CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug031.ark / TBASICA4.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 42.6 KB | 1,869 lines

CON99 DB 43H DB 1 DB 99H DB 99H DB 99H DB 50H * RTN. D.15 * INSERT CODED LINE INTO SOURCE CODE FILE * USES ESRC, INSR, AND SLIN ICLS LHLD ESRC ;CHECK FOR INSERTION AT END XCHG ;TO DE LHLD FRAV ;GET FFRAV CALL CMP16 ;SAME? JNZ ICLS2 ;NOPE ICLS3 LHLD ESRC XCHG ;TO DE LHLD INSR CALL CMP16 ;COMPARE THE ADDRESSES JZ ICLS1 ;SAME, SO NO MOVES REQUIRED LHLD SLIN ;COMPUTE "TO" ADDRESS CALL SUB16 ;HL=SLIN-ESRC PUSH H ;SAVE IT PUSH H ;AND AGAIN LHLD INSR ;COMPUTE NUMBER OF BYTES TO MOVE XCHG ;TO DE LHLD SLIN CALL SUB16 ;HL=SLIN-INSR MOV C,L ;BC=HL MOV B,H POP D ;FINISH COMPUTING "TO" ADDRESS LHLD INSR XCHG ;DE<>HL DAD D ;HL=INSR+SLIN-ESRC XCHG ;TO DE CALL MOVE ;MOVE THAT STUFF UP POP B ;GET SLIN-ESRC PUSH B ;SAVE IT AGAIN LHLD INSR ;GET "TO" ADDRESS XCHG ;TO DE LHLD SLIN ;GET "FROM" ADDRESS CALL MOVE ;MOVE IT SHLD ESRC ;SET NEW END OF SOURCE MVI M,80H ;STORE END CODE SHLD FRAV ;UPDATE FRAV LHLD INSR ;GET OLD INSERTION ADDRESS POP D ;GET SLIN-ESRC DAD D ;ADD THEM SHLD INSR ;SAVE IT RET ;DONE.... ICLS2 LHLD FRAV ;MOVE LINE DOWN XCHG LHLD SLIN CALL SUB16 MOV C,L MOV B,H LHLD ESRC XCHG CALL MOVE XCHG DAD B SHLD SLIN ;UPDATE SLIN JMP ICLS3 ICLS1 LHLD SLIN ;GET NEW INSERTION ADDRESS SHLD ESRC ;SET ALL THESE CRAZY FLAGS MVI M,80H ;STORE END CODE SHLD FRAV ;UPDATE FRAV SHLD INSR RET ;DONE.. * RTN. D.16 * PROCESS CODED LINE CLPR LDA CMND ;CHECK IT WE'RE IN COMMAND MODE ANA A ;SET FLAGS JNZ CLPR1 ;SEEM TO BE CALL ICLS ;INSERT THE LINE IF WE'RE NOT LDA EDITM ;CHECK FOR EDIT MODE ANA A JNZ EDIT2 ;SURE WAS JMP RSTRR ;LOOP FOR ANOTHER LINE CLPR1 CALL SUBS ;GET ADDRESS PUSH H LHLD PNTR SHLD PNTRA LHLD SLIN ;SET UP NEW PNTR SHLD PNTR SHLD NPNTR LHLD SDIR ;SET UP FARY IF RUN NOT READY LDA RURD ANA A JNZ CLPR9 ;IT'S OKAY ALREADY SHLD FARY ;SET IT UP CLPR9 POP H ;FIRST ADDRESS TO EXECUTE JMP RUN ;RUN IT * THE FOLLOWING IS A TABLE OF ALL INTRINSIC FUNCTIONS * RECOGNIZED BY TARBELL BASIC. THEY ARE IN OPCODE ORDER FUNT DB 'AB','S'+80H DB 'AS','C'+80H DB 'AT','N'+80H DB 'CHR','$'+80H DB 'CO','S'+80H DB 'EX','P'+80H DB 'FR','E'+80H DB 'IN','P'+80H DB 'IN','T'+80H DB 'LEFT','$'+80H DB 'LE','N'+80H DB 'LO','G'+80H DB 'MID','$'+80H DB 'OCT','$'+80H DB 'PEE','K'+80H DB 'PO','S'+80H DB 'RIGHT','$'+80H DB 'RN','D'+80H DB 'SG','N'+80H DB 'SI','N'+80H DB 'SPACE','$'+80H DB 'SP','C'+80H DB 'SQ','R'+80H DB 'STR','$'+80H DB 'TA','B'+80H DB 'TA','N'+80H DB 'US','R'+80H DB 'VA','L'+80H DB 'MATC','H'+80H DB 'HEX','$'+80H DB 'CAL','L'+80H DB 'LO','C'+80H DB 'HE','X'+80H * RTN. D.17 * PROCESS INTRINSIC FUNCTIONS * CHECKS TO SEE IF TOKEN AT TSCN IS A VALID * INTRINSIC FUNCTION. IF IT IS, EXIT IS WITH ZERO AND * THE OPCODE IN A. IF IT IS NOT, EXIT IS NOT ZERO. PFUN LHLD TSCN ;GET TOKEN ADDRESS LXI D,FUNT ;TABLE ADDRESS LXI B,33 ;NUMBER OF ITEMS ON TABLE CALL STSRH ;SEARCH THE TABLE RNZ ;NO FIND PUSH B ;SAVE OFFSET CALL USCN ;SCAN OFF NEXT TOKEN JC SPRAT ;SYNTAX ERROR IF NONE LHLD TSCN ;GET THE ADDRESS MOV A,M ;GET IT CPI '('+80H ;SEE IF IT'S RIGHT JNZ SPRAT ;NOPE!! CALL BSCN ;SCAN BACK TO LAST TOKEN POP B ;RESTORE OFFSET MVI A,3FH ;OPCODE OFFSET ADD C ;FORM THE CODE MVI C,1 ;SET THE ZERO FLAG DCR C RET ;DONE. * RTN. D.18 * CHECK FOR SEMICOLON OR COMMA * IF IT IS, EXITS WITH ZERO SET AND OPCODE IN * A. IF NOT, ZERO IS CLEARED. SCCC LHLD TSCN ;GET TOKEN ADDRESS MOV A,M ;GET THE CHARACTER CPI ';'+80H ;CHECK FOR SEMICOLON JZ SCCC1 ;IT IS CPI ','+80H ;CHECK FOR COMMA RNZ ;IT WASN'T MVI A,0DH ;SET OPCODE RET ;DONE SCCC1 MVI A,0EH ;GET OPCODE RET ;DONE. * RTN. D.19 * INSERT CODE BYTE * A = CODE BYTE ICBY LHLD SLIN ;GET ADDRESS TO PUT THE THING MOV M,A ;STUFF IT IN INX H ;UPDATE INDEX SHLD SLIN ;SAVE IT RET ;DONE * RTN. D.20 * NORMAL STATEMENT PROCESSOR * A = NORMAL INDEX NSPR ADI 09FH ;ADD OFFSET TO FORM OPCODE STA OPFLG ;SAVE IT CALL ICBY ;INSERT IN STRING CALL USCN ;CHECK FOR ANY EXPRESSION FOLLOWING JC ENPR ;RETURN IF NOTHING FOLLOWS CALL BSCN ;SCAN BACK TO WHENCE WE STARTED NSPR1 CALL EVEX ;PROCESS THIS EXPRESSION JMP ENPR ;PROCESS END OF EXPRESSION INTBL DB ':'+80H DB 'GOT','O'+80H DB 'T','O'+80H DB 'STE','P'+80H DB 'THE','N'+80H DB 0A7H DB 0DCH ;BACKSLASH DB 'GOSU','B'+80H DB 'ELS','E'+80H DB 89H * RTN. D.22 * PROCESS INTERMEDIARIES PINT LHLD TSCN ;GET ADDRESS OF TOKEN LXI D,INTBL ;GET ADDRESS OF TABLE OF INTERMEDIARYS LXI B,10 ;NUMBER OF ITEMS TO LOOK FOR CALL STSRH MOV A,C ;FIND # TO C RET ;DONE. * RTN. D.21 * END OF STATEMENT PROCESSOR * RETURNS IF END IS OK, GOES TO EXEC3 IF A COLON, * SYNTAX ERROR (10) OTHERWISE ENPR LDA ESCN ;END OF LINE? CPI 2 RZ ;YUP ENPR2 CALL PINT ;CHECK INTERMEDIATE CODE JNZ EXEC3 ;PROCESS AS STATEMENT CPI 2 ;GOTO? JZ EXEC3 ;YUP CPI 8 ;GOSUB? JZ EXEC3 ;YUP CPI 1 ;COLON? MVI B,9EH ;JUST IN CASE JZ ENPR1 ;YUP CPI 6 ;REMARK JZ PREM ;YUP CPI 7 ;BACKSLASH? MVI B,9DH ;JUST IN CASE JZ ENPR1 ;YUP CPI 10 ;IS IT A TAB? MVI B,9CH ;JUST IN CASE JZ ENPR1 ;YUP CPI 9 ;ELSE? MVI B,9BH ;JUST IN CASE JZ ENPR1 ;YUP JMP SPRAT ;MUST BE ILLEGAL ENPR1 MOV A,B CALL ICBY ;INSERT IT CALL USCN ;GET THE NEXT TOKEN JC SPRAT ;OUT OF DATA JMP ENPR2 ;TRY AGAIN INTB DW INON DW INGO DW INFO DW INGT DW INGS DW INIF DW INRE DW INCH DW INON DW INRT * RTN. D.23 INRT LDA ESCN ;ARE WE NEAR THE END? CPI 2 JZ ENPR ;YUP CALL INSN ;PROCESS THE STATEMENT NAME JMP ENPR ;DONE * PROCESS ODDBALL STATEMENTS * IN: A = STATEMENT CODE PROS CPI 11 ;IS IT REMARK? JNZ PROS1 ;NOPE MVI A,7 ;CORRECT PROS1 PUSH PSW ;SAVE THE CODE ADI 7FH ;ADD OFFSET STA OPFLG CALL ICBY ;INSERT IN CODE STRING POP PSW ;RESTORE THE CODE MOV E,A ;SET IN DE MVI D,0 LXI H,INTB ;SET UP TO LOOKUP ADDRESS OF PROCESSOR CALL TABLE ;LOOK IT UP MOV L,C ;MOVE THE RESULT TO HL MOV H,B PCHL ;JUMP TO THE PROCESSOR ODTBL DB 'O','N'+80H DB 'GOPRO','C'+80H DB 'FO','R'+80H DB 'GOT','O'+80H DB 'GOSU','B'+80H DB 'I','F'+80H DB 'RE','M'+80H DB 'CHANNE','L'+80H DB 'O','N'+80H DB 'RESTOR','E'+80H DB 'REMAR','K'+80H NOTBL DB 'CLOA','D'+80H DB 'CSAV','E'+80H DB 'ASSIG','N'+80H DB 'DAT','A'+80H DB 'DE','F'+80H DB 'DI','M'+80H DB 'DRO','P'+80H DB 'INPU','T'+80H DB 'LE','T'+80H DB 'EN','D'+80H DB 'NEX','T'+80H DB 'OU','T'+80H DB 'POK','E'+80H DB 'PRIN','T'+80H DB 'PROCEDUR','E'+80H DB 'REA','D'+80H DB 'RECEIV','E'+80H DB 'BSAV','E'+80H DB 'RETUR','N'+80H DB 'STO','P'+80H DB 'WAI','T'+80H DB 'CLEA','R'+80H DB 'BLOA','D'+80H DB 'BPU','T'+80H DB 'BGE','T'+80H CHCKA CALL CHCK ;CHECK INTEGRITY MOV B,A ;SAVE TO B LDA CHECK ;GET THE CHECK BYTE CMP B ;COMPARE IT RZ ;IT'S OKAY, BASIC LIVES! CHCKB LXI H,CKMSG ;OOPS, A DESTROYED BIT OR TWO SOMEWHERE CALL MSGER ;TELL THE OPERATOR JMP CHCKB ;DO IT AGAIN SUBS LDA RURD ;IS RUN READY? ANA A ;SET FLAGS LHLD FRAV ;JUST IN CASE RZ ;NOPE LHLD PNTR ;YUP RET ;DONE. CKMSG DB 'BASIC IS CRASHED',8DH * RTN. D.24 * CHECK FOR STATEMENT * JUMPS TO PROCESSOR IF IT IS A STATEMENT CHST LHLD TSCN ;SET UP CASER SHLD CASER LHLD TSCN ;GET ADDRESS OF TOKEN XRA A ;CLEAR A STA STFLG ;CLEAR NOT STATEMENT FLAG MOV A,M ;CHECK FOR ? FOR PRINT CPI '?'+80H MVI A,14 ;PRINT ITEM NUMBER JZ NSPR ;SURE WAS LXI D,NOTBL ;GET ADDRESS OF TABLE OF NORMAL STATEMENTS LXI B,19H ;NUMBER OF NORMAL STATEMENTS CALL STSRH ;SEARCH MOV A,C ;CODE TO A JZ NSPR ;FOUND CHST1 LHLD TSCN ;GET ADDRESS OF TOKEN LXI D,ODTBL ;GET ADDRESS OF TABLE OF ODDBALL STATEMENTS LXI B,11 ;NUMBER OF ODDBALL STATEMENT TYPES CALL STSRH ;SEARCH IT MOV A,C ;GET CODE FOUND IF ANY JZ PROS ;JUMP TO PROCESS ODDBALL STATEMENT MVI A,0FFH ;SET NOT STATEMENT FLAG STA STFLG ;SET IT RET ;NOT A STATEMENT COTBL DB 'CAD','D'+80H DB 'CLEA','R'+80H DB 'CLOA','D'+80H DB 'CON','T'+80H DB 'CSAV','E'+80H DB 'DELET','E'+80H DB 'ENTE','R'+80H DB 'LIS','T'+80H DB 'NE','W'+80H DB 'RU','N'+80H DB 'EDI','T'+80H DB 'SYMBO','L'+80H DB 'BY','E'+80H * RTN. D.25 * EXECUTIVE RSTRT LDA CSST ;CHECK FOR CASSETTE MODE ANA A ;SET FLAGS JNZ EXCE1 ;CASSETTE MODE CALL CRLF ;PRINT HEAD TO THE LEFT RSTRR LXI SP,STACK+100 ;SET UP THE STACK POINTER EXEC2 LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ EXCE1 ;CASSETTE MODE LDA CMND ;CHECK FOR COMMAND MODE ANA A ;SET FLAGS JZ EXECA ;NOPE MVI A,'>' ;COMMAND MODE PROMPT JMP EXECB ;SKIP THE NEXT EXECA MVI A,':' ;ENTER MODE PROMPT EXECB CALL TOUT ;OUTPUT IT EXCE1 CALL SUBS ;GET END OF SOURCE LXI D,100 ;ADD 100 TO IT DAD D MVI M,80H ;CLEAR OUT A BYTE INX H ;GET NEXT ADDRESS MVI M,80H ;AND ANOTHER ONE INX H ;UPDATE LDA CSST ;CHECK FOR CASSETTE MODE STA CATV ;STORE AS CASSETTE/TV MODE CALL LIIN ;INPUT A LINE FROM THE KEYBOARD JNC EXEC1 ;SOMETHING WAS INPUTTED MVI A,0FFH ;SET COMMAND MODE STA CMND ;DONE LDA CSST ;CHECK FOR CASSETTE MODE ANA A JZ EXCYY ;NOT CASSETTE MODE STC ;STOP MOTORS CALL CAIN EXCYY XRA A ;CLEAR CSST MODE STA CSST JMP RSTRT ;TRY AGAIN EXEC1 XRA A ;CLEAR A STA ESCN ;CLEAR END OF SCAN FLAG CALL SUBS ;SET UP NEXT SCAN AND SOURCE LINE FLAGS LXI D,101 SHLD SLIN ;SOURCE LINE FLAG DAD D EXE77 SHLD NSCN ;NEXT SCAN FLAG CALL USCN ;UPSCAN TWICE TO GET FIRST TOKEN CALL USCN ;AGAIN LHLD TSCN ;GET ADDRESS OF THIS TOKEN MOV A,M ;CHECK FOR COLON CPI ':'+80H LXI B,7 ;CHECK FIND NUMBER JUST IN CAST JZ EXE80 ;SURE WAS LXI D,COTBL ;TABLE OF COMMANDS LXI B,13 ;NUMBER OF COMMANDS TO DECODE CALL STSRH ;SEARCH THE COMMAND TABLE JNZ EXEC3 ;WASN'T A COMMAND EXE80 LXI H,COJMP ;TABLE OF COMMAND PROCESSING ENTRANCES MOV D,B ;MOVE BC TO DE MOV E,C LDA CMND ;CHECK FOR COMMAND MODE ANA A JNZ EXE88 ;SURE IS MOV A,C ;GET COMMAND TYPE CPI 10 ;CHECK FOR VALIDITY IN ENTER MODE JNC EXE88 ;OK CPI 9 JZ EXEC3 ;NOT OK CPI 6 JC EXEC3 ;NOT OK EXE88 CALL TABLE ;GET ADDRESS MOV H,B ;MOVE BC TO HL MOV L,C MVI A,0FFH ;SET COMMAND MODE STA CMND PCHL ;JUMP TO PROCESS COMMAND EXEC3 CALL CHST ;CHECK TO SEE IF THIS TOKEN IS A STATEMENT LDA STFLG ;GET STATEMENT FLAG ANA A ;SET FLAGS JNZ EXEC4 ;WASN'T A STATEMENT JMP CLPR ;PROCESS THE CODED LINE EXEC4 LHLD TSCN ;GET ADDRESS MOV A,M ;GET CHARACTER CPI 89H ;IS IT A TAB? JZ EXECTAB ;YUP CALL BSCN ;SCAN BACK LHLD NSCN ;CHECK FOR = SIGN EX000 MOV A,M ;GET A BYTE ANA A ;CHECK FOR END REACHED JZ EXEC5 ;YUP CPI 20H JNZ EXXZZ ;NOT A SPACE INX H ;CHECK FOR = NEXT MOV A,M ;GET A BYTE ANI 7FH ;STRIP END BIT CPI '=' JNZ EXEC5 ;NOT A "LET" STATEMENT DCX H EXXZZ INX H ;NEXT BYTE CPI '=' ;CHECK FOR THE EQUALS SIGN JNZ EX000 ;TRY AGAIN INIF4 MVI A,0A8H ;CODE FOR "LET" STATEMENT LXI H,EXEC3+3 ;RETURN ADDRESS PUSH H ;ONTO THE STACK LXI H,STFLG ;CLEAR OUT THE STATEMENT FLAG MVI M,0 STA OPFLG ;STORE CODE CALL ICBY ;INSERT IN LINE JMP NSPR1 ;PROCESS THE LET STATEMENT EXEC5 LDA CMND ;CHECK FOR MODE ANA A ;SET FLAGS MVI B,8 ;POSSIBLE ERROR JNZ ERROR ;NO LABELS IN COMMAND MODE! CALL USCN ;GET EVERYTHING BACK TO NORMAL CALL LGLB ;CHECK FOR LABEL LEGALITY MVI B,7 ;POSSIBLE ERROR JC ERROR ;ILLEGAL LABEL MVI A,9FH ;GET STATEMENT OPCODE CALL ICBY ;INSERT IT MVI A,6 ;START OF STATEMENT NAME CODE CALL ICBY ;INSERT IT LHLD TSCN ;GET TOKEN ADDRESS MVI A,1 ;STATEMENT NAME CODE CALL GTNM ;GET THE SYMBOL NUMBER PUSH B MVI B,7 ;POSSIBLE ERROR JC ERROR ;STATEMENT NAME USED AS VARIABLE NAME POP B MOV A,C ;MOVE SYMBOL NUMBER INTO CODE LINE MOV L,C MOV H,B SHLD EDITS CALL ICBY MOV A,B CALL ICBY MVI A,7 CALL ICBY CALL USCN ;GET NEXT TOKEN JC SPRAT ;ERROR IF ONLY A LABEL JMP EXEC3 ;GET REST OF STATEMENT EXECTAB MVI A,9CH ;STORE THE OPCODE CALL ICBY CALL USCN ;GET NEXT TOKEN JMP EXEC3 ;DO IT PRSY LXI H,PRSYMSG1 ;DUMP THE TITLE OUT CALL MSGER LDA RURD ;SEE IF WE ARE ALREADY SET UP ANA A JNZ PRSYSKIP ;YUP CALL ASDA ;SET IT ALL UP CALL AVAP PRSYSKIP LHLD SNUM ;GET NUMBER OF SYMBOLS MOV B,H ;TO BC MOV C,L LHLD SDIR ;GET START OF DIRECTORY PUSH H ;TO THE STACK LHLD STAB ;GET START OF THE SYMBOL TABLE PRSY1 CALL COUNT ;ADVANCE ONE SYMBOL DAD D MOV A,M ;GET A BYTE ANA A JNZ PRSY1A ;NOT AN ARRAY NAME INX H PRSY1A XTHL ;ADVANCE THE DIRECTORY INX H INX H INX H XTHL ;DID THAT DCX B ;UPDATE SYMBOL COUNT MOV A,B ;CHECK FOR DONENESS ORA C JZ RSTRT ;ALL DONE PEOPLE PUSH B ;SAVE EM PUSH H CALL MSGER ;DUMP THE LABEL NAME PRSY2 LDA POSIT ;SEE IF WE'RE AT THE COLUMN YET CPI 32 JZ PRSY3 ;YUP MVI A,20H CALL TOUT ;NO, SO DUMP A SPACE JMP PRSY2 ;TRY AGAIN PRSY3 POP H ;RESTORE POP B XTHL ;GET DIRECTORY INX H INX H PUSH H ;SAVE IT PUSH B MOV A,M ;GET ID BYTE ANI 1 ;IS IT LABEL? JNZ PRSY3A ;YUP MOV A,M ANI 2 ;IS IT A VARIABLE? JNZ PRSY3B ;YUP LXI H,PRSYMSG2 JMP PRSY3C PRSY3A LXI H,PRSYMSG3 JMP PRSY3C PRSY3B LXI H,PRSYMSG4 PRSY3C CALL MSGER POP B POP H ;GET BACK LOCATION DCX H MOV D,M ;FISH OUT THE POINTER DCX H MOV E,M PUSH H ;SAVE IT XCHG PUSH B LXI D,TMP1 ;CONVERSION PLACE CALL BBCD ;CONVERT TO BINARY LHLD FRAV ;GET PLACE TO CONVERT TO XCHG LXI H,TMP1 CALL NMST ;CONVERT TO NUMBER XCHG DCX H MOV A,M ;SET LAST BIT ORI 80H MOV M,A LHLD FRAV CALL MSGER ;DUMP IT OUT CALL CRLF ;SEND A CARRIAGE RETURN POP B POP H ;RESTORE ADDRESS XTHL ;TRADE JMP PRSY1 ;DO IT AGAIN * RTN. D.26 * ON STATEMENT PROCESSOR INON LHLD SLIN ;SAVE ADDRESS OF OPCODE PUSH H CALL EVEX ;PROCESS EXPRESSION CALL PINT ;CHECK FOR "GOTO" CPI 2 JZ INON1 ;IT'S A GOTO CPI 8 ;CHECK FOR A GOSUB JNZ SPRAT ;NOPE, SO ERROR POP H ;CHANGE OPCODE DCX H MVI M,88H ;STORE THE NEW ONE PUSH H ;SET STACK UP INON1 POP H ;CLEAN UP THE STACK CALL PLDL ;PROCESS LINE DESCRIPTOR LIST JMP ENPR ;END OF LINE PROCESSING * RTN. D.27 * GOPROC STATEMENT PROCESSOR INGO CALL INSN ;PROCESS THE STATEMENT NAME JC ENPR ;NO TRANSFER LIST CALL SCCC ;CHECK FOR COMMA CPI 0DH ;COMPARE MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;SYNTAX ERROR CALL EVEX ;PROCESS EXPRESSION JMP ENPR ;END PROCESSOR * RTN. D.28 * INSERT STATEMENT NAME INSN JMP PLDS ;USE PROCESS LINE DESCRIPTOR ROUTINE * RTN. D.29 * FOR STATEMENT PROCESSOR INFO MVI A,0A8H ;GET CODE FOR "LET" STATEMENT STA OPFLG ;SET ASSIGNMENT MODE FOR = CALL EVEX ;EVALUATE THE EXPRESSION CALL PINT ;CHECK FOR "TO" CPI 3 ;CHECK IT MVI B,19H ;ERROR CODE JUST IN CASE JNZ ERROR ;NO "TO" CALL EVEX ;GET THE NEXT PART CALL PINT ;SEE IF THERE IS A "STEP" CPI 4 ;COMPARE CODES JNZ ENPR ;NOPE, WE MUST BE DONE CALL EVEX ;GET THE STEP INTERVAL JMP ENPR ;DONE * RTN. D.30 * GOTO STATEMENT PROCESSOR INGT CALL INSN ;GET STATEMENT NAME JMP ENPR ;DONE * RTN. D.31 * GOSUB STATEMENT PROCESSOR INGS JMP INGT ;SAME AS GOTO * RTN. D.31 * IF STATEMENT PROCESSOR INIF CALL EVEX ;GET EXPRESSION CALL PINT ;GET CODE FOR INTERMEDIARY CPI 2 ;IS IT A "GOTO"? JZ EXEC3 ;SO GET THE NAME CPI 5 ;IS IT A "THEN"? JNZ SPRAT ;SYNTAX ERROR CALL USCN ;SCAN OFF ANOTHER TOKEN JC SPRAT ;NOTHING FOLLOWING, SYNTAX ERROR CALL CHST ;CHECK TO SEE IF THE TOKEN IS A STATEMENT LDA STFLG ;CHECK IT OUT ANA A JZ CLPR ;IT WAS A STATEMENT, SO PROCESS IT CALL BSCN ;CHECK FOR "=" SIGN LHLD NSCN INIF1 MOV A,M ;GET A BYTE ANA A ;CHECK FOR END REACHED JZ INIF2 ;YUP CPI 20H ;CHECK FOR SPACE JNZ INIF3 ;NOPE INX H ;CHECK FOR "=" NEXT MOV A,M ;GET IT ANI 7FH ;STRIP END BIT CPI '=' ;CHECK IT OUT JNZ INIF2 ;NOT A LET STATEMENT DCX H ;CORRECT INDEX INIF3 INX H CPI '=' ;CHECK FOR = SIGN JNZ INIF1 ;TRY AGAIN JMP INIF4 ;PUT IN THE LET STATEMENT INIF2 CALL USCN ;CORRECT IT MVI A,83H ;SET IN THE GOTO CODE CALL ICBY ;INSERT THE CODE BYTE CALL BSCN ;BACK OFF, JACK XRA A ;CLEAR THE STATEMENT FLAG STA STFLG JMP INGT ;PROCESS AS GOTO * RTN. D.33 * REMARKS PROCESSOR INRE JMP PREM ;DO IT THIS WAY * RTN. D.34 * CHANNEL PROCESSOR INCH CALL EVEX ;PROCESS EXPRESSION JMP ENPR ;DONE * RTN. D.35 * GET INCREMENT GTIN LXI D,1 ;PRESET INCREMENT TO MINIMUM CPI 8 ;IS A>=8? RNC ;YUP PUSH H ;SAVE ADDRESS ANA A ;IS A=0? JZ GTIN2 ;YUP DCR A ;IS A=1? JZ GTIN3 ;YUP CPI 3 ;IS A=4? JZ GTIN4 ;YUP CPI 4 ;IS A=4? JZ GTIN4 ;YUP LXI D,4 ;LABEL NUMBER POP H ;RESTORE ADDRESS RET ;DONE GTIN4 LXI D,8 ;NUMBER POP H ;RESTORE ADDRESS RET ;DONE GTIN3 DCX H ;UPDATE INDEX INX D ;UPDATE COUNTER MOV A,M ;GET A BYTE ANA A ;IS IT A ZERO? JNZ GTIN3 ;NOPE POP H ;RESTORE ADDRESS RET ;DONE GTIN2 INX H ;UPDATE INDEX INX D ;UPDATE COUNTER MOV A,M ;GET A BYTE CPI 1 ;IS IT A ONE? JNZ GTIN2 ;NOPE POP H ;RESTORE ADDRESS RET ;DONE * RTN. D.36 * MOVE FORWARD ONE STATEMENT IN SOURCE * TSCN CONTAINS ADDRESS OF CURRENT STATEMENT MFOS LHLD LINE ;GET CURRENT STATEMENT INX H ;GET NEXT BYTE MFOS2 XCHG ;TO DE LHLD ESRC ;CHECK FOR RUNOVER CALL CMP16 ;COMPARE JZ MFOS1 ;YUP LHLD SLIN ;DIRECT MODE CALL CMP16 JZ MFOS1 ;YUP XCHG ;BACK TO HL MOV A,M ;CHECK FOR A STATEMENT HERE ANA A ;IS IT ANOTHER STATEMENT JM MFOS1 ;YUP MFOS1A CALL GTIN ;NOPE DAD D ;ADD INCREMENT JMP MFOS2 ;LOOP TO TRY AGAIN MFOS1 SHLD LINE ;SAVE IT XCHG ;TO DE LHLD FSRC ;SEE IF WE'RE WITHIN THE PROGRAM DCX H ;CORRECT CALL CMP16 ;CHECK IT OUT JNC MFOS3 ;NO GOOD LHLD ESRC ;CHECK FOR WITHIN STORED PROGRAM CALL CMP16 ;CHECK IT OUT XCHG ;GET LINE BACK TO HL RNC ;GOOD FOR SURE XCHG ;BACK TO DE LHLD FRAV ;CHECK FOR DIRECT MODE LEAP DCX H ;CORRECT CALL CMP16 ;CHECK IT OUT JNC MFOS3 ;NO GOOD LHLD SLIN ;AGAIN CALL CMP16 ;CHECK IT OUT XCHG ;TO HL RNC ;IT'S GOOD FOR SURE MFOS3 MVI B,7 ;ERROR TYPE LHLD ESRC ;RESET LINE SHLD LINE JMP ERROR ;GO DO IT * RTN. D.37 * MOVE BACKWARDS ONE STATEMENT IN SOURCE MBOS LHLD LINE ;GET CURRENT STATEMENT DCX H ;GET LAST ONE MBOS1 MOV A,M ;GET A BYTE ANA A ;SET FLAGS JM MFOS1 ;FOUND THE LAST STATEMENT MBOS1A CALL GTIN ;GET THE INCREMENT CALL SUB16 ;HL=HL-DE JMP MBOS1 ;LOOP TO TRY AGAIN * RTN. D.38 * ASSIGN STATEMENT AND DEF ADDRESSES ASDA LHLD ESRC ;STORE THE FAKE END MVI M,0FFH LHLD SNUM ;NUMBER OF SYMBOLS XCHG ;TO DE LHLD SDIR ;SYMBOL DIRECTORY ASD00 INX H ;GET ID BYTE INX H MVI A,5 ;CHECK FOR DEF OR STATEMENT ANA M JZ ASD01 ;NOPE DCX H ;STORE A 0 MVI M,0 DCX H MVI M,0 INX H INX H ASD01 INX H ;GET NEXT ONE DCX D ;CHECK FOR DONENESS MOV A,D ORA E JNZ ASD00 ;NOT YET LHLD FSRC ;SET UP LIN FLAG SHLD LINE ASDA1 MOV A,M ;GET STATEMENT BYTE CPI 9FH ;IS THIS A STATEMENT NAME? JZ ASDA3 ;YUP CPI 0A4H ;IS THIS A DEF FNXXX STATEMENT? JZ ASDA2 ;YUP ASDA4 XCHG ;HL TO DE LHLD ESRC ;GET END OF SOURCE ADDRESS CALL CMP16 ;SEE IF WE ARE DONE YET RZ ;YUP ASDAQ CALL MFOS ;GET NEXT STATEMENT JMP ASDA1 ;LOOP TO PROCESS IT ASDA3 INX H ;GET ADDRESS OF STATEMENT NAME NUMBER INX H MOV C,M ;GET NUMBER TO BC INX H MOV B,M CALL DFND ;GET THE ADDRESS OF POINTER MOV A,H ;CHECK FOR POINTER = 0 ORA L JNZ ASD20 ;DUPLICATE NAME ERROR ASDAM LXI H,LINE ;ADDRESS OF LINE POINTER LXI B,2 ;NUMBER OF BYTES DCX D DCX D CALL MOVE ;MOVE THE NUMBER IN JMP ASDAQ ;LOOP FOR NEXT STATEMENT ASDA2 INX H ;GET ADDRESS OF SYMBOL LABEL INX H MOV A,M ;GET THE ID BYTE CPI 2 ;CHECK IT MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;SYNTAX ERROR INX H ;GET NUMBER ADDRESS MOV C,M ;GET THE NUMBER INX H MOV B,M CALL DFND ;FIND THE POINTER ADDRESS MOV A,H ;CHECK FOR POINTER = 0 ORA L JNZ ASD10 ;DUPLICATE FNXX ERROR JMP ASDAM ;CONTINUE PROCESSING * RTN. D.39 * ASSIGN VARIABLE AND ARRAY POINTER SPACE AVAP LXI B,1 ;SET UP FOR FIRST SYMBOL LHLD SDIR ;SET UP FARY SHLD FARY LHLD ESRC ;GET FIRST ADDRESS FOR VARIABLES AVAP3 PUSH H ;SAVE IT AVAP1 CALL DFND ;FIND THE POINTER CPI 2 ;IS IT A VARIABLE? JZ AVAP4 ;YUP CPI 16 ;IS IT AN ARRAY? JZ AVAP2 ;YUP AVAPD MOV D,B ;BC TO DE MOV E,C LHLD SNUM ;SEE IF WE ARE DONE YET INX B ;UPDATE SYMBOL NUMBER CALL CMP16 ;CHECK JNZ AVAP1 ;NOPE POP H ;GET ADDRESS BACK SHLD FRAV ;SAVE NEXT AVAILABLE RET ;DONE AVAP4 PUSH D PUSH B LHLD STAB ;GET START OF SYMBOL TABLE AVAP41 CALL COUNT DAD D DCX B MOV A,B ORA C JNZ AVAP41 ;LOOP TILL WE FIND IT DCX H MOV A,M CPI '$'+80H ;SEE IF IT'S A DOLLAR SIGN POP B POP D JNZ AVAP2 ;REGULAR VARIABLE POP H ;RESTORE PUSH B ;SAVE PUSH D ;SAVE PUSH H ;SAVE XCHG ;STORE THE POINTER DCX H MOV M,D DCX H MOV M,E XCHG MVI A,81H ;ID BYTE INX H INX H INX H ;BACKPOINTER ADDRESS XCHG LXI H,1 CALL AMBL ;ASSIGN MEMORY BLOCK FOR STRING MVI M,80H ;STORE A NULL XCHG ;ADDRESS TO DE POP H ;RESTORE BLOCK ADDRESS MVI M,8 ;STORE BLOCK ID INX H ;UPDATE INX H INX H MOV M,E ;STORE POINTER INX H MOV M,D INX H INX H ;CORRECT NEXT ADDRESS POP D ;RESTORE POP B PUSH H ;SAVE JMP AVAPD AVAP2 POP H ;GET ADDRESS BACK XCHG ;FREE HL DCX H ;GET POINTER ADDRESS MOV M,D ;STORE THE ADDRESS DCX H MOV M,E XCHG ;GET HL BACK MVI A,6 ;ZERO OUT 6 BYTES AVAPA MVI M,0FFH ;STORE A FILLER INX H ;UPDATE DCR A JNZ AVAPA PUSH H ;STUFF IT ON THE STACK JMP AVAPD ;LOOP FOR THE NEXT ONE ASD20 CALL ASD30 ;PRINT THE SYMBOL MVI B,20H ;DUPLICATE STATEMENT ERROR LXI H,ASD40 ;PRINT DUP STATEMENT MESSAGE CALL MSGER JMP ASDAQ ;GET NEXT SYMBOL ASD10 CALL ASD30 ;PRINT THE SYMBOL MVI B,21H ;DUPLICATE FNXX ERROR LXI H,ASD50 ;PRINT DUP DEF MESSAGE CALL MSGER JMP ASDAQ ;GET NEXT SYMBOL ASD30 PUSH B ;SAVE SYMBOL NUMBER MVI A,0DH ;SEND A CARRIAGE RETURN CALL TOUT POP B ;RESTORE SYMBOL NUMBER LXI H,TMP9 ;STORE AS A TOKEN MVI M,2 INX H MOV M,C INX H MOV M,B LXI H,TMP9 ;DUMP IT CALL PRIT RET ASD40 DB ' DUP STATE N','M'+80H ASD50 DB ' DUP DE','F'+80H COLON DB ':'+80H * RTN. D.40 * UNDO POLISH STRING AND PRINT IT * IN: HL=LAST ADDRESS OF POLISH STRING (09 CODE) UPOS PUSH H ;SAVE ADDRESS LHLD FARY ;SET UP UNPOLISH STRING ADDRESS XCHG LDA RURD ;IS RUN READY? ANA A JZ UPOO1 ;NOPE LHLD PNTR ;YUP, SO USE SPACE AFTER STACK JMP UPOO2 ;SKIP UPOO1 LHLD SLIN ;SET UP STACK ADDRESS UPOO2 MVI B,0 ;STACK COUNT TO 0 DCX D ;STORE END FLAG MVI A,9 STAX D UPOS1 XTHL ;GET POLISH STRING ADDRESS UPOS3 DCX H ;GET THE ONE BEFORE IT MOV A,M ;AYE, AYE, SIR PUSH D ;SAVE NEW STRING ADDRESS CALL GTIN ;GET THE INCREMENT CALL SUB16 ;FIND THE BEGINNING OF THIS TOKEN INX H POP D ;RESTORE NEW STRING ADDRESS MOV A,M ;GET FIRST CHARACTER CPI 9 ;IS IT THE END YET? JZ UPOS2 ;YUP CPI 6 ;IS IT A LABEL, LITERAL, OR CONSTANT? JC UPOS4 ;YUP CPI 0EH ;IS IT A SEMICOLON? JZ UPOSW ;YUP CPI 0DH ;IS IT A COMMA? JZ UPOSW ;YUP XTHL ;MUST BE AN OPERATOR OR FUNCTION MOV C,A ;STICK THE CHARACTER IN C CPI 40H ;IS IT A FUNCTION? JP UPOSM ;YUP CPI 34H ;IS IT ARRAY OR FN OPERATOR? JP UPOSN ;YUP CPI 20H ;IS IT BIGGER THAN AN OPERATOR? JP DMS10 ;YUP, SO NO NEED TO CHECK PRECEDENCE CPI 0FH ;IS IT AN OPERATOR? JM DMS10 ;NOPE, SO NO NEED TO CHECK PRECEDENCE LDAX D ;GET BYTE FROM UNPOLISH STRING CPI 20H ;CHECK FOR OTHER THAN OPERATOR JNC DMS48 ;NOT AN OPERATOR DCR A ;CHECK PRECEDENC CMP C ;COMPARE JP DMS11 ;OOPS, NEED A PAREN OR TWO DMS48 INR B ;CHECK FOR EMPTY STACK DCR B JZ UPOS5 ;SURE IS DMS10 DCX H ;GET TOP OF STACK MOV A,M CPI 20H ;CHECK FOR PAREN ON STACK INX H ;SET STACK BACK JZ UPOS5 ;NO NEED TO CHECK FURTHER DCR A ;SET UP FOR COMPARE CMP C ;CHECK FOR STACK HAVING PRECEDENCE JM UPOS5 ;STACK'S OK DMS11 MVI M,20H ;STORE CODE FOR "(" ON STACK INX H ;UPDATE COUNTERS INR B DCX D ;STICK A ")" ON OUTPUT MVI A,21H STAX D UPOS5 MOV M,C ;STORE OPERATOR ON STACK INX H INR B ;UPDATED THE COUNTERS JMP UPOS1 ;LOOP FOR ANOTHER TOKEN UPOSW DCX D ;NEXT BYTE OF UNPOLISH STRING STAX D ;STORE THE COMMA OR SEMICOLON XTHL DCX H MOV A,M INX H CPI 3BH JNZ UP02 DCX H DCR B UP02 XTHL JMP UPOS3 ;CONTINUE PROCESSING UPOSM MOV M,A ;STUFF IT ON THE STACK INX H MVI M,20H ;STUFF A '(' ON INX H INR B INR B CPI 49H ;CHECK FOR MULTI-ARGUMENT FUNCTIONS JZ UP00 CPI 5EH ;IS IT CALL(X,X)? JZ UP00 ;SURE IS CPI 50H JZ UP00 CPI 4CH JZ UP01 CPI 5CH ;CHECK FOR A MATCH JZ UP01 ;SURE WAS UPOSO DCX D ;STICK A ')' ON MVI A,21H STAX D JMP UPOS1 ;LOOP FOR ANOTHER ONE UP10 XTHL DCX H MOV A,M INX H XTHL CPI 0DH JZ UPOS1 DCX H DCR B JMP UPOS6 UPOSN MOV M,A ;ON THE STACK INX H INR B JMP UPOSO UP01 MVI M,3BH INX H INR B UP00 MVI M,3BH INX H INR B JMP UPOSO UPOSP XTHL DCX H MOV A,M ;GET NEXT TOKEN INX H XTHL INX H ;UNPOP ARRAY OPERATOR INR B CPI 0DH ;COMMA? JZ UPOS1 ;YUP CPI 0EH ;SEMICOLON? JZ UPOS1 ;YUP DCX H ;POP ONE DCR B DCX D ;MOVE ON A'(' MVI A,20H STAX D JMP UPOS1 ;AND ANOTHER ONE UPOS4 PUSH B ;SAVE REGISTERS PUSH D MOV A,M ;GET A BYTE CALL GTIN ;GET INCREMENT XTHL ;GET STRING ADDRESS CALL SUB16 ;COMPUTE THE NEW ONE XCHG ;STICK IT IN YOUR DE MOV C,L ;BC = HL MOV B,H POP H ;GET SOURCE ADDRESS BACK CALL MOVE ;MOVE IT IN POP B ;GET BACK THE COUNTER XTHL ;GET THE STACK RIGHT UPOS6 INR B ;CHECK FOR EMPTY STACK DCR B JZ UPOS1 ;SURE IS, SO LOOP FOR ANOTHER TOKEN DCX H ;GET ONE OFF STACK DCR B MOV A,M INX H INR B CPI 3BH JZ UP10 DCX H DCR B CPI 34H ;IS IT ARRAY? JZ UPOSP ;YUP CPI 36H ;IS IT FN? JZ UPOSP ;YUP DCX D ;MAKE ROOM ON STRING STAX D ;STUFF IT IN CPI 40H ;CHECK FOR FUNCTION JP UPOS6 ;LOOP FOR ANOTHER ONE OFF STACK CPI 20H ;IS IT "("? JZ UPOS6 ;YUP CPI 1DH ;CHECK FOR UNARYS JZ UPOS6 CPI 1EH JZ UPOS6 JMP UPOS1 ;OK, WE GOT ONE UPOS2 POP H ;GET BACK STACK TO NORMAL XCHG ;TO HL UPOS7 PUSH H ;SAVE STRING ADDRESS CALL PRIT ;PRINT THIS TOKEN POP H MOV A,M ;GET INCREMENT FOR THIS TOKEN CALL GTIN DAD D ;ADD IT MOV A,M ;GET NEXT BYTE CPI 9 ;IS IT THE END FLAG? JNZ UPOS7 ;NOPE RET ;DONE. LOTB DB ','+80H DB ';'+80H DB '='+80H * RTN. D.41 * PRINT INTERNAL FORM * HL = ADDRESS OF TOKEN TO PRINT PRIT MOV A,M ;GET A BYTE CPI 34H ;IS IT AN ARRAY OPERATOR? RZ ;YUP CPI 36H ;IS IT A FUNCTION OPERATOR? RZ ;YUP CPI 0A0H ;CHECK FOR NORMAL STATEMENT JC PRIT8 ;NOPE LXI H,NOTBL ;ADDRESS OF NORMAL STATEMENT TABLE SUI 0A0H ;SUBTRACT OFFSET JMP PRITP ;DUMP IT OUT PRIT8 CPI 80H ;CHECK FOR AN ODDBALL STATEMENT JC PRIT7 ;NOPE LXI H,ODTBL ;ADDRESS OF ODDBALL STATEMENT TABLE SUI 80H ;SUBTRACT OFFSET CPI 8 ;CHECK FOR ON..GOSUB JNZ PRITP ;NOPE XRA A ;YUP PRITP CALL PRIT2 ;DUMP IT LXI H,DRAT ;SEND A SPACE OUT CALL LNOT RET PRIT7 CPI 40H ;CHECK FOR AN INTRINSIC FUNCTION JC PRIT1 ;NOPE LXI H,FUNT ;ADDRESS OF FUNCTION TABLE SUI 40H ;DUMP IT OUT JMP PRIT2 PRIT1 CPI 2FH ;CHECK FOR AN INTERMEDIARY JC PRIT3 ;NOPE LXI H,INTBL ;ADDRESS OF INTERMEDIARY TABLE SUI 2FH ;SUBTRACT OFFSET JMP PRIT2 PRIT3 CPI 10H ;CHECK FOR NORMAL OPERATOR JC PRIT4 ;NOPE CPI 10H ;CHECK FOR WORD OPERATORS JZ PRITW CPI 11H JZ PRITW CPI 12H JZ PRITW CPI 1EH JZ PRITW LXI H,OTBL ;OPERATOR TABLE ADDRESS SUI 10H ;SUBTRACT OFFSET JMP PRIT2 PRIT4 CPI 0DH ;CHECK FOR LOW OPERATORS JC PRIT5 ;NOPE LXI H,LOTB ;LOW OPERATORS TABLE ADDRESS SUI 0DH ;SUBTRACT OFFSET JMP PRIT2 ;DO IT PRIT5 ANA A ;IS IT A STRING START? JNZ PRIT6 ;NOPE INX H ;GET FIRST CHARACTER PUSH H ;SAVE ADDRESS LXI H,DRAT1 ;QUOTE MESSAGE CALL LNOT ;SEND IT OUT POP H ;GET BACK THE ADDRESS CALL LNOT ;SEND IT OUT LXI H,DRAT1 ;ANOTHER QUOT JMP PRITZ ;DO IT PRITW PUSH PSW LXI H,DRAT CALL LNOT ;SEND A SPACE LXI H,OTBL POP PSW SUI 10H ;SUBTRACT OFFSET CALL PRIT2 ;SEND IT LXI H,DRAT ;SEND ANOTHER SPACE CALL LNOT RET ;DONE PRIT6 CPI 4 ;IS IT A NUMBER? JNZ PRIT9 ;NOPE XCHG ;SET UP INDEXES LDA RURD ;SEE IF READY TO RUN ANA A JZ P0000 ;NOPE LHLD PNTR ;YUP JMP P0001 P0000 LHLD SLIN P0001 XCHG PUSH D ;SAVE ADDRESS FOR NUMBER INX H CALL NMST ;CONVERT INTO A STRING XCHG ;LAST ADDRESS TO HL DCX H ;SET UPPER BIT MOV A,M ORI 80H MOV M,A POP H ;GET ADDRESS BACK JMP PRITZ ;DO IT PRIT9 INX H ;GET NAME NUMBER MOV C,M INX H MOV B,M PUSH B ;SAVE IT LHLD STAB ;START OF SYMBOL TABLE PRITB DCX B ;CHECK COUNT MOV A,B ORA C JZ PRITA ;FOUND IT CALL COUNT ;COUNT CHARACTERS DAD D ;ADD TO INDEX JMP PRITB ;LOOP TO TRY AGAIN PRITA MOV A,M ;GET FIRST CHARACTER ANA A ;SEE IF IT IS ZERO JNZ PRITC ;NOPE INX H ;CORRECT PRITC CALL LNOT ;DUMP IT POP B ;RESTORE SYMBOL NUMBER CALL DFND ;GET ID BYTE RET ;DONE DRAT DB 0A0H PRIT2 MOV C,A ;COUNT TO C PRITE DCR C ;CHECK FOR C=0 JM PRITZ ;YUP CALL COUNT ;COUNT CHARACTERS DAD D JMP PRITE ;LOOP AGAIN PRITZ CALL LNOT ;DUMP IT RET * RTN. D.42 * FIND END OF EXPRESSION AND DUMP IT * IN: HL = ADDRESS OF FIRST BYTE OF SOURCE EXPRESSION * OUT: HL = ADDRESS AFTER EXPRESSION FEND MOV A,M ;GET A BYTE CALL GTIN ;GET THE INCREMENT DAD D ;ADD TO HL MOV A,M ;GET NEXT BYTE CPI 9 ;IS IT END OF EXPRESSION?? JNZ FEND ;NOPE PUSH H ;SAVE THE ADDRESS CALL UPOS ;DUMP THE EXPRESSION POP H ;RECOVER ADDRESS INX H ;GET NEXT BYTE RET ;DONE.. * RTN. D.43 * DUMP NAME DMNM PUSH H ;SAVE ADDRESS CALL PRIT ;DUMP IT POP H ;GET ADDRESS BACK MOV A,M ;GET THE BYTE CALL GTIN ;GET THE INCREMENT DAD D ;ADD IT XCHG ;TO DE LHLD ESRC ;CHECK FOR OVERRUN CALL CMP16 XCHG ;BACK TO HL RZ ;SURE IS MOV A,M ;GET NEXT BYTE CPI 8 ;CHECK FOR OFFSET RNZ ;NOPE INX H ;YUP PUSH H ;SAVE IT LXI H,DMNMM ;PLUS MESSAGE CALL LNOT ;SEND IT POP H ;RESTORE HL JMP FEND ;PROCESS IT * RTN. D.44 * DUMP STATEMENT * IN: HL = ADDRESS OF FIRST BYTE OF STATEMENT LOOKAH MOV A,M ;GET A BYTE CPI 9FH ;IS IT A TAB,COLON, OR BACKSLASH? RNC ;CAN'T BE CPI 9CH RC ;NOPE INX H ;TRY AGAIN JMP LOOKAH DMST MOV A,M ;GET A BYTE CPI 9FH ;IS IT A STATEMENT NAME??? JZ DMST1 ;YUP CPI 9BH ;IS IT AN ELSE? JZ DMELS ;YUP CPI 9CH ;IS IT A TAB? JZ DMSTAB ;YUP PUSH H ;SAVE IT AGAIN CALL PRIT ;PRINT THE STATEMENT NAME POP H ;RECOVER ADDRESS MOV A,M ;GET A BYTE AGAIN CPI 0A0H ;IS IT A NORMAL STATEMENT JP DMST2 ;YUP SUI 80H ;SUBTRACT OFFSET ADD A ;MULTIPLY BY TWO XCHG ;HL TO DE LXI H,DUJM ;JUMP TABLE CALL ADHL ;ADD A TO HL MOV C,M ;GET ADDRESS OUT INX H MOV B,M XCHG ;DE BACK TO HL INX H ;NEXT TOKEN PUSH B ;ADDRESS TO THE STACK RET ;JUMP TO PROCESSOR DMELS PUSH H ;SAVE IT LXI H,DMELSE ;DUMP THE MESSAGE CALL LNOT POP H ;RESTORE INX H JMP DMST DMST1 INX H ;GET NEXT BYTE CALL DMNM ;DUMP THE NAME PUSH H ;SAVE HL LXI H,WWWWW ;SPACE MESSAGE CALL LNOT ;SEND IT POP H ;RESTORE HL JMP DMST ;DUMP THE REST OF THE STATEMENT DMSTAB PUSH H LXI H,DMSTBMS ;SEND THE TAB OUT CALL LNOT POP H INX H JMP DMST DMSTBMS DB 89H WWWWW DB 0A0H ;SPACE MESSAGE DMST2 INX H ;GET NEXT BYTE MOV A,M ;CHECK FOR EXPRESSION FOLLOWING CPI 9 JNZ DMST5 ;NOPE DMST3 CALL FEND ;DUMP THE EXPRESSION DMST5 XCHG ;SWAP LHLD ESRC CALL CMP16 ;CHECK FOR OVERRUN XCHG JZ DMST6 MOV A,M CPI 35H ;IS IT A REMARKS INDICATOR? JNZ DMST6 ;NOPE PUSH H ;SAVE ADDRESS LXI H,DMSG1 ;SEND A QUOTE OUT CALL LNOT ;GONE POP H ;GET ADDRESS BACK DMSTC INX H ;GET FIRST BYTE OF REMARKS INX H DMSTD CALL LNOT ;SEND THEM OUT INX H ;GET NEXT BYTE ADDRESS DMST6 SHLD FLST ;SAVE THE NEXT ADDRESS OF STATEMENT MOV A,M ;CHECK FOR A COLON BYTE CPI 9EH JZ DMS00 ;SURE WAS CPI 9DH ;CHECK FOR BACKSLASH JZ DMS65 ;SURE WAS CALL LOOKAH ;GET NEXT SIGNIFICANT STATEMENT MOV A,M ;IS IT AN "ELSE"? CPI 9BH LHLD FLST ;SET UP TO CONTINUE IF IT IS JZ DMST ;SURE IS LXI H,DMSG2 ;SEND A CARRIAGE RETURN CALL LNOT ;SEND IT RET ;DONE DMS00 LXI H,COLON ;SEND A COLON OUT CALL LNOT LHLD FLST ;GET ADDRESS BACK INX H ;GET ADDRESS OF FOLLOWING STATEMENT JMP DMST ;DUMP IT OUT, TOO. DMSG9 DB ','+80H DMSG1 DB 20H ;QUOTES MESSAGE DB 0A7H DMSG2 DB 08DH ;CARRIAGE RETURN MESSAGE DUJM DW DMST4 ;TABLE OF JUMPS FOR SPECIAL STATEMENTS DW DMST7 DW DMST9 DW DMST8 DW DMST8 DW DMSTA DW DMSTC DW DMST5 DW DMSTT DW DMST8 DMST4 CALL FEND ;DUMP EXPRESSION PUSH H ;SAVE ADDRESS LXI H,DMSG3 ;"GOTO" MESSAGE DMSTU CALL LNOT ;SEND IT POP H ;RECOVER ADDRESS CALL DNLS ;SEND THE LIST OF LINE DESCRIPTORS JMP DMST5 ;CHECK FOR REMARKS FOLLOWING DMST7 CALL DMNM ;PROCESS NAME MOV A,M ;CHECK FOR EXPRESSION FOLLOWING CPI 9 JNZ DMST5 ;NONE PUSH H ;SAVE ADDRESS LXI H,DMSG9 ;COMMA CALL LNOT ;SEND IT POP H ;RECOVER ADDRESS JMP DMST3 ;DUMP THE EXPRESSION JMP DMST3 ;GET FOLLOWING EXPRESSION DMST8 CALL DMNM ;PROCESS NAME JMP DMST5 ;CHECK FOR REMARKS DMST9 CALL FEND ;PROCESS EXPRESSION PUSH H ;SAVE ADDRESS LXI H,DMSG4 ;DUMP A "TO" CALL LNOT ;THERE YOU GO POP H ;RECOVER ADDRESS CALL FEND ;GET NEXT EXPRESSION MOV A,M ;GET NEXT BYTE CPI 9 ;CHECK FOR ANOTHER EXPRESSION JNZ DMST5 ;NOPE, SO LOOK FOR REMARKS PUSH H ;SAVE ADDRESS LXI H,DMSG5 ;DUMP A "STEP" CALL LNOT ;DUMP IT DUMMY POP H ;RECOVER ADDRESS JMP DMST3 ;DUMP THE LAST EXPRESSION AND QUIT DMSTA CALL FEND ;DUMP EXPRESSION DMSTB PUSH H ;SAVE ADDRESS LXI H,DMSG6 ;DUMP A "THEN" CALL LNOT ;SEND IT POP H ;GET BACK THE ADDRESS CALL DMST ;PROCESS AS ANOTHER COMPLETE STATEMEN RET ;DONE DMELSE DB ' ELSE',' '+80H DMSG3 DB ' GOTO',0A0H DMSG4 DB ' TO',0A0H DMSG5 DB ' STEP',0A0H DMSG6 DB ' THEN',0A0H * RTN. D.45 * DUMP NAME LIST DNLS CALL DMNM ;DUMP A NAME MOV A,M ;GET A BYTE CPI 6 ;IS IT A NAME? JZ DNLS1 ;YUP RET ;NOPE DNLS1 PUSH H ;SAVE HL LXI H,LOTB ;COMMA MESSAGE CALL LNOT ;SEND IT POP H ;GET HL BACK JMP DNLS ;DUMP THE NEXT ONE * RTN. D.46 * FIND LINE IN SOURCE, WITH OFFSET * IN: BC = SYMBOL NUMBER * DE = OFFSET (+- 32K) LILO PUSH D ;SAVE OFFSET PUSH B ;SAVE 'EM LDA RUNF ;ARE WE RUNNING? ANA A JNZ LILO7 ;YUP CALL ASDA ;ASSIGN ALL STATEMENT NAMES LILO7 POP B ;GET 'EM BACK CALL DFND ;GET THE POINTER XCHG LHLD ESRC INX H CALL CMP16 JC LILOG ;TOO BIG LHLD FSRC DCX H CALL CMP16 JNC LILOG ;TOO SMALL XCHG SHLD LINE MOV A,M ;CHECK FOR A STATEMENT CPI 9FH MVI B,7 ;ERROR CODE JUST IN CASE JNZ ERROR POP B ;GET OFFSET TO BC INR B ;CHECK FOR NEGATIVE DCR B JP LILO1 ;NOPE INX B ;YUP, SO DECREASE BY ONE LILO1 MOV A,B ;CHECK FOR BC=0 ORA C RZ ;SURE WAS CALL LILO3 ;MOVE UP OR BACK ONE STATEMENT PUSH D ;SAVE D XCHG LHLD ESRC CALL CMP16 JZ LIL82 ;ERROR LHLD SLIN CALL CMP16 JZ LIL82 XCHG POP D LILO2 INR B ;SET FLAGS FOR B DCR B JM LILO4 ;WE'S GOIN' BACKWARDS DCX B ;ANOTHER ONE DOWN THE DRAIN JMP LILO1 ;SEE IF WE'RE DONE YET LILO4 INX B ;THE BACKWARDS MOVE JMP LILO1 ;CHECK FOR DONENESS LILO3 PUSH B ;SAVE THE OFFSET COUNT INR B ;SET FLAGS FOR B DCR B JM LILO5 ;TIME FOR A BACKSTROKE LILOF MOV A,M ;GET A BYTE PUSH PSW ;SAVE IT CALL MFOS ;MOVE FORWARD ONE STATEMENT POP PSW ;GET BYTE BACK CPI 9FH ;IS IT A NAME? JZ LILOF ;YUP CPI 85H ;IS IT AN IF? JZ LILOF ;YUP CPI 9CH ;IS IT A TAB JZ LILOF ;YUP! MOV A,M ;CHECK FOR COLON BYTE CPI 9EH JZ LIL00 ;SURE WAS CPI 9BH ;IS IT AN ELSE? JZ LIL00 ;YUP CPI 9DH JZ LIL00 LILO6 POP B ;GET BACK THE OFFSET COUNT RET ;DONE LILO5 CALL LILOBAK ;MOVE BACK CALL LILOBAK ;MOVE BACK AGAIN MOV A,M ;GET A BYTE PUSH PSW ;SAVE IT CALL MFOS ;MOVE UP POP PSW ;GET BYTE BACK CPI 9FH ;IS IT A STATEMENT NAME? JZ LILO5 ;YUP CPI 85H ;IS IT AN IF? JZ LILO5 CPI 9EH ;CHECK FOR COLON BYTE JZ LIL01 ;SURE WAS CPI 9BH ;IS IT AN ELSE? JZ LIL01 ;YUP CPI 9DH JZ LIL01 CPI 9CH ;IS IT A TAB? JZ LILO5 ;YUP JMP LILO6 ;NOPE LILOG MVI B,7 ;ILLEGAL STATEMENT JMP ERROR LIL00 INX H ;GET NEXT ADDRESS SHLD LINE ;MAKE IT NEXT JMP LILOF ;CONTINUE LIL01 CALL LILOBAK ;BACK UP, JACK JMP LILO5 LILOBAK CALL MBOS ;BACK UP MOV A,M ;CHECK FOR TAB CPI 9CH JZ LILOBAK ;SURE IS, SO BACK UP AGAIN RET ;DON DMNMM DB ' &',0A0H DMS65 LXI H,DMS66 ;SEND BACKSLASH/CARRIAGE RETURN JMP DMS00+3 ;SEND IT OUT DMS66 DB 5CH ;BACKSLASH DB 8DH ;CARRIAGE RETURN LIL82 MVI B,7 JMP ERROR DMSTT CALL FEND ;DUMP EXPRESSION PUSH H ;SAVE ADDRESS LXI H,DMGOS ;GOSUB MESSAGE JMP DMSTU ;FINISH IT UP DMGOS DB ' GOSUB',0A0H * RTN. D.47 * GET LINE AND OFFSET FOR COMMANDS GLFC CALL USCN ;GET NEXT TOKEN RC ;THERE AIN'T NONE, BOSS LHLD TSCN ;GET ADDRESS OF TOKEN CALL SSRC ;SEE IF IT'S IN THE TABLE PUSH B ;SAVE THE SYMBOL NUMBER MVI B,7 ;ERROR CODE JUST IN CASE JNZ ERROR ;NOT EVEN LISTED! ANI 3FH ;STRIP OFF UPPER TWO BITS CPI 1 ;MAKE SURE IT'S A STATEMENT JNZ ERROR ;NOT A STATEMENT!!!!!!! CALL USCN ;SCAN OFF THE NEXT TOKEN JNC GLFC1 ;NOT THE END YET GLFC4 LXI D,0 ;CLEAR DE GLFC2 XRA A ;CLEAR CARRY POP B ;GET BACK SYMBOL NUMBER RET ;DONE..... GLFC1 LHLD TSCN ;ADDRESS OF TOKEN MOV A,M ;GET THE TOKEN CPI '+'+80H ;IS IT A PLUS SIGN? JZ GLFC5 ;YUP CPI '-'+80H ;IS IT A MINUS SIGN? JNZ GLFC3 ;NOPE GLFC5 PUSH PSW ;SAVE IT CALL USCN ;SCAN OFF YET ANOTHER TOKEN. MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;RAN INTO THE END, BUMP. CALL LGNM ;CONVERT TO A NUMBER MVI B,10H ;ERROR CODE IN CASE A STONE IS ENTERING JC ERROR ;HE WAS LXI H,TMP10 ;ADDRESS OF NUMBER CALL BCDB ;CONVERT NUMBER TO BINARY POP PSW ;GET THE TOKEN BACK XCHG ;HL TO DE CPI '-'+80H ;WAS IT A MINUS SIGN JNZ GLFC2 ;NOPE MOV A,D ;YES, SO 1'S COMPLEMENT TIME CMA MOV D,A MOV A,E CMA MOV E,A INX D ;CORRECT FOR 2'S COMPLEMENT JMP GLFC2 ;CONTINUE TOWARDS LEAVING GLFC3 CALL BSCN ;OOPS, BACK UP JMP GLFC4 ;EXIT WITHOUT ANY OFFSET * RTN. D.48 * LIST COMMAND INTERPRETER LIST LHLD FSRC ;GET FIRST ADDRESS OF SOURC SHLD FLST ;MAKE THIS THE FIRST ADDRESS TO LIST LHLD ESRC ;GET LAST ADDRESS OF SOURCE LDA CSST ;SET CATV APPROPRIATELY STA CATV SHLD LLST ;MAKE THIS THE LAST ADDRESS TO LIST CALL GLFC ;GET LINE JC LIST1 ;THIS PARAMETER NOT INPUTTED CALL LILO ;FIND THE ADDRESS SHLD FLST ;CHANGE THE FIRST ADDRESS TO LIST CALL GLFC ;GET LINE JC LIST1 ;THIS PARAMETER NOT INPUTTED CALL LILO ;FIND THE ADDRESS SHLD LINE ;MOVE UP ONE MORE LISTK MOV A,M ;GET A BYTE PUSH PSW ;SAVE IT CALL MFOS ;MOVE UP ONE POP PSW ;CHECK FOR NAMES AND IFS CPI 85H JZ LISTK CPI 9FH JZ LISTK CPI 9EH JZ LISTK CPI 9DH JZ LISTK CPI 9CH JZ LISTK CPI 9BH JZ LISTK SHLD LLST ;CHANGE THE LAST ADDRESS TO LIST LIST1 XRA A ;GET FIRST ADDRESS TO DE LIS33 LHLD FLST XCHG LHLD LLST ;GET LAST ADDRESS CALL CMP16 ;CHECK RELATIVE SIZE JZ LISTW ;DONE JC SPRAT ;REVERSED PARAMETERS LIST2 XCHG ;PUT 'EM BACK CALL DMST ;DUMP THE STATEMENT OUT CALL CONT ;CHECK FOR CONTROL C JZ RSTRT ;IT WAS PUSHED JMP LIS33 ;GET THE NEXT ONE LISTW LDA CSST ANA A JZ RSTRT LXI H,DMSG2 CALL LNOT XRA A STA CSST STA CATV STC INR A ;CLEAR ZERO FLAG CALL COUT JMP RSTRT * RTN. D.49 * ENTER COMMAND INTERPRETER ENTR LHLD ESRC ;GET END OF SOURCE XRA A ;CLEAR RUN READY FLAG STA RURD SHLD INSR ;SET INSERTION POINT THERE CALL GLFC ;CHECK FOR A PARAMETER MVI A,0 ;SET ENTER MODE STA CMND JC RSTRT ;NONE CALL LILO ;GET THE ADDRESS SHLD INSR ;SET INSERTION POINT THERE JMP RSTRT ;BACK TO THE MAINSTREAM * RTN. D.50 * DELETE COMMAND INTERPRETER DLTE CALL GLFC ;CHECK FOR A PARAMETER PUSH B ;SAVE BC MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;NO PARAMETERS ENTERED POP B ;RECOVER BC CALL LILO ;GET ADDRESS SHLD FLST ;SET UP FLAGS SHLD LLST CALL GLFC ;CHECK FOR SECOND PARAMETER JC DLTE1 ;NOPE CALL LILO ;GET ADDRESS SHLD LLST ;SAVE IT DLTE1 MOV A,M ;GET A BYTE PUSH PSW ;SAVE IT CALL MFOS ;MOVE FORWARD ONE POP PSW ;RESTORE PSW CPI 9FH ;CHECK FOR A STATEMENT NAME JZ DLTE1 ;NOPW CPI 85H ;CHECK FOR IF JZ DLTE1 ;YUP CPI 9CH ;IS IT A TAB? JZ DLTE1 ;SURE IS MOV A,M ;CHECK FOR COLON OR BACKSLASH CPI 9EH JZ DLTE4 ;SURE WAS CPI 9BH ;IS IT AN ELSE? JZ DLTE4 ;YUP CPI 9DH JNZ DLTE2 ;NOPE DLTE4 CALL MFOS ;MOVE UP TWO JMP DLTE1 ;TRY AGAIN DLTE2 XCHG ;HL TO DE LHLD ESRC ;END OF SOURCE CALL SUB16 ;GET THE DIFFERENCE MOV A,H ;CHECK FOR NONE TO MOVE ORA L JZ DLTE3 ;MUST BE LAST STATEMENT DELETED MOV C,L MOV B,H LHLD FLST ;GET FIRST ADDRESS TO KILL XCHG ;SWAP CALL MOVE ;MOVE 'EM DOWN XCHG ;FLST TO HL DAD B ;ADD N SHLD ESRC ;NEW END OF SOURCE * RTN. D.51 * CLEAR COMMAND PROCESSOR CLER XRA A ;CLEAR RURD (RUN READY FLAG) STA RURD LDA EDITM ANA A ;ARE WE IN EDIT MODE? JZ RSTRT ;NOPE LXI SP,STACK+100 PUSH H ;SET UP FOR BACK TO EDIT JMP PSSF ;MOVE FORWARD ONE STATEMENT DLTE3 LHLD FLST ;NEW END SHLD ESRC JMP CLER * RTN. D.52 * RUN COMMAND PROCESSOR PRUN LHLD ESRC ;MAKE SURE THERE IS A PROGRAM XCHG LHLD FSRC CALL CMP16 JZ RSTRT ;NONE LOADED CALL CHCKA ;CHECK BASIC'S INTEGRITY. CALL GLFC ;LOOK FOR A SPECIFIC LINE LHLD FSRC ;PRESET DATA FLAGS SHLD DATAP LXI H,0 SHLD DATAT SHLD DATAW LHLD SDIR ;INITIALIZE ARRAY SPACE SHLD FARY LHLD FRAV ;INITIALIZE PNTR SHLD PNTR SHLD NPNTR LHLD FSRC ;GET START OF SOURCE IN CASE THERE IS NO * SPECIFIED LINE JC PRUN2 ;TWERE'NT NONE CALL LILO ;FIND THE ADDRESS PRUN2 LDA RURD ;GET RUN READY FLAG ANA A ;IS IT SET? JNZ RUN ;ALREADY SET PUSH H ;SAVE START ADDRESS CALL ASDA ;ASSIGN STATEMENT ADDRESSES CALL AVAP ;ASSIGN ARRAY POINTER AND VARIABLE SPACE MVI A,0FFH ;SET RUN READY STA RURD LHLD FRAV ;INITIALIZE PNTR SHLD PNTR POP H ;GET BACK ADDRESS JMP RUN ;SO GO RUN ALREADY * RTN. D.53 * CONT COMMAND INTERPRETER PCNT LDA RURD ;RUN READY? ANA A ;FIND OUT JZ PCNT1 ;NOPE LHLD LINEA ;GET CURRENT LINE ADDRESS XCHG ;SEE IF WE ARE DONE LHLD ESRC XCHG CALL CMP16 JZ PCNT1 ;YUP JMP RUN ;GO RUN IT PCNT1 MVI B,22H ;ERROR JMP ERROR * RTN. D.54 * NEW COMMAND PROCESSOR PNEW CALL PNEW1 ;INITIALIZE ALL THIS CRAP JMP RSTRT ;DONE PNEW1 LXI H,1 ;GET A 16 BIT ONE SHLD SNUM ;NUMBER OF SYMBOLS IS ONE LHLD MEND ;END OF MEMORY SHLD STAB ;IS EQUAL TO THE START OF SYMBOLS MVI M,80H ;AND SET THE END IN DCX H ;GET MEND-3 MVI M,0 DCX H MVI M,0 DCX H MVI M,0 SHLD SDIR ;START OF DIRECTORY XRA A ;CLEAR A STA RURD ;CLEAR THE RUN READY FLAG LHLD EBSC ;GET END BASIC FLAG SHLD FSRC ;STORE SOURCE FLAGS SHLD ESRC SHLD FRAV ;INITIALIZE FRAV LXI H,C2767 ;INITIALIZE SEED LXI D,SEED LXI B,6 CALL MOVE CALL CHCKA ;CHECK ON THE INTERPRETER'S INTEGRITY INERT RET ;DONE.... * RTN. D.55 * CLOAD STATEMENT PROCESSOR PCLD CALL PNEW1 ;MAKE ROOM FOR A NEW PROGRAM PCLD1 LXI H,PCLDM ;CADD ENTRANCE CALL MSGER ;SEND NOTIFIER XRA A ;SEND START MOTORS CALL CAIN CALL USCN ;SCAN OFF NEXT TOKEN MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;NO INPUT, DUMMY PCLD2 LHLD ESRC ;GET ADDRESS TO INPUT TO CALL LICA ;INPUT A LINE FROM THE CASSETTE LHLD ESRC ;GET ADDRESS AGAIN MOV A,M ;GET THE BYTE CPI 1 ;WAS IT NAME INDICATOR? JNZ PCLD2 ;NOPE INX H ;GET NEXT ADDRESS XCHG ;HL TO DE LHLD TSCN ;GET CHARACTER MOV A,M ORI 80H ;INSERT STROBE XCHG ;DE TO HL CMP M ;ARE THEY THE SAME ? JNZ PCLD2 ;NOPE MVI A,0FFH ;SET CSST AND ENTER MODE STA CSST XRA A STA CMND LHLD ESRC ;SET UP INSERTION POINT SHLD INSR JMP RSTRT ;INPUT 'EM LINK4 LINK B:TBASICA5