Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /OS8 SABR ASSEMBLER OVERLAY ***SPATCH.07*** |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | // | |
10 | / | |
11 | / | |
12 | / | |
13 | / | |
14 | /COPYRIGHT (C) 1974,1975 | |
15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. | |
16 | / | |
17 | / | |
18 | / | |
19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A | |
20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- | |
21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER | |
22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE | |
23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO | |
24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE | |
25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. | |
26 | / | |
27 | / | |
28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT | |
29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL | |
30 | /EQUIPMRNT COROPATION. | |
31 | / | |
32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS | |
33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. | |
34 | / | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | \f/ | |
41 | /FIXES TO SPATCH FOR V18 J.K. 1975 | |
42 | / | |
43 | / .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER | |
44 | / BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED | |
45 | / TO FROM FORT | |
46 | / .ALLOW TWO PAGE OUTPUT HANDLER | |
47 | / | |
48 | / | |
49 | /SABR ASSEMBLER, LIKE 8K FORTRAN UNDER OS/8, RUNS | |
50 | /IN FIELD 1 WITH ITS TABLES IN FIELD 0. | |
51 | / OCTOBER 26,1971 | |
52 | / | |
53 | /MODIFIED SO THAT SABR WILL, AT RUN TIME, DETERMINE IF THE USER | |
54 | /SPECIFIED I/O DEVICES REQUIRE TWO PAGE HANDLERS, AND IF SO | |
55 | /SABR WILL ALLOCATE SPACE FOR THEM. ALSO IF ALL I/O IS DONE VIA THE | |
56 | /SYSTEM DEVICE, SABR WILL NOT RESERVE ANY SPACE FOR I/O HANDLERS | |
57 | /SPACE FOR TWO PAGE HANDLERS IS MADE BY SHRINKING THE INPUT | |
58 | /BUFFERS-CURRENTLY 4 PAGES-TO 2 PAGES. B.CLOGHER 10/71 | |
59 | / | |
60 | ||
61 | FIELD 0 | |
62 | SDVHND=772 | |
63 | MPARAM=7643 | |
64 | DVHNDL=7647 | |
65 | JSBITS=7746 | |
66 | MOFILE=7600 | |
67 | CORE1=6200 /UPPER CORE LIMIT OF OCCURRENCE TABLE(VARIES WITH I/O HANDLERS NEEDED!!) | |
68 | SABR=201 /SABR V17 FIRST LOC AFTER "JMS I IOINIT" | |
69 | PASS=110 /SABR V17 | |
70 | SERROR=JMS I 177/SABR V17 | |
71 | ERRE=2701 /SABR V17 | |
72 | PRSYMP=41 /SABR V17 | |
73 | TEM1=123 /SABR V17 | |
74 | TEM2=124 /" | |
75 | M4=3704 /" | |
76 | CLOC1=6 /" | |
77 | CLOC2=3162 /" | |
78 | CLOC3=4356 /" | |
79 | CTYPE=23 /" | |
80 | CRLF=24 | |
81 | CHR=61 /" | |
82 | SYMBOL=3 /" | |
83 | LLFS=5364 /" | |
84 | LINE=67 /" | |
85 | L64=4772 /" | |
86 | TYPE=54 /" | |
87 | PUNCH=42 /" | |
88 | INBUF=6200 /6200-7177 OR 6600-7177 | |
89 | PRJ5=4051 | |
90 | PRNOP=4136 | |
91 | PRJ2=4170 | |
92 | PRS2=4025 | |
93 | PRS5=4101 | |
94 | \f *30 /CCL PATCH; GOES HERE AS A HACK | |
95 | CCLKLG, TAD [SKP | |
96 | DCA I [CCLSKP | |
97 | CDF 10 | |
98 | TAD I [7645 | |
99 | SMA CLA | |
100 | JMP I [NOTFRT | |
101 | TAD I [7645 | |
102 | AND P3777 | |
103 | DCA I [7645 | |
104 | CDF | |
105 | JMP I [SETCOR | |
106 | P3777, 3777 | |
107 | ||
108 | *200 /INITIALIZATION - GETS DESTROYED DURING SABR EXECUTION | |
109 | ||
110 | START, ISZ I [FSWITC /SKIPS SINCE FSWITC=-1. ENTRY FROM "R SABR" | |
111 | FSTART, JMP CCLKLG /ENTRY FROM 8K FORTRAN VIA "RUN SABR" MONITOR CALL | |
112 | CLA CMA /USED AS TEM. BY SUBR. DNUM | |
113 | DCA I [FSWITC /USED AS TEM. BY SUBR. DNUM | |
114 | PTEM1, CIF 10 | |
115 | JMS I [7700 /CALL I/O MONITOR | |
116 | 10 /AND ASK IT TO STICK AROUND | |
117 | CIF 10 | |
118 | JMS I [200 | |
119 | 5 /COMMAND DECODE | |
120 | 2302 /.SB ASSUMED EXTENSION | |
121 | NOTFRT, CDF 10 | |
122 | TAD I [MPARAM | |
123 | AND [100 | |
124 | CDF 0 | |
125 | SNA CLA /IS /F SWITCH ON? | |
126 | DCA I [FSWITC /NO - ZERO OUT FSWITC | |
127 | TAD I [JSBITS | |
128 | TAD [1000 | |
129 | DCA I [JSBITS | |
130 | CCLSKP, JMP .+5 | |
131 | SETCOR, ISZ I [FDSW /SET DELETE SWITCH | |
132 | CIF 10 | |
133 | JMS I [7700 /CALL I/O MONITOR--LOCK IT IN | |
134 | 10 | |
135 | CDF 10 | |
136 | TAD I [MOFILE /CHECK FIRST TWO OUT DEV. SPECS.--NEED 2 PAGE HNDLR? | |
137 | OUTL, JMS DNUM | |
138 | JMP OSYS /NO OUTPUT OR SYS DEV. | |
139 | JMP TWOPAG /NEED TWO-PAGE HANDLER | |
140 | DONE, TAD I [MOFILE+5 /1 PAGE HNDLR-LOOK AT 2ND OUT DEV. | |
141 | ISZ CNT /DONE BOTH? | |
142 | JMP OUTL /NO-GO ON | |
143 | CLA /YES- | |
144 | TAD PTEM2 /ARE BOTH OUT DEVS. SYS: OR NOT THERE? | |
145 | SZA CLA /IF SO-ALLOT 0 PAGES FOR OUTPUT HANDLER | |
146 | TAD [-200 /NO-ALLOT 1 PAGE FOR HANDLER | |
147 | DONE1, DCA OPGES /-SIZE OF OUT HANDLER NEEDED | |
148 | INLP, TAD I TEM /NOW LOOP THRU 9 POSSIBLE INPUT SPECS. | |
149 | JMS DNUM | |
150 | JMP ISYS /INPUT NOT THERE OR SYS DEV. | |
151 | JMP TWOPG /TWO PAGE HANDLER NEEDED | |
152 | ILP1, ISZ TEM /ONE-MOVE PTR TO NEXT | |
153 | ISZ TEM | |
154 | ISZ CNT1 /DONE ALL 9? | |
155 | JMP INLP /NO | |
156 | TAD TEM3 /YES-ARE ALL INPUTS FROM SYS OR NOT THERE? | |
157 | SZA CLA /IF SO-DON'T SAVE ROOM FOR INPUT HANDLER | |
158 | TAD [-200 /NO-NEED ONE PAGE FOR HANDLER | |
159 | IDONE, DCA IPGES /STORE AS SIZE OF INPUT HANDLER | |
160 | TAD IPGES | |
161 | TAD OPGES | |
162 | TAD [400 /NEED MORE THAN A TOTAL OF 2 PAGES FOR HANDLERS? | |
163 | CDF 00 /BACK TO DF 0 | |
164 | SMA CLA | |
165 | JMP NOTWO /NO-GO ON | |
166 | DCA I [INREC1 /YES-ADJUST INPUT ROUTINE FOR ONLY 2 PAGE BUFFERS | |
167 | TAD [200 | |
168 | DCA I [INBFPT-1 | |
169 | DCA I [INRD1 | |
170 | DCA I [INRD1+1 | |
171 | TAD [6600 /RESET ADDRESS OF INPUT BUFFER | |
172 | DCA I [INBFPT | |
173 | TAD [400 | |
174 | NOTWO, TAD [6200 /RESET UPPER CORE LIM. OF OCCURRANCE TABLE | |
175 | TAD IPGES | |
176 | TAD OPGES | |
177 | DCA [CORE1 | |
178 | TAD OPGES | |
179 | TAD [200 | |
180 | SPA CLA /MORE THAN ONE PAGE OUT HNDLR NEEDED? | |
181 | IAC /YES | |
182 | TAD OPGES | |
183 | TAD I [INBFPT /ADJUST HANDLER FETCH FOR TWO PAGE HANDLER | |
184 | CDF 10 /BACK TO DATA FIELD 1 | |
185 | DCA I [OUHND | |
186 | CMA /PROPAGATE CHANGES INTO MAIN PART OF SABR | |
187 | TAD [CORE1 | |
188 | DCA I [CLOC1 | |
189 | TAD I [CLOC1 | |
190 | DCA I [CLOC3 | |
191 | TAD [CORE1 | |
192 | DCA I [CLOC2 | |
193 | TAD IPGES | |
194 | TAD [200 | |
195 | SPA CLA /MORE THAN ONE PAGE FOR INPUT HNDLR? | |
196 | IAC /YES-ADJUST IN HNDLR FETCH ROUTINE | |
197 | TAD I [CLOC2 /(CONTAINS START ADDRESS OF CORE FOR IN HNDLR.) | |
198 | CDF 00 | |
199 | DCA I [ADEVN /STORE FOR HNDLR FETCH ROUTINE | |
200 | CDF 10 | |
201 | JMP I [LCHK | |
202 | ISYS, ISZ TEM3 | |
203 | IPGES, 0 | |
204 | JMP ILP1 /INPUT SPEC. NOT THERE OR SYS DEV. | |
205 | TWOPG, TAD [-200 /INPUT SPEC-NEEDS TWO PAGES | |
206 | JMP IDONE-1 | |
207 | TWOPAG, TAD [-200 /OUT HNDLR NEEDS TWO PAGES | |
208 | JMP DONE1-1 | |
209 | OSYS, ISZ PTEM2 /OUT HNDLR NOT NEEDED OR SYS. DEVICE | |
210 | OPGES, 0 | |
211 | JMP DONE | |
212 | / | |
213 | /ROUTINE TO CHECK DEVICE SPECS. LEFT BY COMMAND DECODER AND SEE | |
214 | /IF WE NEED ANY TWO PAGE HANDLERS. ALSO CHECK IF ALL I/O IS FROM | |
215 | /SYS DEVICE IN WHICH WE DON'T HAVE TO SAVE ROOM FOR ANY HANDLERS | |
216 | /RETN. TO CALL + 1 IF DON'T NEED ROOM FOR ANY HANDLER | |
217 | /RETN. TO CALL + 2 IF NEED 2 PAGES FOR HANDLER | |
218 | /RETN. TO CALL + 3 IF NEED 1 PAGE FOR HANDLER | |
219 | / | |
220 | DNUM, 0 | |
221 | AND [17 /MASK DEV. # | |
222 | DCA FSTART+1 /STORE | |
223 | TAD FSTART+1 | |
224 | CLL | |
225 | SNA /ANYTHING THERE? | |
226 | JMP I DNUM /NO-TREAT LIKE SYS. DEV | |
227 | TAD [DVHNDL-1 /CHECK IF THIS HANDLER CO-RESIDENT WITH SYS.(TD8/E--UNIT 1) | |
228 | DCA FSTART+2 | |
229 | TAD I FSTART+2 | |
230 | TAD [200 | |
231 | SZL CLA /IS ENTRY PT. ABOVE 7600?? | |
232 | JMP I DNUM /YES-JUST LIKE SYS DEV. | |
233 | TAD FSTART+1 | |
234 | TAD [SDVHND-1 /NO-PICK UP TABLE WD WHICH TELLS IF 2 PAGE HNDLR. | |
235 | DCA FSTART+2 | |
236 | TAD I FSTART+2 | |
237 | ISZ DNUM /BUMP RETN. | |
238 | SMA CLA /BIT 0=1? I.E. DOES IT NEED TWO PAGES? | |
239 | ISZ DNUM /NO-NORMAL RETN. TO CALL+3--NEED 1 PAGE | |
240 | \f JMP I DNUM /YES-RETN. TO CALL+2--NEED 2 PAGES | |
241 | TEM3, -11 | |
242 | CNT, -2 | |
243 | CNT1, -11 | |
244 | PTEM2, -2 | |
245 | TEM, MOFILE+17 | |
246 | \f*400 | |
247 | LCHK, TAD I [MPARAM+1 | |
248 | AND (4 | |
249 | SNA CLA | |
250 | ISZ STSABR | |
251 | TAD I [MPARAM+1 | |
252 | AND [40 | |
253 | SNA CLA /IF /S IS ON | |
254 | TAD I [MOFILE+5 | |
255 | SZA CLA /OR IF THERE IS NO LISTING OUTPUT FILE | |
256 | JMP NSPEED | |
257 | TAD [PRS5&177+5200 /SPEED UP SYMBOL TABLE SORT | |
258 | DCA I [PRJ5 | |
259 | DCA I [PRNOP | |
260 | DCA I [SYMXX /AND PRINT "U" MESSAGE FOR UNDEFINEDS | |
261 | TAD [PRS2-1&177+5200 | |
262 | DCA I [PRJ2 | |
263 | NSPEED, CDF 10 | |
264 | TAD I [MOFILE+4 /GET EXTENSION OF BINARY OUTPUT | |
265 | SNA /IS IT THERE? | |
266 | TAD [2214 /NO - SET TO .RL | |
267 | DCA I [MOFILE+4 | |
268 | TAD I [MOFILE+11 | |
269 | SNA | |
270 | TAD [1423 /SIMILIARLY SET LISTING EXTENSION TO .LS | |
271 | DCA I [MOFILE+11 | |
272 | DCA I [OUTINH | |
273 | TAD I [MOFILE | |
274 | SNA CLA /BINARY OUTPUT? | |
275 | JMP NOBNOT /NO | |
276 | CDF CIF 10 | |
277 | JMS I [TSTNTR /YES - OPEN IT | |
278 | CDF 10 | |
279 | JMP YESBOT | |
280 | NOBNOT, TAD [MOFILE+1 | |
281 | DCA I [PFILE | |
282 | ISZ I [OUTINH /INHIBIT OUTPUT | |
283 | YESBOT, TAD I [MOFILE+5 | |
284 | CDF 0 | |
285 | SZA CLA | |
286 | DCA I [LSTFLG | |
287 | CDF 10 | |
288 | TAD I [MPARAM | |
289 | AND [41 /"L" OR "G" FLAGS ON? | |
290 | CDF 0 | |
291 | SNA CLA | |
292 | JMP NOLOAD | |
293 | JMS I [MINCOR | |
294 | CLA IAC /DEVICE "SYS" | |
295 | CIF 10 | |
296 | JMS I [200 | |
297 | 2 /LOOKUP | |
298 | ALOAD, LOADER | |
299 | 0 /LENGTH GOES HERE AND IS IGNORED | |
300 | JMP NOLODR /COULDN'T FIND IT | |
301 | TAD ALOAD | |
302 | DCA I [LDRBLK | |
303 | CDF 10 | |
304 | TAD I [OUTREC | |
305 | CDF 0 | |
306 | DCA I [REMEMB | |
307 | NOLOAD, JMS I [OPENFL /OPEN FIRST INPUT FILE WHILE MONITOR STILL IN CORE | |
308 | CDF CIF 10 | |
309 | JMP I .+1 | |
310 | STSABR, SABR /FIRST LOC IN SABR AFTER "INITIAL DIALOGUE" | |
311 | NOLODR, TAD [1200 | |
312 | JMP I [ERROR | |
313 | LOADER, TEXT /LOADERSV/ | |
314 | \f *1100 /FILE OPENER - RESIDES IN PART OF THE OLD SABR INPUT BUFFER | |
315 | O7760, 7760 | |
316 | OPENFL, 0 | |
317 | CDF 10 | |
318 | TAD I FILPTR | |
319 | SNA /IS THERE ANOTHER INPUT FILE? | |
320 | JMP I (ERROR+1 /ERROR - NO END STATEMENT IN PROGRAM | |
321 | DCA OTEMP | |
322 | TAD OTEMP | |
323 | AND (17 /EXTRACT DEVICE NUMBER | |
324 | TAD (DVHNDL-1 | |
325 | DCA OTEMP2 | |
326 | TAD I OTEMP2 | |
327 | DCA OTEMP2 | |
328 | ISZ FILPTR | |
329 | TAD I FILPTR /GET STARTING BLOCK # | |
330 | CDF 0 | |
331 | DCA I (INREC /STORE IT AWAY | |
332 | ISZ FILPTR | |
333 | TAD OTEMP | |
334 | AND (7760 /EXTRACT LENGTH | |
335 | SZA /LENGTH OF 256 IMPLIES MAY BE LARGER | |
336 | TAD (17 | |
337 | CLL CML RTR | |
338 | RTR /GET LENGTH AS A NORMAL NEGATIVE NUMBER | |
339 | DCA I (INCNT /STORE THAT AWAY TOO | |
340 | TAD OTEMP2 | |
341 | SZA | |
342 | JMP GOTIT | |
343 | JMS I (MINCOR /GET MONITOR | |
344 | TAD ADEVN /THIS LOC. SET UP BY INITIALIZATION ROUTINE | |
345 | DCA ADEVNO | |
346 | TAD OTEMP | |
347 | CIF 10 | |
348 | JMS I O200 | |
349 | 1 /ASSIGN | |
350 | ADEVNO, 5600 /FORCE HANDLER INTO PAGE 5600 | |
351 | JMP I (DELERR /GIVE S ERROR | |
352 | TAD ADEVNO | |
353 | GOTIT, DCA I (INDEV | |
354 | JMS I (MOUCOR /GET MONITOR OUT | |
355 | CLA CMA | |
356 | DCA I (INCHCT /FORCE BUFFER LOAD ON FIRST READ | |
357 | JMP I OPENFL | |
358 | OTEMP, 0 | |
359 | OTEMP2, 0 | |
360 | FILPTR, 7617 | |
361 | O200, 200 | |
362 | ADEVN, 0 /SET UP BY INIT. ROUTINE-PAGE ADDR. OF IN HNDLR | |
363 | \f *1600 | |
364 | MINCOR, 0 | |
365 | RDF | |
366 | TAD MINCIF | |
367 | DCA MINXIT | |
368 | MINCIF, CDF CIF 0 | |
369 | CIF 10 | |
370 | JMS I SYSTEM | |
371 | 10 /ESCAPE | |
372 | TAD MIN200 | |
373 | DCA SYSTEM | |
374 | MINXIT, 0 /RESTORE CALLING FIELDS | |
375 | JMP I MINCOR | |
376 | MOUCOR, 0 | |
377 | CDF 0 | |
378 | TAD SYSTEM | |
379 | E7500, SMA | |
380 | CIF 10 | |
381 | MN7700, SMA CLA | |
382 | JMS I SYSTEM | |
383 | 11 /GET OUT | |
384 | TAD MN7700 | |
385 | DCA SYSTEM | |
386 | JMP I MOUCOR | |
387 | SYSTEM, 200 | |
388 | MIN200, 200 | |
389 | ERROR, TAD E7500 /MAKE SABR ERROR "B" | |
390 | DCA MINCOR | |
391 | JMS MOUCOR /KICK MONITOR OUT | |
392 | CDF CIF 10 | |
393 | DCA I EPASS /SET PASS=0 SO ERROR WILL PRINT | |
394 | TAD EL64 | |
395 | DCA I ETYPE | |
396 | TAD MINCOR | |
397 | JMP I .+1 | |
398 | ERRE | |
399 | EPASS, PASS | |
400 | EL64, L64 | |
401 | ETYPE, TYPE | |
402 | \f *7200 | |
403 | SPAUSE, 0 /"PAUSE" STATEMENT PATCH | |
404 | TAD FSWITC | |
405 | CLL RAL | |
406 | TAD I (FILPTR | |
407 | DCA I (FILPTR /RESET FILE POINTER IF CALLED FROM FORTRAN | |
408 | JMS I (OPENFL /OPEN NEXT FILE | |
409 | CDF CIF 10 | |
410 | JMP I SPAUSE | |
411 | FSWITC, -1 /AS ADVERTISED | |
412 | ||
413 | DELETE, TAD I (MPARAM | |
414 | RTR /PUT "K" SWITCH IN LINK | |
415 | D7600, 7600 | |
416 | CDF 0 | |
417 | TAD I (JSBITS | |
418 | RAR | |
419 | CLL CML RAL | |
420 | DCA I (JSBITS /MARK "DON'T CARE IF MONITOR AREA DESTROYED" BITS | |
421 | TAD FDSW | |
422 | SZL SNA CLA /DELETE ONLY IF CALLED FROM FORTRAN WITH | |
423 | JMP NODLET /"K" SWITCH(IN LINK) ZERO | |
424 | JMS I (MINCOR | |
425 | CLA IAC /DEVICE "SYS" | |
426 | CIF 10 | |
427 | JMS I (200 | |
428 | 4 /CLOSE - USED AS DELETE | |
429 | NAME /NAME FOR CLOSE PROCESSOR | |
430 | 0 /NO BLOCKS - WILL BE DELETED | |
431 | JMP DELERR /ERROR | |
432 | NODLET, TAD LDRBLK | |
433 | SNA CLA /WAS A LOADER BLOCK STORED | |
434 | JMP GETOUT | |
435 | CDF 10 | |
436 | TAD I (L64 | |
437 | CDF 0 | |
438 | SZA CLA /IF WE USED THE TELETYPE ROUTINE, | |
439 | JMP GETOUT /THEN THERE WAS AN ERROR | |
440 | TAD REMEMB | |
441 | CDF 10 | |
442 | DCA I (MOFILE+1 | |
443 | CLL CML CLA RAR | |
444 | TAD I (MPARAM+2 | |
445 | DCA I (MPARAM+2 | |
446 | CDF 0 | |
447 | JMS I (MINCOR | |
448 | CIF 10 | |
449 | JMS I (200 | |
450 | 6 /RUN | |
451 | LDRBLK, 0 | |
452 | REMEMB, 0 | |
453 | FDSW, 0 | |
454 | GETOUT, TAD I (SYSTEM | |
455 | CDF 10 | |
456 | D7700, SMA CLA | |
457 | CMA | |
458 | DCA I D7700 | |
459 | CDF 0 | |
460 | JMP I .+1 | |
461 | 7605 | |
462 | DELERR, TAD (1700 /GIVE A "S" ERROR | |
463 | DELER2, TAD (200 | |
464 | CDF CIF 0 | |
465 | JMP I (ERROR | |
466 | NAME, 0617;2224;2216;2415 | |
467 | ||
468 | INREAD, 0 | |
469 | AND D7700 | |
470 | SNA CLA | |
471 | JMS I POPNFL | |
472 | JMS I INDEV | |
473 | 400 /OR 200 IF NEED TWO PAGE HANDLERS-REDUCE BUFFER SIZE TO MAKE ROOM | |
474 | INBFPT, INBUF | |
475 | INREC, 0 | |
476 | JMP INERR | |
477 | ISZ INREAD | |
478 | ISZ INREC | |
479 | INREC1, ISZ INREC /OR 0000 IF TWO PAGE HANDLERS-SINCE IN BUFFER IS 1/2 SIZE | |
480 | JMP I INREAD | |
481 | INDEV, 0 | |
482 | INERR, SPA CLA | |
483 | JMP DELER2 | |
484 | JMP INREC+3 | |
485 | POPNFL, OPENFL | |
486 | ||
487 | CLSMBE, 0 /SUBR TO CLOSE OUTPUT FILE IF ONE EXISTS | |
488 | CDF CIF 10 | |
489 | TAD I (OUTINH | |
490 | SNA CLA | |
491 | JMS I (OUCLOS | |
492 | CIF 0 /IN CASE WE DIDN'T CLOSE IT | |
493 | JMP I CLSMBE | |
494 | \f *7400 /END OF PASS CRAP AND INPUT ROUTINE | |
495 | P40, 40 | |
496 | PASEND, ISZ I (PASS /BUMP PASS COUNTER | |
497 | LSTFLG, JMP SBSYMT /ZERO IF LISTING FILE EXISTS | |
498 | JMS I (CLSMBE /CLOSE BINARY FILE | |
499 | CDF CIF 10 | |
500 | JMS I (TSTNTR /ENTER LISTING FILE | |
501 | TAD I (FSWITC | |
502 | SZA CLA | |
503 | JMP .+4 | |
504 | TAD (7617 | |
505 | DCA I (FILPTR /RESET FILE POINTER TO BEGINNING | |
506 | JMS I (OPENFL /AND OPEN FIRST FILE | |
507 | /IF CALLED FROM FORTRAN WE DONT HAVE TO DO THIS | |
508 | /BECAUSE OF THE PECULIAR NATURE OF FORTRAN OUTPUT | |
509 | JMS I (MOUCOR /KICK MONITOR OUT | |
510 | CDF CIF 10 | |
511 | TAD I (MPARAM+1 | |
512 | P200, AND P40 /MASK OUT "S" SWITCH | |
513 | DCA I (OUTINH /INTO "OUTPUT INHIBIT" FLAG | |
514 | JMS I (SYMPRT /PRINT SYMBOL TABLE UNDER CONTROL OF /S | |
515 | DCA I (OUTINH /ZERO FLAG FOR LISTING | |
516 | TAD I (MPARAM+1 /SYMPRT RETURNS WITH DATA FIELD=10 | |
517 | RTL | |
518 | CIF 10 | |
519 | SNL CLA /"N" FLAG IS IN THE LINK | |
520 | JMP I (ENDRSM /HE WANTS A LISTING - GO GET IT | |
521 | SBREND, CIF 0 | |
522 | JMS I (CLSMBE /CLOSE OUTPUT FILE | |
523 | JMP I (DELETE /DELETE FORTRN.TM AND CHAIN OR RETURN | |
524 | ||
525 | SBSYMT, TAD (TDUMMY | |
526 | CDF CIF 10 | |
527 | DCA I (PUNCH /INHIBIT ALL FUTURE OUTPUT | |
528 | JMS I (SYMPRT /CHECK SYMTAB FOR UNDEFINEDS | |
529 | CDF 0 | |
530 | ISZ I (JSBITS /SET "DON'T CARE ABOUT USR CORE" FLAG | |
531 | JMP SBREND /NOW GO CLOSE BINARY OUTPUT FILE AND RETURN | |
532 | ||
533 | INCHAR, 0 | |
534 | ISZ INJMP | |
535 | KSF | |
536 | JMP .+5 | |
537 | KRS | |
538 | TAD (-203 | |
539 | SNA CLA | |
540 | JMP I (7600 /EXIT TO MONITOR IF ^C TYPED | |
541 | ISZ INCHCT | |
542 | INJMPP, INJMPE | |
543 | TAD INCNT | |
544 | INRD, JMS I (INREAD | |
545 | DCA INCNT /RETURN HERE ON EOF | |
546 | INRD1, ISZ INCNT /SET TO 0000 IF 2 PAGE HANDLERS FORCE INPT. BUFF. TO 1/2 SIZE | |
547 | SKP / " " " | |
548 | TAD (600 | |
549 | ISZ INCNT | |
550 | IN7400, 7400 | |
551 | TAD (-1401 | |
552 | DCA INCHCT | |
553 | TAD INJMPP | |
554 | DCA INJMP | |
555 | TAD I (INBFPT | |
556 | DCA INPTR | |
557 | JMP INCHAR+1 | |
558 | INJMPE=JMP . | |
559 | INJMP, INJMPE | |
560 | JMP INCHA1 | |
561 | JMP INCHA2 | |
562 | INCHA3, TAD INJMPP | |
563 | DCA INJMP | |
564 | TAD I INPTR | |
565 | AND IN7400 | |
566 | CLL RTR | |
567 | RTR | |
568 | TAD INTEMP | |
569 | RTR | |
570 | RTR | |
571 | ISZ INPTR | |
572 | JMP INCOM | |
573 | INCHA2, TAD I INPTR | |
574 | AND IN7400 | |
575 | DCA INTEMP | |
576 | ISZ INPTR | |
577 | INCHA1, TAD I INPTR | |
578 | INCOM, AND (177 | |
579 | SZA | |
580 | TAD (-177 | |
581 | SNA | |
582 | JMP INCHAR+1 | |
583 | TAD (145 /CHECK FOR ^Z | |
584 | SNA | |
585 | JMP INRD /^Z ON INPUT MEANS GO TO NEXT FILE | |
586 | TAD (232 | |
587 | CDF CIF 10 | |
588 | DCA I (CHR | |
589 | JMP I INCHAR | |
590 | INPTR, 0 | |
591 | INCHCT, 0 | |
592 | INTEMP, 0 | |
593 | INCNT, 0 | |
594 | FIELD 1 | |
595 | \f *6400 /OUTPUT ROUTINE INTERFACE - CANT GO PAST 6423 | |
596 | OUCHAR, 0 | |
597 | DCA I POUTEM | |
598 | TAD OUTINH | |
599 | SZA CLA | |
600 | OUCRET, JMP I OUCHAR /DOUBLES AS OFF-PAGE RETURN | |
601 | ISZ I POUJMP | |
602 | ISZ OUCHCT | |
603 | JMP I POUJMX | |
604 | JMS OUTDMP | |
605 | JMP OUCHAR+2 | |
606 | POUJMP, OUJMP | |
607 | POUJMX, OUJMX | |
608 | POUTEM, OUTEMP | |
609 | OUTINH, 0 | |
610 | F3ERR, TAD O2100 | |
611 | F2ERR, TAD O2100 | |
612 | F1ERR, CDF CIF 0 | |
613 | JMP I .+1 | |
614 | ERROR | |
615 | O2100, 2100 | |
616 | *6457 /LOADS OVER OLD SABR INITIALIZATION ROUTINE | |
617 | TSTNTR, 0 /CALLED FROM FIELD 0 | |
618 | TAD PFILE | |
619 | TAD C4 | |
620 | DCA PFILE | |
621 | TAD I PFILE | |
622 | ISZ PFILE | |
623 | DCA ODEVNO | |
624 | TAD OUHND /THIS LOC. IS SET UP AT INIT. TIME | |
625 | DCA OUHNDL | |
626 | CIF 0 | |
627 | JMS I (MINCOR | |
628 | JMS I (200 | |
629 | 13 /RESET OUTPUT DEVICE | |
630 | TAD ODEVNO /LOAD OUTPUT DEVICE | |
631 | JMS I (200 | |
632 | 1 | |
633 | OUHNDL, 7400 | |
634 | JMP F2ERR | |
635 | TAD PFILE | |
636 | DCA ENAME /POINTS TO FILE NAME | |
637 | DCA OULNGT /ZERO CLOSING LENGTH | |
638 | TAD ODEVNO /LOAD DEVICE NUMBER AND REQUESTED LENGTH | |
639 | JMS I (200 | |
640 | 3 /ENTER | |
641 | ENAME, 0 /POINTER INTO COMMAND DECODER AREA GOES HERE | |
642 | OUCHCT=ENAME | |
643 | ELENGT, 0 /"0 LENGTH" MEANS AS LARGE A SPACE AS POSSIBLE | |
644 | JMP F2ERR /COULDN'T ENTER FILE - MAYBE BAD DIRECTORY | |
645 | TAD ENAME /GET STARTING BLOCK # | |
646 | DCA OUTREC /STORE IT AWAY | |
647 | JMS OUSPTR /INITIALIZE OUTPUT ROUTINE | |
648 | ENTRTN, CDF CIF 0 | |
649 | JMP I TSTNTR | |
650 | OUSPTR, 0 | |
651 | TAD POUBUF | |
652 | DCA I (OUPTR | |
653 | TAD (-601 | |
654 | DCA OUCHCT | |
655 | TAD (OUJMPE | |
656 | DCA I POUJMP | |
657 | JMP I OUSPTR | |
658 | OUTDMP, 0 | |
659 | CIF 0 | |
660 | JMS I OUHNDL | |
661 | 4200 | |
662 | POUBUF, 1200 /REMAINDER OF OLD SABR INPUT BUFFER | |
663 | OUTREC, 0 | |
664 | JMP F3ERR | |
665 | ISZ OUTREC | |
666 | JMS OUSPTR | |
667 | ISZ OULNGT | |
668 | ISZ ELENGT | |
669 | JMP I OUTDMP | |
670 | JMP F2ERR | |
671 | OUCLOS, 0 | |
672 | TAD OUT232 /PUT A ^Z IN THE OUTPUT FILE | |
673 | JMS OUCHAR | |
674 | TAD OUCHCT | |
675 | CMA | |
676 | SZA CLA | |
677 | JMP .-4 /FILL REMAINDER OF BUFFER WITH ZEROS | |
678 | JMS OUTDMP | |
679 | CIF 0 | |
680 | JMS I (MINCOR | |
681 | TAD ODEVNO | |
682 | JMS I (200 | |
683 | C4, 4 /CLOSE | |
684 | PFILE, 7574 | |
685 | OULNGT, 0 | |
686 | JMP F2ERR /ERROR ON CLOSE | |
687 | DCA OULNGT | |
688 | CIF 0 | |
689 | JMP I OUCLOS | |
690 | OUT232, 232 | |
691 | ODEVNO, 0 | |
692 | OUHND, 0 /SET UP AT INIT. TIME TO ALLOW 2 PAGE HNDLR | |
693 | /IF NEEDED | |
694 | *6610 /OUTPUT ROUTINE - CANT GO PAST 6661 | |
695 | OUJMX, CDF 0 | |
696 | OUJMPE=JMP . | |
697 | OUJMP, OUJMPE | |
698 | JMP OUCHA1 | |
699 | JMP OUCHA2 | |
700 | OUCHA3, TAD OUTEMP | |
701 | RTL | |
702 | RTL | |
703 | DCA OUTEMP | |
704 | TAD OUJMPP | |
705 | DCA OUJMP | |
706 | TAD OUTEMP | |
707 | AND OU7400 | |
708 | TAD I OUPOLD | |
709 | DCA I OUPOLD | |
710 | TAD OUTEMP | |
711 | RTL | |
712 | RTL | |
713 | AND OU7400 | |
714 | TAD I OUPTR | |
715 | DCA I OUPTR | |
716 | ISZ OUPTR | |
717 | JMP OUCOM | |
718 | OUCHA2, TAD OUPTR | |
719 | DCA OUPOLD | |
720 | ISZ OUPTR | |
721 | OUCHA1, TAD OUTEMP | |
722 | AND OU377 | |
723 | DCA I OUPTR | |
724 | OUCOM, CDF 10 | |
725 | JMP I .+1 | |
726 | OUCRET | |
727 | OUPTR, 0 | |
728 | OUJMPP, OUJMPE | |
729 | OUPOLD, 0 | |
730 | OUTEMP, 0 | |
731 | OU7400, 7400 | |
732 | OU377, 377 | |
733 | \f /PATCHES TO SABR TO HOOK INTO THESE WONDERFUL ROUTINES | |
734 | *4574 /OLD "INITR" ROUTINE AREA - 4 LOCATIONS LONG | |
735 | SYMPRT, 0 /INTERMEDIATE ROUTINE TO PRINT SYMBOL TABLE | |
736 | JMS I PRSYMP /CALL SABR'S ROUTINE | |
737 | CIF 0 | |
738 | JMP I SYMPRT /BUT RETURN TO FIELD 0 | |
739 | ||
740 | *4641 /CODE IN THIS SECTION CAN'T GO PAST 4704 | |
741 | FETCH, 0 /REPLACES ROUTINE IN SABR OF SAME NAME | |
742 | CDF CIF 0 | |
743 | JMS I .+2 | |
744 | JMP I FETCH | |
745 | INCHAR | |
746 | ||
747 | LDRCT, 7700 /FOR LEADER-TRAILER ROUTINE ON SAME PAGE | |
748 | ||
749 | USYMFG, 0 /ROUTINE TO GIVE UNDEFINED SYMBOL MESSAGES WHEN | |
750 | JMS I CTYPE /NO SYMBOL TABLE IS REQUESTED | |
751 | SYMXX, JMP I USYMFG /ZEROED IF CHECKING FOR UNDEFINEDS | |
752 | TAD SYMBOL | |
753 | DCA I PLLFS /SET UP SABR CELLS SO THAT ERROR ROUTINE WILL | |
754 | DCA LINE /PRINT THE NAME OF THE UNDEFINED SYMBOL | |
755 | TAD U2300 /FUDGE FOR "U" ERROR MESSAGE - UNFORTUNATELY, | |
756 | JMP I .+1 /THIS MESSAGE IS INSTANTLY FATAL - SERVES HIM RIGHT | |
757 | F1ERR | |
758 | PLLFS, LLFS /RANDOM LOCATION IN SABR | |
759 | U2300, 2300 | |
760 | ||
761 | TDUMMY, 0 /DUMMY OUTPUT ROUTINE | |
762 | CLA | |
763 | JMP I TDUMMY /AS DUMMY AS YOU CAN GET | |
764 | ||
765 | *6133 /PATCH TO SYMBOL TABLE PRINTER TO USE ABOVE | |
766 | JMS I 6177 /THIS REPLACES A "JMS I CTYPE" | |
767 | *6177 | |
768 | USYMFG /LUCKILY THERE WAS A LOCATION FREE | |
769 | ||
770 | *3665 /REWRITE OF OCTAL TYPEOUT ROUTINE TO | |
771 | DCA TEM1 /NOT KEEP INFORMATION IN THE LINK ACROSS | |
772 | TAD M4 /A CALL TO THE OUTPUT ROUTINE | |
773 | DCA TEM2 | |
774 | L62A, TAD TEM1 | |
775 | RTL | |
776 | RAL | |
777 | DCA TEM1 | |
778 | TAD TEM1 | |
779 | RAL | |
780 | *3702 | |
781 | JMP L62A | |
782 | ||
783 | *4317 /"PAUSE" PROCESSOR | |
784 | CLA /REPLACES CLA HLT | |
785 | CDF CIF 0 | |
786 | ||
787 | *4332 /PATCHES TO INITIALIZATION ROUTINE | |
788 | NOP /DON'T GIVE | |
789 | NOP /TWO USELESS CARRIAGE RETURN - LINE FEED PAIRS | |
790 | ||
791 | *4341 | |
792 | NOP /DON'T JMS I 4372 'CAUSE WE HAVE CHANGED 4372! | |
793 | ||
794 | *4372 /MORE "PAUSE" FUDGE | |
795 | SPAUSE | |
796 | ||
797 | *4715 /ALTER COUNT ON LEADER-TRAILER | |
798 | TAD LDRCT | |
799 | ||
800 | *561 /"END" STMT PROCESSOR | |
801 | CIF 0 | |
802 | JMP I PEND /END OF PASS 1 | |
803 | ENDRSM=. | |
804 | ||
805 | *565 /MORE ON "END" | |
806 | NOP /ELIMINATE HALT AT END OF PASS 1 | |
807 | ||
808 | *570 /STILL MORE ON "END" | |
809 | CDF CIF 0 | |
810 | JMP I SEND /END OF PASS 2 | |
811 | ||
812 | *576 /THERE ARE (WERE) TWO WHOLE FREE LOCATIONS IN THIS PAGE! | |
813 | SEND, SBREND | |
814 | PEND, PASEND | |
815 | ||
816 | *2761 /FATAL ERROR HALT IN ERROR ROUTINE | |
817 | CDF CIF 0 | |
818 | JMP I 166 /166 = LITERAL 7600 | |
819 | ||
820 | *4003 /LISTING ROUTINE | |
821 | SKP CLA /ALWAYS PUT LISTING ON "PUNCH" | |
822 | ||
823 | *PUNCH /POINTER TO PUNCH ROUTINE | |
824 | OUCHAR /POINTER TO MY PUNCH ROUTINE | |
825 | / | |
826 | *200 | |
827 | VERNUM | |
828 | JMS I .-1 | |
829 | / | |
830 | *7000 | |
831 | VERNUM, 0 | |
832 | JMS I CRLF | |
833 | TAD I POINT | |
834 | JMS I CTYPE | |
835 | ISZ POINT | |
836 | ISZ COUNT | |
837 | JMP .-4 | |
838 | JMS I CRLF | |
839 | DCA I TYPE | |
840 | JMP I VERNUM | |
841 | / | |
842 | POINT, TITLE | |
843 | COUNT, -5 | |
844 | TITLE, TEXT /SABR V18A / | |
845 | $ | |
846 | \f | |
847 | \r\f |