; ; Tiny BASIC Extended by Dick Whipple ; ; Date: 01/12/2017 ; ; Base on version originally published in ; Dr. Dobb's Journal Jauary 1976 ; SIM EQU 1 ;SET TO 1 FOR SIMULATION OR 0 FOR ALTAIR LFNEED EQU 0 ;SET TO 1 IF LINEFEED NEEDED, 0 OTHERWISE LLINES EQU 16 ;NUMBER OF LINES TO LIST BEFORE STOP ; MEMEND EQU 0x3EFF ;BYTES OF PROGRAM MEMORY (16K LEAVING 256 BYTES FOR BOOT) ZWIDTH EQU 15 ;WIDTH OF ZONE FOR COMMA (ZONE SPACING) IN PRINT STATEMENT ; ORG 0x0000 ; JMP CSTART ;COLD START ENTRY POINT JMP WSTART ;WARM START ENTRY POINT (PRESERVES PROGRAM) ; CSTART: LXI SP,0x4000 ;COLD START CALL CLRSCR ;CLEAR SCREEN AND SEND SIGNON MESSSAGE LXI H,CSMSG CALL MSGOUT ; CSTARTC:CALL CRLF JMP ILXQT ; CSMSG: .asciz 'TINY BASIC - WHIPPLE VERSION 1.0' db 0 ; MSGOUT: MOV A,M ;OUTPUT MESSAGE AT HL UNTIL END-OF-MESSAGE BYTE = 0 ORA A RZ CALL CHROUT INX H JMP MSGOUT ; WSTART: LXI SP,0X4000 ;WARM START - RESET STACKS ONLY LXI H,AESTK ;RESET ARITHMETIC STACK SHLD AELVL LXI H,SBRSTK ;RESET SUBROUTINE STACK LXI H,NEWLNE ;START AT NEW BASIC LINE (NO INITIALIZATION) JMP NXTIL ; ; INIT - INITIALIZE SYSTEM VALUES ON STARTUP AND CLEAR COMMAND ; INIT: LXI H,IDATA ;COPY INITIALIZE DATA TO SYSTEM TABLE LXI B,CURLBL INITL: MOV A,M STAX B MOV A,L CPI lo(IDATAE) JZ ZEROVAR INX H INX B JMP INITL ZEROVAR:LXI H,VARSTRT ;ZERO A-Z VARIABLES MVI A, 26*2 INITCL: MVI M,0 INX H DCR A JNZ INITCL RET ; ; INITIALIZE DATA ; IDATA: DW 0x0000 ;CURRENT LABEL DW PRGMEM ;FIRST BYTE OF PROGRAM DW PRGMEM ;LAST BYTE OF PROGRAM DB 1 ;LENGTH OF TEXT IN BUFFER DB 0x20 ;NOT USED (ARTIFACT OF BAUDOT TO ASCII CONVERSION) DB ZWIDTH ;ZONE SET TO ZONE WIDTH DW AESTK ;ARITHMETIC EXPRESSION LEVEL STARTING ADDRESS DB 1 ;ARRAY INDEX DW SBRSTK ;SUBROUTINE LEVEL STARTING ADDRESS DW PRGMEM ;ARRAY START DB 0x68 ;RANDOM NUMBER SEED 1 DB 0x85 ;RANDOM NUMBER SEED 1 DB 0xE1 ;RANDOM NUMBER SEED 1 DB 0xD6 ;RANDOM NUMBER SEED 1 DW MEMEND ;MEMORY END IDATAE: ; ; INITIALIZE BEFORE EXECUTING A PROGRAM ; XINIT: LXI H,AESTK ;RESET ARITHMETIC STACK SHLD AELVL LXI H,SBRSTK ;RESET SUBROUTINE STACK SHLD SBRLVL LHLD PRGEND ;SET ARRAY START AT END OF PROGRAM SHLD ASTRT CALL ZEROVAR ;ZERO A-Z VARIABLES LHLD PRGSTRT ;CHECK THAT A PROGRAM EXISTS XCHG LHLD PRGEND CALL TWOCMP DAD D MOV A,H ORA A JNZ XINITC MOV A,L CPI 2 JC FIN ;IF NO PROGRAM, DO NOTHING. XINITC: LHLD PRGSTRT ;SET CURLBL TO LABEL OF FIRST PROGRAM LINE MOV D,M INX H MOV E,M XCHG SHLD CURLBL INX D INX D ANA A RET ; ; INTERPRETIVE LANGUAGE EXECUTION ROUTINE ; ; 0b00xxxxxx JUMP TO IL INSTRUCTION AT 00xxxxxx ; 0b01xxxxxx CALL IL SUBROUTINE AT 00xxxxxx ; 0b10xxxxxx COMPARE TO STRING FAIL TO IL AT 00xxxxxx ; 0b11xxxxxx CALL ML SUBROUTINE AT 00xxxxxx ; ILXQT: LXI H,NEWPRG NXTIL: MOV A,M CPI 0b10000000 JNC ML ;IF COMPARE OR CALL ML, THEN GOTO ML IL: CPI 0b01000000 JNC ILCALL ;IF CALL IL, THEN GOTO ILCALL ILJMP: INX H ;OTHERWISE, PROCESS AS IL JUMP MOV L,M ;GET NEXT IL ADDRESS MOV H,A JMP NXTIL ;GOTO IL ADDRESS ILCALL: ANI 0b00111111 ;PROCESS CALL IL MOV B,A INX H MOV C,M INX H PUSH H ;IL CALL ADDRESS->BC AND PUT IL RETURN ON STACK. MOV H,B ;BC->HL MOV L,C JMP NXTIL ;GOTO IL ADDRESS (LATER USE ML RTN TO RETURN FROM IL SUBROUTINE) ; ML: CPI 0b11000000 ;PROCESS CALL ML OR COMPARE JNC MLCALL ;IF CALL ML, GOTO MLCALL ANI 0b00111111 ;MUST BE COMPARE! MOV B,A ;COMPARE STRING POINTER IN BC INX H MOV C,M INX H MLL1: LDAX D ;SKIP SPACES IN IL CODE INX D CPI ' ' JZ MLL1 DCX D PUSH D ;SAVE START OF STRING TO BE COMPARED XCHG MLL2: LDAX D ;PERFORM COMPARISON UNTIL MSB OF IL COMPARE STRING REACHED CPI 0b10000000 ;NOTE: THE MSB'ED CHARACTER IS INCLUDED IN COMPARE JNC MLE1 CMP M INX H INX D JZ MLL2 MLE2: POP D ;IF COMPARE SUCCEEDS, EXECUTE IL INSTRUCTION FOLLOWING COMPARE STRING MOV H,B MOV L,C JMP NXTIL MLE1: ANI 0b01111111 CMP M JNZ MLE2 XCHG POP B INX D INX H JMP NXTIL ;IF COMPARE FAILS, SKIP IL INSTRUCTION AFTER COMPARE STRING AND GOTO SECOND IL INSTRUCTION ; MLCALL: ANI 0b00111111 ;PERFORM A ML CALL INX H MOV C,M INX H PUSH H ;GET ML ADDRESS IN AC AND SAVE NEXT IL ADDRESS ON STACK LXI H,MLRET PUSH H ;SAVE ML RETURN ADDRESS ON STACK MOV H,A MOV L,C PCHL ;GOTO CALLED ML ADDRESS ; MLRET: POP H ;RETURN HERE FROM ML CALL JNC NXTIL ;IF CARRY RESET, GOTO NEXT IL INSTRUCTION INX H INX H JMP NXTIL ;IF OTHERWISE (CARRY SET), SKIP NEXT IL INSTRUCTION AND GOTO SECOND IL INSTRUCTION ; ; CLEAR SCREEN ; #IF(SIM = 1) CLRSCR: MVI A, 25 ;RDT SIMULATOR CLEAR SCREEN OUTPUT CNTRL Y OR 25(DECIMAL) CALL CHROUT ANA A RET #ELSE CLRSCR: MVI A, 0x1B ;CLEAR SCREEN OUTPUT ESC + 5D(HEX) + 52(HEX) CALL CHROUT MVI A,0x5D CALL CHROUT MVI A,0x52 CALL CHROUT ANA A RET #ENDIF ; ; NEWLINE - NEW LINE ; NEWLINE:CALL CRLF ; ; GET LINE FROM BUFFER ; GETLINE:MVI A,'>' ;OUTPUT '>' AS PROMPT CALL CHROUT ; ; BUFFER INPUT ; #IF(SIM = 1) BUFIN: LXI H, BUFSTRT ;INPUT BUFFER MVI B, 72 ;MAX BUFFER CHARACTERS OVER: CALL CHRIN ;GET CHARACTER CPI 13 ;CR? JZ BUFEND ;DONE CPI 127 ;DEL? JZ RUBOUT ;RUBOUT CHARACTER CPI '|' ;USE @? (USE | POINT AS CONTROL L FOR SIMULATION TESTING) JZ NEWLINE ;NEW LINE MOV M,A INX H DCR B ;EXCEED BUFFER LENGTH? CZ ERR1 ;CHANGE TO ERR1 JMP OVER BUFEND: MOV M,A RET RUBOUT: DCX H INR B MVI A,"?" CALL CHROUT JMP OVER #ELSE BUFIN: LXI H, BUFSTRT ;INPUT BUFFER MVI B, 72 ;MAX BUFFER CHARACTERS OVER: CALL CHRIN ;GET CHARACTER CPI 13 ;CR? JZ BUFEND ;DONE CPI 127 ;DEL? JZ RUBOUT ;RUBOUT CHARACTER MOV M,A INX H DCR B ;EXCEED BUFFER LENGTH? JZ ERR1 ;IF SO, ERR1 JMP OVER ;GET NEXT CHARACTER BUFEND: MOV M,A RET ; RUBOUT: MOV A,B ;IF AT BEGINNING OF LINE, DO NOTHING CPI 72 JZ OVER DCX H ;OTHERWISE, POINT BACK ONE CHARACTER INR B MVI A,0x08 ;OUTPUT BACK SPACE CALL CHROUT MVI A,' ' ;ERASE RUBBED OUT CHARACTER CALL CHROUT MVI A,0x08 ;BACK SPACE AGAIN TO NEW INPUT POSITION CALL CHROUT JMP OVER ;GET NEXT CHARACTER #ENDIF ; ; LINE INSERTION ROUTINE ; ; INSERTS A NEW LINE; DELETES IF ONLY LINE NUMBER; OR OVERWRITES. ; INSRT: PUSH D LHLD CURLBL ;CURLBL->BC MOV A,H ;CHECK FOR 0 LINE NUMBER ORA L JZ ERR2 MOV B,H MOV C,L LXI H,BUFSTRT ;BUFSTRT->HL INSRTL1:MVI A,'9' ;FIND FIRST NON-NUMBER (END OF LABEL) INX H CMP M JC INSRTF1 MVI A,'/' CMP M JC INSRTL1 ; INSRTF1:PUSH H ;SAVE START OF TEXT;NOW GET TEXT LENGTH IN D (INCLUDE CR) MVI D,1 MVI A,13 ;CR->A INSRTL2:CMP M ;CR? JZ INSRTC1 ;IF SO, FOUND IT! INR D INX H JMP INSRTL2 ;REPEAT INSRTC1:MOV A,D ;TEXT LENGTH->COUNT STA COUNT POP D ;START OF TEXT->DE LHLD PRGSTRT ;START OF PROGRAM SPACE->HL INSRTL4:CALL CKPEND ;CHECK IF AT PROGRAM END? JZ APPEND ;IF SO, APPEND NEW LINE TO END OF PROGRAM MOV A,M ;BC IS LABEL FROM NEW LINE TO BE INSERTED CMP B ;IS B = MSB OF CURRENT LINE? JZ INSRTC2 ;MAYBE - GO CHECK LSB JNC HERE ;IF CURRENT PROGRAM LINE MSB > NEW LINE MSB THEN INSERT NEW LINE HERE INX H ;IF NOT, MOVE HL TO START OF NEXT LINE AND REPEAT INSRTL3:INX H ;POINT HL TO LINE LENGTH MOV A,L ;HL + LINE LENGTH -> HL ADD M MOV L,A JNC INSRTL4 ;REPEAT INR H ;IF CARRY SET, INCREMENT H AND REPEAT JMP INSRTL4 ; INSRTC2:INX H ;IS LSB OF NEW LINE = LSB OF CURRENT PROGRAM LINE? MOV A,M CMP C JZ OVRDEL ;IF SO, NEW LINE LABEL EXISTS SO GO OVERWRITE PROGRAM LINE JC INSRTL3 ;IF LSB OF NEW LABEL > LSB OF CURRENT LABEL, THEN MOVE CURRENT TO NEXT LINE AND REPEAT SEARCH DCX H ;HL -> MSB OF CURRENT LINE HERE: DCX H ;HL -> ??? PUSH D XCHG LHLD PRGEND PUSH H LDA COUNT ADI 3 ADD L JNC INSRTC3 INR H INSRTC3:MOV L,A CALL MEMTEST ;CHECK FOR OUT OF MEMORY SHLD PRGEND MOV B,H MOV C,L POP H INSRTL5:MOV A,M ;INSERT NEW LINE HERE. STAX B DCX H DCX B MOV A,H CMP D JNZ INSRTL5 MOV A,L CMP E JNZ INSRTL5 INX D LHLD CURLBL XCHG MOV M,D INX H MOV M,E INX H LDA COUNT INR A MOV M,A INX H POP D INSRTL6:LDAX D MOV M,A CPI 13 ;CR? JZ INSRTE INX H INX D JMP INSRTL6 INSRTE: POP D RET ;NEW LINE INSERTED; DONE ; OVRDEL: DCX H ;DELETE CURRENT PROGRAM LINE PUSH H INX H INX H INX H INSRTL7:MOV A,M CPI 13 ;CR? JZ INSRTC6 INX H JMP INSRTL7 ; INSRTC6:INX H XCHG LHLD PRGEND INX H MOV B,H MOV C,L POP H INSRTL8:LDAX D MOV M,A INX H INX D MOV A,D CMP B JNZ INSRTL8 MOV A,E CMP C JNZ INSRTL8 DCX H SHLD PRGEND LDA COUNT CPI 1 JNZ INSRT+1 ;IF NEW LINE HAS TEXT (NOT DELETE ONLY), THEN INSERT IT HERE. POP D RET ;OTHERWISE DONE. ; APPEND: MOV M,B ;APPEND NEW LINE TO END OF PROGRAM INX H MOV M,C INX H LDA COUNT INR A MOV M,A DCX D APPENDL:INX H INX D LDAX D MOV M,A CPI 13 JNZ APPENDL INX H SHLD PRGEND POP D RET ;NEW LINE APPENDED; DONE ; ; CKPEND - IF HL AT PROGRAM END, RETURN ZERO ; CKPEND: LDA PRGEND+1 ;MSB(PRGEND)->A CMP H ;MSB(PRGEND)=H? RNZ ;IF NOT, RETURN WITH ZERO RESET LDA PRGEND ;LSB(PRGEND)->A CMP L ;LSB(PRGEND)=L? RET ;IF SO, RETURN WITH ZERO SET ; MEMTEST:LDA MEND+1 ;TEST FOR MEMORY DEPLETION CMP H JZ MEMTSTC JC ERR15 ;ERROR15 MEMTSTE:RET MEMTSTC:LDA MEND SUI 0 CMP L JNC MEMTSTE JMP ERR15 ;ERROR15 ; ; LIST PROGRAM ; LST: PUSH D LHLD PRGSTRT ;PROGRAM START->DE XCHG DCX D LSTB: MVI B,LLINES LSTNL: INX D XCHG CALL CKPEND ;CHECK FOR PROGRAM END? JZ LSTE ;IF SO, THEN DONE XCHG CALL CRLF ;OTHERWISE, OUTPUT CR & LF LSTC: LDAX D ;OUTPUT LINE NUMBER MOV H,A INX D LDAX D MOV L,A CALL LBLOUT INX D LSTL: INX D ;SKIP LINE LENGTH AND OUTPUT REMAINING CHARACTERS IN LINE LDAX D CPI 13 ;CR? JZ LSTW ;IF AT END OF LINE, GOTO TO OUTPUTING OF NEXT LINE PUSH B PUSH H CALL ASCOUT POP H POP B JMP LSTL ; LSTW: DCR B JNZ LSTNL LSTW0: IN 1 ;I/O STATUS BYTE->A ANI 0x80 ;CHECK INPUT DATA AVAILABLE BIT JNZ LSTW0 ;IF NO DATA AVAILABLE, CONNTINUE IN 2 ;CLEAR DATA AVAILABLE BIT JMP LSTB ; LSTE: POP D ;DONE RET ; ; LBLOUT - OUTPUT HL THROUGH IOUT W/O ZERO SUPPRESSION ; LBLOUT: PUSH H PUSH D PUSH B XCHG MVI C,0xFF ;-1->C JMP IOUTC1 ; ; IOUT - OUTPUT VALUE IN HL SUPPRESSING ZEROS BEFORE FIRST NON-ZERO DIGIT ; IOUT: PUSH H PUSH D PUSH B XCHG MVI C,0 ;0->C IOUTC1: LXI H,10000 CALL CNVRT LXI H,1000 CALL CNVRT LXI H,100 CALL CNVRT LXI H,10 CALL CNVRT MOV A,E CALL BCDOUT POP B POP D POP H RET ; ; CNVRT - CONVERT VALUE IN DE TO ASCII DIGIT FOR TIMES-TEN VALUE IN HL ; CNVRT: MVI B,0xFF ;-1->B CNVRTL: INR B ;B+1->B MOV A,E ;DE-HL->DE INCREMENTING B FOR EACH POSITIVE RESULT SUB L MOV E,A MOV A,D SBB H MOV D,A JNC CNVRTL MOV A,E ADD L MOV E,A MOV A,D ADC H MOV D,A MOV A,B CMP C ;WHILE B=C=0, DON'T OUTPUT ZERO DIGIT RZ DCR C ;FOR FIRST NON-ZERO DIGIT, C-1->C TO PROHIBIT ANY FURTHER ZERO SUPRESSION BCDOUT: ADI 0x30 ;ADD ASCII BIAS ASCOUT: LXI H,ZONE-1 ;OUTPUT DIGIT AND ADJUST ZONE COUNTER CALL CHROUT INX H DCR M RNZ ;IF AT END OF ZONE, SET ZONE BYTE TO ZONE WIDTH MVI M,ZWIDTH RET ; ; LABEL TEST ROUTINE ; ; TEST FOR NUMERIC LABEL ; ; IF SO, STORE LABEL IN BINARY IN CURLBL AND RETURN WITH CARRY SET. ; IF NOT, STORE 0->CURLBL AND RETURN WITH CARRY RESET ; TSTL: LXI D, BUFSTRT ;ASSUME LABEL IS AT START OF INPUT BUFFER PUSH D ;SAVE IT SKIPSPC:LDAX D CPI ' ' ;SPACE? INX D JZ SKIPSPC ;IF SO, SKIP THE SPACE. DCX D LXI H, 0 ;0->HL CPI 'A'-1 JC LBL ;IF SO, PROCESS LABEL. CMND: SHLD CURLBL ;OTHERWISE, ITS A COMMAND. POP D RET LBL: CALL BIN ;CONVERT LABEL TO BINARY->HL SHLD CURLBL STC POP D RET BIN: CALL ASCIN ;READ ASCII LABEL AND CONVERT TO BINARY CPI 10 RNC ;DONE INX D MOV B,H MOV C,L DAD H ;10*HL->HL DAD H DAD B DAD H JC ERR2 ;LABEL SIZE OVERFLOW MOV C,A MVI B,0 DAD B ;HL+A->HL JMP BIN ; ; ASCII INPUT ; ASCIN: LDAX D ;CHARACTER->A CPI '0' ;IF ASSCII NUMBER 0 TO 9, MASK LS NIBBLE RC CPI ':' RNC ANI 00001111B RET ; #IF(SIM = 1) ; ; SIMULATION I/O CODE ; ; ; CHRIN - GET KEYBOARD INPUTTED CHARACTER INTO A ; CHRIN: IN 1 ;I/O STATUS BYTE->A ANI 0x80 ;CHECK INPUT DATA AVAILABLE BIT JNZ CHRIN ;IF NO DATA AVAILABLE, LOOP IN 2 ;GET DATA BYTE FROM INPUT PORT->A CPI '!' ;USE !? (USE EXCLAMATION POINT AS ESC FOR SIMULATION TESTING) JZ CHRINC ;IF SO, CHECK FOR ESC CHARACTER CPI 0x0D ;IF CR, DO NOT ECHO RZ ; ; CHROUT - OUTPUT CHARACTER IN A TO SCREEN ; CHROUT: PUSH B ;SAVE BC MOV C,A ;SAVE A->C WAIT: IN 1 ;I/O STATUS BYTE->A ANI 0x40 ;CHECK OUTPUT BUSY BIT JNZ WAIT ;IF BUSY, LOOP MOV A,C ;GET CHARACTER TO OUTPUT C->A OUT 2 ;SEND IT TO OUTPUT PORT POP B ;RESTORE BC RET ;DONE/RETURN ; ; CHRINC - CHECK FOR SPECIAL CHARACTERS ; CHRINC: IN 1 ;I/O STATUS BYTE->A ANI 0x80 ;CHECK INPUT DATA AVAILABLE BIT JNZ CHRINC ;IF NO DATA AVAILABLE, LOOP IN 2 ;GET DATA BYTE FROM INPUT PORT->A CPI "E" ;IF "E" (ESCAPE), EXECUTE WARM BOOT JZ WSTART CPI "B" ;IF "B" (BACKSPACE), SUBSTITUTE ASCII DEL CODE JNZ CHROUT MVI A,127 RET ; #ELSE ; ; ALTAIR CODE ; ; CHRIN - GET KEYBOARD INPUTTED CHARACTER INTO A ; CHRIN: IN 0 ;I/O STATUS BYTE->A ANI 0x01 ;CHECK INPUT DATA AVAILABLE BIT JNZ CHRIN ;IF NO DATA AVAILABLE, LOOP IN 1 ;GET DATA BYTE FROM INPUT PORT->A CPI 0x1B ;IF "E" (ESCAPE), EXECUTE WARM BOOT JZ WSTART CPI 0x7F ;IF BS (BACKSPACE), DO NOT ECHO RZ CPI 0x0D ;IF CR, DO NOT ECHO RZ ; ; CHROUT - OUTPUT CHARACTER IN A TO SCREEN ; CHROUT: PUSH B ;SAVE BC MOV C,A ;SAVE A->C WAIT: IN 0 ;I/O STATUS BYTE->A ANI 0x80 ;CHECK OUTPUT BUSY BIT JNZ WAIT ;IF BUSY, LOOP MOV A,C ;GET CHARACTER TO OUTPUT C->A OUT 1 ;SEND IT TO OUTPUT PORT POP B ;RESTORE BC RET ;DONE/RETURN #ENDIF ; ; ML NLINE - OUTPUT CARRIAGE RETURN AND LINE FEED TO SCREEN ; NLINE: LXI H,ZONE ;SET ZONE BYTE TO ZONE WIDTH MVI M,ZWIDTH CALL CRLF ;OUTPUT CARRIAGE RETURN AND LINE FEED TO SCREEN SUB A RET ; ; OUTPUT CARRIAGE RETURN AND LINE FEED ; CRLF: MVI A,13 ;OUTPUT A CR CALL CHROUT ;OUTPUT LINE FEED IF NEEDED #IF (LFNEED = 1) MVI A,10 ;OUTPUT A LF JMP CHROUT #ELSE RET #ENDIF ; ; PRS - PRINT STRING LITERAL ; PRS: LDAX D ;GET CHARACTER TO OUTPUT INX D ;POINT NEXT CHARACTER CPI '"' ;IF QUOTATION MARK, END OF STRING REACHED AND DONE RZ CPI 13 ;IF CARRIAGE RETURN, UNTERMINATED STRING ERR0R JZ ERR4 CALL ASCOUT ;OUTPUT CHARACTER TO SCREEN JMP PRS ;LOOP FOR MORE CHARACTERS ; ; SPCZ - ML ZONE PRINT SPACES TO NEXT ZONE ; SPCZNE: LXI H,ZONE ;POINT HL TO ZONE COUNTER SPCZNEL:MVI A,' ' ;OUTPUT A SPACE TO SCREEN CALL CHROUT DCR M ;DECREMENT THE ZONE BYTE JNZ SPCZNEL ;IF NOT ZERO, LOOP AND OUTPUT ANOTHER SPACE MVI M,ZWIDTH;IF ZERO, SET ZONE BYTE TO ZONE WIDTH THEN DONE. CLEAR CARRY AND RETURN ANA A RET ; ; SPCO - ML SINGLE SPACE PRINT ; SPCONE: LXI H,ZONE ;POINT HL TO ZONE COUNTER MVI A,' ' ;OUTPUT A SPACE TO SCREEN CALL CHROUT DCR M ;DECREMENT THE ZONE BYTE RNZ ;IF NOT ZERO, DONE. RETURN WITH CARRY CLEARED MVI M,ZWIDTH;IF ZERO, SET ZONE BYTE TO ZONE WIDTH THEN DONE. CLEAR CARRY AND RETURN ANA A RET; ; DONE - CHECKS FOR END OF LINE (A CR) ; DONE: LDAX D INX D CPI ' ' JZ DONE DCX D CPI 13 ;CR? RZ CPI ':' JNZ ERR3 JMP NXTC3 ; ; TRANSFER EXECUTION TO NEXT TBX INSTRUCTION (CURLBL<>0) ; OR NEWLNE (GETLINE) FOR A DIRECT INSTRUCTION (CURLBL=0) ; NXT: LHLD CURLBL MOV A,H ORA L JNZ NXTC1 ;CURLBL<>0 THEN NEXT TBX INSTRUCTION ; FIN: LXI H,NEWLNE ;CURLBL=0 THEN GET NEW LINE POP B XTHL PUSH B ANA A RET ; NXTC1: LDAX D INX D CPI ':' JZ NXTX NXTC2: XCHG CALL CKPEND JZ FIN XCHG LDAX D MOV H,A INX D LDAX D MOV L,A SHLD CURLBL INX D NXTC3: INX D POP B LXI H,DIR XTHL PUSH B #IF(SIM = 0) IN 0 ANI 0x01 JNZ NXTC4 IN 1 CPI 0x1B ;ESC - WARM START JNZ NXTC4 CALL ESCMSG JMP WSTART ; #ENDIF NXTC4: ANA A RET ; ; TRANSFERS TO NEXT INSTRUCTION IN LINE AFTER A ":" ; NXTX: POP B LXI H,DIR XTHL PUSH B ANA A RET ; ; RETURNS FROM AN IL CALL ; RTN: POP H POP B PUSH H RET ; ; PRINTS THE NUMBER ON TOP OF THE AE STACK (ADD CODE LATER) ; PRN: CALL POPAE MOV A,H ORA A JP PRNC CALL TWOCMP MVI A,'-' PUSH H CALL CHROUT POP H PRNC: CALL IOUT ANA A RET ; ; TSTV - TEST FOR VARIABLE A-Z IF SO, PUSH VAR ADDRESS ON AE STACK ; TSTV: LDAX D INX D CPI ' ' JZ TSTV DCX D ADI 0xC0 RNC RLC MOV L,A MVI H, hi(VARSTRT) CALL PSHAE STC INX D RET ; ; TSTN - TEST FOR NUMBER IF SO, PUSH NUMBER ON AE STACK ; TSTN: LDAX D INX D CPI ' ' JZ TSTN DCX D CPI '(' RZ CPI '-' PUSH PSW JNZ TSTNC INX D LDAX D TSTNC: CPI '9'+1 JNC TSTNE CPI '0' JC TSTNE LXI H,0 CALL BIN POP PSW CZ TWOCMP CALL PSHAE STC RET TSTNE: POP PSW ANA A RET ; ; PSHAE - PUSH HL ONTO AE STACK ; PSHAE: PUSH B MOV B,H MOV C,L LHLD AELVL MOV M,B INX H MOV M,C INX H SHLD AELVL POP B MOV A,L CPI 0x7F RC JMP ERR5 ; ; POPAE - POP TOP OF AESTK INTO HL ; POPAE: PUSH B LHLD AELVL MOV A,L ORA A JZ ERR6 DCX H MOV B,M DCX H SHLD AELVL MOV H,M MOV L,B POP B ANA A RET ; ; TWOCMP - TAKES 2'S COMPLEMENT OF HL ; TWOCMP: MOV A,H CMA MOV H,A MOV A,L CMA MOV L,A INX H RET ; ; IND - REPLACE TOP OF AE STACK WITH VARIABLE VALUE ; IND: CALL POPAE MOV B,M INX H MOV H,M MOV L,B CALL PSHAE ANA A RET ; ; ARRAY - GETS LOCATION OF ARRAY VALUE ON TOP OF AE STACK ; ARRAY: PUSH D CALL POPAE DAD H MOV B,H MOV C,L CALL POPAE MOV D,M INX H MOV E,M XCHG MOV A,M CMP B JZ ARRAYC1 JC ERR10 INX H ARRAYC0:INX H DAD B CALL PSHAE POP D ANA A RET ; ARRAYC1:INX H MOV A,M CMP C JC ERR10 JMP ARRAYC0 ; ; STORE - STORE TOP OF AE STACK AT VARIABLE NEXT ON STACK ; STORE: CALL POPAE MOV C,H MOV B,L CALL POPAE MOV M,B INX H MOV M,C ANA A RET ; ; ADD - ADD TOP TWO VALUES ON AE STACK ; ADD: CALL POPAE MOV B,H MOV C,L CALL POPAE DAD B CALL PSHAE ANA A RET ; ; SUB - SUBTRACT TOP OF AE STACK FROM NEXT VALUE ON AE STACK ; SUB: CALL POPAE CALL TWOCMP MOV B,H MOV C,L CALL POPAE DAD B CALL PSHAE ANA A RET ; ; MUL - MULTIPLY TOP TWO TWO VALUES ON AESTK ; MUL: PUSH D MVI B,0 CALL POPAE MOV A,H ORA A CM NINOX XCHG CALL POPAE MOV A,H ORA A CM NINOX CALL MULT DCR B CZ TWOCMP CALL PSHAE POP D ANA A RET ; NINOX: INR B JMP TWOCMP ; MULT: PUSH B MOV B,H MOV C,L LXI H,0 MVI A,17 STA INDX MULTL: MOV A,B RAR MOV B,A MOV A,C RAR MOV C,A JNC MULTC DAD D MULTC: MOV A,H RAR MOV H,A MOV A,L RAR MOV L,A LDA INDX DCR A JZ MULTE STA INDX JMP MULTL MULTE: MOV H,B MOV L,C POP B RET ; ; DIV - DIVIDE TOP OF AESTK INTO THE NEXT VALUE ON THE AE STACK ; DIV: PUSH D MVI B,0 CALL POPAE MOV A,H ORA A CM NINOX XCHG CALL POPAE MOV A,H ORA A CM NINOX XCHG SUB A CMP H JNZ DIVC CMP L JZ ERR8 DIVC: CALL DIVD DCR B CZ TWOCMP CALL PSHAE POP D ANA A RET ; DIVD: PUSH B MVI B,1 DIVDL1: MOV A,H ANI 0x40 JNZ DIVDC0 DAD H INR B JMP DIVDL1 DIVDC0: MOV A,B STA INDX MOV B,H MOV C,L LXI H,0 DIVDL2: MOV A,E SUB C MOV E,A MOV A,D SBB B MOV D,A JNC DIVDC2 MOV A,E ADD C MOV E,A MOV A,D ADC B MOV D,A DAD H LDA INDX DCR A JZ DIVDE DIVDC1: STA INDX XCHG DAD H XCHG JMP DIVDL2 DIVDE: POP B RET DIVDC2: DAD H INX H LDA INDX DCR A JZ DIVDE JMP DIVDC1 ; ; NEG - NEGATE THE TOP OF AE STACK ; NEG: CALL POPAE CALL TWOCMP CALL PSHAE ANA A RET ; ; CMPR - COMPARES VALUES ON THE AE STACK USING LOGICAL OPERATOR ALSO ON AE STACK ; CMPR: PUSH D CALL POPAE XCHG CALL POPAE PUSH H CALL POPAE MOV A,H ANI 0b10000000 JNZ CMPRC3 MOV A,D ANI 0b10000000 JNZ CMPRB4 CMPRC1: MOV A,H CMP D JZ CMPRC2 JNC CMPRB4 JMP CMPRB1 ; CMPRC2: MOV A,L CMP E JZ CMPRB0 JNC CMPRB4 CMPRB1: MVI A,1 DB 0X21 CMPRB4: MVI A,4 DB 0X21 CMPRB0: MVI A,0 POP H LXI D,CMPRA PUSH D PCHL ; CMPRA: JZ TRUE FALSE: POP D CMPRL1: LDAX D CPI 13 ;CR JZ NXT INX D JMP CMPRL1 ; TRUE: POP D RET ; CMPRC3: MOV A,D ANI 0b10000000 JNZ CMPRC1 JMP CMPRB1 ; CMPR0: CPI 0 RET CMPR1: CPI 1 RET CMPR2: CPI 0 RZ CPI 1 RET CMPR3: CPI 1 RZ CPI 4 RET CMPR4: CPI 4 RET CMPR5: CPI 0 RZ CPI 4 RET ; LIT0: LXI H,CMPR0 JMP CMPRC4 LIT1: LXI H,CMPR1 JMP CMPRC4 LIT2: LXI H,CMPR2 JMP CMPRC4 LIT3: LXI H,CMPR3 JMP CMPRC4 LIT4: LXI H,CMPR4 JMP CMPRC4 LIT5: LXI H,CMPR5 ; CMPRC4: CALL PSHAE ANA A RET ; ; FNDLBL - FIND THE PROGRAM LINE NUMBER IN HL ; FNDLBL: PUSH H LHLD PRGSTRT MOV B,H MOV C,L POP H FNDL: LDAX B MOV E,A INX B LDAX B ORA E JZ FNDE2 DCX B MOV A,E CMP H JZ FNDNXT RNC JMP FNDNEW FNDNXT: INX B LDAX B CMP L JZ FNDE1 RNC DCX B FNDNEW: INX B INX B LDAX B ADD C MOV C,A JNC FNDL INR B JMP FNDL FNDE1: DCX B MOV H,B MOV L,C RET FNDE2: INR A RET ; ; XFER - TRANSFER EXCUTION TO LINE NUMBER ON TOP OF AE STACK ; XFER: CALL POPAE PUSH D CALL FNDLBL POP D XCHG JZ NXTC2 JMP ERR7 ; ; DONEX - SAME AS DONE EXCEPT IGNORES $ ; DONEX: LDAX D INX D CPI ' ' JZ DONEX DCX D CPI 13 ;CR? RZ CPI ':' RZ JMP ERR3 ; ; SAVE - PUTS RETURN ADDRESS ON SBR STACK ; SAVE: MOV H,D MOV L,E CALL PSHSBR ANA A RET ; ; RSTR - RESTORES RETURN ADDRESS FROM SBR STACK ; RSTR: CALL POPSBR XCHG ANA A RET ; ; PSHSBR - PUT HL ON SBR STACK ; PSHSBR: PUSH B MOV B,H MOV C,L LHLD SBRLVL ;??? CHECK FOR STACK OVERFLOW MOV M,B INX H MOV M,C INX H SHLD SBRLVL POP B RET ; ; POPSBBR - GET HL FROM SBR STACK ; POPSBR: PUSH B LHLD SBRLVL ;??? CHECK FOR STACK UNDERFLOW DCX H MOV B,M DCX H SHLD SBRLVL MOV H,M MOV L,B POP B RET ; ; INNUM - INPUT A NUMBER FROM THE KEYBOARD ; INNUM: PUSH D MVI A,'?' CALL CHROUT MVI A,' ' CALL CHROUT CALL BUFIN LXI D,BUFSTRT LDAX D CPI '-' LXI H,0 JZ INNUMN CALL BIN INNUME: CALL PSHAE ; MVI A,' ' ; CALL CHROUT POP D ANA A RET INNUMN: INX D CALL BIN CALL TWOCMP JMP INNUME ; ; RNDM - PUTS RANDOM NTEGER (0-10000) ON AE STACK ; RNDM: LXI H,SEED4 MVI B,8 RNDML: MOV A,M RLC RLC RLC XRA M RAL RAL DCR L DCR L DCR L MOV A,M RAL MOV M,A INR L MOV A,M RAL MOV M,A INR L MOV A,M RAL MOV M,A INR L MOV A,M RAL MOV M,A DCR B JNZ RNDML LHLD SEED3 MOV A,M ANI 0x3F MOV H,A CPI 0x27 JZ RNDMC2 RNDMC1: JNC RNDM CALL PSHAE CMC RET ; RNDMC2: MOV A,L CPI 0x10 JMP RNDMC1 ; ; DIM - DIMENSIONS A SIMPLE ARRAY (ONE DIMENSIONAL) ; DIM: LHLD CURLBL ;DON'T ALLOW DIM IN DIRECT COMMANG MOV A,H ORA L JZ ERR9 PUSH D ;SAVE DE CALL POPAE ;SIZE->HL DCX H DAD H ;DOUBLE TO GET ARRAY SIZE MOV B,H ;ARRAY SIZE->BC MOV C,L CALL POPAE ;VARIABLE ADDRESS->DE XCHG LHLD ASTRT ;ARRAY START->HL MOV A,H STAX D INX D MOV A,L ;LSB(ARRAY START)->VARIABLE(DE) STAX D MOV M,B ;ARRAY SIZE IN FIRST TWO BYTES OF ARRAY SPACE INX H MOV M,C DIML: INX H ;ZERO ARRAY MVI M,0 DCX B MOV A,C ORA B JNZ DIML INX H CALL MEMTEST ;CHECK FOR OUT OF MEMORY SHLD ASTRT ;UPDATE ASTRT POP D RET ; ; END PROGRAM EXECUTION ; ; ERROR PROCESSING ; ERR0: MVI A,0 ;SYNTAX ERROR DB 1 ERR1: MVI A,1 DB 1 ERR2: MVI A,2 DB 1 ERR3: MVI A,3 DB 1 ERR4: MVI A,4 DB 1 ERR5: MVI A,5 DB 1 ERR6: MVI A,6 DB 1 ERR7: MVI A,7 DB 1 ERR8: MVI A,8 DB 1 ERR9: MVI A,9 DB 1 ERR10: MVI A,10 DB 1 ERR11: MVI A,11 DB 1 ERR12: MVI A,12 DB 1 ERR13: MVI A,13 DB 1 ERR14: MVI A,14 DB 1 ERR15: MVI A,15 DB 1 ERR16: MVI A,16 PUSH PSW CALL CRLF LXI H,ERRMSG0 CALL MSGOUT POP PSW MVI H,0 MOV L,A CALL IOUT LXI H,ERRMSG1 CALL MSGOUT LHLD CURLBL CALL LBLOUT CALL CRLF JMP WSTART ; ERRMSG0:.asciz 'ERROR ' db 0 ; ERRMSG1:.asciz ' IN LINE ' db 0 ; ENDMSG: CALL CRLF LXI H,ENDMSG0 CALL MSGOUT LHLD CURLBL CALL LBLOUT CALL CRLF ANA A RET ENDMSG0:.asciz 'END IN LINE ' db 0 ; ESCMSG: CALL CRLF LXI H,ESCMSG0 CALL MSGOUT LHLD CURLBL CALL LBLOUT CALL CRLF ANA A RET ; ESCMSG0:.asciz 'ESC IN LINE ' db 0 ; ; ;#IF(SIM = 1) ; ; HALT WITH DUMP ; HLT: CALL HEXOUT MVI A,' ' CALL CHROUT MOV A,B CALL HEXOUT MOV A,C CALL HEXOUT MVI A,' ' CALL CHROUT MOV A,D CALL HEXOUT MOV A,E CALL HEXOUT MVI A,' ' CALL CHROUT MOV A,H CALL HEXOUT MOV A,L CALL HEXOUT MVI A,' ' CALL CHROUT POP H MOV A,H CALL HEXOUT MOV A,L CALL HEXOUT MVI A,' ' CALL CHROUT POP H MOV A,H CALL HEXOUT MOV A,L CALL HEXOUT MVI A,' ' CALL CHROUT JMP $ ; ; OUTPUT A IN HEX ; HEXOUT: PUSH PSW RRC RRC RRC RRC CALL HEXDIG POP PSW HEXDIG: ANI 0x0F CPI 10 JNC HEXDIGC ADI 48 JMP CHROUT HEXDIGC:ADI 55 JMP CHROUT ;#ENDIF ; ; INTERPRETIVE LANGUAGE PROGRAM ; ; 0b00xxxxxx JUMP TO IL INSTRUCTION AT 00xxxxxx ; 0b01xxxxxx CALL IL SUBROUTINE AT 00xxxxxx ; 0b10xxxxxx COMPARE TO STRING FAIL TO IL AT 00xxxxxx ; 0b11xxxxxx CALL ML SUBROUTINE AT 00xxxxxx ; NEWPRG: DB hi(INIT) | 0b11000000, lo(INIT) ;CALL INIT NEWLNE: DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(GETLINE) | 0b11000000, lo(GETLINE) ;CALL GETLINE DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(TSTL) | 0b11000000, lo(TSTL) ;CALL TSTL DB hi(DIR) | 0b00000000, lo(DIR) ;JUMP DIR DB hi(INSRT) | 0b11000000, lo(INSRT) ;CALL INSRT DB hi(NEWLNE) | 0b00000000, lo(NEWLNE) ;JUMP NEWLNE ; XEQ: DB hi(XINIT) | 0b11000000, lo(XINIT) ;CALL XINIT DIR: ; LET: DB hi(GOTO) | 0b10000000, lo(GOTO) ;TST <>'LET' THEN JUMP GOTO DEFM 'LET'+0x80 ;ELSE LETC: DB hi(TSTV) | 0b11000000, lo(TSTV) ;CALL TSTV DB hi(ERR11) | 0b11000000, lo(ERR11) ;CALL ERR11 DB hi(LETCA) | 0b10000000, lo(LETCA) ;TST <>'(' THEN JUMP LETCA DEFM '('+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(ILERR0) | 0b10000000, lo(ILERR0) ;TST <>')' THEN JUMP ILERR0 DEFM ')'+0x80 ;ELSE DB hi(ARRAY) | 0b11000000, lo(ARRAY) ;GET ARRAY LOCATION LETCA: DB hi(ILERR0) | 0b10000000, lo(ILERR0) ;TST <>'=' THEN JUMP ERR0 DEFM '='+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(STORE) | 0b11000000, lo(STORE) ;CALL STORE DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; GOTO: DB hi(GOSUB) | 0b10000000, lo(GOSUB) ;TST <>'GOTO' THEN JUMP GOSUB DEFM 'GOTO'+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(XFER) | 0b11000000, lo(XFER) ;CALL XFER ; GOSUB: DB hi(RET) | 0b10000000, lo(RET) ;TST <>'GOSUB' THEN JUMP RET DEFM 'GOSUB'+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(DONEX) | 0b11000000, lo(DONEX) ;CALL DONEX DB hi(SAVE) | 0b11000000, lo(SAVE) ;CALL SAVE DB hi(XFER) | 0b11000000, lo(XFER) ;CALL XFER ; RET: DB hi(IF) | 0b10000000, lo(IF) ;TST <>'RETURN' THEN JUMP IF DEFM 'RETURN'+0x80 ;ELSE DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(RSTR) | 0b11000000, lo(RSTR) ;CALL RSTR DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; IF: DB hi(IN) | 0b10000000, lo(IN) ;TST <>'IF' THEN JUMP IN DEFM 'IF'+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(RELOP) | 0b01000000, lo(RELOP) ;CALL IL RELOP DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(ILERR16) | 0b10000000, lo(ILERR16) ;TST <>'THEN' THEN JUMP ILERR16 DEFM 'THEN'+0x80 ;ELSE DB hi(CMPR) | 0b11000000, lo(CMPR) ;CALL CMPR DB hi(DIR) | 0b00000000, lo(DIR) ;JUMP IL DIR ; IN: DB hi(ILDIM) | 0b10000000, lo(ILDIM) ;TST <>'IN' THEN JUMP DIM DEFM 'INPUT'+0x80 ;ELSE INC0: DB hi(TSTV) | 0b11000000, lo(TSTV) ;CALL TSTV DB hi(ERR11) | 0b11000000, lo(ERR11) ;IF NOT A VARIABLE THEN CALL ERR11 DB hi(INNUM) | 0b11000000, lo(INNUM) ;CALL INNUM DB hi(STORE) | 0b11000000, lo(STORE) ;CALL STORE DB hi(INC1) | 0b10000000, lo(INC1) ;TST <>',' THEN JUMP INC1 DEFM ','+0x80 ;ELSE DB hi(INC0) | 0b00000000, lo(INC0) ;JUMP IL INC0 INC1: DB hi(CRLF) | 0b11000000, lo(CRLF) ;CALL CRLF DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILDIM: DB hi(PRINT) | 0b10000000, lo(PRINT) ;TST <>'DIM' THEN JUMP PRINT DEFM 'DIM'+0x80 ;ELSE DB hi(TSTV) | 0b11000000, lo(TSTV) ;CALL TSTV DB hi(ERR11) | 0b11000000, lo(ERR11) ;IF NOT A VARIABLE THEN CALL ERR11 DB hi(ILERR0) | 0b10000000, lo(ILERR0) ;TST <>'(' THEN JUMP ILERR0 DEFM '('+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(ILERR0) | 0b10000000, lo(ILERR0) ;TST <>')' THEN JUMP ILERR0 DEFM ')'+0x80 ;ELSE DB hi(DIM) | 0b11000000, lo(DIM) ;CALL DIM DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; PRINT: DB hi(ILLIST) | 0b10000000, lo(ILLIST) ;TST <>'PRINT' THEN JUMP ILLIST DEFM 'PRINT'+0x80 ;ELSE DB hi(ILSTRG) | 0b10000000, lo(ILSTRG) ;TST <>'*' THEN JUMP ILSTRG DEFM '*'+0x80 ;ELSE DB hi(CLRSCR) | 0b11000000, lo(CLRSCR) ;CALL CLRSCR (CLEAR SCREEN) DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILSTRG: DB hi(ILC1) | 0b10000000, lo(ILC1) ;TST <>'"' THEN JUMP ILC1 DEFM '"'+0x80 ;ELSE DB hi(PRS) | 0b11000000, lo(PRS) ;CALL PRS ILZONE: DB hi(ILSPC) | 0b10000000, lo(ILSPC) ;TST <>',' JUMP ILSPC DEFM ','+0x80 ;ELSE DB hi(SPCZNE) | 0b11000000, lo(SPCZNE) ;CALL SPCZNE ILE1: DB hi(ILE2) | 0b10000000, lo(ILE2) ;TST <>CR THEN JUMP ILE2 DB 141 ;ELSE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILE2: DB hi(ILSTRG) | 0b10000000, lo(ILSTRG) ;TST <>':' THEN JUMP ILSTRG DEFM ':'+0x80 DB hi(NXTX) | 0b11000000, lo(NXTX) ;CALL NXTX ; ILSPC: DB hi(ILC0) | 0b10000000, lo(ILC0) ;TST <>';' THEN JUMP ILC0 DEFM ';'+0x80 ;ELSE DB hi(ILESPC0) | 0b10000000, lo(ILESPC0) ;TST <>CR THEN JUMP ILESPC0 DB 141 ;ELSE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILESPC0:DB hi(ILESPCC) | 0b10000000, lo(ILESPCC) ;TST <>':' THEN JUMP ILESPCC DEFM ':'+0x80 DB hi(NXTX) | 0b11000000, lo(NXTX) ;CALL NXTX ; ILESPCC:DB hi(SPCONE) | 0b11000000, lo(SPCONE) ;CALL SPCONE DB hi(ILE1) | 0b00000000, lo(ILE1) ;JUMP ILE1 ; ILC0: DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILC1: DB hi(ILC2) | 0b10000000, lo(ILC2) ;TST <>CR THEN JUMP ILC2 DB 141 ;ELSE DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(NXT) | 0b11000000, lo(NXT) ;CALL NXT ; ILC2: DB hi(ILC3) | 0b10000000, lo(ILC3) ;TST <>':' THEN JUMP ILC3 DEFM ':'+0x80 DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(NXTX) | 0b11000000, lo(NXTX) ;CALL NXTX ; ILC3: DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;ILCALL EXPRS DB hi(PRN) | 0b11000000, lo(PRN) ;CALL PRN DB hi(ILZONE) | 0b00000000, lo(ILZONE) ;JUMP ILZONE ; EXPRS: DB hi(EXPR) | 0b10000000, lo(EXPR) ;TST <>'+' THEN JUMP EXPR (IGNORE LEADING +) DEFM '+'+0x80 ;ELSE EXPR: DB hi(EXPR0) | 0b10000000, lo(EXPR0) ;TST <>'-' THEN JUMP EXPR0 DEFM '-'+0x80 ;ELSE DB hi(TERM) | 0b01000000, lo(TERM) ;CALL IL TERM DB hi(NEG) | 0b11000000, lo(NEG) ;CALL NEG DB hi(EXPR1) | 0b00000000, lo(EXPR1) ;JMP IL EXPR1 ; EXPR0: DB hi(TERM) | 0b01000000, lo(TERM) ;CALL IL TERM EXPR1: DB hi(EXPR2) | 0b10000000, lo(EXPR2) ;TST <>'+' THEN JUMP EXPR2 DEFM '+'+0x80 ;ELSE DB hi(TERM) | 0b01000000, lo(TERM) ;CALL IL TERM DB hi(ADD) | 0b11000000, lo(ADD) ;CALL ADD DB hi(EXPR1) | 0b00000000, lo(EXPR1) ;JMP IL EXPR1 ; EXPR2: DB hi(EXPR3) | 0b10000000, lo(EXPR3) ;TST <>'-' THEN JUMP EXPR3 DEFM '-'+0x80 ;ELSE DB hi(TERM) | 0b01000000, lo(TERM) ;CALL IL TERM DB hi(SUB) | 0b11000000, lo(SUB) ;CALL SUB DB hi(EXPR1) | 0b00000000, lo(EXPR1) ;JMP IL EXPR1 ; EXPR3: DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; TERM: DB hi(FACT) | 0b01000000, lo(FACT) ;CALL IL FACT TERM0: DB hi(TERM1) | 0b10000000, lo(TERM1) ;TST <>'*' THEN JUMP TERM1 DEFM '*'+0x80 ;ELSE DB hi(FACT) | 0b01000000, lo(FACT) ;CALL IL FACT DB hi(MUL) | 0b11000000, lo(MUL) ;CALL MUL DB hi(TERM0) | 0b00000000, lo(TERM0) ;JMP IL TERM0 ; TERM1: DB hi(TERM2) | 0b10000000, lo(TERM2) ;TST <>'/' THEN JUMP TERM2 DEFM '/'+0x80 ;ELSE DB hi(FACT) | 0b01000000, lo(FACT) ;CALL IL FACT DB hi(DIV) | 0b11000000, lo(DIV) ;CALL DIV DB hi(TERM0) | 0b00000000, lo(TERM0) ;JMP IL TERM0 ; TERM2: DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; FACT: DB hi(FACT0) | 0b10000000, lo(FACT0) ;TST <>'RANDOM' THEN JUMP FACT0 DEFM 'RANDOM'+0x80 ;ELSE DB hi(RNDM) | 0b11000000, lo(RNDM) ;CALL RNDM DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; FACT0: DB hi(TSTV) | 0b11000000, lo(TSTV) ;CALL TSTV DB hi(FACT1) | 0b00000000, lo(FACT1) ;JMP IL FACT1 DB hi(FACT0A) | 0b10000000, lo(FACT0A) ;TST <>'(' THEN JUMP FACT0A DEFM '('+0x80 ;ELSE DB hi(EXPRS) | 0b01000000, lo(EXPRS) ;CALL IL EXPRS DB hi(ILERR0) | 0b10000000, lo(ILERR0) ;TST <>')' THEN JUMP ILERR0 DEFM ')'+0x80 ;ELSE DB hi(ARRAY) | 0b11000000, lo(ARRAY) ;GET ARRAY LOCATION ; DB hi(HLT) | 0b11000000, lo(HLT) ;CALL HLT FACT0A: DB hi(IND) | 0b11000000, lo(IND) ;CALL IND DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; FACT1: DB hi(TSTN) | 0b11000000, lo(TSTN) ;CALL TSTN DB hi(FACT2) | 0b00000000, lo(FACT2) ;JMP IL FACT2 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; FACT2: DB hi(FACT3) | 0b10000000, lo(FACT3) ;TST <>'(' THEN JUMP FACT3 DEFM '('+0x80 ;ELSE DB hi(EXPR) | 0b01000000, lo(EXPR) ;CALL IL EXPR DB hi(FACT3) | 0b10000000, lo(FACT3) ;TST <>')' THEN JUMP FACT3 DEFM ')'+0x80 ;ELSE DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; FACT3: DB hi(ERR13) | 0b11000000, lo(ERR13) ;CALL ERR13 ; ; IL TB COMMANDS ; ILLIST: DB hi(RUN) | 0b10000000, lo(RUN) ;TST <>'LIST' THEN JUMP RUN DEFM 'LIST'+0x80 ;LIST DB hi(LST) | 0b11000000, lo(LST) ;CALL LIST DB hi(NEWLNE) | 0b00000000, lo(NEWLNE) ;JUMP NEWLNE RUN: DB hi(END) | 0b10000000, lo(END) ;TST <>'RUN' THEN JUMP END DEFM 'RUN'+0x80 ;LIST DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(XEQ) | 0b00000000, lo(XEQ) ;JUMP XEQ ; END: DB hi(NEW) | 0b10000000, lo(NEW) ;TST <>'END' THEN JUMP NEW DEFM 'END'+0x80 DB hi(ENDMSG) | 0b11000000, lo(ENDMSG) ;CALL ENDMSG DB hi(NLINE) | 0b11000000, lo(NLINE) ;CALL NLINE DB hi(FIN) | 0b11000000, lo(FIN) ;CALL FIN ; NEW: DB hi(LETC) | 0b10000000, lo(LETC) ;TST <>'CLEAR' THEN JUMP LETC DEFM 'NEW'+0x80 DB hi(DONE) | 0b11000000, lo(DONE) ;CALL DONE DB hi(NEWPRG) | 0b00000000, lo(NEWPRG) ;JUMP NEW PROGRAM (NEWPRG) ; RELOP: DB hi(RELOP0) | 0b10000000, lo(RELOP0) ;TST <>'=' THEN JUMP RELOP0 DEFM '='+0x80 DB hi(LIT0) | 0b11000000, lo(LIT0) ;CALL LIT0 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP0: DB hi(RELOP4) | 0b10000000, lo(RELOP4) ;TST <>'<' THEN JUMP RELOP4 DEFM '<'+0x80 DB hi(RELOP1) | 0b10000000, lo(RELOP1) ;TST <>'<' THEN JUMP RELOP1 DEFM '='+0x80 DB hi(LIT2) | 0b11000000, lo(LIT2) ;CALL LIT2 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP1: DB hi(RELOP3) | 0b10000000, lo(RELOP3) ;TST <>'>' THEN JUMP RELOP3 DEFM '>'+0x80 DB hi(LIT3) | 0b11000000, lo(LIT3) ;CALL LIT3 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP3: DB hi(LIT1) | 0b11000000, lo(LIT1) ;CALL LIT1 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP4: DB hi(ILERR12) | 0b10000000, lo(ILERR12) ;TST <>'>' THEN JUMP ERR12 DEFM '>'+0x80 DB hi(RELOP5) | 0b10000000, lo(RELOP5) ;TST <>'<' THEN JUMP RELOP5 DEFM '='+0x80 DB hi(LIT5) | 0b11000000, lo(LIT5) ;CALL LIT5 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP5: DB hi(RELOP6) | 0b10000000, lo(RELOP6) ;TST <>'<' THEN JUMP RELOP6 DEFM '<'+0x80 DB hi(LIT3) | 0b11000000, lo(LIT3) ;CALL LIT3 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; RELOP6: DB hi(LIT4) | 0b11000000, lo(LIT4) ;CALL LIT4 DB hi(RTN) | 0b11000000, lo(RTN) ;CALL RTN ; ; ILERR0: DB hi(ERR0) | 0b11000000, lo(ERR0) ;CALL ERR0 ILERR12:DB hi(ERR12) | 0b11000000, lo(ERR12) ;CALL ERR12 ILERR16:DB hi(ERR16) | 0b11000000, lo(ERR16) ;CALL ERR16 ; ; TBX END ; CURLBL: DW 0x0000 ;CURRENT LABEL PRGSTRT:DW PRGMEM ;FIRST BYTE OF PROGRAM PRGEND: DW PRGMEM ;LAST BYTE OF PROGRAM COUNT: DB 1 ;LENGTH OF TEXT IN BUFFER CASE: DB 0x20 ;??? ZONE: DB ZWIDTH ;ZONE SET TO ZONE WIDTH AELVL: DW AESTK ;ARITHMETIC EXPRESSION LEVEL INDX: DB 1 ;ARRAY INDEX SBRLVL: DW SBRSTK ;SUBROUTINE LEVEL ASTRT: DW 0x2FFF ;ARRAY START SEED1: DB 0x68 ;RANDOM NUMBER SEED 1 SEED2: DB 0x85 ;RANDOM NUMBER SEED 1 SEED3: DB 0xE1 ;RANDOM NUMBER SEED 1 SEED4: DB 0xD6 ;RANDOM NUMBER SEED 1 MEND: DW MEMEND ;MEMORY END ; BUFSTRT:DS 72,0 ;INPUT BUFFER ; DS ((hi($)+1)*256) - $ ; VARSTRT: DS 256,0 ;START OF VARIABLE STORAGE ; AESTK: DS 256,0 ;ARITHMETIC EXPRESSION STACK STARTING ADDRESS ; SBRSTK DS 256,0 ;SUBROUTINE STACK STARTING ADDRESS ; PRGMEM: DW 0 ;START OF PROGRAM MEMORY ; ; END OF TBX ;