Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /2 PAL8 ASSEMBLER FOR OS/8 MONITOR VERSION 10 |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION | |
12 | / | |
13 | / | |
14 | / | |
15 | / | |
16 | / | |
17 | / | |
18 | / | |
19 | / | |
20 | / | |
21 | / | |
22 | /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE | |
23 | /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT | |
24 | /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY | |
25 | /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. | |
26 | / | |
27 | /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER | |
28 | /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED | |
29 | /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH | |
30 | /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. | |
31 | / | |
32 | /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE | |
33 | /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY | |
34 | /DIGITAL. | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | / | |
41 | / | |
42 | / | |
43 | / | |
44 | / | |
45 | \f/1-OCT-75 MB/MB/SM/MB/RL/JR/SR | |
46 | ||
47 | DECIMAL | |
48 | ||
49 | VERSION= 10 | |
50 | SUBVERSION= "A | |
51 | ||
52 | OCTAL | |
53 | ||
54 | /PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED | |
55 | /TO BE COMPATIBLE WITH THE OS/8 SYSTEM. | |
56 | ||
57 | /PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS | |
58 | /THE SYMBOL TABLE. | |
59 | ||
60 | /PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH | |
61 | /MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER. | |
62 | ||
63 | /PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY | |
64 | /LISTING. | |
65 | ||
66 | /PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8 | |
67 | /4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10. | |
68 | ||
69 | IFNDEF HASH<HASH=1> /DEFINE FOR HASH SYMBOL TABLE | |
70 | /SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE | |
71 | ||
72 | /MAINTENANCE RELEASE CHANGES: | |
73 | ||
74 | /1. INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS | |
75 | /2. ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN] | |
76 | /3. PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN] | |
77 | /4. FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN] | |
78 | /5. ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8] | |
79 | /6. FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975] | |
80 | /7. FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75] | |
81 | /8. FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS | |
82 | /9. CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT | |
83 | /10. ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS | |
84 | /11. CORE ALLOCATION: | |
85 | / WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS | |
86 | / WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES) | |
87 | / UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL | |
88 | /12. /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE | |
89 | /13. 14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE | |
90 | ||
91 | /JR 14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING | |
92 | \f/COMMAND DECODER RULES: | |
93 | ||
94 | /*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS | |
95 | ||
96 | /OPTIONS: | |
97 | /B BYTE SHIFT - ! IS 6 BIT SHIFT (!=^100+) | |
98 | /C CREF AFTER - "CREFLS.TM" CREATED IF NO CREF | |
99 | /D DDT TYPE SYMBOL - ONLY IF LISTING | |
100 | /E 'LG' ERROR - LINKS ARE ERRORS | |
101 | /F NO TEXT FILL - NO EXTRA 0 FILL IN 'TEXT' | |
102 | /G LOAD+GO AFTER - SAME AS /L, BUT /G PASSED TO ABSLDR | |
103 | /H NO PAGING - ONLY IF LISTING | |
104 | /J JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE | |
105 | /K CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K) | |
106 | /L LOAD AFTER - "PAL8BN.TM" CREATED IF NO BINARY | |
107 | /N NO LISTING - ONLY IF LISTING | |
108 | /O NO 200 ORG - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD' | |
109 | /S NO SYMBOL TABLE - ONLY IF LISTING | |
110 | /T CR-LF NOT FF - ONLY IF LISTING | |
111 | /W WIPE LITERALS - INHIBITS REMEMBERING OF LITERAL BOUNDS | |
112 | ||
113 | /PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS | |
114 | /OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640 | |
115 | /TO REVERSE THE POLARITY OF THE "T" SWITCH. | |
116 | ||
117 | /PSEUDO-OPS: | |
118 | /DECIMAL RADIX TO BASE 10 | |
119 | /DEVICE 2 WORD DEVICE CODE | |
120 | /DTORG TYPESETTING TAPE ORIGIN | |
121 | /EJECT SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS, | |
122 | / THAT TEXT BECOMES THE NEW HEADER LINE | |
123 | /ENPUNCH ENABLE PUNCHING | |
124 | /EXPUNGE REMOVE ALL SYMBOLS | |
125 | /FIELD SET FIELD | |
126 | /FILENAME 4 WORD FILE CODE | |
127 | /FIXMRI DEFINE MEMORY REFERENCE INSTRUCTION | |
128 | /FIXTAB MAKE ALL SYMBOLS PERMANENT | |
129 | /IFDEF CONDITIONAL ON DEFINITION | |
130 | /IFNDEF CONDITIONAL ON UNDEFINED | |
131 | /IFNZRO CONDITIONAL ON NON-ZERO | |
132 | /IFZERO CONDITIONAL ON ZERO | |
133 | /NOPUNCH DISABLE PUNCHING | |
134 | /OCTAL RADIX TO BASE 8 | |
135 | /PAGE RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N | |
136 | /PAUSE ALTERNATE END-OF-FILE | |
137 | /RELOC ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC | |
138 | /TEXT 6 BIT TEXT | |
139 | /XLIST LISTING INHIBIT UNLESS THE XLIST IS | |
140 | / FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION | |
141 | / IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING | |
142 | /ZBLOCK RESERVE BLOCK OF ZEROS | |
143 | \f/SYMBOL LAYOUT: | |
144 | ||
145 | / WORD 1 BIT 0=1 PERMANENT SYMBOL | |
146 | / BIT 1=1 "I" OR "Z" | |
147 | / BITS 3-11 CHARS 1 AND 2 | |
148 | / | |
149 | / WORD 2 BIT 0=1 MEMORY REFERENCE INSTRUCTION | |
150 | / BITS 2-11 CHARS 3 AND 4 | |
151 | / | |
152 | / WORD 3 BIT 0=1 PSEUDO-OP | |
153 | / BITS 2-11 CHARS 5 AND 6 | |
154 | / | |
155 | / WORD 4 BITS 0-11 OCTAL VALUE | |
156 | /CHARS ARE STORED AS: | |
157 | / A TO Z ARE 01 TO 32 | |
158 | / 0 TO 9 ARE 33 TO 44 | |
159 | / | |
160 | / CHAR1^45+CHAR2 | |
161 | ||
162 | /OPERATORS: | |
163 | /+ TWO'S COMPLEMENT ADD | |
164 | /- TWO'S COMPLEMENT SUBTRACT | |
165 | /& BOOLEAN AND | |
166 | /! BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT | |
167 | / (SPACE) DELIMITER OR INCLUSIVE OR | |
168 | /^ MULTIPLY (REPEATED ADDITION) | |
169 | /% DIVIDE (REPEATED SUBTRACTION) | |
170 | \f/DEFINITIONS | |
171 | ||
172 | ASWAP= 40 /WATCH THIS SWAP AREA!! | |
173 | MDATE= 7666 /MONITOR DATE | |
174 | BIPCCL= 7777 /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0 | |
175 | MPARAM= 7643 /COMMAND DECODER OPTION LIST | |
176 | DCB= 7760 /DEVICE CONTROL BLOCK | |
177 | JSBITS= 7746 /JOB STATUS WORD | |
178 | BATOUT= 7400 /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT | |
179 | LNPRPG= 70 /56 LINES PER PAGE | |
180 | HEDLEN= 50 /40 CHARACTERS IN PAGE TITLE | |
181 | /(MUST BE A MULTIPLE OF 8) | |
182 | ||
183 | AC7776= STA CLL RAL | |
184 | AC7775= STA CLL RTL | |
185 | AC4000= STL CLA RAR | |
186 | AC3777= STA CLL RAR | |
187 | AC2000= STL CLA RTR | |
188 | AC0002= STL CLA RTL | |
189 | ||
190 | ||
191 | /TABLE OF ERROR MESSAGE DEFINITIONS | |
192 | ||
193 | ||
194 | IZ= "I-240^100+"Z-240 /ILLEGAL PAGE ZERO REFERENCE | |
195 | CF= "C-240^100+"F-240 /CREF.SV NOT FOUND | |
196 | US= "U-240^100+"S-240 /UNDEFINED SYMBOL | |
197 | IP= "I-240^100+"P-240 /ILLEGAL PSEUDO-OP USAGE | |
198 | SE= "S-240^100+"E-240 /SYMBOL TABLE EXCEEDED | |
199 | ZE= "Z-240^100+"E-240 /PAGE ZERO EXCEEDED | |
200 | PE= "P-240^100+"E-240 /CURRENT PAGE EXCEEDED | |
201 | IC= "I-240^100+"C-240 /ILLEGAL CHARACTER | |
202 | ID= "I-240^100+"D-240 /ILLEGAL DEFINITION | |
203 | BE= "B-240^100+"E-240 /PUSH-DOWN OVERFLOW | |
204 | DE= "D-240^100+"E-240 /DEVICE ERROR | |
205 | DF= "D-240^100+"F-240 /DEVICE FULL | |
206 | LD= "L-240^100+"D-240 /ABSLDR.SV NOT FOUND | |
207 | IE= "I-240^100+"E-240 /ILLEGAL EQUATE | |
208 | PH= "P-240^100+"H-240 /PHASE ERROR | |
209 | II= "I-240^100+"I-240 /ILLEGAL INDIRECT | |
210 | RD= "R-240^100+"D-240 /REDEFINITION | |
211 | UO= "U-240^100+"O-240 /UNDEFINED ORIGIN | |
212 | LG= "L-240^100+"G-240 /LINK GENERATED | |
213 | ||
214 | ||
215 | ||
216 | /ABBREVIATIONS | |
217 | /CR/LF CARRIAGE RETURN/LINE FEED (215,212) | |
218 | /F/F FORM FEED (214) | |
219 | \f/PAGE ZERO | |
220 | ||
221 | *0 | |
222 | FORMF6, 0 /USED IN DECIMAL PRINT ROUTINE | |
223 | ERROR5, 0 /USED BY PACKED ASCII PRINT ROUTINE | |
224 | PTR, 0 /V3C USED BY | |
225 | KNTR, 0 /INPUT ROUTINE | |
226 | ||
227 | /AUTOINDEX REGISTERS | |
228 | /PRESET FOR ONCE ONLY CODE | |
229 | ||
230 | *10 | |
231 | PDLXR, PDLST /PUSH-DOWN AUTO INDEX REGISTER | |
232 | TAGXR, SWAP1-1 /TAG AUTO INDEX REGISTER | |
233 | XREG1, DSWIT1-1 /GENERAL AUTO INDEX REGISTER | |
234 | XREG2, DSWIT2-1 /GENERAL AUTO INDEX REGISTER | |
235 | ||
236 | /NOT USED AS AUTO INDEX REGISTERS | |
237 | /EXCEPT DURING ONCE ONLY CODE | |
238 | ||
239 | LAST1, DATE-1 /LAST DEFINED SYMBOL | |
240 | LAST2, SWAP2-1 | |
241 | LAST3, IFZERO HASH <SYMPRT+4-1> | |
242 | IFNZRO HASH <SYMNWP-1> | |
243 | LAST4, IFZERO HASH <SYMPR9-2-1> | |
244 | IFNZRO HASH <SYMDDT-1> | |
245 | ||
246 | *20 | |
247 | TAG1, 0 /TAG STORAGE | |
248 | TAG2, 0 | |
249 | TAG3, 0 | |
250 | ||
251 | LITPTR, 200 /LITERAL POINTER | |
252 | ||
253 | RADIX, 0 /7777 IF DECIMAL MODE | |
254 | PUNCHX, 0 /NON-ZERO IF NO PUNCHING | |
255 | XLISTX, 0 /NON-ZERO IF NO LISTING | |
256 | /*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER | |
257 | /AND IN THIS ORDER | |
258 | ||
259 | LOC, 200 /CURRENT LOCATION | |
260 | OFFSET, 0 /LOCATION COUNTER OFFSET FROM "LOC" | |
261 | OFSBUF, 0 /LOCATION COUNTER OFFSET BUFFER | |
262 | STARSW, 0 /-1 IF NEXT ORIGIN SHOULD BE INHIBITED | |
263 | ||
264 | OP, 0 /LAST OPERATOR CODE (0-6) | |
265 | VALUE, 0 /EXPRESSION VALUE | |
266 | VALUE2, 0 /EXPRESSION OPERAND | |
267 | ||
268 | TXTSWT, 0 /SPACE SWITCH | |
269 | TXTPTR, LINBUF+120 /TEXT POINTER | |
270 | CHAR, 0 /CURRENT CHARACTER | |
271 | ||
272 | THISPG, 0 /OVERFLOW PAGE | |
273 | EDITPG, 0 /EDITOR PAGE | |
274 | \fTEMP, 0 /TEMPORARY REGISTERS | |
275 | TEMP1, 0 | |
276 | TEMP2, 0 | |
277 | TEMP3, 0 | |
278 | ||
279 | OCHAR, OUTPUT /OUTPUT ROUTINE | |
280 | OERROR, OTYPEO /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT | |
281 | PASS, -2 /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3 | |
282 | IOMON, 200 /USER SERVICE ROUTINES | |
283 | CONDSW, 0 /NUMBER OF NESTED CONDITIONALS | |
284 | EXPIND, 0 /0 IF MRI OK HERE | |
285 | /NOT 0 IF MRI NOT OK HERE | |
286 | CHKSUM, 0 /BINARY CHECK SUM | |
287 | IZIND, 0 /"I" AND "Z" INDICATOR | |
288 | /IF I, LEFT 6 BITS ARE NON-ZERO | |
289 | /IF Z, RIGHT 6 BITS ARE NON-ZERO | |
290 | THISTG, 0 /ASSIGNED NUMBER OF CURRENT TAG | |
291 | HIGHTG, SYME-SYMS%4-1 /ASSIGNED NUMBER OF LAST TAG | |
292 | LINCNT, 0 /LINE COUNT | |
293 | ALPHAI, 0 /UNDEFINED TAG INDICATOR | |
294 | /-1 IF UNDEFINED | |
295 | GETCI, 0 /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE | |
296 | /OTHERWISE /,;, OR CARRIAGE RETURN ENDS | |
297 | LSTCNT, 0 /TAB COUNTER | |
298 | UNDFSW, 0 /UNDEFINED SWITCH | |
299 | INCTL, 601 /CONTROL WORD - FOR OS/8 I/O | |
300 | LINKSW, 0 /OFF-PAGE LINK SWITCH | |
301 | /0 IF NO LINK GENERATED, 0700 IF LINK | |
302 | LININD, 0 /BACK-UP FOR LINKSW | |
303 | PERROR, PERRO1 /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN | |
304 | /MESSAGES DURING PASS 1 | |
305 | FLDIND, "0 /CURRENT FIELD IN ASCII DIGIT FORM | |
306 | BINSRT, 0 /BINARY OR LISTING STARTING | |
307 | ERCNT, 0 /ERROR COUNTER | |
308 | LINK, 0 /LINK COUNTER | |
309 | IFNZRO HASH< | |
310 | TAGMAX, 0 /SET TO PRIME # EQ TO MAX # SYMS | |
311 | > | |
312 | PAGE | |
313 | \f/STARTING ADDRESS OF PAL8 (0200) | |
314 | /CHAINING ADDRESS (0201) | |
315 | ||
316 | NAME1, JMP I NAME3 /NAME1-NAME3 USED LATER | |
317 | NAME2, JMP I GETTA2 /TO STORE TAGS AS THEY ARE BUILT | |
318 | NAME3, BEGIN /V3C | |
319 | GETTA2, NOCD /BUILDING SWITCH AND OVERFLOW PROTECT | |
320 | ||
321 | ||
322 | /HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS | |
323 | ||
324 | NOPUNX, CLA IAC /NON-ZERO FOR NO PUNCHING | |
325 | ENPUNX, DCA PUNCHX /ZERO FOR PUNCHING | |
326 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
327 | ||
328 | ||
329 | /HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS | |
330 | ||
331 | DECIMX, STA /7777 FOR DECIMAL RADIX | |
332 | OCTALX, DCA RADIX /ZERO FOR OCTAL RADIX | |
333 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
334 | \f/GET A TAG ROUTINE | |
335 | /PICKS UP A TAG AND SEARCHES FOR IT | |
336 | /"THISTG" HAS NUMBER OF TAG | |
337 | /"VALUE2" HAS VALUE | |
338 | /AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND | |
339 | ||
340 | GETTAG, 0 | |
341 | DCA NAME1 /CLEAR BUILD AREA | |
342 | DCA NAME2 | |
343 | DCA NAME3 | |
344 | TAD [NAME1 | |
345 | DCA GETTA4 /SET POINTER FOR BUILDING | |
346 | DCA GETTA2 /ZERO SWITCH | |
347 | GETTG1, TAD CHAR /GET THE CHARACTER | |
348 | AND [77 /MAKE IT 01-32 OR 60-71 | |
349 | TAD (-32 /WAS IT A TO Z? | |
350 | SMA SZA | |
351 | TAD (-25 /NO - MAKE 60-71 INTO 33-44 | |
352 | TAD (32 /YES - IT IS NOW 01-32 OR 33-44 | |
353 | ISZ GETTA2 /LEFT SIDE? | |
354 | JMP GETTA3 /YES | |
355 | TAD I GETTA4 /NO - RIGHT SIDE | |
356 | DCA I GETTA4 /BUILD THE WORD | |
357 | ISZ GETTA4 /BUMP TO NEXT WORD | |
358 | GETTA1, JMS I [GETC /GET NEXT CHARACTER | |
359 | JMS I [TSTALN /IS IT ALPHANUMERIC? | |
360 | JMP GETTG1 /YES - KEEP BUILDING | |
361 | IFZERO HASH< | |
362 | TAD HIGHTG /NO - GET NUMBER OF HIGHEST TAG | |
363 | CLL RAR /DIVIDE BY 2 | |
364 | DCA TEMP2 /SAVE DIFFERENCE | |
365 | DCA THISTG /START AT TAG ZERO | |
366 | CLL CML /LINK MUST BE ON INITIALLY | |
367 | DCA TEMP1 | |
368 | ||
369 | ||
370 | /GETTA4 IS POINTER TO NAME1-NAME3 | |
371 | /FOR DEPOSITING TAG AS IT IS BUILT | |
372 | ||
373 | /TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH | |
374 | /DURING BINARY SEARCHING | |
375 | \fGETTG2, SZL /IS THISTG HIGHER THAN TAG? | |
376 | JMP GETTG3 /NO-LOWER | |
377 | GETTG4, DCA TEMP1 /CLEAR LAST TIME SWITCH | |
378 | SNL | |
379 | ISZ TEMP1 /SET LAST TIME SWITCH TO 1 | |
380 | TAD TEMP2 /GET # OF TAGS TO SKIP | |
381 | SNL | |
382 | CIA | |
383 | TAD THISTG /INCREASE OR DECREASE TAG NUMBER | |
384 | DCA THISTG | |
385 | TAD TEMP2 /GET NUMBER | |
386 | CLL RAR /DIVIDE BY 2 | |
387 | SNA /IS RESULT 0? | |
388 | ISZ TEMP1 /YES-BUMP LAST TIME SWITCH | |
389 | SNA | |
390 | IAC /IF RESULT WAS 1, MAKE IT 2 | |
391 | DCA TEMP2 /SAVE IT FOR NEXT TIME | |
392 | JMS I [FINDTG /GET THE TAG | |
393 | TAD [1777 /MASK | |
394 | AND TAG1 /GET WORD 1 | |
395 | CLL CIA | |
396 | TAD NAME1 /DOES IT MATCH? | |
397 | SZA CLA | |
398 | JMP GETTG2 /NO - TRY NEXT TAG | |
399 | AC3777 | |
400 | AND TAG2 /YES - GET WORD 2 | |
401 | CLL CIA | |
402 | TAD NAME2 /DOES IT MATCH? | |
403 | SZA CLA | |
404 | JMP GETTG2 /NO - TRY NEXT TAG | |
405 | AC3777 | |
406 | AND TAG3 /YES - DOES IT MATCH? | |
407 | CLL CIA | |
408 | TAD NAME3 | |
409 | SZA CLA | |
410 | JMP GETTG2 /NO - TRY NEXT TAG | |
411 | JMP I GETTAG /YES--RETURN-- | |
412 | \fGETTG3, AC7776 | |
413 | TAD TEMP1 /LAST TIME SWITCH = 2? | |
414 | SZA CLA | |
415 | JMP GETTG4 /NO-KEEP TRYING | |
416 | ISZ THISTG /YES-QUIT SEARCHING | |
417 | DCA VALUE2 | |
418 | DCA TAG1 | |
419 | DCA TAG2 | |
420 | DCA TAG3 /TAG NOT FOUND | |
421 | STA /AC=7777 MEANS NOT FOUND | |
422 | JMP I GETTAG /--RETURN-- | |
423 | > | |
424 | \f IFNZRO HASH< | |
425 | PRIME=TAGMAX | |
426 | ||
427 | GETTGH,/JMS I [TLYREF /HACK ONLY | |
428 | TAD NAME1 /HASH OUR NAME | |
429 | CLL RTL | |
430 | TAD NAME2 | |
431 | RTL | |
432 | TAD NAME3 | |
433 | RTL | |
434 | TAD NAME1 | |
435 | JMS PROBE /NOW PROBE THE TABLE | |
436 | TAD NAME1 /RE HASH THE NAME FOR A STEPSIZE | |
437 | CLL RAL | |
438 | RTL | |
439 | TAD NAME2 | |
440 | CLL /CALC MODULO PRIME INLINE | |
441 | TAD MPRIME | |
442 | SZL | |
443 | JMP .-3 | |
444 | TAD PRIME | |
445 | SNA | |
446 | IAC /STEPSIZE MUST BE NON ZERO! | |
447 | DCA CRPDEL | |
448 | PRBLUP, CLL | |
449 | TAD THISTG /BUMP THE POINTER RANDOMLY | |
450 | TAD CRPDEL | |
451 | SZL /PROTECT AGAINST WRAP AROUND | |
452 | TAD MPRIME /PROBABLY UNOPTIMAL SOLUTION | |
453 | JMS PROBE | |
454 | JMP PRBLUP | |
455 | ||
456 | PROBE, 0 | |
457 | CLL | |
458 | TAD MPRIME | |
459 | SZL | |
460 | JMP .-3 | |
461 | TAD PRIME | |
462 | DCA THISTG /THISTG MODULO PRIME | |
463 | / JMS I [TLYPRB /HACK ONLY | |
464 | JMS I [FINDTG /GO GET IT | |
465 | TAD [1777 /MASK THE TYPE BITS OUT | |
466 | AND TAG1 /IS THERE ONE? | |
467 | SNA | |
468 | JMP NOTFND /NO EXIT POINTING AT IT | |
469 | CIA /YES, DO A COMPARE | |
470 | TAD NAME1 | |
471 | SZA CLA | |
472 | JMP I PROBE | |
473 | AC3777 | |
474 | AND TAG2 | |
475 | CIA | |
476 | TAD NAME2 | |
477 | SZA CLA | |
478 | JMP I PROBE | |
479 | AC3777 | |
480 | AND TAG3 | |
481 | CIA | |
482 | TAD NAME3 | |
483 | SZA CLA | |
484 | JMP I PROBE /FOUND EXIT WITH AC CLEAR | |
485 | JMP I GETTAG | |
486 | NOTFND, STA /NOT FOUND EXIT WITH AC SET | |
487 | JMP I GETTAG | |
488 | ||
489 | CRPDEL, 0 | |
490 | MPRIME, 0 /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND | |
491 | > | |
492 | ||
493 | ||
494 | GETTA3, DCA GETTA2 /SAVE CHAR | |
495 | TAD GETTA2 | |
496 | CLL RTL /*4 | |
497 | RAL /*10 | |
498 | TAD GETTA2 /*11 | |
499 | RTL /*44 | |
500 | TAD GETTA2 /*45 | |
501 | DCA I GETTA4 /SET LEFT SIDE | |
502 | TAD GETTA4 | |
503 | TAD (-GETTA2 | |
504 | SZA CLA /IS THIS AN OVERFLOW (>6) CHAR? | |
505 | STA /NO - SET SWITCH TO RIGHT HALF | |
506 | DCA GETTA2 /YES - LEAVE SWITCH AT LEFT HALF | |
507 | JMP GETTA1 | |
508 | ||
509 | GETTA4, NAME1 | |
510 | \f/IGNORE SPACES ROUTINE | |
511 | ||
512 | SPNOR, 0 | |
513 | TAD CHAR /GET THE CHARACTER | |
514 | TAD [-240 /IS IT A SPACE? | |
515 | SZA CLA | |
516 | JMP I SPNOR /NO --RETURN-- | |
517 | JMS I [GETC /YES - GET NEXT CHARACTER | |
518 | JMP SPNOR+1 /LOOP | |
519 | ||
520 | ||
521 | /HANDLER FOR PAUSE PSEUDO-OP | |
522 | /END-OF-TAPE OR END-OF-FILE | |
523 | ||
524 | PAUSEX, AC4000 | |
525 | DCA CHAR /SET END-OF-LINE CHARACTER | |
526 | TAD [LINBUF+120 /REINITIALIZE TEXT POINTER | |
527 | DCA TXTPTR | |
528 | CLA CMA | |
529 | DCA I (INCHCT /INDICATE EMPTY BUFFER | |
530 | ISZ I (INEOF /SET END-OF-FILE | |
531 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
532 | PAGE | |
533 | \f/OUTPUT 2 CHARACTER ERROR CODE | |
534 | ||
535 | ERROR1, 0 | |
536 | DCA ERROR5 | |
537 | TAD ERROR5 | |
538 | JMS I [RTL6 | |
539 | RAL | |
540 | AND [77 | |
541 | TAD [240 /CONVERT SIXBIT TO ASCII | |
542 | JMS I OERROR /OUTPUT FIRST CHAR | |
543 | TAD ERROR5 | |
544 | AND [77 | |
545 | TAD [240 | |
546 | JMS I OERROR /OUTPUT SECOND CHAR | |
547 | JMP I ERROR1 /--RETURN-- | |
548 | ||
549 | /HANDLER FOR FIELD PSEUDO-OP | |
550 | ||
551 | FIELDX, JMS I [SPNOR /IGNORE SPACES | |
552 | JMS I [DUMPS /DUMP CURRENT PAGE LITERALS | |
553 | JMS I [DUMPZ /DUMP PAGE ZERO LITERALS | |
554 | JMS I [EXP /GET EXPRESSION | |
555 | TAD VALUE /TRIM TO RIGHT 3 BITS | |
556 | AND [7 | |
557 | DCA FLDIND /STORE FOR LISTING | |
558 | TAD PASS /IS THIS PASS 2? | |
559 | SZA CLA | |
560 | JMP FIELDY /NO - PREPARE TO EXIT | |
561 | TAD FLDIND /YES - GET FIELD NUMBER | |
562 | CLL RTL | |
563 | RAL /AND CHANNELS 7 AND 8 | |
564 | TAD [7700 | |
565 | JMS I OCHAR /OUTPUT FIELD SETTING | |
566 | FIELDY, JMS I [CLEAN /CLEAN UP THINGS | |
567 | TAD [200 /RESET ORIGIN TO 200 | |
568 | JMP STAR1 | |
569 | ||
570 | /CHANGE LAST 2 LOCATIONS TO: | |
571 | / CLA | |
572 | / JMP STAR1+1 | |
573 | /FOR INDAC GROUP TO OMIT RE-ORIGIN | |
574 | \f/HANDLER FOR PAGE PSEUDO-OP | |
575 | ||
576 | PAGEX, JMS I [DUMPS /DUMP SAME PAGE LITERALS | |
577 | JMS I (XLISTZ /ANY EXPRESSION? | |
578 | JMP PAGEY /NO | |
579 | JMS I [EXP /YES - GET EXPRESSION | |
580 | TAD VALUE | |
581 | JMS I [RTL6 | |
582 | RAL /GET PAGE NUMBER | |
583 | JMP STAR3-1 | |
584 | ||
585 | PAGEY, TAD LOC /NO ARGUMENT - FIND NEXT PAGE | |
586 | TAD [177 | |
587 | AND [7600 | |
588 | STAR3, DCA VALUE | |
589 | TAD VALUE /GET START OF PAGE | |
590 | STAR1, JMS I [PUNORG /PUNCH ORIGIN | |
591 | JMS I [FINDSP | |
592 | TAD [LITBUF /RESET POINTERS | |
593 | DCA TEMP | |
594 | TAD I TEMP | |
595 | DCA LITPTR /INITIALIZE LITERAL POINTER FOR NEW PAGE | |
596 | DCA LAST1 | |
597 | JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE | |
598 | ||
599 | /HANDLER FOR FIXMRI PSEUDO-OP | |
600 | ||
601 | FIXMRX, JMS I [SPNOR /IGNORE SPACES | |
602 | JMS I [TSTALP /IS CHARACTER ALPHABETIC? | |
603 | JMP FIXMR1 /YES-CONTINUE | |
604 | JMS I [ICMESG /NO - GENERATE IC MESSAGE, GET NEXT CHAR | |
605 | JMP FIXMRX+1 /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE | |
606 | FIXMR1, JMS I [GETTAG /PICK UP TAG | |
607 | DCA ALPHAI /STORE UNDEFINED SWITCH | |
608 | SKP | |
609 | FIXMR2, JMS I [ICMESG | |
610 | JMS I [SPNOR /IGNORE SPACES | |
611 | TAD CHAR /WAS CHARACTER = ? | |
612 | TAD (-"= | |
613 | SZA CLA | |
614 | JMP FIXMR2 /NO - PRINT IC MESSAGE AND KEEP LOOKING | |
615 | /FALL INTO EQUALS PROCESSOR | |
616 | \f/HANDLER FOR = | |
617 | ||
618 | AC4000 /FALL INTO HERE FROM FIXMRI | |
619 | EQUAL, JMS I [PUSHA /PUSH FIXMRI FLAG | |
620 | JMS I [GETC /GET NEXT CHARACTER | |
621 | TAD I (NAME1 /STORE THE SYMBOL NAME | |
622 | JMS I [PUSHA /ON THE PUSH DOWN LIST | |
623 | TAD I (NAME2 | |
624 | JMS I [PUSHA | |
625 | TAD I (NAME3 | |
626 | JMS I [PUSHA | |
627 | TAD THISTG /AND ITS PRESENT (OR FUTURE) | |
628 | JMS I [PUSHA /POSITION IN THE SYMTAB | |
629 | TAD ALPHAI | |
630 | JMS I [PUSHA /STORE UNDEFINED INDICATOR | |
631 | JMS I [SPNOR /IGNORE SPACES | |
632 | JMS I [EXP /GET EXPRESSION TO RIGHT OF = | |
633 | TAD I PDLXR | |
634 | DCA ALPHAI /RESTORE UNDEFINED INDICATOR | |
635 | TAD I PDLXR | |
636 | DCA THISTG /RESTORE SYMBOL TABLE POSITION | |
637 | TAD I PDLXR /RESTORE TAG NAME | |
638 | DCA I (NAME3 | |
639 | TAD I PDLXR | |
640 | DCA I (NAME2 | |
641 | TAD I PDLXR | |
642 | DCA I (NAME1 | |
643 | ISZ UNDFSW /WAS ANY PART OF DEFINITION UNDEFINED? | |
644 | JMP EQUAL3 /NO | |
645 | JMS I PERROR /YES - GENERATE IE ERROR MESSAGE | |
646 | IE | |
647 | ISZ PDLXR /CLEAR EXTRA WORD FROM PDL | |
648 | JMP I [PUNVAL /FORGET ABOUT DEFINING TAG | |
649 | \f/MORE = PROCESSING | |
650 | ||
651 | EQUAL3, ISZ ALPHAI /WAS TAG DEFINED BEFORE? | |
652 | JMP .+3 /YES - CHECK FOR ILLEGAL REDEFINITION | |
653 | JMS I [INSRTG /NO - INSERT TAG INTO SYMBOL TABLE | |
654 | JMP EQUAL2 /AND BYPASS ILLEGAL REDEF CHECK | |
655 | JMS I [FINDTG /PUT TAG IN TAG1-TAGE AND VALUE2 | |
656 | TAD VALUE | |
657 | CIA | |
658 | TAD VALUE2 | |
659 | SZA CLA /WERE DEFINITIONS THE SAME? | |
660 | TAD TAG1 /NO - IS IT A PERMANENT SYMBOL? | |
661 | SMA CLA | |
662 | JMP EQUAL2 /NO - OK TO REDEFINE | |
663 | JMS I [ERROR /YES - GENERATE RD ERROR MESSAGE FIRST | |
664 | RD | |
665 | EQUAL2, TAD VALUE /DEFINE OR REDEFINE | |
666 | DCA VALUE2 | |
667 | AC3777 | |
668 | AND TAG2 /CLEAR OLD FIXMRI BIT | |
669 | TAD I PDLXR /INSERT NEW ONE | |
670 | DCA TAG2 | |
671 | JMS I [PUTTAG /STORE TAG | |
672 | JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE | |
673 | PAGE | |
674 | \f/ROTATE AC 6 LEFT | |
675 | ||
676 | RTL6, 0 | |
677 | CLL RTL | |
678 | RTL | |
679 | RTL | |
680 | JMP I RTL6 /--RETURN-- | |
681 | ||
682 | ||
683 | /GET NEXT CHARACTER ROUTINE | |
684 | /READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS | |
685 | /TO THE PROGRAM | |
686 | /IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED | |
687 | ||
688 | GETC, 0 | |
689 | ISZ TXTPTR /POINT TO NEXT CHARACTER | |
690 | GETC7, TAD I TXTPTR /GET NEXT CHARACTER | |
691 | SZA /IS IT 0? | |
692 | JMP GETC8 /NO - MORE ARE IN THIS LINE | |
693 | TAD PASS /IS THIS PASS 3? | |
694 | SPA SNA CLA | |
695 | JMP GETC1 /NO | |
696 | TAD [LINBUF /YES | |
697 | DCA TXTPTR /RESET POINTER TO BEGINNING | |
698 | TAD I TXTPTR /GET 1ST CHARACTER | |
699 | SNA /IS IT 0? | |
700 | JMP GETC1 /YES - LINE HAS BEEN PRINTED | |
701 | TAD [-215 /IS IT 215? | |
702 | SNA CLA | |
703 | JMP GETC2 /YES - DO NOT PRINT THE SPACES | |
704 | TAD [211 /NO-OUTPUT 2 TABS | |
705 | JMS I OERROR | |
706 | TAD [211 | |
707 | JMS I OERROR | |
708 | GETC2, JMS LINPRT /NOW PRINT THE LINE | |
709 | GETC1, TAD (-121 | |
710 | DCA TXTSWT | |
711 | TAD (LINBUF-1 | |
712 | DCA TXTPTR /RESET POINTER | |
713 | ISZ TXTPTR | |
714 | GETC6, JMS I (INPUT /GET NEXT CHARACTER | |
715 | JMP GETC4 /215 | |
716 | DCA I TXTPTR /STORE THE CHARACTER | |
717 | ISZ TXTSWT /TOO MANY? | |
718 | JMP GETC6-1 /NO | |
719 | CLA CMA /YES | |
720 | DCA TXTSWT | |
721 | JMP GETC6 | |
722 | \fGETC4, DCA I TXTPTR /SET END | |
723 | ISZ TXTPTR | |
724 | DCA I TXTPTR /SET END OF LINE | |
725 | TAD [LINBUF | |
726 | DCA TXTPTR /RESET POINTER | |
727 | CLA CMA | |
728 | DCA TXTSWT /RESET SWITCH | |
729 | JMP GETC7 /GET THAT CHARACTER | |
730 | ||
731 | GETC8, TAD [-215 /IS IT A CARRIAGE RETURN? | |
732 | SNA | |
733 | JMP GETC12 /YES-END OF LINE | |
734 | TAD GETCI /NO- | |
735 | TAD (215-"/ /IS IT A /? | |
736 | SNA /YES- | |
737 | JMP GETC13 /"/" IS END | |
738 | TAD ("/-"; /IS IT A ;? | |
739 | SNA /YES- | |
740 | JMP GETC12 /";" IS END | |
741 | TAD (";-211 /IS IT A TAB? | |
742 | SZA | |
743 | TAD (211-240 /OR A SPACE? | |
744 | SZA CLA | |
745 | JMP GETC9 /NO-NOT ANYTHING SPECIAL | |
746 | ISZ TXTSWT /YES-2ND OCCURANCE? | |
747 | JMP GETC+1 /YES - IGNORE | |
748 | TAD [240 | |
749 | DCA CHAR /NO - GIVE A SPACE | |
750 | JMP I GETC /--RETURN-- | |
751 | ||
752 | GETC16, ISZ CONDSW /DECREMENT CONDITIONAL COUNTER | |
753 | JMP GETC15 | |
754 | GETC17, TAD [LINBUF+120 | |
755 | DCA TXTPTR | |
756 | GETC12, AC4000 | |
757 | GETC9, TAD I TXTPTR | |
758 | DCA CHAR /STORE CHARACTER | |
759 | CLA CMA | |
760 | DCA TXTSWT /SET THE SWITCH | |
761 | JMP I GETC /--RETURN-- | |
762 | \fGETC13, TAD CONDSW /CURRENTLY IN CONDITIONALS? | |
763 | SNA | |
764 | JMP GETC17 /NO | |
765 | DCA CONDSW /STORE UPDATED CONDITIONAL LEVEL | |
766 | GETC15, ISZ TXTPTR /YES-SCAN LINE FOR < AND > | |
767 | TAD I TXTPTR | |
768 | TAD [-215 /IS CHARACTER A CARRIAGE RETURN? | |
769 | SNA | |
770 | JMP GETC17 /YES | |
771 | TAD (215-"> /NO IS IT A >? | |
772 | SNA | |
773 | JMP GETC16 /YES | |
774 | TAD (">-"< /NO-IS IT <? | |
775 | SNA CLA | |
776 | STA /YES - INCREMENT CONDITIONAL COUNTER | |
777 | JMP GETC13 /NO - KEEP LOOKING | |
778 | ||
779 | ||
780 | /CHAR IS NEGATIVE IF LOGICAL END OF LINE: | |
781 | / CARRIAGE RETURN | |
782 | / / | |
783 | / ; | |
784 | ||
785 | /CHAR MAY BE ZERO IF PHYSICAL END OF LINE: | |
786 | / CARRIAGE RETURN | |
787 | \f/PRINT A LINE OF SOURCE CODE | |
788 | ||
789 | LINPRT, 0 | |
790 | TAD (LINBUF-1 | |
791 | DCA XREG1 /SET POINTER TO LINE | |
792 | LINPR1, TAD I XREG1 /GET CHARACTER | |
793 | SNA /IS IT END OF LINE? | |
794 | JMP I LINPRT /YES - END LINE | |
795 | JMS I OERROR /NO - OUTPUT CHARACTER | |
796 | DCA I [LINBUF /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG | |
797 | JMP LINPR1 | |
798 | ||
799 | /HANDLE PHASE ERROR | |
800 | /AND ALL ERROR EXITS TO MONITOR | |
801 | ||
802 | SYMOFL, CLA | |
803 | TAD (SE /SYMBOL TABLE EXCEEDED MESSAGE | |
804 | MONERR, DCA MONER1 /ERROR IS SERIOUS ENOUGH TO | |
805 | PHASE, TAD (OTYPEO / CAUSE IMMEDIATE RETURN TO | |
806 | DCA OERROR / MONITOR | |
807 | JMS I [ERROR | |
808 | MONER1, PH /STORE ERROR TYPE HERE | |
809 | JMP I [7600 /***EXIT TO MONITOR*** | |
810 | ||
811 | ||
812 | /FIND CURRENT PAGE NUMBER | |
813 | /EXIT WITH NUMBER IN AC | |
814 | ||
815 | FINDSP, 0 | |
816 | TAD LOC | |
817 | AND [7600 | |
818 | JMS I [RTL6 | |
819 | JMP I FINDSP /--RETURN-- | |
820 | PAGE | |
821 | \f/********************************************************** | |
822 | /THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2 | |
823 | /** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT ** | |
824 | ||
825 | SWAP1=. | |
826 | ||
827 | /PASS 3 LISTING OUTPUT | |
828 | ||
829 | LISOUT, 0 | |
830 | DCA LISOU2 | |
831 | TAD XLISTX /IS THIS COVERED BY XLIST? | |
832 | SZA CLA | |
833 | JMP I LISOUT /YES--RETURN-- | |
834 | ISZ LISCNT /NO-WAS PREVIOUS CHARACTER A 215? | |
835 | JMP LISOU1 /NO | |
836 | ISZ LINCNT /WAS IT END OF PAGE? | |
837 | JMP LISOU1 /NO | |
838 | ISZ THISPG /YES-START OVERFLOW PAGE | |
839 | BEGIAB, JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED | |
840 | HSWIT1, JMS I [FORMFD /0 IF /H SWITCH OPTION TO SUPRESS PAGING | |
841 | ISZ LINCNT | |
842 | LISOU1, TAD LISOU2 /IS CHARACTER A CARRIAGE RETURN? | |
843 | TAD [-215 | |
844 | SNA | |
845 | JMP LISOU3 /YES - OUTPUT CR/LF | |
846 | TAD [215 /NO - RESTORE CHARACTER | |
847 | JMS I OCHAR /OUTPUT CHARACTER | |
848 | JMP I LISOUT /--RETURN-- | |
849 | ||
850 | LISOU3, CLA CMA | |
851 | DCA LISCNT /REMEMBER THE 215 FOR NEXT TIME | |
852 | JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED | |
853 | JMP I LISOUT /--RETURN-- | |
854 | ||
855 | LISCNT, -1 | |
856 | LISOU2, 0 | |
857 | \f/FORM FEED OUTPUT ROUTINES | |
858 | ||
859 | FORMFD, 0 | |
860 | TAD LINCNT /GET LINE COUNTER | |
861 | TAD FORMLN | |
862 | SNA CLA /ARE WE AT TOP OF PAGE? | |
863 | JMP I FORMFD /YES - NO NEED FOR FORM FEED | |
864 | TAD XLISTX /IS THIS COVERED BY XLIST? | |
865 | SZA CLA | |
866 | JMP I FORMFD /YES--RETURN-- | |
867 | HSWITC, JMP FORMF1 /0 IF /T OR TTY:; JMP FORMF3 IF /H | |
868 | /OUTPUT IF TTY:OR /T OPTION | |
869 | TAD LINCNT | |
870 | TAD [-4 | |
871 | DCA LINCNT | |
872 | JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED | |
873 | ISZ LINCNT | |
874 | JMP CRLF1 /OUTPUT LINE FEED | |
875 | /CRLF1 WILL RETURN TO | |
876 | /JMP-1 UNTIL LINCNT HAS | |
877 | /BEEN BUMPED SUFFICIENTLY | |
878 | TAD FORMM6 | |
879 | DCA LINCNT | |
880 | TAD MINUS /OUTPUT ------ | |
881 | JMS I OCHAR | |
882 | ISZ LINCNT /* NEXT 3 LOCS CHANGED IF NO /T OR TTY: | |
883 | FORMF1, JMP .-3 /* STA | |
884 | TAD [-4 /* DCA LINCNT /GENERATE ONE FORM FEED | |
885 | DCA LINCNT /* STA /TURN CR INTO FF | |
886 | JMS CRLF /OUTPUT CR/LF OR FF/LF | |
887 | ISZ LINCNT | |
888 | JMP CRLF1 /OUTPUT LINE FEED | |
889 | TAD FORMLN | |
890 | CIA | |
891 | DCA LINCNT | |
892 | FORM22, TAD [HEADER-1 /OUTPUT HEADER | |
893 | DCA XREG2 | |
894 | DCA LSTCNT | |
895 | FORM30, TAD I XREG2 /GET NEXT CHARACTER OF HEADING | |
896 | SNA /IS IT LAST + 1 | |
897 | JMP FORM20 /YES | |
898 | JMS I OCHAR /NO-OUTPUT IT | |
899 | TAD LSTCNT | |
900 | TAD [-HEDLEN /DONE "HEDLEN" CHARACTERS YET? | |
901 | SZA CLA | |
902 | JMP FORM30 /NO-CONTINUE | |
903 | TAD FORMHD /YES-START SYSTEM HEADER | |
904 | JMP FORM22 /WHICH STARTS AT HEADER+HEDLEN | |
905 | ||
906 | FORMLN, LNPRPG | |
907 | FORMHD, HEDLEN | |
908 | MINUS, "- | |
909 | \f/TTY: OR /T OUTPUTS FORM FEED AS | |
910 | /CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE | |
911 | /------ | |
912 | /CARRIAGE RETURN, 5 LINE FEEDS | |
913 | /HEADER | |
914 | /NO OPTIONS TREATS F/F AS | |
915 | /F/F, LF, CR/LF | |
916 | /HEADER | |
917 | ||
918 | / /H OPTION TREATS F/F AS 2 CR/LF | |
919 | ||
920 | /USER HEADER IS "HEDLEN" CHARACTERS WIDE | |
921 | /ASSEMBLER HEADER ENDS WITH 0 | |
922 | ||
923 | ||
924 | /OUTPUT PAGE NUMBERS | |
925 | ||
926 | FORM20, TAD EDITPG /OUTPUT EDITOR PAGE NUMBER | |
927 | JMS FORMF4 | |
928 | TAD THISPG /IS THERE PAGE OVERFLOW? | |
929 | SNA CLA | |
930 | FORM21, JMP FORMF3 /NO | |
931 | TAD MINUS /YES | |
932 | JMS I OCHAR /OUTPUT - | |
933 | TAD THISPG /OUTPUT NUMBER OF OVERFLOW PAGE | |
934 | JMS FORMF4 | |
935 | /OUTPUT IF /H OPTION | |
936 | FORMF3, JMS CRLF /OUTPUT 2 CR/LF | |
937 | JMS CRLF | |
938 | JMP I FORMFD /--RETURN-- | |
939 | \f/DECIMAL PRINT ROUTINE | |
940 | ||
941 | FORMF4, 0 | |
942 | DCA FORMF6 /SAVE NUMBER | |
943 | TAD FORM8F | |
944 | DCA CRLF /POINT TO DIVISION LIST | |
945 | FORM12, DCA FORMF7 /START WITH 0 | |
946 | JMP .+3 | |
947 | FORMF5, DCA FORMF6 | |
948 | ISZ FORMF7 /ADD 1 TO DIGIT | |
949 | TAD I CRLF /SUBTRACT 1000, 100, OR 10 | |
950 | SNA | |
951 | JMP FORM11 /0 IS END OF TABLE - NO MORE DIGITS | |
952 | TAD FORMF6 | |
953 | SMA /OVERFLOW | |
954 | JMP FORMF5 /NO-KEEP SUBTRACTING | |
955 | CLA /YES-DIGIT DONE | |
956 | ISZ CRLF /BUMP LIST POINTER | |
957 | TAD FORMF7 /WAS DIGIT A 0? | |
958 | SNA | |
959 | JMP FORM12 /YES | |
960 | TAD ["0 /NO-MAKE IT ASCII | |
961 | JMS I OCHAR /OUTPUT DIGIT | |
962 | AC4000 | |
963 | JMP FORM12 /4000 IN AC FORCES SIGNIFICANCE | |
964 | ||
965 | FORM11, TAD FORMF6 /GET LAST DIGIT (UNITS PLACE) | |
966 | TAD ["0 | |
967 | JMS I OCHAR /OUTPUT DIGIT | |
968 | JMP I FORMF4 /--RETURN-- | |
969 | ||
970 | FORMM6, -6 | |
971 | FORM8F, FORMF8 | |
972 | \f/OUTPUT CARRIAGE RETURN/LINE FEED | |
973 | /ENTER WITH AC=-1 TO GENERATE F/F LF | |
974 | ||
975 | HEDCL2, | |
976 | CRLF, 0 | |
977 | TAD [215 | |
978 | JMS I OCHAR | |
979 | CRLF1, TAD [212 /RE-ENTRY FOR MULTIPLE LINE FEEDS | |
980 | JMS I OCHAR | |
981 | JMP I CRLF /--RETURN-- | |
982 | ||
983 | /CLEAR PAGE HEADING BUFFER | |
984 | ||
985 | FORMF7, | |
986 | HEDCLR, 0 | |
987 | TAD [-HEDLEN /SET HEADING BUFFER | |
988 | DCA HEDCL2 /TO TABS | |
989 | TAD [HEADER-1 | |
990 | DCA XREG2 | |
991 | TAD [211 | |
992 | DCA I XREG2 | |
993 | ISZ HEDCL2 | |
994 | JMP .-3 | |
995 | JMP I HEDCLR /--RETURN-- | |
996 | PAGE | |
997 | \f/SYMBOL TABLE OUTPUT (COLUMNAR) | |
998 | /*CODE TO GENERATE DDT COMPATIBLE* | |
999 | /**SYMBOL TABLE--SUBSTITUTED WITH* | |
1000 | /**ONCE ONLY CODE IF NEEDED******* | |
1001 | IFZERO HASH< | |
1002 | ||
1003 | SYMPRT, 0 | |
1004 | ISZ EDITPG /NEW PAGE | |
1005 | DCA THISPG | |
1006 | JMS I [FORMFD | |
1007 | TAD SMIN67 /DCA I SYMPR6-1 | |
1008 | DCA SYMPR7 /JMS SYMPR9+6 | |
1009 | SYMPR8, DCA SYMPR2 /TAD [377 //RUBOUT | |
1010 | CLA CMA /JMS I OERROR | |
1011 | DCA THISTG /CLA CMA | |
1012 | TAD SYMPR2 /DCA THISTG | |
1013 | CMA /TAD [215 //CARRIAGE RETURN | |
1014 | DCA SYMPR3 /JMS I OERROR | |
1015 | SYMPR5, ISZ SYMPR3 /JMS SYMPPP | |
1016 | JMP SYMPR4 /JMP SYMPR9-1 | |
1017 | TAD [-4 /JMP SYMPR6+2 | |
1018 | DCA SYMPR3 /HSWIT1 | |
1019 | SYMPR6, JMS SYMPPP /204 //EOT | |
1020 | JMP SYMPRB | |
1021 | SYMPR1, TAD [1777 | |
1022 | AND TAG1 /OUTPUT TAG | |
1023 | JMS I SDIV45 | |
1024 | TAD TAG2 | |
1025 | JMS I SDIV45 | |
1026 | TAD TAG3 | |
1027 | JMS I SDIV45 | |
1028 | TAD [240 | |
1029 | JMS I OERROR /OUTPUT SPACE | |
1030 | TAD VALUE2 | |
1031 | JMS OCTPRT /OUTPUT OCTAL VALUE | |
1032 | ISZ SYMPR3 /JMP SYMPR5-2 | |
1033 | JMP SYMPR0 /TAD SYMPR6 | |
1034 | SYMPR9, TAD [215 /JMS I OERROR /CARRIAGE RETURN | |
1035 | JMS I OERROR /TAD [377 //RUBOUT | |
1036 | SYMPRB, ISZ SYMPR7 /JMS I OERROR | |
1037 | JMP SYMPRA /JMS SYMPR9+6 | |
1038 | HSWIT2, JMS I [FORMFD /DCA LINCNT /0 IF NOT /H | |
1039 | TAD SMIN67 /JMP I SYMPRT //--RETURN-- | |
1040 | DCA SYMPR7 /0 | |
1041 | TAD SYMOFS /TAD [-200 | |
1042 | SYMPRA, IAC /DCA SYMPR2 | |
1043 | TAD SYMPR2 /TAD [200 //LEADER-TRAILER | |
1044 | JMP SYMPR8 /JMS I OERROR | |
1045 | ||
1046 | SYMPR4, JMS SYMPPP /ISZ SYMPR2 | |
1047 | JMP I SYMPRT /JMP SYMPR4-2 /--RETURN-- | |
1048 | JMP SYMPR5 /JMP I SYMPR9+6 | |
1049 | ||
1050 | SDIV45, DIV45 | |
1051 | SMIN67, 1-LNPRPG | |
1052 | \fSYMPR0, TAD SMIN67 | |
1053 | DCA SYMPPB | |
1054 | JMS SYMPPP /SKIP 67(8) SYMBOLS | |
1055 | JMP SYMPR9 | |
1056 | ISZ SYMPPB | |
1057 | JMP .-3 | |
1058 | JMS I [ERROR1 | |
1059 | JMS I [ERROR1 | |
1060 | JMS I [ERROR1 | |
1061 | JMP SYMPR1 /GO PRINT THE 67TH(8) SYMBOL | |
1062 | ||
1063 | SYMPR2= LINKSW | |
1064 | SYMPR3= UNDFSW | |
1065 | SYMPR7= ALPHAI | |
1066 | SYMPPB= CHKSUM | |
1067 | ||
1068 | SYMPPP, 0 | |
1069 | ISZ THISTG | |
1070 | SYMOFS, 245 | |
1071 | TAD THISTG | |
1072 | CLL CIA | |
1073 | TAD HIGHTG | |
1074 | SNL CLA | |
1075 | JMP I SYMPPP /--RETURN-- | |
1076 | JMS I [FINDTG | |
1077 | AC4000 | |
1078 | AND TAG1 | |
1079 | TAD TAG3 | |
1080 | SPA SZL CLA | |
1081 | JMP SYMPPP+1 | |
1082 | ISZ SYMPPP | |
1083 | JMP I SYMPPP /--RETURN-- | |
1084 | /SYMNCL, -4 /DEFAULT IN LIU OF =N OPTION | |
1085 | /SYMOFS, 245 /OFFSET TO FIRST SYM ON NEXT PAGE | |
1086 | ||
1087 | > | |
1088 | \f IFNZRO HASH< | |
1089 | ||
1090 | SYMPRT, 0 | |
1091 | ISZ EDITPG | |
1092 | DCA THISPG | |
1093 | JMS I [FORMFD /OUTPUT A HEADING | |
1094 | JMS I SYMHND /NOW READ THE SYMBOL TABLE SORT OVERLAY | |
1095 | 0200 /2 PAGES | |
1096 | SYMSRT, OUDEVH+400 /TO HERE | |
1097 | ASWAP+1 /FROM HERE | |
1098 | JMP I SYMERR /UGH | |
1099 | JMS I SYMSRT /SORT THEM AND SET LINK | |
1100 | SYMNWP, DCA SYMTAG /POINT TO SYMBOL | |
1101 | SZL /LINK OFF IF ANY SYMBOLS TO LIST | |
1102 | JMP I SYMPRT /NONE --RETURN-- | |
1103 | TAD SMIN67 /SET LINE/PAGE COUNT | |
1104 | DCA SYMLCT | |
1105 | SYMPAG, TAD HIGHTG | |
1106 | CLL CIA | |
1107 | TAD SYMTAG | |
1108 | SZL CLA | |
1109 | JMP I SYMPRT /NO MORE IF AT HIGHTAG NOW | |
1110 | TAD SYMTAG | |
1111 | DCA THISTG /PREPARE TO PRINT LEFTMOST SYMBOL | |
1112 | TAD SYMNCL /4 PER LINE (DEFAULT) | |
1113 | DCA SYMCCT /TO COLLUMS/LINE CNTR | |
1114 | JMP SYMGO | |
1115 | SYMLIN, JMS I [ERROR1 | |
1116 | JMS I [ERROR1 | |
1117 | JMS I [ERROR1 | |
1118 | TAD HIGHTG | |
1119 | CLL CIA | |
1120 | TAD THISTG | |
1121 | SZL CLA | |
1122 | JMP SYMNXL /SKIP TO NEXT LINE IF OFF TABLE | |
1123 | \fSYMGO, JMS I [FINDTG /OK, GET IT | |
1124 | TAD TAG1 | |
1125 | JMS I SDIV45 | |
1126 | TAD TAG2 | |
1127 | JMS I SDIV45 | |
1128 | TAD TAG3 | |
1129 | JMS I SDIV45 | |
1130 | TAD [240 | |
1131 | JMS I OERROR | |
1132 | TAD VALUE2 /PRINT VALUE NOW | |
1133 | JMS OCTPRT | |
1134 | SYMDDT, TAD SMIN67 | |
1135 | CLL CIA | |
1136 | TAD THISTG | |
1137 | DCA THISTG | |
1138 | SZL | |
1139 | JMP SYMNXL /SKIP IF WRAP AROUND | |
1140 | ISZ SYMCCT /ELSE DO NEXT COLUMN | |
1141 | JMP SYMLIN | |
1142 | SYMNXL, TAD [215 | |
1143 | JMS I OERROR /CR/LF | |
1144 | ISZ SYMTAG /POINT TO NEXT SYMBOL | |
1145 | ISZ SYMLCT | |
1146 | JMP SYMPAG | |
1147 | HSWIT2, JMS I [FORMFD | |
1148 | TAD SYMTAG | |
1149 | CLL | |
1150 | TAD SYMOFS /OFFSET TO NEXT SYMBOL | |
1151 | JMP SYMNWP /DO THE NEXT PAGE | |
1152 | ||
1153 | SDIV45, DIV45 | |
1154 | SMIN67, -67 | |
1155 | SYMERR, SYSERR | |
1156 | SYMHND, 7607 | |
1157 | SYMOFS, 245 /DEFAULT | |
1158 | SYMNCL, -4 | |
1159 | SYMTAG= LINKSW | |
1160 | SYMLCT= UNDFSW | |
1161 | SYMCCT= ALPHAI | |
1162 | ZBLOCK 4 /WASTE SOME SPACE | |
1163 | > | |
1164 | ||
1165 | ||
1166 | /END OF AREA WHICH MAY BE SWAPPED OUT | |
1167 | /DURING PASSES 1 AND 2 | |
1168 | /********************************************************************** | |
1169 | ||
1170 | ENDOVL= . | |
1171 | \f/OCTAL PRINT ROUTINE | |
1172 | /ENTER WITH # TO BE OUTPUT IN AC | |
1173 | /** DO NOT USE TEMPS BELOW THIS LOC! | |
1174 | ||
1175 | OCTPRT, 0 | |
1176 | DCA OCTPR1 | |
1177 | TAD [-4 | |
1178 | DCA OCTPR3 | |
1179 | OCTPR2, TAD OCTPR1 /GET EACH DIGIT SEPARATELY | |
1180 | CLL RTL | |
1181 | RAL | |
1182 | DCA OCTPR1 | |
1183 | TAD OCTPR1 | |
1184 | RAL | |
1185 | AND [7 | |
1186 | TAD ["0 /MAKE IT INTO AN ASCII CHARACTER | |
1187 | JMS I OERROR /OUTPUT IT | |
1188 | ISZ OCTPR3 | |
1189 | JMP OCTPR2 | |
1190 | JMP I OCTPRT /--RETURN-- | |
1191 | ||
1192 | OCTPR1, 0 | |
1193 | OCTPR3, 0 | |
1194 | \f/OUTPUT ONE REGISTER | |
1195 | ||
1196 | PUNONE, 0 | |
1197 | TAD PASS /WHICH PASS IS THIS? | |
1198 | SNA | |
1199 | JMP PUNON2 /PASS 2--OUTPUT BINARY | |
1200 | SPA CLA | |
1201 | JMP PUNON3 /PASS 1--EXIT | |
1202 | TAD FLDIND /GET FIELD NUMBER | |
1203 | TAD ["0 /CONVERT TO ASCII | |
1204 | JMS I OERROR /PRINT IT | |
1205 | TAD LOC /GET LOW ORDER 4 DIGITS (LOC CTR) | |
1206 | JMS OCTPRT /PRINT IT TOO | |
1207 | TAD OFFSET /IF THIS CODE IS IN A RELOC SECTION, | |
1208 | SZA CLA / | |
1209 | TAD (1200 /FLAG THE LOCATION COUNTER WITH A * | |
1210 | DTORG1, JMS I [ERROR1 /OUTPUT 2 SPACES | |
1211 | TAD VALUE | |
1212 | JMS OCTPRT /OUTPUT CONTENTS | |
1213 | TAD I [LINBUF /IS THERE SOURCE CODE TO DUMP? | |
1214 | SNA CLA | |
1215 | JMP PUNON1 /NO-OUTPUT CARRIAGE RETURN | |
1216 | TAD LINKSW /YES-DUMP LINK SWITCH (' ) OR ( ) | |
1217 | JMS I [ERROR1 | |
1218 | JMS I [LINPRT /DUMP SOURCE CODE | |
1219 | JMP PUNON3 /AND EXIT | |
1220 | ||
1221 | PUNON1, TAD LINKSW /NO LINE - OUTPUT LINK SWITCH ANYWAY | |
1222 | SZA /IF THERE IS ONE | |
1223 | JMS I [ERROR1 | |
1224 | TAD [215 /OUTPUT CARRIAGE RETURN | |
1225 | JMS I OERROR | |
1226 | PUNON3, DCA LINKSW /CLEAR LINK SWITCH | |
1227 | JMP I PUNONE /--RETURN-- | |
1228 | ||
1229 | /PASS 2-OUTPUT ONE REGISTER | |
1230 | ||
1231 | PUNON2, TAD VALUE /GET CONTENTS | |
1232 | CLL | |
1233 | JMS I [PUNOUT /OUTPUT AS 2 FRAMES | |
1234 | JMP PUNON3 /AND EXIT | |
1235 | PAGE | |
1236 | \f/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST** | |
1237 | /***WHEN OVERLAYED BY PUSHDOWN LIST** | |
1238 | ||
1239 | /ARRANGE TO OUTPUT ONE REGISTER | |
1240 | ||
1241 | PUNBIN, 0 | |
1242 | DCA VALUE | |
1243 | JMS I [FINDSP /FIND CURRENT PAGE NUMBER | |
1244 | TAD [LITBUF | |
1245 | DCA TEMP2 /POINT TO NUMBER OR LITERALS | |
1246 | TAD LOC | |
1247 | AND [177 | |
1248 | DCA TEMP | |
1249 | TAD I TEMP2 /IS PAGE FULL? | |
1250 | CIA | |
1251 | TAD TEMP | |
1252 | ISZ TEMP | |
1253 | SPA CLA | |
1254 | JMP ONEOK /NO-OK TO ADD ONE MORE REGISTER | |
1255 | TAD TEMP /YES- | |
1256 | DCA I TEMP2 | |
1257 | JMS I [FINDSP /FIND CURRENT PAGE NUMBER | |
1258 | JMS I PPEZE /GENERATE PE OR ZE ERROR | |
1259 | ONEOK, JMS I [FINDSP /FIND CURRENT PAGE NUMBER | |
1260 | TAD [TPINST | |
1261 | DCA TEMP2 | |
1262 | TAD TEMP /IS THIS ADDRESS HIGHER THAN PREVIOUS | |
1263 | CIA /HIGH INSTRUCTION PAGE? | |
1264 | TAD I TEMP2 | |
1265 | SMA CLA | |
1266 | JMP PUNMOD /NO | |
1267 | TAD TEMP /YES-THIS IS NEW HIGH INSTRUCTION | |
1268 | DCA I TEMP2 | |
1269 | ||
1270 | PUNMOD, JMS I [PUNONE /OUTPUT THIS REGISTER | |
1271 | ISZ LOC /GET NEXT LOCATION | |
1272 | TAD LOC /IF THE "ISZ" SKIPS IT IS O.K. (A 0) | |
1273 | AND [177 /IS THIS FIRST INSTRUCTION ON NEXT PAGE? | |
1274 | SZA CLA | |
1275 | JMP I PUNBIN /NO--RETURN-- | |
1276 | JMS I [FINDSP /YES-FIND CURRENT PAGE NUMBER | |
1277 | TAD [LITBUF /RESET POINTERS | |
1278 | DCA TEMP2 | |
1279 | TAD I TEMP2 | |
1280 | DCA LITPTR | |
1281 | JMP I PUNBIN /--RETURN-- | |
1282 | ||
1283 | PPEZE, PEZE | |
1284 | \fHEADER, "S;"Y;"M;"B;"O;"L;"S | |
1285 | 211;211;211;211;211 /FOR /N HEADER | |
1286 | ||
1287 | /************************************************************ | |
1288 | /CODE OVERLAYED ON PASS 3 | |
1289 | /BY USER HEADER BUFFER | |
1290 | ||
1291 | /CONTINUATION OF EXPUNGE HANDLER | |
1292 | /ENTER ON PASS 1 ONLY | |
1293 | ||
1294 | EXPUNW, IFZERO HASH< | |
1295 | DCA TEMP1 | |
1296 | DCA EXPUN2 /CLEAR NEW HIGH TAG COUNTER | |
1297 | TAD HIGHTG | |
1298 | CMA | |
1299 | DCA TEMP3 /SAVE NUMBER OF SYM TBL ENTRIES | |
1300 | EXPUNY, TAD TEMP1 | |
1301 | DCA THISTG | |
1302 | JMS I [FINDTG /GET A SYMBOL | |
1303 | TAD TAG1 /ONLY SAVE THE SYMBOL IF | |
1304 | RTL | |
1305 | CLA /IT WAS A PSEUDO-OP, OR | |
1306 | TAD TAG3 /THE SYMBOLS I OR Z | |
1307 | SNL SMA CLA | |
1308 | JMP EXPUA4 /NO-FORGET TAG | |
1309 | TAD EXPUN2 /YES-RETURN TAG TO SYMBOL TABLE | |
1310 | DCA THISTG | |
1311 | JMS I [PUTTAG | |
1312 | ISZ EXPUN2 | |
1313 | EXPUA4, ISZ TEMP1 | |
1314 | ISZ TEMP3 /DONE YET? | |
1315 | JMP EXPUNY /NO- TRY NEXT TAG | |
1316 | CLA CMA /YES | |
1317 | TAD EXPUN2 /RESET HIGH TAG | |
1318 | DCA HIGHTG | |
1319 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
1320 | ||
1321 | EXPUN2, 0 | |
1322 | > | |
1323 | \f IFNZRO HASH< | |
1324 | /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS | |
1325 | /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!) | |
1326 | ||
1327 | DCA THISTG /POINT TO FIRST ENTRY | |
1328 | TAD TAGMAX /SET THE COUNT | |
1329 | CIA | |
1330 | DCA TEMP1 | |
1331 | EXPUNL, JMS I [FINDTG /GO GET ONE | |
1332 | TAD TAG1 | |
1333 | RTL | |
1334 | CLA | |
1335 | TAD TAG3 | |
1336 | SPA SZL CLA /PSEUDO OP? | |
1337 | JMP EXPUNS /YES, SKIP DELETION | |
1338 | DCA TAG1 /NO, WIPE IT | |
1339 | DCA TAG2 | |
1340 | DCA TAG3 | |
1341 | JMS I [PUTTAG /AND PUT IT BACK | |
1342 | STA | |
1343 | TAD HIGHTG | |
1344 | DCA HIGHTG /DECREMENT SYMBOL COUNT | |
1345 | EXPUNS, ISZ THISTG /POINT TO NEXT ENTRY | |
1346 | ISZ TEMP1 /TALLY COUNT | |
1347 | JMP EXPUNL /GET ANOTHER | |
1348 | JMP I [LOOKEX /DONE --RETURN-- | |
1349 | > | |
1350 | ||
1351 | /*************************************************************** | |
1352 | \f/ASSEMBLER HEADER BUFFER | |
1353 | ||
1354 | ZBLOCK HEADER+HEDLEN-. | |
1355 | ||
1356 | " ;" ;"P;"A;"L;"8;"- | |
1357 | "V;"1;VERSION-12+"0;SUBVERSION | |
1358 | " | |
1359 | DATE, "N;"O;" ;"D;"A;"T;"E;" /GETS SET TO DD-MMM-YY IF DATE PRESENT | |
1360 | " ;" ;"P;"A;"G;"E;" ;0 | |
1361 | \f/PUSHDOWN LIST | |
1362 | /OCCUPIES NEXT 43(8) LOCATIONS | |
1363 | PDLND=. | |
1364 | ||
1365 | ||
1366 | ||
1367 | /********************************************************* | |
1368 | /ONCE ONLY CODE FOR /D OPTION | |
1369 | /PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE | |
1370 | /OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST | |
1371 | ||
1372 | DSWIT1, IFZERO HASH< | |
1373 | RELOC SYMPRT+4 | |
1374 | ||
1375 | DCA I SYMPRF | |
1376 | JMS SYMPRC | |
1377 | TAD [377 | |
1378 | JMS I OERROR | |
1379 | CLA CMA | |
1380 | DCA THISTG | |
1381 | SYMPRE, TAD [215 | |
1382 | JMS I OERROR | |
1383 | JMS SYMPPP | |
1384 | JMP SYMPRD | |
1385 | JMP SYMPR1 | |
1386 | SYMPRF, HSWIT1 | |
1387 | SYM204, 204 | |
1388 | RELOC | |
1389 | ||
1390 | > | |
1391 | IFNZRO HASH< | |
1392 | RELOC SYMNWP | |
1393 | DCA THISTG | |
1394 | DCA I SYMHSW | |
1395 | JMS DDTLDR | |
1396 | TAD [377 | |
1397 | JMS I OERROR | |
1398 | SYMLUP, TAD [215 | |
1399 | JMS I OERROR | |
1400 | TAD HIGHTG | |
1401 | CLL CIA | |
1402 | TAD THISTG | |
1403 | SZL CLA | |
1404 | JMP SYMXIT | |
1405 | JMP SYMGO | |
1406 | SYMHSW, HSWIT1 | |
1407 | RELOC | |
1408 | > | |
1409 | DSWITA= . | |
1410 | ||
1411 | /********************************************************** | |
1412 | PAGE | |
1413 | \f/************************************************************* | |
1414 | ||
1415 | /PAL8 TABLES - LOAD OVER INITIALIZATION CODE | |
1416 | ||
1417 | PDLST= PDLND+42 /PUSHDOWN LIST 43(8) LOCS LONG | |
1418 | ||
1419 | ||
1420 | LINBUF= PDLST+1 /LINE BUFFER OCCUPIES 122(8) LOCATIONS | |
1421 | ||
1422 | LITBUF= LINBUF+122 /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE) | |
1423 | / SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS | |
1424 | ||
1425 | TPINST= LITBUF+40 /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS | |
1426 | / SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS | |
1427 | ||
1428 | LITBF2= TPINST+40-17 /LITERAL BUFFER 2 CONTAINS UP TO 160(8) | |
1429 | /PAGE 0 LITERALS, SUBSCRIPTS 20-177 | |
1430 | ||
1431 | LITBF1= LITBF2+200-100 /LITERAL BUFFER 1 CONTAINS UP TO 100(8) | |
1432 | /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177 | |
1433 | ||
1434 | /************************************************************* | |
1435 | \f/ONCE ONLY CODE FOR ASSEMBLER START UP | |
1436 | /OVERLAYED BY BUFFERS | |
1437 | ||
1438 | /HANDLES SWITCH OPTIONS | |
1439 | ||
1440 | BEGIN, CIF 10 | |
1441 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
1442 | 5 /*COMMAND DECODER* | |
1443 | 2001 /DEFAULT INPUT EXTENSION IS .PA | |
1444 | NOCD, CDF 10 /RETURN | |
1445 | TAD I (7604 /IS THERE A BINARY FILE EXTENSION? | |
1446 | SNA | |
1447 | TAD (216 /NO - DEFAULT EXTENSION IS .BN | |
1448 | DCA I (7604 /YES | |
1449 | TAD I (7611 /IS THERE A LISTING FILE EXTENSION? | |
1450 | SNA | |
1451 | TAD (1423 /NO - DEFAULT EXTENSION IS .LS | |
1452 | DCA I (7611 | |
1453 | TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED? | |
1454 | CDF | |
1455 | AND (20 | |
1456 | ZT7640, SNA CLA | |
1457 | JMP BEGINA /NO | |
1458 | BEGIAA, DCA I (HSWITC /YES - GENERATE CR/LF IN PLACE OF F/F | |
1459 | JMP BEGIN2 | |
1460 | ||
1461 | BEGINA, TAD [7605 /WAS TTY THE PASS 3 DEVICE? | |
1462 | JMS I (OTYPE | |
1463 | AND (770 | |
1464 | SNA CLA | |
1465 | JMP BEGIAA /YES - GENERATE CR/LF IN PLACE OF F/F | |
1466 | DCA I (BEGIAB /NOT /T OR TTY: | |
1467 | ||
1468 | BEGIN2, CDF 10 | |
1469 | TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED? | |
1470 | CDF | |
1471 | AND (40 | |
1472 | SZA CLA | |
1473 | DCA I (SSWITC /YES -OMIT SYMBOL TABLE | |
1474 | CDF 10 | |
1475 | AC2000 | |
1476 | AND I (MPARAM+1 | |
1477 | CDF | |
1478 | SNA CLA /WAS THE /N OPTION SELECTED? | |
1479 | JMP BEGIN4 /NO | |
1480 | TAD BEGSKP /SET SWITCH | |
1481 | DCA I (NSWITC /YES -SYMBOL TABLE BUT NO LISTING | |
1482 | \fBEGIN4, CDF 10 | |
1483 | TAD I (MPARAM /WAS THE /H OPTION SELECTED? | |
1484 | CDF | |
1485 | AND (20 | |
1486 | ZH7640, SNA CLA | |
1487 | JMP BEGINB /NO | |
1488 | BEGHSW, TAD I (FORM21 /YES -SUPPRESS LISTING PAGE FORMAT | |
1489 | DCA I (HSWITC | |
1490 | DCA I (HSWIT1 | |
1491 | BEGSKP, CLA SKP | |
1492 | BEGINB, DCA I (HSWIT2 | |
1493 | CDF 10 | |
1494 | TAD I (MPARAM /WAS THE /D OPTION SELECTED? | |
1495 | CDF | |
1496 | AND [400 | |
1497 | ZD7640, SNA CLA | |
1498 | JMP BEGIN1 /NO | |
1499 | TAD I XREG1 /YES -DDT COMPATIBLE SYMBOL TABLE | |
1500 | DCA I LAST3 /SUBSTITUTE ALTERNATE CODE | |
1501 | ISZ DSWIT3 /INTO SYMBOL TABLE OUTPUT ROUTINE | |
1502 | JMP .-3 | |
1503 | TAD I XREG2 | |
1504 | DCA I LAST4 | |
1505 | ISZ DSWIT4 | |
1506 | JMP .-3 | |
1507 | ||
1508 | BEGIN1, TAD I (JSBITS /RESET JOB STATUS WORD TO | |
1509 | AND (6777 /INDICATE PAL8 NOT RESTARTABLE | |
1510 | TAD (1000 | |
1511 | DCA I (JSBITS | |
1512 | CIF CDF 10 | |
1513 | JMS I (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE | |
1514 | JMP I (BEGINZ /CONTINUE ON | |
1515 | \f | |
1516 | DSWIT3, DSWIT1-DSWITA | |
1517 | DSWIT4, DSWIT2-DSWITB | |
1518 | PAGE | |
1519 | \f/ONCE ONLY CODE CONTINUED | |
1520 | /ASSEMBLER INITIALIZATION PROCEDURES | |
1521 | ||
1522 | ||
1523 | BEGINZ, TAD [7600 /WHAT DEVICE FOR BINARY OUTPUT? | |
1524 | JMS I (OTYPE | |
1525 | SMA CLA | |
1526 | TAD (-70 /STAND-ALONE | |
1527 | TAD (-10 /DIRECTORY | |
1528 | DCA I (SWAPR2+LEADER /SET AMOUNT OF LEADER TRAILER | |
1529 | DCA LAST1 /NO DEFINED TAG | |
1530 | BEGIN5, IFZERO HASH< | |
1531 | CDF | |
1532 | TAD I BLK1 /MOVE SYMBOL TABLE TO FIELD 1 | |
1533 | CDF 10 | |
1534 | DCA I BLK2 | |
1535 | ISZ BLK1 | |
1536 | ISZ BLK2 | |
1537 | ISZ BLK3 | |
1538 | JMP BEGIN5 | |
1539 | > | |
1540 | CDF | |
1541 | DCA I [LINBUF+120 /SET BUFFER POINTERS | |
1542 | DCA I (LINBUF+121 | |
1543 | TAD [7600 /IS PTP BINARY OUTPUT DEVICE? | |
1544 | JMS I (OTYPE | |
1545 | DCA BLK1 | |
1546 | TAD BLK1 | |
1547 | AND (770 | |
1548 | TAD (-20 | |
1549 | SNA CLA | |
1550 | DCA I (PTPSW /YES - SET PTP SWITCH | |
1551 | TAD BLK1 /NO - IS IT A DIRECTORY DEVICE? | |
1552 | SPA CLA | |
1553 | JMP .+3 /NO | |
1554 | TAD (TAD [77 /YES - SET DIRECTORY SWITCH | |
1555 | DCA I (DIRSW | |
1556 | TAD [7605 /IS PTP GETTING LISTING OUTPUT? | |
1557 | JMS I (OTYPE | |
1558 | AND (770 | |
1559 | TAD (-20 | |
1560 | SNA CLA | |
1561 | DCA I (SWAPR2+PTPSW1 /YES - SET PASS 3 PTP SWITCH | |
1562 | TAD [7605 /NO - IS DIRECTORY DEVICE GETTING | |
1563 | JMS I (OTYPE /LISTING OUTPUT? | |
1564 | SPA CLA | |
1565 | JMP .+3 /NO | |
1566 | TAD (TAD [77 /YES - SET PASS 3 DIRECTORY SWITCH | |
1567 | DCA I (SWAPR2+DIRSW1 | |
1568 | JMP I (BEGINF | |
1569 | \fMONLST, TEXT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/ | |
1570 | *.-1 | |
1571 | ||
1572 | /CONTINUED CHECK OF COMMAND DECODER OPTIONS | |
1573 | ||
1574 | BEGINH, CDF 10 | |
1575 | TAD I (MPARAM /WAS THE /G OR /L OPTION CHOSEN? | |
1576 | CDF | |
1577 | AND (41 | |
1578 | SNA CLA | |
1579 | JMP I (BEGISW /NO | |
1580 | CDF 10 /YES | |
1581 | TAD I [7600 | |
1582 | SZA CLA /WAS THERE A BINARY OUTPUT FILE? | |
1583 | JMP YESBIN /YES | |
1584 | BINLOP, TAD PALBIN /NO - CREATE FILE PAL8BN.TM | |
1585 | DCA I PALBIX /ON SYSTEM DEVICE | |
1586 | ISZ BINLOP | |
1587 | ISZ PALBIX | |
1588 | ISZ BINCNT | |
1589 | JMP BINLOP | |
1590 | CDF | |
1591 | TAD (-10 /SET AMOUNT OF LEADER TRAILER | |
1592 | DCA I (SWAPR2+LEADER | |
1593 | \f/SET UP FOR LOAD OR LOAD AND GO | |
1594 | ||
1595 | YESBIN, CDF | |
1596 | CIF 10 | |
1597 | CLA IAC | |
1598 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
1599 | 2 /* LOOKUP PERMANENT FILE * | |
1600 | LOAD, PLOAD /FILENAME ABSLDR.SV | |
1601 | BINCNT, -5 /FILE LENGTH | |
1602 | JMP NOLOAD /ABSLDR.SV NOT FOUND | |
1603 | TAD LOAD /NORMAL RETURN | |
1604 | DCA I (CHAIN /SET STARTING BLOCK NUMBER | |
1605 | DCA I (LSWITC /FOR CHAIN CALL | |
1606 | JMP I (BEGISW | |
1607 | ||
1608 | NOLOAD, JMS I [ERROR /GENERATE LD ERROR MESSAGE | |
1609 | LD | |
1610 | JMP I (BEGISW /ASSEMBLE BUT DO NOT CHAIN TO LOADER | |
1611 | ||
1612 | BLK1, SYMS | |
1613 | BLK2, 7600+SYMS-SYME | |
1614 | BLK3, SYMS-SYME | |
1615 | ||
1616 | PALBIX, 7600 | |
1617 | PALBIN, 1 | |
1618 | FILENAME PAL8BN.TM | |
1619 | PAGE | |
1620 | \fCCC, TAD I CC231 /FINAL PIECE OF STARTUP ONCE-ONLY CODE | |
1621 | SNA | |
1622 | TAD CC23 | |
1623 | DCA I CC231 /"HSWITC"=JMP FORMF1 IF WAS 0 | |
1624 | BEGISW, CDF 10 | |
1625 | TAD I CCJWD | |
1626 | CDF 0 | |
1627 | AND CCJBIT | |
1628 | ZJ7640, SNA CLA /WAS /J OPTION SPECIFIED? | |
1629 | DCA I CCJLOC /NO - PRINT UNASSEMBLED CONDITIONAL CODE | |
1630 | CDF 10 | |
1631 | TAD I CCWWD | |
1632 | CDF 0 | |
1633 | AND CCWBIT | |
1634 | ZW7640, SNA CLA /WAS /W OPTION SPECIFIED? | |
1635 | JMP D4 /V3C | |
1636 | D5, TAD I CC231 | |
1637 | CIA | |
1638 | TAD CC23 | |
1639 | SZA CLA /ARE WE OUTPUTTING FF'S IN LISTING? | |
1640 | JMP BEGIS3 /NO | |
1641 | TAD CC24 /YES - SUBSTITUTE SOME CODE | |
1642 | DCA I CC25 | |
1643 | TAD CC26 | |
1644 | DCA I CC27 | |
1645 | TAD CC24 | |
1646 | DCA I CC28 | |
1647 | BEGIS3, JMS I OVLL7 /CALL SYSTEM DEVICE | |
1648 | 4200 /WRITE 2 PAGES | |
1649 | SWAP1 /FORM SWAP1 | |
1650 | ASWAP /INTO TEMP AREA | |
1651 | JMP I OVLL8 /ERROR?! | |
1652 | TAD I LAST2 /MOVE PASS 1&2 ONLY CODE | |
1653 | DCA I TAGXR /OVER PASS3 SWAPPED OUT CODE | |
1654 | ISZ CC29 | |
1655 | JMP .-3 | |
1656 | IFNZRO HASH< | |
1657 | JMS I CCHSH /FINALLY HASH OUT THE TABLE | |
1658 | > | |
1659 | ||
1660 | JMP I .+1 | |
1661 | START2-1 /OK - NOW GO DO SOME ASSEMBLING! | |
1662 | D4, DCA I CCWLOC /NO - DON'T WIPE LITERALS AS YOU DUMP THEM | |
1663 | DCA I (D3 | |
1664 | JMP D5 /V3C | |
1665 | \fOVLL7, 7607 | |
1666 | OVLL8, SYSER3 | |
1667 | ||
1668 | CC231, HSWITC | |
1669 | CC23, FORMF1&177+5200 | |
1670 | CC24, STA | |
1671 | CC25, FORMF1 | |
1672 | CC26, DCA LINCNT | |
1673 | CC27, FORMF1+1 | |
1674 | CC28, FORMF1+2 | |
1675 | CC29, SWAPB2-SWAPE2 | |
1676 | ||
1677 | IFNZRO HASH< | |
1678 | CCHSH, HSHSMS | |
1679 | > | |
1680 | CCJWD, MPARAM | |
1681 | CCJBIT, 4 | |
1682 | CCJLOC, IFTST4 | |
1683 | CCWWD, MPARAM+1 | |
1684 | CCWBIT, 2 | |
1685 | CCWLOC, LITHAK | |
1686 | PLOAD, FILENAME ABSLDR.SV | |
1687 | ||
1688 | CKBAT, TAD I CC7777 /GET BATCH FLAG WORD | |
1689 | CLL RTL | |
1690 | SNL CLA /BATCH RUNNING? | |
1691 | JMP I CCOPTM /NO, GO WITH LINK OFF | |
1692 | TAD I CC7777 | |
1693 | AND CC0070 /GET BATCH FIELD | |
1694 | TAD CCCIF0 /FORM CIF TO BATCH FIELD | |
1695 | DCA OTYPB1 /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH | |
1696 | TAD CCJMSB /LOG INSTEAD | |
1697 | DCA OTYPB2 | |
1698 | TAD OTYPTD | |
1699 | DCA OTYPB3 | |
1700 | JMP I CCOPTM /RETURN TO CORE DETERMINER, LINK SET | |
1701 | ||
1702 | CC7777, 7777 | |
1703 | CCOPTM, OPTIM4 | |
1704 | CC0070, 70 | |
1705 | CCCIF0, CIF 0 | |
1706 | CCJMSB, JMS I [BATOUT | |
1707 | \f/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE | |
1708 | ||
1709 | IFNZRO .-LITBF1-200&4000 <*LITBF1+200> | |
1710 | ||
1711 | OTYPEO, 0 /TYPE A CHARACTER, CHECKING FOR ^O AND ^C | |
1712 | DCA OTYPEC /SAVE CHAR | |
1713 | JMS CTCCHK /CHECK FOR ^C - RETURN CHAR-203 IN AC | |
1714 | TAD (-14 | |
1715 | SNA CLA /^O? | |
1716 | JMP I OTYPEO /YES | |
1717 | OTYPTD, TAD OTYPEC | |
1718 | OTYPB1, TLS | |
1719 | OTYPB2, TSF | |
1720 | OTYPB3, JMP .-1 /WAIT FOR TTY | |
1721 | TAD [-215 | |
1722 | OTYPCR, SZA CLA /SET TO CLA DURING "ERRORS DETECTED" STUFF | |
1723 | JMP I OTYPEO | |
1724 | TAD [212 /IF CHAR WAS CR, TYPE LF | |
1725 | JMP OTYPEO+1 | |
1726 | OTYPEC, 0 | |
1727 | ||
1728 | CTCCHK, 0 /CHECK FOR ^C | |
1729 | TAD [200 | |
1730 | KRS /OR IN KEYBOARD CHAR | |
1731 | TAD (-203 | |
1732 | SNA | |
1733 | KSF /3B BUT WAS CHAR REALLY THERE? | |
1734 | JMP I CTCCHK /NO ^C - RETURN | |
1735 | JMP I [7600 /RETURN TO OS/8 | |
1736 | ||
1737 | TTLMSG, "E-240^100+"R-240 /ERRORS DETECTED: | |
1738 | "R-240^100+"O-240 | |
1739 | "R-240^100+"S-240 | |
1740 | "D-240 | |
1741 | "E-240^100+"T-240 | |
1742 | "E-240^100+"C-240 | |
1743 | "T-240^100+"E-240 | |
1744 | "D-240^100+":-240 | |
1745 | 0 | |
1746 | ||
1747 | "L-240^100+"I-240 /LINKS GENERATED: | |
1748 | "N-240^100+"K-240 | |
1749 | "S-240^100 | |
1750 | "G-240^100+"E-240 | |
1751 | "N-240^100+"E-240 | |
1752 | "R-240^100+"A-240 | |
1753 | "T-240^100+"E-240 | |
1754 | "D-240^100+":-240 | |
1755 | 0 | |
1756 | PAGE | |
1757 | \f/OUTPUT A CHARACTER TO OUTPUT DEVICE | |
1758 | /CALLED BY JMS I OCHAR | |
1759 | /WITH CHARACTER IN 8-BIT ASCII IN AC | |
1760 | ||
1761 | OUTPT1, PUNCHX /PASS 2=PUNCHX; 3=XLISTX | |
1762 | ||
1763 | OUTPUT, 0 | |
1764 | AND [377 /MASK OUT LEFT 4 BITS | |
1765 | DCA OUTPT2 /STORE | |
1766 | TAD I OUTPT1 /IS THIS PASS 3 AND | |
1767 | SNA | |
1768 | TAD OUTINH /IS THIS COVERED BY XLIST? | |
1769 | SZA CLA | |
1770 | JMP I OUTPUT /YES--RETURN-- | |
1771 | TAD OUTPT2 /NO - GET CHARACTER | |
1772 | AND [200 | |
1773 | SNA CLA | |
1774 | TAD OUTPT2 /IF LESS THAN 200, THEN | |
1775 | TAD CHKSUM /ADD IT TO CHECKSUM | |
1776 | DCA CHKSUM | |
1777 | TAD OUTPT2 /GET CHARACTER | |
1778 | TAD (-211 /IS IT A TAB? | |
1779 | SNA CLA | |
1780 | JMP OUTPT3 /YES - OUTPUT SPACES | |
1781 | JMS OUTPUX /NO - OUTPUT CHARACTER | |
1782 | TAD OUTPT2 /IS IT LINE FEED? | |
1783 | TAD (-212 | |
1784 | SZA CLA | |
1785 | JMP I OUTPUT /NO--RETURN-- | |
1786 | TAD [7773 /YES - RESET LSTCNT | |
1787 | DCA LSTCNT | |
1788 | JMP I OUTPUT /--RETURN-- | |
1789 | ||
1790 | \f/OUTPUT SPACES INSTEAD OF TAB | |
1791 | ||
1792 | OUTPT3, TAD [240 | |
1793 | DCA OUTPT2 | |
1794 | JMS OUTPUX /OUTPUT SPACE | |
1795 | TAD LSTCNT /TAB STOPS ARE EVERY 8 SPACES | |
1796 | AND [7 | |
1797 | SZA CLA | |
1798 | JMP .-4 | |
1799 | JMP I OUTPUT /--RETURN-- | |
1800 | ||
1801 | /OUTPUT THE CHARACTER | |
1802 | /PACKS CHARACTERS IN STANDARD OS/8 FORMAT | |
1803 | ||
1804 | OUTPUX, 0 | |
1805 | ISZ OUJMP /BUMP 3-WAY SWITCH | |
1806 | OUJMP, HLT /WILL BE CHANGED - SHOULD NEVER HALT | |
1807 | JMP OCHAR1 /CHARACTER #1 | |
1808 | JMP OCHAR2 /CHARACTER #2 | |
1809 | OCHAR3, TAD OUTPT2 /CHARACTER #3 | |
1810 | CLL RTL | |
1811 | RTL | |
1812 | AND [7400 | |
1813 | TAD I OUPOLD /ADD 4 BITS TO WORD 1 | |
1814 | DCA I OUPOLD | |
1815 | TAD OUTPT2 | |
1816 | CLL RTR | |
1817 | RTR | |
1818 | RAR | |
1819 | AND [7400 | |
1820 | TAD I OUPTR /ADD 4 BITS TO WORD 2 | |
1821 | DCA I OUPTR | |
1822 | TAD OUJMPE | |
1823 | DCA OUJMP /RESET SWITCH | |
1824 | ISZ OUPTR | |
1825 | ISZ OUDWCT /BUFFER FULL? | |
1826 | JMP OUCHLV /NO | |
1827 | TAD [200 /YES | |
1828 | JMS I (OUTDMP /DUMP BUFFER | |
1829 | JMS OUSETP /RESET POINTERS | |
1830 | JMP OUCHLV | |
1831 | ||
1832 | \fOCHAR2, TAD OUPTR /SAVE POINTER | |
1833 | DCA OUPOLD | |
1834 | ISZ OUPTR | |
1835 | OCHAR1, TAD OUTPT2 | |
1836 | DCA I OUPTR /SET 8 BIT WORD | |
1837 | OUCHLV, TAD OUTPT2 | |
1838 | TAD [40 | |
1839 | AND [100 /CHECK FOR PRINTABLE CHAR | |
1840 | SZA CLA /IF IT IS, | |
1841 | ISZ LSTCNT /BUMP TAB COUNT | |
1842 | OUTINH, 0 /ALWAYS 0 OR 1! | |
1843 | JMP I OUTPUX /--RETURN-- | |
1844 | ||
1845 | OUPOLD, 0 | |
1846 | OUPTR, 0 | |
1847 | OUJMPE, JMP OUJMP | |
1848 | OUDWCT, 0 | |
1849 | OUTPT2, 0 | |
1850 | ||
1851 | OUSETP, 0 | |
1852 | TAD [7600 /SET OUTPUT WORD COUNT | |
1853 | DCA OUDWCT /TO 200 | |
1854 | TAD (OUBUF | |
1855 | DCA OUPTR /RESET POINTER | |
1856 | TAD OUJMPE | |
1857 | DCA OUJMP /RESET SWITCH | |
1858 | CLL /MUST CLEAR LINK!! | |
1859 | JMP I OUSETP /--RETURN-- | |
1860 | \f/HANDLER FOR DEVICE PSEUDO-OP | |
1861 | ||
1862 | DEVICX, JMS I [SPNOR /IGNORE TRAILING SPACES | |
1863 | TAD [-5 | |
1864 | JMP DEVIC1 /PACK 4 CHARACTERS | |
1865 | ||
1866 | ||
1867 | /HANDLER FOR FILENAME PSEUDO-OP | |
1868 | ||
1869 | FILENX, JMS I [SPNOR /IGNORE TRAILING SPACES | |
1870 | TAD (-7 | |
1871 | JMS FILE1 /PACK 6 CHARACTERS | |
1872 | TAD CHAR | |
1873 | TAD [-". /WAS CHARACTER . ? | |
1874 | SNA CLA | |
1875 | JMS I [GETC /YES-SKIP TO EXTENSION | |
1876 | AC7775 | |
1877 | DEVIC1, JMS FILE1 /PACK 2 CHARACTERS | |
1878 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
1879 | ||
1880 | /PACK CHARACTERS | |
1881 | /NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY | |
1882 | ||
1883 | FILE1, 0 | |
1884 | DCA FILE6 /SAVE # OF CHARACTERS TO PACK | |
1885 | DCA I (TEXT6 /RESET PACK SWITCH | |
1886 | FILE4, JMS I [TSTALN /IS CHARACTER IN CHAR ALPHANUMERIC? | |
1887 | SKP | |
1888 | JMP FILE5 /NO-DONE PACKING | |
1889 | ISZ FILE6 /YES-TOO MANY CHARACTERS? | |
1890 | JMP FILE3 /NO-O.K. | |
1891 | CLA CMA /YES | |
1892 | DCA FILE6 /RESET # OF CHARACTERS AND IGNORE | |
1893 | JMP FILE2 | |
1894 | ||
1895 | FILE3, TAD CHAR | |
1896 | JMS I (TEXT2 /PACK A CHARACTER | |
1897 | FILE2, JMS I [GETC /GET A CHARACTER | |
1898 | JMP FILE4 /TEST IT | |
1899 | ||
1900 | JMS I (TEXT2 /PACK A ZERO CHAR | |
1901 | FILE5, ISZ FILE6 /ARE WE DONE? | |
1902 | JMP .-2 /NO - PAD WITH ZEROES | |
1903 | JMP I FILE1 /YES--RETURN-- | |
1904 | FILE6, 0 | |
1905 | PAGE | |
1906 | \f/HANDLER FOR TEXT PSEUDO-OP | |
1907 | /SPACES ARE IGNORED TO DELIMITER | |
1908 | /DELIMITER IS FIRST PRINTING CHARACTER | |
1909 | /OTHER THAN SPACE | |
1910 | /NON-PRINTING CHARACTERS ARE ILLEGAL | |
1911 | /A PRINTING CHARACTER HAS EITHER BIT 5 | |
1912 | /OR BIT 6 SET, BUT NOT BOTH | |
1913 | ||
1914 | TEXT8, JMS I [GETC /GET NEXT CHARACTER | |
1915 | TEXTX, CLL CLA CML RAR /AC=4000 | |
1916 | DCA GETCI /; AND / ARE NOT END OF LINE | |
1917 | JMS TEXT1A /CHECK FOR PRINTING CHARACTER | |
1918 | JMP TEXT8 /NON PRINTING - IGNORE | |
1919 | TAD [-240 /IGNORE SPACES UNTIL DELIMITER | |
1920 | SNA /HAS BEEN FOUND | |
1921 | JMP TEXT8 | |
1922 | TAD [240 /RESTORE CHARACTER | |
1923 | CIA | |
1924 | DCA VALUE2 /STORE NEGATIVE DELIMITER | |
1925 | DCA TEXT6 /SET PACKING SWITCH | |
1926 | TEXT3, JMS I [GETC /GET NEXT CHARACTER | |
1927 | JMS TEXT1A /IS IT A PRINTING CHARACTER? | |
1928 | JMP TEXT9 /NO - IC | |
1929 | TAD VALUE2 /YES - IS IT DELIMITER? | |
1930 | SNA CLA | |
1931 | JMP TEXT4 /YES - TERMINATE | |
1932 | TAD CHAR /NO - PACK AND OUTPUT | |
1933 | JMS TEXT2 /PACK IT | |
1934 | JMP TEXT3 | |
1935 | ||
1936 | TEXT4, DCA GETCI /RESET GETCI TO CALL ; AND / END OF LINE | |
1937 | JMS I [GETC /SKIP DELIMITER | |
1938 | TEXT4X, JMS TEXT2 /OUTPUT 0 TO FILE | |
1939 | JMS TEXT2 | |
1940 | /CHANGE TEXT4X TO: | |
1941 | / NOP | |
1942 | /FOR NO EXTRA WORD OF ZEROS | |
1943 | DCA GETCI /RESET GETCI IN CASE WE HIT CR | |
1944 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
1945 | \fTEXT9, JMS I [ERROR /GENERATE IC ERROR MESSAGE | |
1946 | IC | |
1947 | JMP TEXT3 | |
1948 | ||
1949 | /SKIP ON PRINTING CHARACTER | |
1950 | ||
1951 | TEXT1A, 0 | |
1952 | TAD CHAR | |
1953 | SPA SNA CLA /IS CHARACTER - | |
1954 | JMP TEXT4X /YES | |
1955 | TAD CHAR | |
1956 | TAD [40 | |
1957 | AND [100 | |
1958 | SZA CLA /IS THE CHAR PRINTING? | |
1959 | ISZ TEXT1A /YES - INCREMENT RETURN | |
1960 | TAD CHAR /WITH CHARACTER IN AC | |
1961 | JMP I TEXT1A /--RETURN-- | |
1962 | ||
1963 | /OUTPUT 2 TEXT CHARACTERS (ONE REGISTER) | |
1964 | /ENTER WITH CHARACTERS IN AC | |
1965 | ||
1966 | TEXT2, 0 | |
1967 | AND [77 /GET RIGHT 6 BITS | |
1968 | ISZ TEXT6 /WHICH HALF OF WORD? | |
1969 | JMP TEXT5 /LEFT | |
1970 | TAD TEXT7 /RIGHT--ADD IN LEFT HALF | |
1971 | JMS I [PUNBIN /OUTPUT IT | |
1972 | JMP I TEXT2 /--RETURN-- | |
1973 | ||
1974 | TEXT5, JMS I [RTL6 /GET LEFT HALF OF WORD | |
1975 | DCA TEXT7 /SAVE IT | |
1976 | CLA CMA /SET SWITCH FOR RIGHT HALF | |
1977 | DCA TEXT6 | |
1978 | JMP I TEXT2 /--RETURN-- | |
1979 | ||
1980 | TEXT6, 0 | |
1981 | TEXT7, 0 | |
1982 | \f/HANDLER FOR EXPUNGE PSEUDO-OP | |
1983 | ||
1984 | EXPUNX, TAD PASS /IS THIS PASS 1 | |
1985 | SMA CLA | |
1986 | JMP I [LOOKEX /NO--EXIT TO MAIN-- | |
1987 | JMP I (EXPUNW /YES-CONTINUE AT EXPUNW | |
1988 | ||
1989 | ||
1990 | ||
1991 | /CLOSE OUTPUT FILE | |
1992 | ||
1993 | OCLOSE, 0 | |
1994 | TAD I (OUTINH /OUTPUT INHIBITED? | |
1995 | SZA CLA | |
1996 | JMP I OCLOSE /YES--RETURN-- | |
1997 | PTPSW, TAD [232 /NO-0 IF PTP: - OUTPUT ^Z | |
1998 | JMS I OCHAR | |
1999 | JMS I OCHAR /AND ZEROS | |
2000 | FILLLP, JMS I OCHAR | |
2001 | DIRSW, TAD [177 /TAD [77 IF NOT DIRECTORY | |
2002 | AND I (OUDWCT /FILL OUT BUFFER OR HALF BUFFER | |
2003 | SZA CLA /WITH ZEROS | |
2004 | JMP FILLLP | |
2005 | TAD I (OUDWCT /IS THERE OUTPUT TO BE DUMPED? | |
2006 | TAD [200 | |
2007 | SZA | |
2008 | JMS OUTDMP /YES - DUMP IT | |
2009 | TAD OUFILE /GET DEVICE NUMBER IN AC | |
2010 | CIF 10 | |
2011 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
2012 | 4 /*CLOSE OUTPUT FILE* | |
2013 | OUCNAM, 0 /POINTER TO FILENAME TO BE DELETED | |
2014 | OUCCNT, 0 /LENGTH OF NEW PERMANENT FILE | |
2015 | JMP SYSER3 /DE**FATAL ERROR** | |
2016 | JMP I OCLOSE /--RETURN-- | |
2017 | ||
2018 | OUFILE, ZBLOCK 5 | |
2019 | \f/OUTPUT DUMP | |
2020 | /AC CONTAINS CONTROL WORD FOR DUMP | |
2021 | ||
2022 | OUTDMP, 0 | |
2023 | TAD [4000 /BE SURE CONTROL WORD IS | |
2024 | DCA OUCTLW /A WRITE OPERATION | |
2025 | TAD OUBLK /GET STARTING BLOCK NUMBER | |
2026 | TAD OUCCNT /ADD IN COUNT | |
2027 | DCA OUREC /SET THIS BLOCK NUMBER | |
2028 | TAD OUCTLW | |
2029 | TAD [100 /ROUND HALF-BLOCK, IF ANY | |
2030 | CLL RTL | |
2031 | RTL | |
2032 | RTL | |
2033 | AND [17 /GET THIS COUNT | |
2034 | TAD OUCCNT | |
2035 | DCA OUCCNT /ADD TO TOTAL COUNT | |
2036 | TAD OUCCNT /IS OUTPUT DEVICE FULL? | |
2037 | CLL CML | |
2038 | TAD OUELEN /CHECK AGAINST MAXIMUM LENGTH | |
2039 | SNL SZA CLA | |
2040 | JMP SYSER2 /DF**FATAL ERROR** | |
2041 | JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER | |
2042 | OUCTLW, 0 /CONTROL WORD | |
2043 | OUBUF /BEGINNING OF OUTPUT BUFFER | |
2044 | OUREC, 0 /STARTING BLOCK NUMBER | |
2045 | SYSER3, CLA SKP /ERROR RETURN | |
2046 | JMP I OUTDMP /--RETURN-- | |
2047 | SYSERR, TAD (DE /DE **FATAL ERROR** | |
2048 | JMP I [MONERR | |
2049 | ||
2050 | OUHNDL, 0 | |
2051 | OUBLK, 0 | |
2052 | OUELEN, 0 | |
2053 | ||
2054 | SYSER2, TAD (DF /GENERATE DF ERROR MESSAGE | |
2055 | JMP I [MONERR /**FATAL ERROR** | |
2056 | PAGE | |
2057 | \f/MAINLINE CODE | |
2058 | ||
2059 | LOOKE2, 0 /WAS THIS END OF LINE | |
2060 | TAD CHAR / OR END OF CONDITIONAL? | |
2061 | TAD [-"> | |
2062 | SNA | |
2063 | JMP CONEND /END OF CONDITIONAL | |
2064 | TAD ("> | |
2065 | SMA CLA | |
2066 | JMP I LOOKE2 /NOT END OF LINE--RETURN-- | |
2067 | LOOKE1, JMS I [GETC /GET A CHARACTER | |
2068 | MAIN, JMS I (CTCCHK /CHECK FOR ^C | |
2069 | CLA /** CTCCHK RETURNS AC NON-ZERO! | |
2070 | JMS I [SPNOR /IGNORE SPACES | |
2071 | TAD CHAR | |
2072 | TAD (-"$ /WAS IT $ ? | |
2073 | SNA /YES-- | |
2074 | JMP I (ENDPAS /NO-END THIS PASS | |
2075 | TAD ("$-"* | |
2076 | SNA CLA /WAS IT * ? | |
2077 | JMP STAR /YES-HANDLE * | |
2078 | JMS I [TSTALP /NO-WAS IT ALPHABETIC? | |
2079 | JMP ALPHA /YES | |
2080 | JMS LOOKE2 /NO | |
2081 | TOEXP, JMS I [EXP /GET REST OF EXPRESSION | |
2082 | TAD LININD | |
2083 | DCA LINKSW /STORE LINK SWITCH | |
2084 | TAD VALUE | |
2085 | JMS I [PUNBIN /OUTPUT THE REGISTER | |
2086 | LOOKEX, JMS I [SPNOR /IGNORE TRAILING SPACES | |
2087 | JMS LOOKE2 /IS LINE ENDED? | |
2088 | ILCHAR, JMS I [ERROR /NO-GENERATE IC ERROR MESSAGE | |
2089 | IC | |
2090 | JMP CONEN1 | |
2091 | ||
2092 | CONEND, TAD CONDSW /ARE WE INTO CONDITIONALS? | |
2093 | SNA | |
2094 | JMP ILCHAR /NO - > IS ILLEGAL | |
2095 | IAC /ONE LESS CONDITIONAL | |
2096 | DCA CONDSW | |
2097 | CONEN1, JMS I [GETC /GET NEXT CHARACTER | |
2098 | JMP LOOKEX /AND TRY FOR END AGAIN | |
2099 | \f/HANDLER FOR * | |
2100 | ||
2101 | STAR, JMS I [GETC /GET NEXT CHARACTER AFTER * | |
2102 | JMS I [SPNOR /IGNORE SPACES | |
2103 | JMS I [EXP /GET REST OF EXPRESSION | |
2104 | STAR0, DCA STARSW /ENTER HERE FROM RELOC WITH AC = -1 | |
2105 | ISZ UNDFSW /WAS ANYTHING UNDEFINED? | |
2106 | JMP .+3 | |
2107 | JMS I [ERROR /YES-GENERATE UO ERROR MESSAGE | |
2108 | UO | |
2109 | TAD VALUE /NO | |
2110 | DCA OP | |
2111 | TAD LOC /IS THIS THE SAME PAGE AS | |
2112 | AND [7600 /THE PREVIOUS CODE? | |
2113 | CIA | |
2114 | TAD OP | |
2115 | AND [7600 | |
2116 | SNA CLA | |
2117 | JMP STAR2 /YES-PUNCH ORIGIN | |
2118 | JMS I [DUMPS /NO-DUMP LITERALS | |
2119 | TAD OFSBUF /SET OFFSET TO NEW VALUE | |
2120 | DCA OFFSET /AFTER LITERALS ARE DUMPED. | |
2121 | TAD OP /PUNCH NEW ORIGIN, SET "VALUE" | |
2122 | JMP I (STAR3 /FOR LISTING, AND SET UP IN NEW PAGE | |
2123 | ||
2124 | STAR2, TAD OFSBUF /SET OFFSET TO NEW VALUE | |
2125 | DCA OFFSET / | |
2126 | TAD OP | |
2127 | JMS I [PUNORG /PUNCH ORIGIN | |
2128 | DCA LAST1 /CLEAR LAST DEFINED SYMBOL | |
2129 | JMP I [PUNVAL | |
2130 | ||
2131 | ALPHA, JMS I [GETTAG /PICK UP TAG-IS IT IN TABLE? | |
2132 | DCA ALPHAI /STORE UNDEFINED TAG SWITCH | |
2133 | TAD TAG3 /IS IT A PSEUDO-OP? | |
2134 | SPA CLA | |
2135 | JMP I VALUE2 /YES-GO TO ITS HANDLER | |
2136 | TAD CHAR /NO | |
2137 | TAD (-", /WAS IT TERMINATED BY , ? | |
2138 | SNA | |
2139 | JMP COMMA /YES-DEFINE THE SYMBOL | |
2140 | TAD (",-"= /NO-WAS IT TERMINATED BY = ? | |
2141 | SNA CLA | |
2142 | JMP I (EQUAL /YES-EQUATE THE SYMBOL | |
2143 | AC4000 /NO | |
2144 | JMP TOEXP /TREAT AS AN EXPRESSION | |
2145 | \f/HANDLER FOR , | |
2146 | ||
2147 | COMMA, JMS I [GETC /GET NEXT CHARACTER | |
2148 | ISZ ALPHAI /WAS TAG DEFINED PREVIOUSLY? | |
2149 | JMP COMMA2 /YES | |
2150 | TAD LOC /NO-STORE CURRENT ADDRESS FOR DEFINITION | |
2151 | DCA VALUE2 | |
2152 | JMS I [INSRTG /PUT TAG IN SYMBOL TABLE | |
2153 | COMMA1, TAD TAG1 /STORE FOR ERROR MESSAGE OUTPUT | |
2154 | DCA LAST1 | |
2155 | TAD TAG2 | |
2156 | DCA LAST2 | |
2157 | TAD TAG3 | |
2158 | DCA LAST3 | |
2159 | TAD VALUE2 | |
2160 | DCA LAST4 | |
2161 | JMP MAIN /--EXIT TO MAIN-- | |
2162 | ||
2163 | COMMA2, TAD LOC /DO NEW AND OLD DEFINITIONS AGREE? | |
2164 | CIA | |
2165 | TAD VALUE2 | |
2166 | SNA CLA | |
2167 | JMP COMMA1 /YES-ALLOW REDEFINITION | |
2168 | JMS I [ERROR /NO-GENERATE ID ERROR MESSAGE | |
2169 | ID | |
2170 | JMP MAIN /--EXIT TO MAIN-- | |
2171 | \fOPTABL, OP0 /+ | |
2172 | OP1 /- | |
2173 | OP6 /% | |
2174 | OP2 /& | |
2175 | OP5 /(SPACE) | |
2176 | OPEXPL, OP5 /! - CHANGED TO OP3 IF /B ON | |
2177 | OP4 /^ | |
2178 | PAGE | |
2179 | \f/EXPRESSION PROCESSOR | |
2180 | /POSSIBLE RECURSIVE ENTRY | |
2181 | /ENTER WITH CHARACTER IN CHAR | |
2182 | ||
2183 | EXP, 0 | |
2184 | DCA EXPIND /SET INDICATOR (NOT 0 IF NO MRI FOUND) | |
2185 | DCA LININD /CLEAR LINK GENERATED SWITCH (' ) | |
2186 | DCA VALUE /START WITH "VALUE" = 0 | |
2187 | DCA UNDFSW /CLEAR UNDIFINED SWITCH | |
2188 | TAD EXP | |
2189 | JMS I [PUSHA /SAVE RETURN ADDRESS | |
2190 | DCA OP /OP=0; ADD | |
2191 | TAD EXPIND | |
2192 | SPA CLA | |
2193 | JMP I (EXPINT | |
2194 | TAD CHAR /IS CHARACTER A + ? | |
2195 | TAD [-"+ | |
2196 | CLL RTR /PUT THE 2 BIT IN THE LINK | |
2197 | SZA CLA /WAS CHAR 53(+) OR 55(-)? | |
2198 | JMP EXP1A /NO | |
2199 | RAL /YES - OP IS 0 OR 1, DEPENDING | |
2200 | EXP1, DCA OP | |
2201 | JMS I [GETC /GET NEXT CHARACTER | |
2202 | ISZ EXPIND /MRI NO LONGER LEGAL ON THIS LINE | |
2203 | EXP1A, TAD CHAR /IS CHARACTER A . ? | |
2204 | TAD [-". | |
2205 | SNA | |
2206 | JMP PERIOD /YES-GO TO . HANDLER | |
2207 | TAD (".-"" /NO-IS IT " ? | |
2208 | SNA | |
2209 | JMP QUOTE /YES-GO TO " HANDLER | |
2210 | TAD (""-"[ /NO-IS IT [ ? | |
2211 | CLL | |
2212 | SZA | |
2213 | TAD ("[-"( /OR (? | |
2214 | SNA CLA | |
2215 | JMP I (LIT /YES - LITERAL - LINK HOLDS WHICH KIND | |
2216 | JMS I [TSTALP /NO-IS IT ALPHABETIC? | |
2217 | JMP I (ALPHA1 /YES-HANDLE SYMBOL | |
2218 | JMS I [TSTNUM /NO-IS IT NUMERIC? | |
2219 | JMP NUMBER /YES-HANDLE NUMBER | |
2220 | ||
2221 | EXP2, JMS ENDCHK /NO-CHECK FOR END | |
2222 | JMP EXP1A /NOGO - TRY AGAIN | |
2223 | TAD OP | |
2224 | TAD [-4 /IS OP SPACE (4) | |
2225 | SNA CLA | |
2226 | JMP I (EXPXIT /YES-EXIT | |
2227 | JMS I [ERROR | |
2228 | IC /GIVE IC MESSAGE ON ILLEGAL OPERATOR | |
2229 | JMP I (EXPINT /EXIT ANYWAY | |
2230 | \f/END OF EXPRESSION CHECK | |
2231 | /SKIP IF OK | |
2232 | ||
2233 | ENDCHK, 0 | |
2234 | TAD CHAR | |
2235 | TAD (-"] /IS CHARACTER A ] ? | |
2236 | SZA /YES-SKIP A EXIT | |
2237 | TAD ("]-") /IS CHARACTER A ) ? | |
2238 | SZA /YES-SKIP A EXIT | |
2239 | TAD (")-"> /IS CHARACTER A > ? | |
2240 | SZA /YES-SKIP AND EXIT | |
2241 | TAD (">-"< /IS CHARACTER A < ? | |
2242 | SNA | |
2243 | JMP ENDCH1 /YES-SKIP AND EXIT | |
2244 | TAD ("< | |
2245 | SPA CLA /IS IT END-OF-LINE? | |
2246 | JMP ENDCH1 /YES-SKIP AND EXIT | |
2247 | JMS I [ICMESG /NO - GENERATE IC MESSAGE AND GET NEXT CHAR | |
2248 | JMP I ENDCHK /--RETURN-- | |
2249 | ||
2250 | ENDCH1, ISZ ENDCHK /INCREMENT RETURN ADDRESS | |
2251 | JMP I ENDCHK /--RETURN-- | |
2252 | ||
2253 | NUMBER, DCA TEMP | |
2254 | NUMBE2, TAD RADIX /IS THE CURRENT RADIX OCTAL? | |
2255 | SNA CLA | |
2256 | TAD CHAR /YES-IS THE DIGIT GREATER THAN 7? | |
2257 | TAD (-"8 | |
2258 | SMA CLA | |
2259 | JMP NUMBE3 /YES-ILLEGAL CHARACTER | |
2260 | TAD TEMP /NO-ADD IT TO THE PREVIOUS | |
2261 | CLL RAL /ACCUMULATED VALUE | |
2262 | CLL RAL | |
2263 | DCA TEMP2 | |
2264 | TAD RADIX /IS RADIX OCTAL? | |
2265 | AND TEMP /NO | |
2266 | TAD TEMP2 /YES | |
2267 | CLL RAL | |
2268 | TAD CHAR | |
2269 | TAD (-"0 | |
2270 | DCA TEMP | |
2271 | JMS I [GETC /GET NEXT CHARACTER | |
2272 | NUMBE4, JMS I [TSTNUM /IS IT NUMERIC? | |
2273 | JMP NUMBE2 /YES-CONTINUE ACCUMULATING NUMBER | |
2274 | TAD TEMP /NO-STORE NUMBER | |
2275 | NUMBE1, DCA VALUE2 | |
2276 | NUMBE5, TAD OP /GO COMBINE IT VIA LAST OPERATION | |
2277 | TAD (OPTABL | |
2278 | DCA TEMP /FIND THE OPERATOR HANDLER | |
2279 | TAD I TEMP | |
2280 | DCA TEMP | |
2281 | JMP I TEMP /GO TO THE HANDLER | |
2282 | \f/8 OR 9 FOUND DURING OCTAL RADIX | |
2283 | ||
2284 | NUMBE3, JMS I [ICMESG /GENERATE IC ERROR MESSAGE AND | |
2285 | JMP NUMBE4 /IGNORE CHARACTER | |
2286 | ||
2287 | ||
2288 | /HANDLER FOR . | |
2289 | ||
2290 | PERIOD, JMS I [GETC /GET NEXT CHARACTER | |
2291 | TAD LOC /MAKE CURRENT LOCATION | |
2292 | JMP NUMBE1 /INTO VALUE OF NUMBER | |
2293 | ||
2294 | /HANDLER FOR " | |
2295 | ||
2296 | QUOTE, ISZ TXTPTR | |
2297 | TAD I TXTPTR /GET CHARACTER FROM TEXT BUFFER | |
2298 | TAD [-215 /WAS IT CARRIAGE RETURN? | |
2299 | SNA CLA | |
2300 | JMP QUOTE1 /YES-IT IS IC-IGNORE " | |
2301 | TAD I TXTPTR /NO-PUT ASCII CODE INTO | |
2302 | DCA VALUE2 /VALUE WORD | |
2303 | JMS I [GETC /GET NEXT CHARACTER | |
2304 | JMP NUMBE5 /RETURN TO EXPRESSION PROCESSOR | |
2305 | ||
2306 | /CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT | |
2307 | ||
2308 | QUOTE1, JMS I [ERROR /GENERATE IC ERROR MESSAGE | |
2309 | IC | |
2310 | CLA CMA | |
2311 | DCA CHAR | |
2312 | JMP I (EXPXIT | |
2313 | PAGE | |
2314 | \f/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER | |
2315 | ||
2316 | ALPHA1, JMS I [GETTAG /PICK UP TAG | |
2317 | DCA ALPHAI /STORE UNDEFINED INDICATOR | |
2318 | ALPHA3, TAD TAG3 /IS IT A PSEUDO-OP? | |
2319 | SMA CLA | |
2320 | JMP .+3 | |
2321 | JMS I [ERROR /YES-GENERATE IP ERROR MESSAGE | |
2322 | IP | |
2323 | ISZ ALPHAI /NO-WAS IT UNDEFINED? | |
2324 | JMP ALPHA0 | |
2325 | ISZ UNDFSW /YES-SET UNDEFINED SWITCH | |
2326 | TAD PASS /IS THIS PASS 1? | |
2327 | SPA CLA | |
2328 | JMP ALPHA0 /YES-SUPPRESS ERROR MAESSAGE | |
2329 | JMS I [ERROR /NO-GENERATE US ERROR MESSAGE | |
2330 | US | |
2331 | ALPHA0, TAD TAG2 /NO-WAS IT A MEMORY REFERENCE INSTRUCTION? | |
2332 | SPA CLA | |
2333 | TAD CHAR /YES-GET TERMINATING CHARACTER | |
2334 | TAD [-240 /WAS IT SPACE? | |
2335 | SZA CLA | |
2336 | JMP I (NUMBE5 /NOT MEMREF FOLLOWED BY SPACE | |
2337 | JMS I [SPNOR /YES-IGNORE SPACES | |
2338 | TAD CHAR | |
2339 | SPA CLA | |
2340 | JMP I (NUMBE5 | |
2341 | TAD EXPIND /IS MEMORY REFERENCE INSTRUCTION OK? | |
2342 | SZA CLA | |
2343 | JMP I (NUMBE5 /NO- | |
2344 | DCA IZIND /YES-CLEAR I AND Z INDICATOR | |
2345 | TAD VALUE2 /STORE MRI ON PUSHDOWN LIST | |
2346 | JMS I [PUSHA | |
2347 | \fALPHA6, TAD IZIND | |
2348 | JMS I [PUSHA /PUSH THE I AND Z INDICATOR | |
2349 | JMS I [TSTALP /WAS TERMINATING CHARACTER ALPHABETIC? | |
2350 | SKP | |
2351 | JMP ALPHA4 /NO- | |
2352 | JMS I [GETTAG /YES-PICK UP TAG | |
2353 | DCA ALPHAI /STORE UNDEFINED INDICATOR | |
2354 | AC2000 | |
2355 | AND TAG1 /WAS IT AN I OR Z? | |
2356 | SNA CLA | |
2357 | JMP ALPHA5 /NO | |
2358 | TAD VALUE2 /YES-WAS IT I? | |
2359 | SNA | |
2360 | IAC /NO - SET LOW ORDER | |
2361 | TAD I PDLXR /GET OLD IZIND FROM PDL | |
2362 | DCA IZIND /SET NEW IZIND | |
2363 | JMS I [SPNOR /IGNORE SPACES | |
2364 | JMP ALPHA6 | |
2365 | ||
2366 | EXPINT, TAD EXPIND | |
2367 | TAD [4000 | |
2368 | DCA EXPIND | |
2369 | JMP ALPHA3 | |
2370 | ||
2371 | ALPHA5, AC4000 | |
2372 | ALPHA4, IAC | |
2373 | JMS I [EXP /GET REST OF EXPRESSION | |
2374 | TAD I PDLXR /RETRIEVE MRI | |
2375 | DCA IZIND | |
2376 | TAD I PDLXR | |
2377 | DCA VALUE2 | |
2378 | /FALL INTO NEXT PAGE | |
2379 | \f/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION | |
2380 | ||
2381 | TAD VALUE /GET ADDRESS | |
2382 | AND [7600 | |
2383 | SNA /IS IT PAGE 0? | |
2384 | JMP FIX4 /YES | |
2385 | CIA /NO-IS IT ON CURRENT PAGE? | |
2386 | TAD LOC | |
2387 | AND [7600 | |
2388 | SNA CLA | |
2389 | JMP FIX2 /YES | |
2390 | TAD VALUE /NO-SET UP LINK | |
2391 | JMS I (FINDS | |
2392 | DCA VALUE | |
2393 | TAD FIXMD0 /SET ' IN LISTING | |
2394 | DCA LININD | |
2395 | ISZ LINK /BUMP NUMBER OF LINKS GENERATED | |
2396 | FIXMD0, 0700 /PROTECTION FOR ISZ | |
2397 | LGERR, SKP /JMS I PERROR IF /E SPECIFIED | |
2398 | LG | |
2399 | JMS ADDIND /SET INDIRECT BIT IN INSTRUCTION | |
2400 | FIX2, TAD [200 /SET CURRENT PAGE BIT | |
2401 | TAD VALUE2 | |
2402 | DCA VALUE2 | |
2403 | TAD IZIND | |
2404 | AND [77 /WAS Z SPECIFIED? | |
2405 | SNA CLA | |
2406 | JMP FIX4 /NO | |
2407 | JMS I [ERROR /YES - ILLEGAL REFERENCE | |
2408 | IZ /TO PAGE 0 | |
2409 | FIX4, TAD IZIND /WAS THERE AN I? | |
2410 | AND [7700 | |
2411 | SZA CLA | |
2412 | JMS ADDIND /YES - ADD INDIRECT BIT TO INSTRUCTION | |
2413 | TAD VALUE /GET ADDRESS | |
2414 | AND [177 | |
2415 | TAD VALUE2 /GET OP CODE | |
2416 | DCA VALUE /STORE | |
2417 | POPJ, TAD I PDLXR | |
2418 | DCA TEMP /POP A WORD OFF THE STACK | |
2419 | JMP I TEMP /JUMP THROUGH IT. | |
2420 | \fADDIND, 0 /ROUTINE TO ADD INDIRECT BIT TO AN INSTR | |
2421 | TAD VALUE2 | |
2422 | CMA | |
2423 | AND [400 | |
2424 | SZA /WAS THERE ONE ALREADY? | |
2425 | JMP .+3 /NO | |
2426 | JMS I [ERROR /YES - ILLEGAL INDIRECT | |
2427 | II | |
2428 | TAD VALUE2 | |
2429 | DCA VALUE2 | |
2430 | JMP I ADDIND | |
2431 | ||
2432 | / ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB | |
2433 | ||
2434 | PTCH, 0 /RUNS IN DF 10 | |
2435 | TAD (7647 /POINT TO DEVICE | |
2436 | DCA PTR /HANDLER RESIDENCY TABLE | |
2437 | TAD [-17 /IT HAS 15 ENTRIES | |
2438 | DCA KNTR /V3C | |
2439 | KLOOP, TAD I PTR /GET HANDLER ENTRY POINT | |
2440 | AND [7600 /LOOK AT PAGE IT'S ON | |
2441 | TAD [-INDEVH /IS IT ON THE PAGE WE PUT BUFFER OVER? | |
2442 | SNA CLA /WELL? | |
2443 | DCA I PTR /YES IT IS, WIPE IT FROM RESIDENCY | |
2444 | ISZ PTR /LOOK AT NEXT ENTRY | |
2445 | ISZ KNTR /ANY MORE ENTRIES? | |
2446 | JMP KLOOP /YES, MIGHT HAVE TO WIPE SEVERAL GUYS | |
2447 | TAD [200 /INCREASE INPUT BUFFER SIZE | |
2448 | JMP I PTCH /V3C | |
2449 | PAGE | |
2450 | \f/COMBINE CURRENT VALUE WITH PREVIOUS VALUE | |
2451 | /ACCORDING TO LAST OPERATOR | |
2452 | ||
2453 | OP0, TAD VALUE2 /HANDLER FOR + | |
2454 | TAD VALUE /** OP0+1 AND OP0+2 JUMPED TO ** | |
2455 | DCA VALUE | |
2456 | EXP3, TAD CHAR /GET LAST OPERATOR | |
2457 | TAD [-"+ /WAS IT A + OR - ? | |
2458 | CLL RTR | |
2459 | SNA | |
2460 | JMP PLSMIN /YES - LINK=0 FOR +, 1 FOR - | |
2461 | RTL | |
2462 | TAD ("+-"% | |
2463 | CLL RAR | |
2464 | SNA /IS THE CHAR % OR &? | |
2465 | JMP DIVAND /YES - LINK=0 FOR %, 1 FOR & | |
2466 | RAL | |
2467 | TAD ("%-240 | |
2468 | CLL RAR | |
2469 | SNA /IS THE CHAR SPACE OR !? | |
2470 | JMP BLKEXP /YES - LINK=0 FOR SPACE, 1 FOR ! | |
2471 | RAL | |
2472 | TAD (240-"^ | |
2473 | SNA CLA /IS THE CHAR ^? | |
2474 | JMP MUL /YES - LINK IRRELEVANT | |
2475 | JMS I (ENDCHK /NO-SEE IF END OF LINE FOUND | |
2476 | JMP EXP3 /NO-TRY AGAIN | |
2477 | EXPXIT, TAD UNDFSW /EXIT FROM EXP | |
2478 | SNA CLA /RESTORE EXIT POINT | |
2479 | JMP I (POPJ /--EXIT VIA POPJ-- | |
2480 | CLA CMA | |
2481 | DCA UNDFSW /SET UNDEFINED SWITCH | |
2482 | DCA VALUE /RESULT IS 0 | |
2483 | JMP I (POPJ /--EXIT VIA POPJ-- | |
2484 | \fMUL, CLL IAC /LINK DOESN'T COUNT FOR ^ | |
2485 | BLKEXP, IAC /** BLANK ASSUMED TO BE 4 ELSEWHERE ** | |
2486 | DIVAND, IAC | |
2487 | PLSMIN, RAL | |
2488 | JMP I (EXP1 /GET REST OF EXPRESSION | |
2489 | ||
2490 | /HANDLER FOR & | |
2491 | ||
2492 | OP2, TAD VALUE | |
2493 | AND VALUE2 | |
2494 | JMP OP0+2 | |
2495 | ||
2496 | ||
2497 | /HANDLER FOR ^ | |
2498 | /MULTIPLY BY REPEATED ADDITION | |
2499 | ||
2500 | OP4, TAD VALUE | |
2501 | CIA | |
2502 | DCA TEMP | |
2503 | TAD VALUE2 | |
2504 | ISZ TEMP | |
2505 | JMP .-2 | |
2506 | JMP OP0+2 | |
2507 | ||
2508 | OP1, TAD VALUE2 /- OPERATOR | |
2509 | CIA | |
2510 | JMP I (OP0+1 /JUMP INTO ADD OPERATOR | |
2511 | ||
2512 | /OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR: | |
2513 | ||
2514 | OP3, TAD VALUE | |
2515 | JMS I [RTL6 | |
2516 | AND [7700 /ISOLATE 6 BITS AND FALL INTO "OR" | |
2517 | DCA VALUE /V3C | |
2518 | ||
2519 | /HANDLER FOR ! AND SPACE AS INCLUSIVE OR | |
2520 | ||
2521 | OP5, TAD VALUE | |
2522 | CMA | |
2523 | AND VALUE2 | |
2524 | JMP I (OP0+1 | |
2525 | \f/CHARACTER INPUT CHECK | |
2526 | /ENTER WITH CHARACTER IN AC | |
2527 | ||
2528 | LSTCH9, SZA /IGNORE NULL (0) | |
2529 | TAD (-177 | |
2530 | SZA /IGNORE RUBOUT (377) | |
2531 | TAD (177-13 | |
2532 | SZA /IGNORE VERTICAL TAB (213) | |
2533 | IAC | |
2534 | SNA | |
2535 | JMP I (INPUT+1 /IGNORE LINE FEED (212) | |
2536 | TAD [12-32 /WAS IT ^Z (END-OF-FILE=232)? | |
2537 | SNA | |
2538 | JMP I (ENDCHR /YES - GET NEXT FILE | |
2539 | TAD (32-15 /NO - WAS IT CARRIAGE RETURN? | |
2540 | SNA | |
2541 | JMP LSTCHR /YES - LAST CHARACTER OF LINE | |
2542 | IAC /NO | |
2543 | SNA /WAS IT FORM FEED (214)? | |
2544 | JMP FORCHR /YES - HANDLER FORM FEED | |
2545 | ISZ I (INPUT | |
2546 | TAD (14+200 | |
2547 | DCA LSTCH5 /STORE CHARACTER | |
2548 | TAD PASS /IS THIS PASS 3? | |
2549 | SPA SNA CLA | |
2550 | JMP LSTCH4 /NO - | |
2551 | ISZ LSTCH6 /YES - FILLING HEADER AREA? | |
2552 | JMP LSTCH3 /YES | |
2553 | CLA CMA /NO - RESET SWITCH | |
2554 | DCA LSTCH6 | |
2555 | LSTCH4, TAD I (INPUT | |
2556 | DCA TEMP | |
2557 | TAD LSTCH5 /GET CHARACTER IN AC | |
2558 | JMP I TEMP /-EXIT FROM INPUT- | |
2559 | ||
2560 | LSTCH3, ISZ LSTCH7 /FILLING HEADER | |
2561 | TAD LSTCH5 /STORE CHARACTER IN HEADER AREA | |
2562 | DCA I LSTCH7 | |
2563 | JMP LSTCH4 | |
2564 | ||
2565 | LSTCH5, 0 | |
2566 | LSTCH6, -HEDLEN | |
2567 | LSTCH7, HEADER-1 | |
2568 | \fLSTCHR, TAD FORMSW /CARRIAGE RETURN WAS FOUND | |
2569 | SNA CLA /HAS THERE BEEN A FORM FEED? | |
2570 | JMP LSTCH1 /NO - | |
2571 | DCA FORMSW /YES - CLEAR FORM FEED SWITCH | |
2572 | ISZ EDITPG /GO TO NEXT EDITOR PAGE | |
2573 | DCA THISPG /CLEAR OVERFLOW PAGE | |
2574 | TAD PASS /IS THIS PASS 3? | |
2575 | SMA SZA CLA | |
2576 | JMS I [FORMFD /YES - GENERATE FORM FEED | |
2577 | LSTCH1, TAD [215 /NO - CARRIAGE RETURN IS CHARACTER | |
2578 | DCA LSTCH5 | |
2579 | JMP LSTCH4-2 /EXIT | |
2580 | ||
2581 | FORCHR, ISZ FORMSW /SET FORM FEED SWITCH | |
2582 | JMP I (INPUT+1 /GET ANOTHER CHARACTER | |
2583 | ||
2584 | FORMSW, 1 | |
2585 | PAGE | |
2586 | \f/ERROR MESSAGE OUTPUT | |
2587 | ||
2588 | DUMPS1, | |
2589 | ERROR, 0 | |
2590 | CLA | |
2591 | ISZ ERCNT /COUNT THE ERRORS | |
2592 | ERPLUS, "+ /PROTECTION | |
2593 | TAD I ERROR /GET ERROR MESSAGE | |
2594 | ISZ ERROR /INCREMENT RETURN ADDRESS | |
2595 | JMS I [ERROR1 /OUTPUT 2 CHARACTER ERROR MESSAGE | |
2596 | TAD (JMP I [7600 /PUT EXIT TO MONITOR | |
2597 | CSWIT1, DCA I (LSWITC /IN SWITCH - "CLA" IF /C | |
2598 | TAD PASS /IS THIS PASS 3? | |
2599 | SMA SZA CLA | |
2600 | JMP ERROR4 /YES - CARRIAGE RETURN/LINE FEED | |
2601 | JMS I [ERROR1 /NO - OUTPUT 2 SPACES | |
2602 | TAD [1777 /IS THERE A TAG SAVED? | |
2603 | AND LAST1 | |
2604 | SNA | |
2605 | JMP ERROR3 /NO | |
2606 | JMS I (DIV45 /YES - OUTPUT FIRST 2 CHARACTERS | |
2607 | TAD LAST2 /OUTPUT SECOND 2 CHARACTERS | |
2608 | JMS I (DIV45 | |
2609 | TAD LAST3 | |
2610 | JMS I (DIV45 /OUTPUT THIRD 2 CHARACTERS | |
2611 | TAD LAST4 /IS ERROR LOCATION SAME AS LAST TAG? | |
2612 | CIA | |
2613 | TAD LOC | |
2614 | SNA CLA | |
2615 | JMP ERROR4 /YES - CARRIAGE RETURN | |
2616 | TAD ERPLUS | |
2617 | JMS I OERROR | |
2618 | TAD LAST4 | |
2619 | CIA | |
2620 | ERROR3, TAD LOC /OUTPUT 4 DIGIT ADDRESS OR INCREMENT | |
2621 | JMS I (OCTPRT | |
2622 | ERROR4, TAD [215 /OUTPUT CARRIAGE RETURN/LINE FEED | |
2623 | JMS I OERROR | |
2624 | JMP I ERROR /--RETURN-- | |
2625 | \f/RESET LITERAL TABLES AND POINTERS | |
2626 | ||
2627 | DUMPS5, | |
2628 | CLEAN, 0 | |
2629 | TAD (LITBUF-1 | |
2630 | DCA XREG1 /SET LITERAL TABLE POINTER | |
2631 | TAD (TPINST-1 | |
2632 | DCA XREG2 /SET TOP INST. TABLE POINTER | |
2633 | TAD (-40 | |
2634 | DCA TEMP | |
2635 | TAD [200 | |
2636 | DCA I XREG1 /SET LITERAL TABLE ENTRIES TO 200 | |
2637 | DCA I XREG2 /SET TOP INST. TABLE ENTRIES TO 0 | |
2638 | ISZ TEMP | |
2639 | JMP .-4 | |
2640 | DCA LAST1 /CLEAR LAST DEFINED TAG | |
2641 | JMP I CLEAN /--RETURN-- | |
2642 | ||
2643 | /DUMP CURRENT PAGE LITERALS | |
2644 | ||
2645 | DUMPS, 0 | |
2646 | JMS I [FINDSP | |
2647 | SNA /IF THIS IS PAGE 0, | |
2648 | JMP I DUMPS /--RETURN-- | |
2649 | TAD [LITBUF | |
2650 | DCA DUMPS1 | |
2651 | TAD LITPTR | |
2652 | CIA CLL | |
2653 | TAD I DUMPS1 | |
2654 | DCA DUMPS2 /STORE NUMBER OF LITERALS ON THIS PAGE | |
2655 | SZL /ARE THERE ANY? | |
2656 | JMP D2 /V3C | |
2657 | DCA STARSW /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED | |
2658 | TAD LOC | |
2659 | AND [7600 | |
2660 | TAD I DUMPS1 | |
2661 | JMS I [PUNORG /OUTPUT ORIGIN | |
2662 | TAD I DUMPS1 | |
2663 | TAD [LITBF1 | |
2664 | DUMPS3, DCA DUMPS5 | |
2665 | TAD I [LINBUF /SAVE LINBUF | |
2666 | JMS I [PUSHA | |
2667 | DCA I [LINBUF | |
2668 | DUMPS6, TAD I DUMPS5 | |
2669 | DCA VALUE | |
2670 | JMSPUN, JMS I [PUNONE /OUTPUT ONE REGISTER | |
2671 | ISZ LOC | |
2672 | ISZ DUMPS5 | |
2673 | LITHAK, ISZ I DUMPS1 /DESTROY RECORD OF CURRENT PAGE LITERALS - | |
2674 | /ZEROED IF NO /W OPTION SPECIFIED | |
2675 | ISZ DUMPS2 | |
2676 | JMP DUMPS6 | |
2677 | TAD I PDLXR | |
2678 | DCA I [LINBUF /RESTORE LINBUF | |
2679 | D2, TAD DUMPS1 /WIPE REMEMBRANCE OF TOP OF PAGE (JR) | |
2680 | TAD (40 /V3C | |
2681 | DCA DUMPS5 | |
2682 | D3, DCA I DUMPS5 | |
2683 | JMP I DUMPS /--RETURN-- | |
2684 | \f/HANDLER FOR ZBLOCK PSEUDO-OP | |
2685 | /RESERVES AS MANY WORDS OF ZERO | |
2686 | /AS VALUE OF EXPRESSION | |
2687 | ||
2688 | ZBLOCX, JMS I [SPNOR /IGNORE SPACES | |
2689 | JMS I [EXP /GET THE EXPRESSION | |
2690 | TAD VALUE | |
2691 | CMA /PROTECT AGAINST ZERO CASE | |
2692 | DCA TEMP3 /STORE NEGATIVE AS COUNTER | |
2693 | JMP ZBLOCZ /JUMP INTO LOOP | |
2694 | ZBLOCY, JMS I [PUNBIN /OUTPUT ONE WORD OF ZERO | |
2695 | TAD PASS /IS THIS PASS 3? | |
2696 | SMA SZA CLA | |
2697 | DCA I (PUNMOD /YES - PREVENT OUTPUT | |
2698 | ZBLOCZ, ISZ TEMP3 /NO - DONE YET? | |
2699 | JMP ZBLOCY /NO - CONTINUE | |
2700 | TAD JMSPUN /YES - RESTORE PUNMOD | |
2701 | DCA I (PUNMOD | |
2702 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
2703 | ||
2704 | /DUMP PAGE 0 LITERALS | |
2705 | ||
2706 | DUMPS2, | |
2707 | DUMPZ, 0 | |
2708 | TAD DUMPZ /RESET EXIT FROM DUMPS | |
2709 | DCA DUMPS | |
2710 | TAD [200 | |
2711 | CIA CLL | |
2712 | TAD I [LITBUF /STORE THE NUMBER OF LITERALS ON PAGE 0 | |
2713 | DCA DUMPS2 | |
2714 | SZL /ARE THERE ANY? | |
2715 | JMP I DUMPS /NO - ** DUMPZ IS DESTROYED ** | |
2716 | TAD I [LITBUF | |
2717 | JMS I [PUNORG /OUTPUT ORIGIN | |
2718 | TAD I [LITBUF /SET VALUES FOR DUMPS | |
2719 | TAD (LITBF2 | |
2720 | JMP DUMPS3 | |
2721 | PAGE | |
2722 | \f/ENTER A TAG INTO SYMBOL TABLE | |
2723 | ||
2724 | IFZERO HASH< | |
2725 | INSRTG, 0 | |
2726 | TAD VALUE2 /SAVE VALUE 2 | |
2727 | JMS I [PUSHA | |
2728 | ISZ HIGHTG /COUNT IN THIS TAG | |
2729 | TAD TAGMAX | |
2730 | CLL CIA /GET LIMIT OF SYMBOL STORAGE | |
2731 | TAD HIGHTG /IS THERE ROOM FOR ONE MORE? | |
2732 | SZL | |
2733 | JMP I (SYMOFL /NO - SE**FATAL ERROR** | |
2734 | TAD TAGMAX /YES - IS USR IN CORE? | |
2735 | TAD (-1340 | |
2736 | SZL CLA | |
2737 | JMP GETTG5 /YES | |
2738 | TAD [7700 /NO - RESET ADDRESS TO | |
2739 | DCA IOMON /USR NON-RESIDENT | |
2740 | AC7776 | |
2741 | AND I (JSBITS /RESET JOB STATUS WORD TO | |
2742 | DCA I (JSBITS /SAVE CORE WHEN USR CALLED | |
2743 | GETTG5, TAD THISTG /SEARCH SYMBOL TABLE | |
2744 | DCA TEMP2 | |
2745 | TAD HIGHTG | |
2746 | IAC | |
2747 | DCA THISTG | |
2748 | GETTG8, AC7776 | |
2749 | TAD THISTG | |
2750 | DCA THISTG | |
2751 | JMS I [FINDTG /GET NEXT TAG FROM SYMBOL TABLE | |
2752 | ISZ THISTG | |
2753 | TAD THISTG | |
2754 | CIA | |
2755 | TAD TEMP2 /DOES NEW TAG GO WHERE PREVIOUS TAG WAS? | |
2756 | SNA CLA | |
2757 | JMP GETTG9 /YES-PUT IT THERE AND EXIT | |
2758 | JMS I [PUTTAG /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS | |
2759 | JMP GETTG8 | |
2760 | ||
2761 | /THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION | |
2762 | /IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE | |
2763 | ||
2764 | GETTG9, TAD I (NAME1 /GET CURRENT TAG | |
2765 | DCA TAG1 /PUT IT IN TAG1-TAG3 | |
2766 | TAD I (NAME2 | |
2767 | DCA TAG2 | |
2768 | TAD I (NAME3 | |
2769 | DCA TAG3 | |
2770 | TAD I PDLXR /RESTORE VALUE 2 | |
2771 | DCA VALUE2 | |
2772 | JMS I [PUTTAG /PUT TAG1 - TAG3 INTO SYMBOL TABLE | |
2773 | JMP I INSRTG /--RETURN-- | |
2774 | ||
2775 | TAGMAX, 1740 /12K=3740, ... | |
2776 | > | |
2777 | ||
2778 | / IFNZRO HASH< /***HACK ONLY*** | |
2779 | /TLYREF, 0 /TALLY REFS TO SYMBOL TABLE | |
2780 | / ISZ NREFL | |
2781 | / JMP I TLYREF | |
2782 | / ISZ NREFH | |
2783 | / JMP I TLYREF | |
2784 | / JMP I TLYREF | |
2785 | /TLYPRB, 0 /TALLY PROBES INTO TABLE | |
2786 | / JMS I [FINDTG /FUDGE, OUT OF ROOM | |
2787 | / ISZ NPROBL | |
2788 | / JMP I TLYPRB | |
2789 | / ISZ NPROBH | |
2790 | / JMP I TLYPRB | |
2791 | / JMP I TLYPRB | |
2792 | /NREFH, 0 | |
2793 | /NREFL, 0 | |
2794 | /NPROBH, 0 | |
2795 | /NPROBL, 0 | |
2796 | / > /***HACK ONLY*** | |
2797 | \f IFNZRO HASH< | |
2798 | ||
2799 | /INSERT A TAG INTO THE HASH TABLE | |
2800 | ||
2801 | INSRTG, 0 | |
2802 | ISZ HIGHTG /BUMP SYM NUM (SKIPS ON 0) | |
2803 | TAD HIGHTG | |
2804 | STL CMA | |
2805 | TAD TAGMAX | |
2806 | SNA SZL CLA /STILL ROOM FOR AT LEAST 2 MORE? | |
2807 | JMP I (SYMOFL /NO SE** FATAL ERROR** | |
2808 | TAD I (NAME1 | |
2809 | DCA TAG1 | |
2810 | TAD I (NAME2 | |
2811 | DCA TAG2 | |
2812 | TAD I (NAME3 | |
2813 | DCA TAG3 | |
2814 | JMS I [PUTTAG /NOW ACTUALLY INSERT IT | |
2815 | JMP I INSRTG | |
2816 | > | |
2817 | \f/OUTPUT 2 CHARACTER WORD | |
2818 | /FROM SYMBOL TABLE FORMAT | |
2819 | /DIVIDE BY 45(8) | |
2820 | ||
2821 | DIV45, 0 | |
2822 | RAL | |
2823 | CLL RAR /CLEAR SIGN BIT | |
2824 | DIV45A, ISZ DIV45C | |
2825 | TAD (-45 | |
2826 | SMA | |
2827 | JMP DIV45A | |
2828 | TAD (45 | |
2829 | JMS DIV45E | |
2830 | DCA DIV45B | |
2831 | STA | |
2832 | TAD DIV45C | |
2833 | JMS DIV45E | |
2834 | JMS I [RTL6 | |
2835 | TAD DIV45B | |
2836 | JMS I [ERROR1 /OUTPUT 2 CHARACTERS | |
2837 | DCA DIV45C /CLEAR DIV45C FOR NEXT GO-ROUND | |
2838 | JMP I DIV45 /--RETURN-- | |
2839 | ||
2840 | DIV45B, 0 | |
2841 | DIV45C, 0 /** MUST BE 0 WHEN DIV45 IS ENTERED ** | |
2842 | ||
2843 | DIV45E, 0 | |
2844 | SNA | |
2845 | JMP I DIV45E | |
2846 | TAD (-33 | |
2847 | SMA | |
2848 | TAD (20-40-33 | |
2849 | TAD (33+40 | |
2850 | JMP I DIV45E /--RETURN-- | |
2851 | \f/HANDLER FOR FIXTAB PSEUDO-OP | |
2852 | ||
2853 | FIXTBX, TAD PASS /IS THIS PASS 1? | |
2854 | SMA CLA | |
2855 | JMP I [LOOKEX /NO--EXIT TO MAIN-- | |
2856 | JMP I (FIXTAY /YES--DO FIXTAB | |
2857 | ||
2858 | /SET FIELD | |
2859 | ||
2860 | SETFLD, 0 | |
2861 | CLA CLL /SETFLD CALLED WITH AC RANDOM | |
2862 | DCA SETFL1 /INITIALIZE FIELD | |
2863 | IFNZRO HASH< | |
2864 | TAD USROFS /FUDGE FOR KEEPING USR AROUND | |
2865 | > | |
2866 | TAD THISTG | |
2867 | SETFLP, ISZ SETFL1 | |
2868 | CML | |
2869 | TAD (-1740 /PUT 1740 SYMBOLS IN EACH FIELD | |
2870 | SNL /IS THE DIVIDE THROUGH? | |
2871 | JMP SETFLP /NO - CONTINUE | |
2872 | IFZERO HASH< | |
2873 | CLL CMA RTL /AC CONTAINED REM-1740; THIS MAKES IT INTO | |
2874 | TAD (-1 /7573-4*REM WHICH IS THE ADDRESS WE WANT | |
2875 | > | |
2876 | IFNZRO HASH< | |
2877 | CLL RTL /AC GETS 0201 TO 7775 | |
2878 | TAD (-202 /AC GETS 7777 TO 7573 FOR TAGXR | |
2879 | > | |
2880 | DCA TAGXR /TO STICK INTO AN AUTO-XR | |
2881 | TAD SETFL1 | |
2882 | CLL RTL | |
2883 | RAL | |
2884 | TAD SETFL2 | |
2885 | DCA SETFL1 | |
2886 | SETFL1, HLT | |
2887 | JMP I SETFLD /--RETURN-- | |
2888 | IFNZRO HASH< | |
2889 | USROFS, 0 /GETS 400 IF KEEPING USR | |
2890 | > | |
2891 | \f/FIND TAG | |
2892 | /GET TAG FROM SYMBOL TABLE | |
2893 | /PUT IT INTO TAG1-TAG3 | |
2894 | /WITH ITS VALUE IN VALUE2 | |
2895 | ||
2896 | FINDTG, 0 | |
2897 | TAD THISTG | |
2898 | JMS SETFLD | |
2899 | TAD I TAGXR | |
2900 | DCA TAG1 | |
2901 | TAD I TAGXR | |
2902 | DCA TAG2 | |
2903 | TAD I TAGXR | |
2904 | DCA TAG3 | |
2905 | TAD I TAGXR | |
2906 | DCA VALUE2 | |
2907 | SETFL2, CDF | |
2908 | JMP I FINDTG /--RETURN-- | |
2909 | ||
2910 | /OPTIMIZATION MAY CHANGE SETFLD TO | |
2911 | /REMOVE CLA ON ENTRY | |
2912 | PAGE | |
2913 | \f/BEGINNING OF PASS CODE | |
2914 | ||
2915 | JMS I (IOPEN /SET INPUT ROUTINE TO OPEN FILE | |
2916 | START2, ISZ PASS /SET UP COUNTERS AND POINTERS | |
2917 | DCA XLISTX /CLEAR XLIST SWITCH | |
2918 | DCA FLDIND /SET FIELD TO 0 | |
2919 | DCA CONDSW | |
2920 | DCA EDITPG | |
2921 | DCA LINK | |
2922 | DCA RADIX | |
2923 | DCA ERCNT | |
2924 | DCA GETCI | |
2925 | DCA PUNCHX | |
2926 | DCA I [LINBUF | |
2927 | TAD (PDLST | |
2928 | DCA PDLXR | |
2929 | JMS I [CLEAN | |
2930 | TAD [200 | |
2931 | DCA LITPTR | |
2932 | TAD [200 | |
2933 | JMS I [PUNORG | |
2934 | JMP I (LOOKE1 /--EXIT TO MAIN-- | |
2935 | ||
2936 | /HANDLER FOR $ | |
2937 | ||
2938 | ENDPAS, JMS I [DUMPS /DUMP CURRENT PAGE LITERALS | |
2939 | DCA OFSBUF /CLEAR OFFSET FOR NEXT PASS | |
2940 | TAD PASS /WHAT PASS IS ENDING? | |
2941 | SNA | |
2942 | JMP I (ENDPA2 /PASS 2 | |
2943 | SPA CLA | |
2944 | JMP I (START1 /PASS 1 | |
2945 | TAD I [LINBUF /PASS 3 | |
2946 | SNA CLA /ANYTHING TO PRINT? | |
2947 | JMP ENDPA1-1 /NO | |
2948 | TAD [211 /YES - TAB OVER TWICE | |
2949 | JMS I OERROR | |
2950 | TAD [211 | |
2951 | JMS I OERROR | |
2952 | JMS I [LINPRT /PRINT LINE | |
2953 | JMS I [DUMPZ /DUMP PAGE 0 LITERALS | |
2954 | ENDPA1, DCA XLISTX | |
2955 | /OUTPUT SYMBOL TABLE | |
2956 | SSWITC, JMS I (SYMPRT /(0 IF /S) | |
2957 | TAD I (FORM21 | |
2958 | DCA I (FORM22 | |
2959 | JMS I [FORMFD /OUTPUT FORM FEED | |
2960 | ERMSGS, TAD ERCNT | |
2961 | JMS OUTTTL /PRINT "ERRORS DETECTED: N" | |
2962 | TAD LINK | |
2963 | JMS OUTTTL /PRINT "LINKS GENERATED: N" | |
2964 | FINLFF, JMS I [FORMFD /PRINT FINAL FF (ZEROED IF NO PASS 3) | |
2965 | JMS I (OCLOSE /AND CLOSE THE OUTPUT FILE | |
2966 | \f/CREF AND LOAD-AND-GO OPTIONS | |
2967 | /****FINAL EXIT TO MONITOR**** | |
2968 | LSWITC, JMP I [7605 /0 IF /L OR /G OR /C | |
2969 | TAD (7616 | |
2970 | DCA XREG1 | |
2971 | CDF 10 | |
2972 | CSWITC, TAD I [7600 /"TAD I [7605" IF /C | |
2973 | AND [17 | |
2974 | DCA I XREG1 /SET BINARY DEVICE | |
2975 | TAD BINSRT | |
2976 | ||
2977 | /EXIT FROM PAL8 BY CHAINING | |
2978 | /TO NEXT PROGRAM | |
2979 | /SHOULD BE ABSLDR OR CREF | |
2980 | ||
2981 | DCA I XREG1 /SET STARTING BLOCK | |
2982 | DCA I XREG1 /SET 0 TERMINATOR | |
2983 | CDF | |
2984 | TAD I (JSBITS /SET BIT 11 OF JOB STATUS WORD | |
2985 | RAR /SO 10000-11777 IS NOT SAVED | |
2986 | CLL CML RAL | |
2987 | DCA I (JSBITS | |
2988 | CIF 10 | |
2989 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
2990 | 6 /*CHAIN TO NEXT PROGRAM* | |
2991 | CHAIN, 0 /STARTING BLOCK OF NEXT PROGRAM | |
2992 | ||
2993 | OUTTTL, 0 | |
2994 | DCA LAST1 /SAVE NUMBER TO BE PRINTED | |
2995 | OUTTLL, TAD I TTLPTR /GET A WORD OF MESSAGE | |
2996 | ISZ TTLPTR | |
2997 | SNA /END? | |
2998 | JMP PRTTTL /YES | |
2999 | JMS I [ERROR1 /NO - PRINT IT | |
3000 | JMP OUTTLL /AND LOOP | |
3001 | PRTTTL, TAD [240 /PRINT A SPACE | |
3002 | JMS I OCHAR | |
3003 | TAD LAST1 | |
3004 | JMS I (FORMF4 /PRINT NUMBER IN DECIMAL | |
3005 | JMS I (CRLF /PRINT CR AND 2 LF'S (1 IF PASS 3) | |
3006 | JMP I OUTTTL /AND RETURN | |
3007 | ||
3008 | TTLPTR, TTLMSG | |
3009 | \f/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2 | |
3010 | ||
3011 | LOADOV, JMS I (7607 /CALL SYSTEM DEVICE HANDLER | |
3012 | 0200 /SWAP IN CODE UNIQUE TO PASS 3 | |
3013 | SWAP1 /BUFFER ADDRESS | |
3014 | ASWAP /STARTING BLOCK NUMBER | |
3015 | JMP I (SYSER3 /DE**FATAL ERROR** | |
3016 | NSWITC, JMP START2 /(0 IF NO LIST FILE, SKP IF /N) START PASS3 | |
3017 | JMP ERMSG1 | |
3018 | JMP ENDPA1 | |
3019 | ||
3020 | ERMSG1, TAD (OTYPEO /COME HERE IF NO PASS 3 OUTPUT FILE | |
3021 | DCA OCHAR | |
3022 | TAD (OTYPEO | |
3023 | DCA OERROR | |
3024 | TAD [7600 | |
3025 | DCA I (OTYPCR /INHIBIT AUTO-LF ON CARRIAGE RETURN | |
3026 | DCA FINLFF /KILL LAST FORM FEED | |
3027 | JMP ERMSGS | |
3028 | ||
3029 | /ADD BITS TO PUNCH ORIGIN | |
3030 | ||
3031 | PUNORG, 0 | |
3032 | DCA LOC | |
3033 | TAD PASS /IS THIS PASS 2? | |
3034 | SZA CLA | |
3035 | JMP I PUNORG /NO--RETURN-- | |
3036 | TAD LOC /YES - OUTPUT ORIGIN SETTING | |
3037 | TAD OFFSET /"LOC" MAY BE FICTITIOUS - MAKE IT REAL | |
3038 | CLL CML | |
3039 | ISZ STARSW /INHIBIT PUNCHING ORIGIN IF NECESSARY | |
3040 | JMS I [PUNOUT | |
3041 | CLA | |
3042 | DCA STARSW /RESET SWITCH | |
3043 | JMP I PUNORG /--RETURN-- | |
3044 | PAGE | |
3045 | \f\f/EVALUATE LITERAL | |
3046 | ||
3047 | LIT, STA RAL /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE | |
3048 | DCA FINDS1 /SAVE FLAG | |
3049 | JMS I [GETC /GET NEXT CHARACTER | |
3050 | JMS I [SPNOR /IGNORE SPACES | |
3051 | TAD EXPIND /STORE IMPORTANT VALUES PRIOR TO | |
3052 | JMS I [PUSHA /ENTRANCE INTO EXP | |
3053 | TAD OP | |
3054 | JMS I [PUSHA | |
3055 | TAD VALUE | |
3056 | JMS I [PUSHA | |
3057 | TAD FINDS1 | |
3058 | JMS I [PUSHA | |
3059 | JMS I [EXP /GET EXPRESSION | |
3060 | TAD VALUE /FIND LITERAL IN TABLE | |
3061 | ISZ I PDLXR /PAGE 0? | |
3062 | JMP .+3 | |
3063 | JMS FINDS /NO | |
3064 | SKP | |
3065 | JMS FIND0 /YES | |
3066 | DCA VALUE2 /STORE ADDRESS | |
3067 | TAD I PDLXR | |
3068 | DCA VALUE | |
3069 | TAD I PDLXR /RESTORE SAVED VALUES | |
3070 | DCA OP | |
3071 | TAD I PDLXR | |
3072 | DCA EXPIND | |
3073 | TAD CHAR /IGNORE ) OR ] | |
3074 | TAD (-") | |
3075 | SZA | |
3076 | TAD (")-"] | |
3077 | SNA CLA | |
3078 | JMS I [GETC /GET NEXT CHARACTER | |
3079 | JMP I (NUMBE5 /RETURN TO EXPRESSION PROCESSOR | |
3080 | ||
3081 | ||
3082 | PEZE, 0 /SUBR TO ISSUE PE OR ZE MESSAGE | |
3083 | SNA CLA /WHICH ONE? | |
3084 | JMP .+4 /PAGE 0 | |
3085 | JMS I PERROR | |
3086 | PE | |
3087 | JMP I PEZE | |
3088 | JMS I PERROR | |
3089 | ZE | |
3090 | JMP I PEZE | |
3091 | \f/FIND LITERAL ON CURRENT PAGE | |
3092 | ||
3093 | FINDS, 0 | |
3094 | DCA FINDS1 | |
3095 | TAD LOC | |
3096 | AND [7600 | |
3097 | SNA /IS THIS PAGE 0? | |
3098 | JMP FIND01 /YES | |
3099 | DCA FINDS2 /NO - SAVE PAGE NUMBER | |
3100 | TAD [LITBF1 | |
3101 | DCA FIND0 | |
3102 | TAD [7700 /ALLOW 100(8) CURRENT PAGE LITERALS | |
3103 | DCA FORMF6 | |
3104 | TAD LITPTR /GET PG ADDR OF 1ST LITERAL IN BUFFER | |
3105 | FIND02, DCA FINDS3 | |
3106 | TAD FINDS2 | |
3107 | JMS I [RTL6 | |
3108 | TAD [LITBUF | |
3109 | DCA TEMP | |
3110 | TAD FIND0 /COMPUTE ACTUAL CORE ADDRESS OF LITERAL | |
3111 | TAD I TEMP | |
3112 | DCA TEMP2 | |
3113 | TAD FINDS3 /COMPUTE THE NUMBER OF ENTRIES | |
3114 | CIA | |
3115 | TAD I TEMP /IN THE LITERAL BUFFER | |
3116 | SNA | |
3117 | JMP FINDS6 /NONE | |
3118 | DCA FINDS3 | |
3119 | FINDS4, TAD I TEMP2 /GET LITERAL FROM TABLE | |
3120 | CIA | |
3121 | TAD FINDS1 /AND CURRENT LITERAL | |
3122 | SNA CLA /DO THEY MATCH? | |
3123 | JMP FINDS5 /YES | |
3124 | ISZ TEMP2 /NO - BUMP COUNTERS | |
3125 | ISZ FINDS3 | |
3126 | JMP FINDS4 /TRY AGAIN | |
3127 | FINDS6, TAD FINDS2 | |
3128 | JMS I [RTL6 | |
3129 | TAD [TPINST | |
3130 | DCA FINDS3 | |
3131 | TAD I TEMP /DOES THIS OVERFLOW PAGE? | |
3132 | CIA | |
3133 | TAD I FINDS3 | |
3134 | SPA CLA | |
3135 | JMP FINDS7 /NO | |
3136 | ||
3137 | \fFIND03, TAD FINDS2 /PAGE FULL - WHICH PAGE? | |
3138 | JMS PEZE /GENERATE PE OR ZE MESSAGE | |
3139 | CLA CMA | |
3140 | JMP FINDS9 | |
3141 | FINDS7, CLA CMA | |
3142 | TAD I TEMP /IS PAGE FULL? | |
3143 | AND FORMF6 | |
3144 | SNA CLA | |
3145 | JMP FIND03 /YES - OUTPUT ERROR MESSAGE | |
3146 | CLA CMA | |
3147 | TAD I TEMP /NO | |
3148 | DCA I TEMP | |
3149 | FINDS9, TAD I TEMP | |
3150 | TAD FIND0 | |
3151 | DCA TEMP2 | |
3152 | TAD FINDS1 | |
3153 | DCA I TEMP2 | |
3154 | FINDS5, TAD FIND0 /GET ADDRESS OF LITERAL | |
3155 | CIA | |
3156 | TAD TEMP2 | |
3157 | TAD FINDS2 | |
3158 | JMP I FINDS /--RETURN-- | |
3159 | ||
3160 | ||
3161 | /FIND LITERAL ON PAGE 0 | |
3162 | ||
3163 | FIND0, 0 | |
3164 | DCA FINDS1 | |
3165 | TAD FIND0 /RESET EXIT FROM FINDS | |
3166 | DCA FINDS | |
3167 | FIND01, DCA FINDS2 /SET POINTERS | |
3168 | TAD (LITBF2 | |
3169 | DCA FIND0 | |
3170 | TAD [7760 /ALLOW 160(8) PAGE 0 LITERALS | |
3171 | DCA FORMF6 | |
3172 | TAD [200 | |
3173 | JMP FIND02 | |
3174 | ||
3175 | FINDS1, 0 | |
3176 | FINDS2, 0 | |
3177 | FINDS3, 0 | |
3178 | PAGE | |
3179 | \f/HANDLER FOR IFZERO PSEUDO-OP | |
3180 | ||
3181 | IF0, TAD (10 /IFTST1, SNA CLA | |
3182 | ||
3183 | /HANDLER FOR IFNZERO PSEUDO-OP | |
3184 | ||
3185 | IFN0, TAD IFSZA /IFTST1, SZA CLA | |
3186 | DCA IFTST1 | |
3187 | JMS I [SPNOR /IGNORE SPACES | |
3188 | JMS I [EXP /GET EXPRESSION | |
3189 | IFTST3, TAD CHAR /GET LAST CHARACTER | |
3190 | TAD (-"< | |
3191 | SNA CLA /IS IT <? | |
3192 | JMP IFTST2 /YES | |
3193 | JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR | |
3194 | IFTST9, JMS I [SPNOR /IGNORE SPACES | |
3195 | JMP IFTST3 /TRY AGAIN | |
3196 | ||
3197 | IFTST2, JMS I [GETC /GET NEXT CHARACTER | |
3198 | TAD CONDSW | |
3199 | CIA | |
3200 | DCA CONDTM /SET NUMBER OF NESTED CONDITIONALS | |
3201 | CLA CMA /DECREMENT NUMBER OF NESTED CONDITIONALS | |
3202 | TAD CONDSW | |
3203 | DCA CONDSW | |
3204 | TAD VALUE | |
3205 | IFTST1, HLT /SZA CLA OR SNA CLA | |
3206 | JMP I (MAIN /--EXIT TO MAIN-- | |
3207 | IFTST5, TAD CONDSW /DONE WITH ALL CONDITIONALS IN NEST? | |
3208 | TAD CONDTM | |
3209 | SMA CLA | |
3210 | JMP I (MAIN /YES --EXIT TO MAIN-- | |
3211 | TAD CHAR | |
3212 | TAD (-"< /NO - GET NEXT CHARACTER | |
3213 | SNA /IS IT <? | |
3214 | JMP IFTST6 /YES - HANDLE NEXT CONDITIONAL | |
3215 | TAD ("<-"> /NO - IS IT >? | |
3216 | IFSZA, SZA CLA | |
3217 | JMP IFTST4 /NO - FINISH THIS CONDITIONAL | |
3218 | AC7776 | |
3219 | IFTST6, CMA | |
3220 | TAD CONDSW | |
3221 | DCA CONDSW | |
3222 | IFTST4, DCA I [LINBUF /INHIBIT LISTING OF UNASSEMBLED CODE - | |
3223 | /ZEROED IF /J OPTION NOT SPECIFIED | |
3224 | JMS I [GETC /GET NEXT CHARACTER | |
3225 | JMP IFTST5 | |
3226 | \f/HANDLER FOR IFDEF PSEUDO-OP | |
3227 | ||
3228 | IFD, TAD (10 /IFTST1, SNA CLA | |
3229 | ||
3230 | /HANDLER FOR IFNDEF PSEUDO-OP | |
3231 | ||
3232 | IFND, TAD IFSZA /IFTST1, SZA CLA | |
3233 | DCA IFTST1 | |
3234 | IFTST7, JMS I [SPNOR /IGNORE SPACES | |
3235 | JMS I [TSTALP /IS NEXT CHARACTER ALPHABETIC | |
3236 | JMP IFTST8 /YES | |
3237 | JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR | |
3238 | JMP IFTST7 /KEEP TRYING | |
3239 | ||
3240 | IFTST8, JMS I [GETTAG /PICK UP TAG | |
3241 | DCA VALUE /STORE UNDEFINED INDICATOR | |
3242 | TAD TAG3 /WAS IT A PSEUDO-OP? | |
3243 | SMA CLA | |
3244 | JMP IFTST9 /NO | |
3245 | JMS I [ERROR /YES - GENERATE IP ERROR MESSAGE | |
3246 | IP | |
3247 | JMP IFTST9 | |
3248 | ||
3249 | ICMESG, 0 | |
3250 | JMS I [ERROR | |
3251 | IC /IC COMES OUT ON ALL PASSES | |
3252 | TAD CHAR | |
3253 | SPA CLA | |
3254 | JMP I [LOOKEX /END OF LINE - GO AWAY | |
3255 | JMS I [GETC /GET NEXT CHAR | |
3256 | JMP I ICMESG | |
3257 | \fCONDTM, | |
3258 | ||
3259 | /PUT TAG IN SYMBOL TABLE | |
3260 | ||
3261 | PUTTAG, 0 | |
3262 | TAD THISTG | |
3263 | JMS I (SETFLD /SET FIELD | |
3264 | TAD TAG1 | |
3265 | DCA I TAGXR | |
3266 | TAD TAG2 | |
3267 | DCA I TAGXR | |
3268 | TAD TAG3 | |
3269 | DCA I TAGXR | |
3270 | TAD VALUE2 | |
3271 | DCA I TAGXR | |
3272 | CDF | |
3273 | JMP I PUTTAG /--RETURN-- | |
3274 | ||
3275 | ||
3276 | /PUSHDOWN ROUTINE | |
3277 | /PUT NEW ENTRY ON PUSHDOWN STACK | |
3278 | ||
3279 | PUSHA, 0 | |
3280 | DCA TEMP | |
3281 | CLA CMA | |
3282 | TAD PDLXR | |
3283 | DCA PDLXR | |
3284 | TAD PDLXR | |
3285 | TAD (-PDLND | |
3286 | SPA CLA /IS LIST TOO FULL? | |
3287 | JMP PUSHA1 /BE**FATAL ERROR** | |
3288 | TAD TEMP /NO - MAKE ENTRY | |
3289 | DCA I PDLXR | |
3290 | CLA CMA | |
3291 | TAD PDLXR | |
3292 | DCA PDLXR | |
3293 | JMP I PUSHA /--RETURN-- | |
3294 | ||
3295 | PUSHA1, TAD (BE | |
3296 | JMP I [MONERR /PUSHDOWN OVERFLOW IS FATAL ERROR | |
3297 | \f/TEST NUMERIC ROUTINE | |
3298 | /CALL WITH CHARACTER TO TEST IN "CHAR" | |
3299 | /SKIPS IF THE CHARACTER IS NOT NUMERIC | |
3300 | ||
3301 | TSTNUM, 0 | |
3302 | TAD CHAR /GET THE CHARACTER | |
3303 | TAD (-"9-1 | |
3304 | CLL | |
3305 | TAD ("9-"0+1 | |
3306 | SNL CLA /CHECK FOR RANGE 0-9 | |
3307 | ISZ TSTNUM /OUT OF RANGE | |
3308 | JMP I TSTNUM /--RETURN-- | |
3309 | ||
3310 | /TEST ALPHANUMERIC ROUTINE | |
3311 | /CALL WITH CHARACTER IN "CHAR" | |
3312 | /SKIPS IF CHARACTER IS NOT ALPHANUMERIC | |
3313 | ||
3314 | TSTALN, 0 | |
3315 | JMS I [TSTNUM /IS IT NUMERIC | |
3316 | JMP I TSTALN /YES--RETURN-- | |
3317 | JMS I [TSTALP /IS IT ALPHABETIC | |
3318 | JMP I TSTALN /YES--RETURN-- | |
3319 | ISZ TSTALN /NEITHER | |
3320 | JMP I TSTALN /--RETURN-- | |
3321 | ||
3322 | /TEST ALPHABETIC ROUTINE | |
3323 | /CALL WITH CHARACTER IN "CHAR" | |
3324 | /SKIPS IF NOT ALPHABETIC | |
3325 | ||
3326 | TSTALP, 0 | |
3327 | TAD CHAR | |
3328 | TAD (-"Z-1 | |
3329 | CLL | |
3330 | TAD ("Z-"A+1 | |
3331 | SNL CLA /CHECK FOR RANGE A-Z | |
3332 | ISZ TSTALP /OUT OF RANGE | |
3333 | JMP I TSTALP /--RETURN-- | |
3334 | PAGE | |
3335 | \f/INPUT ROUTINE | |
3336 | /UNPACKS CHARACTERS FROM BUFFER | |
3337 | ||
3338 | INPUT, 0 | |
3339 | ISZ INCHCT /ARE THERE CHARACTERS LEFT IN BUFFER? | |
3340 | JMP I CHARLV /YES - FETCH ONE | |
3341 | TAD INEOF /NO - WAS OLD FILE ENDED? | |
3342 | SZA CLA | |
3343 | JMP ENDCHR /YES - START NEW FILE | |
3344 | INGBUF, TAD INCTLA /NO | |
3345 | AND [7600 | |
3346 | JMS I [RTL6 | |
3347 | TAD INCTR | |
3348 | SNL | |
3349 | DCA INCTR | |
3350 | SZL | |
3351 | ISZ INEOF | |
3352 | CLL CML CMA RTR /SET CONTROL WORD | |
3353 | RTR | |
3354 | RTR | |
3355 | TAD INCTLA | |
3356 | DCA INCTLW | |
3357 | JMS I INHNDL /CALL INPUT DEVICE HANDLER | |
3358 | INCTLW, 0 /CONTROL WORD | |
3359 | INBUFP, INBUF /INPUT BUFFER ADDRESS | |
3360 | INREC, 0 /STARTING BLOCK NUMBER | |
3361 | JMP INERRX /ERROR RETURN | |
3362 | INBREC, TAD INCTLA /NORMAL RETURN | |
3363 | AND [7600 | |
3364 | JMS I [RTL6 | |
3365 | TAD INREC | |
3366 | DCA INREC /RESET STARTING BLOCK NUMBER | |
3367 | TAD INCTLW | |
3368 | AND [7600 | |
3369 | CLL RAL | |
3370 | TAD INCTLW | |
3371 | AND [7600 | |
3372 | CIA | |
3373 | DCA INCHCT /SET CHARACTER COUNT | |
3374 | TAD INBUFP | |
3375 | DCA INPTR /SET BUFFER POINTER | |
3376 | \f/CHARACTERS ARE FOUND IN BUFFER | |
3377 | /IN STANDARD OS/8 PACKING | |
3378 | /WORD 1: AAA A11 111 111 | |
3379 | /WORD 2: BBB B22 222 222 | |
3380 | /WHICH REPRESENTS 3 CHARACTERS | |
3381 | /CHARACTER 1: 11 111 111 | |
3382 | /CHARACTER 2: 22 222 222 | |
3383 | /CHARACTER 3: AA AAB BBB | |
3384 | ||
3385 | ||
3386 | ICHAR1, TAD I INPTR /PICK UP CHARACTER WORD 1 | |
3387 | JMS CHARLV /CHECK RIGHT 8 BITS | |
3388 | ICHAR2, TAD I INPTR /PICK UP WORD 1 | |
3389 | ISZ INPTR /(INCREMENT POINTER TO WORD 2) | |
3390 | AND [7400 /WITH WORD 1 IN AC | |
3391 | DCA INCTLW /RETRIEVE LEFT 4 BITS AND SAVE | |
3392 | TAD I INPTR /PICK UP WORD 2 | |
3393 | JMS CHARLV /CHECK RIGHT 8 BITS | |
3394 | ICHAR3, TAD I INPTR /PICK UP WORD 2 | |
3395 | ISZ INPTR /(POINT TO NEXT WORD 1) | |
3396 | AND [7400 /WITH WORD 2 IN AC | |
3397 | CLL RTR /RETRIEVE LEFT 4 BITS | |
3398 | RTR | |
3399 | TAD INCTLW /PUT BOTH SETS OF 4 BITS TOGETHER | |
3400 | RTR | |
3401 | RTR | |
3402 | JMS CHARLV /CHECK CHARACTER | |
3403 | JMP ICHAR1 /TRY NEXT SET OF 2 WORDS | |
3404 | ||
3405 | INERRX, ISZ INEOF | |
3406 | SMA CLA /EOF OR FATAL ERROR? | |
3407 | JMP INBREC /EOF - UNPACK THIS BUFFER | |
3408 | JMP I (SYSERR /FATAL - GENERATE DE ERROR MESSAGE | |
3409 | ||
3410 | INCHCT, -1 | |
3411 | INEOF, 1 | |
3412 | INPTR, 0 | |
3413 | INCTR, 0 | |
3414 | INCTLA, 0 | |
3415 | INFPTR, 7617 | |
3416 | \f/START NEW FILE | |
3417 | ||
3418 | ENDCHR, ISZ I (FORMSW /^Z OR EOF SIMULATES FORM FEED | |
3419 | TAD PASS /IS THIS PASS 3? | |
3420 | SPA SNA CLA | |
3421 | JMP NXTFLE /NO | |
3422 | JMS I (HEDCLR /YES - CLEAR HEADING BUFFER | |
3423 | TAD [-HEDLEN | |
3424 | DCA I (LSTCH6 | |
3425 | TAD [HEADER-1 | |
3426 | DCA I (LSTCH7 | |
3427 | DCA LSTCNT | |
3428 | NXTFLE, TAD (INDEVH+1 /SET ADDRESS OF DEVICE HANDLER | |
3429 | DCA INHNDL | |
3430 | CDF 10 | |
3431 | TAD I INFPTR | |
3432 | CDF | |
3433 | SNA | |
3434 | JMP FAKDLR /END OF FILE - FAKE A $ | |
3435 | CIF 10 | |
3436 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
3437 | 1 /*FETCH HANDLER* | |
3438 | INHNDL, 0 /LOADING ADDRESS OF HANDLER | |
3439 | HLT /ERROR RETURN | |
3440 | CDF 10 /V3C | |
3441 | TAD INHNDL /NORMAL RETURN - HANDLER IN CORE | |
3442 | AND [7600 | |
3443 | TAD [-INDEVH /SEE IF INPUT HANDLER IS IN 7200 | |
3444 | SZA CLA | |
3445 | JMS I (PTCH /IT IS - INCREASE SIZE OF BUFFER | |
3446 | /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE | |
3447 | TAD INCTL | |
3448 | DCA INCTLA /DF=10 | |
3449 | TAD I INFPTR | |
3450 | AND [7760 | |
3451 | SZA | |
3452 | TAD [17 | |
3453 | CLL CML RTR | |
3454 | RTR | |
3455 | DCA INCTR | |
3456 | ISZ INFPTR | |
3457 | TAD I INFPTR | |
3458 | DCA INREC /RESET STARTING BLOCK NUMBER | |
3459 | ISZ INFPTR | |
3460 | DCA INEOF | |
3461 | CDF | |
3462 | JMP INGBUF | |
3463 | \fFAKDLR, TAD (244 | |
3464 | JMS CHARLV /CALL THE COROUTINE | |
3465 | TAD [215 /WITH $ AND CR | |
3466 | JMS CHARLV /TO END THE ASSEMBLY. | |
3467 | JMP I (PHASE /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL | |
3468 | ||
3469 | CHARLV, 0 /CHARACTER IN AC | |
3470 | AND [177 /AND OFF LEFT 5 BITS | |
3471 | JMP I (LSTCH9 /RETURN TO LSTCH9 | |
3472 | PAGE | |
3473 | \f/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING) | |
3474 | /PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES | |
3475 | /FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED | |
3476 | /ADDED TO CHECKSUM | |
3477 | ||
3478 | DTORGX, JMS I [SPNOR /IGNORE SPACES | |
3479 | JMS I [EXP /GET EXPRESSION | |
3480 | TAD PASS /IS THIS PASS 2? | |
3481 | SNA | |
3482 | JMP DTORG2 /YES | |
3483 | PUNVA1, SPA SNA CLA /NO - IS THIS PASS 3? | |
3484 | JMP I [LOOKEX /NO--EXIT TO MAIN-- | |
3485 | TAD LININD /GET LINK SWITCH FROM "EXP" | |
3486 | DCA LINKSW /YES | |
3487 | TAD [LOOKEX /FIX PUNONE TO EXIT TO MAIN | |
3488 | DCA I (PUNONE | |
3489 | TAD [211 /OUTPUT TAB | |
3490 | JMS I OERROR | |
3491 | JMP I (DTORG1 | |
3492 | ||
3493 | DTORG2, TAD VALUE /PASS 2 - GET BLOCK NUMBER | |
3494 | JMS I [RTL6 | |
3495 | RAL | |
3496 | AND [77 | |
3497 | TAD (300 /PICK UP CHANNELS 7 AND 8 | |
3498 | DCA TEMP | |
3499 | TAD TEMP | |
3500 | TAD CHKSUM /ADD VALUE TO CHECKSUM | |
3501 | DCA CHKSUM | |
3502 | TAD TEMP | |
3503 | JMS I OCHAR /OUTPUT BLOCK NUMBER - FIRST FRAME | |
3504 | TAD VALUE | |
3505 | AND [77 | |
3506 | JMS I OCHAR /OUTPUT SECOND FRAME | |
3507 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
3508 | ||
3509 | /HANDLER FOR % | |
3510 | /DIVIDE BY REPEATED SUBTRACTION | |
3511 | ||
3512 | OP6, DCA TEMP | |
3513 | TAD VALUE2 | |
3514 | CIA | |
3515 | DCA VALUE2 | |
3516 | TAD VALUE | |
3517 | OP6A, CLL | |
3518 | TAD VALUE2 /SUBTRACT DIVISOR FROM DIVIDEND | |
3519 | SNL /DONE YET? | |
3520 | JMP OP6B /YES - EXIT | |
3521 | ISZ TEMP /NO - COUNT ONE MORE SUBTRACTION | |
3522 | JMP OP6A /SUBTRACT AGAIN | |
3523 | OP6B, CLA | |
3524 | TAD TEMP /RESULT IS # OF SUBTRACTIONS | |
3525 | JMP I (OP0+2 | |
3526 | \f/HANDLER FOR XLIST PSEUDO-OP | |
3527 | ||
3528 | XLISTY, JMS XLISTZ /ANY EXPRESSION? | |
3529 | JMP XLIST1 /NO | |
3530 | JMS I [EXP /GET EXPRESSION | |
3531 | TAD VALUE /USE THE VALUE | |
3532 | XLIST2, DCA XLISTX /SET SWITCH | |
3533 | DCA I [LINBUF /XLIST NEVER LISTS! | |
3534 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
3535 | ||
3536 | XLIST1, TAD XLISTX | |
3537 | SNA CLA | |
3538 | IAC /FLIP IT | |
3539 | JMP XLIST2 | |
3540 | ||
3541 | RELOCY, JMS XLISTZ /RELOCATE PSEUDO-OP - EXPRESSION? | |
3542 | JMP RELOC1 /NO | |
3543 | JMS I [EXP /GET IT | |
3544 | TAD VALUE | |
3545 | CIA /COMPUTE OFFSET OF REL LOC CTR | |
3546 | TAD LOC /FROM FAKE LOC CTR | |
3547 | TAD OFFSET /OFFSET IS CUMULATIVE! | |
3548 | RELOC2, DCA OFSBUF /SET NEW OFFSET - THIS TAKES EFFECT AFTER | |
3549 | STA /THE LITERALS (IF ANY) ARE DUMPED. | |
3550 | JMP I (STAR0 /FAKE ORIGIN TO NEW LOC, | |
3551 | /ACTUALLY A NO-OP BECAUSE OF OFFSET | |
3552 | RELOC1, TAD OFFSET /SET OFSBUF=0, LOC=LOC+OFFSET - | |
3553 | TAD LOC /THIS CANCELS ALL RELOCATION STUFF. | |
3554 | DCA VALUE | |
3555 | DCA UNDFSW /JUST IN CASE - "STAR0" CHECKS THIS | |
3556 | JMP RELOC2 /STILL MUST OUTPUT *. TO GET IN SYNCH | |
3557 | \f/HANDLER FOR EJECT PSEUDO-OP | |
3558 | ||
3559 | EJECTX, ISZ THISPG | |
3560 | TAD PASS /IS THIS PASS 3? | |
3561 | SMA SZA CLA | |
3562 | JMP EJECT2 /YES | |
3563 | EJECT1, TAD CHAR /NO - LOOK FOR NEXT NEGATIVE CHARACTER | |
3564 | SPA CLA | |
3565 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
3566 | JMS I [GETC /GET NEXT CHARACTER | |
3567 | JMP EJECT1 | |
3568 | ||
3569 | EJECT2, JMS XLISTZ /PASS 3 - IS THERE AN EXPRESSION? | |
3570 | JMP EJECT3 /NO - EXIT | |
3571 | JMS I (HEDCLR /YES - CLEAR HEADING BUFFER | |
3572 | TAD [-HEDLEN | |
3573 | DCA EJECT7 /SET UP FOR 40 NEW CHARACTERS | |
3574 | TAD [HEADER-1 | |
3575 | DCA XREG1 /SET HEADER BUFFER POINTER | |
3576 | JMP EJECT4 | |
3577 | ||
3578 | EJECT6, ISZ EJECT7 /FILLED 40 CHARACTERS YET? | |
3579 | JMP EJECT4 /NO - KEEP FILLING | |
3580 | CLA CMA /YES - SKIP CHARACTERS TO | |
3581 | DCA EJECT7 /END OF LINE | |
3582 | JMP EJECT5 | |
3583 | ||
3584 | EJECT4, TAD CHAR /FILL HEADING BUFFER | |
3585 | DCA I XREG1 | |
3586 | EJECT5, CLA CMA | |
3587 | DCA TXTSWT | |
3588 | JMS I [GETC /GET NEXT CHARACTER | |
3589 | TAD CHAR /END OF LINE? | |
3590 | SMA CLA | |
3591 | JMP EJECT6 /NO - KEEP FILLING | |
3592 | EJECT3, JMS I [FORMFD /GENERATE FORM FEED | |
3593 | JMP I [LOOKEX /--EXIT TO MAIN-- | |
3594 | \fPUNVAL, TAD PASS /IS THIS PASS 3? | |
3595 | JMP PUNVA1 /IF SO, LIST STUFF | |
3596 | ||
3597 | ||
3598 | /SEE IF EXPRESSION FOLLOWS XLIST | |
3599 | /SKIP ON EXPRESSION | |
3600 | ||
3601 | EJECT7, | |
3602 | XLISTZ, 0 | |
3603 | JMS I [SPNOR /IGNORE TRAILING SPACES | |
3604 | TAD CHAR | |
3605 | TAD [-"> /IS THERE AN EXPRESSION? | |
3606 | SNA CLA | |
3607 | JMP I XLISTZ /NO--RETURN-- | |
3608 | TAD CHAR | |
3609 | SMA CLA | |
3610 | ISZ XLISTZ /YES - INCREMENT RETURN ADDRESS | |
3611 | JMP I XLISTZ /--RETURN-- | |
3612 | ||
3613 | ||
3614 | /DUMMY ERROR ROUTINE | |
3615 | /TO SUPPRESS CERTAIN ERROR MESSAGES | |
3616 | /ON PASS 1 | |
3617 | ||
3618 | PERRO1, 0 | |
3619 | ISZ PERRO1 /SKIP ERROR MESSAGE POINTER | |
3620 | JMP I PERRO1 /--RETURN-- | |
3621 | ||
3622 | ||
3623 | /CONSTANTS FOR DECIMAL PRINT | |
3624 | ||
3625 | DECIMAL | |
3626 | FORMF8, -1000 | |
3627 | -100 | |
3628 | -10 | |
3629 | 0 | |
3630 | OCTAL | |
3631 | PAGE | |
3632 | \f/********************************************************************* | |
3633 | ||
3634 | INBUF=. /INPUT BUFFER | |
3635 | ||
3636 | OUBUF=. /OUTPUT BUFFER | |
3637 | ||
3638 | OUDEVH=.+400 /OUTPUT DEVICE HANDLER | |
3639 | ||
3640 | INDEVH=7200 /INPUT DEVICE HANDLER | |
3641 | ||
3642 | /********************************************************************** | |
3643 | ||
3644 | / EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM | |
3645 | ||
3646 | /PASS1: | |
3647 | ||
3648 | / THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200 | |
3649 | / THE INPUT HANDLER GOES IN 7200-7600. | |
3650 | / THERE IS NO OUTPUT HANDLER. | |
3651 | / HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT | |
3652 | / LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED | |
3653 | / SO THAT THE INPUT BUFFER IS 5600-7600 | |
3654 | ||
3655 | /PASS2 AND PASS3: | |
3656 | ||
3657 | / THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED | |
3658 | / AT 5600-6200. | |
3659 | / THE OUTPUT HANDLER RESIDES IN 6200-6600. | |
3660 | / THE INPUT HANDLER RESIDES IN 7200-7600. | |
3661 | / THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200 | |
3662 | / BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR | |
3663 | / THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE | |
3664 | / DON'T EXIST. | |
3665 | ||
3666 | /WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR | |
3667 | /HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE | |
3668 | /WERE ANY HANDLERS THERE. IF ANY HANDLERS WERE THERE IN THE PAST, | |
3669 | /THEY ARE NOW MARKED AS BEING NON-RESIDENT. | |
3670 | \f/MORE ONCE ONLY CODE | |
3671 | ||
3672 | OTYPE, 0 | |
3673 | DCA TEMP | |
3674 | CDF 10 | |
3675 | TAD I TEMP | |
3676 | AND [17 /GET DEVICE NUMBER | |
3677 | TAD (DCB-1 | |
3678 | DCA TEMP | |
3679 | TAD I TEMP /GET DCB ENTRY | |
3680 | CDF | |
3681 | JMP I OTYPE /--RETURN-- | |
3682 | ||
3683 | /CHECK TO SEE HOW MUCH CORE EXISTS | |
3684 | /AND STORE SYMBOL TABLE ACCORDINGLY | |
3685 | ||
3686 | IFZERO HASH< | |
3687 | BEGINF, CDF 10 /WAS THE /K OPTION SELECTED TO | |
3688 | TAD I (MPARAM /CHECK FOR MORE THAN 8K? | |
3689 | CDF 0 | |
3690 | RTR | |
3691 | ZK7630, SNL CLA /YES | |
3692 | JMP I (CKBAT /NO - CHECK FOR BATCH, USE 8K ONLY | |
3693 | CDF 50 | |
3694 | JMS FLD2 /WHAT IS HIGHEST FIELD? | |
3695 | JMP FLD1-1 /5 | |
3696 | CDF 40 | |
3697 | JMS FLD2 | |
3698 | JMP FLD1 /4 | |
3699 | CDF 30 | |
3700 | JMS FLD2 | |
3701 | JMP FLD1+1 /3 | |
3702 | CDF 20 | |
3703 | JMS FLD2 | |
3704 | JMP FLD1+2 /2 | |
3705 | JMP OPTIM4 /1 | |
3706 | \f TAD [177 /IF FIELD 5, ALLOW 4095 SYMBOLS | |
3707 | FLD1, TAD (1740 /OTHERWISE ALLOW 1740*(NR OF FIELDS) | |
3708 | TAD (1740 | |
3709 | TAD (1740 | |
3710 | OPTIM0, TAD (1740 | |
3711 | DCA I (TAGMAX /SET HIGHEST ADDRESS FOR TAGS | |
3712 | JMP I (BEGING | |
3713 | ||
3714 | OPTIM4, TAD I OPTIM1 /OPTIMIZE SEARCH PATTERN | |
3715 | ISZ OPTIM1 /BY SUBSTITUTING CODE IN SEARCH | |
3716 | DCA I OPTIM2 /ROUTINE | |
3717 | ISZ OPTIM2 | |
3718 | ISZ OPTIM3 | |
3719 | JMP OPTIM4 | |
3720 | OPTIM8, TAD I OPTIM5 | |
3721 | ISZ OPTIM5 | |
3722 | DCA I OPTIM6 | |
3723 | ISZ OPTIM6 | |
3724 | ISZ OPTIM7 | |
3725 | JMP OPTIM8 | |
3726 | JMP OPTIM0 | |
3727 | > | |
3728 | ||
3729 | IFNZRO HASH< | |
3730 | /SIZE CHECK OUR MACHINE | |
3731 | ||
3732 | BEGINF, CDF 10 | |
3733 | TAD I (MPARAM | |
3734 | CDF | |
3735 | RTR /K TO LINK | |
3736 | ZK7630, SNL CLA /ALTER FOR COMPLEMENT OF K | |
3737 | TAD [400 /TAD TO KEEP USR | |
3738 | DCA I (USROFS | |
3739 | CDF 50 | |
3740 | JMS FLD2 | |
3741 | ISZ HIFLD | |
3742 | CDF 40 | |
3743 | JMS FLD2 | |
3744 | ISZ HIFLD | |
3745 | CDF 30 | |
3746 | JMS FLD2 | |
3747 | ISZ HIFLD | |
3748 | CDF 20 | |
3749 | JMS FLD2 | |
3750 | ISZ HIFLD | |
3751 | TAD I (7777 /CHECK SOFT CORE SIZE | |
3752 | AND (70 | |
3753 | SNA | |
3754 | JMP CKSEV /NOT THERE | |
3755 | CLL RTR | |
3756 | RAR | |
3757 | DCA HIFLD /THERE, SET HIFLD WITH IT | |
3758 | TAD HIFLD /TAKE MIN(HIFLD,5) | |
3759 | TAD (7772 | |
3760 | SMA CLA /SMA TO USE HIFLD | |
3761 | TAD (5 /ELSE USE 5 | |
3762 | SZA | |
3763 | DCA HIFLD /STORE 5 IF NECESSARY | |
3764 | CKSEV, CDF 10 | |
3765 | TAD I (MPARAM+2 /LOOK AT /7 | |
3766 | CDF | |
3767 | AND (4 | |
3768 | SNA CLA /SNA IF THERE | |
3769 | JMP I (CKBAT /ELSE CHECK FOR BATCH | |
3770 | TAD (-7 /SET TO PRINT 7 COLUMNS OF STAB | |
3771 | DCA I (SYMNCL | |
3772 | TAD (67^6 /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE | |
3773 | DCA I (SYMOFS | |
3774 | JMP I (CKBAT /OK, CHECK FOR BATCH NOW | |
3775 | OPTIM4, SNL /SNL IF BATCH RUNNING | |
3776 | JMP I (BEGING /ELSE TAKE DEFAULT TABLE SIZE | |
3777 | TAD (BPRIME/SET ALTERNATE TABLE SIZE | |
3778 | DCA I (PRIMES /INTO THE ONCE ONLY CODE | |
3779 | JMP I (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD | |
3780 | HIFLD, 1 /8K MINIMUM | |
3781 | > | |
3782 | ||
3783 | /SKIP IF CURRENT DATA FIELD DOES NOT EXIST | |
3784 | FLD2, 0 | |
3785 | TAD (FLD3 | |
3786 | DCA I (FLD4 | |
3787 | FLD3, CLA | |
3788 | TAD I (FLD4 | |
3789 | NOP | |
3790 | CDF | |
3791 | TAD (-FLD3 | |
3792 | SZA CLA | |
3793 | JMP FLD5 | |
3794 | TAD IOMON | |
3795 | TAD [-200 | |
3796 | SNA CLA /IS FIELD THERE? | |
3797 | JMP I FLD2 /YES--RETURN-- | |
3798 | TAD [200 | |
3799 | DCA IOMON | |
3800 | FLD5, ISZ FLD2 /NO-INCREMENT RETURN ADDRESS | |
3801 | JMP I FLD2 /--RETURN-- | |
3802 | ||
3803 | FLD4, IOMON | |
3804 | \f/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH | |
3805 | /IN 8K | |
3806 | IFZERO HASH< | |
3807 | ||
3808 | OPTIM1, OPTIMA | |
3809 | OPTIM2, SETFLD+1 | |
3810 | OPTIM3, -7 | |
3811 | ||
3812 | OPTIM5, OPTIMB | |
3813 | OPTIM6, GETTG5 | |
3814 | OPTIM7, -21 | |
3815 | ||
3816 | OPTIMA, RELOC SETFLD+1 | |
3817 | ||
3818 | CLL CMA RTL | |
3819 | TAD STM202 | |
3820 | DCA TAGXR | |
3821 | CDF 10 | |
3822 | JMP I SETFLD | |
3823 | STM202, -202 | |
3824 | SETFL4, 4 | |
3825 | RELOC | |
3826 | ||
3827 | OPTIMB, RELOC GETTG5 | |
3828 | ||
3829 | TAD HIGHTG | |
3830 | JMS SETFLD | |
3831 | TAD TAGXR | |
3832 | DCA XREG1 | |
3833 | TAD XREG1 | |
3834 | TAD SETFL4 | |
3835 | DCA XREG2 | |
3836 | TAD THISTG | |
3837 | JMS SETFLD | |
3838 | OPTIML, TAD I XREG2 | |
3839 | DCA I XREG1 | |
3840 | TAD XREG1 | |
3841 | CIA | |
3842 | TAD TAGXR | |
3843 | SZA CLA | |
3844 | JMP OPTIML | |
3845 | CDF | |
3846 | RELOC | |
3847 | > | |
3848 | \f/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT | |
3849 | ||
3850 | DSWIT2, IFZERO HASH< | |
3851 | RELOC SYMPR9-2 | |
3852 | JMP SYMPRE | |
3853 | SYMPRD, TAD SYM204 | |
3854 | JMS I OERROR | |
3855 | TAD [377 | |
3856 | JMS I OERROR | |
3857 | JMS SYMPRC | |
3858 | DCA LINCNT | |
3859 | JMP I SYMPRT | |
3860 | SYMPRC, 0 | |
3861 | TAD [-200 | |
3862 | DCA SYMPR2 | |
3863 | TAD [200 | |
3864 | JMS I OERROR | |
3865 | ISZ SYMPR2 | |
3866 | JMP .-3 | |
3867 | JMP I SYMPRC | |
3868 | RELOC | |
3869 | > | |
3870 | IFNZRO HASH< | |
3871 | RELOC SYMDDT | |
3872 | ISZ THISTG | |
3873 | JMP SYMLUP | |
3874 | SYMXIT, TAD SYM204 | |
3875 | JMS I OERROR | |
3876 | TAD [377 | |
3877 | JMS I OERROR | |
3878 | JMS DDTLDR | |
3879 | DCA LINCNT | |
3880 | JMP I SYMPRT | |
3881 | DDTLDR, 0 | |
3882 | TAD [7600 | |
3883 | DCA SYMCCT | |
3884 | TAD [200 | |
3885 | JMS I OERROR | |
3886 | ISZ SYMCCT | |
3887 | JMP .-3 | |
3888 | JMP I DDTLDR | |
3889 | SYM204, 204 | |
3890 | RELOC | |
3891 | > | |
3892 | DSWITB= . | |
3893 | PAGE | |
3894 | \fBEGING, CIF 10 | |
3895 | JMS I IOMON /CALL THE USR | |
3896 | 12 /TO FIND OUT DSK: | |
3897 | BEGINJ, TEXT /DSK/ | |
3898 | 7201 /DUMMY | |
3899 | HLT /NEVER! | |
3900 | /V3C TAD BEGINJ+1 /GET DEVICE NUMBER OF DSK: | |
3901 | /V3C DCA CC7 /AND SET IT | |
3902 | TAD BEGINJ+1 | |
3903 | DCA I BEGINL /AND SET IT INTO "PALBIN" | |
3904 | CDF 10 | |
3905 | TAD I CC1 /GET PARAMETER WORD 1 | |
3906 | CDF | |
3907 | CLL RTL /OPTION /B INTO LINK | |
3908 | AND [400 /IS IT /F? | |
3909 | ZF7650, SZA CLA | |
3910 | DCA I CCX1 /YES: /F => NO 0 FILL | |
3911 | ZB7430, SNL /IS IT /B? | |
3912 | JMP .+3 | |
3913 | TAD CCX2 | |
3914 | DCA I CCX3 /YES: /B => ! IS SHIFT | |
3915 | CDF 10 | |
3916 | TAD I CC1 /GET WORD 1 AGAIN | |
3917 | CDF | |
3918 | AND [200 /IS IT /E? | |
3919 | ZE7640, SNA CLA | |
3920 | JMP .+3 | |
3921 | TAD CCX8 | |
3922 | DCA I CCX4 /YES: /E => SET 'LG' ERROR | |
3923 | CDF 10 | |
3924 | TAD I CCX5 /GET WORD 2 THIS TIME | |
3925 | CDF | |
3926 | RTL | |
3927 | ZO7710, SMA CLA /IS IT /O? | |
3928 | JMP .+3 | |
3929 | DCA I CCX6 /YES: /O => NO 200 ORG | |
3930 | ISZ I CCX7 | |
3931 | CDF 10 | |
3932 | TAD I CC1 /GET WORD 1 AGAIN | |
3933 | AND CC2 /IS IT /C? | |
3934 | SNA CLA | |
3935 | JMP I CC3 /NO: TRY FOR /L OR /G | |
3936 | TAD I CC4 /CREF FILE SPECIFIED? | |
3937 | SZA CLA | |
3938 | JMP CC5 /YES | |
3939 | CC6, TAD CC7 /NO: GIVE "CREFLS.TM" | |
3940 | DCA I CC4 | |
3941 | ISZ CC6 | |
3942 | ISZ CC4 | |
3943 | ISZ CC8 | |
3944 | JMP CC6 | |
3945 | \fCC5, CDF | |
3946 | CIF 10 | |
3947 | CLA IAC | |
3948 | JMS I IOMON /LOOKUP "CREF.SV" | |
3949 | 2 | |
3950 | CC13, CC9 /POINT TO NAME - BACK WITH START | |
3951 | CC8, -5 /LENGTH GOES HERE | |
3952 | JMP CC16 /NOT FOUND! | |
3953 | TAD CC30 | |
3954 | JMS I CC31 /CHECK TYPE FILE | |
3955 | SMA CLA | |
3956 | JMP CC16 /NOT DIRECTORY IS ERROR | |
3957 | TAD CC12 | |
3958 | DCA I CC121 /CSWITC=TAD I [7605 | |
3959 | TAD CC11 | |
3960 | DCA I CC111 /CSWIT1=CLA | |
3961 | TAD CC10 | |
3962 | DCA I CC101 /CSWIT2=DCA BINSRT | |
3963 | DCA I CC171 /CMOVE=0 | |
3964 | TAD CC13 | |
3965 | DCA I CC131 /CHAIN="CREF.SV" | |
3966 | DCA I CC141 /LSWITC=0 | |
3967 | TAD CC30 | |
3968 | DCA I CC301 /NOPA22=7612 | |
3969 | DCA I CC20 /"BEGIAB"=0 | |
3970 | TAD CC21 | |
3971 | DCA I CC211 /"DIRSW1"=TAD [177 | |
3972 | TAD CC22 | |
3973 | DCA I CC221 /"PTPSW1"=TAD [232 | |
3974 | JMP I .+1 | |
3975 | CCC /KEEP GOING (SIGH) | |
3976 | ||
3977 | CC16, JMS I [ERROR | |
3978 | CF /OPTION /C ERROR | |
3979 | JMP I CC3 /TRY FOR /L OR /G | |
3980 | \fCC171, SWAPR2+CMOVE | |
3981 | CC141, LSWITC | |
3982 | CC131, CHAIN | |
3983 | CC121, CSWITC | |
3984 | CC12, TAD I [7605 | |
3985 | CC111, CSWIT1 | |
3986 | CC11, CLA | |
3987 | CC101, SWAPR2+CSWIT2 | |
3988 | CC10, DCA BINSRT | |
3989 | CC301, SWAPR2+NOPA22 | |
3990 | CC30, 7612 | |
3991 | CC31, OTYPE | |
3992 | CC1, MPARAM | |
3993 | CC2, 1000 | |
3994 | CC3, BEGINH | |
3995 | CC4, 7612 | |
3996 | ||
3997 | CCX1, TEXT4X /V3C | |
3998 | CCX2, OP3 | |
3999 | CCX3, OPEXPL | |
4000 | CCX4, LGERR | |
4001 | CCX5, MPARAM+1 | |
4002 | CCX6, FIELDY+1 | |
4003 | CCX7, FIELDY+2 | |
4004 | CCX8, JMS I PERROR | |
4005 | ||
4006 | CC7, 1 | |
4007 | FILENAME CREFLS.TM | |
4008 | CC9, FILENAME CREF.SV | |
4009 | ||
4010 | CC20, BEGIAB | |
4011 | CC21, TAD [177 | |
4012 | CC211, SWAPR2+DIRSW1 | |
4013 | CC22, TAD [232 | |
4014 | CC221, SWAPR2+PTPSW1 | |
4015 | ||
4016 | BEGINL, PALBIN | |
4017 | PAGE | |
4018 | \f/*********************************************************************** | |
4019 | /SYMBOL TABLE | |
4020 | /MOVED BY ASSEMBLER TO FIELD 1 | |
4021 | /MUST REMAIN IN ALPHABETICAL ORDER | |
4022 | /*********************************************************************** | |
4023 | ||
4024 | SYMS, 5777 /TERMINATOR | |
4025 | 3777 /IMPOSSIBLE (LIMITING) SYMBOL | |
4026 | 5777 | |
4027 | 0000 | |
4028 | IFNZRO HASH< /PSEUDO OPS MUST GO FIRST FOR EXPUNGE | |
4029 | "I-300^45+4000+2000 /I | |
4030 | 0 | |
4031 | 0 | |
4032 | 0400 | |
4033 | ||
4034 | "P-300^45+"A-300+4000 /PAUSE | |
4035 | "U-300^45+"S-300 | |
4036 | "E-300^45+4000 | |
4037 | PAUSEX | |
4038 | ||
4039 | "P-300^45+"A-300+4000 /PAGE | |
4040 | "G-300^45+"E-300 | |
4041 | 4000 | |
4042 | PAGEX | |
4043 | ||
4044 | "T-300^45+"E-300+4000 /TEXT | |
4045 | "X-300^45+"T-300 | |
4046 | 4000 | |
4047 | TEXTX | |
4048 | ||
4049 | "R-300^45+"E-300+4000 /RELOC | |
4050 | "L-300^45+"O-300 | |
4051 | "C-300^45+4000 | |
4052 | RELOCY | |
4053 | ||
4054 | "O-300^45+"C-300+4000 /OCTAL | |
4055 | "T-300^45+"A-300 | |
4056 | "L-300^45+4000 | |
4057 | OCTALX | |
4058 | ||
4059 | "N-300^45+"O-300+4000 /NOPUNCH | |
4060 | "P-300^45+"U-300 | |
4061 | "N-300^45+"C-300+4000 | |
4062 | NOPUNX | |
4063 | ||
4064 | ||
4065 | "I-300^45+"F-300+4000 /IFZERO | |
4066 | "Z-300^45+"E-300 | |
4067 | "R-300^45+"O-300+4000 | |
4068 | IF0 | |
4069 | \f "I-300^45+"F-300+4000 /IFNZRO | |
4070 | "N-300^45+"Z-300 | |
4071 | "R-300^45+"O-300+4000 | |
4072 | IFN0 | |
4073 | ||
4074 | "I-300^45+"F-300+4000 /IFNDEF | |
4075 | "N-300^45+"D-300 | |
4076 | "E-300^45+"F-300+4000 | |
4077 | IFND | |
4078 | ||
4079 | "I-300^45+"F-300+4000 /IFDEF | |
4080 | "D-300^45+"E-300 | |
4081 | "F-300^45+4000 | |
4082 | IFD | |
4083 | ||
4084 | "F-300^45+"I-300+4000 /FIXTAB | |
4085 | "X-300^45+"T-300 | |
4086 | "A-300^45+"B-300+4000 | |
4087 | FIXTBX | |
4088 | ||
4089 | "F-300^45+"I-300+4000 /FIXMRI | |
4090 | "X-300^45+"M-300 | |
4091 | "R-300^45+"I-300+4000 | |
4092 | FIXMRX | |
4093 | ||
4094 | "F-300^45+"I-300+4000 /FILENAME | |
4095 | "L-300^45+"E-300 | |
4096 | "N-300^45+"A-300+4000 | |
4097 | FILENX | |
4098 | ||
4099 | "F-300^45+"I-300+4000 /FIELD | |
4100 | "E-300^45+"L-300 | |
4101 | "D-300^45+4000 | |
4102 | FIELDX | |
4103 | ||
4104 | "E-300^45+"X-300+4000 /EXPUNGE | |
4105 | "P-300^45+"U-300 | |
4106 | "N-300^45+"G-300+4000 | |
4107 | EXPUNX | |
4108 | ||
4109 | "E-300^45+"N-300+4000 /ENPUNCH | |
4110 | "P-300^45+"U-300 | |
4111 | "N-300^45+"C-300+4000 | |
4112 | ENPUNX | |
4113 | ||
4114 | "E-300^45+"J-300+4000 /EJECT | |
4115 | "E-300^45+"C-300 | |
4116 | "T-300^45+4000 | |
4117 | EJECTX | |
4118 | \f "D-300^45+"T-300+4000 /DTORG | |
4119 | "O-300^45+"R-300 | |
4120 | "G-300^45+4000 | |
4121 | DTORGX | |
4122 | ||
4123 | "D-300^45+"E-300+4000 /DEVICE | |
4124 | "V-300^45+"I-300 | |
4125 | "C-300^45+"E-300+4000 | |
4126 | DEVICX | |
4127 | ||
4128 | "D-300^45+"E-300+4000 /DECIMAL | |
4129 | "C-300^45+"I-300 | |
4130 | "M-300^45+"A-300+4000 | |
4131 | DECIMX | |
4132 | > | |
4133 | "Z-300^45+"B-300+4000 /ZBLOCK | |
4134 | "L-300^45+"O-300 | |
4135 | "C-300^45+"K-300+4000 | |
4136 | ZBLOCX | |
4137 | ||
4138 | "Z-300^45+4000+2000 /Z | |
4139 | 0 | |
4140 | 0 | |
4141 | 0000 | |
4142 | ||
4143 | "X-300^45+"L-300+4000 /XLIST | |
4144 | "I-300^45+"S-300 | |
4145 | "T-300^45+4000 | |
4146 | XLISTY | |
4147 | ||
4148 | "T-300^45+"S-300+4000 /TSK | |
4149 | "K-300^45 | |
4150 | 0 | |
4151 | 6045 | |
4152 | ||
4153 | "T-300^45+"S-300+4000 /TSF | |
4154 | "F-300^45 | |
4155 | 0 | |
4156 | TSF | |
4157 | ||
4158 | "T-300^45+"P-300+4000 /TPC | |
4159 | "C-300^45 | |
4160 | 0 | |
4161 | TPC | |
4162 | ||
4163 | "T-300^45+"L-300+4000 /TLS | |
4164 | "S-300^45 | |
4165 | 0 | |
4166 | TLS | |
4167 | ||
4168 | "T-300^45+"F-300+4000 /TFL | |
4169 | "L-300^45 | |
4170 | 0 | |
4171 | 6040 | |
4172 | \f IFZERO HASH< | |
4173 | "T-300^45+"E-300+4000 /TEXT | |
4174 | "X-300^45+"T-300 | |
4175 | 4000 | |
4176 | TEXTX | |
4177 | > | |
4178 | "T-300^45+"C-300+4000 /TCF | |
4179 | "F-300^45 | |
4180 | 0 | |
4181 | TCF | |
4182 | ||
4183 | "T-300^45+"A-300+4000 /TAD | |
4184 | "D-300^45+4000 | |
4185 | 0 | |
4186 | TAD 0 | |
4187 | ||
4188 | "S-300^45+"Z-300+4000 /SZL | |
4189 | "L-300^45 | |
4190 | 0 | |
4191 | SZL | |
4192 | ||
4193 | "S-300^45+"Z-300+4000 /SZA | |
4194 | "A-300^45 | |
4195 | 0 | |
4196 | SZA | |
4197 | ||
4198 | "S-300^45+"W-300+4000 /SWP | |
4199 | "P-300^45 | |
4200 | 0 | |
4201 | 7521 | |
4202 | ||
4203 | "S-300^45+"T-300+4000 /STL | |
4204 | "L-300^45 | |
4205 | 0 | |
4206 | STL | |
4207 | ||
4208 | "S-300^45+"T-300+4000 /STA | |
4209 | "A-300^45 | |
4210 | 0 | |
4211 | STA | |
4212 | ||
4213 | "S-300^45+"R-300+4000 /SRQ | |
4214 | "Q-300^45 | |
4215 | 0 | |
4216 | 6003 | |
4217 | ||
4218 | "S-300^45+"P-300+4000 /SPA | |
4219 | "A-300^45 | |
4220 | 0 | |
4221 | SPA | |
4222 | \f "S-300^45+"N-300+4000 /SNL | |
4223 | "L-300^45 | |
4224 | 0 | |
4225 | SNL | |
4226 | ||
4227 | "S-300^45+"N-300+4000 /SNA | |
4228 | "A-300^45 | |
4229 | 0 | |
4230 | SNA | |
4231 | ||
4232 | "S-300^45+"M-300+4000 /SMA | |
4233 | "A-300^45 | |
4234 | 0 | |
4235 | SMA | |
4236 | ||
4237 | "S-300^45+"K-300+4000 /SKP | |
4238 | "P-300^45 | |
4239 | 0 | |
4240 | SKP | |
4241 | ||
4242 | "S-300^45+"K-300+4000 /SKON | |
4243 | "O-300^45+"N-300 | |
4244 | 0 | |
4245 | 6000 | |
4246 | ||
4247 | "S-300^45+"G-300+4000 /SGT | |
4248 | "T-300^45 | |
4249 | 0 | |
4250 | 6006 | |
4251 | ||
4252 | "R-300^45+"T-300+4000 /RTR | |
4253 | "R-300^45 | |
4254 | 0 | |
4255 | RTR | |
4256 | ||
4257 | "R-300^45+"T-300+4000 /RTL | |
4258 | "L-300^45 | |
4259 | 0 | |
4260 | RTL | |
4261 | ||
4262 | "R-300^45+"T-300+4000 /RTF | |
4263 | "F-300^45 | |
4264 | 0 | |
4265 | 6005 | |
4266 | ||
4267 | "R-300^45+"S-300+4000 /RSF | |
4268 | "F-300^45 | |
4269 | 0 | |
4270 | RSF | |
4271 | \f "R-300^45+"R-300+4000 /RRB | |
4272 | "B-300^45 | |
4273 | 0 | |
4274 | RRB | |
4275 | ||
4276 | "R-300^45+"P-300+4000 /RPE | |
4277 | "E-300^45 | |
4278 | 0 | |
4279 | 6010 | |
4280 | ||
4281 | "R-300^45+"M-300+4000 /RMF | |
4282 | "F-300^45 | |
4283 | 0 | |
4284 | RMF | |
4285 | ||
4286 | "R-300^45+"I-300+4000 /RIF | |
4287 | "F-300^45 | |
4288 | 0 | |
4289 | RIF | |
4290 | ||
4291 | "R-300^45+"I-300+4000 /RIB | |
4292 | "B-300^45 | |
4293 | 0 | |
4294 | RIB | |
4295 | ||
4296 | "R-300^45+"F-300+4000 /RFC | |
4297 | "C-300^45 | |
4298 | 0 | |
4299 | RFC | |
4300 | IFZERO HASH< | |
4301 | "R-300^45+"E-300+4000 /RELOC | |
4302 | "L-300^45+"O-300 | |
4303 | "C-300^45+4000 | |
4304 | RELOCY | |
4305 | > | |
4306 | "R-300^45+"D-300+4000 /RDF | |
4307 | "F-300^45 | |
4308 | 0 | |
4309 | RDF | |
4310 | ||
4311 | "R-300^45+"A-300+4000 /RAR | |
4312 | "R-300^45 | |
4313 | 0 | |
4314 | RAR | |
4315 | ||
4316 | "R-300^45+"A-300+4000 /RAL | |
4317 | "L-300^45 | |
4318 | 0 | |
4319 | RAL | |
4320 | \f "P-300^45+"S-300+4000 /PSF | |
4321 | "F-300^45 | |
4322 | 0 | |
4323 | PSF | |
4324 | ||
4325 | "P-300^45+"P-300+4000 /PPC | |
4326 | "C-300^45 | |
4327 | 0 | |
4328 | PPC | |
4329 | ||
4330 | "P-300^45+"L-300+4000 /PLS | |
4331 | "S-300^45 | |
4332 | 0 | |
4333 | PLS | |
4334 | ||
4335 | "P-300^45+"C-300+4000 /PCF | |
4336 | "F-300^45 | |
4337 | 0 | |
4338 | PCF | |
4339 | ||
4340 | "P-300^45+"C-300+4000 /PCE | |
4341 | "E-300^45 | |
4342 | 0 | |
4343 | 6020 | |
4344 | IFZERO HASH< | |
4345 | "P-300^45+"A-300+4000 /PAUSE | |
4346 | "U-300^45+"S-300 | |
4347 | "E-300^45+4000 | |
4348 | PAUSEX | |
4349 | ||
4350 | "P-300^45+"A-300+4000 /PAGE | |
4351 | "G-300^45+"E-300 | |
4352 | 4000 | |
4353 | PAGEX | |
4354 | > | |
4355 | "O-300^45+"S-300+4000 /OSR | |
4356 | "R-300^45 | |
4357 | 0 | |
4358 | OSR | |
4359 | ||
4360 | "O-300^45+"P-300+4000 /OPR | |
4361 | "R-300^45 | |
4362 | 0 | |
4363 | OPR | |
4364 | IFZERO HASH< | |
4365 | "O-300^45+"C-300+4000 /OCTAL | |
4366 | "T-300^45+"A-300 | |
4367 | "L-300^45+4000 | |
4368 | OCTALX | |
4369 | > | |
4370 | \f IFZERO HASH< | |
4371 | "N-300^45+"O-300+4000 /NOPUNCH | |
4372 | "P-300^45+"U-300 | |
4373 | "N-300^45+"C-300+4000 | |
4374 | NOPUNX | |
4375 | > | |
4376 | "N-300^45+"O-300+4000 /NOP | |
4377 | "P-300^45 | |
4378 | 0 | |
4379 | NOP | |
4380 | ||
4381 | "M-300^45+"Q-300+4000 /MQL | |
4382 | "L-300^45 | |
4383 | 0 | |
4384 | 7421 | |
4385 | ||
4386 | "M-300^45+"Q-300+4000 /MQA | |
4387 | "A-300^45 | |
4388 | 0 | |
4389 | 7501 | |
4390 | ||
4391 | "L-300^45+"A-300+4000 /LAS | |
4392 | "S-300^45 | |
4393 | 0 | |
4394 | LAS | |
4395 | ||
4396 | "K-300^45+"S-300+4000 /KSF | |
4397 | "F-300^45 | |
4398 | 0 | |
4399 | KSF | |
4400 | ||
4401 | "K-300^45+"R-300+4000 /KRS | |
4402 | "S-300^45 | |
4403 | 0 | |
4404 | KRS | |
4405 | ||
4406 | "K-300^45+"R-300+4000 /KRB | |
4407 | "B-300^45 | |
4408 | 0 | |
4409 | KRB | |
4410 | ||
4411 | "K-300^45+"I-300+4000 /KIE | |
4412 | "E-300^45 | |
4413 | 0 | |
4414 | 6035 | |
4415 | ||
4416 | "K-300^45+"C-300+4000 /KCF | |
4417 | "F-300^45 | |
4418 | 0 | |
4419 | 6030 | |
4420 | \f "K-300^45+"C-300+4000 /KCC | |
4421 | "C-300^45 | |
4422 | 0 | |
4423 | KCC | |
4424 | ||
4425 | "J-300^45+"M-300+4000 /JMS | |
4426 | "S-300^45+4000 | |
4427 | 0 | |
4428 | JMS 0 | |
4429 | ||
4430 | "J-300^45+"M-300+4000 /JMP | |
4431 | "P-300^45+4000 | |
4432 | 0 | |
4433 | JMP 0 | |
4434 | ||
4435 | "I-300^45+"S-300+4000 /ISZ | |
4436 | "Z-300^45+4000 | |
4437 | 0 | |
4438 | ISZ 0 | |
4439 | ||
4440 | "I-300^45+"O-300+4000 /IOT | |
4441 | "T-300^45 | |
4442 | 0 | |
4443 | IOT | |
4444 | ||
4445 | "I-300^45+"O-300+4000 /ION | |
4446 | "N-300^45 | |
4447 | 0 | |
4448 | ION | |
4449 | ||
4450 | "I-300^45+"O-300+4000 /IOF | |
4451 | "F-300^45 | |
4452 | 0 | |
4453 | IOF | |
4454 | IFZERO HASH< | |
4455 | "I-300^45+"F-300+4000 /IFZERO | |
4456 | "Z-300^45+"E-300 | |
4457 | "R-300^45+"O-300+4000 | |
4458 | IF0 | |
4459 | ||
4460 | "I-300^45+"F-300+4000 /IFNZRO | |
4461 | "N-300^45+"Z-300 | |
4462 | "R-300^45+"O-300+4000 | |
4463 | IFN0 | |
4464 | ||
4465 | "I-300^45+"F-300+4000 /IFNDEF | |
4466 | "N-300^45+"D-300 | |
4467 | "E-300^45+"F-300+4000 | |
4468 | IFND | |
4469 | > | |
4470 | \f IFZERO HASH< | |
4471 | "I-300^45+"F-300+4000 /IFDEF | |
4472 | "D-300^45+"E-300 | |
4473 | "F-300^45+4000 | |
4474 | IFD | |
4475 | > | |
4476 | "I-300^45+"A-300+4000 /IAC | |
4477 | "C-300^45 | |
4478 | 0 | |
4479 | IAC | |
4480 | IFZERO HASH< | |
4481 | "I-300^45+4000+2000 /I | |
4482 | 0 | |
4483 | 0 | |
4484 | 0400 | |
4485 | > | |
4486 | "H-300^45+"L-300+4000 /HLT | |
4487 | "T-300^45 | |
4488 | 0 | |
4489 | HLT | |
4490 | ||
4491 | "G-300^45+"T-300+4000 /GTF | |
4492 | "F-300^45 | |
4493 | 0 | |
4494 | 6004 | |
4495 | ||
4496 | "G-300^45+"L-300+4000 /GLK | |
4497 | "K-300^45 | |
4498 | 0 | |
4499 | GLK | |
4500 | IFZERO HASH< | |
4501 | "F-300^45+"I-300+4000 /FIXTAB | |
4502 | "X-300^45+"T-300 | |
4503 | "A-300^45+"B-300+4000 | |
4504 | FIXTBX | |
4505 | ||
4506 | "F-300^45+"I-300+4000 /FIXMRI | |
4507 | "X-300^45+"M-300 | |
4508 | "R-300^45+"I-300+4000 | |
4509 | FIXMRX | |
4510 | ||
4511 | "F-300^45+"I-300+4000 /FILENAME | |
4512 | "L-300^45+"E-300 | |
4513 | "N-300^45+"A-300+4000 | |
4514 | FILENX | |
4515 | ||
4516 | "F-300^45+"I-300+4000 /FIELD | |
4517 | "E-300^45+"L-300 | |
4518 | "D-300^45+4000 | |
4519 | FIELDX | |
4520 | > | |
4521 | \f IFZERO HASH< | |
4522 | "E-300^45+"X-300+4000 /EXPUNGE | |
4523 | "P-300^45+"U-300 | |
4524 | "N-300^45+"G-300+4000 | |
4525 | EXPUNX | |
4526 | ||
4527 | "E-300^45+"N-300+4000 /ENPUNCH | |
4528 | "P-300^45+"U-300 | |
4529 | "N-300^45+"C-300+4000 | |
4530 | ENPUNX | |
4531 | ||
4532 | "E-300^45+"J-300+4000 /EJECT | |
4533 | "E-300^45+"C-300 | |
4534 | "T-300^45+4000 | |
4535 | EJECTX | |
4536 | ||
4537 | "D-300^45+"T-300+4000 /DTORG | |
4538 | "O-300^45+"R-300 | |
4539 | "G-300^45+4000 | |
4540 | DTORGX | |
4541 | ||
4542 | "D-300^45+"E-300+4000 /DEVICE | |
4543 | "V-300^45+"I-300 | |
4544 | "C-300^45+"E-300+4000 | |
4545 | DEVICX | |
4546 | ||
4547 | "D-300^45+"E-300+4000 /DECIMAL | |
4548 | "C-300^45+"I-300 | |
4549 | "M-300^45+"A-300+4000 | |
4550 | DECIMX | |
4551 | > | |
4552 | "D-300^45+"C-300+4000 /DCA | |
4553 | "A-300^45+4000 | |
4554 | 0 | |
4555 | DCA 0 | |
4556 | ||
4557 | "C-300^45+"M-300+4000 /CML | |
4558 | "L-300^45 | |
4559 | 0 | |
4560 | CML | |
4561 | ||
4562 | "C-300^45+"M-300+4000 /CMA | |
4563 | "A-300^45 | |
4564 | 0 | |
4565 | CMA | |
4566 | ||
4567 | "C-300^45+"L-300+4000 /CLL | |
4568 | "L-300^45 | |
4569 | 0 | |
4570 | CLL | |
4571 | \f "C-300^45+"L-300+4000 /CLA | |
4572 | "A-300^45 | |
4573 | 0 | |
4574 | CLA | |
4575 | ||
4576 | "C-300^45+"I-300+4000 /CIF | |
4577 | "F-300^45 | |
4578 | 0 | |
4579 | CIF | |
4580 | ||
4581 | "C-300^45+"I-300+4000 /CIA | |
4582 | "A-300^45 | |
4583 | 0 | |
4584 | CIA | |
4585 | ||
4586 | "C-300^45+"D-300+4000 /CDF | |
4587 | "F-300^45 | |
4588 | 0 | |
4589 | CDF | |
4590 | ||
4591 | "C-300^45+"A-300+4000 /CAF | |
4592 | "F-300^45 | |
4593 | 0 | |
4594 | 6007 | |
4595 | ||
4596 | "B-300^45+"S-300+4000 /BSW | |
4597 | "W-300^45 | |
4598 | 0 | |
4599 | 7002 | |
4600 | ||
4601 | "A-300^45+"N-300+4000 /AND | |
4602 | "D-300^45+4000 | |
4603 | 0 | |
4604 | AND 0 | |
4605 | ||
4606 | 4001 /TERMINATOR | |
4607 | 0000 /IMPOSSIBLE (LIMITING) SYMBOL | |
4608 | 4000 | |
4609 | 0000 | |
4610 | ||
4611 | SYME=. | |
4612 | ||
4613 | /********************************************************************** | |
4614 | /TOP OF SYMBOL TABLE | |
4615 | /********************************************************************** | |
4616 | \fSWAP2=. | |
4617 | ||
4618 | /********************************************************************** | |
4619 | /CODE UNIQUE TO PASSES 1 AND 2 | |
4620 | /SWAPPED IN FOR PASSES 1 AND 2 | |
4621 | /OVERLAYED DURING PASS 3 *** NO LITERALS *** | |
4622 | ||
4623 | RELOC 1000 /ASSEMBLED INTO 1000-1247 | |
4624 | ||
4625 | SWAPB2= . | |
4626 | SWAPR2= SWAP2-SWAPB2 /RELOCATION FACTOR FOR THIS CODE | |
4627 | ||
4628 | OOPEN, 0 | |
4629 | TAD OPEN01 /OPEN BINARY AND LISTING FILES | |
4630 | DCA XOUHND /SET ADDRESS OF DEVICE HANDLER | |
4631 | TAD OPEN02 | |
4632 | DCA XOUBLK | |
4633 | TAD [-5 | |
4634 | DCA XOUELE /SET NEW OUTPUT FILE LENGTH | |
4635 | CDF 10 | |
4636 | TAD I OUFPTR | |
4637 | CDF | |
4638 | DCA I XOUBLK | |
4639 | ISZ XOUBLK | |
4640 | ISZ OUFPTR | |
4641 | ISZ XOUELE /INCREMENT OUTPUT FILE LENGTH | |
4642 | JMP .-7 | |
4643 | TAD OPEN02 | |
4644 | IAC | |
4645 | DCA XOUBLK /SET POINTER TO NEW FILENAME | |
4646 | TAD XOUBLK | |
4647 | DCA I OPEN04 | |
4648 | CIF 10 | |
4649 | JMS I IOMON /CALL USER SERVICE ROUTINES | |
4650 | 13 /*RESET SYSTEM TABLES* | |
4651 | DCA I OPEN05 /DELETE UNCLOSED FILES AND | |
4652 | TAD I OPEN02 /DELETE HANDLERS | |
4653 | AND [17 /GET NEW DEVICE HANDLER # | |
4654 | SNA /OUTPUT INHIBIT? | |
4655 | JMP ONOFIL /YES | |
4656 | CIF 10 /NO | |
4657 | JMS I IOMON /CALL USER SERVICE ROUTINE | |
4658 | 1 /*FETCH DEVICE HANDLER* | |
4659 | XOUHND, 0 /LOADING ADDRESS | |
4660 | HLT /HANDLER NOT AVAILABLE | |
4661 | OUENTR, TAD I OPEN02 /NORMAL RETURN - GET OUTPUT | |
4662 | CIF 10 /DEVICE NUMBER AND FILE LENGTH | |
4663 | \f JMS I IOMON /CALL NEW SERVICE ROUTINES | |
4664 | 3 /*ENTER OUTUT FILE | |
4665 | XOUBLK, 0 /POINTER TO FILENAME | |
4666 | XOUELE, 0 /FILE LENGTH | |
4667 | JMP OEFAIL /ERROR RETURN | |
4668 | DCA I OPEN06 /NORMAL RETURN | |
4669 | JMS I OPEN07 | |
4670 | TAD XOUHND | |
4671 | TAD [200 /LINK IS CLEAR!! | |
4672 | SNL CLA | |
4673 | TAD [400 | |
4674 | TAD OUFDEV | |
4675 | DCA I OUFINP | |
4676 | TAD I OUFINP | |
4677 | CLL RAR | |
4678 | CIA | |
4679 | TAD OU3501 | |
4680 | DCA INCTL | |
4681 | ISZ OOPEN | |
4682 | TAD XOUHND | |
4683 | DCA I OPEN09 | |
4684 | TAD XOUBLK | |
4685 | DCA I OPEN10 | |
4686 | TAD XOUELE | |
4687 | DCA I OPEN11 | |
4688 | JMP I OOPEN /--RETURN-- | |
4689 | ||
4690 | OEFAIL, TAD I OPEN02 | |
4691 | AND [7760 | |
4692 | SNA CLA | |
4693 | JMP I OPEN12 /DE**FATAL ERROR** | |
4694 | TAD I OPEN02 | |
4695 | AND [17 | |
4696 | DCA I OPEN02 | |
4697 | JMP OUENTR | |
4698 | ||
4699 | ONOFIL, ISZ I OPEN05 /SET OUTPUT INHIBIT SWITCH | |
4700 | JMP I OOPEN /--RETURN-- | |
4701 | ||
4702 | OUFPTR, 7600 | |
4703 | ||
4704 | OPEN01, OUDEVH+1 | |
4705 | OPEN02, OUFILE | |
4706 | OPEN04, OUCNAM | |
4707 | OPEN05, OUTINH | |
4708 | OPEN06, OUCCNT | |
4709 | OPEN07, OUSETP | |
4710 | OPEN09, OUHNDL | |
4711 | OPEN10, OUBLK | |
4712 | OPEN11, OUELEN | |
4713 | OPEN12, SYSERR | |
4714 | OU3501, 3501 | |
4715 | OUFDEV, OUDEVH | |
4716 | OUFINP, INBUFP | |
4717 | \f/CONTINUATION OF FIXTAB HANDLER | |
4718 | ||
4719 | FIXTAY, IFZERO HASH< | |
4720 | TAD HIGHTG /SET POINTERS TO TABLE | |
4721 | CMA | |
4722 | > | |
4723 | IFNZRO HASH< | |
4724 | TAD TAGMAX | |
4725 | CIA | |
4726 | > | |
4727 | DCA TEMP3 | |
4728 | DCA THISTG | |
4729 | FIXTAX, JMS I [FINDTG /GET A TAG | |
4730 | AC3777 | |
4731 | AND TAG1 | |
4732 | IFNZRO HASH< | |
4733 | SZA | |
4734 | > | |
4735 | TAD [4000 /SET BIT 0 OF FIRST WORD TO 1 | |
4736 | DCA TAG1 /RETURN IT TO TABLE | |
4737 | JMS I [PUTTAG | |
4738 | ISZ THISTG | |
4739 | ISZ TEMP3 /DONE WITH TABLE YET? | |
4740 | JMP FIXTAX /NO | |
4741 | JMP I [LOOKEX /YES--EXIT TO MAIN-- | |
4742 | ||
4743 | /OUTPUT ONE REGISTER - BINARY | |
4744 | /ENTER WITH CONTENTS IN AC | |
4745 | ||
4746 | PUNOUT, 0 | |
4747 | DCA PUNOU1 | |
4748 | TAD PUNOU1 | |
4749 | RTR | |
4750 | RTR | |
4751 | RTR | |
4752 | AND [177 | |
4753 | JMS I OCHAR /OUTPUT FIRST FRAME | |
4754 | TAD PUNOU1 | |
4755 | AND [77 | |
4756 | JMS I OCHAR /OUTPUT SECOND FRAME | |
4757 | JMP I PUNOUT /--RETURN-- | |
4758 | ||
4759 | PUNOU1, | |
4760 | IOPEN, 0 /SET UP INPUT ROUTINE | |
4761 | CLA CMA /TO OPEN FILE | |
4762 | DCA I IOPEN1 | |
4763 | ISZ I IOPEN2 | |
4764 | TAD IOPEN3 | |
4765 | DCA I IOPEN4 | |
4766 | ISZ I IOPEN5 | |
4767 | TAD [LINBUF+120 | |
4768 | DCA TXTPTR | |
4769 | JMP I IOPEN /--RETURN-- | |
4770 | ||
4771 | IOPEN1, INCHCT | |
4772 | IOPEN2, INEOF | |
4773 | IOPEN3, 7617 | |
4774 | IOPEN4, INFPTR | |
4775 | IOPEN5, FORMSW | |
4776 | PAGE | |
4777 | \f/START PASS 2 *** NO LITERALS HERE EITHER *** | |
4778 | ||
4779 | START1, TAD [ERROR | |
4780 | DCA PERROR /RESET PREUDO-ERROR ROUTINE | |
4781 | JMS I ST1OPN /OPEN PASS 2 OUTPUT FILE | |
4782 | JMP NOPA21 /NO PASS 2 IF PASS 3 | |
4783 | NOPA23, TAD I ST1OBL | |
4784 | DCA BINSRT | |
4785 | DCA PUNCHX /CLEAR PUNCH INHIBIT | |
4786 | JMS START3 | |
4787 | JMP I .+1 | |
4788 | START2-1 | |
4789 | ||
4790 | NOPA21, CDF 10 | |
4791 | TAD I NOPA22 /IS THERE A PASS 3? | |
4792 | CDF | |
4793 | SNA CLA | |
4794 | JMP NOPA23 /NO - DO PASS 2 | |
4795 | ISZ PASS /SKIP PASS 2 | |
4796 | NOP | |
4797 | JMP NOPAS2 /CONTINUE TO PASS 3 | |
4798 | ||
4799 | NOPA22, 7605 | |
4800 | ||
4801 | START3, 0 /GENERATE LEADER/TRAILER | |
4802 | TAD LEADER | |
4803 | DCA TXTPTR | |
4804 | TAD [200 | |
4805 | JMS I OCHAR | |
4806 | ISZ TXTPTR | |
4807 | JMP .-3 | |
4808 | JMP I START3 /--RETURN-- | |
4809 | ||
4810 | LEADER, -10 | |
4811 | \f/END PASS 2 | |
4812 | ||
4813 | ENDPA2, JMS I [DUMPZ /DUMP PAGE 0 LITERALS | |
4814 | DCA PUNCHX | |
4815 | CLL /V3C | |
4816 | TAD CHKSUM /OUTPUT CHECKSUM | |
4817 | JMS I [PUNOUT /PUNCH THE CHECKSUM | |
4818 | JMS START3 /GENERATE LEADER/TRAILER | |
4819 | JMS I EN2CLS /CLOSE PASS 2 OUTPUT FILE | |
4820 | NOPAS2, TAD EN2LSO | |
4821 | DCA OERROR /SET NEW OUTPUT TO BE LISTING | |
4822 | ISZ I EN2OU1 | |
4823 | CMOVE, JMP CMOVA /ZEROED IF /C | |
4824 | CDF 10 /MOVE CODE FOR /C OPTION | |
4825 | CMOVB, TAD I CMOV1 | |
4826 | DCA I CMOV2 /MOVE OUTPUT FILE STORAGE | |
4827 | ISZ CMOV1 | |
4828 | ISZ CMOV2 | |
4829 | ISZ CMOV3 | |
4830 | JMP CMOVB /LOOP | |
4831 | CMOVA, CDF | |
4832 | JMS I ST1OPN /OPEN 3RD PASS FILE | |
4833 | DCA I CMOV4 /NO 3RD PASS | |
4834 | TAD I ST1OBL /GET FILE START | |
4835 | CSWIT2, CLA /"DCA BINSRT" IF /C | |
4836 | TAD PTPSW1 | |
4837 | DCA I EN2PTP /RESET PAPERTAPE SWITCH | |
4838 | TAD DIRSW1 | |
4839 | DCA I EN2DIR /RESET DIRECTORY SWITCH | |
4840 | JMS I PIOPEN | |
4841 | JMP I .+1 | |
4842 | LOADOV /OVERLAY THIS AREA WITH PASS3 CODE | |
4843 | ||
4844 | PIOPEN, IOPEN | |
4845 | DIRSW1, TAD [177 | |
4846 | PTPSW1, TAD [232 | |
4847 | ||
4848 | CMOV1, 7605 | |
4849 | CMOV2, 7600 | |
4850 | CMOV3, -12 | |
4851 | CMOV4, NSWITC | |
4852 | EN2CLS, OCLOSE | |
4853 | EN2LSO, LISOUT | |
4854 | EN2OU1, OUTPT1 | |
4855 | EN2PTP, PTPSW | |
4856 | EN2DIR, DIRSW | |
4857 | ST1OPN, OOPEN | |
4858 | ST1OBL, OUBLK | |
4859 | SWAPE2, RELOC | |
4860 | IFNZRO ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__> | |
4861 | PAGE | |
4862 | \f IFNZRO HASH< | |
4863 | ||
4864 | /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS | |
4865 | ||
4866 | HSHSMS, 0 | |
4867 | JMS I (7607 /WRITE THE SYMBOL TABLE SORT OVERLAY | |
4868 | 4210 /2 PAGES FROM FIELD 1 | |
4869 | OUDEVH+400 /FROM HERE | |
4870 | ASWAP+1 /TO HERE | |
4871 | JMP I (SYSERR/WONDERFUL. | |
4872 | TAD I (USROFS | |
4873 | SZA CLA /SZA IF KICKING OUT USR | |
4874 | TAD (12 /ELSE FUDGE POINTER | |
4875 | TAD I (HIFLD /FIRST SET HASH TABLE SIZE | |
4876 | TAD PRIMES /ACCORDING TO CORE SIZE | |
4877 | DCA PRIME | |
4878 | TAD I PRIME | |
4879 | DCA PRIME | |
4880 | TAD PRIME | |
4881 | CIA | |
4882 | DCA I (MPRIME | |
4883 | TAD I (USROFS | |
4884 | SZA CLA | |
4885 | JMP KPUSR /JMP IF KEEPING USR | |
4886 | CDF 10 /SERVE NOTICE WE'RE OCCUPYING FIELD 1 | |
4887 | AC7776 | |
4888 | AND I (JSBITS | |
4889 | DCA I (JSBITS | |
4890 | TAD [7700 | |
4891 | DCA IOMON /AND POINT AT PROPER MONITOR E.P. | |
4892 | KPUSR, CDF | |
4893 | TAD I (MPRIME /HOW MANY SLOTS TO WIPE | |
4894 | DCA LAST3 /TO COUNTER | |
4895 | TAD I (USROFS | |
4896 | CLL RTL | |
4897 | TAD (7777 /FUDGE THE INITIAL AUTO XR | |
4898 | JMP CLRGO /INTO THE LOOP NOW | |
4899 | CLRLUP, TAD LAST1 | |
4900 | TAD (-7577 | |
4901 | SZA CLA /SZA IF NEED TO DO NEXT FIELD | |
4902 | JMP CLCDF0+1/ELSE CLEAR ANOTHER | |
4903 | TAD (10 | |
4904 | TAD CLCDF0 | |
4905 | DCA CLCDF0 /CDF INSTR GETS BUMPED | |
4906 | STA | |
4907 | CLRGO, DCA LAST1 /XRGETS SET | |
4908 | CLCDF0, CDF 10 /INITIALLY CDF 10 | |
4909 | DCA I LAST1 | |
4910 | DCA I LAST1 | |
4911 | DCA I LAST1 | |
4912 | DCA I LAST1 | |
4913 | ISZ LAST3 /SKP IF NO MORE | |
4914 | JMP CLRLUP /ELSE DO ANOTHER | |
4915 | CDF /THE TABLE IS CLEAN | |
4916 | TAD (HSHRTN | |
4917 | DCA I [GETTAG | |
4918 | STA | |
4919 | DCA HIGHTG /HIGHTG=CURRENT SYMBOL INDEX | |
4920 | TAD (SYMS+3 /USE THESE AUTO XR'S NOW | |
4921 | DCA LAST1 | |
4922 | TAD LAST1 | |
4923 | DCA LAST2 | |
4924 | HSHLP, TAD I LAST1 | |
4925 | AND [1777 /FIRST, STRIP THE TYPE BITS | |
4926 | DCA I (NAME1 | |
4927 | AC3777 | |
4928 | AND I LAST1 | |
4929 | DCA I (NAME2 | |
4930 | AC3777 | |
4931 | AND I LAST1 | |
4932 | DCA I (NAME3 | |
4933 | ISZ LAST1 /SKIP THE VALUE | |
4934 | JMP I (GETTGH /GO FIND IT'S PLACE | |
4935 | HSHRTN, CLA CLL | |
4936 | TAD I LAST2 | |
4937 | DCA I (NAME1 | |
4938 | TAD I LAST2 | |
4939 | DCA I (NAME2 | |
4940 | TAD I LAST2 | |
4941 | DCA I (NAME3 | |
4942 | TAD I LAST2 | |
4943 | DCA VALUE2 | |
4944 | JMS I (INSRTG /AND STORE IT | |
4945 | TAD LAST1 | |
4946 | TAD (1-SYME+4 | |
4947 | SZA CLA | |
4948 | JMP HSHLP /LOOP IF MORE TO GO | |
4949 | JMP I HSHSMS /--RETURN-- | |
4950 | ||
4951 | PRIMES, . | |
4952 | 1737 /1 FIELD | |
4953 | 3673 /2 FIELDS | |
4954 | 5633 /3 FIELDS | |
4955 | 7577 /4 FIELDS | |
4956 | 7775 /5 FIELDS (THE LAST MOSTELY WASTE) | |
4957 | BPRIMES=.-1 /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY | |
4958 | 1737 /1 FIELD (MEANS NO BATCH) | |
4959 | 3133 /2 FIELDS | |
4960 | 5075 /3 FIELDS | |
4961 | 7035 /4 FIELDS | |
4962 | 7775 /5 FIELDS (SOME OF WASTE FOR BATCH) | |
4963 | ||
4964 | 1335 /STILL ANOTHER ALTERNATE SET IF KEEPING USR | |
4965 | 3273 | |
4966 | 5237 | |
4967 | 7175 | |
4968 | 7775 | |
4969 | ||
4970 | 0 | |
4971 | 2535 | |
4972 | 4465 | |
4973 | 6437 | |
4974 | 7775 | |
4975 | ||
4976 | PAGE | |
4977 | > | |
4978 | \f/************************************************************** | |
4979 | /PAGE 0 LITERALS | |
4980 | /************************************************************** | |
4981 | IFNZRO HASH< | |
4982 | ||
4983 | /SYMBOL TABLE SORT OVERLAY | |
4984 | /ONLY SWAPPED IF TABLE WILL BE LISTED | |
4985 | ||
4986 | /FIRST, SOME EQUATES | |
4987 | ||
4988 | PPUTTAG= [PUTTAG | |
4989 | PFINDTG= [FINDTG | |
4990 | O1777= [1777 | |
4991 | O7774= [7774 | |
4992 | ||
4993 | SXR= XREG1 | |
4994 | TXR= XREG2 | |
4995 | SXR2= LAST1 | |
4996 | TXR2= LAST2 | |
4997 | UXR= LAST3 | |
4998 | DXR= LAST4 | |
4999 | ||
5000 | BEG= LOC | |
5001 | END= OFFSET | |
5002 | LO= OFSBUF | |
5003 | HI= STARSW | |
5004 | MED= OP | |
5005 | ||
5006 | FIELD 1 /SET THE FIELD NOW | |
5007 | \f *OUDEVH+400 /IT GOES HERE | |
5008 | ||
5009 | SORTAB, 0 /FIRST LOC IN PAGE | |
5010 | TAD TAGMAX | |
5011 | CIA | |
5012 | DCA TEMP /TEMP=#CELLS TO SCAN | |
5013 | ||
5014 | /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT | |
5015 | /OUT WITH EMPTIES AND PERMANENTS | |
5016 | ||
5017 | DCA HIGHTG /TARGET POINTER | |
5018 | DCA TEMP2 /SOURCE POINTER | |
5019 | DEFLP, TAD TEMP2 | |
5020 | DCA THISTG | |
5021 | JMS I PFINDTG /GET THE NEXT STAB CELL | |
5022 | TAD TAG1 | |
5023 | CLL RAL | |
5024 | SNA SZL CLA /AND THERE BUT NOT FIXED? | |
5025 | JMP DEFNUL /NO, DON'T STORE IT | |
5026 | TAD O1777 /YES,DISCARD THE TYPE BITS NOW | |
5027 | AND TAG1 | |
5028 | DCA TAG1 | |
5029 | AC3777 | |
5030 | AND TAG2 | |
5031 | DCA TAG2 | |
5032 | AC3777 | |
5033 | AND TAG3 | |
5034 | DCA TAG3 | |
5035 | TAD HIGHTG | |
5036 | DCA THISTG | |
5037 | JMS I PPUTTAG | |
5038 | ISZ HIGHTG | |
5039 | DEFNUL, ISZ TEMP2 | |
5040 | ISZ TEMP /TRY AGAIN | |
5041 | JMP DEFLP | |
5042 | JMS I (SORT /NOW SORT THEM | |
5043 | JMP I SORTAB /EXIT TO PRTSTAB | |
5044 | \f /MOVE A SYMBOL THRU THE TABLE | |
5045 | ||
5046 | SMOV, 0 | |
5047 | TAD SXR2 /GET SOURCE DF+XREG | |
5048 | JMS GETFLD | |
5049 | DCA SMVCD1 | |
5050 | TAD TXR | |
5051 | DCA SXR | |
5052 | TAD TXR2 | |
5053 | JMS GETFLD | |
5054 | DCA SMVCD2 | |
5055 | TAD O7774 | |
5056 | DCA SSWT | |
5057 | SMVCD1, 0 | |
5058 | TAD I SXR | |
5059 | SMVCD2, 0 | |
5060 | DCA I TXR | |
5061 | ISZ SSWT | |
5062 | JMP SMVCD1 | |
5063 | SMVCD0, CDF | |
5064 | JMP I SMOV | |
5065 | ||
5066 | /AUXILLIARY FIELD+XREG SETTER | |
5067 | ||
5068 | GETFLD, 0 | |
5069 | CLL | |
5070 | TAD I (USROFS /IF KEEPING USR | |
5071 | DCA TXR /AC=SYM NUM | |
5072 | DCA SMVCD2 | |
5073 | TAD TXR | |
5074 | ISZ SMVCD2 | |
5075 | CML | |
5076 | TAD (-1740 | |
5077 | SNL | |
5078 | JMP .-4 | |
5079 | CLL RTL | |
5080 | TAD (-202 /SETS AS IN SETFLD... | |
5081 | DCA TXR /TENTATIVELY SET TXR | |
5082 | TAD SMVCD2 | |
5083 | CLL RTL | |
5084 | RAL | |
5085 | TAD SMVCD0 | |
5086 | JMP I GETFLD /EXIT WITH AC SET TO CDF INSTR | |
5087 | \f /ROUTINE TO EXCHANGE SYMBOLS LO AND HI | |
5088 | ||
5089 | SSWT, 0 | |
5090 | TAD HI | |
5091 | JMS GETFLD | |
5092 | DCA SWCDF1 | |
5093 | TAD SWCDF1 | |
5094 | DCA SWCDF3 | |
5095 | TAD TXR | |
5096 | DCA SXR | |
5097 | TAD SXR | |
5098 | DCA SXR2 /SXR'S FOR HIGH SYMBOL | |
5099 | TAD LO | |
5100 | JMS GETFLD | |
5101 | DCA SWCDF2 | |
5102 | TAD TXR | |
5103 | DCA TXR2 /TXR'S FOR LOW SYMBOL | |
5104 | TAD O7774 | |
5105 | DCA SMOV /COUNTER | |
5106 | ||
5107 | SWCDF1, 0 | |
5108 | TAD I SXR /GET HI SYM WORD | |
5109 | DCA GETFLD /HOLD IT | |
5110 | SWCDF2, 0 | |
5111 | TAD I TXR /GET LO | |
5112 | DCA SCOM /HOLD IT | |
5113 | TAD GETFLD | |
5114 | DCA I TXR2 /STORE HI IN LOW | |
5115 | SWCDF3, 0 | |
5116 | TAD SCOM /NOW STORE LO | |
5117 | DCA I SXR2 /IN HI | |
5118 | ISZ SMOV | |
5119 | JMP SWCDF1+1 | |
5120 | CDF | |
5121 | JMP I SSWT | |
5122 | \f /COMPARE SYMBOLS + SET LINK THEREBY | |
5123 | ||
5124 | SCOM, 0 | |
5125 | DCA THISTG /AC=TAG # | |
5126 | JMS I (SETFLD | |
5127 | TAD I TAGXR | |
5128 | CLL CIA | |
5129 | TAD TAG1 | |
5130 | SZA CLA | |
5131 | JMP SCOMRT | |
5132 | TAD I TAGXR | |
5133 | CLL CIA | |
5134 | TAD TAG2 | |
5135 | SZA CLA | |
5136 | JMP SCOMRT | |
5137 | TAD I TAGXR | |
5138 | CLL CIA | |
5139 | TAD TAG3 | |
5140 | SNA CLA | |
5141 | HLT /NEVER | |
5142 | SCOMRT, CDF | |
5143 | JMP I SCOM | |
5144 | ||
5145 | PAGE | |
5146 | ||
5147 | ||
5148 | ||
5149 | ||
5150 | ||
5151 | ||
5152 | ||
5153 | ||
5154 | \f /SORT ROUTINE HERE | |
5155 | ||
5156 | SORT, 0 | |
5157 | DCA BEG /INITIALIZE PARTITION BOUNDS | |
5158 | STA STL | |
5159 | TAD HIGHTG | |
5160 | DCA END /ARE THERE ANY SYMBOLS? | |
5161 | SZL | |
5162 | JMP I SORT /NO EXIT WITH LINK SET | |
5163 | TAD (LITBF1-1+26 /OK, SET STACK NOW | |
5164 | DCA DXR | |
5165 | TAD DXR | |
5166 | DCA UXR | |
5167 | ||
5168 | SLOOP, STA | |
5169 | TAD LEVEL | |
5170 | DCA LEVEL | |
5171 | SLOOP2, TAD BEG | |
5172 | STL CIA | |
5173 | TAD END | |
5174 | SNA SZL | |
5175 | JMP OKCOOL /END.LOS.BEG | |
5176 | CLL RAR | |
5177 | TAD BEG | |
5178 | DCA MED /MED=BEG+(END-BEG)/2 | |
5179 | TAD MED | |
5180 | DCA THISTG | |
5181 | JMS I PFINDTG /T=A(MED) | |
5182 | TAD BEG | |
5183 | DCA LO /LO=BEG | |
5184 | TAD END | |
5185 | DCA HI /HI=END | |
5186 | TAD MED | |
5187 | CIA | |
5188 | TAD BEG | |
5189 | SNA CLA | |
5190 | JMP JUSTWO /BEG.EQ.MED | |
5191 | \f TAD LO | |
5192 | DCA SXR2 | |
5193 | TAD MED | |
5194 | DCA TXR2 | |
5195 | JMS I (SMOV /A(MED)=A(LO) | |
5196 | BEGLP, ISZ LO | |
5197 | TAD LO | |
5198 | CLL CIA | |
5199 | TAD HI | |
5200 | SNL CLA | |
5201 | JMP DONE /HI.LOS.LO | |
5202 | TAD LO | |
5203 | JMS I (SCOM /T.GT.A(LO) TO LINK | |
5204 | SZL CLA | |
5205 | JMP BEGLP /T.GT.A(LO) | |
5206 | JMP ENDGO /T.LT.A(LO) | |
5207 | ENDLP, TAD LO | |
5208 | CLL CIA | |
5209 | TAD HI | |
5210 | SNL CLA | |
5211 | JMP DONE /IF HI.LO.LO | |
5212 | ENDGO, TAD HI | |
5213 | JMS I (SCOM | |
5214 | SZL CLA | |
5215 | JMP SWITCH | |
5216 | STA | |
5217 | TAD HI | |
5218 | DCA HI | |
5219 | JMP ENDLP | |
5220 | SWITCH, JMS I (SSWT | |
5221 | STA | |
5222 | TAD HI | |
5223 | DCA HI | |
5224 | JMP BEGLP | |
5225 | \fDONE, TAD HI | |
5226 | DCA SXR2 | |
5227 | TAD BEG | |
5228 | DCA TXR2 | |
5229 | JMS I (SMOV /A(BEG)=A(HI) | |
5230 | TAD HI | |
5231 | DCA THISTG | |
5232 | JMS I PPUTTAG /A(HI)=T | |
5233 | AC7776 | |
5234 | TAD UXR | |
5235 | DCA UXR | |
5236 | TAD UXR | |
5237 | DCA DXR | |
5238 | TAD HI | |
5239 | CLL CIA | |
5240 | TAD MED | |
5241 | SZL CLA | |
5242 | JMP HIBIGR /DEFER HIGH FOR LATER | |
5243 | TAD BEG | |
5244 | DCA I DXR /DEFER LO FOR LATER | |
5245 | STA | |
5246 | TAD HI | |
5247 | DCA I DXR | |
5248 | TAD HI | |
5249 | IAC | |
5250 | DCA BEG | |
5251 | JMP SLOOP | |
5252 | HIBIGR, TAD HI | |
5253 | IAC | |
5254 | DCA I DXR | |
5255 | TAD END | |
5256 | DCA I DXR | |
5257 | STA | |
5258 | TAD LEVEL /CLUMSY | |
5259 | DCA LEVEL | |
5260 | CLL STA | |
5261 | TAD HI | |
5262 | DCA END | |
5263 | SNL /PROTECT AGAINST WRAP AROUND | |
5264 | JMP OKCOOL | |
5265 | JMP SLOOP2 | |
5266 | ||
5267 | JUSTWO, TAD HI | |
5268 | JMS I (SCOM | |
5269 | SZL CLA | |
5270 | JMS I (SSWT /SWITCH IF T.GT.A(HI) | |
5271 | OKCOOL, CLA CLL /NOW CONSIDER PREV PARTITIONS | |
5272 | TAD I UXR | |
5273 | DCA BEG | |
5274 | TAD I UXR | |
5275 | DCA END | |
5276 | ISZ LEVEL | |
5277 | JMP SLOOP2 /REITERATE | |
5278 | JMP I SORT /DONE, RETURN WITH A CLEAR LINK | |
5279 | LEVEL, 0 | |
5280 | PAGE | |
5281 | > | |
5282 | \f /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY | |
5283 | /IN THE HEADING | |
5284 | ||
5285 | IFZERO HASH < | |
5286 | FIELD 1 | |
5287 | *OUDEVH+400 | |
5288 | > | |
5289 | ||
5290 | FMTDAT, 0 | |
5291 | TAD I (MDATE /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY | |
5292 | CDF /RUN WITH DF = 0 | |
5293 | SNA | |
5294 | JMP NODATE /EXIT IF NO DATE | |
5295 | DCA DATWD /ELSE STORE DATE WORD | |
5296 | TAD ("0-1 | |
5297 | DCA I DATPTR /SET FIRST DIGIT OF DAY | |
5298 | TAD DATWD /NOW GET DAY BITS | |
5299 | CLL RTR | |
5300 | RAR | |
5301 | AND (37 | |
5302 | JMS DIV10 /DO DAY DIGITS NOW | |
5303 | TAD ("- | |
5304 | DCA I DATPTR /STORE DASH | |
5305 | ISZ DATPTR | |
5306 | TAD DATWD /NOW GET MONTH BITS | |
5307 | TAD (7400 /REDUCE TO ORIGIN 0 | |
5308 | AND (7400 | |
5309 | CLL RTL | |
5310 | RTL | |
5311 | RAL | |
5312 | DCA DIV10 | |
5313 | TAD DIV10 | |
5314 | CLL RAR /GENERATE 1.5*MONTH INDEX | |
5315 | TAD DIV10 | |
5316 | TAD (MONLST /INDEX MONTH LIST (SIXBIT) | |
5317 | DCA MONPTR | |
5318 | TAD (-3 | |
5319 | DCA DIV10 /SET 3 TIMES THRU LOOP | |
5320 | SZL | |
5321 | JMP MONGO /IF EVEN START AT RIGHT HALF | |
5322 | MONLP, TAD I MONPTR | |
5323 | CLL RTR | |
5324 | RTR | |
5325 | RTR | |
5326 | JMS MONPUT /PUT LEFT CHAR | |
5327 | MONGO, TAD I MONPTR | |
5328 | JMS MONPUT /PUT RIGHT CHAR | |
5329 | ISZ MONPTR | |
5330 | JMP MONLP /LOOP FOR MORE | |
5331 | MONPUT, 0 | |
5332 | TAD (40 | |
5333 | AND (77 | |
5334 | TAD (40 /CONVERT TO 7BIT | |
5335 | DCA I DATPTR | |
5336 | ISZ DATPTR | |
5337 | ISZ DIV10 | |
5338 | JMP I MONPUT /RETURN TO UNPACK LOOP | |
5339 | TAD ("- | |
5340 | DCA I DATPTR /PUT ANOTHER DASH | |
5341 | ISZ DATPTR | |
5342 | TAD ("6 | |
5343 | DCA I DATPTR /SETUP YEAR TENS DIGIT FOR DIVIDE | |
5344 | TAD I (BIPCCL | |
5345 | AND (600 /GET YEAR EXTENSION FROM 600 BITS | |
5346 | CLL RTR | |
5347 | RTR | |
5348 | DCA DIV10 | |
5349 | TAD DATWD /NOW GET YEAR | |
5350 | AND (7 /ISOLATE IT | |
5351 | TAD DIV10 /ADD EXTENSION | |
5352 | JMS DIV10 /UNPACK IT | |
5353 | NODATE, CIF CDF /NOW RETURN | |
5354 | JMP I FMTDAT | |
5355 | ||
5356 | DIV10, 0 | |
5357 | ISZ I DATPTR | |
5358 | TAD (-12 | |
5359 | SMA | |
5360 | JMP .-3 /REDUCE MON 10. | |
5361 | TAD (12+"0 | |
5362 | ISZ DATPTR | |
5363 | DCA I DATPTR /STORE LOW DIGIT | |
5364 | ISZ DATPTR | |
5365 | JMP I DIV10 /--RETURN-- | |
5366 | ||
5367 | DATPTR, DATE | |
5368 | DATWD, 0 | |
5369 | MONPTR, 0 | |
5370 | ||
5371 | PAGE | |
5372 | ||
5373 | $$$$$ |