Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | /3 OS/8 FORTRAN (PASS THREE) |
2 | / | |
3 | / VERSION 4A PT 16-MAY-77 | |
4 | / | |
5 | / OS/8 FORTRAN IV COMPILER-PASS 3 | |
6 | / | |
7 | / BY: HANK MAURER | |
8 | / UPDATED BY: R. LARY + M. HURLEY | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 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 | VERSON=4 | |
39 | \f/ PAGE ZERO STUFF | |
40 | OUDEVH=7000 /PUT OUDEVH AND OUBUF IN DIFFERENT | |
41 | INDEVH=6400 | |
42 | INBUF=6000 | |
43 | OUBUF=5400 /SEGMENTS, STAN KNOWS WHY | |
44 | X10=10 | |
45 | X11=11 | |
46 | X12=12 | |
47 | NCHARS=20 | |
48 | CHAR=21 | |
49 | TEMP=22 | |
50 | FILDEV=6 | |
51 | FILBLK=7 | |
52 | DEV1CE=173 /THROUGH 177 | |
53 | DEVH=23 | |
54 | LINENO=24 | |
55 | SEVCHR=25 /THROUGH 33 | |
56 | ||
57 | ||
58 | / OS/8 V3C MAINTENANCE RELEASE FIXES: | |
59 | ||
60 | /1. EXTENDED RANGE OF PAGE NUMBERS TO 99 | |
61 | /2 INTERCHANGED CR/LF FOR HASSINGER | |
62 | /3 CHANGED VERSION NO. TO 305 | |
63 | /5. ADDED 'I' TO JMP (OFOO3 | |
64 | / | |
65 | / | |
66 | / CHANGES FOR OS/8 V3D AND OS/78 BY P.T. | |
67 | / .CHANGED VERSION NUMBER TO 4A | |
68 | / .PUT IN NEW DATE ALGORITHM | |
69 | / | |
70 | / | |
71 | \f/START OF PASS 3 | |
72 | *400 /DON'T LOAD INTO 0-377 | |
73 | SPASS3, CDF 10 | |
74 | TAD I (7666 /GET DATE | |
75 | DCA TEMP | |
76 | TAD I LSTFIL /COPY FILE NAME | |
77 | CDF | |
78 | DCA I FILLST | |
79 | ISZ LSTFIL | |
80 | ISZ FILLST | |
81 | ISZ OFSIZE | |
82 | JMP SPASS3 | |
83 | TAD DEV1CE /FETCH HANDLER FOR OUTPUT FILE | |
84 | CIF 10 | |
85 | JMS I (200 /USR IS IN CORE | |
86 | 1 | |
87 | OH, OUDEVH+1 /TWO PAGE HANDLER IS OK | |
88 | JMP I (OFOO3 | |
89 | CIF 10 | |
90 | TAD DEV1CE /OPEN THE LISTING FILE | |
91 | JMS I (200 | |
92 | 3 | |
93 | OB, DEV1CE+1 | |
94 | OS, 0 | |
95 | JMP I (OFOO3 | |
96 | TAD OB /SAVE BLOCK NUMBER | |
97 | DCA OBLOCK | |
98 | TAD OS | |
99 | DCA OSIZE /AND SIZE OF HOLE | |
100 | TAD OH /SAVE HANDLER ADDRESS | |
101 | DCA DEVH | |
102 | TAD (NUMS-1 /SET UP NUMBER POINTER | |
103 | DCA I (NUM | |
104 | TAD TEMP /GET THE DATE--FOR YEAR ROUTINE | |
105 | SNA | |
106 | JMP I (PAJE /NO DATE | |
107 | AND (7 /MASK OUT ALL BUT YEAR OFFSET BITS | |
108 | DCA YRTEMP /INCREMENT FROM THE BASE YEAR | |
109 | DCA TEMP1 /HOLDS THE FIRST DIGIT OF THE YEAR | |
110 | TAD I (7777 /GET THE DATE EXTENSION BITS | |
111 | AND (600 /MASK TO GET THE EXTENSION BITS | |
112 | CLL RTR /ROTATE THEM INTO BIT | |
113 | RTR /POSITIONS 7 AND 8 | |
114 | TAD (106 /ADD IN 70---OLD BASE YEAR | |
115 | TAD YRTEMP /ADD IN THE YEAR OFFSET BITS | |
116 | /TO FIND THE NEW BASE YEAR | |
117 | CONVYR, CLL /FIND THE YEAR IN DECIMAL | |
118 | TAD (-12 /KEEP SUBTRACTING 12 | |
119 | SNL /ALMOST DONE | |
120 | JMP SECDIG /FIND THE SECOND DIGIT OF THE YEAR | |
121 | ISZ TEMP1 /FIND THE FIRST DIGIT OF THE YEAR | |
122 | JMP CONVYR /TRY AGAIN | |
123 | SECDIG, TAD (72 /GET THE SECOND DIGIT OF THE YEAR | |
124 | RTL /AND MAKE IT SIXBIT | |
125 | RTL | |
126 | RTL | |
127 | DCA I (YEAR+1 /PUT IT IN THE PRINT LINE | |
128 | TAD TEMP1 /GET THE FIRST DIGIT | |
129 | TAD (5560 /MAKE IT SIXBIT | |
130 | DCA I (YEAR /PRINT IT | |
131 | TAD TEMP /GET THE DATE--NOW FIND THE MONTH/DAY | |
132 | CLL RTR | |
133 | RAR | |
134 | AND (777 | |
135 | DCA TEMP | |
136 | SIMPLE, TAD TEMP /GET THE DAY | |
137 | AND (37 | |
138 | TAD (DAYS-1 /THIS IS THE LAZY WAY | |
139 | DCA NCHARS | |
140 | TAD I NCHARS | |
141 | DCA I (DAY | |
142 | TAD TEMP /GET THE MONTH | |
143 | CLL RTR | |
144 | RTR | |
145 | AND (36 | |
146 | TAD (MONTHS-3 | |
147 | DCA X10 | |
148 | TAD I X10 | |
149 | DCA I (MONTH | |
150 | TAD I X10 | |
151 | DCA I (MONTH+1 | |
152 | JMP I (PAJE /WE GOT THE DATE | |
153 | LSTFIL, 7605 | |
154 | FILLST, DEV1CE | |
155 | OFSIZE, -5 | |
156 | YRTEMP, 0 | |
157 | TEMP1, 0 | |
158 | \f PAGE | |
159 | PAJE, JMP I (PRHDR /PRINT THE FIRST HEADING | |
160 | CLL CML RTL /INITIALIZE LINE NUMBER | |
161 | DCA LINENO | |
162 | DCA TABCNT /** | |
163 | RDLUPE, TAD (SEVCHR-1 /SEVEN CHAR BUFFER | |
164 | DCA X10 | |
165 | TAD (-6 | |
166 | DCA NCHARS | |
167 | RDLOOP, JMS I (ICHAR | |
168 | JMP RDACHO /ECHO & IGNORE SHORT LINES | |
169 | TAD (-211 /IS IT A TAB ? | |
170 | SZA CLA | |
171 | JMP NOTAB /NO | |
172 | TAD (-2 | |
173 | DCA TABCNT /SET POINTER TO DO EXTRA SPACES LATER** | |
174 | TAD (240 | |
175 | DCA I X10 /DO A TAB | |
176 | ISZ NCHARS | |
177 | JMP .-3 | |
178 | JMP WHAT /GO LOOK AT THE LINE | |
179 | NOTAB, TAD CHAR | |
180 | DCA I X10 /SAVE THE CHAR | |
181 | ISZ NCHARS | |
182 | JMP RDLOOP | |
183 | WHAT, TAD SEVCHR /IS IT A COMMNET | |
184 | TAD (-303 | |
185 | SNA CLA | |
186 | JMP NOISN /YES, NO INTERNAL STMT NUMBER | |
187 | TAD SEVCHR+5 /IS IT A CONTINUATION ? | |
188 | TAD (-240 | |
189 | SZA CLA | |
190 | JMP NOISN /YES, NO ISN | |
191 | TAD LINENO /NEITHER OF THESE | |
192 | JMS I (ONUMBR /PRINT ISN | |
193 | TAD LINENO /2.01/ PUT LINE NUM | |
194 | 7421 /2.01/ INTO MQ | |
195 | CLA /2.01/ CLA IF NO EAE | |
196 | ISZ LINENO /BUMP LINE NUMBER | |
197 | NOISN, TAD (211 /TAB | |
198 | JMS I (OCHAR | |
199 | TAD (SEVCHR-1 /PRINT FIRST SEVEN | |
200 | DCA X10 | |
201 | TAD (-6 | |
202 | DCA NCHARS | |
203 | TAD I X10 | |
204 | JMS I (OCHAR | |
205 | ISZ NCHARS | |
206 | JMP .-3 | |
207 | TAD TABCNT /SEE IF A TAB WAS 1ST | |
208 | SMA CLA /IF YES,NEED 2 MORE SPACES | |
209 | JMP NOTTAB | |
210 | DCA TABCNT /WAS A TAB | |
211 | TAD (240 | |
212 | JMS I (OCHAR | |
213 | TAD (240 | |
214 | JMS I (OCHAR | |
215 | NOTTAB, JMS I (ICHAR /PRINT REST OF LINE | |
216 | JMP ENDLIN | |
217 | JMS I (OCHAR | |
218 | JMP .-3 | |
219 | ENDLIN, JMS I (CRLF /END LINE | |
220 | JMS I (ERRCHK /CHECK ERROR LIST | |
221 | JMP RDLUPE /DO NEXT LINE | |
222 | TABCNT, 0 | |
223 | ||
224 | HEADER, TEXT ' FORTRAN IV 4AAAA ' | |
225 | *.-1 | |
226 | DAY, 4040 | |
227 | MONTH, 4040;4040 | |
228 | YEAR, TEXT ' PAGE ' | |
229 | *.-1 | |
230 | PAGENO, TEXT 'ONE' | |
231 | ZBLOCK 7 /V3C ROOM FOR LARGE PAGE NUMBERS | |
232 | RDACHO, TAD (211 | |
233 | JMS I (OCHAR | |
234 | JMP I (RDECHO | |
235 | PAGE | |
236 | \f TEXT " " | |
237 | LOS, TEXT "ONE " | |
238 | NUMS,/ 2427;1740;4040 | |
239 | / 2410;2205;0540 | |
240 | / 0617;2522;4040 | |
241 | / 0611;2605;4040 | |
242 | / 2311;3040;4040 | |
243 | / 2305;2605;1640 | |
244 | / 0511;0710;2440 | |
245 | / 1611;1605;4040 | |
246 | / 2405;1640;4040 | |
247 | / 0514;0526;0516 | |
248 | / 2427;0514;2605 | |
249 | TEXT "TWO@@@@@" | |
250 | TEXT "THREE@@@" | |
251 | TEXT "FOUR@@@@" | |
252 | TEXT "FIVE@@@@" | |
253 | TEXT "SIX@@@@@" | |
254 | TEXT "SEVEN@@@" | |
255 | TEXT "EIGHT@@@" | |
256 | TEXT "NINE@@@@" | |
257 | TEXT "TEN@@@@@" | |
258 | TEXT "ELEVEN@@" | |
259 | TEXT "TWELVE@@" | |
260 | TEXT "THIRTEEN" | |
261 | TEXT "FOURTEEN" | |
262 | TEXT "FIFTEEN@" | |
263 | TEXT "SIXTEEN@" | |
264 | TEXT "SEVENTEEN" | |
265 | TEXT "EIGHTEEN" | |
266 | TEXT "NINETEEN" | |
267 | HIS, TEXT " TWENTY " | |
268 | *.-1 | |
269 | TEXT " THIRTY " | |
270 | *.-1 | |
271 | TEXT " FORTY " | |
272 | *.-1 | |
273 | TEXT " FIFTY " | |
274 | *.-1 | |
275 | TEXT " SIXTY " | |
276 | *.-1 | |
277 | TEXT "SEVENTY " | |
278 | *.-1 | |
279 | TEXT " EIGHTY " | |
280 | *.-1 | |
281 | TEXT " NINETY " | |
282 | *.-1 | |
283 | TEXT "HUNDRED " | |
284 | *.-1 | |
285 | DAYS, 4061;4062;4063;4064;4065;4066;4067;4070;4071 | |
286 | 6160;6161;6162;6163;6164;6165;6166;6167;6170;6171 | |
287 | 6260;6261;6262;6263;6264;6265;6266;6267;6270;6271 | |
288 | 6360;6361 | |
289 | MONTHS, 5512;0116 /-JAN | |
290 | 5506;0502 /-FEB | |
291 | 5515;0122 /-MAR | |
292 | 5501;2022 /-APR | |
293 | 5515;0131 /-MAY | |
294 | 5512;2516 /-JUN | |
295 | 5512;2514 /-JUL | |
296 | 5501;2507 /-AUG | |
297 | 5523;0520 /-SEP | |
298 | 5517;0324 /-OCT | |
299 | 5516;1726 /-NOV | |
300 | 5504;0503 /-DEC | |
301 | IFZERO .&100 <PAGE> | |
302 | \fENDX, TAD (-601 /2.02/ CLEAR END OF BUFFER | |
303 | DCA LINENO /2.01/ FOR TV: REASONS | |
304 | TAD X232 /2.01/ OUTPUT ^Z | |
305 | JMS I (OCHAR /2.01/ | |
306 | ISZ LINENO /2.01/ | |
307 | JMP .-3 /2.01/ | |
308 | CIF 10 /CLOSE THE OUTPUT FILE | |
309 | TAD DEV1CE | |
310 | JMS I (200 | |
311 | 4 | |
312 | DEV1CE+1 | |
313 | FILSIZ, 0 | |
314 | JMP (OFOO3 | |
315 | CDF 10 /LOOK AT OPTIONS | |
316 | TAD I X7643 | |
317 | CDF | |
318 | M70, SPA CLA | |
319 | JMP I (7605 //A MEANS DON'T CHAIN TO RALF | |
320 | CIF CDF 10 | |
321 | TAD FILDEV /SET UP RALF INPUT LIST | |
322 | DCA I (7617 /FILE SIZE AND DEVICE CODE | |
323 | ISZ (7617 | |
324 | TAD FILBLK /FILE START | |
325 | DCA I (7617 | |
326 | ISZ (7617 /ZERO END OF LIST | |
327 | DCA I (7617 | |
328 | TAD I X7643 /IS IT /F (FULL LIST) ? | |
329 | AND (100 | |
330 | CIF 0 | |
331 | SZA CLA /** | |
332 | JMP LISTIT | |
333 | CIF 10 | |
334 | TAD I (7644 | |
335 | AND (20 /LET /T SWITCH THRU ALSO | |
336 | SNA CLA | |
337 | DCA I (7605 /NO, INHIBIT RALF LISTING | |
338 | LISTIT, CIF 10 | |
339 | CLA IAC | |
340 | CDF | |
341 | JMS I (200 /LOOKUP RALF.SV | |
342 | 2 | |
343 | RALFNM | |
344 | X7643, 7643 | |
345 | JMP (OFOO3 | |
346 | TAD .-3 | |
347 | DCA .+4 | |
348 | CIF 10 /CHAIN TO RALF | |
349 | JMS I (200 | |
350 | 6 | |
351 | X232, 232 | |
352 | NCNT, 0 | |
353 | ONUMBR, 0 | |
354 | DCA TEMP /OUTPUT ISN IN OCTAL | |
355 | TAD (-4 | |
356 | DCA NCNT | |
357 | OLOOP, TAD TEMP | |
358 | CLL RTL /ANYONE WHO CAN'T FOLLOW THIS | |
359 | RAL /SHOULDN'T BE A PROGRAMMER | |
360 | DCA TEMP | |
361 | TAD TEMP | |
362 | RAL | |
363 | AND (7 | |
364 | TAD (260 | |
365 | JMS I (OCHAR | |
366 | ISZ NCNT | |
367 | JMP OLOOP | |
368 | JMP I ONUMBR | |
369 | CONVRT, 0 /CONVERT TO ASCII AND PRINT | |
370 | AND (77 | |
371 | SZA | |
372 | TAD (-40 | |
373 | SPA | |
374 | TAD (100 | |
375 | TAD (240 | |
376 | JMS I (OCHAR | |
377 | JMP I CONVRT | |
378 | LINECT, -1 /EJECT FIRST TIME | |
379 | CRLF, PAJE+1 | |
380 | TAD (215 /CR LF | |
381 | JMS I (OCHAR | |
382 | TAD (212 | |
383 | JMS I (OCHAR | |
384 | ISZ LINECT | |
385 | JMP I CRLF | |
386 | TAD (214 | |
387 | JMS I (OCHAR | |
388 | PRHDR, TAD M70 /RESET COUNT | |
389 | DCA LINECT | |
390 | TAD (HEADER /COPY HEADER OUT | |
391 | DCA TEMP | |
392 | OHDR, TAD I TEMP | |
393 | CLL RTR | |
394 | CLL RTR | |
395 | CLL RTR | |
396 | JMS CONVRT | |
397 | TAD I TEMP | |
398 | JMS CONVRT | |
399 | TAD I TEMP /END YET ? | |
400 | ISZ TEMP | |
401 | AND (77 | |
402 | SZA CLA | |
403 | JMP OHDR | |
404 | TAD (215 /V3C SKIP EXTRA LINE AFTER TITLE | |
405 | JMS I (OCHAR | |
406 | TAD (212 /V3C | |
407 | JMS I (OCHAR /FOR CENTRONICS | |
408 | JMP PUTNUM /GET NEW PAGE NUMBER | |
409 | \f/ OS/8 FILE INPUT ROUTINES | |
410 | PAGE | |
411 | ICHAR, 0 /READ CHAR FROM INPUT FILE | |
412 | ISZ INJMP /BUMP THREE WAY UNPACK SWITCH | |
413 | ISZ INCHCT | |
414 | INJMPP, JMP INJMP | |
415 | TAD INEOF /DID LAST READ YEILD END OF FILE ? | |
416 | SNA CLA | |
417 | JMP INGBUF /NO, DO ANOTHER READ | |
418 | GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE | |
419 | JMP I (ENDX /NO FILE TO OPEN | |
420 | INGBUF, TAD INCTR /BUMP RECORD COUNTER | |
421 | CLL IAC | |
422 | SNL | |
423 | DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED | |
424 | SZL | |
425 | ISZ INEOF /SET END OF FILE SWITCH | |
426 | JMS I INHNDL /DO THE READ | |
427 | INCALL, 200 | |
428 | INBUFP, INBUF | |
429 | INREC, 0 | |
430 | JMP INERR /HANDLER ERROR | |
431 | INBREC, ISZ INREC /BUMP RECORD NUMBER | |
432 | TAD (-601 /SET CHAR COUNT | |
433 | DCA INCHCT | |
434 | TAD INJMPP /RESET THREE WAY JUMP SWITCH | |
435 | DCA INJMP | |
436 | TAD INBUFP /RESET BUFFER POINTER | |
437 | DCA INPTR | |
438 | JMP ICHAR+1 /GO AGAIN | |
439 | INERR, ISZ INEOF /EITHER EOF OR BADDIE | |
440 | SMA CLA | |
441 | JMP INBREC /END OF FILE, DO NEXT FILE | |
442 | JMP OFOO3 | |
443 | INJMP, HLT /3 WAY CHARACTER UUPACK SWITCH | |
444 | JMP ICHAR1 | |
445 | JMP ICHAR2 | |
446 | ICHAR3, TAD INJMPP /RESET JUMP SWITCH | |
447 | DCA INJMP | |
448 | TAD I INPTR | |
449 | AND (7400 /COMBINE THE HIGH ORDER BITS | |
450 | CLL RTR /OF THE TWO WORDS | |
451 | RTR | |
452 | TAD INTMP /TO FORM THE THIRD CHAR | |
453 | RTR | |
454 | RTR | |
455 | ISZ INPTR /BUMP WORD POINTER | |
456 | JMP ICHAR1+1 /DO SOME COMMON STUFF | |
457 | ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS | |
458 | AND (7400 | |
459 | DCA INTMP /FOR THE THIRD CHAR | |
460 | ISZ INPTR /GO TO THE SECOND WORD | |
461 | ICHAR1, TAD I INPTR /GET THE LOW 8 BITS | |
462 | AND (377 /AND I MEAN ONLY 8 !! | |
463 | DCA CHAR | |
464 | TAD CHAR | |
465 | TAD (-232 /IS IT ^Z (END OF FILE) | |
466 | SNA | |
467 | JMP GETNEW /YES, LOOK FOR THE NEXT FILE | |
468 | TAD (232-212 | |
469 | SNA | |
470 | JMP ICHAR+1 /IGNORE LINE FEEDS | |
471 | TAD (212-215 | |
472 | SNA | |
473 | JMP I ICHAR /RETURN ON CARRIAGE RETURN | |
474 | IAC | |
475 | SNA CLA | |
476 | JMP ICHAR+1 /IGNORE FORM FEEDS | |
477 | TAD CHAR | |
478 | ISZ ICHAR | |
479 | JMP I ICHAR /RETURN TO THE CALLING WORLD | |
480 | INTMP, 0 | |
481 | INFPTR, 7617 /POINTER TO INPUT FILE LIST | |
482 | INEOF, 1 | |
483 | INCHCT, | |
484 | INNEWF, -1 /FETCH HANDLER FOR NEXT FILE | |
485 | TAD (INDEVH+1 /THIS IS WHERE IT GOES | |
486 | DCA INHNDL | |
487 | CDF 10 | |
488 | TAD I INFPTR /GET NEXT INPUT FILE INFO | |
489 | CDF | |
490 | SNA | |
491 | JMP I INNEWF /NO MORE FILES | |
492 | CIF 10 | |
493 | JMS I INCALL /CALL MONITOR | |
494 | 1 /FETCH HANDLER | |
495 | INHNDL, 0 /ENTRY ADDR GOES HERE | |
496 | JMP OFOO3 | |
497 | CDF 10 | |
498 | TAD I INFPTR /GET LENGTH | |
499 | AND (7760 | |
500 | SZA /A ZERO HERE MEANS >=256 BLOCKS | |
501 | TAD (17 /PUT IN SOME MORE BITS | |
502 | CLL CML RTR | |
503 | RTR | |
504 | DCA INCTR /STORE LENGTH OF FILE | |
505 | ISZ INFPTR | |
506 | TAD I INFPTR /GET STARTING RECORD NUMBER | |
507 | DCA INREC | |
508 | ISZ INFPTR | |
509 | DCA INEOF /CLEAR EOF FLAG | |
510 | ISZ INNEWF | |
511 | CDF | |
512 | JMP I INNEWF | |
513 | INCTR, 0 | |
514 | INPTR, 0 | |
515 | /PUTNUM, TAD (PAGENO-1 /COPY THE NEW NUMBER | |
516 | / DCA X10 | |
517 | / TAD I NUM | |
518 | / ISZ NUM | |
519 | / DCA I X10 | |
520 | / TAD I NUM | |
521 | / ISZ NUM | |
522 | / DCA I X10 | |
523 | / TAD I NUM | |
524 | / ISZ NUM | |
525 | / DCA I X10 | |
526 | / JMP CRLF+1 | |
527 | RDECHO, /KEEP LINES WITH L.T. 6 CHARS OUT OF ISN COLUMN | |
528 | TAD (SEVCHR-1 | |
529 | DCA X12 | |
530 | RDECLP, TAD X12 | |
531 | CIA | |
532 | TAD X10 | |
533 | SNA CLA | |
534 | JMP ENDLIN /ONLY ECHO WHAT YOU READ | |
535 | TAD I X12 | |
536 | JMS I (OCHAR | |
537 | JMP RDECLP | |
538 | \f PAGE | |
539 | OUDUMP, 0 /BUMP THE DUFFER | |
540 | TAD OSIZE /ANY ROOM LEFT ? | |
541 | IAC | |
542 | SNA | |
543 | JMP OFOO3 | |
544 | DCA OSIZE /YES, ITS OK | |
545 | JMS I DEVH /WRITE | |
546 | 4200 /CONTROL WORD | |
547 | OUBUF /BUFFER POINTER | |
548 | OBLOCK, 0 /BLOCK NUMBER | |
549 | JMP OFOO3 | |
550 | ISZ OBLOCK /INCREMENT BLOCK NUMBER | |
551 | ISZ FILSIZ /AND FILE SIZE | |
552 | TAD OBLOCK-1 /SET BUFFER POINTER | |
553 | DCA OUPTR | |
554 | TAD (-200 /SET DOUBLE WORD COUNT | |
555 | DCA OUWDCT | |
556 | JMP I OUDUMP | |
557 | OCHAR, 0 /OUTPUT A CHAR TO THE RALF INPUT FILE | |
558 | AND (377 | |
559 | DCA OUTEMP /SAVE CHAR | |
560 | KSF /^C TEST | |
561 | JMP NOSTOP | |
562 | KRB | |
563 | AND (177 | |
564 | TAD (-3 | |
565 | SNA CLA | |
566 | JMP I (7605 /YES | |
567 | NOSTOP, ISZ OUJUMP /BUMP 3 WAY SWITCH | |
568 | OUJUMP, JMP . | |
569 | JMP CHAR1 | |
570 | JMP CHAR2 | |
571 | TAD OUTEMP /HIGH FOUR BITS GO INTO | |
572 | CLL RTL /THE HIGH ORDER BITS OF THE | |
573 | RTL /FIRST WORD OF THE TWO WORD PAIR | |
574 | AND (7400 /SEE NOTE * BELOW | |
575 | TAD I OUPOLD /COMBINE WITH OTHER BITS | |
576 | DCA I OUPOLD | |
577 | TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR | |
578 | CLL RTR /GO INTO THE HIGH ORDER FOUR | |
579 | RTR /BITS OF THE SECOND WORD OF THE PAIR | |
580 | RAR | |
581 | AND (7400 | |
582 | TAD I OUPTR | |
583 | DCA I OUPTR | |
584 | TAD OUJMP /RESET 3 WAY BRANCH | |
585 | DCA OUJUMP | |
586 | ISZ OUPTR /BUMP BUFFER POINTER | |
587 | ISZ OUWDCT /AND DOUBLE WORD COUNTER | |
588 | JMP I OCHAR /BUFFER NOT FULL | |
589 | JMS OUDUMP /DUMP IT | |
590 | JMP I OCHAR | |
591 | CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER | |
592 | DCA OUPOLD | |
593 | ISZ OUPTR /GO TO SECOND WORD | |
594 | CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2 | |
595 | DCA I OUPTR | |
596 | JMP I OCHAR | |
597 | OUTEMP, 0 | |
598 | OUPOLD, 0 | |
599 | OUPTR, OUBUF | |
600 | OUJMP, JMP OUJUMP | |
601 | OUWDCT, -200 | |
602 | OSIZE, 0 | |
603 | ERRPTR, 5000 | |
604 | ERRCHK, 0 | |
605 | CDF 10 | |
606 | TAD I ERRPTR /ANY ERRORS FOR THIS LINE | |
607 | CDF | |
608 | CMA | |
609 | TAD LINENO | |
610 | SZA CLA | |
611 | JMP I ERRCHK /NO | |
612 | CLL CMA RAL /BACK UP POINTER | |
613 | TAD ERRPTR | |
614 | DCA ERRPTR | |
615 | TAD ERRPTR | |
616 | IAC | |
617 | DCA TEMP | |
618 | CDF 10 | |
619 | TAD I TEMP /GET CODE | |
620 | CDF | |
621 | CIA | |
622 | DCA TEMP /SAVE NEGATIVE | |
623 | TAD (ERRLST-1 | |
624 | DCA X10 | |
625 | FIND, TAD I X10 /LOOK FOR ERROR MESSAGE | |
626 | SZA | |
627 | TAD TEMP | |
628 | SNA CLA | |
629 | JMP .+3 | |
630 | ISZ X10 | |
631 | JMP FIND /SKIP POINTER WORD | |
632 | CLA CMA | |
633 | TAD I X10 | |
634 | DCA X10 /POINTER TO MESSAGE | |
635 | PMLOOP, TAD I X10 /GET TWO CHARS | |
636 | DCA TEMP | |
637 | TAD TEMP | |
638 | RTR | |
639 | RTR | |
640 | RTR | |
641 | JMS CONVRT /PRINT FIRST | |
642 | TAD TEMP | |
643 | JMS CONVRT /PRINT SECOND | |
644 | TAD TEMP | |
645 | AND (77 /END OF MESSAGE ? | |
646 | SZA CLA | |
647 | JMP PMLOOP /NO, LOOP | |
648 | JMS I (CRLF | |
649 | JMP ERRCHK+1 /SEE IF ANY MORE FOR THIS LINE | |
650 | RALFNM, FILENAME RALF.SV | |
651 | \f PAGE | |
652 | X304, 304 | |
653 | X305, 305 | |
654 | X7605, 7605 | |
655 | OFOO3, TAD X304 /FATAL ERROR IN PASS 3 | |
656 | JMS TTY | |
657 | TAD X305 | |
658 | JMS TTY | |
659 | JMP I X7605 | |
660 | TTY, 0 /PRINT ON TTY | |
661 | TLS | |
662 | TSF | |
663 | JMP .-1 | |
664 | CLA | |
665 | JMP I TTY | |
666 | /ERROR MESSAGES | |
667 | ERRLST, 0724;GT | |
668 | 1124;IT | |
669 | 0504;ED | |
670 | 2227;RW | |
671 | 0317;CO | |
672 | 0530;EX | |
673 | 2123;QS | |
674 | 2114;QL | |
675 | 1106;IF | |
676 | 0417;DO | |
677 | 2316;SN | |
678 | 2404;TD | |
679 | 0204;BD | |
680 | 2224;RT | |
681 | 2204;RD | |
682 | 2324;ST | |
683 | 0314;CL | |
684 | 1517;MO | |
685 | 1017;HO | |
686 | 1515;MM | |
687 | 2323;SS | |
688 | 1720;OP | |
689 | 0123;AS | |
690 | 0401;DA | |
691 | 0410;DH | |
692 | 1514;ML | |
693 | 0405;DE | |
694 | 0223;BS | |
695 | 1424;LT | |
696 | 1105;IE | |
697 | 2010;PH | |
698 | 1513;MK | |
699 | 1724;OT | |
700 | 2004;PD | |
701 | 1524;MT | |
702 | 0726;GV | |
703 | 1411;LI | |
704 | 0420;DP | |
705 | 0414;DL | |
706 | 0101;AA | |
707 | 2306;SF | |
708 | 0406;DF | |
709 | 1111;II | |
710 | 0;SYSERR | |
711 | SYSERR, TEXT 'UNDEFINED ERROR' | |
712 | II, TEXT 'ILLEGAL USE OF IF' | |
713 | GT, TEXT 'BAD GOTO STATEMENT' | |
714 | RW, TEXT 'BAD READ OR WRITE STATEMENT' | |
715 | CO, TEXT 'ARGS IN COMMON OR VAR IN TWO COMMONS OR SYNTAX BAD' | |
716 | IT, TEXT 'BAD IO LIST ELEMENT' | |
717 | EX, TEXT 'BAD EXTERNAL STMT' | |
718 | QS, TEXT 'SYNTAX ERROR IN EQUIVALENCE' | |
719 | QL, TEXT 'VARIABLE IS EQUIVALENCED MORE THAN ONCE' | |
720 | IF, TEXT 'THIS KIND OF STATEMENT NOT LEGAL AFTER LOGICAL IF' | |
721 | DO, TEXT 'BAD SYNTAX IN DO OR IMPLIED DO' | |
722 | SN, TEXT 'NOT LEGAL AS SUBROUTINE NAME' | |
723 | TD, TEXT 'SYNTAX ERROR IN TYPE STATEMENT' | |
724 | BD, TEXT 'DIMENSIONS TOO BIG, OR SYNTAX ERROR IN DIMENSION LIST' | |
725 | ED, TEXT 'ILLEGAL AS DO ENDING STATEMENT' | |
726 | RT, TEXT 'ATTEMPT TO RE-TYPE A VARIABLE' | |
727 | RD, TEXT 'ATTEMPT TO RE-DIMENSION A VARIABLE' | |
728 | ST, TEXT 'INTERNAL COMPILER ABORT NUMBER ONE' | |
729 | CL, TEXT 'ERROR IN COMPLEX LITERAL' | |
730 | MO, TEXT 'OPERAND EXPECTED, NONE PRESENT' | |
731 | HO, TEXT 'HOLLERITH COUNT WRONG, OR MISSING QUOTES' | |
732 | MM, TEXT 'MISMATCHED PARENTHESIS' | |
733 | SS, TEXT 'SUBSCRIPT OR ARGUMENT LIST ERROR' | |
734 | OP, TEXT 'ILLEGAL OPERATOR' | |
735 | AS, TEXT 'ASSIGN ???' | |
736 | DA, TEXT 'DATA STATEMENT ?' | |
737 | DH, TEXT 'HOLLERITH COUNT OR QUOTE ERROR IN DATA STATEMENT' | |
738 | ML, TEXT 'THIS LINE NUMBER IS ALREADY DEFINED' | |
739 | DE, TEXT "WRONG WAY TO END A DO LOOP" | |
740 | BS, TEXT 'ILLEGAL IN BLOCK DATA' | |
741 | LT, TEXT 'LINE TOO BIG' | |
742 | IE, TEXT 'INPUT FILE ERROR, TAKEN AS END STATEMENT' | |
743 | PH, TEXT 'THIS FUNCTION / SUBROUTINE STATEMENT IS UNACCEPTABLE' | |
744 | MK, TEXT 'YOU MISPELED A KEYWURD' | |
745 | OT, TEXT 'ILLEGAL OPERAND TYPE FOR THIS OPERATOR' | |
746 | PD, TEXT 'INTERNAL COMPILER ABORT NUMBER TWO' | |
747 | MT, TEXT "ILLEGAL VARIABLE TYPE MIXING" | |
748 | GV, TEXT 'VARIABLE IN ASSIGNED OR COMPUTED GOTO MUST BE INTEGER OR REAL' | |
749 | LI, TEXT 'EXPRESSION IN LOGICAL IF IS NOT TYPED LOGICAL' | |
750 | DP, TEXT 'DO PARAMETERS MUST BE INTEGER OR REAL' | |
751 | DL, TEXT "YOUR DATA AND VARIABLE LISTS ARE OF DIFFERENT LENGTHS" | |
752 | AA, TEXT 'SUBROUTINES MAY ONLY HAVE SIX ARGUMENTS THAT ARE DIMENSIONED' | |
753 | SF, TEXT 'BAD STATEMENT FUNCTION' | |
754 | DF, TEXT 'BAD DEFINE FILE' | |
755 | \fPAGEN, 1 | |
756 | ||
757 | PUTNUM, ISZ PAGEN /BUMP PAGE NUMBER | |
758 | TAD PAGEN | |
759 | TAD (-24 /LT 20? | |
760 | SMA CLA | |
761 | JMP OVER19 /YES | |
762 | TAD (-5 /NO | |
763 | JMS MOVE /MOVE IN NUMBER | |
764 | NUM, 0 | |
765 | PAGENO-1 | |
766 | TAD NUM | |
767 | TAD (5 | |
768 | DCA NUM /PT TO NEXT ONE | |
769 | JMP I (CRLF+1 | |
770 | ||
771 | TENS, 0 | |
772 | ONES, 0 | |
773 | KNT, 0 | |
774 | ||
775 | OVER19, DCA TENS /CONVERT | |
776 | TAD PAGEN /PAGE NUMBER TO ONES AND TENS | |
777 | O1, TAD (-12 /DIVIDE BY TEN | |
778 | SPA | |
779 | JMP .+3 | |
780 | ISZ TENS | |
781 | JMP O1 | |
782 | TAD (12 | |
783 | DCA ONES | |
784 | TAD TENS | |
785 | CLL RTL | |
786 | TAD (HIS-10-1 | |
787 | DCA HIP /POINT TO HIGH PART | |
788 | TAD ONES | |
789 | CLL RTL | |
790 | TAD ONES | |
791 | TAD (LOS-5-1 | |
792 | DCA LOP | |
793 | TAD (-4 | |
794 | JMS MOVE | |
795 | HIP, 0 | |
796 | PAGENO-1 | |
797 | TAD (-5 | |
798 | JMS MOVE | |
799 | LOP, 0 | |
800 | PAGENO+4-1 | |
801 | JMP I (CRLF+1 | |
802 | \fMOVE, 0 | |
803 | DCA KNT | |
804 | TAD I MOVE | |
805 | DCA X11 | |
806 | ISZ MOVE | |
807 | TAD I MOVE | |
808 | DCA X12 | |
809 | ISZ MOVE | |
810 | TAD I X11 | |
811 | DCA I X12 | |
812 | ISZ KNT | |
813 | JMP .-3 | |
814 | JMP I MOVE | |
815 | $ | |
816 | \f |