; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft ; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3 ; (May-June 1983) to Vol 3, Issue 3 (May-June 1984) ; Adapted for the freeware Zilog Macro Assembler 2.10 to produce ; the original ROM code (checksum A934H). PA ; MONITOR EQUATES (RESTART INSTRUCTIONS) _ROUT EQU 0F7H ; ROUT - Output char in A _BLNK EQU 07BDFH ; SCAL BLINK - Get input char in A _INLN EQU 063DFH ; SCAL INLIN - Get input line _MFLP EQU 05FDFH ; SCAL MFLP - Toggle tape drv LED _MRET EQU 05BDFH ; SCAL MRET - Return to monitor _READ EQU 052DFH ; SCAL READ _RIN EQU 062DFH ; SCAL RIN - Scan for input char _VRFY EQU 056DFH ; SCAL VERIFY _WRIT EQU 057DFH ; SCAL WRITE ; GENERAL EQUATES UARTD EQU 01H ; UART data port UARTS EQU 02H ; UART status port CTRLC EQU 03H ; Control "C" CTRLG EQU 07H ; Control "G" BKSP EQU 08H ; Back space LF EQU 0AH ; Line feed CS EQU 0CH ; Clear screen CR EQU 0DH ; Carriage return CTRLO EQU 0FH ; Control "O" CTRLR EQU 12H ; Control "R" CTRLS EQU 13H ; Control "S" CTRLU EQU 15H ; Control "U" CTRLZ EQU 1AH ; Control "Z" ESC EQU 1BH ; Escape TBRK EQU 1CH ; "T" monitor break TBS EQU 1DH ; "T" monitor back space TCS EQU 1EH ; "T" monitor clear screen TCR EQU 1FH ; "T" monitor carriage return DEL EQU 7FH ; Delete ; MONITOR LOCATIONS MONSTT EQU 0000H ; Start of monitor STMON EQU 000DH ; NAS-SYS initialisation MFLP EQU 0051H ; Flip tape LED ("T") MONTYP EQU 008DH ; Type of "T" monitor T2DUMP EQU 03D1H ; "T2" Dump routine T4WR EQU 0400H ; "T4" Write routine T4READ EQU 070CH ; "T4" Read routine VDU EQU 0800H ; NASCOM Video RAM base ; MONITOR WORK SPACE LOCATIONS PORT0 EQU 0C00H ; Copy of output port 0 ARG1 EQU 0C0CH ; Argument 1 ARG2 EQU 0C0EH ; Argument 2 TCUR EQU 0C18H ; "T" monitor cursor CURSOR EQU 0C29H ; NAS-SYS Cursor ARGN EQU 0C2BH ; Number of ARGS TOUT EQU 0C4AH ; "T" Output reflection TIN EQU 0C4DH ; "T" Input reflection CIN EQU 0C75H ; NAS-SYS Input table NMI EQU 0C7EH ; NAS-SYS NMI Jump ; BASIC WORK SPACE LOCATIONS WRKSPC EQU 1000H ; BASIC Work space USR EQU 1003H ; "USR (x)" jump OUTSUB EQU 1006H ; "OUT p,n" OTPORT EQU 1007H ; Port (p) DIVSUP EQU 1009H ; Division support routine DIV1 EQU 100AH ; <- Values DIV2 EQU 100EH ; <- to DIV3 EQU 1012H ; <- be DIV4 EQU 1015H ; <-inserted SEED EQU 1017H ; Random number seed LSTRND EQU 103AH ; Last random number INPSUB EQU 103EH ; #INP (x)" Routine INPORT EQU 103FH ; PORT (x) NULLS EQU 1041H ; Number of nulls LWIDTH EQU 1042H ; Terminal width COMMAN EQU 1043H ; Width for commas NULFLG EQU 1044H ; Null after input byte flag CTLOFG EQU 1045H ; Control "O" flag LINESC EQU 1046H ; Lines counter LINESN EQU 1048H ; Lines number CHKSUM EQU 104AH ; Array load/save check sum NMIFLG EQU 104CH ; Flag for NMI break routine BRKFLG EQU 104DH ; Break flag RINPUT EQU 104EH ; Input reflection POINT EQU 1051H ; "POINT" reflection (unused) PSET EQU 1054H ; "SET" reflection RESET EQU 1057H ; "RESET" reflection STRSPC EQU 105AH ; Bottom of string space LINEAT EQU 105CH ; Current line number BASTXT EQU 105EH ; Pointer to start of program BUFFER EQU 1061H ; Input buffer STACK EQU 1066H ; Initial stack CURPOS EQU 10ABH ; Character position on line LCRFLG EQU 10ACH ; Locate/Create flag TYPE EQU 10ADH ; Data type flag DATFLG EQU 10AEH ; Literal statement flag LSTRAM EQU 10AFH ; Last available RAM TMSTPT EQU 10B1H ; Temporary string pointer TMSTPL EQU 10B3H ; Temporary string pool TMPSTR EQU 10BFH ; Temporary string STRBOT EQU 10C3H ; Bottom of string space CUROPR EQU 10C5H ; Current operator in EVAL LOOPST EQU 10C7H ; First statement of loop DATLIN EQU 10C9H ; Line of current DATA item FORFLG EQU 10CBH ; "FOR" loop flag LSTBIN EQU 10CCH ; Last byte entered READFG EQU 10CDH ; Read/Input flag BRKLIN EQU 10CEH ; Line of break NXTOPR EQU 10D0H ; Next operator in EVAL ERRLIN EQU 10D2H ; Line of error CONTAD EQU 10D4H ; Where to CONTinue PROGND EQU 10D6H ; End of program VAREND EQU 10D8H ; End of variables ARREND EQU 10DAH ; End of arrays NXTDAT EQU 10DCH ; Next data item FNRGNM EQU 10DEH ; Name of FN argument FNARG EQU 10E0H ; FN argument value FPREG EQU 10E4H ; Floating point register FPEXP EQU FPREG+3 ; Floating point exponent SGNRES EQU 10E8H ; Sign of result PBUFF EQU 10E9H ; Number print buffer MULVAL EQU 10F6H ; Multiplier PROGST EQU 10F9H ; Start of program text area STLOOK EQU 115DH ; Start of memory test ; BASIC ERROR CODE VALUES NF EQU 00H ; NEXT without FOR SN EQU 02H ; Syntax error RG EQU 04H ; RETURN without GOSUB OD EQU 06H ; Out of DATA FC EQU 08H ; Function call error OV EQU 0AH ; Overflow OM EQU 0CH ; Out of memory UL EQU 0EH ; Undefined line number BS EQU 10H ; Bad subscript DD EQU 12H ; Re-DIMensioned array DZ EQU 14H ; Division by zero (/0) ID EQU 16H ; Illegal direct TM EQU 18H ; Type miss-match OS EQU 1AH ; Out of string space LS EQU 1CH ; String too long ST EQU 1EH ; String formula too complex CN EQU 20H ; Can't CONTinue UF EQU 22H ; UnDEFined FN function MO EQU 24H ; Missing operand ORG 0E000H START: JP STARTB ; Jump for restart jump STARTB: DI ; No interrupts LD IX,0 ; Flag cold start JP CSTART ; Jump to initialise DW DEINT ; Get integer -32768 to 32767 DW ABPASS ; Return integer in AB JP LDNMI1 ; << NO REFERENCE TO HERE >> CSTART: LD HL,WRKSPC ; Start of workspace RAM LD SP,HL ; Set up a temporary stack JP INITST ; Go to initialise INIT: LD DE,INITAB ; Initialise workspace LD B,INITBE-INITAB+3; Bytes to copy LD HL,WRKSPC ; Into workspace RAM COPY: LD A,(DE) ; Get source LD (HL),A ; To destination INC HL ; Next destination INC DE ; Next source DEC B ; Count bytes JP NZ,COPY ; More to move LD SP,HL ; Temporary stack CALL CLREG ; Clear registers and stack CALL PRNTCR ; Output CRLF LD (BUFFER+72+1),A ; Mark end of buffer LD (PROGST),A ; Initialise program area MSIZE: LD HL,MEMMSG ; Point to message CALL PRS ; Output "Memory size" CALL PROMPT ; Get input with "?" CALL GETCHR ; Get next character OR A ; Set flags JP NZ,TSTMEM ; If number - Test if RAM there LD HL,STLOOK ; Point to start of RAM MLOOP: INC HL ; Next byte LD A,H ; Above address FFFF ? OR L JP Z,SETTOP ; Yes - 64K RAM LD A,(HL) ; Get contents LD B,A ; Save it CPL ; Flip all bits LD (HL),A ; Put it back CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP Z,MLOOP ; If RAM - test next byte JP SETTOP ; Top of RAM found TSTMEM: CALL ATOH ; Get high memory into DE OR A ; Set flags on last byte JP NZ,SNERR ; ?SN Error if bad character EX DE,HL ; Address into HL DEC HL ; Back one byte LD A,11011001B ; Test byte LD B,(HL) ; Get old contents LD (HL),A ; Load test byte CP (HL) ; RAM there if same LD (HL),B ; Restore old contents JP NZ,MSIZE ; Ask again if no RAM SETTOP: DEC HL ; Back one byte LD DE,STLOOK-1 ; See if enough RAM CALL CPDEHL ; Compare DE with HL JP C,MSIZE ; Ask again if not enough RAM NOP NOP NOP NOP NOP NOP NOP NOP NOP LD DE,0-50 ; 50 Bytes string space LD (LSTRAM),HL ; Save last available RAM ADD HL,DE ; Allocate string space LD (STRSPC),HL ; Save string space CALL CLRPTR ; Clear program area LD HL,(STRSPC) ; Get end of memory LD DE,0-17 ; Offset for free bytes ADD HL,DE ; Adjust HL LD DE,PROGST ; Start of program text LD A,L ; Get LSB SUB E ; Adjust it LD L,A ; Re-save LD A,H ; Get MSB SBC A,D ; Adjust it LD H,A ; Re-save PUSH HL ; Save bytes free LD HL,SIGNON ; Sign-on message CALL PRS ; Output string POP HL ; Get bytes free back CALL PRNTHL ; Output amount of free memory LD HL,BFREE ; " Bytes free" message CALL PRS ; Output string WARMST: LD SP,STACK ; Temporary stack BRKRET: CALL CLREG ; Clear registers and stack JP PRNTOK ; Go to get command line BFREE: DB " Bytes free",CR,0,0 SIGNON: DB "NASCOM ROM BASIC Ver 4.7 ",CR DB "Copyright (C) 1978 by Microsoft",CR,0,0 MEMMSG: DB "Memory size",0 ; FUNCTION ADDRESS TABLE FNCTAB: DW SGN DW INT DW ABS DW USR DW FRE DW INP DW POS DW SQR DW RND DW LOG DW EXP DW COS DW SIN DW TAN DW ATN DW PEEK DW DEEK DW POINT DW LEN DW STR DW VAL DW ASC DW CHR DW LEFT DW RIGHT DW MID ; RESERVED WORD LIST WORDS: DB "E"+80H,"ND" DB "F"+80H,"OR" DB "N"+80H,"EXT" DB "D"+80H,"ATA" DB "I"+80H,"NPUT" DB "D"+80H,"IM" DB "R"+80H,"EAD" DB "L"+80H,"ET" DB "G"+80H,"OTO" DB "R"+80H,"UN" DB "I"+80H,"F" DB "R"+80H,"ESTORE" DB "G"+80H,"OSUB" DB "R"+80H,"ETURN" DB "R"+80H,"EM" DB "S"+80H,"TOP" DB "O"+80H,"UT" DB "O"+80H,"N" DB "N"+80H,"ULL" DB "W"+80H,"AIT" DB "D"+80H,"EF" DB "P"+80H,"OKE" DB "D"+80H,"OKE" DB "S"+80H,"CREEN" DB "L"+80H,"INES" DB "C"+80H,"LS" DB "W"+80H,"IDTH" DB "M"+80H,"ONITOR" DB "S"+80H,"ET" DB "R"+80H,"ESET" DB "P"+80H,"RINT" DB "C"+80H,"ONT" DB "L"+80H,"IST" DB "C"+80H,"LEAR" DB "C"+80H,"LOAD" DB "C"+80H,"SAVE" DB "N"+80H,"EW" DB "T"+80H,"AB(" DB "T"+80H,"O" DB "F"+80H,"N" DB "S"+80H,"PC(" DB "T"+80H,"HEN" DB "N"+80H,"OT" DB "S"+80H,"TEP" DB "+"+80H DB "-"+80H DB "*"+80H DB "/"+80H DB "^"+80H DB "A"+80H,"ND" DB "O"+80H,"R" DB ">"+80H DB "="+80H DB "<"+80H DB "S"+80H,"GN" DB "I"+80H,"NT" DB "A"+80H,"BS" DB "U"+80H,"SR" DB "F"+80H,"RE" DB "I"+80H,"NP" DB "P"+80H,"OS" DB "S"+80H,"QR" DB "R"+80H,"ND" DB "L"+80H,"OG" DB "E"+80H,"XP" DB "C"+80H,"OS" DB "S"+80H,"IN" DB "T"+80H,"AN" DB "A"+80H,"TN" DB "P"+80H,"EEK" DB "D"+80H,"EEK" DB "P"+80H,"OINT" DB "L"+80H,"EN" DB "S"+80H,"TR$" DB "V"+80H,"AL" DB "A"+80H,"SC" DB "C"+80H,"HR$" DB "L"+80H,"EFT$" DB "R"+80H,"IGHT$" DB "M"+80H,"ID$" DB 80H ; End of list marker ; KEYWORD ADDRESS TABLE WORDTB: DW PEND DW FOR DW NEXT DW DATA DW INPUT DW DIM DW READ DW LET DW GOTO DW RUN DW IF DW RESTOR DW GOSUB DW RETURN DW REM DW STOP DW POUT DW ON DW NULL DW WAIT DW DEF DW POKE DW DOKE DW SCREEN DW LINES DW CLS DW WIDTH DW MONITR DW PSET DW RESET DW PRINT DW CONT DW LIST DW CLEAR DW CLOAD DW CSAVE DW NEW ; RESERVED WORD TOKEN VALUES ZEND EQU 080H ; END ZFOR EQU 081H ; FOR ZDATA EQU 083H ; DATA ZGOTO EQU 088H ; GOTO ZGOSUB EQU 08CH ; GOSUB ZREM EQU 08EH ; REM ZPRINT EQU 09EH ; PRINT ZNEW EQU 0A4H ; NEW ZTAB EQU 0A5H ; TAB ZTO EQU 0A6H ; TO ZFN EQU 0A7H ; FN ZSPC EQU 0A8H ; SPC ZTHEN EQU 0A9H ; THEN ZNOT EQU 0AAH ; NOT ZSTEP EQU 0ABH ; STEP ZPLUS EQU 0ACH ; + ZMINUS EQU 0ADH ; - ZTIMES EQU 0AEH ; * ZDIV EQU 0AFH ; / ZOR EQU 0B2H ; OR ZGTR EQU 0B3H ; > ZEQUAL EQU 0B4H ; M ZLTH EQU 0B5H ; < ZSGN EQU 0B6H ; SGN ZPOINT EQU 0C7H ; POINT ZLEFT EQU 0CDH ; LEFT$ ; ARITHMETIC PRECEDENCE TABLE PRITAB: DB 79H ; Precedence value DW PADD ; FPREG = + FPREG DB 79H ; Precedence value DW PSUB ; FPREG = - FPREG DB 7CH ; Precedence value DW MULT ; PPREG = * FPREG DB 7CH ; Precedence value DW DIV ; FPREG = / FPREG DB 7FH ; Precedence value DW POWER ; FPREG = ^ FPREG DB 50H ; Precedence value DW PAND ; FPREG = AND FPREG DB 46H ; Precedence value DW POR ; FPREG = OR FPREG ; BASIC ERROR CODE LIST ERRORS: DB "NF" ; NEXT without FOR DB "SN" ; Syntax error DB "RG" ; RETURN without GOSUB DB "OD" ; Out of DATA DB "FC" ; Illegal function call DB "OV" ; Overflow error DB "OM" ; Out of memory DB "UL" ; Undefined line DB "BS" ; Bad subscript DB "DD" ; Re-DIMensioned array DB "/0" ; Division by zero DB "ID" ; Illegal direct DB "TM" ; Type mis-match DB "OS" ; Out of string space DB "LS" ; String too long DB "ST" ; String formula too complex DB "CN" ; Can't CONTinue DB "UF" ; Undefined FN function DB "MO" ; Missing operand ; INITIALISATION TABLE INITAB: JP WARMST ; Warm start jump JP FCERR ; "USR (X)" jump (Set to Error) OUT (0),A ; "OUT p,n" skeleton RET SUB 0 ; Division support routine LD L,A LD A,H SBC A,0 LD H,A LD A,B SBC A,0 LD B,A LD A,0 RET DB 0,0,0 ; Random number seed ; Table used by RND DB 035H,04AH,0CAH,099H ;-2.65145E+07 DB 039H,01CH,076H,098H ; 1.61291E+07 DB 022H,095H,0B3H,098H ;-1.17691E+07 DB 00AH,0DDH,047H,098H ; 1.30983E+07 DB 053H,0D1H,099H,099H ;-2-01612E+07 DB 00AH,01AH,09FH,098H ;-1.04269E+07 DB 065H,0BCH,0CDH,098H ;-1.34831E+07 DB 0D6H,077H,03EH,098H ; 1.24825E+07 DB 052H,0C7H,04FH,080H ; Last random number IN A,(0) ; INP (x) skeleton RET DB 1 ; POS (x) number (1) DB 47 ; Terminal width (47) DB 28 ; Width for commas (3 columns) DB 0 ; No nulls after input bytes DB 0 ; Output enabled (^O off) DW 5 ; Initial lines counter DW 5 ; Initial lines number DW 0 ; Array load/save check sum DB 0 ; Break not by NMI DB 0 ; Break flag JP TTYLIN ; Input reflection (set to TTY) JP POINTB ; POINT reflection unused JP SETB ; SET reflection JP RESETB ; RESET reflection DW STLOOK ; Temp string space DW -2 ; Current line number (cold) DW PROGST+1 ; Start of program text INITBE: ; END OF INITIALISATION TABLE ERRMSG: DB " Error",0 INMSG: DB " in ",0 ZERBYT EQU $-1 ; A zero byte OKMSG: DB "Ok",CR,0,0 BRKMSG: DB "Break",0 BAKSTK: LD HL,4 ; Look for "FOR" block with ADD HL,SP ; same index as specified LOKFOR: LD A,(HL) ; Get block ID INC HL ; Point to index address CP ZFOR ; Is it a "FOR" token RET NZ ; No - exit LD C,(HL) ; BC = Address of "FOR" index INC HL LD B,(HL) INC HL ; Point to sign of STEP PUSH HL ; Save pointer to sign LD L,C ; HL = address of "FOR" index LD H,B LD A,D ; See if an index was specified OR E ; DE = 0 if no index specified EX DE,HL ; Specified index into HL JP Z,INDFND ; Skip if no index given EX DE,HL ; Index back into DE CALL CPDEHL ; Compare index with one given INDFND: LD BC,16-3 ; Offset to next block POP HL ; Restore pointer to sign RET Z ; Return if block found ADD HL,BC ; Point to next block JP LOKFOR ; Keep on looking MOVUP: CALL ENFMEM ; See if enough memory MOVSTR: PUSH BC ; Save end of source EX (SP),HL ; Swap source and dest" end POP BC ; Get end of destination MOVLP: CALL CPDEHL ; See if list moved LD A,(HL) ; Get byte LD (BC),A ; Move it RET Z ; Exit if all done DEC BC ; Next byte to move to DEC HL ; Next byte to move JP MOVLP ; Loop until all bytes moved CHKSTK: PUSH HL ; Save code string address LD HL,(ARREND) ; Lowest free memory LD B,0 ; BC = Number of levels to test ADD HL,BC ; 2 Bytes for each level ADD HL,BC DB 3EH ; Skip "PUSH HL" ENFMEM: PUSH HL ; Save code string address LD A,LOW -48 ; 48 Bytes minimum RAM SUB L LD L,A LD A,HIGH -48 ; 48 Bytes minimum RAM SBC A,H JP C,OMERR ; Not enough - ?OM Error LD H,A ADD HL,SP ; Test if stack is overflowed POP HL ; Restore code string address RET C ; Return if enough mmory OMERR: LD E,OM ; ?OM Error JP ERROR DATSNR: LD HL,(DATLIN) ; Get line of current DATA item LD (LINEAT),HL ; Save as current line SNERR: LD E,SN ; ?SN Error DB 01H ; Skip "LD E,DZ" DZERR: LD E,DZ ; ?/0 Error DB 01H ; Skip "LD E,NF" NFERR: LD E,NF ; ?NF Error DB 01H ; Skip "LD E,DD" DDERR: LD E,DD ; ?DD Error DB 01H ; Skip "LD E,UF" UFERR: LD E,UF ; ?UF Error DB 01H ; Skip "LD E,OV OVERR: LD E,OV ; ?OV Error DB 01H ; Skip "LD E,TM" TMERR: LD E,TM ; ?TM Error ERROR: CALL CLREG ; Clear registers and stack LD (CTLOFG),A ; Enable output (A is 0) CALL STTLIN ; Start new line LD HL,ERRORS ; Point to error codes LD D,A ; D = 0 (A is 0) LD A,"?" CALL OUTC ; Output "?" ADD HL,DE ; Offset to correct error code LD A,(HL) ; First character CALL OUTC ; Output it CALL GETCHR ; Get next character CALL OUTC ; Output it LD HL,ERRMSG ; "Error" message ERRIN: CALL PRS ; Output message LD HL,(LINEAT) ; Get line of error LD DE,-2 ; Cold start error if -2 CALL CPDEHL ; See if cold start error JP Z,CSTART ; Cold start error - Restart LD A,H ; Was it a direct error? AND L ; Line = -1 if direct error INC A CALL NZ,LINEIN ; No - output line of error DB 3EH ; Skip "POP BC" POPNOK: POP BC ; Drop address in input buffer PRNTOK: XOR A ; Output "Ok" and get command LD (CTLOFG),A ; Enable output CALL STTLIN ; Start new line LD HL,OKMSG ; "Ok" message CALL PRS ; Output "Ok" GETCMD: LD HL,-1 ; Flag direct mode LD (LINEAT),HL ; Save as current line CALL GETLIN ; Get an input line JP C,GETCMD ; Get line again if break CALL GETCHR ; Get first character INC A ; Test if end of line DEC A ; Without affecting Carry JP Z,GETCMD ; Nothing entered - Get another PUSH AF ; Save Carry status CALL ATOH ; Get line number into DE PUSH DE ; Save line number CALL CRUNCH ; Tokenise rest of line LD B,A ; Length of tokenised line POP DE ; Restore line number POP AF ; Restore Carry JP NC,EXCUTE ; No line number - Direct mode PUSH DE ; Save line number PUSH BC ; Save length of tokenised line XOR A LD (LSTBIN),A ; Clear last byte input CALL GETCHR ; Get next character OR A ; Set flags PUSH AF ; And save them CALL SRCHLN ; Search for line number in DE JP C,LINFND ; Jump if line found POP AF ; Get status PUSH AF ; And re-save JP Z,ULERR ; Nothing after number - Error OR A ; Clear Carry LINFND: PUSH BC ; Save address of line in prog JP NC,INEWLN ; Line not found - Insert new EX DE,HL ; Next line address in DE LD HL,(PROGND) ; End of program SFTPRG: LD A,(DE) ; Shift rest of program down LD (BC),A INC BC ; Next destination INC DE ; Next source CALL CPDEHL ; All done? JP NZ,SFTPRG ; More to do LD H,B ; HL - New end of program LD L,C LD (PROGND),HL ; Update end of program INEWLN: POP DE ; Get address of line, POP AF ; Get status JP Z,SETPTR ; No text - Set up pointers LD HL,(PROGND) ; Get end of program EX (SP),HL ; Get length of input line POP BC ; End of program to BC ADD HL,BC ; Find new end PUSH HL ; Save new end CALL MOVUP ; Make space for line POP HL ; Restore new end LD (PROGND),HL ; Update end of program pointer EX DE,HL ; Get line to move up in HL LD (HL),H ; Save MSB POP DE ; Get new line number INC HL ; Skip pointer INC HL LD (HL),E ; Save LSB of line number INC HL LD (HL),D ; Save MSB of line number INC HL ; To first byte in line LD DE,BUFFER ; Copy buffer to program MOVBUF: LD A,(DE) ; Get source LD (HL),A ; Save destinations INC HL ; Next source INC DE ; Next destination OR A ; Done? JP NZ,MOVBUF ; No - Repeat SETPTR: CALL RUNFST ; Set line pointers INC HL ; To LSB of pointer EX DE,HL ; Address to DE PTRLP: LD H,D ; Address to HL LD L,E LD A,(HL) ; Get LSB of pointer INC HL ; To MSB of pointer OR (HL) ; Compare with MSB pointer JP Z,GETCMD ; Get command line if end INC HL ; To LSB of line number INC HL ; Skip line number INC HL ; Point to first byte in line XOR A ; Looking for 00 byte FNDEND: CP (HL) ; Found end of line? INC HL ; Move to next byte JP NZ,FNDEND ; No - Keep looking EX DE,HL ; Next line address to HL LD (HL),E ; Save LSB of pointer INC HL LD (HL),D ; Save MSB of pointer JP PTRLP ; Do next line SRCHLN: LD HL,(BASTXT) ; Start of program text SRCHLP: LD B,H ; BC = Address to look at LD C,L LD A,(HL) ; Get address of next line INC HL OR (HL) ; End of program found? DEC HL RET Z ; Yes - Line not found INC HL INC HL LD A,(HL) ; Get LSB of line number INC HL LD H,(HL) ; Get MSB of line number LD L,A CALL CPDEHL ; Compare with line in DE LD H,B ; HL = Start of this line LD L,C LD A,(HL) ; Get LSB of next line address INC HL LD H,(HL) ; Get MSB of next line address LD L,A ; Next line to HL CCF RET Z ; Lines found - Exit CCF RET NC ; Line not found,at line after JP SRCHLP ; Keep looking NEW: RET NZ ; Return if any more on line CLRPTR: LD HL,(BASTXT) ; Point to start of program XOR A ; Set program area to empty LD (HL),A ; Save LSB = 00 INC HL LD (HL),A ; Save MSB = 00 INC HL LD (PROGND),HL ; Set program end RUNFST: LD HL,(BASTXT) ; Clear all variables DEC HL INTVAR: LD (BRKLIN),HL ; Initialise RUN variables LD HL,(LSTRAM) ; Get end of RAM LD (STRBOT),HL ; Clear string space XOR A CALL RESTOR ; Reset DATA pointers LD HL,(PROGND) ; Get end of program LD (VAREND),HL ; Clear variables LD (ARREND),HL ; Clear arrays CLREG: POP BC ; Save return address LD HL,(STRSPC) ; Get end of working RAN LD SP,HL ; Set stack LD HL,TMSTPL ; Temporary string pool LD (TMSTPT),HL ; Reset temporary string ptr XOR A ; A = 00 LD L,A ; HL = 0000 LD H,A LD (CONTAD),HL ; No CONTinue LD (FORFLG),A ; Clear FOR flag LD (FNRGNM),HL ; Clear FN argument PUSH HL ; HL = 0000 PUSH BC ; Put back return DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN RET ; Return to execution driver PROMPT: LD A,"?" ; "?" CALL OUTC ; Output character LD A," " ; Space CALL OUTC ; Output character JP RINPUT ; Get input line CRUNCH: XOR A ; Tokenise line @ HL to BUFFER LD (DATFLG),A ; Reset literal flag LD C,2+3 ; 2 byte number and 3 nulls LD DE,BUFFER ; Start of input buffer CRNCLP: LD A,(HL) ; Get byte CP " " ; Is it a space? JP Z,MOVDIR ; Yes - Copy direct LD B,A ; Save character CP '"' ; Is it a quote? JP Z,CPYLIT ; Yes - Copy literal string OR A ; Is it end of buffer? JP Z,ENDBUF ; Yes - End buffer LD A,(DATFLG) ; Get data type OR A ; Literal? LD A,(HL) ; Get byte to copy JP NZ,MOVDIR ; Literal - Copy direct CP "?" ; Is it "?" short for PRINT LD A,ZPRINT ; "PRINT" token JP Z,MOVDIR ; Yes - replace it LD A,(HL) ; Get byte again CP "0" ; Is it less than "0" JP C,FNDWRD ; Yes - Look for reserved words CP ";"+1 ; Is it "0123456789:;" ? JP C,MOVDIR ; Yes - copy it direct FNDWRD: PUSH DE ; Look for reserved words LD DE,WORDS-1 ; Point to table PUSH BC ; Save count LD BC,RETNAD ; Where to return to PUSH BC ; Save return address LD B,ZEND-1 ; First token value -1 LD A,(HL) ; Get byte CP "a" ; Less than "a" ? JP C,SEARCH ; Yes - search for words CP "z"+1 ; Greater than "z" ? JP NC,SEARCH ; Yes - search for words AND 01011111B ; Force upper case LD (HL),A ; Replace byte SEARCH: LD C,(HL) ; Search for a word EX DE,HL GETNXT: INC HL ; Get next reserved word OR (HL) ; Start of word? JP P,GETNXT ; No - move on INC B ; Increment token value LD A, (HL) ; Get byte from table AND 01111111B ; Strip bit 7 RET Z ; Return if end of list CP C ; Same character as in buffer? JP NZ,GETNXT ; No - get next word EX DE,HL PUSH HL ; Save start of word NXTBYT: INC DE ; Look through rest of word LD A,(DE) ; Get byte from table OR A ; End of word ? JP M,MATCH ; Yes - Match found LD C,A ; Save it LD A,B ; Get token value CP ZGOTO ; Is it "GOTO" token ? JP NZ,NOSPC ; No - Don't allow spaces CALL GETCHR ; Get next character DEC HL ; Cancel increment from GETCHR NOSPC: INC HL ; Next byte LD A,(HL) ; Get byte CP "a" ; Less than "a" ? JP C,NOCHNG ; Yes - don't change AND 01011111B ; Make upper case NOCHNG: CP C ; Same as in buffer ? JP Z,NXTBYT ; Yes - keep testing POP HL ; Get back start of word JP SEARCH ; Look at next word MATCH: LD C,B ; Word found - Save token value POP AF ; Throw away return EX DE,HL RET ; Return to "RETNAD" RETNAD: EX DE,HL ; Get address in string LD A,C ; Get token value POP BC ; Restore buffer length POP DE ; Get destination address MOVDIR: INC HL ; Next source in buffer LD (DE),A ; Put byte in buffer INC DE ; Move up buffer INC C ; Increment length of buffer SUB ":" ; End of statement? JP Z,SETLIT ; Jump if multi-statement line CP ZDATA-3AH ; Is it DATA statement ? JP NZ,TSTREM ; No - see if REM SETLIT: LD (DATFLG),A ; Set literal flag TSTREM: SUB ZREM-3AH ; Is it REM? JP NZ,CRNCLP ; No - Leave flag LD B,A ; Copy rest of buffer NXTCHR: LD A,(HL) ; Get byte OR A ; End of line ? JP Z,ENDBUF ; Yes - Terminate buffer CP B ; End of statement ? JP Z,MOVDIR ; Yes - Get next one CPYLIT: INC HL ; Move up source string LD (DE),A ; Save in destination INC C ; Increment length INC DE ; Move up destination JP NXTCHR ; Repeat ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer LD (DE),A ; Mark end of buffer (A = 00) INC DE LD (DE),A ; A = 00 INC DE LD (DE),A ; A = 00 RET DODEL: LD A,(NULFLG) ; Get null flag status OR A ; Is it zero? LD A,0 ; Zero A - Leave flags LD (NULFLG),A ; Zero null flag JP NZ,ECHDEL ; Set - Echo it DEC B ; Decrement length JP Z,GETLIN ; Get line again if empty CALL OUTC ; Output null character DB 3EH ; Skip "DEC B" ECHDEL: DEC B ; Count bytes in buffer DEC HL ; Back space buffer JP Z,OTKLN ; No buffer - Try again LD A,(HL) ; Get deleted byte CALL OUTC ; Echo it JP MORINP ; Get more input DELCHR: DEC B ; Count bytes in buffer DEC HL ; Back space buffer CALL OUTC ; Output character in A JP NZ,MORINP ; Not end - Get more OTKLN: CALL OUTC ; Output character in A KILIN: CALL PRNTCR ; Output CRLF JP TTYLIN ; Get line again GETLIN: CALL MONTST ; Is it NAS-SYS? JP Z,TTYLIN ; No - Character input LD HL,(CIN) ; Point to NAS-SYS input table LD A,(HL) ; Get input mode CP 74H ; Is it "X" mode? JP Z,TTYLIN ; Yes - Teletype line input CALL INLINE ; Get a line from NAS-SYS JP DONULL ; POS(X)=0 and do nulls TTYLIN: LD HL,BUFFER ; Get a line by character LD B,1 ; Set buffer as empty XOR A LD (NULFLG),A ; Clear null flag MORINP: CALL CLOTST ; Get character and test ^O LD C,A ; Save character in C CP DEL ; Delete character? JP Z,DODEL ; Yes - Process it LD A,(NULFLG) ; Get null flag OR A ; Test null flag status JP Z,PROCES ; Reset - Process character LD A,0 ; Set a null CALL OUTC ; Output null XOR A ; Clear A LD (NULFLG),A ; Reset null flag PROCES: LD A,C ; Get character CP CTRLG ; Bell? JP Z,PUTCTL ; Yes - Save it CP CTRLC ; Is it control "C"? CALL Z,PRNTCR ; Yes - Output CRLF SCF ; Flag break RET Z ; Return if control "C" CP CR ; Is it enter? JP Z,ENDINP ; Yes - Terminate input CP CTRLU ; Is it control "U"? JP Z,KILIN ; Yes - Get another line CP "@" ; Is it "kill line"? JP Z,OTKLN ; Yes - Kill line CP "_" ; Is it delete? JP Z,DELCHR ; Yes - Delete character CP BKSP ; Is it backspace? JP Z,DELCHR ; Yes - Delete character CP CTRLR ; Is it control "R"? JP NZ,PUTBUF ; No - Put in buffer PUSH BC ; Save buffer length PUSH DE ; Save DE PUSH HL ; Save buffer address LD (HL),0 ; Mark end of buffer CALL OUTNCR ; Output and do CRLF LD HL,BUFFER ; Point to buffer start CALL PRS ; Output buffer POP HL ; Restore buffer address POP DE ; Restore DE POP BC ; Restore buffer length JP MORINP ; Get another character PUTBUF: CP " " ; Is it a control code? JP C,MORINP ; Yes - Ignore PUTCTL: LD A,B ; Get number of bytes in buffer CP 72+1 ; Test for line overflow LD A,CTRLG ; Set a bell JP NC,OUTNBS ; Ring bell if buffer full LD A,C ; Get character LD (HL),C ; Save in buffer LD (LSTBIN),A ; Save last input byte INC HL ; Move up buffer INC B ; Increment length OUTIT: CALL OUTC ; Output the character entered JP MORINP ; Get another character OUTNBS: CALL OUTC ; Output bell and back over it LD A,BKSP ; Set back space JP OUTIT ; Output it and get more CPDEHL: LD A,H ; Get H SUB D ; Compare with D RET NZ ; Different - Exit LD A,L ; Get L SUB E ; Compare with E RET ; Return status CHKSYN: LD A,(HL) ; Check syntax of character EX (SP),HL ; Address of test byte CP (HL) ; Same as in code string? INC HL ; Return address EX (SP),HL ; Put it back JP Z,GETCHR ; Yes - Get next character JP SNERR ; Different - ?SN Error OUTC: PUSH AF ; Save character LD A,(CTLOFG) ; Get control "O" flag OR A ; Is it set? JP NZ,POPAF ; Yes - don't output POP AF ; Restore character PUSH BC ; Save buffer length PUSH AF ; Save character CP " " ; Is it a control code? JP C,DINPOS ; Yes - Don't INC POS(X) LD A,(LWIDTH) ; Get line width LD B,A ; To B LD A,(CURPOS) ; Get cursor position INC B ; Width 255? JP Z,INCLEN ; Yes - No width limit DEC B ; Restore width CP B ; At end of line? CALL Z,PRNTCR ; Yes - output CRLF INCLEN: INC A ; Move on one character LD (CURPOS),A ; Save new position DINPOS: POP AF ; Restore character POP BC ; Restore buffer length PUSH AF ; << This sequence >> POP AF ; << is not needed >> PUSH AF ; Save character PUSH BC ; Save buffer length LD C,A ; Character to C CALL CONMON ; Send it POP BC ; Restore buffer length POP AF ; Restore character RET CLOTST: CALL GETINP ; Get input character AND 01111111B ; Strip bit 7 CP CTRLO ; Is it control "O"? RET NZ ; No don't flip flag LD A,(CTLOFG) ; Get flag CPL ; Flip it LD (CTLOFG),A ; Put it back XOR A ; Null character RET LIST: CALL ATOH ; ASCII number to DE RET NZ ; Return if anything extra POP BC ; Rubbish - Not needed CALL SRCHLN ; Search for line number in DE PUSH BC ; Save address of line CALL SETLIN ; Set up lines counter LISTLP: POP HL ; Restore address of line LD C,(HL) ; Get LSB of next line INC HL LD B,(HL) ; Get MSB of next line INC HL LD A,B ; BC = 0 (End of program)? OR C JP Z,PRNTOK ; Yes - Go to command mode CALL COUNT ; Count lines CALL TSTBRK ; Test for break key PUSH BC ; Save address of next line CALL PRNTCR ; Output CRLF LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number INC HL PUSH HL ; Save address of line start EX DE,HL ; Line number to HL CALL PRNTHL ; Output line number in decimal LD A," " ; Space after line number POP HL ; Restore start of line address LSTLP2: CALL OUTC ; Output character in A LSTLP3: LD A,(HL) ; Get next byte in line OR A ; End of line? INC HL ; To next byte in line JP Z,LISTLP ; Yes - get next line JP P,LSTLP2 ; No token - output it SUB ZEND-1 ; Find and output word LD C,A ; Token offset+1 to C LD DE,WORDS ; Reserved word list FNDTOK: LD A,(DE) ; Get character in list INC DE ; Move on to next OR A ; Is it start of word? JP P,FNDTOK ; No - Keep looking for word DEC C ; Count words JP NZ,FNDTOK ; Not there - keep looking OUTWRD: AND 01111111B ; Strip bit 7 CALL OUTC ; Output first character LD A,(DE) ; Get next character INC DE ; Move on to next OR A ; Is it end of word? JP P,OUTWRD ; No - output the rest JP LSTLP3 ; Next byte in line SETLIN: PUSH HL ; Set up LINES counter LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Save in LINES counter POP HL RET LDNMI1: LD HL,BREAK ; Break routine LD (NMI),HL ; NMI forces break JP PRNTOK ; Go to command mode DB 0FEH ; <<< NO REFERENCE TO HERE >>> COUNT: PUSH HL ; Save code string address PUSH DE LD HL,(LINESC) ; Get LINES counter LD DE,-1 ADC HL,DE ; Decrement LD (LINESC),HL ; Put it back POP DE POP HL ; Restore code string address RET P ; Return if more lines to go PUSH HL ; Save code string address LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter LD A,(NMIFLG) ; Break by NMI? OR A JP NZ,ARETN ; Yes - "RETN" CALL GETINP ; Get input character CP CTRLC ; Is it control "C"? JP Z,RSLNBK ; Yes - Reset LINES an break POP HL ; Restore code string address JP COUNT ; Keep on counting RSLNBK: LD HL,(LINESN) ; Get LINES number LD (LINESC),HL ; Reset LINES counter JP BRKRET ; Go and output "Break" FOR: LD A,64H ; Flag "FOR" assignment LD (FORFLG),A ; Save "FOR" flag CALL LET ; Set up initial index POP BC ; Drop RETurn address PUSH HL ; Save code string address CALL DATA ; Get next statement address LD (LOOPST),HL ; Save it for start of lo6p LD HL,2 ; Offset for "FOR" block ADD HL,SP ; Point to it FORSLP: CALL LOKFOR ; Look for existing "FOR" block POP DE ; Get code string address JP NZ,FORFND ; No nesting found ADD HL,BC ; Move into "FOR" block PUSH DE ; Save code string address DEC HL LD D,(HL) ; Get MSB of loop statement DEC HL LD E,(HL) ; Get LSB of loop statement INC HL INC HL PUSH HL ; Save block address LD HL,(LOOPST) ; Get address of loop statement CALL CPDEHL ; Compare the FOR loops POP HL ; Restore block address JP NZ,FORSLP ; Different FORs - Find another POP DE ; Restore code string address LD SP,HL ; Remove all nested loops FORFND: EX DE,HL ; Code string address to HL LD C,8 CALL CHKSTK ; Check for 8 levels of stack PUSH HL ; Save code string address LD HL,(LOOPST) ; Get first statement of loop EX (SP),HL ; Save and restore code string PUSH HL ; Re-save code string address LD HL,(LINEAT) ; Get current line number EX (SP),HL ; Save and restore code string CALL TSTNUM ; Make sure it's a number CALL CHKSYN ; Make sure "TO" is next DB ZTO ; "TO" token CALL GETNUM ; Get "TO" expression value PUSH HL ; Save code string address CALL BCDEFP ; Move "TO" value to BCDE POP HL ; Restore code string address PUSH BC ; Save "TO" value in block PUSH DE LD BC,8100H ; BCDE - 1 (default STEP) LD D,C ; C=0 LD E,D ; D=0 LD A,(HL) ; Get next byte in code string CP ZSTEP ; See if "STEP" is stated LD A,1 ; Sign of step = 1 JP NZ,SAVSTP ; No STEP given - Default to 1 CALL GETCHR ; Jump over "STEP" token CALL GETNUM ; Get step value PUSH HL ; Save code string address CALL BCDEFP ; Move STEP to BCDE CALL TSTSGN ; Test sign of FPREG POP HL ; Restore code string address SAVSTP: PUSH BC ; Save the STEP value in block PUSH DE PUSH AF ; Save sign of STEP INC SP ; Don't save flags PUSH HL ; Save code string address LD HL,(BRKLIN) ; Get address of index variable EX (SP),HL ; Save and restore code string PUTFID: LD B,ZFOR ; "FOR" block marker PUSH BC ; Save it INC SP ; Don't save C RUNCNT: CALL CHKBRK ; Execution driver - Test break OR A ; Break key hit? CALL NZ,STALL ; Yes - Pause for a key LD (BRKLIN),HL ; Save code address for break LD A,(HL) ; Get next byte in code string CP ":" ; Multi statement line? JP Z,EXCUTE ; Yes - Execute it OR A ; End of line? JP NZ,SNERR ; No - Syntax error INC HL ; Point to address of next line LD A,(HL) ; Get LSB of line pointer INC HL OR (HL) ; Is it zero (End of prog)? JP Z,ENDPRG ; Yes - Terminate execution INC HL ; Point to line number LD E,(HL) ; Get LSB of line number INC HL LD D,(HL) ; Get MSB of line number EX DE,HL ; Line number to HL LD (LINEAT),HL ; Save as current line number EX DE,HL ; Line number back to DE EXCUTE: CALL GETCHR ; Get key word LD DE,RUNCNT ; Where to RETurn to PUSH DE ; Save for RETurn IFJMP: RET Z ; Go to RUNCNT if end of STMT ONJMP: SUB ZEND ; Is it a token? JP C,LET ; No - try to assign it CP ZNEW+1-ZEND ; END to NEW ? JP NC,SNERR ; Not a key word - ?SN Error RLCA ; Double it LD C,A ; BC = Offset into table LD B,0 EX DE,HL ; Save code string address LD HL,WORDTB ; Keyword address table ADD HL,BC ; Point to routine address LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address PUSH BC ; Save routine address EX DE,HL ; Restore code string address GETCHR: INC HL ; Point to next character LD A,(HL) ; Get next code string byte CP ":" ; Z if ":" RET NC ; NC if > "9" CP " " JP Z,GETCHR ; Skip over spaces CP "0" CCF ; NC if < "0" INC A ; Test for zero - Leave carry DEC A ; Z if Null RET RESTOR: EX DE,HL ; Save code string address LD HL,(BASTXT) ; Point to start of program JP Z,RESTNL ; Just RESTORE - reset pointer EX DE,HL ; Restore code string address CALL ATOH ; Get line number to DE PUSH HL ; Save code string address CALL SRCHLN ; Search for line number in DE LD H,B ; HL = Address of line LD L,C POP DE ; Restore code string address JP NC,ULERR ; ?UL Error if not found RESTNL: DEC HL ; Byte before DATA statement UPDATA: LD (NXTDAT),HL ; Update DATA pointer EX DE,HL ; Restore code string address RET TSTBRK: CALL CHKBRK ; Test for interrupts OR A RET Z ; Return if no key pressed STALL: CALL CLOTST ; Get input and test for ^O CP CTRLS ; Is it control "S" CALL Z,CLOTST ; Yes - Get another character CP CTRLC ; Return if not control "C" STOP: RET NZ ; Exit if anything else DB 0F6H ; Flag "STOP" PEND: RET NZ ; Exit if anything else LD (BRKLIN),HL ; Save point of break DB 21H ; Skip "OR 11111111B" INPBRK: OR 11111111B ; Flag "Break" wanted POP BC ; Return not needed and more ENDPRG: LD HL,(LINEAT) ; Get current line number PUSH AF ; Save STOP / END status LD A,L ; Is it direct break? AND H INC A ; Line is -1 if direct break JP Z,NOLIN ; Yes - No line number LD (ERRLIN),HL ; Save line of break LD HL,(BRKLIN) ; Get point of break LD (CONTAD),HL ; Save point to CONTinue NOLIN: XOR A LD (CTLOFG),A ; Enable output CALL STTLIN ; Start a new line POP AF ; Restore STOP / END status LD HL,BRKMSG ; "Break" message JP NZ,ERRIN ; "in line" wanted? JP PRNTOK ; Go to command mode CONT: LD HL,(CONTAD) ; Get CONTinue address LD A,H ; Is it zero? OR L LD E,CN ; ?CN Error JP Z,ERROR ; Yes - output "?CN Error" EX DE,HL ; Save code string address LD HL,(ERRLIN) ; Get line of last break LD (LINEAT),HL ; Set up current line number EX DE,HL ; Restore code string address RET ; CONTinue where left off NULL: CALL GETINT ; Get integer 0-255 RET NZ ; Return if bad value LD (NULLS),A ; Set nulls number RET ARRLD1: LD B,-1 ; Flag array load ARRSV1: CALL GETCHR ; Skip "*" LD A,B ; CLOAD* or CSAVE* LD (BRKLIN),A ; Save it LD A,1 ; It's an array LD (FORFLG),A ; Flag array name CALL GETVAR ; Get address of array name PUSH HL ; Save code string address LD (FORFLG),A ; Clear flag LD H,B ; Address of array to HL LD L,C DEC BC ; Back space DEC BC ; to point DEC BC ; to the DEC BC ; array name LD A,(BRKLIN) ; CLOAD* or CSAVE* ? OR A PUSH AF ; Save CLOAD* / CSAVE* status EX DE,HL ; Array data length ADD HL,DE ; End of data EX DE,HL ; To DE LD C,(HL) ; Get dimension bytes LD B,0 ADD HL,BC ; 2 Bytes each dimension ADD HL,BC INC HL ; Over number of dimensions PUSH HL ; Address of array data PUSH DE ; End of array data PUSH BC ; Number of dimensions LD A,(BRKLIN) ; CLOAD* or CSAVE* ? CP -1 CALL Z,CASFF ; CLOAD* - Cassette on LD A,(BRKLIN) ; CLOAD* or CSAVE* ? CP -1 CALL NZ,CASFFW ; CSAVE* - Cassette on and wait NOP NOP NOP LD HL,0 LD (CHKSUM),HL ; Zero check sum POP BC ; Number of dimensions POP DE ; End of array data POP HL ; Address of array data LD B,11010010B ; Header byte JP JPLDSV ; CSAVE-SNDHDR , CLOAD-GETHDR SNDHDR: LD A,B ; Get header byte CALL WUART2 ; Send 2 bytes to UART CALL WUART2 ; Send 2 bytes to UART JP SNDARY ; Send array data GETHDR: LD C,4 ; 4 Bytes to check HDRLP: CALL RUART ; Read byte from UART CP B ; Same as header? JP NZ,GETHDR ; No - Wait for another DEC C ; Count bytes JP NZ,HDRLP ; More needed SNDARY: CALL TSTNUM ; Check it's a numerical array ARYLP: CALL CPDEHL ; All array data done JP Z,SUMOFF ; Yes - Do check sum POP AF ; CLOAD* or CSAVE* ? PUSH AF ; Re-save flags LD A,(HL) ; Get byte CALL P,WUART ; CSAVE* - Write byte CALL M,RUART ; CLOAD* - Read byte LD (HL),A ; Save byte in case of CLOAD* CALL ACCSUM ; Accumulate check sum INC HL ; Next byte JP ARYLP ; Repeat SUMOFF: CALL DOSUM ; Do check sum CALL CASFF ; Cassette off POP AF ; Not needed any more POP HL ; Restore code string address RET ACCSUM: PUSH HL ; Save address in array LD HL,(CHKSUM) ; Get check sum LD B,0 ; BC - Value of byte LD C,A ADD HL,BC ; Add byte to check sum LD (CHKSUM),HL ; Re-save check sum POP HL ; Restore address in array RET DOSUM: LD A,(BRKLIN) ; CLOAD* or CSAVE* ? OR A JP M,CHSUMS ; CLOAD* - Check if sums match LD A,(CHKSUM) ; Get LSB of check sum CALL WUART ; Write to UART LD A,(CHKSUM+1) ; Get MSB of check sum JP WUART ; Write to UART and return CHSUMS: CALL RUART ; Read LSB of check sum PUSH AF ; Save it CALL RUART ; Read MSB of check sum POP BC ; LSB to B LD E,B ; LSB to E LD D,A ; MSB to D LD HL,(CHKSUM) ; Get accumulated check sum CALL CPDEHL ; Are they the same? RET Z ; Yes - End CLOAD* CALL CASFF ; Cassette off JP OUTBAD ; Different - Output "Bad" CHKLTR: LD A,(HL) ; Get byte CP "A" ; < "A" ? RET C ; Carry set if not letter CP "Z"+1 ; > "Z" ? CCF RET ; Carry set if not letter FPSINT: CALL GETCHR ; Get next character POSINT: CALL GETNUM ; Get integer 0 to 32767 DEPINT: CALL TSTSGN ; Test sign of FPREG JP M,FCERR ; Negative - ?FC Error DEINT: LD A,(FPEXP) ; Get integer value to DE CP 80H+16 ; Exponent in range (16 bits)? JP C,FPINT ; Yes - convert it LD BC,9080H ; BCDE = -32768 LD DE,0000 PUSH HL ; Save code string address CALL CMPNUM ; Compare FPREG with BCDE POP HL ; Restore code string address LD D,C ; MSB to D RET Z ; Return if in range FCERR: LD E,FC ; ?FC Error JP ERROR ; Output error- ATOH: DEC HL ; ASCII number to DE binary GETLN: LD DE,0 ; Get number to DE GTLNLP: CALL GETCHR ; Get next character RET NC ; Exit if not a digit PUSH HL ; Save code string address PUSH AF ; Save digit LD HL,65529/10 ; Largest number 65529 CALL CPDEHL ; Number in range? JP C,SNERR ; No - ?SN Error LD H,D ; HL = Number LD L,E ADD HL,DE ; Times 2 ADD HL,HL ; Times 4 ADD HL,DE ; Times 5 ADD HL,HL ; Times 10 POP AF ; Restore digit SUB "0" ; Make it 0 to 9 LD E,A ; DE = Value of digit LD D,0 ADD HL,DE ; Add to number EX DE,HL ; Number to DE POP HL ; Restore code string address JP GTLNLP ; Go to next character CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters CALL POSINT ; Get integer 0 to 32767 to DE DEC HL ; Cancel increment CALL GETCHR ; Get next character PUSH HL ; Save code string address LD HL,(LSTRAM) ; Get end of RAM JP Z,STORED ; No value given - Use stored POP HL ; Restore code string address CALL CHKSYN ; Check for comma DB "," PUSH DE ; Save number CALL POSINT ; Get integer 0 to 32767 DEC HL ; Cancel increment CALL GETCHR ; Get next character JP NZ,SNERR ; ?SN Error if more on line EX (SP),HL ; Save code string address EX DE,HL ; Number to DE STORED: LD A,L ; Get LSB of new RAM top SUB E ; Subtract LSB of string space LD E,A ; Save LSB LD A,H ; Get MSB of new RAM top SBC A,D ; Subtract MSB of string space LD D,A ; Save MSB JP C,OMERR ; ?OM Error if not enough mem PUSH HL ; Save RAM top LD HL,(PROGND) ; Get program end LD BC,40 ; 40 Bytes minimum working RAM ADD HL,BC ; Get lowest address CALL CPDEHL ; Enough memory? JP NC,OMERR ; No - ?OM Error EX DE,HL ; RAM top to HL LD (STRSPC),HL ; Set new string space POP HL ; End of memory to use LD (LSTRAM),HL ; Set new top of RAM POP HL ; Restore code string address JP INTVAR ; Initialise variables RUN: JP Z,RUNFST ; RUN from start if just RUN CALL INTVAR ; Initialise variables LD BC,RUNCNT ; Execution driver loop JP RUNLIN ; RUN from line number GOSUB: LD C,3 ; 3 Levels of stack needed CALL CHKSTK ; Check for 3 levels of stack POP BC ; Get return address PUSH HL ; Save code string for RETURN PUSH HL ; And for GOSUB routine LD HL,(LINEAT) ; Get current line EX (SP),HL ; Into stack - Code string out LD A,ZGOSUB ; "GOSUB" token PUSH AF ; Save token INC SP ; Don't save flags RUNLIN: PUSH BC ; Save return address GOTO: CALL ATOH ; ASCII number to DE binary CALL REM ; Get end of line PUSH HL ; Save end of line LD HL,(LINEAT) ; Get current line CALL CPDEHL ; Line after current? POP HL ; Restore end of line INC HL ; Start of next line CALL C,SRCHLP ; Line is after current line CALL NC,SRCHLN ; Line is before current line LD H,B ; Set up code string address LD L,C DEC HL ; Incremented after RET C ; Line found ULERR: LD E,UL ; ?UL Error JP ERROR ; Output error message RETURN: RET NZ ; Return if not just RETURN LD D,-1 ; Flag "GOSUB" search CALL BAKSTK ; Look "GOSUB" block LD SP,HL ; Kill all FORs in subroutine CP ZGOSUB ; Test for "GOSUB" token LD E,RG ; ?RG Error JP NZ,ERROR ; Error if no "GOSUB" found POP HL ; Get RETURN line number LD (LINEAT),HL ; Save as current INC HL ; Was it from direct statement? LD A,H OR L ; Return to line JP NZ,RETLIN ; No - Return to line LD A,(LSTBIN) ; Any INPUT in subroutine? OR A ; If so buffer is corrupted JP NZ,POPNOK ; Yes - Go to command mode RETLIN: LD HL,RUNCNT ; Execution driver loop EX (SP),HL ; Into stack - Code string out DB 3EH ; Skip "POP HL" NXTDTA: POP HL ; Restore code string address DATA: DB 01H,3AH ; ":" End of statement REM: LD C,0 ; 00 End of statement LD B,0 NXTSTL: LD A,C ; Statement and byte LD C,B LD B,A ; Statement end byte NXTSTT: LD A,(HL) ; Get byte OR A ; End of line? RET Z ; Yes - Exit CP B ; End of statement? RET Z ; Yes - Exit INC HL ; Next byte CP '"' ; Literal string? JP Z,NXTSTL ; Yes - Look for another '"' JP NXTSTT ; Keep looking LET: CALL GETVAR ; Get variable name CALL CHKSYN ; Make sure "=" follows DB ZEQUAL ; "=" token PUSH DE ; Save address of variable LD A,(TYPE) ; Get data type PUSH AF ; Save type CALL EVAL ; Evaluate expression POP AF ; Restore type EX (SP),HL ; Save code - Get var addr LD (BRKLIN),HL ; Save address of variable RRA ; Adjust type CALL CHKTYP ; Check types are the same JP Z,LETNUM ; Numeric - Move value LETSTR: PUSH HL ; Save address of string var LD HL,(FPREG) ; Pointer to string entry PUSH HL ; Save it on stack INC HL ; Skip over length INC HL LD E,(HL) ; LSB of string address INC HL LD D,(HL) ; MSB of string address LD HL,(BASTXT) ; Point to start of program CALL CPDEHL ; Is string before program? JP NC,CRESTR ; Yes - Create string entry LD HL,(STRSPC) ; Point to string space CALL CPDEHL ; Is string literal in program? POP DE ; Restore address of string JP NC,MVSTPT ; Yes - Set up pointer LD HL,TMPSTR ; Temporary string pool CALL CPDEHL ; Is string in temporary pool? JP NC,MVSTPT ; No - Set up pointer DB 3EH ; Skip "POP DE" CRESTR: POP DE ; Restore address of string CALL BAKTMP ; Back to last tmp-str entry EX DE,HL ; Address of string entry CALL SAVSTR ; Save string in string area MVSTPT: CALL BAKTMP ; Back to last tmp-str entry POP HL ; Get string pointer CALL DETHL4 ; Move string pointer to var POP HL ; Restore code string address RET LETNUM: PUSH HL ; Save address of variable CALL FPTHL ; Move value to variable POP DE ; Restore address of variable POP HL ; Restore code string address RET ON: CALL GETINT ; Get integer 0-255 LD A,(HL) ; Get "GOTO" or "GOSUB" token LD B,A ; Save in B CP ZGOSUB ; "GOSUB" token? JP Z,ONGO ; Yes - Find line number CALL CHKSYN ; Make sure it's "GOTO" DB ZGOTO ; "GOTO" token DEC HL ; Cancel increment ONGO: LD C,E ; Integer of branch value ONGOLP: DEC C ; Count branches LD A,B ; Get "GOTO" or "GOSUB" token JP Z,ONJMP ; Go to that line if right one CALL GETLN ; Get line number to DE CP "," ; Another line number? RET NZ ; No - Drop through JP ONGOLP ; Yes - loop IF: CALL EVAL ; Evaluate expression LD A,(HL) ; Get token CP ZGOTO ; "GOTO" token? JP Z,IFGO ; Yes - Get line CALL CHKSYN ; Make sure it's "THEN" DB ZTHEN ; "THEN" token DEC HL ; Cancel increment IFGO: CALL TSTNUM ; Make sure it's numeric CALL TSTSGN ; Test state of expression JP Z,REM ; False - Drop through CALL GETCHR ; Get next character JP C,GOTO ; Number - GOTO that line JP IFJMP ; Otherwise do statement MRPRNT: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character PRINT: JP Z,PRNTCR ; CRLF if just PRINT PRNTLP: RET Z ; End of list - Exit CP ZTAB ; "TAB(" token? JP Z,DOTAB ; Yes - Do TAB routine CP ZSPC ; "SPC(" token? JP Z,DOTAB ; Yes - Do SPC routine PUSH HL ; Save code string address CP "," ; Comma? JP Z,DOCOM ; Yes - Move to next zone CP ";" ; Semi-colon? JP Z,NEXITM ; Do semi-colon routine POP BC ; Code string address to BC CALL EVAL ; Evaluate expression PUSH HL ; Save code string address LD A,(TYPE) ; Get variable type OR A ; Is it a string variable? JP NZ,PRNTST ; Yes - Output string contents CALL NUMASC ; Convert number to text CALL CRTST ; Create temporary string LD (HL)," " ; Followed by a space LD HL,(FPREG) ; Get length of output INC (HL) ; Plus 1 for the space LD HL,(FPREG) ; < Not needed > LD A,(LWIDTH) ; Get width of line LD B,A ; To B INC B ; Width 255 (No limit)? JP Z,PRNTNB ; Yes - Output number string INC B ; Adjust it LD A,(CURPOS) ; Get cursor position ADD A,(HL) ; Add length of string DEC A ; Adjust it CP B ; Will output fit on this line? CALL NC,PRNTCR ; No - CRLF first PRNTNB: CALL PRS1 ; Output string at (HL) XOR A ; Skip CALL by setting "Z" flag PRNTST: CALL NZ,PRS1 ; Output string at (HL) POP HL ; Restore code string address JP MRPRNT ; See if more to PRINT STTLIN: LD A,(CURPOS) ; Make sure on new line OR A ; Already at start? RET Z ; Yes - Do nothing JP PRNTCR ; Start a new line ENDINP: LD (HL),0 ; Mark end of buffer LD HL,BUFFER-1 ; Point to buffer PRNTCR: LD A,CR ; Load a CR CALL OUTC ; Output character DONULL: XOR A ; Set to position 0 LD (CURPOS),A ; Store it LD A,(NULLS) ; Get number of nulls NULLP: DEC A ; Count them RET Z ; Return if done PUSH AF ; Save count XOR A ; Load a null CALL OUTC ; Output it POP AF ; Restore count JP NULLP ; Keep counting DOCOM: LD A,(COMMAN) ; Get comma width LD B,A ; Save in B LD A,(CURPOS) ; Get current position CP B ; Within the limit? CALL NC,PRNTCR ; No - output CRLF JP NC,NEXITM ; Get next item ZONELP: SUB 14 ; Next zone of 14 characters JP NC,ZONELP ; Repeat if more zones CPL ; Number of spaces to output JP ASPCS ; Output them DOTAB: PUSH AF ; Save token CALL FNDNUM ; Evaluate expression CALL CHKSYN ; Make sure ")" follows DB ")" DEC HL ; Back space on to ")" POP AF ; Restore token SUB ZSPC ; Was it "SPC(" ? PUSH HL ; Save code string address JP Z,DOSPC ; Yes - Do "E" spaces LD A,(CURPOS) ; Get current position DOSPC: CPL ; Number of spaces to print to ADD A,E ; Total number to print JP NC,NEXITM ; TAB < Current POS(X) ASPCS: INC A ; Output A spaces LD B,A ; Save number to print LD A," " ; Space SPCLP: CALL OUTC ; Output character in A DEC B ; Count them JP NZ,SPCLP ; Repeat if more NEXITM: POP HL ; Restore code string address CALL GETCHR ; Get next character JP PRNTLP ; More to print REDO: DB "?Redo from start",CR,LF,0 BADINP: LD A,(READFG) ; READ or INPUT? OR A JP NZ,DATSNR ; READ - ?SN Error POP BC ; Throw away code string addr LD HL,REDO ; "Redo from start" message CALL PRS ; Output string JP DOAGN ; Do last INPUT again INPUT: CALL IDTEST ; Test for illegal direct LD A,(HL) ; Get character after "INPUT" CP '"' ; Is there a prompt string? LD A,0 ; Clear A and leave flags LD (CTLOFG),A ; Enable output JP NZ,NOPMPT ; No prompt - get input CALL QTSTR ; Get string terminated by '"' CALL CHKSYN ; Check for ";" after prompt DB ";" PUSH HL ; Save code string address CALL PRS1 ; Output prompt string DB 3EH ; Skip "PUSH HL" NOPMPT: PUSH HL ; Save code string address CALL PROMPT ; Get input with "? " prompt POP BC ; Restore code string address JP C,INPBRK ; Break pressed - Exit INC HL ; Next byte LD A,(HL) ; Get it OR A ; End of line? DEC HL ; Back again PUSH BC ; Re-save code string address JP Z,NXTDTA ; Yes - Find next DATA stmt LD (HL),"," ; Store comma as separator JP NXTITM ; Get next item READ: PUSH HL ; Save code string address LD HL,(NXTDAT) ; Next DATA statement DB 0F6H ; Flag "READ" NXTITM: XOR A ; Flag "INPUT" LD (READFG),A ; Save "READ"/"INPUT" flag EX (SP),HL ; Get code str' , Save pointer JP GTVLUS ; Get values NEDMOR: CALL CHKSYN ; Check for comma between items DB "," GTVLUS: CALL GETVAR ; Get variable name EX (SP),HL ; Save code str" , Get pointer PUSH DE ; Save variable address LD A,(HL) ; Get next "INPUT"/"DATA" byte CP "," ; Comma? JP Z,ANTVLU ; Yes - Get another value LD A,(READFG) ; Is it READ? OR A JP NZ,FDTLP ; Yes - Find next DATA stmt LD A,"?" ; More INPUT needed CALL OUTC ; Output character CALL PROMPT ; Get INPUT with prompt POP DE ; Variable address POP BC ; Code string address JP C,INPBRK ; Break pressed INC HL ; Point to next DATA byte LD A,(HL) ; Get byte OR A ; Is it zero (No input) ? DEC HL ; Back space INPUT pointer PUSH BC ; Save code string address JP Z,NXTDTA ; Find end of buffer PUSH DE ; Save variable address ANTVLU: LD A,(TYPE) ; Check data type OR A ; Is it numeric? JP Z,INPBIN ; Yes - Convert to binary CALL GETCHR ; Get next character LD D,A ; Save input character LD B,A ; Again CP '"' ; Start of literal sting? JP Z,STRENT ; Yes - Create string entry LD A,(READFG) ; "READ" or "INPUT" ? OR A LD D,A ; Save 00 if "INPUT" JP Z,ITMSEP ; "INPUT" - End with 00 LD D,":" ; "DATA" - End with 00 or ":" ITMSEP: LD B,"," ; Item separator DEC HL ; Back space for DTSTR STRENT: CALL DTSTR ; Get string terminated by D EX DE,HL ; String address to DE LD HL,LTSTND ; Where to go after LETSTR EX (SP),HL ; Save HL , get input pointer PUSH DE ; Save address of string JP LETSTR ; Assign string to variable INPBIN: CALL GETCHR ; Get next character CALL ASCTFP ; Convert ASCII to FP number EX (SP),HL ; Save input ptr, Get var addr CALL FPTHL ; Move FPREG to variable POP HL ; Restore input pointer LTSTND: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,MORDT ; End of line - More needed? CP "," ; Another value? JP NZ,BADINP ; No - Bad input MORDT: EX (SP),HL ; Get code string address DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,NEDMOR ; More needed - Get it POP DE ; Restore DATA pointer LD A,(READFG) ; "READ" or "INPUT" ? OR A EX DE,HL ; DATA pointer to HL JP NZ,UPDATA ; Update DATA pointer if "READ" PUSH DE ; Save code string address OR (HL) ; More input given? LD HL,EXTIG ; "?Extra ignored" message CALL NZ,PRS ; Output string if extra given POP HL ; Restore code string address RET EXTIG: DB "?Extra ignored",CR,LF,0 FDTLP: CALL DATA ; Get next statement OR A ; End of line? JP NZ,FANDT ; No - See if DATA statement INC HL LD A,(HL) ; End of program? INC HL OR (HL) ; 00 00 Ends program LD E,OD ; ?OD Error JP Z,ERROR ; Yes - Out of DATA INC HL LD E,(HL) ; LSB of line number INC HL LD D,(HL) ; MSB of line number EX DE,HL LD (DATLIN),HL ; Set line of current DATA item EX DE,HL FANDT: CALL GETCHR ; Get next character CP ZDATA ; "DATA" token JP NZ,FDTLP ; No "DATA" - Keep looking JP ANTVLU ; Found - Convert input NEXT: LD DE,0 ; In case no index given NEXT1: CALL NZ,GETVAR ; Get index address LD (BRKLIN),HL ; Save code string address CALL BAKSTK ; Look for "FOR" block JP NZ,NFERR ; No "FOR" - ?NF Error LD SP,HL ; Clear nested loops PUSH DE ; Save index address LD A,(HL) ; Get sign of STEP INC HL PUSH AF ; Save sign of STEP PUSH DE ; Save index address CALL PHLTFP ; Move index value to FPREG EX (SP),HL ; Save address of TO value PUSH HL ; Save address of index CALL ADDPHL ; Add STEP to index value POP HL ; Restore address of index CALL FPTHL ; Move value to index variable POP HL ; Restore address of TO value CALL LOADFP ; Move TO value to BCDE PUSH HL ; Save address of line of FOR CALL CMPNUM ; Compare index with TO value POP HL ; Restore address of line num POP BC ; Address of sign of STEP SUB B ; Compare with expected sign CALL LOADFP ; BC = Loop stmt,DE = Line num JP Z,KILFOR ; Loop finished - Terminate it EX DE,HL ; Loop statement line number LD (LINEAT),HL ; Set loop line number LD L,C ; Set code string to loop LD H,B JP PUTFID ; Put back "FOR" and continue KILFOR: LD SP,HL ; Remove "FOR" block LD HL,(BRKLIN) ; Code string after "NEXT" LD A,(HL) ; Get next byte in code string CP "," ; More NEXTs ? JP NZ,RUNCNT ; No - Do next statement CALL GETCHR ; Position to index name CALL NEXT1 ; Re-enter NEXT routine ; < will not RETurn to here , Exit to RUNCNT or Loop > GETNUM: CALL EVAL ; Get a numeric expression TSTNUM: DB 0F6H ; Clear carry (numeric) TSTSTR: SCF ; Set carry (string) CHKTYP: LD A,(TYPE) ; Check types match ADC A,A ; Expected + actual OR A ; Clear carry , set parity RET PE ; Even parity - Types match JP TMERR ; Different types - Error ; <<< NO REFERENCE TO HERE >>> CALL CHKSYN ; Make sure "=" follows DB ZEQUAL ; "=" JP EVAL ; Evaluate expression OPNPAR: CALL CHKSYN ; Make sure "(" follows DB "(" EVAL: DEC HL ; Evaluate expression & save LD D,0 ; Precedence value EVAL1: PUSH DE ; Save precedence LD C,1 CALL CHKSTK ; Check for 1 level of stack CALL OPRND ; Get next expression value EVAL2: LD (NXTOPR),HL ; Save address of next operator EVAL3: LD HL,(NXTOPR) ; Restore address of next opr POP BC ; Precedence value and operator LD A,B ; Get precedence value CP 78H ; "AND" or "OR" ? CALL NC,TSTNUM ; No - Make sure it's a number LD A,(HL) ; Get next operator / function LD D,0 ; Clear Last relation RLTLP: SUB ZGTR ; ">" Token JP C,FOPRND ; + - * / ^ AND OR - Test it CP ZLTH+1-ZGTR ; < = > JP NC,FOPRND ; Function - Call it CP ZEQUAL-ZGTR ; "=" RLA ; <- Test for legal XOR D ; <- combinations of < = > CP D ; <- by combining last token LD D,A ; <- with current one JP C,SNERR ; Error if "<<" "==" or ">>" LD (CUROPR),HL ; Save address of current token CALL GETCHR ; Get next character JP RLTLP ; Treat the two as one FOPRND: LD A,D ; < = > found ? OR A JP NZ,TSTRED ; Yes - Test for reduction LD A,(HL) ; Get operator token LD (CUROPR),HL ; Save operator address SUB ZPLUS ; Operator or function? RET C ; Neither - Exit CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ? RET NC ; No - Exit LD E,A ; Coded operator LD A,(TYPE) ; Get data type DEC A ; FF = numeric , 00 = string OR E ; Combine with coded operator LD A,E ; Get coded operator JP Z,CONCAT ; String concatenation RLCA ; Times 2 ADD A,E ; Times 3 LD E,A ; To DE (D is 0) LD HL,PRITAB ; Precedence table ADD HL,DE ; To the operator concerned LD A,B ; Last operator precedence LD D,(HL) ; Get evaluation precedence CP D ; Compare with eval precedence RET NC ; Exit if higher precedence INC HL ; Point to routine address CALL TSTNUM ; Make sure it's a number STKTHS: PUSH BC ; Save last precedence & token LD BC,EVAL3 ; Where to go on prec' break PUSH BC ; Save on stack for return LD B,E ; Save operator LD C,D ; Save precedence CALL STAKFP ; Move value to stack LD E,B ; Restore operator LD D,C ; Restore precedence LD C,(HL) ; Get LSB of routine address INC HL LD B,(HL) ; Get MSB of routine address INC HL PUSH BC ; Save routine address LD HL,(CUROPR) ; Address of current operator JP EVAL1 ; Loop until prec' break OPRND: XOR A ; Get operand routine LD (TYPE),A ; Set numeric expected CALL GETCHR ; Get next character LD E,MO ; ?MO Error JP Z,ERROR ; No operand - Error JP C,ASCTFP ; Number - Get value CALL CHKLTR ; See if a letter JP NC,CONVAR ; Letter - Find variable CP ZPLUS ; "+" Token ? JP Z,OPRND ; Yes - Look for operand CP "." ; "." ? JP Z,ASCTFP ; Yes - Create FP number CP ZMINUS ; "-" Token ? JP Z,MINUS ; Yes - Do minus CP '"' ; Literal string ? JP Z,QTSTR ; Get string terminated by '"' CP ZNOT ; "NOT" Token ? JP Z,EVNOT ; Yes - Eval NOT expression CP ZFN ; "FN" Token ? JP Z,DOFN ; Yes - Do FN routine SUB ZSGN ; Is it a function? JP NC,FNOFST ; Yes - Evaluate function EVLPAR: CALL OPNPAR ; Evaluate expression in "()" CALL CHKSYN ; Make sure ")" follows DB ")" RET MINUS: LD D,7DH ; "-" precedence CALL EVAL1 ; Evaluate until prec' break LD HL,(NXTOPR) ; Get next operator address PUSH HL ; Save next operator address CALL INVSGN ; Negate value RETNUM: CALL TSTNUM ; Make sure it's a number POP HL ; Restore next operator address RET CONVAR: CALL GETVAR ; Get variable address to DE FRMEVL: PUSH HL ; Save code string address EX DE,HL ; Variable address to HL LD (FPREG),HL ; Save address of variable LD A,(TYPE) ; Get type OR A ; Numeric? CALL Z,PHLTFP ; Yes - Move contents to FPREG POP HL ; Restore code string address RET FNOFST: LD B,0 ; Get address of function RLCA ; Double function offset LD C,A ; BC = Offset in function table PUSH BC ; Save adjusted token value CALL GETCHR ; Get next character LD A,C ; Get adjusted token value CP 2*(ZPOINT-ZSGN) ; Adjusted "POINT" token? JP Z,POINTB ; Yes - Do "POINT" (not POINTB) CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ? JP C,FNVAL ; No - Do function CALL OPNPAR ; Evaluate expression (X,... CALL CHKSYN ; Make sure "," follows DB "," CALL TSTSTR ; Make sure it's a string EX DE,HL ; Save code string address LD HL,(FPREG) ; Get address of string EX (SP),HL ; Save address of string PUSH HL ; Save adjusted token value EX DE,HL ; Restore code string address CALL GETINT ; Get integer 0-255 EX DE,HL ; Save code string address EX (SP),HL ; Save integer,HL = adj' token JP GOFUNC ; Jump to string function FNVAL: CALL EVLPAR ; Evaluate expression EX (SP),HL ; HL = Adjusted token value LD DE,RETNUM ; Return number from function PUSH DE ; Save on stack GOFUNC: LD BC,FNCTAB ; Function routine addresses ADD HL,BC ; Point to right address LD C,(HL) ; Get LSB of address INC HL ; LD H,(HL) ; Get MSB of address LD L,C ; Address to HL JP (HL) ; Jump to function SGNEXP: DEC D ; Dee to flag negative exponent CP ZMINUS ; "-" token ? RET Z ; Yes - Return CP "-" ; "-" ASCII ? RET Z ; Yes - Return INC D ; Inc to flag positive exponent CP "+" ; "+" ASCII ? RET Z ; Yes - Return CP ZPLUS ; "+" token ? RET Z ; Yes - Return DEC HL ; DEC 'cos GETCHR INCs RET ; Return "NZ" POR: DB 0F6H ; Flag "OR" PAND: XOR A ; Flag "AND" PUSH AF ; Save "AND" / "OR" flag CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag EX DE,HL ; <- Get last POP BC ; <- value EX (SP),HL ; <- from EX DE,HL ; <- stack CALL FPBCDE ; Move last value to FPREG PUSH AF ; Save "AND" / "OR" flag CALL DEINT ; Get integer -32768 to 32767 POP AF ; Restore "AND" / "OR" flag POP BC ; Get value LD A,C ; Get LSB LD HL,ACPASS ; Address of save AC as current JP NZ,POR1 ; Jump if OR AND E ; "AND" LSBs LD C,A ; Save LSB LD A,B ; Get MBS AND D ; "AND" MSBs JP (HL) ; Save AC as current (ACPASS) POR1: OR E ; "OR" LSBs LD C,A ; Save LSB LD A,B ; Get MSB OR D ; "OR" MSBs JP (HL) ; Save AC as current (ACPASS) TSTRED: LD HL,CMPLOG ; Logical compare routine LD A,(TYPE) ; Get data type RRA ; Carry set = string LD A,D ; Get last precedence value RLA ; Times 2 plus carry LD E,A ; To E LD D,64H ; Relational precedence LD A,B ; Get current precedence CP D ; Compare with last RET NC ; Eval if last was rel' or log' JP STKTHS ; Stack this one and get next CMPLOG: DW CMPLG1 ; Compare two values / strings CMPLG1: LD A,C ; Get data type OR A RRA POP BC ; Get last expression to BCDE POP DE PUSH AF ; Save status CALL CHKTYP ; Check that types match LD HL,CMPRES ; Result to comparison PUSH HL ; Save for RETurn JP Z,CMPNUM ; Compare values if numeric XOR A ; Compare two strings LD (TYPE),A ; Set type to numeric PUSH DE ; Save string name CALL GSTRCU ; Get current string LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address POP DE ; Restore string name PUSH BC ; Save address of string PUSH AF ; Save length of string CALL GSTRDE ; Get second string CALL LOADFP ; Get address of second string POP AF ; Restore length of string 1 LD D,A ; Length to D POP HL ; Restore address of string 1 CMPSTR: LD A,E ; Bytes of string 2 to do OR D ; Bytes of string 1 to do RET Z ; Exit if all bytes compared LD A,D ; Get bytes of string 1 to do SUB 1 RET C ; Exit if end of string 1 XOR A CP E ; Bytes of string 2 to do INC A RET NC ; Exit if end of string 2 DEC D ; Count bytes in string 1 DEC E ; Count bytes in string 2 LD A,(BC) ; Byte in string 2 CP (HL) ; Compare to byte in string 1 INC HL ; Move up string 1 INC BC ; Move up string 2 JP Z,CMPSTR ; Same - Try next bytes CCF ; Flag difference (">" or "<") JP FLGDIF ; "<" gives -1 , ">" gives +1 CMPRES: INC A ; Increment current value ADC A,A ; Double plus carry POP BC ; Get other value AND B ; Combine them ADD A,-1 ; Carry set if different SBC A,A ; 00 - Equal , FF - Different JP FLGREL ; Set current value & continue EVNOT: LD D,5AH ; Precedence value for "NOT" CALL EVAL1 ; Eval until precedence break CALL TSTNUM ; Make sure it's a number CALL DEINT ; Get integer -32768 - 32767 LD A,E ; Get LSB CPL ; Invert LSB LD C,A ; Save "NOT" of LSB LD A,D ; Get MSB CPL ; Invert MSB CALL ACPASS ; Save AC as current POP BC ; Clean up stack JP EVAL3 ; Continue evaluation DIMRET: DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character RET Z ; End of DIM statement CALL CHKSYN ; Make sure "," follows DB "," DIM: LD BC,DIMRET ; Return to "DIMRET" PUSH BC ; Save on stack DB 0F6H ; Flag "Create" variable GETVAR: XOR A ; Find variable address,to DE LD (LCRFLG),A ; Set locate / create flag LD B,(HL) ; Get First byte of name GTFNAM: CALL CHKLTR ; See if a letter JP C,SNERR ; ?SN Error if not a letter XOR A LD C,A ; Clear second byte of name LD (TYPE),A ; Set type to numeric CALL GETCHR ; Get next character JP C,SVNAM2 ; Numeric - Save in name CALL CHKLTR ; See if a letter JP C,CHARTY ; Not a letter - Check type SVNAM2: LD C,A ; Save second byte of name ENDNAM: CALL GETCHR ; Get next character JP C,ENDNAM ; Numeric - Get another CALL CHKLTR ; See if a letter JP NC,ENDNAM ; Letter - Get another CHARTY: SUB "$" ; String variable? JP NZ,NOTSTR ; No - Numeric variable INC A ; A = 1 (string type) LD (TYPE),A ; Set type to string RRCA ; A = 80H , Flag for string ADD A,C ; 2nd byte of name has bit 7 on LD C,A ; Resave second byte on name CALL GETCHR ; Get next character NOTSTR: LD A,(FORFLG) ; Array name needed ? DEC A JP Z,ARLDSV ; Yes - Get array name JP P,NSCFOR ; No array with "FOR" or "FN" LD A,(HL) ; Get byte again SUB "(" ; Subscripted variable? JP Z,SBSCPT ; Yes - Sort out subscript NSCFOR: XOR A ; Simple variable LD (FORFLG),A ; Clear "FOR" flag PUSH HL ; Save code string address LD D,B ; DE = Variable name to find LD E,C LD HL,(FNRGNM) ; FN argument name CALL CPDEHL ; Is it the FN argument? LD DE,FNARG ; Point to argument value JP Z,POPHRT ; Yes - Return FN argument value LD HL,(VAREND) ; End of variables EX DE,HL ; Address of end of search LD HL,(PROGND) ; Start of variables address FNDVAR: CALL CPDEHL ; End of variable list table? JP Z,CFEVAL ; Yes - Called from EVAL? LD A,C ; Get second byte of name SUB (HL) ; Compare with name in list INC HL ; Move on to first byte JP NZ,FNTHR ; Different - Find another LD A,B ; Get first byte of name SUB (HL) ; Compare with name in list FNTHR: INC HL ; Move on to LSB of value JP Z,RETADR ; Found - Return address INC HL ; <- Skip INC HL ; <- over INC HL ; <- F.P. INC HL ; <- value JP FNDVAR ; Keep looking CFEVAL: POP HL ; Restore code string address EX (SP),HL ; Get return address PUSH DE ; Save address of variable LD DE,FRMEVL ; Return address in EVAL CALL CPDEHL ; Called from EVAL ? POP DE ; Restore address of variable JP Z,RETNUL ; Yes - Return null variable EX (SP),HL ; Put back return PUSH HL ; Save code string address PUSH BC ; Save variable name LD BC,6 ; 2 byte name plus 4 byte data LD HL,(ARREND) ; End of arrays PUSH HL ; Save end of arrays ADD HL,BC ; Move up 6 bytes POP BC ; Source address in BC PUSH HL ; Save new end address CALL MOVUP ; Move arrays up POP HL ; Restore new end address LD (ARREND),HL ; Set new end address LD H,B ; End of variables to HL LD L,C LD (VAREND),HL ; Set new end address ZEROLP: DEC HL ; Back through to zero variable LD (HL),0 ; Zero byte in variable CALL CPDEHL ; Done them all? JP NZ,ZEROLP ; No - Keep on going POP DE ; Get variable name LD (HL),E ; Store second character INC HL LD (HL),D ; Store first character INC HL RETADR: EX DE,HL ; Address of variable in DE POP HL ; Restore code string address RET RETNUL: LD (FPEXP),A ; Set result to zero LD HL,ZERBYT ; Also set a null string LD (FPREG),HL ; Save for EVAL POP HL ; Restore code string address RET SBSCPT: PUSH HL ; Save code string address LD HL,(LCRFLG) ; Locate/Create and Type EX (SP),HL ; Save and get code string LD D,A ; Zero number of dimensions SCPTLP: PUSH DE ; Save number of dimensions PUSH BC ; Save array name CALL FPSINT ; Get subscript (0-32767) POP BC ; Restore array name POP AF ; Get number of dimensions EX DE,HL EX (SP),HL ; Save subscript value PUSH HL ; Save LCRFLG and TYPE EX DE,HL INC A ; Count dimensions LD D,A ; Save in D LD A,(HL) ; Get next byte in code string CP "," ; Comma (more to come)? JP Z,SCPTLP ; Yes - More subscripts CALL CHKSYN ; Make sure ")" follows DB ")" LD (NXTOPR),HL ; Save code string address POP HL ; Get LCRFLG and TYPE LD (LCRFLG),HL ; Restore Locate/create & type LD E,0 ; Flag not CSAVE* or CLOAD* PUSH DE ; Save number of dimensions (D) DB 11H ; Skip "PUSH HL" and "PUSH AF' ARLDSV: PUSH HL ; Save code string address PUSH AF ; A = 00 , Flags set = Z,N LD HL,(VAREND) ; Start of arrays DB 3EH ; Skip "ADD HL,DE" FNDARY: ADD HL,DE ; Move to next array start EX DE,HL LD HL,(ARREND) ; End of arrays EX DE,HL ; Current array pointer CALL CPDEHL ; End of arrays found? JP Z,CREARY ; Yes - Create array LD A,(HL) ; Get second byte of name CP C ; Compare with name given INC HL ; Move on JP NZ,NXTARY ; Different - Find next array LD A,(HL) ; Get first byte of name CP B ; Compare with name given NXTARY: INC HL ; Move on LD E,(HL) ; Get LSB of next array address INC HL LD D,(HL) ; Get MSB of next array address INC HL JP NZ,FNDARY ; Not found - Keep looking LD A,(LCRFLG) ; Found Locate or Create it? OR A JP NZ,DDERR ; Create - ?DD Error POP AF ; Locate - Get number of dim'ns LD B,H ; BC Points to array dim'ns LD C,L JP Z,POPHRT ; Jump if array load/save SUB (HL) ; Same number of dimensions? JP Z,FINDEL ; Yes - Find element BSERR: LD E,BS ; ?BS Error JP ERROR ; Output error CREARY: LD DE,4 ; 4 Bytes per entry POP AF ; Array to save or 0 dim'ns? JP Z,FCERR ; Yes - ?FC Error LD (HL),C ; Save second byte of name INC HL LD (HL),B ; Save first byte of name INC HL LD C,A ; Number of dimensions to C CALL CHKSTK ; Check if enough memory INC HL ; Point to number of dimensions INC HL LD (CUROPR),HL ; Save address of pointer LD (HL),C ; Set number of dimensions INC HL LD A,(LCRFLG) ; Locate of Create? RLA ; Carry set = Create LD A,C ; Get number of dimensions CRARLP: LD BC,10+1 ; Default dimension size 10 JP NC,DEFSIZ ; Locate - Set default size POP BC ; Get specified dimension size INC BC ; Include zero element DEFSIZ: LD (HL),C ; Save LSB of dimension size INC HL LD (HL),B ; Save MSB of dimension size INC HL PUSH AF ; Save num' of dim'ns an status PUSH HL ; Save address of dim'n size CALL MLDEBC ; Multiply DE by BC to find EX DE,HL ; amount of mem needed (to DE) POP HL ; Restore address of dimension POP AF ; Restore number of dimensions DEC A ; Count them JP NZ,CRARLP ; Do next dimension if more PUSH AF ; Save locate/create flag LD B,D ; MSB of memory needed LD C,E ; LSB of memory needed EX DE,HL ADD HL,DE ; Add bytes to array start JP C,OMERR ; Too big - Error CALL ENFMEM ; See if enough memory LD (ARREND),HL ; Save new end of array ZERARY: DEC HL ; Back through array data LD (HL),0 ; Set array element to zero CALL CPDEHL ; All elements zeroed? JP NZ,ZERARY ; No - Keep on going INC BC ; Number of bytes + 1 LD D,A ; A=0 LD HL,(CUROPR) ; Get address of array LD E,(HL) ; Number of dimensions EX DE,HL ; To HL ADD HL,HL ; Two bytes per dimension size ADD HL,BC ; Add number of bytes EX DE,HL ; Bytes needed to DE DEC HL DEC HL LD (HL),E ; Save LSB of bytes needed INC HL LD (HL),D ; Save MSB of bytes needed INC HL POP AF ; Locate / Create? JP C,ENDDIM ; A is 0 , End if create FINDEL: LD B,A ; Find array element LD C,A LD A,(HL) ; Number of dimensions INC HL DB 16H ; Skip "POP HL" FNDELP: POP HL ; Address of next dim' size LD E,(HL) ; Get LSB of dim'n size INC HL LD D,(HL) ; Get MSB of dim'n size INC HL EX (SP),HL ; Save address - Get index PUSH AF ; Save number of dim'ns CALL CPDEHL ; Dimension too large? JP NC,BSERR ; Yes - ?BS Error PUSH HL ; Save index CALL MLDEBC ; Multiply previous by size POP DE ; Index supplied to DE ADD HL,DE ; Add index to pointer POP AF ; Number of dimensions DEC A ; Count them LD B,H ; MSB of pointer LD C,L ; LSB of pointer JP NZ,FNDELP ; More - Keep going ADD HL,HL ; 4 Bytes per element ADD HL,HL POP BC ; Start of array ADD HL,BC ; Point to element EX DE,HL ; Address of element to DE ENDDIM: LD HL,(NXTOPR) ; Got code string address RET FRE: LD HL,(ARREND) ; Start of free memory EX DE,HL ; To DE LD HL,0 ; End of free memory ADD HL,SP ; Current stack value LD A,(TYPE) ; Dummy argument type OR A JP Z,FRENUM ; Numeric - Free variable space CALL GSTRCU ; Current string to pool CALL GARBGE ; Garbage collection LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string space FRENUM: LD A,L ; Get LSB of end SUB E ; Subtract LSB of beginning LD C,A ; Save difference if C LD A,H ; Get MSB of end SBC A,D ; Subtract MSB of beginning ACPASS: LD B,C ; Return integer AC ABPASS: LD D,B ; Return integer AB LD E,0 LD HL,TYPE ; Point to type LD (HL),E ; Set type to numeric LD B,80H+16 ; 16 bit integer JP RETINT ; Return the integr POS: LD A,(CURPOS) ; Get cursor position PASSA: LD B,A ; Put A into AB XOR A ; Zero A JP ABPASS ; Return integer AB DEF: CALL CHEKFN ; Get "FN" and name CALL IDTEST ; Test for illegal direct LD BC,DATA ; To get next statement PUSH BC ; Save address for RETurn PUSH DE ; Save address of function ptr CALL CHKSYN ; Make sure "(" follows DB "(" CALL GETVAR ; Get argument variable name PUSH HL ; Save code string address EX DE,HL ; Argument address to HL DEC HL LD D,(HL) ; Get first byte of arg name DEC HL LD E,(HL) ; Get second byte of arg name POP HL ; Restore code string address CALL TSTNUM ; Make sure numeric argument CALL CHKSYN ; Make sure ")" follows DB ")" CALL CHKSYN ; Make sure "=" follows DB ZEQUAL ; "=" token LD B,H ; Code string address to BC LD C,L EX (SP),HL ; Save code str , Get FN ptr LD (HL),C ; Save LSB of FN code string INC HL LD (HL),B ; Save MSB of FN code string JP SVSTAD ; Save address and do function DOFN: CALL CHEKFN ; Make sure FN follows PUSH DE ; Save function pointer address CALL EVLPAR ; Evaluate expression in "()" CALL TSTNUM ; Make sure numeric result EX (SP),HL ; Save code str , Get FN ptr LD E,(HL) ; Get LSB of FN code string INC HL LD D,(HL) ; Get MSB of FN code string INC HL LD A,D ; And function DEFined? OR E JP Z,UFERR ; No - ?UF Error LD A,(HL) ; Get LSB of argument address INC HL LD H,(HL) ; Get MSB of argument address LD L,A ; HL = Arg variable address PUSH HL ; Save it LD HL,(FNRGNM) ; Get old argument name EX (SP),HL ; ; Save old , Get new LD (FNRGNM),HL ; Set new argument name LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value PUSH HL ; Save it LD HL,(FNARG) ; Get MSB,EXP of old arg value PUSH HL ; Save it LD HL,FNARG ; HL = Value of argument PUSH DE ; Save FN code string address CALL FPTHL ; Move FPREG to argument POP HL ; Get FN code string address CALL GETNUM ; Get value from function DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP NZ,SNERR ; Bad character in FN - Error POP HL ; Get MSB,EXP of old arg LD (FNARG),HL ; Restore it POP HL ; Get LSB,NLSB of old arg LD (FNARG+2),HL ; Restore it POP HL ; Get name of old arg LD (FNRGNM),HL ; Restore it POP HL ; Restore code string address RET IDTEST: PUSH HL ; Save code string address LD HL,(LINEAT) ; Get current line number INC HL ; -1 means direct statement LD A,H OR L POP HL ; Restore code string address RET NZ ; Return if in program LD E,ID ; ?ID Error JP ERROR CHEKFN: CALL CHKSYN ; Make sure FN follows DB ZFN ; "FN" token LD A,80H LD (FORFLG),A ; Flag FN name to find OR (HL) ; FN name has bit 7 set LD B,A ; in first byte of name CALL GTFNAM ; Get FN name JP TSTNUM ; Make sure numeric function STR: CALL TSTNUM ; Make sure it's a number CALL NUMASC ; Turn number into text CALL CRTST ; Create string entry for it CALL GSTRCU ; Current string to pool LD BC,TOPOOL ; Save in string pool PUSH BC ; Save address on stack SAVSTR: LD A,(HL) ; Get string length INC HL INC HL PUSH HL ; Save pointer to string CALL TESTR ; See if enough string space POP HL ; Restore pointer to string LD C,(HL) ; Get LSB of address INC HL LD B,(HL) ; Get MSB of address CALL CRTMST ; Create string entry PUSH HL ; Save pointer to MSB of addr LD L,A ; Length of string CALL TOSTRA ; Move to string area POP DE ; Restore pointer to MSB RET MKTMST: CALL TESTR ; See if enough string space CRTMST: LD HL,TMPSTR ; Temporary string PUSH HL ; Save it LD (HL),A ; Save length of string INC HL SVSTAD: INC HL LD (HL),E ; Save LSB of address INC HL LD (HL),D ; Save MSB of address POP HL ; Restore pointer RET CRTST: DEC HL ; DEC - INCed after QTSTR: LD B,'"' ; Terminating quote LD D,B ; Quote to D DTSTR: PUSH HL ; Save start LD C,-1 ; Set counter to -1 QTSTLP: INC HL ; Move on LD A,(HL) ; Get byte INC C ; Count bytes OR A ; End of line? JP Z,CRTSTE ; Yes - Create string entry CP D ; Terminator D found? JP Z,CRTSTE ; Yes - Create string entry CP B ; Terminator B found? JP NZ,QTSTLP ; No - Keep looking CRTSTE: CP '"' ; End with '"'? CALL Z,GETCHR ; Yes - Get next character EX (SP),HL ; Starting quote INC HL ; First byte of string EX DE,HL ; To DE LD A,C ; Get length CALL CRTMST ; Create string entry TSTOPL: LD DE,TMPSTR ; Temporary string LD HL,(TMSTPT) ; Temporary string pool pointer LD (FPREG),HL ; Save address of string ptr LD A,1 LD (TYPE),A ; Set type to string CALL DETHL4 ; Move string to pool CALL CPDEHL ; Out of string pool? LD (TMSTPT),HL ; Save new pointer POP HL ; Restore code string address LD A,(HL) ; Get next code byte RET NZ ; Return if pool OK LD E,ST ; ?ST Error JP ERROR ; String pool overflow PRNUMS: INC HL ; Skip leading space PRS: CALL CRTST ; Create string entry for it PRS1: CALL GSTRCU ; Current string to pool CALL LOADFP ; Move string block to BCDE INC E ; Length + 1 PRSLP: DEC E ; Count characters RET Z ; End of string LD A,(BC) ; Get byte to output CALL OUTC ; Output character in A CP CR ; Return? CALL Z,DONULL ; Yes - Do nulls INC BC ; Next byte in string JP PRSLP ; More characters to output TESTR: OR A ; Test if enough room DB 0EH ; No garbage collection done GRBDON: POP AF ; Garbage collection done PUSH AF ; Save status LD HL,(STRSPC) ; Bottom of string space in use EX DE,HL ; To DE LD HL,(STRBOT) ; Bottom of string area CPL ; Negate length (Top down) LD C,A ; -Length to BC LD B,-1 ; BC = -ve length of string ADD HL,BC ; Add to bottom of space in use INC HL ; Plus one for 2's complement CALL CPDEHL ; Below string RAM area? JP C,TESTOS ; Tidy up if not done else err LD (STRBOT),HL ; Save new bottom of area INC HL ; Point to first byte of string EX DE,HL ; Address to DE POPAF: POP AF ; Throw away status push RET TESTOS: POP AF ; Garbage collect been done? LD E,OS ; ?OS Error JP Z,ERROR ; Yes - Not enough string apace CP A ; Flag garbage collect done PUSH AF ; Save status LD BC,GRBDON ; Garbage collection done PUSH BC ; Save for RETurn GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer GARBLP: LD (STRBOT),HL ; Reset string pointer LD HL,0 PUSH HL ; Flag no string found LD HL,(STRSPC) ; Get bottom of string space PUSH HL ; Save bottom of string space LD HL,TMSTPL ; Temporary string pool GRBLP: EX DE,HL LD HL,(TMSTPT) ; Temporary string pool pointer EX DE,HL CALL CPDEHL ; Temporary string pool done? LD BC,GRBLP ; Loop until string pool done JP NZ,STPOOL ; No - See if in string area LD HL,(PROGND) ; Start of simple variables SMPVAR: EX DE,HL LD HL,(VAREND) ; End of simple variables EX DE,HL CALL CPDEHL ; All simple strings done? JP Z,ARRLP ; Yes - Do string arrays LD A,(HL) ; Get type of variable INC HL INC HL OR A ; "S" flag set if string CALL STRADD ; See if string in string area JP SMPVAR ; Loop until simple ones done GNXARY: POP BC ; Scrap address of this array ARRLP: EX DE,HL LD HL,(ARREND) ; End of string arrays EX DE,HL CALL CPDEHL ; All string arrays done? JP Z,SCNEND ; Yes - Move string if found CALL LOADFP ; Get array name to BCDE LD A,E ; Get type of array PUSH HL ; Save address of num of dim'ns ADD HL,BC ; Start of next array OR A ; Test type of array JP P,GNXARY ; Numeric array - Ignore it LD (CUROPR),HL ; Save address of next array POP HL ; Get address of num of dim'ns LD C,(HL) ; BC = Number of dimensions LD B,0 ADD HL,BC ; Two bytes per dimension size ADD HL,BC INC HL ; Plus one for number of dim'ns GRBARY: EX DE,HL LD HL,(CUROPR) ; Get address of next array EX DE,HL CALL CPDEHL ; Is this array finished? JP Z,ARRLP ; Yes - Get next one LD BC,GRBARY ; Loop until array all done STPOOL: PUSH BC ; Save return address OR 80H ; Flag string type STRADD: LD A,(HL) ; Get string length INC HL INC HL LD E,(HL) ; Get LSB of string address INC HL LD D,(HL) ; Get MSB of string address INC HL RET P ; Not a string - Return OR A ; Set flags on string length RET Z ; Null string - Return LD B,H ; Save variable pointer LD C,L LD HL,(STRBOT) ; Bottom of new area CALL CPDEHL ; String been done? LD H,B ; Restore variable pointer LD L,C RET C ; String done - Ignore POP HL ; Return address EX (SP),HL ; Lowest available string area CALL CPDEHL ; String within string area? EX (SP),HL ; Lowest available string area PUSH HL ; Re-save return address LD H,B ; Restore variable pointer LD L,C RET NC ; Outside string area - Ignore POP BC ; Get return , Throw 2 away POP AF ; POP AF ; PUSH HL ; Save variable pointer PUSH DE ; Save address of current PUSH BC ; Put back return address RET ; Go to it SCNEND: POP DE ; Addresses of strings POP HL ; LD A,L ; HL = 0 if no more to do OR H RET Z ; No more to do - Return DEC HL LD B,(HL) ; MSB of address of string DEC HL LD C,(HL) ; LSB of address of string PUSH HL ; Save variable address DEC HL DEC HL LD L,(HL) ; HL = Length of string LD H,0 ADD HL,BC ; Address of end of string+1 LD D,B ; String address to DE LD E,C DEC HL ; Last byte in string LD B,H ; Address to BC LD C,L LD HL,(STRBOT) ; Current bottom of string area CALL MOVSTR ; Move string to new address POP HL ; Restore variable address LD (HL),C ; Save new LSB of address INC HL LD (HL),B ; Save new MSB of address LD L,C ; Next string area+1 to HL LD H,B DEC HL ; Next string area address JP GARBLP ; Look for more strings CONCAT: PUSH BC ; Save prec' opr & code string PUSH HL ; LD HL,(FPREG) ; Get first string EX (SP),HL ; Save first string CALL OPRND ; Get second string EX (SP),HL ; Restore first string CALL TSTSTR ; Make sure it's a string LD A,(HL) ; Get length of second string PUSH HL ; Save first string LD HL,(FPREG) ; Get second string PUSH HL ; Save second string ADD A,(HL) ; Add length of second string LD E,LS ; ?LS Error JP C,ERROR ; String too long - Error CALL MKTMST ; Make temporary string POP DE ; Get second string to DE CALL GSTRDE ; Move to string pool if needed EX (SP),HL ; Get first string CALL GSTRHL ; Move to string pool if needed PUSH HL ; Save first string LD HL,(TMPSTR+2) ; Temporary string address EX DE,HL ; To DE CALL SSTSA ; First string to string area CALL SSTSA ; Second string to string area LD HL,EVAL2 ; Return to evaluation loop EX (SP),HL ; Save return,get code string PUSH HL ; Save code string address JP TSTOPL ; To temporary string to pool SSTSA: POP HL ; Return address EX (SP),HL ; Get string block,save return LD A,(HL) ; Get length of string INC HL INC HL LD C,(HL) ; Get LSB of string address INC HL LD B,(HL) ; Get MSB of string address LD L,A ; Length to L TOSTRA: INC L ; INC - DECed after TSALP: DEC L ; Count bytes moved RET Z ; End of string - Return LD A,(BC) ; Get source LD (DE),A ; Save destination INC BC ; Next source INC DE ; Next destination JP TSALP ; Loop until string moved GETSTR: CALL TSTSTR ; Make sure it's a string GSTRCU: LD HL,(FPREG) ; Get current string GSTRHL: EX DE,HL ; Save DE GSTRDE: CALL BAKTMP ; Was it last tmp-str? EX DE,HL ; Restore DE RET NZ ; No - Return PUSH DE ; Save string LD D,B ; String block address to DE LD E,C DEC DE ; Point to length LD C,(HL) ; Get string length LD HL,(STRBOT) ; Current bottom of string area CALL CPDEHL ; Last one in string area? JP NZ,POPHL ; No - Return LD B,A ; Clear B (A=0) ADD HL,BC ; Remove string from str' area LD (STRBOT),HL ; Save new bottom of str' area POPHL: POP HL ; Restore string RET BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top DEC HL ; Back LD B,(HL) ; Get MSB of address DEC HL ; Back LD C,(HL) ; Get LSB of address DEC HL ; Back DEC HL ; Back CALL CPDEHL ; String last in string pool? RET NZ ; Yes - Leave it LD (TMSTPT),HL ; Save new string pool top RET LEN: LD BC,PASSA ; To return integer A PUSH BC ; Save address GETLEN: CALL GETSTR ; Get string and its length XOR A LD D,A ; Clear D LD (TYPE),A ; Set type to numeric LD A,(HL) ; Get length of string OR A ; Set status flags RET ASC: LD BC,PASSA ; To return integer A PUSH BC ; Save address GTFLNM: CALL GETLEN ; Get length of string JP Z,FCERR ; Null string - Error INC HL INC HL LD E,(HL) ; Get LSB of address INC HL LD D,(HL) ; Get MSB of address LD A,(DE) ; Get first byte of string RET CHR: LD A,1 ; One character string CALL MKTMST ; Make a temporary string CALL MAKINT ; Make it integer A LD HL,(TMPSTR+2) ; Get address of string LD (HL),E ; Save character TOPOOL: POP BC ; Clean up stack JP TSTOPL ; Temporary string to pool LEFT: CALL LFRGNM ; Get number and ending ")" XOR A ; Start at first byte in string RIGHT1: EX (SP),HL ; Save code string,Get string LD C,A ; Starting position in string MID1: PUSH HL ; Save string block address LD A,(HL) ; Get length of string CP B ; Compare with number given JP C,ALLFOL ; All following bytes required LD A,B ; Get new length DB 11H ; Skip "LD C,0" ALLFOL: LD C,0 ; First byte of string PUSH BC ; Save position in string CALL TESTR ; See if enough string space POP BC ; Get position in string POP HL ; Restore string block address PUSH HL ; And re-save it INC HL INC HL LD B,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,B ; HL = address of string LD B,0 ; BC = starting address ADD HL,BC ; Point to that byte LD B,H ; BC = source string LD C,L CALL CRTMST ; Create a string entry LD L,A ; Length of new string CALL TOSTRA ; Move string to string area POP DE ; Clear stack CALL GSTRDE ; Move to string pool if needed JP TSTOPL ; Temporary string to pool RIGHT: CALL LFRGNM ; Get number and ending ")" POP DE ; Get string length PUSH DE ; And re-save LD A,(DE) ; Get length SUB B ; Move back N bytes JP RIGHT1 ; Go and get sub-string MID: EX DE,HL ; Get code string address LD A,(HL) ; Get next byte "," or ")" CALL MIDNUM ; Get number supplied INC B ; Is it character zero? DEC B JP Z,FCERR ; Yes - Error PUSH BC ; Save starting position LD E,255 ; All of string CP ")" ; Any length given? JP Z,RSTSTR ; No - Rest of string CALL CHKSYN ; Make sure "," follows DB "," CALL GETINT ; Get integer 0-255 RSTSTR: CALL CHKSYN ; Make sure ")" follows DB ")" POP AF ; Restore starting position EX (SP),HL ; Get string,8ave code string LD BC,MID1 ; Continuation of MID$ routine PUSH BC ; Save for return DEC A ; Starting position-1 CP (HL) ; Compare with length LD B,0 ; Zero bytes length RET NC ; Null string if start past end LD C,A ; Save starting position-1 LD A,(HL) ; Get length of string SUB C ; Subtract start CP E ; Enough string for it? LD B,A ; Save maximum length available RET C ; Truncate string if needed LD B,E ; Set specified length RET ; Go and create string VAL: CALL GETLEN ; Get length of string JP Z,RESZER ; Result zero LD E,A ; Save length INC HL INC HL LD A,(HL) ; Get LSB of address INC HL LD H,(HL) ; Get MSB of address LD L,A ; HL = String address PUSH HL ; Save string address ADD HL,DE LD B,(HL) ; Get end of string+1 byte LD (HL),D ; Zero it to terminate EX (SP),HL ; Save string end,get start PUSH BC ; Save end+1 byte LD A,(HL) ; Get starting byte CALL ASCTFP ; Convert ASCII string to FP POP BC ; Restore end+1 byte POP HL ; Restore end+1 address LD (HL),B ; Put back original byte RET LFRGNM: EX DE,HL ; Code string address to HL CALL CHKSYN ; Make sure ")" follows DB ")" MIDNUM: POP BC ; Get return address POP DE ; Get number supplied PUSH BC ; Re-save return address LD B,E ; Number to B RET INP: CALL MAKINT ; Make it integer A LD (INPORT),A ; Set input port CALL INPSUB ; Get input from port JP PASSA ; Return integer A POUT: CALL SETIO ; Set up port number JP OUTSUB ; Output data and return WAIT: CALL SETIO ; Set up port number PUSH AF ; Save AND mask LD E,0 ; Assume zero if none given DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character JP Z,NOXOR ; No XOR byte given CALL CHKSYN ; Make sure "," follows DB "," CALL GETINT ; Get integer 0-255 to XOR with NOXOR: POP BC ; Restore AND mask WAITLP: CALL INPSUB ; Get input XOR E ; Flip selected bits AND B ; Result non-zero? JP Z,WAITLP ; No = keep waiting RET SETIO: CALL GETINT ; Get integer 0-255 LD (INPORT),A ; Set input port LD (OTPORT),A ; Set output port CALL CHKSYN ; Make sure "," follows DB "," JP GETINT ; Get integer 0-255 and return FNDNUM: CALL GETCHR ; Get next character GETINT: CALL GETNUM ; Get a number from 0 to 255 MAKINT: CALL DEPINT ; Make sure value 0 - 255 LD A,D ; Get MSB of number OR A ; Zero? JP NZ,FCERR ; No - Error DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character LD A,E ; Get number to A RET ; << NO REFERENCE TO THIS SECTION OF CODE >> ; << Set up another program area (can be in ROM) >> LD HL,(BASTXT) ; Get start of program text LD (PROGND),HL ; Set more variable space LD HL,8000H ; Address of new program LD E,(HL) ; Get LSB of new RAM end INC HL LD D,(HL) ; Get MSB of new RAM end INC HL INC HL ; Null at start of program LD (BASTXT),HL ; New program text area 8003H EX DE,HL ; New RAM end to HL LD (LSTRAM),HL ; Set new RAM end LD (STRSPC),HL ; Clear string space LD BC,RUNCNT ; Execution driver loop PUSH BC ; Save for return JP RUNFST ; Clear variables and continue RUART: JP GUART ; Get a byte from UART WUART2: CALL WUART ; Send 2 Bytes to UART WUART: PUSH AF ; Save byte PUSH BC ; Save BC LD C,A ; Byte to C CALL SUART ; Send byte to UART POP BC ; Restore BC POP AF ; Restore byte RET CSAVE: LD B,1 ; Flag "CSAVE" CP ZTIMES ; "*" token? ("CSAVE*") JP Z,ARRSV1 ; Yes - Array save CALL EVAL ; Evaluate expression PUSH HL ; Save code string address CALL GTFLNM ; Get file name PUSH DE ; Save file name CALL CASFFW ; Turn on motor and wait POP DE ; Restore file name LD A,11010011B ; Header byte CALL WUART ; Send byte to UART CALL WUART2 ; Send byte twice more LD A,(DE) ; Get file name CALL WUART ; Send it to UART NOP NOP NOP LD HL,PROGND ; Start of program information LD (ARG1),HL ; Save for monitor save routine LD HL,(PROGND) ; End of program information LD (ARG2),HL ; Save for monitor save routine CALL SAVE ; Save program to tape CALL ARET ; Not much there! POP HL ; Restore code string address RET CLOAD: LD A,(HL) ; Get byte after "CLOAD" CP ZTIMES ; "*" token? ("CLOAD*") JP Z,ARRLD1 ; Yes - Array load CALL SMOTOR ; Start motor and get "?" SUB ZPRINT ; "?" ("PRINT" token) Verify? JP Z,FLGVER ; Yes - Flag "verify" XOR A ; Flag "load" DB 01H ; Skip "CPL" and "INC HL" FLGVER: CPL ; Flag "verify" INC HL ; Skip over "?" PUSH AF ; Save verify flag DEC HL ; DEC 'cos GETCHR INCs CALL GETCHR ; Get next character LD A,0 ; Any file will do JP Z,ANYNAM ; No name given - Any will do CALL EVAL ; Evaluate expression CALL GTFLNM ; Get file name LD A,(DE) ; Get first byte of name ANYNAM: LD L,A ; Save name to find POP AF ; Get verify flag PUSH AF ; And re-save OR A ; Verify of load? LD H,A LD (FPREG),HL ; Save nam of file to find CALL Z,CLRPTR ; Load - Clear pointers LD HL,(FPREG) ; Get name of program to find EX DE,HL ; Name to DE CLOAD1: LD B,3 ; 3 Header bytes CLOAD2: CALL RUART ; Get a byte from UART SUB 11010011B ; Header byte? JP NZ,CLOAD1 ; Look for header DEC B ; Count header bytes JP NZ,CLOAD2 ; More to find? CALL RUART ; Get name of file CALL FILFND ; Display "file X found" INC E ; Any file name given? DEC E JP Z,THSFIL ; No - This file will do CP E ; Has file been found? JP NZ,CLOAD1 ; No - Look for another THSFIL: NOP NOP NOP POP AF ; Get verify flag OR A ; Load or verify? JP NZ,CLOADV ; Verify program CALL MONLD ; Use monitor to load program LD HL,(PROGND) ; Get end of program CALL ENFMEM ; See if enough memory JP CLOADE ; "Ok" and set up pointers CLOADV: CALL MONVE ; Use monitor to verify program CLOADE: LD HL,OKMSG ; "Ok" message CALL PRS ; Output string CALL ARET ; Not a lot there! JP SETPTR ; Set up line pointers OUTBAD: LD HL,BAD ; "Bad" message CALL PRS ; Output string JP ERRIN ; In line message FILFND: PUSH BC ; <- Save PUSH HL ; <- all PUSH DE ; <- the PUSH AF ; <- registers LD HL,FILE ; "File" message CALL PRS ; Output string POP AF ; Get file name PUSH AF ; And re-save CALL CONMON ; Output file name to screen LD HL,FOUND ; "Found" message CALL PRS ; Output string POP AF ; <- Restore POP DE ; <- all POP HL ; <- the POP BC ; <- registers RET FILE: DB "File ",0 FOUND: DB " Found",CR,LF,0 BAD: DB "Bad",0,0,0 PEEK: CALL DEINT ; Get memory address LD A,(DE) ; Get byte in memory JP PASSA ; Return integer A POKE: CALL GETNUM ; Get memory address CALL DEINT ; Get integer -32768 to 3276 PUSH DE ; Save memory address CALL CHKSYN ; Make sure "," follows DB "," CALL GETINT ; Get integer 0-255 POP DE ; Restore memory address LD (DE),A ; Load it into memory RET ROUND: LD HL,HALF ; Add 0.5 to FPREG ADDPHL: CALL LOADFP ; Load FP at (HL) to BCDE JP FPADD ; Add BCDE to FPREG SUBPHL: CALL LOADFP ; FPREG = -FPREG + number at HL DB 21H ; Skip "POP BC" and "POP DE" PSUB: POP BC ; Get FP number from stack POP DE SUBCDE: CALL INVSGN ; Negate FPREG FPADD: LD A,B ; Get FP exponent OR A ; Is number zero? RET Z ; Yes - Nothing to add LD A,(FPEXP) ; Get FPREG exponent OR A ; Is this number zero? JP Z,FPBCDE ; Yes - Move BCDE to FPREG SUB B ; BCDE number larger? JP NC,NOSWAP ; No - Don't swap them CPL ; Two's complement INC A ; FP exponent EX DE,HL CALL STAKFP ; Put FPREG on stack EX DE,HL CALL FPBCDE ; Move BCDE to FPREG POP BC ; Restore number from stack POP DE NOSWAP: CP 24+1 ; Second number insignificant? RET NC ; Yes - First number is result PUSH AF ; Save number of bits to scale CALL SIGNS ; Set MSBs & sign of result LD H,A ; Save sign of result POP AF ; Restore scaling factor CALL SCALE ; Scale BCDE to same exponent OR H ; Result to be positive? LD HL,FPREG ; Point to FPREG JP P,MINCDE ; No - Subtract FPREG from CDE CALL PLUCDE ; Add FPREG to CDE JP NC,RONDUP ; No overflow - Round it up INC HL ; Point to exponent INC (HL) ; Increment it JP Z,OVERR ; Number overflowed - Error LD L,1 ; 1 bit to shift right CALL SHRT1 ; Shift result right JP RONDUP ; Round it up MINCDE: XOR A ; Clear A and carry SUB B ; Negate exponent LD B,A ; Re-save exponent LD A,(HL) ; Get LSB of FPREG SBC A, E ; Subtract LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG SBC A,D ; Subtract NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG SBC A,C ; Subtract MSB of BCDE LD C,A ; Save MSB of BCDE CONPOS: CALL C,COMPL ; Overflow - Make it positive BNORM: LD L,B ; L = Exponent LD H,E ; H = LSB XOR A BNRMLP: LD B,A ; Save bit count LD A,C ; Get MSB OR A ; Is it zero? JP NZ,PNORM ; No - Do it bit at a time LD C,D ; MSB = NMSB LD D,H ; NMSB= LSB LD H,L ; LSB = VLSB LD L,A ; VLSB= 0 LD A,B ; Get exponent SUB 8 ; Count 8 bits CP -24-8 ; Was number zero? JP NZ,BNRMLP ; No - Keep normalising RESZER: XOR A ; Result is zero SAVEXP: LD (FPEXP),A ; Save result as zero RET NORMAL: DEC B ; Count bits ADD HL,HL ; Shift HL left LD A,D ; Get NMSB RLA ; Shift left with last bit LD D,A ; Save NMSB LD A,C ; Get MSB ADC A,A ; Shift left with last bit LD C,A ; Save MSB PNORM: JP P,NORMAL ; Not done - Keep going LD A,B ; Number of bits shifted LD E,H ; Save HL in EB LD B,L OR A ; Any shifting done? JP Z,RONDUP ; No - Round it up LD HL,FPEXP ; Point to exponent ADD A,(HL) ; Add shifted bits LD (HL),A ; Re-save exponent JP NC,RESZER ; Underflow - Result is zero RET Z ; Result is zero RONDUP: LD A,B ; Get VLSB of number RONDB: LD HL,FPEXP ; Point to exponent OR A ; Any rounding? CALL M,FPROND ; Yes - Round number up LD B,(HL) ; B = Exponent INC HL LD A,(HL) ; Get sign of result AND 10000000B ; Only bit 7 needed XOR C ; Set correct sign LD C,A ; Save correct sign in number JP FPBCDE ; Move BCDE to FPREG FPROND: INC E ; Round LSB RET NZ ; Return if ok INC D ; Round NMSB RET NZ ; Return if ok INC C ; Round MSB RET NZ ; Return if ok LD C,80H ; Set normal value INC (HL) ; Increment exponent RET NZ ; Return if ok JP OVERR ; Overflow error PLUCDE: LD A,(HL) ; Get LSB of FPREG ADD A,E ; Add LSB of BCDE LD E,A ; Save LSB of BCDE INC HL LD A,(HL) ; Get NMSB of FPREG ADC A,D ; Add NMSB of BCDE LD D,A ; Save NMSB of BCDE INC HL LD A,(HL) ; Get MSB of FPREG ADC A,C ; Add MSB of BCDE LD C,A ; Save MSB of BCDE RET COMPL: LD HL,SGNRES ; Sign of result LD A,(HL) ; Get sign of result CPL ; Negate it LD (HL),A ; Put it back XOR A LD L,A ; Set L to zero SUB B ; Negate exponent,set carry LD B,A ; Re-save exponent LD A,L ; Load zero SBC A,E ; Negate LSB LD E,A ; Re-save LSB LD A,L ; Load zero SBC A,D ; Negate NMSB LD D,A ; Re-save NMSB LD A,L ; Load zero SBC A,C ; Negate MSB LD C,A ; Re-save MSB RET SCALE: LD B,0 ; Clear underflow SCALLP: SUB 8 ; 8 bits (a whole byte)? JP C,SHRITE ; No - Shift right A bits LD B,E ; <- Shift LD E,D ; <- right LD D,C ; <- eight LD C,0 ; <- bits JP SCALLP ; More bits to shift SHRITE: ADD A,8+1 ; Adjust count LD L,A ; Save bits to shift SHRLP: XOR A ; Flag for all done DEC L ; All shifting done? RET Z ; Yes - Return LD A,C ; Get MSB SHRT1: RRA ; Shift it right LD C,A ; Re-save LD A,D ; Get NMSB RRA ; Shift right with last bit LD D,A ; Re-save it LD A,E ; Get LSB RRA ; Shift right with last bit LD E,A ; Re-save it LD A,B ; Get underflow RRA ; Shift right with last bit LD B,A ; Re-save underflow JP SHRLP ; More bits to do UNITY: DB 000H,000H,000H,081H ; 1.00000 LOGTAB: DB 3 ; Table used by LOG DB 0AAH,056H,019H,080H ; 0.59898 DB 0F1H,022H,076H,080H ; 0.96147 DB 045H,0AAH,038H,082H ; 2.88539 LOG: CALL TSTSGN ; Test sign of value OR A JP PE,FCERR ; ?FC Error if <= zero LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent LD BC,8035H ; BCDE = SQR(1/2) LD DE,04F3H SUB B ; Scale value to be < 1 PUSH AF ; Save scale factor LD (HL),B ; Save new exponent PUSH DE ; Save SQR(1/2) PUSH BC CALL FPADD ; Add SQR(1/2) to value POP BC ; Restore SQR(1/2) POP DE INC B ; Make it SQR(2) CALL DVBCDE ; Divide by SQR(2) LD HL,UNITY ; Point to 1. CALL SUBPHL ; Subtract FPREG from 1 LD HL,LOGTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD BC,8080H ; BCDE = -0.5 LD DE,0000H CALL FPADD ; Subtract 0.5 from FPREG POP AF ; Restore scale factor CALL RSCALE ; Re-scale number MULLN2: LD BC,8031H ; BCDE = Ln(2) LD DE,7218H DB 21H ; Skip "POP BC" and "POP DE" MULT: POP BC ; Get number from stack POP DE FPMULT: CALL TSTSGN ; Test sign of FPREG RET Z ; Return zero if zero LD L,0 ; Flag add exponents CALL ADDEXP ; Add exponents LD A,C ; Get MSB of multiplier LD (MULVAL),A ; Save MSB of multiplier EX DE,HL LD (MULVAL+1),HL ; Save rest of multiplier LD BC,0 ; Partial product (BCDE) = zero LD D,B LD E,B LD HL,BNORM ; Address of normalise PUSH HL ; Save for return LD HL,MULT8 ; Address of 8 bit multiply PUSH HL ; Save for NMSB,MSB PUSH HL ; LD HL,FPREG ; Point to number MULT8: LD A,(HL) ; Get LSB of number INC HL ; Point to NMSB OR A ; Test LSB JP Z,BYTSFT ; Zero - shift to next byte PUSH HL ; Save address of number LD L,8 ; 8 bits to multiply by MUL8LP: RRA ; Shift LSB right LD H,A ; Save LSB LD A,C ; Get MSB JP NC,NOMADD ; Bit was zero - Don't add PUSH HL ; Save LSB and count LD HL,(MULVAL+1) ; Get LSB and NMSB ADD HL,DE ; Add NMSB and LSB EX DE,HL ; Leave sum in DE POP HL ; Restore MSB and count LD A,(MULVAL) ; Get MSB of multiplier ADC A,C ; Add MSB NOMADD: RRA ; Shift MSB right LD C,A ; Re-save MSB LD A,D ; Get NMSB RRA ; Shift NMSB right LD D,A ; Re-save NMSB LD A,E ; Get LSB RRA ; Shift LSB right LD E,A ; Re-save LSB LD A,B ; Get VLSB RRA ; Shift VLSB right LD B,A ; Re-save VLSB DEC L ; Count bits multiplied LD A,H ; Get LSB of multiplier JP NZ,MUL8LP ; More - Do it POPHRT: POP HL ; Restore address of number RET BYTSFT: LD B,E ; Shift partial product left LD E,D LD D,C LD C,A RET DIV10: CALL STAKFP ; Save FPREG on stack LD BC,8420H ; BCDE = 10. LD DE,0000H CALL FPBCDE ; Move 10 to FPREG DIV: POP BC ; Get number from stack POP DE DVBCDE: CALL TSTSGN ; Test sign of FPREG JP Z,DZERR ; Error if division by zero LD L,-1 ; Flag subtract exponents CALL ADDEXP ; Subtract exponents INC (HL) ; Add 2 to exponent to adjust INC (HL) DEC HL ; Point to MSB LD A,(HL) ; Get MSB of dividend LD (DIV3),A ; Save for subtraction DEC HL LD A,(HL) ; Get NMSB of dividend LD (DIV2),A ; Save for subtraction DEC HL LD A,(HL) ; Get MSB of dividend LD (DIV1),A ; Save for subtraction LD B,C ; Get MSB EX DE,HL ; NMSB,LSB to HL XOR A LD C,A ; Clear MSB of quotient LD D,A ; Clear NMSB of quotient LD E,A ; Clear LSB of quotient LD (DIV4),A ; Clear overflow count DIVLP: PUSH HL ; Save divisor PUSH BC LD A,L ; Get LSB of number CALL DIVSUP ; Subt' divisor from dividend SBC A,0 ; Count for overflows CCF JP NC,RESDIV ; Restore divisor if borrow LD (DIV4),A ; Re-save overflow count POP AF ; Scrap divisor POP AF SCF ; Set carry to DB 0D2H ; Skip "POP BC" and "POP HL" RESDIV: POP BC ; Restore divisor POP HL LD A,C ; Get MSB of quotient INC A DEC A RRA ; Bit 0 to bit 7 JP M,RONDB ; Done - Normalise result RLA ; Restore carry LD A,E ; Get LSB of quotient RLA ; Double it LD E,A ; Put it back LD A,D ; Get NMSB of quotient RLA ; Double it LD D,A ; Put it back LD A,C ; Get MSB of quotient RLA ; Double it LD C,A ; Put it back ADD HL,HL ; Double NMSB,LSB of divisor LD A,B ; Get MSB of divisor RLA ; Double it LD B,A ; Put it back LD A,(DIV4) ; Get VLSB of quotient RLA ; Double it LD (DIV4),A ; Put it back LD A,C ; Get MSB of quotient OR D ; Merge NMSB OR E ; Merge LSB JP NZ,DIVLP ; Not done - Keep dividing PUSH HL ; Save divisor LD HL,FPEXP ; Point to exponent DEC (HL) ; Divide by 2 POP HL ; Restore divisor JP NZ,DIVLP ; Ok - Keep going JP OVERR ; Overflow error ADDEXP: LD A,B ; Get exponent of dividend OR A ; Test it JP Z,OVTST3 ; Zero - Result zero LD A,L ; Get add/subtract flag LD HL,FPEXP ; Point to exponent XOR (HL) ; Add or subtract it ADD A,B ; Add the other exponent LD B,A ; Save new exponent RRA ; Test exponent for overflow XOR B LD A,B ; Get exponent JP P,OVTST2 ; Positive - Test for overflow ADD A,80H ; Add excess 128 LD (HL),A ; Save new exponent JP Z,POPHRT ; Zero - Result zero CALL SIGNS ; Set MSBs and sign of result LD (HL),A ; Save new exponent DEC HL ; Point to MSB RET OVTST1: CALL TSTSGN ; Test sign of FPREG CPL ; Invert sign POP HL ; Clean up stack OVTST2: OR A ; Test if new exponent zero OVTST3: POP HL ; Clear off return address JP P,RESZER ; Result zero JP OVERR ; Overflow error MLSP10: CALL BCDEFP ; Move FPREG to BCDE LD A,B ; Get exponent OR A ; Is it zero? RET Z ; Yes - Result is zero ADD A,2 ; Multiply by 4 JP C,OVERR ; Overflow - ?OV Error LD B,A ; Re-save exponent CALL FPADD ; Add BCDE to FPREG (Times 5) LD HL,FPEXP ; Point to exponent INC (HL) ; Double number (Times 10) RET NZ ; Ok - Return JP OVERR ; Overflow error TSTSGN: LD A,(FPEXP) ; Get sign of FPREG OR A RET Z ; RETurn if number is zero LD A,(FPREG+2) ; Get MSB of FPREG DB 0FEH ; Test sign RETREL: CPL ; Invert sign RLA ; Sign bit to carry FLGDIF: SBC A,A ; Carry to all bits of A RET NZ ; Return -1 if negative INC A ; Bump to +1 RET ; Positive - Return +1 SGN: CALL TSTSGN ; Test sign of FPREG FLGREL: LD B,80H+8 ; 8 bit integer in exponent LD DE,0 ; Zero NMSB and LSB RETINT: LD HL,FPEXP ; Point to exponent LD C,A ; CDE = MSB,NMSB and LSB LD (HL),B ; Save exponent LD B,0 ; CDE = integer to normalise INC HL ; Point to sign of result LD (HL),80H ; Set sign of result RLA ; Carry = sign of integer JP CONPOS ; Set sign of result ABS: CALL TSTSGN ; Test sign of FPREG RET P ; Return if positive INVSGN: LD HL,FPREG+2 ; Point to MSB LD A,(HL) ; Get sign of mantissa XOR 80H ; Invert sign of mantissa LD (HL),A ; Re-save sign of mantissa RET STAKFP: EX DE,HL ; Save code string address LD HL,(FPREG) ; LSB,NLSB of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return LD HL,(FPREG+2) ; MSB and exponent of FPREG EX (SP),HL ; Stack them,get return PUSH HL ; Re-save return EX DE,HL ; Restore code string address RET PHLTFP: CALL LOADFP ; Number at HL to BCDE FPBCDE: EX DE,HL ; Save code string address LD (FPREG),HL ; Save LSB,NLSB of number LD H,B ; Exponent of number LD L,C ; MSB of number LD (FPREG+2),HL ; Save MSB and exponent EX DE,HL ; Restore code string address RET BCDEFP: LD HL,FPREG ; Point to FPREG LOADFP: LD E,(HL) ; Get LSB of number INC HL LD D,(HL) ; Get NMSB of number INC HL LD C,(HL) ; Get MSB of number INC HL LD B,(HL) ; Get exponent of number INCHL: INC HL ; Used for conditional "INC HL" RET FPTHL: LD DE,FPREG ; Point to FPREG DETHL4: LD B,4 ; 4 bytes to move DETHLB: LD A,(DE) ; Get source LD (HL),A ; Save destination INC DE ; Next source INC HL ; Next destination DEC B ; Count bytes JP NZ,DETHLB ; Loop if more RET SIGNS: LD HL,FPREG+2 ; Point to MSB of FPREG LD A,(HL) ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD (HL),A ; Save new MSB CCF ; Complement sign RRA ; Old sign to carry INC HL INC HL LD (HL),A ; Set sign of result LD A,C ; Get MSB RLCA ; Old sign to carry SCF ; Set MSBit RRA ; Set MSBit of MSB LD C,A ; Save MSB RRA XOR (HL) ; New sign of result RET CMPNUM: LD A,B ; Get exponent of number OR A JP Z,TSTSGN ; Zero - Test sign of FPREG LD HL,RETREL ; Return relation routine PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD A,C ; Get MSB of number RET Z ; FPREG zero - Number's MSB LD HL,FPREG+2 ; MSB of FPREG XOR (HL) ; Combine signs LD A,C ; Get MSB of number RET M ; Exit if signs different CALL CMPFP ; Compare FP numbers RRA ; Get carry to sign XOR C ; Combine with MSB of number RET CMPFP: INC HL ; Point to exponent LD A,B ; Get exponent CP (HL) ; Compare exponents RET NZ ; Different DEC HL ; Point to MBS LD A,C ; Get MSB CP (HL) ; Compare MSBs RET NZ ; Different DEC HL ; Point to NMSB LD A,D ; Get NMSB CP (HL) ; Compare NMSBs RET NZ ; Different DEC HL ; Point to LSB LD A,E ; Get LSB SUB (HL) ; Compare LSBs RET NZ ; Different POP HL ; Drop RETurn POP HL ; Drop another RETurn RET FPINT: LD B,A ; <- Move LD C,A ; <- exponent LD D,A ; <- to all LD E,A ; <- bits OR A ; Test exponent RET Z ; Zero - Return zero PUSH HL ; Save pointer to number CALL BCDEFP ; Move FPREG to BCDE CALL SIGNS ; Set MSBs & sign of result XOR (HL) ; Combine with sign of FPREG LD H,A ; Save combined signs CALL M,DCBCDE ; Negative - Decrement BCDE LD A,80H+24 ; 24 bits SUB B ; Bits to shift CALL SCALE ; Shift BCDE LD A,H ; Get combined sign RLA ; Sign to carry CALL C,FPROND ; Negative - Round number up LD B,0 ; Zero exponent CALL C,COMPL ; If negative make positive POP HL ; Restore pointer to number RET DCBCDE: DEC DE ; Decrement BCDE LD A,D ; Test LSBs AND E INC A RET NZ ; Exit if LSBs not FFFF DEC BC ; Decrement MSBs RET INT: LD HL,FPEXP ; Point to exponent LD A,(HL) ; Get exponent CP 80H+24 ; Integer accuracy only? LD A,(FPREG) ; Get LSB RET NC ; Yes - Already integer LD A,(HL) ; Get exponent CALL FPINT ; F.P to integer LD (HL),80H+24 ; Save 24 bit integer LD A,E ; Get LSB of number PUSH AF ; Save LSB LD A,C ; Get MSB of number RLA ; Sign to carry CALL CONPOS ; Set sign of result POP AF ; Restore LSB of number RET MLDEBC: LD HL,0 ; Clear partial product LD A,B ; Test multiplier OR C RET Z ; Return zero if zero LD A,16 ; 16 bits MLDBLP: ADD HL,HL ; Shift P.P left JP C,BSERR ; ?BS Error if overflow EX DE,HL ADD HL,HL ; Shift multiplier left EX DE,HL JP NC,NOMLAD ; Bit was zero - No add ADD HL,BC ; Add multiplicand JP C,BSERR ; ?BS Error if overflow NOMLAD: DEC A ; Count bits JP NZ,MLDBLP ; More RET ASCTFP: CP "-" ; Negative? PUSH AF ; Save it and flags JP Z,CNVNUM ; Yes - Convert number CP "+" ; Positive? JP Z,CNVNUM ; Yes - Convert number DEC HL ; DEC 'cos GETCHR INCs CNVNUM: CALL RESZER ; Set result to zero LD B,A ; Digits after point counter LD D,A ; Sign of exponent LD E,A ; Exponent of ten CPL LD C,A ; Before or after point flag MANLP: CALL GETCHR ; Get next character JP C,ADDIG ; Digit - Add to number CP "." JP Z,DPOINT ; "." - Flag point CP "E" JP NZ,CONEXP ; Not "E" - Scale number CALL GETCHR ; Get next character CALL SGNEXP ; Get sign of exponent EXPLP: CALL GETCHR ; Get next character JP C,EDIGIT ; Digit - Add to exponent INC D ; Is sign negative? JP NZ,CONEXP ; No - Scale number XOR A SUB E ; Negate exponent LD E,A ; And re-save it INC C ; Flag end of number DPOINT: INC C ; Flag point passed JP Z,MANLP ; Zero - Get another digit CONEXP: PUSH HL ; Save code string address LD A,E ; Get exponent SUB B ; Subtract digits after point SCALMI: CALL P,SCALPL ; Positive - Multiply number JP P,ENDCON ; Positive - All done PUSH AF ; Save number of times to /10 CALL DIV10 ; Divide by 10 POP AF ; Restore count INC A ; Count divides ENDCON: JP NZ,SCALMI ; More to do POP DE ; Restore code string address POP AF ; Restore sign of number CALL Z,INVSGN ; Negative - Negate number EX DE,HL ; Code string address to HL RET SCALPL: RET Z ; Exit if no scaling needed MULTEN: PUSH AF ; Save count CALL MLSP10 ; Multiply number by 10 POP AF ; Restore count DEC A ; Count multiplies RET ADDIG: PUSH DE ; Save sign of exponent LD D,A ; Save digit LD A,B ; Get digits after point ADC A,C ; Add one if after point LD B,A ; Re-save counter PUSH BC ; Save point flags PUSH HL ; Save code string address PUSH DE ; Save digit CALL MLSP10 ; Multiply number by 10 POP AF ; Restore digit SUB "0" ; Make it absolute CALL RSCALE ; Re-scale number POP HL ; Restore code string address POP BC ; Restore point flags POP DE ; Restore sign of exponent JP MANLP ; Get another digit RSCALE: CALL STAKFP ; Put number on stack CALL FLGREL ; Digit to add to FPREG PADD: POP BC ; Restore number POP DE JP FPADD ; Add BCDE to FPREG and return EDIGIT: LD A,E ; Get digit RLCA ; Times 2 RLCA ; Times 4 ADD A,E ; Times 5 RLCA ; Times 10 ADD A,(HL) ; Add next digit SUB "0" ; Make it absolute LD E,A ; Save new digit JP EXPLP ; Look for another digit LINEIN: PUSH HL ; Save code string address LD HL,INMSG ; Output " in " CALL PRS ; Output string at HL POP HL ; Restore code string address PRNTHL: EX DE,HL ; Code string address to DE XOR A LD B,80H+24 ; 24 bits CALL RETINT ; Return the integer LD HL,PRNUMS ; Print number string PUSH HL ; Save for return NUMASC: LD HL,PBUFF ; Convert number to ASCII PUSH HL ; Save for return CALL TSTSGN ; Test sign of FPREG LD (HL)," " ; Space at start JP P,SPCFST ; Positive - Space to start LD (HL),"-" ; "-" sign at start SPCFST: INC HL ; First byte of number LD (HL),"0" ; "0" if zero JP Z,JSTZER ; Return "0" if zero PUSH HL ; Save buffer address CALL M,INVSGN ; Negate FPREG if negative XOR A ; Zero A PUSH AF ; Save it CALL RNGTST ; Test number is in range SIXDIG: LD BC,9143H ; BCDE - 99999.9 LD DE,4FF8H CALL CMPNUM ; Compare numbers OR A JP PO,INRNG ; > 99999.9 - Sort it out POP AF ; Restore count CALL MULTEN ; Multiply by ten PUSH AF ; Re-save count JP SIXDIG ; Test it again GTSIXD: CALL DIV10 ; Divide by 10 POP AF ; Get count INC A ; Count divides PUSH AF ; Re-save count CALL RNGTST ; Test number is in range INRNG: CALL ROUND ; Add 0.5 to FPREG INC A CALL FPINT ; F.P to integer CALL FPBCDE ; Move BCDE to FPREG LD BC,0306H ; 1E+06 to 1E-03 range POP AF ; Restore count ADD A,C ; 6 digits before point INC A ; Add one JP M,MAKNUM ; Do it in "E" form if < 1E-02 CP 6+1+1 ; More than 999999 ? JP NC,MAKNUM ; Yes - Do it in "E" form INC A ; Adjust for exponent LD B,A ; Exponent of number LD A,2 ; Make it zero after MAKNUM: DEC A ; Adjust for digits to do DEC A POP HL ; Restore buffer address PUSH AF ; Save count LD DE,POWERS ; Powers of ten DEC B ; Count digits before point JP NZ,DIGTXT ; Not zero - Do number LD (HL),"." ; Save point INC HL ; Move on LD (HL),"0" ; Save zero INC HL ; Move on DIGTXT: DEC B ; Count digits before point LD (HL),"." ; Save point in case CALL Z,INCHL ; Last digit - move on PUSH BC ; Save digits before point PUSH HL ; Save buffer address PUSH DE ; Save powers of ten CALL BCDEFP ; Move FPREG to BCDE POP HL ; Powers of ten table LD B, "0"-1 ; ASCII "0" - 1 TRYAGN: INC B ; Count subtractions LD A,E ; Get LSB SUB (HL) ; Subtract LSB LD E,A ; Save LSB INC HL LD A,D ; Get NMSB SBC A,(HL) ; Subtract NMSB LD D,A ; Save NMSB INC HL LD A,C ; Get MSB SBC A,(HL) ; Subtract MSB LD C,A ; Save MSB DEC HL ; Point back to start DEC HL JP NC,TRYAGN ; No overflow - Try again CALL PLUCDE ; Restore number INC HL ; Start of next number CALL FPBCDE ; Move BCDE to FPREG EX DE,HL ; Save point in table POP HL ; Restore buffer address LD (HL),B ; Save digit in buffer INC HL ; And move on POP BC ; Restore digit count DEC C ; Count digits JP NZ,DIGTXT ; More - Do them DEC B ; Any decimal part? JP Z,DOEBIT ; No - Do "E" bit SUPTLZ: DEC HL ; Move back through buffer LD A,(HL) ; Get character CP "0" ; "0" character? JP Z,SUPTLZ ; Yes - Look back for more CP "." ; A decimal point? CALL NZ,INCHL ; Move back over digit DOEBIT: POP AF ; Get "E" flag JP Z,NOENED ; No "E" needed - End buffer LD (HL),"E" ; Put "E" in buffer INC HL ; And move on LD (HL),"+" ; Put '+' in buffer JP P,OUTEXP ; Positive - Output exponent LD (HL),"-" ; Put "-" in buffer CPL ; Negate exponent INC A OUTEXP: LD B,"0"-1 ; ASCII "0" - 1 EXPTEN: INC B ; Count subtractions SUB 10 ; Tens digit JP NC,EXPTEN ; More to do ADD A,"0"+10 ; Restore and make ASCII INC HL ; Move on LD (HL),B ; Save MSB of exponent JSTZER: INC HL ; LD (HL),A ; Save LSB of exponent INC HL NOENED: LD (HL),C ; Mark end of buffer POP HL ; Restore code string address RET RNGTST: LD BC,9474H ; BCDE = 999999. LD DE,23F7H CALL CMPNUM ; Compare numbers OR A POP HL ; Return address to HL JP PO,GTSIXD ; Too big - Divide by ten JP (HL) ; Otherwise return to caller HALF: DB 00H,00H,00H,80H ; 0.5 POWERS: DB 0A0H,086H,001H ; 100000 DB 010H,027H,000H ; 10000 DB 0E8H,003H,000H ; 1000 DB 064H,000H,000H ; 100 DB 00AH,000H,000H ; 10 DB 001H,000H,000H ; 1 NEGAFT: LD HL,INVSGN ; Negate result EX (SP),HL ; To be done after caller JP (HL) ; Return to caller SQR: CALL STAKFP ; Put value on stack LD HL,HALF ; Set power to 1/2 CALL PHLTFP ; Move 1/2 to FPREG POWER: POP BC ; Get base POP DE CALL TSTSGN ; Test sign of power LD A,B ; Get exponent of base JP Z,EXP ; Make result 1 if zero JP P,POWER1 ; Positive base - Ok OR A ; Zero to negative power? JP Z,DZERR ; Yes - ?/0 Error POWER1: OR A ; Base zero? JP Z,SAVEXP ; Yes - Return zero PUSH DE ; Save base PUSH BC LD A,C ; Get MSB of base OR 01111111B ; Get sign status CALL BCDEFP ; Move power to BCDE JP P,POWER2 ; Positive base - Ok PUSH DE ; Save power PUSH BC CALL INT ; Get integer of power POP BC ; Restore power POP DE PUSH AF ; MSB of base CALL CMPNUM ; Power an integer? POP HL ; Restore MSB of base LD A,H ; but don't affect flags RRA ; Exponent odd or even? POWER2: POP HL ; Restore MSB and exponent LD (FPREG+2),HL ; Save base in FPREG POP HL ; LSBs of base LD (FPREG),HL ; Save in FPREG CALL C,NEGAFT ; Odd power - Negate result CALL Z,INVSGN ; Negative base - Negate it PUSH DE ; Save power PUSH BC CALL LOG ; Get LOG of base POP BC ; Restore power POP DE CALL FPMULT ; Multiply LOG by power EXP: CALL STAKFP ; Put value on stack LD BC,08138H ; BCDE = 1/Ln(2) LD DE,0AA3BH CALL FPMULT ; Multiply value by 1/LN(2) LD A,(FPEXP) ; Get exponent CP 80H+8 ; Is it in range? JP NC,OVTST1 ; No - Test for overflow CALL INT ; Get INT of FPREG ADD A,80H ; For excess 128 ADD A,2 ; Exponent > 126? JP C,OVTST1 ; Yes - Test for overflow PUSH AF ; Save scaling factor LD HL,UNITY ; Point to 1. CALL ADDPHL ; Add 1 to FPREG CALL MULLN2 ; Multiply by LN(2) POP AF ; Restore scaling factor POP BC ; Restore exponent POP DE PUSH AF ; Save scaling factor CALL SUBCDE ; Subtract exponent from FPREG CALL INVSGN ; Negate result LD HL,EXPTAB ; Coefficient table CALL SMSER1 ; Sum the series LD DE,0 ; Zero LSBs POP BC ; Scaling factor LD C,D ; Zero MSB JP FPMULT ; Scale result to correct value EXPTAB: DB 8 ; Table used by EXP DB 040H,02EH,094H,074H ; -1/7! (-1/5040) DB 070H,04FH,02EH,077H ; 1/6! ( 1/720) DB 06EH,002H,088H,07AH ; -1/5! (-1/120) DB 0E6H,0A0H,02AH,07CH ; 1/4! ( 1/24) DB 050H,0AAH,0AAH,07EH ; -1/3! (-1/6) DB 0FFH,0FFH,07FH,07FH ; 1/2! ( 1/2) DB 000H,000H,080H,081H ; -1/1! (-1/1) DB 000H,000H,000H,081H ; 1/0! ( 1/1) SUMSER: CALL STAKFP ; Put FPREG on stack LD DE,MULT ; Multiply by "X" PUSH DE ; To be done after PUSH HL ; Save address of table CALL BCDEFP ; Move FPREG to BCDE CALL FPMULT ; Square the value POP HL ; Restore address of table SMSER1: CALL STAKFP ; Put value on stack LD A,(HL) ; Get number of coefficients INC HL ; Point to start of table CALL PHLTFP ; Move coefficient to FPREG DB 06H ; Skip "POP AF" SUMLP: POP AF ; Restore count POP BC ; Restore number POP DE DEC A ; Cont coefficients RET Z ; All done PUSH DE ; Save number PUSH BC PUSH AF ; Save count PUSH HL ; Save address in table CALL FPMULT ; Multiply FPREG by BCDE POP HL ; Restore address in table CALL LOADFP ; Number at HL to BCDE PUSH HL ; Save address in table CALL FPADD ; Add coefficient to FPREG POP HL ; Restore address in table JP SUMLP ; More coefficients RND: CALL TSTSGN ; Test sign of FPREG LD HL,SEED+2 ; Random number seed JP M,RESEED ; Negative - Re-seed LD HL,LSTRND ; Last random number CALL PHLTFP ; Move last RND to FPREG LD HL,SEED+2 ; Random number seed RET Z ; Return if RND(0) ADD A,(HL) ; Add (SEED)+2) AND 00000111B ; 0 to 7 LD B,0 LD (HL),A ; Re-save seed INC HL ; Move to coefficient table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to coefficient CALL LOADFP ; Coefficient to BCDE CALL FPMULT ; ; Multiply FPREG by coefficient LD A,(SEED+1) ; Get (SEED+1) INC A ; Add 1 AND 00000011B ; 0 to 3 LD B,0 CP 1 ; Is it zero? ADC A,B ; Yes - Make it 1 LD (SEED+1),A ; Re-save seed LD HL,RNDTAB-4 ; Addition table ADD A,A ; 4 bytes ADD A,A ; per entry LD C,A ; BC = Offset into table ADD HL,BC ; Point to value CALL ADDPHL ; Add value to FPREG RND1: CALL BCDEFP ; Move FPREG to BCDE LD A,E ; Get LSB LD E,C ; LSB = MSB XOR 01001111B ; Fiddle around LD C,A ; New MSB LD (HL),80H ; Set exponent DEC HL ; Point to MSB LD B,(HL) ; Get MSB LD (HL),80H ; Make value -0.5 LD HL,SEED ; Random number seed INC (HL) ; Count seed LD A,(HL) ; Get seed SUB 171 ; Do it modulo 171 JP NZ,RND2 ; Non-zero - Ok LD (HL),A ; Zero seed INC C ; Fillde about DEC D ; with the INC E ; number RND2: CALL BNORM ; Normalise number LD HL,LSTRND ; Save random number JP FPTHL ; Move FPREG to last and return RESEED: LD (HL),A ; Re-seed random numbers DEC HL LD (HL),A DEC HL LD (HL),A JP RND1 ; Return RND seed RNDTAB: DB 068H,0B1H,046H,068H ; Table used by RND DB 099H,0E9H,092H,069H DB 010H,0D1H,075H,068H COS: LD HL,HALFPI ; Point to PI/2 CALL ADDPHL ; Add it to PPREG SIN: CALL STAKFP ; Put angle on stack LD BC,8349H ; BCDE = 2 PI LD DE,0FDBH CALL FPBCDE ; Move 2 PI to FPREG POP BC ; Restore angle POP DE CALL DVBCDE ; Divide angle by 2 PI CALL STAKFP ; Put it on stack CALL INT ; Get INT of result POP BC ; Restore number POP DE CALL SUBCDE ; Make it 0 <= value < 1 LD HL,QUARTR ; Point to 0.25 CALL SUBPHL ; Subtract value from 0.25 CALL TSTSGN ; Test sign of value SCF ; Flag positive JP P,SIN1 ; Positive - Ok CALL ROUND ; Add 0.5 to value CALL TSTSGN ; Test sign of value OR A ; Flag negative SIN1: PUSH AF ; Save sign CALL P,INVSGN ; Negate value if positive LD HL,QUARTR ; Point to 0.25 CALL ADDPHL ; Add 0.25 to value POP AF ; Restore sign CALL NC,INVSGN ; Negative - Make positive LD HL,SINTAB ; Coefficient table JP SUMSER ; Evaluate sum of series HALFPI: DB 0DBH,00FH,049H,081H ; 1.5708 (PI/2) QUARTR: DB 000H,000H,000H,07FH ; 0.25 SINTAB: DB 5 ; Table used by SIN DB 0BAH,0D7H,01EH,086H ; 39.711 DB 064H,026H,099H,087H ;-76.575 DB 058H,034H,023H,087H ; 81.602 DB 0E0H,05DH,0A5H,086H ;-41.342 DB 0DAH,00FH,049H,083H ; 6.2832 TAN: CALL STAKFP ; Put angle on stack CALL SIN ; Get SIN of angle POP BC ; Restore angle POP HL CALL STAKFP ; Save SIN of angle EX DE,HL ; BCDE = Angle CALL FPBCDE ; Angle to FPREG CALL COS ; Get COS of angle JP DIV ; TAN = SIN / COS ATN: CALL TSTSGN ; Test sign of value CALL M,NEGAFT ; Negate result after if -ve CALL M,INVSGN ; Negate value if -ve LD A,(FPEXP) ; Get exponent CP 81H ; Number less than 1? JP C,ATN1 ; Yes - Get arc tangnt LD BC,8100H ; BCDE = 1 LD D,C LD E,C CALL DVBCDE ; Get reciprocal of number LD HL,SUBPHL ; Sub angle from PI/2 PUSH HL ; Save for angle > 1 ATN1: LD HL,ATNTAB ; Coefficient table CALL SUMSER ; Evaluate sum of series LD HL,HALFPI ; PI/2 - angle in case > 1 RET ; Number > 1 - Sub from PI/2 ATNTAB: DB 9 ; Table used by ATN DB 04AH,0D7H,03BH,078H ; 1/17 DB 002H,06EH,084H,07BH ;-1/15 DB 0FEH,0C1H,02FH,07CH ; 1/13 DB 074H,031H,09AH,07DH ;-1/11 DB 084H,03DH,05AH,07DH ; 1/9 DB 0C8H,07FH,091H,07EH ;-1/7 DB 0E4H,0BBH,04CH,07EH ; 1/5 DB 06CH,0AAH,0AAH,07FH ;-1/3 DB 000H,000H,000H,081H ; 1/1 CASFFW: CALL FLPLED ; Turn on cassette LD B,0 ; Set 1 second delay DELAYB: CALL DELAY ; Wait a bit DEC B ; Count JP NZ,DELAYB ; More delay needed RET CASFF: JP FLPLED ; Flip tape LED ARET: RET ; A RETurn instruction CONMON: PUSH HL ; Output character to screen PUSH BC ; PUSH DE ; PUSH AF ; CALL MONTST ; See if NAS-SYS JP NZ,NASOUT ; NAS-SYS - Output ASCII POP AF ; Get character PUSH AF ; And re-save CP LF ; ASCII Line feed? JP Z,IGCHR ; Yes - Ignore it CP BKSP ; ASCII back space? JP NZ,CONOT1 ; No - Test for CR LD A,TBS ; NASBUG back space CONOT1: CP CR ; ASCII CR? JP NZ,OUTCHR ; No - Output character LD A,TCR ; NASBUG CR JP OUTCHR ; Output it NASOUT: POP AF ; Get character PUSH AF ; And re-save OUTCHR: CALL MONOUT ; Output it IGCHR: POP AF ; Restore character POP DE ; POP BC ; POP HL ; RET GETINP: PUSH HL ; Get an input character PUSH BC ; PUSH DE ; CALL MONTST ; See if NAS-SYS JP Z,GETTIN ; "T" monitor - Get input DW _BLNK JP CONVIN ; Convert to ASCII GETTIN: CALL TIN ; "T" input a character JP NC,GETTIN ; No input - wait CONVIN: CP TBS ; NASBUG back space? JP NZ,CNVIN1 ; No - Test for break LD A,BKSP ; ASCII back space CNVIN1: CP TBRK ; NASBUG break? JP NZ,CNVIN2 ; No - Test for control Z LD A,CTRLC ; Control C CNVIN2: CP CTRLZ ; ^Z? JP NZ,CNVIN3 ; No - Test for escape LD A,DEL ; Delete CNVIN3: CP ESC ; "ESC" ? JP NZ,CNVIN4 ; No - Test for CR LD A,CTRLC ; Control C CNVIN4: CP TCR ; NASBUG CR? JP NZ,CNVIN5 ; No - Return character LD A,CR ; ASCII CR CNVIN5: POP DE POP BC POP HL RET CHKBRK: XOR A ; Check for break CALL SFTENT ; Test for shift/enter JP Z,TBRK2 ; Yes - Test for second break LD A,(BRKFLG) ; Get break flag OR A ; Break flag set? JP NZ,TBRK2 ; Yes - Test for second break XOR A ; Flag no break RET TBRK2: CALL BREAK2 ; Second break? LD A,-1 ; Flag break RET GUART: IN A,(UARTS) ; Get UART status RLA ; Any data ready? JP NC,GUART ; No - wait until there is IN A,(UARTD) ; Get data from UART RET UARTOT: OUT (UARTD),A ; Send data to UART URTOLP: IN A,(UARTS) ; Get status ADD A,A ; Byte sent? RET M ; Yes - Return JP URTOLP ; Keep waiting SUART: PUSH AF ; Save A CALL UARTOT ; Send it to UART POP AF ; Restore A RET NOP NOP SFTENT: PUSH HL ; Test for Shift Enter from KBD LD A,00000010B ; Reset KBD counter mask LD HL,PORT0 ; Get old contents XOR (HL) ; Toggle bit OUT (0),A ; Reset KBD counter XOR 00000001B ; Toggle bit OUT (0),A ; Next row XOR 00000010B OUT (0),A ; Clear "clear" strobe LD A,(HL) ; Get old value OUT (0),A ; Original contents ADD HL,DE ; ?? WHAT ?? POP HL ; Restore HL IN A,(0) ; Read in row AND 00010010B ; Mask SHIFT and ENTER RET CLS: CALL MONTST ; See if NAS-SYS JP Z,TCLS ; "T" CLS LD A,CS ; ASCII Clear screen JP CONMON ; Output character TCLS: LD A,TCS ; NASBUG Clear screen JP CONMON ; Output character DELAY: XOR A ; Delay routine DELAY1: PUSH AF ; PUSHes and POPs delay POP AF PUSH AF POP AF DEC A ; Count delays JP NZ,DELAY1 ; More delay RET WIDTH: CALL GETINT ; Get integer 0-255 LD A,E ; Width to A LD (LWIDTH),A ; Set width RET LINES: CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 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 DB "," CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 EX (SP),HL ; Save value,get address LD (HL),E ; Save LSB of value INC HL LD (HL),D ; Save MSB of value POP HL ; Restore code string address RET JJUMP1: DI ; Disable interrupts LD IX,-1 ; Flag cold start JP CSTART ; Go and initialise SCREEN: CALL GETINT ; Get integer 0 to 255 PUSH AF ; Save column CALL CHKSYN ; Make sure "," follows DB "," CALL GETINT ; Get integer 0 to 255 POP BC ; Column to B PUSH HL ; Save code string address PUSH BC ; Save column CALL SCRADR ; Calculate screen address PUSH HL ; Save screen address CALL MONTST ; See if NAS-SYS JP Z,TMNCUR ; "T" monitor - "T" cursor POP HL ; Restore screen address LD (CURSOR),HL ; Set new cursor position POP HL ; Rstore code string address RET TMNCUR: LD HL,(TCUR) ; Get address or cursor LD (HL)," " ; Remove cursor POP HL ; Get new cursor address LD (TCUR),HL ; Set new cursor LD (HL),"_" ; Put it on screen POP HL ; Restore code string address RET SCRADR: LD HL,VDU+10-65 ; SCREEN VDU address (0,0) LD B,0 LD C,A ; Line to BC OR A ; Test it JP Z,FCERR ; Zero - ?FC Error CP 16+1 ; 16 lines JP P,FCERR ; > 16 - ?FC Error POP DE ; RETurn address POP AF ; Get column PUSH DE ; Re-save RETurn LD D,0 LD E,A ; Column to DE OR A ; Test it JP Z,FCERR ; Zero - ?FC Error CP 48+1 ; 48 characters per line JP P,FCERR ; > 48 - ?FC Error ADD HL,DE ; Add column to address LD D,0 LD E,C ; Line to DE LD B,64 ; 64 Bytes per line ADD64X: ADD HL,DE ; Add line DJNZ ADD64X ; SIXTY FOUR TIMES!!! RET FLPLED: CALL MONTST ; See if NAS-SYS JP Z,TMFLP ; "T" MFLP DW _MFLP RET TMFLP: JP MFLP ; Flip drive LED MONOUT: PUSH AF ; Save character CALL MONTST ; See if NAS-SYS JP Z,TMNOUT ; "T" output POP AF ; Restore character DB _ROUT ; Output it RET TMNOUT: POP AF ; Restore character JP TOUT ; "T" output BREAK2: LD A,(BRKFLG) ; Break flag set? JP NZ,RETCTC ; Yes - Return ^C CALL MONTST ; See if NAS-SYS JP Z,TCHINP ; Get "T" character input DW _RIN ; Scan for a character RET TCHINP: JP TIN ; "T" input a character RETCTC: LD A,0 ; Clear Break flag LD (BRKFLG),A LD A,CTRLC ; Return ^C RET MONTST: LD A,(MONSTT+1) ; "T" monitor or NAS-SYS? CP 33H ; 31 00 10 / 31 33 0C RET SAVE: CALL FLPLED ; Flip tape LED CALL MONTST ; See if NAS-SYS JP Z,TSAVE ; "T" save DW _WRIT ; Save program RET TSAVE: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) JP Z,T4WR ; T4 Write JP T2DUMP ; T2 Dump MONLD: CALL FLPLED ; Flip tape LED CALL MONTST ; See if NAS-SYS JP Z,TLOAD ; "T" load LD A,"R" ; Set READ LD (ARGN),A DW _READ ; Load program RET TLOAD: LD A,(MONTYP) ; "T2" or "T4" (FLAGS!!!) JP Z,T4READ ; T4 Read JP T2DUMP ; T2 Dump ?????????? MONITR: CALL MONTST ; See if NAS-SYS JP Z,MONSTT ; Jump to zero if "T" DW _MRET ; Return to NAS-SYS MONVE: CALL FLPLED ; Flip tape LED CALL MONTST ; See if NAS-SYS JP Z,FCERR ; Verify not available on "T" LD A,"V" ; Set VERIFY LD (ARGN),A DW _VRFY ; Verify tape RET INITST: LD A,0 ; Clear break flag LD (BRKFLG),A CALL MONTST ; See if NAS-SYS JP Z,INIT ; "T" - No NMI vector LD HL,BREAK ; Set NMI gives break LD (NMI),HL PUSH IX ; Get start up condition POP AF ; "Z" set if cold , Else clear OR A ; "Cold" or "Cool" start? JP NZ,INIT ; "Cool" don't init NAS-SYS LD B,15 ; Delay for keyboard clear CALL DELAYB ; Allow time for key release CALL STMON ; Initialise NAS-SYS JP INIT ; Initialise BASIC BREAK: PUSH AF ; Save character LD A,-1 LD (BRKFLG),A ; Flag break POP AF ; Restore character ARETN: RETN ; Return from NMI NOP INLINE: DW _INLN ; Get an input line PUSH DE ; Save cursor address PUSH DE ; Cursor address to HL POP HL LD DE,48-1 ; Length of line-1 ADD HL,DE ; Point to end of line ENDLIN: LD A,(HL) ; Get end of line CP " " ; Space? JP NZ,LINTBF ; No - Copy to buffer DEC E ; Back 1 character LD A,0 ; Wasteful test on E OR E JP Z,LINTBF ; Start of line - Copy it DEC HL ; Back 1 character JP ENDLIN ; Keep looking for end LINTBF: PUSH DE ; Line length to BC POP BC INC BC ; Length +1 LD DE,BUFFER ; Input buffer POP HL ; Line start PUSH BC ; Save length LDIR ; Move line to buffer LD A,0 LD (DE),A ; Mark end of buffer with 00 POP BC ; Restore buffer length LD B,C ; Length returned in B LD HL,BUFFER-1 ; Point to start of buffer-1 RET GETXYA: CALL CHKSYN ; Make sure "(" follows DB "(" CALL GETNUM ; Get a number CALL DEINT ; Get integer -32768 to 32767 PUSH DE ; Save "X" CALL CHKSYN ; Make sure "," follows DB "," CALL GETNUM ; Get a number CALL CHKSYN ; Make sure ")" follows DB ")" CALL DEINT ; Get integer -32768 to 32767 PUSH HL ; Save code string address POP IY ; In IY CALL XYPOS ; Address and bit mask PUSH AF ; Save mask CALL ADJCOL ; Adjust column CALL SCRADR ; Get VDU address POP AF ; Restore bit mask LD B,11000000B ; Block graphics base OR B ; Set bits 7 & 6 RET SETB: CALL GETXYA ; Get co-ords and VDU address PUSH AF ; Save bit mask LD A,(HL) ; Get character from screen CP 11000000B ; Is it a block graphic? JP NC,SETOR ; Yes - OR new bit POP AF ; Restore bit mask PUTBIT: LD (HL),A ; Put character on screen RESCSA: PUSH IY ; Restore code string address POP HL ; From IY RET SETOR: POP BC ; Restore bit mask OR B ; Merge the bits JP PUTBIT ; Save on screen RESETB: CALL GETXYA ; Get co-ords and VDU address PUSH AF ; Save bit mask LD A,(HL) ; Get byte from screen CP 11000000B ; Is it a block graphic? JP C,NORES ; No - Leave it LD B,00111111B ; Six bits per block AND B ; Clear bits 7 & 6 POP BC ; Get bit mask AND B ; Test for common bit JP Z,RESCSA ; None - Leave it LD A,(HL) ; Get byte from screen AND 00111111B ; Isolate bit XOR B ; Clear that bit CP 11000000B ; Is it a graphic blank? JP NZ,PUTBIT ; No - Save character LD A," " ; Put a space there JP PUTBIT ; Save the space NORES: POP BC ; Drop bit mask JP RESCSA ; Restore code string address POINTB: CALL GETXYA ; Get co-ords and VDU address LD B,(HL) ; Get character from screen CALL TSTBIT ; Test if bit is set JP NZ,POINT0 ; Different - Return zero LD A,0 LD B,1 ; Integer AB = 1 POINTX: POP HL ; Drop return PUSH IY ; PUSH code string address LD DE,RETNUM ; To return a number PUSH DE ; Save for return JP ABPASS ; Return integer AB POINT0: LD B,0 ; Set zero JP POINTX ; Return value XYPOS: POP BC ; Get return address POP HL ; Get column PUSH HL ; And re-save PUSH BC ; Put back return address LD A,L ; Get column LD B,00000001B ; 2 bits per character AND B ; Odd or even bit PUSH AF ; Save it PUSH DE ; Get row POP HL ; to HL LD DE,0 ; Zero line count LD BC,3 ; 3 blocks per line INC HL DIV3LP: SBC HL,BC ; Subtract 3 INC DE ; Count the subtractions JP Z,DIV3EX ; Exactly - Exit JP P,DIV3LP ; More to do DIV3EX: ADD HL,BC ; Restore number POP AF ; Restore column and odd/even OR A ; Set flags (NZ or Z) LD A,L ; Get remainder from /3 JP Z,NOREMD ; No remainder ADD A,3 ; Adjust remainder NOREMD: LD B,A ; Bit number+1 to B LD A,00000001B ; Bit to rotate SHFTBT: RLCA ; Shift bit left DJNZ SHFTBT ; Count shifts RRA ; Restore correct place RET ADJCOL: POP BC ; Restore return address POP AF ; Get bit mask POP HL ; Get column PUSH AF ; Re-save but mask LD A,L ; Get column RRA ; Divide by 2 ADD A,1 ; Start at column 1 AND 00111111B ; 0 to 63 LD H,A ; Save column in H PUSH HL ; Re-save column PUSH BC ; Put back return LD A,E ; Get row RET SMOTOR: CALL CASFF ; Flip tape drive LD A,(HL) ; Get byte RET JPLDSV: LD A,(BRKLIN) ; CLOAD or CSAVE? CP -1 JP NZ,SNDHDR ; CSAVE - Send header JP GETHDR ; CLOAD - Get header CRLIN1: CALL PRNTCR ; Output CRLF JP GETLIN ; Get an input line CRLIN: CALL PRNTCR ; Output CRLF JP GETLIN ; Get an input line TSTBIT: PUSH AF ; Save bit mask AND B ; Get common bits POP BC ; Restore bit mask CP B ; Same bit set? LD A,0 ; Return 0 in A RET OUTNCR: CALL OUTC ; Output character in A JP PRNTCR ; Output CRLF JJUMP: JP JJUMP1 ; "Cool" start ZJUMP: JP BRKRET ; Warm start END