Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /OS8 FORTRAN II COMPILER OVERLAY V5 ***FPATCH.05*** |
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 FPATCH FOR V4 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 FORM FORT INSTEAD OF WHOLE WORD | |
46 | / | |
47 | / .VERSION NUMBER VIA /V--OPTION | |
48 | / WILL BE PASSED ONTO SABR | |
49 | / | |
50 | / | |
51 | / | |
52 | FIELD 0 | |
53 | JSBITS=7746 | |
54 | MOFILE=7600 | |
55 | MPARAM=7643 | |
56 | LLUNCH=7001 /TAKE OUT WHEN MERGING WITH COMPILER | |
57 | DO=7173 /" | |
58 | ELIST=1162 /" | |
59 | EMSG1=1270 /" | |
60 | EMSG14=1520 /" | |
61 | FLST=242 /" | |
62 | FORST=5362 /" | |
63 | FPROP=144 /" | |
64 | GOOON=5455 /" | |
65 | KOUNT=113 /" | |
66 | LPTRIN=545 /" | |
67 | LPUNCH=5333 /" | |
68 | LTTYPE=3372 /" | |
69 | L75=75 /" | |
70 | OSTOP=4052 /" | |
71 | XFINI=5354 /" | |
72 | \f *200 | |
73 | START, CLA CMA | |
74 | DCA FCHFLG | |
75 | CIF 10 | |
76 | JMS I (7700 | |
77 | 10 /ESCAPE | |
78 | ISZ FCHFLG | |
79 | JMP .+5 | |
80 | CIF 10 | |
81 | JMS I (200 | |
82 | 5 /COMMAND DECODE | |
83 | 0624 /.FT ASSUMED EXTENSION | |
84 | CDF 10 | |
85 | TAD I (MPARAM+1 | |
86 | CDF 0 | |
87 | AND (4 | |
88 | SZA CLA | |
89 | JMS VERNUM | |
90 | CLA IAC | |
91 | CIF 10 | |
92 | JMS I (200 | |
93 | 4 /CLOSE OPERATOR USED AS DELETE | |
94 | OUSNAME /DELETE FORTRN.TM IF IT EXISTS | |
95 | 0 | |
96 | CLA /IT DIDN'T EXIST | |
97 | CLA IAC /ENTER A FILE ON "SYS" - MAXIMUM SIZE | |
98 | CIF 10 | |
99 | JMS I (200 | |
100 | 3 /ENTER | |
101 | OUSREC, OUSNAME | |
102 | HOLSIZ, 0 | |
103 | JMP I (OUERR /WHATS GOING ON HERE? | |
104 | CLA IAC /DEVICE "SYS" | |
105 | CIF 10 | |
106 | JMS I (200 | |
107 | 2 | |
108 | PTSABR, SABR | |
109 | FCHFLG, 0 /USELESS LENGTH WORD | |
110 | JMP I (BIGGIE | |
111 | TAD PTSABR | |
112 | DCA I (CLSABR | |
113 | TAD OUSREC | |
114 | DCA I (OUTREC | |
115 | TAD HOLSIZ | |
116 | DCA I (OURCNT | |
117 | TAD (1000 | |
118 | TAD I (JSBITS | |
119 | DCA I (JSBITS /SET "UNSTARTABLE" STATUS BIT | |
120 | JMS I (FNEWF /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE | |
121 | CDF 10 | |
122 | TAD OUSREC | |
123 | DCA I (7620 | |
124 | CLA IAC | |
125 | DCA I (7617 | |
126 | CLA CLL CML RTL | |
127 | AND I (MPARAM | |
128 | TAD I (MOFILE+5 | |
129 | SNA CLA | |
130 | DCA I (FLST | |
131 | TAD I (7600 | |
132 | SNA CLA | |
133 | TAD I (MPARAM | |
134 | AND (41 | |
135 | SNA CLA /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A | |
136 | JMP FCDF0-3 /RELOCATABLE OUTPUT FILE? | |
137 | FTADNM, TAD BDFALT /YES - GIVE HIM ONE | |
138 | DCA I B7600 /NAMED "FORTRL.TM" | |
139 | ISZ FTADNM | |
140 | ISZ B7600 | |
141 | ISZ B7773 | |
142 | JMP FTADNM | |
143 | CLA CLL CML RAR | |
144 | TAD I (7645 | |
145 | DCA I (7645 /SABR IT WAS CHAINED TO BY FORT | |
146 | FCDF0, CDF 0 | |
147 | JMP I (1003 /START COMPILATION | |
148 | ||
149 | BDFALT, 1 /DEVICE "SYS" | |
150 | TEXT /FORTRLTM/ | |
151 | B7600, 7600 | |
152 | B7773, 7773 | |
153 | / | |
154 | VERNUM, 0 | |
155 | TAD I POINT | |
156 | CDF CIF 10 | |
157 | JMS I VPRINT | |
158 | ISZ POINT | |
159 | ISZ COUNT | |
160 | JMP .-5 | |
161 | JMP I VERNUM | |
162 | / | |
163 | POINT, VERN | |
164 | COUNT, -12 | |
165 | VERN, 306 | |
166 | 317 | |
167 | 322 | |
168 | 324 | |
169 | 240 | |
170 | 326 | |
171 | 265 | |
172 | 301 | |
173 | 215 | |
174 | 212 | |
175 | / | |
176 | VPRINT, VERPRT | |
177 | ||
178 | \f /ADDITIONS TO FORTRAN ERROR MESSAGES | |
179 | ||
180 | *ELIST+1 | |
181 | NUMSG1 | |
182 | *EMSG1-2 | |
183 | -ERR61-1; EMSG15 | |
184 | -ERR62-1; EMSG16 | |
185 | -ERR63-1; EMSG17 | |
186 | -ERR64-1; EMSG20 | |
187 | 0 ; EMSG14 | |
188 | /DUMMY PAGES TO CONSOLIDATE CORE IMAGE | |
189 | *1600 | |
190 | 0 | |
191 | *2000 | |
192 | 0 | |
193 | *2400 | |
194 | 0 | |
195 | *3000 | |
196 | 0 | |
197 | *5600 | |
198 | 0 | |
199 | \f *5400 | |
200 | FNEWF, 0 | |
201 | CDF 10 | |
202 | TAD I FILPTR | |
203 | SNA | |
204 | JMP EOFERR /END OF INPUT REACHED BEFORE END STATEMENT | |
205 | DCA INWCNT | |
206 | TAD I FILPTR | |
207 | AND (7760 | |
208 | SZA | |
209 | TAD (17 | |
210 | CLL CML RTR | |
211 | RTR | |
212 | DCA INRCNT | |
213 | ISZ FILPTR | |
214 | TAD I FILPTR | |
215 | DCA INREC | |
216 | ISZ FILPTR | |
217 | TAD (5001 /FORTRAN ALLOWS TWO-PAGE HANDLERS | |
218 | DCA INHNDL | |
219 | TAD INWCNT | |
220 | CDF 0 | |
221 | CIF 10 | |
222 | JMS I (200 | |
223 | 1 /ASSIGN AND FETCH HANDLER | |
224 | INHNDL, 5000 /LOCATIONS 5000-5377 ARE FREE | |
225 | JMP IOERR /SOMETHINGS SCREWY | |
226 | CLA CMA | |
227 | DCA INWCNT | |
228 | DCA INEOF | |
229 | JMS MOUCOR | |
230 | JMP I FNEWF | |
231 | FILPTR, 7617 | |
232 | GETCH, 0 | |
233 | KSF | |
234 | JMP .+5 | |
235 | KRS | |
236 | TAD (-203 | |
237 | SNA CLA | |
238 | JMP I (7600 | |
239 | ISZ JMPGET | |
240 | ISZ INWCNT | |
241 | JMPG, JMP JMPGET | |
242 | TAD INEOF | |
243 | SNA CLA | |
244 | JMP JUSTRD | |
245 | GETNXT, CIF 10 | |
246 | JMS I G7700 | |
247 | 10 /ESCAPE | |
248 | JMS FNEWF | |
249 | JUSTRD, JMS I INHNDL /INHNDL CONTAINS LOCN OF DEVICE HANDLER | |
250 | 0200 /READ 2 HALF-RECORDS INTO FIELD 0 | |
251 | INBFPT, INBUF | |
252 | INREC, 0 | |
253 | JMP RERROR | |
254 | ISZ INREC | |
255 | ISZ INRCNT | |
256 | SKP | |
257 | ENDFIL, ISZ INEOF | |
258 | TAD (-601 | |
259 | DCA INWCNT | |
260 | TAD JMPG | |
261 | DCA JMPGET | |
262 | TAD INBFPT | |
263 | DCA INPTR | |
264 | JMP GETCH+1 | |
265 | JMPGET, JMP . | |
266 | JMP INCHR1 | |
267 | JMP INCHR2 | |
268 | INCHR3, TAD JMPG | |
269 | DCA JMPGET | |
270 | TAD I INPTR | |
271 | AND (7400 | |
272 | CLL RTR | |
273 | RTR | |
274 | TAD INTMP | |
275 | RTR | |
276 | RTR | |
277 | ISZ INPTR | |
278 | JMP GCHCOM | |
279 | INCHR2, TAD I INPTR | |
280 | AND (7400 | |
281 | DCA INTMP | |
282 | ISZ INPTR | |
283 | INCHR1, TAD I INPTR | |
284 | GCHCOM, AND (377 | |
285 | TAD (-232 | |
286 | SNA | |
287 | JMP GETNXT | |
288 | TAD (232 | |
289 | CIF 10 | |
290 | ISZ GETCH | |
291 | JMP I GETCH | |
292 | RERROR, SMA CLA | |
293 | G7700=RERROR | |
294 | JMP ENDFIL | |
295 | IOERR, JMS I (SFATAL | |
296 | CIF 10 | |
297 | ERR62, JMS I (LLUNCH | |
298 | INPTR, 0 | |
299 | INWCNT, 0 | |
300 | INTMP, 0 | |
301 | INRCNT, 0 | |
302 | INEOF, 0 | |
303 | EOFERR, JMS MOUCOR /KICK MONITOR OUT | |
304 | JMS I (SFATAL | |
305 | CIF 10 | |
306 | ERR61, JMS I (LLUNCH | |
307 | MOUCOR, 0 | |
308 | CDF 0 | |
309 | CIF 10 | |
310 | JMS I (200 | |
311 | 11 | |
312 | JMP I MOUCOR | |
313 | \f *3200 | |
314 | P377, 377 | |
315 | P7400, 7400 /WARNING ***DO NOT MOVE THIS*** | |
316 | ||
317 | PUTCH, 0 | |
318 | DCA PUTMP | |
319 | RAL | |
320 | DCA PUTLNK | |
321 | PUTCHX, ISZ JMPPUT | |
322 | ISZ OUWDCT | |
323 | JMPP, JMP JMPPUT | |
324 | CLA CLL CML RTL | |
325 | TAD OURCNT | |
326 | SZL | |
327 | JMP OUERR+1 | |
328 | DCA OURCNT | |
329 | ISZ CLOSCT | |
330 | ISZ CLOSCT | |
331 | JMS I (7607 | |
332 | 4400 | |
333 | OUBFPT, OUBUF | |
334 | OUTREC, 0 | |
335 | JMP I (IOERR | |
336 | ISZ OUTREC | |
337 | ISZ OUTREC | |
338 | TAD (-1401 | |
339 | DCA OUWDCT | |
340 | TAD OUBFPT | |
341 | DCA OUPTR | |
342 | TAD JMPP | |
343 | DCA JMPPUT | |
344 | JMP PUTCHX | |
345 | JMPPUT, JMP . | |
346 | JMP PUTCH1 | |
347 | JMP PUTCH2 | |
348 | PUTCH3, TAD PUTMP | |
349 | RTL | |
350 | RTL | |
351 | DCA PUTMP | |
352 | TAD JMPP | |
353 | DCA JMPPUT | |
354 | TAD PUTMP | |
355 | AND P7400 | |
356 | TAD I OUPOLD | |
357 | DCA I OUPOLD | |
358 | TAD PUTMP | |
359 | RTL | |
360 | RTL | |
361 | P201, AND P7400 | |
362 | TAD I OUPTR | |
363 | DCA I OUPTR | |
364 | ISZ OUPTR | |
365 | JMP PCHCOM | |
366 | PUTCH2, TAD OUPTR | |
367 | DCA OUPOLD | |
368 | ISZ OUPTR | |
369 | PUTCH1, TAD PUTMP | |
370 | P200, AND P377 | |
371 | DCA I OUPTR | |
372 | PCHCOM, CIF 10 | |
373 | TAD PUTLNK | |
374 | CLL RAR | |
375 | JMP I PUTCH | |
376 | ||
377 | EOFORT, SZA CLA /ANY ERRORS? | |
378 | JMP I SF7600 /YES, DO NOT ASSEMBLE | |
379 | DCA PCHCOM | |
380 | TAD (232 | |
381 | JMS PUTCH | |
382 | TAD OUWDCT | |
383 | TAD (1400 | |
384 | SZA CLA | |
385 | JMP .-5 /FILL BUFFER WITH ^Z | |
386 | TAD I (JSBITS | |
387 | RAR | |
388 | CLL CML RAL | |
389 | DCA I (JSBITS /NO NEED TO SAVE CORE ON THIS MONITOR CALL | |
390 | CIF 10 | |
391 | JMS I (7700 | |
392 | 10 /ESCAPE | |
393 | CLA IAC /DEVICE "SYS" | |
394 | CIF 10 | |
395 | JMS I P200 | |
396 | 4 /CLOSE | |
397 | OUSNAM | |
398 | CLOSCT, 0 /CLOSING LENGTH | |
399 | JMP OUERR-3 | |
400 | CIF 10 | |
401 | JMS I P200 | |
402 | 6 /RUN | |
403 | CLSABR, 0 | |
404 | BIGGIE, JMS I (MOUCOR | |
405 | JMS SFATAL | |
406 | CIF 10 | |
407 | ERR63, JMS I (LLUNCH | |
408 | CLA CLL CMA RTL | |
409 | AND I (JSBITS | |
410 | DCA I (JSBITS /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL | |
411 | OUERR, JMS I (MOUCOR | |
412 | JMS SFATAL | |
413 | CIF 10 | |
414 | ERR64, JMS I (LLUNCH | |
415 | INBUF=1600 | |
416 | OUBUF=3600 | |
417 | OURCNT, 0 | |
418 | OUPTR, OUBUF | |
419 | OUWDCT, -1401 | |
420 | PUTMP, 0 | |
421 | OUPOLD, 0 | |
422 | SFATAL, 0 | |
423 | PUTLNK=SFATAL | |
424 | SF7600, 7600 /CLEAR AC | |
425 | CDF 10 | |
426 | TAD SCDIF0 | |
427 | DCA I (177 | |
428 | TAD (5601 | |
429 | DCA I P200 | |
430 | TAD SF7600 | |
431 | DCA I P201 | |
432 | SCDIF0, CDF CIF 0 | |
433 | JMP I SFATAL | |
434 | \f *2200 /CANNOT GO PAST 2373 | |
435 | SABR, TEXT /SABR/ | |
436 | TEXT /SV/ | |
437 | OUSNAM, TEXT /FORTRNTM/ | |
438 | NUMSG1, TEXT /ILLEGAL CONTINUATION/ | |
439 | EMSG15, TEXT /NO END STATEMENT/ | |
440 | EMSG16, TEXT #I/O ERROR# | |
441 | EMSG17, TEXT /SABR.SV NOT FOUND/ | |
442 | EMSG20, TEXT /NO ROOM FOR OUTPUT/ | |
443 | \f FIELD 1 | |
444 | /THESE ARE THE PATCHES OVER THE COMPILER. | |
445 | ||
446 | ||
447 | *FORST /HEADER PRINTER | |
448 | NOP | |
449 | NOP | |
450 | NOP | |
451 | ||
452 | *FORST+5 /LEADER OUTPUT | |
453 | CLA CLL CMA RTL /3 CHARACTERS OF LEADER | |
454 | ||
455 | *LPTRIN+1 /HIGH-SPEED READER ROUTINE | |
456 | CIF 0 | |
457 | JMS I .+1 | |
458 | GETCH | |
459 | ||
460 | *OSTOP+1 | |
461 | JMS I FPROP /PUNCH 'CALL 0,EXIT' | |
462 | 6253 | |
463 | JMP I OSTOP | |
464 | ||
465 | *LPUNCH+1 /PUNCH ROUTINE | |
466 | CIF 0 | |
467 | JMS I .+2 | |
468 | CLA SKP | |
469 | PUTCH | |
470 | ||
471 | *XFINI-3 /TRAILER PRINTER | |
472 | CLA CLL CMA RTL /3 CHARACTERS OF TRAILER | |
473 | ||
474 | *XFINI-1 /ENDING SEQUENCE | |
475 | CDF CIF 0 | |
476 | TAD L75 /PICK UP ERROR FLAG | |
477 | JMP I .+1 | |
478 | EOFORT | |
479 | ||
480 | *GOOON+4 /TRAILER AFTER "END" STATEMENT | |
481 | CLA CLL CMA RTL /3 CHARS ETC. | |
482 | ||
483 | ||
484 | *LTTYPE+1 /REVERSE TTY WAIT MODE | |
485 | TLS | |
486 | TSF | |
487 | JMP .-1 | |
488 | ||
489 | / | |
490 | *4753 | |
491 | VERPRT, 0 | |
492 | JMS I VPUNCH | |
493 | CDF CIF 0 | |
494 | JMP I VERPRT | |
495 | VPUNCH, 3372 | |
496 | / | |
497 | $ | |
498 | \f |