ftp.barnyard.co.uk

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

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG031.ARK / TBASICA5.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 56KB | 2,614 lines

* RTN. D.56 * CLOAD? PROCESSOR PCLO LXI H,PCLOM ;SEND CHECKING MESSAGE CALL MSGER XRA A ;SEND START MOTORS CALL CAIN PCLO1 LHLD FRAV ;ADDRESS FOR TRIAL INPUT CALL LICA ;INPUT JNC PCLO1 ;NOPE XRA A ;SEND STOP MOTORS STC INR A CALL CAIN LXI H,OKOK ;SEND "FILE OK" MESSAGE CALL MSGER JMP RSTRT ;YUP, SO WE ARE DONE OKOK DB 0DH,'FILE O','K'+80H PCLDM DB 'READING...',8DH PCLOM DB 'CHECKING...',8DH PCSVM DB 'WRITING...',8DH PCSAM DB 'WRITING BASIC',8DH * RTN. D.57 * CSAVE PROCESSOR PCSV LXI H,PCSVM ;SEND NOTIFIER CALL MSGER XRA A ;START MOTORS CALL COUT CALL USCN ;SCAN OFF STRING EXPRESSION LHLD TSCN ;GET FIRST CHARACTER OF TOKEN MOV A,M ANI 7FH ;STRIP STROBE STA TMP10+1 ;SAVE IT MVI A,1 ;GET NAME BLOCK INDICATOR STA TMP10 MVI A,8DH ;STORE A CR STA TMP10+2 LXI H,TMP10 ;ADDRESS CALL CLIN ;TO DUMP ON TAPE MVI A,0FFH ;SET CSST STA CSST JMP LIST ;DUMP IT ALL ON TAPE * RTN. D.58 * CSAVE! PROCESSOR PCSA LXI H,PCSAM ;SEND NOTIFIER CALL MSGER XRA A ;START MOTORS CALL BPORT LHLD EBSC ;GET LAST ADDRESS XCHG ;PUT IT IN DE LXI H,START ;GET FIRST ADDRESS CALL PCSA1 ;WRITE IT LHLD SMEN ;SEE IF THERE IS A MONITOR TO WRITE MOV A,H ORA L JZ RSTRT ;NOPE XCHG ;END TO DE LHLD SMST ;GET START OF MONITOR CALL PCSA1 ;WRITE IT,TOO JMP RSTRT PCSA1 PUSH H ;SAVE ADDRESSES PUSH D XCHG ;SWAP 'EM CALL SUB16 ;COMPUTE NUMBER OF WORDS TO WRITE SHLD NN ;SAVE IT MOV B,H ;HL TO BC MOV C,L LXI H,0 ;CLEAR HL PCSA2 LDAX D ;GET A BYTE CALL ADHL ;ADD TO HL INX D ;UPDATE INDEXES DCX B MOV A,B ;BC = 0? ORA C JNZ PCSA2 ;NOPE XCHG ;COMPUTE 0-HL LXI H,0 ;CLEAR HL CALL SUB16 ;SUBTRACT SHLD MM ;SAVE THE CHECKSUM XRA A ;CLEAR A POP D ;GET BACK ADDRESSES POP H PCSA3 MOV A,M ;GET A BYTE PUSH H ;SAVE ADDRESSES PUSH D CALL OBPORT ;CASSETTE OUTPUT BYTE POP D ;GET ADDRESSES BACK POP H INX H ;UPDATE INDEX CALL CMP16 ;HL=DE? STC ;CLEAR THE CARRY CMC JNZ PCSA3 ;NOPE STC ;SEND DUMMY OUTPUT CALL BPORT RET ;DONE. * RTN. D.59 * OUTPUT LINE DESCRIPTOR LNDSC LDA RUNF ;SEE IF WE ARE RUNNING ANA A JZ LND44 ;PRINT COMMAND LHLD LINE ;GET ADDRESS OF CURRENT LINE PUSH H ;SAVE LINE LXI D,0 ;CLEAR DE LNDS1 PUSH D ;SAVE COUNT LHLD LINE ;CHECK FOR BEGINNING OF SOURCE XCHG LHLD FSRC ;FIRST SOURCE ADDRESS CALL CMP16 ;CHECK 'EM OUT JZ LNDS2 ;SURE WAS LHLD FRAV ;CHECK FOR DIRECT MODE START CALL CMP16 JZ LNDS2 LNDS8 CALL MBOS ;BACK UP ONE POP D ;RECOVER COUNT MOV A,M ;GET A BYTE CPI 85H JZ LNDS1 CPI 9CH ;CHECK FOR TAB JZ LNDS1 DCX D ;CHECK FOR COLON OR BACKSLASH CPI 9EH JZ LNDS1 ;SURE WAS CPI 9BH JZ LNDS1 CPI 9DH JZ LNDS1 ;YUP INX D ;INDEX BACK TO NORMAL INX D ;UPDATE COUNT CPI 9FH ;IS IT A STATEMENT NAME JNZ LNDS1 ;NO, SO LOOP AND TRY AGAIN DCX D ;CORRECT COUNT PUSH D ;SAVE IT INX H ;CORRECT INDEX PUSH H ;SAVE H LXI H,SPMGE CALL LNOT POP H CALL PRIT ;PRINT THE NAME LNDS3 POP H ;GET BACK COUNT MOV A,H ;SEE IF IT'S ZERO ORA L JZ LNDS4 ;YUP, SO RETURN PUSH H ;SAVE IT AGAIN LXI H,PLUSM ;PRINT A PLUS SIGN CALL MSGER POP H ;GET BACK COUNT LXI D,TMP9 ;CONVERSION SPACE CALL BBCD ;CONVERT BINARY TO BCD MVI A,4 ;STORE NUMBER START/STOP STA TMP9-1 INR A STA TMP10 LXI H,TMP9-1 ;ADDRESS CALL PRIT ;PRINT THE NUMBER OUT LNDS4 POP H ;RESTORE LINE SHLD LINE RET ;DONE * RTN. D.60 * CADD PROCESSOR PCAD JMP PCLD1 ;GO TO IT * RTN. D.61 * CLOAD SEPARATOR PCLS LHLD NSCN ;GET NEXT TOKEN MOV A,M CPI '?'+80H ; IS IT A QUESTION MARK? JNZ PCLD ;NOPE CALL USCN ;SCAN IT OFF JMP PCLO ;YUP * RTN. D.62 * CSAVE SEPARATOR PCSS LHLD NSCN ;GET NEXT TOKEN MOV A,M CPI '!'+80H ;IS IT AN EXCLAMATION POINT? JNZ PCSV ;NOPE CALL USCN ;SCAN IT OFF JMP PCSA DRAT1 DB '"'+80H ;QUOTE MESSAGE LNDS2 LDAX D ;GET BYTE CPI 9FH ;CHECK FOR NAME TAG JZ LNDS8 ;SURE IS! LXI H,LNMSG ;GET START MESSAGE CALL LNOT ;DUMP IT JMP LNDS3 LNMSG DB 20H DB '*' DB '*'+80H SPMGE DB 0A0H LND44 LXI H,LND45 ;PRINT "COMMAND" CALL MSGER RET ;DONE0LT LND45 DB 'ENTR' DB 'Y'+80H HNDRD DB 2,0,0,0,1,0 ;ONE HUNDRED CONSTANT * INTERPRETER MODULE * RTN. E.1 * PUSH ITEM ON CONTROL STACK * IN: HL = ADDRESS OF ITEM TO PUSH PUSZ PUSH H ;SAVE THE REGISTERS PUSH D PUSH B PUSH PSW MOV A,M ;GET FIRST BYTE OF ITEM CALL GTIN ;HOW MANY BYTES IN ITEM? MOV B,D ;DE TO BC MOV C,E XCHG ;HL TO DE LHLD PNTR ;GET STACK ADDRESS PUSH H PUSH D PUSH B DAD B XCHG LHLD FARY CALL CMP16 MVI B,27H JC ERROR POP B POP D POP H XCHG ;BACK TO THE RIGHT PLACE CALL MVDN ;MOVE IT IN QUICK LIKE XCHG ;DESTINATION TO HL DAD B ;COMPUTE NEW STACK POINTER SHLD PNTR ;SAVE IT POP PSW ;GET ALL THE REGISTERS BACK POP B POP D POP H RET ;DONE. * RTN. E.2 * POP ITEM FROM CONTROL STACK * OUT: HL = ADDRESS OF ITEM POPPED POPS PUSH D ;SAVE REGISTERS PUSH B PUSH PSW LHLD PNTR ;GET STACK ADDRESS DCX H ;GET LAST BYTE OF TOP OF STACK MOV A,M CALL GTIN ;COMPUTE NUMBER OF BYTES IN ITEM CALL SUB16 ;COMPUTE NEW ADDRESS INX H SHLD PNTR ;UPDATE POINTER POP PSW ;RESTORE REGISTERS POP B POP D RET ;DONE. * RTN. E.3 * GET ITEM ADDRESS * IN: HL = ITEM LOCATION * OUT: BC = ADDRESS OF ITEM GEIM MOV A,M ;GET FIRST BYTE CPI 2 ;IS IT A LABEL? JZ GEIM1 ;YUP MOV C,L ;MOVE HL TO BC MOV B,H ANA A ;CHECK FOR LITERAL RZ ;IT WAS INX B ;CORRECT RET GEIM1 INX H ;GET LABEL NUMBER OUT MOV C,M INX H MOV B,M PUSH D ;SAVE DE CALL DFND ;GET THE POINTER MOV B,H ;MOVE HL TO BC MOV C,L POP D ;RESTORE DE RET ;DONE.. * RTN. E.4 * FIND OPERAND * OUT: HL = ADDRESS OF OPERAND * CARRY SET IF OPERAND IS A STRING FNOP CALL POPS ;POP ONE OFF CONTROL STACK FNOPO MOV A,M ;GET A BYTE CPI 2 ;IS THIS A POINTER? JZ FNOP1 ;YUP ANA A ;IS THIS A LITERAL? JZ FNOP2 ;YUP CPI 4 ;IS THIS A CONSTANT? JZ FNOP3 ;YUP CPI 9 ;IS IT END MARKER? JZ FNOP ;YUP, SO DIG FOR ANOTHER MVI B,26H ;ERROR JMP ERROR FNOP1 INX H ;GET THE POINTER OUT MOV E,M INX H MOV D,M XCHG ;PUT IT IN HL MOV A,M ;GET A BYTE ANA A ;IS IT A LITERAL? JZ FNOP2 ;YUP ANI 3EH ;STRIP OFF SUPERFLUOUS BITS CPI 2 ;IS IT A NUMBER? JZ FNOP5 ;YUP CPI 8 ;IS IT A STRING ARRAY/VARIABLE? JZ FNOP4 ;YUP MVI B,26H ;ERROR JMP ERROR FNOP2 INX H ;GET NEXT ADDRESS STC ;INDICATE STRING RET ;DONE FNOP3 INX H ;GET NEXT ADDRESS MOV A,M ;CHECK IF IT'S A NUMBER ANI 0EH ;STRIP OFF ID BITS CPI 2 ;IS IT A NUMBER? JNZ FNOP6 ;NOPE FNOP5 XRA A ;CLEAR CARRY RET ;DONE FNOP4 INX H ;GET POINTER ADDRESS INX H INX H MOV E,M ;GET A BYTE INX H MOV D,M ;GET THE OTHER XCHG ;TO HL STC ;INDICATE STRING RET ;DONE FNOP6 SUI 6 ;SET CARRY IF IT'S A STRING CMC INX H ;GET POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL RNC ;NOT A STRING MOV E,M ;GET ANOTHER POINTER INX H MOV D,M XCHG ;TO HL RET ;DONE. * RTN. E.5 * GET OPERANDS FOR OPERATORS * IN: CARRY SET IF NUMERICS ONLY OK. * OUT: * HL = OPERAND 1 ADDRESS * DE = OPERAND 2 ADDRESS (TOP OF STACK) * BC = DESTINATION ADDRESS * CARRY SET IF OPERANDS ARE STRINGS GOFO MVI A,0 ;CLEAR A RAL ;SHIFT THE CARRY INTO BIT 0 LXI B,TMP10 ;SET INDEX STAX B ;INITIALIZE THE COUNTER CALL FNOP ;GET AN OPERAND LDAX B ;GET COUNTER INR A ;ADD 2 WITHOUT AFFECTING CARRY INR A JNC GOFOA ADI 2 GOFOA STAX B ;SAVE COUNTER PUSH H ;GET ANOTHER OPERAND CALL FNOP LDAX B INR A INR A JNC GOFOB ADI 2 GOFOB PUSH H ;SAVE THE ADDRESS CPI 8 ;IS IT STRINGS? JZ GOFO2 ;YUP ORI 1 ;SET BIT 0 CPI 5 ;IS IT NUMERICS? JZ GOFO3 ;YUP MVI B,24H ;MIXED OPERANDS, NO NO JMP ERROR GOFO2 STC ;SET CARRY FOR INDICATION OF STRING GOFO3 LHLD PNTR ;GET NEXT AVAILABLE STACK ADDRESS INX H ;AFTER ID MOV C,L ;BC=HL MOV B,H POP H ;GET BACK ADDRESSES POP D RET ;ALL DONE. * RTN. E.6 * LOGICAL OPERATOR PREPARER OPR10 STC ;NUMERIC ONLY CALL GOFO ;GET OPERANDS PUSH B ;SAVE DESTINATION PUSH D ;SAVE O2 CALL BCDB ;CONVERT TO BINARY XTHL ;GET O2 CALL BCDB ;CONVERT TO BINARY POP D ;GET BACK BINARY O1 MOV C,L ;BC = HL MOV B,H POP H ;GET BACK DESTINATION XTHL ;PUT IT ON THE STACK PCHL ;RETURN * RTN. E.7 * LOGICAL OPERATOR ENDER OPR20 XCHG ;SWAP POP H ;GET RETURN ADDRESS XCHG ;SWAP CALL BBCD ;CONVERT TO FLOATING POINT * RTN. E.8 * NUMERIC FINISHER OPR30 LHLD PNTR ;GET STACK ADDRESS MVI M,4 ;STUFF A NUMBER INDICATOR LXI D,7 ;ADD 7 DAD D MVI M,5 ;STUFF AN END OF NUMBER INDICATOR INX H ;NEXT AVAILABLE SHLD PNTR ;RESET PNTR RET ;ALL DONE. * RTN. E.9 * RELATIONAL OPERATOR FINISHER OPR40 JC OPR41 ;TRUE ANSWER XCHG ;HL TO DE LXI H,ZERO0 ;GET A ZERO LXI B,6 ;NUMBER OF BYTES CALL MVDN ;MOVE IT IN JMP OPR30 ;FINISH UP OPR41 XCHG ;HL TO DE LXI H,NEGA1 ;GET A ONE LXI B,6 ;NUMBER OF BYTES CALL MVDN ;MOVE IT IN JMP OPR30 ;FINISH IT UP * RTN. E.10 * RELATIONAL OPERATOR PREPARER OPR50 XRA A ;CLEAR CARRY CALL GOFO ;GET OPERANDS PUSH B ;SAVE DESTINATION JC OPR51 ;LOOKS LIKE STRINGS CALL CMPR ;COMPARE NUMBERS POP H ;GET BACK THE DESTINATION RET ;DONE OPR51 XCHG ;SWAP HL,DE CALL STRNG ;COMPARE STRINGS POP H ;GET BACK DESTINATION RET ;DONE * RTN. E.11 * OR PROCESSOR OPRA CALL OPR10 ;GET OPERANDS MOV A,E ;BC OR DE TO HL ORA C MOV L,A MOV A,D ORA B MOV H,A JMP OPR20 ;STORE IT * RTN. E.12 * AND PROCESSOR OPRB CALL OPR10 ;GET OPERANDS MOV A,E ;BC AND DE TO HL ANA C MOV L,A MOV A,D ANA B MOV H,A JMP OPR20 ;STORE IT * RTN. E.13 * NOT PROCESSOR OPRC CALL OPR10 MOV A,C ;BC NOT DE TO HL CMA ANA E MOV L,A MOV A,B CMA ANA D MOV H,A JMP OPR20 ;STORE IT * RTN. E.14 * >= PROCESSOR OPRD CALL OPR50 ;COMPARE CMC ;SET CARRY FOR TRUE JMP OPR40 ;STORE * RTN. E.15 * <= PROCESSOR OPRE CALL OPR50 ;COMPARE JC OPR40 ;TRUE JNZ OPR40 ;NOT TRUE STC ;ALSO TRUE JMP OPR40 ;STORE IT * RTN. E.16 * > PROCESSOR OPRF CALL OPR50 ;COMPARE CMC ;SET CARRY IF TRUE JNZ OPR40 ;TRUE XRA A ;CLEAR CARRY JMP OPR40 ;NOT TRUE * RTN. E.17 * < PROCESSOR OPRG CALL OPR50 ;COMPARE JMP OPR40 ;STORE * RTN. E.18 * <> PROCESSOR OPRH CALL OPR50 ;COMPARE STC JNZ OPR40 ;STRORE CMC JMP OPR40 ;STORE * RTN. E.19 * = PROCESSOR OPRI LDA FNFLG ;CHECK FOR FN MODE ANA A RNZ LDA OPFLG ;LOOK FOR A CHANNEL STATEMENT CPI 87H ;CHECK IT RZ ;IT WAS, SO IGNORE THIS EQUALS CALL OPR50 ;COMPARE STC JZ OPR40 ;STORE CMC JMP OPR40 ;STORE * RTN. E.20 * - PROCESSOR OPRP STC ;NUMERIC ONLY CALL GOFO ;GET OPERANDS CALL SUBER ;SUBTRACT JMP OPR30 ;STORE * RTN. E.21 * / PROCESSOR OPRJ STC ;NUMERIC ONLY CALL GOFO ;GET OPERANDS CALL DIVER ;DIVIDE JMP OPR30 ;STORE * RTN. E.22 * * PROCESSOR OPRK STC ;NUMERIC ONLY CALL GOFO ;GET OPERANDS CALL MULER ;MULTIPLY JMP OPR30 ;STORE * RTN. E.23 * POWERS PROCESSOR OPRL STC ;NUMERIC ONLY CALL GOFO ;GET OPERANDS CALL PWRS ;Y TO X JMP OPR30 ;STORE * RTN. E.24 * + PROCESSOR OPRM XRA A ;NUMERIC OR ALPHABETIC CALL GOFO ;GET OPERANDS JC OPRM1 ;STRINGS CALL ADDER ;ADD JMP OPR30 ;STORE OPRM1 PUSH D ;SAVE ADDRESSES PUSH H LHLD PNTR ;GET STORAGE PLACE MVI M,0 ;STRING INDICATOR XCHG ;PNTR TO DE INX D ;NEXT LOCATION POP H ;FIRST STRING PUSH D ;SAVE PNTR CALL COUNT ;HOW MANY? MOV C,E ;BC = DE MOV B,D POP D ;RESTORE DE CALL MOVE ;MOVE IN THE STRING XCHG ;PNTR TO HL DAD B ;ADD B XTHL ;SWAP WITH NEXT STRING ADDX CALL COUNT ;HOW MANY? MOV C,E ;TO BC MOV B,D POP D ;GET BACK PNTR CALL MOVE ;MOVE IN THE STRING XCHG ;PNTR TO HL DCX H ;GET LAST BYTE OF FIRST STRING MOV A,M ;CLEAR UPPER BIT ANI 7FH MOV M,A DAD B ;FIND LAST ADDRESS INX H MVI M,1 ;STORE END OF STRING INDICATOR INX H SHLD PNTR ;UPDATE POINTER RET ;DONE. * RTN. E.25 * UNARY - OPERATOR PROCESSOR OPRN CALL FNOP ;GET OPERAND MVI B,24H ;ERROR CODE JUST IN CASE JC ERROR ;NEGATE A STRING? XCHG ;ADDX TO DE LHLD PNTR ;FIND WHERE TO STORE INX H CALL CMP16 ;SEE IF THEY ARE EQUAL JZ OPRN1 ;YUP XCHG ;NOPE LXI B,6 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN XCHG ;NEW ADDRESS TO HL OPRN1 MVI A,80H ;SET UP TO CHANGE SIGN XRA M MOV M,A JMP OPR30 ;STORE * RTN. E.26 * UNARY NOT PROCESSOR OPRO CALL FNOP ;GET OPERAND MVI B,24H ;ERROR CODE JUST IN CASE JC ERROR ;CAN'T LOGICALLY OPERATE ON A STRING,DUMMY. CALL BCDB ;CONVERT TO BINARY MOV A,H ;INVERT IT CMA MOV H,A MOV A,L CMA MOV L,A XCHG ;TO DE LHLD PNTR ;GET ADDRESS TO STORE TO INX H XCHG ;BACK TO HL CALL BBCD ;CONVERT TO BCD JMP OPR30 ;STORE NEGA1 DB 82H,0,0,0,0,1 ;NEGATIVE ONE C2767 DB 2,0,3,27H,67H ;32767 * ASSIGN MEMORY BLOCK * SQUISHES MEMORY IF IT RUNS OUT * IN: HL = NUMBER OF BYTES NEEDED * DE = BACKPOINTER ADDRESS * A = ID BYTE * OUT: HL = FIRST ASSIGNED ADDRESS AMBL PUSH PSW ;SAVE ID PUSH D ;SAVE BACKPOINTER PUSH H ;SAVE NUMBER OF BYTES XRA A ;CLEAR OVERFLOW FLAG STA TMP10+1 AMBL2 XCHG ;NUMBER TO DE LHLD FARY ;GET FIRST USED ADDRESS CALL SUB16 ;SUBTRACT MVI B,27H JNC ERROR LXI D,250 ;STACK MARGIN CALL SUB16 ;SUBTRACT AGAIN JNC ERROR XCHG ;TO DE LHLD PNTR ;TOP OF STACK ADDRESS CALL CMP16 ;SEE IF WE ARE OUT OF MEMORY JNC AMBL1 ;YUP, SO SQUISH POP D ;GET NUMBER OF BYTES INX D ;ADD THREE INX D INX D LHLD FARY ;GET FIRST USED BYTE DCX H ;STORE THE NUMBER OF BYTES MOV M,D DCX H MOV M,E CALL SUB16 ;COMPUTE FIRST ADDRESS OF BLOCK SHLD FARY ;UPDATE FARY POP D ;GET BACKPOINTER POP PSW ;GET ID BYTE MOV M,A ;STORE THEM INX H MOV M,E INX H MOV M,D INX H ;GET FIRST ASSIGNED ADDRESS RET ;DONE. AMBL1 LDA TMP10+1 ;CHECK OVERFLOW FLAG ANA A MVI B,27H ;ERROR CODE JUST IN CASE JNZ ERROR ;OH,OH, OUT OF MEMORY INR A ;SO SET IT STA TMP10+1 LHLD SDIR ;INITIALIZE SQUISH LOOP SHLD TMP9 SHLD TMP8 AMBL4 LHLD TMP8 ;TMP8=FARY? XCHG LHLD FARY CALL CMP16 ;COMPARE JZ AMBL6 ;YUP, SO THE LOOP'S DONE XCHG ;TMP8 TO HL DCX H ;PULL OUT NUMBER OF BYTES MOV D,M DCX H MOV E,M CALL SUB16 ;FIND FIRST BYTE OF BLOCK MOV A,M ;GET ID BYTE ANA A ;IS IT ACTIVE? JP AMBL3 ;NOPE PUSH H ;SAVE BLOCK ADDRESS LHLD TMP8 ;TMP8=TMP9? XCHG LHLD TMP9 CALL CMP16 POP H ;RESTORE BLOCK ADDRESS JNZ AMBL5 ;NOT EQUAL SHLD TMP9 ;RESET TO AMBL3 SHLD TMP8 ;RESET FROM JMP AMBL4 ;LOOP FOR ANOTHER BLOCK AMBL5 XCHG ;COMPUTE NUMBER OF BYTES CALL SUB16 XCHG ;SWAP 'EM SHLD TMP8 ;NEW FROM LHLD TMP9 ;GET TO CALL SUB16 ;NEW TO SHLD TMP9 MOV C,E ;BC=DE MOV B,D XCHG ;DE = HL LHLD TMP8 ;GET FROM CALL MOVE ;MOVE BLOCK XCHG ;TO TO HL INX H ;GET BACKPOINTER OUT MOV E,M INX H MOV D,M XCHG INX D ;STORE NEW FRONTPOINTER MOV M,E INX H MOV M,D JMP AMBL4 ;LOOP FOR ANOTHER BLOCK AMBL6 LHLD TMP9 ;SET NEW FARY SHLD FARY POP H ;RESTORE HL PUSH H JMP AMBL2 ;TRY AGAIN * RTN. E.28 * ARRAY OPERATOR PROCESSOR AOOP LHLD PNTR ;GET TOP OF STACK AOOP1 DCX H ;GET LAST ITEM MOV A,M ;GET BYTE CALL GTIN ;HOW BIG IS IT? CALL SUB16 ;MOVE BACK TO IT MOV A,M ;GET BYTE CPI 0DH ;IS IT A COMMA? JZ AOOP1 ;YUP, SO LOOP AGAIN CALL GTIN ;HOW BIG IS THIS THING? CALL SUB16 ;GET THE BEGINNING OF IT INX H MOV A,M ;GET THE ID BYTE CPI 2 ;IS IT A LABEL? MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;NOPE INX H ;GET THE POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL LDA OPFLG ;IS THIS A DIMENSION STATEMENT? CPI 0A5H ;CHECK JZ AOOP6 ;YUP MOV A,M ;GET BYTE CPI 0FFH ;CHECK FOR UNFILLED MVI B,28H ;ERROR CODE JUST IN CASE JZ ERROR ;UNDIMENSIONED ARRAY ERROR ANI 0CH ;CHECK FOR ARRAY MVI B,10H ;ERROR CODE JUST IN CASE JZ ERROR ;NOT AN ARRAY INX H ;GET NUMBER OF DIMENSIONS OUT MOV E,M INX H MOV D,M XCHG SHLD CNVR1 ;SAVE IT XCHG INX H ;GET POINTER OUT MOV E,M INX H MOV D,M XCHG SHLD CNVR3 ;SAVE IT LXI H,0 ;GET A SIXTEEN BIT 0 PUSH H ;STUFF IT UP YOUR STACK JMP AOOP2 ;TO MIDDLE OF LOOP AOOP3 CALL POPS ;LOOK FOR A COMMA MOV A,M ;GET IT CPI 0DH ;IS IT A COMMA? MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;IT WASN'T LHLD CNVR3 ;GET POINTER MOV E,M ;PULL OUT NUMBER OF ELEMENTS INX H MOV D,M LHLD CNVR5 ;GET OFFSET CALL I6X16 ;MULTIPLY PUSH H ;SAVE PRODUCT AOOP2 CALL FNOP ;LOOK FOR AN OPERAND MVI B,24H ;ERROR CODE JUST IN CASE JC ERROR ;THE TURKEY USED A STRING FOR A SUBSCRIPT CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE HL LHLD CNVR3 ;GET POINTER MOV E,M ;PULL OUT NUMBER OF ELEMENTS INX H MOV D,M INX H SHLD CNVR3 ;UPDATED POINTER POP H ;RESTORE HL XCHG ;SWAP 'EM CALL CMP16 ;CHECK FOR TOO BIG MVI B,29H ;ERROR CODE JUST IN CASE XCHG JC ERROR ;TOO BIG A SUBSCRIPT POP D ;GET TRIAL OFFSET BACK DAD D ;ADD IT SHLD CNVR5 ;SAVE IT TO OFFSET LHLD CNVR1 ;GET DIMENSION COUNT DCX H ;UPDATE COUNT SHLD CNVR1 MOV A,H ;IS IT ZERO? ORA L JNZ AOOP3 ;NO, SO LOOP FOR ANOTHER DIMENSION CALL POPS ;POP OFF THE LABEL INX H ;GET THE POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL DCX D ;GET ADDRESS TO SAVE IT TO MOV A,M ;GET THE ID BYTE STAX D ;STUFF IT IN XCHG INX H ;GET ADDRESS FOR POINTER INX H INX H MOV M,E ;STUFF IT IN INX H MOV M,D XCHG PUSH D ;SAVE ADDRESS MOV A,M ;GET ID BYTE ANI 4 ;CHECK FOR STRING/NUMERIC ARRAY JNZ AOOP4 ;WASN'T A STRING LHLD CNVR5 ;GET OFFSET LXI D,2 ;GET OFFSET *2 CALL I6X16 JMP AOOP5 AOOP4 LHLD CNVR5 ;GET OFFSET CALL FSTML ;MULTIPLY BY SIX AOOP5 XCHG ;OFFSET TO DE LHLD CNVR3 ;GET POINTER DAD D ;ADD AOOPA XCHG ;TO DE POP H ;GET ADDRESS ON STACK BACK DCX H DCX H ;STORE ELEMENT POINTER MOV M,D DCX H MOV M,E JMP OPR30 ;NUMERIC FINISHER AOOP6 PUSH H ;SAVE POINTER MOV A,M ;GET ID BYTE CPI 0FFH ;IS IT AN UNDIMENSIONED ARRAY? JZ AOOP7 ;YUP INX H ;GET POINTER INX H INX H MOV E,M INX H MOV D,M XCHG CALL KILL ;INACTIVATE THE BLOCK AOOP7 LHLD PNTR ;GET TOP OF STACK SHLD CNVR1 ;PRESET FLAGS SHLD LLST LXI H,1 SHLD CNVR3 DCX H SHLD CNVR5 AOOP8 CALL FNOP ;GET AN OPERAND MVI B,24H ;ERROR CODE JUST IN CASE JC ERROR ;A STRING FOR A SUBSCRIPT? CALL BCDB ;CONVERT TO BINARY INX H ;CORRECTION XCHG ;TO DE LHLD LLST ;GET PLACE TO PUT IT MOV M,E ;STUFF IT IN INX H MOV M,D INX H SHLD LLST ;STORE UPDATED INDEX LHLD CNVR3 ;GET ELEMENT COUNT CALL I6X16 ;MULTIPLY SHLD CNVR3 ;STORE NEW ELEMENT COUNT LHLD CNVR5 ;INCREMENT DIMENSION INX H SHLD CNVR5 ;RESTORE IT CALL POPS ;LOOK FOR COMMA MOV A,M ;GET A BYTE CPI 0DH ;IS IT A COMMA? JZ AOOP8 ;YES, SO CONTINUE THE LOOP INX H ;GET THE POINTER OUT MOV E,M INX H MOV D,M LHLD STAB ;GET START OF SYMBOL TABLE PUSH H LHLD SDIR ;GET START OF SYMBOL DIRECTORY XCHG ;TO DE SHLD TMP10 ;SAVE THE POINTER TO FIND XCHG ;BACK TO HL AOOPB MOV E,M ;GET OUT TRIAL POINTER INX H MOV D,M INX H INX H XTHL ;GET THE TABLE ADDRESS PUSH D ;SAVE POINTER CALL COUNT ;FIND THE END DAD D ;ADD POP D ;GET POINTER BACK XTHL ;GET SDIR BACK PUSH H ;SAVE IT LHLD TMP10 ;SEE IF WE'VE FOUND IT YET CALL CMP16 POP H ;RESTORE SDIR JNZ AOOPB ;NOPE, SO LOOP AGAIN POP H ;GET STRING LOCATION DCX H ;GET LAST CHARACTER MOV A,M STA TMP10 ;SAVE IT LHLD CNVR3 ;COMPUTE NUMBER OF BYTES TO ASSIGN LXI D,2 LDA TMP10 ;SEE IF THIS IS A NUMERIC ARRAY CPI '$'+80H JZ AOOPC ;NOPE LXI D,6 ;YUP AOOPC CALL I6X16 PUSH H ;SAVE IT LHLD CNVR5 LXI D,2 CALL I6X16 POP D DAD D ;GOT IT POP D ;GET ADDRESS INX D ;GET POINTER ADDRESS INX D INX D PUSH D ;SAVE IT LDA TMP10 ;CHECK FOR NUMERIC ARRAY CPI '$'+80H JZ AOOPE MVI A,84H ;NUMERIC ARRAY ID BYTE JMP AOOPF AOOPE MVI A,82H ;ID BYTE AOOPF CALL AMBL ;ASSIGN A BLOCK POP D ;GET POINTER ADDRESS BACK XCHG MOV M,E INX H MOV M,D PUSH D ;SAVE IT DCX H ;GET NUMBER OF DIMENSIONS BYTES DCX H XCHG ;SWAP LHLD CNVR5 ;GET NUMBER OF DIMENSIONS XCHG MOV M,D DCX H MOV M,E DCX H ;GET ID BYTE ADDRESS LDA TMP10 ;CHECK FOR NUMERIC ARRAY CPI '$'+80H JZ AOOPG MVI M,4 JMP AOOPH AOOPG MVI M,48H ;STRING ARRAY ID BYTE AOOPH LHLD CNVR5 ;GET NUMBER OF DIMENSIONS LXI D,2 CALL I6X16 MOV B,H ;NUMBER OF BYTES TO MOVE MOV C,L LHLD CNVR1 ;GET NUMBER OF ELEMENTS FLAGS POP D ;TO ADDRESS CALL MOVE ;MOVE 'EM IN, BOYS XCHG DAD B ;COMPUTE ADDX FOR STRING POINTER PUSH H ;SAVE HL LHLD CNVR3 ;GET NUMBER OF ELEMENTS MOV B,H ;TO BC MOV C,L POP H ;GET HL BACK LDA TMP10 ;CHECK FOR NUMERIC ARRAY CPI '$'+80H JNZ AOOPD ;SURE IS LXI D,DUMS ;DUMMY STRING ADDRESS AOOP9 MOV M,E ;STUFF IN THE POINTERS INX H MOV M,D INX H DCX B ;UPDATE COUNTE MOV A,B ORA C ;IS BC = 0? JNZ AOOP9 ;NO, SO LOOP FOR MORE STORES RET ;DONE. AOOPD PUSH B ;SAVE NUMBER OF XCHG ;HL TO DE LXI H,ZERO0 ;GET A ZERO LXI B,6 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN XCHG ;DE BACK TO HL DAD B ;UPDATE IT POP B ;GET NUMBER BACK DCX B ;SEE IF WE ARE DONE MOV A,B ORA C JNZ AOOPD ;NOPE RET ;DONE. DB 0,0,0 DUMS DB 080H ;DUMMY STRING * RTN. E.29 * 16 BY 16 MULTIPLY * HL=HL*DE, OVERFLOW GENERATES ERROR 30 I6X16 MOV B,H ;BC = HL MOV C,L PUSH D ;SAVE DE MOV D,C CALL MULT ;ONE OF THREE XCHG ;DE TO HL POP D PUSH D MOV D,B CALL MULT ;SECOND OF THREE MOV A,E ;ADD 'EM UP ADD H MOV H,A MVI B,30H ;ERROR CODE JUST IN CASE JC ERROR ;OVERFLOW POP D MOV E,C CALL MULT ;THE LAST MOV A,E ADD H MOV H,A JC ERROR ;OVERFLOW RET ;DONE * RTN. E.30 * KILL ASSIGNED BLOCK * IN: HL POINTS TO DATA START KILL DCX H ;BACK UP THREE DCX H DCX H MOV A,M ;GET ID BYTE ANI 7FH ;CLEAR ACTIVE BIT MOV M,A ;STUFF IT BACK RET ;DONE. * RTN. E.31 * INITIALIZER INTR LXI SP,STACK+100 ;INITIALIZE STACK LXI H,1 ;SET SNUM SHLD SNUM LHLD SSSS ;CHECK END OF MEMORY FLAG MOV A,H ORA L ;IS IT 0? JNZ INTR1 ;NOPE LXI H,PNTR+1 ;GET LAST USED ADDRESS INTR2 INX H MVI M,0 ;CHECK THIS ADDRESS'S EXISTENCE MOV A,M ANA A ;SET FLAGS JZ INTR2 ;IT EXISTS DCX H ;GET LAST EXISTING ADDRESS INTR1 SHLD MEND ;SET END OF MEMORY FLAG DCX H MVI M,80H ;STORE DUMMY NAME SHLD STAB ;SET SYMBOL TABLE START DCX H ;STORE DUMMY ID BLOCK MVI M,0 DCX H MVI M,0 DCX H MVI M,0 SHLD SDIR ;SET DIRECTORY START XRA A ;CLEAR CSST,RURD, AND RUNF STA BFLAG STA CSST STA RURD STA RUNF STA EDITM ;CLEAR EDIT MODE INR A ;SET CMND STA CMND LXI H,0 ;CLEAR DUMP MEMORY MODE SHLD DMPMM LXI H,PNTR+2 ;GET FIRST ADDRESS FOR SOURCE CODE SHLD ESRC ;SET SOURCE FLAGS SHLD FSRC SHLD EBSC ;SET END OF BASIC FLAG CALL PNEW1 ;INITIALIZE SOURCE MVI A,0C3H ;STORE JUMP INSTRUCTION STA START LXI H,RSTRT SHLD START+1 JMP RSTRT ;AND WE'RE OFF AND RUNNING * RTN. E.32 * EVALUATE POLISH EXPRESSION * IN: HL = BEGINNING OF EXPRESSION * OUT: HL = BEGINNING OF STACK * DE = END OF EXPRESSION EVPE XCHG ;HL TO DE XRA A ;CLEAR FNFLG STA FNFLG LHLD PNTR ;SEE WHERE TO START THE STACK PUSH H ;SAVE IT XCHG ;DE BACK TO HL INX H ;GET NEXT BYTE EVPE7 MOV A,M ;GET THE BYTE OUT PUSH H ;SAVE ADDRESS CPI 9 ;IS IT END OF EXPRESSION? JZ EVPE2 ;YUP CPI 6 ;IS IT AN OPERAND? JC EVPE1 ;YUP CPI 0FH ;IS IT A COMMA OR SEMICOLON? JC EVPE4 ;YUP CPI 40H ;IS IT A FUNCTION? JP EVPE3 ;YUP CPI 34H ;IS IT AN ARRAY OPERATOR? JZ EVPE8 ;YUP CPI 36H ;IS IT A FN OPERATOR? JZ EVPE9 ;YUP SUI 0FH ;MUST BE A REGULAR OLD OPERATOR ADD A ;DOUBLE IT LXI H,OPRCS ;OPERATOR PROCESSOR JUMP TABLE CALL ADHL ;ADD OFFSET MOV E,M ;GET THE ADDRESS OUT INX H MOV D,M LXI H,EVPE6 ;PUSH RETURN ADDRESS PUSH H XCHG ;JUMP ADDRESS TO HL PCHL ;GO GET IT EVPE9 CALL FNPR ;PROCESS FN JMP EVPE6 EVPE8 CALL AOOP ;PROCESS THE ARRAY OPERATOR EVPE6 POP H ;GET ADDRESS OF ITEM PROCESSED MOV A,M ;GET FIRST BYTE CALL GTIN ;HOW BIG IS IT? DAD D ;ADD IT UP JMP EVPE7 ;LOOP FOR THE NEXT ONE EVPE3 SUI 40H ;MAKE FIRST ONE ZERO ADD A ;DOUBLE IT LXI H,FPRCS ;FUNCTION PROCESSOR ADDRESS TABLE CALL ADHL ;ADD IT MOV E,M ;FISH OUT THE ADDRESS INX H MOV D,M LXI H,EVPE6 ;PUSH RETURN ADDRESS PUSH H XCHG ;ADDRESS TO HL PCHL ;GO GET IT EVPE1 MOV A,M ;GET ID BYTE CPI 2 ;IS IT A LABEL? JNZ EVPEP ;NOPE LDA FNFLG ;CHECK FOR FN MODE ANA A JNZ EVPEJ ;FN MODE EVPEP CALL GEIM ;GET OPERAND ADDRESS LHLD PNTR ;GET TOP OF STACK MVI M,2 ;START OF LABEL INDICATOR INX H MOV M,C ;STUFF IN THE ADDRESS INX H MOV M,B INX H MVI M,3 ;END OF LABEL INDICATOR INX H SHLD PNTR ;UPDATED PNTR JMP EVPE6 ;LOOP FOR ANOTHER ONE EVPE4 CALL PUSZ ;STUFF IT ONTO THE STACK JMP EVPE6 ;LOOP FOR ANOTHER ONE EVPE2 CALL PUSZ ;PUSH THE 09 ONTO THE STACK POP D ;GET BACK PARAMETERS POP H RET ;DONE....... OPRCS DW OPRQ DW OPRA DW OPRB DW OPRC DW OPRD DW OPRE DW OPRF DW OPRG DW OPRH DW OPRI DW OPRP DW OPRM DW OPRJ DW OPRK DW OPRN DW OPRO DW OPRL * RTN. E.33 * RUN CONTROLLER RUN8 LHLD NPNTR SHLD PNTR POP H ;GET NEXT ADDRESS XCHG LHLD ESRC CALL CMP16 JZ RUN4 ;DONE LHLD SLIN CALL CMP16 JZ RUN4A ;DONE XCHG ;ADDRESS BACK TO HL RUN SHLD LINE ;UPDATE LINE FLAG MVI A,0FFH ;SET RUN FLAG STA RUNF RUN1 CALL CONT ;CHECK FOR CONTROL C PUSHED JZ RUN2 ;SURE WAS LHLD PNTR ;SET NPNTR SHLD NPNTR LHLD PNTR ;CHECK FOR OUT OF MEMORY XCHG LHLD FARY CALL CMP16 ;PNTR SHOULD BE SMALLER MVI B,27H ;ERROR CODE JUST IN CASE JC ERROR ;OOPS, ALL OUT LHLD LINE ;GET CURRENT STATEMENT CODE RUNA MOV A,M ;GET OPCODE CPI 9BH ;IS IT AN ELSE? JZ RUNELS ;YUP CPI 9FH ;IS IT A STATEMENT NAME? JZ RUNB ;YUP CPI 9CH ;IS IT A TAB? JZ RU000 ;YUP CPI 35H ;IS IT A REMARKS SECTION? JZ RUNC ;YUP CPI 86H ;IS IT A REMARKS STATEMENT? JZ RUNC ;YUP CPI 0A4H ;IS IT A DEF STATEMENT? JZ RUNG ;YUP CPI 9EH ;IS IT A COLON OR BACKSLASH? JZ RU000 ;YUP CPI 9DH JZ RU000 ;YUP STA OPFLG ;SET OPCODE FLAG CPI 0A0H ;IS IT A NORMAL STATEMENT? JM RUN6 ;NOPE INX H ;CHECK FOR TRAILING EXPRESSION MOV A,M CPI 9 JNZ RUN7 ;NO EXPRESSION FOLLOWING CALL EVPE ;EVALUATE IT INX D ;GET NEXT COMMAND ADDRESS PUSH D ;ONTO THE STACK STC ;SET CARRY RUN9 PUSH PSW ;SAVE FLAGS PUSH H ;SAVE FIRST STACK ADDRESS LHLD LINE ;GET OPCODE AGAIN MOV A,M SUI 0A0H ;SUBTRACT OFFSET ADD A ;DOUBLE IT LXI H,NSPRC ;NORMAL STATEMENT PROCESSOR ADDRESSES CALL ADHL ;ADD IT UP MOV E,M ;GET OUT ADDRESS INX H MOV D,M XCHG ;TO HL POP D ;GET BACK STACK ADDRESS POP PSW ;GET BACK FLAGS LXI B,RUN8 ;PUSH RETURN ADDRESS PUSH B PCHL ;JUMP TO PROCESSOR RUNELS LXI B,1 ;MOVE UP ONE LOGICAL LINE INX H ;UPDATE LINE SHLD LINE CALL LILO1 ;DO IT LHLD LINE ;RUN JMP RUN RUN7 XRA A ;CLEAR CARRY PUSH H ;SAVE ADDRESS JMP RUN9 ;PROCESS IT RUN6 SUI 80H ;SUBTRACT OFFSET ADD A ;DOUBLE IT LXI H,OSPRC ;ODDBALL STATEMENT PROCESSOR ADDRESSES CALL ADHL ;ADD IT MOV E,M ;GET THE ADDRESS OUT INX H MOV D,M LXI H,RUN8 ;PUSH RETURN ADDRESS PUSH H XCHG ;ADDRESS TO HL PCHL ;GO GET IT RUN4 XRA A ;CLEAR RUNF LHLD ESRC SHLD LINEA RUN4TES STA RUNF INR A ;SET COMMAND MODE STA CMND JMP RSTRT ;BACK TO EXECUTIVE RUNB MVI A,5 ;SET UP TO GET STATEMENT ADDRESS CALL ADHL ;ADD IT UP JMP RUN ;DO IT RUN2 CALL CRLF ;CARRIAGE RETURN LHLD LINE ;SAVE LINE POINTER SHLD LINEA LXI H,RNMSG ;PRINT BREAK MESSAGE CALL MSGER ;DUMP IT CALL LNDSC ;PRINT LINE DESCRIPTOR XRA A JMP RUN4TES ;BACK TO EXECUTIVE RUNC INX H ;GET NEXT ADDRESS MOV A,M ;GET A BYTE DCR A ;CHECK FOR 01 CODE JNZ RUNC ;NOPE INX H ;FOUND IT PUSH H ;ONTO THE STACK JMP RUN8 ;DO NEXT STATEMENT PLUSM DB '+'+80H RNMSG DB 'BREAK IN',0A0H SSSS DW 0DBFFH * RTN. E.34 * ASSIGNMENT OPERATOR PROCESSOR OPRQ CALL FNOP ;GET SOURCE PUSH H ;SAVE ADDRESS PUSH PSW ;SAVE FLAGS XRA A ;CLEAR CHANGE STRING FLAG STA TMP7 CALL POPS ;GET DESTINATION MOV A,M ;GET ID BYTE CPI 2 ;IS IT A LABEL? JZ OPRQ1 ;YUP CPI 4 ;IS IT A NUMBER BLOCK? JZ OPRQ6 ;YUP ANA A ;IS IT A LITERAL? MVI B,31H JZ ERROR ;YUP MVI B,10H JMP ERROR ;NOPE OPRQ1 INX H ;GET POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL MOV A,M ;GET ID BYTE ANI 0EH ;STRIP OFF ID BITS CPI 2 ;IS IT A NUMBER? JNZ OPRQ2 ;NOPE POP PSW ;GET FLAGS BACK JNC OPRQ4 ;NOT STRING INTO NUMBER POP D ;GET SOURCE PUSH D ;SAVE IT AGAIN LDAX D ;GET A BYTE CPI 80H ;NULL STRING? MVI B,32H JNZ INPTA ;STRING INTO NUMBER LDA OPFLG ;ARE WE IN AN INPUT INSTRUCTION? CPI 0A7H MVI B,32H ;ERROR CODE JUST IN CASE JNZ ERROR ;NOPE XCHG POP B LXI H,ZERO0 LXI B,6 CALL MOVE XCHG SHLD SCFLG RET ;DONE OPRQ4 XCHG ;LOCATION TO DE POP H ;GET SOURCE ADDRESS LXI B,6 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN XCHG ;STORE ADDRESS FOR "FOR" SHLD SCFLG RET ;DONE. OPRQ2 CPI 8 ;IS IT A STRING POINTER JNZ OPRQ3 ;NOPE POP PSW ;GET FLAGS BACK MVI B,33H ;ERROR CODE CNC OQ00 ;NUMBER INTO A STRING INX H ;GET POINTER LOCATION INX H INX H MOV E,M ;GET POINTER OUT INX H MOV D,M OPRQ8 XCHG ;SWAP PUSH D ;SAVE LOCATION OF POINTER CALL KILL ;ELIMINATE THE BLOCK POP H ;GET BACK POINTER LOCATION OPRQ5 XTHL ;SWAP IT WITH STRING LOCATION LDA TMP7 ;CHECK FOR CHANGE STRING FLAG ANA A JNZ OQ01 ;YUP OQ02 CALL COUNT ;HOW MANY LITTLE INDIANS? XTHL ;POINTER LOCATION TO HL XCHG ;SWAP DCX D ;GET IT RIGHT MVI A,81H ;ID BYTE PUSH D ;SAVE POINTER LOCATION PUSH H ;SAVE NUMBER OF BYTES CALL AMBL ;ASSIGN MEMORY SPACE POP B ;NUMBER TO TRANSFER XCHG ;DESTINATION TO DE POP H ;POINTER LOCATION XTHL ;SWAP IT WITH SOURCE CALL MOVE ;MOVE THE STRING IN POP H ;GET POINTER LOCATION MOV M,E ;STUFF IT IN INX H MOV M,D RET ;DONE. OPRQ3 MOV A,M ;GET BYTE AGAIN INR A MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR POP PSW ;GET FLAGS JNC OPRQ4 ;NUMERIC TRANSFER MVI M,8 ;STORE ID BYTE INX H ;GET POINTER LOCATION INX H INX H INX H JMP OPRQ5 ;PROCESS OPRQ6 INX H ;GET NEXT BYTE MOV A,M CPI 4 ;NUMERIC ARRAY? JNZ OPRQ7 ;NOPE POP PSW ;GET BACK FLAGS MVI B,32H JC INPTA ;STRING INTO NUMERIC INX H ;GET POINTER OUT MOV E,M INX H MOV D,M JMP OPRQ4+1 ;PROCESS OPRQ7 POP PSW ;GET FLAGS MVI B,33H CNC OQ00 ;NUMBER INTO STRING INX H ;GET POINTER OUT MOV E,M INX H MOV D,M XCHG ;TO HL MOV E,M ;GET STRING POINTER OUT INX H MOV D,M JMP OPRQ8 OQ00 LDA OPFLG ;CHECK FOR INPUT STATEMENT CPI 0A7H STA TMP7 RZ ;IT WAS CPI 0A0H RZ ;IF CLOAD, IT'S OK JMP ERROR ;IT WASN'T OQ01 LHLD LLST SHLD PNTR LHLD TMP11+2 JMP OQ02 * RTN. E.35 * PRINT PROCESSOR SPRA MVI A,0 ;SET TERMINAL MODE STA CSST STA CATV SPRAZ XCHG ;TO HL PUSH H ;SAVE ADDRESS JNC SPRA8 ;SKIP IF NO EXPRESSION SPRA1 MOV A,M ;GET STACK BYTE CPI 9 ;END? JZ SPRA6 ;YUP CPI 0DH ;COMMA? JZ SPRA5 ;YUP CPI 0EH ;SEMICOLON? JZ SPRA2 ;YUP LDA BFLAG ;IS IT BINARY MODE ANA A JNZ SPRAB2 ;YUP MOV A,M CPI 6 ;IS IT SPECIAL OPERAND? JZ SP000 ;YUP SPRAB2 PUSH H ;SAVE THE ADDRESS LDA BFLAG ;CHECK FOR BINARY OUTPUT ANA A JNZ SPRAB1 ;SURE IS CALL FNOPO ;GET OPERAND JC SPRAA ;STRING XCHG ;TO DE LHLD PNTR ;PLACE TO PUT STRING LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ SPRACAS ;SURE IS MVI M,20H ;STORE A SPACE INX H ;NEXT ADDRESS XCHG ;BACK TO NORMAL CALL NMST ;CONVERT NUMBER TO STRING XCHG ;TO HL MVI M,0A0H ;STORE END SPACE SPRA3 LHLD PNTR ;PLACE TO OUTPUT FROM SPRAA CALL LNOT ;SEND IT OUT SPRA4 POP H ;GET ADDRESS BACK SPRA2 MOV A,M ;GET BYTE BACK CALL GTIN ;HOW BIG IS IT? DAD D ;ADD IT UP JMP SPRA1 ;LOOP FOR MORE ON THE STACK SPRAB1 CALL FNOPO ;GET THE OPERAND JC SPRAB3 ;IF STRING MVI B,6 ;NUMBER OF BYTES SPRAB11 MOV A,M ;GET A BYTE PUSH H ;SAVE PUSH B CALL OBPORT ;SEND IT POP B POP H ;RESTORE DCR B ;DONE? INX H ;UPDATE INDEX JNZ SPRAB11 ;NOPE JMP SPRA4 ;YUP SPRAB3 PUSH H ;SAVE ADDRESS XRA A ;SEND A 0 CALL OBPORT ;INDICATING A STRING POP H ;RESTORE ADDRESS SPRAB31 MOV A,M ;GET A CHARACTER PUSH H ;SAVE ADDRESS CALL OBPORT POP H MOV A,M INX H ;UPDATE INDEX ANA A ;DONE? JP SPRAB31 ;NOPE JMP SPRA4 SPRA5 PUSH H ;SAVE ADDRESS LDA BFLAG ;CHECK FOR BINARY OUTPUT ANA A JNZ SPRA4 ;YUP, SO IGNORE LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ Q0000 ;SURE IS LDA POSIT ;PRINT HEAD POSITION MOV L,A ;TO HL MVI H,0 MVI E,14 ;SET UP CALL DIV ;TO DIVIDE BY 14 FOR COLUMNS MVI A,14 SUB H ;SUBTRACT REMAINDER JZ SPRA4 ;NO MOVE AT ALL LHLD PNTR ;PLACE FOR SPACE STRING SPRAB MVI M,20H ;STUFF A SPACE INX H ;UPDATE POSITION DCR A ;UPDATE COUNT JNZ SPRAB ;MORE TO DUMP DCX H ;SET UPPER BIT ON LAST ONE MVI M,0A0H JMP SPRA3 ;DUMP IT SPRA6 DCX H ;LOOK AT LAST BYTE MOV A,M CPI 0DH ;COMMA? JZ SPRA7 ;YUP CPI 0EH ;SEMICOLON? JZ SPRA7 ;YUP LDA BFLAG ;CHECK FORBINARY MODE ANA A JNZ SPRA7 ;YUP SPRA8 LXI H,SPRMS ;SEND A CARRIAGE RETURN CALL LNOT SPRA7 POP H ;GET BACK FIRST ADDRESS SHLD PNTR ;CLEAR THE STACK LDA BFLAG ;BINARY MODE? ANA A JNZ SPRABF ;YUP LDA CSST ;CASSETTE MODE? ANA A RZ ;NOPE XRA A ;CLEAR OUT ANY CASSETTE MODE STA CSST INR A ;CLEAR 0 FLAG STC ;MOTORS OFF CALL COUT RET ;DONE. SPRABF XRA A ;CLEAR AND STOP MOTORS STA BFLAG INR A STC CALL BPORT RET ;DONE SPRACAS XCHG ;CONVERT TO STRING CALL NMST XCHG DCX H MOV A,M ;SET LAST BIT ORI 80H MOV M,A JMP SPRA3 ;DONE SPRMS DB 8DH ;CARRIAGE RETURN MESSAGE * RTN. E.36 * GET NUMERICAL OPERAND ADDRESS FPR10 CALL FNOP ;GET ADDRESS MVI B,26H ;ERROR CODE JC ERROR ;CAN'T HAVE A STRING, TURKEY! FPR11 XCHG ;TO DE LHLD PNTR ;GET PNTR MVI M,0 ;STORE BEGINNING OF POINTER NUMBER INX H ;INCREMENT XCHG ;EVERYTHING BACK TO NORMAL RET ;ALL DONE * RTN. E.37 * GET STRING OPERAND ADDRESS FPR20 CALL FNOP ;GET ADDRESS MVI B,26H ;ERROR CODE JNC ERROR ;CAN'T HAVE A NUMBER, ROCK. JMP FPR11 ;FINISH UP * RTN. E.38 STA CATV * GET NUMERICAL OPERAND AND CHECK FOR COMMA FPR30 CALL FPR10 ;GET OPERAND ADDRESS PUSH H ;SAVE PARAMETERS PUSH D CALL POPS ;POP ANOTHER ONE MOV A,M ;GET FIRST BYTE CPI 0DH ;IS IT A COMMA? MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;IT WASN'T A COMMA POP D ;RESTORE PARAMETERS POP H DCX D ;CORRECT FOR PNTR+1 RET ;DONE * RTN. E.39 * GET NUMERICAL OPERAND TO BINARY FPR40 CALL FPR10 ;GET BCD OPERAND PUSH D ;SAVE PNTR+1 CALL BCDB ;CONVERT TO BINARY POP D ;RESTORE PNTR+ RET ;DONE * RTN. E.40 * STRING FINISHER FPR50 INX H ;GET NEXT CHARACTER MVI M,1 ;STORE END OF STRING CHARACTER INX H ;GET NEXT ADDRESS SHLD PNTR ;UPDATE PNTR RET ;DONE * RTN. E.41 * ABS PROCESSOR FPRA CALL FPR10 ;GET OPERAND CALL ABSLT ;GET ABSOLUTE VALUE JMP OPR30 ;FINISH * RTN. E.42 * ASC PROCESSOR FPRB CALL FPR20 ;GET OPERAND MOV A,M ;GET FIRST BYTE ANI 7FH ;STRIP OFF UPPER BIT MOV L,A ;TO HL MVI H,0 ;CLEAR H * RTN. E.43 * BINARY FINISHER FPR60 CALL BBCD ;CONVERT TO BCD JMP OPR30 ;FINISH * RTN. E.44 * ATN PROCESSOR FPRC CALL FPR10 ;GET OPERAND CALL ATAN ;COMPUTE ARCTANGENT JMP OPR30 ;FINISH * RTN. E.45 * CHR$ PROCESSOR FPRD CALL FPR40 ;GET OPERAND INR H ;CHECK FOR TOO BIG DCR H MVI B,26H ;ERROR CODE JUST IN CASE JNZ ERROR ;SURE WAS MOV A,L ;CODE TO A STAX D ;STUFF IT IN JMP FPRU2 ;FINISH * RTN. E.46 * COS PROCESSOR FPRE CALL FPR10 ;GET OPERAND CALL COSN ;COMPUTE COSINE JMP OPR30 ;FINISH * RTN. E.47 * EXP PROCESSOR FPRF CALL FPR10 ;GET OPERAND CALL ETOX ;COMPUTE E TO THE XTH POWER JMP OPR30 * RTN. E.48 * FRE PROCESSOR FPRG CALL POPS ;GET RID OF OPERAND LHLD PNTR ;COMPUTE FREE SPACE LEFT XCHG LHLD FARY CALL SUB16 INX D ;UPDATE PNTR PUSH D ;SAVE IT LXI D,250 ;SUBTRACT STACK ROOM CALL SUB16 ;SUBTRACT IT JC FPRG1 ;IT'S OKAY LXI H,0 ;ALL OUT FPRG1 POP D ;RESTORE POINTER JMP FPR60 ;FINISH Q0000 LXI H,SPRMS ;CARRIAGE RETURN MESSAGE JMP SPRAA ;DUMP IT OUT RU000 INX H JMP RUN ;TRY AGAIN ON NEXT STATEMENT RUN4A LHLD PNTRA ;RESTORE PNTR SHLD PNTR XRA A JMP RUN4TES * RTN. E.49 * INP PROCESSOR FPRH CALL FPR40 ;GET OPERAND MOV A,H ;TOO BIG? ANA A MVI B,26H ;ERROR CODE JUST IN CASE JNZ ERROR ;SURE WAS MOV H,L ;STORE PORT NUMBER AND INSTRUCTION MVI L,0DBH ;INPUT INSTRUCTION SHLD IOST ;STORE IT CALL IOST ;DO IT MOV L,A ;TO HL MVI H,0 JMP FPR60 ;FINISH * RTN. E.50 * INT PROCESSOR FPRI CALL FPR10 ;GET OPERAND CALL INTG ;CONVERT TO INTEGER JMP OPR30 ;FINISH * RTN. E.51 * LEFT$ PROCESSOR FPRJ CALL FPR40 ;GET OPERAND PUSH H ;SAVE IT CALL POPS ;POP OFF A COMMA MOV A,M ;CHECK IT CPI 0DH MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;WASN'T A COMMA CALL FPR20 ;GET OPERAND TWO FPRJ1 POP B ;GET COUNT BACK FPRJ2 MOV A,M ;GET A CHARACTER STAX D ;STORE IT ANA A ;SEE IF IT WAS END OF STRING JM FPRJ3 ;IT WAS DCX B ;IT WASN'T INX H ;UPDATE INDICES INX D MOV A,B ;SEE IF COUNT IS EXHAUSTED ORA C JNZ FPRJ2 ;NOPE DCX D ;GET LAST CHARACTER ADDRESS FPRJ3 LDAX D ;GET UPPER BIT SET ORI 80H STAX D ;STUFF IT BACK JMP FPRU2 ;FINISH * RTN. E.52 * LEN PROCESSOR FPRK CALL FPR20 ;GET OPERAND PUSH D ;SAVE PNTR CALL COUNT ;COUNT CHARACTERS XCHG ;COUNT TO HL POP D ;GET BACK PNTR JMP FPR60 ;FINISH * RTN. E.53 * LOG PROCESSOR FPRL CALL FPR10 ;GET OPERAND CALL LOGX ;COMPUTE LOG BASE E JMP OPR30 ;FINSIH * RTN. E.54 * MID$ PROCESSOR FPRM CALL FPR30 ;GET OPERAND CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE IT CALL FNOP ;GET ANOTHER OPERAND JC FPRM1 ;STRING ALREADY CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE IT CALL POPS ;GET THE COMMA OFF MOV A,M ;CHECK IT OUT CPI 0DH MVI B,10H ;ERROR CODE JUST IN CASE JNZ ERROR ;NO COMMA CALL FPR20 ;GET THE STRING OFF FPRM2 POP B ;GET FIRST COUNT BACK FPRM4 DCX B ;CHECK FOR DONENESS MOV A,B ORA C JZ FPRJ1 ;GOT IT MOV A,M ;CHECK FOR RUNNING INTO END ANA A JM FPRM3 ;WE DID INX H ;UPDATE INDEX JMP FPRM4 ;LOOP FOR ANOTHER ONE DCR B FPRM1 LXI D,0FFFFH ;GET ALL ONES TO DE POP B ;COUNT BACK PUSH D ;PUSH 'EM BACK PUSH B PUSH H LHLD PNTR ;GET PNTR+1 BACK MVI M,0 ;STORE STRING START INX H XCHG ;TO DE POP H ;RESTORE ADDRESS JMP FPRM2 ;CONTINUE FPRM3 POP B ;GET STACK RIGHT MVI A,0A0H ;GET BLANKS CODE STAX D ;STUFF IT IN JMP FPRU2 ;FINISH * RTN. E.55 * OCT$ PROCESSOR FPRN CALL FPR40 ;GET OPERAND DCX D MVI C,1 ;SET UP FOR LOOP MVI B,0 JMP FPRN1 ;TO MIDDLE OF LOOP FPRN6 MVI C,3 ;TRIPLE SHIFT FPRN1 XRA A ;CLEAR A FPRN2 DAD H ;LEFT SHIFT HL RAL ;BIT TO A DCR C ;UPDATE SHIFT COUNT JNZ FPRN2 ;MORE SHIFTS INR B ;UPDATE COUNT ANA A ;CHECK FOR A ZERO JNZ FPRN3 ;NOT ZERO DCR B ;CHECK FOR B=MINUS INR B ;CHECK FOR B=MINUS JP FPRN4 ;IT'S NOT FPRN3 INX D ;STORE THE CHARACTER ORI 30H ;MAKE IT ASCII STAX D ;STUFF IT MOV A,B ;MAKE B MINUS ORI 80H ;INDICATING NO MORE ZERO SKIPPING MOV B,A FPRN4 MOV A,B ;CHECK FOR DONENESS ANI 7FH ;STRIP OFF UPPER BIT CPI 6 JNZ FPRN6 ;NOT DONE YET XCHG ;ADDRESS TO HL MOV A,B ;CHECK FOR NOTHING PRINTED CPI 6 JNZ FPRN7 ;ALL IS WELL INX H ;STORE A ZERO MVI A,30H MOV M,A FPRN7 MOV A,M ;SET UPPER BIT ORI 80H MOV M,A JMP FPR50 ;DONE * RTN. E.56 * PEEK PROCESSOR FPRO CALL FPR40 ;GET OPERAND MOV L,M ;GET BYTE OUT MVI H,0 ;CLEAR H JMP FPR60 ;FINISH * RTN. E.57 * POS PROCESSOR FPRP CALL POPS ;DUMP ONE OFF STACK LDA POSIT ;GET POSITION LHLD PNTR ;POINTER TO DE XCHG INX D MOV L,A ;TO HL MVI H,0 JMP FPR60 ;FINISH * RTN. E.58 * RIGHT$ PROCESSOR FPRQ CALL FPR40 ;GET OPERAND PUSH H ;SAVE IT CALL POPS ;GET THE COMMA OFF MOV A,M ;CHECK IT OUT MVI B,10H ;ERROR CODE JUST IN CASE CPI 0DH JNZ ERROR ;IT WASN'T CALL FPR20 ;GET THE OTHER OPERAND PUSH D ;SAVE PNTR CALL COUNT ;FIND END OF STRING DAD D DCX H ;CORRECTION POP D ;GET BACK PNTR POP B ;GET BACK COUNT FPRQ2 MOV A,M ;GET A CHARACTER ANA A ;CHECK FOR START CODE JZ FPRQ1 ;IT WAS DCX B ;CHECK COUNT MOV A,C ORA B DCX H JNZ FPRQ2 ;MORE TO GOT FPRQ1 INX H ;FIRST CHARACTER TO USE LXI B,0FFFFH ;ALL ONES JMP FPRJ2 ;FINISH IT * RTN. E.59 * RND PROCESSOR FPRR CALL FPR10 ;GET OPERAND PUSH D ;SAVE PNTR MOV A,M ;GET SIGN ANA A ;SEE IF IT'S MINUS JM FPRR1 ;YUP, SO NEW SEED LXI D,ZERO0 ;COMPARE WITH ZERO CALL CMPR JZ FPRR2 ;GET LAST NUMBER FPRR3 LXI D,SEED ;GET OPERANDS FOR MODULO 10E 08 MULTIPLY LXI H,A7579 CALL FMUL ;DO IT LXI H,WORK1+8 ;ANSWER LXI D,SEED+2 ;DESTINATION LXI B,4 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN FPRR2 POP B ;GET PLACE FOR RANDOM NUMBER LXI D,TENT8 ;CONSTANT LXI H,SEED CALL DIVER ;COMPUTE NUMBER BETWEEN 0 AND 1 JMP OPR30 ;FINISH FPRR1 LXI D,SEED ;GET ABSOLUTE VALUE OF NEW SEED CALL ABSLT LXI H,SEED ;GET INTEGER OF SEED LXI D,SEED CALL INTG JMP FPRR3 ;COMPUTE RANDOM NUMBER * RTN. E.60 * SGN PROCESSOR FPRS CALL FPR10 ;GET OPERAND CALL SIGN ;GET EQUIVALENT SIGN JMP OPR30 ;FINISH * RTN. E.61 * SIN PROCESSOR FPRT CALL FPR10 ;GET OPERAND CALL SINE ;COMPUTE SINE JMP OPR30 * RTN. E.62 * SPACE$ PROCESSOR FPRU CALL FPR40 ;GET OPERAND DCX D FPRU1 MOV A,H ;HL=0? ORA L JZ FPRU2 ;FINISH UP INX D ;GET ADDRESS FOR SPACE MVI A,20H ;STORE IT STAX D DCX H ;UPDATE COUNT JMP FPRU1 ;LOOP FOR ANOTHER ONE FPRU2 XCHG ;ADDRESS TO HL MOV A,M ;SET UPPER BIT ON LAST ONE ORI 80H MOV M,A JMP FPR50 ;FINISH * RTN. E.63 * SPC PROCESSOR FPRV CALL FPR40 ;GET OPERAND XCHG ;TO DE LHLD PNTR ;GET POINTER MVI M,6 ;STORE SPECIAL OPERATOR CODE BLOCK INX H MVI M,1 ;SPC CODE SPCO0 INX H MOV M,E ;STORE NUMBER OF SPACES INX H MVI M,7 ;END OF BLOCK CODE INX H SHLD PNTR ;UPDATE POINTER RET ;DONE....... A7579 DB 2,0,0,0,75H,79H ;7579 CONSTANT TENT8 DB 3,8,10H,0,0,0 ;TEN TO THE EIGHTH CONST * RTN. E.64 * SQR PROCESSOR FPRW CALL FPR10 ;GET OPERAND CALL SQUR ;COMPUTE SQUARE ROOT JMP OPR30 ;FINISH * RTN. E.65 * STR$ PROCESSOR FPRX CALL FPR10 ;GET OPERAND CALL NMST ;DUMP STRING OUT DCX D ;SET BIT OF LAST CHARACTER XCHG MOV A,M ORI 80H MOV M,A JMP FPR50 ;FINISH * RTN. E.66 * TAB PROCESSOR FPRY CALL FPR40 ;GET OPERAND MOV A,H ;TOO BIG? ANA A MVI B,26H ;ERROR CODE JUST IN CASE JNZ ERROR ;SURE WAS XCHG ;TO DE LHLD PNTR ;GET POINTER MVI M,6 ;STORE SPECIAL OPERATOR CODE BLOCK INX H MVI M,0 ;TAB CODE JMP SPCO0 ;CONTINUE * RTN. E.67 * TAN PROCESSOR FPRZ CALL FPR10 ;GET OPERAND CALL TANG ;COMPUTE TANGENT JMP OPR30 ;FINISH * RTN. E.68 * USR PROCESSOR FPRAA CALL FPR40 ;GET OPERAND XCHG ;TO DE PUSH H ;SAVE PNTR CALL 0 ;CALL TO USER'S ROUTINE XCHG ;NUMBER TO HL POP D ;RESTORE PNTR JMP FPR60 ;FINISH * RTN. E.69 * VAL PROCESSOR FPRAB CALL FPR20 ;GET OPERAND PUSH D ;SAVE PNTR CALL STNM ;CONVERT STRING TO NUBMER POP D ;RESTORE PNTR JNC OPR30 ;GOOD CONVERSION LXI H,ZERO0 ;MOVE A ZERO IN LXI B,6 CALL MOVE JMP OPR30 ;FINISH FPHEX CALL FPR40 ;GET OPERAND MVI B,4 ;SET UP FOR 4 DIGITS FPHEX1 XRA A ;CLEAR A MVI C,4 ;SET UP FOR 4 BITS FPHEX2 DAD H ;SHIFT RAL DCR C ;UPDATE BIT COUNT JNZ FPHEX2 ;MORE TO SHIFT ADI 30H ;ADD ASCII OFFSET CPI 3AH ;SEE IF IT'S A HEX A THRU F JC FPHEX3 ;NOPE ADI 7 FPHEX3 STAX D ;STUFF IT INX D ;UPDATE INDEX DCR B ;UPDATE DIGIT COUNT JNZ FPHEX1 ;MORE TO GO XCHG ;ADDRESS TO HL DCX H ;SET LAST BIT MOV A,M ORI 80H MOV M,A JMP FPR50 ;DO IT FPHXR CALL FNOP ;GET STRING TO CONVERT JNC SPRAT ;NOT A STRING, STUPID! LXI D,0 ;INITIALIZE CONVERSION LOOP PUSH D ;TO THE STACK FPHXR1 MOV A,M ;GET A CHARACTER ANI 7FH ;STRIP ANY STROBE OFF SUI 30H ;CONVERT NUMERIC JC SPRAT ;OOPS, TOO SMALL CPI 0AH ;MAYBE IT'S A LETTER JC FPHXR2 ;NOPE, IT'S OK SUI 7 ;CONVERT THE LETTER CPI 10H ;IS IT TOO BIG? JNC SPRAT ;YUP FPHXR2 XTHL ;GET THE NUMBER DAD H ;SHIFT LEFT 4 BITS DAD H DAD H DAD H ORA L ;SET IN THE NEW LSN (LEAST SIGN. NIBBLE) MOV L,A XTHL ;BACK TO THE STACK MOV A,M ;ARE WE DONE? ANA A INX H JP FPHXR1 ;NOPE POP H ;GET THE NUMBER XCHG ;GET PLACE TO CONVERT TO LHLD PNTR XCHG INX D CALL BBCD ;CONVERT TO INTERNAL FORM JMP OPR30 ;FINISH OFF THE NUMBER FPRCS DW FPRA DW FPRB DW FPRC DW FPRD DW FPRE DW FPRF DW FPRG DW FPRH DW FPRI DW FPRJ DW FPRK DW FPRL DW FPRM DW FPRN DW FPRO DW FPRP DW FPRQ DW FPRR DW FPRS DW FPRT DW FPRU DW FPRV DW FPRW DW FPRX DW FPRY DW FPRZ DW FPRAA DW FPRAB DW FPMAT DW FPHEX DW FPRCAL DW FPRLOC DW FPHXR FPRCAL CALL FPR40 ;GET FIRST OPERAND PUSH H ;SAVE IT CALL POPS ;LOOK FOR A COMMA MOV A,M CPI 0DH ;IS IT? JNZ SPRAT ;NOPE CALL FPR40 ;GET SECOND OPERAND XCHG ;TO DE XTHL ;GET FIRST ONE BACK XCHG ;FIX IT UP LXI B,FPRCAL1 ;PUSH THE RETURN ADDRESS PUSH B PCHL ;DO IT TO IT FPRCAL1 POP H ;RETURN THE PNTR LOCATION XCHG ;TO DE CALL BBCD ;CONVERT TO NUMBER JMP OPR30 ;EXIT FPRLOC CALL FNOP ;GET LOCATION OF OPERAND XCHG LHLD PNTR ;GET PLACE TO PUT IT XCHG INX D CALL BBCD ;CONVERT TO NUMBER JMP OPR30 ;DONE....... FPMAT CALL FPR30 ;GET OPERAND CALL BCDB ;CONVERT TO BINARY PUSH H ;SAVE START NUMBER CALL FNOP ;GET SEARCH STRING JNC SPRAT ;SHOULD BE A STRING PUSH H ;SAVE LOCATION CALL POPS ;GET THE COMMA OFF MOV A,M CPI 0DH ;IS IT A COMMA? JNZ SPRAT ;NOPE, SO ERROR CALL FNOP ;GET PATTERN STRING JNC SPRAT ;SHOULD BE A STRING, DUMMY! CALL TRANS ;TRANSFORM INTO PATTERN POP D ;GET SEARCH STRING XTHL ;GET THE START MOV A,H ;CHECK FOR0 ORA L JZ SPRAT ;CAN'T BE PUSH H ;BACK TO THE STACK XCHG ;SEARCH STRING TO HL CALL COUNT ;HOW MANY CHARACTERS? XTHL ;START BACK TO HL INX D ;CHECK FOR IMPOSSIBLE SITUATION CALL CMP16 JNC SPRAT ;CAN'T START AFTER THE STRING! PUSH H POP B POP H DCX B DAD B INX B POP D ;GET THE PATTERN FPMAT1 CALL OMATCH ;CHECK IT OUT JZ FPMAT3 ;WE FOUND IT MOV A,M ;DID WE HIT THE END OF THE SEARCH STRING? ANA A JM FPMAT2 ;YUP INX B ;UPDATE AND TRY AGAIN INX H JMP FPMAT1 FPMAT2 LHLD PNTR ;PLACE TO STORE TO XCHG LXI H,ZERO0 ;WHAT TO STORE INX D LXI B,6 ;HOW MANY TO STORE CALL MOVE JMP OPR30 ;FINISH IT OFF FPMAT3 MOV L,C ;BC TO HL MOV H,B XCHG ;GET PLACE TO PUT IT LHLD PNTR INX H XCHG CALL BBCD ;CONVERT TO BCD JMP OPR30 ;FINISH IT OFF TRANS XCHG ;GET PLACE TO PUT IT LHLD FARY DCR H DCR H MVI C,0 ;CLEAR FLAG PUSH H ;SAVE ADDRESS TRANS1 LDAX D ;GET A CHARACTER ANI 7FH ;STRIP END BIT CPI '\' ;IS IT A BACKSLASH? JZ TRANS4 ;YUP CPI '?' ;IS IT A QUESTION MARK? JZ TRANS5 ;YUP CPI '!' ;IS IT AN EXCLAMATION POINT? JZ TRANS5 ;YUP CPI '#' ;IS IT A POUND SIGN? JZ TRANS5 ;YUP TRANS2 MOV M,A ;STORE IT MVI C,0 ;CLEAR SLASH SIGN LDAX D ;CHECK FOR ENCOUNTER OF THE END KIND ANA A JM TRANS3 ;DONE INX H ;UPDATE INX D JMP TRANS1 ;DO IT AGAIN TRANS3 MOV A,M ;SET LAST INDICATOR ORI 80H MOV M,A POP H ;RESTORE ADDRESS RET ;DONE TRANS4 INR C ;SET SLASH FLAG LDAX D ;CHECK FOR END ANA A JM TRANS3 INX D ;GET NEXT CHARACTER JMP TRANS1 ;TRY AGAIN TRANS5 INR C ;CHECK FOR C=0 DCR C JNZ TRANS2 ;NOPE, SO INSERT THE CHARACTER ANI 0FH ;TURN INTO CONTROL TYPE JMP TRANS2 ;STORE IT OMATCH PUSH H ;SAVE THE WORLD PUSH D PUSH B MATCH1 MOV A,M ;GET A CHARACTER FROM SEARCH STRING ANI 7FH ;STRIP IT MOV B,A ;TO B LDAX D ;GET A CHARACTER FROM PATTERN STRING ANI 7FH ;STRIP IT CPI 10H ;IS IT A SPECIAL CHARACTER? JC MATCH4 ;YUP MATCH2 CMP B ;A=B? JNZ MATCH7 ;NOPE MATCH3 LDAX D ;CHECK FOR END OF PATTERN ANA A JM MATCH8 ;FIND MOV A,M ;CHECK FOR END OF SEARCH STRING ANA A JM MATCH7 ;NO FIND INX H ;TRY AGAIN INX D JMP MATCH1 MATCH4 CPI 1 ;IS IT ALPHA FLAG? JZ MATCH6 ;YUP CPI 3 ;IS IT NUMERIC FLAG? JZ MATCH5 ;YUP CPI 0FH ;IS IT ANY CHARACTER? JNZ MATCH2 ;NO, SO TREAT AS NORMAL CHARACTER JMP MATCH3 ;ASSUME A MATCH MATCH5 MOV A,B ;CHECK FOR NUMBER CPI 3AH ;IS IT TOO BIG? JNC MATCH7 ;YUP CPI 30H ;IS IT TOO SMALL? JC MATCH7 ;YUP JMP MATCH3 ;IT'S OKAY MATCH6 MOV A,B ;CHECK FOR ALPHABETIC CPI 7BH ;IS IT TOO BIG? JNC MATCH7 ;YUP CPI 61H ;IS IT LOWER CASE JNC MATCH3 ;YUP, SO IT'S OKAY CPI 5BH ;IS IT TOO BIG? JNC MATCH7 ;YUP CPI 41H ;IS IT UPPER CASE? JNC MATCH3 ;YUP, SO IT'S OKAY MATCH7 MVI A,1 ;CLEAR THE ZERO FLAG ANA A JMP MATCH9 ;RETURN MATCH8 XRA A ;SET THE ZERO FLAG MATCH9 POP B ;RESTORE THE WORLD POP D POP H RET ;DONE....... EVPEJ INX H ;GET SYMBOL NUMBER OUT MOV C,M INX H MOV B,M PUSH H ;SAVE ADDRESS CALL DFND ;CHECK FOR FNXX LABEL CPI 4 POP H ;RESTORE ADDRESS DCX H DCX H JZ EVPEP ;IT WAS, SO ONTO THE STACK WITH IT LHLD FNONE ;GET FIRST LIST LXI D,0 ;CLEAR COUNTR EVPEM MOV A,M ;GET BYTE CPI 2 ;LABEL? JNZ SPRAT ;ERROR INX H MOV A,M ;GET A BYTE INX H ;GET ADDRESS OF NEXT ONE CMP C ;GOOD SO FAR? JNZ EVPEK ;NOPE MOV A,M ;GET ANOTHER ONE CMP B ;GOOD? JZ EVPEL ;YUP EVPEK INX H ;GET COMMA INX H MOV A,M ;CHECK IT CPI 0DH JNZ SPRAT ;ERROR INX H INX D ;UPDATE COUNT JMP EVPEM ;LOOP FOR ANOTHER EVPEL LHLD FNTWO ;GET SECOND LIST EVPEN MOV A,D ;DE=0? ORA E JZ EVPEO ;YUP, SO WE FOUND IT PUSH D MOV A,M ;GET A BYTE CALL GTIN ;GET INCREMENT DAD D ;ADD IT MOV A,M ;CHECK FOR COMMA CPI 0DH JNZ SPRAT ;ERROR INX H ;GET NEXT ITEM POP D ;UPDATE COUNTER DCX D JMP EVPEN ;LOOP FOR ANOTHER EVPEO CALL PUSZ ;PUSH THIS ITEM ON THE STACK JMP EVPE6 ;PROCESS AS NORMAL NSPRC DW SPRY DW SPRX DW SPRG DW SPRB DW SPRB DW SPRB DW SPRH DW SPRF DW SPRB DW SPRC DW SPRL DW SPRO DW SPRP DW SPRA DW SPRQ DW SPRR DW SPRT DW SANA DW SPRU DW SPRV DW SPRW DW SPRZ DW SANB DW SANC DW SAND OSPRC DW SPRN DW SPRI DW SPRJ DW SPRD DW SPRM DW SPRE DW SPRB DW SPR1 DW SPRN DW SPRS INPTA LDA OPFLG ;SEE IF WE ARE IN AN INPUT INSTRUCTION CPI 0A7H JNZ ERROR ;NOPE LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ ERROR ;YUP POP H ;CLEAN UP THE STACK LXI H,INPTM ;ERROR MESSAGE CALL MSGER JMP SPRF1 ;RETRY INPUT INPTM DB 0DH,'INPUT ERROR',8DH RUNG CALL MFOS ;GET NEXT STATEMENT ADDRESS PUSH H ;ONTO THE STACK JMP RUN8 ;CONTINUE SP000 PUSH H ;SAVE ADDRESS INX H ;GET NEXT BYTE MOV A,M ANA A ;SEE IF IT'S A TAB JNZ SP001 ;NOPE, SO MUST BE A SPC INX H ;GET POSITION DESIRED MOV B,M LDA POSIT ;SEE WHERE WE'RE AT NOW DCR A CMP B ;CHECK FOR SIZE JC SP002 ;IT'S OKAY PUSH B ;SAVE POSIT CALL CRLF ;NEXT LINE POP B ;RESTORE COUNT SP002 LDA POSIT ;COMPUTE NUMBER OF SPACES NEEDED SUB B ;SUBTRACT CMA INR A SP003 DCR A ;CHECK FOR DONENESS JM SPRA4 ;ALL DONE LXI H,BLANK ;SEND OUT A SPACE PUSH PSW ;SAVE COUNT CALL LNOT POP PSW ;RESTORE COUNT JMP SP003 ;TRY FOR ANOTHER ONE SP001 INX H ;GET NUMBER OF SPACES OUT MOV A,M JMP SP003 ;PUT 'EM OUT BLANK DB 0A0H * RTN. E.70 * DIMENSION AND LET STATEMENT DUMMY SPRB RET ;DONE * RTN. E.71 * END PROCESSOR SPRC XRA A ;CLEAR RUN FLAG STA RUNF LHLD LINE SHLD LINEA JMP RSTRT ;TO EXEC * RTN. E.72 * GOTO PROCESSOR SPRD LHLD LINE ;GET CURRENT LOCATION INX H ;GET LABEL NUMBER OUT INX H MOV C,M INX H MOV B,M PUSH B ;ONTO THE STACK INX H ;CHECK FOR A OFFSET INX H XCHG ;TO DE LHLD ESRC ;CHECK FOR END OF SOURCE COLLISION XCHG CALL CMP16 LXI D,0 ;SET OFFSET TO ZERO JZ SPRD2 ;YUP, SO NO OFFSET MOV A,M CPI 8 ;EIGHT IF IT IS JNZ SPRD2 ;NO OFFSET INX H ;GET BEGINNING OF EXPRESSION CALL EVPE ;EVALUATE THE EXPRESSION CALL SPRD1 ;GET BINARY OFFSET SPRD2 POP B ;GET BACK SYMBOL NUMBER CALL LILO ;FIND ADDRESS XCHG ;SWAP 'EM POP H ;RETURN ADDRESS TO HL PUSH D ;NEW PROGRAM ADDRESS TO THE STACK PCHL ;RETURN SPRD1 SHLD PNTR ;RESET PNTR CALL FNOPO ;GET OPERAND MVI B,26H ;ERROR CODE JUST IN CASE JC ERROR ;CAN'T HAVE A STRING FOR AN OFFSET MOV A,M ;GET SIGNS BYTE ANA A PUSH PSW ;SAVE IT CALL BCDB ;CONVERT IT TO BINARY POP PSW ;GET SIGN BACK XCHG ;TO DE RP ;RETURN IF NO INVERSION REQUIRED DCX D RET ;DONE....... * RTN. E.73 * IF PROCESSOR SPRE LHLD LINE ;GET CURRENT LINE INX H ;GET EXPRESSION ADDRESS CALL EVPE ;EVALUATE IT CALL FNOPO ;GET EVALUATED VALUE MVI B,40H ;ERROR CODE JUST IN CASE JC ERROR ;SOMETHING'S WRONG WITH A STRING RESULT! CALL BCDB ;CONVERT TO BINARY LXI D,0FFFFH ;SEE IF IT'S A -ONE CALL CMP16 JZ SPRE1 ;SURE WAS MOV A,H ;SEE IF IT'S A ZERO ORA L MVI B,40H ;ERROR CODE JUST IN CASE JNZ ERROR ;NOT A LOGICAL EXPRESSION SPRE2 CALL MFOS ;MOVE UP ONE CALL MFOS ;AND AGAIN MOV A,M ;CHECK FOR COLON OR BACKSLASH CPI 9DH JZ SPRE2 ;YUP CPI 9EH JZ SPRE2 CPI 9CH ;IS IT A TAB? JZ SPRE2+3 ;YUP CPI 9BH ;IS IT AN ELSE? JNZ SPRE21 ;NOPE CALL MFOS ;MOVE UP ANOTHER ONE SPRE21 XTHL ;SET UP THE STACK PCHL ;RETURN SPRE1 CALL MFOS ;MOVE UP ONE XTHL ;SET UP THE STACK PCHL * RTN. E.74 * INPUT PROCESSOR SPRF MVI A,0 ;SET KEYBOARD MODE STA CATV STA CSST SPRFZ MVI B,10H ;IN CASE OF ERROR JNC ERROR ;NO EXPRESSION FOLLOWING XCHG ;SWAP SHLD TMP1 ;SAVE EXPRESSION START LHLD PNTR ;PRESET NN SHLD TMP2 XRA A ;CLEAR PROMPT FLAG STA STFLG SPRF1 LHLD TMP1 ;INITIALIZE SHLD FLST LHLD TMP2 SHLD PNTR SHLD LLST SPRF2 LHLD FLST ;GET CURRENT TOKEN MOV A,M ANA A ;CHECK FOR LITERAL JZ SPRF6 ;IT WAS CPI 0DH ;CHECK FOR COMMA JZ SPRF7 ;IT WAS CPI 0EH ;IS IT A ";"? JZ SPRF7 ;YUP CPI 09H ;CHECK FOR END CODE JZ SPRFF ;IT WAS, AND WE'RE DONE CPI 2 ;CHECK FOR A LABEL JZ SPRFP ;YUP SPRFL LHLD LLST ;SEE IF ANY INPUT IS AVAILABLE XCHG LHLD PNTR CALL CMP16 JNZ SPRF5 ;SURE IS LDA STFLG ;GET PROMPT FLAG ANA A ;IS IT SET? JNZ SPRF8 ;YUP LDA BFLAG ;BINARY MODE? ANA A JNZ SPRF8 ;YUP SPRFQ LXI H,SPRFM ;NO, SO SEND A ? LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ SPRF8 ;SURE IS, SO NO PROMPT CALL MSGER SPRF8 LHLD PNTR ;INPUT A LINE LDA BFLAG ;CHECK FOR BINARY MODE ANA A JNZ SPRFBIN ;SURE IS LXI D,100 DAD D SHLD TMP11+2 PUSH H ;SAVE ADDRESS CALL LIIN ;INPUT FROM KEYBOARD POP H JC SPF10 SPF20 XRA A ;CLEAR STFLG STA STFLG SPRF3 PUSH H ;SAVE THE ADDRESS XCHG LHLD PNTR INX H XCHG CALL STNM ;TRY TO CONVERT IT JC SPRF4 ;NO GOOD SP99A XTHL ;NEW ADDRESS TO STACK CALL OPR30 ;COMPLETE NUMBER BLOCK POP H ;GET ADDRESS BACK DCX H ;CHECK FOR END OF LINE MOV A,M ANA A JM SPRF2 ;IT WAS INX H ;CHECK FOR COMMA SEPARATOR MOV A,M CPI ',' INX H ;GET NEXT ADDRESS JZ SPRF3 ;IT WAS JMP SPRF2 ;IGNORE EXTRA INPUT SPRF4 POP H ;GET BACK ADDRESS CALL COUNT ;HOW MANY CHARACTERS? MOV C,E ;TO BC MOV B,D XCHG ;TO DE LHLD PNTR ;STORE THE THING MVI M,0 ;STRING INDICATOR INX H XCHG ;BACK TO HL CALL MOVE ;MOVE IT DOWN XCHG ;BACK TO HL DAD B MVI M,1 ;END OF STRING CODE INX H SHLD PNTR ;UPDATE PNTR JMP SPRF2 ;BACK TO SCANNER SPRFBIN PUSH H ;SAVE ADDRESS CALL OBINPOR ;GET A BYTE ANA A ;IS IT A STRING? POP H ;RESTORE ADDRESS JZ SPRFBA ;YUP MVI M,4 ;STORE NUMBER BLOCK INX H ;NEXT ADDRESS MOV M,A ;STORE THE FIRST BYTE OF NUMBER MVI B,5 ;BYTES LEFT INX H ;FIRST ADDRESS FOR THAT SPRFBB1 PUSH H ;SAVE PUSH B CALL OBINPOR ;GET A BYTE POP B POP H MOV M,A ;STORE IT INX H DCR B ;DONE? JNZ SPRFBB1 ;NOPE MVI M,05H ;YUP{ INX H SHLD PNTR ;UPDATE STACK JMP SPRF2 ;CONTINUE SPRFBA MOV M,A ;STORE THE BYTE INX H ;UPDATE THE INDEX SPRFBA1 PUSH H ;SAVE ADDRESS CALL OBINPOR ;GET ANOTHER BYTE POP H ;RESTORE ADDRESS MOV M,A ;STORE IT INX H ;UPDATE ANA A ;END? JP SPRFBA1 ;NOPE MVI M,01 ;END INX H SHLD PNTR JMP SPRF2 ;CONTINUE SPRF5 LHLD FLST ;PUSH RECEIVING VARIABLE CALL PUSZ MOV A,M ;GET INCREMENT CALL GTIN DAD D ;ADD IT SHLD FLST ;UPDATE LHLD LLST ;PUSH CONSTANT CALL PUSZ MOV A,M ;GET INCREMENT CALL GTIN DAD D SHLD LLST ;UPDATE CALL OPRQ ;ASSIGN JMP SPRF2 ;TO SCANNER SPRF6 INX H ;PRINT LITERAL LDA CSST ;CHECK FOR CASSETTE MODE ANA A JNZ SPRF7 ;YUP, SO SKIPTHE PROMPT CALL MSGER MVI A,0FFH ;SET THE PROMPT FLAG STA STFLG SPRF7 LHLD FLST ;UPDATE FLST MOV A,M CALL GTIN DAD D SHLD FLST JMP SPRF2 ;BACK TO THE SCANNER SPRFM DB '?'+80H LINK5 LINK B:TBASICA6