/ FPP-12 ASSEMBLER / ASSEMBLER FOR PDP-8, FPP-12 FOR DIAL-MS. / WRITTEN BY JACK BURNESS. / TRANSLATED TO P?S/8 (PAL8) FORMAT BY CHARLES LASNER. / DIAL-MS ARTIFACTS HAVE BEEN LEFT IN AS COMMENTS. / LAST EDIT: 05-NOV-1984 17:00:00 CJL / MUST BE ASSEMBLED WITH '/J' (PAL8 '/F') SWITCH SET. /*20 /FPP ASSEMBLER 04/01/71 /COPYRIGHT /DIGITAL EQUIPMENT CORP. /MAYNARD, MASS. / DEFINITIONS. BINARB= 15 BINARY= 6400 CPLBUF= 6000 FLD0= 0 FLD1= 10 LINE= 6200 P0LBUF= 7400 SOURCB= 16 SOURCE= 7000 USEB= 14 USETBL= 6340 / ORG 3 FIELD FLD0%10 /PROGRAM FIELD *3 /INITIAL ORIGIN VERS, 14 /VERSION NUMBER OLDN3, 0 /TEMP FOR LOOKUP OTEMP, 0 /A COUPLE OF TEMPS THAT OCNT, 0 /DIDNT FIT INTO THEIR PAGE PAGSIZ, -76 /LINES PER PAGE COUNTER X10, 0 X11, 0 X12, 0 X13, 0 X14, 0 X15, 0 NEXT, FREE-1 CHRPTR, 0 NCHARS, -1 /CHARACTER INPUT STUFF CPTMP, 0 NCTMP, 0 /USED TO SAVE CHAR POSITION LINSIZ, 0 /SIZE OF LINE FOR PRINTING CHRCNT, -1 /CHAR COUNT FOR INPUT FILE SIZPAG, -76 /NUMBER OF LINES PER PAGE LOCTR1, 0 /24 BIT LOCATION COUNTER LOCTR2, 200 LITRG1, 4000 /FIRST WORD OF LITERAL (FP) ORG LITRG2, 0 BASER, 4000 /BASE REGISTER SETTING 0 EXPVAL, 0 /EXPRESSION VALUE 0 0 EXPTYP, 0 /EXPRESSION TYPE EXPSW, 0 /FLAG=1 IF NO EXPR WORD1, 0 /TEMPORARY 2 WORD OPERAND WORD2, 0 FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR 0 OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER INDEX, 0 /INDEX FLAG = 1 IF INDEX PRESENT INDRCT, 0 /INDIRECT FLAG = 0 IF IND IN FPP XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR BUCKET, 0 /FIRST CHAR OF NAME NAME1, 0 /CHARS 2 AND 3 OF NAME NAME2, 0 /CHARS 4 AND 5 OF NAME NAME3, 0 /CHAR 6 OF NAME AND TYPE LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR PASSNO, 1 /PASS NUMBER ASMOF, 0 /SET TO 1 WHEN ASSEMBLY OFF LINENO, 0 /LINE NUMBER LISTSW, 1 /LIST SWITCH LSTON, 1 /NO LIST OPTION SWITCH OUTSWT, 0 /OUT SWITCH SCSWT, 0 /SEMICOLON SWITCH RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL) LTEMP, 0 /TEMP USED BY LOOKUP EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS EXTMP2, 0 EQUN, 0;0;0;0 FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0 LITRL, 0 /SET = 1 FOR LITERAL DIALRD, 7630 /DIAL INPUT ROUTINE DIALWR, 7632 /DIAL OUTPUT ROUTINE BBLOCK, 0 /CURRENT BINARY OUT BLOCK (REL) BFUDGE, 370 /BINARY FUDGE FACTOR SBLOCK, 0 /CURRENT SOURCE INPUT BLOCK SFUDGE, 370 /SOURCE FUDGE FACTOR STAR20, 0 /IGNORE *20 AT BEGINNING OF FILE P0LIT, 177 CPLIT, 177 ACE, 0 OPE, 0 TMP, 0 ACO, 0 ACL, 0 ACH, 0 OPO, 0 OPL, 0 OPH, 0 PAGE / ORG 177 / ENTER INTERPRETER BY A JMS 177 /FPT, 0 / THE FOLLOWING TRICK MAKES THE ENTRY POINT AT 0177 NOT VIOLATE THE / PAGE ZERO LITERAL TABLE: FPT= [0000] /FPT IS LOCATION 000177 F7600= . /WRONG! WRONG! WRONG! F7400, 7400 DCA ACO /CLEAR AC OVFLO WD TAD I FPT AND F177 DCA FADR /GET LOW ORDER ADDRESS BITS TAD I FPT AND F200 CIA F177, AND FPT /ADD BEGINNING OF PAGE IF NECESSARY TAD FADR DCA FADR TAD I FPT ISZ FPT /BUMP FP LOC CTR F200, AND F7400 CLL CML CMA RTL RTL TAD FPJUMP DCA FPGOTO /FORM JUMP FROM OPCODE FPSNL, SNL CLA /USED AS BASE FOR OPRS JMP .+3 /NO INDIRECT ADDRESSING TAD I FADR DCA FADR TAD FADR DCA TMP /SAVE ADDRESS FOR FUTURE USE TAD I FADR DCA OPE ISZ FADR TAD I FADR DCA OPH ISZ FADR TAD I FADR DCA OPL /LOAD OPERAND DCA OPO /AND ZERO OVFLO WD FPGOTO= . /THIS WILL BE THE RIGHT INSTRUCTION AL1, TAD [0 /RESERVE LOC 177 /SHIFT AC LEFT 1 TAD ACO CLL RAL DCA ACO TAD ACL RAL DCA ACL TAD ACH RAL DCA ACH JMP I AL1 FPOPER, TAD TMP /OPR 0 =EXIT F.P. PACKAGE SNA JMP I FPT TAD FPSNL DCA FPSKIP /OTHERWISE SAME AS PDP-8 CODE TAD ACH FPSKIP, HLT ISZ FPT /EXCEPT SKIP CONDITION REVERSED JMP F7600 FPJMP, TAD TMP DCA FPT JMP F7600 /FLOATING JUMP FPSTO, TAD ACE DCA I TMP TAD ACH ISZ TMP DCA I TMP TAD ACL DCA I FADR /REMEMBER FADR?? JMP F7600 FPLAC, TAD OPL DCA ACL /THIS LOC JUMPED TO FROM PAGE 2 TAD OPH DCA ACH FPLACE, TAD OPE DCA ACE /BECAUSE FPLAC IS JUMPED TO, FALL THROUGH NORM. ANORM, TAD ACH SNA TAD ACL SNA TAD ACO SNA CLA /IF FRACTION IS ZERO, JMP ADCEXP /ZERO EXPONENT NORMLP, CLA CLL CML RTR /2000 TAD ACH SZA /IF ACH=6000, JMP .+3 TAD ACL /AND ACL=0 WERE DONE SZA CLA SPA CLA /OTHERWISE WERE DONE WHEN ACH(0)<>ACH(1) JMP F7600 JMS AL1 /LEFT SHIFT AC ONE PLACE CLA CMA TAD ACE DCA ACE /REDUCE EXPONENT JMP NORMLP /KEEP GOING FPDIV /7000 FPMUL /6000 FPSUB /5000 FPADD /4000 FPLAC /3000 FPSTO /2000 FPJMP /1000 FPOPER /0000 FEXIT /0010 FNOP /0020 FSNA /0030 FSZA /0060 FSPA /0070 FSMA /0120 FSPASNA /0130 FSMASZA AR1, 0 /RIGHT SHIFT AC ONE PLACE CLA CLL TAD ACH SPA CML RAR DCA ACH TAD ACL RAR DCA ACL RAR DCA ACO /ONLY SAVE ONE BIT OF OVERFLOW WORD ISZ ACE POPO, OPO FPJUMP, JMP I AR1 ADCEXP, DCA ACE JMP F7600 /ZERO EXPONENT AND GET NEXT INST. FADR= . FNEGX, 0 /TRIPLE-WORD NEGATION TAD POPO DCA AL1 /AC=0 OR -3 ON ENTRY CLA CLL CMA RTL DCA AR1 NEGLP, CML RAL TAD I AL1 CLL CIA DCA I AL1 ISZ AL1 ISZ AR1 JMP NEGLP JMP I FNEGX PAGE / ORG 400 /SECOND PAGE OF FLOATING POINT PACKAGE OADD, 0 /ADD OP TO AC CLL TAD OPO TAD ACO DCA ACO RAL TAD OPL TAD ACL DCA ACL RAL TAD OPH TAD ACH DCA ACH JMP I OADD FPSUB, JMS I PNEG FPADD, TAD OPH SNA CLA JMP I PANORM /OP=0 - NOP TAD ACH SNA CLA JMP DOADDS+2 /AC=0 - SET AC TO OP FPADLP, TAD ACE CLL CIA TAD OPE SNA /COMPARE AC EXP TO OP EXP JMP DOADDS /EQUAL - GO ADD SMA JMS I PAR1 /OPE>ACE SPA CLA JMS OR1 /ACE>OPE JMP FPADLP DOADDS, JMS OR1 JMS I PAR1 /UNNORMALIZE BOTH BY ONE PLACE JMS OADD JMP I PFPLCE /SET ACE=OPE (IN CASE AC WAS 0) OR1, 0 /SHIFT OPERAND RIGHT ONE PLACE CLA CLL TAD OPH SPA CML RAR DCA OPH TAD OPL RAR DCA OPL RAR DCA OPO /OP OVFLO WD ISZ OPE FITCNT, 0 JMP I OR1 FPMUL, TAD OPH SNA CLA JMP I PFPLAC TAD ACH SNA CLA JMP I PANORM /EITHER ARG=0 MEANS RESULT=0 TAD ACE TAD OPE DCA OPE TAD ACH DCA OR1 TAD ACL DCA TMP TAD FM30 /ITERATION COUNTER DCA FITCNT DCA ACH DCA ACL CLL JMP FPMDCD FPMLLP, JMS I PAR1 /RIGHT SHIFT AC ONE PLACE TAD OR1 RAR DCA OR1 TAD TMP RAR DCA TMP /RIGHT SHIFT MULTIPLIER FPMDCD, TAD TMP RAL IAC RTR SNL CLA /DOES BIT SHIFTED OUT = NEXT BIT? JMP FMNOAD /YES - DO NOTHING JMS I PNEG /NEGATE MULTIPLICAND JMS OADD /ADD TO PRODUCT FMNOAD, ISZ FITCNT JMP FPMLLP JMP I .+1 /NOW GO SET ACE = OPE PFPLCE, FPLACE FM30, -30 FPDIV, TAD OPH SNA JMP I PFPLAC /DIVIDE BY ZERO RESULTS IN ZERO! SMA CLA /CHECK DIVISOR SIGN JMP .+3 CLA CLL CMA RTL /IF NEGATIVE, JMS I PNEG /NEGATE AC JMS I PAR1 /UNNORMALIZE DIVIDEND ONE PLACE TAD OPE CIA TAD ACE DCA OPE /SET UP RESULTANT EXPONENT TAD FM30 DCA FITCNT /SET UP ITERATION COUNT TAD ACH RAL /INITIALIZE LINK FPDVLP, CLA RAR /GET DIVIDEND SIGN FROM LINK AFTER LEFTSHIFT TAD OPH SMA CLA /DOES DIVIDEND SIGN = DIVISOR SIGN? JMS I PNEG /YES - NEGATE DIVISOR JMS OADD /ADD DIVISOR TO DIVIDEND TAD ACE RAL /ADD CARRY INTO QUOTIENT DCA ACE TAD TMP RAL DCA TMP JMS I PAL1 /LEFT SHIFT DIVIDEND ISZ FITCNT JMP FPDVLP /LOOP TAD TMP DCA OPH TAD ACE JMP I .+1 PFPLAC, FPLAC+1 /PUT RESULT INTO AC PANORM, ANORM PNEG, FNEGX PAR1, AR1 PAL1, AL1 PAGE NEXTST, CLA CMA /CHECK PASS NUMBER TAD PASSNO SNA CLA JMP START /IF PASS 1 THEN NO LISTING TAD LISTSW /CHECK LIST STATUS SNA CLA JMP START /NO, DONT LIST TAD OUTSWT /DID THIS LINE GENERATE OUTPUT? SZA CLA JMP START /YES, NO PRINT NECESSARY JMS I [PRINTC /PRINT CR/LF TAD LINENO /PRINT LINE NUMBER JMS I [OCTOUT TAD [247 JMS I [PRINTC /THEN TAB TAD [247 /ANOTHER TAB JMS I [PRINTC JMS I (PRNTLN /THEN PRINT LINE START, JMS I [GETCHR /ANY MORE CHARS ? JMP NOTEG JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE 0507 /*EG* NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ? SNA CLA JMP .+5 /NO DCA SCSWT /KILL SC SWITCH ISZ CHRPTR /SKIP OVER SEMICOLON ISZ NCHARS JMP I (ASMBL /DONT READ NEW LINE TAD [LINE-1 /RESET POINTER DCA CHRPTR TAD (-137 /95 CHARACTERS ONLY DCA MAXLIN DCA OUTSWT /CLEAR OUTPUT SWITCH DCA LTMSG /SET LT MESSAGE SWITCH RDLOOP, ISZ CHRCNT /ANY MORE CHARS IN THIS BLOCK? JMP NOREAD /YES, GO GET IT TAD M1000 /NUMBER OF CHARS PER BLOCK DCA CHRCNT TAD [SOURCE /SOURCE FILE BUFFER DCA WDPTR /INTO POINTER DCA ODDEVN /START WITH EVEN CHAR TAD SBLOCK /FIND BLOCK NUMBER TAD SFUDGE DCA RDBLOK TAD STAR20 /CHECK FOR FIRST READ SZA CLA JMP .+6 ISZ STAR20 /SET SWITCH TAD (-774 /IGNORE FIRST FOUR CHARACTERS DCA CHRCNT TAD (SOURCE+2 /SKIP FIRST TWO WORDS DCA WDPTR JMS I DIALRD /DIAL READ SRCUNT, 0 /SOURCE UNIT SOURCB /CORE LOC OVER 256 RDBLOK, 0 /BLOCK NUMBER 1 /NUMBER OF BLOCKS CLA /DOES DIAL RETURN ZERO AC? ISZ SBLOCK /INCREMENT RELATIVE BLOCK NUMBER NOREAD, TAD ODDEVN /WHICH CHAR? SZA CLA JMP ODDCHR /ODD ONE ISZ ODDEVN /FLIP SWITCH TAD I WDPTR /GET EVEN CHAR RTR RTR RTR DOCHR, AND [77 /SIX BITS SNA /ZERO IS EOF JMP I (ENDX /SO DO "END" TAD [-43 /DIAL CR SNA JMP ENDLIN /BUMP LINE NUMBER TAD (3 /CONVERT TO ASCII SPA TAD [100 TAD [240 DCA I CHRPTR ISZ MAXLIN /TEST FOR LINE TOO LONG JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1 CLA CMA DCA MAXLIN /IGNORE REST OF LINE CLA CMA TAD CHRPTR /BACK UP BUFFER DCA CHRPTR ISZ LTMSG /SET SWITCH JMP RDLOOP ODDCHR, DCA ODDEVN TAD I WDPTR /GET ODD CHAR ISZ WDPTR /BUMP WORD POINTER JMP DOCHR ENDLIN, ISZ LINENO /BUMP LINE NUMBER M1000, NOP TAD LINENO MQL /PUT LINE NUM INTO MQ CLA /NO BUG ON NON-MQ MACHINES TAD CHRPTR /FIND - NUMBER OF CHARS - 1 CMA TAD [LINE-1 DCA NCHARS IAC /SAVE SIZE OF LINE FOR PRINT TAD NCHARS DCA LINSIZ TAD [LINE-1 DCA CHRPTR /SET POINTER TAD LTMSG /CHECK FOR LINE TOO LONG MESSAGE SNA CLA JMP I (ASMBL /NONE, OK JMS I [ERMSG /PRINT LINE TOO LONG MESSAGE 1424 /*LT* JMP I (ASMBL MAXLIN= LTEMP ODDEVN, 0 LTMSG, 0 WDPTR, 0 PAGE ASMBL, JMS I [GETCHR /LOOK FOR A CHARACTER JMP I [NEXTST TAD [-257 /IS IT SLASH ? SNA JMP NOASM /YES, COOL IT TAD (257-244 /IS IT $ SNA JMP ISDOLR TAD (244-240 /IS IT BLANK OR TAB ? SNA CLA JMP ASMBL /YES, TRY AGAIN JMS I [BACK1 /NO, PUT IT BACK JMS I [CKKILL /CHECK FOR ABORT TAD ASMOF /IS ASSEMBLY SWITCHED OFF ? SNA CLA JMP I (LUNAME /ASSEMBLE STMT NOASM, CLA CMA DCA NCHARS /DONT ASSEMBLE THIS LINE JMP I [NEXTST /(PREVENTING *EG* MESSAGE) ISDOLR, DCA ASMOF /TURN ASSEMBLY BACK ON (IF IT WAS OFF) JMP I [NEXTST OVER3, 0 /DIVIDE AC BY THREE DCA EXTMP2 /MQ TAD (-15 /SET SHIFT COUNT DCA LTEMP DIVLUP, CLL /ZERO LINK TAD (-3 /SUBTRACT DIVISOR FROM AC SZL /IF AC>=3 SET LINK TO 1 JMP .+3 /OK, DONT RESTORE TAD (3 /TOO SMALL, RESTORE AC CLL /SET LINK BACK TO 0 DCA EXTMP /SAVE AC TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK INTO MQ RAL DCA EXTMP2 /SAVE MQ TAD EXTMP /GET BACK AC RAL /COMPLETE SHIFT ISZ LTEMP /TEST COUNT JMP DIVLUP /KEEP GOING DCA EXTMP /THIS IS REMAINDER TAD EXTMP2 /RETURN QUOTIENT JMP I OVER3 OCTOUT, 0 DCA OTEMP /SAVE WORD TAD [-4 DCA OCNT /FOUR DIGITS OLOOP, TAD OTEMP CLL RTL RAL DCA OTEMP /SAVE SHIFTED WORD TAD OTEMP RAL /SHIFT REST OF THE WAY AND [7 TAD [260 /CONVERT TO ASCII JMS I [PRINTC ISZ OCNT JMP OLOOP TAD [240 /PRINT BLANK JMS I [PRINTC JMP I OCTOUT ENDEXP, JMS I [BACK1 /END OF EXPR, PUT BACK CHAR TAD LITRL /LITERAL ? SZA CLA JMS I (CRLIT /GO CREATE LITERAL TAD EXPSW /DONT SKIP IF NO EXPRESSION SZA CLA JMP I (BAD /BECAUSE ITS AN ERROR TAD LASTOP /WAS THERE A TRAILING OPERATOR ? SNA JMP I (OKEXP /NO, JUST RETURN TAD (-1 /WAS IT PLUS ? SNA TAD XINCR /AND IS IT LEGAL ? SNA CLA JMP I (OKEXP /YES TO BOTH JMP I (BAD LITORX, JMS I [ADRGET /GET ORIGIN TAD LITRG1 /PREVIOUS LITORG ? SMA CLA JMP I [NEXTST /YES, IGNORE THIS ONE TAD EXPVAL+1 AND [7 DCA LITRG1 TAD EXPVAL+2 DCA LITRG2 JMP I [NEXTST PAGE LUNAME, TAD CHRPTR /SAVE CHAR STUFF DCA CPTMP TAD NCHARS DCA NCTMP JMS I [GETNAM /LOOK FOR NAME JMP I EXPGET /NONE, MIGHT BE EXPRESSION JMS I [GETCHR /LOOK FOR COMMA JMP JSTONE /ITS JUST ONE SYMBOL TAD (-254 /COMMA TEST SZA JMP TRYEQU /NO COMMA, CHECK FOR EQUAL JMS I [LOOKUP /LOOK UP SYMBOL JMP NEWLBL /ITS COMPLETELY NEW SNA CLA JMP DEFLBL /ITS UNDEFINED TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION CIA TAD LOCTR1 /FIRST UPPERR HALF SZA CLA JMP .+6 TAD I X10 CIA TAD LOCTR2 /THEN LOWER HALF SNA CLA JMP DEFIND JMS I [ERMSG /MULTIPLY DEFINED 1504 /*MD* JMP I (ASMBL /FIELD IS OK NEWLBL, CLL CML RTL /BUMP NEXT BY 2 TAD NEXT /TO MAKE ROOM DCA NEXT /FOR NEW SYMBOL DEFLBL, ISZ I LTEMP /SET TYPE TO 1 (USER ADDR) TAD LOCTR1 /PUT LOCATION COUNTER DCA I X10 /INTO VALUE TAD LOCTR2 DCA I X10 DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG JMP I (ASMBL TRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN SZA JMP TRYBLK /NO, TRY BLANK TAD NAME1 DCA EQUN /SAVE 6 CHARACTER NAME TAD NAME2 DCA EQUN+1 TAD NAME3 DCA EQUN+2 TAD BUCKET DCA EQUN+3 JMS I [EXPR /GET VALUE RIGHT OF EQUALS JMP EQUERR /BAD EQU TAD EXPTYP /IS EXPR UNDEFINED ? SNA CLA JMP I [NEXTST /YES, LEAVE SYMBOL UNDEFINED TAD EQUN /RESTORE NAME DCA NAME1 TAD EQUN+1 DCA NAME2 TAD EQUN+2 DCA NAME3 TAD EQUN+3 DCA BUCKET JMS I [LOOKUP /LOOKUP SYMBOL JMP NEWSYM /NEW SYMBOL SNA IAC /REFNCD BUT UNDEF, ASSUME ADDR TYPE CIA TAD EXPTYP /COMPARE TYPES SZA CLA JMP EQUERR /TYPE CONFLICT PUTVAL, CLL CMA RAL /-2 TAD EXPTYP /GO TO PROPER PLACE SPA SNA CLA JMP MOV2WD TAD EXPVAL /F.P. SYMBOL DCA I X10 MOV2WD, TAD EXPVAL+1 /D.P. OR ADDRESS SYMBOL DCA I X10 TAD EXPVAL+2 DCA I X10 TAD I LTEMP /NOW GET TYPE WORD AND (7740 /ZERO OLD TYPE (PRESERVING FORCE BIT) TAD EXPTYP /PUT IN NEW DCA I LTEMP /RESTORE WORD CDF FLD0 JMP I [NEXTST /GO GET NEXT STMT EQUERR, JMS I [ERMSG /BAD EQU 0205 /*BE* JMP I [NEXTST NEWSYM, CLL CMA RTL /-3 TAD EXPTYP /BUMP NEXT BY CORRECT NUMBER SMA CLA ISZ NEXT /THRICE FOR FLOATING ISZ NEXT /TWICE FOR DP AND ADDRESS ISZ NEXT JMP PUTVAL TRYBLK, TAD (35 /CHECK FOR BLANK SZA CLA JMP I EXPGET /NO BLANK, GO TRY FOR EXPRESSION JSTONE, JMS I [LOOKUP /LOOKUP SYMBOL JMP I (NEWONE /ITS A NEW SYMBOL TAD OPCTBL /CREATE JUMP THRU TABLE DCA OPCJMP /SAVE IT TAD I X10 /PICK UP FIRST WORD OF VALUE DCA OPCODE /ITS AN OPCODE-MAYBE? CDF FLD0 OPCJMP, 0 /JUMP SOMEWHERE OPCTBL, JMP I .+1 EXPGET, GETEXP /UNDEFINED GETEXP /USER ADDRESS GETEXP /USER DP GETEXP /USER FP GETEXP /PDP 8 OPERATE PSEUDO /PSEUDO OP PDP8MR /PDP8 MR FPPMR /FPPMR FPPS1 /OTHER FPP OPCODES FPPS2 FPPS3 FPPS4 FPPS5 FPPMRL /FPP 2 WORD MR FORMAT PAGE NEWONE, DCA I NEXT /RESERVE 2 WORDS DCA I NEXT /THUS ASSUMING ADDR TYPE CDF FLD0 GETEXP, TAD CPTMP /RESTORE CHARACTER POINTER DCA CHRPTR TAD NCTMP /TO JUST AFTER TAG (IF ANY) DCA NCHARS JMS I [EXPR /TRY FOR AN EXPRESSION JMP BADEXP /IF NONE, ERROR CLL CMA RAL TAD EXPTYP /CHECK TYPE SNA JMP OUT2WD /D,P,. OUTPUT 2 WORDS SPA CLA JMP OUT1WD /ADDRESS, OUTPUT 1 WORD OUT3WD, TAD EXPVAL /F.P., OUTPUT 3 WORDS JMS I [OUTWRD OUT2WD, TAD EXPVAL+1 JMS I [OUTWRD OUT1WD, TAD EXPVAL+2 JMS I [OUTWRD JMP I [NEXTST /GO DO NEXT STMT BADEXP, JMS I [ERMSG /BAD EXPRESSION 0230 JMP I [NEXTST /DO NEXT STMT FPPMR, JMS I [CHKIND /CHECK FOR INDIRECT CLA IAC /SET SWITCH DCA INDRCT JMS I [GETADR /GO GET ADDRESS AND INDEX TAD FPPWD2 /CHECK FOR FORCED 2 WORD ADDR SZA CLA JMP FORMT1 /FORWD REFNCE, USE 2 WORD FORMAT TAD BASER+1 CLL CML CIA /COMPARE BASE WITH ADDR TAD FPPADR+1 DCA WORD2 /BY DOUBLE SUBTRACTION RAL TAD BASER CIA TAD FPPADR SZA CLA JMP FORMT1 /IF HIGH ORDER WORD NOT 0, LONG FORM TAD INDRCT /IF INDIRECT, USE SHORTEST FORM SNA CLA JMP FORMT3 TAD INDEX /IF INDEX USED, MUST USE LONG SZA CLA JMP FORMT1 TAD WORD2 /COMPARE ADDR-BASE CLL TAD (-600 /IF <= 128*3, CAN USE SHORT SZL CLA JMP FORMT1 /OTHERWISE USE 2 WORD FMT FORMT2, TAD WORD2 /DIVIDE DISPLACEMENT BY THREE JMS I (OVER3 TAD OPCODE /ADD OPCODE TO DISPLACEMENT TAD [200 /TURN ON A BIT JMS I [OUTWRD /OUTPUT IT JMP I [NEXTST FPPMRL, JMS I [CHKIND /CHECK FOR "I" (INDIRECT) CLA IAC /SET SWITCH DCA INDRCT JMS I [GETADR /GET ADDRESS FIELD FORMT1, TAD INDRCT /CHECK FOR INDIRECT SZA CLA /IF INDIRECT, THIS IS A NO-NO JMP .+4 JMS I [ERMSG /ILLEGAL INDIRECT 1111 /*II* DCA INDRCT /CLEAR SWITCH JMS I [FIXOPC /GO PUT IN INDEX AND INCREMENT TAD FPPADR /GET ADDRESS EXTENSION AND [7 TAD OPCODE /PLUS OPCODE JMS I [OUTWRD /OUTPUT IT TAD FPPADR+1 JMS I [OUTWRD /THEN REST OF ADDRESS JMP I [NEXTST FORMT3, TAD WORD2 /TRY INDIRECT FORMAT CLL TAD [-30 /DISPLACEMENT CAN BE < OR = TO 7 SNL CLA JMP .+4 DCA WORD2 /SET DISPLACEMENT TO 0 JMS I [ERMSG /ILLEGAL INDIRECT 1111 /*II* JMS I [FIXOPC /STICK IN INDEX AND INCR TAD WORD2 /GET DISPLACEMENT JMS I (OVER3 /DIVIDE BY THREE TAD OPCODE /PLUS OPCODE TAD [200 /PLUS ANOTHER BIT JMS I [OUTWRD /OUTPUT JMP I [NEXTST FPPS1, JMS I [CHKIND /WAS INDIRECT ASKED FOR ? JMP .+3 /NO JMS I [ERMSG /*II* 1111 JMS I [GETADR /GET ADDR, AND INDEX JMS I [FIXOPC /PUT OPCODE TOGETHER TAD FPPADR /GET ADDR EXTENSION AND [7 TAD OPCODE /WITH TOGETHER OPCODE AND (7377 /WITHDRAW ONE BIT JMS I [OUTWRD /OUTPUT THIS TAD FPPADR+1 JMS I [OUTWRD /NOW OUTPUT REST OF ADDRESS JMP I [NEXTST FPPS3, TAD OPCODE /JUST PUT OUT OPCODE JMS I [OUTWRD JMP I [NEXTST PSEUDO, JMP I OPCODE /GO HANDLE PSEUDO OP PAGE PDP8MR, JMS CHKIND /CHECK FOR INDIRECT JMP .+4 /NO TAD OPCODE /PUT INDIRECT INTO OPCODE TAD (400 DCA OPCODE JMS ADRGET /PICK UP ADDRESS FIELD TAD EXPVAL+2 /CHECK PAGE OF ADDRESS AND [7600 SNA JMP PAGE0 /ITS IN PAGE 0 CIA TAD LOCTR2 /COMPARE WITH CURRENT PAGE AND [7600 SNA CLA JMP THSPAG /OK, ITS THIS PAGE TAD OPCODE /CAN WE USE A LINK ? AND (400 /IS INDIRECT BIT ON ? SNA CLA JMP MAKLNK /YES, GO MAKE LINK JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE 1122 /*IR* JMP THSPAG+1 MAKLNK, JMS I (CRLINK /YES, CREATE LINK THSPAG, TAD EXPVAL+2 /GET ADDRESS AND [177 /LOWER 7 BITS TAD [200 /PUT IN PAGE BIT SKP PAGE0, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO) TAD OPCODE /PLUS OPCODE JMS I [OUTWRD /OUTPUT WORD JMP I [NEXTST FPPS2, JMS ADRGET /GET ADDRESS FIELD TAD EXPVAL+1 /PUT EXTENSION AND [7 TAD OPCODE /WITH OPCODE JMS I [OUTWRD /OUT TAD EXPVAL+2 JMS I [OUTWRD /REST OF ADDR JMP I [NEXTST FPPS4, JMS ADRGET /GET INDEX REG EXPRESSION TAD EXPVAL+2 /GET LOWER 3 BITS AND [7 /OF INDEX REG EXPR TAD OPCODE /WITH OPCODE JMS I [OUTWRD /OUT JMP I [NEXTST FPPS5, CLA IAC /SET INDEX INCR SWITCH OFF JMS GETADR /GET ADR AND INDEX FIELDS TAD INDEX /WAS THERE AN INDEX? SNA CLA JMP .+3 /NO TAD EXPVAL+2 /YES, GET 3 BITS AND [7 TAD OPCODE /GET OPCODE JMS I [OUTWRD /OUTPUT TAD FPPADR+1 /NOW OUTPUT LOWER 12 BITS JMS I [OUTWRD /OF ADDRESS JMP I [NEXTST XITEMP, CHKIND, 0 /CHECK FOR "I" TAD CHRPTR /SAVE CHAR POSITION DCA CPTMP TAD NCHARS DCA NCTMP JMS I [GETNAM /LOOK FOR NAME "I" JMP I CHKIND /IF NO NAME, NO INDIRECT TAD BUCKET /DID IT START WITH "I"? TAD (-11 SZA CLA JMP NOTIND /NO, GO AWAY TAD NAME1 /WAS "I" ENTIRE NAME? SZA CLA JMP NOTIND /NO, GO AWAY ISZ CHKIND /YES, SKIP ON RETURN JMS I [GETCHR /LOOK FOR BLANK JMP I CHKIND /NONE LEFT, RETURN TAD [-240 SZA CLA JMS I [BACK1 /NOT BLANK, BACKUP JMP I CHKIND /RETURN NOTIND, TAD CPTMP /RESET CHAR POSITION DCA CHRPTR TAD NCTMP DCA NCHARS JMP I CHKIND /RETURN, NO SKIP ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE JMS I [EXPR /GET EXPR JMP ERR1 CLA CLL CMA RAL /MUST BE TYPE 1 OR 0 (ADR OR UND) TAD EXPTYP SPA SNA CLA JMP I ADRGET ERR1, JMS I [ERMSG /BAD ADDR EXPR 0230 /*BX* DCA EXPVAL+1 /SET EXPR TO 0 DCA EXPVAL+2 JMP I ADRGET GETADR, 0 /GET ADDR, INDEX DCA XITEMP /SAVE INDEX INCREMENT SWITCH ISZ FPPSWT /TELL EXPR ITS AN FPP INSTR JMS ADRGET /GET ADDR DCA FPPSWT /KILL FPP SWITCH TAD EXPTYP /IF EXPR WAS UNDEFINED SNA CLA IAC /OR FORCE BIT WAS SET TAD FPP2WD DCA FPPWD2 /FORCE 2 WORD FORMAT DCA INDEX /ZERO INDEX SWT TAD EXPVAL+1 /SAVE ADDRESS VALUE DCA FPPADR TAD EXPVAL+2 DCA FPPADR+1 JMS I [GETCHR /LOOK FOR COMMA JMP I GETADR /NO INDEX TAD (-254 SZA CLA JMP ERR2 /NON COMMA IS BAD ISZ INDEX /SET INDEX SWITCH TAD XITEMP /SET INDEX INCREMENT SWITCH DCA XINCR JMS ADRGET ISZ XINCR /CLEAR INDEX INCREMENT SWITCH JMP I GETADR ERR2, JMS I [ERMSG /BAD ADDR EXPR 0230 /*BX* JMP I GETADR PAGE PRNTLN, 0 /PRINT THE LINE TAD OUTSWT /HAS THE LINE BEEN PRINTED YET? SZA CLA JMP I PRNTLN /YES, COOL IT ISZ OUTSWT /SET SWITCH TAD [LINE-1 /POINTER TO LINE DCA X10 TAD I X10 /GET A CHAR JMS I [PRINTC /PRINT IT ISZ LINSIZ /BUMP COUNT JMP .-3 JMP I PRNTLN GETUNT, 0 /GET UNIT FOR CHAIN JMS I [GETCHR /IS ANYTHING THERE ? JMP NOUNIT /TREAT IT AS UNIT 0 JMS I [BACK1 /PUT BACK EXPR CHAR JMS I [ADRGET /GET UNIT EXPR TAD EXPVAL+2 TAD (-10 /CHECK RANGE SMA /CHECK RANGE JMP I (CHERR /TOO BIG TAD (10 SPA JMP I (CHERR /TOO SMALL NOUNIT, DCA I (UNIT /SAVE UNIT JMP I GETUNT /RETURN FP, TAD EXPSW /FIRST TIME THRU ? SNA CLA JMP .+3 /NO TAD (3 /SET TYPE TO 3 (FP) DCA EXPTYP TAD EXPTYP /CHECK TYPE OF EXPR SO FAR SZA /0 (UND) IS OK TAD (-3 /SO IS 3 (FP) SZA CLA JMP I (MXDTYP /ANYTHING ELSE IS A NO-NO TAD I X10 /GET OPERAND DCA OPRAND TAD I X10 DCA OPRAND+1 TAD I X10 DCA OPRAND+2 CDF FLD0 DCA EXPSW /CLEAR FIRST TIME SWITCH TAD (XFPTBL-1 /GET CORRECT FP OPERATION TAD LASTOP /LAST OPERATOR DCA XFOPR /ADDR OF CORRECT OPERATION TAD I XFOPR /GET CORRECT OPERATION DCA XFOPR /STORE IT JMS 177 /ENTER FPPRL 3000 EXPVAL /FPLAC EXPVAL XFOPR, 0 /FPXXX OPRAND 2000 EXPVAL /FPSTO EXPVAL 0 /FPEXIT JMP I [OPR8R /GO GET OPERATOR XOPRND= OPRAND&177 /PAGE ADDR OF OPRAND XBAD= BADX&177 /PAGE ADDR OF BADX XFPTBL, 4200 XOPRND /FPADD OPRAND 5200 XOPRND /FPSUB OPRAND 6200 XOPRND /FPMUL OPRAND 7200 XOPRND /FPDIV OPRAND 1200 XBAD /FPJMP BADX 1200 XBAD /FPJMP BADX BADX, 0 /FPEXIT JMP I (BAD /& ! BAD FOR FP OR DP INFP, JMS I (FLINTP /GET FP OR DP NUMBER JMP FP /ITS FP TAD I X10 /ITS DP, BUT NORMALIZED DP, DCA OPRAND /PUT EXPONENT TAD I X10 /THEN HIGH PART DCA OPRAND+1 TAD I X10 /THEN LOW PART DCA OPRAND+2 CDF FLD0 TAD EXPSW /TYPE CHECK SNA CLA JMP .+3 CLL CML RTL /FIRST TIME SETS TYPE DCA EXPTYP TAD EXPTYP /CHECK SZA /0 OR 2 OK TAD (-2 SZA CLA JMP I (MXDTYP /MIXED TYPES DCA EXPSW TAD LASTOP /GET CORRECT OPERATION TAD (XFPTBL-1 DCA XDOPR TAD I XDOPR DCA XDOPR JMS 177 /ENTER FPPRL 3200 XOPRND /FPLAC OPRAND 2200 XOPRND /FPSTO OPRAND (NORMALIZES) 3000 EXPVAL /FPLAC EXPVAL XDOPR, 0 /FPXXX OPRAND 0 /FEXIT UNNORM, TAD ACE /CHECK EXPONENT SNA JMP MOVEDP /DONT SHIFT IF EXP 0 SMA TAD (-27 /IF POS EXP, INTEGERIZE SMA CLA JMP MOVEDP /IF STILL POS DONT SHIFT JMS I (AR1 /SHIFT AC RIGHT 1 JMP UNNORM /CONTINUE UN-NORMALIZATION MOVEDP, DCA EXPVAL /ZERO EXPONENT TAD ACL DCA EXPVAL+2 /LOWER WORD TAD ACH DCA EXPVAL+1 /UPPER WORD JMP I [OPR8R /GET OPERATOR /OPRAND,0.0 OPRAND, 0;0;0 PAGE FLINTP, 0 DCA PRSW /SET PERIOD SWITCH JMS DECONV JMS I [GETCHR /GET CHAR JMP ENDFPN+1 TAD [-256 /IS IT "." SZA CLA JMP ENDFPN /IF NOT, LOOK FOR EXPONENT TAD PRSW /PERIOD FOUND PREVIOUSLY ? SZA CLA JMP PER2 /YES, SECOND PERIOD DCA DNUMBR /ZERO DIGIT COUNT ISZ PRSW /SET PERIOD SWITCH JMP DECON /CONVERT REST OF STRING ENDFPN, JMS I [BACK1 /PUT BACK NON PERIOD TAD PRSW /PERIOD READ IN PREVIOUSLY ? SZA CLA PER2, TAD DNUMBR /YES, -NUMBER OF DIGITS TO SEXP CIA /NO, ZERO TO SEXP DCA SEXP TAD RADIX /SAVE RADIX DCA DECONV ISZ RADIX /AND SET RADIX TO DECIMAL JMS I [GETCHR /CHECK TERMINATOR JMP FPFIX /END OF LINE TAD (-305 /"E"? SNA JMP .+4 /YES IAC /"D"? SNA ISZ FLINTP /SKIP ON RETURN IF DP SZA CLA /"D" OR "E" ? JMP FPFIX-1 /NO, END OF NUMBER JMS I [GETCHR /LOOK FOR SIGN JMP FPFIX /NO SIGN TAD (-253 /IS IT + SNA JMP ISPLUS /YES TAD (253-255 /IS IT - SNA CLA JMP ISPLUS+1 /YES JMS I [BACK1 /PUT IT BACK ISPLUS, IAC DCA FPESGN /SET EXP SIGN JMS I [NUMBER /GET EXP JMP FPFIX /NO EXP TAD FPESGN /GET SIGN INDICATOR CLL RAR /INTO LINK TAD WORD2 /EXPONENT VALUE SNL CIA /COMPLEMENT IF SIGN - TAD SEXP /NUMBER OF DIGITS RIGHT OF . DCA SEXP /GIVES MODIFIED EXPONENT SKP JMS I [BACK1 /RETURN CHAR FPFIX, TAD SEXP /KEEP GOING ? SNA JMP ENDFPI /NO, RETURN SMA CLA JMP MULT10 /MULT BY 10. ISZ SEXP /INCREMENT BY 1 NOP JMS 177 TEN&177+7200 /DIVIDE BY 10. 0 JMP FPFIX MULT10, CLA CMA /DECREMENT BY 1 TAD SEXP DCA SEXP JMS 177 TEN&177+6200 /MULTIPLY BY 10. 0 JMP FPFIX ENDFPI, JMS 177 /PUT NUMBER INTO FPTMP FPTMP&177+2200 0 TAD DECONV /RESTORE RADIX DCA RADIX TAD (FPTMP-1 DCA X10 /SET POINTER IN X10 JMP I FLINTP /RETURN TEN, 4;2400;0 /10. PRSW, 0 SEXP, 0 DECONV, 0 DCA ACE /ZERO FAC DCA ACL DCA ACH DCA ACO DCA DNUMBR /ZERO DIGIT COUNT DECON, JMS I [GETCHR /GET A CHARACTER JMP I DECONV /RETURN TAD [-272 /TEST FOR DIGIT SMA JMP NOTFPD /NOT A DIGIT TAD [12 SPA JMP NOTFPD DCA FPDIGT+2 /STORE IN LOW PART OF FP NUMBER JMS 177 FPTMP&177+2200 /SAVE FAC FPDIGT&177+3200 /NORMALIZE DIGIT FPTMP2&177+2200 FPTMP&177+3200 /GET FAC TEN&177+6200 /MULT BY 10. FPTMP2&177+4200 /ADD NEW DIGIT 0 /FEXIT ISZ DNUMBR /INCR DIGIT COUNT JMP DECON /LOOP NOTFPD, JMS I [BACK1 JMP I DECONV DNUMBR, 0 FPDIGT, 27;0;0 FPTMP, 0;0;0 FPTMP2, 0;0;0 FPESGN, 0 / CHAIN "FPPASM2" /*20 PAGE EXPR, 0 /GET EXPRESSION DCA EXPVAL /ZERO EXPR VALUE DCA EXPVAL+1 DCA EXPVAL+2 DCA EXPTYP /AND TYPE CLA IAC /SET EXPR SWITCH TO NO EXPR DCA EXPSW DCA FPP2WD /SET FORCE SWITCH OFF CLA IAC /SET LASTOP TO + DCA LASTOP JMS I [CHKLIT /GO CHECK FOR LITERAL JMS I [GETCHR /LOOK FOR UNARY+ - JMP I EXPR /NO EXPRESSION TAD (-255 /IS IT - SNA ISZ LASTOP /SET LAST OPER8R TO - SZA TAD (255-253 /IS IT + OR - SZA CLA JMS I [BACK1 /NO, PUT CHAR BACK SYMBOL, JMS I [GETNAM /NOW PICK UP NAME JMP NOSYM /NONE, TRY OTHER JMS I [LOOKUP /LOOK IT UP JMP DEFSYM /NEW SYMBOL TAD (-5 /CHECK FOR BADDIES SMA JMP BAD /BAD EXPRESSION TAD SYMTYP DCA .+1 /STORE JUMP 0 /JUMP THRU TABLE SYMTYP, JMP I .+6 PUNDEF, UNDEF /UNDEFINED ADR /USER ADDRESS DP /USER D.P. FP /USER F.P. ONE /PDP-8 OPERATE OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN BAD, CLA JMP I EXPR /RETURN NOSYM, TAD CHRPTR /NO NAME, SAVE CHAR POS DCA EXTMP TAD NCHARS DCA EXTMP2 JMS I (NUMBER /LOOK FOR A NUMBER JMP NOTNUM /NO NUMBER JMS I [GETCHR /LOOK AT NEXT CHAR JMP ADREXP /NO NEXT CHAR, USE NUMBER TAD [-256 /IS CHAR "." SZA TAD (256-305 /IS IT "E" ? SZA IAC /IS IT "D" ? SNA CLA JMP GETFPN /TRY FOR DP NUM JMS I [BACK1 /OTHERWISE PUT IT BACK JMP ADREXP /GO USE IT GETFPN, TAD EXTMP /RESET CHAR POINTER DCA CHRPTR TAD EXTMP2 DCA NCHARS JMP I (INFP /TRY FOR FP OR DP NUMBER NOTNUM, JMS I [GETCHR /NOT A NUMBER, GET A CHAR JMP I (ENDEXP+1 /NONE LEFT, END TAD [-256 /IS IT "." ? SZA CLA JMP I (ENDEXP /NO, END EXPR JMS I [GETCHR /LOOK AT NEXT CHAR JMP ISDOT /NO NEXT CHAR, ITS LOC SYMBOL TAD [-272 /IS NEXT CHAR A DIGIT SMA JMP ISDOT-1 /NO TAD [12 SMA CLA JMP GETFPN /YES, TREAT ".N" AS FP NUMBER JMS I [BACK1 /OTHERWISE PUT IT BACK ISDOT, TAD LOCTR1 /THIS WAS LOC SYMBOL DCA WORD1 /PUT VALUE INTO WORD1,2 TAD LOCTR2 DCA WORD2 JMP ADREXP /AND USE VALUE ADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL AND [40 SZA CLA ISZ FPP2WD /AND SET SWITCH IF BIT ON TAD I X10 /GET FIRST WORD OF VALUE ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0 TAD I X10 /GET REST OF SYMBOL DCA WORD2 CDF FLD0 /FIX FIELD ADREXP, TAD EXPSW /FIRST TIME THROUGH ? SZA /IF SO THEN SET TYPE TO ADDR DCA EXPTYP /OTHERWISE LEAVE IT ALONE CLL CMA RAL TAD EXPTYP /CHECK FOR TYPE CONFLICT SMA CLA JMP MXDTYP /NOT - MEANS FP OR DP DCA EXPSW /KILL FIRST TIME SWITCH TAD LASTOP /PICK UP LAST OPERATOR TAD ADROP /MAKE A JMP I DCA .+1 0 /DO IT ADROP, JMP I . ADRADD ADRSUB ADRMUL BAD /INTEGER DIVIDE NOT IMPLEMENTED ADRAND ADROR MXDTYP, JMS I [ERMSG /MIXED TYPES 1524 /*MT* JMP I [OPR8R DEFSYM, DCA I NEXT /NEW SYMBOL, ALLOCATE 2 WORDS DCA I NEXT JMP I PUNDEF /THEN TREAT LIKE UNDEFINED PAGE UNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ? SNA CLA JMP .+5 /NO, SKIP AROUND TAD I LTEMP /TURN ON FORCE BIT AND (7737 /FOR THIS SYMBOL TAD [40 DCA I LTEMP DCA EXPTYP /SET TYPE TO UNDEFINED CDF FLD0 /FIX FIELD DCA EXPSW /KILL FIRST TIME SWITCH CLL CMA RAL /-2 TAD PASSNO /IF > PASS 1, UNDEFINED ERROR SPA CLA JMP OPR8R /UNDEFINED HAS VALUE 0 JMS I [ERMSG 2523 /*US* OPR8R, TAD (OPR8RS-1 /SET POINTER DCA X11 /TO OPERATOR TABLE DCA LASTOP /ZERO LASTOP JMS I [GETCHR /GET CHAR JMP I (ENDEXP+1 /NONE, DONE DCA EXTMP /SAVE IT FINDOP, TAD I X11 /GET NEXT LIST ENTRY SNA JMP I (ENDEXP /ZERO IS END OF LIST TAD EXTMP /COMPARE SNA CLA JMP GOTOP /THIS IS THE OPERATOR ISZ X11 /NO, BUMP PTR JMP FINDOP /LOOP GOTOP, TAD I X11 /PICK UP OTHER VALUE DCA LASTOP /SAVE IN "LASTOP" JMP I (SYMBOL /LOOK FOR OPERAND ADRADD, TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS CLL /ZERO LINK TAD WORD2 /ADD LOW WORDS DCA EXPVAL+2 /SAVE RESULT RAL /PUT CARRY INTO BIT 11 TAD EXPVAL+1 /ADD HIGH TAD WORD1 /ORDER WORDS DCA EXPVAL+1 /SAVE RESULTT JMP OPR8R /LOOK FOR OPERATOR ADRSUB, TAD WORD2 /SUBTRACT LOW 12 BITS CLL CML CIA TAD EXPVAL+2 DCA EXPVAL+2 /SAVE LOW HALF RAL TAD WORD1 /SUBTRACT HIGH HALF CIA TAD EXPVAL+1 DCA EXPVAL+1 /SAVE HIGH HALF JMP OPR8R /GET OPERATOR ADRAND, TAD WORD1 /AND AND EXPVAL+1 /HIGH DCA EXPVAL+1 /HALF TAD WORD2 /THEN AND EXPVAL+2 /LOW DCA EXPVAL+2 /HALF JMP OPR8R /THEN COOL IT ADROR, TAD WORD1 /OR IS THE SAME AS CMA /SETTING THE BITS AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A TAD WORD1 /AND THEN SETTING THE BITS DCA EXPVAL+1 /THAT ARE ON IN A TAD WORD2 CMA AND EXPVAL+2 TAD WORD2 DCA EXPVAL+2 JMP OPR8R /LOOK FOR OPERATOR ADRMUL, DCA SIGNX /ZERO SWITCH TAD EXPVAL+1 /IS EXPR NEGATIVE SPA CLA JMS COMPL /YES, COMPLEMENT IT TAD (-31 DCA NBITS /BIT COUNT DCA EXTMP /ZERO RESULT (HIGH 24 BITS) DCA EXTMP2 /RECEPTACLE MULOOP, TAD EXTMP /ROTATE 48 BIT REGISTER CLL RAR /RIGHT ONE DCA EXTMP TAD EXTMP2 RAR DCA EXTMP2 TAD EXPVAL+1 RAR DCA EXPVAL+1 TAD EXPVAL+2 RAR DCA EXPVAL+2 SNL /IS LINK ON? JMP NOADD /NO, DONT ADD TAD EXTMP2 /YES, ADD MULTIPLIER CLL /TO HIGH HALF OF 48 BIT TAD WORD2 /RESULT DCA EXTMP2 /(THIS IS A 2 WORD ADD) RAL TAD WORD1 TAD EXTMP DCA EXTMP NOADD, ISZ NBITS /INCREMENT COUNTER JMP MULOOP /LOOP TAD SIGNX /CHECK FOR RE-COMPLEMENT SZA CLA JMS COMPL /YES, GO DO IT JMP OPR8R /LOOK FOR OPERATOR COMPL, 0 ISZ SIGNX /SET SWITCH TAD EXPVAL+2 /COMPLEMENT CLL CML CIA /THE DCA EXPVAL+2 /TWO RAL TAD EXPVAL+1 /WORD CIA /THING DCA EXPVAL+1 JMP I COMPL /RETURN SIGNX= LTEMP NBITS= X10 PAGE CHKLIT, 0 /CHECK FOR LITERAL DCA PAGENO /ZERO PAGE NUMBER DCA LITRL JMS I [GETCHR /GET CHARACTER JMP I CHKLIT /NO LITERAL TAD (-250 /CHECK FOR ( SNA ISZ PAGENO /CURRENT PAGE LITERAL SZA /SKIP IF ALREADY ZERO TAD (-63 /CHECK FOR [ SNA ISZ LITRL /SET SWITCH SZA CLA JMS I [BACK1 /PUT BACK NON ([ JMP I CHKLIT CRLINK, 0 /CREATE LINK TAD CRLINK /FIX RETURN ADDR DCA CRLIT TAD OPCODE /SET INDIRECT BIT TAD (400 DCA OPCODE CLA IAC DCA PAGENO /SET INDICATOR JMS I [ERMSG /*LG* 1407 JMP NOTP0 CRLIT, 0 /CREATE LITERAL WITH TYPE EXPTYP /VALUE:EXPVAL, IN PAGE:PAGENO TAD FPPSWT /FP LITERAL ? SZA CLA JMP I (FPPLIT TAD PAGENO /CHECK FOR PAGE 0 SZA CLA JMP NOTP0 /NOT A PAGE 0 LITERAL TAD (P0LBUF /SET BASE TO PAGE 0 LIT BUFFER DCA LITBAS TAD (17 /ASSUME FIRST 20 WORDS USED JMP DOLIT /GO DO LITERAL NOTP0, TAD (CPLBUF /CURRENT PAGE LIT BUFFER DCA LITBAS TAD LOCTR2 /NUMBER OF WORDS USED IN PAGE AND [177 DOLIT, DCA NWUSED TAD PAGENO /GET POINTER TO TAD [P0LIT /LITERAL BOUNDARY DCA XPAGE TAD I XPAGE /DISPLACEMENT OF LIT BUFR - 1 DCA LITPTR /INTO LITPTR TAD EXPTYP /TYPE IS ACTUALLY SIZE OF LITERAL SZA /CHECK FOR UNDEFINED JMP .+3 /OK, ITS DEFINED DCA EXPVAL+2 /UNDEFINED, ASSUME ZERO IAC /AND ADDRESS TYPE CIA DCA EXPTYP /GET THE COMPLEMENT TAD (EXPVAL+2 TAD EXPTYP /GET POINTER TO VALUE DCA X12 /MINUS ONE INTO X12 NOTIT, TAD EXPTYP /CHECK FOR END OF TABLE CIA TAD LITPTR /POINTER+SIZE AND [200 /SHOULD BE LESS THAN 200 SZA CLA JMP NEWLIT /ENTER NEW LITERAL TAD EXPTYP /PUT COPY OF LENGTH DCA LTEMP /INTO LTEMP TAD X12 /AND COPY OF PROTOTYPE POINTER DCA X15 /INTO X15 TAD LITPTR /NOW GET POINTER TAD LITBAS /TO TABLE DCA X11 /FOR COMPARISON ISZ LITPTR /INCREMENT POINTER TSTLIT, TAD I X11 /GET WORD OF LITERAL CIA TAD I X15 /COMPARE WITH PROTOTYPE SZA CLA JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY ISZ LTEMP /BUMP COUNTER JMP TSTLIT /LOOP IF MORE LITADR, TAD PAGENO /PAGE 0 ? SZA CLA TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS AND [7600 TAD LITPTR /PLUS PAGE DISPLACEMENT DCA EXPVAL+2 /INTO VALUE TAD LOCTR1 RETLIT, DCA EXPVAL+1 CLA IAC /SET TYPE TO ADDRESS DCA EXPTYP JMP I CRLIT NEWLIT, TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN TAD EXPTYP DCA X10 /ADDRESS OF NEW LITERAL TAD NWUSED /CHECK FOR PAGE OVERFULL CIA TAD X10 SMA CLA JMP .+5 /NOT FULL JMS I [ERMSG /*PO* 2017 DCA EXPVAL+2 /ZERO ADDRESS JMP RETLIT TAD X10 DCA I XPAGE TAD I XPAGE /SET UP POINTER FOR MOVE TAD LITBAS DCA X10 TAD I X12 /MOVE LITERAL INTO PLACE DCA I X10 ISZ EXPTYP JMP .-3 TAD I XPAGE /SET UP LITERAL ADDRESS IAC DCA LITPTR JMP LITADR /RETURN LITERAL ADDRESS PAGENO, 0 XPAGE, 0 LITBAS, 0 NWUSED, 0 LITPTR, 0 PAGE FPPLIT, CLA IAC DCA FPP2WD /FORCE 2 WORD INSTRUCTION CLA CMA /WHAT PASS ? TAD PASSNO SNA CLA JMP I (RETLIT /PASS 1 DONT GENERATE FP LITERALS JMS TYPE3 /SKIP IF FP OR ADDR TYPE IAC /DP TYPE TAD (FPLIST /POINTER TO FP LITERAL BUCKET CDF FLD1 FPLOOK, DCA OLDFP /START ADDR OF CURRENT BLOCK TAD I OLDFP /ADDR OF NEXT BLOCK SNA JMP NEWFPL /IF 0 THEN END OF LIST DCA X10 TAD I X10 /GET DISPLACEMENT DCA LTEMP /SAVE IT JMS TYPE3 JMP CMP2WD /DP, ONLUT 2 WORDS TAD EXPVAL /DO 3 WORD COMPARE CIA CLL TAD I X10 SZA CLA JMP DIFFPL /NOT THE SAME CMP2WD, TAD EXPVAL+1 CIA CLL TAD I X10 SZA CLA JMP DIFFPL TAD EXPVAL+2 CIA CLL TAD I X10 SZA CLA JMP DIFFPL RETFPL, TAD LTEMP /GET LITERAL DISPLACEMENT CDF FLD0 CLL /ADD LITORG ADDR TAD LITRG2 DCA EXPVAL+2 /AND MAKE IT THE NEW EXPVAL RAL TAD LITRG1 JMP I (RETLIT DIFFPL, SZL JMP NEWFPL /INSERT NEW LITERAL HERE TAD I OLDFP /GET START ADDR OF THIS BLOCK JMP FPLOOK NEWFPL, TAD I OLDFP /HOOK IN NEW FP LITERAL DCA I NEXT TAD NEXT DCA I OLDFP TAD FPLNUM /PUT IN DISPLACEMENT DCA I NEXT JMS TYPE3 /2 OR 3 WORDS JMP .+3 TAD EXPVAL /STORE VALUE DCA I NEXT TAD EXPVAL+1 DCA I NEXT TAD EXPVAL+2 DCA I NEXT TAD NEXT /CHECK FOR ST OVERFLOW CLL TAD [12 SNL CLA JMP .+4 /OK, NOT FULL JMS I [ERMSG1 2324 /*ST* JMP I (RETSYS /SINCE ITS FATAL, ABORT TAD FPLNUM /SAVE DISPLACEMENT DCA LTEMP ISZ FPLNUM /BUMP DISPLACEMENT BY 3 ISZ FPLNUM JMS TYPE3 /OR MAYBE 2 SKP ISZ FPLNUM JMP RETFPL DLITS, 0 /DUMP FP LITERALS CLL CMA RAL /2 LISTS DCA TYPE3 /SAVE COUNT IN SUBR ENTRY DLITS2, TAD (FPLIST /FP LITERAL BUCKET CDF FLD1 FPLDMP, DCA OLDFP TAD I OLDFP /GET ADDR OF NEXT FP LITERAL SZA JMP MORFPL CDF FLD0 CLA IAC /SET AC=1 ISZ TYPE3 /FINISHED YET JMP DLITS2 /NO, DO DP LIST CLA JMP I DLITS /YES, RETURN MORFPL, DCA X10 /SAVE POINTER TAD I X10 /GET DISPLACEMENT CLL TAD LITRG2 /ADD LITERAL ORG DCA LOCTR2 /AND PUT IT INTO LOCATION COUNTER RAL TAD LITRG1 DCA LOCTR1 TAD TYPE3 /2 OR 3 WORDS ? IAC SZA CLA JMS OUTFPL /THREE JMS OUTFPL JMS OUTFPL TAD I OLDFP /POINTER TO NEXT BLOCK JMP FPLDMP OLDFP, 0 FPLNUM, 0 TYPE3, 0 /SKIP ON ADDR OR FP CLL CMA RAL /-2 TAD EXPTYP SZA CLA ISZ TYPE3 /NOT TYPE 2 JMP I TYPE3 OUTFPL, 0 /PUT WORD FROM LITERALS TAD I X10 /GET WORD CDF FLD0 JMS I [OUTWRD CDF FLD1 JMP I OUTFPL PAGE LOOKUP, 0 /SYMBOL TABLE LOOKUP TAD BUCKET /GET BUCKET ADDRESS TAD (BUCKTS-1 DCA BUCKET /INTO "BUCKET" TAD I BUCKET /GET ADDR OF BUCKET BOTTOM CDF FLD1 /GO TO FIELD 1 LOOK, DCA OLDN3 /THIS IS PTR OF PREV ENTRY TAD I OLDN3 /THIS IS ADR OF NEXT ENTRY SNA /IF ZERO, THEN JMP HOOKIN /GO HOOK IN AT THE END DCA X10 /SAVE NEXT NAME PTR TAD NAME1 /COMPARE NAMES CIA CLL TAD I X10 /WORD 1 SZA CLA JMP NOTSAM TAD NAME2 CIA CLL TAD I X10 /WORD2 SZA CLA JMP NOTSAM TAD I X10 AND (7700 /WORD 3 (ONLY UPPER HALF) DCA LTEMP TAD NAME3 CIA CLL TAD LTEMP SZA CLA JMP NOTSAM ISZ LOOKUP /IF FOUND BUMP RETURN TAD X10 DCA LTEMP /ADDR OF TYPE WORD TAD I LTEMP /GET TYPE INTO AC AND [37 /WITHOUT FORCE BIT JMP I LOOKUP /RETURN NOTSAM, SZL /NAMES DIFFER, IS NAME 1,2,3 < ENTRY JMP HOOKIN /YES, HOOK IN HERE TAD I OLDN3 /GET ADDR OF LINK INTO AC JMP LOOK /LOOP HOOKIN, TAD I OLDN3 /GET FORWARD LINK TO DCA I NEXT /NEXT ENTRY INTO NEW ENTRY TAD NEXT /PUT FORWARD LINK TO NEW DCA I OLDN3 /ENTRY INTO PREVIOUS ENTRY TAD NAME1 /PUT IN NAME DCA I NEXT TAD NAME2 DCA I NEXT TAD NAME3 DCA I NEXT TAD NEXT /X10=NEXT DCA X10 TAD NEXT /LTEMP=NEXT DCA LTEMP TAD NEXT /CHECK FOR TABLE FULL CLL TAD [12 SNL CLA JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP) JMS I [ERMSG1 2324 /*ST* JMP I (RETSYS /ST FULL, ABORT NUMBER, 0 /GET INTEGER NUMBER (NO SIGN) DCA NSWTCH /CLEAR SWITCH DCA WORD1 /CLEAR 24 BIT NUMBER DCA WORD2 NUMLUP, JMS I [GETCHR /GET A CHAR JMP NODGT+1 /NONE LEFT TAD [-272 /IS IT A DIGIT? SMA JMP NODGT /NO, TOO BIT TAD [12 SPA JMP NODGT /NO, TOO SMALL DCA NUM /YES, SAVE IT TAD WORD1 /SAVE CURRENT VALUE DCA NUM1 /OF NUMBER TAD WORD2 DCA NUM2 JMS SHIFT /SHIFT WORD1,2, LEFT 1 (MULT BY 2) JMS SHIFT /DO IT AGAIN (MULT BY 4) TAD RADIX /LOOK AT RADIX (1=DECIMAL) SNA CLA JMP OCTNUM /ITS OCTAL CLL /DECIMAL, ADD IN NUMBER TAD NUM2 TAD WORD2 /THUS MULTIPLYING BY 5 DCA WORD2 RAL TAD NUM1 TAD WORD1 DCA WORD1 OCTNUM, JMS SHIFT /SHIFT LEFT 1 AGAIN, THUS TAD WORD2 /MULTIPLYING BY 8 OR 10 CLL /THEN ADD IN NEW DIGIT TAD NUM DCA WORD2 RAL TAD WORD1 DCA WORD1 ISZ NSWTCH /SET SWITCH JMP NUMLUP /LOOP NODGT, JMS I [BACK1 /PUT BACK NON-DIGIT TAD NSWTCH /WAS THERE A NUMBER SZA CLA ISZ NUMBER /YES, SKIP JMP I NUMBER /RETURN NSWTCH, 0 NUM, 0 NUM1, 0 NUM2, 0 SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1 TAD WORD2 CLL RAL DCA WORD2 TAD WORD1 RAL DCA WORD1 JMP I SHIFT PAGE BACK1, 0 CLA CMA /BACKUP COUNT TAD NCHARS DCA NCHARS CLA CMA /AND POINTER TAD CHRPTR DCA CHRPTR JMP I BACK1 GETNAM, 0 /GET A NAME JMS GETCHR /GET FIRST CHAR JMP I GETNAM /NO CHAR, NO NAME JMS LETTER /FIRST CHAR MUST BE LETTER JMP NONAME /OTHERWISE, NO NAME AND [77 DCA BUCKET /THIS CHAR IS BUCKET DCA NAME1 DCA NAME2 /ZERO REST DCA NAME3 /OF NAME TAD (NAME1 /SET DCA NPTR /POINTER CLL CMA RTL /AND DCA NCNT /COUNTER PAKLUP, JMS GNC /GET NAME CHAR (LETTER OR DIGIT) CLL RTL /SHIFT TO UPPER HALF RTL RTL DCA I NPTR /SAVE HALF JMS GNC /GET NEXT CHAR TAD I NPTR /PUT 2 TOGETHER DCA I NPTR /STORE ISZ NPTR /BUMP POINTER ISZ NCNT /AND COUNTER JMP PAKLUP /LOOP JMS GNC /SKIP ANY EXTRA CHARS CLA JMP .-2 NDONE, TAD NAME3 /ZERO TYPE FIELD AND (7700 DCA NAME3 ISZ GETNAM /SKIP JMP I GETNAM /RETURN NONAME, JMS BACK1 /PUT CHAR BACK JMP I GETNAM /NO-SKIP, RETURN NPTR, 0 NCNT, 0 LETTER, 0 /IS AC A LETTER? TAD (-301 SPA JMP NLETR /NO, TOO SMALL TAD (-32 SPA ISZ LETTER /YES, INCR RETURN TAD (333 /RESTORE CHAR JMP I LETTER /RETURN NLETR, TAD (301 /RESTORE NON-LETTER JMP I LETTER /RETURN GNC, 0 /GET A CHAR IF LETTER OR DIGIT JMS GETCHR JMP NDONE /NONE LEFT JMS LETTER /IS IT A LETTER? JMP .+3 /NO AND [77 /ONLY 6 BITS JMP I GNC /RETURN TAD [-272 /CHECK FOR DIGIT SMA JMP .+6 /NO, TOO BIG TAD [12 SPA JMP .+3 /NO, TOO SMALL TAD (60 /OK, MAKE IT 60-71 JMP I GNC /RETURN JMS BACK1 /PUT BACK NON LETTER/DIGIT JMP NDONE /NAME DONE GETCHR, 0 /GET NEXT CHAR ISZ NCHARS /BUMP COUNT JMP .+4 /YES VIRGINIA, THERE ARE MORE GETC2, CLA CMA /RESET COUNT DCA NCHARS /TO MINUS1 JMP I GETCHR /RETURN WITH NO SKIP TAD I CHRPTR /GET CHAR TAD [-240 /CHECK FOR BLANK SNA JMP BLANK /YES, BLANK TAD (-7 /CHECK FOR TAB SNA JMP BLANK /SAME AS BLANK TAD (247-273 /CHECK FOR SEMI COLON SNA JMP SEMICL /YUP! TAD (273 /FIX CHAR ISZ GETCHR /INCR RETURN JMP I GETCHR /RETURN BLANK, ISZ NCHARS /GET NEXT CHAR SKP JMP GETC2 /BLANKS AT END OF LINE =CR TAD I CHRPTR TAD [-240 /IS IT BLANK? SNA JMP BLANK /YES, TRY AGAIN TAD (-7 /IS IT TAB ? SNA JMP BLANK /YES, TRY AGAIN TAD (-10 /IS IT SLASH ? SNA JMP GETC2 /YES, (BLANK.OR.TAB) SLASH=CR TAD (257-273 /IS IT SEMI COLON ? SNA CLA JMP SEMICL /YES JMS BACK1 /NONE OF THESE, PUT IT BACK TAD [240 /AND RETURN A SINGLE BLANK ISZ GETCHR JMP I GETCHR SEMICL, CLA IAC /SET SEMI COLON SWITCH DCA SCSWT JMS BACK1 /PUT BACK SEMI COLON JMP I GETCHR PAGE FIXOPC, 0 /COMBINE OPCODE PARTS TAD INDEX /CHECK INDEX SWITCH SNA CLA JMP ZRONDX /IF ZERO, NO INDEX REG CLA CMA TAD LASTOP /IF INDEX, CHECK FOR INCR SNA CLA TAD [100 /YES, PUT + BIT ON TAD OPCODE /COMBINE WITH OPCODE DCA OPCODE TAD EXPVAL+2 /GET INDEX REG. EXPR AND [7 /ONLY 3 BITS CLL RTL /SHIFT INTO POSITION RAL ZRONDX, TAD OPCODE /ADD OPCODE TAD (400 /TURN ON TYPE BIT DCA OPCODE /SAVE OPCODE JMP I FIXOPC /RETURN BUCKTS, ALIST /BUCKET LIST BLIST CLIST DLIST ELIST FLIST GLIST HLIST ILIST JLIST KLIST LLIST MLIST NLIST OLIST PLIST QLIST RLIST SLIST TLIST ULIST VLIST WLIST LISTX YLIST ZLIST OPR8RS, -240 6 -253 1 -255 2 -252 3 -257 4 -246 5 -241 6 0 CKKILL, 0 /TEST FOR CHAR ON TTY KSF /CHAR TYPED ? JMP I CKKILL /NO, RETURN KRB /READ CHAR TAD (-214 /CONTROL L? SZA JMP .+4 /NO DCA LISTSW /YES, STOP LISTING DCA LSTON JMP I CKKILL /RETURN TAD (214-204 /CONTROL D? SZA CLA JMP I CKKILL /NO, RETURN CDF FLD0 ENDXX, TAD BBLOCK /GET REAL BLOCK NUMBER TAD BFUDGE /OF LAST BLOCK DCA ENDBLK /AND WRITE IT OUT JMS I DIALWR 1 BINARB ENDBLK, 0 1 TAD (57 /WRITE OUT CORE USE TABLE TAD BFUDGE DCA USEBLK JMS I DIALWR 1 USEB USEBLK, 0 1 RETSYS, CLA JMS I (PAGEJ /EJECT PAGE TSF /WAIT FOR TTY JMP .-1 TAD SFUDGE /COMPUTE FUDGED BLOCK FOR SYSTEM TAD (-46 /ONLY J.B. KNOWS THE REASON FOR THIS DCA SYSBLK JMS I DIALRD /READ IN SYSTEM 0 36 /INTO 17000 SYSBLK, 0 2 6213 JMP I (7777 /RETURN TO SYSTEM P1, 0 /CONVERT TO ASCII AND PRINT AND [77 SNA JMP .+4 /ZERO CHAR PRINTS AS BLANK TAD (-40 SPA TAD [100 TAD [240 JMS I [PRINTC JMP I P1 PAGE PRINTC, 0 /PRINT CHAR ON ANALEX, LP08 OR TTY SNA JMP CRLF /ZERO IS CR-LF TAD (-247 SZA JMP NOTAB TAD [240 /DO TAB JMS PCHR ISZ TABCNT JMP .-3 /KEEP GOING UNTIL TAB STOP SETTAB, TAD (-10 DCA TABCNT /SET TAB COUNTER JMP I PRINTC NOTAB, TAD [247 /FIX CHAR JMS PCHR JMS I [CKKILL /CHECK FOR ABORT ISZ TABCNT JMP I PRINTC /RETURN JMP SETTAB /RESET TAB COUNT CRLF, DCA LSIZE /MAKE SURE THERES ROOM TAD (215 /OUTPUT CR-LF JMS PCHR TAD (212 JMS PCHR ISZ PAGSIZ /NEW PAGE ? JMP NEJECT /NO TAD SIZPAG /RESET COUNT DCA PAGSIZ TAD (214 JMS PCHR /START NEW PAGE NEJECT, TAD WIDTH /SET WIDTH OF PRINTER DCA LSIZE JMP SETTAB /RESET TAB SETTING TABCNT, -10 LSIZE, 0 WIDTH, -111 /WIDTH OF PRINTER IN CHARS PC, TTY PCHR, 0 /TAKE CARE OF PRINTER WIDTH DCA ACHR /SAVE CHAR ISZ LSIZE /ANY ROOM LEFT JMP NOCRLF /NO, GO CLA CMA /TRUNCATE LINE DCA LSIZE JMP I PCHR NOCRLF, TAD ACHR JMS I PC JMP I PCHR ACHR, 0 ANALEX, 0 /ANALEX PRINTER HANDLER DCA ACHR TAD ACHR /LINE FEED? TAD (-212 SNA CLA JMP I ANALEX /YES,IGNORE IT 6661 /WAIT FOR PRINTER JMP .-1 6652 /CLEAR FLAG TAD ACHR /GET CHAR BACK TAD (-215 /END LINE ON CR SNA JMP FINLPB IAC /CHECK FOR FORM SNA CLA JMP FINLPB-1 /PAGE EJECT ON FORM TAD ACHR /PRINT CHAR 6654 CLA JMP I ANALEX TAD [7 /SET CONTROL FINLPB, TAD (10 6664 CLA JMP I ANALEX TTY, 0 TSF JMP .-1 TLS CLA JMP I TTY LP08, 0 6661 JMP .-1 6666 CLA JMP I LP08 ERMSG1, 0 /PASS 1 MESSAGES CLA CDF FLD0 TAD ERMSG1 DCA ERMSG /COMMONIZE CALL JMS PRINTC /CR-LF TAD LINENO /PRINT LINE NUMBER JMS I [OCTOUT /ON PASS 1 MESSAGE JMP PRMSG /SKIP OVER PASS TEST ERMSG, 0 CDF FLD0 /FIX FIELD CLA CMA /NO MESSAGE ON PASS 1 TAD PASSNO SNA CLA JMP MSGDUN JMS PRINTC /PRINT CR-LF TAD LISTSW /IS LIST ON ? SZA CLA JMP .+3 /YES TAD LINENO /NO, PRINT LINE NUMBER JMS I [OCTOUT PRMSG, TAD (252 /PRINT * JMS PRINTC TAD I ERMSG /FIRST CHAR OF CODE JMS I (PRINT2 /PRINT THE MESSAGE TAD (252 /PRINT * JMS PRINTC MSGDUN, ISZ ERMSG ISZ I (ERRORS /BUMP ERROR COUNT JMP I ERMSG JMP I ERMSG PAGE OUTWRD, 0 /OUTPUT ROUTINE DCA WRD /SAVE WORD CLA CMA TAD PASSNO /CHECK PASS SNA CLA JMP ENDOUT TAD LOCTR2 /GET LOW 12 BITS OF LOCATION RTL RTL RTL AND [37 /GET PAGE NUMBER (WITHIN FIELD) DCA OTEMP /SAVE PAGE NUMBER TAD OTEMP SZA CLA /POINTER TO P0LIT OR CPLIT IAC TAD [P0LIT DCA OWTEMP TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT AND [177 CIA /COMPARE WITH LITERAL BOUNDARY TAD I OWTEMP SMA CLA JMP .+4 /NO PAGE OVER FLOW JMS I [ERMSG 2017 /*PO* JMP PRNTST /DONT STORE IF PAGE OVERFLOW TAD OTEMP /NOW GET SUPER-PAGE NUMBER CLL RAR DCA OTEMP /AND SAVE IT TAD LOCTR1 /GET FIELD BITS AND O1 /ONLY ONE BIT FOR DIAL CRAP CLL RTL RTL TAD OTEMP /THIS GIVES TAPE BLOCK NUMBER DCA OTEMP TAD BBLOCK /GET CURRENT BLOCK CIA TAD OTEMP /COMPARE WITH DESIRED BLOCK SNA CLA JMP SAMBLK /SAME BLOCK TAD BBLOCK /FIND REAL BLOCK NUMBER TAD BFUDGE DCA WRBLOK JMS I DIALWR /WRITE OUT OLD BLOCK 1 BINARB WRBLOK, 0 1 TAD OTEMP /CHECK FOR THIS BLOCK ALREADY USED TAD (USETBL DCA OCNT /POINTER INTO USE TABLE TAD I OCNT /GET INDICATOR SNA CLA JMP NEWBLK /FIRST TIME USED TAD OTEMP /BLOCK WAS USED, FIND REAL BLOCK TAD BFUDGE /NUMBER AND READ BLOCK DCA BLOCKN JMS I DIALRD O1, 1 BINARB BLOCKN, 0 1 JMP DONT0 NEWBLK, ISZ I (USETBL-1 /INCREMENT COUNT OF BLKS IN USE TAD (BINARY DCA CLRBIN /CLEAR OUT BUFFER TAD (-400 DCA OWTEMP DCA I CLRBIN ISZ CLRBIN ISZ OWTEMP JMP .-3 DONT0, TAD OTEMP /RESET CURRENT BLOCK DCA BBLOCK CLA CMA /SET BLOCK IN USE DCA I OCNT SAMBLK, TAD LOCTR2 /GET POINTER FOR STORING WORD AND (377 TAD (BINARY DCA OTEMP TAD WRD /GET WORD DCA I OTEMP /STORE IT PRNTST, TAD LISTSW /IS LIST ON ? SNA CLA JMP ENDOUT /NO, DONT PRINT JMS I [PRINTC /PUT CR-LF TAD OUTSWT /WAS LINE NUM PRINTED YET? SZA CLA JMP .+4 TAD LINENO /NO, PRINT IT JMS I [OCTOUT JMP NOBLNK /SKIP OVER BLANKS JMS I (PRINT2 /2 BLANKS JMS I (PRINT2 /2 MORE TAD [240 JMS I [PRINTC /1 MORE 4 5 NOBLNK, TAD LOCTR1 /PRINT LOCATION COUNTER AND [7 TAD [260 /FIRST DIGIT JMS I [PRINTC TAD LOCTR2 /NEXT FOUR DIGITS JMS I [OCTOUT TAD WRD /NOW WORD JMS I [OCTOUT JMS I (PRNTLN /PRINT LINE IF NECESSARY ENDOUT, ISZ LOCTR2 /BUMP LOCATION COUNTER JMP I OUTWRD ISZ LOCTR1 /BUMP SECOND WORD JMP I OUTWRD JMP I OUTWRD WRD, 0 OWTEMP, 0 CLRBIN, 0 / CHAIN "FPPASM3" /*20 PAGE ENDX, DCA RADIX /SET DEFAULT CONDITIONS CLA CMA /END OF WHICH PASS ? TAD PASSNO SZA CLA JMP EOP2 /END OF PASS TWO JMS I (PAGEJ /EJECT AFTER PASS ONE DCA STAR20 /RESET STUPIDITY SWITCH DCA LINENO /ZERO LINE NUMBER DCA ASMOF /ZERO CONDITIONAL SWITCH DCA SCSWT /ZERO SEMICOLON SWITCH TAD LSTON /SET LIST SWITCH DCA LISTSW TAD LITRG1 /IF LITORG HAS BEEN SET SMA CLA JMP .+5 /DONT CHANGE IT TAD LOCTR1 /SET LITORG INCASE NO COMMAND DCA LITRG1 TAD LOCTR2 DCA LITRG2 TAD [200 DCA LOCTR2 /LOCATION COUNTER DCA LOCTR1 CLL CML RAR /4000 DCA BASER /SET BASE BEYOND BELIEF TAD [177 /INITIALIZE LITERAL BOUNDARIES DCA P0LIT TAD [177 DCA CPLIT CMA /OPEN INPUT FILE DCA CHRCNT DCA SBLOCK DCA I (SRCUNT /START AT UNIT 0 DCA ERRORS /ZERO ERROR COUNT ISZ PASSNO /BUMP PASS NUMBER JMP I [START /DO NEXT PASS EOP2, CLA IAC /DUMP CURRENT PAGE LITERALS JMS I (DMPLIT JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS ISZ OUTSWT /DONT PRINT LINE WITH FP LITERALS JMS I (DLITS /THEN FLOATING POINT LITERALS JMS I (PAGEJ /EJECT TAD ERRORS /ERROR COUNT JMS I [OCTOUT TAD (0522 /PRINT ER JMS I (PRINT2 TAD (2217 /PRINT RO JMS I (PRINT2 TAD (2223 /PRINT RS JMS I (PRINT2 JMS I (PAGEJ /EJECT TAD (BUCKTS-1 /SET UP FOR SYMBOL TABLE DCA X15 TAD (-32 /26 BUCKETS DCA LTEMP TAD (301 /BUCKET CHARACTER DCA BUCKET STPRNT, TAD I X15 /GET NEXT BUCKET CDF FLD1 DCA EXTMP /BUCKET START ADDRESS LUPBKT, CLA TAD I EXTMP /WAS TTAT LAST SYMBOL ? SNA JMP NXTBKT /YES, GO GET NEXT BUCKET DCA EXTMP /SAVE LINK ADDR TAD EXTMP DCA X14 /SET UP POINTER FOR NAME TAD I X14 /PICK UP THE NAME DCA NAME1 TAD I X14 DCA NAME2 TAD I X14 DCA NAME3 TAD NAME3 /LOOK AT THE TYPE AND [37 /LOSE FORCE BIT TAD [-4 /IS AN OPCODE ? SMA JMP LUPBKT /YES, GET NEXT SYMBOL TAD SETTYP /GET JUMP THRU TABLE DCA SETTYP-1 JMS I [PRINTC /PRINT CR-LF TAD BUCKET JMS I [PRINTC /PRINT FIRST CHAR TAD NAME1 JMS I (PRINT2 /PRINT 2 AND 3 TAD NAME2 JMS I (PRINT2 /PRINT 4 AND 5 TAD NAME3 AND (7700 /PRINT 6 AND BLANK JMS I (PRINT2 0 SETTYP, JMP I .+5 LUPBKT /UNDEFINED, PRINT NOTHING SYM1 SYM2 SYM3 SYM3, TAD I X14 /PRINT 3 WORD THING JMS I [OCTOUT SYM2, TAD I X14 /PRINT 2 WORD THING JMS I [OCTOUT TAD I X14 JMS I [OCTOUT JMP LUPBKT /GET NEXT SYMBOL SYM1, TAD I X14 /PRINT FIRST DIGIT AND [7 TAD [260 JMS I [PRINTC JMP SYM2+2 /PRINT NEXT FOUR DIGITS NXTBKT, ISZ BUCKET /NEXT BUCKET CHAR CDF FLD0 ISZ LTEMP /INCREMENT COUNT JMP STPRNT JMS I (PAGEJ /EJECT JMS I [PRINTC /FINAL CR/LF JMP I (ENDXX /FINISH IT OFF ERRORS, 0 PAGE BASEX, JMS I [ADRGET /GET ADDRESS EXPR VALUE TAD EXPTYP /WAS THING DEFINED SNA CLA JMP ORGERR /NO, GIVE *UO* ERROR TAD EXPVAL+1 /PUT INTO BASER AND [7 DCA BASER TAD EXPVAL+2 DCA BASER+1 JMP I [NEXTST ORGX, JMS I [EXPR /GET ORG EXPR JMP ORGERR /BAD IF NO EXPR CLA CMA /CHECK TYPE TAD EXPTYP SNA CLA JMP FIXORG /TYPE OK ORGERR, JMS I [ERMSG 2517 /*UO* JMP I [NEXTST FIXORG, TAD LOCTR1 /CHECK FOR NEW FIELD CIA TAD EXPVAL+1 SNA CLA JMP SAMFLD /NOT A DIFFERENT FIELD CLA IAC JMS DMPLIT /DUMP CURRENT PAGE LITERALS JMS DMPLIT /DUMP PAGE 0 LITERALS TAD [177 /RESET PAGE 0 LIT BOUNDARY DCA P0LIT JMP SAMPAG-2 /DO THE SAME FOR CURRENT PAGE SAMFLD, TAD LOCTR2 AND [7600 /CHECK FOR SAME PAGE DCA LTEMP TAD EXPVAL+2 AND [7600 CIA TAD LTEMP SNA CLA JMP SAMPAG /PAGE IS THE SAME CLA IAC JMS DMPLIT /DUMP CURRENT PAGE LITERALS TAD [177 /RESET BOUNDARY DCA CPLIT SAMPAG, TAD EXPVAL+1 /PUT ORG VALUE AND [7 DCA LOCTR1 /INTO LOCATION COUTER TAD EXPVAL+2 DCA LOCTR2 JMP I [NEXTST LSTONX, TAD LSTON LSTOFX, DCA LISTSW /SET LIST STATUS JMP I [NEXTST PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE CLL TAD [177 AND [7600 DCA EXPVAL+2 RAL TAD LOCTR1 DCA EXPVAL+1 JMP FIXORG SWTOUT= OPE DMPLIT, 0 DCA PAGEN /SAVE PAGE INDICATOR TAD OUTSWT /SAVE OUTPUT SWITCH DCA SWTOUT ISZ OUTSWT /DONT PRINT LINE WITH LITERALS TAD PAGEN TAD [P0LIT /GET BOUNDARY POINTER DCA LTEMP TAD PAGEN /WHICH LITERAL BUFFER ? SNA CLA TAD (P0LBUF-CPLBUF /PAGE 0 BUFFER TAD (CPLBUF /CURRENT PAGE BUFFER TAD I LTEMP /PLUS PAGE ADDRESS DCA X10 /GIVES START OF LITERALS -1 TAD PAGEN SZA CLA TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS AND [7600 TAD I LTEMP /PLUS LOWER SEVEN IAC /PLUS ONE DCA LOCTR2 /GIVES LOCATION COUNTER TAD I LTEMP /SAVE OLD LITERAL BOUNDARY DCA PAGEN TAD [177 /STORE SPURIOUS LITERAL BOUNDARY DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES LITLUP, TAD X10 /END OF LITERALS AND [177 /GET DISPLACEMENT -1 TAD (-177 /IS IT .GE. 177 ? SMA CLA JMP DMPFIN /GO RESTORE LITERAL BOUNDARY TAD I X10 /NO, GET NEXT LITERAL JMS I [OUTWRD /OUTPUT WORD AND BUMP LC JMP LITLUP /LOOP DMPFIN, TAD PAGEN /GET CORRECT LITERAL BOUNDARY DCA I LTEMP /PUT IT IN ITS PLACE TAD SWTOUT /RESTORE OUTPUT SWITCH DCA OUTSWT JMP I DMPLIT /ALL DONE PAGEN= ACE EJECTX, CLA CMA /NO EJECT ON PASS 1 TAD PASSNO SNA CLA JMP I [NEXTST TAD LISTSW /OR LIST OFF SNA CLA JMP I [NEXTST JMS PAGEJ JMP I [NEXTST PAGEJ, 0 /PAGE EJECT SUBROUTINE JMS I [PRINTC /CR-LF TAD (214 JMS I [PRINTC /FORM FEED TAD SIZPAG /FIX PAGE COUNTER DCA PAGSIZ JMP I PAGEJ PAGE CHAINX, JMS I [GETCHR /LOOK FOR FIRST " JMP CHERR /MISSING FILE NAME TAD (-242 SZA CLA JMP CHAINX /KEEP LOOKING TAD [-4 /NAME WORD COUNT DCA LTEMP TAD (FNAME /NAME POINTER DCA EXTMP DCA CBSWIT /SET CAT BLOCK SWITCH CNLOOP, JMS I (GETCN /GET CHAR CLL RTL RTL RTL DCA I EXTMP /SAVE UPPER HALF JMS I (GETCN TAD I EXTMP /UNITE HALVES DCA I EXTMP ISZ EXTMP /BUMP POINTER ISZ LTEMP /AND COUNT JMP CNLOOP JMS I [GETCHR /LOOK FOR CLOSE QUOTE JMP CHERR TAD (-242 SZA CLA JMP CHERR JMS I (GETUNT /GO GET UNIT NUMBER CLL CMA RAL /2 BLOCKS OF CAT DCA EXTMP TAD (-40 /32 ENTRIES PER BLOCK DCA NFILES TAD (-22 /COMPUTE CAT BLOCK NUMBER TAD SFUDGE DCA DIRBLK DIRLUP, JMS I DIALRD /READ CATALOG UNIT, 0 SOURCB /INTO SOURCE BUFFER DIRBLK, 0 1 ISZ DIRBLK /INCR BLOCK TAD (SOURCE-1 /GET CAT POINTER DCA X10 TAD CBSWIT /IS THIS SECOND HALF OF CAT ? ISZ CBSWIT /SET SWITCH SZA CLA JMP FILLUP /YES TAD I [SOURCE /CHECK FIRST NAME FOR "////////" TAD (-5757 SZA CLA JMP CHERR /FILE NOT FOUND JMP NOTFIL /GO BUMP NAME POINTER FILLUP, TAD (FNAME-1 /NAME POINTER DCA X11 TAD X10 /SAVE CAT POINTER DCA X12 TAD [-4 /NAME SIZE DCA LTEMP FNLOOP, TAD I X12 /COMPARE NAMES CIA TAD I X11 SZA CLA JMP NOTFIL /NOT THIS ONE ISZ LTEMP JMP FNLOOP /NOT DONE TAD SFUDGE /GET RELATIVE BLOCK NUM CIA TAD I X12 DCA SBLOCK TAD I X12 /CHECK SIZE SPA CLA JMP CHERR /IF NEG, NO SUCH FILE TAD UNIT /SAVE UNIT DCA I (SRCUNT CMA DCA CHRCNT /SET COUNT TO -1 DCA LINENO /ZERO LINE NUMBER DCA SCSWT /ZERO SEMICOLON SWITCH DCA STAR20 /ZERO STUPIDITY SWITCH CLA CMA DCA NCHARS /REMOVE FALSE *EG* MESSAGE CLA CMA /DO WE PRINT MESSAGE TAD PASSNO SZA CLA TAD LISTSW SZA CLA JMP I [NEXTST /ONLY IF PASS1, OR PASS2 & NOLIST JMS I [PRINTC /CR-LF TAD (-12 /MESSAGE SIZE DCA LTEMP TAD (CMSG-1 /AND POINTER DCA X10 TAD I X10 /GET WORD OF MESSAGE JMS I (PRNT2 /PRINT 2 CHARS ISZ LTEMP JMP .-3 JMP I [NEXTST /PRINT CHAIN COMMAND NOTFIL, TAD X10 /BUMP CAT POINTER TAD (10 /BY 8 DCA X10 ISZ NFILES /MORE FILES IN BLOCK ? JMP FILLUP /YES ISZ EXTMP /ANOTHER BLOCK ? JMP DIRLUP /YES CHERR, JMS I [ERMSG1 0310 /*CH* JMP I (RETSYS /FATAL ERROR NFILES, 0 CBSWIT, 0 PAGE GETCN, 0 /RETURN NEXT CHAR OR 77 JMS I [GETCHR /GET CHAR JMP I (CHERR /NONE, GIVE ERROR TAD (-242 /IS IT " SNA JMP ISQ /YES TAD (242 /FIX CHAR AND [77 JMP I GETCN /RETURN IT ISQ, JMS I [BACK1 /PUT BACK " TAD [77 /RETURN 77 JMP I GETCN PAGE TEXTX, JMS I [GETCHR /GET DELIMITER JMP I [NEXTST /NULL STMT CIA DCA EXTMP /SAVE - DELIM LOOP6B, JMS GETCHT /GET HIG ORDER CHAR JMP I [NEXTST CLL RTL RTL RTL /SHIFT IT UP DCA LTEMP /SAVE HALF JMS GETCHT /GET LOWER CHAR JMP OUTTXT /GO PUT LAST TAD LTEMP /PUT 2 CHARS TOGETHER JMS I [OUTWRD /OUTPUT WORD JMP LOOP6B /LOOP OUTTXT, TAD LTEMP /PUT OUT HALF WORD JMS I [OUTWRD /OR ZERO WORD JMP I [NEXTST GETCHT, 0 /GET CHAR FOR TEXT STMT ISZ NCHARS /BUMP COUNT SKP JMP I GETCHT /END OF TEXT TAD I CHRPTR /GET CHAR DCA BUCKET /SAVE IT TAD BUCKET /IS IT THE DELIM ? TAD EXTMP SNA CLA JMP I GETCHT /YES, RETURN NO SKIP ISZ GETCHT /BUMP RETURN TAD BUCKET /GET CHAR AND [77 /LOW 6 BITS JMP I GETCHT /RETURN IFNZRX, JMS I [ADRGET /GET EXPR FOR IFNZRO TAD EXPVAL+1 SNA TAD EXPVAL+2 SNA CLA ISZ ASMOF /IF BOTH HALVES 0, SET SWITCH JMP I [NEXTST IFZROX, JMS I [ADRGET /GET EXPR FOR IFZERO TAD EXPVAL+1 SNA TAD EXPVAL+2 SZA CLA ISZ ASMOF /IF BOTH HALVES NON ZERO, SET SWITCH JMP I [NEXTST IFNEGX, JMS I [ADRGET /GET EXPR FOR IFNEG TAD EXPVAL+1 /CHECK SIGN SMA CLA ISZ ASMOF /SET SWITCH IF POSITIVE JMP I [NEXTST IFPOSX, JMS I [ADRGET /GET EXPR FOR IFPOS TAD EXPVAL+1 /CHECK SIGN SPA CLA ISZ ASMOF /SET SWITCH IF NEGATIVE JMP I [NEXTST IFREFX, JMS I [GETNAM /GET SYMBOL NAME JMP I [NEXTST /RETURN IF NONE JMS I [LOOKUP /S.T. LOOKUP JMP NOTREF /NOT REFERENCED YET CLA /REFERENCED, ASSEMBLY ON DCA ASMOF CDF FLD0 /FIX DATA FIELD JMP I [NEXTST NOTREF, TAD NEXT /SYMBOL WAS JUST ENTERRED TAD [-4 DCA NEXT /FIRST FIX NEXT TAD NEXT DCA X10 /SET UP POINTER TAD I X10 /GET FWD POINTER DCA I OLDN3 /INTO PREVIOUS ENTRY CDF FLD0 CLA IAC /SET ASSEMBLY OFF DCA ASMOF JMP I [NEXTST P2, 0 P3, PRINT2, 0 /PRINT TWO PACKED CHARS DCA P2 TAD P2 RTR RTR RTR JMS I (P1 TAD P2 JMS I (P1 JMP I PRINT2 PRNT2, 0 /SPECIAL PRINT FOR CHAIN DCA P2 /ELIMINATES ? TAD P2 RTR RTR RTR DCA P3 TAD P3 AND (77 TAD (-77 SNA CLA JMP I PRNT2 TAD P3 JMS I (P1 TAD P2 AND (77 TAD (-77 SNA CLA JMP I PRNT2 TAD P2 JMS I (P1 JMP I PRNT2 CMSG, TEXT "CHAINING TO " FNAME, 0;0;0;0 DECX, CLA IAC /RADIX=DECIMAL OCTALX, DCA RADIX /RADIX=OCTAL JMP I [NEXTST PAGE / ORG USETBL-1 *USETBL-1 1 /1 BLOCK USED -1 /PAGE 200 BLOCK 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 PDPOP= 4 PSUDO= 5 PDPMR= 6 FPPMRF= 7 FPPSF1= 10 FPPSF2= 11 FPPSF3= 12 FPPSF4= 13 FPPSF5= 14 FPMRFL= 15 FIELD 1 *20 / ORG 10020 /INITIAL SYMBOL TABLE FPLIST, 0 /FP LITERAL BUCKET DPLIST, 0 /DP LITERAL BUCKET ALIST, .+1 .+5 /ADDX 0404;3000 FPPSF5 0110 .+5 /ALN 1416;0 FPPSF4 0010 .+5 /AND 1604;0 PDPMR AND 0 0 /ATX 2430;0 FPPSF4 0020 BLIST, .+1 0 /BASE 0123;0500 PSUDO BASEX CLIST, .+1 .+5 /CDF 0406;0 PDPOP CDF .+5 /CHAIN 1001;1116 PSUDO CHAINX .+5 /CIA 1101;0 PDPOP CIA .+5 /CIF 1106;0 PDPOP CIF .+5 /CLA 1401;0 PDPOP CLA .+5 /CLL 1414;0 PDPOP CLL .+5 /CMA 1501;0 PDPOP CMA 0 /CML 1514;0 PDPOP CML DLIST, .+1 .+5 /DCA 0301;0 PDPMR DCA 0 0 /DECIMAL 0503;1115 PSUDO 0100 DECX ELIST, .+1 .+5 /EJECT 1205;0324 PSUDO EJECTX 0 /END 1604;0 PSUDO ENDX FLIST, .+1 .+5 /FADD 0104;0400 FPPMRF 1000 .+5 /FADDL 0104;0414 FPMRFL 1000 .+5 /FADDM 0104;0415 FPPMRF 5000 .+5 /FADDML 0104;0415 FPMRFL+1400 5000 .+5 /FCLA 0314;0100 FPPSF3 0002 .+5 /FDIV 0411;2600 FPPMRF 3000 .+5 /FDIVL 0411;2614 FPMRFL 3000 .+5 /FEXIT 0530;1124 FPPSF3 0000 .+5 /FLDA 1404;0100 FPPMRF 0000 .+5 /FLDAL 1404;0114 FPMRFL 0000 .+5 /FMUL 1525;1400 FPPMRF 4000 .+5 /FMULL 1525;1414 FPMRFL 4000 .+5 /FMULM 1525;1415 FPPMRF 7000 .+5 /FMULML 1525;1415 FPMRFL+1400 7000 .+5 /FNEG 1605;0700 FPPSF3 0003 .+5 /FNOP 1617;2000 FPPSF3 0040 .+5 /FNORM 1617;2215 FPPSF3 0004 .+5 /FPAUSE 2001;2523 FPPSF3+0500 0001 .+5 /FPCOM 2003;1715 PDPOP 6553 .+5 /FPHLT 2010;1424 PDPOP 6554 .+5 /FPICL 2011;0314 PDPOP 6552 .+5 /FPINT 2011;1624 PDPOP 6551 .+5 /FPIST 2011;2324 PDPOP 6557 .+5 /FPRST 2022;2324 PDPOP 6556 .+5 /FPST 2023;2400 PDPOP 6555 .+5 /FSTA 2324;0100 FPPMRF 6000 .+5 /FSTAL 2324;0114 FPMRFL 6000 .+5 /FSUB 2325;0200 FPPMRF 2000 0 /FSUBL 2325;0214 FPMRFL 2000 GLIST, 0 HLIST, .+1 0 /HLT 1424;0 PDPOP HLT ILIST, .+1 .+5 /IAC 0103;0 PDPOP IAC .+5 /IFNEG 0616;0507 PSUDO IFNEGX .+5 /IFNZRO 0616;3222 PSUDO+1700 IFNZRX .+5 /IFPOS 0620;1723 PSUDO IFPOSX .+5 /IFREF 0622;0506 PSUDO IFREFX .+5 /IFZERO 0632;0522 PSUDO+1700 IFZROX 0 /ISZ 2332;0 PDPMR ISZ 0 JLIST, .+1 .+5 /JA 0100;0 FPPSF2 1030 .+5 /JAC 0103;0 FPPSF3 0007 .+5 /JAL 0114;0 FPPSF2 1070 .+5 /JEQ 0521;0 FPPSF2 1000 .+5 /JGE 0705;0 FPPSF2 1010 .+5 /JGT 0724;0 FPPSF2 1060 .+5 /JLE 1405;0 FPPSF2 1020 .+5 /JLT 1424;0 FPPSF2 1050 .+5 /JMP 1520;0 PDPMR JMP 0 .+5 /JMS 1523;0 PDPMR JMS 0 .+5 /JNE 1605;0 FPPSF2 1040 .+5 /JSA 2301;0 FPPSF2 1120 .+5 /JSR 2322;0 FPPSF2 1130 0 /JXN 3016;0 FPPSF1 2000 KLIST, .+1 .+5 /KCC 0303;0 PDPOP KCC .+5 /KRB 2202;0 PDPOP KRB .+5 /KRS 2223;0 PDPOP KRS 0 /KSF 2306;0 PDPOP KSF LLIST, .+1 .+5 /LAS 0123;0 PDPOP LAS .+5 /LDX 0430;0 FPPSF5 0100 .+5 /LISTOFF 1123;2417 PSUDO+0600 LSTOFX .+5 /LISTON 1123;2417 PSUDO+1600 LSTONX 0 /LITORG 1124;1722 PSUDO+00700 LITORX MLIST, 0 NLIST, .+1 0 /NOP 1720;0 PDPOP NOP OLIST, .+1 .+5 /OCTAL 0324;0114 PSUDO OCTALX .+5 /ORG 2207;0 PSUDO ORGX 0 /OSR 2322;0 PDPOP OSR PLIST, .+1 0 /PAGE 0107;0500 PSUDO PAGEX QLIST, 0 RLIST, .+1 .+5 /RAL 0114;0 PDPOP RAL .+5 /RAR 0122;0 PDPOP RAR .+5 /RDF 0406;0 PDPOP RDF .+5 /RIB 1102;0 PDPOP RIB .+5 /RIF 1106;0 PDPOP RIF .+5 /RMF 1506;0 PDPOP RMF .+5 /RTL 2414;0 PDPOP RTL 0 /RTR 2422;0 PDPOP RTR SLIST, .+1 .+5 /SETB 0524;0200 FPPSF2 1110 .+5 /SETX 0524;3000 FPPSF2 1100 .+5 /SKP 1320;0 PDPOP SKP .+5 /SMA 1501;0 PDPOP SMA .+5 /SNA 1601;0 PDPOP SNA .+5 /SNL 1614;0 PDPOP SNL .+5 /SPA 2001;0 PDPOP SPA .+5 /STARTD 2401;2224 FPPSF3+0400 0006 .+5 /STARTF 2401;2224 FPPSF3+0600 0005 .+5 /SZA 3201;0 PDPOP SZA 0 /SZL 3214;0 PDPOP SZL TLIST, .+1 .+5 /TAD 0104;0 PDPMR TAD 0 .+5 /TCF 0306;0 PDPOP TCF .+5 /TEXT 0530;2400 PSUDO TEXTX .+5 /TLS 1423;0 PDPOP TLS .+5 /TPC 2003;0 PDPOP TPC .+5 /TRAP3 2201;2063 FPPSF1 3000 .+5 /TRAP4 2201;2064 FPPSF1 4000 .+5 /TRAP5 2201;2065 FPPSF1 5000 .+5 /TRAP6 2201;2066 FPPSF1 6000 .+5 /TRAP7 2201;2067 FPPSF1 7000 0 /TSF 2306;0 PDPOP TSF ULIST, 0 VLIST, 0 WLIST, 0 LISTX, .+1 0 /XTA 2401;0 FPPSF4 0030 YLIST, 0 ZLIST, 0 FREE, PAGE INITAL, CLA CDF FLD1 DCA I (7775 /FIX UP DIAL I/O ROUTINES TAD (5772 DCA I (7776 TAD (5773 DCA I (7777 JMS I (7774 /READ I COPLETE COPY OF I/O STUFF RDSYS /POINTER TO ARGS FOR SYS READ IN JMS I (4200 /MOVE ROUTINE UP CDF FLD1 4000 CDF FLD1 7000 1000 JMS I (7774 /FIND FUDGE FACTOR FOR SOURCE DUMYS TAD I (7770 /GET READ ENTRY POINT DCA RDDIAL TAD I (7771 /SOURCE FUDGE NUMBER DCA FUDGES JMS I (7774 /FIND STUFF FOR BINARY DUMYB TAD I (7770 /MAKE SURE ITS THE SAME HANDLER CIA TAD RDDIAL SZA CLA HLT /TWO DIFFERENT HANDLERS TAD I (7771 /STORE BINARY FUDGE CDF FLD0 DCA I (BFUDGE TAD FUDGES /NOW SOURCE FUDGE DCA I (SFUDGE TAD RDDIAL /READ ENTRY POINT AND (177 /GET PAGE DISPLACEMENT TAD (7600 /PLUS BASE DCA I (DIALRD CLL CML RTL TAD I (DIALRD /NOW WRITE ENTRY POINT DCA I (DIALWR CDF FLD1 TAD RDDIAL AND (7600 /GET PAGE ADDR OF I/O ROUTINE DCA .+3 JMS I (7200 /MOVE ROUTINE TO FIELD 0 CDF FLD1 0 CDF FLD0 7600 200 JMP I (GETLPT /GO FIND LINE PRINTER DUMYS, 110;SOURCB;0;1 DUMYB, 111;BINARB;0;1 RDSYS, 100;30;22;2 FUDGES, 0 RDDIAL, 0 PAGE GETLPT, CDF FLD0 /NOW FIND OUT ... 6652 /WHICH PRINTER ? 6662 TAD (-4 DCA LPT DCA LPT2 TLS /INITIALIZE TTY ALPT, 6661 /CHECK FOR ANALEX SKP JMP ISANAL /ITS THE 645 ISZ LPT2 /INCREMENT TIMER JMP ALPT ISZ LPT JMP ALPT TAD (-4 /RESET TIMER FOR LP08 TRY DCA LPT 6666 CLA LLPT, 6661 /TEST LP08 FLAG SKP JMP ISLP08 /ITS AN LP08 ISZ LPT2 /INCREMENT TIMER JMP LLPT ISZ LPT JMP LLPT TSTLST, CDF CIF JMP I (START ISANAL, TAD (ANALEX /SET PRINTER HANDLER PTR DCA I (PC /TO ANALEX PRINTER HANDLER TAD (-201 /SET WIDTH TO 128 CHARS DCA I (WIDTH JMP TSTLST ISLP08, TAD (LP08 DCA I (PC TAD (-121 /SET WIDTH TO 80 DCA I (WIDTH JMP TSTLST LPT, 0 LPT2, 0 PAGE / END $