14 /COPYRIGHT (C) 1974, 1975, 1977
15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
21 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
24 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
30 /EQUIPMRNT COROPATION.
32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
40 \f/ RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV
43 / FPPASM BY HANK MAURER
44 / RALF MODS BY JUD LEONARD
45 / OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY
46 / NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER
48 / THE FOLLOWING FORMULA GIVES THE NUM
50 / -(FREE+200[BASE8])/6[BASE10]
51 / WHERE THE VALUE OF FREE IS FROM THE
55 IFNDEF RALF <RALF=1 /GO RELOCATABLE THEN>
57 / ASSEMBLE WITH PAL8-V9 WITH W SWITCH
59 / .SAVE SYS RALF.SV ;200=2000
62 / CHANGES FOR OS/78 AND OS/8 V3D BY P.T.
63 / .CHANGED VERSION NUMBER TO 62
64 / .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF:
65 / 1.) THE ESD IS LONGER THAN ONE BLOCK, AND
66 / 2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER
72 PATCH="A /PATCH LEVEL A
74 VERS, VNUM /VERSION NUMBER
75 OLDN3, 0 /
\ fTEMP FOR LOOKUP
76 OTEMP, 0 /A COUPLE OF TEMPS THAT
77 OCNT, 0 /DIDNT FIT INTO THEIR PAGE
87 NCHARS, -1 /CHARACTER INPUT STUFF
89 NCTMP, 0 /USED TO SAVE CHAR POSITION
90 LINSIZ, 0 /SIZE OF LINE FOR PRINTING
91 STYPE, /SYMBOL TYPE CODE
92 CHKSUM, 0 /FOR BINARY OUTPUT
94 LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM
97 ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
98 LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
101 \fBASER, 4000 /BASE REGISTER SETTING
103 INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER
105 EXPVAL, 0 /EXPRESSION VALUE
108 EXPDEF, 0 /=0 IF EXPR IS UNDEFINED
109 EXPSW, 0 /FLAG=1 IF NO EXPR
110 WORD1, 0 /TEMPORARY 2 WORD OPERAND
112 FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR
114 OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER
115 XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT
116 XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR
117 BUCKET, 0 /FIRST CHAR OF NAME
118 NAME1, 0 /CHARS 2 AND 3 OF NAME
119 NAME2, 0 /CHARS 4 AND 5 OF NAME
120 NAME3, 0 /CHAR 6 OF NAME AND TYPE
121 LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR
122 PASSNO, -1 /PASS NUMBER
123 ASMOF, 0 /SET NEGATIVE WHEN ASSEMBLY OFF
124 PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT
125 LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING)
126 OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED
127 REPCNT, 0 /REPEAT COUNTER
128 SCSWT, 0 /SEMICOLON SWITCH
129 RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL)
130 LTEMP, -177 /TEMP USED BY LOOKUP
131 EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS
133 EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN
134 /NEXT TWO LOCS USED WITH EQUN BY DMPESD
135 FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR
136 FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT
137 FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0
138 LITRL, 0 /SET = 1 FOR LITERAL
142 ERRORS, 0 /ERROR COUNT
143 PC, TTYOUT /OUTPUT ROUTINE
144 OUFILE, 7573 /OUTPUT FILE LIST POINTER
146 \fLPAGE1, 1 /INPUT FORMFEED COUNT
147 LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE
148 LINPAG, -1 /LINES/PAGE COUNTER
149 LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE
150 LINKS, /NO OF LINKS GENERATED
151 ABREFS, 0 /NO OF ABSOLUTE REFERENCES
152 ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT
153 USR, 200 /CURRENT CALL ADDRESS FOR USR
154 SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE
155 /IS SPECIFIED. ITS SET VIA SLASH S
168 / CORE ALLOCATION IN HIGH FIELD 0
170 CPLBUF=5100 /ACTUALLY AT 5200
171 P0LBUF=5200 /AND 5300, 1/2 PAGE EACH
175 INBUF=6000 /AFTER PASS 1, MOVES TO 5400>
177 LINE=7000 /CURRENT INPUT LINE IN ASCII
178 INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR
179 OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR
184 / COLLECT THE NEXT STATEMENT
188 REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001
189 NEXTST, CDF FLD0 /JUST PRECAUTION
190 TAD OUTSWT /IF NO OUTPUT FROM THIS LINE,
192 TAD PASSNO /AND LISTING PASS
194 TAD LISTSW /AND LISTING ENABLED
195 SNA CLA /PRINT THIS LINE NOW
196 JMP START /ELSE GET NEXT
197 JMS I [CRLF /PRINT CR/LF
199 DCA LTEMP /SPACE OVER
200 JMS I [PRINT2 /12 SPACES
203 JMS I (PRNTLN /THEN PRINT LINE
204 START, JMS I [GETCHR /ANY MORE CHARS ?
206 JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE
208 NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ?
211 DCA SCSWT /KILL SC SWITCH
212 ISZ CHRPTR /SKIP OVER SEMICOLON
214 JMP ASMBL /DON'T READ A NEW LINE
215 TAD REPCNT /IS THIS LINE TO BE REPEATED?
218 NEWLIN, TAD BLINE /RESET POINTER
220 TAD [-200 /LIMIT LINE SIZE
222 DCA OUTSWT /CLEAR OUTPUT SWITCH
223 \fRDLOOP, JMS I (ICHAR /READ A CHAR
226 JMP RDLOOP /IGNORE LINE FEEDS
227 TAD (212-215 /END ON CR
234 DCA I CHRPTR /SAVE IT
235 ISZ MAXLIN /TEST FOR LINE TOO LONG
236 JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1
237 JMS I (ICHAR /IGNORE ANOTHER CHAR
241 JMS I [ERMSG /EXCESS LENGTH LINE
243 ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1
247 TAD REPCNT /0 BECOMES 0,
248 CIA /BUT POS REP COUNT
249 DCA REPCNT /ENABLES REPEAT
250 TAD NCHARS /SAVE LENGTH
252 TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT
254 REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT
257 DCA CHRPTR /SET POINTER
258 ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL
260 JMP OFFIT /YES, AND THE COND WAS FALSE
261 JMS I [GETCHR /LOOK FOR A CHARACTER
263 TAD (-257 /IS IT SLASH ?
265 JMP NOASM /YES, COOL IT
266 TAD [257-240 /IS IT BLANK OR TAB ?
268 JMS I [BACK1 /NO, PUT IT BACK
269 JMP I (LUNAME /ASSEMBLE STMT
270 \fFORMFD, ISZ LPAGE1 /BUMP FORM FEED COUNT
271 DCA LPAGE2 /CLEAR SUB-PAGE COUNT
273 DCA LINPAG /FORCE EJECT ON CRLF
275 OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE
278 OFFIT, ISZ NCHARS /MORE TO GO?
281 DCA NCHARS /DONT ASSEMBLE THIS LINE
282 JMP NEXTST /(PREVENTING *EG* MESSAGE)
283 GETIT, TAD I CHRPTR /PICK UP THE CHARACTER
284 TAD (-274 /OPEN ANGLE BRACKET?
286 JMP OPENIT /YES, PUSH ONE LEVEL DOWN
289 ISZ ASMOF /IF CLOSE, CHECK LEVEL
290 JMP OFFIT /TRY FOR NEXT
291 JMP ASMBL /RESUME WORK
292 AGAIN, TAD REPLEN /WE NOW REPEAT THE SAME LINE
294 DCA LISTSW /NO LISTING DURRING REPEAT
296 JMP REASM /ASSUMING COUNT STILL OK
297 TAD REPLST /RESTORE LISTING
299 JMP NEWLIN /GET NEXT LINE
302 TXERR, TEXT " ERRORS"
307 / USEFUL IN FPP REFERENCES TO BASE
309 OVER3, 0 /DIVIDE AC BY THREE
311 TAD (-15 /SET SHIFT COUNT
313 DIVLUP, CLL /ZERO LINK
314 TAD (-3 /SUBTRACT DIVISOR FROM AC
315 SZL /IF AC>=3 SET LINK TO 1
316 JMP .+3 /OK, DONT RESTORE
317 TAD (3 /TOO SMALL, RESTORE AC
318 CLL /SET LINK BACK TO 0
320 TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK IN MQ
323 TAD EXTMP /GET BACK AC
325 ISZ LTEMP /TEST COUNT
326 JMP DIVLUP /KEEP GOING
327 DCA EXTMP /THIS IS REMAINDER
328 TAD EXTMP2 /RETURN QUOTIENT
331 / INITIALIZE FOR OUTPUT
334 TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
335 CIA /NEGATE IT (PAL10 BLOWS)
338 DCA OUPTR /INITIALIZE WORD POINTER
340 DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
344 / STORE CHARACTERS IN OUTPUT BUFFER
345 / IN PS8 FORMAT (YOU KNOW, 3 CHARS
346 / IN 2 WORDS THE WRONG WAY)
352 SZA CLA /IS THERE AN OUTPUT FILE?
353 JMP I OCHAR /NO - EXIT
354 CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD
355 ISZ OUJMP /BUMP THE CHARACTER SWITCH
356 OUJMP, HLT /THREE WAY CHARACTER SWITCH
364 DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
365 /ORDER 4 BITS OF THIRD CHAR
372 DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
374 DCA OUJMP /RESET SWITCH
376 ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
378 TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
379 JMS I (OUTDMP /DUMP THE BUFFER
380 JMS OUSETP /RE-INITIALIZE THE POINTERS
383 DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
384 ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
396 / MOVE OUTPUT FILE NAME TO FIELD 0
413 / GET OUTPUT DEVICE CHARISTICS
440 / PROCESS A STATEMENT
442 LUNAME, TAD CHRPTR /SAVE CHAR STUFF
446 DCA LINKSW /CLEAR SWITCH
447 JMS I [GETNAM /LOOK FOR NAME
449 JMP I (TRYSTR /COULD BE AN ORG>
451 JMP I (GETEXP /NOT ONE OF OURS, I GUESS>
452 JMS I [GETCHR /LOOK FOR COMMA
453 JMP JSTONE /ITS JUST ONE SYMBOL
454 TAD (-254 /COMMA TEST
456 JMP TRYEQU /NO COMMA, CHECK FOR EQUAL
457 JMS I [LOOKUP /LOOK UP SYMBOL
458 JMP DEFLBL /ITS UNDEFINED
459 CLL RAR /VERIFY ADDR TYPE
461 JMP MDERR /THAT'S A NO-NO
462 TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION
464 TAD LOCTR1 /FIRST UPPERR HALF
469 TAD LOCTR2 /THEN LOWER HALF
472 MDERR, JMS I [ERMSG /MULTIPLY DEFINED
474 JMP I (ASMBL /FIELD IS OK
475 DEFLBL, ISZ I LTEMP /SET TYPE TO 1 (USER ADDR)
476 TAD LOCTR1 /PUT LOCATION COUNTER
477 DCA I X10 /INTO VALUE
480 DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG
482 \fTRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN
484 JMP TRYBLK /NO, TRY BLANK
486 DCA EQUN /SAVE 6 CHARACTER NAME
493 JMS I [GETCHR /ALLOW BLANK AFTER =
497 JMS I [BACK1 /ANYTHING ELSE GOES BACK
498 JMS I [EXPR /GET VALUE RIGHT OF EQUALS
500 TAD EQUN /RESTORE NAME
508 JMS I [LOOKUP /LOOKUP SYMBOL
509 JMP PUTVAL /A NEW SYMBOL
512 JMP EQUERR /TYPE CONFLICT
513 PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE
517 TAD I LTEMP /NOW GET TYPE WORD
518 AND (7740 /ZERO OLD TYPE, PRESERVING FORCE BIT
519 TAD EXPDEF /DEFINED BY RIGHT HAND SIDE
520 DCA I LTEMP /RESTORE WORD
522 JMP I [NEXTST /GO GET NEXT STMT
523 EQUERR, JMS I [ERMSG /BAD EQU
526 \fTRYBLK, TAD (35 /CHECK FOR BLANK
531 DCA NAME3 /MAKE MODIFIED NAME OF IT
532 JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK
533 JMP I (GETEXP /LOOKS BAD
536 JMP I (GETEXP /LET EXPR TELL HIM IF ITS WRONG
537 JSTONE, TAD (33 /USE OUR INTERNAL SYMBOL TABLE
538 JMS I [FIND /IS IT THERE?
539 JMP I (GETEXP /NO, LOOK IN USER'S
540 TAD OPCTBL /CREATE JUMP THRU TABLE
542 TAD I X10 /PICK UP FIRST WORD OF VALUE
543 DCA OPCODE /ITS AN OPCODE-MAYBE?
545 OPCJMP, 0 /JUMP SOMEWHERE
550 FPPS1 /OTHER FPP OPCODES
555 FPMRI /INDIRECT FPP MEM REF
556 FPMRS /SHORT DIRECT MEM REF
557 FPMRL /LONG DIRECT REF
558 PDPOPR /8-MODE OPERATES
559 REPETX, JMS I (ADRGET /EVALUATE REPEAT EXPR
567 TAD CPTMP /RESTORE CHARACTER POINTER
569 TAD NCTMP /TO JUST AFTER TAG (IF ANY)
572 JMS I [EXPR /TRY FOR AN EXPRESSION
573 JMP BADEXP /IF NONE, ERROR
575 JMS RELERR /BOMB IF NOT ABSOLUTE EXP>
578 JMP I [NEXTST /GO DO NEXT STMT
579 IFNZRO RALF </IF EXPVAL IS RELOCATABLE,
580 RELERR, 0 /GIVE ERROR MESSAGE
581 TAD EXPVAL+1 /CAUTION: THIS ROUTINE IS
582 /SOMETIMES CALLED WITH NON-ZERO AC
583 AND [7770 /JUST ESD BITS
585 JMP I RELERR /ITS ABSOLUTELY FINE
593 FPPMR, ISZ FPPSWT /SET FORCE ENABLE
595 TAD WORD1 /IF WAY OFF BASE,
597 TAD FPPWD2 /OR IF FORCED
599 TAD XFLAG /OR IF INDEXED
601 JMP FORMT1 /USE LONG FORM
604 TAD (-600 /COMPLETE OFF-BASE CHECK
608 FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR
609 JMS IXMES /BUT DISALLOW INDEX
610 JMP F2WD /PUT TWO WORDS OUT
613 TAD XFLAG /NO INDEX ALLOWED
615 JMP I IXMES /HE'S COOL
620 FORMT1, JMS I (FIXOPC
623 TAD OPCODE /IN FIRST WORD
626 TAD FPPADR+1 /LOW ADDRESS
628 JMP I [NEXTST /NEXT!>
630 JMP I (OUTREL /DUMP TWO RELOCATABLE>
631 FPMRS, JMS FPADR /COLLECT OPERAND
632 JMS IXMES /ERROR IF INDEX GIVEN
638 TAD (-600 /DOES IT FIT?
643 TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT
649 JMP BADEXP /NOT EVEN CLOSE
654 JMP BADEXP /GOTTA BE IN THE FIRST 10
655 FORMT3, JMS I (FIXOPC
657 JMS I (OVER3 /BY 3 FOR BASE ADDRESS
662 FPPS1, JMS I (GETADR /GET ADDR, AND INDEX
663 JMS I (FIXOPC /PUT OPCODE TOGETHER
664 TAD FPPADR /GET ADDR EXTENSION
666 TAD OPCODE /WITH TOGETHER OPCODE
667 AND (7377 /WITHDRAW ONE BIT
668 JMP FPDMP /PUT IT OUT
669 \fFPPS5, CLA IAC /DISALLOW INDEX INCR
670 JMS I (GETADR /COLLECT ADDRESS AND INDEX
673 AND [7770 /MUST BE ABSOLUTE
681 AND [7 /STRIP OFF ESD BITS
683 JMS I [OUTWRD /DUMP THAT
685 JMS I [OUTWRD /NOW LOW 12 BITS
689 JMS I (GETADR /COLLECT ADDRESS AND INDEX
693 DCA WORD2 /GET ADDRESS RELATIVE TO BASE
702 PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR
706 / ASSEMBLE VARIOUS INSTRUCTION TYPES
708 PDP8MR, TAD CHRPTR /SAVE POSITION
711 DCA NCTMP /SAVE COUNT
712 JMS I [GETCHR /LOOK FOR SPACE "I"
713 JMP GETMR /WILL GIVE BX ERROR
715 SNA CLA /IF NOT, FORGET IT
716 JMS I [GETCHR /MUST BE FOLLOWED BY SPACE
720 JMP NOTIND /SOMETHING ELSE
721 TAD OPCODE /PUT INDIRECT INTO OPCODE
724 GETMR, JMS ADRGET /PICK UP ADDRESS FIELD
725 TAD EXPVAL+2 /CHECK PAGE OF ADDRESS
728 JMP PAGEZ /ITS IN PAGE 0
730 TAD LOCTR2 /COMPARE WITH CURRENT PAGE
733 JMP THSPAG /OK, ITS THIS PAGE
734 TAD OPCODE /CAN WE USE A LINK ?
735 AND (400 /IS INDIRECT BIT OFF ?
737 JMP I (MAKLNK /YES, GO MAKE LINK
738 JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE
740 THSPAG, TAD EXPVAL+2 /GET ADDRESS
741 AND [177 /LOWER 7 BITS
742 TAD [200 /PUT IN PAGE BIT
744 PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
745 TAD OPCODE /PLUS OPCODE
746 JMS I [OUTWRD /OUTPUT WORD
748 NOTIND, TAD CPTMP /RESTORE CHAR POINTER
752 JMP GETMR /NOT AN INDIRECT>
753 \fFPPS4, JMS ADRGET /GET INDEX REG EXPRESSION
755 JMS LITERR /CAN'T ALLOW LITERAL>
756 JMS SUBX /GET RELATIVE INDEX VALUE
757 TAD EXPVAL+2 /GET LOWER 3 BITS
758 AND [7 /OF INDEX REG EXPR
759 TAD OPCODE /WITH OPCODE
762 ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE
763 JMS I [EXPR /GET EXPR
764 JMS I [ERMSG /BAD ADDR EXPR
768 LITERR, 0 /GIVE ERROR IF LITERAL
779 \fGETADR, 0 /GET ADDR, INDEX
780 DCA XITEMP /SAVE INDEX INCREMENT SWITCH
782 DCA FPPSWT /KILL FPP SWITCH
784 JMS LITERR /DISALLOW LITERALS>
785 TAD EXPDEF /IF EXPR WAS UNDEFINED
787 IAC /OR FORCE BIT WAS SET
789 DCA FPPWD2 /FORCE 2 WORD FORMAT
790 DCA XFLAG /ZERO INDEX SWT
791 TAD EXPVAL+1 /SAVE ADDRESS VALUE
795 JMS I [GETCHR /LOOK FOR COMMA
796 JMP I GETADR /NO INDEX
799 JMS I [BACK1 /WILL CAUSE A BX ERROR
800 ISZ XFLAG /SET INDEX SWITCH
801 TAD XITEMP /SET INDEX INCREMENT SWITCH
804 ISZ XINCR /CLEAR INDEX INCREMENT SWITCH
807 JMS SUBX /CALCULATE INDEX NO
811 TAD INDXR+1 /CHECK FOR INDEX IN RANGE
831 / CLEAR LENGTHS OF ALL SECTIONS
835 DCA LTEMP /POINT TO USER SYMBOL SPACE
837 CSLOOP, TAD I LTEMP /GET TYPE
838 AND [37 /STRIP TO TYPE ONLY
840 SPA CLA /IS IT COMMON OR SECTION?
841 JMP NOTSCT /NO, PASS IT
842 ISZ LTEMP /BUMP POINTER TO VALUE
844 AND [7770 /SAVE ESD NUMBER
847 DCA I LTEMP /CLEAR LOW ORDER
849 NOTSCT, TAD (6 /BUMP POINTER
850 TAD LTEMP /TO NEXT SYMBOL
852 TAD NEXT /COMPARE END OF SYMBOL TABLE
856 JMP CSLOOP /MORE TO GO
858 JMP I CLRSCT /THAS ALL>
863 / ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE
866 TAD WORD1 /IS SYMBOL RELOCATABLE?
867 AND [7770 /TEST ESD BITS
869 STL RAR /IF SO, FORCE ERROR
870 JMS I (RELERR /TEST SUB EXPR
872 DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS
873 DCA DPFLG /DP HARDWARE
875 / SET BASE AND INDEX LOCS
876 INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
877 BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
878 DCA X12 /HOPEFULLY UNUSED XR
879 JMS I (ADRGET /COLLECT EXPRESSION
881 DCA I X12 /HIGH ORDER AND ESD
884 JMP I [NEXTST >/THIS CONDITIONAL SASSEMBLY WAS
885 /EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO
886 /COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP.
901 / PRINT THE CURRENT LINE IF NOT ALREADY DONE
903 PRNTLN, 0 /PRINT THE LINE
904 TAD OUTSWT /HAS THE LINE BEEN PRINTED YET?
906 JMP I PRNTLN /YES, COOL IT
907 ISZ OUTSWT /SET SWITCH
908 TAD BLINE /POINTER TO LINE
910 DCA CRLF /CLEAR POSITION COUNT
911 JMP PRLTST /IN CASE OF EMPTY LINE
912 PRLNXT, TAD I X13 /GET A CHAR
913 TAD (-211 /WATCH OUT FOR TAB
915 JMP TABIT /CONVERT TO BLANKS
917 ISZ CRLF /BUMP POSITION COUNT
919 PRLTST, ISZ LINSIZ /CHECK COUNT
922 TABIT, TAD [240 /REPLACE TAB WITH BLANKS
936 JMS I PC /PRINT A CHAR
939 ISZ LINPAG /FULL PAGE?
944 / NEW PAGE, WITH HEADING AND PAGE NO
946 TAD PASSNO /IF NOT LISTING PASS
948 TAD LISTSW /OR IF NOT LISTING,
950 JMP I CRLF /DO NOT EJECT
952 SZA /DON'T F.F. FIRST TIME
953 JMS I PC /TOP OF PAGE
956 JMS I (PRTXT /PRINT HEADING
959 TAD LPAGE1 /FORM FEED COUNT
963 JMP .+5 /NO SUB PAGE IF 0
973 TAD (-71 /RESET LINE COUNTER
975 JMP CRLF+1 /GIVE ANOTHER CRLF
1006 JMP .+4 /PRINT ZERO AS BLANK
1007 TAD (-40 /TEST ABOVE OR BELOW 300
1009 TAD [100 /ABOVE, MAKE 301 TO 337
1010 TAD [240 /IF BELOW, MAKE 240 TO 277
1011 JMS I PC /PRINT IT, WHATEVER IT IS
1018 TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE
1029 TXLNK, TEXT " LINKS"
1032 TXABR, TEXT " ABS REFS"
1036 / GET AND EVALUATE AN EXPRESSION
1038 EXPR, 0 /GET EXPRESSION
1039 DCA EXPVAL /ZERO EXPR VALUE
1043 DCA EXPDEF /AND TYPE
1044 CLA IAC /SET EXPR SWITCH TO NO EXPR
1046 DCA FPP2WD /SET FORCE SWITCH OFF
1047 CLA IAC /SET LASTOP TO +
1050 JMS I (CHKLIT /GO CHECK FOR LITERAL>
1051 JMS I (GETSGN /IGNORE +, BUMP LASTOP IF -
1052 SYMBOL, JMS I [GETNAM /NOW PICK UP NAME
1053 JMP NOSYM /NONE, TRY OTHER
1054 JMS I [LOOKUP /LOOK IT UP
1055 JMP UNDEF /A NEW ONE
1062 SCTN, TAD I LTEMP /GET TYPE
1065 ISZ FPP2WD /SET FORCE EXPR SW
1066 TAD I X10 /GET ESD FROM SYMBOL
1068 DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO
1069 JMP CLR2 /SO CLEAR WORD 2>
1070 \fNOTDOT, TAD (256-242 /IS IT DBL QUOTE?
1073 ISZ NCHARS /IS THERE ANOTHER CHAR?
1074 JMP ISQUOT /YES, USE IT
1075 ENDEXP, JMS I [BACK1 /PUT IT BACK
1076 TAD EXPSW /WAS THERE ANY EXPRESSION AT ALL?
1078 JMP BAD /NO, DON'T SKIP
1080 TAD LITRL /WAS IT A LITERAL REF?
1082 JMS I (CRLIT /YES, STICK IT IN THE POOL>
1083 TAD LASTOP /TRAILING OPERATOR?
1085 JMP OKEXP /NO, ALL IS FINE
1086 CLL RAR /IF PLUS OPERATOR
1087 TAD XINCR /AND THATS LEGAL
1089 OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN
1092 JMP I EXPR /AND RETURN
1094 NOSYM, JMS I (NUMBER /LOOK FOR A NUMBER
1095 JMP ADREXP /USE NUMBER
1096 JMS I [GETCHR /NOT A NUMBER, GET A CHAR
1097 JMP ENDEXP+1 /NONE LEFT, END
1098 TAD (-256 /IS IT "." ?
1100 JMP NOTDOT /NO, TRY FOR QUOTE
1101 TAD LOCTR1 /THIS WAS LOC SYMBOL
1102 DCA WORD1 /PUT VALUE INTO WORD1,2
1104 JMP CLR2 /AND USE VALUE
1110 KSF /IF NOTHING AT THE KEYBOARD,
1113 KRS /ELSE, LOOK AT IT
1114 TAD (-203 /IS IT CTRL/C?
1116 JMP I [7600 /GO TO MOMMA
1118 \fADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL
1121 ISZ FPP2WD /AND SET SWITCH IF BIT ON
1122 TAD I X10 /GET FIRST WORD OF VALUE
1123 ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0
1124 TAD I X10 /GET REST OF SYMBOL
1127 ADREXP, DCA EXPSW /KILL FIRST TIME SWITCH
1128 TAD LASTOP /PICK UP LAST OPERATOR
1129 TAD ADROP /MAKE A JMP I
1140 \fUNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ?
1142 JMP .+5 /NO, SKIP AROUND
1143 TAD I LTEMP /TURN ON FORCE BIT
1144 AND (7737 /FOR THIS SYMBOL
1147 DCA EXPDEF /SET TYPE TO UNDEFINED
1149 DCA EXPSW /KILL FIRST TIME SWITCH
1152 OPR8R, TAD (OPR8RS-1 /SET POINTER
1153 DCA X11 /TO OPERATOR TABLE
1154 DCA LASTOP /ZERO LASTOP
1155 JMS I [GETCHR /GET CHAR
1156 JMP ENDEXP+1 /NONE, DONE
1159 TAD I X11 /GET NEXT LIST ENTRY
1161 JMP NOOPR /ZERO IS END OF LIST
1165 JMP SYMBOL /LOOK FOR OPERAND
1166 NOOPR, DCA LASTOP /NO MATCH FOUND
1167 JMP ENDEXP /PUT IT BACK
1169 \fADRADD, IFNZRO RALF <
1171 AND [7770 /IF THIS SYMBOL IS RELOCATABLE,
1172 SZA CLA /CHECK FOR EXPR VALIDITY
1174 TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS
1176 TAD WORD2 /ADD LOW WORDS
1177 DCA EXPVAL+2 /SAVE RESULT
1178 RAL /PUT CARRY INTO BIT 11
1179 TAD WORD1 /ORDER WORDS
1180 JMP ADRASX /LOOK FOR OPERATOR
1181 ADRSUB, IFNZRO RALF <
1182 TAD WORD1 /IF SYMBOL IS RELOCATABLE
1183 AND [7770 /WE MUST COMPARE SECTIONS
1184 CIA /IF EQUAL, EXPR BECOMES ABSOLUTE
1185 SNA /ELSE, EXPR IS ILLEGAL
1186 JMP .+5 /OK, USE EXPVAL ESD
1187 JMS I (RELERR /COMPARE: AC DELIBERATELY NON-ZERO
1189 AND [7 /IF WORD RELOCATABLE, EXP IS ABS
1191 TAD WORD2 /SUBTR LOW 12 BITS
1194 DCA EXPVAL+2 /SAVE LOW HALF
1196 TAD WORD1 /SUBTRACT HIGH HALF
1198 AND [7 /DO NOT SUBTR ESD'S
1199 ADRASX, TAD EXPVAL+1
1200 AND (7767 /PREVENT CARRY INTO BIT 8
1201 ADRASY, DCA EXPVAL+1 /SAVE HIGH HALF
1202 JMP I (OPR8R /GET OPERATOR
1203 /INDXX HERE FOR FLAP
1205 / SET BASE AND INDEX LOCS
1206 INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
1207 BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET
1208 DCA X12 /HOPEFULLY UNUSED XR
1209 JMS I (ADRGET /COLLECT EXPRESSION
1211 DCA I X12 /HIGH ORDER AND ESD
1213 DCA I X12 /LOW ORDER
1215 \fADRAND, TAD WORD1 /AND
1222 ADROR, TAD WORD1 /OR IS PERFORMED BY
1223 CMA /SETTING THE BITS
1224 AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A
1225 TAD WORD1 /AND THEN SETTING THE BITS
1227 DCA EXPVAL+1 /THAT ARE ON IN A
1232 ADRAOX, DCA EXPVAL+2
1235 JMP I (OPR8R /GET NEXT OPERATOR
1237 \fADRMUL, TAD WORD2 /**RL CODE
1239 DCA EXPVAL+1 /MULT BY
1240 TAD EXPVAL+2 /REPEATED ADDITIONS
1254 ISZ WORD1 /COUNTING SUBTRACTIONS
1259 \fDIVERR, JMS I [ERMSG
1261 JMP I (OPR8R /CONTINUE
1262 \fPDPOPR, TAD CHRPTR
1266 JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST
1268 TAD (33 /USE INTERNAL TABLE
1269 JMS I [FIND /IS IT THERE ?
1271 TAD (-PDPOP /IS IT AN OPERATE ?
1274 TAD I X10 /GET VALUE
1278 CMA /OR THEM TOGETHER
1282 JMS I [GETCHR /MORE CHARS ?
1283 JMP I (FPPS3 /NO-DONE
1286 JMP PDPOPR /YES-PROCESS NEXT
1299 TXSYM, TEXT " SYMBOLS,"
1306 CHKLIT, 0 /CHECK FOR LITERAL
1307 DCA PAGENO /ZERO PAGE NUMBER
1309 JMS I [GETCHR /GET CHARACTER
1310 JMP I CHKLIT /NO LITERAL
1311 TAD (-250 /CHECK FOR (
1313 ISZ PAGENO /CURRENT PAGE LITERAL
1314 SZA /SKIP IF ALREADY ZERO
1315 TAD (-63 /CHECK FOR [
1317 ISZ LITRL /SET SWITCH
1319 JMS I [BACK1 /PUT BACK NON ([
1322 / CREATE A LINK FOR OFF-PAGE REFERENCE
1324 MAKLNK, TAD (THSPAG /PROPER RETURN ADDR
1326 TAD OPCODE /SET INDIRECT BIT
1330 DCA PAGENO /SET INDICATOR
1331 ISZ LINKS /COUNT ANOTHER LINK GENERATED
1332 ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT
1334 CRLIT, 0 /CREATE LITERAL
1335 /VALUE:EXPVAL, IN PAGE:PAGENO
1336 TAD PAGENO /CHECK FOR PAGE 0
1338 JMP ISP0 /PAGE 0 LITERAL
1339 NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER
1341 TAD LOCTR2 /CHECK FOR LIT BUFFER FULL
1344 JMP DOLIT-1 /USE 77 AS LIMIT
1347 JMP DOLIT /USE CURRENT ADDR AS LIMIT
1348 \fISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER
1350 TAD [77 /ASSUME FIRST 64 WORDS USED
1352 TAD PAGENO /GET POINTER TO
1353 TAD [P0LIT /LITERAL BOUNDARY
1355 TAD I XPAGE /DISPLACEMENT OF LIT BUFR - 1
1356 DCA LITPTR /INTO LITPTR
1357 NOTIT, TAD LITPTR /POINTER+SIZE
1358 TAD (-177 /SHOULD BE LESS THAN 177
1360 JMP NEWLIT /ENTER NEW LITERAL
1361 TAD LITPTR /NOW GET POINTER
1362 TAD LITBAS /TO TABLE
1363 DCA X11 /FOR COMPARISON
1364 ISZ LITPTR /INCREMENT POINTER
1365 TAD I X11 /GET WORD OF LITERAL
1367 TAD EXPVAL+2 /COMPARE PROTOTYPE
1369 JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY
1370 LITADR, TAD PAGENO /PAGE 0 ?
1372 TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS
1374 TAD LITPTR /PLUS PAGE DISPLACEMENT
1375 DCA EXPVAL+2 /INTO VALUE
1377 RETLIT, DCA EXPVAL+1
1380 TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN
1381 DCA X10 /ADDRESS OF NEW LITERAL
1382 TAD NWUSED /CHECK FOR PAGE OVERFULL
1389 DCA EXPVAL+2 /ZERO ADDRESS
1393 TAD I XPAGE /SET UP POINTER FOR MOVE
1396 TAD EXPVAL+2 /MOVE LITERAL IN
1398 TAD I XPAGE /SET UP LITERAL ADDRESS
1401 JMP LITADR /RETURN LITERAL ADDRESS
1409 / FIND SYMBOL TABLE ENTRY
1410 / FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3
1411 / SKIP IF FOUND WITH TYPE IN AC
1413 FIND, 0 /SYMBOL TABLE LOOKUP
1414 TAD BUCKET /GET BUCKET ADDRESS
1415 CDF FLD1 /GO TO FIELD 1
1416 LOOK, DCA OLDN3 /THIS IS PTR OF PREV ENTRY
1417 TAD I OLDN3 /THIS IS ADR OF NEXT ENTRY
1419 JMP I FIND /IT AIN'T HERE
1420 DCA X10 /SAVE NEXT NAME PTR
1421 TAD NAME1 /COMPARE NAMES
1433 TAD I X10 /COMPARE LAST CHAR
1434 AND [7700 /HIGH HALF ONLY
1437 ISZ FIND /IF FOUND BUMP RETURN
1439 DCA LTEMP /ADDR OF TYPE WORD
1440 TAD I LTEMP /GET TYPE INTO AC
1441 AND [37 /WITHOUT FORCE BIT
1443 NOTSAM, SZL CLA /IS NAME 1,2,3 .LT. ENTRY
1444 JMP I FIND /YES, IT ISN'T HERE
1445 TAD I OLDN3 /GET ADDR OF LINK INTO AC
1448 / FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT
1454 ISZ LOOKUP /SKIP RETURN IF DEFINED
1455 JMP I LOOKUP /RETURN TYPE CODE
1456 TAD I OLDN3 /GET FORWARD LINK TO
1457 DCA I NEXT /NEXT ENTRY INTO NEW ENTRY
1458 TAD NEXT /PUT FORWARD LINK TO NEW
1459 DCA I OLDN3 /ENTRY INTO PREVIOUS ENTRY
1460 TAD NAME1 /PUT IN NAME
1468 TAD NEXT /LTEMP=NEXT
1470 DCA I NEXT /INITIAL VALUE IS ZERO
1472 TAD NEXT /CHECK FOR TABLE FULL
1474 TAD [200 /GONNA OVERFLO PS8?
1476 JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP)
1480 / COLLECT AN INTEGER IN THE CURRENT RADIX
1482 NUMBER, 0 /GET INTEGER NUMBER (NO SIGN)
1483 DCA NSWTCH /CLEAR SWITCH
1484 DCA NOFLO /CLEAR OVRFLO SW
1485 DCA WORD1 /CLEAR 24 BIT NUMBER
1487 NUMLUP, JMS I (DIGIT
1489 DCA NUM /YES, SAVE IT
1490 TAD WORD1 /SAVE CURRENT VALUE
1494 JMS SHIFT /SHIFT WORD1,2, LEFT 1 (MULT BY 2)
1495 JMS SHIFT /DO IT AGAIN (MULT BY 4)
1496 TAD RADIX /LOOK AT RADIX (1=DECIMAL)
1498 JMP OCTNUM /ITS OCTAL
1499 CLL /DECIMAL, ADD IN NUMBER
1501 TAD WORD2 /THUS MULTIPLYING BY 5
1509 AND [7770 /CHECK FOR 8 OR 9
1511 ISZ NOFLO /SET ERROR FLAG
1512 ADDDGT, JMS SHIFT /SHIFT LEFT 1 AGAIN, THUS
1513 TAD WORD2 /MULTIPLYING BY 8 OR 10
1514 CLL /THEN ADD IN NEW DIGIT
1520 SZL /BEWARE OF OVERFLO
1523 \fNODGT, TAD NSWTCH /WAS THERE A NUMBER
1525 ISZ NUMBER /NO, SKIP
1527 AND [7770 /CHECK FOR MORE THAN 15 BITS
1529 TAD NOFLO /OR GROSS OVERFLOW
1531 JMP I NUMBER /ALL GREEN
1534 JMP I NUMBER /RETURN
1535 NOFLO= LOOKUP /ZERO IF NO ERRORS
1539 NSWTCH, /ZERO IF NO DIGITS
1540 SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1
1547 SZL /IF BIT SHIFTED FROM HI WORD,
1548 ISZ NOFLO /SET ERROR FLAG
1552 / BACK UP GETCHR POINTERS,
1553 / WE DON'T WANT THIS ONE
1556 CLA CMA /BACKUP COUNT
1559 CLA CMA /AND POINTER
1564 / GET NEXT CHAR FROM LINE BUFFER
1565 / FOR ASSEMBLY PURPOSES ONLY
1566 / SKIP UNLESS END OF LINE (CR, ;, OR /)
1570 GETSKP, ISZ GETCHR /SKIP RETURN
1572 BLANK, JMS GETAC /COME HERE IF BALNK OR TAB
1573 TAD (-257 /END OF LINE ON SLASH AFTER BLANK
1576 JMS BACK1 /PUT IT BACK
1577 TAD [240 /AND RETURN A SINGLE BLANK
1578 JMP GETSKP /SKIP OUT
1580 JMS BACK1 /PUT BACK SEMI COLON
1583 ISZ NCHARS /END OF LINE?
1585 GETCND, CLA CMA /YES, RESET IN CASE OF
1586 DCA NCHARS /ANOTHER CALL
1587 JMP I GETCHR /RETURN END OF LINE
1588 TAD I CHRPTR /PICK UP NEXT
1589 TAD [-240 /CHECK FOR BLANK
1591 TAD (240-211 /OR TAB
1593 JMP BLANK /THEY GET SPECIAL HANDLING
1594 TAD (211-273 /LOOKOUT FOR SEMICOLON
1596 JMP SEMICL /ALSO SPECIAL
1597 TAD (273-276 /IGNORE CLOSE ANGLE BRACKET
1599 JMP GETAC+1 /GET ANOTHER
1600 TAD (276 /ELSE, RESTORE CHAR
1601 JMP I GETAC /AND PASS IT BACK
1603 / COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3
1604 / NO SKIP ON RETURN IF NO SYMBOL
1607 DCA NAME1 /CLEAR SYMBOL SPACE
1610 JMS LETTER /GET A LETTER
1612 JMS GETCHR /CHECK FOR #
1620 ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE
1621 JMS GNC /FRIENDLY LOCAL SUBR
1636 JMS GNC /AFTER 6, WE IGNORE
1640 JMP I GNC /RETTURN LETTER
1642 JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER
1646 / IF NEXT CHAR IS A LETTER, RETURN 6 BITS
1647 / IF NOT, REPLACE CHAR AND SKIP.
1651 JMP NLETR /NO LETTER, SKIP
1655 SZA SNL /DON'T ALLOW 300
1661 / IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
1690 / BUILD AN INSTRUCTION
1692 FIXOPC, 0 /COMBINE OPCODE PARTS
1693 TAD XFLAG /CHECK INDEX SWITCH
1695 JMP ZRONDX /IF ZERO, NO INDEX REG
1697 TAD LASTOP /IF INDEX, CHECK FOR INCR
1699 TAD [100 /YES, PUT + BIT ON
1700 TAD OPCODE /COMBINE WITH OPCODE
1702 TAD EXPVAL+2 /GET INDEX REG. EXPR
1704 CLL RTL /SHIFT INTO POSITION
1706 ZRONDX, TAD OPCODE /ADD OPCODE
1707 TAD (400 /TURN ON TYPE BIT
1708 DCA OPCODE /SAVE OPCODE
1709 JMP I FIXOPC /RETURN
1714 -252 /STAR (MULTIPLY) **
1715 -257 /SLASH (DIVIDE)
1716 -246 /AMPERSAND (AND)
1718 -241 /EXCLAMATION (OR)
1723 ERMSG1, 0 /PASS 1 (FATAL) MESSAGES
1725 TAD I ERMSG1 /GET CODE
1728 JMS ERMSG /DO THE MSG THING
1734 JMP I [7600 /EXIT TO PS8
1736 / GENERAL GARBAGE TYPE ERRORS
1740 CLA /NO MESSAGE ON PASS 1
1742 SMA SZA /IF PASS 3, OUTPUT LEADING CRLF
1748 TAD I ERMSG /2-CHAR CODE
1749 JMS I [PRINT2 /PRINT THE MESSAGE
1756 PLINE, JMS I (PRNTLN
1758 ISZ ERRORS /BUMP COUNT
1763 / SUPPRESS LEADING ZEROS
1764 / PRINT "NO" INSTEAD OF "0"
1767 SNA /ZERO IS SPECIAL
1768 JMP DECNO /NO INSTEAD OF 0
1771 JMS DEC2 /GET THOUSANDS
1777 TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE)
1778 JMS PDIG /PRINT LAST DIGIT
1779 JMP I DECOUT /EASY, WHEN YOU KNOW HOW
1781 DECNO, TAD (1617 /NO
1785 / LAZY MAN'S DIVISION
1788 CDF FLD0 /JUST TO MAKE SURE
1793 TAD I DEC2 /SUBTRACT DIVISOR
1795 JMP DEC4 /YES, STOP NOW
1796 DCA OTEMP /NO, SAVE NEW REMAIN
1797 ISZ OCNT /BUMP QUOTIENT
1798 JMP DEC3 /DO IT AGAIN
1800 ISZ DEC2 /SKIP RETURN
1801 TAD OCNT /CHECK FOR SIGNIFICANCE
1805 CLA STL RAR /FORCE SIGNIFICANCE
1820 / OCTAL CONVERSION, THE HARD WAY
1824 STL RAR /NO ZERO SUPPRESS
1846 OUTREL, DCA WRD /HOLD FIRST WORD
1847 DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR
1848 TAD FPPADR /GET ESD CODE
1851 AND [177 /STRIP TO ESD ONLY
1852 SNA /CHECK FOR ABSOLUTE
1854 DCA FPPADR /SAVE ESD
1855 TAD PASSNO /CHECK FOR PASS 2
1857 JMP PRNTRL /IF NOT, TREAT NORMALLY
1860 JMS I (FULCHK /ENSURE 3 WORDS LEFT
1861 TAD FPPADR /GET ESD AGAIN
1862 TAD (TTREL /INSERT CONTROL CODE
1864 TAD WRD /FIRST DATUM
1868 JMS I (FULCHK /IS IT FULL?
1869 JMS BMPLOC /TWO WORDS OUT
1870 JMS BMPLOC /SO LOCCTR +2
1872 PUTABS, ISZ ABREFS /COUNT IT
1873 ISZ LINKSW /SET FLAG
1874 PRNTRL, TAD WRD /GET FIRST WORD
1880 OUTWRD, 0 /OUTPUT ROUTINE
1883 TAD LOCTR2 /GET LOW 12 BITS OF LOCATION
1885 AND [37 /GET PAGE NUMBER (WITHIN FIELD)
1886 DCA OTEMP /SAVE PAGE NUMBER
1888 SZA CLA /POINTER TO LITERAL POINTER
1892 TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT
1894 CIA /COMPARE WITH LITERAL BOUNDARY
1897 JMP .+3 /NO PAGE OVER FLOW
1900 TAD PASSNO /CHECK PASS
1902 JMP PRNTST /ITS NOT PASS 2
1904 TAD WRD /NOW OUTPUT WORD
1911 TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT
1913 JMP INABS /NO PROBLEM
1916 TAD (TTABS /SET ABS CONTROL CODE
1918 TAD OUTPTR /SAVE POINTER FOR FUTRUE REF
1920 INABS, ISZ I ABSOP /BUMP COUNT
1923 JMS I (FULCHK /GOOD!>
1924 \fPRNTST, SMA SZA CLA
1925 TAD LISTSW /IS LIST ON ?
1927 JMP ENDOUT /NO, DONT PRINT
1928 JMS I [CRLF /NEW LINE
1929 TAD LOCTR1 /PRINT LOCATION COUNTER
1932 TAD LOCTR2 /NEXT FOUR DIGITS
1938 TAD LINKSW /LINK GENERATED ON THIS LINE?
1940 TAD (4700 /IF SO, GIVE APOSTROPHE SPACE
1942 DCA LINKSW /CLEAR SW
1943 JMS I (PRNTLN /PRINT LINE IF NECESSARY
1944 ENDOUT, JMS BMPLOC /BUMP LOC CNTR
1945 JMP I OUTWRD /RETURN
1949 ISZ LOCTR2 /BUMP LOW ORDER
1953 AND (7767 /STOP CARRY INTO BIT 8
1967 TAD PASSNO /CHECK FOR PASS 2
1969 JMP I PUTORG /ELSE FORGET IT
1970 TAD LOCTR2 /OUTPUT FIRST CHAR
1973 JMS OOCHAR /OUTPUT CHAR
1974 TAD LOCTR2 /NOW LOWER HALF OF ORIGIN
1980 OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM
1982 TAD PNCHOF /PUNCHING?
1993 / WITH APPROPRIATE THINGS RESET
1996 RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE
1997 TAD USR /EITHER 200 OR 7700
1998 SPA CLA /IS USR IN CORE?
2000 CIF 10 /YES, DISMISS IT
2006 CLA STL RTL /COUNTING FROM 2,
2007 DCA ESDNO /RESET ESD COUNT
2008 JMS I (CLRSCT /ZERO ALL SECTION LENGTHS>
2009 DCA ASMOF /ZERO CONDITIONAL SWITCH
2010 DCA SCSWT /ZERO SEMICOLON SWITCH
2011 TAD SYONLY /IF NOT SYM MAP ONLY
2012 DCA LISTSW /FORCE LIST ENABLE
2020 DCA P0LIT /RESET LITERAL BUFFER POINTERS
2024 DCA LOCTR2 /LOCATION COUNTER
2029 DCA BASER /SET BASE BEYOND BELIEF
2032 DCA RADIX /RESET DEFAULT OCTAL
2033 DCA ERRORS /ZERO ERROR COUNT
2035 ISZ PASSNO /BUMP PASS NUMBER
2037 JMP I (NEWLIN /DO NEXT PASS
2043 DCA PNCHOF /RE-ENABLE PUNCH>
2045 JMS I (BORG /SET MAX LEN OF CURRENT SECT>
2047 SMA CLA /WHAT PASS WAS THIS?
2048 JMP EOP2 /NOT THE FIRST
2051 DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD>
2054 JMP START3 /NO BINARY, START PASS 3
2056 TAD [200 /START BIN OUT WITH L/T
2060 JMP I (DMPESD /OUTPUT EXT SYM TABLE>
2063 CLA IAC /DUMP CURRENT PAGE LITERALS
2065 JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS>
2068 JMP EOP3 /YES, PRINT SYMBOL TABLE
2070 TAD CHKSUM /OUTPUT CHECKSUM
2075 JMS I [OCHAR /LOWER HALF
2076 TAD [200 /TRAILER CHAR
2079 DCA I OUTPTR /SET OUTPUT END INDICATOR>
2080 JMS I (OCLOSE /CLOSE THE BINARY FILE
2081 START3, DCA PASSNO /SKIP PASS TWO
2082 JMS I (OOPEN /OPEN LISTING FILE
2084 JMP NOP3 /NO LISTING, GIVE INFO ON TTY>
2087 TAD [OCHAR /CHANGE PRINT ROUTINE
2089 JMP I (RESET /NO,RESET EVERYTHING
2092 / GIVE SOME STATISTICS
2097 NOP3, JMS I (7607 /READ IN OVERLAY
2100 40 /USE SYS SCRATCH BLK
2105 TAD OPCODE /BE SURE ALL REFS ARE
2106 AND [200 /ARE ON SAME PG
2114 ADRERR, JMS I [ERMSG
2122 IOERR, TAD INOP /REMOVE JMS PRNTLN
2130 / ORG THINGS FOR ABSOLUTE ASSEMBLIES
2132 TRYSTR, JMS I [GETCHR
2133 JMP I [NEXTST /WHAT CAN YOU DO?
2134 TAD (-252 /IS IT AN ORG
2136 JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE
2138 TAD LOCTR1 /CHECK FOR NEW FIELD
2142 JMP SAMFLD /NOT A DIFFERENT FIELD
2144 JMS DMPLIT /DUMP CURRENT PAGE LITERALS
2145 JMS DMPLIT /DUMP PAGE 0 LITERALS
2149 TAD PNCHOF /PUNCHING ENABLED?
2153 JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD
2154 TAD LOCTR1 /NEW FIELD BITS
2157 TAD (300 /TURN ON THE LEFT TWO BITS
2158 JMS I [OCHAR /PUT IT OUT (NOT IN CHECK SUM)
2159 JMP SAMPAG /DO THE SAME FOR CURRENT PAGE
2161 AND [7600 /CHECK FOR SAME PAGE
2168 JMP SAMPAG /PAGE IS THE SAME
2170 JMS DMPLIT /DUMP CURRENT PAGE LITERALS
2171 SAMPAG, TAD EXPVAL+2
2175 PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE
2183 JMP ORGX+1 /DO ORG THINGS
2185 DCA PAGEN /SAVE PAGE INDICATOR
2186 TAD OUTSWT /SAVE OUTPUT SWITCH
2188 ISZ OUTSWT /DONT PRINT LINE WITH LITERALS
2190 TAD [P0LIT /GET BOUNDARY POINTER
2192 TAD PAGEN /WHICH LITERAL BUFFER ?
2194 TAD (P0LBUF-CPLBUF /PAGE 0 BUFFER
2195 TAD (CPLBUF /CURRENT PAGE BUFFER
2196 TAD I LTEMP /PLUS PAGE ADDRESS
2197 DCA X10 /GIVES START OF LITERALS -1
2200 TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS
2202 TAD I LTEMP /PLUS LOWER SEVEN
2204 DCA LOCTR2 /GIVES LOCATION COUNTER
2206 AND [177 /ANYTHING TO DUMP?
2211 JMS I [CRLF /ONLY IF PASS 3
2213 TAD [177 /STORE SPURIOUS LITERAL BOUNDARY
2214 DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES
2215 LITLUP, TAD I X10 /NO, GET NEXT LITERAL
2216 JMS I [OUTWRD /OUTPUT WORD AND BUMP LC
2222 DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH
2224 JMP I DMPLIT /ALL DONE
2229 JMS I (GETSGN /GET SIGN OF EXPONENT
2232 ISZ RADIX /SET RADIX TO DECIMAL
2233 JMS I (NUMBER /GET EXPONENT
2236 DCA RADIX /RESTORE RADIX
2240 RAR /LASTOP TO LINK,
2241 DCA LASTOP /TMP TO SIGN OF LASTOP
2244 CIA /PUT SIGN ON EXP
2247 IFZERO RALF < PAGE / >
2250 / IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
2252 RETSYS, JMS I (DELFIL /THIS LOCATION USED BY INIT CODE
2253 /MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING
2254 /FROM COMPILER + OUTPUT DEV IS NOT SYS
2256 TAD (7604 /POINT TO 2ND OUT FILE THING
2258 TAD (7611 /POINTER TO 3RD
2260 TAD (-5 /LENGTH OF SUCH THINGS
2262 TAD I X10 /MOVE 3RD TO 2ND
2263 DCA I X11 /FOR LOADER MAP FILE
2266 TAD I [7600 /WAS THERE A FIRST OUT FILE
2267 AND NP17 /(BINARY OUT)*
2269 TAD OUTBLK /GET FILE LENGTH
2274 TAD LTEMP /COMBINE UNIT AND LEN
2275 DCA I X10 /FOR FIRST INPUT FILE TO LOADER
2276 TAD PASBLK /STARTING BLOCK
2278 DCA I X10 /THAT'S THE END OF INPUT
2280 TAD ERRORS /IF NO ERRORS
2282 ISZ CHNSW /SHOULD WE CHAIN?
2288 LDRBLK, 0 /FIRST BLOCK OF LOADER
2290 PASBLK, 0 /FIRST BLOCK OF FILE PASSED
2291 CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
2293 / OUTPUT A BLOCK OF BINARY
2295 OUTBLK, 0 /AT END OF PASS2, BECOMES
2296 /LENGTH OF BINARY FILE
2297 TAD (OUCTL /DEV HNDLR CONTROL WORD
2298 JMS I (OUTDMP /CALL THE HANDLER
2300 DCA OUTPTR /RESET BUFFER POINTER
2301 DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL
2305 TYPCOD, 2500 /UNDEFINED
2312 7000 /8-M0DE SECTION
2313 3200 /8-MODE PAGE0 COMMON SECTION
2314 0600 /8-MODE FIELD1 SECTION
2321 TAD (ESDBUF-1 /POINT INTO ESD TABLE
2324 TAD (4 /ADDRESS VALUE
2328 AND [7 /GET ADDR BITS ONLY
2330 TAD I LTEMP /OLD HIGH VALUE BITS
2333 TAD BOTMP /COMPARE THEM
2335 JMP BOXIT /NO UPDATE REQUIRED
2337 JMP BOCHKL /NO DIFFERENCE YET
2339 DCA I LTEMP /RESET TO NEW HIGH
2341 JMP BOSETL /SKIP OVER TEST
2342 BOCHKL, ISZ LTEMP /POINT TO LO-ORDER
2345 TAD LOCTR2 /COMPARE LOW ORDERS
2347 JMP BOXIT /NO REPLACE
2357 TAD (-177 /CHECK LIMIT
2360 JMS I [ERMSG1 /TOO MANY
2362 ISZ ESDNO /BUMP COUNT
2363 TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1
2367 TAD (ESDBUF-1 /INDEX BUFFER
2370 TAD I OLDN3 /GET POINTER TO THIS SYMBOL
2375 DCA ESDTMP /NOW ADDRESS CHAR TABLE
2381 / RELOCATION CONTROL PSEUDO-OPS
2383 ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT
2385 JMS I [LOOKUP /FIND IT
2387 CLL RAR /MUST BE USER ADDR TYPE
2389 TAD I X10 /LOOK AT ESD
2391 SZA CLA /IS IT RELOCATABLE?
2393 QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1
2395 OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT
2399 DCA STYPE /EXTERNS ARE TYPE 2
2403 JMS CRESD /IF UNDEFINED, DEFINE IT
2404 CLL RTR /IF DEFINED, CHECK LEGALITY
2406 ESDERR, JMS I [ERMSG
2410 CLA IAC /FIELD1 SECT=11
2415 COMMX, TAD (COMMN /GET DESIRED CODE
2416 DCA STYPE /FOR SECTION TYPE
2418 DCA BUCKET /IF NO NAME, BLANK COMMON
2420 JMP NEWSCT /UNDEFINED
2424 JMP SETSCT /YUP, DO IT
2428 JMS NEWESD /CREATE NEW ESD ENTRY
2430 TAD I LTEMP /SET TYPE CODE
2436 CLL RTL /ESD NO TO SYMBOL VLAUE
2442 NEWSCT, JMS CRESD /CREATE AN ESD
2443 SETSCT, JMS I (BORG /ADJUST LOC CTR'S
2445 TAD I X10 /GET NEW LOC CTR VALUE
2448 DCA LOCTR2 /LOW LOC CTR
2452 ORGX, JMS I (ADRGET /GET ORG EXPR
2455 AND [7770 /DOES IT HAVE AN ESD?
2457 TAD LOCTR1 /IF NOT, KEEP CURRENT ESD
2460 DCA LOCTR1 /RESET PC
2463 PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY
2466 DCA ABSOP /CLEAR ABS OUTPUT SW
2468 JMS I (FULCHK /ROOM FOR MORE?
2484 / VARIOUS PSEUDO-OP HANDLERS
2486 LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY
2494 TEXTX, JMS I [GETCHR /GET DELIMITER
2495 JMP I [NEXTST /NULL STMT
2497 DCA EXTMP /SAVE - DELIM
2498 LOOP6B, JMS GETCHT /GET HIG ORDER CHAR
2500 JMS I [R6L /SHIFT IT UP
2501 DCA LTEMP /SAVE HALF
2502 JMS GETCHT /GET LOWER CHAR
2503 JMP OUTTXT /GO PUT LAST
2504 TAD LTEMP /PUT 2 CHARS TOGETHER
2505 JMS I [OUTWRD /OUTPUT WORD
2507 OUTTXT, TAD LTEMP /PUT OUT HALF WORD
2508 JMS I [OUTWRD /OR ZERO WORD
2510 GETCHT, 0 /GET CHAR FOR TEXT STMT
2511 ISZ NCHARS /BUMP COUNT
2513 JMP I GETCHT /END OF TEXT
2514 TAD I CHRPTR /GET CHAR
2516 TAD BUCKET /IS IT THE DELIM ?
2519 JMP I GETCHT /YES, RETURN NO SKIP
2520 ISZ GETCHT /BUMP RETURN
2521 TAD BUCKET /GET CHAR
2523 JMP I GETCHT /RETURN
2525 / CONDITIONAL ASSEMBLY HANDLERS
2528 IFZROX, JMS GETCON /GET CONDITION EXPR
2529 TAD EXPVAL+1 /HIGH ORDER
2532 TAD EXPVAL+2 /LOW ORDER
2534 JMP TRUE /PRESENT CONDITION OF ASMOF IS OK
2535 FALSE, TAD ASMOF /GOTTA REVERSE IT
2537 DCA ASMOF /THAT DOES IT
2540 JMP BADCND /FORGOT THE ANGLE
2541 TAD [-240 /IGNORE BLANK, IF ANY
2546 JMP I (ASMBL /GO FROM HERE
2547 JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT
2551 DCA ASMOF /SET INITIAL TRUTH
2552 JMS I [EXPR /COLLECT EXPR
2553 JMP OKCND /BAD MAY MEAN GOOD
2554 BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD
2556 DCA ASMOF /ENABLE ASSEMBLY
2558 OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST?
2566 AND EXPVAL+1 /SIGN OF EXPR
2567 JMP SWTCH /GO FROM THERE
2571 JMS I [GETNAM /GET SYMBOL NAME
2572 JMP BADCND /GOTTA GIVE SOMETHING
2573 JMS I [FIND /IS IT KNOWN TO US?
2574 JMP FALSE /NOT REFERENCED YET
2575 SNA CLA /SKIP IF DEFINED
2576 DCA ASMOF /ELSE ASSEMBLE
2580 TAD (7642 /ADDRESS OF OPTION WORDS
2582 JMS I (LETTER /ALLOW LETTER
2583 JMP .+4 /AC BETWEEN 1 AND 32
2584 JMS I (DIGIT /OR NUMBER
2585 JMP BADCND /ALL ELSE IS BAD
2586 TAD (33 /MAKE 0 = Z+1
2587 ISZ WORD2 /BUMP POINTER
2588 TAD (-14 /IS IT IN THIS WORD?
2590 JMP .-3 /NO, POINT TO NEXT
2592 CMA STL /BIT COUNT AWAY FROM LINK
2597 CDF 10 /OPTIONS FIELD
2598 AND I WORD2 /GET SELECTED BIT
2599 JMP SWTCH /AND TEST IT
2601 ZBLKX, JMS I (ADRGET /EVALUATE EXPR
2604 DCA ZBCNT /HOLD COUNT
2605 TAD LISTSW /SAVE LISTSWITCH
2607 JMS I [OUTWRD /PUT A WORD
2608 DCA LISTSW /NO LIST AFTER FIRST
2609 ISZ ZBCNT /COUNT THEM
2621 INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
2622 OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
2628 DCA INFPTR /RESET FILE POINTER
2629 JMS INNEWF /FETCH NEW HNDLR, ETC
2630 /WHILE USR IS STILL IN CORE
2632 DCA INCHCT /FORCE A READ ON NEXT CHAR
2638 ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
2642 SZA CLA /DID LAST READ GIVE EOF ?
2643 GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
2648 DCA INCTR /RESTORE INCR IF NOT OVERFLOWED
2649 SZL /IS THIS THE LAST READ?
2650 ISZ INEOF /YES - SET END-OF-FILE FLAG
2651 CLL CML CMA RTR /MAKE CONTROL WORD
2652 RTR /FROM THE AMOUNT OF THE OVERFLOW
2653 RTR /(IF ANY) AND THE STANDARD CNTRL WD
2657 JMS I INHNDL /CALL THE DEVICE HANDLER
2661 JMP INERRX /SOME KIND OF HANDLER ERROR
2664 DCA INREC /UPDATE THE RECORD NUMBER
2671 DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
2673 DCA INJMP /RESET THE CHARACTER SWITCH
2675 DCA INPTR /AND THE WORD POINTER
2676 JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED
2677 INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
2678 SMA CLA /WHICH TYPE WAS IT ?
2679 JMP INBREC /END OF FILE - RESUME PROCESSING
2680 JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE
2681 INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH
2689 RTR /COMBINE HIGH-ORDER FOUR BITS OF
2691 RTR /THE 2 WORD TO FORM THE 3RD CHAR
2697 DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD
2698 ISZ INPTR /BUMP THE WORD POINTER
2700 INCOMN, AND (177 /PHPH WAS 277
2701 TAD (-32 /PHPH WAS 232
2702 SNA /IS THE CHARACTER A ^Z?
2703 JMP GETNEW /YES - GET A NEW FILE
2704 TAD (232 /RESTORE THE CHARACTER /PHPH NOW WE HAVE PARITY ON!
2706 JMP I ICHAR /AND RETURN
2708 INEOF, 1 /PARAMETERS ARE SET UP SO THAT
2709 INCHCT, /IOPEN IS UNNECESSARY.
2712 DCA INHNDL /INITIALIZE HANDLER ADDRESS
2714 TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
2717 JMP I (ENDX /NO MORE INPUT
2720 1 /ASSIGN, FETCH HANDLER
2726 AND (7760 /GET LENGTH PART OF WORD
2727 SZA /LENGTH OF 0 MEANS LENGTH GE 256
2728 TAD [17 /ADD HIGH ORDER BITS
2731 DCA INCTR /STORE LENGTH OF FILE
2735 DCA INREC /STARTING RECORD NUMBER OF FILE
2737 DCA INEOF /ZERO END-OF-FILE FLAG
2741 OUFNAM, 0;0;0;0 /OUTPUT FILE NAME
2745 TAD OUFILE /INCR OUTPUT FILE POINTER
2749 TAD I OUFILE /GET DEVICE CODE, LEN
2750 DCA OUELEN /HOLD IT A MO
2751 JMS I (OFNAME /GET FILE NAME INTO FIELD 0
2752 TAD OUELEN /CHECK FOR NULL FILE
2754 JMP ONOFIL /INHIBIT OUTPUT
2755 JMS GETUSR /LOAD USR IF NOT ALREADY IN
2756 TAD OUNAME /RESET ENTER CALL
2760 TAD OUELEN /THE UNIT
2763 1 /ASSIGN, FETCH HANDLER
2764 OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
2766 TAD OUELEN /UNIT AGAIN
2769 3 /ENTER OUTPUT FILE
2770 OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
2771 OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
2772 JMP I [IOERR /YOU BLEW IT!!!
2774 DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
2778 ONOFIL, ISZ I (OUTINH
2781 DCA OUCTLW /STORE THE CONTROL WORD
2786 DCA OUREC /COMPUTE STARTING BLOCK
2789 AND [17 /COMPUTE THE NUMBER OF RECORDS
2790 TAD OUCCNT /UPDATE SIZE OF FILE
2795 SNL SZA CLA /EXCEED GIVEN LENGTH ?
2796 JMP I [IOERR /YES - ERROR
2805 JMS GETUSR /ENSURE USR IN CORE
2811 JMS I (FULCHK /DUMP LAST BLOCK
2812 TAD OUCCNT /SAVE FILE LENGTH
2813 DCA I (OUTBLK /FOR CHAIN
2817 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
2818 SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
2819 TAD (232 /OUTPUT A ^Z
2821 FILLLP, JMS I [OCHAR
2822 JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
2827 SZA CLA /UP TO THE BOUNDARY YET?
2828 JMP FILLLP /NO - FILL WITH ZEROS
2829 TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
2831 SNA /A FULL WRITE LEFT?
2832 JMP NODUMP /YES DON'T DO IT
2833 TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS
2839 4 /CLOSE THE OUTPUT FILE
2840 OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
2842 JMP I [IOERR /ERROR WHILE CLOSING - BAD!!
2843 JMP I OCLOSE /ALL DONE
2846 / LOAD USR IF NOT IN CORE ALREADY
2849 TAD USR /CURRENT CALL ADDR
2851 JMP I GETUSR /WE GOT IT
2853 JMS I USR /THE ANSWERING SERVICE
2856 DCA USR /RESET THE CALL ADDRESS
2857 JMP I GETUSR /JES FINE
2862 / IF THE RELOCATABLE BINARY OUTPUT
2863 / BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
2864 / FILL THE REST WITH NOP CODES AND OUTPUT THE
2880 KOUBUF, -OUBUF-377 >
2883 / GET SIGN CHARACTER IF ANY
2884 / BUMP LASTOP IF MINUS
2893 CLL CMA RAR /IF IT WAS PLUS, BECOMES 0
2894 SZA CLA /SKIP IF PLUS OR MINUS
2895 JMS I [BACK1 /OTHERWISE PUT IT BACK
2897 \f/ AS PER RICHIE LARY
2899 / SINGLE AND DOUBLE PRECISION
2900 / FLOATING POINT INPUT
2905 DCA DESW /STORE LENGTH
2907 JMS CLEAR /CLEAR FAC+OP
2909 JMS GETSGN /GET SIGN
2913 JMS I (DIGIT /GET A DIGIT
2916 JMS I (FMPTEN /MULT FAC*10
2920 JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0
2923 TAD DCNT /BUMP IF FP SEEN
2925 \fLOOKP, JMS I [GETCHR
2933 JMP I (EXPON /E OR D
2934 DEXERR, JMS I [ERMSG
2938 JMP DEXERR /2 PERIODS
2941 OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC
2943 JMP NOSCAL /NO SCALING NEEDE
2946 CIA CML /SIGN IN LINK,MAGNITUDE IN AC
2947 DCA DCNT /AS A COUNT
2949 TAD (TENTH-TEN /OFFSET KLUDGE
2952 JMS I (FMPTEN /MULT BY 10.0 OR 0.1
2957 DCA OP+5 /ROUNDING CONSTANT
2961 JMS I (NORM /WATCH IT!
2977 NOTNEG, JMS CLEAR /SET UP X10
2983 \fCLEAR, 0 /AC MAY NOT BE 0
2997 FAD, 0 /FLOATING ADD DIGIT IN AC
3008 JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1
3009 JMP ALNLP /TRY AGAIN
3010 GOADD, JMS ADD /ADD FRACTIONS
3011 JMS NORM /NORMALIZE RESULT
3014 RSHFT, 0 /SHIFT RIGHT
3015 TAD (ACX /DEFAULT IS FAC
3017 ISZ I P /BUMP EXPONENT
3034 DCA I P /ADD ONE WORD
3036 TAD P /COMPLEMENT LINK
3039 TAD PP2 /COMPLEMENT LINK
3044 \fNORM, 0 /NORMALIZE FAC
3046 SPA CLA /CHECK FOR OVERNORMALIZATION
3047 JMS RSHFT /AND CORRECT
3050 SZA CLA /NORMALIZED?
3057 STA CML /COMPLEMENT LINK
3066 \fFMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1
3070 SNA CLA /AC=0 MEANS RESULT=0
3081 DCA MUX /CLEAR MULT TEMP EXP
3083 TAD I SETUP /MOVE FAC
3085 DCA I SETUP /CLEAR FAC
3087 TAD I P /MOVE MULTIPLIER
3088 DCA I X11 /TO MULT TEMP
3093 JMS RSHFT /SHIFT MULT TEMP RIGHT 1
3095 JMS ADD /ADD IF LOW ORDER BIT WAS 1
3096 JMS RSHFT /SHIFT FAC RIGHT
3098 SZA CLA /12 SUCCESSIVE 0 BITS
3099 JMP MPLP2 /IN MULTIPLIER MEANS DONE
3103 SETUP, 0 /COMMON CODE
3117 ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN
3118 PNDL /DITTO FOR BLANK COMMON
3119 ZBLOCK 376 /FILL TO 400 LOCS
3122 / DUMP EXTERNAL SYMBOL DICTIONARY
3123 / DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
3125 DMPESD, CLA CLL CMA RAL /-2
3126 DCA EXTMP2 /PASS CONTROL
3127 TAD (3 /RALF OUTPUT IDENTIFIER
3130 DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES
3131 TAD DPFLG /4000=NEED DP HARDWARE
3132 DCA I OUTPTR /EXACTLY FILL A BLOCK
3134 ESDSCN, TAD (ESDBUF-1
3135 DCA X10 /POINT TO POINTERS
3137 DCA X12 /POINT TO INITAIL CHARS
3142 DCA LTEMP /NAME LENGTH COUNT
3143 TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME
3145 TAD I X10 /GET POINTER
3147 TAD I X12 /GET FIRST CHAR
3148 SNA /BLANK BECOMES #
3153 TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE
3157 JMS I [R6R /GET LEFT CHAR
3158 TAD EQUN+2 /COMBINE THEM
3160 TAD EQUN+3 /GET RIGHT HALF OF PAIR
3164 AND [37 /DROP FORCE BIT FROM TYPE
3167 TAD I X11 /HIGH VALUE
3169 TAD I X11 /LOW VALUE
3172 TAD EXTMP2 /WHAT PASS IS THIS?
3173 RAR /LINK 0 IF FIRST, 1 IF SECOND
3175 JMP NOENTS /FIRST, ENTRYS NOT OUTPUT
3176 TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND
3181 JMP ESDOUT /YES, PUT IT
3182 NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN
3185 JMP ESDLND /UNDEFINED OR ENTRY
3188 JMP ESDOUT /IF EXTERN, DO IT
3189 TAD EQUN+4 /IF SECTION, CHECK
3194 JMP ESDLND /ZERO LEN JUST GETS IN THE WAY
3199 TAD I X13 /GET OUTPUT WORD
3202 JMP .-3 /6-WORD ENTRIES
3206 JMP ESDLND /NOT END OF BLOCK YET
3213 ESDLND, ISZ EXTMP /GO THRU ESD LIST
3215 ISZ EXTMP2 /WHOLE LIST TWO PASSES
3217 TAD (-6 /THEN STORE END-OF-ESD
3222 TAD (377 /FORCE BLOCK OUTPUT
3224 CDF FLD1 /THEN DEFAULT ORG
3225 TAD I (LMAIN /IF MAIN LEN .NE. 0
3231 JMP I (RESET /FIRST SECTION WILL GET IT
3232 TAD (TTORG+1 /ORG TO ZERO OF MAIN
3240 / INITIALIZATION CODE
3242 BEGIN, JMP CHNIN /IF ENTERED BY CHAIN
3243 GCMND, CIF 10 /IF ENTERED BY .R, ETC
3244 JMS I USR /USR IS LEFT OVER
3247 620 /DEFAULT EXT = .FP>
3249 2201 /DEFAULT EXT = .RA>
3250 DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED
3252 4100 /TEMP WRITE OUT OVERLAY
3254 40 /TO SYS SCRATCH BLK 40
3258 TAD I [7600 /BIN FILE UNIT
3261 JMP DEFBIN /NO, SET DEFAULT
3262 TAD (7757 /POINT TO DEV CTRL WORD
3266 JMP OKBIN /FILE-STRUCTURED, OK
3268 JMS I (PRTXT /TYPE MESSAGE
3272 JMP GCMND /TRY AGAIN
3274 DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS
3275 DCA I [7600 /SET UNIT
3277 DCA X10 /SET POINTER
3286 JMP I (NOEXT /NOW, OPEN THE FILE>
3287 \fOKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE
3288 JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE
3293 ISZ SYONLY /=NO SLASH T
3295 JMS I (NEW /**SEE IF NEED 2 PG HANDLER
3300 TAD R41 /L OR G SWITCH**
3302 AND I (7643 /TEST /L OR /G SWITCH
3305 JMP KCHN /KILL CHAIN, IT'S SET
3307 CLA IAC /UNIT IS SYS
3310 LBLK, LDRNAM /LOADER.SV
3312 JMP KCHN /NO FIND, NO CALL
3313 TAD LBLK /STARTING BLOCK
3314 DCA I (LDRBLK /FOR CHAIN
3315 TAD I (OUBLK /OUTPUT STARTING BLOCK
3316 DCA I (PASBLK /SAVED FOR CHAIN TO LOADER
3317 CLA CMA /ENABLE CHAIN
3318 KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER>
3319 JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
3320 JMS I (INNEWF /GET INPUT HANDLER
3322 DCA I (INCHCT /SET INITIAL COUNT
3324 DCA USR /FROM NOW ON, USE THE HIGH CALL
3326 7605 /CHECK LIST DEV TOO**
3328 TAD I (7611 /LST FILE EXT
3330 TAD (1423 /LS DEFAULT
3332 TAD I (7666 /GET DATE
3335 / MOVE SYMBOL TABLE TO ITS PROPER LOCATION
3338 DCA X10 /LOADED ADDRESS OF SYMBOL TABLE
3340 DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS
3341 TAD (-FREE /LENGTH OF SYMBOL TABLE
3342 DCA WORD2 /SET COUNT
3344 DCA I X11 /THIS SAVES SWAPS OF USR
3348 JMP I (GDATE /CHECK FOR FPP PRESENCE**
3351 / PUT THE DATE INTO THE PAGE HEADING
3354 DCA I (7746 /SET NO-RESTART BIT
3355 /PUT VERNUM IN TITLE LINE
3358 TAD VMSG+1 /PATCH LEVEL
3360 DCA OCNT /CLEAR OCNT
3361 TAD WORD1 /RE-GET DATE
3363 JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED
3416 VMSG, VNUM&70^10+VNUM&707+6060
3419 LDRNAM, TEXT "LOAD@@SV"
3420 TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED"
3422 MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
3424 /PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
3426 TAD NT2 /CHECK IF ALREADY CHECKED
3429 TAD I NEW /NO. GET THE DEV TO CHECK
3432 TAD I NTEMP /GET DEV.NUM
3434 DCA NT1 /INCHK NEEDS TO KNOW TOO
3436 SNA /IF 0,THEN NO DEVICE
3440 TAD I (37 /GET PTR TO DEV TBL
3442 DCA NTEMP /PTS TO ENTRY IN DEV TBL
3446 JMP FIX /NOT A 2 PG HANDLER
3447 TAD (6377 /FIX ALL LOCATIONS THAT REFER TO
3448 /THE BUFFER VARIABLES.
3450 /OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
3457 DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS
3462 JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER
3476 FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN
3477 NEWDON, ISZ NEW /GET CORRECT ADDR
3481 NT2, 0 /0 IF NO 2PG HANDLERS YET
3482 INCHK, 0 /CHECK THE INPUT DEVICES
3488 SNA CLA /SKIP IF FILE USED
3491 SZA CLA /SKIP IF STILL 1 PAGE HANDLERS
3495 DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR
3500 NOKBIN, CDF 10 /BELONGS WITH INIT CODE
3504 DCA WORD1 /CREATE POINTER INTO DEV TBL
3508 SNA CLA /IF ITS SYS, NO PROBLEMS
3509 DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE
3513 JMP FEND /AN EXT WAS SPECIFIED
3515 TAD (0216 /.BN DEFAULT FOR FLAP
3519 TAD I (7643 /CHECK IF L OR G SPEC
3522 TAD (0610 /NO-NEEDS RL EXT
3523 TAD (1404 > /YES-NEEDS LD
3529 TAD (1401 /CHANGE OUTPUT BUFFER
3535 \fLDADR, RELOC OVBUFR
3536 TAD ERRORS /ERROR COUNT
3538 JMS I (PRTXT /"ERRORS"
3543 TAD PASSNO /IF NOT LISTING PASS
3544 SPA SNA CLA /ERROR COUNT IS ENUF
3547 TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS
3551 JMS I (PRTXT /"SYMBOLS, "
3557 JMS I (PRTXT /"LINKS"
3563 JMS I (PRTXT /"ABS REFS"
3567 TAD (-33 /27 BUCKETS
3571 DCA OPCODE /SYMBOLS PER LINE COUNTER
3572 \fSTPRNT, TAD BUCKET
3573 DCA EXTMP /BUCKET START ADDRESS
3575 TAD I EXTMP /WAS THAT LAST SYMBOL ?
3577 JMP NXTBKT /YES, GO GET NEXT BUCKET
3578 DCA EXTMP /SAVE LINK ADDR
3580 DCA X14 /SET UP POINTER FOR NAME
3581 ISZ OPCODE /IS LINE FULL?
3589 JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR
3592 JMS I [PRINT2 /PRINT 2 AND 3
3595 JMS I [PRINT2 /PRINT 4 AND 5
3601 AND [7700 /PRINT 6 AND BLANK
3606 TAD (TYPCOD /POINT TO TABLE
3608 TAD I OTEMP /GET TYPE INDICATOR
3611 TAD I X14 /PRINT FIRST DIGIT
3613 JMS I (PDIG /FIELD DIGIT
3615 TAD I X14 /LOW 12 BITS
3617 JMS I [PRINT2 /TWO BLANKS
3619 \fNXTBKT, ISZ BUCKET /NEXT BUCKET CHAR
3621 ISZ LTEMP /INCREMENT COUNT
3623 JMS I [CRLF /DO FINAL CRLF**
3624 TAD (214 /DO NOT PAGEJ
3625 JMS I PC /THAT WOULD GIVE A HEADING
3627 JMP I (RETSYS /FINISH IT OFF
3634 / SYMBOL TABLE IS IN FIELD ONE.
3635 / EACH ENTRY HAS THE FOLLOWING FORMAT
3637 / 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
3638 / 1: 2ND AND 3RD CHARS OF SYMBOL
3640 / 3: 6TH AND TYPE CODE
3641 / 4: ESD # AND HIGH-ORDER VALUE
3642 / 5: LOW-ORDER VALUE
3651 FPPSF1=10 /JXN, TRAP
3652 FPPSF2=11 /JA, SETB, SETX
3653 FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM,
3654 /PAUS, JAC, STARTD, STARTF
3655 FPPSF4=13 /ALN, ATX, XTA
3656 FPPSF5=14 /ADDX, LDX
3662 / THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
3663 / THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
3664 / THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
3665 / IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
3666 / DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
3673 / BUCKETS FOR USER-DEFINED SYMBOLS
3674 / AND PDP8 OPERATES AND IOTS
3679 / BUCKETS FOR INTERNALLY DEFINED SYMBOLS
3783 0 /COMMZ (8-MODE COMM SECT)
3809 IFZERO RALF < 0 > /DECIMAL
3814 IFNZRO RALF < 0 /DPCHK
3901 .+5 /FIELD1 (8-MODE FIELD1 SECT)
4237 NL, IFZERO RALF < .+5 >
4265 QL= 0 /WHAT DID YOU EXPECT?
4441 \f IFZERO RALF < PNDL=0 >
4443 PNDL, .+6 /BLANK COMMON
4450 LMAIN, 20;0 /ESD #1, LEN=0>
4452 END, END /NICE WHEN FLAP ASSEMBLES