File RALF.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/ RALF, V62A
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1974, 1975, 1977
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/

/ RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV / / / FPPASM BY HANK MAURER / RALF MODS BY JUD LEONARD / OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY / NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER / / THE FOLLOWING FORMULA GIVES THE NUM / OF USER SYMBOLS: / -(FREE+200[BASE8])/6[BASE10] / WHERE THE VALUE OF FREE IS FROM THE / RALF SYMBOL MAP / / IFNDEF RALF <RALF=1 /GO RELOCATABLE THEN> / / ASSEMBLE WITH PAL8-V9 WITH W SWITCH / SAVE AS: / .SAVE SYS RALF.SV ;200=2000 / / CHANGES FOR OS/78 AND OS/8 V3D BY P.T. / .CHANGED VERSION NUMBER TO 62 / .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF: / 1.) THE ESD IS LONGER THAN ONE BLOCK, AND / 2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER / / FLD0=0 FLD1=10 VNUM=62 PATCH="A /PATCH LEVEL A *3 VERS, VNUM /VERSION NUMBER OLDN3, 0 /TEMP FOR LOOKUP OTEMP, 0 /A COUPLE OF TEMPS THAT OCNT, 0 /DIDNT FIT INTO THEIR PAGE 0 X10, 0 X11, 0 X12, 0 X13, 0 X14, 0 OUTPTR, OUBUF-1 NEXT, FREE-1 CHRPTR, LINE-1 NCHARS, -1 /CHARACTER INPUT STUFF CPTMP, 0 NCTMP, 0 /USED TO SAVE CHAR POSITION LINSIZ, 0 /SIZE OF LINE FOR PRINTING STYPE, /SYMBOL TYPE CODE CHKSUM, 0 /FOR BINARY OUTPUT IFZERO RALF < LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM LOCTR2, 200 > IFNZRO RALF < ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT) LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN) LOCTR2, 0 DPFLG, 0 >
BASER, 4000 /BASE REGISTER SETTING 0 INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER 0 EXPVAL, 0 /EXPRESSION VALUE 0 0 EXPDEF, 0 /=0 IF EXPR IS UNDEFINED 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 XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT 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 NEGATIVE WHEN ASSEMBLY OFF PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING) OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED REPCNT, 0 /REPEAT COUNTER SCSWT, 0 /SEMICOLON SWITCH RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL) LTEMP, -177 /TEMP USED BY LOOKUP EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS EXTMP2, 0 EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN /NEXT TWO LOCS USED WITH EQUN BY DMPESD 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 P0LIT, 177 CPLIT, 177 PAGEN, 0 ERRORS, 0 /ERROR COUNT PC, TTYOUT /OUTPUT ROUTINE OUFILE, 7573 /OUTPUT FILE LIST POINTER BFILE, 1
LPAGE1, 1 /INPUT FORMFEED COUNT LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE LINPAG, -1 /LINES/PAGE COUNTER LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE LINKS, /NO OF LINKS GENERATED ABREFS, 0 /NO OF ABSOLUTE REFERENCES ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT USR, 200 /CURRENT CALL ADDRESS FOR USR SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE /IS SPECIFIED. ITS SET VIA SLASH S /=1=REGULAR NP17, 17 /** NP7700, 7700 OPX, 0 OP, ZBLOCK 6 ACX, 0 AC, ZBLOCK 6 M3, -3 BLINE, LINE-1 / PAGE
/ / CORE ALLOCATION IN HIGH FIELD 0 / CPLBUF=5100 /ACTUALLY AT 5200 P0LBUF=5200 /AND 5300, 1/2 PAGE EACH IFZERO RALF < INBUF=5400 > IFNZRO RALF < INBUF=6000 /AFTER PASS 1, MOVES TO 5400> OUBUF=6400 LINE=7000 /CURRENT INPUT LINE IN ASCII INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR INRECS=2 INCTL=400 OUCTL=4200 / / COLLECT THE NEXT STATEMENT / ISZ .+2 REPLEN, JMP I .+1 REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001 NEXTST, CDF FLD0 /JUST PRECAUTION TAD OUTSWT /IF NO OUTPUT FROM THIS LINE, SNA CLA TAD PASSNO /AND LISTING PASS SMA SZA CLA TAD LISTSW /AND LISTING ENABLED SNA CLA /PRINT THIS LINE NOW JMP START /ELSE GET NEXT JMS I [CRLF /PRINT CR/LF TAD (-6 DCA LTEMP /SPACE OVER JMS I [PRINT2 /12 SPACES ISZ LTEMP JMP .-2 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 ASMBL /DON'T READ A NEW LINE TAD REPCNT /IS THIS LINE TO BE REPEATED? SPA CLA JMP AGAIN /DO IT NEWLIN, TAD BLINE /RESET POINTER DCA CHRPTR TAD [-200 /LIMIT LINE SIZE DCA MAXLIN DCA OUTSWT /CLEAR OUTPUT SWITCH
RDLOOP, JMS I (ICHAR /READ A CHAR TAD (-212 SNA JMP RDLOOP /IGNORE LINE FEEDS TAD (212-215 /END ON CR SNA JMP ENDLIN IAC SNA /FORM FEED? JMP FORMFD TAD (214 /FIX CHAR DCA I CHRPTR /SAVE IT ISZ MAXLIN /TEST FOR LINE TOO LONG JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1 JMS I (ICHAR /IGNORE ANOTHER CHAR TAD (-215 /UNLESS CR SZA CLA JMP .-3 JMS I [ERMSG /EXCESS LENGTH LINE 1424 /*LT* ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1 CMA TAD BLINE DCA NCHARS TAD REPCNT /0 BECOMES 0, CIA /BUT POS REP COUNT DCA REPCNT /ENABLES REPEAT TAD NCHARS /SAVE LENGTH DCA REPLEN TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT DCA REPLST REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT DCA LINSIZ TAD BLINE DCA CHRPTR /SET POINTER ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL SZA CLA JMP OFFIT /YES, AND THE COND WAS FALSE JMS I [GETCHR /LOOK FOR A CHARACTER JMP NEXTST TAD (-257 /IS IT SLASH ? SNA JMP NOASM /YES, COOL IT TAD [257-240 /IS IT BLANK OR TAB ? SZA CLA /YES, IGNORE JMS I [BACK1 /NO, PUT IT BACK JMP I (LUNAME /ASSEMBLE STMT
FORMFD, ISZ LPAGE1 /BUMP FORM FEED COUNT DCA LPAGE2 /CLEAR SUB-PAGE COUNT CLA CMA DCA LINPAG /FORCE EJECT ON CRLF JMP RDLOOP OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE TAD ASMOF DCA ASMOF OFFIT, ISZ NCHARS /MORE TO GO? JMP GETIT /YES NOASM, CLA CMA DCA NCHARS /DONT ASSEMBLE THIS LINE JMP NEXTST /(PREVENTING *EG* MESSAGE) GETIT, TAD I CHRPTR /PICK UP THE CHARACTER TAD (-274 /OPEN ANGLE BRACKET? SNA JMP OPENIT /YES, PUSH ONE LEVEL DOWN CLL RTR SNA CLA ISZ ASMOF /IF CLOSE, CHECK LEVEL JMP OFFIT /TRY FOR NEXT JMP ASMBL /RESUME WORK AGAIN, TAD REPLEN /WE NOW REPEAT THE SAME LINE DCA NCHARS DCA LISTSW /NO LISTING DURRING REPEAT ISZ REPCNT JMP REASM /ASSUMING COUNT STILL OK TAD REPLST /RESTORE LISTING DCA LISTSW JMP NEWLIN /GET NEXT LINE MAXLIN=LTEMP / TXERR, TEXT " ERRORS" TXELN= .-TXERR PAGE
/ / DIVIDE AC BY 3 / USEFUL IN FPP REFERENCES TO BASE / 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 IN 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 / / INITIALIZE FOR OUTPUT / OUSETP, 0 TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS CIA /NEGATE IT (PAL10 BLOWS) DCA OUDWCT TAD NOUBUF DCA OUPTR /INITIALIZE WORD POINTER TAD OUJMPE DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH JMP I OUSETP NOUBUF, OUBUF / / STORE CHARACTERS IN OUTPUT BUFFER / IN PS8 FORMAT (YOU KNOW, 3 CHARS / IN 2 WORDS THE WRONG WAY) / OCHAR, 0 AND (377 DCA OUTEMP TAD OUTINH SZA CLA /IS THERE AN OUTPUT FILE? JMP I OCHAR /NO - EXIT CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD ISZ OUJMP /BUMP THE CHARACTER SWITCH OUJMP, HLT /THREE WAY CHARACTER SWITCH JMP OCHAR1 JMP OCHAR2 TAD OUTEMP CLL RTL RTL AND (7400 TAD I OUPOLD DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH /ORDER 4 BITS OF THIRD CHAR TAD OUTEMP CLL RTR RTR RAR AND (7400 TAD I OUPTR DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS TAD OUJMPE DCA OUJMP /RESET SWITCH ISZ OUPTR ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS JMP OUCOMN TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE JMS I (OUTDMP /DUMP THE BUFFER JMS OUSETP /RE-INITIALIZE THE POINTERS JMP OUCOMN OCHAR2, TAD OUPTR DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD OCHAR1, TAD OUTEMP DCA I OUPTR OUCOMN, CDF JMP I OCHAR OUTEMP, 0 OUPOLD, 0 OUPTR, 0 OUJMPE, JMP OUJMP OUDWCT, 0 OUTINH, 0 / / MOVE OUTPUT FILE NAME TO FIELD 0 / OFNAME, 0 TAD OUFILE DCA X10 TAD (OUFNAM-1 DCA X11 TAD (-4 DCA LTEMP CDF 10 TAD I X10 CDF 0 DCA I X11 ISZ LTEMP JMP .-5 JMP I OFNAME
/ / GET OUTPUT DEVICE CHARISTICS / OTYPE, 0 CDF 10 TAD I (7600 AND [17 TAD (DCB-1 DCA OTYPP TAD I OTYPP CDF 0 JMP I OTYPE OTYPP= OFNAME / / BASIC TITLE INFO / TITBUF, IFZERO RALF < TEXT "FLAP V" > IFNZRO RALF < TEXT "RALF V" > *.-1 VMTXT, 0;0;0 TITDAT, ZBLOCK 6 TEXT " PAGE" TITLEN= .-TITBUF PAGE
/ / PROCESS A STATEMENT / LUNAME, TAD CHRPTR /SAVE CHAR STUFF DCA CPTMP TAD NCHARS DCA NCTMP DCA LINKSW /CLEAR SWITCH JMS I [GETNAM /LOOK FOR NAME IFZERO RALF < JMP I (TRYSTR /COULD BE AN ORG> IFNZRO RALF < JMP I (GETEXP /NOT ONE OF OURS, I GUESS> 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 DEFLBL /ITS UNDEFINED CLL RAR /VERIFY ADDR TYPE SZA CLA JMP MDERR /THAT'S A NO-NO 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 MDERR, JMS I [ERMSG /MULTIPLY DEFINED 1504 /*MD* JMP I (ASMBL /FIELD IS OK 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 [GETCHR /ALLOW BLANK AFTER = JMP EQUERR TAD [-240 SZA CLA JMS I [BACK1 /ANYTHING ELSE GOES BACK JMS I [EXPR /GET VALUE RIGHT OF EQUALS JMP EQUERR /BAD EQU 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 PUTVAL /A NEW SYMBOL CLL RAR SZA CLA JMP EQUERR /TYPE CONFLICT PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE 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 EXPDEF /DEFINED BY RIGHT HAND SIDE 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
TRYBLK, TAD (35 /CHECK FOR BLANK SNA /MATCH BLANK? JMP JSTONE /YES AND [77 JMS I [R6L DCA NAME3 /MAKE MODIFIED NAME OF IT JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK JMP I (GETEXP /LOOKS BAD TAD [-240 /GOT IT? SZA CLA JMP I (GETEXP /LET EXPR TELL HIM IF ITS WRONG JSTONE, TAD (33 /USE OUR INTERNAL SYMBOL TABLE JMS I [FIND /IS IT THERE? JMP I (GETEXP /NO, LOOK IN USER'S 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 .-4 PSEUDO /PSEUDO OPS PDP8MR /PDP8 MRI FPPMR /FPPMR FPPS1 /OTHER FPP OPCODES FPPS2 FPPS3 FPPS4 FPPS5 FPMRI /INDIRECT FPP MEM REF FPMRS /SHORT DIRECT MEM REF FPMRL /LONG DIRECT REF PDPOPR /8-MODE OPERATES REPETX, JMS I (ADRGET /EVALUATE REPEAT EXPR CLL CMA RAR /3777 AND EXPVAL+2 DCA REPCNT JMP I [NEXTST PAGE
/ GETEXP, CDF FLD0 TAD CPTMP /RESTORE CHARACTER POINTER DCA CHRPTR TAD NCTMP /TO JUST AFTER TAG (IF ANY) DCA NCHARS SX, DCA OPCODE JMS I [EXPR /TRY FOR AN EXPRESSION JMP BADEXP /IF NONE, ERROR IFNZRO RALF < JMS RELERR /BOMB IF NOT ABSOLUTE EXP> TAD EXPVAL+2 JMS I [OUTWRD JMP I [NEXTST /GO DO NEXT STMT IFNZRO RALF </IF EXPVAL IS RELOCATABLE, RELERR, 0 /GIVE ERROR MESSAGE TAD EXPVAL+1 /CAUTION: THIS ROUTINE IS /SOMETIMES CALLED WITH NON-ZERO AC AND [7770 /JUST ESD BITS SNA CLA JMP I RELERR /ITS ABSOLUTELY FINE TAD EXPVAL+1 AND [7 /REMOVE ESD DCA EXPVAL+1 JMS I [ERMSG 2205 /*RE* JMP I RELERR > / FPPMR, ISZ FPPSWT /SET FORCE ENABLE JMS FPADR TAD WORD1 /IF WAY OFF BASE, SNA TAD FPPWD2 /OR IF FORCED SNA TAD XFLAG /OR IF INDEXED SZA CLA JMP FORMT1 /USE LONG FORM TAD WORD2 CLL TAD (-600 /COMPLETE OFF-BASE CHECK SZL CLA JMP FORMT1 /USE LONG JMP FORMT2 FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR JMS IXMES /BUT DISALLOW INDEX JMP F2WD /PUT TWO WORDS OUT / IXMES, 0 TAD XFLAG /NO INDEX ALLOWED SNA CLA JMP I IXMES /HE'S COOL JMS I [ERMSG 1130 /*IX* JMP I IXMES
FPMRL, JMS FPADR FORMT1, JMS I (FIXOPC F2WD, TAD FPPADR AND [7 /FIELD BITS TAD OPCODE /IN FIRST WORD FPDMP, IFZERO RALF < JMS I [OUTWRD TAD FPPADR+1 /LOW ADDRESS JMS I [OUTWRD JMP I [NEXTST /NEXT!> IFNZRO RALF < JMP I (OUTREL /DUMP TWO RELOCATABLE> FPMRS, JMS FPADR /COLLECT OPERAND JMS IXMES /ERROR IF INDEX GIVEN TAD WORD1 SZA CLA JMP BADEXP TAD WORD2 CLL TAD (-600 /DOES IT FIT? SNL CLA JMP FORMT2 BADEXP, JMS I [ERMSG 0230 /*BX* TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT JMS I [OUTWRD JMP I [NEXTST FPMRI, JMS FPADR TAD WORD1 SZA CLA JMP BADEXP /NOT EVEN CLOSE TAD WORD2 CLL TAD (-30 SZL CLA JMP BADEXP /GOTTA BE IN THE FIRST 10 FORMT3, JMS I (FIXOPC FORMT2, TAD WORD2 JMS I (OVER3 /BY 3 FOR BASE ADDRESS TAD [200 FPPS3, TAD OPCODE JMS I [OUTWRD /WHEW! JMP I [NEXTST FPPS1, 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 JMP FPDMP /PUT IT OUT
FPPS5, CLA IAC /DISALLOW INDEX INCR JMS I (GETADR /COLLECT ADDRESS AND INDEX IFNZRO RALF < TAD FPPADR AND [7770 /MUST BE ABSOLUTE SNA CLA JMP .+3 /OK JMS I [ERMSG 2205 /*RE*> TAD XFLAG SZA CLA /ANY INDEX? TAD EXPVAL+2 AND [7 /STRIP OFF ESD BITS TAD OPCODE JMS I [OUTWRD /DUMP THAT TAD FPPADR+1 JMS I [OUTWRD /NOW LOW 12 BITS JMP I [NEXTST / FPADR, 0 JMS I (GETADR /COLLECT ADDRESS AND INDEX TAD BASER+1 CIA STL TAD FPPADR+1 DCA WORD2 /GET ADDRESS RELATIVE TO BASE RAL TAD BASER CIA TAD FPPADR DCA WORD1 JMP I FPADR PAGE
/ PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR / IFZERO RALF < / / ASSEMBLE VARIOUS INSTRUCTION TYPES / PDP8MR, TAD CHRPTR /SAVE POSITION DCA CPTMP TAD NCHARS DCA NCTMP /SAVE COUNT JMS I [GETCHR /LOOK FOR SPACE "I" JMP GETMR /WILL GIVE BX ERROR TAD (-"I /IS IT I? SNA CLA /IF NOT, FORGET IT JMS I [GETCHR /MUST BE FOLLOWED BY SPACE JMP NOTIND TAD [-240 SZA CLA JMP NOTIND /SOMETHING ELSE TAD OPCODE /PUT INDIRECT INTO OPCODE TAD (400 DCA OPCODE GETMR, JMS ADRGET /PICK UP ADDRESS FIELD TAD EXPVAL+2 /CHECK PAGE OF ADDRESS AND [7600 SNA JMP PAGEZ /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 OFF ? SNA CLA JMP I (MAKLNK /YES, GO MAKE LINK JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE 1122 /*IR* THSPAG, TAD EXPVAL+2 /GET ADDRESS AND [177 /LOWER 7 BITS TAD [200 /PUT IN PAGE BIT SKP PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO) TAD OPCODE /PLUS OPCODE JMS I [OUTWRD /OUTPUT WORD JMP I [NEXTST NOTIND, TAD CPTMP /RESTORE CHAR POINTER DCA CHRPTR TAD NCTMP DCA NCHARS JMP GETMR /NOT AN INDIRECT>
FPPS4, JMS ADRGET /GET INDEX REG EXPRESSION IFZERO RALF < JMS LITERR /CAN'T ALLOW LITERAL> JMS SUBX /GET RELATIVE INDEX VALUE TAD EXPVAL+2 /GET LOWER 3 BITS AND [7 /OF INDEX REG EXPR TAD OPCODE /WITH OPCODE JMS I [OUTWRD /OUT JMP I [NEXTST ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE JMS I [EXPR /GET EXPR JMS I [ERMSG /BAD ADDR EXPR 0230 /*BX* JMP I ADRGET IFZERO RALF < LITERR, 0 /GIVE ERROR IF LITERAL TAD LITRL SNA CLA JMP I LITERR JMS I [ERMSG 1114 /*IL* JMP I LITERR > IFNZRO RALF < PDP8MR, JMS ADRGET JMP I (CHCKMR /V.56 >
GETADR, 0 /GET ADDR, INDEX DCA XITEMP /SAVE INDEX INCREMENT SWITCH JMS ADRGET /GET ADDR DCA FPPSWT /KILL FPP SWITCH IFZERO RALF < JMS LITERR /DISALLOW LITERALS> TAD EXPDEF /IF EXPR WAS UNDEFINED SNA CLA IAC /OR FORCE BIT WAS SET TAD FPP2WD DCA FPPWD2 /FORCE 2 WORD FORMAT DCA XFLAG /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 JMS I [BACK1 /WILL CAUSE A BX ERROR ISZ XFLAG /SET INDEX SWITCH TAD XITEMP /SET INDEX INCREMENT SWITCH DCA XINCR JMS ADRGET ISZ XINCR /CLEAR INDEX INCREMENT SWITCH IFZERO RALF < JMS LITERR > JMS SUBX /CALCULATE INDEX NO JMP I GETADR XITEMP, SUBX, 0 TAD INDXR+1 /CHECK FOR INDEX IN RANGE STL CIA TAD EXPVAL+2 DCA EXPVAL+2 RAL TAD INDXR CIA TAD EXPVAL+1 SZA CLA JMP BIERR TAD EXPVAL+2 CLL TAD [-10 SZL CLA BIERR, JMS I [ERMSG 0211 /*BI* JMP I SUBX
IFNZRO RALF < / / AT END OF PASS, / CLEAR LENGTHS OF ALL SECTIONS / CLRSCT, 0 TAD (PNDL+3 DCA LTEMP /POINT TO USER SYMBOL SPACE CDF FLD1 CSLOOP, TAD I LTEMP /GET TYPE AND [37 /STRIP TO TYPE ONLY TAD (-3 SPA CLA /IS IT COMMON OR SECTION? JMP NOTSCT /NO, PASS IT ISZ LTEMP /BUMP POINTER TO VALUE TAD I LTEMP AND [7770 /SAVE ESD NUMBER DCA I LTEMP ISZ LTEMP DCA I LTEMP /CLEAR LOW ORDER CLA CLL CMA RAL /-2 NOTSCT, TAD (6 /BUMP POINTER TAD LTEMP /TO NEXT SYMBOL DCA LTEMP TAD NEXT /COMPARE END OF SYMBOL TABLE CIA CLL TAD LTEMP SNL CLA JMP CSLOOP /MORE TO GO CDF FLD0 JMP I CLRSCT /THAS ALL> / / IFNZRO RALF < / / ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE / NOREL, 0 TAD WORD1 /IS SYMBOL RELOCATABLE? AND [7770 /TEST ESD BITS SZA CLA STL RAR /IF SO, FORCE ERROR JMS I (RELERR /TEST SUB EXPR JMP I NOREL DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS DCA DPFLG /DP HARDWARE JMP I [NEXTST / SET BASE AND INDEX LOCS INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET DCA X12 /HOPEFULLY UNUSED XR JMS I (ADRGET /COLLECT EXPRESSION TAD EXPVAL+1 DCA I X12 /HIGH ORDER AND ESD TAD EXPVAL+2 DCA I X12 /LOW ORDER JMP I [NEXTST >/THIS CONDITIONAL SASSEMBLY WAS /EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO /COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP. DELFIL, 0 TAD [7600 DCA OUFILE JMS I [OFNAME CLA IAC CIF 10 JMS I USR 4 OUFNAM 0 NOP JMP I DELFIL PAGE
/ / PRINT THE CURRENT LINE IF NOT ALREADY DONE / 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 BLINE /POINTER TO LINE DCA X13 DCA CRLF /CLEAR POSITION COUNT JMP PRLTST /IN CASE OF EMPTY LINE PRLNXT, TAD I X13 /GET A CHAR TAD (-211 /WATCH OUT FOR TAB SNA JMP TABIT /CONVERT TO BLANKS TAD (211 /RESTORE ISZ CRLF /BUMP POSITION COUNT JMS I PC /PRINT IT PRLTST, ISZ LINSIZ /CHECK COUNT JMP PRLNXT JMP I PRNTLN TABIT, TAD [240 /REPLACE TAB WITH BLANKS ISZ CRLF JMS I PC TAD CRLF AND [7 SZA CLA JMP TABIT JMP PRLTST / / GO TO NEXT LINE / CRLF, 0 CLA TAD (215 JMS I PC /PRINT A CHAR TAD (212 JMS I PC ISZ LINPAG /FULL PAGE? JMP I CRLF /NO CLA CMA DCA LINPAG / / NEW PAGE, WITH HEADING AND PAGE NO / TAD PASSNO /IF NOT LISTING PASS SMA SZA CLA TAD LISTSW /OR IF NOT LISTING, SNA CLA JMP I CRLF /DO NOT EJECT TAD RFORMF SZA /DON'T F.F. FIRST TIME JMS I PC /TOP OF PAGE TAD (214 DCA RFORMF JMS I (PRTXT /PRINT HEADING TITBUF-1 -TITLEN TAD LPAGE1 /FORM FEED COUNT JMS I (DECOUT TAD LPAGE2 SNA CLA JMP .+5 /NO SUB PAGE IF 0 TAD (255 JMS I PC TAD LPAGE2 JMS I (DECOUT ISZ LPAGE2 TAD (215 /FOR BH JMS I PC TAD (212 JMS I PC TAD (-71 /RESET LINE COUNTER DCA LINPAG JMP CRLF+1 /GIVE ANOTHER CRLF RFORMF, 0 / / PRINT TEXT / PRTXT, 0 TAD I PRTXT DCA X13 ISZ PRTXT TAD I PRTXT DCA PRTTMP ISZ PRTXT TAD I X13 JMS PRINT2 ISZ PRTTMP JMP .-3 JMP I PRTXT PRTTMP= PRNTLN / PRINT2, 0 DCA P2 TAD P2 JMS I [R6R JMS P1 TAD P2 JMS P1 JMP I PRINT2 / P1, 0 AND [77 SNA JMP .+4 /PRINT ZERO AS BLANK TAD (-40 /TEST ABOVE OR BELOW 300 SPA TAD [100 /ABOVE, MAKE 301 TO 337 TAD [240 /IF BELOW, MAKE 240 TO 277 JMS I PC /PRINT IT, WHATEVER IT IS JMP I P1
/ TTYOUT, 0 TLS TSF JMP .-1 TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE TAD (-14 /CTRL/O SZA CLA JMP I TTYOUT TAD .+2 DCA TTYOUT+1 JMP I TTYOUT / P2, 0 / IFZERO RALF < TXLNK, TEXT " LINKS" TXLLN= .-TXLNK > IFNZRO RALF < TXABR, TEXT " ABS REFS" TXALN= .-TXABR > PAGE
/ / GET AND EVALUATE AN EXPRESSION / EXPR, 0 /GET EXPRESSION DCA EXPVAL /ZERO EXPR VALUE DCA EXPVAL+1 DCA EXPVAL+2 CLA IAC DCA EXPDEF /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 IFZERO RALF < JMS I (CHKLIT /GO CHECK FOR LITERAL> JMS I (GETSGN /IGNORE +, BUMP LASTOP IF - SYMBOL, JMS I [GETNAM /NOW PICK UP NAME JMP NOSYM /NONE, TRY OTHER JMS I [LOOKUP /LOOK IT UP JMP UNDEF /A NEW ONE IFZERO RALF < JMP ADR /YES > IFNZRO RALF < CLL RAR SNA JMP ADR SCTN, TAD I LTEMP /GET TYPE AND (40 /FORCE BIT SZA CLA ISZ FPP2WD /SET FORCE EXPR SW TAD I X10 /GET ESD FROM SYMBOL AND [7770 /ESD ONLY DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO JMP CLR2 /SO CLEAR WORD 2>
NOTDOT, TAD (256-242 /IS IT DBL QUOTE? SZA CLA JMP ENDEXP ISZ NCHARS /IS THERE ANOTHER CHAR? JMP ISQUOT /YES, USE IT ENDEXP, JMS I [BACK1 /PUT IT BACK TAD EXPSW /WAS THERE ANY EXPRESSION AT ALL? SZA CLA JMP BAD /NO, DON'T SKIP IFZERO RALF < TAD LITRL /WAS IT A LITERAL REF? SZA CLA JMS I (CRLIT /YES, STICK IT IN THE POOL> TAD LASTOP /TRAILING OPERATOR? SNA JMP OKEXP /NO, ALL IS FINE CLL RAR /IF PLUS OPERATOR TAD XINCR /AND THATS LEGAL SNA CLA OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN BAD, JMS CKCTC CLA JMP I EXPR /AND RETURN / NOSYM, JMS I (NUMBER /LOOK FOR A NUMBER JMP ADREXP /USE NUMBER JMS I [GETCHR /NOT A NUMBER, GET A CHAR JMP ENDEXP+1 /NONE LEFT, END TAD (-256 /IS IT "." ? SZA JMP NOTDOT /NO, TRY FOR QUOTE TAD LOCTR1 /THIS WAS LOC SYMBOL DCA WORD1 /PUT VALUE INTO WORD1,2 TAD LOCTR2 JMP CLR2 /AND USE VALUE ISQUOT, DCA WORD1 TAD I CHRPTR JMP CLR2 CKCTC, 0 CLA KSF /IF NOTHING AT THE KEYBOARD, JMP I CKCTC /RETURN TAD [200 KRS /ELSE, LOOK AT IT TAD (-203 /IS IT CTRL/C? SNA JMP I [7600 /GO TO MOMMA JMP I CKCTC
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 CLR2, DCA WORD2 CDF FLD0 /FIX FIELD ADREXP, 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 ADRDIV ADRAND ADROR ADROR
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 EXPDEF /SET TYPE TO UNDEFINED CDF FLD0 /FIX FIELD DCA EXPSW /KILL FIRST TIME SWITCH 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 ENDEXP+1 /NONE, DONE DCA EXTMP /SAVE IT FINDOP, ISZ LASTOP TAD I X11 /GET NEXT LIST ENTRY SNA JMP NOOPR /ZERO IS END OF LIST TAD EXTMP /COMPARE SZA CLA JMP FINDOP /LOOP JMP SYMBOL /LOOK FOR OPERAND NOOPR, DCA LASTOP /NO MATCH FOUND JMP ENDEXP /PUT IT BACK PAGE
ADRADD, IFNZRO RALF < TAD WORD1 AND [7770 /IF THIS SYMBOL IS RELOCATABLE, SZA CLA /CHECK FOR EXPR VALIDITY JMS I (RELERR > 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 WORD1 /ORDER WORDS JMP ADRASX /LOOK FOR OPERATOR ADRSUB, IFNZRO RALF < TAD WORD1 /IF SYMBOL IS RELOCATABLE AND [7770 /WE MUST COMPARE SECTIONS CIA /IF EQUAL, EXPR BECOMES ABSOLUTE SNA /ELSE, EXPR IS ILLEGAL JMP .+5 /OK, USE EXPVAL ESD JMS I (RELERR /COMPARE: AC DELIBERATELY NON-ZERO TAD EXPVAL+1 AND [7 /IF WORD RELOCATABLE, EXP IS ABS DCA EXPVAL+1 > TAD WORD2 /SUBTR LOW 12 BITS CLL CML CIA TAD EXPVAL+2 DCA EXPVAL+2 /SAVE LOW HALF RAL TAD WORD1 /SUBTRACT HIGH HALF CIA AND [7 /DO NOT SUBTR ESD'S ADRASX, TAD EXPVAL+1 AND (7767 /PREVENT CARRY INTO BIT 8 ADRASY, DCA EXPVAL+1 /SAVE HIGH HALF JMP I (OPR8R /GET OPERATOR /INDXX HERE FOR FLAP IFZERO RALF < / SET BASE AND INDEX LOCS INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET DCA X12 /HOPEFULLY UNUSED XR JMS I (ADRGET /COLLECT EXPRESSION TAD EXPVAL+1 DCA I X12 /HIGH ORDER AND ESD TAD EXPVAL+2 DCA I X12 /LOW ORDER JMP I [NEXTST >
ADRAND, TAD WORD1 /AND AND EXPVAL+1 /HIGH AND [7 /3 BITS DCA EXPVAL+1 /HALF TAD WORD2 /THEN AND EXPVAL+2 /LOW JMP ADRAOX ADROR, TAD WORD1 /OR IS PERFORMED BY CMA /SETTING THE BITS AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A TAD WORD1 /AND THEN SETTING THE BITS AND [7 DCA EXPVAL+1 /THAT ARE ON IN A TAD WORD2 CMA AND EXPVAL+2 TAD WORD2 ADRAOX, DCA EXPVAL+2 IFNZRO RALF < JMS I (NOREL /**> JMP I (OPR8R /GET NEXT OPERATOR /
ADRMUL, TAD WORD2 /**RL CODE CIA DCA EXPVAL+1 /MULT BY TAD EXPVAL+2 /REPEATED ADDITIONS ISZ EXPVAL+1 JMP .-2 JMP ADRAOX ADRDIV, DCA WORD1 DCA EXPVAL+1 TAD WORD2 SNA CLA JMP DIVERR TAD EXPVAL+2 CIA CLL TAD WORD2 SZL JMP .+3 /DIVIDE BY ISZ WORD1 /COUNTING SUBTRACTIONS JMP .-4 CLA TAD WORD1 JMP ADRAOX
DIVERR, JMS I [ERMSG 0626 /*DV* JMP I (OPR8R /CONTINUE
PDPOPR, TAD CHRPTR DCA CPTMP TAD NCHARS DCA NCTMP JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST JMP TRYEXP /NONE TAD (33 /USE INTERNAL TABLE JMS I [FIND /IS IT THERE ? JMP TRYEXP /NO TAD (-PDPOP /IS IT AN OPERATE ? SZA CLA JMP TRYEXP /NO TAD I X10 /GET VALUE CDF FLD0 DCA EXPVAL+2 PDPOR, TAD EXPVAL+2 CMA /OR THEM TOGETHER AND OPCODE TAD EXPVAL+2 DCA OPCODE JMS I [GETCHR /MORE CHARS ? JMP I (FPPS3 /NO-DONE TAD [-240 /BLANK ? SNA CLA JMP PDPOPR /YES-PROCESS NEXT JMP I (BADEXP TRYEXP, CDF FLD0 TAD CPTMP DCA CHRPTR TAD NCTMP DCA NCHARS ISZ NCTMP SKP JMP I (FPPS3 JMS I [EXPR JMP I (BADEXP JMP PDPOR TXSYM, TEXT " SYMBOLS," TXSLN=.-TXSYM PAGE
IFZERO RALF < / / LITERAL THINGS / 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 / / CREATE A LINK FOR OFF-PAGE REFERENCE / MAKLNK, TAD (THSPAG /PROPER RETURN ADDR DCA CRLIT TAD OPCODE /SET INDIRECT BIT TAD (400 DCA OPCODE CLA IAC DCA PAGENO /SET INDICATOR ISZ LINKS /COUNT ANOTHER LINK GENERATED ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT JMP NOTP0 CRLIT, 0 /CREATE LITERAL /VALUE:EXPVAL, IN PAGE:PAGENO TAD PAGENO /CHECK FOR PAGE 0 SNA CLA JMP ISP0 /PAGE 0 LITERAL NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER DCA LITBAS TAD LOCTR2 /CHECK FOR LIT BUFFER FULL AND [100 SNA CLA JMP DOLIT-1 /USE 77 AS LIMIT TAD LOCTR2 AND [177 JMP DOLIT /USE CURRENT ADDR AS LIMIT
ISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER DCA LITBAS TAD [77 /ASSUME FIRST 64 WORDS USED 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 NOTIT, TAD LITPTR /POINTER+SIZE TAD (-177 /SHOULD BE LESS THAN 177 SMA CLA JMP NEWLIT /ENTER NEW LITERAL TAD LITPTR /NOW GET POINTER TAD LITBAS /TO TABLE DCA X11 /FOR COMPARISON ISZ LITPTR /INCREMENT POINTER TAD I X11 /GET WORD OF LITERAL CIA TAD EXPVAL+2 /COMPARE PROTOTYPE SZA CLA JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY 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 JMP I CRLIT
NEWLIT, CLA CMA TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN 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 EXPVAL+2 /MOVE LITERAL IN DCA I X10 TAD I XPAGE /SET UP LITERAL ADDRESS IAC DCA LITPTR JMP LITADR /RETURN LITERAL ADDRESS LITBAS, 0 NWUSED, 0 LITPTR, 0 PAGENO, 0 XPAGE, 0 PAGE />
/ / FIND SYMBOL TABLE ENTRY / FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3 / SKIP IF FOUND WITH TYPE IN AC / FIND, 0 /SYMBOL TABLE LOOKUP TAD BUCKET /GET BUCKET ADDRESS 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 I FIND /IT AIN'T HERE 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 NAME3 CIA CLL TAD I X10 /COMPARE LAST CHAR AND [7700 /HIGH HALF ONLY SZA CLA JMP NOTSAM ISZ FIND /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 FIND /RETURN NOTSAM, SZL CLA /IS NAME 1,2,3 .LT. ENTRY JMP I FIND /YES, IT ISN'T HERE TAD I OLDN3 /GET ADDR OF LINK INTO AC JMP LOOK /LOOP
/ / FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT / LOOKUP, 0 JMS FIND JMP .+4 SZA ISZ LOOKUP /SKIP RETURN IF DEFINED JMP I LOOKUP /RETURN TYPE CODE 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 DCA I NEXT /INITIAL VALUE IS ZERO DCA I NEXT TAD NEXT /CHECK FOR TABLE FULL CLL TAD [200 /GONNA OVERFLO PS8? SNL CLA JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP) JMS I [ERMSG1 2324 /*ST*
/ / COLLECT AN INTEGER IN THE CURRENT RADIX / NUMBER, 0 /GET INTEGER NUMBER (NO SIGN) DCA NSWTCH /CLEAR SWITCH DCA NOFLO /CLEAR OVRFLO SW DCA WORD1 /CLEAR 24 BIT NUMBER DCA WORD2 NUMLUP, JMS I (DIGIT JMP NODGT /TOO BAD 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 JMP ADDDGT OCTNUM, TAD NUM AND [7770 /CHECK FOR 8 OR 9 SZA CLA ISZ NOFLO /SET ERROR FLAG ADDDGT, 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 SZL /BEWARE OF OVERFLO ISZ NOFLO JMP NUMLUP /LOOP
NODGT, TAD NSWTCH /WAS THERE A NUMBER SNA CLA ISZ NUMBER /NO, SKIP TAD WORD1 AND [7770 /CHECK FOR MORE THAN 15 BITS SNA TAD NOFLO /OR GROSS OVERFLOW SNA CLA JMP I NUMBER /ALL GREEN JMS I [ERMSG 1605 /*NE* JMP I NUMBER /RETURN NOFLO= LOOKUP /ZERO IF NO ERRORS NUM= FIND NUM1= EXTMP NUM2= EXTMP2 NSWTCH, /ZERO IF NO DIGITS SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1 TAD WORD2 CLL RAL DCA WORD2 TAD WORD1 RAL DCA WORD1 SZL /IF BIT SHIFTED FROM HI WORD, ISZ NOFLO /SET ERROR FLAG JMP I SHIFT PAGE
/ / BACK UP GETCHR POINTERS, / WE DON'T WANT THIS ONE / BACK1, 0 CLA CMA /BACKUP COUNT TAD NCHARS DCA NCHARS CLA CMA /AND POINTER TAD CHRPTR DCA CHRPTR JMP I BACK1 / / GET NEXT CHAR FROM LINE BUFFER / FOR ASSEMBLY PURPOSES ONLY / SKIP UNLESS END OF LINE (CR, ;, OR /) / GETCHR, 0 JMS GETAC GETSKP, ISZ GETCHR /SKIP RETURN JMP I GETCHR BLANK, JMS GETAC /COME HERE IF BALNK OR TAB TAD (-257 /END OF LINE ON SLASH AFTER BLANK SNA CLA JMP GETCND JMS BACK1 /PUT IT BACK TAD [240 /AND RETURN A SINGLE BLANK JMP GETSKP /SKIP OUT SEMICL, ISZ SCSWT JMS BACK1 /PUT BACK SEMI COLON JMP I GETCHR GETAC, 0 ISZ NCHARS /END OF LINE? JMP .+4 /NO, GET IT GETCND, CLA CMA /YES, RESET IN CASE OF DCA NCHARS /ANOTHER CALL JMP I GETCHR /RETURN END OF LINE TAD I CHRPTR /PICK UP NEXT TAD [-240 /CHECK FOR BLANK SZA TAD (240-211 /OR TAB SNA JMP BLANK /THEY GET SPECIAL HANDLING TAD (211-273 /LOOKOUT FOR SEMICOLON SNA JMP SEMICL /ALSO SPECIAL TAD (273-276 /IGNORE CLOSE ANGLE BRACKET SNA JMP GETAC+1 /GET ANOTHER TAD (276 /ELSE, RESTORE CHAR JMP I GETAC /AND PASS IT BACK
/ / COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3 / NO SKIP ON RETURN IF NO SYMBOL / GETNAM, 0 DCA NAME1 /CLEAR SYMBOL SPACE DCA NAME2 DCA NAME3 JMS LETTER /GET A LETTER JMP ISSYM JMS GETCHR /CHECK FOR # JMP I GETNAM /NOPE TAD (-"# SNA CLA JMP ISSYM JMS BACK1 JMP I GETNAM ISSYM, DCA BUCKET ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE JMS GNC /FRIENDLY LOCAL SUBR JMS R6L DCA NAME1 JMS GNC TAD NAME1 DCA NAME1 JMS GNC JMS R6L DCA NAME2 JMS GNC TAD NAME2 DCA NAME2 JMS GNC JMS R6L DCA NAME3 JMS GNC /AFTER 6, WE IGNORE SKP CLA GNC, 0 JMS LETTER JMP I GNC /RETTURN LETTER JMS DIGIT JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER TAD (60 JMP I GNC
/ / IF NEXT CHAR IS A LETTER, RETURN 6 BITS / IF NOT, REPLACE CHAR AND SKIP. / LETTER, 0 JMS GETCHR JMP NLETR /NO LETTER, SKIP TAD (-333 CLL CML TAD (33 SZA SNL /DON'T ALLOW 300 JMP I LETTER JMS BACK1 NLETR, ISZ LETTER JMP I LETTER / / IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP / DIGIT, 0 JMS GETCHR JMP I DIGIT TAD (-272 CLL TAD (12 SNL JMP NDIGT ISZ DIGIT JMP I DIGIT NDIGT, JMS BACK1 JMP I DIGIT / R6L, 0 CLL RTL RTL RTL JMP I R6L / R6R, 0 RTR RTR RTR AND [77 JMP I R6R PAGE
/ / BUILD AN INSTRUCTION / FIXOPC, 0 /COMBINE OPCODE PARTS TAD XFLAG /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 / OPR8RS, -253 /PLUS -255 /MINUS -252 /STAR (MULTIPLY) ** -257 /SLASH (DIVIDE) -246 /AMPERSAND (AND) -240 /SPACE (OR) -241 /EXCLAMATION (OR) 0 /END OF LIST
/ / FATAL ERRORS / ERMSG1, 0 /PASS 1 (FATAL) MESSAGES CDF TAD I ERMSG1 /GET CODE DCA .+3 DCA PASSNO JMS ERMSG /DO THE MSG THING 0 IFZERO RALF < RETSYS, > TSF /FINISH TYPING JMP .-1 JMP I [7600 /EXIT TO PS8 / / GENERAL GARBAGE TYPE ERRORS / ERMSG, 0 CDF FLD0 /FIX FIELD CLA /NO MESSAGE ON PASS 1 TAD PASSNO SMA SZA /IF PASS 3, OUTPUT LEADING CRLF JMS I [CRLF SPA CLA JMP MSGDUN TAD (5555 /MINUSES JMS I [PRINT2 TAD I ERMSG /2-CHAR CODE JMS I [PRINT2 /PRINT THE MESSAGE TAD (5555 JMS I [PRINT2 TAD PASSNO SZA CLA JMP .+4 JMS I [PRINT2 PLINE, JMS I (PRNTLN JMS I [CRLF ISZ ERRORS /BUMP COUNT MSGDUN, ISZ ERMSG JMP I ERMSG
/ / OUTPUT DECIMAL / SUPPRESS LEADING ZEROS / PRINT "NO" INSTEAD OF "0" / DECOUT, 0 SNA /ZERO IS SPECIAL JMP DECNO /NO INSTEAD OF 0 DCA OTEMP DCA OCNT JMS DEC2 /GET THOUSANDS -1750 JMS DEC2 /HUNDREDS -144 JMS DEC2 /TENS -12 TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE) JMS PDIG /PRINT LAST DIGIT JMP I DECOUT /EASY, WHEN YOU KNOW HOW / DECNO, TAD (1617 /NO JMS I [PRINT2 JMP I DECOUT / / LAZY MAN'S DIVISION / DEC2, 0 CDF FLD0 /JUST TO MAKE SURE DEC3, CLA CLL TAD OTEMP SNA JMP DEC4 TAD I DEC2 /SUBTRACT DIVISOR SNL /TOO MUCH? JMP DEC4 /YES, STOP NOW DCA OTEMP /NO, SAVE NEW REMAIN ISZ OCNT /BUMP QUOTIENT JMP DEC3 /DO IT AGAIN DEC4, CLA ISZ DEC2 /SKIP RETURN TAD OCNT /CHECK FOR SIGNIFICANCE SNA JMP I DEC2 /NONE JMS PDIG CLA STL RAR /FORCE SIGNIFICANCE DCA OCNT JMP I DEC2
/ TENTH, -111 1463;1463;1463 1463;1463;1463 TEN, 1 PDIG, 0 TAD P260 JMS I PC JMP I PDIG P260, 260 5 / / OCTAL CONVERSION, THE HARD WAY / OCTOUT, 0 DCA OTEMP STL RAR /NO ZERO SUPPRESS DCA OCNT JMS DEC2 -1000 JMS DEC2 -100 JMS DEC2 -10 TAD OTEMP JMS PDIG JMP I OCTOUT PAGE
/ / OUTPUT ONE WORD / IFNZRO RALF < / / TEXT TYPE CODES: TTABS= 0400 TTORG= 1000 TTREL= 1400 / OUTREL, DCA WRD /HOLD FIRST WORD DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR TAD FPPADR /GET ESD CODE RTR RTR /RIGHT IN AC AND [177 /STRIP TO ESD ONLY SNA /CHECK FOR ABSOLUTE JMP PUTABS DCA FPPADR /SAVE ESD TAD PASSNO /CHECK FOR PASS 2 SZA CLA JMP PRNTRL /IF NOT, TREAT NORMALLY DCA ABSOP CLA STL RTL JMS I (FULCHK /ENSURE 3 WORDS LEFT TAD FPPADR /GET ESD AGAIN TAD (TTREL /INSERT CONTROL CODE DCA I OUTPTR TAD WRD /FIRST DATUM DCA I OUTPTR TAD FPPADR+1 DCA I OUTPTR JMS I (FULCHK /IS IT FULL? JMS BMPLOC /TWO WORDS OUT JMS BMPLOC /SO LOCCTR +2 JMP I [NEXTST PUTABS, ISZ ABREFS /COUNT IT ISZ LINKSW /SET FLAG PRNTRL, TAD WRD /GET FIRST WORD JMS OUTWRD TAD FPPADR+1 JMS OUTWRD JMP I [NEXTST >
/ OUTWRD, 0 /OUTPUT ROUTINE DCA WRD /SAVE WORD IFZERO RALF < TAD LOCTR2 /GET LOW 12 BITS OF LOCATION JMS I [R6L AND [37 /GET PAGE NUMBER (WITHIN FIELD) DCA OTEMP /SAVE PAGE NUMBER TAD OTEMP SZA CLA /POINTER TO LITERAL POINTER IAC TAD [P0LIT DCA OWTEMP TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT AND [177 CIA /COMPARE WITH LITERAL BOUNDARY TAD I OWTEMP SMA CLA JMP .+3 /NO PAGE OVER FLOW JMS I [ERMSG 2017 /*PO*> TAD PASSNO /CHECK PASS SZA JMP PRNTST /ITS NOT PASS 2 IFZERO RALF < TAD WRD /NOW OUTPUT WORD JMS I [R6R JMS OOCHAR TAD WRD AND [77 JMS OOCHAR > IFNZRO RALF < TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT SZA CLA JMP INABS /NO PROBLEM CLA IAC JMS I (FULCHK TAD (TTABS /SET ABS CONTROL CODE DCA I OUTPTR TAD OUTPTR /SAVE POINTER FOR FUTRUE REF DCA ABSOP INABS, ISZ I ABSOP /BUMP COUNT TAD WRD DCA I OUTPTR JMS I (FULCHK /GOOD!>
PRNTST, SMA SZA CLA TAD LISTSW /IS LIST ON ? SNA CLA JMP ENDOUT /NO, DONT PRINT JMS I [CRLF /NEW LINE TAD LOCTR1 /PRINT LOCATION COUNTER AND [7 JMS I (PDIG TAD LOCTR2 /NEXT FOUR DIGITS JMS I [OCTOUT TAD [240 JMS I PC TAD WRD /NOW WORD JMS I [OCTOUT TAD LINKSW /LINK GENERATED ON THIS LINE? SZA CLA TAD (4700 /IF SO, GIVE APOSTROPHE SPACE JMS I [PRINT2 DCA LINKSW /CLEAR SW JMS I (PRNTLN /PRINT LINE IF NECESSARY ENDOUT, JMS BMPLOC /BUMP LOC CNTR JMP I OUTWRD /RETURN / WRD, BMPLOC, 0 ISZ LOCTR2 /BUMP LOW ORDER JMP I BMPLOC CLA IAC TAD LOCTR1 AND (7767 /STOP CARRY INTO BIT 8 DCA LOCTR1 JMP I BMPLOC
IFZERO RALF < / / PUNCH CONTROL / NOPNCX, CLA IAC ENPNCX, DCA PNCHOF JMP I [NEXTST / / OUTPUT AN ORIGIN / PUTORG, 0 TAD PASSNO /CHECK FOR PASS 2 SZA CLA JMP I PUTORG /ELSE FORGET IT TAD LOCTR2 /OUTPUT FIRST CHAR JMS I [R6R TAD [100 JMS OOCHAR /OUTPUT CHAR TAD LOCTR2 /NOW LOWER HALF OF ORIGIN AND [77 JMS OOCHAR JMP I PUTORG OWTEMP, CHAROO, 0 OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM DCA CHAROO TAD PNCHOF /PUNCHING? SZA CLA JMP I OOCHAR /NOPE TAD CHAROO TAD CHKSUM DCA CHKSUM TAD CHAROO JMS I [OCHAR JMP I OOCHAR >
/ / BEGIN NEXT PASS / WITH APPROPRIATE THINGS RESET / TO DEFAULT VALUES / RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE TAD USR /EITHER 200 OR 7700 SPA CLA /IS USR IN CORE? JMP .+6 /NO CIF 10 /YES, DISMISS IT JMS I USR 11 /USROUT TAD [7700 DCA USR /ITS GONE IFNZRO RALF < CLA STL RTL /COUNTING FROM 2, DCA ESDNO /RESET ESD COUNT JMS I (CLRSCT /ZERO ALL SECTION LENGTHS> DCA ASMOF /ZERO CONDITIONAL SWITCH DCA SCSWT /ZERO SEMICOLON SWITCH TAD SYONLY /IF NOT SYM MAP ONLY DCA LISTSW /FORCE LIST ENABLE CLA IAC DCA LPAGE1 DCA LPAGE2 CLA CMA DCA LINPAG IFZERO RALF < TAD [177 DCA P0LIT /RESET LITERAL BUFFER POINTERS TAD [177 DCA CPLIT TAD [200 > DCA LOCTR2 /LOCATION COUNTER IFNZRO RALF < TAD (20 > DCA LOCTR1 CLL CML RAR /4000 DCA BASER /SET BASE BEYOND BELIEF DCA INDXR DCA INDXR+1 DCA RADIX /RESET DEFAULT OCTAL DCA ERRORS /ZERO ERROR COUNT DCA LINKS ISZ PASSNO /BUMP PASS NUMBER JMP I (NEWLIN JMP I (NEWLIN /DO NEXT PASS PAGE
/ / END OF A PASS / ENDX, IFZERO RALF < DCA PNCHOF /RE-ENABLE PUNCH> IFNZRO RALF < JMS I (BORG /SET MAX LEN OF CURRENT SECT> TAD PASSNO SMA CLA /WHAT PASS WAS THIS? JMP EOP2 /NOT THE FIRST IFNZRO RALF < TAD (INBUF-400 DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD> TAD BFILE SNA CLA JMP START3 /NO BINARY, START PASS 3 IFZERO RALF < TAD [200 /START BIN OUT WITH L/T JMS I [OCHAR JMP I (RESET > IFNZRO RALF < JMP I (DMPESD /OUTPUT EXT SYM TABLE> / EOP2, IFZERO RALF < CLA IAC /DUMP CURRENT PAGE LITERALS JMS I (DMPLIT JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS> TAD PASSNO SMA SZA CLA JMP EOP3 /YES, PRINT SYMBOL TABLE IFZERO RALF < TAD CHKSUM /OUTPUT CHECKSUM JMS I [R6R JMS I [OCHAR TAD CHKSUM AND [77 JMS I [OCHAR /LOWER HALF TAD [200 /TRAILER CHAR JMS I [OCHAR > IFNZRO RALF < DCA I OUTPTR /SET OUTPUT END INDICATOR> JMS I (OCLOSE /CLOSE THE BINARY FILE START3, DCA PASSNO /SKIP PASS TWO JMS I (OOPEN /OPEN LISTING FILE IFZERO RALF < JMP NOP3 /NO LISTING, GIVE INFO ON TTY> IFNZRO RALF < JMP I (RETSYS > TAD [OCHAR /CHANGE PRINT ROUTINE DCA PC JMP I (RESET /NO,RESET EVERYTHING
/ / END OF LAST PASS / GIVE SOME STATISTICS / EOP3, CLA CMA DCA LINPAG JMS I [CRLF NOP3, JMS I (7607 /READ IN OVERLAY 0100 OVERLY, OVBUFR 40 /USE SYS SCRATCH BLK JMP I (7605 JMP I OVERLY CHCKMR, 0 TAD OPCODE /BE SURE ALL REFS ARE AND [200 /ARE ON SAME PG SZA CLA TAD LOCTR2 AND [7600 CIA TAD EXPVAL+2 AND [7600 SZA CLA ADRERR, JMS I [ERMSG 0201 /**BA** TAD EXPVAL+2 AND [177 TAD OPCODE JMS I [OUTWRD JMP I [NEXTST IOERR, TAD INOP /REMOVE JMS PRNTLN DCA PLINE JMS I [ERMSG1 1117 /**IO** INOP, NOP PAGE
IFZERO RALF < / ORG THINGS FOR ABSOLUTE ASSEMBLIES / TRYSTR, JMS I [GETCHR JMP I [NEXTST /WHAT CAN YOU DO? TAD (-252 /IS IT AN ORG SZA CLA JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE ORGX, JMS I (ADRGET 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 EXPVAL+1 AND [7 DCA LOCTR1 TAD PNCHOF /PUNCHING ENABLED? SNA TAD PASSNO /PASS 2? SZA CLA JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD TAD LOCTR1 /NEW FIELD BITS RTL CLL RAL TAD (300 /TURN ON THE LEFT TWO BITS JMS I [OCHAR /PUT IT OUT (NOT IN CHECK SUM) JMP SAMPAG /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 SAMPAG, TAD EXPVAL+2 DCA LOCTR2 JMS I (PUTORG JMP I [NEXTST /DONE PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE CLL TAD [177 AND [7600 DCA EXPVAL+2 RAL TAD LOCTR1 DCA EXPVAL+1 JMP ORGX+1 /DO ORG THINGS
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 LOCTR2 AND [177 /ANYTHING TO DUMP? SNA CLA JMP DMPFIN /NO TAD PASSNO SMA SZA CLA JMS I [CRLF /ONLY IF PASS 3 JMS I (PUTORG TAD [177 /STORE SPURIOUS LITERAL BOUNDARY DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES LITLUP, TAD I X10 /NO, GET NEXT LITERAL JMS I [OUTWRD /OUTPUT WORD AND BUMP LC TAD X10 /DONE? IAC AND [77 SZA CLA JMP LITLUP /LOOP DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH DCA OUTSWT JMP I DMPLIT /ALL DONE SWTOUT, 0 >
EXPON, TAD LASTOP DCA TMP DCA LASTOP JMS I (GETSGN /GET SIGN OF EXPONENT TAD RADIX DCA OTEMP ISZ RADIX /SET RADIX TO DECIMAL JMS I (NUMBER /GET EXPONENT NOP TAD OTEMP DCA RADIX /RESTORE RADIX TAD TMP CLL RAR TAD LASTOP RAR /LASTOP TO LINK, DCA LASTOP /TMP TO SIGN OF LASTOP TAD WORD2 SZL CIA /PUT SIGN ON EXP JMP I (OVER TMP, 0 IFZERO RALF < PAGE / >
IFNZRO RALF < / / IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER / RETSYS, JMS I (DELFIL /THIS LOCATION USED BY INIT CODE /MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING /FROM COMPILER + OUTPUT DEV IS NOT SYS CDF 10 TAD (7604 /POINT TO 2ND OUT FILE THING DCA X11 TAD (7611 /POINTER TO 3RD DCA X10 TAD (-5 /LENGTH OF SUCH THINGS DCA LTEMP TAD I X10 /MOVE 3RD TO 2ND DCA I X11 /FOR LOADER MAP FILE ISZ LTEMP JMP .-3 TAD I [7600 /WAS THERE A FIRST OUT FILE AND NP17 /(BINARY OUT)* DCA LTEMP TAD OUTBLK /GET FILE LENGTH AND (377 CLL RTL RTL CIA TAD LTEMP /COMBINE UNIT AND LEN DCA I X10 /FOR FIRST INPUT FILE TO LOADER TAD PASBLK /STARTING BLOCK DCA I X10 DCA I X10 /THAT'S THE END OF INPUT CDF 0 TAD ERRORS /IF NO ERRORS SNA CLA ISZ CHNSW /SHOULD WE CHAIN? JMP I (7605 /NO!!! ISZ I (7746 /** CIF 10 JMS I USR 6 /CHAIN LDRBLK, 0 /FIRST BLOCK OF LOADER / PASBLK, 0 /FIRST BLOCK OF FILE PASSED CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
/ / OUTPUT A BLOCK OF BINARY / OUTBLK, 0 /AT END OF PASS2, BECOMES /LENGTH OF BINARY FILE TAD (OUCTL /DEV HNDLR CONTROL WORD JMS I (OUTDMP /CALL THE HANDLER TAD MOUBUF DCA OUTPTR /RESET BUFFER POINTER DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL JMP I OUTBLK MOUBUF, OUBUF-1 / TYPCOD, 2500 /UNDEFINED 0000 /ADDRESS 3000 /XTERNAL 0300 /COMMON 2300 /SECTION -1 /? -1 /? 7000 /8-M0DE SECTION 3200 /8-MODE PAGE0 COMMON SECTION 0600 /8-MODE FIELD1 SECTION
BORG, 0 CDF FLD0 TAD LOCTR1 RTR RTR AND [177 TAD (ESDBUF-1 /POINT INTO ESD TABLE DCA LTEMP TAD I LTEMP TAD (4 /ADDRESS VALUE DCA LTEMP CDF FLD1 TAD LOCTR1 AND [7 /GET ADDR BITS ONLY DCA BOTMP /SAVE EM TAD I LTEMP /OLD HIGH VALUE BITS AND [7 CIA TAD BOTMP /COMPARE THEM SPA JMP BOXIT /NO UPDATE REQUIRED SNA CLA JMP BOCHKL /NO DIFFERENCE YET TAD LOCTR1 DCA I LTEMP /RESET TO NEW HIGH ISZ LTEMP JMP BOSETL /SKIP OVER TEST BOCHKL, ISZ LTEMP /POINT TO LO-ORDER TAD I LTEMP CIA CLL TAD LOCTR2 /COMPARE LOW ORDERS SNL CLA JMP BOXIT /NO REPLACE BOSETL, TAD LOCTR2 DCA I LTEMP BOXIT, CLA CDF FLD0 JMP I BORG /WHEW! BOTMP= EXTMP PAGE
NEWESD, 0 TAD ESDNO TAD (-177 /CHECK LIMIT SPA CLA JMP .+3 JMS I [ERMSG1 /TOO MANY 3023 /*XS* ISZ ESDNO /BUMP COUNT TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1 SMA CLA JMP I NEWESD TAD ESDNO TAD (ESDBUF-1 /INDEX BUFFER DCA ESDTMP CDF FLD1 TAD I OLDN3 /GET POINTER TO THIS SYMBOL CDF FLD0 DCA I ESDTMP TAD ESDTMP TAD [200 DCA ESDTMP /NOW ADDRESS CHAR TABLE TAD BUCKET DCA I ESDTMP JMP I NEWESD ESDTMP= EXTMP / / RELOCATION CONTROL PSEUDO-OPS / ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT JMP ESDERR JMS I [LOOKUP /FIND IT JMP QENT /UNDEFINED CLL RAR /MUST BE USER ADDR TYPE SNA CLA TAD I X10 /LOOK AT ESD AND [7770 SZA CLA /IS IT RELOCATABLE? JMP OKENT /YES QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1 1105 /*IE* OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT JMP I [NEXTST
/ EXTRNX, CLA STL RTL DCA STYPE /EXTERNS ARE TYPE 2 JMS I [GETNAM JMP ESDERR JMS I [LOOKUP JMS CRESD /IF UNDEFINED, DEFINE IT CLL RTR /IF DEFINED, CHECK LEGALITY SZA CLA ESDERR, JMS I [ERMSG 0523 /*ES* JMP I [NEXTST / CLA IAC /FIELD1 SECT=11 IAC /COMMZ SECT=10 SECT8X, TAD [7 JMP COMMX+1 SECTX, CLA IAC COMMX, TAD (COMMN /GET DESIRED CODE DCA STYPE /FOR SECTION TYPE JMS I [GETNAM DCA BUCKET /IF NO NAME, BLANK COMMON JMS I [LOOKUP JMP NEWSCT /UNDEFINED CIA /OLD FRIEND TAD STYPE /SAME? SNA CLA JMP SETSCT /YUP, DO IT JMP ESDERR / CRESD, 0 JMS NEWESD /CREATE NEW ESD ENTRY CDF FLD1 TAD I LTEMP /SET TYPE CODE AND [7700 TAD STYPE DCA I LTEMP ISZ LTEMP TAD ESDNO CLL RTL /ESD NO TO SYMBOL VLAUE RTL DCA I LTEMP CDF FLD0 JMP I CRESD / NEWSCT, JMS CRESD /CREATE AN ESD SETSCT, JMS I (BORG /ADJUST LOC CTR'S CDF FLD1 TAD I X10 /GET NEW LOC CTR VALUE DCA LOCTR1 TAD I X10 DCA LOCTR2 /LOW LOC CTR CDF FLD0 JMP PUTORG
/ ORGX, JMS I (ADRGET /GET ORG EXPR JMS I (BORG TAD EXPVAL+1 AND [7770 /DOES IT HAVE AN ESD? SNA CLA TAD LOCTR1 /IF NOT, KEEP CURRENT ESD AND [7770 TAD EXPVAL+1 DCA LOCTR1 /RESET PC TAD EXPVAL+2 DCA LOCTR2 PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY SZA CLA JMP I [NEXTST DCA ABSOP /CLEAR ABS OUTPUT SW CLA STL RTL JMS I (FULCHK /ROOM FOR MORE? TAD LOCTR1 RTR RTR /GET ESD AND [177 TAD (TTORG DCA I OUTPTR TAD LOCTR1 AND [7 /FIELD BITS DCA I OUTPTR TAD LOCTR2 /ADDRESS DCA I OUTPTR JMS I (FULCHK JMP I [NEXTST PAGE />
/ / VARIOUS PSEUDO-OP HANDLERS / LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY LSTOFX, DCA LISTSW JMP I [NEXTST / DECX, CLA IAC OCTALX, DCA RADIX JMP I [NEXTST / 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 JMS I [R6L /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
/ / CONDITIONAL ASSEMBLY HANDLERS / IFNZRX, CLA CMA IFZROX, JMS GETCON /GET CONDITION EXPR TAD EXPVAL+1 /HIGH ORDER AND [7 SNA TAD EXPVAL+2 /LOW ORDER SWTCH, SNA CLA JMP TRUE /PRESENT CONDITION OF ASMOF IS OK FALSE, TAD ASMOF /GOTTA REVERSE IT CMA DCA ASMOF /THAT DOES IT TRUE, CDF FLD0 JMS I [GETCHR JMP BADCND /FORGOT THE ANGLE TAD [-240 /IGNORE BLANK, IF ANY SNA JMP TRUE /TRY AGAIN TAD (240-274 SNA CLA JMP I (ASMBL /GO FROM HERE JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT JMP BADCND / GETCON, 0 DCA ASMOF /SET INITIAL TRUTH JMS I [EXPR /COLLECT EXPR JMP OKCND /BAD MAY MEAN GOOD BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD 1103 /*IC* DCA ASMOF /ENABLE ASSEMBLY JMP I (ASMBL OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST? SNA CLA JMP I GETCON /YES JMP BADCND / IFNEGX, CLA CMA IFPOSX, JMS GETCON CLA CLL IAC RTL /4 AND EXPVAL+1 /SIGN OF EXPR JMP SWTCH /GO FROM THERE / IFNDFX, CLA CMA IFREFX, DCA ASMOF JMS I [GETNAM /GET SYMBOL NAME JMP BADCND /GOTTA GIVE SOMETHING JMS I [FIND /IS IT KNOWN TO US? JMP FALSE /NOT REFERENCED YET SNA CLA /SKIP IF DEFINED DCA ASMOF /ELSE ASSEMBLE JMP TRUE
IFSWX, CLA CMA IFNSWX, DCA ASMOF TAD (7642 /ADDRESS OF OPTION WORDS DCA WORD2 /A TEMP JMS I (LETTER /ALLOW LETTER JMP .+4 /AC BETWEEN 1 AND 32 JMS I (DIGIT /OR NUMBER JMP BADCND /ALL ELSE IS BAD TAD (33 /MAKE 0 = Z+1 ISZ WORD2 /BUMP POINTER TAD (-14 /IS IT IN THIS WORD? SMA SZA JMP .-3 /NO, POINT TO NEXT CIA CMA STL /BIT COUNT AWAY FROM LINK DCA WORD1 RAL /SHIFT ISZ WORD1 /COUNT JMP .-2 CDF 10 /OPTIONS FIELD AND I WORD2 /GET SELECTED BIT JMP SWTCH /AND TEST IT / ZBLKX, JMS I (ADRGET /EVALUATE EXPR TAD EXPVAL+2 CIA DCA ZBCNT /HOLD COUNT TAD LISTSW /SAVE LISTSWITCH DCA ZBTMP JMS I [OUTWRD /PUT A WORD DCA LISTSW /NO LIST AFTER FIRST ISZ ZBCNT /COUNT THEM JMP .-3 /MORE TAD ZBTMP /RESTORE DCA LISTSW /LISTING JMP I [NEXTST ZBCNT= EXTMP ZBTMP= EXTMP2 PAGE
PTP=20 DCB=7760 INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER IN7400, 7400 NINCTL, INCTL+1 NINREC, INRECS IOPEN, 0 TAD (7617 DCA INFPTR /RESET FILE POINTER JMS INNEWF /FETCH NEW HNDLR, ETC /WHILE USR IS STILL IN CORE CLA CMA DCA INCHCT /FORCE A READ ON NEXT CHAR JMP I IOPEN ICHAR, 0 IN7600, 7600 INCHAR, CDF INFLD ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH ISZ INCHCT INJMPP, JMP INJMP TAD INEOF SZA CLA /DID LAST READ GIVE EOF ? GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE TAD INCTR CLL TAD NINREC SNL DCA INCTR /RESTORE INCR IF NOT OVERFLOWED SZL /IS THIS THE LAST READ? ISZ INEOF /YES - SET END-OF-FILE FLAG CLL CML CMA RTR /MAKE CONTROL WORD RTR /FROM THE AMOUNT OF THE OVERFLOW RTR /(IF ANY) AND THE STANDARD CNTRL WD TAD NINCTL DCA INCTLW CDF JMS I INHNDL /CALL THE DEVICE HANDLER INCTLW, 0 INBUFP, INBUF INREC, 0 JMP INERRX /SOME KIND OF HANDLER ERROR INBREC, TAD INREC TAD NINREC DCA INREC /UPDATE THE RECORD NUMBER TAD INCTLW AND IN7600 CLL RAL TAD INCTLW AND IN7600 CMA DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT TAD INJMPP DCA INJMP /RESET THE CHARACTER SWITCH TAD INBUFP DCA INPTR /AND THE WORD POINTER JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE SMA CLA /WHICH TYPE WAS IT ? JMP INBREC /END OF FILE - RESUME PROCESSING JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH JMP ICHAR1 JMP ICHAR2 TAD INJMPP DCA INJMP TAD I INPTR AND IN7400 CLL RTR RTR /COMBINE HIGH-ORDER FOUR BITS OF TAD INCTLW RTR /THE 2 WORD TO FORM THE 3RD CHAR RTR ISZ INPTR JMP INCOMN ICHAR2, TAD I INPTR AND IN7400 DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD ISZ INPTR /BUMP THE WORD POINTER ICHAR1, TAD I INPTR INCOMN, AND (377 TAD (-232 SNA /IS THE CHARACTER A ^Z? JMP GETNEW /YES - GET A NEW FILE TAD (232 /RESTORE THE CHARACTER CDF JMP I ICHAR /AND RETURN INFPTR, 7617 INEOF, 1 /PARAMETERS ARE SET UP SO THAT INCHCT, /IOPEN IS UNNECESSARY. INNEWF, -1 TAD NINDEV DCA INHNDL /INITIALIZE HANDLER ADDRESS CDF 10 TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY CDF SNA /ANY MORE? JMP I (ENDX /NO MORE INPUT CIF 10 JMS I USR 1 /ASSIGN, FETCH HANDLER INHNDL, 0 JMP I [IOERR /HUH? CDF 10 TAD I INFPTR AND (7760 /GET LENGTH PART OF WORD SZA /LENGTH OF 0 MEANS LENGTH GE 256 TAD [17 /ADD HIGH ORDER BITS CLL CML RTR RTR DCA INCTR /STORE LENGTH OF FILE ISZ INFPTR TAD I INFPTR CDF DCA INREC /STARTING RECORD NUMBER OF FILE ISZ INFPTR DCA INEOF /ZERO END-OF-FILE FLAG JMP I INNEWF INCTR, 0 INPTR, 0 OUFNAM, 0;0;0;0 /OUTPUT FILE NAME NINDEV, INDEVH PAGE
OOPEN, 0 TAD OUFILE /INCR OUTPUT FILE POINTER TAD (5 DCA OUFILE CDF 10 TAD I OUFILE /GET DEVICE CODE, LEN DCA OUELEN /HOLD IT A MO JMS I (OFNAME /GET FILE NAME INTO FIELD 0 TAD OUELEN /CHECK FOR NULL FILE SNA CLA JMP ONOFIL /INHIBIT OUTPUT JMS GETUSR /LOAD USR IF NOT ALREADY IN TAD OUNAME /RESET ENTER CALL DCA OUBLK TAD NOUDEV DCA OUHNDL TAD OUELEN /THE UNIT CIF 10 JMS I USR 1 /ASSIGN, FETCH HANDLER OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY JMP I [IOERR /HUH? TAD OUELEN /UNIT AGAIN CIF 10 JMS I USR 3 /ENTER OUTPUT FILE OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK OUELEN, 0 /REPLACED WITH LENGTH OF HOLE JMP I [IOERR /YOU BLEW IT!!! DCA OUCCNT DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG JMS I (OUSETP ISZ OOPEN JMP I OOPEN ONOFIL, ISZ I (OUTINH JMP I OOPEN OUTDMP, 0 DCA OUCTLW /STORE THE CONTROL WORD TAD OUCCNT SNA ISZ OUCTLW TAD OUBLK DCA OUREC /COMPUTE STARTING BLOCK TAD OUCTLW JMS I [R6L AND [17 /COMPUTE THE NUMBER OF RECORDS TAD OUCCNT /UPDATE SIZE OF FILE DCA OUCCNT TAD OUCCNT CLL CML TAD OUELEN SNL SZA CLA /EXCEED GIVEN LENGTH ? JMP I [IOERR /YES - ERROR CDF JMS I OUHNDL OUCTLW, 0 LOUBUF, OUBUF OUREC, 0 JMP I [IOERR JMP I OUTDMP OCLOSE, 0 JMS GETUSR /ENSURE USR IN CORE IFNZRO RALF < TAD PASSNO SZA CLA JMP .+6 TAD (377 JMS I (FULCHK /DUMP LAST BLOCK TAD OUCCNT /SAVE FILE LENGTH DCA I (OUTBLK /FOR CHAIN JMP NODUMP > JMS I (OTYPE AND (770 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT SZA CLA /AND SKIP ^Z OUTPUT IF TRUE TAD (232 /OUTPUT A ^Z JMS I [OCHAR FILLLP, JMS I [OCHAR JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE SPA CLA TAD [100 TAD [77 AND I (OUDWCT SZA CLA /UP TO THE BOUNDARY YET? JMP FILLLP /NO - FILL WITH ZEROS TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT TAD (OUCTL&3700 SNA /A FULL WRITE LEFT? JMP NODUMP /YES DON'T DO IT TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS JMS OUTDMP NODUMP, CIF CDF 10 TAD I OUFILE CDF JMS I USR 4 /CLOSE THE OUTPUT FILE OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME OUCCNT, 0 JMP I [IOERR /ERROR WHILE CLOSING - BAD!! JMP I OCLOSE /ALL DONE NOUDEV, OUDEVH
/ / LOAD USR IF NOT IN CORE ALREADY / GETUSR, 0 TAD USR /CURRENT CALL ADDR SMA CLA JMP I GETUSR /WE GOT IT CIF 10 JMS I USR /THE ANSWERING SERVICE 10 /CALLS THE SR TAD [200 DCA USR /RESET THE CALL ADDRESS JMP I GETUSR /JES FINE PAGE
FULCHK, 0 IFNZRO RALF < / / IF THE RELOCATABLE BINARY OUTPUT / BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC) / FILL THE REST WITH NOP CODES AND OUTPUT THE / BLOCK. / TAD OUTPTR TAD KOUBUF SPA CLA JMP I FULCHK FULLUP, TAD OUTPTR TAD KOUBUF SMA CLA JMP .+4 CLA IAC DCA I OUTPTR JMP FULLUP JMS I (OUTBLK JMP I FULCHK KOUBUF, -OUBUF-377 > / / / GET SIGN CHARACTER IF ANY / BUMP LASTOP IF MINUS / GETSGN, 0 JMS I [GETCHR JMP I GETSGN TAD (-255 /MINUS? SNA ISZ LASTOP SZA CLL CMA RAR /IF IT WAS PLUS, BECOMES 0 SZA CLA /SKIP IF PLUS OR MINUS JMS I [BACK1 /OTHERWISE PUT IT BACK JMP I GETSGN
/ AS PER RICHIE LARY / / SINGLE AND DOUBLE PRECISION / FLOATING POINT INPUT / / EX, TAD M3 FX, TAD M3 DCA DESW /STORE LENGTH TAD (-7 JMS CLEAR /CLEAR FAC+OP DCA LASTOP JMS GETSGN /GET SIGN STA /CLA CMA DCA DPSW /SET NO DP GETD, DCA DCNT JMS I (DIGIT /GET A DIGIT JMP LOOKP /NO DCA OTEMP /SAVE IT JMS I (FMPTEN /MULT FAC*10 JMS CLEAR TAD OTEMP SZA JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0 TAD DPSW CMA TAD DCNT /BUMP IF FP SEEN JMP GETD
LOOKP, JMS I [GETCHR JMP OVER /DONE TAD (-256 SNA JMP DECPT TAD (256-304 CLL RAR SNA CLA JMP I (EXPON /E OR D DEXERR, JMS I [ERMSG 0620 /FP JMP NOTNEG DECPT, ISZ DPSW JMP DEXERR /2 PERIODS JMP GETD / OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC SNA JMP NOSCAL /NO SCALING NEEDE CLL SMA CIA CML /SIGN IN LINK,MAGNITUDE IN AC DCA DCNT /AS A COUNT SNL TAD (TENTH-TEN /OFFSET KLUDGE DCA OTEMP SCALUP, TAD OTEMP JMS I (FMPTEN /MULT BY 10.0 OR 0.1 ISZ DCNT JMP SCALUP NOSCAL, JMS CLEAR STL RAR DCA OP+5 /ROUNDING CONSTANT JMS I (ADD TAD AC SZA CLA JMS I (NORM /WATCH IT! DCA AC+5 TAD LASTOP SNA CLA /SIGN -? JMP NOTNEG /NO TAD (AC+5 JMS I (SETUP ACNGLP, RAL TAD I P /NEGATE FAC CLL CIA DCA I P STA TAD P DCA P ISZ CT JMP ACNGLP NOTNEG, JMS CLEAR /SET UP X10 TAD I X10 JMS I [OUTWRD ISZ DESW /OUTPUT # JMP .-3 JMP I [NEXTST
CLEAR, 0 /AC MAY NOT BE 0 TAD (-7 DCA CT TAD (OPX-1 DCA X10 DCA I X10 ISZ CT JMP .-2 JMP I CLEAR DCNT=FULCHK DPSW=NCTMP DESW=OPCODE PAGE
OVBUFR=. FAD, 0 /FLOATING ADD DIGIT IN AC DCA OP TAD (13 DCA OPX ALNLP, TAD OPX CIA TAD ACX SNA /ALIGNED? JMP GOADD /YES SMA CLA TAD (OPX-ACX JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1 JMP ALNLP /TRY AGAIN GOADD, JMS ADD /ADD FRACTIONS JMS NORM /NORMALIZE RESULT JMP I FAD /RETURN / RSHFT, 0 /SHIFT RIGHT TAD (ACX /DEFAULT IS FAC JMS SETUP ISZ I P /BUMP EXPONENT RSLP, ISZ P TAD I P RAR DCA I P ISZ CT JMP RSLP JMP I RSHFT / ADD, 0 /ADD TO FAC TAD (OP+5 DCA PP2 TAD (AC+5 JMS SETUP ADDLP, RAL /CARRY TAD I PP2 TAD I P DCA I P /ADD ONE WORD STA TAD P /COMPLEMENT LINK DCA P STA TAD PP2 /COMPLEMENT LINK DCA PP2 ISZ CT JMP ADDLP JMP I ADD
NORM, 0 /NORMALIZE FAC TAD AC SPA CLA /CHECK FOR OVERNORMALIZATION JMS RSHFT /AND CORRECT NORMLP, STL RTR AND AC SZA CLA /NORMALIZED? JMP I NORM /YES TAD (AC+5 JMS SETUP LSLP, TAD I P RAL /LEFT SHIFT DCA I P /FAC 1 BIT STA CML /COMPLEMENT LINK TAD P DCA P ISZ CT JMP LSLP STA TAD ACX /BUMP EXP DCA ACX /DOWN 1 JMP NORMLP
FMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1 TAD (TEN JMS SETUP TAD AC SNA CLA /AC=0 MEANS RESULT=0 JMP I FMPTEN TAD I P TAD ACX /FUDGE FAC DCA ACX /EXPONENT TAD (MUX DCA X11 TAD (ACX DCA SETUP TAD (OPX DCA X10 DCA MUX /CLEAR MULT TEMP EXP MPLP1, ISZ SETUP TAD I SETUP /MOVE FAC DCA I X10 /TO OP DCA I SETUP /CLEAR FAC ISZ P TAD I P /MOVE MULTIPLIER DCA I X11 /TO MULT TEMP ISZ CT JMP MPLP1 / MPLP2, TAD (MUX-ACX JMS RSHFT /SHIFT MULT TEMP RIGHT 1 SZL JMS ADD /ADD IF LOW ORDER BIT WAS 1 JMS RSHFT /SHIFT FAC RIGHT TAD MU+5 SZA CLA /12 SUCCESSIVE 0 BITS JMP MPLP2 /IN MULTIPLIER MEANS DONE JMS NORM JMP I FMPTEN / SETUP, 0 /COMMON CODE DCA P TAD (-6 DCA CT CLL JMP I SETUP / MUX, 0 /MULT TEMP MU, ZBLOCK 6 CT=CPTMP P=EXTMP PP2=PAGEN
PAGE
IFNZRO RALF < ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN PNDL /DITTO FOR BLANK COMMON ZBLOCK 376 /FILL TO 400 LOCS / / BEGIN OF PASS 2: / DUMP EXTERNAL SYMBOL DICTIONARY / DURING PASSES 2 AND 3, THIS IS INPUT BUFFER / DMPESD, CLA CLL CMA RAL /-2 DCA EXTMP2 /PASS CONTROL TAD (3 /RALF OUTPUT IDENTIFIER DCA I OUTPTR TAD VERS DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES TAD DPFLG /4000=NEED DP HARDWARE DCA I OUTPTR /EXACTLY FILL A BLOCK DCA I OUTPTR ESDSCN, TAD (ESDBUF-1 DCA X10 /POINT TO POINTERS TAD (ESDBUF+177 DCA X12 /POINT TO INITAIL CHARS TAD ESDNO CIA DCA EXTMP ESDLUP, TAD (-3 DCA LTEMP /NAME LENGTH COUNT TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME DCA X13 TAD I X10 /GET POINTER DCA X11 TAD I X12 /GET FIRST CHAR SNA /BLANK BECOMES # TAD (43 ESDNLP, JMS I [R6L DCA EQUN+2 CDF FLD1 TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE DCA EQUN+3 /HOLD IT CDF FLD0 TAD EQUN+3 JMS I [R6R /GET LEFT CHAR TAD EQUN+2 /COMBINE THEM DCA I X13 TAD EQUN+3 /GET RIGHT HALF OF PAIR AND [77 ISZ LTEMP JMP ESDNLP AND [37 /DROP FORCE BIT FROM TYPE DCA EQUN+3 CDF FLD1 TAD I X11 /HIGH VALUE DCA EQUN+4 TAD I X11 /LOW VALUE DCA EQUN+5 CDF FLD0 TAD EXTMP2 /WHAT PASS IS THIS? RAR /LINK 0 IF FIRST, 1 IF SECOND SNL CLA JMP NOENTS /FIRST, ENTRYS NOT OUTPUT TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND CLL RAR SNA CLA SNL JMP ESDLND /NO GO JMP ESDOUT /YES, PUT IT NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN CLL RAR SNA /SKIP IF OK JMP ESDLND /UNDEFINED OR ENTRY RAR SNA CLA JMP ESDOUT /IF EXTERN, DO IT TAD EQUN+4 /IF SECTION, CHECK AND [7 /THAT LENGTH SNA /IS NON-ZERO TAD EQUN+5 SNA CLA JMP ESDLND /ZERO LEN JUST GETS IN THE WAY ESDOUT, TAD (EQUN-1 DCA X13 TAD (-6 DCA LTEMP TAD I X13 /GET OUTPUT WORD DCA I OUTPTR ISZ LTEMP JMP .-3 /6-WORD ENTRIES TAD OUTPTR TAD OUTBUF SPA CLA JMP ESDLND /NOT END OF BLOCK YET JMS I (OUTBLK TAD (3 DCA I OUTPTR DCA I OUTPTR DCA I OUTPTR DCA I OUTPTR ESDLND, ISZ EXTMP /GO THRU ESD LIST JMP ESDLUP ISZ EXTMP2 /WHOLE LIST TWO PASSES JMP ESDSCN TAD (-6 /THEN STORE END-OF-ESD DCA LTEMP DCA I OUTPTR ISZ LTEMP JMP .-2 TAD (377 /FORCE BLOCK OUTPUT JMS I (FULCHK CDF FLD1 /THEN DEFAULT ORG TAD I (LMAIN /IF MAIN LEN .NE. 0 AND [7 SNA TAD I (LMAIN+1 CDF FLD0 SNA CLA JMP I (RESET /FIRST SECTION WILL GET IT TAD (TTORG+1 /ORG TO ZERO OF MAIN DCA I OUTPTR DCA I OUTPTR DCA I OUTPTR JMP I (RESET OUTBUF, 1001 PAGE />
/ / INITIALIZATION CODE / BEGIN, JMP CHNIN /IF ENTERED BY CHAIN GCMND, CIF 10 /IF ENTERED BY .R, ETC JMS I USR /USR IS LEFT OVER 5 /DECODE IFZERO RALF < 620 /DEFAULT EXT = .FP> IFNZRO RALF < 2201 /DEFAULT EXT = .RA> DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED CHNIN, JMS I (7607 4100 /TEMP WRITE OUT OVERLAY 6600 /NOW AT 6600 40 /TO SYS SCRATCH BLK 40 JMP I (7605 /ERROR CDF 10 IFNZRO RALF < TAD I [7600 /BIN FILE UNIT AND NP17 SNA /IS THERE ONE? JMP DEFBIN /NO, SET DEFAULT TAD (7757 /POINT TO DEV CTRL WORD DCA WORD1 TAD I WORD1 SPA CLA JMP OKBIN /FILE-STRUCTURED, OK CDF 0 JMS I (PRTXT /TYPE MESSAGE TXBBIN-1 -TXBLN JMS I [CRLF JMP GCMND /TRY AGAIN / DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS DCA I [7600 /SET UNIT TAD [7600 DCA X10 /SET POINTER TAD (0617 /FO DCA I X10 TAD (2224 /RT DCA I X10 TAD (2216 /RN DCA I X10 /FORTRN. DCA I X10 CDF 0 JMP I (NOEXT /NOW, OPEN THE FILE>
OKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE GBIN, CDF 10 TAD I (7644 AND (20 SNA CLA ISZ SYONLY /=NO SLASH T CDF 0 JMS I (NEW /**SEE IF NEED 2 PG HANDLER 7600 JMS I (OOPEN DCA BFILE IFNZRO RALF < TAD R41 /L OR G SWITCH** CDF 10 AND I (7643 /TEST /L OR /G SWITCH CDF 0 SNA CLA /** JMP KCHN /KILL CHAIN, IT'S SET CIF 10 CLA IAC /UNIT IS SYS JMS I USR 2 /LOOKUP LBLK, LDRNAM /LOADER.SV R41, 41 /** JMP KCHN /NO FIND, NO CALL TAD LBLK /STARTING BLOCK DCA I (LDRBLK /FOR CHAIN TAD I (OUBLK /OUTPUT STARTING BLOCK DCA I (PASBLK /SAVED FOR CHAIN TO LOADER CLA CMA /ENABLE CHAIN KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER> JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS JMS I (INNEWF /GET INPUT HANDLER CLA CMA DCA I (INCHCT /SET INITIAL COUNT TAD NP7700 DCA USR /FROM NOW ON, USE THE HIGH CALL
JMS I (NEW 7605 /CHECK LIST DEV TOO** CDF 10 TAD I (7611 /LST FILE EXT SNA TAD (1423 /LS DEFAULT DCA I (7611 TAD I (7666 /GET DATE DCA WORD1 / / MOVE SYMBOL TABLE TO ITS PROPER LOCATION / TAD (1777 DCA X10 /LOADED ADDRESS OF SYMBOL TABLE CLA CMA DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS TAD (-FREE /LENGTH OF SYMBOL TABLE DCA WORD2 /SET COUNT TAD I X10 DCA I X11 /THIS SAVES SWAPS OF USR ISZ WORD2 JMP .-3 CDF 0 JMP I (GDATE /CHECK FOR FPP PRESENCE** PAGE
/ / PUT THE DATE INTO THE PAGE HEADING / GDATE, TAD (1000 DCA I (7746 /SET NO-RESTART BIT /PUT VERNUM IN TITLE LINE TAD VMSG DCA I (VMTXT TAD VMSG+1 /PATCH LEVEL DCA I (VMTXT+1 DCA OCNT /CLEAR OCNT TAD WORD1 /RE-GET DATE SNA JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED AND (370 CLL RTR RAR TAD (-12 SPA JMP .+3 ISZ OCNT JMP .-4 TAD (72 /60+12 DCA OTEMP TAD (TITDAT-1 DCA X11 TAD OCNT JMS I (R6L SZA TAD (6000 TAD OTEMP DCA I X11 TAD WORD1 AND (7400 /MONTH JMS I (R6L TAD (MONTHS-3 DCA X10 TAD I X10 DCA I X11 TAD I X10 DCA I X11 DCA OCNT TAD WORD1 AND [7 DCA OTEMP TAD I (7777 AND (600 RTR CLL RTR TAD OTEMP TAD (106
TAD (-12 SPA JMP .+3 ISZ OCNT JMP .-4 TAD (72 DCA OTEMP TAD (5560 TAD OCNT DCA I 11 TAD OTEMP JMS I (R6L TAD (40 DCA I X11 JMP I (NEWLIN VMSG, VNUM&70^10+VNUM&707+6060 PATCH&77^100+40 IFNZRO RALF < LDRNAM, TEXT "LOAD@@SV" TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED" TXBLN= .-TXBBIN > MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
PAGE /PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN NEW, 0 TAD NT2 /CHECK IF ALREADY CHECKED SZA CLA JMP NEWDON TAD I NEW /NO. GET THE DEV TO CHECK DCA NTEMP CDF 10 TAD I NTEMP /GET DEV.NUM AND [17 DCA NT1 /INCHK NEEDS TO KNOW TOO TAD NT1 SNA /IF 0,THEN NO DEVICE JMP NEWDON DCA NTEMP CLA CMA TAD I (37 /GET PTR TO DEV TBL TAD NTEMP DCA NTEMP /PTS TO ENTRY IN DEV TBL TAD I NTEMP CDF 0 SMA CLA JMP FIX /NOT A 2 PG HANDLER TAD (6377 /FIX ALL LOCATIONS THAT REFER TO /THE BUFFER VARIABLES. /THE CHANGES ARE: /OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200 /INRECS=1,INCTL=200 DCA I (BLINE TAD (6000 DCA I (NOUBUF IFNZRO RALF < TAD (5777 DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS TAD (6601 DCA I (NINDEV TAD (201 DCA I (NINCTL JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER DCA I (NINREC TAD (6000 DCA I (LOUBUF TAD (7201 DCA I (NOUDEV TAD (5777 DCA I (OUTPTR TAD (6377 DCA I (CHRPTR IFNZRO RALF < TAD (1401 DCA I (KOUBUF > TAD (7201 FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN NEWDON, ISZ NEW /GET CORRECT ADDR JMP I NEW NTEMP, 0 NT1, 0 /DEV. NUM. NT2, 0 /0 IF NO 2PG HANDLERS YET INCHK, 0 /CHECK THE INPUT DEVICES JMS NEW INLOC, 7617 TAD INLOC DCA NEXTIN ANOTH, TAD NT1 SNA CLA /SKIP IF FILE USED JMP I INCHK TAD NT2 SZA CLA /SKIP IF STILL 1 PAGE HANDLERS JMP I INCHK TAD NP2 TAD NEXTIN DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR JMS NEW NEXTIN, 0 JMP ANOTH NP2, 2 NOKBIN, CDF 10 /BELONGS WITH INIT CODE TAD I [7600 AND NP17 TAD (7646 DCA WORD1 /CREATE POINTER INTO DEV TBL TAD I WORD1 CDF 0 TAD (-7607 SNA CLA /IF ITS SYS, NO PROBLEMS DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE CDF 10 TAD I (7604 SZA JMP FEND /AN EXT WAS SPECIFIED IFZERO RALF < TAD (0216 /.BN DEFAULT FOR FLAP JMP FEND > IFNZRO RALF < NOEXT, CDF 10 TAD I (7643 /CHECK IF L OR G SPEC AND L41 SNA CLA TAD (0610 /NO-NEEDS RL EXT TAD (1404 > /YES-NEEDS LD FEND, DCA I (7604 CDF 0 JMP I (GBIN L41, 41 TPNSH, 0 TAD (1401 /CHANGE OUTPUT BUFFER DCA I (OUTBUF IAC JMP I TPNSH / PAGE
LDADR, RELOC OVBUFR TAD ERRORS /ERROR COUNT JMS I (DECOUT JMS I (PRTXT /"ERRORS" TXERR-1 -TXELN JMS I [CRLF IFZERO RALF < TAD PASSNO /IF NOT LISTING PASS SPA SNA CLA /ERROR COUNT IS ENUF JMP I (RETSYS > TAD NEXT TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS CLL RAR /DIVIDE JMS I (OVER3 /BY 6 JMS I (DECOUT JMS I (PRTXT /"SYMBOLS, " TXSYM-1 -TXSLN IFZERO RALF < TAD LINKS JMS I (DECOUT JMS I (PRTXT /"LINKS" TXLNK-1 -TXLLN > IFNZRO RALF < TAD ABREFS JMS I (DECOUT JMS I (PRTXT /"ABS REFS" TXABR-1 -TXALN > JMS I [CRLF TAD (-33 /27 BUCKETS DCA LTEMP DCA BUCKET CLA CMA DCA OPCODE /SYMBOLS PER LINE COUNTER
STPRNT, TAD BUCKET DCA EXTMP /BUCKET START ADDRESS LUPBKT, CDF FLD1 TAD I EXTMP /WAS THAT LAST SYMBOL ? SNA JMP NXTBKT /YES, GO GET NEXT BUCKET DCA EXTMP /SAVE LINK ADDR TAD EXTMP DCA X14 /SET UP POINTER FOR NAME ISZ OPCODE /IS LINE FULL? JMP .+4 /NO TAD (-4 DCA OPCODE JMS I [CRLF TAD BUCKET SNA /WATCH FOR # TAD (43 JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR CDF FLD1 TAD I X14 /SYMBOL JMS I [PRINT2 /PRINT 2 AND 3 CDF FLD1 TAD I X14 JMS I [PRINT2 /PRINT 4 AND 5 CDF FLD1 TAD I X14 IFNZRO RALF < DCA OTEMP /HOLD TAD OTEMP > AND [7700 /PRINT 6 AND BLANK JMS I [PRINT2 IFNZRO RALF < TAD OTEMP /GET TYPE AND [17 TAD (TYPCOD /POINT TO TABLE DCA OTEMP TAD I OTEMP /GET TYPE INDICATOR JMS I [PRINT2 > CDF FLD1 TAD I X14 /PRINT FIRST DIGIT AND [7 JMS I (PDIG /FIELD DIGIT CDF FLD1 TAD I X14 /LOW 12 BITS JMS I [OCTOUT JMS I [PRINT2 /TWO BLANKS JMP LUPBKT
NXTBKT, ISZ BUCKET /NEXT BUCKET CHAR CDF FLD0 ISZ LTEMP /INCREMENT COUNT JMP STPRNT JMS I [CRLF /DO FINAL CRLF** TAD (214 /DO NOT PAGEJ JMS I PC /THAT WOULD GIVE A HEADING JMS I (OCLOSE JMP I (RETSYS /FINISH IT OFF PAGE RELOC
/ PAGE 0 LITERALS FIELD 1 *10000
/ / SYMBOL TABLE IS IN FIELD ONE. / EACH ENTRY HAS THE FOLLOWING FORMAT / / 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST / 1: 2ND AND 3RD CHARS OF SYMBOL / 2: 4TH AND 5TH / 3: 6TH AND TYPE CODE / 4: ESD # AND HIGH-ORDER VALUE / 5: LOW-ORDER VALUE / USER=1 XTERN=2 COMMN=3 SECTN=4 PSUDO=5 PDPMR=6 FPPMRF=7 FPPSF1=10 /JXN, TRAP FPPSF2=11 /JA, SETB, SETX FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM, /PAUS, JAC, STARTD, STARTF FPPSF4=13 /ALN, ATX, XTA FPPSF5=14 /ADDX, LDX FPPMRI=15 /% FPPMRS=16 /' FPPMRL=17 /# PDPOP=20 / / THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING / THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT, / THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE. / IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE / DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS / *12000 NOPUNCH *10000 ENPUNCH
/ / BUCKETS FOR USER-DEFINED SYMBOLS / AND PDP8 OPERATES AND IOTS / PNDL ZBLOCK 33
/ / BUCKETS FOR INTERNALLY DEFINED SYMBOLS / AL BL CL DL EL FL GL HL IL JL KL LL ML NL OL PL QL RL SL TL UL VL WL XL YL ZL
AL, .+5 /ADDR 0404;2200 FPPSF2 0 .+5 /ADDX 0404;3000 FPPSF5 0110 .+5 /ALN 1416;0 FPPSF4 0010 IFZERO RALF < .+5 /AND 1604;0 PDPMR AND 0 > IFNZRO RALF < .+5 /AND . 1604;0 PDPMR 200 .+5 /AND% 1604;0 PDPMR+500 600 .+5 /ANDZ 1604;3200 PDPMR 0 .+5 /ANDZ% 1604;3200 PDPMR+500 400 > 0 /ATX 2430;0 FPPSF4 0020 BL, 0 /BASE 0123;0500 PSUDO BASEX CL, .+5 /CDF 0406;0 PDPOP CDF .+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 IFZERO RALF < 0 > IFNZRO RALF < .+5 > 1514;0 /CML PDPOP CML IFNZRO RALF < .+5 /COMMON 1715;1517 PSUDO+1600 COMMX 0 /COMMZ (8-MODE COMM SECT) 1715;1532 PSUDO SECT8X-1 >
DL, IFZERO RALF < .+5 /DCA 0301;0 PDPMR DCA 0 > IFNZRO RALF < .+5 /DCA . 0301;0 PDPMR 3200 .+5 /DCA% 0301;0 PDPMR+500 3600 .+5 /DCAZ 0301;3200 PDPMR DCA 0 .+5 /DCAZ% 0301;3200 PDPMR+500 DCA I 0 > IFZERO RALF < 0 > /DECIMAL IFNZRO RALF < .+5 > 0503;1115 PSUDO+0100 DECX IFNZRO RALF < 0 /DPCHK 2003;1013 PSUDO DPCHKX > EL, .+5 /E 0;0 PSUDO EX .+5 /END 1604;0 PSUDO ENDX IFZERO RALF < 0 /ENPUNCH 1620;2516 PSUDO+0300 ENPNCX > IFNZRO RALF < .+5 /ENTRY 1624;2231 PSUDO ENTRX 0 /EXTERN 3024;0522 PSUDO+1600 EXTRNX >
FL, .+5 /F 0;0 PSUDO FX .+5 /FADD 0104;0400 FPPMRF 1000 .+5 /FADD# 0104;0400 FPPMRL+300 1000 .+5 /FADD% 0104;0400 FPPMRI+500 1000 .+5 /FADD' 0104;0400 FPPMRS+700 1000 .+5 /FADDM 0104;0415 FPPMRF 5000 .+5 /FADDM# 0104;0415 FPPMRL+300 5000 .+5 /FADDM% 0104;0415 FPPMRI+500 5000 .+5 /FADDM' 0104;0415 FPPMRS+700 5000 .+5 /FCLA 0314;0100 FPPSF3 0002
.+5 /FDIV 0411;2600 FPPMRF 3000 .+5 /FDIV# 0411;2600 FPPMRL+300 3000 .+5 /FDIV% 0411;2600 FPPMRI+500 3000 .+5 /FDIV' 0411;2600 FPPMRI+700 3000 .+5 /FEXIT 0530;1124 FPPSF3 0 IFNZRO RALF < .+5 /FIELD1 (8-MODE FIELD1 SECT) 1105;1404 PSUDO+6100 SECT8X-2 > .+5 /FLDA 1404;0100 FPPMRF 0000 .+5 /FLDA# 1404;0100 FPPMRL+300 0000 .+5 /FLDA% 1404;0100 FPPMRI+500 0000 .+5 /FLDA' 1404;0100 FPPMRS+700 0000
.+5 /FMUL 1525;1400 FPPMRF 4000 .+5 /FMUL# 1525;1400 FPPMRL+300 4000 .+5 /FMUL% 1525;1400 FPPMRI+500 4000 .+5 /FMUL' 1525;1400 FPPMRS+700 4000 .+5 /FMULM 1525;1415 FPPMRF 7000 .+5 /FMULM# 1525;1415 FPPMRL+300 7000 .+5 /FMULM% 1525;1415 FPPMRI+500 7000 .+5 /FMULM' 1525;1415 FPPMRS+700 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 /FSTA# 2324;0100 FPPMRL+300 6000 .+5 /FSTA% 2324;0100 FPPMRI+500 6000 .+5 /FSTA' 2324;0100 FPPMRS+700 6000 .+5 /FSUB 2325;0200 FPPMRF 2000 .+5 /FSUB# 2325;0200 FPPMRL+300 2000 .+5 /FSUB% 2325;0200 FPPMRI+500 2000 0 /FSUB' 2325;0200 FPPMRS+700 2000
GL= 0 /AINT NONE HL, 0 /HLT 1424;0 PDPOP HLT IL, .+5 /IAC 0103;0 PDPOP IAC .+5 /IFFLAP 0606;1401 PSUDO+2000 IFZERO RALF <TRUE> IFNZRO RALF <FALSE> .+5 /IFNDEF 0616;0405 PSUDO+0600 IFNDFX .+5 /IFNEG 0616;0507 PSUDO IFNEGX .+5 /IFNSW 0616;2327 PSUDO IFNSWX .+5 /IFNZRO 0616;3222 PSUDO+1700 IFNZRX
.+5 /IFPOS 0620;1723 PSUDO IFPOSX .+5 /IFRALF 0622;0114 PSUDO+0600 IFNZRO RALF <TRUE> IFZERO RALF <FALSE> .+5 /IFREF 0622;0506 PSUDO IFREFX .+5 /IFSW 0623;2700 PSUDO IFSWX .+5 /IFZERO 0632;0522 PSUDO+1700 IFZROX .+5 1604;0530 PSUDO INDXX .+5 /IOF 1706;0 PDPOP IOF .+5 /ION 1716;0 PDPOP ION IFZERO RALF < 0 /ISZ 2332;0 PDPMR ISZ 0 > IFNZRO RALF < .+5 /ISZ . 2332;0 PDPMR ISZ .&7600 .+5 /ISZ% 2332;0 PDPMR+500 ISZ I .&7600 .+5 /ISZZ 2332;3200 PDPMR ISZ 0 0 /ISZZ% 2332;3200 PDPMR+500 ISZ I 0 >
JL, .+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 IFZERO RALF < .+5 /JMP 1520;0 PDPMR JMP 0 .+5 /JMS 1523;0 PDPMR JMS 0 > IFNZRO RALF < .+5 /JMP . 1520;0 PDPMR JMP .&7600 .+5 /JMP% 1520;0 PDPMR+500 JMP I .&7600 .+5 /JMPZ 1520;3200 PDPMR JMP 0 .+5 /JMPZ% 1520;3200 PDPMR+500 JMP I 0 .+5 /JMS . 1523;0 PDPMR JMS .&7600 .+5 /JMS% 1523;0 PDPMR+500 JMS I .&7600 .+5 /JMSZ 1523;3200 PDPMR JMS 0 .+5 /JMSZ% 1523;3200 PDPMR+500 JMS I 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 KL, .+5 /KCC 0303;0 PDPOP KCC .+5 /KRB 2202;0 PDPOP KRB .+5 /KRS 2223;0 PDPOP KRS 0 /KSF 2306;0 PDPOP KSF LL, .+5 /LAS 0123;0 PDPOP LAS .+5 /LDX 0430;0 FPPSF5 0100 .+5 /LISTOFF 1123;2417 PSUDO+0600 LSTOFX 0 /LISTON 1123;2417 PSUDO+1600 LSTONX
ML= 0 /NO LIST NL, IFZERO RALF < .+5 > IFNZRO RALF < 0 > 1720;0 /NOP PDPOP NOP IFZERO RALF < 0 /NOPUNCH 1720;2516 PSUDO+0300 NOPNCX > OL, .+5 /OCTAL 0324;0114 PSUDO OCTALX .+5 /ORG 2207;0 PSUDO ORGX 0 /OSR 2322;0 PDPOP OSR IFZERO RALF < PL, 0 /PAGE 0107;0500 PSUDO PAGEX > IFNZRO RALF <PL=0 > QL= 0 /WHAT DID YOU EXPECT? RL, .+5 /RAL 0114;0 PDPOP RAL .+5 /RAR 0122;0 PDPOP RAR .+5 /RDF 0406;0 PDPOP RDF .+5 /REPEAT 0520;0501 PSUDO+2400 REPETX .+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
SL, .+5 /S 0;0 PSUDO SX IFNZRO RALF < .+5 /SECT 0503;2400 PSUDO SECTX .+5 /8 MODE SECT 0503;2470 PSUDO SECT8X > .+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 /STARTE 2401;2224 FPPSF3+0500 0050 .+5 /STARTF 2401;2224 FPPSF3+0600 0005 .+5 /STL 2414;0 PDPOP STL .+5 /SZA 3201;0 PDPOP SZA 0 /SZL 3214;0 PDPOP SZL
TL, IFZERO RALF < .+5 /TAD 0104;0 PDPMR TAD 0 > IFNZRO RALF < .+5 /TAD . 0104;0 PDPMR TAD .&7600 .+5 /TAD% 0104;0 PDPMR+500 TAD I .&7600 .+5 /TADZ 0104;3200 PDPMR TAD 0 .+5 /TADZ% 0104;3200 PDPMR+500 TAD I 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
UL= 0 VL= 0 WL= 0 XL, 0 /XTA 2401;0 FPPSF4 0030 YL= 0 ZL, 0 /ZBLOCK 0214;1703 PSUDO+1300 ZBLKX
IFZERO RALF < PNDL=0 > IFNZRO RALF < PNDL, .+6 /BLANK COMMON 0;0 3 /CODE FOR COMMON 40;0 /ESD #2, LEN=0 0 /#MAIN 1501;1116 4 /CODE FOR SECTION LMAIN, 20;0 /ESD #1, LEN=0> FREE, END, END /NICE WHEN FLAP ASSEMBLES $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search