; monbas.asm ; Z80 monitor by Andre Adrian, DL1ADR, and Microsoft (NASCOM) BASIC ; assemble: ; tasm -80 -fff -b -c monbas.asm monbas.bin ;============================================================================= ; 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.x10host.com/z80/SimpleZ80.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 BACKSL .EQU 5Ch DEL .EQU 7FH ; Delete ; BASIC WORK SPACE LOCATIONS WRKSPC .EQU 2045H ; BASIC Work space USR .EQU WRKSPC+3H ; "USR (x)" jump OUTSUB .EQU WRKSPC+6H ; "OUT p,n" OTPORT .EQU WRKSPC+7H ; Port (p) DIVSUP .EQU WRKSPC+9H ; Division support routine DIV1 .EQU WRKSPC+0AH ; <- Values DIV2 .EQU WRKSPC+0EH ; <- to DIV3 .EQU WRKSPC+12H ; <- be DIV4 .EQU WRKSPC+15H ; <-inserted SEED .EQU WRKSPC+17H ; Random number seed LSTRND .EQU WRKSPC+3AH ; Last random number INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine INPORT .EQU WRKSPC+3FH ; PORT (x) NULLS .EQU WRKSPC+41H ; Number of nulls LWIDTH .EQU WRKSPC+42H ; Terminal width COMMAN .EQU WRKSPC+43H ; Width for commas NULFLG .EQU WRKSPC+44H ; Null after input byte flag CTLOFG .EQU WRKSPC+45H ; Control "O" flag LINESC .EQU WRKSPC+46H ; Lines counter LINESN .EQU WRKSPC+48H ; Lines number CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine BRKFLG .EQU WRKSPC+4DH ; Break flag RINPUT .EQU WRKSPC+4EH ; Input reflection POINT .EQU WRKSPC+51H ; "POINT" reflection (unused) PSET .EQU WRKSPC+54H ; "SET" reflection RESET .EQU WRKSPC+57H ; "RESET" reflection STRSPC .EQU WRKSPC+5AH ; Bottom of string space LINEAT .EQU WRKSPC+5CH ; Current line number BASTXT .EQU WRKSPC+5EH ; Pointer to start of program BUFFER .EQU WRKSPC+61H ; Input buffer STACK .EQU WRKSPC+66H ; Initial stack CURPOS .EQU WRKSPC+0ABH ; Character position on line LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag TYPE .EQU WRKSPC+0ADH ; Data type flag DATFLG .EQU WRKSPC+0AEH ; Literal statement flag LSTRAM .EQU WRKSPC+0AFH ; Last available RAM TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool TMPSTR .EQU WRKSPC+0BFH ; Temporary string STRBOT .EQU WRKSPC+0C3H ; Bottom of string space CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL LOOPST .EQU WRKSPC+0C7H ; First statement of loop DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag LSTBIN .EQU WRKSPC+0CCH ; Last byte entered READFG .EQU WRKSPC+0CDH ; Read/Input flag BRKLIN .EQU WRKSPC+0CEH ; Line of break NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL ERRLIN .EQU WRKSPC+0D2H ; Line of error CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue PROGND .EQU WRKSPC+0D6H ; End of program VAREND .EQU WRKSPC+0D8H ; End of variables ARREND .EQU WRKSPC+0DAH ; End of arrays NXTDAT .EQU WRKSPC+0DCH ; Next data item FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument FNARG .EQU WRKSPC+0E0H ; FN argument value FPREG .EQU WRKSPC+0E4H ; Floating point register FPEXP .EQU FPREG+3 ; Floating point exponent SGNRES .EQU WRKSPC+0E8H ; Sign of result PBUFF .EQU WRKSPC+0E9H ; Number print buffer MULVAL .EQU WRKSPC+0F6H ; Multiplier PROGST .EQU WRKSPC+0F9H ; Start of program text area STLOOK .EQU WRKSPC+15DH ; Start of memory test ; BASIC ERROR CODE VALUES NF .EQU 00H ; NEXT without FOR SN .EQU 02H ; Syntax error RG .EQU 04H ; RETURN without GOSUB OD .EQU 06H ; Out of DATA FC .EQU 08H ; Function call error OV .EQU 0AH ; Overflow OM .EQU 0CH ; Out of memory UL .EQU 0EH ; Undefined line number BS .EQU 10H ; Bad subscript DD .EQU 12H ; Re-DIMensioned array DZ .EQU 14H ; Division by zero (/0) ID .EQU 16H ; Illegal direct TM .EQU 18H ; Type miss-match OS .EQU 1AH ; Out of string space LS .EQU 1CH ; String too long ST .EQU 1EH ; String formula too complex CN .EQU 20H ; Can't CONTinue UF .EQU 22H ; UnDEFined FN function MO .EQU 24H ; Missing operand HX .EQU 26H ; HEX error BN .EQU 28H ; BIN error ; ************************************************************ ; Z80 monitor program for ACIA 65C51 ; by Andre Adrian, DL1ADR ; 2026-04-18 first version, based on 6309 mon ; 6551 ACIA addresses ACIA .EQU 7Ch ; CS0=/M1, /CS1=A7, RS1=A1, RS0=A0 ACIRX .EQU ACIA ACITX .EQU ACIA ACIST .EQU ACIA+1 ACICMD .EQU ACIA+2 ACICTR .EQU ACIA+3 TMPSTK .EQU 20EDh ; Top of BASIC line input buffer so is ; "free ram" when BASIC resets .ORG 0 reset: di ; disable interrupt im 1 ; interrupt = 38h ld sp,TMPSTK ; Temp stack jr reset2 ; TX a character over RS232 .ORG 08h jr putc reset2: ld A,09h ; no parity, /rts=lo, /dtr=lo out (ACICMD),a ; no tx interrupt, rx interrupt jr reset3 ; RX a character over RS232 Channel A [Console], hold here until char ready. .ORG 10h ; call acia input, return A=char getc: rst 18h jr z,getc in a,(ACIRX) ret ; Check serial status .ORG 18h ; call acia input available, return A!=0 if yes keybd: in a,(ACIST) and 8 ; Receive data reg full bit ret .ORG 20h ; call output Carrige Return, Line Feed putcrlf: ld a,CR rst 08h ld a,LF jr putc ; ret via putc .ORG 28h ; call output 2 Hex digits as ASCII, A=byte putbyte: push af ; save A on stack rrca ; A >>= 4 rrca rrca rrca rst 30h ; print hex nibble as ascii pop af ; restore A from stack nop .ORG 30h xascii: and 0Fh ; A &= 0x0F add a,'0' cp '9'+1 jr xascii2 .ORG 38h ; interrupt jp 2000h xascii2: jr c,outc ; jump if A < 'A'+1 add a,7 ; A += 'A'-'9'-1 outc: jr putc ; ret via putc ; call acia input with echo, return A=char echoc: rst 10h cp 'a' ; to capital chars jr c,endUpper cp 'z'+1 jr nc,endUpper sub 20h ; 'a'-'A' endUpper: ; call acia output, A=char ; not for W65C51N with Transmit data reg empty bug ! putc: push af ; save A on stack putc2: in a,(ACIST) and 10h ; Transmit data reg empty bit jr z,putc2 pop af ; restore A from stack out (ACITX),a ret reset3: ld A,03Fh ; 7n1, 19200 bps (baud) out (ACICTR),a Loop3: rst 20h ; print CR, LF ld a,BACKSL rst 08h ; print \ Loop2: ld hl,0 ; accu = 0 Loop: call echoc ; get char with echo cp CR ; CR do nothing jr z,Loop3 cp '0' ; Digit 0..9 jr c,endDigit cp '9'+1 jr nc,endDigit sub '0' nibble: add hl,hl ; accu <<= 4 add hl,hl add hl,hl add hl,hl or l ; accu_lo = A | accu_lo ld l,a jr Loop endDigit: cp 'A' ; Hex A..F jr c,endHex cp 'F'+1 jr nc,endHex sub 'A'-10 jr nibble endHex: cp 'P' ; P print memory range jr nz,endPrint prLoop2: rst 20h ; print CR, LF ld a,d ; A = argA_hi rst 28h ; print addr high ld a,e ; A = argA_lo rst 28h ; print addr low ld a,':' rst 08h ; print : prLoop: ld a,(de) inc de rst 28h ; print *argA++ ld a,',' rst 08h ; print , ld a,l ; accu-argA sub e ld a,h sbc a,d jr c,Loop3 ; jump if (accu < argA) ld a,e ; A = argA_lo and 0Fh jr z,prLoop2 ; jump if (!(argA & 15)) jr prLoop endPrint: cp ':' ; Colon enter address jr nz,endColon ld e,l ; argA = accu ld d,h jr Loop2 endColon: cp 'R' ; R run jr nz,endRun jp (hl) endRun: cp ',' ; Comma store byte jr nz,Loop ld a,l ld (de),a ; *argA++ = accu low byte inc de ld l,0 ; accu low = 0 jr Loop ; ************************************************************ ; basic .ORG 00150H COLD: JP STARTB ; Jump for cold start WARM: JP WARMST ; Jump for warm start STARTB: LD IX,0 ; Flag cold start JP CSTART ; Jump to initialise .WORD DEINT ; Get integer -32768 to 32767 .WORD ABPASS ; Return integer in AB CSTART: LD HL,WRKSPC ; Start of workspace RAM LD SP,HL ; Set up a temporary stack JP INITST ; Go to initialise INIT: LD DE,INITAB ; Initialise workspace LD B,INITBE-INITAB+3; Bytes to copy LD HL,WRKSPC ; Into workspace RAM COPY: LD A,(DE) ; Get source LD (HL),A ; To destination INC HL ; Next destination INC DE ; Next source DEC B ; Count bytes JP NZ,COPY ; More to move LD SP,HL ; Temporary stack CALL CLREG ; Clear registers and stack CALL PRNTCRLF ; Output CRLF LD (BUFFER+72+1),A ; Mark end of buffer LD (PROGST),A ; Initialise program area MSIZE: LD HL,MEMMSG ; Point to message CALL PRS ; Output "Memory size" CALL PROMPT ; Get input with '?' CALL GETCHR ; Get next character OR A ; Set flags JP NZ,TSTMEM ; If number - Test if RAM there LD HL,STLOOK ; Point to start of RAM MLOOP: INC HL ; Next byte LD A,H ; Above address FFFF ? OR L JP Z,SETTOP ; Yes - 64K RAM LD A,(HL) ; Get contents LD B,A ; Save it CPL ; Flip all bits LD (HL),A ; Put it back CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP Z,MLOOP ; If RAM - test next byte JP SETTOP ; Top of RAM found TSTMEM: CALL ATOH ; Get high memory into DE OR A ; Set flags on last byte JP NZ,SNERR ; ?SN Error if bad character EX DE,HL ; Address into HL DEC HL ; Back one byte LD A,11011001B ; Test byte LD B,(HL) ; Get old contents LD (HL),A ; Load test byte CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP NZ,MSIZE ; Ask again if no RAM SETTOP: DEC HL ; Back one byte LD DE,STLOOK-1 ; See if enough RAM CALL CPDEHL ; Compare DE with HL JP C,MSIZE ; Ask again if not enough RAM LD DE,0-50 ; 50 Bytes string space LD (LSTRAM),HL ; Save last available RAM ADD HL,DE ; Allocate string space LD (STRSPC),HL ; Save string space CALL CLRPTR ; Clear program area LD HL,(STRSPC) ; Get end of memory LD DE,0-17 ; Offset for free bytes ADD HL,DE ; Adjust HL LD DE,PROGST ; Start of program text LD A,L ; Get LSB SUB E ; Adjust it LD L,A ; Re-save LD A,H ; Get MSB SBC A,D ; Adjust it LD H,A ; Re-save PUSH HL ; Save bytes free LD HL,SIGNON ; Sign-on message CALL PRS ; Output string POP HL ; Get bytes free back CALL PRNTHL ; Output amount of free memory LD HL,BFREE ; " Bytes free" message CALL PRS ; Output string WARMST: LD SP,STACK ; Temporary stack BRKRET: CALL CLREG ; Clear registers and stack JP PRNTOK ; Go to get command line BFREE: .BYTE " Bytes free",CR,LF,0,0 SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF .BYTE "Copyright ",40,"C",41 .BYTE " 1978 by Microsoft",CR,LF,0,0 MEMMSG: .BYTE "Memory top",0 ; FUNCTION ADDRESS TABLE FNCTAB: .WORD SGN .WORD INT .WORD ABS .WORD USR .WORD FRE .WORD INP .WORD POS .WORD SQR .WORD RND .WORD LOG .WORD EXP .WORD COS .WORD SIN .WORD TAN .WORD ATN .WORD PEEK .WORD DEEK .WORD POINT .WORD LEN .WORD STR .WORD VAL .WORD ASC .WORD CHR .WORD HEX .WORD BIN .WORD LEFT .WORD RIGHT .WORD MID ; RESERVED WORD LIST WORDS: .BYTE 'E'+80H,"ND" .BYTE 'F'+80H,"OR" .BYTE 'N'+80H,"EXT" .BYTE 'D'+80H,"ATA" .BYTE 'I'+80H,"NPUT" .BYTE 'D'+80H,"IM" .BYTE 'R'+80H,"EAD" .BYTE 'L'+80H,"ET" .BYTE 'G'+80H,"OTO" .BYTE 'R'+80H,"UN" .BYTE 'I'+80H,"F" .BYTE 'R'+80H,"ESTORE" .BYTE 'G'+80H,"OSUB" .BYTE 'R'+80H,"ETURN" .BYTE 'R'+80H,"EM" .BYTE 'S'+80H,"TOP" .BYTE 'O'+80H,"UT" .BYTE 'O'+80H,"N" .BYTE 'N'+80H,"ULL" .BYTE 'W'+80H,"AIT" .BYTE 'D'+80H,"EF" .BYTE 'P'+80H,"OKE" .BYTE 'D'+80H,"OKE" .BYTE 'S'+80H,"CREEN" .BYTE 'L'+80H,"INES" .BYTE 'C'+80H,"LS" .BYTE 'W'+80H,"IDTH" .BYTE 'M'+80H,"ONITOR" .BYTE 'S'+80H,"ET" .BYTE 'R'+80H,"ESET" .BYTE 'P'+80H,"RINT" .BYTE 'C'+80H,"ONT" .BYTE 'L'+80H,"IST" .BYTE 'C'+80H,"LEAR" .BYTE 'C'+80H,"LOAD" .BYTE 'C'+80H,"SAVE" .BYTE 'N'+80H,"EW" .BYTE 'T'+80H,"AB(" .BYTE 'T'+80H,"O" .BYTE 'F'+80H,"N" .BYTE 'S'+80H,"PC(" .BYTE 'T'+80H,"HEN" .BYTE 'N'+80H,"OT" .BYTE 'S'+80H,"TEP" .BYTE '+'+80H .BYTE '-'+80H .BYTE '*'+80H .BYTE '/'+80H .BYTE '^'+80H .BYTE 'A'+80H,"ND" .BYTE 'O'+80H,"R" .BYTE '>'+80H .BYTE '='+80H .BYTE '<'+80H .BYTE 'S'+80H,"GN" .BYTE 'I'+80H,"NT" .BYTE 'A'+80H,"BS" .BYTE 'U'+80H,"SR" .BYTE 'F'+80H,"RE" .BYTE 'I'+80H,"NP" .BYTE 'P'+80H,"OS" .BYTE 'S'+80H,"QR" .BYTE 'R'+80H,"ND" .BYTE 'L'+80H,"OG" .BYTE 'E'+80H,"XP" .BYTE 'C'+80H,"OS" .BYTE 'S'+80H,"IN" .BYTE 'T'+80H,"AN" .BYTE 'A'+80H,"TN" .BYTE 'P'+80H,"EEK" .BYTE 'D'+80H,"EEK" .BYTE 'P'+80H,"OINT" .BYTE 'L'+80H,"EN" .BYTE 'S'+80H,"TR$" .BYTE 'V'+80H,"AL" .BYTE 'A'+80H,"SC" .BYTE 'C'+80H,"HR$" .BYTE 'H'+80H,"EX$" .BYTE 'B'+80H,"IN$" .BYTE 'L'+80H,"EFT$" .BYTE 'R'+80H,"IGHT$" .BYTE 'M'+80H,"ID$" .BYTE 80H ; End of list marker ; KEYWORD ADDRESS TABLE WORDTB: .WORD PEND .WORD FOR .WORD NEXT .WORD DATA .WORD INPUT .WORD DIM .WORD READ .WORD LET .WORD GOTO .WORD RUN .WORD IF .WORD RESTOR .WORD GOSUB .WORD RETURN .WORD REM .WORD STOP .WORD POUT .WORD ON .WORD NULL .WORD WAIT .WORD DEF .WORD POKE .WORD DOKE .WORD REM .WORD LINES .WORD CLS .WORD WIDTH .WORD MONITR .WORD PSET .WORD RESET .WORD PRINT .WORD CONT .WORD LIST .WORD CLEAR .WORD REM .WORD REM .WORD NEW ; RESERVED WORD TOKEN VALUES ZEND .EQU 080H ; END ZFOR .EQU 081H ; FOR ZDATA .EQU 083H ; DATA ZGOTO .EQU 088H ; GOTO ZGOSUB .EQU 08CH ; GOSUB ZREM .EQU 08EH ; REM ZPRINT .EQU 09EH ; PRINT ZNEW .EQU 0A4H ; NEW ZTAB .EQU 0A5H ; TAB ZTO .EQU 0A6H ; TO ZFN .EQU 0A7H ; FN ZSPC .EQU 0A8H ; SPC ZTHEN .EQU 0A9H ; THEN ZNOT .EQU 0AAH ; NOT ZSTEP .EQU 0ABH ; STEP ZPLUS .EQU 0ACH ; + ZMINUS .EQU 0ADH ; - ZTIMES .EQU 0AEH ; * ZDIV .EQU 0AFH ; / ZOR .EQU 0B2H ; OR ZGTR .EQU 0B3H ; > ZEQUAL .EQU 0B4H ; M ZLTH .EQU 0B5H ; < ZSGN .EQU 0B6H ; SGN ZPOINT .EQU 0C7H ; POINT ZLEFT .EQU 0CDH +2 ; LEFT$ ; ARITHMETIC PRECEDENCE TABLE PRITAB: .BYTE 79H ; Precedence value .WORD PADD ; FPREG = + FPREG .BYTE 79H ; Precedence value .WORD PSUB ; FPREG = - FPREG .BYTE 7CH ; Precedence value .WORD MULT ; PPREG = * FPREG .BYTE 7CH ; Precedence value .WORD DIV ; FPREG = / FPREG .BYTE 7FH ; Precedence value .WORD POWER ; FPREG = ^ FPREG .BYTE 50H ; Precedence value .WORD PAND ; FPREG = AND FPREG .BYTE 46H ; Precedence value .WORD POR ; FPREG = OR FPREG ; BASIC ERROR CODE LIST ERRORS: .BYTE "NF" ; NEXT without FOR .BYTE "SN" ; Syntax error .BYTE "RG" ; RETURN without GOSUB .BYTE "OD" ; Out of DATA .BYTE "FC" ; Illegal function call .BYTE "OV" ; Overflow error .BYTE "OM" ; Out of memory .BYTE "UL" ; Undefined line .BYTE "BS" ; Bad subscript .BYTE "DD" ; Re-DIMensioned array .BYTE "/0" ; Division by zero .BYTE "ID" ; Illegal direct .BYTE "TM" ; Type mis-match .BYTE "OS" ; Out of string space .BYTE "LS" ; String too long .BYTE "ST" ; String formula too complex .BYTE "CN" ; Can't CONTinue .BYTE "UF" ; Undefined FN function .BYTE "MO" ; Missing operand .BYTE "HX" ; HEX error .BYTE "BN" ; BIN error ; INITIALISATION TABLE ------------------------------------------------------- INITAB: JP WARMST ; Warm start jump JP FCERR ; "USR (X)" jump (Set to Error) OUT (0),A ; "OUT p,n" skeleton RET SUB 0 ; Division support routine LD L,A LD A,H SBC A,0 LD H,A LD A,B SBC A,0 LD B,A LD A,0 RET .BYTE 0,0,0 ; Random number seed table used by RND .BYTE 035H,04AH,0CAH,099H ;-2.65145E+07 .BYTE 039H,01CH,076H,098H ; 1.61291E+07 .BYTE 022H,095H,0B3H,098H ;-1.17691E+07 .BYTE 00AH,0DDH,047H,098H ; 1.30983E+07 .BYTE 053H,0D1H,099H,099H ;-2-01612E+07 .BYTE 00AH,01AH,09FH,098H ;-1.04269E+07 .BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07 .BYTE 0D6H,077H,03EH,098H ; 1.24825E+07 .BYTE 052H,0C7H,04FH,080H ; Last random number IN A,(0) ; INP (x) skeleton RET .BYTE 1 ; POS (x) number (1) .BYTE 255 ; Terminal width (255 = no auto CRLF) .BYTE 28 ; Width for commas (3 columns) .BYTE 0 ; No nulls after input bytes .BYTE 0 ; Output enabled (^O off) .WORD 20 ; Initial lines counter .WORD 20 ; Initial lines number .WORD 0 ; Array load/save check sum .BYTE 0 ; Break not by NMI .BYTE 0 ; Break flag JP TTYLIN ; Input reflection (set to TTY) JP $0000 ; POINT reflection unused JP $0000 ; SET reflection JP $0000 ; RESET reflection .WORD STLOOK ; Temp string space .WORD -2 ; Current line number (cold) .WORD PROGST+1 ; Start of program text INITBE: ; END OF INITIALISATION TABLE --------------------------------------------------- ERRMSG: .BYTE " Error",0 INMSG: .BYTE " in ",0 ZERBYT .EQU $-1 ; A zero byte OKMSG: .BYTE "Ok",CR,LF,0,0 BRKMSG: .BYTE "Break",0 BAKSTK: LD HL,4 ; Look for "FOR" block with ADD HL,SP ; same index as specified LOKFOR: LD A,(HL) ; Get block ID INC HL ; Point to index address CP ZFOR ; Is it a "FOR" token RET NZ ; No - exit LD C,(HL) ; BC = Address of "FOR" index INC HL LD B,(HL) INC HL ; Point to sign of STEP PUSH HL ; Save pointer to sign LD L,C ; HL = address of "FOR" index LD H,B LD A,D ; See if an index was specified OR E ; DE = 0 if no index specified EX DE,HL ; Specified index into HL JP Z,INDFND ; Skip if no index given EX DE,HL ; Index back into DE CALL CPDEHL ; Compare index with one given INDFND: LD BC,16-3 ; Offset to next block POP HL ; Restore pointer to sign RET Z ; Return if block found ADD HL,BC ; Point to next block JP LOKFOR ; Keep on looking MOVUP: CALL ENFMEM ; See if enough memory MOVSTR: PUSH BC ; Save end of source EX (SP),HL ; Swap source and dest" end POP BC ; Get end of destination MOVLP: CALL CPDEHL ; See if list moved LD A,(HL) ; Get byte LD (BC),A ; Move it RET Z ; Exit if all done DEC BC ; Next byte to move to DEC HL ; Next byte to move JP MOVLP ; Loop until all bytes moved CHKSTK: PUSH HL ; Save code string address LD HL,(ARREND) ; Lowest free memory LD B,0 ; BC = Number of levels to test ADD HL,BC ; 2 Bytes for each level ADD HL,BC .BYTE 3EH ; Skip "PUSH HL" ENFMEM: PUSH HL ; Save code string address LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM SUB L LD L,A LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM SBC A,H JP C,OMERR ; Not enough - ?OM Error LD H,A ADD HL,SP ; Test if stack is overflowed POP HL ; Restore code string address RET C ; Return if enough mmory OMERR: LD E,OM ; ?OM Error JP ERROR DATSNR: LD HL,(DATLIN) ; Get line of current DATA item LD (LINEAT),HL ; Save as current line SNERR: LD E,SN ; ?SN Error .BYTE 01H ; Skip "LD E,DZ" DZERR: LD E,DZ ; ?/0 Error .BYTE 01H ; Skip "LD E,NF" NFERR: LD E,NF ; ?NF Error .BYTE 01H ; Skip "LD E,DD" DDERR: LD E,DD ; ?DD Error .BYTE 01H ; Skip "LD E,UF" UFERR: LD E,UF ; ?UF Error .BYTE 01H ; Skip "LD E,OV OVERR: LD E,OV ; ?OV Error .BYTE 01H ; Skip "LD E,TM" TMERR: LD E,TM ; ?TM Error ERROR: CALL CLREG ; Clear registers and stack LD (CTLOFG),A ; Enable output (A is 0) CALL STTLIN ; Start new line LD HL,ERRORS ; Point to error codes LD D,A ; D = 0 (A is 0) LD A,'?' CALL OUTC ; Output '?' ADD HL,DE ; Offset to correct error code LD A,(HL) ; First character CALL OUTC ; Output it CALL GETCHR ; Get next character CALL OUTC ; Output it LD HL,ERRMSG ; "Error" message ERRIN: CALL PRS ; Output message LD HL,(LINEAT) ; Get line of error LD DE,-2 ; Cold start error if -2 CALL CPDEHL ; See if cold start error JP Z,CSTART ; Cold start error - Restart LD A,H ; Was it a direct error? AND L ; Line = -1 if direct error INC A CALL NZ,LINEIN ; No - output line of error .BYTE 3EH ; Skip "POP BC" POPNOK: POP BC ; Drop address in input buffer PRNTOK: XOR A ; Output "Ok" and get command LD (CTLOFG),A ; Enable output CALL STTLIN ; Start new line LD HL,OKMSG ; "Ok" message CALL PRS ; Output "Ok" GETCMD: LD HL,-1 ; Flag direct mode LD (LINEAT),HL ; Save as current line CALL GETLIN ; Get an input line JP C,GETCMD ; Get line again if break CALL GETCHR ; Get first character INC A ; Test if end of line DEC A ; Without affecting Carry JP Z,GETCMD ; Nothing entered - Get another PUSH AF ; Save Carry status CALL ATOH ; Get line number into DE PUSH DE ; Save line number CALL CRUNCH ; Tokenise rest of line LD B,A ; Length of tokenised line POP DE ; Restore line number POP AF ; Restore Carry JP NC,EXCUTE ; No line number - Direct mode PUSH DE ; Save line number PUSH BC ; Save length of tokenised line XOR A LD (LSTBIN),A ; Clear last byte input CALL GETCHR ; Get next character OR A ; Set flags PUSH AF ; And save them CALL SRCHLN ; Search for line number in DE JP C,LINFND ; Jump if line found POP AF ; Get status PUSH AF ; And re-save JP Z,ULERR ; Nothing after number - Error OR A ; Clear Carry LINFND: PUSH BC ; Save address of line in prog JP NC,INEWLN ; Line not found - Insert new EX DE,HL ; Next line address in DE LD HL,(PROGND) ; End of program SFTPRG: LD A,(DE) ; Shift rest of program down LD (BC),A INC BC ; Next destination INC DE ; Next source CALL CPDEHL ; All done? JP NZ,SFTPRG ; More to do LD H,B ; HL - New end of program LD L,C LD (PROGND),HL ; Update end of program INEWLN: POP DE ; Get address of line, POP AF ; Get status JP Z,SETPTR ; No text - Set up pointers LD HL,(PROGND) ; Get end of program EX (SP),HL ; Get length of input line POP BC ; End of program to BC ADD HL,BC ; Find new end PUSH HL ; Save new end CALL MOVUP ; Make space for line POP HL ; Restore new end LD (PROGND),HL ; Update end of program pointer EX DE,HL ; Get line to move up in HL LD (HL),H ; Save MSB POP DE ; Get new line number INC HL ; Skip pointer INC HL LD (HL),E ; Save LSB of line number INC HL LD (HL),D ; Save MSB of line number INC HL ; To first byte in line LD DE,BUFFER ; Copy buffer to program MOVBUF: LD A,(DE) ; Get source LD (HL),A ; Save destinations INC HL ; Next source INC DE ; Next destination OR A ; Done? JP NZ,MOVBUF ; No - Repeat SETPTR: CALL RUNFST ; Set line pointers INC HL ; To LSB of pointer EX DE,HL ; Address to DE PTRLP: LD H,D ; Address to HL LD L,E LD A,(HL) ; Get LSB of pointer INC HL ; To MSB of pointer OR (HL) ; Compare with MSB pointer JP Z,GETCMD ; Get command line if end INC HL ; To LSB of line number INC HL ; Skip line number INC HL ; Point to first byte in line XOR A ; Looking for 00 byte FNDEND: CP (HL) ; Found end of line? INC HL ; Move to next byte JP NZ,FNDEND ; No - Keep looking EX DE,HL ; Next line address to HL LD (HL),E ; Save LSB of pointer INC HL LD (HL),D ; Save MSB of pointer JP PTRLP ; Do next line SRCHLN: LD HL,(BASTXT) ; Start of program text SRCHLP: LD B,H ; BC = Address to look at LD C,L LD A,(HL) ; Get address of next line INC HL OR (HL) ; End of program found? DEC HL RET Z ; Yes - Line not found INC HL INC HL LD A,(HL) ; Get LSB of line number INC HL LD H,(HL) ; Get MSB of line number LD L,A CALL CPDEHL ; Compare with line in DE LD H,B ; HL = Start of this line LD L,C LD A,(HL) ; Get LSB of next line address INC HL LD H,(HL) ; Get MSB of next line address LD L,A ; Next line to HL CCF RET Z ; Lines found - Exit CCF RET NC ; Line not found,at line after JP SRCHLP ; Keep looking NEW: RET NZ ; Return if any more on line CLRPTR: LD HL,(BASTXT) ; Point to start of program XOR A ; Set program area to empty LD (HL),A ; Save LSB = 00 INC HL LD (HL),A ; Save MSB = 00 INC HL LD (PROGND),HL ; Set program end RUNFST: LD HL,(BASTXT) ; Clear all variables DEC HL INTVAR: LD (BRKLIN),HL ; Initialise RUN variables LD HL,(LSTRAM) ; Get end of RAM LD (STRBOT),HL ; Clear string space XOR A CALL RESTOR ; Reset DATA pointers LD HL,(PROGND) ; Get end of program LD (VAREND),HL ; Clear variables LD (ARREND),HL ; Clear arrays CLREG: POP BC ; Save return address LD HL,(STRSPC) ; Get end of working RAN LD SP,HL ; Set stack LD HL,TMSTPL ; Temporary string pool LD (TMSTPT),HL ; Reset temporary string ptr XOR A ; A = 00 LD L,A ; HL = 0000 LD H,A LD (CONTAD),HL ; No CONTinue LD (FORFLG),A ; Clear FOR flag LD (FNRGNM),HL ; Clear FN argument PUSH HL ; HL = 0000 PUSH BC ; Put back return DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN RET ; Return to execution driver PROMPT: LD A,'?' ; '?' CALL OUTC ; Output character LD A,' ' ; Space CALL OUTC ; Output character JP RINPUT ; Get input line CRUNCH: XOR A ; Tokenise line @ HL to BUFFER LD (DATFLG),A ; Reset literal flag LD C,2+3 ; 2 byte number and 3 nulls LD DE,BUFFER ; Start of input buffer CRNCLP: LD A,(HL) ; Get byte CP ' ' ; Is it a space? JP Z,MOVDIR ; Yes - Copy direct LD B,A ; Save character CP '"' ; Is it a quote? JP Z,CPYLIT ; Yes - Copy literal string OR A ; Is it end of buffer? JP Z,ENDBUF ; Yes - End buffer LD A,(DATFLG) ; Get data type OR A ; Literal? LD A,(HL) ; Get byte to copy JP NZ,MOVDIR ; Literal - Copy direct CP '?' ; Is it '?' short for PRINT LD A,ZPRINT ; "PRINT" token JP Z,MOVDIR ; Yes - replace it LD A,(HL) ; Get byte again CP '0' ; Is it less than '0' JP C,FNDWRD ; Yes - Look for reserved words CP 60; ";"+1 ; Is it "0123456789:;" ? JP C,MOVDIR ; Yes - copy it direct FNDWRD: PUSH DE ; Look for reserved words LD DE,WORDS-1 ; Point to table PUSH BC ; Save count LD BC,RETNAD ; Where to return to PUSH BC ; Save return address LD B,ZEND-1 ; First token value -1 LD A,(HL) ; Get byte CP 'a' ; Less than 'a' ? JP C,SEARCH ; Yes - search for words CP 'z'+1 ; Greater than 'z' ? JP NC,SEARCH ; Yes - search for words AND 01011111B ; Force upper case LD (HL),A ; Replace byte SEARCH: LD C,(HL) ; Search for a word EX DE,HL GETNXT: INC HL ; Get next reserved word OR (HL) ; Start of word? JP P,GETNXT ; No - move on INC B ; Increment token value LD A, (HL) ; Get byte from table AND 01111111B ; Strip bit 7 RET Z ; Return if end of list CP C ; Same character as in buffer? JP NZ,GETNXT ; No - get next word EX DE,HL PUSH HL ; Save start of word NXTBYT: INC DE ; Look through rest of word LD A,(DE) ; Get byte from table OR A ; End of word ? JP M,MATCH ; Yes - Match found LD C,A ; Save it LD A,B ; Get token value CP ZGOTO ; Is it "GOTO" token ? JP NZ,NOSPC ; No - Don't allow spaces CALL GETCHR ; Get next character DEC HL ; Cancel increment from GETCHR NOSPC: INC HL ; Next byte LD A,(HL) ; Get byte CP 'a' ; Less than 'a' ? JP C,NOCHNG ; Yes - don't change AND 01011111B ; Make upper case NOCHNG: CP C ; Same as in buffer ? JP Z,NXTBYT ; Yes - keep testing POP HL ; Get back start of word JP SEARCH ; Look at next word MATCH: LD C,B ; Word found - Save token value POP AF ; Throw away return EX DE,HL RET ; Return to "RETNAD" RETNAD: EX DE,HL ; Get address in string LD A,C ; Get token value POP BC ; Restore buffer length POP DE ; Get destination address MOVDIR: INC HL ; Next source in buffer LD (DE),A ; Put byte in buffer INC DE ; Move up buffer INC C ; Increment length of buffer SUB ':' ; End of statement? JP Z,SETLIT ; Jump if multi-statement line CP ZDATA-3AH ; Is it DATA statement ? JP NZ,TSTREM ; No - see if REM SETLIT: LD (DATFLG),A ; Set literal flag TSTREM: SUB ZREM-3AH ; Is it REM? JP NZ,CRNCLP ; No - Leave flag LD B,A ; Copy rest of buffer NXTCHR: LD A,(HL) ; Get byte OR A ; End of line ? JP Z,ENDBUF ; Yes - Terminate buffer CP B ; End of statement ? JP Z,MOVDIR ; Yes - Get next one CPYLIT: INC HL ; Move up source string LD (DE),A ; Save in destination INC C ; Increment length INC DE ; Move up destination JP NXTCHR ; Repeat ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer LD (DE),A ; Mark end of buffer (A = 00) INC DE LD (DE),A ; A = 00 INC DE LD (DE),A ; A = 00 RET DODEL: LD A,(NULFLG) ; Get null flag status OR A ; Is it zero? LD A,0 ; Zero A - Leave flags LD (NULFLG),A ; Zero null flag JP NZ,ECHDEL ; Set - Echo it DEC B ; Decrement length JP Z,GETLIN ; Get line again if empty CALL OUTC ; Output null character .BYTE 3EH ; Skip "DEC B" ECHDEL: DEC B ; Count bytes in buffer DEC HL ; Back space buffer JP Z,OTKLN ; No buffer - Try again LD A,(HL) ; Get deleted byte CALL OUTC ; Echo it JP MORINP ; Get more input DELCHR: DEC B ; Count bytes in buffer DEC HL ; Back space buffer CALL OUTC ; Output character in A JP NZ,MORINP ; Not end - Get more OTKLN: CALL OUTC ; Output character in A KILIN: CALL PRNTCRLF ; Output CRLF JP TTYLIN ; Get line again GETLIN: TTYLIN: LD HL,BUFFER ; Get a line by character LD B,1 ; Set buffer as empty XOR A LD (NULFLG),A ; Clear null flag MORINP: CALL CLOTST ; Get character and test ^O LD C,A ; Save character in C CP DEL ; Delete character? JP Z,DODEL ; Yes - Process it LD A,(NULFLG) ; Get null flag OR A ; Test null flag status JP Z,PROCES ; Reset - Process character LD A,0 ; Set a null CALL OUTC ; Output null XOR A ; Clear A LD (NULFLG),A ; Reset null flag PROCES: LD A,C ; Get character CP CTRLG ; Bell? JP Z,PUTCTL ; Yes - Save it CP CTRLC ; Is it control "C"? CALL Z,PRNTCRLF ; Yes - Output CRLF SCF ; Flag break RET Z ; Return if control "C" CP CR ; Is it enter? JP Z,ENDINP ; Yes - Terminate input CP CTRLU ; Is it control "U"? JP Z,KILIN ; Yes - Get another line CP '@' ; Is it "kill line"? JP Z,OTKLN ; Yes - Kill line CP '_' ; Is it delete? JP Z,DELCHR ; Yes - Delete character CP BKSP ; Is it backspace? JP Z,DELCHR ; Yes - Delete character CP CTRLR ; Is it control "R"? JP NZ,PUTBUF ; No - Put in buffer PUSH BC ; Save buffer length PUSH DE ; Save DE PUSH HL ; Save buffer address LD (HL),0 ; Mark end of buffer CALL OUTNCR ; Output and do CRLF LD HL,BUFFER ; Point to buffer start CALL PRS ; Output buffer POP HL ; Restore buffer address POP DE ; Restore DE POP BC ; Restore buffer length JP MORINP ; Get another character PUTBUF: CP ' ' ; Is it a control code? JP C,MORINP ; Yes - Ignore PUTCTL: LD A,B ; Get number of bytes in buffer CP 72+1 ; Test for line overflow LD A,CTRLG ; Set a bell JP NC,OUTNBS ; Ring bell if buffer full LD A,C ; Get character LD (HL),C ; Save in buffer LD (LSTBIN),A ; Save last input byte INC HL ; Move up buffer INC B ; Increment length OUTIT: CALL OUTC ; Output the character entered JP MORINP ; Get another character OUTNBS: CALL OUTC ; Output bell and back over it LD A,BKSP ; Set back space JP OUTIT ; Output it and get more CPDEHL: LD A,H ; Get H SUB D ; Compare with D RET NZ ; Different - Exit LD A,L ; Get L SUB E ; Compare with E RET ; Return status CHKSYN: LD A,(HL) ; Check syntax of character EX (SP),HL ; Address of test byte CP (HL) ; Same as in code string? INC HL ; Return address EX (SP),HL ; Put it back JP Z,GETCHR ; Yes - Get next character JP SNERR ; Different - ?SN Error OUTC: PUSH AF ; Save character LD A,(CTLOFG) ; Get control "O" flag OR A ; Is it set? JP NZ,POPAF ; Yes - don't output POP AF ; Restore character PUSH BC ; Save buffer length PUSH AF ; Save character CP ' ' ; Is it a control code? JP C,DINPOS ; Yes - Don't INC POS(X) LD A,(LWIDTH) ; Get line width LD B,A ; To B LD A,(CURPOS) ; Get cursor position INC B ; Width 255? JP Z,INCLEN ; Yes - No width limit DEC B ; Restore width CP B ; At end of line? CALL Z,PRNTCRLF ; Yes - output CRLF INCLEN: INC A ; Move on one character LD (CURPOS),A ; Save new position DINPOS: POP AF ; Restore character POP BC ; Restore buffer length CALL MONOUT ; Send it RET CLOTST: CALL GETINP ; Get input character AND 01111111B ; Strip bit 7 CP CTRLO ; Is it control "O"? RET NZ ; No don't flip flag LD A,(CTLOFG) ; Get flag CPL ; Flip it LD (CTLOFG),A ; Put it back XOR A ; Null character RET LIST: CALL ATOH ; ASCII number to DE RET NZ ; Return if anything extra POP BC ; Rubbish - Not needed CALL SRCHLN ; Search for line number in DE PUSH BC ; Save address of line CALL SETLIN ; Set up lines counter LISTLP: POP HL ; Restore address of line LD C,(HL) ; Get LSB of next line INC HL LD B,(HL) ; Get MSB of next line INC HL LD A,B ; BC = 0 (End of program)? OR C JP Z,PRNTOK ; Yes - Go to command mode CALL COUNT ; Count lines CALL TSTBRK ; Test for break key PUSH BC ; Save address of next line CALL PRNTCRLF ; Output CRLF LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number INC HL PUSH HL ; Save address of line start EX DE,HL ; Line number to HL CALL PRNTHL ; Output line number in decimal LD A,' ' ; Space after line number POP HL ; Restore start of line address LSTLP2: CALL OUTC ; Output character in A LSTLP3: LD A,(HL) ; Get next byte in line OR A ; End of line? INC HL ; To next byte in line JP Z,LISTLP ; Yes - get next line JP P,LSTLP2 ; No token - output it SUB ZEND-1 ; Find and output word LD C,A ; Token offset+1 to C LD DE,WORDS ; Reserved word list FNDTOK: LD A,(DE) ; Get character in list INC DE ; Move on to next OR A ; Is it start of word? JP P,FNDTOK ; No - Keep looking for word DEC C ; Count words JP NZ,FNDTOK ; Not there - keep looking OUTWRD: AND 01111111B ; Strip bit 7 CALL OUTC ; Output first character LD A,(DE) ; Get next character INC DE ; Move on to next OR A ; Is it end of word? JP P,OUTWRD ; No - output the rest JP LSTLP3 ; Next byte in line SETLIN: PUSH HL ; Set up LINES counter LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Save in LINES counter POP HL RET COUNT: PUSH HL ; Save code string address PUSH DE LD HL,(LINESC) ; Get LINES counter LD DE,-1 ADC HL,DE ; Decrement LD (LINESC),HL ; Put it back POP DE POP HL ; Restore code string address RET P ; Return if more lines to go PUSH HL ; Save code string address LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter CALL GETINP ; Get input character CP CTRLC ; Is it control "C"? JP Z,RSLNBK ; Yes - Reset LINES and break POP HL ; Restore code string address JP COUNT ; Keep on counting RSLNBK: LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter JP BRKRET ; Go and output "Break" FOR: LD A,64H ; Flag "FOR" assignment LD (FORFLG),A ; Save "FOR" flag CALL LET ; Set up initial index POP BC ; Drop RETurn address PUSH HL ; Save code string address CALL DATA ; Get next statement address LD (LOOPST),HL ; Save it for start of loop LD HL,2 ; Offset for "FOR" block ADD HL,SP ; Point to it FORSLP: CALL LOKFOR ; Look for existing "FOR" block POP DE ; Get code string address JP NZ,FORFND ; No nesting found ADD HL,BC ; Move into "FOR" block PUSH DE ; Save code string address DEC HL LD D,(HL) ; Get MSB of loop statement DEC HL LD E,(HL) ; Get LSB of loop statement INC HL INC HL PUSH HL ; Save block address LD HL,(LOOPST) ; Get address of loop statement CALL CPDEHL ; Compare the FOR loops POP HL ; Restore block address JP NZ,FORSLP ; Different FORs - Find another POP DE ; Restore code string address LD SP,HL ; Remove all nested loops FORFND: EX DE,HL ; Code string address to HL LD C,8 CALL CHKSTK ; Check for 8 levels of stack PUSH HL ; Save code string address LD HL,(LOOPST) ; Get first statement of loop EX (SP),HL ; Save and restore code string PUSH HL ; Re-save code string address LD HL,(LINEAT) ; Get current line number EX (SP),HL ; Save and restore code string CALL TSTNUM ; Make sure it's a number CALL CHKSYN ; Make sure "TO" is next .BYTE ZTO ; "TO" token CALL GETNUM ; Get "TO" expression value PUSH HL ; Save code string address CALL BCDEFP ; Move "TO" value to BCDE POP HL ; Restore code string address PUSH BC ; Save "TO" value in block PUSH DE LD BC,8100H ; BCDE - 1 (default STEP) LD D,C ; C=0 LD E,D ; D=0 LD A,(HL) ; Get next byte in code string CP ZSTEP ; See if "STEP" is stated LD A,1 ; Sign of step = 1 JP NZ,SAVSTP ; No STEP given - Default to 1 CALL GETCHR ; Jump over "STEP" token CALL GETNUM ; Get step value PUSH HL ; Save code string address CALL BCDEFP ; Move STEP to BCDE CALL TSTSGN ; Test sign of FPREG POP HL ; Restore code string address SAVSTP: PUSH BC ; Save the STEP value in block PUSH DE PUSH AF ; Save sign of STEP INC SP ; Don't save flags PUSH HL ; Save code string address LD HL,(BRKLIN) ; Get address of index variable EX (SP),HL ; Save and restore code string PUTFID: LD B,ZFOR ; "FOR" block marker PUSH BC ; Save it INC SP ; Don't save C RUNCNT: CALL TSTBRK ; Execution driver - Test break LD (BRKLIN),HL ; Save code address for break LD A,(HL) ; Get next byte in code string CP ':' ; Multi statement line? JP Z,EXCUTE ; Yes - Execute it OR A ; End of line? JP NZ,SNERR ; No - Syntax error INC HL ; Point to address of next line LD A,(HL) ; Get LSB of line pointer INC HL OR (HL) ; Is it zero (End of prog)? JP Z,ENDPRG ; Yes - Terminate execution INC HL ; Point to line number LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number EX DE,HL ; Line number to HL LD (LINEAT),HL ; Save as current line number EX DE,HL ; Line number back to DE EXCUTE: CALL GETCHR ; Get key word LD DE,RUNCNT ; Where to RETurn to PUSH DE ; Save for RETurn IFJMP: RET Z ; Go to RUNCNT if end of STMT ONJMP: SUB ZEND ; Is it a token? JP C,LET ; No - try to assign it CP ZNEW+1-ZEND ; END to NEW ? JP NC,SNERR ; Not a key word - ?SN Error RLCA ; Double it LD C,A ; BC = Offset into table LD B,0 EX DE,HL ; Save code string address LD HL,WORDTB ; Keyword address table ADD HL,BC ; Point to routine address LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address PUSH BC ; Save routine address EX DE,HL ; Restore code string address GETCHR: INC HL ; Point to next character LD A,(HL) ; Get next code string byte CP ':' ; Z if ':' RET NC ; NC if > "9" CP ' ' JP Z,GETCHR ; Skip over spaces CP '0' CCF ; NC if < '0' INC A ; Test for zero - Leave carry DEC A ; Z if Null RET RESTOR: EX DE,HL ; Save code string address LD HL,(BASTXT) ; Point to start of program JP Z,RESTNL ; Just RESTORE - reset pointer EX DE,HL ; Restore code string address CALL ATOH ; Get line number to DE PUSH HL ; Save code string address CALL SRCHLN ; Search for line number in DE LD H,B ; HL = Address of line LD L,C POP DE ; Restore code string address JP NC,ULERR ; ?UL Error if not found RESTNL: DEC HL ; Byte before DATA statement UPDATA: LD (NXTDAT),HL ; Update DATA pointer EX DE,HL ; Restore code string address RET TSTBRK: RST 18H ; Check input status RET Z ; No key, go back RST 10H ; Get the key into A CP ESC ; Escape key? JR Z,BRK ; Yes, break CP CTRLC ; JR Z,BRK ; Yes, break CP CTRLS ; Stop scrolling? RET NZ ; Other key, ignore STALL: RST 10H ; Wait for key CP CTRLQ ; Resume scrolling? RET Z ; Release the chokehold CP CTRLC ; Second break? JR Z,STOP ; Break during hold exits prog JR STALL ; Loop until or BRK LD A,$FF ; Set BRKFLG LD (BRKFLG),A ; Store it STOP: RET NZ ; Exit if anything else .BYTE 0F6H ; Flag "STOP" PEND: RET NZ ; Exit if anything else LD (BRKLIN),HL ; Save point of break .BYTE 21H ; Skip "OR 11111111B" INPBRK: OR 11111111B ; Flag "Break" wanted POP BC ; Return not needed and more ENDPRG: LD HL,(LINEAT) ; Get current line number PUSH AF ; Save STOP / END status LD A,L ; Is it direct break? AND H INC A ; Line is -1 if direct break JP Z,NOLIN ; Yes - No line number LD (ERRLIN),HL ; Save line of break LD HL,(BRKLIN) ; Get point of break LD (CONTAD),HL ; Save point to CONTinue NOLIN: XOR A LD (CTLOFG),A ; Enable output CALL STTLIN ; Start a new line POP AF ; Restore STOP / END status LD HL,BRKMSG ; "Break" message JP NZ,ERRIN ; "in line" wanted? JP PRNTOK ; Go to command mode CONT: LD HL,(CONTAD) ; Get CONTinue address LD A,H ; Is it zero? OR L LD E,CN ; ?CN Error JP Z,ERROR ; Yes - output "?CN Error" EX DE,HL ; Save code string address LD HL,(ERRLIN) ; Get line of last break LD (LINEAT),HL ; Set up current line number EX DE,HL ; Restore code string address RET ; CONTinue where left off NULL: CALL GETINT ; Get integer 0-255 RET NZ ; Return if bad value LD (NULLS),A ; Set nulls number RET ACCSUM: PUSH HL ; Save address in array LD HL,(CHKSUM) ; Get check sum LD B,0 ; BC - Value of byte LD C,A ADD HL,BC ; Add byte to check sum LD (CHKSUM),HL ; Re-save check sum POP HL ; Restore address in array RET CHKLTR: LD A,(HL) ; Get byte CP 'A' ; < 'a' ? RET C ; Carry set if not letter CP 'Z'+1 ; > 'z' ? CCF RET ; Carry set if not letter FPSINT: CALL GETCHR ; Get next character POSINT: CALL GETNUM ; Get integer 0 to 32767 DEPINT: CALL TSTSGN ; Test sign of FPREG JP M,FCERR ; Negative - ?FC Error DEINT: LD A,(FPEXP) ; Get integer value to DE CP 80H+16 ; Exponent in range (16 bits)? JP C,FPINT ; Yes - convert it LD BC,9080H ; BCDE = -32768 LD DE,0000 PUSH HL ; Save code string address CALL CMPNUM ; Compare FPREG with BCDE POP HL ; Restore code string address LD D,C ; MSB to D RET Z ; Return if in range FCERR: LD E,FC ; ?FC Error JP ERROR ; Output error- ATOH: DEC HL ; ASCII number to DE binary GETLN: LD DE,0 ; Get number to DE GTLNLP: CALL GETCHR ; Get next character RET NC ; Exit if not a digit PUSH HL ; Save code string address PUSH AF ; Save digit LD HL,65529/10 ; Largest number 65529 CALL CPDEHL ; Number in range? JP C,SNERR ; No - ?SN Error LD H,D ; HL = Number LD L,E ADD HL,DE ; Times 2 ADD HL,HL ; Times 4 ADD HL,DE ; Times 5 ADD HL,HL ; Times 10 POP AF ; Restore digit SUB '0' ; Make it 0 to 9 LD E,A ; DE = Value of digit LD D,0 ADD HL,DE ; Add to number EX DE,HL ; Number to DE POP HL ; Restore code string address JP GTLNLP ; Go to next character CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters CALL POSINT ; Get integer 0 to 32767 to DE DEC HL ; Cancel increment CALL GETCHR ; Get next character PUSH HL ; Save code string address LD HL,(LSTRAM) ; Get end of RAM JP Z,STORED ; No value given - Use stored POP HL ; Restore code string address CALL CHKSYN ; Check for comma .BYTE ',' PUSH DE ; Save number CALL POSINT ; Get integer 0 to 32767 DEC HL ; Cancel increment CALL GETCHR ; Get next character JP NZ,SNERR ; ?SN Error if more on line EX (SP),HL ; Save code string address EX DE,HL ; Number to DE STORED: LD A,L ; Get LSB of new RAM top SUB E ; Subtract LSB of string space LD E,A ; Save LSB LD A,H ; Get MSB of new RAM top SBC A,D ; Subtract MSB of string space LD D,A ; Save MSB JP C,OMERR ; ?OM Error if not enough mem PUSH HL ; Save RAM top LD HL,(PROGND) ; Get program end LD BC,40 ; 40 Bytes minimum working RAM ADD HL,BC ; Get lowest address CALL CPDEHL ; Enough memory? JP NC,OMERR ; No - ?OM Error EX DE,HL ; RAM top to HL LD (STRSPC),HL ; Set new string space POP HL ; End of memory to use LD (LSTRAM),HL ; Set new top of RAM POP HL ; Restore code string address JP INTVAR ; Initialise variables RUN: JP Z,RUNFST ; RUN from start if just RUN CALL INTVAR ; Initialise variables LD BC,RUNCNT ; Execution driver loop JP RUNLIN ; RUN from line number GOSUB: LD C,3 ; 3 Levels of stack needed CALL CHKSTK ; Check for 3 levels of stack POP BC ; Get return address PUSH HL ; Save code string for RETURN PUSH HL ; And for GOSUB routine LD HL,(LINEAT) ; Get current line EX (SP),HL ; Into stack - Code string out LD A,ZGOSUB ; "GOSUB" token PUSH AF ; Save token INC SP ; Don't save flags RUNLIN: PUSH BC ; Save return address GOTO: CALL ATOH ; ASCII number to DE binary CALL REM ; Get end of line PUSH HL ; Save end of line LD HL,(LINEAT) ; Get current line CALL CPDEHL ; Line after current? POP HL ; Restore end of line INC HL ; Start of next line CALL C,SRCHLP ; Line is after current line CALL NC,SRCHLN ; Line is before current line LD H,B ; Set up code string address LD L,C DEC HL ; Incremented after RET C ; Line found ULERR: LD E,UL ; ?UL Error JP ERROR ; Output error message RETURN: RET NZ ; Return if not just RETURN LD D,-1 ; Flag "GOSUB" search CALL BAKSTK ; Look "GOSUB" block LD SP,HL ; Kill all FORs in subroutine CP ZGOSUB ; Test for "GOSUB" token LD E,RG ; ?RG Error JP NZ,ERROR ; Error if no "GOSUB" found POP HL ; Get RETURN line number LD (LINEAT),HL ; Save as current INC HL ; Was it from direct statement? LD A,H OR L ; Return to line JP NZ,RETLIN ; No - Return to line LD A,(LSTBIN) ; Any INPUT in subroutine? OR A ; If so buffer is corrupted JP NZ,POPNOK ; Yes - Go to command mode RETLIN: LD HL,RUNCNT ; Execution driver loop EX (SP),HL ; Into stack - Code string out .BYTE 3EH ; Skip "POP HL" NXTDTA: POP HL ; Restore code string address DATA: .BYTE 01H,3AH ; ':' End of statement REM: LD C,0 ; 00 End of statement LD B,0 NXTSTL: LD A,C ; Statement and byte LD C,B LD B,A ; Statement end byte NXTSTT: LD A,(HL) ; Get byte OR A ; End of line? RET Z ; Yes - Exit CP B ; End of statement? RET Z ; Yes - Exit INC HL ; Next byte CP '"' ; Literal string? JP Z,NXTSTL ; Yes - Look for another '"' JP NXTSTT ; Keep looking LET: CALL GETVAR ; Get variable name CALL CHKSYN ; Make sure "=" follows .BYTE ZEQUAL ; "=" token PUSH DE ; Save address of variable LD A,(TYPE) ; Get data type PUSH AF ; Save type CALL EVAL ; Evaluate expression POP AF ; Restore type EX (SP),HL ; Save code - Get var addr LD (BRKLIN),HL ; Save address of variable RRA ; Adjust type CALL CHKTYP ; Check types are the same JP Z,LETNUM ; Numeric - Move value LETSTR: PUSH HL ; Save address of string var LD HL,(FPREG) ; Pointer to string entry PUSH HL ; Save it on stack INC HL ; Skip over length INC HL LD E,(HL) ; LSB of string address INC HL LD D,(HL) ; MSB of string address LD HL,(BASTXT) ; Point to start of program CALL CPDEHL ; Is string before program? JP NC,CRESTR ; Yes - Create string entry LD HL,(STRSPC) ; Point to string space CALL CPDEHL ; Is string literal in program? POP DE ; Restore address of string JP NC,MVSTPT ; Yes - Set up pointer LD HL,TMPSTR ; Temporary string pool CALL CPDEHL ; Is string in temporary pool? JP NC,MVSTPT ; No - Set up pointer .BYTE 3EH ; Skip "POP DE" CRESTR: POP DE ; Restore address of string CALL BAKTMP ; Back to last tmp-str entry EX DE,HL ; Address of string entry CALL SAVSTR ; Save string in string area MVSTPT: CALL BAKTMP ; Back to last tmp-str entry POP HL ; Get string pointer CALL DETHL4 ; Move string pointer to var POP HL ; Restore code string address RET LETNUM: PUSH HL ; Save address of variable CALL FPTHL ; Move value to variable POP DE ; Restore address of variable POP HL ; Restore code string address RET ON: CALL GETINT ; Get integer 0-255 LD A,(HL) ; Get "GOTO" or "GOSUB" token LD B,A ; Save in B CP ZGOSUB ; "GOSUB" token? JP Z,ONGO ; Yes - Find line number CALL CHKSYN ; Make sure it's "GOTO" .BYTE ZGOTO ; "GOTO" token DEC HL ; Cancel increment ONGO: LD C,E ; Integer of branch value ONGOLP: DEC C ; Count branches LD A,B ; Get "GOTO" or "GOSUB" token JP Z,ONJMP ; Go to that line if right one CALL GETLN ; Get line number to DE CP ',' ; Another line number? RET NZ ; No - Drop through JP ONGOLP ; Yes - loop IF: CALL EVAL ; Evaluate expression LD A,(HL) ; Get token CP ZGOTO ; "GOTO" token? JP Z,IFGO ; Yes - Get line CALL CHKSYN ; Make sure it's "THEN" .BYTE ZTHEN ; "THEN" token DEC HL ; Cancel increment IFGO: CALL TSTNUM ; Make sure it's numeric CALL TSTSGN ; Test state of expression JP Z,REM ; False - Drop through CALL GETCHR ; Get next character JP C,GOTO ; Number - GOTO that line JP IFJMP ; Otherwise do statement MRPRNT: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT PRNTLP: RET Z ; End of list - Exit CP ZTAB ; "TAB(" token? JP Z,DOTAB ; Yes - Do TAB routine CP ZSPC ; "SPC(" token? JP Z,DOTAB ; Yes - Do SPC routine PUSH HL ; Save code string address CP ',' ; Comma? JP Z,DOCOM ; Yes - Move to next zone CP 59 ;";" ; Semi-colon? JP Z,NEXITM ; Do semi-colon routine POP BC ; Code string address to BC CALL EVAL ; Evaluate expression PUSH HL ; Save code string address LD A,(TYPE) ; Get variable type OR A ; Is it a string variable? JP NZ,PRNTST ; Yes - Output string contents CALL NUMASC ; Convert number to text CALL CRTST ; Create temporary string LD (HL),' ' ; Followed by a space LD HL,(FPREG) ; Get length of output INC (HL) ; Plus 1 for the space LD HL,(FPREG) ; < Not needed > LD A,(LWIDTH) ; Get width of line LD B,A ; To B INC B ; Width 255 (No limit)? JP Z,PRNTNB ; Yes - Output number string INC B ; Adjust it LD A,(CURPOS) ; Get cursor position ADD A,(HL) ; Add length of string DEC A ; Adjust it CP B ; Will output fit on this line? CALL NC,PRNTCRLF ; No - CRLF first PRNTNB: CALL PRS1 ; Output string at (HL) XOR A ; Skip CALL by setting 'z' flag PRNTST: CALL NZ,PRS1 ; Output string at (HL) POP HL ; Restore code string address JP MRPRNT ; See if more to PRINT STTLIN: LD A,(CURPOS) ; Make sure on new line OR A ; Already at start? RET Z ; Yes - Do nothing JP PRNTCRLF ; Start a new line ENDINP: LD (HL),0 ; Mark end of buffer LD HL,BUFFER-1 ; Point to buffer PRNTCRLF: LD A,CR ; Load a CR CALL OUTC ; Output character LD A,LF ; Load a LF CALL OUTC ; Output character DONULL: XOR A ; Set to position 0 LD (CURPOS),A ; Store it LD A,(NULLS) ; Get number of nulls NULLP: DEC A ; Count them RET Z ; Return if done PUSH AF ; Save count XOR A ; Load a null CALL OUTC ; Output it POP AF ; Restore count JP NULLP ; Keep counting DOCOM: LD A,(COMMAN) ; Get comma width LD B,A ; Save in B LD A,(CURPOS) ; Get current position CP B ; Within the limit? CALL NC,PRNTCRLF ; No - output CRLF JP NC,NEXITM ; Get next item ZONELP: SUB 14 ; Next zone of 14 characters JP NC,ZONELP ; Repeat if more zones CPL ; Number of spaces to output JP ASPCS ; Output them DOTAB: PUSH AF ; Save token CALL FNDNUM ; Evaluate expression CALL CHKSYN ; Make sure ")" follows .BYTE ")" DEC HL ; Back space on to ")" POP AF ; Restore token SUB ZSPC ; Was it "SPC(" ? PUSH HL ; Save code string address JP Z,DOSPC ; Yes - Do 'E' spaces LD A,(CURPOS) ; Get current position DOSPC: CPL ; Number of spaces to print to ADD A,E ; Total number to print JP NC,NEXITM ; TAB < Current POS(X) ASPCS: INC A ; Output A spaces LD B,A ; Save number to print LD A,' ' ; Space SPCLP: CALL OUTC ; Output character in A DEC B ; Count them JP NZ,SPCLP ; Repeat if more NEXITM: POP HL ; Restore code string address CALL GETCHR ; Get next character JP PRNTLP ; More to print REDO: .BYTE "?Redo from start",CR,LF,0 BADINP: LD A,(READFG) ; READ or INPUT? OR A JP NZ,DATSNR ; READ - ?SN Error POP BC ; Throw away code string addr LD HL,REDO ; "Redo from start" message CALL PRS ; Output string JP DOAGN ; Do last INPUT again INPUT: CALL IDTEST ; Test for illegal direct LD A,(HL) ; Get character after "INPUT" CP '"' ; Is there a prompt string? LD A,0 ; Clear A and leave flags LD (CTLOFG),A ; Enable output JP NZ,NOPMPT ; No prompt - get input CALL QTSTR ; Get string terminated by '"' CALL CHKSYN ; Check for ';' after prompt .BYTE ';' PUSH HL ; Save code string address CALL PRS1 ; Output prompt string .BYTE 3EH ; Skip "PUSH HL" NOPMPT: PUSH HL ; Save code string address CALL PROMPT ; Get input with "? " prompt POP BC ; Restore code string address JP C,INPBRK ; Break pressed - Exit INC HL ; Next byte LD A,(HL) ; Get it OR A ; End of line? DEC HL ; Back again PUSH BC ; Re-save code string address JP Z,NXTDTA ; Yes - Find next DATA stmt LD (HL),',' ; Store comma as separator JP NXTITM ; Get next item READ: PUSH HL ; Save code string address LD HL,(NXTDAT) ; Next DATA statement .BYTE 0F6H ; Flag "READ" NXTITM: XOR A ; Flag "INPUT" LD (READFG),A ; Save "READ"/"INPUT" flag EX (SP),HL ; Get code str' , Save pointer JP GTVLUS ; Get values NEDMOR: CALL CHKSYN ; Check for comma between items .BYTE ',' GTVLUS: CALL GETVAR ; Get variable name EX (SP),HL ; Save code str" , Get pointer PUSH DE ; Save variable address LD A,(HL) ; Get next "INPUT"/"DATA" byte CP ',' ; Comma? JP Z,ANTVLU ; Yes - Get another value LD A,(READFG) ; Is it READ? OR A JP NZ,FDTLP ; Yes - Find next DATA stmt LD A,'?' ; More INPUT needed CALL OUTC ; Output character CALL PROMPT ; Get INPUT with prompt POP DE ; Variable address POP BC ; Code string address JP C,INPBRK ; Break pressed INC HL ; Point to next DATA byte LD A,(HL) ; Get byte OR A ; Is it zero (No input) ? DEC HL ; Back space INPUT pointer PUSH BC ; Save code string address JP Z,NXTDTA ; Find end of buffer PUSH DE ; Save variable address ANTVLU: LD A,(TYPE) ; Check data type OR A ; Is it numeric? JP Z,INPBIN ; Yes - Convert to binary CALL GETCHR ; Get next character LD D,A ; Save input character LD B,A ; Again CP '"' ; Start of literal sting? JP Z,STRENT ; Yes - Create string entry LD A,(READFG) ; "READ" or "INPUT" ? OR A LD D,A ; Save 00 if "INPUT" JP Z,ITMSEP ; "INPUT" - End with 00 LD D,':' ; "DATA" - End with 00 or ':' ITMSEP: LD B,',' ; Item separator DEC HL ; Back space for DTSTR STRENT: CALL DTSTR ; Get string terminated by D EX DE,HL ; String address to DE LD HL,LTSTND ; Where to go after LETSTR EX (SP),HL ; Save HL , get input pointer PUSH DE ; Save address of string JP LETSTR ; Assign string to variable INPBIN: CALL GETCHR ; Get next character CALL ASCTFP ; Convert ASCII to FP number EX (SP),HL ; Save input ptr, Get var addr CALL FPTHL ; Move FPREG to variable POP HL ; Restore input pointer LTSTND: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,MORDT ; End of line - More needed? CP ',' ; Another value? JP NZ,BADINP ; No - Bad input MORDT: EX (SP),HL ; Get code string address DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,NEDMOR ; More needed - Get it POP DE ; Restore DATA pointer LD A,(READFG) ; "READ" or "INPUT" ? OR A EX DE,HL ; DATA pointer to HL JP NZ,UPDATA ; Update DATA pointer if "READ" PUSH DE ; Save code string address OR (HL) ; More input given? LD HL,EXTIG ; "?Extra ignored" message CALL NZ,PRS ; Output string if extra given POP HL ; Restore code string address RET EXTIG: .BYTE "?Extra ignored",CR,LF,0 FDTLP: CALL DATA ; Get next statement OR A ; End of line? JP NZ,FANDT ; No - See if DATA statement INC HL LD A,(HL) ; End of program? INC HL OR (HL) ; 00 00 Ends program LD E,OD ; ?OD Error JP Z,ERROR ; Yes - Out of DATA INC HL LD E,(HL) ; LSB of line number INC HL LD D,(HL) ; MSB of line number EX DE,HL LD (DATLIN),HL ; Set line of current DATA item EX DE,HL FANDT: CALL GETCHR ; Get next character CP ZDATA ; "DATA" token JP NZ,FDTLP ; No "DATA" - Keep looking JP ANTVLU ; Found - Convert input NEXT: LD DE,0 ; In case no index given NEXT1: CALL NZ,GETVAR ; Get index address LD (BRKLIN),HL ; Save code string address CALL BAKSTK ; Look for "FOR" block JP NZ,NFERR ; No "FOR" - ?NF Error LD SP,HL ; Clear nested loops PUSH DE ; Save index address LD A,(HL) ; Get sign of STEP INC HL PUSH AF ; Save sign of STEP PUSH DE ; Save index address CALL PHLTFP ; Move index value to FPREG EX (SP),HL ; Save address of TO value PUSH HL ; Save address of index CALL ADDPHL ; Add STEP to index value POP HL ; Restore address of index CALL FPTHL ; Move value to index variable POP HL ; Restore address of TO value CALL LOADFP ; Move TO value to BCDE PUSH HL ; Save address of line of FOR CALL CMPNUM ; Compare index with TO value POP HL ; Restore address of line num POP BC ; Address of sign of STEP SUB B ; Compare with expected sign CALL LOADFP ; BC = Loop stmt,DE = Line num JP Z,KILFOR ; Loop finished - Terminate it EX DE,HL ; Loop statement line number LD (LINEAT),HL ; Set loop line number LD L,C ; Set code string to loop LD H,B JP PUTFID ; Put back "FOR" and continue KILFOR: LD SP,HL ; Remove "FOR" block LD HL,(BRKLIN) ; Code string after "NEXT" LD A,(HL) ; Get next byte in code string CP ',' ; More NEXTs ? JP NZ,RUNCNT ; No - Do next statement CALL GETCHR ; Position to index name CALL NEXT1 ; Re-enter NEXT routine ; < will not RETurn to here , Exit to RUNCNT or Loop > GETNUM: CALL EVAL ; Get a numeric expression TSTNUM: .BYTE 0F6H ; Clear carry (numeric) TSTSTR: SCF ; Set carry (string) CHKTYP: LD A,(TYPE) ; Check types match ADC A,A ; Expected + actual OR A ; Clear carry , set parity RET PE ; Even parity - Types match JP TMERR ; Different types - Error OPNPAR: CALL CHKSYN ; Make sure "(" follows .BYTE "(" EVAL: DEC HL ; Evaluate expression & save LD D,0 ; Precedence value EVAL1: PUSH DE ; Save precedence LD C,1 CALL CHKSTK ; Check for 1 level of stack CALL OPRND ; Get next expression value EVAL2: LD (NXTOPR),HL ; Save address of next operator EVAL3: LD HL,(NXTOPR) ; Restore address of next opr POP BC ; Precedence value and operator LD A,B ; Get precedence value CP 78H ; "AND" or "OR" ? CALL NC,TSTNUM ; No - Make sure it's a number LD A,(HL) ; Get next operator / function LD D,0 ; Clear Last relation RLTLP: SUB ZGTR ; ">" Token JP C,FOPRND ; + - * / ^ AND OR - Test it CP ZLTH+1-ZGTR ; < = > JP NC,FOPRND ; Function - Call it CP ZEQUAL-ZGTR ; "=" RLA ; <- Test for legal XOR D ; <- combinations of < = > CP D ; <- by combining last token LD D,A ; <- with current one JP C,SNERR ; Error if "<<' '==" or ">>" LD (CUROPR),HL ; Save address of current token CALL GETCHR ; Get next character JP RLTLP ; Treat the two as one FOPRND: LD A,D ; < = > found ? OR A JP NZ,TSTRED ; Yes - Test for reduction LD A,(HL) ; Get operator token LD (CUROPR),HL ; Save operator address SUB ZPLUS ; Operator or function? RET C ; Neither - Exit CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? RET NC ; No - Exit LD E,A ; Coded operator LD A,(TYPE) ; Get data type DEC A ; FF = numeric , 00 = string OR E ; Combine with coded operator LD A,E ; Get coded operator JP Z,CONCAT ; String concatenation RLCA ; Times 2 ADD A,E ; Times 3 LD E,A ; To DE (D is 0) LD HL,PRITAB ; Precedence table ADD HL,DE ; To the operator concerned LD A,B ; Last operator precedence LD D,(HL) ; Get evaluation precedence CP D ; Compare with eval precedence RET NC ; Exit if higher precedence INC HL ; Point to routine address CALL TSTNUM ; Make sure it's a number STKTHS: PUSH BC ; Save last precedence & token LD BC,EVAL3 ; Where to go on prec' break PUSH BC ; Save on stack for return LD B,E ; Save operator LD C,D ; Save precedence CALL STAKFP ; Move value to stack LD E,B ; Restore operator LD D,C ; Restore precedence LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address INC HL PUSH BC ; Save routine address LD HL,(CUROPR) ; Address of current operator JP EVAL1 ; Loop until prec' break OPRND: XOR A ; Get operand routine LD (TYPE),A ; Set numeric expected CALL GETCHR ; Get next character LD E,MO ; ?MO Error JP Z,ERROR ; No operand - Error JP C,ASCTFP ; Number - Get value CALL CHKLTR ; See if a letter JP NC,CONVAR ; Letter - Find variable CP '&' ; &H = HEX, &B = BINARY JR NZ, NOTAMP CALL GETCHR ; Get next character CP 'H' ; Hex number indicated? [function added] JP Z,HEXTFP ; Convert Hex to FPREG CP 'B' ; Binary number indicated? [function added] JP Z,BINTFP ; Convert Bin to FPREG LD E,SN ; If neither then a ?SN Error JP Z,ERROR ; NOTAMP: CP ZPLUS ; '+' Token ? JP Z,OPRND ; Yes - Look for operand CP '.' ; '.' ? JP Z,ASCTFP ; Yes - Create FP number CP ZMINUS ; '-' Token ? JP Z,MINUS ; Yes - Do minus CP '"' ; Literal string ? JP Z,QTSTR ; Get string terminated by '"' CP ZNOT ; "NOT" Token ? JP Z,EVNOT ; Yes - Eval NOT expression CP ZFN ; "FN" Token ? JP Z,DOFN ; Yes - Do FN routine SUB ZSGN ; Is it a function? JP NC,FNOFST ; Yes - Evaluate function EVLPAR: CALL OPNPAR ; Evaluate expression in "()" CALL CHKSYN ; Make sure ")" follows .BYTE ")" RET MINUS: LD D,7DH ; '-' precedence CALL EVAL1 ; Evaluate until prec' break LD HL,(NXTOPR) ; Get next operator address PUSH HL ; Save next operator address CALL INVSGN ; Negate value RETNUM: CALL TSTNUM ; Make sure it's a number POP HL ; Restore next operator address RET CONVAR: CALL GETVAR ; Get variable address to DE FRMEVL: PUSH HL ; Save code string address EX DE,HL ; Variable address to HL LD (FPREG),HL ; Save address of variable LD A,(TYPE) ; Get type OR A ; Numeric? CALL Z,PHLTFP ; Yes - Move contents to FPREG POP HL ; Restore code string address RET FNOFST: LD B,0 ; Get address of function RLCA ; Double function offset LD C,A ; BC = Offset in function table PUSH BC ; Save adjusted token value CALL GETCHR ; Get next character LD A,C ; Get adjusted token value CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? JP C,FNVAL ; No - Do function CALL OPNPAR ; Evaluate expression (X,... CALL CHKSYN ; Make sure ',' follows .BYTE ',' CALL TSTSTR ; Make sure it's a string EX DE,HL ; Save code string address LD HL,(FPREG) ; Get address of string EX (SP),HL ; Save address of string PUSH HL ; Save adjusted token value EX DE,HL ; Restore code string address CALL GETINT ; Get integer 0-255 EX DE,HL ; Save code string address EX (SP),HL ; Save integer,HL = adj' token JP GOFUNC ; Jump to string function FNVAL: CALL EVLPAR ; Evaluate expression EX (SP),HL ; HL = Adjusted token value LD DE,RETNUM ; Return number from function PUSH DE ; Save on stack GOFUNC: LD BC,FNCTAB ; Function routine addresses ADD HL,BC ; Point to right address LD C,(HL) ; Get LSB of address INC HL ; LD H,(HL) ; Get MSB of address LD L,C ; Address to HL JP (HL) ; Jump to function SGNEXP: DEC D ; Dee to flag negative exponent CP ZMINUS ; '-' token ? RET Z ; Yes - Return CP '-' ; '-' ASCII ? RET Z ; Yes - Return INC D ; Inc to flag positive exponent CP '+' ; '+' ASCII ? RET Z ; Yes - Return CP ZPLUS ; '+' token ? RET Z ; Yes - Return DEC HL ; DEC 'cos GETCHR INCs RET ; Return "NZ" POR: .BYTE 0F6H ; Flag "OR" PAND: XOR A ; Flag "AND" PUSH AF ; Save "AND" / "OR" flag CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag EX DE,HL ; <- Get last POP BC ; <- value EX (SP),HL ; <- from EX DE,HL ; <- stack CALL FPBCDE ; Move last value to FPREG PUSH AF ; Save "AND" / "OR" flag CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag POP BC ; Get value LD A,C ; Get LSB LD HL,ACPASS ; Address of save AC as current JP NZ,POR1 ; Jump if OR AND E ; "AND" LSBs LD C,A ; Save LSB LD A,B ; Get MBS AND D ; "AND" MSBs JP (HL) ; Save AC as current (ACPASS) POR1: OR E ; "OR" LSBs LD C,A ; Save LSB LD A,B ; Get MSB OR D ; "OR" MSBs JP (HL) ; Save AC as current (ACPASS) TSTRED: LD HL,CMPLOG ; Logical compare routine LD A,(TYPE) ; Get data type RRA ; Carry set = string LD A,D ; Get last precedence value RLA ; Times 2 plus carry LD E,A ; To E LD D,64H ; Relational precedence LD A,B ; Get current precedence CP D ; Compare with last RET NC ; Eval if last was rel' or log' JP STKTHS ; Stack this one and get next CMPLOG: .WORD CMPLG1 ; Compare two values / strings CMPLG1: LD A,C ; Get data type OR A RRA POP BC ; Get last expression to BCDE POP DE PUSH AF ; Save status CALL CHKTYP ; Check that types match LD HL,CMPRES ; Result to comparison PUSH HL ; Save for RETurn JP Z,CMPNUM ; Compare values if numeric XOR A ; Compare two strings LD (TYPE),A ; Set type to numeric PUSH DE ; Save string name CALL GSTRCU ; Get current string LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address POP DE ; Restore string name PUSH BC ; Save address of string PUSH AF ; Save length of string CALL GSTRDE ; Get second string CALL LOADFP ; Get address of second string POP AF ; Restore length of string 1 LD D,A ; Length to D POP HL ; Restore address of string 1 CMPSTR: LD A,E ; Bytes of string 2 to do OR D ; Bytes of string 1 to do RET Z ; Exit if all bytes compared LD A,D ; Get bytes of string 1 to do SUB 1 RET C ; Exit if end of string 1 XOR A CP E ; Bytes of string 2 to do INC A RET NC ; Exit if end of string 2 DEC D ; Count bytes in string 1 DEC E ; Count bytes in string 2 LD A,(BC) ; Byte in string 2 CP (HL) ; Compare to byte in string 1 INC HL ; Move up string 1 INC BC ; Move up string 2 JP Z,CMPSTR ; Same - Try next bytes CCF ; Flag difference (">" or "<") JP FLGDIF ; "<" gives -1 , ">" gives +1 CMPRES: INC A ; Increment current value ADC A,A ; Double plus carry POP BC ; Get other value AND B ; Combine them ADD A,-1 ; Carry set if different SBC A,A ; 00 - Equal , FF - Different JP FLGREL ; Set current value & continue EVNOT: LD D,5AH ; Precedence value for "NOT" CALL EVAL1 ; Eval until precedence break CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 - 32767 LD A,E ; Get LSB CPL ; Invert LSB LD C,A ; Save "NOT" of LSB LD A,D ; Get MSB CPL ; Invert MSB CALL ACPASS ; Save AC as current POP BC ; Clean up stack JP EVAL3 ; Continue evaluation DIMRET: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character RET Z ; End of DIM statement CALL CHKSYN ; Make sure ',' follows .BYTE ',' DIM: LD BC,DIMRET ; Return to "DIMRET" PUSH BC ; Save on stack .BYTE 0F6H ; Flag "Create" variable GETVAR: XOR A ; Find variable address,to DE LD (LCRFLG),A ; Set locate / create flag LD B,(HL) ; Get First byte of name GTFNAM: CALL CHKLTR ; See if a letter JP C,SNERR ; ?SN Error if not a letter XOR A LD C,A ; Clear second byte of name LD (TYPE),A ; Set type to numeric CALL GETCHR ; Get next character JP C,SVNAM2 ; Numeric - Save in name CALL CHKLTR ; See if a letter JP C,CHARTY ; Not a letter - Check type SVNAM2: LD C,A ; Save second byte of name ENDNAM: CALL GETCHR ; Get next character JP C,ENDNAM ; Numeric - Get another CALL CHKLTR ; See if a letter JP NC,ENDNAM ; Letter - Get another CHARTY: SUB '$' ; String variable? JP NZ,NOTSTR ; No - Numeric variable INC A ; A = 1 (string type) LD (TYPE),A ; Set type to string RRCA ; A = 80H , Flag for string ADD A,C ; 2nd byte of name has bit 7 on LD C,A ; Resave second byte on name CALL GETCHR ; Get next character NOTSTR: LD A,(FORFLG) ; Array name needed ? DEC A JP Z,ARLDSV ; Yes - Get array name JP P,NSCFOR ; No array with "FOR" or "FN" LD A,(HL) ; Get byte again SUB '(' ; Subscripted variable? JP Z,SBSCPT ; Yes - Sort out subscript NSCFOR: XOR A ; Simple variable LD (FORFLG),A ; Clear "FOR" flag PUSH HL ; Save code string address LD D,B ; DE = Variable name to find LD E,C LD HL,(FNRGNM) ; FN argument name CALL CPDEHL ; Is it the FN argument? LD DE,FNARG ; Point to argument value JP Z,POPHRT ; Yes - Return FN argument value LD HL,(VAREND) ; End of variables EX DE,HL ; Address of end of search LD HL,(PROGND) ; Start of variables address FNDVAR: CALL CPDEHL ; End of variable list table? JP Z,CFEVAL ; Yes - Called from EVAL? LD A,C ; Get second byte of name SUB (HL) ; Compare with name in list INC HL ; Move on to first byte JP NZ,FNTHR ; Different - Find another LD A,B ; Get first byte of name SUB (HL) ; Compare with name in list FNTHR: INC HL ; Move on to LSB of value JP Z,RETADR ; Found - Return address INC HL ; <- Skip INC HL ; <- over INC HL ; <- F.P. INC HL ; <- value JP FNDVAR ; Keep looking CFEVAL: POP HL ; Restore code string address EX (SP),HL ; Get return address PUSH DE ; Save address of variable LD DE,FRMEVL ; Return address in EVAL CALL CPDEHL ; Called from EVAL ? POP DE ; Restore address of variable JP Z,RETNUL ; Yes - Return null variable EX (SP),HL ; Put back return PUSH HL ; Save code string address PUSH BC ; Save variable name LD BC,6 ; 2 byte name plus 4 byte data LD HL,(ARREND) ; End of arrays PUSH HL ; Save end of arrays ADD HL,BC ; Move up 6 bytes POP BC ; Source address in BC PUSH HL ; Save new end address CALL MOVUP ; Move arrays up POP HL ; Restore new end address LD (ARREND),HL ; Set new end address LD H,B ; End of variables to HL LD L,C LD (VAREND),HL ; Set new end address ZEROLP: DEC HL ; Back through to zero variable LD (HL),0 ; Zero byte in variable CALL CPDEHL ; Done them all? JP NZ,ZEROLP ; No - Keep on going POP DE ; Get variable name LD (HL),E ; Store second character INC HL LD (HL),D ; Store first character INC HL RETADR: EX DE,HL ; Address of variable in DE POP HL ; Restore code string address RET RETNUL: LD (FPEXP),A ; Set result to zero LD HL,ZERBYT ; Also set a null string LD (FPREG),HL ; Save for EVAL POP HL ; Restore code string address RET SBSCPT: PUSH HL ; Save code string address LD HL,(LCRFLG) ; Locate/Create and Type EX (SP),HL ; Save and get code string LD D,A ; Zero number of dimensions SCPTLP: PUSH DE ; Save number of dimensions PUSH BC ; Save array name CALL FPSINT ; Get subscript (0-32767) POP BC ; Restore array name POP AF ; Get number of dimensions EX DE,HL EX (SP),HL ; Save subscript value PUSH HL ; Save LCRFLG and TYPE EX DE,HL INC A ; Count dimensions LD D,A ; Save in D LD A,(HL) ; Get next byte in code string CP ',' ; Comma (more to come)? JP Z,SCPTLP ; Yes - More subscripts CALL CHKSYN ; Make sure ")" follows .BYTE ")" LD (NXTOPR),HL ; Save code string address POP HL ; Get LCRFLG and TYPE LD (LCRFLG),HL ; Restore Locate/create & type LD E,0 ; Flag not CSAVE* or CLOAD* PUSH DE ; Save number of dimensions (D) .BYTE 11H ; Skip "PUSH HL" and "PUSH AF' ARLDSV: PUSH HL ; Save code string address PUSH AF ; A = 00 , Flags set = Z,N LD HL,(VAREND) ; Start of arrays .BYTE 3EH ; Skip "ADD HL,DE" FNDARY: ADD HL,DE ; Move to next array start EX DE,HL LD HL,(ARREND) ; End of arrays EX DE,HL ; Current array pointer CALL CPDEHL ; End of arrays found? JP Z,CREARY ; Yes - Create array LD A,(HL) ; Get second byte of name CP C ; Compare with name given INC HL ; Move on JP NZ,NXTARY ; Different - Find next array LD A,(HL) ; Get first byte of name CP B ; Compare with name given NXTARY: INC HL ; Move on LD E,(HL) ; Get LSB of next array address INC HL LD D,(HL) ; Get MSB of next array address INC HL JP NZ,FNDARY ; Not found - Keep looking LD A,(LCRFLG) ; Found Locate or Create it? OR A JP NZ,DDERR ; Create - ?DD Error POP AF ; Locate - Get number of dim'ns LD B,H ; BC Points to array dim'ns LD C,L JP Z,POPHRT ; Jump if array load/save SUB (HL) ; Same number of dimensions? JP Z,FINDEL ; Yes - Find element BSERR: LD E,BS ; ?BS Error JP ERROR ; Output error CREARY: LD DE,4 ; 4 Bytes per entry POP AF ; Array to save or 0 dim'ns? JP Z,FCERR ; Yes - ?FC Error LD (HL),C ; Save second byte of name INC HL LD (HL),B ; Save first byte of name INC HL LD C,A ; Number of dimensions to C CALL CHKSTK ; Check if enough memory INC HL ; Point to number of dimensions INC HL LD (CUROPR),HL ; Save address of pointer LD (HL),C ; Set number of dimensions INC HL LD A,(LCRFLG) ; Locate of Create? RLA ; Carry set = Create LD A,C ; Get number of dimensions CRARLP: LD BC,10+1 ; Default dimension size 10 JP NC,DEFSIZ ; Locate - Set default size POP BC ; Get specified dimension size INC BC ; Include zero element DEFSIZ: LD (HL),C ; Save LSB of dimension size INC HL LD (HL),B ; Save MSB of dimension size INC HL PUSH AF ; Save num' of dim'ns an status PUSH HL ; Save address of dim'n size CALL MLDEBC ; Multiply DE by BC to find EX DE,HL ; amount of mem needed (to DE) POP HL ; Restore address of dimension POP AF ; Restore number of dimensions DEC A ; Count them JP NZ,CRARLP ; Do next dimension if more PUSH AF ; Save locate/create flag LD B,D ; MSB of memory needed LD C,E ; LSB of memory needed EX DE,HL ADD HL,DE ; Add bytes to array start JP C,OMERR ; Too big - Error CALL ENFMEM ; See if enough memory LD (ARREND),HL ; Save new end of array ZERARY: DEC HL ; Back through array data LD (HL),0 ; Set array element to zero CALL CPDEHL ; All elements zeroed? JP NZ,ZERARY ; No - Keep on going INC BC ; Number of bytes + 1 LD D,A ; A=0 LD HL,(CUROPR) ; Get address of array LD E,(HL) ; Number of dimensions EX DE,HL ; To HL ADD HL,HL ; Two bytes per dimension size ADD HL,BC ; Add number of bytes EX DE,HL ; Bytes needed to DE DEC HL DEC HL LD (HL),E ; Save LSB of bytes needed INC HL LD (HL),D ; Save MSB of bytes needed INC HL POP AF ; Locate / Create? JP C,ENDDIM ; A is 0 , End if create FINDEL: LD B,A ; Find array element LD C,A LD A,(HL) ; Number of dimensions INC HL .BYTE 16H ; Skip "POP HL" FNDELP: POP HL ; Address of next dim' size LD E,(HL) ; Get LSB of dim'n size INC HL LD D,(HL) ; Get MSB of dim'n size INC HL EX (SP),HL ; Save address - Get index PUSH AF ; Save number of dim'ns CALL CPDEHL ; Dimension too large? JP NC,BSERR ; Yes - ?BS Error PUSH HL ; Save index CALL MLDEBC ; Multiply previous by size POP DE ; Index supplied to DE ADD HL,DE ; Add index to pointer POP AF ; Number of dimensions DEC A ; Count them LD B,H ; MSB of pointer LD C,L ; LSB of pointer JP NZ,FNDELP ; More - Keep going ADD HL,HL ; 4 Bytes per element ADD HL,HL POP BC ; Start of array ADD HL,BC ; Point to element EX DE,HL ; Address of element to DE ENDDIM: LD HL,(NXTOPR) ; Got code string address RET FRE: LD HL,(ARREND) ; Start of free memory EX DE,HL ; To DE LD HL,0 ; End of free memory ADD HL,SP ; Current stack value LD A,(TYPE) ; Dummy argument type OR A JP Z,FRENUM ; Numeric - Free variable space CALL GSTRCU ; Current string to pool CALL GARBGE ; Garbage collection LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string space FRENUM: LD A,L ; Get LSB of end SUB E ; Subtract LSB of beginning LD C,A ; Save difference if C LD A,H ; Get MSB of end SBC A,D ; Subtract MSB of beginning ACPASS: LD B,C ; Return integer AC ABPASS: LD D,B ; Return integer AB LD E,0 LD HL,TYPE ; Point to type LD (HL),E ; Set type to numeric LD B,80H+16 ; 16 bit integer JP RETINT ; Return the integr POS: LD A,(CURPOS) ; Get cursor position PASSA: LD B,A ; Put A into AB XOR A ; Zero A JP ABPASS ; Return integer AB DEF: CALL CHEKFN ; Get "FN" and name CALL IDTEST ; Test for illegal direct LD BC,DATA ; To get next statement PUSH BC ; Save address for RETurn PUSH DE ; Save address of function ptr CALL CHKSYN ; Make sure "(" follows .BYTE "(" CALL GETVAR ; Get argument variable name PUSH HL ; Save code string address EX DE,HL ; Argument address to HL DEC HL LD D,(HL) ; Get first byte of arg name DEC HL LD E,(HL) ; Get second byte of arg name POP HL ; Restore code string address CALL TSTNUM ; Make sure numeric argument CALL CHKSYN ; Make sure ")" follows .BYTE ")" CALL CHKSYN ; Make sure "=" follows .BYTE ZEQUAL ; "=" token LD B,H ; Code string address to BC LD C,L EX (SP),HL ; Save code str , Get FN ptr LD (HL),C ; Save LSB of FN code string INC HL LD (HL),B ; Save MSB of FN code string JP SVSTAD ; Save address and do function DOFN: CALL CHEKFN ; Make sure FN follows PUSH DE ; Save function pointer address CALL EVLPAR ; Evaluate expression in "()" CALL TSTNUM ; Make sure numeric result EX (SP),HL ; Save code str , Get FN ptr LD E,(HL) ; Get LSB of FN code string INC HL LD D,(HL) ; Get MSB of FN code string INC HL LD A,D ; And function DEFined? OR E JP Z,UFERR ; No - ?UF Error LD A,(HL) ; Get LSB of argument address INC HL LD H,(HL) ; Get MSB of argument address LD L,A ; HL = Arg variable address PUSH HL ; Save it LD HL,(FNRGNM) ; Get old argument name EX (SP),HL ; ; Save old , Get new LD (FNRGNM),HL ; Set new argument name LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value PUSH HL ; Save it LD HL,(FNARG) ; Get MSB,EXP of old arg value PUSH HL ; Save it LD HL,FNARG ; HL = Value of argument PUSH DE ; Save FN code string address CALL FPTHL ; Move FPREG to argument POP HL ; Get FN code string address CALL GETNUM ; Get value from function DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,SNERR ; Bad character in FN - Error POP HL ; Get MSB,EXP of old arg LD (FNARG),HL ; Restore it POP HL ; Get LSB,NLSB of old arg LD (FNARG+2),HL ; Restore it POP HL ; Get name of old arg LD (FNRGNM),HL ; Restore it POP HL ; Restore code string address RET IDTEST: PUSH HL ; Save code string address LD HL,(LINEAT) ; Get current line number INC HL ; -1 means direct statement LD A,H OR L POP HL ; Restore code string address RET NZ ; Return if in program LD E,ID ; ?ID Error JP ERROR CHEKFN: CALL CHKSYN ; Make sure FN follows .BYTE ZFN ; "FN" token LD A,80H LD (FORFLG),A ; Flag FN name to find OR (HL) ; FN name has bit 7 set LD B,A ; in first byte of name CALL GTFNAM ; Get FN name JP TSTNUM ; Make sure numeric function STR: CALL TSTNUM ; Make sure it's a number CALL NUMASC ; Turn number into text STR1: CALL CRTST ; Create string entry for it CALL GSTRCU ; Current string to pool LD BC,TOPOOL ; Save in string pool PUSH BC ; Save address on stack SAVSTR: LD A,(HL) ; Get string length INC HL INC HL PUSH HL ; Save pointer to string CALL TESTR ; See if enough string space POP HL ; Restore pointer to string LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address CALL CRTMST ; Create string entry PUSH HL ; Save pointer to MSB of addr LD L,A ; Length of string CALL TOSTRA ; Move to string area POP DE ; Restore pointer to MSB RET MKTMST: CALL TESTR ; See if enough string space CRTMST: LD HL,TMPSTR ; Temporary string PUSH HL ; Save it LD (HL),A ; Save length of string INC HL SVSTAD: INC HL LD (HL),E ; Save LSB of address INC HL LD (HL),D ; Save MSB of address POP HL ; Restore pointer RET CRTST: DEC HL ; DEC - INCed after QTSTR: LD B,'"' ; Terminating quote LD D,B ; Quote to D DTSTR: PUSH HL ; Save start LD C,-1 ; Set counter to -1 QTSTLP: INC HL ; Move on LD A,(HL) ; Get byte INC C ; Count bytes OR A ; End of line? JP Z,CRTSTE ; Yes - Create string entry CP D ; Terminator D found? JP Z,CRTSTE ; Yes - Create string entry CP B ; Terminator B found? JP NZ,QTSTLP ; No - Keep looking CRTSTE: CP '"' ; End with '"'? CALL Z,GETCHR ; Yes - Get next character EX (SP),HL ; Starting quote INC HL ; First byte of string EX DE,HL ; To DE LD A,C ; Get length CALL CRTMST ; Create string entry TSTOPL: LD DE,TMPSTR ; Temporary string LD HL,(TMSTPT) ; Temporary string pool pointer LD (FPREG),HL ; Save address of string ptr LD A,1 LD (TYPE),A ; Set type to string CALL DETHL4 ; Move string to pool CALL CPDEHL ; Out of string pool? LD (TMSTPT),HL ; Save new pointer POP HL ; Restore code string address LD A,(HL) ; Get next code byte RET NZ ; Return if pool OK LD E,ST ; ?ST Error JP ERROR ; String pool overflow PRNUMS: INC HL ; Skip leading space PRS: CALL CRTST ; Create string entry for it PRS1: CALL GSTRCU ; Current string to pool CALL LOADFP ; Move string block to BCDE INC E ; Length + 1 PRSLP: DEC E ; Count characters RET Z ; End of string LD A,(BC) ; Get byte to output CALL OUTC ; Output character in A CP CR ; Return? CALL Z,DONULL ; Yes - Do nulls INC BC ; Next byte in string JP PRSLP ; More characters to output TESTR: OR A ; Test if enough room .BYTE 0EH ; No garbage collection done GRBDON: POP AF ; Garbage collection done PUSH AF ; Save status LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string area CPL ; Negate length (Top down) LD C,A ; -Length to BC LD B,-1 ; BC = -ve length of string ADD HL,BC ; Add to bottom of space in use INC HL ; Plus one for 2's complement CALL CPDEHL ; Below string RAM area? JP C,TESTOS ; Tidy up if not done else err LD (STRBOT),HL ; Save new bottom of area INC HL ; Point to first byte of string EX DE,HL ; Address to DE POPAF: POP AF ; Throw away status push RET TESTOS: POP AF ; Garbage collect been done? LD E,OS ; ?OS Error JP Z,ERROR ; Yes - Not enough string apace CP A ; Flag garbage collect done PUSH AF ; Save status LD BC,GRBDON ; Garbage collection done PUSH BC ; Save for RETurn GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer GARBLP: LD (STRBOT),HL ; Reset string pointer LD HL,0 PUSH HL ; Flag no string found LD HL,(STRSPC) ; Get bottom of string space PUSH HL ; Save bottom of string space LD HL,TMSTPL ; Temporary string pool GRBLP: EX DE,HL LD HL,(TMSTPT) ; Temporary string pool pointer EX DE,HL CALL CPDEHL ; Temporary string pool done? LD BC,GRBLP ; Loop until string pool done JP NZ,STPOOL ; No - See if in string area LD HL,(PROGND) ; Start of simple variables SMPVAR: EX DE,HL LD HL,(VAREND) ; End of simple variables EX DE,HL CALL CPDEHL ; All simple strings done? JP Z,ARRLP ; Yes - Do string arrays LD A,(HL) ; Get type of variable INC HL INC HL OR A ; "S" flag set if string CALL STRADD ; See if string in string area JP SMPVAR ; Loop until simple ones done GNXARY: POP BC ; Scrap address of this array ARRLP: EX DE,HL LD HL,(ARREND) ; End of string arrays EX DE,HL CALL CPDEHL ; All string arrays done? JP Z,SCNEND ; Yes - Move string if found CALL LOADFP ; Get array name to BCDE LD A,E ; Get type of array PUSH HL ; Save address of num of dim'ns ADD HL,BC ; Start of next array OR A ; Test type of array JP P,GNXARY ; Numeric array - Ignore it LD (CUROPR),HL ; Save address of next array POP HL ; Get address of num of dim'ns LD C,(HL) ; BC = Number of dimensions LD B,0 ADD HL,BC ; Two bytes per dimension size ADD HL,BC INC HL ; Plus one for number of dim'ns GRBARY: EX DE,HL LD HL,(CUROPR) ; Get address of next array EX DE,HL CALL CPDEHL ; Is this array finished? JP Z,ARRLP ; Yes - Get next one LD BC,GRBARY ; Loop until array all done STPOOL: PUSH BC ; Save return address OR 80H ; Flag string type STRADD: LD A,(HL) ; Get string length INC HL INC HL LD E,(HL) ; Get LSB of string address INC HL LD D,(HL) ; Get MSB of string address INC HL RET P ; Not a string - Return OR A ; Set flags on string length RET Z ; Null string - Return LD B,H ; Save variable pointer LD C,L LD HL,(STRBOT) ; Bottom of new area CALL CPDEHL ; String been done? LD H,B ; Restore variable pointer LD L,C RET C ; String done - Ignore POP HL ; Return address EX (SP),HL ; Lowest available string area CALL CPDEHL ; String within string area? EX (SP),HL ; Lowest available string area PUSH HL ; Re-save return address LD H,B ; Restore variable pointer LD L,C RET NC ; Outside string area - Ignore POP BC ; Get return , Throw 2 away POP AF ; POP AF ; PUSH HL ; Save variable pointer PUSH DE ; Save address of current PUSH BC ; Put back return address RET ; Go to it SCNEND: POP DE ; Addresses of strings POP HL ; LD A,L ; HL = 0 if no more to do OR H RET Z ; No more to do - Return DEC HL LD B,(HL) ; MSB of address of string DEC HL LD C,(HL) ; LSB of address of string PUSH HL ; Save variable address DEC HL DEC HL LD L,(HL) ; HL = Length of string LD H,0 ADD HL,BC ; Address of end of string+1 LD D,B ; String address to DE LD E,C DEC HL ; Last byte in string LD B,H ; Address to BC LD C,L LD HL,(STRBOT) ; Current bottom of string area CALL MOVSTR ; Move string to new address POP HL ; Restore variable address LD (HL),C ; Save new LSB of address INC HL LD (HL),B ; Save new MSB of address LD L,C ; Next string area+1 to HL LD H,B DEC HL ; Next string area address JP GARBLP ; Look for more strings CONCAT: PUSH BC ; Save prec' opr & code string PUSH HL ; LD HL,(FPREG) ; Get first string EX (SP),HL ; Save first string CALL OPRND ; Get second string EX (SP),HL ; Restore first string CALL TSTSTR ; Make sure it's a string LD A,(HL) ; Get length of second string PUSH HL ; Save first string LD HL,(FPREG) ; Get second string PUSH HL ; Save second string ADD A,(HL) ; Add length of second string LD E,LS ; ?LS Error JP C,ERROR ; String too long - Error CALL MKTMST ; Make temporary string POP DE ; Get second string to DE CALL GSTRDE ; Move to string pool if needed EX (SP),HL ; Get first string CALL GSTRHL ; Move to string pool if needed PUSH HL ; Save first string LD HL,(TMPSTR+2) ; Temporary string address EX DE,HL ; To DE CALL SSTSA ; First string to string area CALL SSTSA ; Second string to string area LD HL,EVAL2 ; Return to evaluation loop EX (SP),HL ; Save return,get code string PUSH HL ; Save code string address JP TSTOPL ; To temporary string to pool SSTSA: POP HL ; Return address EX (SP),HL ; Get string block,save return LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of string address INC HL LD B,(HL) ; Get MSB of string address LD L,A ; Length to L TOSTRA: INC L ; INC - DECed after TSALP: DEC L ; Count bytes moved RET Z ; End of string - Return LD A,(BC) ; Get source LD (DE),A ; Save destination INC BC ; Next source INC DE ; Next destination JP TSALP ; Loop until string moved GETSTR: CALL TSTSTR ; Make sure it's a string GSTRCU: LD HL,(FPREG) ; Get current string GSTRHL: EX DE,HL ; Save DE GSTRDE: CALL BAKTMP ; Was it last tmp-str? EX DE,HL ; Restore DE RET NZ ; No - Return PUSH DE ; Save string LD D,B ; String block address to DE LD E,C DEC DE ; Point to length LD C,(HL) ; Get string length LD HL,(STRBOT) ; Current bottom of string area CALL CPDEHL ; Last one in string area? JP NZ,POPHL ; No - Return LD B,A ; Clear B (A=0) ADD HL,BC ; Remove string from str' area LD (STRBOT),HL ; Save new bottom of str' area POPHL: POP HL ; Restore string RET BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top DEC HL ; Back LD B,(HL) ; Get MSB of address DEC HL ; Back LD C,(HL) ; Get LSB of address DEC HL ; Back DEC HL ; Back CALL CPDEHL ; String last in string pool? RET NZ ; Yes - Leave it LD (TMSTPT),HL ; Save new string pool top RET LEN: LD BC,PASSA ; To return integer A PUSH BC ; Save address GETLEN: CALL GETSTR ; Get string and its length XOR A LD D,A ; Clear D LD (TYPE),A ; Set type to numeric LD A,(HL) ; Get length of string OR A ; Set status flags RET ASC: LD BC,PASSA ; To return integer A PUSH BC ; Save address GTFLNM: CALL GETLEN ; Get length of string JP Z,FCERR ; Null string - Error INC HL INC HL LD E,(HL) ; Get LSB of address INC HL LD D,(HL) ; Get MSB of address LD A,(DE) ; Get first byte of string RET CHR: LD A,1 ; One character string CALL MKTMST ; Make a temporary string CALL MAKINT ; Make it integer A LD HL,(TMPSTR+2) ; Get address of string LD (HL),E ; Save character TOPOOL: POP BC ; Clean up stack JP TSTOPL ; Temporary string to pool LEFT: CALL LFRGNM ; Get number and ending ")" XOR A ; Start at first byte in string RIGHT1: EX (SP),HL ; Save code string,Get string LD C,A ; Starting position in string MID1: PUSH HL ; Save string block address LD A,(HL) ; Get length of string CP B ; Compare with number given JP C,ALLFOL ; All following bytes required LD A,B ; Get new length .BYTE 11H ; Skip "LD C,0" ALLFOL: LD C,0 ; First byte of string PUSH BC ; Save position in string CALL TESTR ; See if enough string space POP BC ; Get position in string POP HL ; Restore string block address PUSH HL ; And re-save it INC HL INC HL LD B,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,B ; HL = address of string LD B,0 ; BC = starting address ADD HL,BC ; Point to that byte LD B,H ; BC = source string LD C,L CALL CRTMST ; Create a string entry LD L,A ; Length of new string CALL TOSTRA ; Move string to string area POP DE ; Clear stack CALL GSTRDE ; Move to string pool if needed JP TSTOPL ; Temporary string to pool RIGHT: CALL LFRGNM ; Get number and ending ")" POP DE ; Get string length PUSH DE ; And re-save LD A,(DE) ; Get length SUB B ; Move back N bytes JP RIGHT1 ; Go and get sub-string MID: EX DE,HL ; Get code string address LD A,(HL) ; Get next byte ',' or ")" CALL MIDNUM ; Get number supplied INC B ; Is it character zero? DEC B JP Z,FCERR ; Yes - Error PUSH BC ; Save starting position LD E,255 ; All of string CP ')' ; Any length given? JP Z,RSTSTR ; No - Rest of string CALL CHKSYN ; Make sure ',' follows .BYTE ',' CALL GETINT ; Get integer 0-255 RSTSTR: CALL CHKSYN ; Make sure ")" follows .BYTE ")" POP AF ; Restore starting position EX (SP),HL ; Get string,8ave code string LD BC,MID1 ; Continuation of MID$ routine PUSH BC ; Save for return DEC A ; Starting position-1 CP (HL) ; Compare with length LD B,0 ; Zero bytes length RET NC ; Null string if start past end LD C,A ; Save starting position-1 LD A,(HL) ; Get length of string SUB C ; Subtract start CP E ; Enough string for it? LD B,A ; Save maximum length available RET C ; Truncate string if needed LD B,E ; Set specified length RET ; Go and create string VAL: CALL GETLEN ; Get length of string JP Z,RESZER ; Result zero LD E,A ; Save length INC HL INC HL LD A,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,A ; HL = String address PUSH HL ; Save string address ADD HL,DE LD B,(HL) ; Get end of string+1 byte LD (HL),D ; Zero it to terminate EX (SP),HL ; Save string end,get start PUSH BC ; Save end+1 byte LD A,(HL) ; Get starting byte CP '$' ; Hex number indicated? [function added] JP NZ,VAL1 CALL HEXTFP ; Convert Hex to FPREG JR VAL3 VAL1: CP '%' ; Binary number indicated? [function added] JP NZ,VAL2 CALL BINTFP ; Convert Bin to FPREG JR VAL3 VAL2: CALL ASCTFP ; Convert ASCII string to FP VAL3: POP BC ; Restore end+1 byte POP HL ; Restore end+1 address LD (HL),B ; Put back original byte RET LFRGNM: EX DE,HL ; Code string address to HL CALL CHKSYN ; Make sure ")" follows .BYTE ")" MIDNUM: POP BC ; Get return address POP DE ; Get number supplied PUSH BC ; Re-save return address LD B,E ; Number to B RET INP: CALL MAKINT ; Make it integer A LD (INPORT),A ; Set input port CALL INPSUB ; Get input from port JP PASSA ; Return integer A POUT: CALL SETIO ; Set up port number JP OUTSUB ; Output data and return WAIT: CALL SETIO ; Set up port number PUSH AF ; Save AND mask LD E,0 ; Assume zero if none given DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,NOXOR ; No XOR byte given CALL CHKSYN ; Make sure ',' follows .BYTE ',' CALL GETINT ; Get integer 0-255 to XOR with NOXOR: POP BC ; Restore AND mask WAITLP: CALL INPSUB ; Get input XOR E ; Flip selected bits AND B ; Result non-zero? JP Z,WAITLP ; No = keep waiting RET SETIO: CALL GETINT ; Get integer 0-255 LD (INPORT),A ; Set input port LD (OTPORT),A ; Set output port CALL CHKSYN ; Make sure ',' follows .BYTE ',' JP GETINT ; Get integer 0-255 and return FNDNUM: CALL GETCHR ; Get next character GETINT: CALL GETNUM ; Get a number from 0 to 255 MAKINT: CALL DEPINT ; Make sure value 0 - 255 LD A,D ; Get MSB of number OR A ; Zero? JP NZ,FCERR ; No - Error DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character LD A,E ; Get number to A RET PEEK: CALL DEINT ; Get memory address LD A,(DE) ; Get byte in memory JP PASSA ; Return integer A POKE: CALL GETNUM ; Get memory address CALL DEINT ; Get integer -32768 to 3276 PUSH DE ; Save memory address CALL CHKSYN ; Make sure ',' follows .BYTE ',' CALL GETINT ; Get integer 0-255 POP DE ; Restore memory address LD (DE),A ; Load it into memory RET ROUND: LD HL,HALF ; Add 0.5 to FPREG ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE JP FPADD ; Add BCDE to FPREG SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL .BYTE 21H ; Skip "POP BC" and "POP DE" PSUB: POP BC ; Get FP number from stack POP DE SUBCDE: CALL INVSGN ; Negate FPREG FPADD: LD A,B ; Get FP exponent OR A ; Is number zero? RET Z ; Yes - Nothing to add LD A,(FPEXP) ; Get FPREG exponent OR A ; Is this number zero? JP Z,FPBCDE ; Yes - Move BCDE to FPREG SUB B ; BCDE number larger? JP NC,NOSWAP ; No - Don't swap them CPL ; Two's complement INC A ; FP exponent EX DE,HL CALL STAKFP ; Put FPREG on stack EX DE,HL CALL FPBCDE ; Move BCDE to FPREG POP BC ; Restore number from stack POP DE NOSWAP: CP 24+1 ; Second number insignificant? RET NC ; Yes - First number is result PUSH AF ; Save number of bits to scale CALL SIGNS ; Set MSBs & sign of result LD H,A ; Save sign of result POP AF ; Restore scaling factor CALL SCALE ; Scale BCDE to same exponent OR H ; Result to be positive? LD HL,FPREG ; Point to FPREG JP P,MINCDE ; No - Subtract FPREG from CDE CALL PLUCDE ; Add FPREG to CDE JP NC,RONDUP ; No overflow - Round it up INC HL ; Point to exponent INC (HL) ; Increment it JP Z,OVERR ; Number overflowed - Error LD L,1 ; 1 bit to shift right CALL SHRT1 ; Shift result right JP RONDUP ; Round it up MINCDE: XOR A ; Clear A and carry SUB B ; Negate exponent LD B,A ; Re-save exponent LD A,(HL) ; Get LSB of FPREG SBC A, E ; Subtract LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG SBC A,D ; Subtract NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG SBC A,C ; Subtract MSB of BCDE LD C,A ; Save MSB of BCDE CONPOS: CALL C,COMPL ; Overflow - Make it positive BNORM: LD L,B ; L = Exponent LD H,E ; H = LSB XOR A BNRMLP: LD B,A ; Save bit count LD A,C ; Get MSB OR A ; Is it zero? JP NZ,PNORM ; No - Do it bit at a time LD C,D ; MSB = NMSB LD D,H ; NMSB= LSB LD H,L ; LSB = VLSB LD L,A ; VLSB= 0 LD A,B ; Get exponent SUB 8 ; Count 8 bits CP -24-8 ; Was number zero? JP NZ,BNRMLP ; No - Keep normalising RESZER: XOR A ; Result is zero SAVEXP: LD (FPEXP),A ; Save result as zero RET NORMAL: DEC B ; Count bits ADD HL,HL ; Shift HL left LD A,D ; Get NMSB RLA ; Shift left with last bit LD D,A ; Save NMSB LD A,C ; Get MSB ADC A,A ; Shift left with last bit LD C,A ; Save MSB PNORM: JP P,NORMAL ; Not done - Keep going LD A,B ; Number of bits shifted LD E,H ; Save HL in EB LD B,L OR A ; Any shifting done? JP Z,RONDUP ; No - Round it up LD HL,FPEXP ; Point to exponent ADD A,(HL) ; Add shifted bits LD (HL),A ; Re-save exponent JP NC,RESZER ; Underflow - Result is zero RET Z ; Result is zero RONDUP: LD A,B ; Get VLSB of number RONDB: LD HL,FPEXP ; Point to exponent OR A ; Any rounding? CALL M,FPROND ; Yes - Round number up LD B,(HL) ; B = Exponent INC HL LD A,(HL) ; Get sign of result AND 10000000B ; Only bit 7 needed XOR C ; Set correct sign LD C,A ; Save correct sign in number JP FPBCDE ; Move BCDE to FPREG FPROND: INC E ; Round LSB RET NZ ; Return if ok INC D ; Round NMSB RET NZ ; Return if ok INC C ; Round MSB RET NZ ; Return if ok LD C,80H ; Set normal value INC (HL) ; Increment exponent RET NZ ; Return if ok JP OVERR ; Overflow error PLUCDE: LD A,(HL) ; Get LSB of FPREG ADD A,E ; Add LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG ADC A,D ; Add NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG ADC A,C ; Add MSB of BCDE LD C,A ; Save MSB of BCDE RET COMPL: LD HL,SGNRES ; Sign of result LD A,(HL) ; Get sign of result CPL ; Negate it LD (HL),A ; Put it back XOR A LD L,A ; Set L to zero SUB B ; Negate exponent,set carry LD B,A ; Re-save exponent LD A,L ; Load zero SBC A,E ; Negate LSB LD E,A ; Re-save LSB LD A,L ; Load zero SBC A,D ; Negate NMSB LD D,A ; Re-save NMSB LD A,L ; Load zero SBC A,C ; Negate MSB LD C,A ; Re-save MSB RET SCALE: LD B,0 ; Clear underflow SCALLP: SUB 8 ; 8 bits (a whole byte)? JP C,SHRITE ; No - Shift right A bits LD B,E ; <- Shift LD E,D ; <- right LD D,C ; <- eight LD C,0 ; <- bits JP SCALLP ; More bits to shift SHRITE: ADD A,8+1 ; Adjust count LD L,A ; Save bits to shift SHRLP: XOR A ; Flag for all done DEC L ; All shifting done? RET Z ; Yes - Return LD A,C ; Get MSB SHRT1: RRA ; Shift it right LD C,A ; Re-save LD A,D ; Get NMSB RRA ; Shift right with last bit LD D,A ; Re-save it LD A,E ; Get LSB RRA ; Shift right with last bit LD E,A ; Re-save it LD A,B ; Get underflow RRA ; Shift right with last bit LD B,A ; Re-save underflow JP SHRLP ; More bits to do UNITY: .BYTE 000H,000H,000H,081H ; 1.00000 LOGTAB: .BYTE 3 ; Table used by LOG .BYTE 0AAH,056H,019H,080H ; 0.59898 .BYTE 0F1H,022H,076H,080H ; 0.96147 .BYTE 045H,0AAH,038H,082H ; 2.88539 LOG: CALL TSTSGN ; Test sign of value OR A JP PE,FCERR ; ?FC Error if <= zero LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent LD BC,8035H ; BCDE = SQR(1/2) LD DE,04F3H SUB B ; Scale value to be < 1 PUSH AF ; Save scale factor LD (HL),B ; Save new exponent PUSH DE ; Save SQR(1/2) PUSH BC CALL FPADD ; Add SQR(1/2) to value POP BC ; Restore SQR(1/2) POP DE INC B ; Make it SQR(2) CALL DVBCDE ; Divide by SQR(2) LD HL,UNITY ; Point to 1. CALL SUBPHL ; Subtract FPREG from 1 LD HL,LOGTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD BC,8080H ; BCDE = -0.5 LD DE,0000H CALL FPADD ; Subtract 0.5 from FPREG POP AF ; Restore scale factor CALL RSCALE ; Re-scale number MULLN2: LD BC,8031H ; BCDE = Ln(2) LD DE,7218H .BYTE 21H ; Skip "POP BC" and "POP DE" MULT: POP BC ; Get number from stack POP DE FPMULT: CALL TSTSGN ; Test sign of FPREG RET Z ; Return zero if zero LD L,0 ; Flag add exponents CALL ADDEXP ; Add exponents LD A,C ; Get MSB of multiplier LD (MULVAL),A ; Save MSB of multiplier EX DE,HL LD (MULVAL+1),HL ; Save rest of multiplier LD BC,0 ; Partial product (BCDE) = zero LD D,B LD E,B LD HL,BNORM ; Address of normalise PUSH HL ; Save for return LD HL,MULT8 ; Address of 8 bit multiply PUSH HL ; Save for NMSB,MSB PUSH HL ; LD HL,FPREG ; Point to number MULT8: LD A,(HL) ; Get LSB of number INC HL ; Point to NMSB OR A ; Test LSB JP Z,BYTSFT ; Zero - shift to next byte PUSH HL ; Save address of number LD L,8 ; 8 bits to multiply by MUL8LP: RRA ; Shift LSB right LD H,A ; Save LSB LD A,C ; Get MSB JP NC,NOMADD ; Bit was zero - Don't add PUSH HL ; Save LSB and count LD HL,(MULVAL+1) ; Get LSB and NMSB ADD HL,DE ; Add NMSB and LSB EX DE,HL ; Leave sum in DE POP HL ; Restore MSB and count LD A,(MULVAL) ; Get MSB of multiplier ADC A,C ; Add MSB NOMADD: RRA ; Shift MSB right LD C,A ; Re-save MSB LD A,D ; Get NMSB RRA ; Shift NMSB right LD D,A ; Re-save NMSB LD A,E ; Get LSB RRA ; Shift LSB right LD E,A ; Re-save LSB LD A,B ; Get VLSB RRA ; Shift VLSB right LD B,A ; Re-save VLSB DEC L ; Count bits multiplied LD A,H ; Get LSB of multiplier JP NZ,MUL8LP ; More - Do it POPHRT: POP HL ; Restore address of number RET BYTSFT: LD B,E ; Shift partial product left LD E,D LD D,C LD C,A RET DIV10: CALL STAKFP ; Save FPREG on stack LD BC,8420H ; BCDE = 10. LD DE,0000H CALL FPBCDE ; Move 10 to FPREG DIV: POP BC ; Get number from stack POP DE DVBCDE: CALL TSTSGN ; Test sign of FPREG JP Z,DZERR ; Error if division by zero LD L,-1 ; Flag subtract exponents CALL ADDEXP ; Subtract exponents INC (HL) ; Add 2 to exponent to adjust INC (HL) DEC HL ; Point to MSB LD A,(HL) ; Get MSB of dividend LD (DIV3),A ; Save for subtraction DEC HL LD A,(HL) ; Get NMSB of dividend LD (DIV2),A ; Save for subtraction DEC HL LD A,(HL) ; Get MSB of dividend LD (DIV1),A ; Save for subtraction LD B,C ; Get MSB EX DE,HL ; NMSB,LSB to HL XOR A LD C,A ; Clear MSB of quotient LD D,A ; Clear NMSB of quotient LD E,A ; Clear LSB of quotient LD (DIV4),A ; Clear overflow count DIVLP: PUSH HL ; Save divisor PUSH BC LD A,L ; Get LSB of number CALL DIVSUP ; Subt' divisor from dividend SBC A,0 ; Count for overflows CCF JP NC,RESDIV ; Restore divisor if borrow LD (DIV4),A ; Re-save overflow count POP AF ; Scrap divisor POP AF SCF ; Set carry to .BYTE 0D2H ; Skip "POP BC" and "POP HL" RESDIV: POP BC ; Restore divisor POP HL LD A,C ; Get MSB of quotient INC A DEC A RRA ; Bit 0 to bit 7 JP M,RONDB ; Done - Normalise result RLA ; Restore carry LD A,E ; Get LSB of quotient RLA ; Double it LD E,A ; Put it back LD A,D ; Get NMSB of quotient RLA ; Double it LD D,A ; Put it back LD A,C ; Get MSB of quotient RLA ; Double it LD C,A ; Put it back ADD HL,HL ; Double NMSB,LSB of divisor LD A,B ; Get MSB of divisor RLA ; Double it LD B,A ; Put it back LD A,(DIV4) ; Get VLSB of quotient RLA ; Double it LD (DIV4),A ; Put it back LD A,C ; Get MSB of quotient OR D ; Merge NMSB OR E ; Merge LSB JP NZ,DIVLP ; Not done - Keep dividing PUSH HL ; Save divisor LD HL,FPEXP ; Point to exponent DEC (HL) ; Divide by 2 POP HL ; Restore divisor JP NZ,DIVLP ; Ok - Keep going JP OVERR ; Overflow error ADDEXP: LD A,B ; Get exponent of dividend OR A ; Test it JP Z,OVTST3 ; Zero - Result zero LD A,L ; Get add/subtract flag LD HL,FPEXP ; Point to exponent XOR (HL) ; Add or subtract it ADD A,B ; Add the other exponent LD B,A ; Save new exponent RRA ; Test exponent for overflow XOR B LD A,B ; Get exponent JP P,OVTST2 ; Positive - Test for overflow ADD A,80H ; Add excess 128 LD (HL),A ; Save new exponent JP Z,POPHRT ; Zero - Result zero CALL SIGNS ; Set MSBs and sign of result LD (HL),A ; Save new exponent DEC HL ; Point to MSB RET OVTST1: CALL TSTSGN ; Test sign of FPREG CPL ; Invert sign POP HL ; Clean up stack OVTST2: OR A ; Test if new exponent zero OVTST3: POP HL ; Clear off return address JP P,RESZER ; Result zero JP OVERR ; Overflow error MLSP10: CALL BCDEFP ; Move FPREG to BCDE LD A,B ; Get exponent OR A ; Is it zero? RET Z ; Yes - Result is zero ADD A,2 ; Multiply by 4 JP C,OVERR ; Overflow - ?OV Error LD B,A ; Re-save exponent CALL FPADD ; Add BCDE to FPREG (Times 5) LD HL,FPEXP ; Point to exponent INC (HL) ; Double number (Times 10) RET NZ ; Ok - Return JP OVERR ; Overflow error TSTSGN: LD A,(FPEXP) ; Get sign of FPREG OR A RET Z ; RETurn if number is zero LD A,(FPREG+2) ; Get MSB of FPREG .BYTE 0FEH ; Test sign RETREL: CPL ; Invert sign RLA ; Sign bit to carry FLGDIF: SBC A,A ; Carry to all bits of A RET NZ ; Return -1 if negative INC A ; Bump to +1 RET ; Positive - Return +1 SGN: CALL TSTSGN ; Test sign of FPREG FLGREL: LD B,80H+8 ; 8 bit integer in exponent LD DE,0 ; Zero NMSB and LSB RETINT: LD HL,FPEXP ; Point to exponent LD C,A ; CDE = MSB,NMSB and LSB LD (HL),B ; Save exponent LD B,0 ; CDE = integer to normalise INC HL ; Point to sign of result LD (HL),80H ; Set sign of result RLA ; Carry = sign of integer JP CONPOS ; Set sign of result ABS: CALL TSTSGN ; Test sign of FPREG RET P ; Return if positive INVSGN: LD HL,FPREG+2 ; Point to MSB LD A,(HL) ; Get sign of mantissa XOR 80H ; Invert sign of mantissa LD (HL),A ; Re-save sign of mantissa RET STAKFP: EX DE,HL ; Save code string address LD HL,(FPREG) ; LSB,NLSB of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return LD HL,(FPREG+2) ; MSB and exponent of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return EX DE,HL ; Restore code string address RET PHLTFP: CALL LOADFP ; Number at HL to BCDE FPBCDE: EX DE,HL ; Save code string address LD (FPREG),HL ; Save LSB,NLSB of number LD H,B ; Exponent of number LD L,C ; MSB of number LD (FPREG+2),HL ; Save MSB and exponent EX DE,HL ; Restore code string address RET BCDEFP: LD HL,FPREG ; Point to FPREG LOADFP: LD E,(HL) ; Get LSB of number INC HL LD D,(HL) ; Get NMSB of number INC HL LD C,(HL) ; Get MSB of number INC HL LD B,(HL) ; Get exponent of number INCHL: INC HL ; Used for conditional "INC HL" RET FPTHL: LD DE,FPREG ; Point to FPREG DETHL4: LD B,4 ; 4 bytes to move DETHLB: LD A,(DE) ; Get source LD (HL),A ; Save destination INC DE ; Next source INC HL ; Next destination DEC B ; Count bytes JP NZ,DETHLB ; Loop if more RET SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG LD A,(HL) ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD (HL),A ; Save new MSB CCF ; Complement sign RRA ; Old sign to carry INC HL INC HL LD (HL),A ; Set sign of result LD A,C ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD C,A ; Save MSB RRA XOR (HL) ; New sign of result RET CMPNUM: LD A,B ; Get exponent of number OR A JP Z,TSTSGN ; Zero - Test sign of FPREG LD HL,RETREL ; Return relation routine PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD A,C ; Get MSB of number RET Z ; FPREG zero - Number's MSB LD HL,FPREG+2 ; MSB of FPREG XOR (HL) ; Combine signs LD A,C ; Get MSB of number RET M ; Exit if signs different CALL CMPFP ; Compare FP numbers RRA ; Get carry to sign XOR C ; Combine with MSB of number RET CMPFP: INC HL ; Point to exponent LD A,B ; Get exponent CP (HL) ; Compare exponents RET NZ ; Different DEC HL ; Point to MBS LD A,C ; Get MSB CP (HL) ; Compare MSBs RET NZ ; Different DEC HL ; Point to NMSB LD A,D ; Get NMSB CP (HL) ; Compare NMSBs RET NZ ; Different DEC HL ; Point to LSB LD A,E ; Get LSB SUB (HL) ; Compare LSBs RET NZ ; Different POP HL ; Drop RETurn POP HL ; Drop another RETurn RET FPINT: LD B,A ; <- Move LD C,A ; <- exponent LD D,A ; <- to all LD E,A ; <- bits OR A ; Test exponent RET Z ; Zero - Return zero PUSH HL ; Save pointer to number CALL BCDEFP ; Move FPREG to BCDE CALL SIGNS ; Set MSBs & sign of result XOR (HL) ; Combine with sign of FPREG LD H,A ; Save combined signs CALL M,DCBCDE ; Negative - Decrement BCDE LD A,80H+24 ; 24 bits SUB B ; Bits to shift CALL SCALE ; Shift BCDE LD A,H ; Get combined sign RLA ; Sign to carry CALL C,FPROND ; Negative - Round number up LD B,0 ; Zero exponent CALL C,COMPL ; If negative make positive POP HL ; Restore pointer to number RET DCBCDE: DEC DE ; Decrement BCDE LD A,D ; Test LSBs AND E INC A RET NZ ; Exit if LSBs not FFFF DEC BC ; Decrement MSBs RET INT: LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent CP 80H+24 ; Integer accuracy only? LD A,(FPREG) ; Get LSB RET NC ; Yes - Already integer LD A,(HL) ; Get exponent CALL FPINT ; F.P to integer LD (HL),80H+24 ; Save 24 bit integer LD A,E ; Get LSB of number PUSH AF ; Save LSB LD A,C ; Get MSB of number RLA ; Sign to carry CALL CONPOS ; Set sign of result POP AF ; Restore LSB of number RET MLDEBC: LD HL,0 ; Clear partial product LD A,B ; Test multiplier OR C RET Z ; Return zero if zero LD A,16 ; 16 bits MLDBLP: ADD HL,HL ; Shift P.P left JP C,BSERR ; ?BS Error if overflow EX DE,HL ADD HL,HL ; Shift multiplier left EX DE,HL JP NC,NOMLAD ; Bit was zero - No add ADD HL,BC ; Add multiplicand JP C,BSERR ; ?BS Error if overflow NOMLAD: DEC A ; Count bits JP NZ,MLDBLP ; More RET ASCTFP: CP '-' ; Negative? PUSH AF ; Save it and flags JP Z,CNVNUM ; Yes - Convert number CP '+' ; Positive? JP Z,CNVNUM ; Yes - Convert number DEC HL ; DEC 'cos GETCHR INCs CNVNUM: CALL RESZER ; Set result to zero LD B,A ; Digits after point counter LD D,A ; Sign of exponent LD E,A ; Exponent of ten CPL LD C,A ; Before or after point flag MANLP: CALL GETCHR ; Get next character JP C,ADDIG ; Digit - Add to number CP '.' JP Z,DPOINT ; '.' - Flag point CP 'E' JP NZ,CONEXP ; Not 'E' - Scale number CALL GETCHR ; Get next character CALL SGNEXP ; Get sign of exponent EXPLP: CALL GETCHR ; Get next character JP C,EDIGIT ; Digit - Add to exponent INC D ; Is sign negative? JP NZ,CONEXP ; No - Scale number XOR A SUB E ; Negate exponent LD E,A ; And re-save it INC C ; Flag end of number DPOINT: INC C ; Flag point passed JP Z,MANLP ; Zero - Get another digit CONEXP: PUSH HL ; Save code string address LD A,E ; Get exponent SUB B ; Subtract digits after point SCALMI: CALL P,SCALPL ; Positive - Multiply number JP P,ENDCON ; Positive - All done PUSH AF ; Save number of times to /10 CALL DIV10 ; Divide by 10 POP AF ; Restore count INC A ; Count divides ENDCON: JP NZ,SCALMI ; More to do POP DE ; Restore code string address POP AF ; Restore sign of number CALL Z,INVSGN ; Negative - Negate number EX DE,HL ; Code string address to HL RET SCALPL: RET Z ; Exit if no scaling needed MULTEN: PUSH AF ; Save count CALL MLSP10 ; Multiply number by 10 POP AF ; Restore count DEC A ; Count multiplies RET ADDIG: PUSH DE ; Save sign of exponent LD D,A ; Save digit LD A,B ; Get digits after point ADC A,C ; Add one if after point LD B,A ; Re-save counter PUSH BC ; Save point flags PUSH HL ; Save code string address PUSH DE ; Save digit CALL MLSP10 ; Multiply number by 10 POP AF ; Restore digit SUB '0' ; Make it absolute CALL RSCALE ; Re-scale number POP HL ; Restore code string address POP BC ; Restore point flags POP DE ; Restore sign of exponent JP MANLP ; Get another digit RSCALE: CALL STAKFP ; Put number on stack CALL FLGREL ; Digit to add to FPREG PADD: POP BC ; Restore number POP DE JP FPADD ; Add BCDE to FPREG and return EDIGIT: LD A,E ; Get digit RLCA ; Times 2 RLCA ; Times 4 ADD A,E ; Times 5 RLCA ; Times 10 ADD A,(HL) ; Add next digit SUB '0' ; Make it absolute LD E,A ; Save new digit JP EXPLP ; Look for another digit LINEIN: PUSH HL ; Save code string address LD HL,INMSG ; Output " in " CALL PRS ; Output string at HL POP HL ; Restore code string address PRNTHL: EX DE,HL ; Code string address to DE XOR A LD B,80H+24 ; 24 bits CALL RETINT ; Return the integer LD HL,PRNUMS ; Print number string PUSH HL ; Save for return NUMASC: LD HL,PBUFF ; Convert number to ASCII PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD (HL),' ' ; Space at start JP P,SPCFST ; Positive - Space to start LD (HL),'-' ; '-' sign at start SPCFST: INC HL ; First byte of number LD (HL),'0' ; '0' if zero JP Z,JSTZER ; Return '0' if zero PUSH HL ; Save buffer address CALL M,INVSGN ; Negate FPREG if negative XOR A ; Zero A PUSH AF ; Save it CALL RNGTST ; Test number is in range SIXDIG: LD BC,9143H ; BCDE - 99999.9 LD DE,4FF8H CALL CMPNUM ; Compare numbers OR A JP PO,INRNG ; > 99999.9 - Sort it out POP AF ; Restore count CALL MULTEN ; Multiply by ten PUSH AF ; Re-save count JP SIXDIG ; Test it again GTSIXD: CALL DIV10 ; Divide by 10 POP AF ; Get count INC A ; Count divides PUSH AF ; Re-save count CALL RNGTST ; Test number is in range INRNG: CALL ROUND ; Add 0.5 to FPREG INC A CALL FPINT ; F.P to integer CALL FPBCDE ; Move BCDE to FPREG LD BC,0306H ; 1E+06 to 1E-03 range POP AF ; Restore count ADD A,C ; 6 digits before point INC A ; Add one JP M,MAKNUM ; Do it in 'E' form if < 1E-02 CP 6+1+1 ; More than 999999 ? JP NC,MAKNUM ; Yes - Do it in 'E' form INC A ; Adjust for exponent LD B,A ; Exponent of number LD A,2 ; Make it zero after MAKNUM: DEC A ; Adjust for digits to do DEC A POP HL ; Restore buffer address PUSH AF ; Save count LD DE,POWERS ; Powers of ten DEC B ; Count digits before point JP NZ,DIGTXT ; Not zero - Do number LD (HL),'.' ; Save point INC HL ; Move on LD (HL),'0' ; Save zero INC HL ; Move on DIGTXT: DEC B ; Count digits before point LD (HL),'.' ; Save point in case CALL Z,INCHL ; Last digit - move on PUSH BC ; Save digits before point PUSH HL ; Save buffer address PUSH DE ; Save powers of ten CALL BCDEFP ; Move FPREG to BCDE POP HL ; Powers of ten table LD B, '0'-1 ; ASCII '0' - 1 TRYAGN: INC B ; Count subtractions LD A,E ; Get LSB SUB (HL) ; Subtract LSB LD E,A ; Save LSB INC HL LD A,D ; Get NMSB SBC A,(HL) ; Subtract NMSB LD D,A ; Save NMSB INC HL LD A,C ; Get MSB SBC A,(HL) ; Subtract MSB LD C,A ; Save MSB DEC HL ; Point back to start DEC HL JP NC,TRYAGN ; No overflow - Try again CALL PLUCDE ; Restore number INC HL ; Start of next number CALL FPBCDE ; Move BCDE to FPREG EX DE,HL ; Save point in table POP HL ; Restore buffer address LD (HL),B ; Save digit in buffer INC HL ; And move on POP BC ; Restore digit count DEC C ; Count digits JP NZ,DIGTXT ; More - Do them DEC B ; Any decimal part? JP Z,DOEBIT ; No - Do 'E' bit SUPTLZ: DEC HL ; Move back through buffer LD A,(HL) ; Get character CP '0' ; '0' character? JP Z,SUPTLZ ; Yes - Look back for more CP '.' ; A decimal point? CALL NZ,INCHL ; Move back over digit DOEBIT: POP AF ; Get 'E' flag JP Z,NOENED ; No 'E' needed - End buffer LD (HL),'E' ; Put 'E' in buffer INC HL ; And move on LD (HL),'+' ; Put '+' in buffer JP P,OUTEXP ; Positive - Output exponent LD (HL),'-' ; Put '-' in buffer CPL ; Negate exponent INC A OUTEXP: LD B,'0'-1 ; ASCII '0' - 1 EXPTEN: INC B ; Count subtractions SUB 10 ; Tens digit JP NC,EXPTEN ; More to do ADD A,'0'+10 ; Restore and make ASCII INC HL ; Move on LD (HL),B ; Save MSB of exponent JSTZER: INC HL ; LD (HL),A ; Save LSB of exponent INC HL NOENED: LD (HL),C ; Mark end of buffer POP HL ; Restore code string address RET RNGTST: LD BC,9474H ; BCDE = 999999. LD DE,23F7H CALL CMPNUM ; Compare numbers OR A POP HL ; Return address to HL JP PO,GTSIXD ; Too big - Divide by ten JP (HL) ; Otherwise return to caller HALF: .BYTE 00H,00H,00H,80H ; 0.5 POWERS: .BYTE 0A0H,086H,001H ; 100000 .BYTE 010H,027H,000H ; 10000 .BYTE 0E8H,003H,000H ; 1000 .BYTE 064H,000H,000H ; 100 .BYTE 00AH,000H,000H ; 10 .BYTE 001H,000H,000H ; 1 NEGAFT: LD HL,INVSGN ; Negate result EX (SP),HL ; To be done after caller JP (HL) ; Return to caller SQR: CALL STAKFP ; Put value on stack LD HL,HALF ; Set power to 1/2 CALL PHLTFP ; Move 1/2 to FPREG POWER: POP BC ; Get base POP DE CALL TSTSGN ; Test sign of power LD A,B ; Get exponent of base JP Z,EXP ; Make result 1 if zero JP P,POWER1 ; Positive base - Ok OR A ; Zero to negative power? JP Z,DZERR ; Yes - ?/0 Error POWER1: OR A ; Base zero? JP Z,SAVEXP ; Yes - Return zero PUSH DE ; Save base PUSH BC LD A,C ; Get MSB of base OR 01111111B ; Get sign status CALL BCDEFP ; Move power to BCDE JP P,POWER2 ; Positive base - Ok PUSH DE ; Save power PUSH BC CALL INT ; Get integer of power POP BC ; Restore power POP DE PUSH AF ; MSB of base CALL CMPNUM ; Power an integer? POP HL ; Restore MSB of base LD A,H ; but don't affect flags RRA ; Exponent odd or even? POWER2: POP HL ; Restore MSB and exponent LD (FPREG+2),HL ; Save base in FPREG POP HL ; LSBs of base LD (FPREG),HL ; Save in FPREG CALL C,NEGAFT ; Odd power - Negate result CALL Z,INVSGN ; Negative base - Negate it PUSH DE ; Save power PUSH BC CALL LOG ; Get LOG of base POP BC ; Restore power POP DE CALL FPMULT ; Multiply LOG by power EXP: CALL STAKFP ; Put value on stack LD BC,08138H ; BCDE = 1/Ln(2) LD DE,0AA3BH CALL FPMULT ; Multiply value by 1/LN(2) LD A,(FPEXP) ; Get exponent CP 80H+8 ; Is it in range? JP NC,OVTST1 ; No - Test for overflow CALL INT ; Get INT of FPREG ADD A,80H ; For excess 128 ADD A,2 ; Exponent > 126? JP C,OVTST1 ; Yes - Test for overflow PUSH AF ; Save scaling factor LD HL,UNITY ; Point to 1. CALL ADDPHL ; Add 1 to FPREG CALL MULLN2 ; Multiply by LN(2) POP AF ; Restore scaling factor POP BC ; Restore exponent POP DE PUSH AF ; Save scaling factor CALL SUBCDE ; Subtract exponent from FPREG CALL INVSGN ; Negate result LD HL,EXPTAB ; Coefficient table CALL SMSER1 ; Sum the series LD DE,0 ; Zero LSBs POP BC ; Scaling factor LD C,D ; Zero MSB JP FPMULT ; Scale result to correct value EXPTAB: .BYTE 8 ; Table used by EXP .BYTE 040H,02EH,094H,074H ; -1/7! (-1/5040) .BYTE 070H,04FH,02EH,077H ; 1/6! ( 1/720) .BYTE 06EH,002H,088H,07AH ; -1/5! (-1/120) .BYTE 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) .BYTE 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) .BYTE 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) .BYTE 000H,000H,080H,081H ; -1/1! (-1/1) .BYTE 000H,000H,000H,081H ; 1/0! ( 1/1) SUMSER: CALL STAKFP ; Put FPREG on stack LD DE,MULT ; Multiply by "X" PUSH DE ; To be done after PUSH HL ; Save address of table CALL BCDEFP ; Move FPREG to BCDE CALL FPMULT ; Square the value POP HL ; Restore address of table SMSER1: CALL STAKFP ; Put value on stack LD A,(HL) ; Get number of coefficients INC HL ; Point to start of table CALL PHLTFP ; Move coefficient to FPREG .BYTE 06H ; Skip "POP AF" SUMLP: POP AF ; Restore count POP BC ; Restore number POP DE DEC A ; Cont coefficients RET Z ; All done PUSH DE ; Save number PUSH BC PUSH AF ; Save count PUSH HL ; Save address in table CALL FPMULT ; Multiply FPREG by BCDE POP HL ; Restore address in table CALL LOADFP ; Number at HL to BCDE PUSH HL ; Save address in table CALL FPADD ; Add coefficient to FPREG POP HL ; Restore address in table JP SUMLP ; More coefficients RND: CALL TSTSGN ; Test sign of FPREG LD HL,SEED+2 ; Random number seed JP M,RESEED ; Negative - Re-seed LD HL,LSTRND ; Last random number CALL PHLTFP ; Move last RND to FPREG LD HL,SEED+2 ; Random number seed RET Z ; Return if RND(0) ADD A,(HL) ; Add (SEED)+2) AND 00000111B ; 0 to 7 LD B,0 LD (HL),A ; Re-save seed INC HL ; Move to coefficient table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to coefficient CALL LOADFP ; Coefficient to BCDE CALL FPMULT ; ; Multiply FPREG by coefficient LD A,(SEED+1) ; Get (SEED+1) INC A ; Add 1 AND 00000011B ; 0 to 3 LD B,0 CP 1 ; Is it zero? ADC A,B ; Yes - Make it 1 LD (SEED+1),A ; Re-save seed LD HL,RNDTAB-4 ; Addition table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to value CALL ADDPHL ; Add value to FPREG RND1: CALL BCDEFP ; Move FPREG to BCDE LD A,E ; Get LSB LD E,C ; LSB = MSB XOR 01001111B ; Fiddle around LD C,A ; New MSB LD (HL),80H ; Set exponent DEC HL ; Point to MSB LD B,(HL) ; Get MSB LD (HL),80H ; Make value -0.5 LD HL,SEED ; Random number seed INC (HL) ; Count seed LD A,(HL) ; Get seed SUB 171 ; Do it modulo 171 JP NZ,RND2 ; Non-zero - Ok LD (HL),A ; Zero seed INC C ; Fillde about DEC D ; with the INC E ; number RND2: CALL BNORM ; Normalise number LD HL,LSTRND ; Save random number JP FPTHL ; Move FPREG to last and return RESEED: LD (HL),A ; Re-seed random numbers DEC HL LD (HL),A DEC HL LD (HL),A JP RND1 ; Return RND seed RNDTAB: .BYTE 068H,0B1H,046H,068H ; Table used by RND .BYTE 099H,0E9H,092H,069H .BYTE 010H,0D1H,075H,068H COS: LD HL,HALFPI ; Point to PI/2 CALL ADDPHL ; Add it to PPREG SIN: CALL STAKFP ; Put angle on stack LD BC,8349H ; BCDE = 2 PI LD DE,0FDBH CALL FPBCDE ; Move 2 PI to FPREG POP BC ; Restore angle POP DE CALL DVBCDE ; Divide angle by 2 PI CALL STAKFP ; Put it on stack CALL INT ; Get INT of result POP BC ; Restore number POP DE CALL SUBCDE ; Make it 0 <= value < 1 LD HL,QUARTR ; Point to 0.25 CALL SUBPHL ; Subtract value from 0.25 CALL TSTSGN ; Test sign of value SCF ; Flag positive JP P,SIN1 ; Positive - Ok CALL ROUND ; Add 0.5 to value CALL TSTSGN ; Test sign of value OR A ; Flag negative SIN1: PUSH AF ; Save sign CALL P,INVSGN ; Negate value if positive LD HL,QUARTR ; Point to 0.25 CALL ADDPHL ; Add 0.25 to value POP AF ; Restore sign CALL NC,INVSGN ; Negative - Make positive LD HL,SINTAB ; Coefficient table JP SUMSER ; Evaluate sum of series HALFPI: .BYTE 0DBH,00FH,049H,081H ; 1.5708 (PI/2) QUARTR: .BYTE 000H,000H,000H,07FH ; 0.25 SINTAB: .BYTE 5 ; Table used by SIN .BYTE 0BAH,0D7H,01EH,086H ; 39.711 .BYTE 064H,026H,099H,087H ;-76.575 .BYTE 058H,034H,023H,087H ; 81.602 .BYTE 0E0H,05DH,0A5H,086H ;-41.342 .BYTE 0DAH,00FH,049H,083H ; 6.2832 TAN: CALL STAKFP ; Put angle on stack CALL SIN ; Get SIN of angle POP BC ; Restore angle POP HL CALL STAKFP ; Save SIN of angle EX DE,HL ; BCDE = Angle CALL FPBCDE ; Angle to FPREG CALL COS ; Get COS of angle JP DIV ; TAN = SIN / COS ATN: CALL TSTSGN ; Test sign of value CALL M,NEGAFT ; Negate result after if -ve CALL M,INVSGN ; Negate value if -ve LD A,(FPEXP) ; Get exponent CP 81H ; Number less than 1? JP C,ATN1 ; Yes - Get arc tangnt LD BC,8100H ; BCDE = 1 LD D,C LD E,C CALL DVBCDE ; Get reciprocal of number LD HL,SUBPHL ; Sub angle from PI/2 PUSH HL ; Save for angle > 1 ATN1: LD HL,ATNTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD HL,HALFPI ; PI/2 - angle in case > 1 RET ; Number > 1 - Sub from PI/2 ATNTAB: .BYTE 9 ; Table used by ATN .BYTE 04AH,0D7H,03BH,078H ; 1/17 .BYTE 002H,06EH,084H,07BH ;-1/15 .BYTE 0FEH,0C1H,02FH,07CH ; 1/13 .BYTE 074H,031H,09AH,07DH ;-1/11 .BYTE 084H,03DH,05AH,07DH ; 1/9 .BYTE 0C8H,07FH,091H,07EH ;-1/7 .BYTE 0E4H,0BBH,04CH,07EH ; 1/5 .BYTE 06CH,0AAH,0AAH,07FH ;-1/3 .BYTE 000H,000H,000H,081H ; 1/1 ARET: RET ; A RETurn instruction GETINP: RST 10H ;input a character RET CLS: LD A,CS ; ASCII Clear screen JP MONOUT ; Output character WIDTH: CALL GETINT ; Get integer 0-255 LD A,E ; Width to A LD (LWIDTH),A ; Set width RET LINES: CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 LD (LINESC),DE ; Set lines counter LD (LINESN),DE ; Set lines number RET DEEK: CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save number POP HL ; Number to HL LD B,(HL) ; Get LSB of contents INC HL LD A,(HL) ; Get MSB of contents JP ABPASS ; Return integer AB DOKE: CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save address CALL CHKSYN ; Make sure ',' follows .BYTE ',' CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 EX (SP),HL ; Save value,get address LD (HL),E ; Save LSB of value INC HL LD (HL),D ; Save MSB of value POP HL ; Restore code string address RET ; HEX$(nn) Convert 16 bit number to Hexadecimal string HEX: CALL TSTNUM ; Verify it's a number CALL DEINT ; Get integer -32768 to 32767 PUSH BC ; Save contents of BC LD HL,PBUFF LD A,D ; Get high order into A CP $0 JR Z,HEX2 ; Skip output if both high digits are zero CALL BYT2ASC ; Convert D to ASCII LD A,B CP '0' JR Z,HEX1 ; Don't store high digit if zero LD (HL),B ; Store it to PBUFF INC HL ; Next location HEX1: LD (HL),C ; Store C to PBUFF+1 INC HL ; Next location HEX2: LD A,E ; Get lower byte CALL BYT2ASC ; Convert E to ASCII LD A,D CP $0 JR NZ,HEX3 ; If upper byte was not zero then always print lower byte LD A,B CP '0' ; If high digit of lower byte is zero then don't print JR Z,HEX4 HEX3: LD (HL),B ; to PBUFF+2 INC HL ; Next location HEX4: LD (HL),C ; to PBUFF+3 INC HL ; PBUFF+4 to zero XOR A ; Terminating character LD (HL),A ; Store zero to terminate INC HL ; Make sure PBUFF is terminated LD (HL),A ; Store the double zero there POP BC ; Get BC back LD HL,PBUFF ; Reset to start of PBUFF JP STR1 ; Convert the PBUFF to a string and return it BYT2ASC LD B,A ; Save original value AND $0F ; Strip off upper nybble CP $0A ; 0-9? JR C,ADD30 ; If A-F, add 7 more ADD A,$07 ; Bring value up to ASCII A-F ADD30 ADD A,$30 ; And make ASCII LD C,A ; Save converted char to C LD A,B ; Retrieve original value RRCA ; and Rotate it right RRCA RRCA RRCA AND $0F ; Mask off upper nybble CP $0A ; 0-9? < A hex? JR C,ADD301 ; Skip Add 7 ADD A,$07 ; Bring it up to ASCII A-F ADD301 ADD A,$30 ; And make it full ASCII LD B,A ; Store high order byte RET ; Convert "&Hnnnn" to FPREG ; Gets a character from (HL) checks for Hexadecimal ASCII numbers "&Hnnnn" ; Char is in A, NC if char is ;<=>?@ A-z, CY is set if 0-9 HEXTFP EX DE,HL ; Move code string pointer to DE LD HL,$0000 ; Zero out the value CALL GETHEX ; Check the number for valid hex JP C,HXERR ; First value wasn't hex, HX error JR HEXLP1 ; Convert first character HEXLP CALL GETHEX ; Get second and addtional characters JR C,HEXIT ; Exit if not a hex character HEXLP1 ADD HL,HL ; Rotate 4 bits to the left ADD HL,HL ADD HL,HL ADD HL,HL OR L ; Add in D0-D3 into L LD L,A ; Save new value JR HEXLP ; And continue until all hex characters are in GETHEX INC DE ; Next location LD A,(DE) ; Load character at pointer CP ' ' JP Z,GETHEX ; Skip spaces SUB $30 ; Get absolute value RET C ; < "0", error CP $0A JR C,NOSUB7 ; Is already in the range 0-9 SUB $07 ; Reduce to A-F CP $0A ; Value should be $0A-$0F at this point RET C ; CY set if was : ; < = > ? @ NOSUB7 CP $10 ; > Greater than "F"? CCF RET ; CY set if it wasn't valid hex HEXIT EX DE,HL ; Value into DE, Code string into HL LD A,D ; Load DE into AC LD C,E ; For prep to PUSH HL CALL ACPASS ; ACPASS to set AC as integer into FPREG POP HL RET HXERR: LD E,HX ; ?HEX Error JP ERROR ; BIN$(NN) Convert integer to a 1-16 char binary string BIN: CALL TSTNUM ; Verify it's a number CALL DEINT ; Get integer -32768 to 32767 BIN2: PUSH BC ; Save contents of BC LD HL,PBUFF LD B,17 ; One higher than max char count ZEROSUP: ; Suppress leading zeros DEC B ; Max 16 chars LD A,B CP $01 JR Z,BITOUT ; Always output at least one character RL E RL D JR NC,ZEROSUP JR BITOUT2 BITOUT: RL E RL D ; Top bit now in carry BITOUT2: LD A,'0' ; Char for '0' ADC A,0 ; If carry set then '0' --> '1' LD (HL),A INC HL DEC B JR NZ,BITOUT XOR A ; Terminating character LD (HL),A ; Store zero to terminate INC HL ; Make sure PBUFF is terminated LD (HL),A ; Store the double zero there POP BC LD HL,PBUFF JP STR1 ; Convert "&Bnnnn" to FPREG ; Gets a character from (HL) checks for Binary ASCII numbers "&Bnnnn" BINTFP: EX DE,HL ; Move code string pointer to DE LD HL,$0000 ; Zero out the value CALL CHKBIN ; Check the number for valid bin JP C,BINERR ; First value wasn't bin, HX error BINIT: SUB '0' ADD HL,HL ; Rotate HL left OR L LD L,A CALL CHKBIN ; Get second and addtional characters JR NC,BINIT ; Process if a bin character EX DE,HL ; Value into DE, Code string into HL LD A,D ; Load DE into AC LD C,E ; For prep to PUSH HL CALL ACPASS ; ACPASS to set AC as integer into FPREG POP HL RET ; Char is in A, NC if char is 0 or 1 CHKBIN: INC DE LD A,(DE) CP ' ' JP Z,CHKBIN ; Skip spaces CP '0' ; Set C if < '0' RET C CP '2' CCF ; Set C if > '1' RET BINERR: LD E,BN ; ?BIN Error JP ERROR JJUMP1: LD IX,-1 ; Flag cold start JP CSTART ; Go and initialise MONOUT: JP $0008 ; output a char MONITR: JP $0000 ; Restart (Normally Monitor Start) INITST: LD A,0 ; Clear break flag LD (BRKFLG),A JP INIT ARETN: RETN ; Return from NMI TSTBIT: PUSH AF ; Save bit mask AND B ; Get common bits POP BC ; Restore bit mask CP B ; Same bit set? LD A,0 ; Return 0 in A RET OUTNCR: CALL OUTC ; Output character in A JP PRNTCRLF ; Output CRLF .end