CP/M

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

/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug031.ark / TBASICA6.ASM < prev

Wrap

Assembly Source File | 1984-04-29 | 25.7 KB | 1,332 lines

SANA JNC SPRAT ;ERROR IF NO EXPRESSION CALL FNOP ;GET AN OPERAND JNC SPRAT ;ERROR IF NOT A STRING PUSH H ;SAVE ADDRESS CALL CRLF ;SEND A CR TO THE CONSOLE LXI H,PCSVM ;SEND WRITING CASSETTE MESSAGE CALL MSGER XRA A ;SEND START MOTORS CALL BPORT POP H SANA1 MOV A,M ;SEND OUT THE NAME PUSH H CALL OBPORT POP H ;SEE IF WE'RE DONE MOV A,M INX H ;UPDATE INDEX ANA A JP SANA1 ;NOPE LHLD FSRC ;COMPUTE NUMBERS OF BYTES XCHG LHLD ESRC CALL SUB16 SHLD TMP1 LHLD SNUM SHLD TMP1+2 LHLD SDIR XCHG LHLD SSSS CALL SUB16 SHLD TMP1+4 XCHG LHLD TMP1 LXI B,7 DAD B DAD D SHLD TMP1+6 MOV A,L ;SEND TOTAL NUMBER OF BYTES CALL OBPORT LDA TMP1+7 ;SEND MSB CALL OBPORT LXI H,TMP1 ;SEND PARAMETERS MVI B,6 SANA2 MOV A,M PUSH B PUSH H CALL OBPORT POP H ;RESTORE POP B DCR B ;UPDATE INX H JNZ SANA2 ;MORE TO DO LHLD TMP1 ;GET NUMBER OF SOURCE BYTES XCHG ;TO DE LHLD FSRC ;FIRST BYTE LOCATION CALL SANAA ;DO IT LHLD TMP1+4 ;GET NUMBER OF DIRECTORY BYTES XCHG INX D LHLD SDIR ;FIRST BYTES LOCATION CALL SANAA ;DO IT STC ;SEND STOP MOTORS MVI A,0 INR A CALL BPORT RET ;DONE SANAA MOV A,M ;GET A BYTE PUSH H PUSH D ;SAVE 'EM CALL OBPORT POP D POP H DCX D INX H ;UPDATE MOV A,D ORA E ;CHECK FOR DONENESS JNZ SANAA RET ;DONE SANC MVI A,0FFH ;SET BFLAG STA BFLAG PUSH PSW ;SAVE PUSH D XRA A ;SEND START MOTORS CALL BPORT POP D POP PSW JMP SPRAZ ;DO IT SAND MVI A,0FFH STA BFLAG PUSH D PUSH PSW XRA A CALL BINPOR POP PSW POP D JMP SPRFZ ;DO IT SANB JNC SPRAT ;ERROR IF NO EXPRESSION CALL FNOP ;GET AN OPERAND JNC SPRAT ;ERROR IF NOT A STRING PUSH H ;SAVE IT CALL CRLF ;SEND A CR TO THE CONSOLE LXI H,PCLDM ;SEND READING CASSETTE MESSAGE CALL MSGER CALL PNEW1 ;CLEAR ANY EXISTING PROGRAMS XRA A ;SEND START MOTORS CALL BINPOR SANB3B LHLD FARY ;GET A PLACE TO READ IN STRING DCR H SANB1 PUSH H ;SAVE ADDRESS CALL OBINPOR ;GET A BYTE POP H MOV M,A ;STUFF IT INX H ANA A ;DONE? JP SANB1 ;NOPE LHLD FARY DCR H POP D CALL STRNG ;COMPARE THEM JNZ SANB2 ;NOT THE SAME CALL OBINPOR ;IGNORE TWO CALL OBINPOR LXI H,TMP1 ;READ PARAMETERS MVI B,6 SANB3 PUSH H PUSH B CALL OBINPOR POP B POP H MOV M,A DCR B ;DONE? INX H JNZ SANB3 ;NOPE LHLD TMP1 ;GET NUMBER OF SOURCE BYTES XCHG ;TO DE LHLD FSRC ;START OF SOURCE DAD D SHLD ESRC ;END OF SOURCE SHLD FRAV LHLD TMP1+2 ;NUMBER OF SYMBOLS SHLD SNUM LHLD TMP1+4 ;NUMBER OF BYTES OF DIRECTORY XCHG ;TO DE LHLD SSSS ;END OF MEMORY CALL SUB16 ;COMPUTE SDIR SHLD FARY SHLD SDIR LHLD TMP1 ;NUMBER OF BYTES OF SOURCE XCHG LHLD FSRC ;FIRST SPOT TO PUT 'EM CALL SANBA ;DO IT LHLD TMP1+4 ;NUMBER OF BYTES OF DIRECTORY XCHG INX D LHLD SDIR ;FIRST PLACE TO PUT 'EM CALL SANBA ;DO IT LHLD SNUM ;COMPUTE STAB MOV E,L MOV D,H DAD D DAD D XCHG LHLD SDIR DAD D SHLD STAB ;SAVE IT MVI A,1 ANA A ;SEND STOP MOTORS STC CALL BINPOR JMP RSTRT ;START OVER SANB2 CALL OBINPOR ;READ A BYTE PUSH PSW CALL OBINPOR ;READ ANOTHER ONE POP B MOV C,B MOV B,A ;GET NUMBER OF BYTES TO IGNORE SANB3A PUSH B CALL OBINPOR POP B DCX B MOV A,B ORA C JNZ SANB3A JMP SANB3B ;LOOK AGAIN SANBA PUSH H PUSH D CALL OBINPOR POP D POP H MOV M,A INX H DCX D MOV A,D ORA E JNZ SANBA XRA A ;CLEAR SOME FLAGS STA RURD ;CLEAR RUN READY FLAG STA RUNF ;CLEAR RUN FLAG RET ;DONE....... * RTN. E.75 * ASSIGN PROCESSOR SPRG JNC SPRAT ;ERROR CALL FNOP ;GET AN OPERAND JC SPRAT ;STRING FOR DEVICE TYPE? CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE PHYSICAL DEVICE NUMBER CALL POPS ;LOOK FOR COMMA MOV A,M CPI 0DH JNZ SPRAT ;ERROR CALL FNOP ;GET THE OTHER OPERAND JC SPRAT ;STRING? CALL BCDB ;CONVERT TO BINARY LXI D,8 ;CHECK FOR TOO BIG CALL CMP16 JNC SPRAT ;TOO BIG CALL SPRGSH ;SHIFT BY HL XTHL ;GET PHYSICAL DEVICE LXI D,10 ;CHECK FOR OVERFLOW CALL CMP16 JNC SPRAT ;TOO BIG LXI D,MODES ;GET MODES TABLE ADDRESS DAD D POP D ;GET LOGICAL DEVICE TYPE MOV A,M ;SET INTO TABLE ORA E MOV M,A RET ;DONE * RTN. E.76 * DROP PROCESSOR * RTN. E.77 SPRH JNC SPRAT ;NO EXPRESSION CALL FNOP ;GET PHYSICAL DEVICE TYPE JC SPRAT ;STRING? CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE IT CALL POPS ;LOOK FOR COMMA MOV A,M CPI 0DH JNZ SPRAT ;ERROR CALL FNOP ;GET LOGICAL DEVICE TYPE JC SPRAT CALL BCDB ;CONVERT TO BINARY LXI D,8 ;CHECK FOR TOO BIG CALL CMP16 JNC SPRAT ;TOO BIG CALL SPRGSH ;SHIFT IT XTHL ;GET PHYSICAL DEVICE LXI D,10 ;CHECK FOR TOO BIG CALL CMP16 JNC SPRAT ;TOO BIG LXI D,MODES DAD D ;DEVICE ADDRESS POP D ;GET BIT MOV A,M ORA E XRA E MOV M,A ;BIT CLEARED RET ;DONE * GOPROC PROCESSOR SPRI LHLD LINE ;GET LINE ADDRESS TO STACK PUSH H CALL MFOS ;GET NEXT STATEMENT ADDRESS XCHG ;TO DE CALL SPRI3 ;RETURN ADDRESS TO STACK CALL MBOS ;BACK UP CALL SPRD ;GET STATEMENT TO JUMP TO POP B ;GET THE STACK RIGHT POP H POP D PUSH B PUSH D INX H ;GET PAST LABEL INX H INX H INX H INX H MOV A,M ;SEE IF THERE IS AN OFFSET CPI 8 JNZ SPRI1 ;NOPE INX H ;MOVE PAST START OF EXPRESSION INX H SPRI4 MOV A,M ;LOOP FOR END OF EXPRESSION CPI 9 ;END? JZ SPRI5 ;YUP CALL GTIN DAD D JMP SPRI4 ;LOOP FOR ANOTHER SPRI5 INX H ;GET NEXT ONE SPRI1 MOV A,M ;SEE IF THERE IS A PASS LIST CPI 9 JNZ SPRI2 ;NOPE XCHG ;TO DE LHLD PNTR ;PUSH A PASSED DATA BLOCK INDICATION MVI M,3AH INX H SHLD PNTR XCHG ;BACK TO HL CALL EVPE ;EVALUATE THE EXPRESSION LHLD PNTR ;PUSH THE END OF BLOCK DCX H MVI M,3AH INX H SHLD PNTR SPRI2 LHLD PNTR SHLD NPNTR ;SET UPDATE CORRECTLY XRA A ;CLEAR RETURN LAST FLAG STA RTFLG RET ;DONE....... SPRI3 LHLD PNTR ;STUFF IN A RETURN ADDRESS MVI M,39H INX H MVI M,2 INX H MOV M,E INX H MOV M,D INX H MVI M,3 INX H MVI M,39H INX H ;UPDATE POINTERS SHLD PNTR SHLD NPNTR RET ;DONE....... * RTN. D.78 * FOR PROCESSOR SPRJ LHLD PNTR ;PUSH A 37H ON THE STACK MVI M,37H INX H SHLD PNTR CALL MFOS ;MOVE UP TO NEXT STATEMENT XCHG ;TO DE LHLD PNTR ;PUSH THE ADDRESS ON THE STACK MVI M,2 INX H MOV M,E INX H MOV M,D INX H MVI M,3 INX H SHLD PNTR XCHG ;BACK TO HL XTHL ;GET STACK RIGHT PUSH H ;RETURN ADDRESS BACK DOWN CALL MBOS ;MOVE BACK INX H ;GET EXPRESSION ADDRESS CALL EVPE ;EVALUATE IT PUSH D ;SAVE END OF EXPRESSION ADDRESS LHLD SCFLG ;GET ADDRESS XCHG CALL POPS MVI M,2 ;STUFF IN THE ADDRESS INX H MOV M,E INX H MOV M,D INX H MVI M,3 INX H SHLD PNTR ;UPDATE POINTER POP H ;GET BACK END ADDRESS INX H ;GET NEXT EXPRESSION CALL SPRJ2 ;DO IT TO IT MOV A,M ;CHECK FOR ANOTHER EXPRESSION (STEP) CPI 9 JNZ SPRJ1 ;NOPE CALL SPRJ2 ;DO IT TO IT TOO SPRJ3 LHLD PNTR ;PUSH A 37 END CODE ON STACK MVI M,37H INX H SHLD NPNTR ;GET UPDATE RIGHT RET ;DONE....... SPRJ1 LHLD PNTR ;MOVE IN A 1 XCHG INX D LXI H,ONEEE LXI B,6 CALL MOVE CALL OPR30 ;FINISH IT ALL OFF JMP SPRJ3 SPRJ2 PUSH H ;GET PNTR TO STACK LHLD PNTR XTHL ;I THINK THAT DID IT CALL EVPE ;EVALUATE THE EXPRESSION XCHG ;SAVE THE END INX H SHLD NN CALL FNOP ;GET THE OPERAND MVI B,10H ;ERROR CODE IN CASE OF STRING JC ERROR XTHL ;GET ORIGINAL POINTER BACK XCHG ;TO DE LHLD PNTR ;SEE IF IT'S THE SAME CALL CMP16 MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;THEY WERE'NT POP H ;GET BACK ADDRESS OF VARIABLE XCHG ;TO DE LHLD PNTR MVI M,4 ;STORE NUMBER BLOCK START INX H XCHG LXI B,6 ;NUMBER OF WORDS CALL MOVE XCHG DAD B MVI M,5 ;END OF NUMBER BLOCK INX H ;UPDATE POINTER SHLD PNTR LHLD NN ;GET BACK THE END OF THE ROAD RET * RTN. E.79 * POP A CONTROL BLOCK INDICATOR SPRK LHLD PNTR ;SEE IF WE'VE REACHED THE BITTER END YET XCHG LHLD FRAV CALL CMP16 MVI B,34H ;ERROR CODE JUST IN CASE JNC ERROR CALL POPS ;POP OFF A TOKEN MOV A,M ;CHECK IT OUT CPI 3BH JNC SPRK ;NOT THERE YET CPI 37H JC SPRK ;NOR YET RET ;AHH, GOT IT SPF10 MVI M,80H ;STORE AN ASCII 0 INX H MVI M,0 DCX H ;INDEX BACK TO NORMAL JMP SPF20 ONEEE DB 2,0,0,0,0,1 * RTN. E.80 * NEXT PROCESSOR SPRL XCHG ;TO HL JNC SPRLA ;NO NAMES FOLLOWING SHLD NN ;INITIALIZE THIS THING SHLD PNTR SPRL1 CALL SPRK ;POP OFF A CONTROL BLOCK CPI 3AH ;IS IT A PASSED DATA BLOCK? JZ SPRL1 ;YUP, SO IGNORE IT CPI 37H ;IS IT A FOR/NEXT CONTROL BLOCK? MVI B,34H ;ERROR CODE JUST IN CASE JNZ ERROR ;NOPE, SO SOMEONE BLEW IT LHLD NN ;GET VARIABLE STRING MOV A,M CPI 9 ;ANY VARIABLES JZ SPRL2 ;NOPE CPI 2 ;MAKE SURE IT'S A VARIABLE MVI B,10H ;ERROR CODE IN CASE IT'S NOT JNZ ERROR INX H ;FISH OUT THE LOCATION MOV E,M INX H MOV D,M PUSH D ;SAVE IT LHLD PNTR ;FISH OUT THE OTHER LOCATION LXI D,19 CALL SUB16 MOV E,M INX H MOV D,M POP H ;SEE IF THEY ARE THE SAME CALL CMP16 JNZ SPRL5 ;NOPE SPRL2 LHLD PNTR INX H ;UPDATE POINTER SHLD PNTR LXI D,20 ;FISH OUT THE LOCATION CALL SUB16 MOV E,M INX H MOV D,M INX H ;GET LOCATION OF END VALUE INX H INX H PUSH D ;SAVE VARIABLE LOCATION PUSH H ;SAVE ADDRESS CALL CMPR ;COMPARE THEM POP H ;RESTORE ADDRESS PUSH PSW ;SAVE RESULTS LXI D,8 DAD D ;COMPUTE LOCATION OF STEP VALUE MOV A,M ;GET THE SIGNS BYTE ANA A ;CHECK FOR SIGN JP SPRL3 ;POSITIVE POP PSW ;CHANGE THE CARRY CMC PUSH PSW SPRL3 POP PSW POP D ;RESTORE VARIABLE LOCATION JZ SPRL4 ;DONE WITH LOOP JC SPRL4 MOV C,E ;DE TO BC MOV B,D CALL ADDER ;STEP AGAIN LHLD PNTR ;UPDATE NPNTR SHLD NPNTR LXI D,24 CALL SUB16 ;GET LOCATION OF ADDRESS MOV E,M INX H MOV D,M POP H ;CHANGE RETURN ADDRESS POP B ;GET RID OF THE OLD ONE PUSH D PCHL ;RETURN.....>> SPRL4 CALL SPRK ;POP A WHOLE BLOCK OFF CALL SPRK SHLD NPNTR ;UPDATE NPNTR LHLD NN ;GET VARIABLE STRING MOV A,M CPI 9 ;THE END? RZ ;YUP INX H ;ADD 4 INX H INX H INX H MOV A,M ;GET THIS BYTE CPI 09 ;THE END? RZ ;YUP CPI 0DH ;COMMA? MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;NOPE INX H SHLD NN ;UPDATE NN JMP SPRL1 ;DO IT AGAIN SPRL5 CALL SPRK ;POP OFF THE BOTTOM JMP SPRL1 ;LOOK AGAIN * RTN. E.81 * GOSUB PROCESSOR SPRM LHLD LINE ;SAVE CURRENT LINE VALUE PUSH H CALL MFOS ;GET RETURN ADDRESS ONTO STACK XCHG CALL SPRI3 POP H ;RESTORE LINE VALUE SHLD LINE CALL SPRD ;GET ADDRESS TO JUMP TO POP H ;FIX STACK AND RETURN XTHL PCHL * RTN. E.82 * ON..GOTO PROCESSOR SPRN LHLD PNTR ;SAVE PNTR ON THE STACK PUSH H LHLD LINE ;EVALUATE EXPRESSION INX H CALL EVPE ;DO IT TO IT POP H ;PUSH END ON STACK BEFORE PNTR PUSH D PUSH H CALL FNOP ;GET OPERATOR MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;STRING INSTEAD OF NUMBER MOV A,M ;CHECK FOR NEGATIVE ANA A MVI B,35H ;ERROR CODE JUST IN CASE JM ERROR XTHL ;GET ORIGINAL PNTR XCHG ;TO DE LHLD PNTR ;CHECK AGAINST PRESENT PNTR CALL CMP16 MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;WHAT A ROCK POP H ;GET LOCATION BACK CALL BCDB ;CONVERT TO BINARY XCHG ;TO DE POP H ;GET END OF EXPRESSION INX H ;GET FIRST LINE DESCRIPTOR SPRN1 DCX D ;DECREMENT COUNT MOV A,D ;IS IT ZERO? ORA E JZ SPRN2 ;YUP, WE FOUND IT PUSH D ;SAVE 'EM SPRN3 MOV A,M ;GET A BYTE CALL GTIN ;GET INCREMENT DAD D ;ADD IT MOV A,M ANA A ;NEXT STATEMENT? JM SPRN6 ;CONTINUE TIME CPI 6 ;STATEMENT NAME? JNZ SPRN3 ;NO, SO TRY AGAIN POP D ;GET COUNT BACK JMP SPRN1 ;LOOP FOR THIS DESCRIPTOR SPRN2 DCX H ;FAKE IT FOR GOTO PROCESSOR SHLD LINE LDA OPFLG ;CHECK FOR ON....GOSUB CPI 88H JNZ SPRD ;NOPE, SO TO GOTO JMP SPRM ;GOSUB * RTN. E.83 * OUT PROCESSOR SPRO MVI B,10H ;ERROR IF NO EXPRESSION JNC ERROR CALL SPRO1 ;GET OPERAND 1 PUSH H CALL POPS ;LOOK FOR COMMA MOV A,M CPI 0DH ;IS IT? MVI B,10H ;ERROR IF NOT JNZ ERROR CALL SPRO1 ;GET OPERAND 2 XTHL ;SWAP 'EM MOV A,L ;OPERAND TO THE ACCUMALATOR POP H ;GET BACK THE PORT NUMBER MOV H,L ;TO H MVI L,0D3H SHLD IOST JMP IOST ;GO DO IT SPRO1 CALL FNOP ;GET OPERAND MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;CAN'T HAVE A STRING JUST NOW CALL BCDB ;CONVERT TO BINARY INR H ;CHECK FOR H=0 DCR H MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;TOO BIG RET ;DONE....... * RTN. E.84 * POKE PROCESSOR SPRP MVI B,10H ;ERROR CODE JUST IN CASE JNC ERROR ;NO EXPRESSION FOLLOWING CALL SPRO1 ;GET BYTE TO POKE PUSH H ;SAVE IT CALL POPS ;CHECK FOR A COMMA MOV A,M CPI 0DH MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;NO COMMA CALL FNOP ;GET ANOTHER OPERAND MVI B,10H ;ERROR CODE JUST IN CASE JC ERROR ;CAN'T HAVE A STRING HERE CALL BCDB ;CONVERT TO BINARY POP D ;GET BACK DATA MOV M,E ;INTO MEMORY RET ;DONE....... * RTN. E.85 * PROCEDURE PROCESSOR SPRQ RNC ;NO EXPRESSION, SO NO LOCALS LHLD NPNTR ;SET BEGINNING OF BLOCK MVI M,38H INX H SHLD PNTR LHLD LINE ;GET START OF UNPROCESSED EXPRESSION INX H INX H SPRQ1 MOV A,M ;GET A BYTE CPI 9 ;END? JZ SPRQ2 ;YUP MVI B,10H ;ERROR CODE JUST IN CASE CPI 2 ;VARIABLE NAME? JNZ ERROR ;NOPE CALL PUSZ ;PUSH THE SYMBOL NUMBER ON THE STACK INX H ;FIND THE POINTER MOV C,M INX H MOV B,M INX H ;GET NEXT ITEM INX H SHLD LINE ;SAVE ADDRESS LHLD PNTR ;GET STACK ADDRESS PUSH H ;SAVE IT CALL DFND ;GET IT XCHG ;TO DE XTHL ;GET STACK LOCATION MVI M,2 ;STORE THE OLD POINTER INX H MOV M,E INX H MOV M,D INX H MVI M,3 INX H ;LOCATION FOR NEW POINTER MVI M,4 INX H XCHG ;TO DE POP H ;STORE NEW POINTER DCX H MOV M,D DCX H MOV M,E XCHG ;TO HL MVI B,6 ;STORE UNFILLED SPRQ3 MVI M,0FFH INX H DCR B JNZ SPRQ3 MVI M,5 ;END OF NUMBER BLOCK INX H ;NEXT ADDRESS SHLD PNTR ;UPDATE PNTR LHLD LINE ;GET ITEM ADDRESS MOV A,M ;CHECK FOR COMMA CPI 0DH INX H ;NEXT ONE JZ SPRQ1 ;IT IS, SO LOOP FOR ANOTHER ONE MVI B,10H ;ERROR CODE JUST IN CASE CPI 9 ;END? JNZ ERROR ;NO, SO SYNTAX ERROR SPRQ2 LHLD PNTR ;STUFF END OF BLOCK INDICATION MVI M,38H INX H SHLD PNTR SHLD NPNTR RET ;DONE....... * RTN. E.86 * READ PROCESSOR SPRR MVI B,10H ;ERROR CODE FOR NO FOLLOWING EXPRESSION JNC ERROR XCHG ;START OF STACK TO HL SHLD NN ;SAVE IT LHLD LINE ;SAVE LINE POSITION SHLD MM SPRR6 LHLD NN ;GET READ ELEMENT MOV A,M ;GET BYTE CPI 9 ;END? RZ ;YUP, SO WE ARE DONE CPI 0DH ;COMMA? JNZ SPRR5 ;NOPE INX H MOV A,M ;GET A BYTE SPRR5 CALL PUSZ ;PUSH THE ITEM ON THE STACK CALL GTIN ;GET NEXT ITEM DAD D SHLD NN ;SAVE ADDRESS CALL SPRR1 ;GET NEXT DATA ELEMENT TO STACK CALL OPRQ ;ASSIGN VALUE JMP SPRR6 ;LOOP FOR ANOTHER ONE SPRR1 LHLD DATAT ;GET ELEMENT POINTER MOV A,L ;CHECK FOR 0 ORA H JZ SPRR3 ;IT WAS MOV A,M ;GET A BYT CPI 0DH ;COMMA? JNZ SPRR2 ;NOPE INX H MOV A,M ;GET NEXT ITEM SPRR2 CPI 09 ;IS IT END? JZ SPRR3 ;YUP CALL PUSZ ;ONTO THE STACK CALL GTIN ;GET NEXT ITEM DAD D SHLD DATAT ;STORE IT'S ADDRESS RET ;DONE....... SPRR3 LHLD DATAW ;GET BLOCK POINTER MOV A,L ;CHECK FOR 0 ORA H JZ SPRR7 ;YUP, SO SKIP KILL BLOCK CALL KILL ;KILL THE EXISTING BLOCK SPRR7 LHLD DATAP ;SET LINE FOR NEXT "DATA" SEARCH SHLD LINE SPRR4 CALL MFOS ;MOVE FORWARD ONE XCHG ;TO DE LHLD ESRC ;CHECK FOR OVER END OF SOURCE XCHG ;BACK TO HL CALL CMP16 JZ SPRR8 ;OH, OH, OUT OF DATA MOV A,M ;CHECK FOR DATA STATEMENT CPI 0A3H ;IS IT? JNZ SPRR4 ;NOPE, SO TRY AGAIN INX H ;GET START OF EXPRESSION CALL EVPE ;PROCESS IT XCHG ;BEGINNING OF STACK TO DE LHLD PNTR ;GET END OF STACK CALL SUB16 ;COMPUTE SIZE OF BLOCK PUSH D ;SAVE PARAMETERS PUSH H MVI A,88H ;ID BYTE LXI D,DATAW ;BACKPOINTER LOCATION CALL AMBL ;ASSIGN A MEMORY BLOCK XCHG ;BLOCK START TO DE POP B ;NUMBER OF BYTES POP H ;WHERE THEY START CALL MOVE ;MOVE THE BYTES IN SHLD PNTR ;UPDATE PNTR XCHG ;DATA BLOCK ADDRESS TO HL SHLD DATAW ;UPDATE DATA POINTERS SHLD DATAT LHLD LINE SHLD DATAP JMP SPRR1 ;TRY AGAIN SPRR8 LHLD MM ;SET LINE TO INDICATE CORRECT ERROR POSITION SHLD LINE MVI B,36H JMP ERROR ;OUT OF DATA ERROR * RTN. E.87 * RESTORE PROCESSOR SPRS LHLD FSRC ;RESET DATAP TO FIRST STATEMENT IN PROGRAM SHLD DATAP LHLD DATAW ;KILL ANY EXISTING BLOCK MOV A,L ORA H JZ SPRS1 ;NO BLOCK ANYHOW CALL KILL SPRS1 LXI H,0 ;INDICATE NO BLOCK SHLD DATAW SHLD DATAT ;INDICATE NO CURRENT ELEMENT CALL MFOS ;SET UP RETURN ADDRESS POP D PUSH H PUSH D CALL MBOS LHLD LINE ;CHECK FOR PARAMETERS INX H MOV A,M ANA A RM ;NONE CALL SPRD ;THERE IS POP H ;GET THE ADDRESS SHLD DATAP ;SET THE POINTER MOV A,M ;CHECK FOR STATEMENT NAME CPI 9FH RZ ;YUP DCX H ;FAKE IT OUT MOV A,M CALL GTIN ;HOW BIG IS IT? CALL SUB16 SHLD DATAP ;NEW POINTER RET ;DONE....... * RTN. E.88 * RECEIVE PROCESSOR SPRT MVI B,10H ;ERROR CODE JUST IN CASE JNC ERROR ;NO FOLLOWING EXPRESSION PUSH D ;SAVE START OF EXPRESSION LHLD PNTR ;SAVE PNTR PUSH H XCHG ;SEND DE TO PNTR SHLD PNTR SPRT1 CALL SPRK ;LOOK FOR PASSED DATA BLOCK CPI 3AH ;IS IT? JNZ SPRT1 ;NOPE CALL SPRK ;FIND THE BEGINNING OF IT INX H ;GET THE FIRST ITEM XTHL ;SWAP WITH PNTR SHLD PNTR ;RESET PNTR CORRECTLY POP H ;GET BACK PASSED DATA START SPRT4 XTHL ;SWAP TO GET START OF EXPRESSION CALL SPRT2 ;PUSH AN ITEM JNC SPRT3 ;IF THE END IS ENCOUNTERED XTHL ;SWAP TO GET PASSED DATA LOCATION CALL SPRT2 ;PUSH AN ITEM JC SPRTQ ;NOT THE END PUSH H ;SAVE ADDRESS, SO WE CAN STUFF A ZERO LXI H,TMP2-1 ;SET UP A ZERO BLOCK MVI M,4 ;START OF NUMBER XCHG ;TO DE INX D LXI H,ZERO0 ;SET UP TO MOVE A ZERO IN LXI B,6 CALL MOVE XCHG ;TO HL DAD B ;FIND NEXT BYTE MVI M,5 ;END OF NUMBER ID LXI H,TMP2-1 ;PUSH ONTO STACK CALL SPRT2 ;DO IT TO IT! POP H ;RESTORE ADDRESS SPRTQ PUSH H ;SAVE ADDRESS CALL OPRQ ;ASSIGN THE VALUE POP H ;RESTORE IT JMP SPRT4 ;LOOP FOR ANOTHER ONE SPRT2 MOV A,M ;GET A BYTE CPI 0DH ;COMMA? JNZ SPRT5 ;NOPE INX H MOV A,M ;GET THE NEXT ONE SPRT5 CPI 9 ;END? RZ ;YUP CPI 3AH ;IS IT END? RZ ;YUP CALL PUSZ ;ONTO THE STACK CALL GTIN ;GET NEXT ITEM ADDRESS DAD D STC ;INDICATE NOT END RET ;DONE SPRT3 POP H ;CHECK FOR END ON OTHER STRING LDA RTFLG ;CHECK FOR A RETURN PASSING ANA A RZ ;IT WASN'T SPRT7 CALL SPRK ;POP OFF A WHOLE BLOCK CALL SPRK CPI 39H ;SEE IF IT'S A RETURN BLOCK JNZ SPRT7 SHLD NPNTR ;UPDATE THE STACK POINTER RET ;DONE....... JMP ERROR ;NOT OK * RTN. E.89 * RETURN PROCESSOR SPRU PUSH PSW ;SAVE FLAGS XCHG JNC SPRU1 ;DON'T MESS WITH IT IF NO EXPRESSION SHLD LLST ;SAVE ADDRESS XCHG LHLD PNTR SHLD FLST XCHG SHLD PNTR ;RESET PNTR SPRU1 CALL SPRK ;POP A CONTROL BLOCK CPI 37H ;FOR/NEXT? JZ SPRU1 ;YUP CPI 3AH ;PASSED DATA? JZ SPRU1 ;YUP CPI 38H ;STUFFED DATA? JZ SPRU2 ;YUP CALL SPRK ;GET START OF RETURN ADDRESS BLOCK SHLD NPNTR ;UPDATE IT INX H INX H ;GET ADDRESS OUT MOV E,M INX H MOV D,M POP PSW ;GET FLAGS BACK POP H ;GET RETURN ADDRESS BACK POP B ;GET OUT WRONG ADDRESS PUSH D ;THE RIGHT ONE PUSH H ;RETURN ADDRESS RNC ;NO PASSED DATA LHLD LLST ;MOVE THE EXPRESSION UP ONE XCHG LHLD FLST CALL SUB16 MOV B,H MOV C,L MOV H,D MOV L,E INX D CALL MOVE MVI M,3AH DAD B MVI M,3AH INX H SHLD NPNTR MVI A,0FFH ;SET RETURN LAST FLAG STA RTFLG RET ;DONE....... SPRU2 CALL SPRU3 ;UNSTUFF STUFFED DATA BLOCK JMP SPRU1 ;KEEP LOOKIN' FOR A RETURN ADDRESS SPRU3 CALL POPS ;POP OFF AN ITEM MOV A,M ;GET ID BYTE CPI 38H ;START OF BLOCK? RZ ;YUP, SO WE ARE DONE CALL POPS ;POP OFF THE OLD POINTER INX H MOV E,M ;GET IT OUT INX H MOV D,M PUSH D ;SAVE IT CALL POPS ;POP OFF THE SYMBOL NUMBER INX H ;GET IT OUT MOV C,M INX H MOV B,M CALL DFND ;GET POINTER LOCATION XCHG ;TO HL DCX H POP D ;GET OLD POINTER BACK MOV M,D ;STUFF IT IN DCX H MOV M,E JMP SPRU3 ;DO ANOTHER ONE SPRFP INX H ;GET THE POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL MOV A,M ;GET A BYTE ANA A ;IS IT A STRING? JNZ SPRFL ;NOPE JMP SPRF6 ;YUP SPRFF LDA CSST ;CASSETTE MODE? ANA A ;SET FLAGS JZ SFFFF ;NOPE STC ;MOTORS OFFF CALL CAIN SFFFF XRA A ;CLEAR CASSETTE MODE STA CATV STA CSST LDA BFLAG ;BINARY MODE? ANA A RZ ;NOPE XRA A ;CLEAR IT AND STOP MOTORS STA BFLAG INR A STC CALL BINPOR RET SPRLA LHLD PNTR ;FAKE IT MVI M,9 STC XCHG JMP SPRL SPRN6 POP H CALL MFOS ;GET NEXT STATEMENT XTHL ;ONTO THE STACK PCHL ;RETURN, DONE....... * RTN. E.90 * STOP PROCESSOR SPRV LXI H,STMSG ;PRINT "STOP" CALL MSGER LHLD LINE SHLD LINEA CALL LNDSC ;PRINT LINE DESCRIPTOR XRA A ;CLEAR RUN FLAGS STA RUNF CALL MFOS JMP RSTRT ;BACK TO COMMAND MODE * RTN. E.91 * WAIT PROCESSOR SPRW MVI B,10H ;ERROR CODE JUST IN CASE JNC ERROR ;NO EXPRESSION FOLLOWING XCHG ;DE TO HL SHLD NN ;SAVE IT CALL SPRO1 ;GET AN OPERAND PUSH H ;TO THE STACK CALL POPS ;LOOK FOR COMMA MOV A,M CPI 0DH JNZ SPRAT ;ERROR CALL SPRO1 ;GET ANOTHER OPERAND PUSH H LHLD PNTR ;CHECK FOR DONENESS XCHG LHLD NN CALL CMP16 ;SAME? JZ SPRW2 ;YUP CALL POPS MOV A,M ;LOOKIN' FOR THAT OLE COMMA AGAIN CPI 0DH JNZ SPRAT ;ERROR CALL SPRO1 ;GET THE LAST OPERAND PUSH H ;TO THE STACK LHLD PNTR ;LOOK FOR END AGAIN XCHG LHLD NN CALL CMP16 ;SAME? JNZ SPRAT ;NOPE POP B ;GET BACK OPERANDS POP D POP H SPRW3 MOV A,C ;GET PORT NUMBER STA SPRW1+1 ;STORE IT SPRW1 IN 0 ;GET A BYTE XRA L ;INVERT SOME BITS ANA E ;SEPARATE JZ SPRW1 ;DO IT AGAIN IF REQUIRED RET ;DONE....... SPRW2 POP B ;GET BACK OPERANDS POP D LXI H,0 ;CLEAR HL JMP SPRW3 ;CONTINUE * RTN. E.92 * CSAVE PROCESSOR SPRX MVI A,0FFH ;SET CASSETTE MODE FLAGS STA CSST STA CATV PUSH PSW PUSH D XRA A CALL COUT POP D POP PSW JMP SPRAZ ;TO PRINT PROCESSOR * RTN. E.93 * CLOAD PROCESSOR SPRY MVI A,0FFH ;SET CASSETTE MODE FLAGS STA CSST STA CATV PUSH PSW PUSH D XRA A CALL CAIN POP D POP PSW JMP SPRFZ ;TO INPUT PROCESSOR * RTN. E.94 * CLEAR PROCESSOR SPRZ LHLD FRAV ;GET LAST ADDRESS XCHG ;TO DE LHLD ESRC ;GET FIRST ADDRESS SPRZ1 CALL CMP16 ;CHECK FOR DONENESS JZ SPRZ2 ;YUP MOV A,M ;GET A BYTE ANI 3EH ;STRIP OFF STRING BITS CPI 2 JNZ SPRZ3 ;NOT A NUMBER PUSH D ;SAVE ADDRESS XCHG LXI H,ZERO0 LXI B,6 CALL MOVE XCHG POP D JMP SPRZ4 SPRZ3 MVI M,0FFH ;CLEAR IT OUT SPRZ4 LXI B,6 ;GET NEXT VARIABLE DAD B JMP SPRZ1 ;LOOP FOR MORE SPRZ2 LHLD SDIR ;RESET FARY SHLD FARY RET ;DONE....... * RTN. E.95 * CHANNEL PROCESSOR SPR1 LXI H,SPR1MSG1 ;DUMP THE HEADING CALL MSGER LXI H,MODES MVI B,0 ;INITIALIZE SPR11 MVI C,0 PUSH B ;SAVE PUSH H MOV A,B ;SEND THE CHANNEL NUMBER ORI 30H CALL TOUT MVI A,9 ;SEND A TAB CALL TOUT MVI A,9 CALL TOUT POP H ;RESTORE POP B SPR12 PUSH B ;SAVE PUSH H MOV A,M ;GET MODES BYTE SPR13 RAR ;ROTATE THROUGH THE CARRY DCR C ;CHECK THE COUNT JP SPR13 ;SHIFT SOME MORE JNC SPR14 ;NOT SET MVI A,'X' ;SEND AN X CALL TOUT JMP SPR1A SPR14 MVI A,20H CALL TOUT ;SEND A TAB SPR1A MVI A,20H CALL TOUT ;SEND A SPACE POP H ;RESTORE POP B INR C ;ARE WE DONE MOV A,C CPI 8 JNZ SPR12 ;NOPE INX H INR B PUSH B ;SAVE 'EM PUSH H CALL CRLF ;SEND A CARRIAGE RETURN POP H ;RESTORE POP B MOV A,B ;SEE IF WE IS DONE CPI 10 JNZ SPR11 ;NOPE CALL MFOS XTHL PCHL SPR1MSG1 DB 0DH,'CHANNELS LOGICAL DEVICES' DB 0DH,'(PHYS.) 0 1 2 3 4 5 6 7',8DH PRSYMSG1 DB 0DH,'SYMBOL TYPE LOCATION',8DH PRSYMSG2 DB 'ARRAY ',0A0H PRSYMSG3 DB 'LABEL ',0A0H PRSYMSG4 DB 'VARIABLE',0A0H * RTN. E.96 * FNXX PROCESSOR FNPR LDA FNFLG ;INC FNFLG INR A STA FNFLG LHLD PNTR ;GET POINTER ADDRESS PUSH H ;SAVE IT XCHG ;TO DE LHLD FNONE ;PUSH FNONE AND FNTWO ON STACK XCHG MOV M,E INX H MOV M,D INX H XCHG LHLD FNTWO XCHG MOV M,E INX H MOV M,D INX H SHLD PNTR POP H ;GET BACK PNTR FNPR1 DCX H ;GET LAST ITEM MOV A,M ;GET A BYTE CALL GTIN ;GET THE INCREMENT CALL SUB16 ;SUBTRACT IT MOV A,M ;CHECK FOR COMMA CPI 0DH JZ FNPR1 ;YUP, SO LOOP BACK SOME MORE INX H ;FIRST ADDRESS OF PASSED VARIABLES SHLD FNTWO ;SO SAVE IT DCX H ;GET ADDRESS OF DEF STATEMENT OUT DCX H MOV D,M DCX H MOV E,M LXI H,6 ;ADD 5 TO ADDRESS DAD D SHLD FNONE ;SAVE IT FNPR2 MOV A,M ;GET A BYTE CALL GTIN ;GET NEXT ITEM DAD D PUSH H ;SAVE 'EM PUSH D LXI H,0 ;CHECK FOR STACK OVERFLOW DAD SP XCHG LXI H,STACK+40 CALL CMP16 ;COMPARE MVI B,16H ;ERROR CODE JUST IN CASE JNC ERROR ;NO ROOM LEFT ON STACK POP D ;RESTORE 'EM POP H MOV A,M ;CHECK FOR FN CPI 36H JNZ FNPR2 ;NOPE XCHG CALL EVPE+5 ;PROCESS IT CALL POPS ;POP OFF THE RESULT CALL POPS PUSH H ;SAVE THE ADDRESS LHLD PNTR ;GET OUT FNONE,FNTWO DCX H MOV D,M DCX H MOV E,M PUSH D ;SAVE FNTWO DCX H MOV D,M DCX H MOV E,M PUSH D ;SAVE FNONE LHLD FNTWO ;RESET POINTER DCX H DCX H DCX H DCX H SHLD PNTR ;NEW VALUE POP H ;FNONE SHLD FNONE POP H ;FNTWO SHLD FNTWO POP H ;ADDRESS OF RESULT CALL PUSZ ;ONTO THE STACK LXI H,FNFLG ;UPDATE FNFLG DCR M RET ;DONE....... STMSG DB 'STOP IN',0A0H SRFLG DB 0 BFLAG DS 1 MERR DS 1 ASFLG DS 1 QFLAG DS 1 ZFRST DS 1 TEMP1 DS 6 TEMP2 DS 6 WORK1 DS 12 WORK2 DS 12 WORK3 DS 18 WORK4 DS 50 WORK5 DS 10 CNVR1 DS 1 CNVR2 DS 1 CNVR3 DS 1 CNVR4 DS 1 CNVR5 DS 1 CNVR6 DS 1 CNVRA DS 1 SIGNF DS 1 TMP1 DS 6 TMP2 DS 6 TMP3 DS 6 TMP4 DS 6 TMP5 DS 6 TMP6 DS 6 TMP7 DS 6 TMP8 DS 6 TMP9 DS 6 TMP10 DS 6 TMP11 DS 6 CHANL DS 20 MODES DS 10 TRMNL DS 30 CATV DS 1 SNUM DS 2 STAB DS 2 SDIR DS 2 MEND DS 2 ESCN DS 1 NSCN DS 2 TSCN DS 2 RURD DS 1 CMND DS 1 ESRC DS 2 SLIN DS 2 FARY DS 2 INSR DS 2 STACK DS 100 STFLG DS 1 OPFLG DS 1 FSRC DS 2 LINE DS 2 FRAV DS 2 FLST DS 2 LLST DS 2 EBSC DS 2 CSST DS 1 RUNF DS 1 IOST DS 2 DS 1 SEED DS 6 NPNTR DS 2 DATAP DS 2 DATAT DS 2 DATAW DS 2 FNFLG DS 1 FNONE DS 2 FNTWO DS 2 SCFLG DS 2 RTFLG DS 1 EDLNP DS 2 DMPMM DS 2 EDITM DS 1 EDITO DS 2 EDITS DS 2 POSIT DS 1 NN DS 2 MM DS 2 CHECK DS 1 CASER DS 2 PNTRA DS 2 LINEA DS 2 PNTR DS 2