Oakland CPM Archive

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

/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug032.ark / TBASICA3.ASM < prev next >

Wrap

Assembly Source File | 1984-04-29 | 52.1 KB | 2,274 lines

* RTN. C.3 * KEYBOARD INPUT * OUT: A = ASCII CODE FOR CHARACTER INPUTTED * USERS ROUTINE HAS RESPONSIBILITY FOR PROVIDING LOWER * TO UPPER CASE CONVERSION, AND MAKING RUBOUT A * 7F, HEXADECIMAL. THE PARITY BIT WILL BE RESET (ZERO) KYIN ORI 1 ;CLEAR THE ZERO FLAG JMP CONT1 ;USE CONTROL C ROUTINE * RTN. C.4 * OUTPUT TO TERMINAL(S) * IN: A = ASCII CODE FOR CHARACTER TO BE SENT * THIS ROUTINE FINDS EACH CHANNEL THAT IS IN TERMINAL MODE, * SENDS THE CHARACTER, AND UPDATES THE POSITION FLAGS. * IF A LINE WILL BE OVERRUN, A CARRIAGE RETURN * WILL BE INSERTED. IF A RUBOUT CHARACTER IS DETECTED, * TWO ACTIONS ARE POSSIBLE. ONE, IF THE RUBOUT FLAG * IS ZERO, A '@' WILL BE SENT. TWO, IF THE RUBOUT * FLAG IS NONZERO, THE RUBOUT WILL BE SENT AND * IT IS ASSUMED THAT THE TERMINAL WILL BACKSPACE * AND ERASE THE LAST CHARACTER TOUT LXI B,1 ;GET CHANNEL ONE FOR STARTERS CALL EDIT1 ;CHECK FOR MEMORY STORE TIME TOUTTAB1 PUSH PSW ;SAVE CHARACTER CPI 0DH ;CARRIAGE RETURN? JZ TOUTZ ;YUP CPI 7FH ;RUBOUT? JZ TOUTY ;YUP CPI 09H ;IS IT A TAB? JZ TOUTTAB ;YUP LDA POSIT ;GET HEAD POSITION INR A ;UPDATE STA POSIT TOUTX POP PSW ;RESTORE CHARACTER TOUT1 PUSH PSW ;SAVE THE CHARACTER MVI A,2 ;GET TERMINAL MODE CODE CALL MFND ;FIND A TERMINAL CHANNEL JNZ TOUT2 ;OH, OH, NO MORE TERMINALS POP PSW ;GET THE CHARACTER BACK PUSH B ;SAVE THE NEXT CHANNEL PUSH PSW ;SAVE THE CHARACTER XCHG ;PUT PARAMETERS ADDRESS IN HL CPI 7FH ;IS IT A RUBOUT? JZ TOUT3 ;SURE IS CPI 0DH ;IS IT A CARRIAGE RETURN? JZ TOUT4 ;YUP INX H ;GET ADDRESS OF POSITION FLAG TOUT9 INR M ;UPDATE POSITION FLAG DCX H ;GET ADDRESS OF WIDTH FLAG MOV A,M ;GET IT INX H ;GET ADDRESS OF POSITION FLAG AGAIN CMP M ;COMPARE JNC TOUTB ;AH, NO OVERRUN MVI M,0 MVI A,0DH ;GET A CARRIAGE RETURN CODE LXI B,TOUTRET ;SET UP RETURN ADDRESS PUSH B XCHG ;PUT CHANNEL ADDRESS BACK IN HL ANA A PCHL ;SEND THE CR TOUTRET MVI A,0AH ;SEND THE LF ANA A LXI B,TOUT6 ;PUSH THE RETURN ADDRESS PUSH B PCHL ;DO IT TO IT TOUTTAB POP PSW TOUTTAB2 MVI A,20H ;SEND A SPACE LXI B,1 CALL TOUTTAB1 LDA POSIT ;CHECK IT ANI 7 RZ ;DONE JMP TOUTTAB2 TOUT6 XCHG ;PUT CHANNEL ADDRESS IN DE MVI M,1 ;SET POSITION TO 1 TOUTB POP PSW ;GET CHARACTER BACK PUSH PSW ;SAVE THE THING AGAIN TOUT5 LXI B,TOUT7 ;SET UP RETURN ADDRESS PUSH B XCHG ;PUT CHANNEL ADDRESS BACK IN HL ANA A PCHL ;SEND THE CHARACTER TOUT7 POP PSW ;GET THE CHARACTER BACK POP B ;GET THE NEXT CHANNEL ADDRESS JMP TOUT1 ;LOOP FOR ANOTHER TERMINAL TOUT2 POP PSW ;CLEAN UP THE STACK CPI 0DH ;WAS THIS A CR? RNZ ;NOPE MVI A,0AH ;SEND A LF TOO LXI B,1 JMP TOUTTAB1 ;DO IT TOUT3 INX H ;GET RUBOUT FLAG INX H MOV A,M DCX H ;GET ADDRESS OF POSITION FLAG ANA A ;SET FLAGS JNZ TOUT8 ;A REAL RUBOUT!! POP PSW ;GET A BACK MVI A,'@' ;SEND A FAKE RUBOUT PUSH PSW ;SAVE IT AGAIN JMP TOUT9 TOUT8 DCR M ;UPDATE THE POSITION MVI A,7FH ;GET A RUBOUT CODE JP TOUT5 ;SEND IT DCX H ;GET THE WIDTH FLAG ADDRESS MOV A,M ;GET IT INX H ;GET THE POSITION FLAG ADDRESS MOV M,A ;STORE IT MVI A,7FH ;GET A RUBOUT CODE JMP TOUT5 ;SEND IT TOUT4 INX H ;GET POSITION ADDRESS MVI M,0 ;CLEAR IT JMP TOUT5 ;SEND THE CARRIAGE RETURN * RTN. C.6 * CASSETTE OUTPUT BYTE * CARRY AND ZERO FLAGS SET UP AS IN CAIN * IN: A = BYTE TO WRITE COUT PUSH PSW CPI 0DH ;IS IT A CR? JZ COUTCR ;YUP COUTA MVI A,8 LXI B,1 ;START WITH CHANNEL 1 CALL MFND ;FIND THE CASSETTE CHANNEL JNZ COUTBA ;NONE FOUND POP PSW ;GET FLAGS BACK PCHL ;GO GET IT COUTCR POP PSW LXI B,COUTCR1 PUSH B PUSH PSW JMP COUTA COUTCR1 MVI A,0AH JMP COUT COUTBA POP PSW RET ;DONE * BINARY PORT ROUTINES * BINARY PORT OUTPUT BPORT PUSH PSW ;SAVE BYTE AND FLAGS LXI B,1 ;START WITH CHANNEL ONE BPORT1 MVI A,20H ;BIT FOR BINARY OUTPUT PORT CALL MFND ;LOOK FOR IT JNZ BPORT2 ;NOT FOUND POP PSW ;GET BYTE AND SET FLAGS PUSH PSW ;SAVE 'EM AGAIN PUSH B ;SAVE CHANNEL COUNT LXI B,BPORT3 ;STUFF THE RETURN ADDRESS PUSH B PCHL ;GO TO THE PORT ROUTINE BPORT3 POP B ;RESTORE JMP BPORT1 ;TRY FOR ANOTHER ONE BPORT2 POP PSW ;RESTORE STACK RET ;DONE * BINARY INPUT PORT BINPOR LXI B,1 ;START WITH CHANNEL ONE PUSH PSW ;SAVE 'EM MVI A,10H ;INPUT PORT BIT CALL MFND ;LOOK FOR IT JNZ SPRAT ;NONE FOUND POP PSW ;GOT IT LXI B,BINPOR1 ;STUFF A RETURN ADDRESS PUSH B PCHL ;DO IT BINPOR1 MVI B,23H ;TAPE READ ERROR? JC ERROR ;YUP RET ;NOPE, ALL'S OK OBPORT PUSH B ;SAVE IT MOV B,A MVI A,1 ANA A MOV A,B ;BACK POP B JMP BPORT OBINPOR MVI A,1 ANA A JMP BINPOR * IN: CATV = 0 FOR TV, <> 0 FOR CASSETTE * HL = ADDRESS OF FIRST CHARACTER IN LINE * LAST CHARACTER IN LINE HAS BIT 7 SET LNOT LDA CATV ;GET TV/CASSETTE FLAG MOV B,A ;STICK IT IN B MOV A,M ;GET THE CHARACTER TO A ANA A ;SET FLAGS PUSH PSW ;SAVE FLAGS ANI 7FH ;STRIP UPPER BIT MOV D,A ;SAVE THE CHARACTER POP PSW ;RESTORE FLAGS MOV A,D ;PUT THE CHARACTER BACK PUSH H ;SAVE ADDRESS PUSH PSW ;SAVE CHARACTER AND THE FLAGS INR B ;CHECK FOR B=0 DCR B JNZ LNOT2 ;CASSETTE MODE POP PSW ;GET CHARACTER BACK PUSH PSW ;SAVE IT AGAIN CALL TOUT ;OUTPUT TO TERMINAL(S) LNOT3 POP PSW ;GET FLAGS BACK POP H ;GET ADDRESS BACK INX H ;UPDATE INDEX RM ;ALL DONE..... ORI 1 ;CLEAR THE ZERO FLAG JMP LNOT ;LOOP FOR ANOTHER CHARACTER LNOT2 POP PSW ;GET THE CHARACTER BACK PUSH PSW ;SAVE IT AGAIN CALL COUT ;SEND IT TO THE CASSETTE(S) JMP LNOT3 ;RESUME NORMAL SEQUENCE * RTN. C.8 * LINE OUTPUT FOR TERMINALS * IN: HL = FIRST ADDRESS OF STRING * LAST CHARACTER IN STRING HAS BIT 7 SET MSGER XRA A ;CLEAR CATV STA CATV JMP LNOT ;OUTPUT LINE * RTN. C.9 * LINE OUTPUT FOR CASSETTE * IN: HL = FIRST ADDRESS OF STRING * LAST CHARACTER IN STRING HS BIT 7 SET * OUT: CARRY SET IF NO CHARACTERS WERE INPUT CLIN MVI A,0FFH ;SET CATV NONZERO STA CATV JMP LNOT ;OUTPUT LINE * RTN. C.9 * LINE INPUT FOR CASSETTE AND KEYBOARD * IN: HL = FIRST ADDRESS TO STORE STRING LIIN LXI D,0 ;NUMBER OF CHARACTERS TO 0 MVI A,1 ANA A LIIN1 PUSH D ;SAVE IT PUSH H ;SAVE ADDRESS PUSH PSW ;SAVE FLAGS MOV C,A ;SAVE IN C LDA CATV ;SEE IF THIS IS FOR CASSETTE ANA A ;SET FLAGS JNZ LIIN2 ;SURE IS POP PSW ;RESTORE FLAGS CALL KYIN ;GET A CHARACTER FROM KEYBOARD LIIN3 CPI 7FH ;CHECK FOR A RUBOUT POP H ;RESTORE ADDRESS POP D ;RESTORE NUMBER OF CHARACTERS JZ LIIN4 ;IT WAS CPI 1 ;CHECK FOR FLAG CODE JZ LIZZZ ;SURE WAS CPI 3 ;CHECK FOR CONTROL C PUSHED JZ RUN2 ;YUP, SO TERMINATE ANY RUN MODE CPI 0DH ;CHECK FOR A CARRIAGE RETURN JZ LIIN5 ;IT WAS CPI 15H ;CHECK FOR CONTROL U JZ LII00 ;SURE WAS CPI 9 ;CHECK FOR TAB JZ LIZZZ ;SURE IS CPI 20H ;CHECK FOR OTHER CONTROL CHARACTERS JC LII20 ;SURE IS LIZZZ MOV M,A ;STORE THE CHARACTER INX H ;UPDATE THE INDEX INX D ;UPDATE NUMBER OF CHARACTERS LDA CATV ;CHECK FOR CASSETTE MODE ANA A ;SET FLAGS JNZ LIIN6 ;IT IS DCX H ;GET CHARACTER ADDRESS MOV A,M ;GET CHARACTER INX H ;BUMP INDEX UP PUSH D PUSH H ;SAVE ADDRESS LIIN7 CALL TOUT ;ECHO IT POP H ;RESTORE ADDRESS POP D LIIN6 ORI 1 ;CLEAR CARRY AND ZERO FLAGS JMP LIIN1 ;LOOP FOR MORE CHARACTERS LIIN2 POP PSW ;RESTORE FLAGS CALL CAIN ;GET A CHARACTER FROM THE CASSETTE JMP LIIN3 ;CONTINUE PROCESSING LIIN4 DCX H ;BACK UP ONE DCX D ;DECREMENT NUMBER OF CHARACTERS JMP LIIN7-2 ;SENT THE RUBOUT CODE LIIN5 DCX H ;BACK UP TO MARK THE LAST CHARACTER MOV A,D ;CHECK FOR NO INPUT ORA E JNZ LIINW ;THERE IS SOME INPUT STC RC ;RETURN IF NO CHARACTERS WERE INPUT LIINW MOV A,M ;GET THE LAST CHARACTER CPI 5CH ;CHECK FOR A BACKSLASH JZ LII68 ;SURE WAS ORI 80H ;SET THE UPPER BIT MOV M,A ;STUFF IT BACK INX H ;GET NEXT POSITION MVI M,0 ;CLEAR IT LDA CATV ;CHECK FOR CASSETTE MODE ANA A ;SET FLAGS RNZ CALL CRLF ;SEND A CARRIAGE RETURN XRA A ;CLEAR CARRY RET ;DONE... LII00 MOV A,D ;CHECK FOR BEING AT FIRST CHARACTER ORA E JZ LIIN6 ;SURE WAS MVI A,7FH ;SEND THE RUBOUT PUSH H ;SAVE IT ALL PUSH D CALL TOUT POP D ;RESTORE POP H DCX D ;UPDATE COUNT DCX H JMP LII00 ;DO IT AGAIN * RTN. C.11 * SEND CARRIAGE RETURN CRLF MVI A,0DH ;GET CARRIAGE RETURN CODE CALL TOUT ;SEND IT RET ;DONE.... * RTN. C.12 * INITIALIZE I/O SECTION INIO CALL CRLF ;INITIALIZE ALL POSITIONS XRA A ;SET CARRY, CLEAR ZERO SUI 1 CALL CAIN ;SHUT OFF ANY CASSETTE INPUT XRA A ;SET CARRY, CLEAR ZER SUI 1 CALL COUT ;SHUT OFF ANY CASSETTE OUTPUT XRA A ;INITIALIZE THE BINARY PORTS SUI 1 CALL BPORT XRA A SUI 1 CALL BINPOR RET ;DONE. * RTN. C.13 * LINE INPUT FROM KEYBOARD * IN: HL=FIRST ADDRESS TO STORE CODE * OUT: CARRY SET IF NO CHARACTERS INPUTTED LIKY XRA A ;CLEAR CATV STA CATV JMP LIIN ;DO IT * RTN. C.14 * LINE INPUT FROM CASSETTE * IN: HL= FIRST ADDRESS TO STORE CODE * OUT: CARRY SET IF NO CHARACTERS INPUTTED LICA MVI A,0FFH ;SET CATV STA CATV JMP LIIN ;DO IT SMST DW 0 SMEN DW 0 * RTN. C.5 * CASSETTE INPUT BYTE * CARRY AND ZERO FLAGS MUST BE PROPERLY SET UP * CARRY FOR LAST BYTE * ZERO FOR FIRST BYTE CAIN PUSH PSW ;SAVE FLAGS MVI A,4 ;CODE FOR CASSETTE INPUT LXI B,1 ;CHANNEL TO START SEARCHING AT CALL MFND ;FIND THE CASSETTE CHANNEL POP PSW ;FLAGS BACK CALL CAIN2 ;GET A BYTE MVI B,23H ;ERROR CODE JUST IN CASE JC ERROR ;TAPE ERROR RET ;DONE... CAIN2 PCHL TOUTZ XRA A ;CLEAR POSIT STA POSIT JMP TOUTX TOUTY LDA POSIT ;DECREMENT POSIT DCR A STA POSIT JMP TOUTX LII20 MVI A,1 ;CLEAR FLAGS ANA A JMP LIIN1 ;GET ANOTHER INPUT LII68 MVI A,0DH ;GET CR CODE BACK INX H ;UPDATE THE INDEX JMP LIIN7-2 ;ECHO IT AND GET ANOTHER * MODS MODULE * RTN. M.1 * EDIT COMMAND EXECUTIVE EDIT LHLD FSRC ;INITILIZE EDITED LINE POINTER SHLD EDLNP XRA A ;SET ENTER MODE STA CMND CALL GLFC ;LOOK FOR PARAMETER JC SPRAT ;NO PARAMETER XCHG ;OFFSET TO HL SHLD EDITO ;SAVE IT MOV H,B ;BC TO HL MOV L,C SHLD EDITS ;SAVE THE SYMBOL NUMBER EDITJ LHLD EDITS ;GET THE SYMBOL NUMBER MOV C,L ;TO BC MOV B,H LHLD EDITO ;GET THE OFFSET XCHG ;TO DE CALL LILO ;FIND THE LINE SHLD EDLNP ;GET THE POINTER EDITA LHLD ESRC LXI D,300 DAD D MVI M,80H ;STORE FAKEOUT FLAGS INX H MVI M,80H INX H SHLD DMPMM ;STORE DUMP TO MEMORY FLAG LHLD EDLNP ;EDITED LINE POINTER CALL DMST ;DUMP THE STATEMENT OUT LHLD DMPMM ;SET THE LAST BIT DCX H MOV A,M ORI 80H MOV M,A LXI H,0 ;CLEAR THE DUMP MEMORY FLAG SHLD DMPMM EDITH LHLD ESRC ;SET EDITING FLAGS LXI D,302 DAD D SHLD LLST SHLD FLST SHLD TMP9 EDITD LXI H,0 ;INPUT A COMMAND SHLD TMP1 ;N=0 EDITB CALL KYIN ;GET A CHARACTER CPI 7FH ;IS IT A RUBOUT?? JZ EDITD ;YUP, SO START OVER ON THE COMMAND CPI 3AH ;IS IT A DIGIT JNC EDITC ;NOPE CPI 30H ;CHECK AGAIN JC EDITC ;FOR SURE ANI 0FH ;STRIP OF ASCII BITS MVI B,10 ;MULTIPLY TMP1 BY TEN LHLD TMP1 ;GET OLD N XCHG ;TO DE LXI H,0 ;CLEAR HL EDITZ DAD D ;ADD DCR B ;CHECK FOR DONENESS JNZ EDITZ CALL ADHL ;ADD THE NEW DIGIT SHLD TMP1 ;STORE IT JMP EDITB ;GET ANOTHER ONE EDITC LXI B,17 ;NUMBER OF COMMAND TYPES LXI H,EDITY ;COMMAND TABLE CALL SRC8 ;SEARCH FOR THE COMMAND JNZ EDITE ;NOT A COMMAND, ROCK! PUSH B ;SAVE COMMAND NUMBER LHLD TMP1 ;CHECK FOR N=0 MOV A,H ORA L JNZ EDITX ;NOPE INX H EDITX SHLD TMP1 ;OK LHLD ESRC ;GET PLACE TO STORE PARAMETER STRING MVI M,80H ;STORE THE FAKEOUT FLAGS INX H MVI M,80H MOV A,C ;CHECK COMMAND NUMBER OUT CPI 3 JZ EDITG CPI 4 JZ EDITG CPI 5 JZ EDITG CPI 12 JNZ EDI45 EDITG PUSH H ;SAVE ADDRESS CALL KYIN ;GET A CHARACTER POP H ;GET ADDRESS BACK CPI 7FH ;IS IT A RUBOUT? POP B ;RESTORE STACK JZ EDITD ;YUP, SO START OVER AGAIN PUSH B ;BACK DOWN, BOY! CPI 0DH ;IS IT A CARRIAGE RETURN? JZ EDITF ;YUP, SO COMMAND IS FINISHED MOV M,A ;NO, SO STORE THE CHARACTER INX H ;UPDATE THE INDEX JMP EDITG ;GO GET ANOTHER ONE EDITF DCX H ;SET UPPER BIT ON LAST CHARACTER MOV A,M ORI 80H MOV M,A EDI45 POP B ;GET BACK COMMAND NUMBER LXI H,EDITW-2 ;COMMAND ADDRESS TABLE DAD B ;ADD OFFSET DAD B MOV E,M ;GET THE ADDRESS OUT INX H MOV D,M XCHG ;TO HL LXI D,EDITD ;SET UP RETURN ADDRESS PUSH D PCHL ;GOTO PROCESSOR EDITE MVI A,'?' ;PRINT A QUESTION MARK CALL TOUT ;TO INDICATE AN ILLEGAL COMMAND CALL PSSU ;PRINT LINE UNTIL POINTER JMP EDITD ;GET ANOTHER COMMAND EDITY DB 'U' DB 'D' DB 'I' DB 'C' DB 'S' DB 'Q' DB 'R' DB 'K' DB 'F' DB 'B' DB 'A' DB 'M' DB 'L' DB 'T' DB 20H DB 'X' DB 'P' EDITW DW PSSU DW PSSD DW PSSI DW PSSC DW PSSS DW PSSQ DW PSSR DW PSSK DW PSSF DW PSSB DW PSSA DW PSSM DW PSSL DW PSST DW PSSZ DW PSSX DW PSSP EDIT1 PUSH PSW ;SAVE REGISTERS PUSH H LHLD DMPMM ;GET INDEX PUSH PSW MOV A,H ;SEE IF IT'S ZERO ORA L JZ EDXT11 ;SURE IS POP PSW CPI 0DH ;CHECK FOR CARRIAGE RETURN JZ EDOT12 ;SURE WAS, SO IGNORE IT MOV M,A ;STORE THE CHARACTER INX H ;UPDATE THE INDEX SHLD DMPMM ;SAVE IT EDOT12 POP H ;RESTORE REGISTERS POP PSW RET ;DONE EDXT11 POP PSW JMP EDOT12 EDIT4 MOV A,D ;DE = 0 ORA E RZ ;YUP, SO WE ARE DONE PUSH H ;SAVE INDEXES PUSH D MOV A,M ;GET A CHARACTER ANI 7FH ;STRIP ANY STROBE CALL TOUT ;PRINT IT POP D ;RESTORE INDEXES POP H INX H ;UPDATE DCX D JMP EDIT4 ;TRY AGAIN EDIT5 LHLD TMP1 DCX H SHLD TMP1 MOV A,H ORA L RET EDIT6 LHLD FLST CALL COUNT ;CHECK FOR POINTER OVERFLOW DAD D XCHG LHLD LLST CALL CMP16 ;CHECK IT OUT RC ;IT'S OKAY XCHG ;FIX IT DCX H SHLD LLST RET ;DONE. PSSK LHLD FLST ;GET FIRST CHARACTER POSITION MVI M,0A0H ;STORE A SPACE, END SHLD LLST ;POINTER SET JMP PSSI1 ;INSERT MODE PSSU MVI A,0DH ;PRINT A CARRIAGE RETURN CALL TOUT ;SEND IT LHLD FLST ;COMPUTE NUMBER OF CHARACTERS TO SEND XCHG LHLD LLST CALL SUB16 XCHG ;RESULT TO DE LHLD FLST ;GET FIRST CHARACTER TO DUMP CALL EDIT4 ;DUMP 'EM RET ;DONE PSSD MVI A,5CH ;DUMP A BACKSLASH CALL TOUT PSSD4 LHLD LLST ;COUNT REMAINING CHARACTERS CALL EDIT6 ;CHECK FOR OVERRUN OF POINTER CALL COUNT LXI H,1 ;IS IT ONE? CALL CMP16 JZ PSSD1 ;YUP LHLD LLST ;GET CHARACTER TO DELETE PUSH D ;SAVE COUNT PUSH H ;SAVE ADDRESS MOV A,M ;GET THE CHARACTER CALL TOUT ;DUMP IT POP D ;GET BACK THE ADDRESS POP B ;GET BACK THE COUNT DCX B ;CORRECT MOV L,E ;ADDRESS TO HL MOV H,D INX H ;GET ADDRESS PLUS ONE MOV A,C ;CHECK FOR COUNT OF 0 ORA B JZ PSSD8 ;SURE IS CALL MOVE ;MOVE 'EM DOWN PSSD2 CALL EDIT5 ;DECREMENT N JNZ PSSD4 ;DO IT AGAIN MVI A,5CH ;DUMP ANOTHER BACKSLASH CALL TOUT RET ;ALL DONE PSSD1 LHLD LLST ;POINTER = FIRST CHARACTER? XCHG ;TO DE LHLD FLST CALL CMP16 ;CHECK THEM JZ PSSD3 ;SURE WERE THE SAME XCHG ;LLST TO HL MOV C,M ;CHARACTER TO C DCX H ;SET NEW LAST CHARACTER MOV A,M ORI 80H MOV M,A INX H SHLD LLST ;NEW POINTER MOV A,C ;GET THE CHARACTER ANI 7FH ;STRIP THE STROBE CALL TOUT ;PRINT IT JMP PSSD2 ;CONTINUE PSSD3 XCHG ;LLST TO HL MOV A,M ;CHECK THE CHARACTER THERE CPI 80H JZ PSSD2 ;NONE LEFT! MVI M,80H ;SET AN 80 IN ANI 7FH ;STRIP ANY STROBE CALL TOUT ;PRINT IT JMP PSSD2 ;CONTINUE PSSS LHLD LLST ;SET SEARCH FLAG UP SHLD TMP2 CALL EDIT6 ;CHECK FOR POINTER OVERRUN LHLD ESRC ;CHECK FOR ANY INPUT INX H MOV A,M CPI 80H RZ ;NO INPUT, SO NO SEARCH PSSS4 LHLD ESRC ;INITIALIZE INDEXES XCHG ;TO DE INX D ;CORRECT TO GET PAST FAKEOUT LHLD TMP2 PSSS3 MOV A,M ;GET A CHARACTER ANI 7FH ;STRIP STROBE OFF MOV B,A ;TO B LDAX D ;GET A CHARACTER ANI 7FH ;STRIP THE STROBE CMP B ;THE SAME? JNZ PSSS1 ;NOPE LDAX D ;CHECK FOR END OF SEARCH STRING ANA A JM PSSS2 ;SURE IS, SO WE'VE GOT A FIND MOV A,M ;CHECK FOR END STRUCK ANA A JM PSSS1 ;SURE DID INX D ;UPDATE INDEXES INX H JMP PSSS3 ;TRY ANOTHER CHARACTER PSSS1 LHLD TMP2 ;UPDATE INPUT STRING TRY POSITION PUSH H ;SAVE ADDRESS MOV A,M ;GET A BYTE CALL TOUT ;PRINT IT POP H ;RESTORE ADDRESS MOV A,M ;CHECK FOR END ANA A JM PSSS5 ;SURE IS INX H SHLD TMP2 JMP PSSS4 ;TRY AGAIN! PSSS2 CALL EDIT5 ;DECREMENT N JNZ PSSS1 ;MORE TO GO LHLD TMP2 ;SET POINTER SHLD LLST RET ;DONE. PSSI CALL PSSS ;PERFORM SEARCH FIRST PSSI1 CALL KYIN ;GET A CHARACTER CPI 0DH ;IS IT A CARRIAGE RETURN JZ PSSID ;DONE CPI 7FH ;IS IT A RUBOUT JZ PSSI2 ;SURE WAS PUSH PSW ;SAVE THE CHARACTER CALL EDIT6 ;CHECK FOR POINTER OVERRUN JC PSSI9 ;NOPE MOV A,M ;GET LAST CHARACTER ANI 7FH ;STRIP THE STROBE MOV M,A INX H ;SET IN THE FAKEOUT MVI M,80H SHLD LLST PSSI9 LHLD LLST ;COUNT CHARACTERS REMAINING CALL COUNT MOV C,E MOV B,D MOV E,L MOV D,H INX D CALL MOVE XCHG ;FIND THE LAST CHARACTER DAD B DCX H MOV A,M ;GET IT CPI 80H ;IS IT A FAKEOUT? JNZ PSSI7 ;NOPE DCX H ;SURE WAS MOV A,M ;SET UPPER BIT ORI 80H MOV M,A PSSI7 XCHG ;HL BACK TO NORMAL POP PSW ;RESTORE CHARACTER MOV M,A ;STUFF IT IN CALL TOUT ;ECHO IT LHLD LLST ;UPDATE THE POINTER INX H SHLD LLST JMP PSSI1 PSSI2 LXI H,1 ;SET UP N SHLD TMP1 LHLD LLST ;FIX THE POINTER DCX H ;BACK UP SHLD LLST MOV A,M ;CHECK FOR A FAKEOUT CPI 80H JNZ PSSI8 ;NOPE DCX H SHLD LLST MOV A,M ORI 80H ;SET END UP MOV M,A PSSI8 CALL PSSD ;KILL ONE JMP PSSI1 ;CONTINUE PSSD8 XCHG ;TO HL DCX H ;GET LAST CHARACTER MOV A,M ;SET UPPER BIT ORI 80H MOV M,A JMP PSSD2 ;CONTINUE PSSC CALL PSSS ;FIND THE STRING LHLD ESRC ;FIND OUT HOW MANY CHARACTERS INX H CALL COUNT ;COUNT 'EM XCHG SHLD TMP1 ;SAVE AS N CALL PSSD ;DELETE THAT MANY JMP PSSI1 ;GO TO INSERT MODE PSSQ MVI A,0FFH ;SET COMMAND MODE STA CMND JMP RSTRT ;BACK TO COMMAND LEVEL EDIT2 LHLD INSR ;SET UP FOR DELETION SHLD FLST SHLD LINE ;SET UP LINE FLAG SHLD LLST JMP DLTE1 ;DELETE IT PSSR CALL PSSP ;PRINT THE PRESENT LINE LHLD FLST ;STORE A BLANK AT THE END CALL COUNT DAD D MVI M,0 LHLD FRAV ;SET UP CODED LINE START MVI A,0FFH ;SET UP EDIT MODE STA EDITM SHLD SLIN LHLD EDLNP ;SET UP INSERTION POINT SHLD INSR XRA A ;CLEAR ESCN STA ESCN LHLD TMP9 ;SET UP FOR LINE DECODING DCX H JMP EXE77 ;DECODE AND ENTER THE LINE PSSP MVI A,0DH ;PRINT A CR CALL TOUT LHLD FLST ;START OF LINE CALL MSGER ;PRINT IT MVI A,0DH ;PRINT A CR CALL TOUT LHLD FLST ;RESET POINTER SHLD LLST RET ;DONE. PSSF LHLD TMP1 ;GET N XCHG ;TO DE LHLD EDITO ;GET OFFSET DAD D ;ADD IT UP SHLD EDITO ;SAVE NEW OFFSET POP H ;CLEAN UP THE STACK XRA A ;CLEAR EDIT MODE STA EDITM JMP EDITJ ;NEW LINE PSSB LHLD TMP1 ;GET N XCHG ;TO DE LHLD EDITO ;GET OFFSET CALL SUB16 ;BACK UP SHLD EDITO ;SAVE NEW OFFSET POP H ;CLEAN UP THE STACK JMP EDITJ ;NEW LINE PSSA CALL EDIT6 ;GET POINTER CALL MSGER ;SEND IT OUT LHLD FLST ;FIND END OF LINE CALL COUNT DAD D INX H ;CORRECT SHLD LLST ;SET POINTER CALL PSSI1 ;INSERT AT END RET ;DONE PSSM LHLD ESRC ;SET UP SCAN FLAGS SHLD NSCN XRA A STA ESCN CALL USCN ;SCAN OFF FAKEOUT POP H ;CLEAN UP THE STACK JMP EDIT ;MOVE TO THE NEW LINE PSSL MVI A,0DH ;DUMP A CR CALL TOUT PSSL1 CALL EDIT5 ;DECREMENT N JZ PSSL2 ;ALL DONE LHLD EDLNP ;DUMP STATEMENT AT POINTER CALL DMST LHLD EDITO ;GET OFFSET INX H ;INCREMENT IT SHLD EDITO XCHG ;TO DE LHLD EDITS ;GET SYMBOL NUMBER MOV C,L ;TO BC MOV B,H CALL LILO ;FIND THE LINE SHLD EDLNP XCHG LHLD ESRC ;SEE IF WE ARE DONE XCHG CALL CMP16 JNC PSSL2 ;DONE (END OF SOURCE) JMP PSSL1 ;GET ANOTHER LINE PSSL2 POP H ;CLEAN UP THE STACK JMP EDITA ;INTO EDIT MODE PSST CALL EDIT6 ;CHECK FOR OVERRUN CALL MSGER ;PRINT IT JMP PSSU ;PRINT UP TO POINTER PSSZ CALL EDIT6 ;GET POINTER MOV A,M ;GET THE CHARACTER INX H ;INCREMENT POINTER SHLD LLST CALL TOUT ;DUMP THE CHARACTER CALL EDIT5 ;CHECK FOR DONENESS JNZ PSSZ ;NOPE RET ;DONE PSSX CALL EDIT6 ;CHECK FOR OVERRUN XCHG ;TO DE LHLD FLST ;CHECK FOR NO BACKUP CALL CMP16 RZ ;DAT'S RIGHT FOLKS DCX D XCHG ;GET LAST CHARACTER MOV A,M SHLD LLST ;NEW POINTER CALL TOUT ;PRINT IT CALL EDIT5 ;CHECK FOR DONENESS JNZ PSSX RET ;ALL DONE PSSS5 MVI A,'?' ;PRINT A QUESTION MARK CALL TOUT CALL PSSP ;PRINT THE LINE POP H ;CLEAN UP THE STACK JMP EDITH ;TRY AGAIN PSSID LHLD LLST ;CHECK FOR 80 AT END MOV A,M CPI 80H RNZ ;NOPE, SO ALL'S WELL DCX H ;STRIP IT MOV A,M ORI 80H MOV M,A RET ;DONE. EDI96 JMP RSTRT ;DONE * INPUT TRANSLATOR MODULE * RTN. D.1 * FIND SYMBOL IN SYMBOL TABLE AND DIRECTORY * IN: HL POINTS TO NAME TO FIND * OUT: ZERO CLEARED, SYMBOL IS NOT IN SYMBOL TABLE * ZERO SET, SYMBOL IS IN THE SYMBOL TABLE, AND * HL = SYMBOL POINTER * DE = POINTS TO SYMBOL ID BYTE * BC = SYMBOL NUMBER * A = SYMBOL ID BYTE SSRC XCHG ;FREE HL LHLD SNUM ;GET NUMBER OF SYMBOLS IN TABLE MOV B,H ;PUT IT IN BC MOV C,L LHLD STAB ;GET START OF SYMBOL TABLE XCHG ;PUT 'EM IN THE RIGHT REGISTERS CALL STSRH ;SEARCH THE SYMBOL TABLE RNZ ;NO FIND EXIT * RTN. D.2 * FIND SYMBOL DIRECTORY ENTRY * IN: BC = SYBMOL NUMBER * OUT: HL = SYMBOL POINTER * DE = POINTS TO SYMBOL ID BYTE * BC = SYMBOL NUMBER * A = SYMBOL ID BYTE DFND LHLD SDIR ;GET START OF SYMBOL DIRECTORY LDA RURD ANA A ;READY TO RUN? JNZ DFND2 ;YUP LDA RUNF ;ARE WE RUNNING ANA A JZ DFND2 ;NOPE MVI B,26H JMP ERROR DFND2 DAD B ;HL=HL+BC*3 DAD B DAD B DCX H ;GET ADDRESS OF ID BYTE PUSH H ;SAVE IT DCX H ;GET ADDRESS OF POINTER MSD MOV D,M ;PUT IT IN D DCX H ;GET ADDRESS OF POINTER LSD MOV E,M ;PUT IT IN E POP H ;GET BACK ID BYTE ADDRESS MOV A,M ;PUT IT IN A XCHG ;POINTER TO HL PUSH D ;SAVE ADDRESS MOV D,A ;SAVE A XRA A ;SET ZERO FLAG MOV A,D ;RESTORE A POP D ;RESTORE ADDRESS RET ;DONE.... * RTN. D.3 * INSERT SYMBOL IN SYMBOL TABLE AND DIRECTORY * IN: HL = POINTER TO SYMBOL NAME * OUT: BC = SYMBOL NUMBER * HL = POINTER TO SYMBOL ID BYTE ITAB CALL COUNT ;COUNT CHARACTERS IN NAME LDA CMND ;CHECK FOR COMMAND MODE ANA A ;SET FLAGS MVI B,18H ;SET ERROR TYPE JUST IN CASE JNZ ERROR ;WHOSE THE STONE THAT TRIED THIS?? PUSH H ;SAVE ADDRESS AND NUMBER OF CHARACTERS PUSH D INX D ;DE=DE+3 INX D INX D LHLD SDIR ;GET START OF DIRECTORY PUSH H ;SAVE IT CALL SUB16 ;COMPUTE NEW START PUSH H ;SAVE IT LHLD SDIR ;HL=(STAB)-(SDIR) XCHG LHLD STAB CALL SUB16 MOV B,H ;NUMBER OF BYTES IN DIRECTORY TO BC MOV C,L POP D ;GET BACK DESTINATION POP H ;GET BACK START OF DIRECTORY CALL MOVE ;MOVE IT BACK XCHG ;NEW SDIR TO HL SHLD SDIR ;STUFF IT IN LHLD STAB ;GET START OF SYMBOL TABLE POP D ;GET NUMBER OF CHARACTERS IN SYMBOL PUSH D ;SAVE IT CALL SUB16 ;COMPUTE NEW SYMBOL TABLE START PUSH H ;SAVE IT DAD D ;GET STAB BACK XCHG ;TO DE LHLD MEND ;GET END OF USEABLE MEMORY CALL SUB16 ;COMPUTE NUMBER OF BYTES IN SYMBOL TABLE INX H ;CORRECT MOV B,H ;STICK IT IN BC MOV C,L POP D ;GET BACK NEW START OF SYMBOL TABLE LHLD STAB ;GET OLD START CALL MOVE ;MOVE IT DOWN XCHG ;NEW START TO HL SHLD STAB ;STUFF IT IN POP D ;GET BACK NUMBER OF CHARACTERS LHLD MEND ;END OF USEABLE MEMORY CALL SUB16 ;COMPUTE LOCATION OF NEW SYMBOL INX H ;CORRECT XCHG ;TO DE MOV B,H ;BC=HL MOV C,L POP H ;GET BACK SYMBOL LOCATION CALL MOVE ;PUT IT IN THE SYMBOL TABLE LHLD SNUM ;GET NUMBER OF SYMBOLS INX H ;UPDATE IT SHLD SNUM ;STICK IT BACK MOV B,H ;BC=HL MOV C,L LHLD STAB ;GET FIRST ADDRESS OF SYMBOL TABLE DCX H ;GET NEW SYMBOL ID BYTE MVI M,0 ;CLEAR IT OUT XRA A ;CLEAR RURD STA RURD RET ;DONE. * RTN. D.4 * UPSCAN IN INPUT LINE * UPDATES TSCN AND NSCN * IF CARRY SET ON EXIT, THERE IS NO MORE DATA IN * THIS INPUT LINE. USCN LDA ESCN ;CHECK FOR NO MORE DATA CPI 2 ;CHECK FOR DONENESS STC ;SET CARRY JUST IN CASE RZ ;RETURN IF END OF LINE AND NO MORE DATA LHLD NSCN ;GET NEXT SCANOFF START SHLD TSCN ;STUFF IT INTO THIS SCANOFF START CPI 1 ;COMPARE JNZ USCNA ;IT'S NOT INX H ;UPDATE NSCN SHLD NSCN INR A ;IT IS STA ESCN ;SET ESCN TO 2 TO INDICATE THE FACT RET ;DONE USCNA MOV A,M ;GET A CHARACTER INX H ;UPDATE INDEX ANA A ;SET FLAGS JP USCNA ;LOOP TO TRY AGAIN MVI C,0 ;CLEAR THE CHARACTER COUNTER USCN2 MOV A,M ;GET A CHARACTER ANA A ;SET FLAGS SHLD NSCN ;KEEP NSCN UP TO DATE JM USCN3 ;OH, OH, THIS IS THE END OF THE LINE CPI 20H ;IS THIS A SPACE? JNZ USCN4 ;NOPE INX H ;GET NEXT CHARACTER AND IGNORE SPACE JMP USCN2 ;TRY AGAIN USCN4 SHLD NSCN ;SAVE THE NEXT SCANOFF START USCN1 MOV A,M ;GET A CHARACTER ANI 7FH ;STRIP OFF UPPER BIT CPI '$' ;IS IT A DOLLAR SIGN? JZ USCN7 ;YUP CPI 30H ;CHECK FOR NUMERIC JM USCN5 ;NOPE CPI 7BH ;CHECK FOR LOWER CASE JP USCN5 ;NOPE CPI 61H ;CHECK AGAIN JP USCN7 ;YUP CPI 'Z'+1 ;CHECK FOR ALPHABETIC JP USCN5 ;NOPE CPI 'A' ;CHECK AGAIN FOR ALPHABETIC JP USCN7 ;SURE IS CPI '9'+1 ;CHECK AGAIN FOR NUMERIC JP USCN5 ;MISSED OUT USCN7 MOV A,M ;GET THE BYTE BACK ANA A ;SET FLAGS JM USCN3 ;END OF THE LINE, BUDDY INX H INR C ;UPDATE CHARACTER COUNTER JMP USCN1 ;LOOP FOR MORE OF THEM USCN5 DCR C ;C=0? DCX H ;JUST IN CASE JP USCN6 ;NOPE INX H ;BACK TO NORMAL MOV A,M ;GET THE BYTE BACK ANA A ;SET FLAGS JM USCN3 ;END OF THE LINE, FOLKS CALL USCNO ;CHECK FOR POSSIBLE DOUBLE JNZ USCN6 ;NOT POSSIBLE INX H ;CHECK FURTHER MOV A,M ;GET IT CALL USCNO ;CHECK IT JZ USCN6 ;DOUBLE DCX H ;BACK TO NORMAL USCN6 MOV A,M ;GET THE CHARACTER ORI 80H ;SET THE UPPER BIT MOV M,A ;STICK IT BACK XRA A ;CLEAR CARRY RET USCN3 MVI A,1 ;SET ESCN STA ESCN MOV A,M ;GET LAST BYTE CPI 0A0H ;CHECK FOR A SPACE JZ USCNJ ;YUP XRA A ;CLEAR CARRY RET USCNJ MVI A,2 ;SET ESCN TO INDICATE NO MORE STA ESCN RET * RTN. D.5 * BACKSCAN INPUT LINE * SETS TSCN AND NSCN BSCN LDA ESCN ;CHECK END SCAN FLAG ANA A ;SET FLAGS JNZ BSCN1 ;DON'T CLEAR THE UPPER BIT LHLD NSCN ;GET NEXT SCAN FLAG BSCN3 MOV A,M ;GET A CHARACTER ANA A ;SET FLAGS JM BSCN2 ;FOUND IT INX H ;GET NEXT CHARACTER LOCATION JMP BSCN3 ;TRY AGAIN BSCN2 ANI 7FH ;CLEAR THE UPPER BIT MOV M,A ;STUFF IT BACK BSCN1 LHLD TSCN ;NSCN=TSCN SHLD NSCN MVI C,2 ;SET UP COUNTER BSCN4 DCX H ;GET LAST CHARACTER MOV A,M ;GET A CHARACTER, STUPID. ANA A ;SET FLAGS JP BSCN4 ;TRY AGAIN DCR C ;FIND TWO YET? JNZ BSCN4 ;NOPE BSCN5 INX H ;GET NEXT CHARACTER MOV A,M ;GET THE CHARACTER CPI 20H ;IS IT A SPACE????? JZ BSCN5 ;YUP, SO TRY AGAIN SHLD TSCN ;STORE NEW TSCN LDA ESCN ;CHECK END FLAG OUT RRC ANI 1 STA ESCN RET ;DONE.. * RTN. D.6 * GET SYMBOL NUMBER * IN: HL = LABEL START * A = ID BYTE FOR TYPE DESIRED * OUT: BC = SYMBOL NUMBER * CARRY SET IF ID BYTE WAS WRONG * A = ID BYTE GTNM PUSH PSW ;SAVE PARAMETERS PUSH H CALL SSRC ;SEARCH THE SYMBOL TABLE JNZ GTNM1 ;OH, OH, WE'LL HAVE TO INSERT IT POP H ;GET BACK PARAMETERS POP D CMP D ;SEE IF ID BYTES ARE THE SAME RZ ;SURE WERE STC ;FLAG THE FACT RET GTNM1 POP H ;GET BACK SYMBOL ADDRESS CALL ITAB ;INSERT IN SYMBOL TABLE POP PSW ;GET BACK ID BYTE MOV M,A ;STORE IT DCX H ;CLEAR THE POINTER OUT MVI M,0 DCX H MVI M,0 ANA A ;CLEAR CARRY RET ;DONE... * RTN. D.7 * LEGAL LABEL CHECK * CHECKS THIS SCAN OFF AS A LABEL * IF ILLEGAL, EXITS WITH CARRY SET * OTHERWISE, CARRY IS CLEARED LGLB LHLD TSCN ;GET THIS SCAN ADDRESS MOV A,M ;GET A CHARACTER ANI 7FH ;STRIP OFF UPPER BIT CPI 7BH ;IS IT BIGGER THAN LOWER CASE? JNC LGLB1 ;YUP CPI 61H ;IS IT LOWER CASE? JNC LGLB2 ;YUP CPI 'Z'+1 ;IS IT BIGGER THAN ALPHABETIC? JP LGLB1 ;YUP CPI 'A' ;IS IT ALPHABETIC? JP LGLB2 ;YUP CPI '9'+1 ;IS IT BIGGER THAN NUMERIC? JP LGLB1 ;YUP CPI '0' ;IS IT NUMERIC JP LGLB2 ;YUP LGLB1 STC ;ILLEGAL EXIT LGLB2 RET ;DONE. * RTN. D.8 * LEGAL NUMBER CHECK * IN: TSCN HAS LOCATION OF TRIAL NUMBER * OUT: CARRY SET IF THIS IS NOT A NUMBER * TMP10 HAS THE NUMBER TRANSLATED * NSCN IS SET TO NEXT CHARACTER AFTER NUMBER LGNM LHLD TSCN ;GET START OF TRIAL NUMBER MOV A,M ;GET FIRST CHARACTER ANI 7FH ;STRIP OFF UPPER BIT CPI '.' ;IS IT A PERIOD? JZ LGNM5 ;YUP CPI '9'+1 ;IS IT BIGGER THAN A NUMBER STC ;SET CARRY JUST IN CASE RP ;RETURN IF IT'S NOT A DIGIT CPI '0' ;SEE IF IT'S LESS THAN A DIGIT RC ;RETURN IF IT'S NOT A DIGIT LGNM5 LXI D,TMP10 ;GET PLACE TO PUT THE NUMBER CALL STNM ;CONVERT TO NUMBER (OR AT LEAST TRY) RC ;RETURN IF CONVERSION ERROR OCCURED DCX H ;CORRECT ADDRESS TO GET LAST CHARACTER IN NUMBER PUSH H ;SAVE ADDRESS CALL BSCN ;GET RID OF END FLAG CALL BSCN POP H ;RESTORE ADDRESS MOV A,M ;UPDATE END FLAG ANA A ;SET FLAGS JM LGNM3 ;JUMP IF END IS ALREADY REACHED ORI 80H MOV M,A SHLD NSCN ;UPDATE NEXT SCAN OFF ADDRESS CALL USCN ;GET ALL THE FLAGS RIGHT XRA A ;CLEAR CARRY RET ;DONE, LET'S GET OUT OF HERE LGNM3 CALL USCN ;SCAN OFF TILL END JNC LGNM3 ;LOOP FOR ANOTHER SCAN-OFF XRA A ;CLEAR CARRY RET ;DONE. * RTN. D.9 * PROCESS OPERATOR * ZERO SET IF IT WAS VALID OPERATOR * A = CODE FOR OPERATOR POPR LHLD TSCN ;GET SCAN START ADDRESS LXI D,OTBL ;OPERATOR TABLE ADDRESS LXI B,22 ;NUMBER OF OPERATOR TYPES CALL STSRH ;SEARCH TABLE JZ POPR1 ;OK, WE FOUND IT RNZ POPR1 MOV A,C ;GET THE ITEM NUMBER CPI 22 ;CHECK FOR "&" JZ POPRA ;SURE WAS CPI 19 ;CHECK FOR DUPLICATE RANGE JM POPR2 ;IT'S NOT SUI 15 ;MAKE IT RIGHT (MAYBE) CPI 6 ;SEE IF IT'S >< JNZ POPR2 ;NOPE INR A ;YUP INR A POPR2 ADI 0FH ;ADD OPCODE OFFSET CPI 18H ;CHECK FOR EQUAL SIGN JZ POPR5 ;YUP POPR6 MOV B,A ;SAVE THE CODE XRA A ;CLEAR CARRY, SET ZERO MOV A,B ;GET THE CODE BACK RET ;DONE!!!!!! POPR5 LDA OPFLG ;CHECK FOR A "LET" STATEMENT CPI 0A8H ;CHECK IT MVI A,18H ;GET REGULAR EQUALS SIGN BACK JNZ POPR6 ;FALSE ALARM MVI A,0FH ;CODE FOR ASSIGNMENT OPERATOR JMP POPR6 ;SEND IT POPRA MVI A,1AH ;GET + CODE RET ;DONE. USCNO CPI '>' ;CHECK THESE THINGS OUT RZ CPI '<' RZ CPI '=' RET ;DONE OTBL DB 'O' DB 'R'+80H DB 'A' DB 'N' DB 'D'+80H DB 'N' DB 'O' DB 'T'+80H DB '>' DB '='+80H DB '<' DB '='+80H DB '>'+80H DB '<'+80H DB '<' DB '>'+80H DB '='+80H DB '-'+80H DB '+'+80H DB '/'+80H DB '*'+80H DB '-'+80H DB 'N' DB 'O' DB 'T'+80H DB 0DEH DB '('+80H DB ')'+80H DB '=' DB '>'+80H DB '=' DB '<'+80H DB '>' DB '<'+80H DB '&'+80H * RTN. D.10 * LINE DESCRIPTOR PROCESSOR * PRODUCES STATEMENT NAME ON TRIAL DECODED STATEMENT, AND * OPTIONALLY, THE +- OFFSET EXPRESSION * ON RETURN, CARRY SET IF END OF LINE ENCOUNTERED PLDS CALL USCN ;SCAN OFF THE LABEL RC CALL LGLB ;CHECK LEGALITY OF LABEL MVI B,7 ;SET UP FOR ERROR 7 JC ERROR ;OH, OH, ILLEGAL LABEL MVI A,1 ;SET UP STATEMENT NAME ID LHLD TSCN ;GET LABEL ADDRESS CALL GTNM ;GET THE SYMBOL NUMBER PUSH B ;SAVE 'EM MVI B,9 ;SET UP FOR ERROR 9 JC ERROR ;OH, OH, TRYING TO USE A VARIABLE FOR A STATEMENT! POP B ;GET 'EM BACK LHLD SLIN ;GET ADDRESS TO STORE CONVERTED CODE MVI M,6 ;STORE IT ALL INX H MOV M,C INX H MOV M,B INX H MVI M,7 INX H SHLD SLIN ;SAVE THE NEW ADDRESS CALL USCN ;SCAN OFF A TOKEN RC ;END OF THE LINE, INSTEAD CALL POPR ;CHECK FOR AN OPERATOR FOLLOWING JZ PLDS1 ;AH, HA, AN OPERATOR PLDS2 ANA A ;CLEAR CARRY RET ;DONE. PLDS1 CPI 19H ;CHECK FOR A - JZ PLDS3 ;YUP CPI 1AH ;CHECK FOR A + JNZ PLDS2 ;NOPE PLDS3 CALL BSCN ;PUT IT ALL BACK LHLD SLIN ;STORE THE EXPRESSION OPCODE MVI M,8 ;DONE INX H ;UPDATE INDEX SHLD SLIN ;SAVE IT JMP EVEX ;PROCESS THE EXPRESSION FOLLOWING SPRAT MVI B,10H ;SYNTAX ERROR CODE JMP ERROR * RTN. D.11 * COMMA, COLON, REMARK, AND END OF LINE CHECKER FOR * STATEMENTS USING LISTS * OUT: CARRY SET IF END OF LINE * ZERO SET IF COMMA * JUMPS TO EXEC3 IF COLON * JUMPS TO PREM IF REMARK * JUMPS TO ERROR 10 (SYNTAX) IF ANYTHING ELSE CCRC CALL USCN ;SCAN OFF A TOKEN RC ;END OF LINE LHLD TSCN ;GET THE CHARACTER MOV A,M ;GOT IT CPI ','+80H ;SEE IF IT'S A COMMA RZ ;SURE WAS CPI ':'+80H ;SEE IF IT'S A COLON JZ CCRC1 ;YUP CPI 0ACH ;SEE IF IT'S A SINGLE QUOTE JZ PREM ;YES, SO PROCESS REMARK MVI B,10H ;GET A 10 FOR ERROR TYPE JMP ERROR ;GO GET IT CCRC1 CALL USCN ;SCAN OFF THE FIRST TOKEN OF NEXT STATEMENT JMP ENPR1 ;GO PROCESS IT * RTN. D.12 * PROCESS LINE DESCRIPTOR LIST * RETURNS WHEN END OF LINE IS REACHED * IF COLON ENCOUNTERED, RETURNS TO EXEC3 PLDL CALL PLDS ;SCAN OFF A LINE DESCRIPTOR RC ;END OF LINE CALL BSCN ;GET BACK THE COMMA CALL CCRC ;CHECK THE SEPARATOR RC ;END OF LINE JMP PLDL ;LOOP FOR ANOTHER LINE DESCRIPTOR * RTN. D.13 * REMARKS PROCESSOR * PROCESSES TEXT FOLLOWING EITHER "'" OR "REM" PREM LHLD NSCN ;GET FIRST SIGNIFICANT TEXT ADDRESS PUSH H ;SAVE IT LDA ESCN ;CHECK FOR REM ALONE PUSH PSW CALL BSCN ;BACK OFF, JACK MVI A,35H ;"'" OPCODE CALL ICBY ;INSERT IT POP PSW ;GET BACK FORMER ESCN CPI 2 ;IS IT REM ALONE? JNZ PREM2 ;NOPE POP D ;STORE FAKEOUT SPACE PUSH D MVI A,0A0H STAX D PREM2 POP D ;FIRST CHARACTER INDEX TO DE DCX D ;GET ONE LESS LHLD SLIN ;GET CONVERTED CODE ADDRESS MVI M,0 ;STORE ID BYTE FOR STRING PREM1 INX H ;UPDATE INDEXES INX D LDAX D ;GET CHARACTER MOV M,A ;STUFF IT IN MEMORY ANA A ;SET FLAGS JP PREM1 ;LOOP FOR MORE CHARACTERS INX H ;GET NEXT CODE LOCATION MVI M,1 ;MARK END OF STRING INX H ;GET NEXT ONE SHLD SLIN ;STUFF IT BACK RET ;DONE. * RTN. D.14 * EVALUATE INFIX EXPRESSION INTO REVERSE POLISH EXPRESSION * OUT: RETURNS WHEN END OF EXPRESSION DETECTED * ERROR EXIT (SYNTAX) OCCURS IF: * 1. AN ILLEGAL SYMBOL OR LABEL IS ENCOUNTERED * 2. A RIGHT PAREN WITHOUT A LEFT PAREN OCCURS * 3. TWO BINARY OPERATORS IN A ROW OCCUR * 4. THERE ARE MORE LEFT PARENS THAN RIGHT * 5. TWO LABELS, LITERALS, OR CONSTANTS OCCUR IN A ROW EVEX LHLD SLIN ;COMPUTE PLACE TO PUT STACK LDA RURD ;CHECK IF RUN READY ANA A JNZ EVE00 ;YUP XCHG LHLD SDIR CALL SUB16 MOV A,H ;RIGHT SHIFT HL INTO DE ANA A ;CLEAR CARRY RAR ;RIGHT SHIFT MOV D,A MOV A,L RAR MOV E,A LHLD SLIN DAD D ;GOT IT SHLD FARY ;SAVE IT EVE01 XCHG ;PUT IT IN DE LHLD SLIN ;GET PLACE TO PUT POLISH STRING LXI B,1 ;INITIALIZE THE COUNTERS MVI M,9 ;STORE THE EXPRESSION OPCODE INX H ;UPDATE SLIN EVEX1 PUSH B ;SAVE ALL THIS JUNK PUSH D PUSH H CALL USCN ;SCAN OFF A TOKEN JC EVEX2 ;RAN INTO END OF LINE CALL POPR ;CHECK FOR NORMAL OPERATOR JZ EVEX3 ;SURE IS CALL PFUN ;CHECK FOR INTRINSIC FUNCTION JZ EVEX3 ;YUP CALL SCCC ;CHECK FOR SEMICOLON OR COMMA JZ COMM ;IT WAS CALL PINT ;CHECK FOR AN INTERMEDIARY JZ EVEX2 ;YUP, SO END OF EXPRESSION LHLD TSCN ;GET THIS ADDRESS THEY'RE TALKIN' ABOUT MOV A,M ;GET THE CHARACTER CPI '"'+80H ;SEE IF IT'S A STRING LITERAL JZ EVEX4 ;SURE IS CALL LGNM ;IS IT A NUMBER? JNC EVEX5 ;YUP CALL LGLB ;IS IT A LABEL? JNC EVEX6 ;'PEARS TO BE.. MVI B,11H ;SET UP ERROR 11 JMP ERROR ;ILLEGAL VARIABLE NAME COMM CPI 0DH ;COMMA? JNZ COMM1 ;NOPE LDA OPFLG ;GET OPCODE CPI 80H ;ON....GOTO? MVI A,0DH ;GET COMMA BACK JNZ COMM1 ;NOPE CALL BSCN ;SCAN BACK ONE JMP EVEX2 ;DONE COMM1 POP H ;POP 'EM ALL POP D POP B PUSH PSW ;SAVE THE CODE COMM3 INR B ;STACK EMPTY? DCR B JZ COMM2 ;YUP LDAX D ;GET TOP OF STACK CPI 20H ;IS IT "("? JZ COMM2 ;YUP MOV M,A ;STORE IT INX D ;BUMP UP INDEXES INX H DCR B JMP COMM3 ;TRY FOR ANOTHER ONE EVE00 LHLD FARY JMP EVE01 COMM2 POP PSW ;GET CODE BACK MOV M,A ;STUFF IT IN INX H ;BUMP UP INDEX MVI C,1 ;SET OPERATOR LAST JMP EVEX1 EVEXQ POP H ;GET REGISTERS BACK POP D POP B MVI A,36H ;FUNCTION OPERATOR OPCODE DCX D ;PUSH ONTO STACK INR B STAX D PUSH B ;SAVE 'EM PUSH D PUSH H LHLD TSCN ;RESTORE INDEX MVI A,4 ;FUNCTION ID BYTE JMP EVEXY ;CONTINUE PROCESSING EVEX6 POP H ;GET 'EM BACK POP D POP B CALL EVEXG ;CHECK FOR TWO LABELS IN A ROW PUSH B ;SAVE 'EM ALL AGAIN PUSH D PUSH H LHLD TSCN ;GET ADDRESS OF THIS LABEL MOV A,M ;GET A CHARACTER CPI 'F' ;CHECK FOR AN F JNZ EVEXX ;NOPE INX H ;GET NEXT CHARACTER MOV A,M ;GET IT CPI 'N' ;CHECK FOR AN N DCX H ;RESTORE INDEX JZ EVEXQ ;YUP, WE'VE GOT AN FN(XXX) EVEXX CALL USCN ;CHECK FOR "(" ON NEXT TOKEN JC EVEXZ ;OOPS, RAN INTO THE END CALL BSCN ;SCAN BACK LHLD NSCN ;GET ADDRESS OF NEXT TOKEN MOV A,M ;GET IT CPI '('+80H ;CHECK IT JNZ EVEXZ ;NOPE LHLD TSCN ;TIME TO CHANGE THE FIRST CHARACTER DCX H ;GET ONE BACK MVI M,0 ;CLEAR IT SHLD TSCN ;SAVE THE ADDRESS MVI A,16 ;ARRAY CODE JMP EVEXY ;SKIP EVEXZ LHLD TSCN ;GET IT AGAIN MVI A,2 ;VARIABLE ID BYTE EVEXY CALL GTNM ;GET SYMBOL NUMBER PUSH B ;SAVE BC MVI B,17H ;ERROR TYPE JC ERROR ;CAN'T USE A STATEMENT FOR A VARIABLE, DUMMY. POP B ;RESTORE BC POP H ;GET SLIN BACK MVI M,2 ;STORE OPCODES AND SYMBOL NUMBER INX H MOV M,C INX H MOV M,B INX H MVI M,3 INX H POP D ;GET EVERY THING ELSE BACK POP B EVEX7 MVI C,2 ;SET C TO "LABEL LAST" JMP EVEX1 ;LOOP FOR ANOTHER TOKEN EVEX5 POP H ;GET IT ALL BACK POP D POP B CALL EVEXG ;CHECK FOR TWO LABELS IN A ROW PUSH B ;STUFF IT ALL BACK PUSH D MVI M,4 ;STORE OPCODES AND NUMBER LXI D,TMP10 ;LOCATION OF TRANSLATED NUMBER XCHG ;GET IT TO THE RIGHT PLACE INX D ;UPDATE SLIN LXI B,6 ;NUMBER OF BYTES CALL MOVE ;MOVE IT IN XCHG ;GET SLIN BACK TO HL DAD B ;ADD 6 MVI M,5 ;OPCODE INX H ;UPDATE SLIN JMP EVEX7-2 ;POP THE REST AND LOOP EVEXG MOV A,B ;SAVE STACK COUNT MVI B,15H ;ERROR DCR C ;CHECK FOR C=2 DCR C JZ ERROR ;TWO IN A ROW, STUPID MOV B,A ;PUT STACK BACK RET ;DONE EVEX4 POP H ;GET 'EM ALL BACK POP D POP B CALL EVEXG ;CHECK FOR C=2 PUSH B ;SAVE SOME PUSH D PUSH H CALL BSCN ;SCAN BACK, JACK LHLD NSCN ;GET QUOTE ADDRESS PUSH H ;SAVE ADDRESS CALL BSCN POP H ;RESTORE ADDRESS POP D ;GET SLIN BACK XCHG ;PUT IN THE RIGHT PLACE MVI M,0 ;STORE START STRING CODE EVEXH INX H ;UPDATE INX D LDAX D ;GET A CHARACTER ANI 7FH ;STRIP OFF UPPER BIT CPI '"' ;IS IT A QUOTE? JZ EVEXI ;YUP LDAX D ;IS IT THE LAST ONE? ANA A ;SET FLAGS MOV M,A ;STUFF IT IN MEMORY JP EVEXH ;IT'S OKAY, GET ANOTHER ONE INX H ;CORRECTION FACTOR EVEXI DCX H ;GET LAST CHARACTER MOV A,M ;GOT IT ANA A JNZ EV00 INX H MVI A,0H EV00 ORI 80H ;SET UPPER BIT MOV M,A ;SET IT BACK INX H ;GET NEXT ADDRESS MVI M,1 ;END OF STRING MARKER INX H ;NEXT SLIN XCHG ;GET QUOTE ADDRESS TO HL SHLD NSCN ;SET NSCN MOV A,M ;GET A BYTE ANA A ;SET FLAGS JP EVEXN ;WASN'T THE END MVI A,1 ;SET ESCN IF THE END HAS STRUCK STA ESCN EVEXN MVI M,'"'+80H ;SET UPPER BIT PUSH D ;SAVE IT CALL USCN ;SCAN UP ONE TO PUT THINGS RIGHT POP D XCHG ;PUT THINGS RIGHT JMP EVEX7-2 ;LOOP FOR MORE CHARACTERS EVEX3 POP H ;GET 'EM ALL BACK POP D POP B CPI 20H ;CHECK FOR "(" JZ EVEX8 ;IT WAS, INDEED CPI 21H ;CHECK FOR ")" JZ EVEX9 ;THERE YOU GO DCR C ;CHECK FOR C=1 JNZ EVEXW ;IT WASN'T CPI 12H ;IS IT "NOT"? JNZ EVEXJ ;NOPE INR C ;INDICATE IT MVI A,1EH ;UNARY NOT EVEXJ CPI 19H ;IS IT "-"? JNZ EVEXK ;NOPE INR C ;INDICATE IT MVI A,1DH ;CONVERT TO UNARY MINUS EVEXK CPI 40H ;SEE IF IT IS A FUNCTION JM EVEXM ;NOPE INR C ;INDICATE IT EVEXM DCR C ;SEE IF C=0 JM EVEXB ;SURE WAS EVEXW MOV C,A ;SAVE THE CHARACTER EVEXA DCR B ;CHECK FOR STACK EMPTY INR B JZ EVEXC ;SURE WAS LDAX D ;GET TOP OF STACK CPI 20H ;SEE IF IT'S A "(" JZ EVEXC ;YUP CPI 19H ;CHECK FOR A MINUS SIGN JNZ QQQQ ;NOPE INR A ;YES, SO CHANGE PRECEDENCE CODE INR A QQQQ DCR A CMP C ;CHECK PRECEDENCE JC EVEXC ;NEW ONE IS HIGHER LDAX D ;GET TOP OF STACK MOV M,A ;STORE THE CHARACTER DCR B ;UPDATE STACK POINTERS INX D INX H ;UPDATE SLIN JMP EVEXA ;LOOP TO TRY AGAIN EVEXB CPI 1AH ;IS IT A '+'? JZ EVEXE ;YUP, SO IGNORE IT MVI B,14H ;UH, OH, ERROR JMP ERROR EVEXC MOV A,C ;CHARACTER TO A DCX D ;UPDATE STACK POINTERS INR B STAX D ;PUSH ONTO STACK EVEXE MVI C,1 ;SET OPERATOR LAST JMP EVEX1 ;LOOP FOR ANOTHER TOKEN EVEX8 DCR C ;CHECK FOR C=2 DCR C JNZ EVEXD ;NOPE LDAX D ;GET TOP OF STACK CPI 36H ;IS IT FUNCTION OPERATOR? JZ EVEXD ;YUP MVI A,34H ;ARRAY OPERATOR DCX D ;UPDATE STACK POINTERS INR B ;ONE MORE ON STACK STAX D ;STUFF IT ON EVEXD MVI A,20H ;GET CODE FOR "(" DCX D ;UPDATE STACK POINTERS INR B STAX D ;STUFF IT ON THE STACK JMP EVEXE ;LOOP FOR ANOTHER TOKEN EVEX9 INR B ;CHECK FOR EMPTY STACK DCR B PUSH B ;SAVE 'EM MVI B,12H ;ERROR TYPE JZ ERROR ;WE SEEM TO HAVE NOT ENOUGH LEFT PARENS POP B ;GET 'EM BACK LDAX D ;GET OPERATOR ON TOP OF STACK INX D ;UPDATE STACK POINTERS DCR B CPI 20H ;IS IT A "(" JZ EVEX7 ;YUP, SO LOOP FOR ANOTHER TOKEN MOV M,A ;NOPE, SO STICK IT ON THE POLISH STRING INX H ;UPDATE SLIN JMP EVEX9 ;LOOP TO CHECK NEXT TOP OF STACK EVEX2 POP H ;RESTORE ALL POP D POP B EVEXU INR B ;CHECK FOR EMPTY STACK DCR B JZ EVEXF ;ALL DONE!! LDAX D ;GET TOP OF STACK INX D ;UPDATE POINTERS DCR B CPI 20H ;IS IT "("? PUSH B ;SAVE 'EM MVI B,13H ;ERROR TYPE JZ ERROR ;TOO MANY LEFT PARENS POP B ;GET 'EM BACK MOV M,A ;STICK IT ON THE POLISH STRING INX H ;UPDATE SLIN JMP EVEXU ;TRY NEXT CHARACTER EVEXF MVI M,9 ;STORE END OF EXPRESSION CHARACTER DCX H ;CHECK FOR NO EXPRESSION MOV A,M ;GET A BYTE CPI 9 ;CHECK FOR BEGINNING OF EXPRESSION SHLD SLIN ;SAVE SLIN RZ ;DONE INX H INX H ;UPDATE SLIN SHLD SLIN ;SAVE IT RET ;DONE.. COJMP DW PCAD DW CLER DW PCLS DW PCNT DW PCSS DW DLTE DW ENTR DW LIST DW PNEW DW PRUN DW EDIT DW PRSY DW 0 CONS3 DB 2 ;ID BYTE FOR 65536 DB 0 DB 0 DB 06H DB 55H DB 36H ETBLE DB 03 ;POWERS OF E (1) DB 0 DB 27H DB 18H DB 28H DB 18H DB 3 ; (2) DB 0 DB 73H DB 89H DB 05H DB 61H DB 3 ; (4) DB 01H DB 54H DB 59H DB 81H DB 50H DB 3 ; (8) DB 03H DB 29H DB 80H DB 95H DB 80H DB 3 ; (16) DB 06H DB 88H DB 86H DB 11H DB 05H DB 3 ; (32) DB 13H DB 78H DB 96H DB 29H DB 60H DB 3 ; (64) DB 27H DB 62H DB 35H DB 14H DB 91H DB 3 ; (128) DB 55H DB 38H DB 87H DB 70H DB 84H * RTN. B.49 * E RAISED TO THE X'TH POWER * (HL) = X, (DE) IS WHERE ANSWER GOES * ANY X SUCH THAT -K<X<K, WHERE * K IS LN(9.9999999E 99) ETOX PUSH D ;SAVE DESTINATION ADDRESS LXI D,TMP1 ;SET UP TO MOVE INTO TMP1 PUSH D ;SAVE LOCATIONS PUSH H CALL ABSLT ;ABSOLUTE VALUE TO TMP1 POP H ;RESTORE LOCATIONS POP D MOV A,M ;GET STARTING ID BYTE ANI 80H ;STRIP OFF MANTISSA SIGN BIT STA SIGNF ;SAVE IT XCHG ;GET TMP1 ADDRESS TO HL CALL BCDB ;CONVERT TO BINARY LXI D,231 ;CHECK SIZE OF EXPONENT CALL CMP16 ;COMPARE JNC ETOX1 ;OVERFLOW ERROR PUSH H ;SAVE THE NUMBER LXI H,ONE11 ;INITIALIZE TMP8 TO A 1 LXI D,TMP8 LXI B,6 CALL MVDN POP B ;GET THE NUMBER BACK IN BC MVI B,1 ;SET MASK LXI H,ETBLE ;SET HL TO BEGINNING OF POWERS OF E ETOX3 MOV A,B ;A=B AND C ANA C JZ ETOX2 ;SKIP IF BIT WAS A ZERO PUSH B ;SAVE MASK AND NUMBER PUSH H ;SAVE INDEX LXI D,TMP8 ;TMP8=TMP8*E TO THE 2 TO THE N'TH MOV B,D MOV C,E CALL MULER ;MULTIPLY POP H ;RESTORE INDEX POP B ;AND MASK, AND NUMBER ETOX2 MVI A,6 ;HL=HL+6 CALL ADHL MOV A,B ;LEFT SHIFT THE MASK RLC MOV B,A JNC ETOX3 ;LOOP FOR MORE INTEGER PORTION LXI H,TMP1 ;TMP1=TMP1-TMP9 LXI D,TMP9 MOV B,H MOV C,L PUSH H ;SAVE ADDRESSES PUSH D CALL SUBER ;SUBTRACT POP D ;RESTORE ADDRESSES POP H LXI B,6 ;NUMBER OF BYTES CALL MVDN ;TMP9=TMP1 LXI H,ONE11 ;TMP2=TMP3=TMP5=1 LXI D,TMP2 CALL MVDN LXI D,TMP5 CALL MVDN LXI D,TMP3 LXI H,CON99 CALL MVDN ETOX4 LXI H,TMP1 ;TMP6=TMP1/TMP3 LXI D,TMP3 LXI B,TMP6 CALL DIVER ;DIVIDE CALL TRMN1 ;CHECK FOR DONENESS JC ETOX5 ;OK, WE'RE DONE CALL FCTRL ;COMPUTE NEXT FACTORIAL TERM LXI H,TMP9 ;TMP1=TMP1*TMP9 LXI D,TMP1 MOV B,D MOV C,E CALL MULER ;MULTIPLY LXI H,TMP6 ;TMP5=TMP5+TMP6 LXI D,TMP5 MOV B,D MOV C,E CALL ADDER ;ADD JMP ETOX4 ;LOOP FOR ANOTHER TERM ETOX5 LXI H,TMP5 ;TMP5=TMP5*TMP8 LXI D,TMP8 MOV B,H MOV C,L CALL MULER ;MULTIPLY LDA SIGNF ;CHECK FOR MINUS ANA A ;SET FLAGS POP B ;RESTORE DESTINATION LXI H,ONE11 ;(BC)=1/TMP8 OR TMP8/1 LXI D,TMP5 JNZ ETOX6 ;SKIP IF IT WAS NEGATIVE XCHG ;SWAP ADDRESSES ETOX6 CALL DIVER ;DIVIDE RET ;DONE.. ETOX1 MVI B,4 ;EXPONENT TOO LARGE ((((ERROR)))) JMP ERROR * RTN. B.50 * LN(HL) TO (DE) * NEGATIVE (HL) WILL PRODUCE AN ERROR LOGX PUSH D ;SAVE DESTINATION PUSH H ;SAVE SOURCE LXI D,ZERO0 ;COMPARE WITH ZERO CALL CMPR POP H ;RESTORE SOURCE MVI B,2 ;ERROR TYPE JUST IN CASE JZ ERROR ;SURE WAS!! LXI D,TMP1 ;TMP1=(HL) LXI B,6 CALL MVDN LDAX D ;GET ID BYTES ANI 80H ;STRIP OFF MANTISSA SIGN BIT JNZ LOGX3 ;OH, OH, WE'VE GOT AN ERROR MVI B,80H ;SET UP MASK MVI C,0 ;CLEAR INTEGER PORTION OF LOG LXI D,ETBLE+42 ;SET UP INDEX LOGX1 LXI H,TMP1 ;SET UP FOR COMPARE PUSH H ;SAVE ALL THESE SILLY REGISTERS PUSH B PUSH D CALL CMPR ;COMPARE POP D ;RESTORE ALL VALUES POP B POP H JC LOGX2 ;SKIP IF IT DON'T FIT PUSH D ;SAVE 'EM AGAIN PUSH B MOV B,H MOV C,L CALL DIVER ;DIVIDE POP B ;RESTORE THE REGISTERS, PLEASE POP D MOV A,C ;C=B OR C ORA B MOV C,A LOGX2 XCHG ;HL=DE LXI D,6 ;SET UP FOR CALL SUB16 ;SUBTRACT XCHG ;DE=HL MOV A,B ;GET THE MASK RRC ;RIGHT SHIFT IT MOV B,A JNC LOGX1 ;LOOP IF THERE ARE MORE BITS TO DO MOV L,C ;CONVERT C TO A NUMBER MVI H,0 LXI D,TMP7 CALL BBCD ;CONVERT LXI H,ZERO0 ;TMP5=0 LXI D,TMP5 LXI B,6 CALL MVDN LXI H,TMP1 ;TMP9=TMP1-1 LXI D,ONE11 LXI B,TMP9 PUSH H ;SAVE SOME PUSH D CALL SUBER ;SUBTRACT POP D ;GET 'EM BACK POP H MOV B,H ;TMP1=TMP1+1 MOV C,L PUSH H ;SAVE AGAIN CALL ADDER ;ADD POP H ;GET TMP1 ADDRESS MOV B,H MOV C,L LXI D,TMP9 ;TMP1=TMP9/TMP1 XCHG ;GET ADDRESSES RIGHT PLACE PUSH B ;SAVE TMP1 ADDRESS CALL DIVER ;DIVIDE POP H ;GET TMP1 ADDRESS MOV D,H MOV E,L LXI B,TMP4 ;TMP4=TMP1*TMP1 CALL MULER ;MULTIPLY LXI H,ONE11 ;TMP2=1 LXI D,TMP2 LXI B,6 CALL MVDN LOGX4 LXI H,TMP1 ;TMP6=TMP1/TMP2 LXI D,TMP2 LXI B,TMP6 CALL DIVER ;DIVIDE CALL TRMN1 ;CHECK FOR DONENESS JC LOGX5 ;OK, WE'RE DONE LXI H,TWO22 ;TMP2=TMP2+2 LXI D,TMP2 MOV B,D MOV C,E CALL ADDER ;ADD LXI H,TMP1 ;TMP1=TMP1*TMP4 LXI D,TMP4 MOV B,H MOV C,L CALL MULER ;MULTIPLY LXI H,TMP5 ;TMP5=TMP5+TMP6 LXI D,TMP6 MOV B,H MOV C,L CALL ADDER ;ADD JMP LOGX4 ;LOOP FOR ANOTHER TERM LOGX5 LXI H,TWO22 ;TMP5=TMP5*2 LXI D,TMP5 MOV B,D MOV C,E CALL MULER ;MULTIPLY LXI H,TMP7 ;(BC)=TMP7+TMP5 LXI D,TMP5 POP B CALL ADDER ;ADD RET ;DONE,DONE,DONE LOGX3 MVI B,6 ;ERROR TYPE 6 JMP ERROR ;GO GET IT * RTN. B.51 * SQUARE ROOT FUNCTION * (DE)=SQR(HL) * RTN. B.52 * POWERS * (BC) = (HL) TO THE (DE) POWER * (HL) CANNOT BE NEGATIVE PWRS PUSH B ;SAVE DESTINATION PUSH D ;SAVE EXPONENT PUSH H ;SAVE SOURCE LXI D,ZERO0 ;CHECK FOR ZERO CALL CMPR POP H ;RESTORE SOURCE JZ PWRSM ;IT'S A ZERO XTHL ;GET EXPONENT TO HL PUSH H ;SAVE SOURCE AGAIN LXI D,HNDRD ;CHECK FOR LESS THAN A HUNDRED CALL CMPR ;COMPARE POP H ;RESTORE THE SOURCE XTHL ;GET SOURCE BACK TO HL JC PWRS1 ;LESS THAN ONE HUNDRED PWRS2 LXI D,TMP10 ;TMP10=LN(HL) CALL LOGX POP D ;GET BACK EXPONENT LXI H,TMP10 ;TMP10=TMP10*(DE) MOV B,H MOV C,L CALL MULER ;MULTIPLY POP D ;GET DESTINATION BACK LXI H,TMP10 ;(DE)=ETOX(TMP10) CALL ETOX RET ;DONE.... * RTN. B.30 * MATCHER - CONVERTS (HL) AND (DE) TO THE SAME * FORM, FLOATING POINT OR INTEGER, FOR LATER MATH * FUNCTIONS. IF THEY ARE BOTH FLOATING POINT, * CARRY IS SET ON EXIT. MATCH LDAX D ;GET ONE ID BYTE XRA M ;GET BITS DIFFERENT IN THE TWO ANI 1 ;STRIP ALL BUT FLOATING/INTEGER BIT MOV A,M ;GET AN ID BYTE JNZ MTCH1 ;SKIP IF THEY ARE DIFFERENT RRC ;SET CARRY ACCORDING TO FORM RET ;NON-CONVERSION EXIT MTCH1 ANI 1 ;WHAT IS (HL)'S FORM? STC ;SET CARRY FOR LATER PUSH PSW ;SAVE STATUS ON STACK JZ MTCH2 ;SKIP IF (HL) IS ALREADY THE INTEGER XCHG ;MAKE (HL) THE INTEGER MTCH2 PUSH D ;SAVE REGISTERS PUSH B LXI D,TMP11 ;GET WORKING REGISTER ADDRESS CALL INFL ;CONVERT INTEGER TO FLOATING POINT POP B ;RESTORE REGISTERS POP D LXI H,TMP11 POP PSW ;GET STATUS BACK RZ ;RETURN IF NO SWAP WAS MADE XCHG ;PUT EVERYTHING BACK TO NORMAL RET ;DONE * RTN. B.31 * MATH ERROR PROCESSOR * CHECK TO SEE IF MERR IS SET, IF NOT, RETURNS * IF IT IS, JUMPS TO ERROR WITH THE APPROPRIATE * ERROR NUMBER IN B MCHK LDA MERR ;GET MERR TO A ANI 07H ;CHECK FOR A BIT SET RZ ;RETURN IF NONE MVI B,1 ;PRESET COUNTER MCHK1 RRC ;LSB TO CARRY JC ERROR ;FOUND THE BIT INR B ;UPDATE COUNTER JMP MCHK1 ;LOOP FOR NEXT BIT * RTN. B.32 * ERROR PROCESSOR * ASSUMES ERROR TYPE NUMBER TO BE IN "B" ERROR LXI H,EMSG ;GET ADDRESS OF ERROR MESSAGE MOV A,B ;CHECK FOR CASSETTE LOAD ERROR CPI 23H JZ ERROR1 ;NOPE LDA CSST ;CASSETTE MODE? ANA A JZ ERROR1 ;NOPE LDA CMND ;ENTER MODE? ANA A JNZ ERROR1 ;NOPE LHLD FRAV ;SET UP TO TURN IT INTO A REMARK SHLD SLIN ;RESET CODED LINE MVI A,86H ;STORE AS REMARK OPCODE CALL ICBY MVI A,35H ;SEND SINGLE QUOTE CODE CALL ICBY ;SEND IT ERROR2 LHLD NSCN ;BACK UP TO START XCHG LHLD CASER CALL CMP16 JZ ERROR3 CALL BSCN JMP ERROR2 ERROR3 CALL BSCN LXI SP,STACK+100 ;RESET THE STACK LXI H,EXEC3+3 ;SET RETURN ADDRES PUSH H XRA A ;CLEAR STFLAG STA STFLG LHLD CASER ;SET UP TO DECODE THIS MESS XCHG JMP PREM2+1 ;DO IT TO IT!! ERROR1 XRA A ;CLEAR ANY CASSETTE MODE STA BFLAG STA CSST STA CATV STA EDITM ;CLEAR ANY EDIT MODE LXI H,0 ;CLEAR ANY DUMP MEMORY MODE SHLD DMPMM MOV A,B ;CONVERT TO BINARY CALL BCDBN LXI H,ERMST ;START OF MESSAGE TABLE DCR A ;CORRECT THE COUNT ERROA ANA A ;CHECK FOR DONENESS JZ ERROB ;SURE IS CALL COUNT ;GET NEXT MESSAGE DAD D DCR A ;UPDATE COUNT JMP ERROA ERROB PUSH H CALL CRLF POP H CALL MSGER ;SEND IT OUT LXI H,EMSG ;SEND REST OF IT CALL MSGER CALL LNDSC ;SEND THE LINE DESCRIPTOR XRA A ;CLEAR RUN MODE STA RUNF JMP EDI96 ;CHECK FOR POSSIBLE EDIT RE-ENTRY. * RTN. B.33 * ADDER * (BC) = (HL) + (DE) ADDER CALL MATCH ;CHECK FORM PUSH PSW ;SAVE CARRY CC FPADD ;FLOATING POINT ADDITION POP PSW ;RESTORE CARRY CNC IADD ;INTEGER ADDITION JMP MCHK ;LOOK FOR ERRORS * RTN. B.34 * SUBTRACTER * (BC) = (HL) - (DE) SUBER CALL MATCH ;CHECK FORM PUSH PSW ;SAVE CARRY CC FPSUB ;FLOATING POINT SUBTRACTION POP PSW ;RESTORE CARRY CNC ISUB ;INTEGER SUBTRACTION JMP MCHK ;LOOK FOR ERRORS * RTN. B.35 * MULTIPLIER * (BC) = (HL) TIMES (DE) MULER CALL MATCH ;CHECK FORM PUSH PSW ;SAVE CARRY CC FLML ;FLOATING POINT MULTIPLICATION POP PSW ;RESTORE CARRY CNC IMUL ;INTEGER MULTIPLICATION JMP MCHK ;LOOK FOR ERRORS * RTN. B.36 * DIVIDER * (BC) = (HL) DIVIDED BY (DE) DIVER CALL MATCH ;CHECK FORM PUSH PSW ;SAVE CARRY CC DIV2A ;FLOATING POINT DIVISION POP PSW ;RESTORE CARRY CNC IDIV ;INTEGER DIVISION JMP MCHK ;LOOK FOR ERRORS EMSG DB ' ERROR IN',' '+80H ERMST DB 'OVRFL','W'+80H DB 'UNDRFL','W'+80H DB '/','0'+80H DB 'EX >','>'+80H DB 'BIN CON >','>'+80H DB '-LO','G'+80H DB 'STATE N','M'+80H DB 'COM','M'+80H DB 'VRBL AS STAT','E'+80H DB 'SYNTA','X'+80H DB 'VRBL N','M'+80H DB '>> ',')'+80H DB '>> ','('+80H DB '2 OPER','S'+80H DB '2 OPAND','S'+80H DB 'ILGL FUN','C'+80H DB 'STATE AS VRB','L'+80H DB 'NEW SYM','B'+80H DB 'NO T','O'+80H DB 'DUPL STAT','E'+80H DB 'DUPL DE','F'+80H DB 'CAN',27H,'T CON','T'+80H DB 'TAP','E'+80H DB 'STRIN','G'+80H DB 'COMM','A'+80H DB 'OPRN','D'+80H DB '<*MEM*','>'+80H DB 'UNDI','M'+80H DB 'SUBSCPT >','>'+80H DB 'SUBSCPT OVFL','W'+80H DB 'ASSIG','N'+80H DB 'STR AS NU','M'+80H DB 'NUM AS ST','R'+80H DB 'CNTRL STC','K'+80H DB 'ON GOT','O'+80H DB '<< DAT','A'+80H DB 'RCV DAT','A'+80H DB 8DH DB '- SQ','R'+80H DB 'LOGICA','L'+80H PWRSM POP D ;GET RID OF EXPONENT POP D ;GET THE DESTINATION LXI B,6 ;SET UP TO MOVE IN THE ZERO CALL MOVE ;DO IT TO IT RET ;ALL DONE PWRS1 POP B ;GET EXPONENT POP D ;GET DESTINATION PUSH H ;SWAP BC AND HL PUSH B POP H POP B PUSH B PUSH D PUSH H LXI D,TMP11 ;PLACE TO PUT IT CALL INTG ;GET THE INTEGER OF BASE POP H ;GET THE NUMBERS AGAIN LXI D,TMP11 ;WHERE IT'S AT PUSH H CALL CMPR ;SEE IF THEY ARE THE SAME POP D POP H XTHL PUSH D JNZ PWRS2 ;NOT AN INTEGER, PROCESS WITH LOGS PUSH H ;SAVE BASE LXI H,ONEEE ;PRESET TMP1 LXI D,TMP1 LXI B,6 CALL MOVE ;MOVE IN A ONE (INTEGER FORM) POP H ;PRESET TMP2 TO COUNT XTHL LXI D,TMP2 CALL MOVE PWRS3 LXI H,TMP2 ;CHECK FOR DONENESS LXI D,ZERO0 CALL CMPR JZ PWRS5 ;SURE IS POP D ;GET BASE PUSH D ;SAVE IT LXI H,TMP1 ;GET CURRENT RESULT MOV B,H MOV C,L CALL MULER ;ANOTHER ITERATION LXI H,TMP2 ;UPDATE THE COUNT LXI D,ONEEE MOV C,L MOV B,H CALL SUBER JMP PWRS3 ;CHECK AGAIN FOR DONENESS PWRS5 POP D ;CLEAN UP THE STACK POP D ;GET THE DESTINATION LXI H,TMP1 ;GET THE SOURCE LXI B,6 ;THE NUMBER OF BYTES JMP MOVE ;MOVE IT IN AND RETURN SPRGSH PUSH D ;SAVE IT LXI D,1 ;PRESET SPRGSH1 MOV A,H ;CHECK FOR DONE ORA L JZ SPRGSH2 ;YUP XCHG ;SWAP DAD H XCHG DCX H JMP SPRGSH1 SPRGSH2 XCHG POP D RET ;DONE LINK3 LINK B:TBASICA4