JSB OUTPT JMP P21 * SKP * * CREATE A WORD TYPE 2 INSTRUCTION. * FIRST, CHECK MNEMONICS AND COLLECT BINARY OPCODES * FOR EACH FIELD. * TYPE2 LDA .+2 GET A 'SPECIAL' CODE LDB .+3 FROM FIELD 3. JSB CODE LDA .+5 GO GET AN 'IMM' CODE LDB .+4 FROM FIELD 4. JSB CODE LDA .+6 GO GET A 'STORE' CODE LDB .+5 FROM FIELD 5. JSB CODE LDB F6ADR GET FLD 6 STARTING BYTE ADDRESS. JSB NUM CONVERT FIELD CONTENTS TO BINARY. SOC ANY PROBLEMS? JMP TY2.1 YES. JMP TY2.2 NO. TY2.1 LDA .+11 PRINT ERROR MESSAGE. JSB ERROR CLA MAKE FIELD 6 = 0. TY2.2 STA 1 AND MSK8 IS # 8 BITS OR LESS? SZA JMP TY2.1 NO, SO ERROR. STB FLD6 YES. * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 2 WORD. * LDA FLD3 BITS 0-4 GET FIELD 3 STA INST1 (HERE A 'SPECIAL' NOP). LDA FLD5 BITS 5-9 GET FIELD 5 ALF,RAL (HERE, A 'STORE'). IOR INST1 STA INST1 LDA FLD6 BITS 10-17 GET FIELD 6 AND MSK6 (HERE, A BINARY NO.). ALF,ALF FIRST, DO BITS 10-15. RAL,RAL IOR INST1 STA INST1 LDA FLD6 NOW BITS 16-17(0-1). AND MSK78 ALF,ALF RAL,RAL STA INST2 LDA FLD4 BITS 18-19(2-3) GET RAL,RAL FIELD 4 (HERE, AN 'IMM'). IOR INST2 STA INST2 LDA FLD2 BITS 20-23(4-7) GET ALF FIELD 2(HERE, AN 'OPCODE'). IOR INST2 STA INST2 JSB OUTPT JMP P21 * SKP * * CREATE A WORD TYPE 3 INSTRUCTION. * FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES. * TYPE3 LDA .+3 GO GET A 'CONDITION' CODE LDB .+4 FROM FIELD 4. JSB CODE LDA .+6 GET A 'STORE' CODE LDB .+5 FROM FIELD 5 JSB CODE LDA FLD5 DID FIELD 5 CONTAIN CPA RJS AN 'RJS'? JMP TY3.5 YES. LDA .+1 NO. SO SET BIT 14. RAR,RAR RSS TY3.5 CLA 'RJS' PRESENT, SO CLEAR STA FLD5 BIT 14. LDB F6ADR GET FLD 6 STARTING BYTE ADDR. JSB NUM CONVERT FIELD CONTENTS TO BINARY. SOC ANY PROBLEMS? RSS YES. JMP TY3.1 NO. TY3.0 LDA .+8 GO OUTPUT ERROR MESSAGE. JSB ERROR CLA MAKE FIELD 6 = 0. STA FLD6 LDA UNCD DEFAULT 'SPECIAL' CODE (FIELD STA FLD3 3) TO 'UNCD'. JMP TY4.6 GO ASSEMBLE AS TYPE 4 WORD. TY3.1 STA SAVA AND MSK21 THROW OUT LOW 9 BITS OF THE #. STA 1 LDA T.001 RE-CREATE THE ABSOLUTE ORIGIN IOR T.002 THROW OUT ITS LOW 9 BITS. AND MSK21 CPA 1 THE 3 HIGH BITS SAME IN BOTH #'S? RSS YES, SO GOOD #. JMP TY3.0 NO, SO ERROR. LDA SAVA AND MSK23 KEEP LOW 9 BITS. STA FLD6 STORE IN FIELD WORD. * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 3 WORD. * LDA FLD3 BITS 0-4 GET FIELD 3 STA INST1 (HERE, THE 'SPECIAL', 'CNDX'.) LDA FLD6 BITS 5-13 GET FIELD 6 ALF,RAL (HERE, AN ADDRESS). IOR INST1 STA INST1 LDA FLD5 BIT 14 GETS FIELD 5 IOR INST1 STA INST1 LDA FLD4 BITS 15-19 GET FIELD 4 RAR (HERE, A 'CONDITION'). AND MSK15 FIRST, BIT 15. IOR INST1 STA INST1 LDB FLD4 BRS STB INST2 NOW BITS 16-19(0-3). LDA FLD2 BITS 20-23(4-7) GET FIELD 2 ALF (HERE AN 'OPCODE'). IOR INST2 STA INST2 JSB OUTPT JMP P21 * SKP * * CREATE A WORD TYPE 4 INSTRUCTION. * WE ALREADY HAVE CODES FROM FIELDS 2 AND 3. * TYPE4 LDA FLD3 GET THE FIELD 3 BINARY CODE. CPA IOFF WAS IT 'IOFF'? JMP TY4.9 YES. SO OK. CPA STFL NO. WAS IT 'STFL'? JMP TY4.9 YES, SO OK. CPA UNCD NO. WAS IT 'UNCD'? JMP TY4.9 YES. SO OK. CPA BLANK NO. WAS IT BLANK? JMP TY4.8 YES. CPA IOG NO. WAS IT 'IOG'? JMP TY4.9 YES. SO OK. ADA .M26 'JMP SPECIAL' BUT NOT 'CNDX'? SSA JMP TY4.7 NO, SO ERROR. LDA FLD3 YES. SO OK. JMP TY4.9 TY4.7 LDA .+4 PRINT ERROR MESSAGE. JSB ERROR TY4.8 LDA UNCD STORE 'UNCD' AS DEFAULT. TY4.9 STA FLD3 LDB F6ADR GET FIELD 6 STRTNG BYTE ADDR. JSB NUM CONVERT FIELD CONTENTS TO BINARY. SOC ANY PROBLEMS? JMP TY4.0 YES. JMP TY4.1 NO. TY4.0 LDA .+8 YES. GO OUTPUT JSB ERROR ERROR MESSAGE. LDA UNCD STORE 'UNCD' IN STA FLD3 FIELD 3. CLA MAKE FIELD 6 = 0. TY4.1 STA 1 AND MSK12 IS THE NO. 12 BITS SZA OR LESS? JMP TY4.0 NO, SO ERROR. STB FLD6 YES. SO SAVE FIELD. * * NOW PUT TOGETHER THE FIELDS OF THE TYPE 4 WORD. * TY4.6 LDA FLD3 BITS 0-4 GET FIELD 3 STA INST1 (HERE, A 'SPECIAL'). LDA FLD6 BITS 5-16 GET FIELD 6 CLE ALF,ELA FIRST, BITS 5-15. IOR INST1 STA INST1 CLB ELB NOW BIT 16. LDA FLD2 LEAVE BITS 17-19(1-3) CLEAR. ALF BITS 20-23(4-7) GET IOR 1 FIELD 2(HERE, AN 'OPCODE'). STA INST2 JSB OUTPT JMP P21 * SKP * * WE COME HERE AFTER READING AN '$END' RECORD * IN PASS 2. * END JSB EMPBF EMPTY PUNCH BUFFER. LDA RCFLG ARE WE PUNCHING SZA,RSS A SUITCASE ROM TAPE? JMP END00 LDA .+2 YES. THEN SET FLAG STA RCFLG FOR 'LAST PUNCHOUT'. JSB EMPBF DO 'LAST PUNCHOUT'. END00 LDA PCH WAS THERE A 'NO-PUNCH' CONTROL SZA,RSS CARD? JMP END0 YES, SO DON'T PUNCH END RECORD. LDA RCFLG NO.. ARE WE PUNCHING A SUITCASE CPA .+2 ROM TAPE? JMP END0 YES, SO NO END RECORD. LDA .+2 NO. PUNCH OUT CLB,INB JSB IOSUB END RECORD. DEF PCH DEF ENDRC DEF .+4 END0 LDA CRLEN LIST THE '$END' STATEMENT. JSB LSTR LDA NMERR ANY PASS 2 SZA,RSS ERRORS? JMP END1 NO. LDB DJ1 YES. SO GO RBL PUT NO. INTO THE INB NO.-OF-ERRORS STATEMENT JSB DECML BUFFER. END1 LDA LIST SZA,RSS USER NOT LISTING? LDA .+6 YES. WELL, HE GETS THE STA LIST NO.-OF-ERRORS STATEMENT ANYWAY. LDA .+2 JSB IOSUB DEF LIST DEF DJ DEF .M18 JSB LEEDR PUNCH OUT TRAILER. LDA LIST IF USER IS LISTING ON CPA .+1 LINE PRINTER, RSS JSB EJECT EJECT PAGE FOR THE GUY. LDA .+2 PRINT FINAL 'END' MESSAGE JSB IOSUB ON THE TELETYPE. DEF TTYO DEF ENDMS DEF .M18 LDA .+2 OUTPUT 4 LDB .+4 SPACES ON TTY. JSB SPACE JMP D1 GO BACK AND DO NEXT MICROPROGRAM. SKP * * 'CHECK' COMPARES A SUBJECT BYTE STRING OF UP TO * 8 BYTES WITH A REFRENCE BYTE STRING. * * CALLING SEQUENCE: * * LDB * LDA * JSB CHECK * * UPON RETURN: * * IF 'A' REG = 0, STRINGS DID NOT COMPARE. * IF 'A' REG # 0, STRINGS COMPARED. * CHECK NOP * * INITIALIZE. * STA SAVO SAVE REF STRING WORD ADDR. LDA .-8 PUT SUBJECT STRING INTO BUFFER, JSB TLOAD 'TOKEN'. LDA .-4 SET '#OF WORDS TO BE COMPARED' STA CNTR4 COUNTER. LDB TOKAD SET 'B' TO WORD ADDR OF 'TOKEN'. * * COMPARE WORDS. * CHEK2 LDA SAVO,I GET NEXT REF. WORD. CPA 1,I SAME AS NEXT SUBJECT WORD? RSS YES. JMP CHEK4 NO. ISZ SAVO INCR REF STRING WORD ADDR. INB INC SUBJ WORD ADDR. ISZ CNTR4 INCR COUNTER. DONE YET? JMP CHEK2 NO. CLA,INA YES. SET 'A' TO INDICATE 'YES, JMP CHECK,I WE GOT A COMPARE'. RETURN. CHEK4 CLA NO COMPARE. SET 'A' TO JMP CHECK,I INDICATE THIS. RETURN. SAVO NOP CNTR4 NOP SKP * 'CLEAN' FILLS A BUFFER WITH A GIVEN CHAR. * * CALLING SEQUENCE: * LDB * * LDA <+ NO. OF WORDS IN BUFFER> * * JSB CLEAN * DEF * CLEAN NOP CMA,INA STA COUNT LDA CLEAN,I BRING IN CHAR. LDA 0,I CLE0 STA 1,I INB ISZ COUNT JMP CLE0 ISZ CLEAN SET RETURN ADDRESS. JMP CLEAN,I SKP * * ASCII TO BINARY CONVERSION ROUTINE. * * CALLING SEQUENCE: * A REG SHOULD BE 0 IF STRING OF OCTAL * ASCII DIGITS IS TO BE CONVERTED TO BINARY; * #0 IF STRING OF DECIMAL ASCII DIGITS. * B REG SHOULD CONTAIN THE STARTING BYTE ADDRESS * OF THE STRING OF ASCII DIGITS TO BE * CONVERTED. * JSB CNVRT * * ON RETURN RESULT IN A REG. * OVERFLOW SET ON ERROR * B REG IS NOT SIGNIFICANT. * CNVRT NOP STB TMPC1 SAVE BYTE ADDRESS LDB .+8 PUT OCTAL BASE IN B. SZA WAMT DECIMAL? LDB .+10 YES, PUT DECIMAL BASE INB. STB TMPC2 SAVE BASE. CLA CLEAR TEMPORARY STA TMPC3 STA CFLG CN1 LDB TMPC1 LOAD JSB LOADB BYTE. ADA .M48 VALUE OF BYTE SSA <@60? JMP CN4 YES STA TMPC4 NO,SAVE BYTE. LDA TMPC2 IS CMA,INA BUTE ADA TMPC4 NON LEGAL SSA,RSS DIGIT? JMP CN4 YES LDA TMPC3 COMPUTE NEXT MPY TMPC2 TEMPORARY RESULT. SZB OVERFLOW? JMP CN2 YES CLO NO, CLEAR O-BIT. ADA TMPC4 ADD IN NEW DIGIT SOC OVERFLOW? JMP CNVRT,I YES RETURN STA TMPC3 SAVE INTERMEDIATE RESULT ISZ CFLG SET GOOD DIGIT FLAG. ISZ TMPC1 BUMP BYTE ADDRESS. JMP CN1 CN4 LDA CFLG ILLEGAL DIGIT FOUND LDB TMPC1 PUT BYTE ADDRESS IN B SZA,RSS DID WE GET ANYTHING? STO NO, SET ERROR CONDITION LDA TMPC3 PUT RESILT IN A-REG JMP CNVRT,I CN2 STO OVERFLOW JMP CNVRT,I SKP * * * "CODE" OBTAINS THE BINARY CODE EQUIVALENT FOR * THE MNEMONIC IN A GIVEN FIELD, AND STORES IT IN * THE APPROPRIATE FIELD STORAGE LOCATION, EG. "FLD1", ETC. * IT PRINTS AN ERROR MESSAGE IF THE MNEMONIC WAS INVALID. * * CALLING SEQUENCE: * LDA * LDB * JSB CODE * * UPON RETURN: THE CODE WILL BE IN THE FIELD STORAGE * LOCATION; A AND B REGS ARE NOT SIGNIFICANT. * CODE NOP STA CSAVA STB CSAVB ADB F0ADR GET STARTING BYTE ADDRESS OF LDB 1,I FIELD. LDA CSAVA JSB $SRCH GO GET BINARY CODE. CPA .-1 MNEMONIC ERROR? RSS JMP CO7 NO. LDA CSAVB INA JSB ERROR PRINT ERROR MESSAGE. LDA CSAVA GET NOP BINARY CODE FOR ADA DEFLT CURRENT MNEMONIC TYPE. LDA 0,I CO7 LDB CSAVB STORE CODE IN PROPER ADB FWORD FIELD WORD. STA 1,I JMP CODE,I * SKP * * * THIS ROUTINE CONVERTS BINARY * TO 4 DIGIT DECIMAL * * CALLING SEQUENCE: * LDA <+BINARY # TO BE CONVERTED> * LDB * JSB DECML * DECML NOP STB D.000 SAVE ADDRESS CLB DIVIDE DIV .1000 BY 1000 ADA B60 A=1000TH DIGIT. MAKE ASCII STB D.001 SAVE REMAINDER LDB D.000 PICK UP ADDRESS JSB STORB STORE 1000TH DIGIT. STB D.000 SAVE NEXT ADDRESS CLB DIVIDE LDA D.001 REMAINDER DIV .100 BY 100. ADA B60 A= HUNDRED DIGIT. MAKE ASCII STB D.001 SAVE REMAINDER LDB D.000 PICK UP ADDRESS JSB STORB STORE HUNDREDS DIGIT STB D.000 SAVE NEXT ADDRESS CLB DIVIDE LDA D.001 BY DIV .+10 10. ADA B60 A= TENS DIGIT. MAKE ASCII STB D.001 SAVE 1'S DIGIT LDB D.000 PICK UP ADDRESS JSB STORB STORE TENS DIGIT LDA D.001 PICK UP 1'S DIGIT ADA B60 MAKE ASCII JSB STORB STORE IT JMP DECML,I RETURN SKP * 'DEF' FIRST CHECKS IF THE FIELD WHOSE BYTE ADDRESS * IS IN B REG, IS A 'DEF'. IF NOT, THEN RETURN IS * MADE WITH A REG # 0. IF SO, THEN THE DEF STATEMENT * IS PROCESSED AND RETURN IS MADE WITH A = 0. * * CALLING SEQUENCE: * * LDB * * JSB DEF * * UPON RETURN: A REG = 0 MEANS THE FIELD CONTAINED * A 'DEF' AND THAT THIS * DEF STATEMENT HAS BEEN PROCESSED. * A REG # 0 MEANS THE FIELD DID NOT CONTAIN * A 'DEF'. * IN EITHER CASE, UPON RETURN, B REG CONTAINS GARBAGE. * DEF NOP * * FIRST DETERMINE IF WE HAVE A 'DEF' IN THE FIELD. * JSB LOADB CPA .D 1ST CHAR = "D"? RSS YES. JMP DEF9 NO. INB YES. JSB LOADB CPA .E 2ND CHAR = "E"? RSS YES. JMP DEF9 NO. INB JSB LOADB CPA .F 3RD CHAR = "F"? RSS YES. JMP DEF9 * * WE HAVE A DEF STATEMENT. * LDB F6ADR GO PROCESS ADDRESS IN FIELD 6. JSB NUM SOC ANY PROBLEMS? JMP DEF8 YES. STA 1 NO. AND M7777 IS NO. IN RANGE 0-7777 OCT? SZA JMP DEF8 NO, SO ERROR. STB INST1 YES, SO OK. STORE ADDRESS. STA INST2 JMP DEF,I RETURN. DEF8 LDA .+7 PRINT ERROR MESSAGE. JSB ERROR JSB NOPER MAKE A 'NOP' MICROINSTRUCTION. CLA JMP DEF,I DEF9 CLA,INA NO DEF STATEMENT. JMP DEF,I SKP * * THIS ROUTINE EJECTS PAGE ON LIST * DEVICE * CALLING SEQUENCE: * JSB EJECT * EJECT NOP LDB LIST SUPPRESS SZB,RSS LISTING? JMP EJECT,I YES, EXIT. JSB TTYIO WE EJECTING ON TTY? SZA,RSS JMP EJTT YES. EJLP LDA .+2 JSB IOSUB DEF LIST DEF LPEJ DEF .-2 JMP EJ2 EJTT NOP LDA SP4 STA SAVA CLA STA SP4 LDA LIST LDB .P24 JSB SPACE LDA SAVA STA SP4 EJ2 NOP LDA LPP CMA,INA STA #LNES JMP EJECT,I SKP * * 'EMCDE' PUNCHES THE OBJECT TAPE IF THE PUNCH * BUFFER IS FULL OR IF WE JUST READ AN '$END' * RECORD. THEN IT RE-INITIALIZES THE PUNCH * BUFFER AND EXITS. * * CALLING SEQUENCE: * JSB EMCDE * EMCDE NOP LDA PNBUF PUNCH BUFUR CPA .59 FULL? JSB EMPBF YES EMPTY IT LDA LASTP IS THIS INA NEXT STA 1 SEQUENTIAL INSTRUCTION? LDA PCNTR AND =B377 CPA 1 RSS JSB EMPBF NO,EMPTY PUNCH BUFUR. LDA CKSUM KEEP ADA INST1 RUNNING ADA INST2 CHECK- STA CKSUM SUM. LDA INST2 PUT LDB INST1 INSTRUCTION STA PNADR,I INTO ISZ PNADR PUNCH STB PNADR,I BUFUR. ISZ PNADR POINT TO NEXT POSITION. LDA PCNTR SAVE CURRENT AND =B377 LOW BITS OF STA LASTP PCNTR FOR NEXT TIME. ISZ PNBUF INCREMENT RECORD CNT. ISZ PNBUF JMP EMCDE,I EXIT SKP * * THIS ROUTINE EMPTIES CURRENT CONTENTS * OF PUNCH BUFUR AND SETS UP HEADER FOR NEXT. * * CALLING SEQUENCE: * JSB EMPBF * EMPBF NOP LDA RCFLG WE PUNCHING SUITCASE ROM TAPE CPA .+2 AND IS THIS 'LAST PUNCHOUT'? JMP EMP05 YES. LDA PNBUF NO. STA RLEN SAVE RECORD COUNT. CPA .+5 ANY DATA IN 'BUFUR'? JMP PB0 NO. GO SET HEADER. LDA RCFLG USER WANT SUITCASE ROM TAPE SZA,RSS PUNCHED? JMP EMP1 NO, WANTS REGULAR OBJECT TAPE. JMP EMP00 YES. EMP05 CLA JMP EMP0 EMP00 LDA PNAD PUT ADDR OF OBJ CODE BUFFER IN 'A'. EMP0 JSB SDUMP GO PUNCH SUITCASE ROM TAPE. JMP PB0 EMP1 LDA RLEN GET RECORD LENGTH. ALF,ALF STA PNBUF SET HIGH COUNT. LDA CKSUM PUT IN STA PNBUF+2 CHECKSUM. LDA PCH SUPPRESS SZA,RSS PUNCHING? JMP PB0 JSB TTYPL LIST AND PUNCH ON TTY? SZA JMP EMP22 NO. HLT 52B YES. LET USER TURN ON PUNCH. CLA,INA SET 'TTY BINARY PUNCH' FLAG. STA PNFLG EMP22 LDA .+2 GO PUNCH OUT. JSB IOSUB DEF PCH DEF PNBUF DEF RLEN JSB TTYPL IST AND PUNCH ON TTY? SZA,RSS HLT 53B YES. LET USER TURN OFF PUNCH. CLA CLEAR 'TTY BINARY PUNCH ' FLAG. STA PNFLG PB0 LDA .+5 SET UP STA PNBUF HEADER LDA PCNTR FOR NEXT STA PNBUF+3 RECORD. ADA DBUG ADA PNBUF+1 STA CKSUM LDA DBUG STA PNBUF+4 LDA PBASE POINT ADA .+5 TO STA PNADR BUFUR POSITION JMP EMPBF,I EXIT SKP * 'EQU' PROCESSES AN EQU STATEMENT. * * CALLING SEQUENCE: * LDB * * JSB EQU * * UPON EXIT, A REG = 0 MEANS FIELD CONTAINS 'EQU'. * AND EQU STATEMENT HAS BEEN PROCESSED. * A REG # 0 MEANS FIELD DOESN1T CONTAIN 'EQU'. * IN EITHER CASE, B REG CONTAINS GARBAGE UPON EXIT. * * EQU NOP JSB LOADB CPA .E 1ST CHAR = "E"? RSS YES. JMP EQT9 NO. INB JSB LOADB CPA .Q 2ND CHAR = "Q"? RSS YES. JMP EQT9 NO. INB JSB LOADB CPA .U 3RD CHAR = "U"? RSS YES. JMP EQT9 NO. CLA WE HAVE AN 'EQU'. LDB PASSN CPB .+2 IS THIS PASS 2? JMP EQU,I YES. THEN EXIT NOW. JMP EQU1 NO, PASS 1. GO PROCESS . EQT9 CLA,INA NO 'EQU'. JMP EQU,I EQU1 LDB F6ADR GET OCTAL # FROM FIELD 6. JSB NUM SOC EVERYTHING OK? JMP EQU10 NO. IOR B1KKK YES. PUT 1 IN BIT 15 AS FLAG. JMP EQU25 EQU10 LDA .-7 NO, THEN ERROR. OUTPUT JSB ERROR ERROR MESSAGE. LDA CRLEN OUTPUT THE BAD EQU STATEMENT ADA .-2 WITH PAIR OF EXTRA SPACES AT STA EQU15 BEGINNING IN CASE OF LINE PRINTER LDA .+2 AS LIST DEVICE. JSB IOSUB DEF LIST DEF CARD-1 DEF EQU15 LDA LIST CLB,INB