X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fralf.pa;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fall%2Fralf.pa;h=ae2b65439adcadac3ec7c1ac175b064f934ab405;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/all/ralf.pa b/sw/os8/v3d/sources/fortran/all/ralf.pa new file mode 100644 index 0000000..ae2b654 --- /dev/null +++ b/sw/os8/v3d/sources/fortran/all/ralf.pa @@ -0,0 +1,4450 @@ +/ 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 +/ +/ 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 +/ +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 + IFNZRO RALF + .+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 + IFZERO RALF + .+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 +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 + $ +