projects / pdp8.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
A large commit.
[pdp8.git] / sw / os8 / v3d / sources / fortran / dectapes / dectape3 / ralf.pa
1 / RALF, V62A
2 /
3 /
4 /
5 /
6 /
7 /
8 /
9 //
10 /
11 /
12 /
13 /
14 /COPYRIGHT (C) 1974, 1975, 1977
15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
16 /
17 /
18 /
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.
26 /
27 /
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.
31 /
32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
34 /
35 /
36 /
37 /
38 /
39 /
40 \f/ RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV
41 /
42 /
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
47 /
48 / THE FOLLOWING FORMULA GIVES THE NUM
49 / OF USER SYMBOLS:
50 / -(FREE+200[BASE8])/6[BASE10]
51 / WHERE THE VALUE OF FREE IS FROM THE
52 / RALF SYMBOL MAP
53 /
54 /
55 IFNDEF RALF <RALF=1 /GO RELOCATABLE THEN>
56 /
57 / ASSEMBLE WITH PAL8-V9 WITH W SWITCH
58 / SAVE AS:
59 / .SAVE SYS RALF.SV ;200=2000
60
61 /
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
67 /
68 /
69 FLD0=0
70 FLD1=10
71 VNUM=62
72 PATCH="A /PATCH LEVEL A
73 *3
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
78 0
79 X10, 0
80 X11, 0
81 X12, 0
82 X13, 0
83 X14, 0
84 OUTPTR, OUBUF-1
85 NEXT, FREE-1
86 CHRPTR, LINE-1
87 NCHARS, -1 /CHARACTER INPUT STUFF
88 CPTMP, 0
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
93 IFZERO RALF <
94 LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM
95 LOCTR2, 200 >
96 IFNZRO RALF <
97 ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
98 LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
99 LOCTR2, 0
100 DPFLG, 0 >
101 \fBASER, 4000 /BASE REGISTER SETTING
102 0
103 INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER
104 0
105 EXPVAL, 0 /EXPRESSION VALUE
106 0
107 0
108 EXPDEF, 0 /=0 IF EXPR IS UNDEFINED
109 EXPSW, 0 /FLAG=1 IF NO EXPR
110 WORD1, 0 /TEMPORARY 2 WORD OPERAND
111 WORD2, 0
112 FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR
113 0
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
132 EXTMP2, 0
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
139 P0LIT, 177
140 CPLIT, 177
141 PAGEN, 0
142 ERRORS, 0 /ERROR COUNT
143 PC, TTYOUT /OUTPUT ROUTINE
144 OUFILE, 7573 /OUTPUT FILE LIST POINTER
145 BFILE, 1
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
156 /=1=REGULAR
157 NP17, 17 /**
158 NP7700, 7700
159 OPX, 0
160 OP, ZBLOCK 6
161 ACX, 0
162 AC, ZBLOCK 6
163 M3, -3
164 BLINE, LINE-1
165 /
166 PAGE
167 \f/
168 / CORE ALLOCATION IN HIGH FIELD 0
169 /
170 CPLBUF=5100 /ACTUALLY AT 5200
171 P0LBUF=5200 /AND 5300, 1/2 PAGE EACH
172 IFZERO RALF <
173 INBUF=5400 >
174 IFNZRO RALF <
175 INBUF=6000 /AFTER PASS 1, MOVES TO 5400>
176 OUBUF=6400
177 LINE=7000 /CURRENT INPUT LINE IN ASCII
178 INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR
179 OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR
180 INRECS=2
181 INCTL=400
182 OUCTL=4200
183 /
184 / COLLECT THE NEXT STATEMENT
185 /
186 ISZ .+2
187 REPLEN, JMP I .+1
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,
191 SNA CLA
192 TAD PASSNO /AND LISTING PASS
193 SMA SZA CLA
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
198 TAD (-6
199 DCA LTEMP /SPACE OVER
200 JMS I [PRINT2 /12 SPACES
201 ISZ LTEMP
202 JMP .-2
203 JMS I (PRNTLN /THEN PRINT LINE
204 START, JMS I [GETCHR /ANY MORE CHARS ?
205 JMP NOTEG
206 JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE
207 0507 /*EG*
208 NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ?
209 SNA CLA
210 JMP .+5 /NO
211 DCA SCSWT /KILL SC SWITCH
212 ISZ CHRPTR /SKIP OVER SEMICOLON
213 ISZ NCHARS
214 JMP ASMBL /DON'T READ A NEW LINE
215 TAD REPCNT /IS THIS LINE TO BE REPEATED?
216 SPA CLA
217 JMP AGAIN /DO IT
218 NEWLIN, TAD BLINE /RESET POINTER
219 DCA CHRPTR
220 TAD [-200 /LIMIT LINE SIZE
221 DCA MAXLIN
222 DCA OUTSWT /CLEAR OUTPUT SWITCH
223 \fRDLOOP, JMS I (ICHAR /READ A CHAR
224 TAD (-212
225 SNA
226 JMP RDLOOP /IGNORE LINE FEEDS
227 TAD (212-215 /END ON CR
228 SNA
229 JMP ENDLIN
230 IAC
231 SNA /FORM FEED?
232 JMP FORMFD
233 TAD (214 /FIX CHAR
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
238 TAD (-215 /UNLESS CR
239 SZA CLA
240 JMP .-3
241 JMS I [ERMSG /EXCESS LENGTH LINE
242 1424 /*LT*
243 ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1
244 CMA
245 TAD BLINE
246 DCA NCHARS
247 TAD REPCNT /0 BECOMES 0,
248 CIA /BUT POS REP COUNT
249 DCA REPCNT /ENABLES REPEAT
250 TAD NCHARS /SAVE LENGTH
251 DCA REPLEN
252 TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT
253 DCA REPLST
254 REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT
255 DCA LINSIZ
256 TAD BLINE
257 DCA CHRPTR /SET POINTER
258 ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL
259 SZA CLA
260 JMP OFFIT /YES, AND THE COND WAS FALSE
261 JMS I [GETCHR /LOOK FOR A CHARACTER
262 JMP NEXTST
263 TAD (-257 /IS IT SLASH ?
264 SNA
265 JMP NOASM /YES, COOL IT
266 TAD [257-240 /IS IT BLANK OR TAB ?
267 SZA CLA /YES, IGNORE
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
272 CLA CMA
273 DCA LINPAG /FORCE EJECT ON CRLF
274 JMP RDLOOP
275 OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE
276 TAD ASMOF
277 DCA ASMOF
278 OFFIT, ISZ NCHARS /MORE TO GO?
279 JMP GETIT /YES
280 NOASM, CLA CMA
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?
285 SNA
286 JMP OPENIT /YES, PUSH ONE LEVEL DOWN
287 CLL RTR
288 SNA CLA
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
293 DCA NCHARS
294 DCA LISTSW /NO LISTING DURRING REPEAT
295 ISZ REPCNT
296 JMP REASM /ASSUMING COUNT STILL OK
297 TAD REPLST /RESTORE LISTING
298 DCA LISTSW
299 JMP NEWLIN /GET NEXT LINE
300 MAXLIN=LTEMP
301 /
302 TXERR, TEXT " ERRORS"
303 TXELN= .-TXERR
304 PAGE
305 \f/
306 / DIVIDE AC BY 3
307 / USEFUL IN FPP REFERENCES TO BASE
308 /
309 OVER3, 0 /DIVIDE AC BY THREE
310 DCA EXTMP2 /MQ
311 TAD (-15 /SET SHIFT COUNT
312 DCA LTEMP
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
319 DCA EXTMP /SAVE AC
320 TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK IN MQ
321 RAL
322 DCA EXTMP2 /SAVE MQ
323 TAD EXTMP /GET BACK AC
324 RAL /COMPLETE SHIFT
325 ISZ LTEMP /TEST COUNT
326 JMP DIVLUP /KEEP GOING
327 DCA EXTMP /THIS IS REMAINDER
328 TAD EXTMP2 /RETURN QUOTIENT
329 JMP I OVER3
330 /
331 / INITIALIZE FOR OUTPUT
332 /
333 OUSETP, 0
334 TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS
335 CIA /NEGATE IT (PAL10 BLOWS)
336 DCA OUDWCT
337 TAD NOUBUF
338 DCA OUPTR /INITIALIZE WORD POINTER
339 TAD OUJMPE
340 DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH
341 JMP I OUSETP
342 NOUBUF, OUBUF
343 /
344 / STORE CHARACTERS IN OUTPUT BUFFER
345 / IN PS8 FORMAT (YOU KNOW, 3 CHARS
346 / IN 2 WORDS THE WRONG WAY)
347 /
348 OCHAR, 0
349 AND (377
350 DCA OUTEMP
351 TAD OUTINH
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
357 JMP OCHAR1
358 JMP OCHAR2
359 TAD OUTEMP
360 CLL RTL
361 RTL
362 AND (7400
363 TAD I OUPOLD
364 DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH
365 /ORDER 4 BITS OF THIRD CHAR
366 TAD OUTEMP
367 CLL RTR
368 RTR
369 RAR
370 AND (7400
371 TAD I OUPTR
372 DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS
373 TAD OUJMPE
374 DCA OUJMP /RESET SWITCH
375 ISZ OUPTR
376 ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS
377 JMP OUCOMN
378 TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE
379 JMS I (OUTDMP /DUMP THE BUFFER
380 JMS OUSETP /RE-INITIALIZE THE POINTERS
381 JMP OUCOMN
382 OCHAR2, TAD OUPTR
383 DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
384 ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
385 OCHAR1, TAD OUTEMP
386 DCA I OUPTR
387 OUCOMN, CDF
388 JMP I OCHAR
389 OUTEMP, 0
390 OUPOLD, 0
391 OUPTR, 0
392 OUJMPE, JMP OUJMP
393 OUDWCT, 0
394 OUTINH, 0
395 /
396 / MOVE OUTPUT FILE NAME TO FIELD 0
397 /
398 OFNAME, 0
399 TAD OUFILE
400 DCA X10
401 TAD (OUFNAM-1
402 DCA X11
403 TAD (-4
404 DCA LTEMP
405 CDF 10
406 TAD I X10
407 CDF 0
408 DCA I X11
409 ISZ LTEMP
410 JMP .-5
411 JMP I OFNAME
412 \f/
413 / GET OUTPUT DEVICE CHARISTICS
414 /
415 OTYPE, 0
416 CDF 10
417 TAD I (7600
418 AND [17
419 TAD (DCB-1
420 DCA OTYPP
421 TAD I OTYPP
422 CDF 0
423 JMP I OTYPE
424 OTYPP= OFNAME
425 /
426 / BASIC TITLE INFO
427 /
428 TITBUF,
429 IFZERO RALF <
430 TEXT "FLAP V" >
431 IFNZRO RALF <
432 TEXT "RALF V" >
433 *.-1
434 VMTXT, 0;0;0
435 TITDAT, ZBLOCK 6
436 TEXT " PAGE"
437 TITLEN= .-TITBUF
438 PAGE
439 \f/
440 / PROCESS A STATEMENT
441 /
442 LUNAME, TAD CHRPTR /SAVE CHAR STUFF
443 DCA CPTMP
444 TAD NCHARS
445 DCA NCTMP
446 DCA LINKSW /CLEAR SWITCH
447 JMS I [GETNAM /LOOK FOR NAME
448 IFZERO RALF <
449 JMP I (TRYSTR /COULD BE AN ORG>
450 IFNZRO RALF <
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
455 SZA
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
460 SZA CLA
461 JMP MDERR /THAT'S A NO-NO
462 TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION
463 CIA
464 TAD LOCTR1 /FIRST UPPERR HALF
465 SZA CLA
466 JMP .+6
467 TAD I X10
468 CIA
469 TAD LOCTR2 /THEN LOWER HALF
470 SNA CLA
471 JMP DEFIND
472 MDERR, JMS I [ERMSG /MULTIPLY DEFINED
473 1504 /*MD*
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
478 TAD LOCTR2
479 DCA I X10
480 DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG
481 JMP I (ASMBL
482 \fTRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN
483 SZA
484 JMP TRYBLK /NO, TRY BLANK
485 TAD NAME1
486 DCA EQUN /SAVE 6 CHARACTER NAME
487 TAD NAME2
488 DCA EQUN+1
489 TAD NAME3
490 DCA EQUN+2
491 TAD BUCKET
492 DCA EQUN+3
493 JMS I [GETCHR /ALLOW BLANK AFTER =
494 JMP EQUERR
495 TAD [-240
496 SZA CLA
497 JMS I [BACK1 /ANYTHING ELSE GOES BACK
498 JMS I [EXPR /GET VALUE RIGHT OF EQUALS
499 JMP EQUERR /BAD EQU
500 TAD EQUN /RESTORE NAME
501 DCA NAME1
502 TAD EQUN+1
503 DCA NAME2
504 TAD EQUN+2
505 DCA NAME3
506 TAD EQUN+3
507 DCA BUCKET
508 JMS I [LOOKUP /LOOKUP SYMBOL
509 JMP PUTVAL /A NEW SYMBOL
510 CLL RAR
511 SZA CLA
512 JMP EQUERR /TYPE CONFLICT
513 PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE
514 DCA I X10
515 TAD EXPVAL+2
516 DCA I X10
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
521 CDF FLD0
522 JMP I [NEXTST /GO GET NEXT STMT
523 EQUERR, JMS I [ERMSG /BAD EQU
524 0205 /*BE*
525 JMP I [NEXTST
526 \fTRYBLK, TAD (35 /CHECK FOR BLANK
527 SNA /MATCH BLANK?
528 JMP JSTONE /YES
529 AND [77
530 JMS I [R6L
531 DCA NAME3 /MAKE MODIFIED NAME OF IT
532 JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK
533 JMP I (GETEXP /LOOKS BAD
534 TAD [-240 /GOT IT?
535 SZA CLA
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
541 DCA OPCJMP /SAVE IT
542 TAD I X10 /PICK UP FIRST WORD OF VALUE
543 DCA OPCODE /ITS AN OPCODE-MAYBE?
544 CDF FLD0
545 OPCJMP, 0 /JUMP SOMEWHERE
546 OPCTBL, JMP I .-4
547 PSEUDO /PSEUDO OPS
548 PDP8MR /PDP8 MRI
549 FPPMR /FPPMR
550 FPPS1 /OTHER FPP OPCODES
551 FPPS2
552 FPPS3
553 FPPS4
554 FPPS5
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
560 CLL CMA RAR /3777
561 AND EXPVAL+2
562 DCA REPCNT
563 JMP I [NEXTST
564 PAGE
565 \f/
566 GETEXP, CDF FLD0
567 TAD CPTMP /RESTORE CHARACTER POINTER
568 DCA CHRPTR
569 TAD NCTMP /TO JUST AFTER TAG (IF ANY)
570 DCA NCHARS
571 SX, DCA OPCODE
572 JMS I [EXPR /TRY FOR AN EXPRESSION
573 JMP BADEXP /IF NONE, ERROR
574 IFNZRO RALF <
575 JMS RELERR /BOMB IF NOT ABSOLUTE EXP>
576 TAD EXPVAL+2
577 JMS I [OUTWRD
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
584 SNA CLA
585 JMP I RELERR /ITS ABSOLUTELY FINE
586 TAD EXPVAL+1
587 AND [7 /REMOVE ESD
588 DCA EXPVAL+1
589 JMS I [ERMSG
590 2205 /*RE*
591 JMP I RELERR >
592 /
593 FPPMR, ISZ FPPSWT /SET FORCE ENABLE
594 JMS FPADR
595 TAD WORD1 /IF WAY OFF BASE,
596 SNA
597 TAD FPPWD2 /OR IF FORCED
598 SNA
599 TAD XFLAG /OR IF INDEXED
600 SZA CLA
601 JMP FORMT1 /USE LONG FORM
602 TAD WORD2
603 CLL
604 TAD (-600 /COMPLETE OFF-BASE CHECK
605 SZL CLA
606 JMP FORMT1 /USE LONG
607 JMP FORMT2
608 FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR
609 JMS IXMES /BUT DISALLOW INDEX
610 JMP F2WD /PUT TWO WORDS OUT
611 /
612 IXMES, 0
613 TAD XFLAG /NO INDEX ALLOWED
614 SNA CLA
615 JMP I IXMES /HE'S COOL
616 JMS I [ERMSG
617 1130 /*IX*
618 JMP I IXMES
619 \fFPMRL, JMS FPADR
620 FORMT1, JMS I (FIXOPC
621 F2WD, TAD FPPADR
622 AND [7 /FIELD BITS
623 TAD OPCODE /IN FIRST WORD
624 FPDMP, IFZERO RALF <
625 JMS I [OUTWRD
626 TAD FPPADR+1 /LOW ADDRESS
627 JMS I [OUTWRD
628 JMP I [NEXTST /NEXT!>
629 IFNZRO RALF <
630 JMP I (OUTREL /DUMP TWO RELOCATABLE>
631 FPMRS, JMS FPADR /COLLECT OPERAND
632 JMS IXMES /ERROR IF INDEX GIVEN
633 TAD WORD1
634 SZA CLA
635 JMP BADEXP
636 TAD WORD2
637 CLL
638 TAD (-600 /DOES IT FIT?
639 SNL CLA
640 JMP FORMT2
641 BADEXP, JMS I [ERMSG
642 0230 /*BX*
643 TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT
644 JMS I [OUTWRD
645 JMP I [NEXTST
646 FPMRI, JMS FPADR
647 TAD WORD1
648 SZA CLA
649 JMP BADEXP /NOT EVEN CLOSE
650 TAD WORD2
651 CLL
652 TAD (-30
653 SZL CLA
654 JMP BADEXP /GOTTA BE IN THE FIRST 10
655 FORMT3, JMS I (FIXOPC
656 FORMT2, TAD WORD2
657 JMS I (OVER3 /BY 3 FOR BASE ADDRESS
658 TAD [200
659 FPPS3, TAD OPCODE
660 JMS I [OUTWRD /WHEW!
661 JMP I [NEXTST
662 FPPS1, JMS I (GETADR /GET ADDR, AND INDEX
663 JMS I (FIXOPC /PUT OPCODE TOGETHER
664 TAD FPPADR /GET ADDR EXTENSION
665 AND [7
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
671 IFNZRO RALF <
672 TAD FPPADR
673 AND [7770 /MUST BE ABSOLUTE
674 SNA CLA
675 JMP .+3 /OK
676 JMS I [ERMSG
677 2205 /*RE*>
678 TAD XFLAG
679 SZA CLA /ANY INDEX?
680 TAD EXPVAL+2
681 AND [7 /STRIP OFF ESD BITS
682 TAD OPCODE
683 JMS I [OUTWRD /DUMP THAT
684 TAD FPPADR+1
685 JMS I [OUTWRD /NOW LOW 12 BITS
686 JMP I [NEXTST
687 /
688 FPADR, 0
689 JMS I (GETADR /COLLECT ADDRESS AND INDEX
690 TAD BASER+1
691 CIA STL
692 TAD FPPADR+1
693 DCA WORD2 /GET ADDRESS RELATIVE TO BASE
694 RAL
695 TAD BASER
696 CIA
697 TAD FPPADR
698 DCA WORD1
699 JMP I FPADR
700 PAGE
701 \f/
702 PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR
703 /
704 IFZERO RALF <
705 /
706 / ASSEMBLE VARIOUS INSTRUCTION TYPES
707 /
708 PDP8MR, TAD CHRPTR /SAVE POSITION
709 DCA CPTMP
710 TAD NCHARS
711 DCA NCTMP /SAVE COUNT
712 JMS I [GETCHR /LOOK FOR SPACE "I"
713 JMP GETMR /WILL GIVE BX ERROR
714 TAD (-"I /IS IT I?
715 SNA CLA /IF NOT, FORGET IT
716 JMS I [GETCHR /MUST BE FOLLOWED BY SPACE
717 JMP NOTIND
718 TAD [-240
719 SZA CLA
720 JMP NOTIND /SOMETHING ELSE
721 TAD OPCODE /PUT INDIRECT INTO OPCODE
722 TAD (400
723 DCA OPCODE
724 GETMR, JMS ADRGET /PICK UP ADDRESS FIELD
725 TAD EXPVAL+2 /CHECK PAGE OF ADDRESS
726 AND [7600
727 SNA
728 JMP PAGEZ /ITS IN PAGE 0
729 CIA
730 TAD LOCTR2 /COMPARE WITH CURRENT PAGE
731 AND [7600
732 SNA CLA
733 JMP THSPAG /OK, ITS THIS PAGE
734 TAD OPCODE /CAN WE USE A LINK ?
735 AND (400 /IS INDIRECT BIT OFF ?
736 SNA CLA
737 JMP I (MAKLNK /YES, GO MAKE LINK
738 JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE
739 1122 /*IR*
740 THSPAG, TAD EXPVAL+2 /GET ADDRESS
741 AND [177 /LOWER 7 BITS
742 TAD [200 /PUT IN PAGE BIT
743 SKP
744 PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
745 TAD OPCODE /PLUS OPCODE
746 JMS I [OUTWRD /OUTPUT WORD
747 JMP I [NEXTST
748 NOTIND, TAD CPTMP /RESTORE CHAR POINTER
749 DCA CHRPTR
750 TAD NCTMP
751 DCA NCHARS
752 JMP GETMR /NOT AN INDIRECT>
753 \fFPPS4, JMS ADRGET /GET INDEX REG EXPRESSION
754 IFZERO RALF <
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
760 JMS I [OUTWRD /OUT
761 JMP I [NEXTST
762 ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE
763 JMS I [EXPR /GET EXPR
764 JMS I [ERMSG /BAD ADDR EXPR
765 0230 /*BX*
766 JMP I ADRGET
767 IFZERO RALF <
768 LITERR, 0 /GIVE ERROR IF LITERAL
769 TAD LITRL
770 SNA CLA
771 JMP I LITERR
772 JMS I [ERMSG
773 1114 /*IL*
774 JMP I LITERR >
775 IFNZRO RALF <
776 PDP8MR, JMS ADRGET
777 JMP I (CHCKMR /V.56
778 >
779 \fGETADR, 0 /GET ADDR, INDEX
780 DCA XITEMP /SAVE INDEX INCREMENT SWITCH
781 JMS ADRGET /GET ADDR
782 DCA FPPSWT /KILL FPP SWITCH
783 IFZERO RALF <
784 JMS LITERR /DISALLOW LITERALS>
785 TAD EXPDEF /IF EXPR WAS UNDEFINED
786 SNA CLA
787 IAC /OR FORCE BIT WAS SET
788 TAD FPP2WD
789 DCA FPPWD2 /FORCE 2 WORD FORMAT
790 DCA XFLAG /ZERO INDEX SWT
791 TAD EXPVAL+1 /SAVE ADDRESS VALUE
792 DCA FPPADR
793 TAD EXPVAL+2
794 DCA FPPADR+1
795 JMS I [GETCHR /LOOK FOR COMMA
796 JMP I GETADR /NO INDEX
797 TAD (-254
798 SZA CLA
799 JMS I [BACK1 /WILL CAUSE A BX ERROR
800 ISZ XFLAG /SET INDEX SWITCH
801 TAD XITEMP /SET INDEX INCREMENT SWITCH
802 DCA XINCR
803 JMS ADRGET
804 ISZ XINCR /CLEAR INDEX INCREMENT SWITCH
805 IFZERO RALF <
806 JMS LITERR >
807 JMS SUBX /CALCULATE INDEX NO
808 JMP I GETADR
809 XITEMP,
810 SUBX, 0
811 TAD INDXR+1 /CHECK FOR INDEX IN RANGE
812 STL CIA
813 TAD EXPVAL+2
814 DCA EXPVAL+2
815 RAL
816 TAD INDXR
817 CIA
818 TAD EXPVAL+1
819 SZA CLA
820 JMP BIERR
821 TAD EXPVAL+2
822 CLL
823 TAD [-10
824 SZL CLA
825 BIERR, JMS I [ERMSG
826 0211 /*BI*
827 JMP I SUBX
828 \f IFNZRO RALF <
829 /
830 / AT END OF PASS,
831 / CLEAR LENGTHS OF ALL SECTIONS
832 /
833 CLRSCT, 0
834 TAD (PNDL+3
835 DCA LTEMP /POINT TO USER SYMBOL SPACE
836 CDF FLD1
837 CSLOOP, TAD I LTEMP /GET TYPE
838 AND [37 /STRIP TO TYPE ONLY
839 TAD (-3
840 SPA CLA /IS IT COMMON OR SECTION?
841 JMP NOTSCT /NO, PASS IT
842 ISZ LTEMP /BUMP POINTER TO VALUE
843 TAD I LTEMP
844 AND [7770 /SAVE ESD NUMBER
845 DCA I LTEMP
846 ISZ LTEMP
847 DCA I LTEMP /CLEAR LOW ORDER
848 CLA CLL CMA RAL /-2
849 NOTSCT, TAD (6 /BUMP POINTER
850 TAD LTEMP /TO NEXT SYMBOL
851 DCA LTEMP
852 TAD NEXT /COMPARE END OF SYMBOL TABLE
853 CIA CLL
854 TAD LTEMP
855 SNL CLA
856 JMP CSLOOP /MORE TO GO
857 CDF FLD0
858 JMP I CLRSCT /THAS ALL>
859 /
860 /
861 IFNZRO RALF <
862 /
863 / ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE
864 /
865 NOREL, 0
866 TAD WORD1 /IS SYMBOL RELOCATABLE?
867 AND [7770 /TEST ESD BITS
868 SZA CLA
869 STL RAR /IF SO, FORCE ERROR
870 JMS I (RELERR /TEST SUB EXPR
871 JMP I NOREL
872 DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS
873 DCA DPFLG /DP HARDWARE
874 JMP I [NEXTST
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
880 TAD EXPVAL+1
881 DCA I X12 /HIGH ORDER AND ESD
882 TAD EXPVAL+2
883 DCA I X12 /LOW ORDER
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.
887 DELFIL, 0
888 TAD [7600
889 DCA OUFILE
890 JMS I [OFNAME
891 CLA IAC
892 CIF 10
893 JMS I USR
894 4
895 OUFNAM
896 0
897 NOP
898 JMP I DELFIL
899 PAGE
900 \f/
901 / PRINT THE CURRENT LINE IF NOT ALREADY DONE
902 /
903 PRNTLN, 0 /PRINT THE LINE
904 TAD OUTSWT /HAS THE LINE BEEN PRINTED YET?
905 SZA CLA
906 JMP I PRNTLN /YES, COOL IT
907 ISZ OUTSWT /SET SWITCH
908 TAD BLINE /POINTER TO LINE
909 DCA X13
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
914 SNA
915 JMP TABIT /CONVERT TO BLANKS
916 TAD (211 /RESTORE
917 ISZ CRLF /BUMP POSITION COUNT
918 JMS I PC /PRINT IT
919 PRLTST, ISZ LINSIZ /CHECK COUNT
920 JMP PRLNXT
921 JMP I PRNTLN
922 TABIT, TAD [240 /REPLACE TAB WITH BLANKS
923 ISZ CRLF
924 JMS I PC
925 TAD CRLF
926 AND [7
927 SZA CLA
928 JMP TABIT
929 JMP PRLTST
930 /
931 / GO TO NEXT LINE
932 /
933 CRLF, 0
934 CLA
935 TAD (215
936 JMS I PC /PRINT A CHAR
937 TAD (212
938 JMS I PC
939 ISZ LINPAG /FULL PAGE?
940 JMP I CRLF /NO
941 CLA CMA
942 DCA LINPAG
943 /
944 / NEW PAGE, WITH HEADING AND PAGE NO
945 /
946 TAD PASSNO /IF NOT LISTING PASS
947 SMA SZA CLA
948 TAD LISTSW /OR IF NOT LISTING,
949 SNA CLA
950 JMP I CRLF /DO NOT EJECT
951 TAD RFORMF
952 SZA /DON'T F.F. FIRST TIME
953 JMS I PC /TOP OF PAGE
954 TAD (214
955 DCA RFORMF
956 JMS I (PRTXT /PRINT HEADING
957 TITBUF-1
958 -TITLEN
959 TAD LPAGE1 /FORM FEED COUNT
960 JMS I (DECOUT
961 TAD LPAGE2
962 SNA CLA
963 JMP .+5 /NO SUB PAGE IF 0
964 TAD (255
965 JMS I PC
966 TAD LPAGE2
967 JMS I (DECOUT
968 ISZ LPAGE2
969 TAD (215 /FOR BH
970 JMS I PC
971 TAD (212
972 JMS I PC
973 TAD (-71 /RESET LINE COUNTER
974 DCA LINPAG
975 JMP CRLF+1 /GIVE ANOTHER CRLF
976 RFORMF, 0
977 /
978 / PRINT TEXT
979 /
980 PRTXT, 0
981 TAD I PRTXT
982 DCA X13
983 ISZ PRTXT
984 TAD I PRTXT
985 DCA PRTTMP
986 ISZ PRTXT
987 TAD I X13
988 JMS PRINT2
989 ISZ PRTTMP
990 JMP .-3
991 JMP I PRTXT
992 PRTTMP= PRNTLN
993 /
994 PRINT2, 0
995 DCA P2
996 TAD P2
997 JMS I [R6R
998 JMS P1
999 TAD P2
1000 JMS P1
1001 JMP I PRINT2
1002 /
1003 P1, 0
1004 AND [77
1005 SNA
1006 JMP .+4 /PRINT ZERO AS BLANK
1007 TAD (-40 /TEST ABOVE OR BELOW 300
1008 SPA
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
1012 JMP I P1
1013 \f/
1014 TTYOUT, 0
1015 TLS
1016 TSF
1017 JMP .-1
1018 TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE
1019 TAD (-14 /CTRL/O
1020 SZA CLA
1021 JMP I TTYOUT
1022 TAD .+2
1023 DCA TTYOUT+1
1024 JMP I TTYOUT
1025 /
1026 P2, 0
1027 /
1028 IFZERO RALF <
1029 TXLNK, TEXT " LINKS"
1030 TXLLN= .-TXLNK >
1031 IFNZRO RALF <
1032 TXABR, TEXT " ABS REFS"
1033 TXALN= .-TXABR >
1034 PAGE
1035 \f/
1036 / GET AND EVALUATE AN EXPRESSION
1037 /
1038 EXPR, 0 /GET EXPRESSION
1039 DCA EXPVAL /ZERO EXPR VALUE
1040 DCA EXPVAL+1
1041 DCA EXPVAL+2
1042 CLA IAC
1043 DCA EXPDEF /AND TYPE
1044 CLA IAC /SET EXPR SWITCH TO NO EXPR
1045 DCA EXPSW
1046 DCA FPP2WD /SET FORCE SWITCH OFF
1047 CLA IAC /SET LASTOP TO +
1048 DCA LASTOP
1049 IFZERO RALF <
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
1056 IFZERO RALF <
1057 JMP ADR /YES >
1058 IFNZRO RALF <
1059 CLL RAR
1060 SNA
1061 JMP ADR
1062 SCTN, TAD I LTEMP /GET TYPE
1063 AND (40 /FORCE BIT
1064 SZA CLA
1065 ISZ FPP2WD /SET FORCE EXPR SW
1066 TAD I X10 /GET ESD FROM SYMBOL
1067 AND [7770 /ESD ONLY
1068 DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO
1069 JMP CLR2 /SO CLEAR WORD 2>
1070 \fNOTDOT, TAD (256-242 /IS IT DBL QUOTE?
1071 SZA CLA
1072 JMP ENDEXP
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?
1077 SZA CLA
1078 JMP BAD /NO, DON'T SKIP
1079 IFZERO RALF <
1080 TAD LITRL /WAS IT A LITERAL REF?
1081 SZA CLA
1082 JMS I (CRLIT /YES, STICK IT IN THE POOL>
1083 TAD LASTOP /TRAILING OPERATOR?
1084 SNA
1085 JMP OKEXP /NO, ALL IS FINE
1086 CLL RAR /IF PLUS OPERATOR
1087 TAD XINCR /AND THATS LEGAL
1088 SNA CLA
1089 OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN
1090 BAD, JMS CKCTC
1091 CLA
1092 JMP I EXPR /AND RETURN
1093 /
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 "." ?
1099 SZA
1100 JMP NOTDOT /NO, TRY FOR QUOTE
1101 TAD LOCTR1 /THIS WAS LOC SYMBOL
1102 DCA WORD1 /PUT VALUE INTO WORD1,2
1103 TAD LOCTR2
1104 JMP CLR2 /AND USE VALUE
1105 ISQUOT, DCA WORD1
1106 TAD I CHRPTR
1107 JMP CLR2
1108 CKCTC, 0
1109 CLA
1110 KSF /IF NOTHING AT THE KEYBOARD,
1111 JMP I CKCTC /RETURN
1112 TAD [200
1113 KRS /ELSE, LOOK AT IT
1114 TAD (-203 /IS IT CTRL/C?
1115 SNA
1116 JMP I [7600 /GO TO MOMMA
1117 JMP I CKCTC
1118 \fADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL
1119 AND (40
1120 SZA CLA
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
1125 CLR2, DCA WORD2
1126 CDF FLD0 /FIX FIELD
1127 ADREXP, DCA EXPSW /KILL FIRST TIME SWITCH
1128 TAD LASTOP /PICK UP LAST OPERATOR
1129 TAD ADROP /MAKE A JMP I
1130 DCA .+1
1131 0 /DO IT
1132 ADROP, JMP I .
1133 ADRADD
1134 ADRSUB
1135 ADRMUL
1136 ADRDIV
1137 ADRAND
1138 ADROR
1139 ADROR
1140 \fUNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ?
1141 SNA CLA
1142 JMP .+5 /NO, SKIP AROUND
1143 TAD I LTEMP /TURN ON FORCE BIT
1144 AND (7737 /FOR THIS SYMBOL
1145 TAD (40
1146 DCA I LTEMP
1147 DCA EXPDEF /SET TYPE TO UNDEFINED
1148 CDF FLD0 /FIX FIELD
1149 DCA EXPSW /KILL FIRST TIME SWITCH
1150 JMS I [ERMSG
1151 2523 /*US*
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
1157 DCA EXTMP /SAVE IT
1158 FINDOP, ISZ LASTOP
1159 TAD I X11 /GET NEXT LIST ENTRY
1160 SNA
1161 JMP NOOPR /ZERO IS END OF LIST
1162 TAD EXTMP /COMPARE
1163 SZA CLA
1164 JMP FINDOP /LOOP
1165 JMP SYMBOL /LOOK FOR OPERAND
1166 NOOPR, DCA LASTOP /NO MATCH FOUND
1167 JMP ENDEXP /PUT IT BACK
1168 PAGE
1169 \fADRADD, IFNZRO RALF <
1170 TAD WORD1
1171 AND [7770 /IF THIS SYMBOL IS RELOCATABLE,
1172 SZA CLA /CHECK FOR EXPR VALIDITY
1173 JMS I (RELERR >
1174 TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS
1175 CLL /ZERO LINK
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
1188 TAD EXPVAL+1
1189 AND [7 /IF WORD RELOCATABLE, EXP IS ABS
1190 DCA EXPVAL+1 >
1191 TAD WORD2 /SUBTR LOW 12 BITS
1192 CLL CML CIA
1193 TAD EXPVAL+2
1194 DCA EXPVAL+2 /SAVE LOW HALF
1195 RAL
1196 TAD WORD1 /SUBTRACT HIGH HALF
1197 CIA
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
1204 IFZERO RALF <
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
1210 TAD EXPVAL+1
1211 DCA I X12 /HIGH ORDER AND ESD
1212 TAD EXPVAL+2
1213 DCA I X12 /LOW ORDER
1214 JMP I [NEXTST >
1215 \fADRAND, TAD WORD1 /AND
1216 AND EXPVAL+1 /HIGH
1217 AND [7 /3 BITS
1218 DCA EXPVAL+1 /HALF
1219 TAD WORD2 /THEN
1220 AND EXPVAL+2 /LOW
1221 JMP ADRAOX
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
1226 AND [7
1227 DCA EXPVAL+1 /THAT ARE ON IN A
1228 TAD WORD2
1229 CMA
1230 AND EXPVAL+2
1231 TAD WORD2
1232 ADRAOX, DCA EXPVAL+2
1233 IFNZRO RALF <
1234 JMS I (NOREL /**>
1235 JMP I (OPR8R /GET NEXT OPERATOR
1236 /
1237 \fADRMUL, TAD WORD2 /**RL CODE
1238 CIA
1239 DCA EXPVAL+1 /MULT BY
1240 TAD EXPVAL+2 /REPEATED ADDITIONS
1241 ISZ EXPVAL+1
1242 JMP .-2
1243 JMP ADRAOX
1244 ADRDIV, DCA WORD1
1245 DCA EXPVAL+1
1246 TAD WORD2
1247 SNA CLA
1248 JMP DIVERR
1249 TAD EXPVAL+2
1250 CIA CLL
1251 TAD WORD2
1252 SZL
1253 JMP .+3 /DIVIDE BY
1254 ISZ WORD1 /COUNTING SUBTRACTIONS
1255 JMP .-4
1256 CLA
1257 TAD WORD1
1258 JMP ADRAOX
1259 \fDIVERR, JMS I [ERMSG
1260 0626 /*DV*
1261 JMP I (OPR8R /CONTINUE
1262 \fPDPOPR, TAD CHRPTR
1263 DCA CPTMP
1264 TAD NCHARS
1265 DCA NCTMP
1266 JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST
1267 JMP TRYEXP /NONE
1268 TAD (33 /USE INTERNAL TABLE
1269 JMS I [FIND /IS IT THERE ?
1270 JMP TRYEXP /NO
1271 TAD (-PDPOP /IS IT AN OPERATE ?
1272 SZA CLA
1273 JMP TRYEXP /NO
1274 TAD I X10 /GET VALUE
1275 CDF FLD0
1276 DCA EXPVAL+2
1277 PDPOR, TAD EXPVAL+2
1278 CMA /OR THEM TOGETHER
1279 AND OPCODE
1280 TAD EXPVAL+2
1281 DCA OPCODE
1282 JMS I [GETCHR /MORE CHARS ?
1283 JMP I (FPPS3 /NO-DONE
1284 TAD [-240 /BLANK ?
1285 SNA CLA
1286 JMP PDPOPR /YES-PROCESS NEXT
1287 JMP I (BADEXP
1288 TRYEXP, CDF FLD0
1289 TAD CPTMP
1290 DCA CHRPTR
1291 TAD NCTMP
1292 DCA NCHARS
1293 ISZ NCTMP
1294 SKP
1295 JMP I (FPPS3
1296 JMS I [EXPR
1297 JMP I (BADEXP
1298 JMP PDPOR
1299 TXSYM, TEXT " SYMBOLS,"
1300 TXSLN=.-TXSYM
1301 PAGE
1302 \f IFZERO RALF <
1303 /
1304 / LITERAL THINGS
1305 /
1306 CHKLIT, 0 /CHECK FOR LITERAL
1307 DCA PAGENO /ZERO PAGE NUMBER
1308 DCA LITRL
1309 JMS I [GETCHR /GET CHARACTER
1310 JMP I CHKLIT /NO LITERAL
1311 TAD (-250 /CHECK FOR (
1312 SNA
1313 ISZ PAGENO /CURRENT PAGE LITERAL
1314 SZA /SKIP IF ALREADY ZERO
1315 TAD (-63 /CHECK FOR [
1316 SNA
1317 ISZ LITRL /SET SWITCH
1318 SZA CLA
1319 JMS I [BACK1 /PUT BACK NON ([
1320 JMP I CHKLIT
1321 /
1322 / CREATE A LINK FOR OFF-PAGE REFERENCE
1323 /
1324 MAKLNK, TAD (THSPAG /PROPER RETURN ADDR
1325 DCA CRLIT
1326 TAD OPCODE /SET INDIRECT BIT
1327 TAD (400
1328 DCA OPCODE
1329 CLA IAC
1330 DCA PAGENO /SET INDICATOR
1331 ISZ LINKS /COUNT ANOTHER LINK GENERATED
1332 ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT
1333 JMP NOTP0
1334 CRLIT, 0 /CREATE LITERAL
1335 /VALUE:EXPVAL, IN PAGE:PAGENO
1336 TAD PAGENO /CHECK FOR PAGE 0
1337 SNA CLA
1338 JMP ISP0 /PAGE 0 LITERAL
1339 NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER
1340 DCA LITBAS
1341 TAD LOCTR2 /CHECK FOR LIT BUFFER FULL
1342 AND [100
1343 SNA CLA
1344 JMP DOLIT-1 /USE 77 AS LIMIT
1345 TAD LOCTR2
1346 AND [177
1347 JMP DOLIT /USE CURRENT ADDR AS LIMIT
1348 \fISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER
1349 DCA LITBAS
1350 TAD [77 /ASSUME FIRST 64 WORDS USED
1351 DOLIT, DCA NWUSED
1352 TAD PAGENO /GET POINTER TO
1353 TAD [P0LIT /LITERAL BOUNDARY
1354 DCA XPAGE
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
1359 SMA CLA
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
1366 CIA
1367 TAD EXPVAL+2 /COMPARE PROTOTYPE
1368 SZA CLA
1369 JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY
1370 LITADR, TAD PAGENO /PAGE 0 ?
1371 SZA CLA
1372 TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS
1373 AND [7600
1374 TAD LITPTR /PLUS PAGE DISPLACEMENT
1375 DCA EXPVAL+2 /INTO VALUE
1376 TAD LOCTR1
1377 RETLIT, DCA EXPVAL+1
1378 JMP I CRLIT
1379 \fNEWLIT, CLA CMA
1380 TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN
1381 DCA X10 /ADDRESS OF NEW LITERAL
1382 TAD NWUSED /CHECK FOR PAGE OVERFULL
1383 CIA
1384 TAD X10
1385 SMA CLA
1386 JMP .+5 /NOT FULL
1387 JMS I [ERMSG /*PO*
1388 2017
1389 DCA EXPVAL+2 /ZERO ADDRESS
1390 JMP RETLIT
1391 TAD X10
1392 DCA I XPAGE
1393 TAD I XPAGE /SET UP POINTER FOR MOVE
1394 TAD LITBAS
1395 DCA X10
1396 TAD EXPVAL+2 /MOVE LITERAL IN
1397 DCA I X10
1398 TAD I XPAGE /SET UP LITERAL ADDRESS
1399 IAC
1400 DCA LITPTR
1401 JMP LITADR /RETURN LITERAL ADDRESS
1402 LITBAS, 0
1403 NWUSED, 0
1404 LITPTR, 0
1405 PAGENO, 0
1406 XPAGE, 0
1407 PAGE />
1408 \f/
1409 / FIND SYMBOL TABLE ENTRY
1410 / FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3
1411 / SKIP IF FOUND WITH TYPE IN AC
1412 /
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
1418 SNA /IF ZERO, THEN
1419 JMP I FIND /IT AIN'T HERE
1420 DCA X10 /SAVE NEXT NAME PTR
1421 TAD NAME1 /COMPARE NAMES
1422 CIA CLL
1423 TAD I X10 /WORD 1
1424 SZA CLA
1425 JMP NOTSAM
1426 TAD NAME2
1427 CIA CLL
1428 TAD I X10 /WORD2
1429 SZA CLA
1430 JMP NOTSAM
1431 TAD NAME3
1432 CIA CLL
1433 TAD I X10 /COMPARE LAST CHAR
1434 AND [7700 /HIGH HALF ONLY
1435 SZA CLA
1436 JMP NOTSAM
1437 ISZ FIND /IF FOUND BUMP RETURN
1438 TAD X10
1439 DCA LTEMP /ADDR OF TYPE WORD
1440 TAD I LTEMP /GET TYPE INTO AC
1441 AND [37 /WITHOUT FORCE BIT
1442 JMP I FIND /RETURN
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
1446 JMP LOOK /LOOP
1447 \f/
1448 / FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT
1449 /
1450 LOOKUP, 0
1451 JMS FIND
1452 JMP .+4
1453 SZA
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
1461 DCA I NEXT
1462 TAD NAME2
1463 DCA I NEXT
1464 TAD NAME3
1465 DCA I NEXT
1466 TAD NEXT /X10=NEXT
1467 DCA X10
1468 TAD NEXT /LTEMP=NEXT
1469 DCA LTEMP
1470 DCA I NEXT /INITIAL VALUE IS ZERO
1471 DCA I NEXT
1472 TAD NEXT /CHECK FOR TABLE FULL
1473 CLL
1474 TAD [200 /GONNA OVERFLO PS8?
1475 SNL CLA
1476 JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP)
1477 JMS I [ERMSG1
1478 2324 /*ST*
1479 \f/
1480 / COLLECT AN INTEGER IN THE CURRENT RADIX
1481 /
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
1486 DCA WORD2
1487 NUMLUP, JMS I (DIGIT
1488 JMP NODGT /TOO BAD
1489 DCA NUM /YES, SAVE IT
1490 TAD WORD1 /SAVE CURRENT VALUE
1491 DCA NUM1 /OF NUMBER
1492 TAD WORD2
1493 DCA NUM2
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)
1497 SNA CLA
1498 JMP OCTNUM /ITS OCTAL
1499 CLL /DECIMAL, ADD IN NUMBER
1500 TAD NUM2
1501 TAD WORD2 /THUS MULTIPLYING BY 5
1502 DCA WORD2
1503 RAL
1504 TAD NUM1
1505 TAD WORD1
1506 DCA WORD1
1507 JMP ADDDGT
1508 OCTNUM, TAD NUM
1509 AND [7770 /CHECK FOR 8 OR 9
1510 SZA CLA
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
1515 TAD NUM
1516 DCA WORD2
1517 RAL
1518 TAD WORD1
1519 DCA WORD1
1520 SZL /BEWARE OF OVERFLO
1521 ISZ NOFLO
1522 JMP NUMLUP /LOOP
1523 \fNODGT, TAD NSWTCH /WAS THERE A NUMBER
1524 SNA CLA
1525 ISZ NUMBER /NO, SKIP
1526 TAD WORD1
1527 AND [7770 /CHECK FOR MORE THAN 15 BITS
1528 SNA
1529 TAD NOFLO /OR GROSS OVERFLOW
1530 SNA CLA
1531 JMP I NUMBER /ALL GREEN
1532 JMS I [ERMSG
1533 1605 /*NE*
1534 JMP I NUMBER /RETURN
1535 NOFLO= LOOKUP /ZERO IF NO ERRORS
1536 NUM= FIND
1537 NUM1= EXTMP
1538 NUM2= EXTMP2
1539 NSWTCH, /ZERO IF NO DIGITS
1540 SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1
1541 TAD WORD2
1542 CLL RAL
1543 DCA WORD2
1544 TAD WORD1
1545 RAL
1546 DCA WORD1
1547 SZL /IF BIT SHIFTED FROM HI WORD,
1548 ISZ NOFLO /SET ERROR FLAG
1549 JMP I SHIFT
1550 PAGE
1551 \f/
1552 / BACK UP GETCHR POINTERS,
1553 / WE DON'T WANT THIS ONE
1554 /
1555 BACK1, 0
1556 CLA CMA /BACKUP COUNT
1557 TAD NCHARS
1558 DCA NCHARS
1559 CLA CMA /AND POINTER
1560 TAD CHRPTR
1561 DCA CHRPTR
1562 JMP I BACK1
1563 /
1564 / GET NEXT CHAR FROM LINE BUFFER
1565 / FOR ASSEMBLY PURPOSES ONLY
1566 / SKIP UNLESS END OF LINE (CR, ;, OR /)
1567 /
1568 GETCHR, 0
1569 JMS GETAC
1570 GETSKP, ISZ GETCHR /SKIP RETURN
1571 JMP I GETCHR
1572 BLANK, JMS GETAC /COME HERE IF BALNK OR TAB
1573 TAD (-257 /END OF LINE ON SLASH AFTER BLANK
1574 SNA CLA
1575 JMP GETCND
1576 JMS BACK1 /PUT IT BACK
1577 TAD [240 /AND RETURN A SINGLE BLANK
1578 JMP GETSKP /SKIP OUT
1579 SEMICL, ISZ SCSWT
1580 JMS BACK1 /PUT BACK SEMI COLON
1581 JMP I GETCHR
1582 GETAC, 0
1583 ISZ NCHARS /END OF LINE?
1584 JMP .+4 /NO, GET IT
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
1590 SZA
1591 TAD (240-211 /OR TAB
1592 SNA
1593 JMP BLANK /THEY GET SPECIAL HANDLING
1594 TAD (211-273 /LOOKOUT FOR SEMICOLON
1595 SNA
1596 JMP SEMICL /ALSO SPECIAL
1597 TAD (273-276 /IGNORE CLOSE ANGLE BRACKET
1598 SNA
1599 JMP GETAC+1 /GET ANOTHER
1600 TAD (276 /ELSE, RESTORE CHAR
1601 JMP I GETAC /AND PASS IT BACK
1602 \f/
1603 / COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3
1604 / NO SKIP ON RETURN IF NO SYMBOL
1605 /
1606 GETNAM, 0
1607 DCA NAME1 /CLEAR SYMBOL SPACE
1608 DCA NAME2
1609 DCA NAME3
1610 JMS LETTER /GET A LETTER
1611 JMP ISSYM
1612 JMS GETCHR /CHECK FOR #
1613 JMP I GETNAM /NOPE
1614 TAD (-"#
1615 SNA CLA
1616 JMP ISSYM
1617 JMS BACK1
1618 JMP I GETNAM
1619 ISSYM, DCA BUCKET
1620 ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE
1621 JMS GNC /FRIENDLY LOCAL SUBR
1622 JMS R6L
1623 DCA NAME1
1624 JMS GNC
1625 TAD NAME1
1626 DCA NAME1
1627 JMS GNC
1628 JMS R6L
1629 DCA NAME2
1630 JMS GNC
1631 TAD NAME2
1632 DCA NAME2
1633 JMS GNC
1634 JMS R6L
1635 DCA NAME3
1636 JMS GNC /AFTER 6, WE IGNORE
1637 SKP CLA
1638 GNC, 0
1639 JMS LETTER
1640 JMP I GNC /RETTURN LETTER
1641 JMS DIGIT
1642 JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER
1643 TAD (60
1644 JMP I GNC
1645 \f/
1646 / IF NEXT CHAR IS A LETTER, RETURN 6 BITS
1647 / IF NOT, REPLACE CHAR AND SKIP.
1648 /
1649 LETTER, 0
1650 JMS GETCHR
1651 JMP NLETR /NO LETTER, SKIP
1652 TAD (-333
1653 CLL CML
1654 TAD (33
1655 SZA SNL /DON'T ALLOW 300
1656 JMP I LETTER
1657 JMS BACK1
1658 NLETR, ISZ LETTER
1659 JMP I LETTER
1660 /
1661 / IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
1662 /
1663 DIGIT, 0
1664 JMS GETCHR
1665 JMP I DIGIT
1666 TAD (-272
1667 CLL
1668 TAD (12
1669 SNL
1670 JMP NDIGT
1671 ISZ DIGIT
1672 JMP I DIGIT
1673 NDIGT, JMS BACK1
1674 JMP I DIGIT
1675 /
1676 R6L, 0
1677 CLL RTL
1678 RTL
1679 RTL
1680 JMP I R6L
1681 /
1682 R6R, 0
1683 RTR
1684 RTR
1685 RTR
1686 AND [77
1687 JMP I R6R
1688 PAGE
1689 \f/
1690 / BUILD AN INSTRUCTION
1691 /
1692 FIXOPC, 0 /COMBINE OPCODE PARTS
1693 TAD XFLAG /CHECK INDEX SWITCH
1694 SNA CLA
1695 JMP ZRONDX /IF ZERO, NO INDEX REG
1696 CLA CMA
1697 TAD LASTOP /IF INDEX, CHECK FOR INCR
1698 SNA CLA
1699 TAD [100 /YES, PUT + BIT ON
1700 TAD OPCODE /COMBINE WITH OPCODE
1701 DCA OPCODE
1702 TAD EXPVAL+2 /GET INDEX REG. EXPR
1703 AND [7 /ONLY 3 BITS
1704 CLL RTL /SHIFT INTO POSITION
1705 RAL
1706 ZRONDX, TAD OPCODE /ADD OPCODE
1707 TAD (400 /TURN ON TYPE BIT
1708 DCA OPCODE /SAVE OPCODE
1709 JMP I FIXOPC /RETURN
1710 /
1711 OPR8RS,
1712 -253 /PLUS
1713 -255 /MINUS
1714 -252 /STAR (MULTIPLY) **
1715 -257 /SLASH (DIVIDE)
1716 -246 /AMPERSAND (AND)
1717 -240 /SPACE (OR)
1718 -241 /EXCLAMATION (OR)
1719 0 /END OF LIST
1720 \f/
1721 / FATAL ERRORS
1722 /
1723 ERMSG1, 0 /PASS 1 (FATAL) MESSAGES
1724 CDF
1725 TAD I ERMSG1 /GET CODE
1726 DCA .+3
1727 DCA PASSNO
1728 JMS ERMSG /DO THE MSG THING
1729 0
1730 IFZERO RALF <
1731 RETSYS, >
1732 TSF /FINISH TYPING
1733 JMP .-1
1734 JMP I [7600 /EXIT TO PS8
1735 /
1736 / GENERAL GARBAGE TYPE ERRORS
1737 /
1738 ERMSG, 0
1739 CDF FLD0 /FIX FIELD
1740 CLA /NO MESSAGE ON PASS 1
1741 TAD PASSNO
1742 SMA SZA /IF PASS 3, OUTPUT LEADING CRLF
1743 JMS I [CRLF
1744 SPA CLA
1745 JMP MSGDUN
1746 TAD (5555 /MINUSES
1747 JMS I [PRINT2
1748 TAD I ERMSG /2-CHAR CODE
1749 JMS I [PRINT2 /PRINT THE MESSAGE
1750 TAD (5555
1751 JMS I [PRINT2
1752 TAD PASSNO
1753 SZA CLA
1754 JMP .+4
1755 JMS I [PRINT2
1756 PLINE, JMS I (PRNTLN
1757 JMS I [CRLF
1758 ISZ ERRORS /BUMP COUNT
1759 MSGDUN, ISZ ERMSG
1760 JMP I ERMSG
1761 \f/
1762 / OUTPUT DECIMAL
1763 / SUPPRESS LEADING ZEROS
1764 / PRINT "NO" INSTEAD OF "0"
1765 /
1766 DECOUT, 0
1767 SNA /ZERO IS SPECIAL
1768 JMP DECNO /NO INSTEAD OF 0
1769 DCA OTEMP
1770 DCA OCNT
1771 JMS DEC2 /GET THOUSANDS
1772 -1750
1773 JMS DEC2 /HUNDREDS
1774 -144
1775 JMS DEC2 /TENS
1776 -12
1777 TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE)
1778 JMS PDIG /PRINT LAST DIGIT
1779 JMP I DECOUT /EASY, WHEN YOU KNOW HOW
1780 /
1781 DECNO, TAD (1617 /NO
1782 JMS I [PRINT2
1783 JMP I DECOUT
1784 /
1785 / LAZY MAN'S DIVISION
1786 /
1787 DEC2, 0
1788 CDF FLD0 /JUST TO MAKE SURE
1789 DEC3, CLA CLL
1790 TAD OTEMP
1791 SNA
1792 JMP DEC4
1793 TAD I DEC2 /SUBTRACT DIVISOR
1794 SNL /TOO MUCH?
1795 JMP DEC4 /YES, STOP NOW
1796 DCA OTEMP /NO, SAVE NEW REMAIN
1797 ISZ OCNT /BUMP QUOTIENT
1798 JMP DEC3 /DO IT AGAIN
1799 DEC4, CLA
1800 ISZ DEC2 /SKIP RETURN
1801 TAD OCNT /CHECK FOR SIGNIFICANCE
1802 SNA
1803 JMP I DEC2 /NONE
1804 JMS PDIG
1805 CLA STL RAR /FORCE SIGNIFICANCE
1806 DCA OCNT
1807 JMP I DEC2
1808 \f/
1809 TENTH, -111
1810 1463;1463;1463
1811 1463;1463;1463
1812 TEN, 1
1813 PDIG, 0
1814 TAD P260
1815 JMS I PC
1816 JMP I PDIG
1817 P260, 260
1818 5
1819 /
1820 / OCTAL CONVERSION, THE HARD WAY
1821 /
1822 OCTOUT, 0
1823 DCA OTEMP
1824 STL RAR /NO ZERO SUPPRESS
1825 DCA OCNT
1826 JMS DEC2
1827 -1000
1828 JMS DEC2
1829 -100
1830 JMS DEC2
1831 -10
1832 TAD OTEMP
1833 JMS PDIG
1834 JMP I OCTOUT
1835 PAGE
1836 \f/
1837 / OUTPUT ONE WORD
1838 /
1839 IFNZRO RALF <
1840 /
1841 / TEXT TYPE CODES:
1842 TTABS= 0400
1843 TTORG= 1000
1844 TTREL= 1400
1845 /
1846 OUTREL, DCA WRD /HOLD FIRST WORD
1847 DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR
1848 TAD FPPADR /GET ESD CODE
1849 RTR
1850 RTR /RIGHT IN AC
1851 AND [177 /STRIP TO ESD ONLY
1852 SNA /CHECK FOR ABSOLUTE
1853 JMP PUTABS
1854 DCA FPPADR /SAVE ESD
1855 TAD PASSNO /CHECK FOR PASS 2
1856 SZA CLA
1857 JMP PRNTRL /IF NOT, TREAT NORMALLY
1858 DCA ABSOP
1859 CLA STL RTL
1860 JMS I (FULCHK /ENSURE 3 WORDS LEFT
1861 TAD FPPADR /GET ESD AGAIN
1862 TAD (TTREL /INSERT CONTROL CODE
1863 DCA I OUTPTR
1864 TAD WRD /FIRST DATUM
1865 DCA I OUTPTR
1866 TAD FPPADR+1
1867 DCA I OUTPTR
1868 JMS I (FULCHK /IS IT FULL?
1869 JMS BMPLOC /TWO WORDS OUT
1870 JMS BMPLOC /SO LOCCTR +2
1871 JMP I [NEXTST
1872 PUTABS, ISZ ABREFS /COUNT IT
1873 ISZ LINKSW /SET FLAG
1874 PRNTRL, TAD WRD /GET FIRST WORD
1875 JMS OUTWRD
1876 TAD FPPADR+1
1877 JMS OUTWRD
1878 JMP I [NEXTST >
1879 \f/
1880 OUTWRD, 0 /OUTPUT ROUTINE
1881 DCA WRD /SAVE WORD
1882 IFZERO RALF <
1883 TAD LOCTR2 /GET LOW 12 BITS OF LOCATION
1884 JMS I [R6L
1885 AND [37 /GET PAGE NUMBER (WITHIN FIELD)
1886 DCA OTEMP /SAVE PAGE NUMBER
1887 TAD OTEMP
1888 SZA CLA /POINTER TO LITERAL POINTER
1889 IAC
1890 TAD [P0LIT
1891 DCA OWTEMP
1892 TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT
1893 AND [177
1894 CIA /COMPARE WITH LITERAL BOUNDARY
1895 TAD I OWTEMP
1896 SMA CLA
1897 JMP .+3 /NO PAGE OVER FLOW
1898 JMS I [ERMSG
1899 2017 /*PO*>
1900 TAD PASSNO /CHECK PASS
1901 SZA
1902 JMP PRNTST /ITS NOT PASS 2
1903 IFZERO RALF <
1904 TAD WRD /NOW OUTPUT WORD
1905 JMS I [R6R
1906 JMS OOCHAR
1907 TAD WRD
1908 AND [77
1909 JMS OOCHAR >
1910 IFNZRO RALF <
1911 TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT
1912 SZA CLA
1913 JMP INABS /NO PROBLEM
1914 CLA IAC
1915 JMS I (FULCHK
1916 TAD (TTABS /SET ABS CONTROL CODE
1917 DCA I OUTPTR
1918 TAD OUTPTR /SAVE POINTER FOR FUTRUE REF
1919 DCA ABSOP
1920 INABS, ISZ I ABSOP /BUMP COUNT
1921 TAD WRD
1922 DCA I OUTPTR
1923 JMS I (FULCHK /GOOD!>
1924 \fPRNTST, SMA SZA CLA
1925 TAD LISTSW /IS LIST ON ?
1926 SNA CLA
1927 JMP ENDOUT /NO, DONT PRINT
1928 JMS I [CRLF /NEW LINE
1929 TAD LOCTR1 /PRINT LOCATION COUNTER
1930 AND [7
1931 JMS I (PDIG
1932 TAD LOCTR2 /NEXT FOUR DIGITS
1933 JMS I [OCTOUT
1934 TAD [240
1935 JMS I PC
1936 TAD WRD /NOW WORD
1937 JMS I [OCTOUT
1938 TAD LINKSW /LINK GENERATED ON THIS LINE?
1939 SZA CLA
1940 TAD (4700 /IF SO, GIVE APOSTROPHE SPACE
1941 JMS I [PRINT2
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
1946 /
1947 WRD,
1948 BMPLOC, 0
1949 ISZ LOCTR2 /BUMP LOW ORDER
1950 JMP I BMPLOC
1951 CLA IAC
1952 TAD LOCTR1
1953 AND (7767 /STOP CARRY INTO BIT 8
1954 DCA LOCTR1
1955 JMP I BMPLOC
1956 \f IFZERO RALF <
1957 /
1958 / PUNCH CONTROL
1959 /
1960 NOPNCX, CLA IAC
1961 ENPNCX, DCA PNCHOF
1962 JMP I [NEXTST
1963 /
1964 / OUTPUT AN ORIGIN
1965 /
1966 PUTORG, 0
1967 TAD PASSNO /CHECK FOR PASS 2
1968 SZA CLA
1969 JMP I PUTORG /ELSE FORGET IT
1970 TAD LOCTR2 /OUTPUT FIRST CHAR
1971 JMS I [R6R
1972 TAD [100
1973 JMS OOCHAR /OUTPUT CHAR
1974 TAD LOCTR2 /NOW LOWER HALF OF ORIGIN
1975 AND [77
1976 JMS OOCHAR
1977 JMP I PUTORG
1978 OWTEMP,
1979 CHAROO, 0
1980 OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM
1981 DCA CHAROO
1982 TAD PNCHOF /PUNCHING?
1983 SZA CLA
1984 JMP I OOCHAR /NOPE
1985 TAD CHAROO
1986 TAD CHKSUM
1987 DCA CHKSUM
1988 TAD CHAROO
1989 JMS I [OCHAR
1990 JMP I OOCHAR >
1991 \f/
1992 / BEGIN NEXT PASS
1993 / WITH APPROPRIATE THINGS RESET
1994 / TO DEFAULT VALUES
1995 /
1996 RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE
1997 TAD USR /EITHER 200 OR 7700
1998 SPA CLA /IS USR IN CORE?
1999 JMP .+6 /NO
2000 CIF 10 /YES, DISMISS IT
2001 JMS I USR
2002 11 /USROUT
2003 TAD [7700
2004 DCA USR /ITS GONE
2005 IFNZRO RALF <
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
2013 CLA IAC
2014 DCA LPAGE1
2015 DCA LPAGE2
2016 CLA CMA
2017 DCA LINPAG
2018 IFZERO RALF <
2019 TAD [177
2020 DCA P0LIT /RESET LITERAL BUFFER POINTERS
2021 TAD [177
2022 DCA CPLIT
2023 TAD [200 >
2024 DCA LOCTR2 /LOCATION COUNTER
2025 IFNZRO RALF <
2026 TAD (20 >
2027 DCA LOCTR1
2028 CLL CML RAR /4000
2029 DCA BASER /SET BASE BEYOND BELIEF
2030 DCA INDXR
2031 DCA INDXR+1
2032 DCA RADIX /RESET DEFAULT OCTAL
2033 DCA ERRORS /ZERO ERROR COUNT
2034 DCA LINKS
2035 ISZ PASSNO /BUMP PASS NUMBER
2036 JMP I (NEWLIN
2037 JMP I (NEWLIN /DO NEXT PASS
2038 PAGE
2039 \f/
2040 / END OF A PASS
2041 /
2042 ENDX, IFZERO RALF <
2043 DCA PNCHOF /RE-ENABLE PUNCH>
2044 IFNZRO RALF <
2045 JMS I (BORG /SET MAX LEN OF CURRENT SECT>
2046 TAD PASSNO
2047 SMA CLA /WHAT PASS WAS THIS?
2048 JMP EOP2 /NOT THE FIRST
2049 IFNZRO RALF <
2050 TAD (INBUF-400
2051 DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD>
2052 TAD BFILE
2053 SNA CLA
2054 JMP START3 /NO BINARY, START PASS 3
2055 IFZERO RALF <
2056 TAD [200 /START BIN OUT WITH L/T
2057 JMS I [OCHAR
2058 JMP I (RESET >
2059 IFNZRO RALF <
2060 JMP I (DMPESD /OUTPUT EXT SYM TABLE>
2061 /
2062 EOP2, IFZERO RALF <
2063 CLA IAC /DUMP CURRENT PAGE LITERALS
2064 JMS I (DMPLIT
2065 JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS>
2066 TAD PASSNO
2067 SMA SZA CLA
2068 JMP EOP3 /YES, PRINT SYMBOL TABLE
2069 IFZERO RALF <
2070 TAD CHKSUM /OUTPUT CHECKSUM
2071 JMS I [R6R
2072 JMS I [OCHAR
2073 TAD CHKSUM
2074 AND [77
2075 JMS I [OCHAR /LOWER HALF
2076 TAD [200 /TRAILER CHAR
2077 JMS I [OCHAR >
2078 IFNZRO RALF <
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
2083 IFZERO RALF <
2084 JMP NOP3 /NO LISTING, GIVE INFO ON TTY>
2085 IFNZRO RALF <
2086 JMP I (RETSYS >
2087 TAD [OCHAR /CHANGE PRINT ROUTINE
2088 DCA PC
2089 JMP I (RESET /NO,RESET EVERYTHING
2090 \f/
2091 / END OF LAST PASS
2092 / GIVE SOME STATISTICS
2093 /
2094 EOP3, CLA CMA
2095 DCA LINPAG
2096 JMS I [CRLF
2097 NOP3, JMS I (7607 /READ IN OVERLAY
2098 0100
2099 OVERLY, OVBUFR
2100 40 /USE SYS SCRATCH BLK
2101 JMP I (7605
2102 JMP I OVERLY
2103
2104 CHCKMR, 0
2105 TAD OPCODE /BE SURE ALL REFS ARE
2106 AND [200 /ARE ON SAME PG
2107 SZA CLA
2108 TAD LOCTR2
2109 AND [7600
2110 CIA
2111 TAD EXPVAL+2
2112 AND [7600
2113 SZA CLA
2114 ADRERR, JMS I [ERMSG
2115 0201 /**BA**
2116 TAD EXPVAL+2
2117 AND [177
2118 TAD OPCODE
2119 JMS I [OUTWRD
2120 JMP I [NEXTST
2121
2122 IOERR, TAD INOP /REMOVE JMS PRNTLN
2123 DCA PLINE
2124 JMS I [ERMSG1
2125 1117 /**IO**
2126 INOP, NOP
2127
2128 PAGE
2129 \f IFZERO RALF <
2130 / ORG THINGS FOR ABSOLUTE ASSEMBLIES
2131 /
2132 TRYSTR, JMS I [GETCHR
2133 JMP I [NEXTST /WHAT CAN YOU DO?
2134 TAD (-252 /IS IT AN ORG
2135 SZA CLA
2136 JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE
2137 ORGX, JMS I (ADRGET
2138 TAD LOCTR1 /CHECK FOR NEW FIELD
2139 CIA
2140 TAD EXPVAL+1
2141 SNA CLA
2142 JMP SAMFLD /NOT A DIFFERENT FIELD
2143 CLA IAC
2144 JMS DMPLIT /DUMP CURRENT PAGE LITERALS
2145 JMS DMPLIT /DUMP PAGE 0 LITERALS
2146 TAD EXPVAL+1
2147 AND [7
2148 DCA LOCTR1
2149 TAD PNCHOF /PUNCHING ENABLED?
2150 SNA
2151 TAD PASSNO /PASS 2?
2152 SZA CLA
2153 JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD
2154 TAD LOCTR1 /NEW FIELD BITS
2155 RTL CLL
2156 RAL
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
2160 SAMFLD, TAD LOCTR2
2161 AND [7600 /CHECK FOR SAME PAGE
2162 DCA LTEMP
2163 TAD EXPVAL+2
2164 AND [7600
2165 CIA
2166 TAD LTEMP
2167 SNA CLA
2168 JMP SAMPAG /PAGE IS THE SAME
2169 CLA IAC
2170 JMS DMPLIT /DUMP CURRENT PAGE LITERALS
2171 SAMPAG, TAD EXPVAL+2
2172 DCA LOCTR2
2173 JMS I (PUTORG
2174 JMP I [NEXTST /DONE
2175 PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE
2176 CLL
2177 TAD [177
2178 AND [7600
2179 DCA EXPVAL+2
2180 RAL
2181 TAD LOCTR1
2182 DCA EXPVAL+1
2183 JMP ORGX+1 /DO ORG THINGS
2184 \fDMPLIT, 0
2185 DCA PAGEN /SAVE PAGE INDICATOR
2186 TAD OUTSWT /SAVE OUTPUT SWITCH
2187 DCA SWTOUT
2188 ISZ OUTSWT /DONT PRINT LINE WITH LITERALS
2189 TAD PAGEN
2190 TAD [P0LIT /GET BOUNDARY POINTER
2191 DCA LTEMP
2192 TAD PAGEN /WHICH LITERAL BUFFER ?
2193 SNA CLA
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
2198 TAD PAGEN
2199 SZA CLA
2200 TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS
2201 AND [7600
2202 TAD I LTEMP /PLUS LOWER SEVEN
2203 IAC /PLUS ONE
2204 DCA LOCTR2 /GIVES LOCATION COUNTER
2205 TAD LOCTR2
2206 AND [177 /ANYTHING TO DUMP?
2207 SNA CLA
2208 JMP DMPFIN /NO
2209 TAD PASSNO
2210 SMA SZA CLA
2211 JMS I [CRLF /ONLY IF PASS 3
2212 JMS I (PUTORG
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
2217 TAD X10 /DONE?
2218 IAC
2219 AND [77
2220 SZA CLA
2221 JMP LITLUP /LOOP
2222 DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH
2223 DCA OUTSWT
2224 JMP I DMPLIT /ALL DONE
2225 SWTOUT, 0 >
2226 \fEXPON, TAD LASTOP
2227 DCA TMP
2228 DCA LASTOP
2229 JMS I (GETSGN /GET SIGN OF EXPONENT
2230 TAD RADIX
2231 DCA OTEMP
2232 ISZ RADIX /SET RADIX TO DECIMAL
2233 JMS I (NUMBER /GET EXPONENT
2234 NOP
2235 TAD OTEMP
2236 DCA RADIX /RESTORE RADIX
2237 TAD TMP
2238 CLL RAR
2239 TAD LASTOP
2240 RAR /LASTOP TO LINK,
2241 DCA LASTOP /TMP TO SIGN OF LASTOP
2242 TAD WORD2
2243 SZL
2244 CIA /PUT SIGN ON EXP
2245 JMP I (OVER
2246 TMP, 0
2247 IFZERO RALF < PAGE / >
2248 \f IFNZRO RALF <
2249 /
2250 / IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
2251 /
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
2255 CDF 10
2256 TAD (7604 /POINT TO 2ND OUT FILE THING
2257 DCA X11
2258 TAD (7611 /POINTER TO 3RD
2259 DCA X10
2260 TAD (-5 /LENGTH OF SUCH THINGS
2261 DCA LTEMP
2262 TAD I X10 /MOVE 3RD TO 2ND
2263 DCA I X11 /FOR LOADER MAP FILE
2264 ISZ LTEMP
2265 JMP .-3
2266 TAD I [7600 /WAS THERE A FIRST OUT FILE
2267 AND NP17 /(BINARY OUT)*
2268 DCA LTEMP
2269 TAD OUTBLK /GET FILE LENGTH
2270 AND (377
2271 CLL RTL
2272 RTL
2273 CIA
2274 TAD LTEMP /COMBINE UNIT AND LEN
2275 DCA I X10 /FOR FIRST INPUT FILE TO LOADER
2276 TAD PASBLK /STARTING BLOCK
2277 DCA I X10
2278 DCA I X10 /THAT'S THE END OF INPUT
2279 CDF 0
2280 TAD ERRORS /IF NO ERRORS
2281 SNA CLA
2282 ISZ CHNSW /SHOULD WE CHAIN?
2283 JMP I (7605 /NO!!!
2284 ISZ I (7746 /**
2285 CIF 10
2286 JMS I USR
2287 6 /CHAIN
2288 LDRBLK, 0 /FIRST BLOCK OF LOADER
2289 /
2290 PASBLK, 0 /FIRST BLOCK OF FILE PASSED
2291 CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
2292 \f/
2293 / OUTPUT A BLOCK OF BINARY
2294 /
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
2299 TAD MOUBUF
2300 DCA OUTPTR /RESET BUFFER POINTER
2301 DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL
2302 JMP I OUTBLK
2303 MOUBUF, OUBUF-1
2304 /
2305 TYPCOD, 2500 /UNDEFINED
2306 0000 /ADDRESS
2307 3000 /XTERNAL
2308 0300 /COMMON
2309 2300 /SECTION
2310 -1 /?
2311 -1 /?
2312 7000 /8-M0DE SECTION
2313 3200 /8-MODE PAGE0 COMMON SECTION
2314 0600 /8-MODE FIELD1 SECTION
2315 \fBORG, 0
2316 CDF FLD0
2317 TAD LOCTR1
2318 RTR
2319 RTR
2320 AND [177
2321 TAD (ESDBUF-1 /POINT INTO ESD TABLE
2322 DCA LTEMP
2323 TAD I LTEMP
2324 TAD (4 /ADDRESS VALUE
2325 DCA LTEMP
2326 CDF FLD1
2327 TAD LOCTR1
2328 AND [7 /GET ADDR BITS ONLY
2329 DCA BOTMP /SAVE EM
2330 TAD I LTEMP /OLD HIGH VALUE BITS
2331 AND [7
2332 CIA
2333 TAD BOTMP /COMPARE THEM
2334 SPA
2335 JMP BOXIT /NO UPDATE REQUIRED
2336 SNA CLA
2337 JMP BOCHKL /NO DIFFERENCE YET
2338 TAD LOCTR1
2339 DCA I LTEMP /RESET TO NEW HIGH
2340 ISZ LTEMP
2341 JMP BOSETL /SKIP OVER TEST
2342 BOCHKL, ISZ LTEMP /POINT TO LO-ORDER
2343 TAD I LTEMP
2344 CIA CLL
2345 TAD LOCTR2 /COMPARE LOW ORDERS
2346 SNL CLA
2347 JMP BOXIT /NO REPLACE
2348 BOSETL, TAD LOCTR2
2349 DCA I LTEMP
2350 BOXIT, CLA
2351 CDF FLD0
2352 JMP I BORG /WHEW!
2353 BOTMP= EXTMP
2354 PAGE
2355 \fNEWESD, 0
2356 TAD ESDNO
2357 TAD (-177 /CHECK LIMIT
2358 SPA CLA
2359 JMP .+3
2360 JMS I [ERMSG1 /TOO MANY
2361 3023 /*XS*
2362 ISZ ESDNO /BUMP COUNT
2363 TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1
2364 SMA CLA
2365 JMP I NEWESD
2366 TAD ESDNO
2367 TAD (ESDBUF-1 /INDEX BUFFER
2368 DCA ESDTMP
2369 CDF FLD1
2370 TAD I OLDN3 /GET POINTER TO THIS SYMBOL
2371 CDF FLD0
2372 DCA I ESDTMP
2373 TAD ESDTMP
2374 TAD [200
2375 DCA ESDTMP /NOW ADDRESS CHAR TABLE
2376 TAD BUCKET
2377 DCA I ESDTMP
2378 JMP I NEWESD
2379 ESDTMP= EXTMP
2380 /
2381 / RELOCATION CONTROL PSEUDO-OPS
2382 /
2383 ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT
2384 JMP ESDERR
2385 JMS I [LOOKUP /FIND IT
2386 JMP QENT /UNDEFINED
2387 CLL RAR /MUST BE USER ADDR TYPE
2388 SNA CLA
2389 TAD I X10 /LOOK AT ESD
2390 AND [7770
2391 SZA CLA /IS IT RELOCATABLE?
2392 JMP OKENT /YES
2393 QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1
2394 1105 /*IE*
2395 OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT
2396 JMP I [NEXTST
2397 \f/
2398 EXTRNX, CLA STL RTL
2399 DCA STYPE /EXTERNS ARE TYPE 2
2400 JMS I [GETNAM
2401 JMP ESDERR
2402 JMS I [LOOKUP
2403 JMS CRESD /IF UNDEFINED, DEFINE IT
2404 CLL RTR /IF DEFINED, CHECK LEGALITY
2405 SZA CLA
2406 ESDERR, JMS I [ERMSG
2407 0523 /*ES*
2408 JMP I [NEXTST
2409 /
2410 CLA IAC /FIELD1 SECT=11
2411 IAC /COMMZ SECT=10
2412 SECT8X, TAD [7
2413 JMP COMMX+1
2414 SECTX, CLA IAC
2415 COMMX, TAD (COMMN /GET DESIRED CODE
2416 DCA STYPE /FOR SECTION TYPE
2417 JMS I [GETNAM
2418 DCA BUCKET /IF NO NAME, BLANK COMMON
2419 JMS I [LOOKUP
2420 JMP NEWSCT /UNDEFINED
2421 CIA /OLD FRIEND
2422 TAD STYPE /SAME?
2423 SNA CLA
2424 JMP SETSCT /YUP, DO IT
2425 JMP ESDERR
2426 /
2427 CRESD, 0
2428 JMS NEWESD /CREATE NEW ESD ENTRY
2429 CDF FLD1
2430 TAD I LTEMP /SET TYPE CODE
2431 AND [7700
2432 TAD STYPE
2433 DCA I LTEMP
2434 ISZ LTEMP
2435 TAD ESDNO
2436 CLL RTL /ESD NO TO SYMBOL VLAUE
2437 RTL
2438 DCA I LTEMP
2439 CDF FLD0
2440 JMP I CRESD
2441 /
2442 NEWSCT, JMS CRESD /CREATE AN ESD
2443 SETSCT, JMS I (BORG /ADJUST LOC CTR'S
2444 CDF FLD1
2445 TAD I X10 /GET NEW LOC CTR VALUE
2446 DCA LOCTR1
2447 TAD I X10
2448 DCA LOCTR2 /LOW LOC CTR
2449 CDF FLD0
2450 JMP PUTORG
2451 \f/
2452 ORGX, JMS I (ADRGET /GET ORG EXPR
2453 JMS I (BORG
2454 TAD EXPVAL+1
2455 AND [7770 /DOES IT HAVE AN ESD?
2456 SNA CLA
2457 TAD LOCTR1 /IF NOT, KEEP CURRENT ESD
2458 AND [7770
2459 TAD EXPVAL+1
2460 DCA LOCTR1 /RESET PC
2461 TAD EXPVAL+2
2462 DCA LOCTR2
2463 PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY
2464 SZA CLA
2465 JMP I [NEXTST
2466 DCA ABSOP /CLEAR ABS OUTPUT SW
2467 CLA STL RTL
2468 JMS I (FULCHK /ROOM FOR MORE?
2469 TAD LOCTR1
2470 RTR
2471 RTR /GET ESD
2472 AND [177
2473 TAD (TTORG
2474 DCA I OUTPTR
2475 TAD LOCTR1
2476 AND [7 /FIELD BITS
2477 DCA I OUTPTR
2478 TAD LOCTR2 /ADDRESS
2479 DCA I OUTPTR
2480 JMS I (FULCHK
2481 JMP I [NEXTST
2482 PAGE />
2483 \f/
2484 / VARIOUS PSEUDO-OP HANDLERS
2485 /
2486 LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY
2487 LSTOFX, DCA LISTSW
2488 JMP I [NEXTST
2489 /
2490 DECX, CLA IAC
2491 OCTALX, DCA RADIX
2492 JMP I [NEXTST
2493 /
2494 TEXTX, JMS I [GETCHR /GET DELIMITER
2495 JMP I [NEXTST /NULL STMT
2496 CIA
2497 DCA EXTMP /SAVE - DELIM
2498 LOOP6B, JMS GETCHT /GET HIG ORDER CHAR
2499 JMP I [NEXTST
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
2506 JMP LOOP6B /LOOP
2507 OUTTXT, TAD LTEMP /PUT OUT HALF WORD
2508 JMS I [OUTWRD /OR ZERO WORD
2509 JMP I [NEXTST
2510 GETCHT, 0 /GET CHAR FOR TEXT STMT
2511 ISZ NCHARS /BUMP COUNT
2512 SKP
2513 JMP I GETCHT /END OF TEXT
2514 TAD I CHRPTR /GET CHAR
2515 DCA BUCKET /SAVE IT
2516 TAD BUCKET /IS IT THE DELIM ?
2517 TAD EXTMP
2518 SNA CLA
2519 JMP I GETCHT /YES, RETURN NO SKIP
2520 ISZ GETCHT /BUMP RETURN
2521 TAD BUCKET /GET CHAR
2522 AND [77 /LOW 6 BITS
2523 JMP I GETCHT /RETURN
2524 \f/
2525 / CONDITIONAL ASSEMBLY HANDLERS
2526 /
2527 IFNZRX, CLA CMA
2528 IFZROX, JMS GETCON /GET CONDITION EXPR
2529 TAD EXPVAL+1 /HIGH ORDER
2530 AND [7
2531 SNA
2532 TAD EXPVAL+2 /LOW ORDER
2533 SWTCH, SNA CLA
2534 JMP TRUE /PRESENT CONDITION OF ASMOF IS OK
2535 FALSE, TAD ASMOF /GOTTA REVERSE IT
2536 CMA
2537 DCA ASMOF /THAT DOES IT
2538 TRUE, CDF FLD0
2539 JMS I [GETCHR
2540 JMP BADCND /FORGOT THE ANGLE
2541 TAD [-240 /IGNORE BLANK, IF ANY
2542 SNA
2543 JMP TRUE /TRY AGAIN
2544 TAD (240-274
2545 SNA CLA
2546 JMP I (ASMBL /GO FROM HERE
2547 JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT
2548 JMP BADCND
2549 /
2550 GETCON, 0
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
2555 1103 /*IC*
2556 DCA ASMOF /ENABLE ASSEMBLY
2557 JMP I (ASMBL
2558 OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST?
2559 SNA CLA
2560 JMP I GETCON /YES
2561 JMP BADCND
2562 /
2563 IFNEGX, CLA CMA
2564 IFPOSX, JMS GETCON
2565 CLA CLL IAC RTL /4
2566 AND EXPVAL+1 /SIGN OF EXPR
2567 JMP SWTCH /GO FROM THERE
2568 /
2569 IFNDFX, CLA CMA
2570 IFREFX, DCA ASMOF
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
2577 JMP TRUE
2578 \fIFSWX, CLA CMA
2579 IFNSWX, DCA ASMOF
2580 TAD (7642 /ADDRESS OF OPTION WORDS
2581 DCA WORD2 /A TEMP
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?
2589 SMA SZA
2590 JMP .-3 /NO, POINT TO NEXT
2591 CIA
2592 CMA STL /BIT COUNT AWAY FROM LINK
2593 DCA WORD1
2594 RAL /SHIFT
2595 ISZ WORD1 /COUNT
2596 JMP .-2
2597 CDF 10 /OPTIONS FIELD
2598 AND I WORD2 /GET SELECTED BIT
2599 JMP SWTCH /AND TEST IT
2600 /
2601 ZBLKX, JMS I (ADRGET /EVALUATE EXPR
2602 TAD EXPVAL+2
2603 CIA
2604 DCA ZBCNT /HOLD COUNT
2605 TAD LISTSW /SAVE LISTSWITCH
2606 DCA ZBTMP
2607 JMS I [OUTWRD /PUT A WORD
2608 DCA LISTSW /NO LIST AFTER FIRST
2609 ISZ ZBCNT /COUNT THEM
2610 JMP .-3 /MORE
2611 TAD ZBTMP /RESTORE
2612 DCA LISTSW /LISTING
2613 JMP I [NEXTST
2614 ZBCNT= EXTMP
2615 ZBTMP= EXTMP2
2616 PAGE
2617 \f PTP=20
2618 DCB=7760
2619 INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
2620 OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
2621 IN7400, 7400
2622 NINCTL, INCTL+1
2623 NINREC, INRECS
2624 IOPEN, 0
2625 TAD (7617
2626 DCA INFPTR /RESET FILE POINTER
2627 JMS INNEWF /FETCH NEW HNDLR, ETC
2628 /WHILE USR IS STILL IN CORE
2629 CLA CMA
2630 DCA INCHCT /FORCE A READ ON NEXT CHAR
2631 JMP I IOPEN
2632 ICHAR, 0
2633 IN7600, 7600
2634 INCHAR, CDF INFLD
2635 ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
2636 ISZ INCHCT
2637 INJMPP, JMP INJMP
2638 TAD INEOF
2639 SZA CLA /DID LAST READ GIVE EOF ?
2640 GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
2641 TAD INCTR
2642 CLL
2643 TAD NINREC
2644 SNL
2645 DCA INCTR /RESTORE INCR IF NOT OVERFLOWED
2646 SZL /IS THIS THE LAST READ?
2647 ISZ INEOF /YES - SET END-OF-FILE FLAG
2648 CLL CML CMA RTR /MAKE CONTROL WORD
2649 RTR /FROM THE AMOUNT OF THE OVERFLOW
2650 RTR /(IF ANY) AND THE STANDARD CNTRL WD
2651 TAD NINCTL
2652 DCA INCTLW
2653 CDF
2654 JMS I INHNDL /CALL THE DEVICE HANDLER
2655 INCTLW, 0
2656 INBUFP, INBUF
2657 INREC, 0
2658 JMP INERRX /SOME KIND OF HANDLER ERROR
2659 INBREC, TAD INREC
2660 TAD NINREC
2661 DCA INREC /UPDATE THE RECORD NUMBER
2662 TAD INCTLW
2663 AND IN7600
2664 CLL RAL
2665 TAD INCTLW
2666 AND IN7600
2667 CMA
2668 DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
2669 TAD INJMPP
2670 DCA INJMP /RESET THE CHARACTER SWITCH
2671 TAD INBUFP
2672 DCA INPTR /AND THE WORD POINTER
2673 JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED
2674 INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
2675 SMA CLA /WHICH TYPE WAS IT ?
2676 JMP INBREC /END OF FILE - RESUME PROCESSING
2677 JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE
2678 INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH
2679 JMP ICHAR1
2680 JMP ICHAR2
2681 TAD INJMPP
2682 DCA INJMP
2683 TAD I INPTR
2684 AND IN7400
2685 CLL RTR
2686 RTR /COMBINE HIGH-ORDER FOUR BITS OF
2687 TAD INCTLW
2688 RTR /THE 2 WORD TO FORM THE 3RD CHAR
2689 RTR
2690 ISZ INPTR
2691 JMP INCOMN
2692 ICHAR2, TAD I INPTR
2693 AND IN7400
2694 DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD
2695 ISZ INPTR /BUMP THE WORD POINTER
2696 ICHAR1, TAD I INPTR
2697 INCOMN, AND (377
2698 TAD (-232
2699 SNA /IS THE CHARACTER A ^Z?
2700 JMP GETNEW /YES - GET A NEW FILE
2701 TAD (232 /RESTORE THE CHARACTER
2702 CDF
2703 JMP I ICHAR /AND RETURN
2704 INFPTR, 7617
2705 INEOF, 1 /PARAMETERS ARE SET UP SO THAT
2706 INCHCT, /IOPEN IS UNNECESSARY.
2707 INNEWF, -1
2708 TAD NINDEV
2709 DCA INHNDL /INITIALIZE HANDLER ADDRESS
2710 CDF 10
2711 TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
2712 CDF
2713 SNA /ANY MORE?
2714 JMP I (ENDX /NO MORE INPUT
2715 CIF 10
2716 JMS I USR
2717 1 /ASSIGN, FETCH HANDLER
2718 INHNDL, 0
2719 JMP I [IOERR /HUH?
2720 CDF 10
2721 TAD I INFPTR
2722 AND (7760 /GET LENGTH PART OF WORD
2723 SZA /LENGTH OF 0 MEANS LENGTH GE 256
2724 TAD [17 /ADD HIGH ORDER BITS
2725 CLL CML RTR
2726 RTR
2727 DCA INCTR /STORE LENGTH OF FILE
2728 ISZ INFPTR
2729 TAD I INFPTR
2730 CDF
2731 DCA INREC /STARTING RECORD NUMBER OF FILE
2732 ISZ INFPTR
2733 DCA INEOF /ZERO END-OF-FILE FLAG
2734 JMP I INNEWF
2735 INCTR, 0
2736 INPTR, 0
2737 OUFNAM, 0;0;0;0 /OUTPUT FILE NAME
2738 NINDEV, INDEVH
2739 PAGE
2740 \fOOPEN, 0
2741 TAD OUFILE /INCR OUTPUT FILE POINTER
2742 TAD (5
2743 DCA OUFILE
2744 CDF 10
2745 TAD I OUFILE /GET DEVICE CODE, LEN
2746 DCA OUELEN /HOLD IT A MO
2747 JMS I (OFNAME /GET FILE NAME INTO FIELD 0
2748 TAD OUELEN /CHECK FOR NULL FILE
2749 SNA CLA
2750 JMP ONOFIL /INHIBIT OUTPUT
2751 JMS GETUSR /LOAD USR IF NOT ALREADY IN
2752 TAD OUNAME /RESET ENTER CALL
2753 DCA OUBLK
2754 TAD NOUDEV
2755 DCA OUHNDL
2756 TAD OUELEN /THE UNIT
2757 CIF 10
2758 JMS I USR
2759 1 /ASSIGN, FETCH HANDLER
2760 OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
2761 JMP I [IOERR /HUH?
2762 TAD OUELEN /UNIT AGAIN
2763 CIF 10
2764 JMS I USR
2765 3 /ENTER OUTPUT FILE
2766 OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
2767 OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
2768 JMP I [IOERR /YOU BLEW IT!!!
2769 DCA OUCCNT
2770 DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
2771 JMS I (OUSETP
2772 ISZ OOPEN
2773 JMP I OOPEN
2774 ONOFIL, ISZ I (OUTINH
2775 JMP I OOPEN
2776 OUTDMP, 0
2777 DCA OUCTLW /STORE THE CONTROL WORD
2778 TAD OUCCNT
2779 SNA
2780 ISZ OUCTLW
2781 TAD OUBLK
2782 DCA OUREC /COMPUTE STARTING BLOCK
2783 TAD OUCTLW
2784 JMS I [R6L
2785 AND [17 /COMPUTE THE NUMBER OF RECORDS
2786 TAD OUCCNT /UPDATE SIZE OF FILE
2787 DCA OUCCNT
2788 TAD OUCCNT
2789 CLL CML
2790 TAD OUELEN
2791 SNL SZA CLA /EXCEED GIVEN LENGTH ?
2792 JMP I [IOERR /YES - ERROR
2793 CDF
2794 JMS I OUHNDL
2795 OUCTLW, 0
2796 LOUBUF, OUBUF
2797 OUREC, 0
2798 JMP I [IOERR
2799 JMP I OUTDMP
2800 OCLOSE, 0
2801 JMS GETUSR /ENSURE USR IN CORE
2802 IFNZRO RALF <
2803 TAD PASSNO
2804 SZA CLA
2805 JMP .+6
2806 TAD (377
2807 JMS I (FULCHK /DUMP LAST BLOCK
2808 TAD OUCCNT /SAVE FILE LENGTH
2809 DCA I (OUTBLK /FOR CHAIN
2810 JMP NODUMP >
2811 JMS I (OTYPE
2812 AND (770
2813 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
2814 SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
2815 TAD (232 /OUTPUT A ^Z
2816 JMS I [OCHAR
2817 FILLLP, JMS I [OCHAR
2818 JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
2819 SPA CLA
2820 TAD [100
2821 TAD [77
2822 AND I (OUDWCT
2823 SZA CLA /UP TO THE BOUNDARY YET?
2824 JMP FILLLP /NO - FILL WITH ZEROS
2825 TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
2826 TAD (OUCTL&3700
2827 SNA /A FULL WRITE LEFT?
2828 JMP NODUMP /YES DON'T DO IT
2829 TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS
2830 JMS OUTDMP
2831 NODUMP, CIF CDF 10
2832 TAD I OUFILE
2833 CDF
2834 JMS I USR
2835 4 /CLOSE THE OUTPUT FILE
2836 OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
2837 OUCCNT, 0
2838 JMP I [IOERR /ERROR WHILE CLOSING - BAD!!
2839 JMP I OCLOSE /ALL DONE
2840 NOUDEV, OUDEVH
2841 \f/
2842 / LOAD USR IF NOT IN CORE ALREADY
2843 /
2844 GETUSR, 0
2845 TAD USR /CURRENT CALL ADDR
2846 SMA CLA
2847 JMP I GETUSR /WE GOT IT
2848 CIF 10
2849 JMS I USR /THE ANSWERING SERVICE
2850 10 /CALLS THE SR
2851 TAD [200
2852 DCA USR /RESET THE CALL ADDRESS
2853 JMP I GETUSR /JES FINE
2854 PAGE
2855 \fFULCHK, 0
2856 IFNZRO RALF <
2857 /
2858 / IF THE RELOCATABLE BINARY OUTPUT
2859 / BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
2860 / FILL THE REST WITH NOP CODES AND OUTPUT THE
2861 / BLOCK.
2862 /
2863 TAD OUTPTR
2864 TAD KOUBUF
2865 SPA CLA
2866 JMP I FULCHK
2867 FULLUP, TAD OUTPTR
2868 TAD KOUBUF
2869 SMA CLA
2870 JMP .+4
2871 CLA IAC
2872 DCA I OUTPTR
2873 JMP FULLUP
2874 JMS I (OUTBLK
2875 JMP I FULCHK
2876 KOUBUF, -OUBUF-377 >
2877 /
2878 /
2879 / GET SIGN CHARACTER IF ANY
2880 / BUMP LASTOP IF MINUS
2881 /
2882 GETSGN, 0
2883 JMS I [GETCHR
2884 JMP I GETSGN
2885 TAD (-255 /MINUS?
2886 SNA
2887 ISZ LASTOP
2888 SZA
2889 CLL CMA RAR /IF IT WAS PLUS, BECOMES 0
2890 SZA CLA /SKIP IF PLUS OR MINUS
2891 JMS I [BACK1 /OTHERWISE PUT IT BACK
2892 JMP I GETSGN
2893 \f/ AS PER RICHIE LARY
2894 /
2895 / SINGLE AND DOUBLE PRECISION
2896 / FLOATING POINT INPUT
2897 /
2898 /
2899 EX, TAD M3
2900 FX, TAD M3
2901 DCA DESW /STORE LENGTH
2902 TAD (-7
2903 JMS CLEAR /CLEAR FAC+OP
2904 DCA LASTOP
2905 JMS GETSGN /GET SIGN
2906 STA /CLA CMA
2907 DCA DPSW /SET NO DP
2908 GETD, DCA DCNT
2909 JMS I (DIGIT /GET A DIGIT
2910 JMP LOOKP /NO
2911 DCA OTEMP /SAVE IT
2912 JMS I (FMPTEN /MULT FAC*10
2913 JMS CLEAR
2914 TAD OTEMP
2915 SZA
2916 JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0
2917 TAD DPSW
2918 CMA
2919 TAD DCNT /BUMP IF FP SEEN
2920 JMP GETD
2921 \fLOOKP, JMS I [GETCHR
2922 JMP OVER /DONE
2923 TAD (-256
2924 SNA
2925 JMP DECPT
2926 TAD (256-304
2927 CLL RAR
2928 SNA CLA
2929 JMP I (EXPON /E OR D
2930 DEXERR, JMS I [ERMSG
2931 0620 /FP
2932 JMP NOTNEG
2933 DECPT, ISZ DPSW
2934 JMP DEXERR /2 PERIODS
2935 JMP GETD
2936 /
2937 OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC
2938 SNA
2939 JMP NOSCAL /NO SCALING NEEDE
2940 CLL
2941 SMA
2942 CIA CML /SIGN IN LINK,MAGNITUDE IN AC
2943 DCA DCNT /AS A COUNT
2944 SNL
2945 TAD (TENTH-TEN /OFFSET KLUDGE
2946 DCA OTEMP
2947 SCALUP, TAD OTEMP
2948 JMS I (FMPTEN /MULT BY 10.0 OR 0.1
2949 ISZ DCNT
2950 JMP SCALUP
2951 NOSCAL, JMS CLEAR
2952 STL RAR
2953 DCA OP+5 /ROUNDING CONSTANT
2954 JMS I (ADD
2955 TAD AC
2956 SZA CLA
2957 JMS I (NORM /WATCH IT!
2958 DCA AC+5
2959 TAD LASTOP
2960 SNA CLA /SIGN -?
2961 JMP NOTNEG /NO
2962 TAD (AC+5
2963 JMS I (SETUP
2964 ACNGLP, RAL
2965 TAD I P /NEGATE FAC
2966 CLL CIA
2967 DCA I P
2968 STA
2969 TAD P
2970 DCA P
2971 ISZ CT
2972 JMP ACNGLP
2973 NOTNEG, JMS CLEAR /SET UP X10
2974 TAD I X10
2975 JMS I [OUTWRD
2976 ISZ DESW /OUTPUT #
2977 JMP .-3
2978 JMP I [NEXTST
2979 \fCLEAR, 0 /AC MAY NOT BE 0
2980 TAD (-7
2981 DCA CT
2982 TAD (OPX-1
2983 DCA X10
2984 DCA I X10
2985 ISZ CT
2986 JMP .-2
2987 JMP I CLEAR
2988 DCNT=FULCHK
2989 DPSW=NCTMP
2990 DESW=OPCODE
2991 PAGE
2992 \f OVBUFR=.
2993 FAD, 0 /FLOATING ADD DIGIT IN AC
2994 DCA OP
2995 TAD (13
2996 DCA OPX
2997 ALNLP, TAD OPX
2998 CIA
2999 TAD ACX
3000 SNA /ALIGNED?
3001 JMP GOADD /YES
3002 SMA CLA
3003 TAD (OPX-ACX
3004 JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1
3005 JMP ALNLP /TRY AGAIN
3006 GOADD, JMS ADD /ADD FRACTIONS
3007 JMS NORM /NORMALIZE RESULT
3008 JMP I FAD /RETURN
3009 /
3010 RSHFT, 0 /SHIFT RIGHT
3011 TAD (ACX /DEFAULT IS FAC
3012 JMS SETUP
3013 ISZ I P /BUMP EXPONENT
3014 RSLP, ISZ P
3015 TAD I P
3016 RAR
3017 DCA I P
3018 ISZ CT
3019 JMP RSLP
3020 JMP I RSHFT
3021 /
3022 ADD, 0 /ADD TO FAC
3023 TAD (OP+5
3024 DCA PP2
3025 TAD (AC+5
3026 JMS SETUP
3027 ADDLP, RAL /CARRY
3028 TAD I PP2
3029 TAD I P
3030 DCA I P /ADD ONE WORD
3031 STA
3032 TAD P /COMPLEMENT LINK
3033 DCA P
3034 STA
3035 TAD PP2 /COMPLEMENT LINK
3036 DCA PP2
3037 ISZ CT
3038 JMP ADDLP
3039 JMP I ADD
3040 \fNORM, 0 /NORMALIZE FAC
3041 TAD AC
3042 SPA CLA /CHECK FOR OVERNORMALIZATION
3043 JMS RSHFT /AND CORRECT
3044 NORMLP, STL RTR
3045 AND AC
3046 SZA CLA /NORMALIZED?
3047 JMP I NORM /YES
3048 TAD (AC+5
3049 JMS SETUP
3050 LSLP, TAD I P
3051 RAL /LEFT SHIFT
3052 DCA I P /FAC 1 BIT
3053 STA CML /COMPLEMENT LINK
3054 TAD P
3055 DCA P
3056 ISZ CT
3057 JMP LSLP
3058 STA
3059 TAD ACX /BUMP EXP
3060 DCA ACX /DOWN 1
3061 JMP NORMLP
3062 \fFMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1
3063 TAD (TEN
3064 JMS SETUP
3065 TAD AC
3066 SNA CLA /AC=0 MEANS RESULT=0
3067 JMP I FMPTEN
3068 TAD I P
3069 TAD ACX /FUDGE FAC
3070 DCA ACX /EXPONENT
3071 TAD (MUX
3072 DCA X11
3073 TAD (ACX
3074 DCA SETUP
3075 TAD (OPX
3076 DCA X10
3077 DCA MUX /CLEAR MULT TEMP EXP
3078 MPLP1, ISZ SETUP
3079 TAD I SETUP /MOVE FAC
3080 DCA I X10 /TO OP
3081 DCA I SETUP /CLEAR FAC
3082 ISZ P
3083 TAD I P /MOVE MULTIPLIER
3084 DCA I X11 /TO MULT TEMP
3085 ISZ CT
3086 JMP MPLP1
3087 /
3088 MPLP2, TAD (MUX-ACX
3089 JMS RSHFT /SHIFT MULT TEMP RIGHT 1
3090 SZL
3091 JMS ADD /ADD IF LOW ORDER BIT WAS 1
3092 JMS RSHFT /SHIFT FAC RIGHT
3093 TAD MU+5
3094 SZA CLA /12 SUCCESSIVE 0 BITS
3095 JMP MPLP2 /IN MULTIPLIER MEANS DONE
3096 JMS NORM
3097 JMP I FMPTEN
3098 /
3099 SETUP, 0 /COMMON CODE
3100 DCA P
3101 TAD (-6
3102 DCA CT
3103 CLL
3104 JMP I SETUP
3105 /
3106 MUX, 0 /MULT TEMP
3107 MU, ZBLOCK 6
3108 CT=CPTMP
3109 P=EXTMP
3110 PP2=PAGEN
3111 \f PAGE
3112 \f IFNZRO RALF <
3113 ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN
3114 PNDL /DITTO FOR BLANK COMMON
3115 ZBLOCK 376 /FILL TO 400 LOCS
3116 /
3117 / BEGIN OF PASS 2:
3118 / DUMP EXTERNAL SYMBOL DICTIONARY
3119 / DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
3120 /
3121 DMPESD, CLA CLL CMA RAL /-2
3122 DCA EXTMP2 /PASS CONTROL
3123 TAD (3 /RALF OUTPUT IDENTIFIER
3124 DCA I OUTPTR
3125 TAD VERS
3126 DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES
3127 TAD DPFLG /4000=NEED DP HARDWARE
3128 DCA I OUTPTR /EXACTLY FILL A BLOCK
3129 DCA I OUTPTR
3130 ESDSCN, TAD (ESDBUF-1
3131 DCA X10 /POINT TO POINTERS
3132 TAD (ESDBUF+177
3133 DCA X12 /POINT TO INITAIL CHARS
3134 TAD ESDNO
3135 CIA
3136 DCA EXTMP
3137 ESDLUP, TAD (-3
3138 DCA LTEMP /NAME LENGTH COUNT
3139 TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME
3140 DCA X13
3141 TAD I X10 /GET POINTER
3142 DCA X11
3143 TAD I X12 /GET FIRST CHAR
3144 SNA /BLANK BECOMES #
3145 TAD (43
3146 ESDNLP, JMS I [R6L
3147 DCA EQUN+2
3148 CDF FLD1
3149 TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE
3150 DCA EQUN+3 /HOLD IT
3151 CDF FLD0
3152 TAD EQUN+3
3153 JMS I [R6R /GET LEFT CHAR
3154 TAD EQUN+2 /COMBINE THEM
3155 DCA I X13
3156 TAD EQUN+3 /GET RIGHT HALF OF PAIR
3157 AND [77
3158 ISZ LTEMP
3159 JMP ESDNLP
3160 AND [37 /DROP FORCE BIT FROM TYPE
3161 DCA EQUN+3
3162 CDF FLD1
3163 TAD I X11 /HIGH VALUE
3164 DCA EQUN+4
3165 TAD I X11 /LOW VALUE
3166 DCA EQUN+5
3167 CDF FLD0
3168 TAD EXTMP2 /WHAT PASS IS THIS?
3169 RAR /LINK 0 IF FIRST, 1 IF SECOND
3170 SNL CLA
3171 JMP NOENTS /FIRST, ENTRYS NOT OUTPUT
3172 TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND
3173 CLL RAR
3174 SNA CLA
3175 SNL
3176 JMP ESDLND /NO GO
3177 JMP ESDOUT /YES, PUT IT
3178 NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN
3179 CLL RAR
3180 SNA /SKIP IF OK
3181 JMP ESDLND /UNDEFINED OR ENTRY
3182 RAR
3183 SNA CLA
3184 JMP ESDOUT /IF EXTERN, DO IT
3185 TAD EQUN+4 /IF SECTION, CHECK
3186 AND [7 /THAT LENGTH
3187 SNA /IS NON-ZERO
3188 TAD EQUN+5
3189 SNA CLA
3190 JMP ESDLND /ZERO LEN JUST GETS IN THE WAY
3191 ESDOUT, TAD (EQUN-1
3192 DCA X13
3193 TAD (-6
3194 DCA LTEMP
3195 TAD I X13 /GET OUTPUT WORD
3196 DCA I OUTPTR
3197 ISZ LTEMP
3198 JMP .-3 /6-WORD ENTRIES
3199 TAD OUTPTR
3200 TAD OUTBUF
3201 SPA CLA
3202 JMP ESDLND /NOT END OF BLOCK YET
3203 JMS I (OUTBLK
3204 TAD (3
3205 DCA I OUTPTR
3206 DCA I OUTPTR
3207 DCA I OUTPTR
3208 DCA I OUTPTR
3209 ESDLND, ISZ EXTMP /GO THRU ESD LIST
3210 JMP ESDLUP
3211 ISZ EXTMP2 /WHOLE LIST TWO PASSES
3212 JMP ESDSCN
3213 TAD (-6 /THEN STORE END-OF-ESD
3214 DCA LTEMP
3215 DCA I OUTPTR
3216 ISZ LTEMP
3217 JMP .-2
3218 TAD (377 /FORCE BLOCK OUTPUT
3219 JMS I (FULCHK
3220 CDF FLD1 /THEN DEFAULT ORG
3221 TAD I (LMAIN /IF MAIN LEN .NE. 0
3222 AND [7
3223 SNA
3224 TAD I (LMAIN+1
3225 CDF FLD0
3226 SNA CLA
3227 JMP I (RESET /FIRST SECTION WILL GET IT
3228 TAD (TTORG+1 /ORG TO ZERO OF MAIN
3229 DCA I OUTPTR
3230 DCA I OUTPTR
3231 DCA I OUTPTR
3232 JMP I (RESET
3233 OUTBUF, 1001
3234 PAGE />
3235 \f/
3236 / INITIALIZATION CODE
3237 /
3238 BEGIN, JMP CHNIN /IF ENTERED BY CHAIN
3239 GCMND, CIF 10 /IF ENTERED BY .R, ETC
3240 JMS I USR /USR IS LEFT OVER
3241 5 /DECODE
3242 IFZERO RALF <
3243 620 /DEFAULT EXT = .FP>
3244 IFNZRO RALF <
3245 2201 /DEFAULT EXT = .RA>
3246 DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED
3247 CHNIN, JMS I (7607
3248 4100 /TEMP WRITE OUT OVERLAY
3249 6600 /NOW AT 6600
3250 40 /TO SYS SCRATCH BLK 40
3251 JMP I (7605 /ERROR
3252 CDF 10
3253 IFNZRO RALF <
3254 TAD I [7600 /BIN FILE UNIT
3255 AND NP17
3256 SNA /IS THERE ONE?
3257 JMP DEFBIN /NO, SET DEFAULT
3258 TAD (7757 /POINT TO DEV CTRL WORD
3259 DCA WORD1
3260 TAD I WORD1
3261 SPA CLA
3262 JMP OKBIN /FILE-STRUCTURED, OK
3263 CDF 0
3264 JMS I (PRTXT /TYPE MESSAGE
3265 TXBBIN-1
3266 -TXBLN
3267 JMS I [CRLF
3268 JMP GCMND /TRY AGAIN
3269 /
3270 DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS
3271 DCA I [7600 /SET UNIT
3272 TAD [7600
3273 DCA X10 /SET POINTER
3274 TAD (0617 /FO
3275 DCA I X10
3276 TAD (2224 /RT
3277 DCA I X10
3278 TAD (2216 /RN
3279 DCA I X10 /FORTRN.
3280 DCA I X10
3281 CDF 0
3282 JMP I (NOEXT /NOW, OPEN THE FILE>
3283 \fOKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE
3284 JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE
3285 GBIN, CDF 10
3286 TAD I (7644
3287 AND (20
3288 SNA CLA
3289 ISZ SYONLY /=NO SLASH T
3290 CDF 0
3291 JMS I (NEW /**SEE IF NEED 2 PG HANDLER
3292 7600
3293 JMS I (OOPEN
3294 DCA BFILE
3295 IFNZRO RALF <
3296 TAD R41 /L OR G SWITCH**
3297 CDF 10
3298 AND I (7643 /TEST /L OR /G SWITCH
3299 CDF 0
3300 SNA CLA /**
3301 JMP KCHN /KILL CHAIN, IT'S SET
3302 CIF 10
3303 CLA IAC /UNIT IS SYS
3304 JMS I USR
3305 2 /LOOKUP
3306 LBLK, LDRNAM /LOADER.SV
3307 R41, 41 /**
3308 JMP KCHN /NO FIND, NO CALL
3309 TAD LBLK /STARTING BLOCK
3310 DCA I (LDRBLK /FOR CHAIN
3311 TAD I (OUBLK /OUTPUT STARTING BLOCK
3312 DCA I (PASBLK /SAVED FOR CHAIN TO LOADER
3313 CLA CMA /ENABLE CHAIN
3314 KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER>
3315 JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
3316 JMS I (INNEWF /GET INPUT HANDLER
3317 CLA CMA
3318 DCA I (INCHCT /SET INITIAL COUNT
3319 TAD NP7700
3320 DCA USR /FROM NOW ON, USE THE HIGH CALL
3321 \f JMS I (NEW
3322 7605 /CHECK LIST DEV TOO**
3323 CDF 10
3324 TAD I (7611 /LST FILE EXT
3325 SNA
3326 TAD (1423 /LS DEFAULT
3327 DCA I (7611
3328 TAD I (7666 /GET DATE
3329 DCA WORD1
3330 /
3331 / MOVE SYMBOL TABLE TO ITS PROPER LOCATION
3332 /
3333 TAD (1777
3334 DCA X10 /LOADED ADDRESS OF SYMBOL TABLE
3335 CLA CMA
3336 DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS
3337 TAD (-FREE /LENGTH OF SYMBOL TABLE
3338 DCA WORD2 /SET COUNT
3339 TAD I X10
3340 DCA I X11 /THIS SAVES SWAPS OF USR
3341 ISZ WORD2
3342 JMP .-3
3343 CDF 0
3344 JMP I (GDATE /CHECK FOR FPP PRESENCE**
3345 PAGE
3346 \f/
3347 / PUT THE DATE INTO THE PAGE HEADING
3348 /
3349 GDATE, TAD (1000
3350 DCA I (7746 /SET NO-RESTART BIT
3351 /PUT VERNUM IN TITLE LINE
3352 TAD VMSG
3353 DCA I (VMTXT
3354 TAD VMSG+1 /PATCH LEVEL
3355 DCA I (VMTXT+1
3356 DCA OCNT /CLEAR OCNT
3357 TAD WORD1 /RE-GET DATE
3358 SNA
3359 JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED
3360 AND (370
3361 CLL RTR
3362 RAR
3363 TAD (-12
3364 SPA
3365 JMP .+3
3366 ISZ OCNT
3367 JMP .-4
3368 TAD (72 /60+12
3369 DCA OTEMP
3370 TAD (TITDAT-1
3371 DCA X11
3372 TAD OCNT
3373 JMS I (R6L
3374 SZA
3375 TAD (6000
3376 TAD OTEMP
3377 DCA I X11
3378 TAD WORD1
3379 AND (7400 /MONTH
3380 JMS I (R6L
3381 TAD (MONTHS-3
3382 DCA X10
3383 TAD I X10
3384 DCA I X11
3385 TAD I X10
3386 DCA I X11
3387 DCA OCNT
3388 TAD WORD1
3389 AND [7
3390 DCA OTEMP
3391 TAD I (7777
3392 AND (600
3393 RTR CLL
3394 RTR
3395 TAD OTEMP
3396 TAD (106
3397 \f TAD (-12
3398 SPA
3399 JMP .+3
3400 ISZ OCNT
3401 JMP .-4
3402 TAD (72
3403 DCA OTEMP
3404 TAD (5560
3405 TAD OCNT
3406 DCA I 11
3407 TAD OTEMP
3408 JMS I (R6L
3409 TAD (40
3410 DCA I X11
3411 JMP I (NEWLIN
3412 VMSG, VNUM&70^10+VNUM&707+6060
3413 PATCH&77^100+40
3414 IFNZRO RALF <
3415 LDRNAM, TEXT "LOAD@@SV"
3416 TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED"
3417 TXBLN= .-TXBBIN >
3418 MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
3419 \f PAGE
3420 /PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
3421 NEW, 0
3422 TAD NT2 /CHECK IF ALREADY CHECKED
3423 SZA CLA
3424 JMP NEWDON
3425 TAD I NEW /NO. GET THE DEV TO CHECK
3426 DCA NTEMP
3427 CDF 10
3428 TAD I NTEMP /GET DEV.NUM
3429 AND [17
3430 DCA NT1 /INCHK NEEDS TO KNOW TOO
3431 TAD NT1
3432 SNA /IF 0,THEN NO DEVICE
3433 JMP NEWDON
3434 DCA NTEMP
3435 CLA CMA
3436 TAD I (37 /GET PTR TO DEV TBL
3437 TAD NTEMP
3438 DCA NTEMP /PTS TO ENTRY IN DEV TBL
3439 TAD I NTEMP
3440 CDF 0
3441 SMA CLA
3442 JMP FIX /NOT A 2 PG HANDLER
3443 TAD (6377 /FIX ALL LOCATIONS THAT REFER TO
3444 /THE BUFFER VARIABLES.
3445 /THE CHANGES ARE:
3446 /OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
3447 /INRECS=1,INCTL=200
3448 DCA I (BLINE
3449 TAD (6000
3450 DCA I (NOUBUF
3451 IFNZRO RALF <
3452 TAD (5777
3453 DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS
3454 TAD (6601
3455 DCA I (NINDEV
3456 TAD (201
3457 DCA I (NINCTL
3458 JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER
3459 DCA I (NINREC
3460 TAD (6000
3461 DCA I (LOUBUF
3462 TAD (7201
3463 DCA I (NOUDEV
3464 TAD (5777
3465 DCA I (OUTPTR
3466 TAD (6377
3467 DCA I (CHRPTR
3468 IFNZRO RALF <
3469 TAD (1401
3470 DCA I (KOUBUF >
3471 TAD (7201
3472 FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN
3473 NEWDON, ISZ NEW /GET CORRECT ADDR
3474 JMP I NEW
3475 NTEMP, 0
3476 NT1, 0 /DEV. NUM.
3477 NT2, 0 /0 IF NO 2PG HANDLERS YET
3478 INCHK, 0 /CHECK THE INPUT DEVICES
3479 JMS NEW
3480 INLOC, 7617
3481 TAD INLOC
3482 DCA NEXTIN
3483 ANOTH, TAD NT1
3484 SNA CLA /SKIP IF FILE USED
3485 JMP I INCHK
3486 TAD NT2
3487 SZA CLA /SKIP IF STILL 1 PAGE HANDLERS
3488 JMP I INCHK
3489 TAD NP2
3490 TAD NEXTIN
3491 DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR
3492 JMS NEW
3493 NEXTIN, 0
3494 JMP ANOTH
3495 NP2, 2
3496 NOKBIN, CDF 10 /BELONGS WITH INIT CODE
3497 TAD I [7600
3498 AND NP17
3499 TAD (7646
3500 DCA WORD1 /CREATE POINTER INTO DEV TBL
3501 TAD I WORD1
3502 CDF 0
3503 TAD (-7607
3504 SNA CLA /IF ITS SYS, NO PROBLEMS
3505 DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE
3506 CDF 10
3507 TAD I (7604
3508 SZA
3509 JMP FEND /AN EXT WAS SPECIFIED
3510 IFZERO RALF <
3511 TAD (0216 /.BN DEFAULT FOR FLAP
3512 JMP FEND >
3513 IFNZRO RALF <
3514 NOEXT, CDF 10
3515 TAD I (7643 /CHECK IF L OR G SPEC
3516 AND L41
3517 SNA CLA
3518 TAD (0610 /NO-NEEDS RL EXT
3519 TAD (1404 > /YES-NEEDS LD
3520 FEND, DCA I (7604
3521 CDF 0
3522 JMP I (GBIN
3523 L41, 41
3524 TPNSH, 0
3525 TAD (1401 /CHANGE OUTPUT BUFFER
3526 DCA I (OUTBUF
3527 IAC
3528 JMP I TPNSH
3529 /
3530 PAGE
3531 \fLDADR, RELOC OVBUFR
3532 TAD ERRORS /ERROR COUNT
3533 JMS I (DECOUT
3534 JMS I (PRTXT /"ERRORS"
3535 TXERR-1
3536 -TXELN
3537 JMS I [CRLF
3538 IFZERO RALF <
3539 TAD PASSNO /IF NOT LISTING PASS
3540 SPA SNA CLA /ERROR COUNT IS ENUF
3541 JMP I (RETSYS >
3542 TAD NEXT
3543 TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS
3544 CLL RAR /DIVIDE
3545 JMS I (OVER3 /BY 6
3546 JMS I (DECOUT
3547 JMS I (PRTXT /"SYMBOLS, "
3548 TXSYM-1
3549 -TXSLN
3550 IFZERO RALF <
3551 TAD LINKS
3552 JMS I (DECOUT
3553 JMS I (PRTXT /"LINKS"
3554 TXLNK-1
3555 -TXLLN >
3556 IFNZRO RALF <
3557 TAD ABREFS
3558 JMS I (DECOUT
3559 JMS I (PRTXT /"ABS REFS"
3560 TXABR-1
3561 -TXALN >
3562 JMS I [CRLF
3563 TAD (-33 /27 BUCKETS
3564 DCA LTEMP
3565 DCA BUCKET
3566 CLA CMA
3567 DCA OPCODE /SYMBOLS PER LINE COUNTER
3568 \fSTPRNT, TAD BUCKET
3569 DCA EXTMP /BUCKET START ADDRESS
3570 LUPBKT, CDF FLD1
3571 TAD I EXTMP /WAS THAT LAST SYMBOL ?
3572 SNA
3573 JMP NXTBKT /YES, GO GET NEXT BUCKET
3574 DCA EXTMP /SAVE LINK ADDR
3575 TAD EXTMP
3576 DCA X14 /SET UP POINTER FOR NAME
3577 ISZ OPCODE /IS LINE FULL?
3578 JMP .+4 /NO
3579 TAD (-4
3580 DCA OPCODE
3581 JMS I [CRLF
3582 TAD BUCKET
3583 SNA /WATCH FOR #
3584 TAD (43
3585 JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR
3586 CDF FLD1
3587 TAD I X14 /SYMBOL
3588 JMS I [PRINT2 /PRINT 2 AND 3
3589 CDF FLD1
3590 TAD I X14
3591 JMS I [PRINT2 /PRINT 4 AND 5
3592 CDF FLD1
3593 TAD I X14
3594 IFNZRO RALF <
3595 DCA OTEMP /HOLD
3596 TAD OTEMP >
3597 AND [7700 /PRINT 6 AND BLANK
3598 JMS I [PRINT2
3599 IFNZRO RALF <
3600 TAD OTEMP /GET TYPE
3601 AND [17
3602 TAD (TYPCOD /POINT TO TABLE
3603 DCA OTEMP
3604 TAD I OTEMP /GET TYPE INDICATOR
3605 JMS I [PRINT2 >
3606 CDF FLD1
3607 TAD I X14 /PRINT FIRST DIGIT
3608 AND [7
3609 JMS I (PDIG /FIELD DIGIT
3610 CDF FLD1
3611 TAD I X14 /LOW 12 BITS
3612 JMS I [OCTOUT
3613 JMS I [PRINT2 /TWO BLANKS
3614 JMP LUPBKT
3615 \fNXTBKT, ISZ BUCKET /NEXT BUCKET CHAR
3616 CDF FLD0
3617 ISZ LTEMP /INCREMENT COUNT
3618 JMP STPRNT
3619 JMS I [CRLF /DO FINAL CRLF**
3620 TAD (214 /DO NOT PAGEJ
3621 JMS I PC /THAT WOULD GIVE A HEADING
3622 JMS I (OCLOSE
3623 JMP I (RETSYS /FINISH IT OFF
3624 PAGE
3625 RELOC
3626 \f/ PAGE 0 LITERALS
3627 FIELD 1
3628 *10000
3629 \f/
3630 / SYMBOL TABLE IS IN FIELD ONE.
3631 / EACH ENTRY HAS THE FOLLOWING FORMAT
3632 /
3633 / 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
3634 / 1: 2ND AND 3RD CHARS OF SYMBOL
3635 / 2: 4TH AND 5TH
3636 / 3: 6TH AND TYPE CODE
3637 / 4: ESD # AND HIGH-ORDER VALUE
3638 / 5: LOW-ORDER VALUE
3639 /
3640 USER=1
3641 XTERN=2
3642 COMMN=3
3643 SECTN=4
3644 PSUDO=5
3645 PDPMR=6
3646 FPPMRF=7
3647 FPPSF1=10 /JXN, TRAP
3648 FPPSF2=11 /JA, SETB, SETX
3649 FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM,
3650 /PAUS, JAC, STARTD, STARTF
3651 FPPSF4=13 /ALN, ATX, XTA
3652 FPPSF5=14 /ADDX, LDX
3653 FPPMRI=15 /%
3654 FPPMRS=16 /'
3655 FPPMRL=17 /#
3656 PDPOP=20
3657 /
3658 / THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
3659 / THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
3660 / THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
3661 / IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
3662 / DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
3663 /
3664 *12000
3665 NOPUNCH
3666 *10000
3667 ENPUNCH
3668 \f/
3669 / BUCKETS FOR USER-DEFINED SYMBOLS
3670 / AND PDP8 OPERATES AND IOTS
3671 /
3672 PNDL
3673 ZBLOCK 33
3674 \f/
3675 / BUCKETS FOR INTERNALLY DEFINED SYMBOLS
3676 /
3677 AL
3678 BL
3679 CL
3680 DL
3681 EL
3682 FL
3683 GL
3684 HL
3685 IL
3686 JL
3687 KL
3688 LL
3689 ML
3690 NL
3691 OL
3692 PL
3693 QL
3694 RL
3695 SL
3696 TL
3697 UL
3698 VL
3699 WL
3700 XL
3701 YL
3702 ZL
3703 \fAL, .+5 /ADDR
3704 0404;2200
3705 FPPSF2
3706 0
3707 .+5 /ADDX
3708 0404;3000
3709 FPPSF5
3710 0110
3711 .+5 /ALN
3712 1416;0
3713 FPPSF4
3714 0010
3715 IFZERO RALF <
3716 .+5 /AND
3717 1604;0
3718 PDPMR
3719 AND 0 >
3720 IFNZRO RALF <
3721 .+5 /AND .
3722 1604;0
3723 PDPMR
3724 200
3725 .+5 /AND%
3726 1604;0
3727 PDPMR+500
3728 600
3729 .+5 /ANDZ
3730 1604;3200
3731 PDPMR
3732 0
3733 .+5 /ANDZ%
3734 1604;3200
3735 PDPMR+500
3736 400 >
3737 0 /ATX
3738 2430;0
3739 FPPSF4
3740 0020
3741 BL, 0 /BASE
3742 0123;0500
3743 PSUDO
3744 BASEX
3745 CL, .+5 /CDF
3746 0406;0
3747 PDPOP
3748 CDF
3749 .+5 /CIA
3750 1101;0
3751 PDPOP
3752 CIA
3753 .+5 /CIF
3754 1106;0
3755 PDPOP
3756 CIF
3757 .+5 /CLA
3758 1401;0
3759 PDPOP
3760 CLA
3761 .+5 /CLL
3762 1414;0
3763 PDPOP
3764 CLL
3765 .+5 /CMA
3766 1501;0
3767 PDPOP
3768 CMA
3769 IFZERO RALF < 0 >
3770 IFNZRO RALF < .+5 >
3771 1514;0 /CML
3772 PDPOP
3773 CML
3774 IFNZRO RALF <
3775 .+5 /COMMON
3776 1715;1517
3777 PSUDO+1600
3778 COMMX
3779 0 /COMMZ (8-MODE COMM SECT)
3780 1715;1532
3781 PSUDO
3782 SECT8X-1 >
3783 \fDL, IFZERO RALF <
3784 .+5 /DCA
3785 0301;0
3786 PDPMR
3787 DCA 0 >
3788 IFNZRO RALF <
3789 .+5 /DCA .
3790 0301;0
3791 PDPMR
3792 3200
3793 .+5 /DCA%
3794 0301;0
3795 PDPMR+500
3796 3600
3797 .+5 /DCAZ
3798 0301;3200
3799 PDPMR
3800 DCA 0
3801 .+5 /DCAZ%
3802 0301;3200
3803 PDPMR+500
3804 DCA I 0 >
3805 IFZERO RALF < 0 > /DECIMAL
3806 IFNZRO RALF < .+5 >
3807 0503;1115
3808 PSUDO+0100
3809 DECX
3810 IFNZRO RALF < 0 /DPCHK
3811 2003;1013
3812 PSUDO
3813 DPCHKX >
3814 EL, .+5 /E
3815 0;0
3816 PSUDO
3817 EX
3818 .+5 /END
3819 1604;0
3820 PSUDO
3821 ENDX
3822 IFZERO RALF <
3823 0 /ENPUNCH
3824 1620;2516
3825 PSUDO+0300
3826 ENPNCX >
3827 IFNZRO RALF <
3828 .+5 /ENTRY
3829 1624;2231
3830 PSUDO
3831 ENTRX
3832 0 /EXTERN
3833 3024;0522
3834 PSUDO+1600
3835 EXTRNX >
3836 \fFL, .+5 /F
3837 0;0
3838 PSUDO
3839 FX
3840 .+5 /FADD
3841 0104;0400
3842 FPPMRF
3843 1000
3844 .+5 /FADD#
3845 0104;0400
3846 FPPMRL+300
3847 1000
3848 .+5 /FADD%
3849 0104;0400
3850 FPPMRI+500
3851 1000
3852 .+5 /FADD'
3853 0104;0400
3854 FPPMRS+700
3855 1000
3856 .+5 /FADDM
3857 0104;0415
3858 FPPMRF
3859 5000
3860 .+5 /FADDM#
3861 0104;0415
3862 FPPMRL+300
3863 5000
3864 .+5 /FADDM%
3865 0104;0415
3866 FPPMRI+500
3867 5000
3868 .+5 /FADDM'
3869 0104;0415
3870 FPPMRS+700
3871 5000
3872 .+5 /FCLA
3873 0314;0100
3874 FPPSF3
3875 0002
3876 \f .+5 /FDIV
3877 0411;2600
3878 FPPMRF
3879 3000
3880 .+5 /FDIV#
3881 0411;2600
3882 FPPMRL+300
3883 3000
3884 .+5 /FDIV%
3885 0411;2600
3886 FPPMRI+500
3887 3000
3888 .+5 /FDIV'
3889 0411;2600
3890 FPPMRI+700
3891 3000
3892 .+5 /FEXIT
3893 0530;1124
3894 FPPSF3
3895 0
3896 IFNZRO RALF <
3897 .+5 /FIELD1 (8-MODE FIELD1 SECT)
3898 1105;1404
3899 PSUDO+6100
3900 SECT8X-2 >
3901 .+5 /FLDA
3902 1404;0100
3903 FPPMRF
3904 0000
3905 .+5 /FLDA#
3906 1404;0100
3907 FPPMRL+300
3908 0000
3909 .+5 /FLDA%
3910 1404;0100
3911 FPPMRI+500
3912 0000
3913 .+5 /FLDA'
3914 1404;0100
3915 FPPMRS+700
3916 0000
3917 \f .+5 /FMUL
3918 1525;1400
3919 FPPMRF
3920 4000
3921 .+5 /FMUL#
3922 1525;1400
3923 FPPMRL+300
3924 4000
3925 .+5 /FMUL%
3926 1525;1400
3927 FPPMRI+500
3928 4000
3929 .+5 /FMUL'
3930 1525;1400
3931 FPPMRS+700
3932 4000
3933 .+5 /FMULM
3934 1525;1415
3935 FPPMRF
3936 7000
3937 .+5 /FMULM#
3938 1525;1415
3939 FPPMRL+300
3940 7000
3941 .+5 /FMULM%
3942 1525;1415
3943 FPPMRI+500
3944 7000
3945 .+5 /FMULM'
3946 1525;1415
3947 FPPMRS+700
3948 7000
3949 .+5 /FNEG
3950 1605;0700
3951 FPPSF3
3952 0003
3953 .+5 /FNOP
3954 1617;2000
3955 FPPSF3
3956 0040
3957 \f .+5 /FNORM
3958 1617;2215
3959 FPPSF3
3960 0004
3961 .+5 /FPAUSE
3962 2001;2523
3963 FPPSF3+0500
3964 0001
3965 .+5 /FPCOM
3966 2003;1715
3967 PDPOP
3968 6553
3969 .+5 /FPHLT
3970 2010;1424
3971 PDPOP
3972 6554
3973 .+5 /FPICL
3974 2011;0314
3975 PDPOP
3976 6552
3977 .+5 /FPINT
3978 2011;1624
3979 PDPOP
3980 6551
3981 .+5 /FPIST
3982 2011;2324
3983 PDPOP
3984 6557
3985 .+5 /FPRST
3986 2022;2324
3987 PDPOP
3988 6556
3989 .+5 /FPST
3990 2023;2400
3991 PDPOP
3992 6555
3993 .+5 /FSTA
3994 2324;0100
3995 FPPMRF
3996 6000
3997 .+5 /FSTA#
3998 2324;0100
3999 FPPMRL+300
4000 6000
4001 .+5 /FSTA%
4002 2324;0100
4003 FPPMRI+500
4004 6000
4005 .+5 /FSTA'
4006 2324;0100
4007 FPPMRS+700
4008 6000
4009 .+5 /FSUB
4010 2325;0200
4011 FPPMRF
4012 2000
4013 .+5 /FSUB#
4014 2325;0200
4015 FPPMRL+300
4016 2000
4017 .+5 /FSUB%
4018 2325;0200
4019 FPPMRI+500
4020 2000
4021 0 /FSUB'
4022 2325;0200
4023 FPPMRS+700
4024 2000
4025 \fGL= 0 /AINT NONE
4026 HL, 0 /HLT
4027 1424;0
4028 PDPOP
4029 HLT
4030 IL, .+5 /IAC
4031 0103;0
4032 PDPOP
4033 IAC
4034 .+5 /IFFLAP
4035 0606;1401
4036 PSUDO+2000
4037 IFZERO RALF <TRUE>
4038 IFNZRO RALF <FALSE>
4039 .+5 /IFNDEF
4040 0616;0405
4041 PSUDO+0600
4042 IFNDFX
4043 .+5 /IFNEG
4044 0616;0507
4045 PSUDO
4046 IFNEGX
4047 .+5 /IFNSW
4048 0616;2327
4049 PSUDO
4050 IFNSWX
4051 .+5 /IFNZRO
4052 0616;3222
4053 PSUDO+1700
4054 IFNZRX
4055 \f .+5 /IFPOS
4056 0620;1723
4057 PSUDO
4058 IFPOSX
4059 .+5 /IFRALF
4060 0622;0114
4061 PSUDO+0600
4062 IFNZRO RALF <TRUE>
4063 IFZERO RALF <FALSE>
4064 .+5 /IFREF
4065 0622;0506
4066 PSUDO
4067 IFREFX
4068 .+5 /IFSW
4069 0623;2700
4070 PSUDO
4071 IFSWX
4072 .+5 /IFZERO
4073 0632;0522
4074 PSUDO+1700
4075 IFZROX
4076 .+5
4077 1604;0530
4078 PSUDO
4079 INDXX
4080 .+5 /IOF
4081 1706;0
4082 PDPOP
4083 IOF
4084 .+5 /ION
4085 1716;0
4086 PDPOP
4087 ION
4088 IFZERO RALF <
4089 0 /ISZ
4090 2332;0
4091 PDPMR
4092 ISZ 0 >
4093 IFNZRO RALF <
4094 .+5 /ISZ .
4095 2332;0
4096 PDPMR
4097 ISZ .&7600
4098 .+5 /ISZ%
4099 2332;0
4100 PDPMR+500
4101 ISZ I .&7600
4102 .+5 /ISZZ
4103 2332;3200
4104 PDPMR
4105 ISZ 0
4106 0 /ISZZ%
4107 2332;3200
4108 PDPMR+500
4109 ISZ I 0 >
4110 \fJL, .+5 /JA
4111 0100;0
4112 FPPSF2
4113 1030
4114 .+5 /JAC
4115 0103;0
4116 FPPSF3
4117 0007
4118 .+5 /JAL
4119 0114;0
4120 FPPSF2
4121 1070
4122 .+5 /JEQ
4123 0521;0
4124 FPPSF2
4125 1000
4126 .+5 /JGE
4127 0705;0
4128 FPPSF2
4129 1010
4130 .+5 /JGT
4131 0724;0
4132 FPPSF2
4133 1060
4134 .+5 /JLE
4135 1405;0
4136 FPPSF2
4137 1020
4138 .+5 /JLT
4139 1424;0
4140 FPPSF2
4141 1050
4142 IFZERO RALF <
4143 .+5 /JMP
4144 1520;0
4145 PDPMR
4146 JMP 0
4147 .+5 /JMS
4148 1523;0
4149 PDPMR
4150 JMS 0 >
4151 IFNZRO RALF <
4152 .+5 /JMP .
4153 1520;0
4154 PDPMR
4155 JMP .&7600
4156 .+5 /JMP%
4157 1520;0
4158 PDPMR+500
4159 JMP I .&7600
4160 .+5 /JMPZ
4161 1520;3200
4162 PDPMR
4163 JMP 0
4164 .+5 /JMPZ%
4165 1520;3200
4166 PDPMR+500
4167 JMP I 0
4168 .+5 /JMS .
4169 1523;0
4170 PDPMR
4171 JMS .&7600
4172 .+5 /JMS%
4173 1523;0
4174 PDPMR+500
4175 JMS I .&7600
4176 .+5 /JMSZ
4177 1523;3200
4178 PDPMR
4179 JMS 0
4180 .+5 /JMSZ%
4181 1523;3200
4182 PDPMR+500
4183 JMS I 0 >
4184 \f .+5 /JNE
4185 1605;0
4186 FPPSF2
4187 1040
4188 .+5 /JSA
4189 2301;0
4190 FPPSF2
4191 1120
4192 .+5 /JSR
4193 2322;0
4194 FPPSF2
4195 1130
4196 0 /JXN
4197 3016;0
4198 FPPSF1
4199 2000
4200 KL, .+5 /KCC
4201 0303;0
4202 PDPOP
4203 KCC
4204 .+5 /KRB
4205 2202;0
4206 PDPOP
4207 KRB
4208 .+5 /KRS
4209 2223;0
4210 PDPOP
4211 KRS
4212 0 /KSF
4213 2306;0
4214 PDPOP
4215 KSF
4216 LL, .+5 /LAS
4217 0123;0
4218 PDPOP
4219 LAS
4220 .+5 /LDX
4221 0430;0
4222 FPPSF5
4223 0100
4224 .+5 /LISTOFF
4225 1123;2417
4226 PSUDO+0600
4227 LSTOFX
4228 0 /LISTON
4229 1123;2417
4230 PSUDO+1600
4231 LSTONX
4232 \fML= 0 /NO LIST
4233 NL, IFZERO RALF < .+5 >
4234 IFNZRO RALF < 0 >
4235 1720;0 /NOP
4236 PDPOP
4237 NOP
4238 IFZERO RALF <
4239 0 /NOPUNCH
4240 1720;2516
4241 PSUDO+0300
4242 NOPNCX >
4243 OL, .+5 /OCTAL
4244 0324;0114
4245 PSUDO
4246 OCTALX
4247 .+5 /ORG
4248 2207;0
4249 PSUDO
4250 ORGX
4251 0 /OSR
4252 2322;0
4253 PDPOP
4254 OSR
4255 IFZERO RALF <
4256 PL, 0 /PAGE
4257 0107;0500
4258 PSUDO
4259 PAGEX >
4260 IFNZRO RALF <PL=0 >
4261 QL= 0 /WHAT DID YOU EXPECT?
4262 RL, .+5 /RAL
4263 0114;0
4264 PDPOP
4265 RAL
4266 .+5 /RAR
4267 0122;0
4268 PDPOP
4269 RAR
4270 .+5 /RDF
4271 0406;0
4272 PDPOP
4273 RDF
4274 .+5 /REPEAT
4275 0520;0501
4276 PSUDO+2400
4277 REPETX
4278 .+5 /RIB
4279 1102;0
4280 PDPOP
4281 RIB
4282 .+5 /RIF
4283 1106;0
4284 PDPOP
4285 RIF
4286 .+5 /RMF
4287 1506;0
4288 PDPOP
4289 RMF
4290 .+5 /RTL
4291 2414;0
4292 PDPOP
4293 RTL
4294 0 /RTR
4295 2422;0
4296 PDPOP
4297 RTR
4298 \fSL, .+5 /S
4299 0;0
4300 PSUDO
4301 SX
4302 IFNZRO RALF <
4303 .+5 /SECT
4304 0503;2400
4305 PSUDO
4306 SECTX
4307 .+5 /8 MODE SECT
4308 0503;2470
4309 PSUDO
4310 SECT8X >
4311 .+5 /SETB
4312 0524;0200
4313 FPPSF2
4314 1110
4315 .+5 /SETX
4316 0524;3000
4317 FPPSF2
4318 1100
4319 .+5 /SKP
4320 1320;0
4321 PDPOP
4322 SKP
4323 .+5 /SMA
4324 1501;0
4325 PDPOP
4326 SMA
4327 .+5 /SNA
4328 1601;0
4329 PDPOP
4330 SNA
4331 .+5 /SNL
4332 1614;0
4333 PDPOP
4334 SNL
4335 .+5 /SPA
4336 2001;0
4337 PDPOP
4338 SPA
4339 .+5 /STARTD
4340 2401;2224
4341 FPPSF3+0400
4342 0006
4343 .+5 /STARTE
4344 2401;2224
4345 FPPSF3+0500
4346 0050
4347 .+5 /STARTF
4348 2401;2224
4349 FPPSF3+0600
4350 0005
4351 .+5 /STL
4352 2414;0
4353 PDPOP
4354 STL
4355 .+5 /SZA
4356 3201;0
4357 PDPOP
4358 SZA
4359 0 /SZL
4360 3214;0
4361 PDPOP
4362 SZL
4363 \fTL, IFZERO RALF <
4364 .+5 /TAD
4365 0104;0
4366 PDPMR
4367 TAD 0 >
4368 IFNZRO RALF <
4369 .+5 /TAD .
4370 0104;0
4371 PDPMR
4372 TAD .&7600
4373 .+5 /TAD%
4374 0104;0
4375 PDPMR+500
4376 TAD I .&7600
4377 .+5 /TADZ
4378 0104;3200
4379 PDPMR
4380 TAD 0
4381 .+5 /TADZ%
4382 0104;3200
4383 PDPMR+500
4384 TAD I 0 >
4385 .+5 /TCF
4386 0306;0
4387 PDPOP
4388 TCF
4389 .+5 /TEXT
4390 0530;2400
4391 PSUDO
4392 TEXTX
4393 .+5 /TLS
4394 1423;0
4395 PDPOP
4396 TLS
4397 .+5 /TPC
4398 2003;0
4399 PDPOP
4400 TPC
4401 .+5 /TRAP3
4402 2201;2063
4403 FPPSF1
4404 3000
4405 .+5 /TRAP4
4406 2201;2064
4407 FPPSF1
4408 4000
4409 .+5 /TRAP5
4410 2201;2065
4411 FPPSF1
4412 5000
4413 .+5 /TRAP6
4414 2201;2066
4415 FPPSF1
4416 6000
4417 .+5 /TRAP7
4418 2201;2067
4419 FPPSF1
4420 7000
4421 0 /TSF
4422 2306;0
4423 PDPOP
4424 TSF
4425 \fUL= 0
4426 VL= 0
4427 WL= 0
4428 XL, 0 /XTA
4429 2401;0
4430 FPPSF4
4431 0030
4432 YL= 0
4433 ZL, 0 /ZBLOCK
4434 0214;1703
4435 PSUDO+1300
4436 ZBLKX
4437 \f IFZERO RALF < PNDL=0 >
4438 IFNZRO RALF <
4439 PNDL, .+6 /BLANK COMMON
4440 0;0
4441 3 /CODE FOR COMMON
4442 40;0 /ESD #2, LEN=0
4443 0 /#MAIN
4444 1501;1116
4445 4 /CODE FOR SECTION
4446 LMAIN, 20;0 /ESD #1, LEN=0>
4447 FREE,
4448 END, END /NICE WHEN FLAP ASSEMBLES
4449 $
4450 \f
My complete PDP-8 universe