; 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