projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
software: Added more and more
[pdp8.git] / sw / f4 / FRTSRC / RALF.PA
CommitLineData
7af5ad59
PH		 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/
55IFNDEF 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
74VERS, VNUM /VERSION NUMBER
75OLDN3, 0 /\ fTEMP FOR LOOKUP
76OTEMP, 0 /A COUPLE OF TEMPS THAT
77OCNT, 0 /DIDNT FIT INTO THEIR PAGE
78 0
79X10, 0
80X11, 0
81X12, 0
82X13, 0
83X14, 0
84OUTPTR, OUBUF-1
85NEXT, FREE-1
86CHRPTR, LINE-1
87NCHARS, -1 /CHARACTER INPUT STUFF
88CPTMP, 0
89NCTMP, 0 /USED TO SAVE CHAR POSITION
90LINSIZ, 0 /SIZE OF LINE FOR PRINTING
91STYPE, /SYMBOL TYPE CODE
92CHKSUM, 0 /FOR BINARY OUTPUT
93 IFZERO RALF <
94LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM
95LOCTR2, 200 >
96 IFNZRO RALF <
97ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT)
98LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN)
99LOCTR2, 0
100DPFLG, 0 >
101\fBASER, 4000 /BASE REGISTER SETTING
102 0
103INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER
104 0
105EXPVAL, 0 /EXPRESSION VALUE
106 0
107 0
108EXPDEF, 0 /=0 IF EXPR IS UNDEFINED
109EXPSW, 0 /FLAG=1 IF NO EXPR
110WORD1, 0 /TEMPORARY 2 WORD OPERAND
111WORD2, 0
112FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR
113 0
114OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER
115XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT
116XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR
117BUCKET, 0 /FIRST CHAR OF NAME
118NAME1, 0 /CHARS 2 AND 3 OF NAME
119NAME2, 0 /CHARS 4 AND 5 OF NAME
120NAME3, 0 /CHAR 6 OF NAME AND TYPE
121LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR
122PASSNO, -1 /PASS NUMBER
123ASMOF, 0 /SET NEGATIVE WHEN ASSEMBLY OFF
124PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT
125LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING)
126OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED
127REPCNT, 0 /REPEAT COUNTER
128SCSWT, 0 /SEMICOLON SWITCH
129RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL)
130LTEMP, -177 /TEMP USED BY LOOKUP
131EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS
132EXTMP2, 0
133EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN
134 /NEXT TWO LOCS USED WITH EQUN BY DMPESD
135FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR
136FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT
137FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0
138LITRL, 0 /SET = 1 FOR LITERAL
139P0LIT, 177
140CPLIT, 177
141PAGEN, 0
142ERRORS, 0 /ERROR COUNT
143PC, TTYOUT /OUTPUT ROUTINE
144OUFILE, 7573 /OUTPUT FILE LIST POINTER
145BFILE, 1
146\fLPAGE1, 1 /INPUT FORMFEED COUNT
147LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE
148LINPAG, -1 /LINES/PAGE COUNTER
149LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE
150LINKS, /NO OF LINKS GENERATED
151ABREFS, 0 /NO OF ABSOLUTE REFERENCES
152ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT
153USR, 200 /CURRENT CALL ADDRESS FOR USR
154SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE
155 /IS SPECIFIED. ITS SET VIA SLASH S
156 /=1=REGULAR
157NP17, 17 /**
158NP7700, 7700
159OPX, 0
160OP, ZBLOCK 6
161ACX, 0
162AC, ZBLOCK 6
163M3, -3
164BLINE, 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
187REPLEN, JMP I .+1
188REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001
189NEXTST, 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
204START, JMS I [GETCHR /ANY MORE CHARS ?
205 JMP NOTEG
206 JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE
207 0507 /*EG*
208NOTEG, 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
218NEWLIN, 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*
243ENDLIN, 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
254REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT
255 DCA LINSIZ
256 TAD BLINE
257 DCA CHRPTR /SET POINTER
258ASMBL, 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
275OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE
276 TAD ASMOF
277 DCA ASMOF
278OFFIT, ISZ NCHARS /MORE TO GO?
279 JMP GETIT /YES
280NOASM, CLA CMA
281 DCA NCHARS /DONT ASSEMBLE THIS LINE
282 JMP NEXTST /(PREVENTING *EG* MESSAGE)
283GETIT, 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
292AGAIN, 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/
302TXERR, TEXT " ERRORS"
303TXELN= .-TXERR
304 PAGE
305\f/
306/ DIVIDE AC BY 3
307/ USEFUL IN FPP REFERENCES TO BASE
308/
309OVER3, 0 /DIVIDE AC BY THREE
310 DCA EXTMP2 /MQ
311 TAD (-15 /SET SHIFT COUNT
312 DCA LTEMP
313DIVLUP, 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/
333OUSETP, 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
342NOUBUF, OUBUF
343/
344/ STORE CHARACTERS IN OUTPUT BUFFER
345/ IN PS8 FORMAT (YOU KNOW, 3 CHARS
346/ IN 2 WORDS THE WRONG WAY)
347/
348OCHAR, 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
356OUJMP, 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
382OCHAR2, TAD OUPTR
383 DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO
384 ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD
385OCHAR1, TAD OUTEMP
386 DCA I OUPTR
387OUCOMN, CDF
388 JMP I OCHAR
389OUTEMP, 0
390OUPOLD, 0
391OUPTR, 0
392OUJMPE, JMP OUJMP
393OUDWCT, 0
394OUTINH, 0
395/
396/ MOVE OUTPUT FILE NAME TO FIELD 0
397/
398OFNAME, 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/
415OTYPE, 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
424OTYPP= OFNAME
425/
426/ BASIC TITLE INFO
427/
428TITBUF,
429 IFZERO RALF <
430 TEXT "FLAP V" >
431 IFNZRO RALF <
432 TEXT "RALF V" >
433*.-1
434VMTXT, 0;0;0
435TITDAT, ZBLOCK 6
436 TEXT " PAGE"
437TITLEN= .-TITBUF
438 PAGE
439\f/
440/ PROCESS A STATEMENT
441/
442LUNAME, 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
472MDERR, JMS I [ERMSG /MULTIPLY DEFINED
473 1504 /*MD*
474 JMP I (ASMBL /FIELD IS OK
475DEFLBL, 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
480DEFIND, 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
513PUTVAL, 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
523EQUERR, 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
537JSTONE, 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
545OPCJMP, 0 /JUMP SOMEWHERE
546OPCTBL, 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
559REPETX, 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/
566GETEXP, CDF FLD0
567 TAD CPTMP /RESTORE CHARACTER POINTER
568 DCA CHRPTR
569 TAD NCTMP /TO JUST AFTER TAG (IF ANY)
570 DCA NCHARS
571SX, 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,
580RELERR, 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/
593FPPMR, 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
608FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR
609 JMS IXMES /BUT DISALLOW INDEX
610 JMP F2WD /PUT TWO WORDS OUT
611/
612IXMES, 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
620FORMT1, JMS I (FIXOPC
621F2WD, TAD FPPADR
622 AND [7 /FIELD BITS
623 TAD OPCODE /IN FIRST WORD
624FPDMP, 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>
631FPMRS, 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
641BADEXP, JMS I [ERMSG
642 0230 /*BX*
643 TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT
644 JMS I [OUTWRD
645 JMP I [NEXTST
646FPMRI, 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
655FORMT3, JMS I (FIXOPC
656FORMT2, TAD WORD2
657 JMS I (OVER3 /BY 3 FOR BASE ADDRESS
658 TAD [200
659FPPS3, TAD OPCODE
660 JMS I [OUTWRD /WHEW!
661 JMP I [NEXTST
662FPPS1, 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/
688FPADR, 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/
702PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR
703/
704 IFZERO RALF <
705/
706/ ASSEMBLE VARIOUS INSTRUCTION TYPES
707/
708PDP8MR, 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
724GETMR, 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*
740THSPAG, TAD EXPVAL+2 /GET ADDRESS
741 AND [177 /LOWER 7 BITS
742 TAD [200 /PUT IN PAGE BIT
743 SKP
744PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO)
745 TAD OPCODE /PLUS OPCODE
746 JMS I [OUTWRD /OUTPUT WORD
747 JMP I [NEXTST
748NOTIND, 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
762ADRGET, 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 <
768LITERR, 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 <
776PDP8MR, 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
809XITEMP,
810SUBX, 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
825BIERR, 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/
833CLRSCT, 0
834 TAD (PNDL+3
835 DCA LTEMP /POINT TO USER SYMBOL SPACE
836 CDF FLD1
837CSLOOP, 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
849NOTSCT, 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/
865NOREL, 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
872DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS
873 DCA DPFLG /DP HARDWARE
874 JMP I [NEXTST
875/ SET BASE AND INDEX LOCS
876INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
877BASEX, 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.
887DELFIL, 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/
903PRNTLN, 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
912PRLNXT, 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
919PRLTST, ISZ LINSIZ /CHECK COUNT
920 JMP PRLNXT
921 JMP I PRNTLN
922TABIT, 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/
933CRLF, 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
976RFORMF, 0
977/
978/ PRINT TEXT
979/
980PRTXT, 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
992PRTTMP= PRNTLN
993/
994PRINT2, 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/
1003P1, 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/
1014TTYOUT, 0
1015 TLS
1016 TSF
1017 JMP .-1
1018TTYCLA, 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/
1026P2, 0
1027/
1028 IFZERO RALF <
1029TXLNK, TEXT " LINKS"
1030TXLLN= .-TXLNK >
1031 IFNZRO RALF <
1032TXABR, TEXT " ABS REFS"
1033TXALN= .-TXABR >
1034 PAGE
1035\f/
1036/ GET AND EVALUATE AN EXPRESSION
1037/
1038EXPR, 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 -
1052SYMBOL, 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
1062SCTN, 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
1075ENDEXP, 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
1089OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN
1090BAD, JMS CKCTC
1091 CLA
1092 JMP I EXPR /AND RETURN
1093/
1094NOSYM, 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
1105ISQUOT, DCA WORD1
1106 TAD I CHRPTR
1107 JMP CLR2
1108CKCTC, 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
1123ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0
1124 TAD I X10 /GET REST OF SYMBOL
1125CLR2, DCA WORD2
1126 CDF FLD0 /FIX FIELD
1127ADREXP, 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
1132ADROP, 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*
1152OPR8R, 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
1158FINDOP, 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
1166NOOPR, 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
1181ADRSUB, 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
1199ADRASX, TAD EXPVAL+1
1200 AND (7767 /PREVENT CARRY INTO BIT 8
1201ADRASY, 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
1206INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER
1207BASEX, 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
1222ADROR, 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
1232ADRAOX, 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
1244ADRDIV, 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
1277PDPOR, 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
1288TRYEXP, 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
1299TXSYM, TEXT " SYMBOLS,"
1300 TXSLN=.-TXSYM
1301 PAGE
1302\f IFZERO RALF <
1303/
1304/ LITERAL THINGS
1305/
1306CHKLIT, 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/
1324MAKLNK, 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
1334CRLIT, 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
1339NOTP0, 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
1351DOLIT, 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
1357NOTIT, 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
1370LITADR, 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
1377RETLIT, 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
1402LITBAS, 0
1403NWUSED, 0
1404LITPTR, 0
1405PAGENO, 0
1406XPAGE, 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/
1413FIND, 0 /SYMBOL TABLE LOOKUP
1414 TAD BUCKET /GET BUCKET ADDRESS
1415 CDF FLD1 /GO TO FIELD 1
1416LOOK, 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
1443NOTSAM, 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/
1450LOOKUP, 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/
1482NUMBER, 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
1487NUMLUP, 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
1508OCTNUM, TAD NUM
1509 AND [7770 /CHECK FOR 8 OR 9
1510 SZA CLA
1511 ISZ NOFLO /SET ERROR FLAG
1512ADDDGT, 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
1535NOFLO= LOOKUP /ZERO IF NO ERRORS
1536NUM= FIND
1537NUM1= EXTMP
1538NUM2= EXTMP2
1539NSWTCH, /ZERO IF NO DIGITS
1540SHIFT, 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/
1555BACK1, 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/
1568GETCHR, 0
1569 JMS GETAC
1570GETSKP, ISZ GETCHR /SKIP RETURN
1571 JMP I GETCHR
1572BLANK, 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
1579SEMICL, ISZ SCSWT
1580 JMS BACK1 /PUT BACK SEMI COLON
1581 JMP I GETCHR
1582GETAC, 0
1583 ISZ NCHARS /END OF LINE?
1584 JMP .+4 /NO, GET IT
1585GETCND, 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/
1606GETNAM, 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
1619ISSYM, 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
1638GNC, 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/
1649LETTER, 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
1658NLETR, ISZ LETTER
1659 JMP I LETTER
1660/
1661/ IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP
1662/
1663DIGIT, 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
1673NDIGT, JMS BACK1
1674 JMP I DIGIT
1675/
1676R6L, 0
1677 CLL RTL
1678 RTL
1679 RTL
1680 JMP I R6L
1681/
1682R6R, 0
1683 RTR
1684 RTR
1685 RTR
1686 AND [77
1687 JMP I R6R
1688 PAGE
1689\f/
1690/ BUILD AN INSTRUCTION
1691/
1692FIXOPC, 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
1706ZRONDX, TAD OPCODE /ADD OPCODE
1707 TAD (400 /TURN ON TYPE BIT
1708 DCA OPCODE /SAVE OPCODE
1709 JMP I FIXOPC /RETURN
1710/
1711OPR8RS,
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/
1723ERMSG1, 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 <
1731RETSYS, >
1732 TSF /FINISH TYPING
1733 JMP .-1
1734 JMP I [7600 /EXIT TO PS8
1735/
1736/ GENERAL GARBAGE TYPE ERRORS
1737/
1738ERMSG, 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
1756PLINE, JMS I (PRNTLN
1757 JMS I [CRLF
1758 ISZ ERRORS /BUMP COUNT
1759MSGDUN, ISZ ERMSG
1760 JMP I ERMSG
1761\f/
1762/ OUTPUT DECIMAL
1763/ SUPPRESS LEADING ZEROS
1764/ PRINT "NO" INSTEAD OF "0"
1765/
1766DECOUT, 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/
1781DECNO, TAD (1617 /NO
1782 JMS I [PRINT2
1783 JMP I DECOUT
1784/
1785/ LAZY MAN'S DIVISION
1786/
1787DEC2, 0
1788 CDF FLD0 /JUST TO MAKE SURE
1789DEC3, 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
1799DEC4, 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/
1809TENTH, -111
1810 1463;1463;1463
1811 1463;1463;1463
1812TEN, 1
1813PDIG, 0
1814 TAD P260
1815 JMS I PC
1816 JMP I PDIG
1817P260, 260
1818 5
1819/
1820/ OCTAL CONVERSION, THE HARD WAY
1821/
1822OCTOUT, 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:
1842TTABS= 0400
1843TTORG= 1000
1844TTREL= 1400
1845/
1846OUTREL, 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
1872PUTABS, ISZ ABREFS /COUNT IT
1873 ISZ LINKSW /SET FLAG
1874PRNTRL, TAD WRD /GET FIRST WORD
1875 JMS OUTWRD
1876 TAD FPPADR+1
1877 JMS OUTWRD
1878 JMP I [NEXTST >
1879\f/
1880OUTWRD, 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
1920INABS, 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
1944ENDOUT, JMS BMPLOC /BUMP LOC CNTR
1945 JMP I OUTWRD /RETURN
1946/
1947WRD,
1948BMPLOC, 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/
1960NOPNCX, CLA IAC
1961ENPNCX, DCA PNCHOF
1962 JMP I [NEXTST
1963/
1964/ OUTPUT AN ORIGIN
1965/
1966PUTORG, 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
1978OWTEMP,
1979CHAROO, 0
1980OOCHAR, 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/
1996RESET, 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/
2042ENDX, 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/
2062EOP2, 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
2081START3, 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/
2094EOP3, CLA CMA
2095 DCA LINPAG
2096 JMS I [CRLF
2097NOP3, JMS I (7607 /READ IN OVERLAY
2098 0100
2099OVERLY, OVBUFR
2100 40 /USE SYS SCRATCH BLK
2101 JMP I (7605
2102 JMP I OVERLY
2103
2104CHCKMR, 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
2114ADRERR, 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
2122IOERR, TAD INOP /REMOVE JMS PRNTLN
2123 DCA PLINE
2124 JMS I [ERMSG1
2125 1117 /**IO**
2126INOP, NOP
2127
2128 PAGE
2129\f IFZERO RALF <
2130/ ORG THINGS FOR ABSOLUTE ASSEMBLIES
2131/
2132TRYSTR, 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
2137ORGX, 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
2160SAMFLD, 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
2171SAMPAG, TAD EXPVAL+2
2172 DCA LOCTR2
2173 JMS I (PUTORG
2174 JMP I [NEXTST /DONE
2175PAGEX, 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
2215LITLUP, 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
2222DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH
2223 DCA OUTSWT
2224 JMP I DMPLIT /ALL DONE
2225SWTOUT, 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
2246TMP, 0
2247 IFZERO RALF < PAGE / >
2248\f IFNZRO RALF <
2249/
2250/ IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER
2251/
2252RETSYS, 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
2288LDRBLK, 0 /FIRST BLOCK OF LOADER
2289/
2290PASBLK, 0 /FIRST BLOCK OF FILE PASSED
2291CHNSW, 0 /-1 TO ENABLE CHAIN LOADER
2292\f/
2293/ OUTPUT A BLOCK OF BINARY
2294/
2295OUTBLK, 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
2303MOUBUF, OUBUF-1
2304/
2305TYPCOD, 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
2342BOCHKL, 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
2348BOSETL, TAD LOCTR2
2349 DCA I LTEMP
2350BOXIT, CLA
2351 CDF FLD0
2352 JMP I BORG /WHEW!
2353BOTMP= 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
2379ESDTMP= EXTMP
2380/
2381/ RELOCATION CONTROL PSEUDO-OPS
2382/
2383ENTRX, 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
2393QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1
2394 1105 /*IE*
2395OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT
2396 JMP I [NEXTST
2397\f/
2398EXTRNX, 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
2406ESDERR, JMS I [ERMSG
2407 0523 /*ES*
2408 JMP I [NEXTST
2409/
2410 CLA IAC /FIELD1 SECT=11
2411 IAC /COMMZ SECT=10
2412SECT8X, TAD [7
2413 JMP COMMX+1
2414SECTX, CLA IAC
2415COMMX, 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/
2427CRESD, 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/
2442NEWSCT, JMS CRESD /CREATE AN ESD
2443SETSCT, 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/
2452ORGX, 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
2463PUTORG, 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/
2486LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY
2487LSTOFX, DCA LISTSW
2488 JMP I [NEXTST
2489/
2490DECX, CLA IAC
2491OCTALX, DCA RADIX
2492 JMP I [NEXTST
2493/
2494TEXTX, JMS I [GETCHR /GET DELIMITER
2495 JMP I [NEXTST /NULL STMT
2496 CIA
2497 DCA EXTMP /SAVE - DELIM
2498LOOP6B, 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
2507OUTTXT, TAD LTEMP /PUT OUT HALF WORD
2508 JMS I [OUTWRD /OR ZERO WORD
2509 JMP I [NEXTST
2510GETCHT, 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/
2527IFNZRX, CLA CMA
2528IFZROX, JMS GETCON /GET CONDITION EXPR
2529 TAD EXPVAL+1 /HIGH ORDER
2530 AND [7
2531 SNA
2532 TAD EXPVAL+2 /LOW ORDER
2533SWTCH, SNA CLA
2534 JMP TRUE /PRESENT CONDITION OF ASMOF IS OK
2535FALSE, TAD ASMOF /GOTTA REVERSE IT
2536 CMA
2537 DCA ASMOF /THAT DOES IT
2538TRUE, 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/
2550GETCON, 0
2551 DCA ASMOF /SET INITIAL TRUTH
2552 JMS I [EXPR /COLLECT EXPR
2553 JMP OKCND /BAD MAY MEAN GOOD
2554BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD
2555 1103 /*IC*
2556 DCA ASMOF /ENABLE ASSEMBLY
2557 JMP I (ASMBL
2558OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST?
2559 SNA CLA
2560 JMP I GETCON /YES
2561 JMP BADCND
2562/
2563IFNEGX, CLA CMA
2564IFPOSX, JMS GETCON
2565 CLA CLL IAC RTL /4
2566 AND EXPVAL+1 /SIGN OF EXPR
2567 JMP SWTCH /GO FROM THERE
2568/
2569IFNDFX, CLA CMA
2570IFREFX, 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
2579IFNSWX, 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/
2601ZBLKX, 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
2614ZBCNT= EXTMP
2615ZBTMP= EXTMP2
2616 PAGE
2617
2618
2619\f PTP=20
2620 DCB=7760
2621 INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER
2622 OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER
2623IN7400, 7400
2624NINCTL, INCTL+1
2625NINREC, INRECS
2626IOPEN, 0
2627 TAD (7617
2628 DCA INFPTR /RESET FILE POINTER
2629 JMS INNEWF /FETCH NEW HNDLR, ETC
2630 /WHILE USR IS STILL IN CORE
2631 CLA CMA
2632 DCA INCHCT /FORCE A READ ON NEXT CHAR
2633 JMP I IOPEN
2634
2635ICHAR, 0
2636IN7600, 7600
2637INCHAR, CDF INFLD
2638 ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH
2639 ISZ INCHCT
2640INJMPP, JMP INJMP
2641 TAD INEOF
2642 SZA CLA /DID LAST READ GIVE EOF ?
2643GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE
2644 TAD INCTR
2645 CLL
2646 TAD NINREC
2647 SNL
2648 DCA INCTR /RESTORE INCR IF NOT OVERFLOWED
2649 SZL /IS THIS THE LAST READ?
2650 ISZ INEOF /YES - SET END-OF-FILE FLAG
2651 CLL CML CMA RTR /MAKE CONTROL WORD
2652 RTR /FROM THE AMOUNT OF THE OVERFLOW
2653 RTR /(IF ANY) AND THE STANDARD CNTRL WD
2654 TAD NINCTL
2655 DCA INCTLW
2656 CDF
2657 JMS I INHNDL /CALL THE DEVICE HANDLER
2658INCTLW, 0
2659INBUFP, INBUF
2660INREC, 0
2661 JMP INERRX /SOME KIND OF HANDLER ERROR
2662INBREC, TAD INREC
2663 TAD NINREC
2664 DCA INREC /UPDATE THE RECORD NUMBER
2665 TAD INCTLW
2666 AND IN7600
2667 CLL RAL
2668 TAD INCTLW
2669 AND IN7600
2670 CMA
2671 DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT
2672 TAD INJMPP
2673 DCA INJMP /RESET THE CHARACTER SWITCH
2674 TAD INBUFP
2675 DCA INPTR /AND THE WORD POINTER
2676 JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED
2677INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE
2678 SMA CLA /WHICH TYPE WAS IT ?
2679 JMP INBREC /END OF FILE - RESUME PROCESSING
2680 JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE
2681INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH
2682 JMP ICHAR1
2683 JMP ICHAR2
2684 TAD INJMPP
2685 DCA INJMP
2686 TAD I INPTR
2687 AND IN7400
2688 CLL RTR
2689 RTR /COMBINE HIGH-ORDER FOUR BITS OF
2690 TAD INCTLW
2691 RTR /THE 2 WORD TO FORM THE 3RD CHAR
2692 RTR
2693 ISZ INPTR
2694 JMP INCOMN
2695ICHAR2, TAD I INPTR
2696 AND IN7400
2697 DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD
2698 ISZ INPTR /BUMP THE WORD POINTER
2699ICHAR1, TAD I INPTR
2700INCOMN, AND (177 /PHPH WAS 277
2701 TAD (-32 /PHPH WAS 232
2702 SNA /IS THE CHARACTER A ^Z?
2703 JMP GETNEW /YES - GET A NEW FILE
2704 TAD (232 /RESTORE THE CHARACTER /PHPH NOW WE HAVE PARITY ON!
2705 CDF
2706 JMP I ICHAR /AND RETURN
2707INFPTR, 7617
2708INEOF, 1 /PARAMETERS ARE SET UP SO THAT
2709INCHCT, /IOPEN IS UNNECESSARY.
2710INNEWF, -1
2711 TAD NINDEV
2712 DCA INHNDL /INITIALIZE HANDLER ADDRESS
2713 CDF 10
2714 TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY
2715 CDF
2716 SNA /ANY MORE?
2717 JMP I (ENDX /NO MORE INPUT
2718 CIF 10
2719 JMS I USR
2720 1 /ASSIGN, FETCH HANDLER
2721
2722INHNDL, 0
2723 JMP I [IOERR /HUH?
2724 CDF 10
2725 TAD I INFPTR
2726 AND (7760 /GET LENGTH PART OF WORD
2727 SZA /LENGTH OF 0 MEANS LENGTH GE 256
2728 TAD [17 /ADD HIGH ORDER BITS
2729 CLL CML RTR
2730 RTR
2731 DCA INCTR /STORE LENGTH OF FILE
2732 ISZ INFPTR
2733 TAD I INFPTR
2734 CDF
2735 DCA INREC /STARTING RECORD NUMBER OF FILE
2736 ISZ INFPTR
2737 DCA INEOF /ZERO END-OF-FILE FLAG
2738 JMP I INNEWF
2739INCTR, 0
2740INPTR, 0
2741OUFNAM, 0;0;0;0 /OUTPUT FILE NAME
2742NINDEV, INDEVH
2743 PAGE
2744\fOOPEN, 0
2745 TAD OUFILE /INCR OUTPUT FILE POINTER
2746 TAD (5
2747 DCA OUFILE
2748 CDF 10
2749 TAD I OUFILE /GET DEVICE CODE, LEN
2750 DCA OUELEN /HOLD IT A MO
2751 JMS I (OFNAME /GET FILE NAME INTO FIELD 0
2752 TAD OUELEN /CHECK FOR NULL FILE
2753 SNA CLA
2754 JMP ONOFIL /INHIBIT OUTPUT
2755 JMS GETUSR /LOAD USR IF NOT ALREADY IN
2756 TAD OUNAME /RESET ENTER CALL
2757 DCA OUBLK
2758 TAD NOUDEV
2759 DCA OUHNDL
2760 TAD OUELEN /THE UNIT
2761 CIF 10
2762 JMS I USR
2763 1 /ASSIGN, FETCH HANDLER
2764OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY
2765 JMP I [IOERR /HUH?
2766 TAD OUELEN /UNIT AGAIN
2767 CIF 10
2768 JMS I USR
2769 3 /ENTER OUTPUT FILE
2770OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK
2771OUELEN, 0 /REPLACED WITH LENGTH OF HOLE
2772 JMP I [IOERR /YOU BLEW IT!!!
2773 DCA OUCCNT
2774 DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG
2775 JMS I (OUSETP
2776 ISZ OOPEN
2777 JMP I OOPEN
2778ONOFIL, ISZ I (OUTINH
2779 JMP I OOPEN
2780OUTDMP, 0
2781 DCA OUCTLW /STORE THE CONTROL WORD
2782 TAD OUCCNT
2783 SNA
2784 ISZ OUCTLW
2785 TAD OUBLK
2786 DCA OUREC /COMPUTE STARTING BLOCK
2787 TAD OUCTLW
2788 JMS I [R6L
2789 AND [17 /COMPUTE THE NUMBER OF RECORDS
2790 TAD OUCCNT /UPDATE SIZE OF FILE
2791 DCA OUCCNT
2792 TAD OUCCNT
2793 CLL CML
2794 TAD OUELEN
2795 SNL SZA CLA /EXCEED GIVEN LENGTH ?
2796 JMP I [IOERR /YES - ERROR
2797 CDF
2798 JMS I OUHNDL
2799OUCTLW, 0
2800LOUBUF, OUBUF
2801OUREC, 0
2802 JMP I [IOERR
2803 JMP I OUTDMP
2804OCLOSE, 0
2805 JMS GETUSR /ENSURE USR IN CORE
2806 IFNZRO RALF <
2807 TAD PASSNO
2808 SZA CLA
2809 JMP .+6
2810 TAD (377
2811 JMS I (FULCHK /DUMP LAST BLOCK
2812 TAD OUCCNT /SAVE FILE LENGTH
2813 DCA I (OUTBLK /FOR CHAIN
2814 JMP NODUMP >
2815 JMS I (OTYPE
2816 AND (770
2817 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT
2818 SZA CLA /AND SKIP ^Z OUTPUT IF TRUE
2819 TAD (232 /OUTPUT A ^Z
2820 JMS I [OCHAR
2821FILLLP, JMS I [OCHAR
2822 JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE
2823 SPA CLA
2824 TAD [100
2825 TAD [77
2826 AND I (OUDWCT
2827 SZA CLA /UP TO THE BOUNDARY YET?
2828 JMP FILLLP /NO - FILL WITH ZEROS
2829 TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT
2830 TAD (OUCTL&3700
2831 SNA /A FULL WRITE LEFT?
2832 JMP NODUMP /YES DON'T DO IT
2833 TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS
2834 JMS OUTDMP
2835NODUMP, CIF CDF 10
2836 TAD I OUFILE
2837 CDF
2838 JMS I USR
2839 4 /CLOSE THE OUTPUT FILE
2840OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME
2841OUCCNT, 0
2842 JMP I [IOERR /ERROR WHILE CLOSING - BAD!!
2843 JMP I OCLOSE /ALL DONE
2844NOUDEV, OUDEVH
2845\f/
2846/ LOAD USR IF NOT IN CORE ALREADY
2847/
2848GETUSR, 0
2849 TAD USR /CURRENT CALL ADDR
2850 SMA CLA
2851 JMP I GETUSR /WE GOT IT
2852 CIF 10
2853 JMS I USR /THE ANSWERING SERVICE
2854 10 /CALLS THE SR
2855 TAD [200
2856 DCA USR /RESET THE CALL ADDRESS
2857 JMP I GETUSR /JES FINE
2858 PAGE
2859\fFULCHK, 0
2860 IFNZRO RALF <
2861/
2862/ IF THE RELOCATABLE BINARY OUTPUT
2863/ BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC)
2864/ FILL THE REST WITH NOP CODES AND OUTPUT THE
2865/ BLOCK.
2866/
2867 TAD OUTPTR
2868 TAD KOUBUF
2869 SPA CLA
2870 JMP I FULCHK
2871FULLUP, TAD OUTPTR
2872 TAD KOUBUF
2873 SMA CLA
2874 JMP .+4
2875 CLA IAC
2876 DCA I OUTPTR
2877 JMP FULLUP
2878 JMS I (OUTBLK
2879 JMP I FULCHK
2880KOUBUF, -OUBUF-377 >
2881/
2882/
2883/ GET SIGN CHARACTER IF ANY
2884/ BUMP LASTOP IF MINUS
2885/
2886GETSGN, 0
2887 JMS I [GETCHR
2888 JMP I GETSGN
2889 TAD (-255 /MINUS?
2890 SNA
2891 ISZ LASTOP
2892 SZA
2893 CLL CMA RAR /IF IT WAS PLUS, BECOMES 0
2894 SZA CLA /SKIP IF PLUS OR MINUS
2895 JMS I [BACK1 /OTHERWISE PUT IT BACK
2896 JMP I GETSGN
2897\f/ AS PER RICHIE LARY
2898/
2899/ SINGLE AND DOUBLE PRECISION
2900/ FLOATING POINT INPUT
2901/
2902/
2903EX, TAD M3
2904FX, TAD M3
2905 DCA DESW /STORE LENGTH
2906 TAD (-7
2907 JMS CLEAR /CLEAR FAC+OP
2908 DCA LASTOP
2909 JMS GETSGN /GET SIGN
2910 STA /CLA CMA
2911 DCA DPSW /SET NO DP
2912GETD, DCA DCNT
2913 JMS I (DIGIT /GET A DIGIT
2914 JMP LOOKP /NO
2915 DCA OTEMP /SAVE IT
2916 JMS I (FMPTEN /MULT FAC*10
2917 JMS CLEAR
2918 TAD OTEMP
2919 SZA
2920 JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0
2921 TAD DPSW
2922 CMA
2923 TAD DCNT /BUMP IF FP SEEN
2924 JMP GETD
2925\fLOOKP, JMS I [GETCHR
2926 JMP OVER /DONE
2927 TAD (-256
2928 SNA
2929 JMP DECPT
2930 TAD (256-304
2931 CLL RAR
2932 SNA CLA
2933 JMP I (EXPON /E OR D
2934DEXERR, JMS I [ERMSG
2935 0620 /FP
2936 JMP NOTNEG
2937DECPT, ISZ DPSW
2938 JMP DEXERR /2 PERIODS
2939 JMP GETD
2940/
2941OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC
2942 SNA
2943 JMP NOSCAL /NO SCALING NEEDE
2944 CLL
2945 SMA
2946 CIA CML /SIGN IN LINK,MAGNITUDE IN AC
2947 DCA DCNT /AS A COUNT
2948 SNL
2949 TAD (TENTH-TEN /OFFSET KLUDGE
2950 DCA OTEMP
2951SCALUP, TAD OTEMP
2952 JMS I (FMPTEN /MULT BY 10.0 OR 0.1
2953 ISZ DCNT
2954 JMP SCALUP
2955NOSCAL, JMS CLEAR
2956 STL RAR
2957 DCA OP+5 /ROUNDING CONSTANT
2958 JMS I (ADD
2959 TAD AC
2960 SZA CLA
2961 JMS I (NORM /WATCH IT!
2962 DCA AC+5
2963 TAD LASTOP
2964 SNA CLA /SIGN -?
2965 JMP NOTNEG /NO
2966 TAD (AC+5
2967 JMS I (SETUP
2968ACNGLP, RAL
2969 TAD I P /NEGATE FAC
2970 CLL CIA
2971 DCA I P
2972 STA
2973 TAD P
2974 DCA P
2975 ISZ CT
2976 JMP ACNGLP
2977NOTNEG, JMS CLEAR /SET UP X10
2978 TAD I X10
2979 JMS I [OUTWRD
2980 ISZ DESW /OUTPUT #
2981 JMP .-3
2982 JMP I [NEXTST
2983\fCLEAR, 0 /AC MAY NOT BE 0
2984 TAD (-7
2985 DCA CT
2986 TAD (OPX-1
2987 DCA X10
2988 DCA I X10
2989 ISZ CT
2990 JMP .-2
2991 JMP I CLEAR
2992 DCNT=FULCHK
2993 DPSW=NCTMP
2994 DESW=OPCODE
2995 PAGE
2996\f OVBUFR=.
2997FAD, 0 /FLOATING ADD DIGIT IN AC
2998 DCA OP
2999 TAD (13
3000 DCA OPX
3001ALNLP, TAD OPX
3002 CIA
3003 TAD ACX
3004 SNA /ALIGNED?
3005 JMP GOADD /YES
3006 SMA CLA
3007 TAD (OPX-ACX
3008 JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1
3009 JMP ALNLP /TRY AGAIN
3010GOADD, JMS ADD /ADD FRACTIONS
3011 JMS NORM /NORMALIZE RESULT
3012 JMP I FAD /RETURN
3013/
3014RSHFT, 0 /SHIFT RIGHT
3015 TAD (ACX /DEFAULT IS FAC
3016 JMS SETUP
3017 ISZ I P /BUMP EXPONENT
3018RSLP, ISZ P
3019 TAD I P
3020 RAR
3021 DCA I P
3022 ISZ CT
3023 JMP RSLP
3024 JMP I RSHFT
3025/
3026ADD, 0 /ADD TO FAC
3027 TAD (OP+5
3028 DCA PP2
3029 TAD (AC+5
3030 JMS SETUP
3031ADDLP, RAL /CARRY
3032 TAD I PP2
3033 TAD I P
3034 DCA I P /ADD ONE WORD
3035 STA
3036 TAD P /COMPLEMENT LINK
3037 DCA P
3038 STA
3039 TAD PP2 /COMPLEMENT LINK
3040 DCA PP2
3041 ISZ CT
3042 JMP ADDLP
3043 JMP I ADD
3044\fNORM, 0 /NORMALIZE FAC
3045 TAD AC
3046 SPA CLA /CHECK FOR OVERNORMALIZATION
3047 JMS RSHFT /AND CORRECT
3048NORMLP, STL RTR
3049 AND AC
3050 SZA CLA /NORMALIZED?
3051 JMP I NORM /YES
3052 TAD (AC+5
3053 JMS SETUP
3054LSLP, TAD I P
3055 RAL /LEFT SHIFT
3056 DCA I P /FAC 1 BIT
3057 STA CML /COMPLEMENT LINK
3058 TAD P
3059 DCA P
3060 ISZ CT
3061 JMP LSLP
3062 STA
3063 TAD ACX /BUMP EXP
3064 DCA ACX /DOWN 1
3065 JMP NORMLP
3066\fFMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1
3067 TAD (TEN
3068 JMS SETUP
3069 TAD AC
3070 SNA CLA /AC=0 MEANS RESULT=0
3071 JMP I FMPTEN
3072 TAD I P
3073 TAD ACX /FUDGE FAC
3074 DCA ACX /EXPONENT
3075 TAD (MUX
3076 DCA X11
3077 TAD (ACX
3078 DCA SETUP
3079 TAD (OPX
3080 DCA X10
3081 DCA MUX /CLEAR MULT TEMP EXP
3082MPLP1, ISZ SETUP
3083 TAD I SETUP /MOVE FAC
3084 DCA I X10 /TO OP
3085 DCA I SETUP /CLEAR FAC
3086 ISZ P
3087 TAD I P /MOVE MULTIPLIER
3088 DCA I X11 /TO MULT TEMP
3089 ISZ CT
3090 JMP MPLP1
3091/
3092MPLP2, TAD (MUX-ACX
3093 JMS RSHFT /SHIFT MULT TEMP RIGHT 1
3094 SZL
3095 JMS ADD /ADD IF LOW ORDER BIT WAS 1
3096 JMS RSHFT /SHIFT FAC RIGHT
3097 TAD MU+5
3098 SZA CLA /12 SUCCESSIVE 0 BITS
3099 JMP MPLP2 /IN MULTIPLIER MEANS DONE
3100 JMS NORM
3101 JMP I FMPTEN
3102/
3103SETUP, 0 /COMMON CODE
3104 DCA P
3105 TAD (-6
3106 DCA CT
3107 CLL
3108 JMP I SETUP
3109/
3110MUX, 0 /MULT TEMP
3111MU, ZBLOCK 6
3112 CT=CPTMP
3113 P=EXTMP
3114 PP2=PAGEN
3115\f PAGE
3116\f IFNZRO RALF <
3117ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN
3118 PNDL /DITTO FOR BLANK COMMON
3119 ZBLOCK 376 /FILL TO 400 LOCS
3120/
3121/ BEGIN OF PASS 2:
3122/ DUMP EXTERNAL SYMBOL DICTIONARY
3123/ DURING PASSES 2 AND 3, THIS IS INPUT BUFFER
3124/
3125DMPESD, CLA CLL CMA RAL /-2
3126 DCA EXTMP2 /PASS CONTROL
3127 TAD (3 /RALF OUTPUT IDENTIFIER
3128 DCA I OUTPTR
3129 TAD VERS
3130 DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES
3131 TAD DPFLG /4000=NEED DP HARDWARE
3132 DCA I OUTPTR /EXACTLY FILL A BLOCK
3133 DCA I OUTPTR
3134ESDSCN, TAD (ESDBUF-1
3135 DCA X10 /POINT TO POINTERS
3136 TAD (ESDBUF+177
3137 DCA X12 /POINT TO INITAIL CHARS
3138 TAD ESDNO
3139 CIA
3140 DCA EXTMP
3141ESDLUP, TAD (-3
3142 DCA LTEMP /NAME LENGTH COUNT
3143 TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME
3144 DCA X13
3145 TAD I X10 /GET POINTER
3146 DCA X11
3147 TAD I X12 /GET FIRST CHAR
3148 SNA /BLANK BECOMES #
3149 TAD (43
3150ESDNLP, JMS I [R6L
3151 DCA EQUN+2
3152 CDF FLD1
3153 TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE
3154 DCA EQUN+3 /HOLD IT
3155 CDF FLD0
3156 TAD EQUN+3
3157 JMS I [R6R /GET LEFT CHAR
3158 TAD EQUN+2 /COMBINE THEM
3159 DCA I X13
3160 TAD EQUN+3 /GET RIGHT HALF OF PAIR
3161 AND [77
3162 ISZ LTEMP
3163 JMP ESDNLP
3164 AND [37 /DROP FORCE BIT FROM TYPE
3165 DCA EQUN+3
3166 CDF FLD1
3167 TAD I X11 /HIGH VALUE
3168 DCA EQUN+4
3169 TAD I X11 /LOW VALUE
3170 DCA EQUN+5
3171 CDF FLD0
3172 TAD EXTMP2 /WHAT PASS IS THIS?
3173 RAR /LINK 0 IF FIRST, 1 IF SECOND
3174 SNL CLA
3175 JMP NOENTS /FIRST, ENTRYS NOT OUTPUT
3176 TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND
3177 CLL RAR
3178 SNA CLA
3179 SNL
3180 JMP ESDLND /NO GO
3181 JMP ESDOUT /YES, PUT IT
3182NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN
3183 CLL RAR
3184 SNA /SKIP IF OK
3185 JMP ESDLND /UNDEFINED OR ENTRY
3186 RAR
3187 SNA CLA
3188 JMP ESDOUT /IF EXTERN, DO IT
3189 TAD EQUN+4 /IF SECTION, CHECK
3190 AND [7 /THAT LENGTH
3191 SNA /IS NON-ZERO
3192 TAD EQUN+5
3193 SNA CLA
3194 JMP ESDLND /ZERO LEN JUST GETS IN THE WAY
3195ESDOUT, TAD (EQUN-1
3196 DCA X13
3197 TAD (-6
3198 DCA LTEMP
3199 TAD I X13 /GET OUTPUT WORD
3200 DCA I OUTPTR
3201 ISZ LTEMP
3202 JMP .-3 /6-WORD ENTRIES
3203 TAD OUTPTR
3204 TAD OUTBUF
3205 SPA CLA
3206 JMP ESDLND /NOT END OF BLOCK YET
3207 JMS I (OUTBLK
3208 TAD (3
3209 DCA I OUTPTR
3210 DCA I OUTPTR
3211 DCA I OUTPTR
3212 DCA I OUTPTR
3213ESDLND, ISZ EXTMP /GO THRU ESD LIST
3214 JMP ESDLUP
3215 ISZ EXTMP2 /WHOLE LIST TWO PASSES
3216 JMP ESDSCN
3217 TAD (-6 /THEN STORE END-OF-ESD
3218 DCA LTEMP
3219 DCA I OUTPTR
3220 ISZ LTEMP
3221 JMP .-2
3222 TAD (377 /FORCE BLOCK OUTPUT
3223 JMS I (FULCHK
3224 CDF FLD1 /THEN DEFAULT ORG
3225 TAD I (LMAIN /IF MAIN LEN .NE. 0
3226 AND [7
3227 SNA
3228 TAD I (LMAIN+1
3229 CDF FLD0
3230 SNA CLA
3231 JMP I (RESET /FIRST SECTION WILL GET IT
3232 TAD (TTORG+1 /ORG TO ZERO OF MAIN
3233 DCA I OUTPTR
3234 DCA I OUTPTR
3235 DCA I OUTPTR
3236 JMP I (RESET
3237OUTBUF, 1001
3238 PAGE />
3239\f/
3240/ INITIALIZATION CODE
3241/
3242BEGIN, JMP CHNIN /IF ENTERED BY CHAIN
3243GCMND, CIF 10 /IF ENTERED BY .R, ETC
3244 JMS I USR /USR IS LEFT OVER
3245 5 /DECODE
3246 IFZERO RALF <
3247 620 /DEFAULT EXT = .FP>
3248 IFNZRO RALF <
3249 2201 /DEFAULT EXT = .RA>
3250 DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED
3251CHNIN, JMS I (7607
3252 4100 /TEMP WRITE OUT OVERLAY
3253 6600 /NOW AT 6600
3254 40 /TO SYS SCRATCH BLK 40
3255 JMP I (7605 /ERROR
3256 CDF 10
3257 IFNZRO RALF <
3258 TAD I [7600 /BIN FILE UNIT
3259 AND NP17
3260 SNA /IS THERE ONE?
3261 JMP DEFBIN /NO, SET DEFAULT
3262 TAD (7757 /POINT TO DEV CTRL WORD
3263 DCA WORD1
3264 TAD I WORD1
3265 SPA CLA
3266 JMP OKBIN /FILE-STRUCTURED, OK
3267 CDF 0
3268 JMS I (PRTXT /TYPE MESSAGE
3269 TXBBIN-1
3270 -TXBLN
3271 JMS I [CRLF
3272 JMP GCMND /TRY AGAIN
3273/
3274DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS
3275 DCA I [7600 /SET UNIT
3276 TAD [7600
3277 DCA X10 /SET POINTER
3278 TAD (0617 /FO
3279 DCA I X10
3280 TAD (2224 /RT
3281 DCA I X10
3282 TAD (2216 /RN
3283 DCA I X10 /FORTRN.
3284 DCA I X10
3285 CDF 0
3286 JMP I (NOEXT /NOW, OPEN THE FILE>
3287\fOKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE
3288 JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE
3289GBIN, CDF 10
3290 TAD I (7644
3291 AND (20
3292 SNA CLA
3293 ISZ SYONLY /=NO SLASH T
3294 CDF 0
3295 JMS I (NEW /**SEE IF NEED 2 PG HANDLER
3296 7600
3297 JMS I (OOPEN
3298 DCA BFILE
3299 IFNZRO RALF <
3300 TAD R41 /L OR G SWITCH**
3301 CDF 10
3302 AND I (7643 /TEST /L OR /G SWITCH
3303 CDF 0
3304 SNA CLA /**
3305 JMP KCHN /KILL CHAIN, IT'S SET
3306 CIF 10
3307 CLA IAC /UNIT IS SYS
3308 JMS I USR
3309 2 /LOOKUP
3310LBLK, LDRNAM /LOADER.SV
3311R41, 41 /**
3312 JMP KCHN /NO FIND, NO CALL
3313 TAD LBLK /STARTING BLOCK
3314 DCA I (LDRBLK /FOR CHAIN
3315 TAD I (OUBLK /OUTPUT STARTING BLOCK
3316 DCA I (PASBLK /SAVED FOR CHAIN TO LOADER
3317 CLA CMA /ENABLE CHAIN
3318KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER>
3319 JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS
3320 JMS I (INNEWF /GET INPUT HANDLER
3321 CLA CMA
3322 DCA I (INCHCT /SET INITIAL COUNT
3323 TAD NP7700
3324 DCA USR /FROM NOW ON, USE THE HIGH CALL
3325\f JMS I (NEW
3326 7605 /CHECK LIST DEV TOO**
3327 CDF 10
3328 TAD I (7611 /LST FILE EXT
3329 SNA
3330 TAD (1423 /LS DEFAULT
3331 DCA I (7611
3332 TAD I (7666 /GET DATE
3333 DCA WORD1
3334/
3335/ MOVE SYMBOL TABLE TO ITS PROPER LOCATION
3336/
3337 TAD (1777
3338 DCA X10 /LOADED ADDRESS OF SYMBOL TABLE
3339 CLA CMA
3340 DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS
3341 TAD (-FREE /LENGTH OF SYMBOL TABLE
3342 DCA WORD2 /SET COUNT
3343 TAD I X10
3344 DCA I X11 /THIS SAVES SWAPS OF USR
3345 ISZ WORD2
3346 JMP .-3
3347 CDF 0
3348 JMP I (GDATE /CHECK FOR FPP PRESENCE**
3349 PAGE
3350\f/
3351/ PUT THE DATE INTO THE PAGE HEADING
3352/
3353GDATE, TAD (1000
3354 DCA I (7746 /SET NO-RESTART BIT
3355 /PUT VERNUM IN TITLE LINE
3356 TAD VMSG
3357 DCA I (VMTXT
3358 TAD VMSG+1 /PATCH LEVEL
3359 DCA I (VMTXT+1
3360 DCA OCNT /CLEAR OCNT
3361 TAD WORD1 /RE-GET DATE
3362 SNA
3363 JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED
3364 AND (370
3365 CLL RTR
3366 RAR
3367 TAD (-12
3368 SPA
3369 JMP .+3
3370 ISZ OCNT
3371 JMP .-4
3372 TAD (72 /60+12
3373 DCA OTEMP
3374 TAD (TITDAT-1
3375 DCA X11
3376 TAD OCNT
3377 JMS I (R6L
3378 SZA
3379 TAD (6000
3380 TAD OTEMP
3381 DCA I X11
3382 TAD WORD1
3383 AND (7400 /MONTH
3384 JMS I (R6L
3385 TAD (MONTHS-3
3386 DCA X10
3387 TAD I X10
3388 DCA I X11
3389 TAD I X10
3390 DCA I X11
3391 DCA OCNT
3392 TAD WORD1
3393 AND [7
3394 DCA OTEMP
3395 TAD I (7777
3396 AND (600
3397 RTR CLL
3398 RTR
3399 TAD OTEMP
3400 TAD (106
3401\f TAD (-12
3402 SPA
3403 JMP .+3
3404 ISZ OCNT
3405 JMP .-4
3406 TAD (72
3407 DCA OTEMP
3408 TAD (5560
3409 TAD OCNT
3410 DCA I 11
3411 TAD OTEMP
3412 JMS I (R6L
3413 TAD (40
3414 DCA I X11
3415 JMP I (NEWLIN
3416VMSG, VNUM&70^10+VNUM&707+6060
3417 PATCH&77^100+40
3418 IFNZRO RALF <
3419LDRNAM, TEXT "LOAD@@SV"
3420TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED"
3421TXBLN= .-TXBBIN >
3422MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC"
3423\f PAGE
3424/PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN
3425NEW, 0
3426 TAD NT2 /CHECK IF ALREADY CHECKED
3427 SZA CLA
3428 JMP NEWDON
3429 TAD I NEW /NO. GET THE DEV TO CHECK
3430 DCA NTEMP
3431 CDF 10
3432 TAD I NTEMP /GET DEV.NUM
3433 AND [17
3434 DCA NT1 /INCHK NEEDS TO KNOW TOO
3435 TAD NT1
3436 SNA /IF 0,THEN NO DEVICE
3437 JMP NEWDON
3438 DCA NTEMP
3439 CLA CMA
3440 TAD I (37 /GET PTR TO DEV TBL
3441 TAD NTEMP
3442 DCA NTEMP /PTS TO ENTRY IN DEV TBL
3443 TAD I NTEMP
3444 CDF 0
3445 SMA CLA
3446 JMP FIX /NOT A 2 PG HANDLER
3447 TAD (6377 /FIX ALL LOCATIONS THAT REFER TO
3448/THE BUFFER VARIABLES.
3449/THE CHANGES ARE:
3450/OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200
3451/INRECS=1,INCTL=200
3452 DCA I (BLINE
3453 TAD (6000
3454 DCA I (NOUBUF
3455 IFNZRO RALF <
3456 TAD (5777
3457 DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS
3458 TAD (6601
3459 DCA I (NINDEV
3460 TAD (201
3461 DCA I (NINCTL
3462 JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER
3463 DCA I (NINREC
3464 TAD (6000
3465 DCA I (LOUBUF
3466 TAD (7201
3467 DCA I (NOUDEV
3468 TAD (5777
3469 DCA I (OUTPTR
3470 TAD (6377
3471 DCA I (CHRPTR
3472 IFNZRO RALF <
3473 TAD (1401
3474 DCA I (KOUBUF >
3475 TAD (7201
3476FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN
3477NEWDON, ISZ NEW /GET CORRECT ADDR
3478 JMP I NEW
3479NTEMP, 0
3480NT1, 0 /DEV. NUM.
3481NT2, 0 /0 IF NO 2PG HANDLERS YET
3482INCHK, 0 /CHECK THE INPUT DEVICES
3483 JMS NEW
3484INLOC, 7617
3485 TAD INLOC
3486 DCA NEXTIN
3487ANOTH, TAD NT1
3488 SNA CLA /SKIP IF FILE USED
3489 JMP I INCHK
3490 TAD NT2
3491 SZA CLA /SKIP IF STILL 1 PAGE HANDLERS
3492 JMP I INCHK
3493 TAD NP2
3494 TAD NEXTIN
3495 DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR
3496 JMS NEW
3497NEXTIN, 0
3498 JMP ANOTH
3499NP2, 2
3500NOKBIN, CDF 10 /BELONGS WITH INIT CODE
3501 TAD I [7600
3502 AND NP17
3503 TAD (7646
3504 DCA WORD1 /CREATE POINTER INTO DEV TBL
3505 TAD I WORD1
3506 CDF 0
3507 TAD (-7607
3508 SNA CLA /IF ITS SYS, NO PROBLEMS
3509 DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE
3510 CDF 10
3511 TAD I (7604
3512 SZA
3513 JMP FEND /AN EXT WAS SPECIFIED
3514 IFZERO RALF <
3515 TAD (0216 /.BN DEFAULT FOR FLAP
3516 JMP FEND >
3517 IFNZRO RALF <
3518NOEXT, CDF 10
3519 TAD I (7643 /CHECK IF L OR G SPEC
3520 AND L41
3521 SNA CLA
3522 TAD (0610 /NO-NEEDS RL EXT
3523 TAD (1404 > /YES-NEEDS LD
3524FEND, DCA I (7604
3525 CDF 0
3526 JMP I (GBIN
3527L41, 41
3528TPNSH, 0
3529 TAD (1401 /CHANGE OUTPUT BUFFER
3530 DCA I (OUTBUF
3531 IAC
3532 JMP I TPNSH
3533/
3534 PAGE
3535\fLDADR, RELOC OVBUFR
3536 TAD ERRORS /ERROR COUNT
3537 JMS I (DECOUT
3538 JMS I (PRTXT /"ERRORS"
3539 TXERR-1
3540 -TXELN
3541 JMS I [CRLF
3542 IFZERO RALF <
3543 TAD PASSNO /IF NOT LISTING PASS
3544 SPA SNA CLA /ERROR COUNT IS ENUF
3545 JMP I (RETSYS >
3546 TAD NEXT
3547 TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS
3548 CLL RAR /DIVIDE
3549 JMS I (OVER3 /BY 6
3550 JMS I (DECOUT
3551 JMS I (PRTXT /"SYMBOLS, "
3552 TXSYM-1
3553 -TXSLN
3554 IFZERO RALF <
3555 TAD LINKS
3556 JMS I (DECOUT
3557 JMS I (PRTXT /"LINKS"
3558 TXLNK-1
3559 -TXLLN >
3560 IFNZRO RALF <
3561 TAD ABREFS
3562 JMS I (DECOUT
3563 JMS I (PRTXT /"ABS REFS"
3564 TXABR-1
3565 -TXALN >
3566 JMS I [CRLF
3567 TAD (-33 /27 BUCKETS
3568 DCA LTEMP
3569 DCA BUCKET
3570 CLA CMA
3571 DCA OPCODE /SYMBOLS PER LINE COUNTER
3572\fSTPRNT, TAD BUCKET
3573 DCA EXTMP /BUCKET START ADDRESS
3574LUPBKT, CDF FLD1
3575 TAD I EXTMP /WAS THAT LAST SYMBOL ?
3576 SNA
3577 JMP NXTBKT /YES, GO GET NEXT BUCKET
3578 DCA EXTMP /SAVE LINK ADDR
3579 TAD EXTMP
3580 DCA X14 /SET UP POINTER FOR NAME
3581 ISZ OPCODE /IS LINE FULL?
3582 JMP .+4 /NO
3583 TAD (-4
3584 DCA OPCODE
3585 JMS I [CRLF
3586 TAD BUCKET
3587 SNA /WATCH FOR #
3588 TAD (43
3589 JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR
3590 CDF FLD1
3591 TAD I X14 /SYMBOL
3592 JMS I [PRINT2 /PRINT 2 AND 3
3593 CDF FLD1
3594 TAD I X14
3595 JMS I [PRINT2 /PRINT 4 AND 5
3596 CDF FLD1
3597 TAD I X14
3598 IFNZRO RALF <
3599 DCA OTEMP /HOLD
3600 TAD OTEMP >
3601 AND [7700 /PRINT 6 AND BLANK
3602 JMS I [PRINT2
3603 IFNZRO RALF <
3604 TAD OTEMP /GET TYPE
3605 AND [17
3606 TAD (TYPCOD /POINT TO TABLE
3607 DCA OTEMP
3608 TAD I OTEMP /GET TYPE INDICATOR
3609 JMS I [PRINT2 >
3610 CDF FLD1
3611 TAD I X14 /PRINT FIRST DIGIT
3612 AND [7
3613 JMS I (PDIG /FIELD DIGIT
3614 CDF FLD1
3615 TAD I X14 /LOW 12 BITS
3616 JMS I [OCTOUT
3617 JMS I [PRINT2 /TWO BLANKS
3618 JMP LUPBKT
3619\fNXTBKT, ISZ BUCKET /NEXT BUCKET CHAR
3620 CDF FLD0
3621 ISZ LTEMP /INCREMENT COUNT
3622 JMP STPRNT
3623 JMS I [CRLF /DO FINAL CRLF**
3624 TAD (214 /DO NOT PAGEJ
3625 JMS I PC /THAT WOULD GIVE A HEADING
3626 JMS I (OCLOSE
3627 JMP I (RETSYS /FINISH IT OFF
3628 PAGE
3629 RELOC
3630\f/ PAGE 0 LITERALS
3631 FIELD 1
3632 *10000
3633\f/
3634/ SYMBOL TABLE IS IN FIELD ONE.
3635/ EACH ENTRY HAS THE FOLLOWING FORMAT
3636/
3637/ 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST
3638/ 1: 2ND AND 3RD CHARS OF SYMBOL
3639/ 2: 4TH AND 5TH
3640/ 3: 6TH AND TYPE CODE
3641/ 4: ESD # AND HIGH-ORDER VALUE
3642/ 5: LOW-ORDER VALUE
3643/
3644 USER=1
3645 XTERN=2
3646 COMMN=3
3647 SECTN=4
3648 PSUDO=5
3649 PDPMR=6
3650 FPPMRF=7
3651 FPPSF1=10 /JXN, TRAP
3652 FPPSF2=11 /JA, SETB, SETX
3653 FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM,
3654 /PAUS, JAC, STARTD, STARTF
3655 FPPSF4=13 /ALN, ATX, XTA
3656 FPPSF5=14 /ADDX, LDX
3657 FPPMRI=15 /%
3658 FPPMRS=16 /'
3659 FPPMRL=17 /#
3660 PDPOP=20
3661/
3662/ THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING
3663/ THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT,
3664/ THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE.
3665/ IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE
3666/ DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS
3667/
3668 *12000
3669 NOPUNCH
3670 *10000
3671 ENPUNCH
3672\f/
3673/ BUCKETS FOR USER-DEFINED SYMBOLS
3674/ AND PDP8 OPERATES AND IOTS
3675/
3676 PNDL
3677 ZBLOCK 33
3678\f/
3679/ BUCKETS FOR INTERNALLY DEFINED SYMBOLS
3680/
3681 AL
3682 BL
3683 CL
3684 DL
3685 EL
3686 FL
3687 GL
3688 HL
3689 IL
3690 JL
3691 KL
3692 LL
3693 ML
3694 NL
3695 OL
3696 PL
3697 QL
3698 RL
3699 SL
3700 TL
3701 UL
3702 VL
3703 WL
3704 XL
3705 YL
3706 ZL
3707\fAL, .+5 /ADDR
3708 0404;2200
3709 FPPSF2
3710 0
3711 .+5 /ADDX
3712 0404;3000
3713 FPPSF5
3714 0110
3715 .+5 /ALN
3716 1416;0
3717 FPPSF4
3718 0010
3719 IFZERO RALF <
3720 .+5 /AND
3721 1604;0
3722 PDPMR
3723 AND 0 >
3724 IFNZRO RALF <
3725 .+5 /AND .
3726 1604;0
3727 PDPMR
3728 200
3729 .+5 /AND%
3730 1604;0
3731 PDPMR+500
3732 600
3733 .+5 /ANDZ
3734 1604;3200
3735 PDPMR
3736 0
3737 .+5 /ANDZ%
3738 1604;3200
3739 PDPMR+500
3740 400 >
3741 0 /ATX
3742 2430;0
3743 FPPSF4
3744 0020
3745BL, 0 /BASE
3746 0123;0500
3747 PSUDO
3748 BASEX
3749CL, .+5 /CDF
3750 0406;0
3751 PDPOP
3752 CDF
3753 .+5 /CIA
3754 1101;0
3755 PDPOP
3756 CIA
3757 .+5 /CIF
3758 1106;0
3759 PDPOP
3760 CIF
3761 .+5 /CLA
3762 1401;0
3763 PDPOP
3764 CLA
3765 .+5 /CLL
3766 1414;0
3767 PDPOP
3768 CLL
3769 .+5 /CMA
3770 1501;0
3771 PDPOP
3772 CMA
3773 IFZERO RALF < 0 >
3774 IFNZRO RALF < .+5 >
3775 1514;0 /CML
3776 PDPOP
3777 CML
3778 IFNZRO RALF <
3779 .+5 /COMMON
3780 1715;1517
3781 PSUDO+1600
3782 COMMX
3783 0 /COMMZ (8-MODE COMM SECT)
3784 1715;1532
3785 PSUDO
3786 SECT8X-1 >
3787\fDL, IFZERO RALF <
3788 .+5 /DCA
3789 0301;0
3790 PDPMR
3791 DCA 0 >
3792 IFNZRO RALF <
3793 .+5 /DCA .
3794 0301;0
3795 PDPMR
3796 3200
3797 .+5 /DCA%
3798 0301;0
3799 PDPMR+500
3800 3600
3801 .+5 /DCAZ
3802 0301;3200
3803 PDPMR
3804 DCA 0
3805 .+5 /DCAZ%
3806 0301;3200
3807 PDPMR+500
3808 DCA I 0 >
3809 IFZERO RALF < 0 > /DECIMAL
3810 IFNZRO RALF < .+5 >
3811 0503;1115
3812 PSUDO+0100
3813 DECX
3814 IFNZRO RALF < 0 /DPCHK
3815 2003;1013
3816 PSUDO
3817 DPCHKX >
3818EL, .+5 /E
3819 0;0
3820 PSUDO
3821 EX
3822 .+5 /END
3823 1604;0
3824 PSUDO
3825 ENDX
3826 IFZERO RALF <
3827 0 /ENPUNCH
3828 1620;2516
3829 PSUDO+0300
3830 ENPNCX >
3831 IFNZRO RALF <
3832 .+5 /ENTRY
3833 1624;2231
3834 PSUDO
3835 ENTRX
3836 0 /EXTERN
3837 3024;0522
3838 PSUDO+1600
3839 EXTRNX >
3840\fFL, .+5 /F
3841 0;0
3842 PSUDO
3843 FX
3844 .+5 /FADD
3845 0104;0400
3846 FPPMRF
3847 1000
3848 .+5 /FADD#
3849 0104;0400
3850 FPPMRL+300
3851 1000
3852 .+5 /FADD%
3853 0104;0400
3854 FPPMRI+500
3855 1000
3856 .+5 /FADD'
3857 0104;0400
3858 FPPMRS+700
3859 1000
3860 .+5 /FADDM
3861 0104;0415
3862 FPPMRF
3863 5000
3864 .+5 /FADDM#
3865 0104;0415
3866 FPPMRL+300
3867 5000
3868 .+5 /FADDM%
3869 0104;0415
3870 FPPMRI+500
3871 5000
3872 .+5 /FADDM'
3873 0104;0415
3874 FPPMRS+700
3875 5000
3876 .+5 /FCLA
3877 0314;0100
3878 FPPSF3
3879 0002
3880\f .+5 /FDIV
3881 0411;2600
3882 FPPMRF
3883 3000
3884 .+5 /FDIV#
3885 0411;2600
3886 FPPMRL+300
3887 3000
3888 .+5 /FDIV%
3889 0411;2600
3890 FPPMRI+500
3891 3000
3892 .+5 /FDIV'
3893 0411;2600
3894 FPPMRI+700
3895 3000
3896 .+5 /FEXIT
3897 0530;1124
3898 FPPSF3
3899 0
3900 IFNZRO RALF <
3901 .+5 /FIELD1 (8-MODE FIELD1 SECT)
3902 1105;1404
3903 PSUDO+6100
3904 SECT8X-2 >
3905 .+5 /FLDA
3906 1404;0100
3907 FPPMRF
3908 0000
3909 .+5 /FLDA#
3910 1404;0100
3911 FPPMRL+300
3912 0000
3913 .+5 /FLDA%
3914 1404;0100
3915 FPPMRI+500
3916 0000
3917 .+5 /FLDA'
3918 1404;0100
3919 FPPMRS+700
3920 0000
3921\f .+5 /FMUL
3922 1525;1400
3923 FPPMRF
3924 4000
3925 .+5 /FMUL#
3926 1525;1400
3927 FPPMRL+300
3928 4000
3929 .+5 /FMUL%
3930 1525;1400
3931 FPPMRI+500
3932 4000
3933 .+5 /FMUL'
3934 1525;1400
3935 FPPMRS+700
3936 4000
3937 .+5 /FMULM
3938 1525;1415
3939 FPPMRF
3940 7000
3941 .+5 /FMULM#
3942 1525;1415
3943 FPPMRL+300
3944 7000
3945 .+5 /FMULM%
3946 1525;1415
3947 FPPMRI+500
3948 7000
3949 .+5 /FMULM'
3950 1525;1415
3951 FPPMRS+700
3952 7000
3953 .+5 /FNEG
3954 1605;0700
3955 FPPSF3
3956 0003
3957 .+5 /FNOP
3958 1617;2000
3959 FPPSF3
3960 0040
3961\f .+5 /FNORM
3962 1617;2215
3963 FPPSF3
3964 0004
3965 .+5 /FPAUSE
3966 2001;2523
3967 FPPSF3+0500
3968 0001
3969 .+5 /FPCOM
3970 2003;1715
3971 PDPOP
3972 6553
3973 .+5 /FPHLT
3974 2010;1424
3975 PDPOP
3976 6554
3977 .+5 /FPICL
3978 2011;0314
3979 PDPOP
3980 6552
3981 .+5 /FPINT
3982 2011;1624
3983 PDPOP
3984 6551
3985 .+5 /FPIST
3986 2011;2324
3987 PDPOP
3988 6557
3989 .+5 /FPRST
3990 2022;2324
3991 PDPOP
3992 6556
3993 .+5 /FPST
3994 2023;2400
3995 PDPOP
3996 6555
3997 .+5 /FSTA
3998 2324;0100
3999 FPPMRF
4000 6000
4001 .+5 /FSTA#
4002 2324;0100
4003 FPPMRL+300
4004 6000
4005 .+5 /FSTA%
4006 2324;0100
4007 FPPMRI+500
4008 6000
4009 .+5 /FSTA'
4010 2324;0100
4011 FPPMRS+700
4012 6000
4013 .+5 /FSUB
4014 2325;0200
4015 FPPMRF
4016 2000
4017 .+5 /FSUB#
4018 2325;0200
4019 FPPMRL+300
4020 2000
4021 .+5 /FSUB%
4022 2325;0200
4023 FPPMRI+500
4024 2000
4025 0 /FSUB'
4026 2325;0200
4027 FPPMRS+700
4028 2000
4029\fGL= 0 /AINT NONE
4030HL, 0 /HLT
4031 1424;0
4032 PDPOP
4033 HLT
4034IL, .+5 /IAC
4035 0103;0
4036 PDPOP
4037 IAC
4038 .+5 /IFFLAP
4039 0606;1401
4040 PSUDO+2000
4041 IFZERO RALF <TRUE>
4042 IFNZRO RALF <FALSE>
4043 .+5 /IFNDEF
4044 0616;0405
4045 PSUDO+0600
4046 IFNDFX
4047 .+5 /IFNEG
4048 0616;0507
4049 PSUDO
4050 IFNEGX
4051 .+5 /IFNSW
4052 0616;2327
4053 PSUDO
4054 IFNSWX
4055 .+5 /IFNZRO
4056 0616;3222
4057 PSUDO+1700
4058 IFNZRX
4059\f .+5 /IFPOS
4060 0620;1723
4061 PSUDO
4062 IFPOSX
4063 .+5 /IFRALF
4064 0622;0114
4065 PSUDO+0600
4066 IFNZRO RALF <TRUE>
4067 IFZERO RALF <FALSE>
4068 .+5 /IFREF
4069 0622;0506
4070 PSUDO
4071 IFREFX
4072 .+5 /IFSW
4073 0623;2700
4074 PSUDO
4075 IFSWX
4076 .+5 /IFZERO
4077 0632;0522
4078 PSUDO+1700
4079 IFZROX
4080 .+5
4081 1604;0530
4082 PSUDO
4083 INDXX
4084 .+5 /IOF
4085 1706;0
4086 PDPOP
4087 IOF
4088 .+5 /ION
4089 1716;0
4090 PDPOP
4091 ION
4092 IFZERO RALF <
4093 0 /ISZ
4094 2332;0
4095 PDPMR
4096 ISZ 0 >
4097 IFNZRO RALF <
4098 .+5 /ISZ .
4099 2332;0
4100 PDPMR
4101 ISZ .&7600
4102 .+5 /ISZ%
4103 2332;0
4104 PDPMR+500
4105 ISZ I .&7600
4106 .+5 /ISZZ
4107 2332;3200
4108 PDPMR
4109 ISZ 0
4110 0 /ISZZ%
4111 2332;3200
4112 PDPMR+500
4113 ISZ I 0 >
4114\fJL, .+5 /JA
4115 0100;0
4116 FPPSF2
4117 1030
4118 .+5 /JAC
4119 0103;0
4120 FPPSF3
4121 0007
4122 .+5 /JAL
4123 0114;0
4124 FPPSF2
4125 1070
4126 .+5 /JEQ
4127 0521;0
4128 FPPSF2
4129 1000
4130 .+5 /JGE
4131 0705;0
4132 FPPSF2
4133 1010
4134 .+5 /JGT
4135 0724;0
4136 FPPSF2
4137 1060
4138 .+5 /JLE
4139 1405;0
4140 FPPSF2
4141 1020
4142 .+5 /JLT
4143 1424;0
4144 FPPSF2
4145 1050
4146 IFZERO RALF <
4147 .+5 /JMP
4148 1520;0
4149 PDPMR
4150 JMP 0
4151 .+5 /JMS
4152 1523;0
4153 PDPMR
4154 JMS 0 >
4155 IFNZRO RALF <
4156 .+5 /JMP .
4157 1520;0
4158 PDPMR
4159 JMP .&7600
4160 .+5 /JMP%
4161 1520;0
4162 PDPMR+500
4163 JMP I .&7600
4164 .+5 /JMPZ
4165 1520;3200
4166 PDPMR
4167 JMP 0
4168 .+5 /JMPZ%
4169 1520;3200
4170 PDPMR+500
4171 JMP I 0
4172 .+5 /JMS .
4173 1523;0
4174 PDPMR
4175 JMS .&7600
4176 .+5 /JMS%
4177 1523;0
4178 PDPMR+500
4179 JMS I .&7600
4180 .+5 /JMSZ
4181 1523;3200
4182 PDPMR
4183 JMS 0
4184 .+5 /JMSZ%
4185 1523;3200
4186 PDPMR+500
4187 JMS I 0 >
4188\f .+5 /JNE
4189 1605;0
4190 FPPSF2
4191 1040
4192 .+5 /JSA
4193 2301;0
4194 FPPSF2
4195 1120
4196 .+5 /JSR
4197 2322;0
4198 FPPSF2
4199 1130
4200 0 /JXN
4201 3016;0
4202 FPPSF1
4203 2000
4204KL, .+5 /KCC
4205 0303;0
4206 PDPOP
4207 KCC
4208 .+5 /KRB
4209 2202;0
4210 PDPOP
4211 KRB
4212 .+5 /KRS
4213 2223;0
4214 PDPOP
4215 KRS
4216 0 /KSF
4217 2306;0
4218 PDPOP
4219 KSF
4220LL, .+5 /LAS
4221 0123;0
4222 PDPOP
4223 LAS
4224 .+5 /LDX
4225 0430;0
4226 FPPSF5
4227 0100
4228 .+5 /LISTOFF
4229 1123;2417
4230 PSUDO+0600
4231 LSTOFX
4232 0 /LISTON
4233 1123;2417
4234 PSUDO+1600
4235 LSTONX
4236\fML= 0 /NO LIST
4237NL, IFZERO RALF < .+5 >
4238 IFNZRO RALF < 0 >
4239 1720;0 /NOP
4240 PDPOP
4241 NOP
4242 IFZERO RALF <
4243 0 /NOPUNCH
4244 1720;2516
4245 PSUDO+0300
4246 NOPNCX >
4247OL, .+5 /OCTAL
4248 0324;0114
4249 PSUDO
4250 OCTALX
4251 .+5 /ORG
4252 2207;0
4253 PSUDO
4254 ORGX
4255 0 /OSR
4256 2322;0
4257 PDPOP
4258 OSR
4259 IFZERO RALF <
4260PL, 0 /PAGE
4261 0107;0500
4262 PSUDO
4263 PAGEX >
4264 IFNZRO RALF <PL=0 >
4265QL= 0 /WHAT DID YOU EXPECT?
4266RL, .+5 /RAL
4267 0114;0
4268 PDPOP
4269 RAL
4270 .+5 /RAR
4271 0122;0
4272 PDPOP
4273 RAR
4274 .+5 /RDF
4275 0406;0
4276 PDPOP
4277 RDF
4278 .+5 /REPEAT
4279 0520;0501
4280 PSUDO+2400
4281 REPETX
4282 .+5 /RIB
4283 1102;0
4284 PDPOP
4285 RIB
4286 .+5 /RIF
4287 1106;0
4288 PDPOP
4289 RIF
4290 .+5 /RMF
4291 1506;0
4292 PDPOP
4293 RMF
4294 .+5 /RTL
4295 2414;0
4296 PDPOP
4297 RTL
4298 0 /RTR
4299 2422;0
4300 PDPOP
4301 RTR
4302\fSL, .+5 /S
4303 0;0
4304 PSUDO
4305 SX
4306 IFNZRO RALF <
4307 .+5 /SECT
4308 0503;2400
4309 PSUDO
4310 SECTX
4311 .+5 /8 MODE SECT
4312 0503;2470
4313 PSUDO
4314 SECT8X >
4315 .+5 /SETB
4316 0524;0200
4317 FPPSF2
4318 1110
4319 .+5 /SETX
4320 0524;3000
4321 FPPSF2
4322 1100
4323 .+5 /SKP
4324 1320;0
4325 PDPOP
4326 SKP
4327 .+5 /SMA
4328 1501;0
4329 PDPOP
4330 SMA
4331 .+5 /SNA
4332 1601;0
4333 PDPOP
4334 SNA
4335 .+5 /SNL
4336 1614;0
4337 PDPOP
4338 SNL
4339 .+5 /SPA
4340 2001;0
4341 PDPOP
4342 SPA
4343 .+5 /STARTD
4344 2401;2224
4345 FPPSF3+0400
4346 0006
4347 .+5 /STARTE
4348 2401;2224
4349 FPPSF3+0500
4350 0050
4351 .+5 /STARTF
4352 2401;2224
4353 FPPSF3+0600
4354 0005
4355 .+5 /STL
4356 2414;0
4357 PDPOP
4358 STL
4359 .+5 /SZA
4360 3201;0
4361 PDPOP
4362 SZA
4363 0 /SZL
4364 3214;0
4365 PDPOP
4366 SZL
4367\fTL, IFZERO RALF <
4368 .+5 /TAD
4369 0104;0
4370 PDPMR
4371 TAD 0 >
4372 IFNZRO RALF <
4373 .+5 /TAD .
4374 0104;0
4375 PDPMR
4376 TAD .&7600
4377 .+5 /TAD%
4378 0104;0
4379 PDPMR+500
4380 TAD I .&7600
4381 .+5 /TADZ
4382 0104;3200
4383 PDPMR
4384 TAD 0
4385 .+5 /TADZ%
4386 0104;3200
4387 PDPMR+500
4388 TAD I 0 >
4389 .+5 /TCF
4390 0306;0
4391 PDPOP
4392 TCF
4393 .+5 /TEXT
4394 0530;2400
4395 PSUDO
4396 TEXTX
4397 .+5 /TLS
4398 1423;0
4399 PDPOP
4400 TLS
4401 .+5 /TPC
4402 2003;0
4403 PDPOP
4404 TPC
4405 .+5 /TRAP3
4406 2201;2063
4407 FPPSF1
4408 3000
4409 .+5 /TRAP4
4410 2201;2064
4411 FPPSF1
4412 4000
4413 .+5 /TRAP5
4414 2201;2065
4415 FPPSF1
4416 5000
4417 .+5 /TRAP6
4418 2201;2066
4419 FPPSF1
4420 6000
4421 .+5 /TRAP7
4422 2201;2067
4423 FPPSF1
4424 7000
4425 0 /TSF
4426 2306;0
4427 PDPOP
4428 TSF
4429\fUL= 0
4430VL= 0
4431WL= 0
4432XL, 0 /XTA
4433 2401;0
4434 FPPSF4
4435 0030
4436YL= 0
4437ZL, 0 /ZBLOCK
4438 0214;1703
4439 PSUDO+1300
4440 ZBLKX
4441\f IFZERO RALF < PNDL=0 >
4442 IFNZRO RALF <
4443PNDL, .+6 /BLANK COMMON
4444 0;0
4445 3 /CODE FOR COMMON
4446 40;0 /ESD #2, LEN=0
4447 0 /#MAIN
4448 1501;1116
4449 4 /CODE FOR SECTION
4450LMAIN, 20;0 /ESD #1, LEN=0>
4451FREE,
4452END, END /NICE WHEN FLAP ASSEMBLES
4453 $
4454\f
My complete PDP-8 universe