Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | /MARK SENSE BATCH AND PIP |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | // | |
10 | / | |
11 | / | |
12 | / | |
13 | / | |
14 | /COPYRIGHT (C) 1974, 1975, 1977 | |
15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. | |
16 | / | |
17 | / | |
18 | / | |
19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A | |
20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- | |
21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER | |
22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE | |
23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO | |
24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE | |
25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. | |
26 | / | |
27 | / | |
28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT | |
29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL | |
30 | /EQUIPMRNT COROPATION. | |
31 | / | |
32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS | |
33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. | |
34 | / | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | \f/MARK SENSE BATCH AND PIP JANUARY 9, 1974 | |
41 | / | |
42 | / | |
43 | / | |
44 | / AUTHOR: | |
45 | / MARK B. ROSENTHAL | |
46 | / DIGITAL EQUIPMENT CORPORATION | |
47 | / | |
48 | / VERSION 3A M.H. 28-APR-77 | |
49 | / | |
50 | / | |
51 | / | |
52 | / | |
53 | / | |
54 | / | |
55 | / | |
56 | / | |
57 | / | |
58 | / | |
59 | / | |
60 | / | |
61 | / | |
62 | / | |
63 | ||
64 | ||
65 | ||
66 | ||
67 | L7775=CLA CLL CMA RTL | |
68 | L7776=CLA CLL CMA RAL | |
69 | L7777=CLA CLL CMA | |
70 | L0002=CLA CLL CML RTL | |
71 | L0001=CLA CLL IAC | |
72 | CONTCH=3 /CONTINUATION CHARACTER | |
73 | RUBOUT=7 /RUBOUT BITS | |
74 | JOBBIT=0200 /BIT POSITION OF $JOB IN COLUMN 1 | |
75 | EOFCHR=6004 /END OF FILE CARD CHARACTER IS _ | |
76 | TABCHR=6010 /TAB CHARACTER | |
77 | FFCHR=3010 /FORM FEED CHARACTER | |
78 | NOCHR=6400 /# CHARACTER | |
79 | RCSE=6672 /CARD READER SELECT AND SKIP IF READY | |
80 | RCSD=6671 /CARD READER SKIP IF CARD DONE | |
81 | RCRD=6674 /CARD READER CLEAR CARD DONE FLAG | |
82 | RCSF=6631 /CARD READER SKIP IF DATA READY | |
83 | RCRB=6634 /CARD READER READ BINARY | |
84 | KCF=6030 /CLEAR KEYBOARD FLAG | |
85 | SYSNO=CLA CLL IAC /OS8 DEVICE NUMBER FOR SYS: | |
86 | DSKNO=CLA CLL CML RTL /OS8 DEVICE NUMBER FOR DSK: | |
87 | FETCH=1 | |
88 | LOOKUP=2 | |
89 | ENTER=3 | |
90 | CLOSE=4 | |
91 | DECODE=5 | |
92 | CHAIN=6 | |
93 | USRIN=10 | |
94 | USROUT=11 | |
95 | F0=0 | |
96 | F1=10 | |
97 | JSBITS=7746 /JOB STATUS WORD | |
98 | ||
99 | ||
100 | ||
101 | *10 | |
102 | XR1, 0 | |
103 | XR2, 0 | |
104 | XRCDR, 0 | |
105 | XROPT, 0 | |
106 | ||
107 | ||
108 | *20 | |
109 | ERROR=JMS I .; XERR | |
110 | CONVRT=JMS I .; XCONVR | |
111 | OUT=JMS I .;OUTAD, XOUT | |
112 | SAVFLD=JMS I .;XSAVDF | |
113 | USR=JMS I .; 200 | |
114 | KEYWD, 0;0;0;0 | |
115 | TEMP1, 0 | |
116 | TEMP2, 0 | |
117 | TEMP3, 0 | |
118 | TEMP4, 0 | |
119 | TEMP5, 0 | |
120 | OPTCNT, 0 /OUTPUT BUFFER COUNT | |
121 | OPTSW, 0 /OUTPUT BUFFER THREE WAY SWITCH | |
122 | KEYADR, 0 | |
123 | KEYVAL, 0 | |
124 | ERRFLG, 0 | |
125 | ERRCNT, 0 | |
126 | CONFLG, 0 | |
127 | LNCNT, 0 | |
128 | USRFLG, 0 | |
129 | OFILE, ZBLOCK 5 /OUTPUT FILE DEVICE, LENGTH, AND NAME | |
130 | CDRFLG, -1 /CDRIN TO PASSES LAST CARD IF 0 | |
131 | BCLSW, 0 | |
132 | CDREOF, -1 | |
133 | DEVENT, 0 /ENTRY ADDRESS OF OUTPUT DEVICE HANDLER | |
134 | IOERR, 0 /ERROR NUMBER | |
135 | VERNO9, ISZ IOERR | |
136 | IOER8, ISZ IOERR | |
137 | CDRER7, ISZ IOERR | |
138 | OPTER6, ISZ IOERR | |
139 | OPTER5, ISZ IOERR | |
140 | OPTER4, ISZ IOERR | |
141 | OPTER3, ISZ IOERR | |
142 | OPTER2, ISZ IOERR | |
143 | OPTER1, JMP I .+1 | |
144 | IOERR1 | |
145 | ||
146 | ||
147 | \f*200 | |
148 | START, ISZ USRFLG;SKP /IS THE USR IN CORE? | |
149 | JMP CD /YES | |
150 | CIF 10;JMS I (7700;USRIN /LOCK USR IN CORE | |
151 | CD, L7777 /SET FLAG FOR USR IN CORE | |
152 | DCA USRFLG | |
153 | CIF 10;USR;DECODE;0 /DELETE TENTATIVE FILES | |
154 | TAD (7577 /COPY OUTPUT FILE #1 (NAME AND DEVICE) | |
155 | DCA XR1 | |
156 | CDF F1 | |
157 | TAD I (7644 /TEST /V SWITCH | |
158 | AND (4 | |
159 | SZA CLA | |
160 | JMP VERNO9 /YES - PRINT VERSION NUMBER | |
161 | TAD I XR1 | |
162 | SNA /IF NOT SPECIFIED, | |
163 | DSKNO /USE DEVICE DSK: | |
164 | DCA OFILE | |
165 | TAD I XR1 | |
166 | SNA /WAS A NAME GIVEN? | |
167 | JMP OPTER1 /NO | |
168 | INIT1, DCA OFILE+1 | |
169 | TAD I XR1 | |
170 | DCA OFILE+2 | |
171 | TAD I XR1 | |
172 | DCA OFILE+3 | |
173 | TAD I XR1 | |
174 | DCA OFILE+4 | |
175 | TAD (OFILE+1 | |
176 | DCA BLOKNO /SET FILE NAME ADDRESS | |
177 | TAD I (7605 /GET SECOND OUTPUT DEVICE SPECIFICATION | |
178 | DCA I (7600 /MOVE TO FIRST FOR SPOOLING IN BATCH | |
179 | CDF | |
180 | TAD BLOKNO /GET ADDRESS OF FILE NAME | |
181 | DCA I (CLOSNM /AND SAVE FOR CALL TO CLOSE | |
182 | TAD (OPTDEV&7600+1 /SET DEVICE HANDLER SPACE | |
183 | DCA DEVHDL | |
184 | TAD OFILE | |
185 | CIF 10;USR;FETCH /FETCH DEVICE HANDLER | |
186 | DEVHDL, OPTDEV&7600+1 /2 PAGES | |
187 | JMP OPTER2 /ERROR - CANNOT FETCH HANDLER | |
188 | TAD DEVHDL /MOVE ENTRY ADDRESS | |
189 | DCA DEVENT /TO PAGE ZERO | |
190 | TAD OFILE /ENTER THE FILE NAME AS TENTATIVE | |
191 | CIF 10;USR;ENTER | |
192 | BLOKNO, OFILE+1 /FILE NAME, STARTING BLOCK RETURNED HERE | |
193 | FILLEN, 0 /RETURNS FILE LENGTH HERE | |
194 | JMP OPTER3 /CANNOT ENTER FILE | |
195 | CIF 10;USR;USROUT /DISMISS THE USR | |
196 | DCA USRFLG /CLEAR USR IN CORE FLAG | |
197 | CDF 10 | |
198 | TAD BLOKNO /SAVE STARTING BLOCK NO. FOR BATCH | |
199 | DCA I (7620 | |
200 | TAD OFILE /SAVE DEVICE NO. FOR BATCH | |
201 | AND (17 | |
202 | DCA I (7617 | |
203 | TAD I (7643 /GET OPTIONS | |
204 | CDF F0 | |
205 | AND (2100 / /B OR /F | |
206 | SNA | |
207 | DCA I (EOFJMP /IF NEITHER, THEN WE CHAIN TO BATCH | |
208 | CLL RTL /GET /B OUT OF AC | |
209 | SZA CLA /IF AC=0 START WITH BASIC KEYWORDS | |
210 | TAD (FORKEY-BASKEY | |
211 | TAD (BASKEY-15 | |
212 | DCA KEYADR | |
213 | JMP I (INIT5 | |
214 | ||
215 | ||
216 | PAGE | |
217 | \fINIT5, TAD (BPRI2 /TAILOR IT FOR BATCH PROCESSING | |
218 | DCA I (BPRKEY /"PRINT #4," | |
219 | TAD (BINP2 | |
220 | DCA I (BINKEY /"INPUT #3," | |
221 | TAD (BSTO2 | |
222 | DCA I (BSTKEY /"CLOSE# 4\STOP" | |
223 | TAD (BEND2 | |
224 | DCA I (BENKEY /"CLOSE #4\END" | |
225 | CDF F1 | |
226 | DCA I (CBAS5 /NO JUMP | |
227 | DCA I (DATL48 /NO JUMP | |
228 | TAD (CL2M1A /".R LOADER_*GENIOX" | |
229 | DCA I (CL2SX | |
230 | TAD I (7643 /TEST /I OPTION (INTERACTIVE) | |
231 | AND (10 | |
232 | SNA CLA | |
233 | JMP INIT6 | |
234 | TAD BASJMP /SET UP FOR FILES 0 & 1 | |
235 | DCA I (CBAS5 /SET UP THE JMP | |
236 | TAD BASJM1 /SET UP JUMP | |
237 | DCA I (DATL48 | |
238 | TAD (CL2M1 /".R LOADER_*" | |
239 | DCA I (CL2SX | |
240 | CDF F0 | |
241 | TAD (BPRI | |
242 | DCA I (BPRKEY | |
243 | TAD (BINP | |
244 | DCA I (BINKEY | |
245 | TAD (BSTO | |
246 | DCA I (BSTKEY | |
247 | TAD (BEND | |
248 | DCA I (BENKEY | |
249 | INIT6, CDF 10 | |
250 | TAD I (7644 /TEST /T OPTION | |
251 | AND (20 | |
252 | SNA CLA | |
253 | TAD (BATLPT-BATTTY | |
254 | TAD (BATTTY | |
255 | CIF CDF F1 | |
256 | JMS I (MOVODV | |
257 | TAD I (7645 /TEST /2 OPTION | |
258 | AND (200 | |
259 | SNA CLA | |
260 | JMP INIT3 | |
261 | TAD (CF2 /FORTRAN 2 | |
262 | DCA I (FORADR | |
263 | TAD (CL2 | |
264 | DCA I (LOAADR | |
265 | TAD (DATX2 | |
266 | JMP INIT4 | |
267 | INIT3, TAD (CF4 /FORTRAN 4 | |
268 | DCA I (FORADR | |
269 | TAD (CL4 | |
270 | DCA I (LOAADR | |
271 | TAD (DATX4 /INITIALIZE $DATA | |
272 | INIT4, DCA I (DATFTN | |
273 | TAD I (DATFTN | |
274 | DCA I (DATADR | |
275 | TAD (SAVARA | |
276 | DCA I (SAVPNT | |
277 | DCA I (NAMCNT | |
278 | CDF F0 | |
279 | DCA BCLSW /NO BCL CARDS YET | |
280 | L7777 | |
281 | DCA CDREOF /RESET EOF SWITCH | |
282 | TAD I (BLOKNO /SET STARTING BLOCK NUMBER | |
283 | DCA I (OPTBLK | |
284 | TAD (OPTBUF-1 | |
285 | DCA XROPT | |
286 | TAD (-200 | |
287 | DCA OPTCNT | |
288 | L7775 | |
289 | DCA OPTSW | |
290 | DCA ERRCNT /CLEAR COUNT OF CARDS IN ERROR | |
291 | JMP I (READY | |
292 | ||
293 | BASJMP, JMP CBAS7&177+INIT5 | |
294 | BASJM1, JMP DATL49&177+INIT5 | |
295 | ||
296 | ||
297 | PAGE | |
298 | \fREADY, JMS I (CDRIN /READ A CARD | |
299 | JMP I (EOF /END OF FILE SENSED | |
300 | TAD I XRCDR /GET COLUMN 1 | |
301 | DCA KEYWD /SAVE AS KEYWORD BITS | |
302 | TAD XRCDR | |
303 | DCA XR2 | |
304 | ||
305 | ||
306 | /TRANSLATE LINE NUMBER | |
307 | TAD (-5 | |
308 | DCA TEMP1 | |
309 | DCA LNCNT /CLEAR COUNT | |
310 | DCA KEYWD+3 /CLEAR COLUMN 2-6 KEYWORD BITS | |
311 | LNLP, TAD I XRCDR /GET LINE NO. COLUMN | |
312 | DCA TEMP2 /SAVE CHAR | |
313 | TAD (6000 | |
314 | AND TEMP2 /GET KEYWORD BITS | |
315 | CLL RAL | |
316 | RTL | |
317 | TAD KEYWD+3 | |
318 | CLL RTL | |
319 | DCA KEYWD+3 | |
320 | TAD (1777 | |
321 | AND TEMP2 /GET CHAR | |
322 | SNA | |
323 | JMP LNLPEN /IGNORE BLANKS | |
324 | CONVRT /TRANSLATE | |
325 | JMP LNLPEN /IGNORE RUBOUTS | |
326 | TAD (-"9 | |
327 | SMA SZA | |
328 | JMP LNERR /NOT A NUMBER | |
329 | TAD ("9-"0 | |
330 | SPA | |
331 | JMP LNERR /NOT A NUMBER | |
332 | TAD ("0 | |
333 | LNLP1, DCA I XR2 /INSERT CHARACTER IN OUTPUT BUFFER | |
334 | ISZ LNCNT /COUNT THIS CHARACTER | |
335 | LNLPEN, ISZ TEMP1 /GOT ALL LINE NUMBER COLUMNS? | |
336 | JMP LNLP /NO - LOOP. | |
337 | JMP I (KEYTRA /GO TRANSLATE KEYWORD | |
338 | ||
339 | ||
340 | LNERR, ERROR | |
341 | JMP LNLP1 | |
342 | ||
343 | ||
344 | MAKNA2, 0 /FIELD 1 OUTPUT ROUTINE FOR MAKNAM | |
345 | CIF CDF F1 | |
346 | JMS I (MAKNA3 | |
347 | JMP I MAKNA2 | |
348 | ||
349 | OOUT2, 0 | |
350 | OUT | |
351 | CIF CDF F1 | |
352 | JMP I OOUT2 | |
353 | ||
354 | GETCD1, 0 | |
355 | TAD I XRCDR | |
356 | CIF CDF F1 | |
357 | JMP I GETCD1 | |
358 | ||
359 | /FOR RETURN TO CALLING FIELD | |
360 | /PRESERVES AC AND LINK WHILE PUTTING | |
361 | /CIF CDF TO DATA FIELD AT ADDRESS | |
362 | /SPECIFIED AS FIRST WORD AFTER CALL | |
363 | XSAVDF, 0 | |
364 | DCA XSAVD1 | |
365 | RDF | |
366 | TAD (CIF CDF | |
367 | DCA XSAVD2 | |
368 | CDF | |
369 | TAD I XSAVDF | |
370 | ISZ XSAVDF | |
371 | DCA XSAVD3 | |
372 | TAD XSAVD2 | |
373 | DCA I XSAVD3 | |
374 | TAD XSAVD1 | |
375 | JMP I XSAVDF | |
376 | XSAVD1, 0 | |
377 | XSAVD2, 0 | |
378 | XSAVD3, 0 | |
379 | ||
380 | PAGE | |
381 | \fXERR, 0 | |
382 | K7600, 7600 | |
383 | TAD ("? /OUTPUT A "?" | |
384 | ISZ ERRFLG /FLAG ERROR ON THIS CARD | |
385 | JMP I XERR | |
386 | ||
387 | TIME=12 | |
388 | ||
389 | CDRIN, 0 /READ A CARD INTO THE BUFFER | |
390 | SAVFLD;CDRCIF /SAVE DATA FIELD FOR RETURN | |
391 | DCA ERRFLG /CLEAR ERROR FLAG FOR THIS CARD | |
392 | ISZ CDREOF /HAVE WE SEEN EOF? | |
393 | JMP CDRCIF /YES - STILL EOF | |
394 | ISZ CDRFLG /SHOULD WE PASS LAST CARD? | |
395 | JMP REINIT /YES | |
396 | CDRIN6, JMS CDRIN5 /RESET TIME OUT COUNTERS | |
397 | TAD (-50 /YES - READ IT INTO THE CDR BUFFER | |
398 | DCA TEMP1 /40 COLUMNS (DECIMAL) | |
399 | TAD (CDRBUF-1 | |
400 | DCA XRCDR | |
401 | CDRIN3, RCSE /CARD READY? | |
402 | JMP CDRIN4 /TEST TIME OUT | |
403 | JMS CDRIN5 /RESET TIME OUT COUNT | |
404 | CDRIN1, JMS KBRD /TEST KEYBOARD (AFTER TIME OUT LOOP) | |
405 | RCSD /CARD DONE? | |
406 | SKP | |
407 | JMP CDRIN7 /YES - TOO FEW COLUMNS | |
408 | RCSF /CHARACTER READY? | |
409 | JMP CDRIN1 /NO - TRY CARD DONE | |
410 | JMS CDRIN5 /RESET TIME OUT COUNT | |
411 | RCRB /YES - READ BINARY | |
412 | CDRIN2, DCA I XRCDR /AND STORE IT | |
413 | ISZ TEMP1 /DON'T READ MORE THAN BUFFER CAN HOLD | |
414 | JMP CDRIN1 /TRY CARD DONE AGAIN | |
415 | RCSD /WAIT FOR END OF CARD - OR ELSE! | |
416 | JMP .-1 | |
417 | RCRD /IF THIS ISN'T CLEARED, | |
418 | /FORTRAN IV BECOMES VERY UNHAPPY! | |
419 | JMP CDRIN8 | |
420 | CDRIN7, RCRD /FORTRAN IV AGAIN | |
421 | ISZ TEMP1 /ALLOW ONE COLUMN TOO FEW (EDU30 - 39 COL) | |
422 | JMP CDRER7 /ERROR! | |
423 | DCA I XRCDR | |
424 | CDRIN8, TAD (CDRBUF-1 /INIT BUFFER POINTERS AGAIN | |
425 | DCA XRCDR | |
426 | TAD (-50 | |
427 | DCA TEMP1 | |
428 | TAD (-EOFCHR /TEST FOR FIRST COLUMN=EOFCHR AND REST =0 | |
429 | EOFLP, TAD I XRCDR /GET NEXT COLUMN | |
430 | SZA CLA | |
431 | JMP REINIT /NON-ZERO - NOT EOF | |
432 | ISZ TEMP1 | |
433 | JMP EOFLP /LOOP | |
434 | JMP CDRCIF /END OF FILE CARD | |
435 | REINIT, TAD (CDRBUF-1 | |
436 | DCA XRCDR | |
437 | ISZ CDRIN /SKIP RETURN IF NOT EOF | |
438 | L7777 /RESET EOF SWITCH | |
439 | CDRCIF, 0 | |
440 | DCA CDREOF | |
441 | L7777 /SET TO READ A NEW CARD NEXT TIME | |
442 | DCA CDRFLG | |
443 | JMP I CDRIN | |
444 | ||
445 | CDRIN4, JMS KBRD /TEST TIME OUT | |
446 | JMP CDRIN3 /TRY SELECTING CARD AGAIN | |
447 | ||
448 | CDRIN5, 0 /RESET TIME OUT | |
449 | DCA TIMOUT | |
450 | TAD (-TIME | |
451 | DCA TIMOU2 | |
452 | JMP I CDRIN5 | |
453 | ||
454 | KBRD, 0 | |
455 | KSF /KEYBOARD? | |
456 | JMP KBRDTM /NO - TIME | |
457 | KRS /IS IT ^C? | |
458 | AND (177 | |
459 | TAD (-3 | |
460 | SNA CLA | |
461 | JMP I K7600 /YES - RETURN TO OS-8 | |
462 | KBRDTM, ISZ TIMOUT /TIMED OUT YET? | |
463 | JMP I KBRD /NO | |
464 | ISZ TIMOU2 | |
465 | JMP I KBRD /LIKEWISE | |
466 | KCF /IGNORE ANYTHING TYPED BEFORE THIS | |
467 | TAD (207 /NOTHING - WAKE HIM UP | |
468 | JMS I (TOUT | |
469 | TAD (MSGJAM /IT COULD BE JAMMED | |
470 | DCA TEMP1 | |
471 | JMS I (TTYOUT | |
472 | KBRD1, KSF /WAIT FOR A CHARACTER OR READER | |
473 | JMP KBRD3 | |
474 | KBRD2, KRS /GET THE CHAR | |
475 | AND (177 /WITHOUT PARITY | |
476 | TAD (-3 /IS IT ^C? | |
477 | SNA | |
478 | JMP I K7600 /YES - TO MONITOR | |
479 | KCF /IF ^C - LEAVE FLAG SO OS-8 WILL SEE IT. ELSE CLEAR IT | |
480 | TAD (3-32 /IS IT ^Z? | |
481 | SNA CLA | |
482 | JMP CDRCIF /YES - EOF | |
483 | JMP CDRIN6 /GO BACK AND TIME OUT AGAIN | |
484 | KBRD3, RCSE /SELECT A CARD? | |
485 | JMP KBRD1 /NO - TRY KEYBOARD | |
486 | TAD (-50 /RESET COUNT | |
487 | DCA TEMP1 | |
488 | TAD (CDRBUF-1 /AND POINTER | |
489 | DCA XRCDR | |
490 | JMP CDRIN3+2 /YES - RE-ENTER ROUTINE WITH SUCCESSFUL SELECT | |
491 | ||
492 | CDRJA1, KSF | |
493 | JMP .-1 | |
494 | JMP KBRD2 | |
495 | ||
496 | TIMOUT, 0 | |
497 | TIMOU2, 0 | |
498 | ||
499 | PAGE | |
500 | \fKEYTRA, TAD I XRCDR /GET KEYWORD COLUMN | |
501 | DCA KEYWD+1 | |
502 | TAD I XRCDR /DITTO | |
503 | DCA KEYWD+2 | |
504 | /CONVERT KEYWORD BITS TO NUMBER | |
505 | TAD (KEYWD-1 /POINT INDEX REGISTER TO KEYWORD BUFFER | |
506 | DCA XR1 | |
507 | TAD (-4 /SET COUNT OF WORDS | |
508 | DCA TEMP1 | |
509 | DCA KEYVAL /ZERO KEYWORD VALUE | |
510 | WRDLP, TAD (-14 /SET BIT COUNT | |
511 | DCA TEMP2 | |
512 | TAD I XR1 /GET WORD | |
513 | BITLP, ISZ KEYVAL /BUMP BIT VALUE | |
514 | CLL RAL /SHIFT INTO LINK | |
515 | SZL /IS THIS ONE ON? | |
516 | JMP KEYFND /YES - KEYWORD FOUND | |
517 | ISZ TEMP2 /COUNT BITS | |
518 | JMP BITLP | |
519 | ISZ TEMP1 /COUNT WORDS | |
520 | JMP WRDLP | |
521 | JMS I (LNOUT /SEND THE LINE NO. | |
522 | JMP I (TEXTRA /ALL BITS OFF - NO KEYWORD | |
523 | ||
524 | ||
525 | KEYBAD, ERROR | |
526 | OUT | |
527 | JMP KEYBLK | |
528 | ||
529 | ||
530 | TAD I XR1 /GET NEXT WORD | |
531 | KEYFND, SZA CLA /TEST THIS WORD | |
532 | JMP KEYBAD /ERROR - MORE THAN ONE KEYWORD MARKED | |
533 | ISZ TEMP1 /COUNT WORDS | |
534 | JMP KEYFND-1 /AND LOOP | |
535 | ||
536 | /OUTPUT THE KEYWORD | |
537 | TAD KEYVAL /IS IT A BATCH CONTROL LANGUAGE COMMAND? | |
538 | TAD (-14 | |
539 | SMA SZA CLA | |
540 | JMP KEYOUT | |
541 | L7777 /FOUND A BCL CARD | |
542 | DCA BCLSW /GENERATE "$END" BEFORE CLOSING FILE | |
543 | CIF CDF F1 | |
544 | JMP I (BCLTRA /YES - HANDLE THAT SPECIALLY | |
545 | ||
546 | ||
547 | KEYOUT, JMS I (LNOUT /SEND LINE NUMBER | |
548 | TAD KEYADR | |
549 | TAD KEYVAL | |
550 | DCA TEMP1 | |
551 | TAD I TEMP1 /GET ADDRESS OF KEYWORD | |
552 | SNA | |
553 | JMP KEYBAD /IF ZERO - UNUSED KEYWORD | |
554 | DCA TEMP1 /ELSE SAVE IT | |
555 | TAD TEMP1 /IS THIS "INPUT" OR "PRINT | |
556 | TAD (-BPRI2 /BEING FUDGED UNDER BASIC? | |
557 | SNA | |
558 | JMP NOSGN /PRINT - CHECK FOR NUMBER SIGN | |
559 | TAD (BPRI2-BINP2 | |
560 | SZA CLA | |
561 | JMP KEYOU5 /NONE - ALL'S WELL | |
562 | NOSGN, TAD (-40 /SET COUNT | |
563 | DCA TEMP3 | |
564 | NOSGN1, TAD I XRCDR /IS NEXT CHAR BLANK? | |
565 | SZA | |
566 | JMP NOSGN2 /NO - IS IT # | |
567 | ISZ TEMP3 | |
568 | JMP NOSGN1 | |
569 | JMP NOSGN3 /REST IS BLANK | |
570 | NOSGN2, TAD (-NOCHR /IS IT "#"? | |
571 | SZA CLA | |
572 | JMP NOSGN3 /NO | |
573 | TAD TEMP1 /YES - USE "INPUT" OR "PRINT" | |
574 | TAD (-BPRI2 | |
575 | SZA CLA | |
576 | TAD (BINP-BPRI | |
577 | TAD (BPRI | |
578 | DCA TEMP1 | |
579 | NOSGN3, TAD (CDRBUF+7 | |
580 | DCA XRCDR | |
581 | KEYOU5, JMS I (UNPACK /AND OUTPUT KEYWORD | |
582 | KEYBLK, TAD (" /INSERT BLANK AFTER KEYWORD | |
583 | OUT | |
584 | JMP I (TEXTRA | |
585 | ||
586 | ||
587 | PAGE | |
588 | \fUNPACK, 0 /OUTPUT PACKED 6-BIT ASCII TEXT | |
589 | TAD I TEMP1 /IS FIRST CHAR = 00? | |
590 | AND (7700 | |
591 | SZA CLA | |
592 | JMP KEYOU1 /NO - NORMAL 6-BIT TRANSLATE | |
593 | TAD (211 /YES - THIS IS TAB RATHER THAN END | |
594 | OUT /OUTPUT IT | |
595 | JMP KEYOU3 /AND GET SECOND CHARACTER | |
596 | KEYOU1, TAD I TEMP1 /GET FIRST CHARACTER | |
597 | CLL RTR | |
598 | RTR | |
599 | RTR | |
600 | JMS KEYOU2 /AND OUTPUT IT | |
601 | KEYOU3, TAD I TEMP1 /GET SECOND CHARACTER | |
602 | JMS KEYOU2 /AND OUTPUT IT | |
603 | ISZ TEMP1 /POINT TO NEXT TWO CHARACTERS | |
604 | JMP KEYOU1 /ETC. | |
605 | ||
606 | KEYOU2, 0 | |
607 | AND (77 /MASK FOR THE LOW ORDER BITS | |
608 | SNA | |
609 | JMP I UNPACK /CHARACTER IS 00 - END OF KEYWORD | |
610 | TAD (-37 /<CR>? | |
611 | SNA | |
612 | TAD (215-337 /THIS WILL BE 215 WHEN WE'RE DONE | |
613 | SPA | |
614 | TAD (100 | |
615 | TAD (237 | |
616 | OUT /OUTPUT THE CHARACTER | |
617 | JMP I KEYOU2 | |
618 | ||
619 | TTYOUT, 0 /USE UNPACK ROUTINE TO PRINT MESSAGE ON TTY | |
620 | TAD (TOUT /SWITCH OUTPUT ROUTINES | |
621 | DCA OUTAD | |
622 | JMS UNPACK | |
623 | TAD (XOUT /RESET OUTPUT ROUTINES | |
624 | DCA OUTAD | |
625 | JMP I TTYOUT /RETURN | |
626 | ||
627 | ||
628 | LNOUT, 0 /OUTPUT THE LINE NUMBER | |
629 | SAVFLD;LNCIF | |
630 | TAD LNCNT /GET NUMBER OF CHARS | |
631 | CMA | |
632 | DCA TEMP1 | |
633 | TAD (CDRBUF /START WITH COLUMN 2 | |
634 | DCA XR2 | |
635 | LNOUT1, ISZ TEMP1;SKP /MORE DIGITS? | |
636 | JMP LNOUT2 /NO | |
637 | TAD I XR2;OUT | |
638 | JMP LNOUT1 | |
639 | LNOUT2, TAD LNCNT /ANY DIGITS? | |
640 | SNA CLA | |
641 | JMP LNCIF | |
642 | TAD (" ;OUT /YES - SUFFIX A BLANK | |
643 | LNCIF, 0 | |
644 | JMP I LNOUT | |
645 | ||
646 | ||
647 | PAGE | |
648 | \f/TRANSLATE TEXT | |
649 | TEXTRA, DCA CONFLG /CLEAR CONTINUATION FLAG | |
650 | DCA TEMP1 /CLEAR COUNT OF BLANK CHARACTERS | |
651 | TAD (-40 /32 COLUMNS OF TEXT (DECIMAL) | |
652 | DCA TEMP3 | |
653 | TEXLP1, TAD I XRCDR | |
654 | SNA /BLANK? | |
655 | JMP TEXBLK /YES - COUNT A BLANK | |
656 | TAD (-CONTCH /CONTINUATION CHARACTER? | |
657 | SNA | |
658 | JMP TEXCON /YES - ENOUGH OF THIS CARD | |
659 | TAD (CONTCH | |
660 | CONVRT /TRANSLATE THE CHARACTER | |
661 | JMP TEXLP2 /RUBOUT? - GET THE NEXT CHARACTER | |
662 | DCA TEMP2 /SAVE THE CHARACTER | |
663 | JMS TEXBOU /OUTPUT THE COUNTED BLANKS | |
664 | TAD TEMP2 | |
665 | OUT /OUTPUT THE CHARACTER | |
666 | TEXLP2, ISZ TEMP3 /COUNT COLUMNS | |
667 | JMP TEXLP1 | |
668 | TAD (215 /OUTPUT A <CR> | |
669 | OUT | |
670 | JMP TEXFIN | |
671 | ||
672 | ||
673 | TEXCON, JMS TEXBOU | |
674 | CLA CMA | |
675 | DCA CONFLG /SET THE CONTINUATION FLAG | |
676 | JMP TEXFIN | |
677 | ||
678 | ||
679 | TEXBLK, ISZ TEMP1 /COUNT THE BLANKS | |
680 | JMP TEXLP2 /GET THE NEXT CHARACTER | |
681 | ||
682 | ||
683 | TEXBOU, 0 /OUTPUT BLANKS | |
684 | TAD TEMP1 | |
685 | CMA | |
686 | DCA TEMP1 | |
687 | TEXBO1, ISZ TEMP1 /MORE BLANKS | |
688 | SKP | |
689 | JMP I TEXBOU /NO - RETURN | |
690 | TAD (" /YES - OUTPUT A BLANK | |
691 | OUT | |
692 | JMP TEXBO1 | |
693 | ||
694 | ||
695 | TEXFIN, TAD ERRFLG /DID THIS CARD HAVE AN ERROR? | |
696 | SZA CLA | |
697 | ISZ ERRCNT /YES - COUNT IT | |
698 | JMP I (READY /PROCESS NEXT CARD | |
699 | ||
700 | ||
701 | \f/CARD CODE TO ASCII CONVERSION ROUTINE | |
702 | XCONVR, 0 /INPUT 12 BIT CARD CODE - OUTPUT 8 BIT ASCII | |
703 | SAVFLD;XCOCIF /SAVE DATA FIELD FOR RETURN | |
704 | DCA CONVR1 /SAVE 12 BIT CARD CODE | |
705 | TAD (RUBOUT | |
706 | AND CONVR1 | |
707 | TAD (-RUBOUT | |
708 | SNA CLA /WAS CHARACTER RUBBED OUT? | |
709 | JMP XCOCIF /YES - RETURN 0 IN AC | |
710 | ISZ XCONVR /NOT RUBBED OUT - SKIP RETURN | |
711 | TAD CONVR1 | |
712 | RTL | |
713 | RTL | |
714 | AND (7 /GET ZONE BITS | |
715 | CLL RAL | |
716 | DCA CONVR2 /2*ZONE BITS | |
717 | TAD CONVR2 | |
718 | RTL | |
719 | TAD CONVR2 /10*ZONE BITS | |
720 | DCA CONVR2 | |
721 | TAD CONVR1 | |
722 | RTL | |
723 | RAL | |
724 | AND (7770 /1-9 "PUNCHES" | |
725 | SNA | |
726 | JMP CONVR3 /IF ALL OFF DON'T INCREMENT COUNT | |
727 | CLL RAL /SHIFT NEXT BIT INTO LINK | |
728 | ISZ CONVR2 /COUNT THE BIT | |
729 | SNL | |
730 | JMP .-3 /LOOP IF OFF | |
731 | SZA CLA | |
732 | JMP CONILL /IF REST OF AC IS NOT ZERO - ILLEGAL CHARACTER | |
733 | CONVR3, TAD CONVR2 /GET DISPLACEMENT OF CHAR IN TABLE | |
734 | CLL RAR /GET WORD DISPLACEMENT IN AC | |
735 | TAD (TRTAB /ADDRESS OF WORD | |
736 | DCA CONVR2 | |
737 | TAD I CONVR2 /GET WORD | |
738 | SZL | |
739 | JMP .+4 /IF DISPLACEMENT WAS ODD, USE LOW ORDER HALF OF WORD | |
740 | RTR | |
741 | RTR | |
742 | RTR | |
743 | AND (77 /MASK FOR LOW PART OF WORD | |
744 | SNA | |
745 | JMP CONVR4 /ZERO IN TABLE IS ILLEGAL CODE (MAYBE) | |
746 | TAD (240 | |
747 | JMP XCOCIF /RETURN WITH 8 BIT ASCII IN AC | |
748 | CONVR4, TAD CONVR1 /GET 12-BIT CARD CODE | |
749 | TAD (-TABCHR /IS IT A TAB CHAR? | |
750 | SNA | |
751 | JMP CONVR5 /YUP! | |
752 | TAD (TABCHR-FFCHR /HOW ABOUT A FORM FEED? | |
753 | SZA CLA | |
754 | JMP CONILL /NOPE - IT'S REALLY BAD | |
755 | TAD (214-211 /IT'S FORM FEED | |
756 | CONVR5, TAD (211 /IT'S TAB | |
757 | JMP XCOCIF | |
758 | CONILL, ERROR /SET ERROR FLAG; RETURN "?" IN AC | |
759 | XCOCIF, 0 | |
760 | JMP I XCONVR | |
761 | ||
762 | CONVR1, 0 | |
763 | CONVR2, 0 | |
764 | ||
765 | ||
766 | PAGE | |
767 | \f/OUTPUT A CHARACTER. RETURNS .+1 IF CHARACTER IS | |
768 | /JUST STORED IN BUFFER. RETURNS .+2 IF NO MORE SPACE IN | |
769 | /EMPTY. RETURNS .+3 IF BLOCK WAS WRITTEN AND THERE ARE | |
770 | /MORE BLOCKS IN THE EMPTY. | |
771 | XOUTP, 0 /OUTPUT ROUTINE | |
772 | ISZ OPTSW /THREE WAY SWITCH | |
773 | JMP XOUT1 | |
774 | DCA XOUT2 /SAVE CHAR IN TEMP | |
775 | L7777 | |
776 | TAD XROPT /BACK UP 2 WORDS | |
777 | DCA XOUT3 | |
778 | TAD XOUT2 /GET FIRST HALF OF CHARACTER | |
779 | RTL | |
780 | RTL | |
781 | AND K7400 | |
782 | TAD I XOUT3 /ADD IN FIRST CHARACTER | |
783 | DCA I XOUT3 | |
784 | ISZ XOUT3 | |
785 | TAD XOUT2 /GET SECOND HALF OF CHARACTER | |
786 | RTR | |
787 | RTR | |
788 | RAR | |
789 | AND K7400 | |
790 | TAD I XOUT3 /ADD IN SECOND CHARACTER | |
791 | DCA I XOUT3 | |
792 | ISZ OPTCNT /IS BUFFER FULL? | |
793 | JMP XOUT6 /NO - RETURN NORMALLY | |
794 | JMS I DEVENT /CALL DEVICE HANDLER | |
795 | 4200 /TWO PAGES OF OUTPUT FROM FIELD 0 | |
796 | OPTBUF /BUFFER ADDRESS | |
797 | OPTBLK, 0 /BLOCK NUMBER | |
798 | JMP OPTER4 /ERROR DOING OUTPUT | |
799 | ISZ OPTBLK /INCREMENT BLOCK NUMBER | |
800 | TAD (OPTBUF-1 /RESET BUFFER POINTER | |
801 | DCA XROPT | |
802 | TAD (-200 /AND BUFFER LENGTH /2 | |
803 | DCA OPTCNT | |
804 | ISZ XOUTP /SKIP RETURN IF BLOCK WRITTEN | |
805 | ISZ I (FILLEN /MORE BLOCKS IN EMPTY? | |
806 | ISZ XOUTP /YES - SKIP AGAIN | |
807 | XOUT6, L7775 /RESET 3-WAY SWITCH | |
808 | DCA OPTSW | |
809 | JMP I XOUTP /RETURN | |
810 | ||
811 | XOUT1, DCA I XROPT /SAVE CHARACTER IN BUFFER | |
812 | JMP I XOUTP | |
813 | ||
814 | XOUT2, 0 | |
815 | XOUT3, 0 | |
816 | ||
817 | ||
818 | XOUT, 0 | |
819 | DCA CLOSLN /SAVE CHAR IN A CONVENIENT TEMP | |
820 | TAD CLOSLN | |
821 | JMS XOUTP /OUTPUT THE CHARACTER | |
822 | SKP | |
823 | JMP OPTER5 /FILLED UP AVAILABLE SPACE BEFORE ^Z | |
824 | TAD CLOSLN /WAS IT <CR>? | |
825 | TAD (-215 | |
826 | SZA CLA | |
827 | JMP I XOUT /RETURN | |
828 | TAD (212 | |
829 | JMP XOUT+1 | |
830 | ||
831 | ||
832 | EOF, DCA KEYVAL /FINISH UP ANY BCL CARD IN PROGRESS | |
833 | DCA CONFLG /ZERO THESE TO GET US AROUND | |
834 | DCA LNCNT /THE TESTS IN BCLHUH | |
835 | CIF CDF F1 | |
836 | JMP I (BCLTRA | |
837 | EOF2, ISZ BCLSW /WERE THERE ANY BCL CARDS? | |
838 | JMP EOF1 /NO | |
839 | TAD (MEND /YES - SEND "$END" | |
840 | DCA TEMP1 | |
841 | JMS I (UNPACK | |
842 | EOF1, TAD (32 /^Z | |
843 | JMS XOUTP /OUTPUT CHAR | |
844 | JMP .-1 /BLOCK NOT YET FULL | |
845 | K7400, 7400 /BLOCK WRITTEN | |
846 | TAD I (BLOKNO /BLOCK WRITTEN | |
847 | CIA | |
848 | TAD OPTBLK /GET LENGTH OF FILE WRITTEN | |
849 | DCA CLOSLN /SET LENGTH FOR CLOSE | |
850 | ISZ USRFLG;SKP /IS USR IN CORE? | |
851 | JMP EOF3 /YES | |
852 | CIF 10;JMS I (7700;USRIN /BRING IN THE USR | |
853 | EOF3, L7777 /SET USR IN CORE FLAG | |
854 | DCA USRFLG | |
855 | TAD OFILE /GET DEVICE NUMBER | |
856 | CIF 10;USR;CLOSE | |
857 | CLOSNM, 0 /POINTER TO NAME | |
858 | CLOSLN, 0 /LENGTH OF FILE | |
859 | JMP OPTER6 | |
860 | TAD CLOSLN | |
861 | CIA | |
862 | RTL | |
863 | RTL | |
864 | AND (7760 /GET MINUS LENGTH IN BITS 0-7 | |
865 | CDF 10 | |
866 | TAD I (7617 | |
867 | DCA I (7617 /SET LENGTH AND DEVICE NO. FOR BATCH | |
868 | CDF | |
869 | JMP I (ERRDEC /CONVERT NUMBER OF ERRORS TO DECIMAL | |
870 | ||
871 | ||
872 | PAGE | |
873 | \f/CONVERT NUMBER OF CARDS IN ERROR TO DECIMAL AND TYPE MESSAGE | |
874 | ERRDEC, TAD (DECN-1 /START POWERS OF 10 AT 1000 | |
875 | DCA XR1 | |
876 | TAD (-4 | |
877 | DCA TEMP1 /FOUR POWERS OF 10 | |
878 | DCA TEMP5 /CLEAR LEADING ZEROES FLAG | |
879 | TAD ERRCNT /SET VALUE | |
880 | DCA TEMP4 | |
881 | TAD (TOUT /FUDGE OUTPUT CALL | |
882 | DCA OUTAD | |
883 | JMS CONDEC /CONVERT TO DECIMAL | |
884 | TAD (XOUT /RESTORE OUTPUT CALL | |
885 | DCA OUTAD | |
886 | TAD (NOMES /SET UP TO PRINT "NO" | |
887 | DCA TEMP1 | |
888 | TAD TEMP5 /DID WE PRINT A NUMBER? | |
889 | SNA CLA | |
890 | JMS I (TTYOUT /NO - PRINT "NO" | |
891 | TAD (CDMES /PRINT "CARDS IN ERROR" | |
892 | DCA TEMP1 | |
893 | JMS I (TTYOUT | |
894 | EOFJMP, JMP I (CD /DONE WITH THIS ONE - CALL COMMAND DECODER | |
895 | SYSNO /LOAD SYS: NUMBER FOR LOOKUP | |
896 | CIF 10;USR;LOOKUP | |
897 | BATBLK, BATNAM | |
898 | 0 | |
899 | JMP IOER8 | |
900 | TAD BATBLK | |
901 | DCA CHNBLK | |
902 | L0001 | |
903 | DCA I (JSBITS /KEEP USR ACROSS CHAIN | |
904 | CIF 10;USR;CHAIN /NOW CHAIN TO BATCH | |
905 | CHNBLK, 0 | |
906 | ||
907 | ||
908 | CONDEC, 0 /CONVERT A NUMBER TO DECIMAL | |
909 | SAVFLD;CONCIF /SAVE DATA FIELD FOR RETURN | |
910 | DIGLP, TAD I XR1 /GET THIS POWER OF 10 | |
911 | DCA TEMP2 /AND SAVE IT | |
912 | DCA TEMP3 /CLEAR THIS DIGIT | |
913 | DIGLP1, TAD TEMP4 /GET NUMBER TO BE CONVERTED | |
914 | TAD TEMP2 /DIVIDE BY SUBTRACTING | |
915 | SPA | |
916 | JMP DIGLP2 /WENT NEGATIVE - DONE | |
917 | ISZ TEMP3 /BUMP COUNT | |
918 | DCA TEMP4 /SAVE REDUCED VALUE | |
919 | JMP DIGLP1 | |
920 | DIGLP2, CLA | |
921 | TAD TEMP3 /GET VALUE OF THIS DIGIT | |
922 | SZA | |
923 | JMP DIGOUT /NOT A ZERO - PRINT IT | |
924 | TAD TEMP5 /IF ZERO - IS IT LEADING? | |
925 | SNA CLA | |
926 | JMP DIGLPE /YES - DON'T PRINT IT | |
927 | DIGOUT, ISZ TEMP5 /IF PRINTING, THEN ZEROES ARE NOT LEADING | |
928 | TAD (260 /CONVERT TO ASCII | |
929 | OUT | |
930 | DIGLPE, ISZ TEMP1 /LAST DIGIT? | |
931 | JMP DIGLP /NO - LOOP | |
932 | CONCIF, 0 | |
933 | JMP I CONDEC /RETURN | |
934 | ||
935 | ||
936 | TOUT, 0 /SEND A CHARACTER TO THE TTY | |
937 | TLS | |
938 | TSF | |
939 | JMP .-1 | |
940 | TAD (-215 /WAS THE CHARACTER <CR>? | |
941 | SZA CLA | |
942 | JMP I TOUT /NO - RETURN | |
943 | TAD (212 /YES - TYPE A LINE FEED | |
944 | JMP TOUT+1 | |
945 | ||
946 | ||
947 | IOERR1, CDF F0 | |
948 | CLA /TYPE ERROR MESSAGE | |
949 | TAD IOERR /GET NUMBER | |
950 | CLL RAL | |
951 | TAD (IOETAB-1 | |
952 | DCA XR1 | |
953 | TAD I XR1 /GET ADDRESS OF MESSAGE | |
954 | DCA TEMP1 | |
955 | DCA IOERR /CLEAR ERROR NUMBER | |
956 | JMS I (TTYOUT /PRINT IT | |
957 | TAD I XR1 /GO TO RESTART ADDRESS | |
958 | DCA TEMP1 | |
959 | JMP I TEMP1 | |
960 | ||
961 | ||
962 | PAGE | |
963 | \fOPTDEV, ZBLOCK 400 /TWO PAGES FOR DEVICE HANDLER | |
964 | OPTBUF, ZBLOCK 400 /TWO PAGES FOR OUTPUT BUFFER | |
965 | CDRBUF, DECIMAL;ZBLOCK 40;OCTAL | |
966 | BATNAM, TEXT "BATCH@SV";*.-1 | |
967 | MEND, TEXT "_$END_" | |
968 | NOMES, TEXT "NO" | |
969 | CDMES, TEXT " CARDS IN ERROR_" | |
970 | MSGJAM, TEXT "LOAD MORE CARDS OR TYPE ^Z_" | |
971 | IOEM1, TEXT "NO OUTPUT FILE SPECIFIED_" | |
972 | IOEM2, TEXT "CAN'T FETCH DEVICE HANDLER_" | |
973 | IOEM3, TEXT "CAN'T ENTER FILE_" | |
974 | IOEM4, TEXT "OUTPUT ERROR_" | |
975 | IOEM5, TEXT "FILE TOO BIG_" | |
976 | IOEM6, TEXT "CAN'T CLOSE FILE_" | |
977 | IOEM7, TEXT "CARD IN READER BACKWARDS. TYPE SPACE TO CONTINUE._" | |
978 | IOEM8, TEXT /"BATCH.SV" NOT ON SYS: - CAN'T CHAIN_/ | |
979 | VERM9, TEXT "MSBAT - VERSION 3A_@@@@@@" | |
980 | ||
981 | IOETAB, IOEM1;START | |
982 | IOEM2;START | |
983 | IOEM3;START | |
984 | IOEM4;START | |
985 | IOEM5;START | |
986 | IOEM6;START | |
987 | IOEM7;CDRJA1 | |
988 | IOEM8;7600 | |
989 | VERM9;START | |
990 | ||
991 | DECIMAL | |
992 | DECN, -1000 | |
993 | -100 | |
994 | -10 | |
995 | -1 | |
996 | OCTAL | |
997 | ||
998 | /CHARACTER CODE TRANSLATION TABLE | |
999 | TRTAB, | |
1000 | /0 IN ROWS 12-0 | |
1001 | 0021 /?1 | |
1002 | 2223 /23 | |
1003 | 2425 /45 | |
1004 | 2627 /67 | |
1005 | 3031 /89 | |
1006 | /1 | |
1007 | 2043 /0C | |
1008 | 4651 /FI | |
1009 | 5457 /LO | |
1010 | 6265 /RU | |
1011 | 7004 /X$ | |
1012 | /2 | |
1013 | 1442 /,B | |
1014 | 4550 /EH | |
1015 | 5356 /KN | |
1016 | 6164 /QT | |
1017 | 6772 /WZ | |
1018 | /3 | |
1019 | 3632 />: | |
1020 | 0106 /!& | |
1021 | 7540 /]@ | |
1022 | 0000 /<FORM FEED> ? | |
1023 | 0000 /?? | |
1024 | /4 | |
1025 | 1641 /.A | |
1026 | 4447 /DG | |
1027 | 5255 /JM | |
1028 | 6063 /PS | |
1029 | 6671 /VY | |
1030 | /5 | |
1031 | 3400 /<? | |
1032 | 0000 /?? | |
1033 | 0000 /?? | |
1034 | 0000 /?? | |
1035 | 0000 /?? | |
1036 | /6 | |
1037 | 3303 /;# | |
1038 | 0705 /'% | |
1039 | 7337 /[? THE REAL ? | |
1040 | 0077 /<TAB> _ | |
1041 | 0000 /?? | |
1042 | /7 | |
1043 | 7435 /\= | |
1044 | 1315 /+- | |
1045 | 1217 /*/ | |
1046 | 7610 /^( | |
1047 | 1102 /)" | |
1048 | ||
1049 | ||
1050 | \f/BASIC KEYWORDS | |
1051 | BDAT, TEXT "DATA" | |
1052 | BCAL, TEXT "CALL" | |
1053 | BCLO, TEXT "CLOSE" | |
1054 | BDEF, TEXT "DEFINE" | |
1055 | BCHN, TEXT "CHAIN" | |
1056 | BDIM, TEXT "DIMENSION" | |
1057 | BCHG, TEXT "CHANGE" | |
1058 | BEND, TEXT "END" | |
1059 | BEND2, TEXT "CLOSE #4\END" | |
1060 | BFIL, TEXT "FILE" | |
1061 | BGOS, TEXT "GOSUB" | |
1062 | BIF, TEXT "IF" | |
1063 | BINP, TEXT "INPUT" | |
1064 | BINP2, TEXT "INPUT #3:" | |
1065 | BLIS, TEXT "LIST" | |
1066 | BNEX, TEXT "NEXT" | |
1067 | BOLD, TEXT "OLD" | |
1068 | BPRI, TEXT "PRINT" | |
1069 | BPRI2, TEXT "PRINT #4:" | |
1070 | BREA, TEXT "READ" | |
1071 | BRES, TEXT "RESTORE" | |
1072 | BRUN, TEXT "RUN" | |
1073 | BFOR, TEXT "FOR" | |
1074 | BGOT, TEXT "GOTO" | |
1075 | BIFE, TEXT "IF END" | |
1076 | BLET, TEXT "LET" | |
1077 | BLIN, TEXT "LINPUT" | |
1078 | BNEW, TEXT "NEW" | |
1079 | BON, TEXT "ON" | |
1080 | BRND, TEXT "RANDOM" | |
1081 | BOV, TEXT "OVERLAY" | |
1082 | BREP, TEXT "REPLACE" | |
1083 | BUNS, TEXT "UNSAVE" | |
1084 | BREM, TEXT "REMARK" | |
1085 | BRET, TEXT "RETURN" | |
1086 | BSAV, TEXT "SAVE" | |
1087 | BSTO, TEXT "STOP" | |
1088 | BSTO2, TEXT "CLOSE #4\STOP" | |
1089 | ||
1090 | /FORTRAN KEYWORDS | |
1091 | FCMN, TEXT "@COMMON" | |
1092 | FASN, TEXT "@ASSIGN" | |
1093 | FCPX, TEXT "@COMPLEX" | |
1094 | FBKS, TEXT "@BACKSPACE" | |
1095 | FCNT, TEXT "@CONTINUE" | |
1096 | FBKD, TEXT "@BLOCK DATA" | |
1097 | FDTA, TEXT "@DATA" | |
1098 | FCAL, TEXT "@CALL" | |
1099 | FDEF, TEXT "@DEFINE FILE" | |
1100 | FDO, TEXT "@DO" | |
1101 | FEND, TEXT "@END" | |
1102 | FEQU, TEXT "@EQUIVALENCE" | |
1103 | FFOR, TEXT "@FORMAT" | |
1104 | FGOT, TEXT "@GO TO" | |
1105 | FINT, TEXT "@INTEGER" | |
1106 | FPAU, TEXT "@PAUSE" | |
1107 | FREAL, TEXT "@REAL" | |
1108 | FREW, TEXT "@REWIND" | |
1109 | FSBR, TEXT "@SUBROUTINE" | |
1110 | FCMT, TEXT "C" /COMMENT | |
1111 | FDIM, TEXT "@DIMENSION" | |
1112 | FDBP, TEXT "@DOUBLE PRECISION" | |
1113 | FEF, TEXT "@END FILE" | |
1114 | FEXT, TEXT "@EXTERNAL" | |
1115 | FFUN, TEXT "@FUNCTION" | |
1116 | FIF, TEXT "@IF" | |
1117 | FLOG, TEXT "@LOGICAL" | |
1118 | FREAD, TEXT "@READ" | |
1119 | FRET, TEXT "@RETURN" | |
1120 | FSTO, TEXT "@STOP" | |
1121 | FWRI, TEXT "@WRITE" | |
1122 | \fBASKEY, | |
1123 | /COLUMN 7 ROW | |
1124 | BDEF /12 | |
1125 | BIFE /11 | |
1126 | BLET /0 | |
1127 | BLIS /1 | |
1128 | BNEW /2 | |
1129 | BON /3 | |
1130 | BOV /4 | |
1131 | BRND /5 | |
1132 | BREM /6 | |
1133 | BRES /7 | |
1134 | BRUN /8 | |
1135 | BSTKEY, BSTO /9 | |
1136 | /COLUMN 8 ROW | |
1137 | BDIM /12 | |
1138 | BINKEY, BINP /11 | |
1139 | BLIN /0 | |
1140 | BNEX /1 | |
1141 | BOLD /2 | |
1142 | BFIL /3 | |
1143 | BPRKEY, BPRI /4 | |
1144 | BREA /5 | |
1145 | BREP /6 | |
1146 | BRET /7 | |
1147 | BSAV /8 | |
1148 | BUNS /9 | |
1149 | /COLUMNS 2-6 COLUMN ROW | |
1150 | BCAL /2 12 | |
1151 | BENKEY, BEND /2 11 | |
1152 | BCLO /3 12 | |
1153 | BFOR /3 11 | |
1154 | BCHN /4 12 | |
1155 | BGOS /4 11 | |
1156 | BCHG /5 12 | |
1157 | BGOT /5 11 | |
1158 | BDAT /6 12 | |
1159 | BIF /6 11 | |
1160 | ||
1161 | ||
1162 | FORKEY, | |
1163 | /COLUMN 7 /ROW | |
1164 | FCAL /12 | |
1165 | FDEF /11 | |
1166 | FDO /0 | |
1167 | FEND /1 | |
1168 | FEQU /2 | |
1169 | FFOR /3 | |
1170 | FGOT /4 | |
1171 | FINT /5 | |
1172 | FPAU /6 | |
1173 | FREAL /7 | |
1174 | FREW /8 | |
1175 | FSBR /9 | |
1176 | /COLUMN 8 ROW | |
1177 | FCMT /12 | |
1178 | FDIM /11 | |
1179 | FDBP /0 | |
1180 | FEF /1 | |
1181 | FEXT /2 | |
1182 | FFUN /3 | |
1183 | FIF /4 | |
1184 | FLOG /5 | |
1185 | FREAD /6 | |
1186 | FRET /7 | |
1187 | FSTO /8 | |
1188 | FWRI /9 | |
1189 | /COLUMN 2-6 COLUMN ROW | |
1190 | 0 /2 12 | |
1191 | 0 /2 11 | |
1192 | 0 /3 12 | |
1193 | FCMN /3 11 | |
1194 | FASN /4 12 | |
1195 | FCPX /4 11 | |
1196 | FBKS /5 12 | |
1197 | FCNT /5 11 | |
1198 | FBKD /6 12 | |
1199 | FDTA /6 11 | |
1200 | ||
1201 | ||
1202 | \f FIELD 1 | |
1203 | ||
1204 | ||
1205 | ||
1206 | ||
1207 | ||
1208 | *17 | |
1209 | ||
1210 | ||
1211 | OXR1, 0 | |
1212 | OTEMP1, 0 | |
1213 | CHAR, 0 | |
1214 | PUTPNT, 0 | |
1215 | GETPNT, 0 | |
1216 | DATFTN, 0 /ADDRESS OF FORTRAN $RUN | |
1217 | GETCHR=JMS I .;XGETCH | |
1218 | PUTCHR=JMS I .;XPUTCH | |
1219 | BCLIN=JMS I .;XBCLIN | |
1220 | OPTION=JMS I .;XOPTIO | |
1221 | MOV6=JMS I .;XMOV6 | |
1222 | COLNAM=JMS I .;XCOLNA | |
1223 | OUTNAM=JMS I .;XOUTNA | |
1224 | ISIT=JMS I .;XISIT | |
1225 | SEND=JMS I .;XSEND | |
1226 | TSTCR=JMS I .;XTSTCR | |
1227 | CDRTRA=JMS I .;BCLTRA+1 | |
1228 | ISNUM=JMS I .;XISNUM | |
1229 | OUT1=JMS I .;OOUT1 | |
1230 | \f*200 | |
1231 | ||
1232 | ||
1233 | /PUT A CHARACTER INTO A 6-BIT BUFFER | |
1234 | PUTCH1=XGETCH | |
1235 | PUTCH4=CON628 | |
1236 | XPUTCH, 0 | |
1237 | TAD (-215 /IF <CR>, IT BECOMES 37 | |
1238 | SZA | |
1239 | TAD (215-337 | |
1240 | TAD (337 | |
1241 | AND (77 /AND OFF 6 BITS | |
1242 | DCA PUTCH1 /SAVE IT IN A TEMP | |
1243 | TAD PUTPNT /GET POINTER TO CHARACTER IN 6-BIT BUFFER | |
1244 | ISZ PUTPNT /AND BUMP POINTER | |
1245 | CLL RAR /GET WORD DISPLACEMENT | |
1246 | TAD I XPUTCH /ADD IN BASE ADDRESS | |
1247 | ISZ XPUTCH /BUMP RETURN ADDRESS | |
1248 | DCA PUTCH4 /SAVE ADDRESS OF WORD CONTAINING CHAR | |
1249 | SZL /LINK HAS FIRST OR LAST HALF INDICATOR | |
1250 | JMP PUTCH2 | |
1251 | TAD PUTCH1 /FIRST HALF - ROTATE CHAR INTO HIGH BITS | |
1252 | CLL RTL;RTL;RTL | |
1253 | DCA PUTCH1 | |
1254 | TAD I PUTCH4 /GET ANY CHARACTER ALREADY THERE | |
1255 | AND (77 | |
1256 | JMP PUTCH3 | |
1257 | PUTCH2, TAD I PUTCH4 | |
1258 | AND (7700 /GET CHARACTER ALREADY THERE | |
1259 | PUTCH3, TAD PUTCH1 /ADD IN NEW CHARACTER | |
1260 | DCA I PUTCH4 /STORE THEM BOTH | |
1261 | JMP I XPUTCH /AND RETURN | |
1262 | ||
1263 | ||
1264 | /GET A CHARACTER FROM A 6-BIT BUFFER | |
1265 | XGETCH, 0 | |
1266 | TAD XGETCH /MOVE RETURN ADDRESS TO CON628 | |
1267 | DCA CON628 | |
1268 | TAD GETPNT /GET POINTER TO CHARACTER | |
1269 | ISZ GETPNT /BUMP IT FOR NEXT TIME | |
1270 | JMP CON628+1 /ENTER CONVERSION ROUTINE | |
1271 | ||
1272 | ||
1273 | /CONVERT 6-BIT ASCII TO 8-BIT | |
1274 | /AC HAS POINTER TO CHARACTER | |
1275 | /ARGUMENT IS BASE ADDRESS OF BUFFER | |
1276 | CO628X=XGETCH | |
1277 | CON628, 0 | |
1278 | CLL RAR /GET WORD DISPLACEMENT IN AC | |
1279 | TAD I CON628 /ADD BASE ADDRESS OF BUFFER | |
1280 | ISZ CON628 /BUMP RETURN ADDRESS | |
1281 | DCA CO628X /SAVE ADDRESS | |
1282 | TAD I CO628X /GET WORD CONTAINING CHARACTER | |
1283 | SZL /LINK HAS INDICATOR FOR FIRST OR LAST CHAR | |
1284 | JMP .+4 | |
1285 | RTR;RTR;RTR /FIRST CHAR - PUT IN LOW BITS | |
1286 | AND (77 | |
1287 | JMS XSEND3 /GET PROPER 8-BIT REPRESENTATION | |
1288 | DCA CHAR /SAVE IT | |
1289 | TAD CHAR /RETURN WITH IT IN AC | |
1290 | JMP I CON628 /RETURN | |
1291 | ||
1292 | ||
1293 | XSEND3, 0 | |
1294 | TAD (-37 | |
1295 | SNA | |
1296 | TAD (215-337 | |
1297 | SPA | |
1298 | TAD (100 | |
1299 | TAD (237 | |
1300 | JMP I XSEND3 | |
1301 | ||
1302 | ||
1303 | GETCDR, 0 | |
1304 | CIF CDF F0 | |
1305 | JMS I (GETCD1 /GET A CHAR FROM THE CDR BUFFER | |
1306 | JMP I GETCDR | |
1307 | ||
1308 | ||
1309 | OOUT1, 0 | |
1310 | CIF CDF F0 | |
1311 | JMS I (OOUT2 | |
1312 | JMP I OOUT1 | |
1313 | ||
1314 | ||
1315 | MOVODV, 0 | |
1316 | DCA .+2 | |
1317 | MOV6;0;BATOUT | |
1318 | CIF F0 /RETURN DF=1 | |
1319 | JMP I MOVODV | |
1320 | ||
1321 | ||
1322 | XTSTCR, 0 | |
1323 | GETCHR;BCLBUF | |
1324 | TAD (-215 | |
1325 | SNA CLA | |
1326 | ISZ XTSTCR | |
1327 | L7777 | |
1328 | TAD GETPNT | |
1329 | DCA GETPNT | |
1330 | JMP I XTSTCR | |
1331 | ||
1332 | ||
1333 | PAGE | |
1334 | \f/SUBROUTINE OPTION WILL SCAN THE BATCH CONTROL LANGUAGE | |
1335 | /BUFFER FOR OPTIONS SPECIFIED IN IT'S CALL. AN OPTION IS | |
1336 | /RECOGNIZED AS ANY ITEM WHICH FOLLOWS A "/". IT'S NAME | |
1337 | /IS COMPOSED OF ANY CHARACTERS OTHER THAN "/" , "," , | |
1338 | /"=",OR <CR>. THE NAME IS TERMINATED BY ANY ONE OF THE | |
1339 | /PREVIOUS DELIMITERS. IF IT IS TERMINATED BY A "=" AND | |
1340 | /THE SUBROUTINE CALL INDICATES THAT IT EXPECTS A FILE NAME, | |
1341 | /THEN THE FILE NAME FOLLOWS THE "=" AND IS TERMINATED BY A | |
1342 | /"/" , "," , OR <CR>. THE SUBROUTINE CALL IS FOLLOWED BY A | |
1343 | /POINTER TO A LIST OF ADDRESSES. THIS LIST IS TERMINATED BY | |
1344 | /A ZERO ENTRY. EACH ENTRY POINTS TO AN OPTION CONTROL | |
1345 | /BLOCK IN THE FOLLOWING FORM: | |
1346 | / OPTION CONTROL WORD | |
1347 | / (FILE NAME SPACE IF NEEDED - 6 WORDS) | |
1348 | / TEXT "OPTION NAME" | |
1349 | / | |
1350 | /THE FORMAT OF THE OPTION CONTROL WORD IS AS FOLLOWS: | |
1351 | / BIT 0: ON RETURN THIS BIT WILL BE SET IF | |
1352 | / THE OPTION WAS FOUND, AND CLEARED | |
1353 | / IF NOT | |
1354 | / BIT1: ON RETURN THIS BIT IS SET IF A NAME | |
1355 | / WAS GIVEN WITH THE OPTION | |
1356 | / BIT 2: SET IF OPTION HAS ALLOCATED 6 WORDS | |
1357 | / FOR A POSSIBLE FILE NAME. CLEARED | |
1358 | / IF NOT | |
1359 | / BITS 6-8: NUMBER OF CHARACTERS -1 OF SHORT | |
1360 | / FORM OF OPTION | |
1361 | / BITS 9-11: DIFFERENCE BETWEEN SIZES OF | |
1362 | / SHORT AND LONG FORMS | |
1363 | / THE SUM OF BITS 6-8 AND BITS 9-11 | |
1364 | / SHOULD TOTAL THE LENGTH OF THE | |
1365 | / LONG FORM-1 | |
1366 | / | |
1367 | /THE FILE NAME SPACE MAY BE INITIALIZED TO SOME DEFAULT | |
1368 | /DEVICE, NAME, AND EXTENSION. | |
1369 | / | |
1370 | XOPTIO, 0 | |
1371 | ||
1372 | /TURN OFF ALL OPTIONS | |
1373 | TAD I XOPTIO /GET ADDRESS OF LIST OF OPTION ADDRESSES | |
1374 | DCA OPTLIS /SAVE IT | |
1375 | OPTIO1, TAD I OPTLIS /GET OPTION ADDRESS | |
1376 | ISZ OPTLIS /POINT TO NEXT ONE | |
1377 | SNA | |
1378 | JMP OPTIO2 /DONE TURNING OFF ALL OPTIONS | |
1379 | DCA OPTCTL | |
1380 | TAD I OPTCTL /GET OPTION CONTROL WORD | |
1381 | AND (1777 /CLEAR FIRST BIT | |
1382 | DCA I OPTCTL | |
1383 | JMP OPTIO1 /LOOP | |
1384 | ||
1385 | /SEARCH BCL BUFFER FOR "/" | |
1386 | OPTIO2, DCA GETPNT /START AT BEGINNING OF BATCH CONTROL LINE | |
1387 | OPTIO3, GETCHR;BCLBUF /GET A CHARACTER FROM THE BUFFER | |
1388 | ISIT /IS IT "/" OR <CR>? | |
1389 | OPTIS3;OPTIS4-1 | |
1390 | JMP OPTIO3 /NO - KEEP LOOKING | |
1391 | OPTI3A, TAD GETPNT /YES - SAVE IT'S POSITION | |
1392 | DCA OPTBEG | |
1393 | TAD I XOPTIO /GET ADDRESS OF LIST AGAIN | |
1394 | DCA OPTLIS /AND SAVE IT | |
1395 | ||
1396 | /FOUND A "/" - TRY ALL OPTIONS | |
1397 | OPTIO4, TAD OPTBEG /START COMPARISON OF OPTION WITH CHARACTER AFTER "/" | |
1398 | DCA GETPNT | |
1399 | TAD I OPTLIS /GET ADDRESS OF OPTION CONTROL WORD | |
1400 | ISZ OPTLIS /AND BUMP POINTER FOR NEXT TIME | |
1401 | SNA /IS THE LIST ENDED? | |
1402 | JMP I (OPTIER /YES - OPTION WAS INVALID | |
1403 | DCA OPTCTL /NO - SAVE ADDRESS OF CONTROL WORD | |
1404 | TAD I OPTCTL /GET CONTROL WORD | |
1405 | RTL | |
1406 | SPA CLA /DOES IT HAVE SPACE FOR A FILE NAME | |
1407 | TAD (6 /YES - ADD SIZE OF THE SPACE | |
1408 | TAD OPTCTL /ADD ADDRESS OF OPTION | |
1409 | IAC /BUMP ONE FOR CONTROL WORD | |
1410 | DCA OPTTEX /SAVE ADDRESS OF OPTION TEXT | |
1411 | TAD I OPTCTL /GET LENGTH FOR UNIQUE OPTION FROM CONTROL WORD | |
1412 | RAR;RTR | |
1413 | AND (7 | |
1414 | CMA /NEGATE IT (INCREMENTED BY ONE) | |
1415 | DCA OPTCT1 /SAVE IN COUNTER | |
1416 | DCA OPTCT2 /ZERO CHARACTER POSITION | |
1417 | \f/COMPARE OPTION WITH CONTENTS OF BCL BUFFER | |
1418 | OPTIO5, JMS OPTI6A | |
1419 | SZA CLA /ARE THEY THE SAME? | |
1420 | JMP OPTIO4 /NO - TRY NEXT OPTION | |
1421 | ISZ OPTCT1 /HAVE WE SUCCEEDED FAR ENOUGH FOR IT TO BE UNIQUE? | |
1422 | JMP OPTIO5 /NO - KEEP COMPARING | |
1423 | ||
1424 | TAD GETPNT /SAVE CURRENT BUFFER POSITION | |
1425 | DCA OPTTM2 | |
1426 | TAD I OPTCTL /GET REMAINING LENGTH FROM CONTROL WORD | |
1427 | AND (7 | |
1428 | CMA | |
1429 | DCA OPTCT1 | |
1430 | OPTIO6, ISZ OPTCT1 /DONE WITH REMAINING CHARACTERS? | |
1431 | SKP | |
1432 | JMP OPTIO7 /YES - SUCCESS | |
1433 | JMS OPTI6A | |
1434 | SNA CLA /ARE THEY THE SAME? | |
1435 | JMP OPTIO6 /YES - KEEP GOING | |
1436 | TAD OPTTM2 /NO - MOVE POINTER BACK TO SHORT FORM | |
1437 | DCA GETPNT | |
1438 | JMP OPTIO7 | |
1439 | ||
1440 | OPTI6A, 0 | |
1441 | TAD OPTCT2 | |
1442 | ISZ OPTCT2 | |
1443 | JMS I (CON628 | |
1444 | OPTTEX, 0 | |
1445 | CIA | |
1446 | DCA OPTTM1 | |
1447 | GETCHR;BCLBUF | |
1448 | TAD OPTTM1 | |
1449 | JMP I OPTI6A | |
1450 | ||
1451 | ||
1452 | OPTRET, ISZ XOPTIO /INCREMENT RETURN ADDRESS | |
1453 | DCA GETPNT /SET POINTER TO BEGINNING OF BUFFER | |
1454 | JMP I XOPTIO | |
1455 | ||
1456 | ||
1457 | OPTLIS, 0 | |
1458 | OPTCTL, 0 | |
1459 | OPTBEG, 0 | |
1460 | OPTCT1, 0 | |
1461 | OPTCT2, 0 | |
1462 | OPTTM1, 0 | |
1463 | OPTTM2, 0 | |
1464 | ||
1465 | ||
1466 | \f/TEST DELIMITER AFTER OPTION | |
1467 | OPTIO7, GETCHR;BCLBUF /GET NEXT BUFFER CHARACTER | |
1468 | ISIT /IS IT "=", "," ,"/", OR <CR>? | |
1469 | OPTIS1;OPTIS2-1 | |
1470 | JMP I (OPTIER /NONE OF THESE | |
1471 | OPTIO8, TAD I OPTCTL /YES - GET CONTROL WORD | |
1472 | RTL | |
1473 | SMA CLA /DOES IT TAKE A FILE NAME? | |
1474 | JMP I (OPTIER /NO - ERROR | |
1475 | TAD OPTCTL /GET ADDRESS OF FILE NAME SPACE | |
1476 | IAC | |
1477 | DCA .+2 | |
1478 | COLNAM /AND COLLECT A NAME INTO IT | |
1479 | OPTTM3, 0 | |
1480 | JMP I (OPTIER /ERROR RETURN | |
1481 | TAD I OPTCTL /TURN ON NAME BIT | |
1482 | AND (1777 | |
1483 | TAD (2000 | |
1484 | DCA I OPTCTL | |
1485 | OPTIO9, TAD I OPTCTL /GET CONTROL WORD | |
1486 | AND (3777 | |
1487 | TAD (4000 /TURN ON OPTION FOUND BIT | |
1488 | DCA I OPTCTL | |
1489 | JMP I (OPTI10 | |
1490 | ||
1491 | ||
1492 | PAGE | |
1493 | \f/ON ERROR, REPORT IT | |
1494 | OPTIER, TAD I (OPTBEG /OPTION BEGINS AT THIS POSITION | |
1495 | JMS OUTERR /OUTPUT THE ERROR | |
1496 | OPTERM | |
1497 | ||
1498 | /SQUISH THE CURRENT OPTION OUT OF BCL BUFFER | |
1499 | OPTI10, L7777 /BACK UP OVER "/" | |
1500 | TAD I (OPTBEG /POINT TO BEGINNING OF OPTION | |
1501 | JMS BCLSQU /SQUISH OUT THIS OPTION | |
1502 | L7777 | |
1503 | TAD I (OPTBEG | |
1504 | JMP I (OPTIO2 /GO LOOK FOR MORE OPTIONS | |
1505 | ||
1506 | ||
1507 | \f/SQUISH OUT A PORTION OF THE BCL BUFFER | |
1508 | / TAD X /POSITION OF FIRST CHAR OF SQUISH | |
1509 | / JMS BCLSQU | |
1510 | /GETPNT POINTS TO FIRST CHAR SURE TO BE KEPT AFTER | |
1511 | /SQUISH CHARS. ONE CHAR PRECEDING IT IS TESTED, | |
1512 | /AND IS KEPT IF IT IS A "/" OR <CR> | |
1513 | BCLSQU, 0 | |
1514 | DCA PUTPNT /AC POINTS TO BEGINNING OF AREA TO BE SQUISHED | |
1515 | TAD PUTPNT /SAVE THE POINTER | |
1516 | DCA OUTERR | |
1517 | L7777 | |
1518 | TAD GETPNT | |
1519 | DCA GETPNT /TEST LAST CHAR OF STUFF TO BE SQUISHED | |
1520 | GETCHR;BCLBUF | |
1521 | ISIT /IS IT "/", OR <CR>? | |
1522 | BCLIS1;BCLIS2-1 | |
1523 | BCLSQ1, GETCHR;BCLBUF /GET A CHAR | |
1524 | TAD (-215 /IS IT <CR>? | |
1525 | SNA CLA | |
1526 | JMP BCLSQ3 /YES - DONE | |
1527 | BCLSQ2, TAD CHAR /RESTORE CHAR | |
1528 | PUTCHR;BCLBUF /PUT THE CHAR IN THE BUFFER | |
1529 | JMP BCLSQ1 /GET ANOTHER CHAR | |
1530 | BCLSQ3, TAD (215 /PUT A <CR> | |
1531 | PUTCHR;BCLBUF | |
1532 | TAD OUTERR /RESTORE POINTER | |
1533 | DCA GETPNT | |
1534 | JMP I BCLSQU /RETURN | |
1535 | ||
1536 | ||
1537 | /SEND AN ERROR MESSAGE INCLUDING PART OF THE BCL BUFFER | |
1538 | /TO THE OUTPUT BUFFER | |
1539 | / TAD X /POSITION OF FIRST CHAR IN BUFFER TO BE SENT | |
1540 | / JMS OUTERR | |
1541 | / A /ADDRESS OF ERROR MESSAGE TO PRECEDE IT | |
1542 | / /SIX-BIT ASCII | |
1543 | OUTERR, 0 | |
1544 | DCA GETPNT /SET BEGINNING OF BCL LINE TO OUTPUT | |
1545 | TAD I OUTERR /GET ERROR MESSAGE ADDRESS | |
1546 | ISZ OUTERR | |
1547 | SEND /PRINT IT | |
1548 | OUTER1, GETCHR;BCLBUF /GET A CHARACTER | |
1549 | ISIT /IS IT "," ,"/", OR <CR>? | |
1550 | OUTIS1;OUTIS2-1 | |
1551 | TAD CHAR /NO - SEND CHAR | |
1552 | OUT1 | |
1553 | JMP OUTER1 | |
1554 | OUTER2, TAD (215 | |
1555 | OUT1 | |
1556 | JMP I OUTERR /RETURN | |
1557 | ||
1558 | ||
1559 | /TEST A CHAR AND JUMP IF IN LIST | |
1560 | / JMS XISIT | |
1561 | / A1 /ADDRESS OF LIST OF NEGATIVE OF CHARS | |
1562 | / /TERMINATED BY A POSITIVE OR ZERO | |
1563 | / A2-1 /ADDRESS -1 OF LIST OF | |
1564 | / /TRANSFER ADDRESSES | |
1565 | XISIT, 0 | |
1566 | DCA ISIT1 /SAVE CHAR | |
1567 | TAD I XISIT /GET LIST OF CHARS | |
1568 | ISZ XISIT | |
1569 | DCA ISIT2 | |
1570 | TAD I XISIT /GET LIST OF ADDRS - 1 | |
1571 | ISZ XISIT | |
1572 | DCA ISIT3 | |
1573 | ISIT4, TAD I ISIT2 /GET THE NEXT CHAR | |
1574 | ISZ ISIT2 | |
1575 | ISZ ISIT3 | |
1576 | SMA | |
1577 | JMP ISIT5 /END OF LIST SIGNALLED BY ENTRY>=0 | |
1578 | TAD ISIT1 /IS IT THE CHAR? | |
1579 | SZA CLA | |
1580 | JMP ISIT4 /NO - TRY THE NEXT | |
1581 | TAD I ISIT3 /GET SEND ADDRESS | |
1582 | DCA XISIT | |
1583 | ISIT5, CLA | |
1584 | JMP I XISIT | |
1585 | ||
1586 | ISIT1, 0 | |
1587 | ISIT2, 0 | |
1588 | ISIT3, 0 | |
1589 | ||
1590 | ||
1591 | PAGE | |
1592 | \f/COLLECT A NAME FROM THE BUFFER | |
1593 | / JMS XCOLNA | |
1594 | / X /ADDRESS OF SPACE TO RECEIVE NAME | |
1595 | / JMP ERR /INVALID NAME | |
1596 | XCOLNA, 0 | |
1597 | TAD I XCOLNA | |
1598 | DCA .+3 | |
1599 | MOV6;ZER6;0 | |
1600 | TAD I XCOLNA /ARGUMENT IS ADDRESS TO PUT NAME | |
1601 | ISZ XCOLNA | |
1602 | DCA COLPU1+2 /SAVE IT FOR USE AS PUTCHR ARG | |
1603 | L7776 /SET NAME - EXTENSION SWITCH FOR NAME | |
1604 | DCA COLSW | |
1605 | TAD (COLIS1 /SET TO COLLECT ANYTHING | |
1606 | DCA COLIS3 /I.E. DEVICE, FILE, OR EXTENSION | |
1607 | TAD (COLIS2-1 | |
1608 | DCA COLIS3+1 | |
1609 | TAD GETPNT /SAVE POINTER TO BEGINNING OF NAME | |
1610 | DCA COLNP1 | |
1611 | COLGE1, TAD GETPNT /SAVE POINTER TO BEGINNING OF SECTION | |
1612 | DCA COLNP2 /OF NAME | |
1613 | COLGE2, GETCHR;BCLBUF /GET A CHAR | |
1614 | ISIT /IS IT ":",".","/", "," , OR <CR>? | |
1615 | COLIS3, 0;0 | |
1616 | JMP COLGE2 | |
1617 | ||
1618 | COLDEV, JMS COLMOV;0;-4-1 /MOVE 4 CHARS TO POSITION 0 | |
1619 | ISZ COLIS3 /REMOVE ":" FROM LIST | |
1620 | ISZ COLIS3+1 | |
1621 | JMP COLGE1 /COLLECT NEXT PART OF NAME | |
1622 | ||
1623 | COLFIL, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 | |
1624 | ISZ COLSW /NEXT TIME COLLECT EXTENSION | |
1625 | TAD (COLIS1+2 /REMOVE "." FROM LIST | |
1626 | DCA COLIS3 | |
1627 | TAD (COLIS2+1 | |
1628 | DCA COLIS3+1 | |
1629 | JMP COLGE1 /COLLECT NEXT PART OF NAME | |
1630 | ||
1631 | COLEXT, ISZ COLSW /ARE WE COLLECTING NAME OR EXTENSION? | |
1632 | JMP COLEX1 /NAME | |
1633 | JMS COLMOV;12;-2-1 /MOVE 2 CHARS TO POSITION 12 | |
1634 | JMP COLEX2 | |
1635 | COLEX1, JMS COLMOV;4;-6-1 /MOVE 6 CHARS TO POSITION 4 | |
1636 | COLEX2, ISZ XCOLNA /NO ERRORS | |
1637 | JMP COLEX3 | |
1638 | ||
1639 | COLERR, CLA | |
1640 | TAD COLNP1 /POINT TO BEGINNING OF NAME | |
1641 | JMS I (OUTERR /SEND IT AS ERROR MESSAGE | |
1642 | COLERM | |
1643 | COLEX3, TAD COLNP1 /POINT TO BEGINNING OF NAME | |
1644 | JMS I (BCLSQU /SQUISH IT OUT | |
1645 | JMP I XCOLNA /RETURN | |
1646 | ||
1647 | COLMOV, 0 | |
1648 | TAD I COLMOV /FIRST ARG IS POSITION | |
1649 | ISZ COLMOV | |
1650 | DCA PUTPNT | |
1651 | TAD I COLMOV /SECOND ARG IS COUNT | |
1652 | ISZ COLMOV | |
1653 | DCA COLCT1 | |
1654 | TAD CHAR /GET DELIMITER | |
1655 | CIA | |
1656 | DCA COLCH1 /SAVE FOR TEST | |
1657 | TAD CHAR | |
1658 | TAD (-"Z | |
1659 | DCA COLCH2 /ANOTHER TEST | |
1660 | TAD COLNP2 /POINT TO BEGINNING OF THIS PART | |
1661 | DCA GETPNT | |
1662 | COLMV1, GETCHR;BCLBUF /GET NEXT CHAR | |
1663 | TAD COLCH1 /SUBTRACT THE DELIMITER | |
1664 | SNA | |
1665 | JMP I COLMOV /DELIMITER - WE'RE DONE | |
1666 | TAD COLCH2 /CHAR-"Z" | |
1667 | SMA SZA | |
1668 | JMP COLERR /NOT ALPHA-NUMERIC | |
1669 | TAD ("Z-"A | |
1670 | SMA | |
1671 | JMP COLPUT /ALPHABETIC | |
1672 | TAD ("A-"9 | |
1673 | SMA SZA | |
1674 | JMP COLERR /NOT NUMERIC | |
1675 | TAD ("9-"0 | |
1676 | SPA | |
1677 | JMP COLERR /NOT NUMERIC | |
1678 | COLPUT, CLA | |
1679 | ISZ COLCT1 /HAVE WE USED UP OUR COUNT? | |
1680 | JMP COLPU1 /NO - PUT THE CHAR | |
1681 | L7777 /YES - SET COUNTER TO SKIP | |
1682 | DCA COLCT1 | |
1683 | JMP COLMV1 /GET NEXT CHAR | |
1684 | COLPU1, TAD CHAR | |
1685 | PUTCHR;0 /PUT THE CHAR IN THE USER SPACE | |
1686 | JMP COLMV1 /GET THE NEXT CHAR | |
1687 | ||
1688 | ||
1689 | COLSW, 0 /FILE NAME OR EXTENSION SWITCH | |
1690 | COLNP1, 0 /POINTER TO BEGINNING OF NAME | |
1691 | COLNP2, 0 /POINTER TO BEGINNING OF NAME PART | |
1692 | COLCH1, 0 /TEMP LOC FOR COLMOV | |
1693 | COLCH2, 0 /DITTO | |
1694 | COLCT1, 0 /DITTO | |
1695 | ||
1696 | PAGE | |
1697 | \fXMOV6, 0 | |
1698 | TAD I XMOV6 /GET "FROM" ADDRESS | |
1699 | ISZ XMOV6 | |
1700 | DCA MOV61 | |
1701 | TAD I XMOV6 /GET "TO" ADDRESS | |
1702 | ISZ XMOV6 | |
1703 | DCA MOV62 | |
1704 | TAD (-6 | |
1705 | DCA MOV63 | |
1706 | MOV64, TAD I MOV61 | |
1707 | DCA I MOV62 | |
1708 | ISZ MOV61 | |
1709 | ISZ MOV62 | |
1710 | ISZ MOV63 | |
1711 | JMP MOV64 | |
1712 | JMP I XMOV6 /RETURN | |
1713 | MOV61, 0 | |
1714 | MOV62, 0 | |
1715 | MOV63, 0 | |
1716 | ||
1717 | ||
1718 | XBCLIN, 0 | |
1719 | DCA PUTPNT /START AT BEGINNING OF BCL BUFFER | |
1720 | JMS I (SENDKY /SEND THE KEYWORD | |
1721 | DCA MOV61 /CLEAR THE BLANK COUNTER | |
1722 | BCLIN5, JMS BCLIN3 /GET NEXT CARD AND PUT IT INTO BCL BUFFER | |
1723 | JMP BCLIN7+2 /CARD NOT CONTINUED - DONE | |
1724 | CIF F0 | |
1725 | JMS I (CDRIN /READ ANOTHER CARD | |
1726 | JMP BCLIN7+2 /EOF | |
1727 | TAD (-10 | |
1728 | DCA BCLIN4 | |
1729 | BCLIN6, JMS I (GETCDR /GET FIRST 8 CHARS | |
1730 | SZA CLA /TEST FOR ZERO | |
1731 | JMP BCLIN7 /NON-ZERO - ERROR | |
1732 | ISZ BCLIN4 | |
1733 | JMP BCLIN6 | |
1734 | JMP BCLIN5 /OK - PUT IT IN BUFFER | |
1735 | ||
1736 | BCLIN7, CDF F0 | |
1737 | DCA I (CDRFLG /SET CDRIN TO RETURN THIS CARD AGAIN | |
1738 | CDF F1 | |
1739 | TAD (215 /PUT A <CR> | |
1740 | PUTCHR;BCLBUF | |
1741 | TAD (215;OUT1 | |
1742 | DCA GETPNT /SET POINTER TO BEGINNING | |
1743 | JMP I XBCLIN /RETURN | |
1744 | ||
1745 | BCLIN4, 0 | |
1746 | BCLIN3, 0 | |
1747 | TAD (-40 | |
1748 | DCA BCLIN4 | |
1749 | BCLIN9, JMS I (GETCDR /GET NEXT CDR CHAR | |
1750 | SNA | |
1751 | JMP BCLI13 /BLANK | |
1752 | TAD (-CONTCH | |
1753 | SNA | |
1754 | JMP BCLI10 /CONTINUATION | |
1755 | TAD (CONTCH | |
1756 | CIF F0 | |
1757 | JMS I (XCONVR | |
1758 | JMP BCLIN8 /RUBOUT | |
1759 | DCA XMOV6 /SAVE THE CHAR | |
1760 | JMS BCLI14 /SEND THE BLANKS | |
1761 | TAD XMOV6 | |
1762 | OUT1 /SEND IT | |
1763 | TAD XMOV6 | |
1764 | PUTCHR;BCLBUF /PUT IT | |
1765 | TAD PUTPNT | |
1766 | TAD (-BCLSIZ^2+2 /BCL BUFFER FULL? | |
1767 | SMA CLA | |
1768 | JMP BCLI11 /FULL - ERROR | |
1769 | BCLIN8, ISZ BCLIN4 /COUNT COLUMNS | |
1770 | JMP BCLIN9 /LOOP | |
1771 | JMP I BCLIN3 | |
1772 | BCLI10, ISZ BCLIN3 /SKIP RETURN FOR CONTINUATION | |
1773 | DCA MOV61 /CLEAR THE BLANK COUNTER | |
1774 | SEND;BCL10E /"_$" | |
1775 | TAD (211;OUT1 /<TAB> | |
1776 | JMP I BCLIN3 /RETURN | |
1777 | ||
1778 | BCLI11, SEND;BCL11E /SEND ERROR | |
1779 | BCLI12, CIF F0 | |
1780 | JMS I (CDRIN /GET THE NEXT CARD | |
1781 | JMP BCLIN7+2 | |
1782 | JMS I (GETCDR /GET THE NEXT COLUMN | |
1783 | DCA BCLIN4 /SAVE THIS COLUMN | |
1784 | TAD (JOBBIT /IS THIS A $JOB CARD? | |
1785 | AND BCLIN4 | |
1786 | SNA CLA | |
1787 | JMP BCLI12 /NO - FLUSH TO $JOB | |
1788 | TAD (-JOBBIT-1 | |
1789 | AND BCLIN4 | |
1790 | SZA CLA | |
1791 | JMP BCLI12 | |
1792 | JMP BCLIN7 /YES - DONE | |
1793 | ||
1794 | BCLI13, ISZ MOV61 /ANOTHER BLANK | |
1795 | JMP BCLIN8 | |
1796 | ||
1797 | BCLI14, 0 | |
1798 | TAD MOV61 | |
1799 | CMA | |
1800 | DCA MOV61 | |
1801 | BCLI15, ISZ MOV61;SKP | |
1802 | JMP I BCLI14 | |
1803 | TAD (" ;OUT1 | |
1804 | JMP BCLI15 | |
1805 | ||
1806 | ||
1807 | ||
1808 | ||
1809 | PAGE | |
1810 | \fBCLTRA, JMP I .+1 /GO FINISH UP LAST BCL COMMAND | |
1811 | BCLHUH /HUH? - I.E. WHICH COMMAND WAS IT? | |
1812 | CIF CDF F0 | |
1813 | JMP I (TEXFIN /TO COPY A DECK UNTIL THE NEXT BCL | |
1814 | /COMMAND - JMS BCLTRA+1 | |
1815 | ||
1816 | BCLHU1, 0 /JMS HERE WITH ARG = TRANSFER ADDRESS | |
1817 | TAD I BCLHU1 /GET TRANSFER ADDRESS | |
1818 | DCA BCLHU1 | |
1819 | TAD (BCLHUH /ON NEXT BCL CARD - NOTHING TO FINISH | |
1820 | DCA BCLTRA+1 | |
1821 | CIF CDF F0 /FIELD 0! | |
1822 | JMP I BCLHU1 /GO GO GO | |
1823 | ||
1824 | ||
1825 | BCLHUH, CDF F0 | |
1826 | TAD I (KEYVAL /GET KEYWORD VALUE | |
1827 | CDF F1 | |
1828 | TAD (BCLGO /USE IT TO GET TRANSFER ADDRESS | |
1829 | DCA OTEMP1 | |
1830 | TAD I OTEMP1 | |
1831 | DCA OTEMP1 | |
1832 | CDF F0 | |
1833 | TAD I (CONFLG /WAS LAST CARD CONTINUED? | |
1834 | CDF F1 | |
1835 | SZA CLA | |
1836 | JMS BCLHU2 /YES - ERROR | |
1837 | CDF F0 | |
1838 | TAD I (LNCNT /DID THIS CARD HAVE A LINE NUMBER? | |
1839 | CDF F1 | |
1840 | SNA CLA | |
1841 | JMP I OTEMP1 /YES - GO TO IT! | |
1842 | CIF CDF F0 | |
1843 | JMS I (LNOUT /OUTPUT THE LINE NUMBER | |
1844 | JMS BCLHU2 /WHAT'S IT DOING WITH A NUMBER ANYWAY? | |
1845 | JMP I OTEMP1 /NOW WE GO. | |
1846 | ||
1847 | BCLHU2, 0 | |
1848 | CDF F0 | |
1849 | ISZ I (ERRFLG | |
1850 | CDF F1 | |
1851 | SEND;BCLHM1 /"?_" | |
1852 | JMP I BCLHU2 | |
1853 | ||
1854 | ||
1855 | BCLEOF, JMS BCLHU1;EOF2 | |
1856 | ||
1857 | ||
1858 | CERR, JMS BCLHU1;KEYBAD | |
1859 | ||
1860 | ||
1861 | \fXOUTNA, 0 | |
1862 | TAD I XOUTNA /GET ADDRESS OF NAME | |
1863 | ISZ XOUTNA | |
1864 | DCA OUTNA2 | |
1865 | TAD GETPNT /SAVE BUFFER INPUT POINTER | |
1866 | DCA OUTNA6 | |
1867 | DCA OUTNA3 /SET FLAG FOR NO NAME | |
1868 | JMS OUTNA4;0;-4 /SEND 4 CHARS FROM POSITION 0 | |
1869 | TAD OUTNA3 | |
1870 | SNA CLA | |
1871 | JMP .+3 /NO DEVICE - NO ":" | |
1872 | TAD (": | |
1873 | OUT1 | |
1874 | JMS OUTNA4;4;-6 /SEND 6 CHARS FROM POSITION 4 | |
1875 | TAD (12 /SET UP TO GET EXTENSION | |
1876 | DCA GETPNT | |
1877 | JMS OUTNA1 /GET FIRST CHAR | |
1878 | JMP OUTNA5 /NO EXTENSION | |
1879 | CLA | |
1880 | TAD (". | |
1881 | OUT1 | |
1882 | JMS OUTNA4;12;-2 /SEND 2 CHARS FROM POSITION 12 | |
1883 | OUTNA5, TAD OUTNA6 /RESTORE BUFFER INPUT POINTER | |
1884 | DCA GETPNT | |
1885 | JMP I XOUTNA | |
1886 | ||
1887 | OUTNA1, 0 | |
1888 | GETCHR | |
1889 | OUTNA2, 0 | |
1890 | TAD (-300 /IS IT NULL? | |
1891 | SNA | |
1892 | JMP I OUTNA1 /YES - DONE | |
1893 | ISZ OUTNA1 /SKIP RETURN | |
1894 | TAD (300 | |
1895 | JMP I OUTNA1 | |
1896 | OUTNA3, 0 /NAME PRESENT SWITCH | |
1897 | ||
1898 | OUTNA4, 0 | |
1899 | TAD I OUTNA4 /GET CHAR POSITION | |
1900 | ISZ OUTNA4 | |
1901 | DCA GETPNT | |
1902 | TAD I OUTNA4 /GET NO OF CHARS | |
1903 | ISZ OUTNA4 | |
1904 | DCA OUTN41 | |
1905 | OUTN42, JMS OUTNA1 /GET A CHAR | |
1906 | JMP I OUTNA4 /NULL - DONE | |
1907 | OUT1 | |
1908 | ISZ OUTNA3 /SET NAME PRESENT | |
1909 | ISZ OUTN41 | |
1910 | JMP OUTN42 | |
1911 | JMP I OUTNA4 /DONE - RETURN | |
1912 | OUTN41, 0 | |
1913 | OUTNA6, 0 | |
1914 | ||
1915 | ||
1916 | PAGE | |
1917 | \fXSEND, 0 | |
1918 | SZA /IF AC =0, ADDRESS IS ARG OF CALL | |
1919 | JMP XSEND4 | |
1920 | TAD I XSEND /GET MESSAGE ADDRESS | |
1921 | ISZ XSEND | |
1922 | XSEND4, DCA OTEMP1 | |
1923 | XSEND1, TAD I OTEMP1 | |
1924 | CLL RTR;RTR;RTR | |
1925 | JMS XSEND2 | |
1926 | TAD I OTEMP1 | |
1927 | JMS XSEND2 | |
1928 | ISZ OTEMP1 | |
1929 | JMP XSEND1 | |
1930 | ||
1931 | XSEND2, 0 | |
1932 | AND (77 | |
1933 | SNA | |
1934 | JMP I XSEND /NULL ENDS MESSAGE | |
1935 | JMS I (XSEND3 /GET 8-BIT REPRESENTATION | |
1936 | OUT1 | |
1937 | JMP I XSEND2 | |
1938 | ||
1939 | ||
1940 | MAKNAM, 0 | |
1941 | TAD (DECN /START CONVERSION AT 100 | |
1942 | CDF F0 | |
1943 | DCA I (XR1 | |
1944 | L7775 /CONVERT 3 DIGITS | |
1945 | DCA I (TEMP1 | |
1946 | ISZ NAMCNT /BUMP NAME COUNTER | |
1947 | TAD NAMCNT | |
1948 | DCA I (TEMP4 | |
1949 | L0001 | |
1950 | DCA I (TEMP5 /SAVE LEADING ZEROES | |
1951 | TAD (MAKNA2 | |
1952 | DCA I (OUTAD | |
1953 | CDF F1 | |
1954 | TAD I MAKNAM /MOVE DEFAULT NAME TO OUTPUT AREA | |
1955 | DCA .+3 | |
1956 | MOV6;FILNAM;0 | |
1957 | TAD I MAKNAM | |
1958 | ISZ MAKNAM | |
1959 | DCA MAKNA3+2 | |
1960 | TAD (7 /PUT NUMBER AT POSITION 7-9 | |
1961 | DCA PUTPNT | |
1962 | CIF F0 | |
1963 | JMS I (CONDEC /OUTPUT NUMBER | |
1964 | TAD (XOUT /RESTORE OUTPUT ROUTINE | |
1965 | CDF F0 | |
1966 | DCA I (OUTAD | |
1967 | CDF F1 | |
1968 | JMP I MAKNAM /RETURN | |
1969 | ||
1970 | MAKNA3, 0 | |
1971 | PUTCHR;0 | |
1972 | CIF CDF F0 | |
1973 | JMP I MAKNA3 | |
1974 | NAMCNT, 0 | |
1975 | ||
1976 | ||
1977 | XISNUM, 0 | |
1978 | TAD (-"9 | |
1979 | SMA SZA | |
1980 | JMP XISNU1 | |
1981 | TAD ("9-"0 | |
1982 | SMA | |
1983 | ISZ XISNUM | |
1984 | XISNU1, CLA | |
1985 | JMP I XISNUM | |
1986 | ||
1987 | ||
1988 | SAVNAM, 0 | |
1989 | TAD SAVPNT | |
1990 | DCA SAV1+2 /PUT NAME IN LIST | |
1991 | TAD SAVPNT | |
1992 | TAD (-SAVTOP /ARE WE AT TOP OF LIST? | |
1993 | SNA | |
1994 | JMP I SAVNAM /YES - DON'T SAVE NAME | |
1995 | TAD (SAVTOP+6 | |
1996 | DCA SAVPNT /ADVANCE POINTER FOR NEXT TIME | |
1997 | TAD I SAVNAM /GET NAME TO SAVE | |
1998 | DCA SAV1+1 | |
1999 | ISZ SAVNAM | |
2000 | SAV1, MOV6;0;0 | |
2001 | JMP I SAVNAM | |
2002 | ||
2003 | SAVPNT, SAVARA /POINT TO SAVE AREA | |
2004 | ||
2005 | ||
2006 | UNSNAM, 0 | |
2007 | TAD I UNSNAM | |
2008 | ISZ UNSNAM | |
2009 | DCA UNSNA1+2 /POINT TO SPACE TO RECEIVE NAME | |
2010 | TAD SAVPNT | |
2011 | TAD (-6-SAVARA | |
2012 | SPA | |
2013 | JMP UNSNA2 /EMPTY - RETURN | |
2014 | TAD (SAVARA | |
2015 | DCA SAVPNT /BACK UP | |
2016 | TAD SAVPNT | |
2017 | DCA UNSNA1+1 /SET ADDRESS FROM WHICH NAME WILL COME | |
2018 | UNSNA1, MOV6;0;0 | |
2019 | ISZ UNSNAM /SKIP RETURN UNLESS EMPTY | |
2020 | UNSNA2, CLA | |
2021 | JMP I UNSNAM | |
2022 | ||
2023 | ||
2024 | PAGE | |
2025 | \f/ | |
2026 | / | |
2027 | / $DECK | |
2028 | / | |
2029 | / | |
2030 | CDECK, BCLIN /GET THE LINE | |
2031 | OPTION;CDEOPT /ANALYZE THE OPTIONS | |
2032 | TSTCR /END OF LINE? | |
2033 | JMP CDECK1 /NO - GET A NAME | |
2034 | CDECK3, MOV6;CDEDEF;NAME1 /YES - MOVE DEFAULT NAME | |
2035 | JMP CDECK2 | |
2036 | CDECK1, COLNAM;NAME1 /COLLECT A NAME | |
2037 | JMP CDECK3 /FAIL - BAD NAME | |
2038 | CDECK2, SEND;CDEM1 /".R PIP_*" | |
2039 | OUTNAM;NAME1 /SEND THE NAME | |
2040 | SEND;CDEM2 /"<BAT:_" | |
2041 | TAD I (OPFOR /WAS "/FOR" SPECIFIED? | |
2042 | SMA CLA | |
2043 | TAD (BASKEY-FORKEY /NO - USE BASIC | |
2044 | TAD (FORKEY-15 | |
2045 | CDF F0 | |
2046 | DCA I (KEYADR | |
2047 | CDF F1 | |
2048 | CDRTRA /TRANSLATE THE CARDS | |
2049 | SEND;CMEOD /"$EOD_" | |
2050 | TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? | |
2051 | SPA CLA | |
2052 | JMP I (BCLHUH /YES - DONE | |
2053 | TAD ("*;OUT1 | |
2054 | JMS I (PIPOUT;BATOUT /SEND NAME OF LISTING DEVICE | |
2055 | TAD ("<;OUT1 | |
2056 | OUTNAM;NAME1 /SEND NAME OF FILE | |
2057 | TAD (215;OUT1 | |
2058 | JMP I (BCLHUH | |
2059 | ||
2060 | ||
2061 | \f/ | |
2062 | / | |
2063 | / $BASIC | |
2064 | / | |
2065 | / | |
2066 | CBAS, BCLIN /GET BCL LINE | |
2067 | OPTION;CBAOPT /ANALYZE OPTIONS | |
2068 | TSTCR /END OF LINE? | |
2069 | JMP CBAS2 /NO - GET NAME | |
2070 | CBAS1, MOV6;CBATK;NAME1 /MOVE IN BAT: | |
2071 | SEND;CBAM1 /.R PIP *PROG.BA< | |
2072 | OUTNAM;NAME1 /SEND NAME | |
2073 | JMP CONT | |
2074 | CBAS2, COLNAM;NAME1 /COLLECT THE NAME | |
2075 | JMP CBAS1 /FAIL - USE DEFAULT | |
2076 | CBAS3, SEND;CBAM1 /".R PIP_*PROG.BA<" | |
2077 | SEND;CBAM6 | |
2078 | CONT, TAD (215;OUT1 | |
2079 | CBAS5, JMP CBAS7 /SET OR CLOBBERED IN INIT | |
2080 | TAD (211;OUT1 | |
2081 | SEND;CBAM3 /'FILE #0,"DATA.DA"\FILEV #1,"' | |
2082 | OUTNAM;BATOUT /"TTY:" OR "LPT:" | |
2083 | SEND;CBAM4 /'"_' | |
2084 | CBAS7, TAD (BASKEY-15 | |
2085 | CDF F0 | |
2086 | DCA I (KEYADR /SET KEYWORD LIST | |
2087 | CDF F1 | |
2088 | CDRTRA /TRANSLATE CARDS | |
2089 | SEND;CMEOD /"$EOD_" | |
2090 | SEND;CBAM7 | |
2091 | SEND;CBAM5 | |
2092 | OUTNAM;NAME1 | |
2093 | SEND;CBAM8 | |
2094 | TAD I (OPNOL /WAS "/NOLIST SPECIFIED?" | |
2095 | SPA CLA | |
2096 | JMP CBAS4 | |
2097 | SEND /SEND AN EOD (MH) | |
2098 | CMEOD /(MH) | |
2099 | SEND /SEND AN .R PIP * (MH) | |
2100 | CDEM1 /(MH) | |
2101 | JMS I (PIPOUT;BATOUT | |
2102 | SEND;CBAM2 /"<PROG.BA_" | |
2103 | CBAS4, TAD (DATBAS | |
2104 | DCA I (DATADR /SET "$DATA" ROUTINE | |
2105 | JMP I (BCLHUH /DONE | |
2106 | ||
2107 | ||
2108 | / | |
2109 | / | |
2110 | / $RUN (AFTER $BASIC) | |
2111 | / | |
2112 | / | |
2113 | DATBAS, BCLIN | |
2114 | OPTION;ZER6 /NO OPTIONS | |
2115 | SEND;DATBM1 /".R PIP_*DATA.DA<BAT:_" | |
2116 | CDRTRA /TRANSLATE THE CARDS | |
2117 | SEND;DATBM2 /"$EOD_.R BCOMP_*PROG.BA_" | |
2118 | TAD DATFTN /$RUN IS FORTRAN NOW | |
2119 | DCA I (DATADR | |
2120 | JMP I (BCLHUH /DONE | |
2121 | ||
2122 | ||
2123 | PAGE | |
2124 | \f/ | |
2125 | / | |
2126 | / $FORTRAN (FORTRAN IV) | |
2127 | / | |
2128 | / | |
2129 | CF4, BCLIN /GET BCL LINE | |
2130 | OPTION;CF4OPT /ANALYZE OPTIONS | |
2131 | TSTCR /END OF LINE? | |
2132 | JMP CF42 | |
2133 | CF41, JMS I (MAKNAM;NAME1 /YES - MAKE A NAME | |
2134 | JMP CF43 | |
2135 | CF42, COLNAM;NAME1 /NO - COLLECT A NAME | |
2136 | JMP CF41 /BAD NAME - MAKE ONE | |
2137 | CF43, SEND;CF4M1 /".R PIP_*" | |
2138 | OUTNAM;NAME1 /SEND THE NAME | |
2139 | TAD ("<;OUT1 | |
2140 | TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN | |
2141 | SMA CLA | |
2142 | JMP CF44 /NO | |
2143 | OUTNAM;OPSRC+1 /YES - SEND IT | |
2144 | TAD (215;OUT1 | |
2145 | JMP CF45 | |
2146 | CF44, SEND;CF4M2 /"BAT:_" | |
2147 | CF45, TAD (FORKEY-15 /FORTRAN CARDS | |
2148 | CDF F0 | |
2149 | DCA I (KEYADR | |
2150 | CDF F1 | |
2151 | CDRTRA /TRANSLATE THE CARDS | |
2152 | SEND;CF4M3 /"$EOD_.R F4_*" | |
2153 | OUTNAM;NAME1 | |
2154 | TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? | |
2155 | SPA CLA | |
2156 | JMP CF46 /YES - DON'T GENERATE LIST FILES | |
2157 | TAD (",;OUT1 | |
2158 | TAD I (OPLIS | |
2159 | RAL | |
2160 | SPA CLA /WAS A NAME GIVEN? | |
2161 | JMP CF47 /YES - GET IT | |
2162 | MOV6;BATOUT;OPLIS+1 /NO - GIVE LIST DEV | |
2163 | CF47, OUTNAM;OPLIS+1 /SEND NAME OF LISTING FILE | |
2164 | CF46, TAD ("<;OUT1 | |
2165 | OUTNAM;NAME1 | |
2166 | TAD I (OPRALF /PRODUCE RALF LISTING? | |
2167 | SMA CLA | |
2168 | JMP CF48 /NO | |
2169 | SEND;CF4M4 /"/F" | |
2170 | CF48, TAD (215;OUT1 | |
2171 | TAD (DATF4 | |
2172 | DCA I (DATADR /SET "$DATA" ADDRESS | |
2173 | JMS I (SAVNAM;NAME1 /SAVE NAME FOR "$LOAD" | |
2174 | JMP I (BCLHUH /DONE | |
2175 | ||
2176 | ||
2177 | / | |
2178 | / | |
2179 | / $RUN (FORTRAN II) | |
2180 | / | |
2181 | / | |
2182 | DATF2, BCLIN | |
2183 | JMS I (CL2S /DO $LOAD STUFF | |
2184 | JMP DATL21 | |
2185 | DATL2, BCLIN | |
2186 | OPTION;ZER6 /NO OPTIONS IF ALREADY LOADED | |
2187 | JMP DATL21 | |
2188 | DATX2, BCLIN | |
2189 | JMS I (DATNAM /GET A NAME | |
2190 | TAD I (NAMELD /WAS A DEVICE SPECIFIED? | |
2191 | SZA CLA | |
2192 | JMP DATL21 /YES | |
2193 | TAD (0423 /NO - USE "DSK" | |
2194 | DCA I (NAMELD | |
2195 | TAD (1300 | |
2196 | DCA I (NAMELD+1 | |
2197 | DATL21, SEND;DTF2M1 /".RUN " | |
2198 | OUTNAM;NAMELD | |
2199 | TAD (215;OUT1 | |
2200 | CDRTRA /WITH GENIOX, INPUT IS FROM BATCH STREAM | |
2201 | SEND;CMEOD /"$EOD_" | |
2202 | TAD DATFTN /$DATA IS NOW FORTRAN | |
2203 | DCA I (DATADR | |
2204 | JMP I (BCLHUH | |
2205 | ||
2206 | ||
2207 | ||
2208 | PAGE | |
2209 | \f/ | |
2210 | / | |
2211 | / $LOAD (FORTRAN IV) | |
2212 | / | |
2213 | / | |
2214 | /THIS SUBROUTINE IS USED WITH EITHER A $LOAD OR $RUN | |
2215 | CL4S, 0 | |
2216 | OPTION;CL4OPT /ANALYZE OPTIONS | |
2217 | SEND;CL4SM1 /".R LOAD_*" | |
2218 | TAD I (OPIMAG /WAS "/IMAGE" FILE SPECIFIED | |
2219 | RAL | |
2220 | SMA CLA | |
2221 | JMP CL4S1 /NO | |
2222 | MOV6;OPIMAG+1;NAMELD /YES - MOVE NAME | |
2223 | JMP CL4S2 | |
2224 | CL4S1, MOV6;CL4DEF;NAMELD /USE DEFAULT NAME | |
2225 | CL4S2, OUTNAM;NAMELD /SEND THE NAME OF THE IMAGE FILE | |
2226 | TAD I (OPLIS /WAS "/LIST" FILE GIVEN? | |
2227 | SMA CLA | |
2228 | JMP CL4S4 | |
2229 | TAD I (OPLIS;RAL | |
2230 | SPA CLA | |
2231 | JMP CL4S3 | |
2232 | MOV6;BATOUT;OPLIS+1 | |
2233 | CL4S3, TAD (",;OUT1 | |
2234 | OUTNAM;OPLIS+1 | |
2235 | CL4S4, TAD I (OPSSYM /LIST SYSTEM SYMBOLS? | |
2236 | SMA CLA | |
2237 | JMP CL4S11 /NO | |
2238 | SEND;CL4SM8 /"/S" | |
2239 | CL4S11, SEND;CL4SM2 /"<_*" | |
2240 | TAD I (OPLIB;RAL /WAS "/LIBRARY" FILE SPECIFIED? | |
2241 | SMA CLA | |
2242 | JMP CL4S5 | |
2243 | OUTNAM;OPLIB+1 /SEND NAME OF LIBRARY | |
2244 | SEND;CL4SM3 /"/L_*" | |
2245 | CL4S5, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED? | |
2246 | SPA CLA | |
2247 | JMP CL4S7 /YES - DON'T BOTHER WITH SAVED NAMES | |
2248 | CL4S6, JMS I (UNSNAM;NAME1 /GET A SAVED NAME | |
2249 | JMP CL4S7 /OUT OF NAMES | |
2250 | OUTNAM;NAME1 /SEND IT | |
2251 | SEND;CL4SM4 /"/C_*" | |
2252 | JMP CL4S6 | |
2253 | CL4S7, TSTCR;SKP /END OF LINE? | |
2254 | JMP CL4S10 | |
2255 | GETCHR;BCLBUF /GET NEXT CHARACTER | |
2256 | DCA CHRSAV | |
2257 | GETCHR;BCLBUF | |
2258 | TAD (-"= | |
2259 | SZA CLA | |
2260 | JMP CL4S8 | |
2261 | TAD CHRSAV | |
2262 | ISIT;CLIS1;CLIS2-1 /IS IT "L" OR "O" | |
2263 | CL4S8, L7776 | |
2264 | TAD GETPNT /BACK UP 2 | |
2265 | DCA GETPNT | |
2266 | CL4S9, COLNAM;NAME1 | |
2267 | JMP CL4S7 /BAD NAME | |
2268 | OUTNAM;NAME1 /SEND THE NAME | |
2269 | SEND;CL4SM4 /"/C_*" | |
2270 | JMP CL4S7 | |
2271 | CL4SL, SEND;CL4SM5 /"/O" | |
2272 | CL4SO, SEND;CL4SM6 /"_*" | |
2273 | L7776 | |
2274 | TAD GETPNT /BACK 2 | |
2275 | JMS I (BCLSQU | |
2276 | JMP CL4S9 | |
2277 | CL4S10, SEND;CL4SM7 /"$_" | |
2278 | DCA I (NAMCNT | |
2279 | JMP I CL4S /RETURN | |
2280 | ||
2281 | ||
2282 | /$LOAD | |
2283 | CL4, BCLIN /GET THE LINE | |
2284 | JMS CL4S /ANALYZE IT | |
2285 | TAD (DATL4 /SET "$DATA" ADDRESS | |
2286 | DCA I (DATADR | |
2287 | JMS I (BCLHU1;TEXFIN | |
2288 | ||
2289 | CHRSAV, 0 | |
2290 | ||
2291 | PAGE | |
2292 | \f/ | |
2293 | / | |
2294 | / $RUN (FORTRAN IV) - FORMERLY CALLED $DATA | |
2295 | / | |
2296 | / | |
2297 | /THIS SUBROUTINE IS CALLED FROM DATF4 - THE REAL $RUN PROCESSOR | |
2298 | DAT4, 0 | |
2299 | TAD (-12^7 /ZERO OUT CONTROL WORD | |
2300 | DCA DEVASC /FOR EACH DEVICE NUMBER | |
2301 | TAD (DEVASN-1 | |
2302 | DCA OXR1 | |
2303 | DEVAS1, DCA I OXR1 | |
2304 | ISZ DEVASC | |
2305 | JMP DEVAS1 | |
2306 | BCLIN /GET THE INPUT LINE | |
2307 | DAT41, GETCHR;BCLBUF /GET A CHAR | |
2308 | DAT411, ISIT;OPTIS3;DATIS1-1 /IS IT "/" OR <CR>? | |
2309 | JMP DAT41 /NO | |
2310 | DAT42, L7777 | |
2311 | TAD GETPNT /SAVE POINTER TO "/" | |
2312 | DCA DEVAST | |
2313 | GETCHR;BCLBUF | |
2314 | ISNUM | |
2315 | JMP DAT411 /IT'S NOT A NUMBER | |
2316 | TAD CHAR | |
2317 | TAD (-"0 | |
2318 | CIA | |
2319 | DCA DEVASC | |
2320 | TAD DEVASC | |
2321 | CIA | |
2322 | CLL RAL;RTL | |
2323 | TAD DEVASC /NUMBER*7 | |
2324 | TAD (DEVASN | |
2325 | DCA DEVASC | |
2326 | DAT47, GETCHR;BCLBUF /GET ANOTHER CHAR | |
2327 | ISIT;DATIS2;DATIS3-1 /IS IT "N","C", OR "="? | |
2328 | JMP DAT411 /NO | |
2329 | DAT44, TAD I DEVASC /"N" SETS BIT 1 | |
2330 | AND (5777 | |
2331 | TAD (2000 | |
2332 | DCA I DEVASC | |
2333 | JMP DAT47 | |
2334 | DAT45, TAD I DEVASC /"C" SETS BIT 2 | |
2335 | AND (6777 | |
2336 | TAD (1000 | |
2337 | DCA I DEVASC | |
2338 | JMP DAT47 | |
2339 | DAT46, TAD GETPNT /SAVE POINTER TO POSSIBLE NAME | |
2340 | DCA DEVASP | |
2341 | GETCHR;BCLBUF /GET THE NEXT CHAR | |
2342 | ISNUM | |
2343 | JMP DAT48 /NOT A NUMBER | |
2344 | TAD CHAR /SAVE THE NUMBER | |
2345 | DCA DEVASS | |
2346 | GETCHR;BCLBUF | |
2347 | ISIT;DATIS4;DATIS5-1 /IS IT "," "/" OR <CR>? | |
2348 | DAT48, TAD DEVASP /RESET NAME POINTER | |
2349 | DCA GETPNT | |
2350 | TAD I DEVASC /ZERO OUT NUMBER | |
2351 | AND (7400 | |
2352 | DCA I DEVASC | |
2353 | TAD DEVASC;IAC /GET POINTER TO DEVICE BLOCK | |
2354 | DCA .+2 | |
2355 | COLNAM;0 /COLLECT NAME | |
2356 | JMP DAT49 /BAD NAME | |
2357 | DAT412, TAD I DEVASC /NAME OR NUM OK - SET BIT 0 | |
2358 | AND (3777 | |
2359 | TAD (4000 | |
2360 | DCA I DEVASC | |
2361 | DAT49, TAD DEVAST /SQUISH | |
2362 | JMS I (BCLSQU | |
2363 | JMP DAT41 | |
2364 | DAT410, TAD I DEVASC /ADD NUMBER TO CONTROL WORD | |
2365 | AND (7400 | |
2366 | TAD DEVASS | |
2367 | DCA I DEVASC | |
2368 | JMP DAT412 | |
2369 | DAT43, JMP I DAT4 | |
2370 | ||
2371 | ||
2372 | DEVASP, 0 | |
2373 | DEVASC, 0 | |
2374 | DEVASS, 0 | |
2375 | DEVAST, 0 | |
2376 | ||
2377 | ||
2378 | /SEND A NAME AND SEND /T OPTION IF DEVICE IS TTY: | |
2379 | PIPOUT, 0 | |
2380 | TAD I PIPOUT /GET ADDRESS OF NAME | |
2381 | ISZ PIPOUT | |
2382 | DCA PIPPNT | |
2383 | OUTNAM /SEND IT | |
2384 | PIPPNT, 0 | |
2385 | TAD I PIPPNT /GET CHAR OF DEVICE | |
2386 | TAD (-2424 /IS IT "TT"? | |
2387 | SZA CLA | |
2388 | JMP I PIPOUT /NO | |
2389 | ISZ PIPPNT | |
2390 | TAD I PIPPNT | |
2391 | TAD (-3100 /IS IT "Y@"? | |
2392 | SZA CLA | |
2393 | JMP I PIPOUT /NO | |
2394 | SEND;PIPM1 /"/T" | |
2395 | JMP I PIPOUT | |
2396 | ||
2397 | ||
2398 | PAGE | |
2399 | \f/$RUN (FORTRAN IV) | |
2400 | DATF4, JMS I (DAT4 /PROCESS DEVICE NUMBER STUFF | |
2401 | JMS I (CL4S /DO LOAD STUFF | |
2402 | JMP DATL46 | |
2403 | DATL4, JMS I (DAT4 | |
2404 | OPTION;ZER6 /NO OPTIONS | |
2405 | JMP DATL46 | |
2406 | DATX4, JMS I (DAT4 /DO DEVICE NUMBER STUFF | |
2407 | JMS DATNAM /COLLECT A NAME | |
2408 | DATL46, SEND;DTF4M1 /".R PIP_*DATA.DA<BAT:_" | |
2409 | CDRTRA /TRANSLATE CARDS | |
2410 | SEND;DTF4M2 /"$EOD_.R FRTS_*" | |
2411 | OUTNAM;NAMELD /SEND LOADER NAME | |
2412 | DATL48, JMP DATL49 /ZEROED OR CREATED IN INIT | |
2413 | SEND;DTF4M6 /"_*DATA.DA/4_*" | |
2414 | OUTNAM;BATOUT | |
2415 | SEND;DTF4M7 /"/5" | |
2416 | JMP DTL410 | |
2417 | DATL49, SEND;DTF4M8 /"_*/5=4" | |
2418 | DTL410, SEND;DTF4M3 /"_*" | |
2419 | TAD (-12 /TRANSLATE THE DEVICE NUMBERS | |
2420 | DCA DATF4C | |
2421 | TAD (DEVASN-7 | |
2422 | DCA DATF4P | |
2423 | DATL41, TAD (7 | |
2424 | TAD DATF4P | |
2425 | DCA DATF4P | |
2426 | TAD I DATF4P | |
2427 | SMA CLA /WAS THIS ONE SPECIFIED? | |
2428 | JMP DATL47 /NO | |
2429 | TAD I DATF4P | |
2430 | AND (377 /WAS IT A NUMBER? | |
2431 | SNA | |
2432 | JMP DATL42 | |
2433 | DCA CHAR /YES - SAVE IT | |
2434 | TAD ("=;OUT1 | |
2435 | TAD CHAR;OUT1 | |
2436 | JMP DATL43 | |
2437 | DATL42, TAD DATF4P;IAC /POINT TO NAME | |
2438 | DCA .+2 | |
2439 | OUTNAM;0 /SEND IT | |
2440 | DATL43, TAD I DATF4P /"N"? | |
2441 | RAL | |
2442 | SMA CLA | |
2443 | JMP DATL44 /NO | |
2444 | TAD ("<;OUT1 | |
2445 | DATL44, TAD I DATF4P /"C"? | |
2446 | RTL | |
2447 | SMA CLA | |
2448 | JMP DATL45 /NO | |
2449 | SEND;DTF4M4 /"/C" | |
2450 | DATL45, TAD ("/;OUT1 | |
2451 | TAD DATF4C | |
2452 | TAD ("0+12;OUT1 | |
2453 | SEND;DTF4M3 /"_*" | |
2454 | DATL47, ISZ DATF4C | |
2455 | JMP DATL41 | |
2456 | SEND;DTF4M5 /"$_" | |
2457 | TAD DATFTN /"$DATA" IS NOW FORTRAN | |
2458 | DCA I (DATADR | |
2459 | JMP I (BCLHUH | |
2460 | ||
2461 | DATF4C, 0 | |
2462 | DATF4P, 0 | |
2463 | ||
2464 | ||
2465 | DATNAM, 0 | |
2466 | OPTION;ZER6 /NO OPTIONS | |
2467 | TSTCR;SKP /IS THERE A NAME? | |
2468 | JMP DATNO /NO | |
2469 | COLNAM;NAMELD /YES - COLLECT IT | |
2470 | JMP DATNO /INVALID NAME | |
2471 | JMP I DATNAM /RETURN | |
2472 | DATNO, SEND;DATNO1 /"?NO PROGRAM TO RUN_" | |
2473 | JMS I (BCLHU1;TEXFIN | |
2474 | ||
2475 | ||
2476 | PAGE | |
2477 | \f/ | |
2478 | / | |
2479 | / $FORTRAN (FORTRAN II) | |
2480 | / | |
2481 | / | |
2482 | CF2, BCLIN | |
2483 | OPTION;CF2OPT /ANALYZE OPTIONS | |
2484 | TSTCR /END OF LINE? | |
2485 | JMP CF22 | |
2486 | CF21, JMS I (MAKNAM;NAME1 /CREATE A NAME | |
2487 | JMP CF23 | |
2488 | CF22, COLNAM;NAME1 /COLLECT A NAME | |
2489 | JMP CF21 /FAIL - CREATE A NAME | |
2490 | CF23, SEND;CF2M1 /".R PIP_*" | |
2491 | OUTNAM;NAME1 | |
2492 | TAD ("<;OUT1 | |
2493 | TAD I (OPSRC;RAL /WAS A SOURCE FILE GIVEN? | |
2494 | SMA CLA | |
2495 | JMP CF24 /NO | |
2496 | OUTNAM;OPSRC+1 | |
2497 | TAD (215;OUT1 | |
2498 | JMP CF25 | |
2499 | CF24, SEND;CF2M2 /"BAT:_" | |
2500 | CF25, TAD (FORKEY-15 /FORTRAN CARDS | |
2501 | CDF F0 | |
2502 | DCA I (KEYADR | |
2503 | CDF F1 | |
2504 | CDRTRA /TRANSLATE THE CARDS | |
2505 | SEND;CF2M3 /"$EOD" | |
2506 | TAD I (OPNOL /WAS "/NOLIST" SPECIFIED? | |
2507 | SPA CLA | |
2508 | JMP CF27 | |
2509 | SEND;CF2M4 /"_*" | |
2510 | TAD I (OPLIS;RAL /WAS A LISTING FILE GIVEN? | |
2511 | SPA CLA | |
2512 | JMP CF26 /YES | |
2513 | MOV6;BATOUT;OPLIS+1 /NO - USE LISTING DEVICE | |
2514 | CF26, JMS I (PIPOUT;OPLIS+1 | |
2515 | TAD ("<;OUT1 | |
2516 | OUTNAM;NAME1 | |
2517 | CF27, SEND;CF2M5 /"_.R FORT_*" | |
2518 | OUTNAM;NAME1 | |
2519 | TAD I (OPNOL /NOLIST? | |
2520 | SPA CLA | |
2521 | JMP CF28 /YES | |
2522 | TAD I (OPSABR /WAS "/SABR" SPECIFIED? | |
2523 | SMA CLA | |
2524 | JMP CF28 /NO | |
2525 | TAD (",;OUT1 | |
2526 | OUTNAM;OPLIS+1 | |
2527 | CF28, TAD ("<;OUT1 | |
2528 | OUTNAM;NAME1 | |
2529 | TAD (215;OUT1 | |
2530 | TAD (DATF2 | |
2531 | DCA I (DATADR /ENABLE $DATA | |
2532 | JMS I (SAVNAM;NAME1 /SAVE THE NAME FOR $LOAD | |
2533 | JMP I (BCLHUH /DONE | |
2534 | ||
2535 | ||
2536 | \f/ | |
2537 | / | |
2538 | / $EOD | |
2539 | / $MSG | |
2540 | / | |
2541 | / | |
2542 | CEOD, | |
2543 | CMSG, | |
2544 | JMS SENDKY /OUTPUT THE BCL KEYWORD | |
2545 | JMS I (BCLHU1;TEXTRA | |
2546 | ||
2547 | / | |
2548 | / | |
2549 | / $JOB | |
2550 | / | |
2551 | / | |
2552 | CJOB, TAD (SAVARA /RESET SAVED NAMES | |
2553 | DCA I (SAVPNT | |
2554 | DCA I (NAMCNT /ZERO MAKNAM COUNTER | |
2555 | TAD DATFTN /$RUN IS NOW FORTRAN | |
2556 | DCA I (DATADR | |
2557 | BCLIN /SEND THE LINE TO THE BATCH STREAM | |
2558 | SEND;MJOB1 /".R FOTP_*FIL???.*/D_" | |
2559 | JMS I (BCLHU1;TEXFIN | |
2560 | ||
2561 | SENDKY, 0 | |
2562 | CDF F0 | |
2563 | TAD I (KEYVAL | |
2564 | CDF F1 | |
2565 | TAD (BCLKEY-1 | |
2566 | DCA OTEMP1 | |
2567 | TAD I OTEMP1 | |
2568 | SEND | |
2569 | TAD (" ;OUT1 | |
2570 | JMP I SENDKY | |
2571 | ||
2572 | ||
2573 | PAGE | |
2574 | \f/ | |
2575 | / | |
2576 | / $LOAD (FORTRAN II) | |
2577 | / | |
2578 | / | |
2579 | /THIS SUBROUTINE IS CALLED BY CL2 OR DATF2 | |
2580 | CL2S, 0 | |
2581 | OPTION;CL2OPT /ANALYZE OPTIONS | |
2582 | SEND /".R LOADER_*" OR ".R LOADER_*GENIOX" | |
2583 | CL2SX, CL2M1 /OR CL2M1A | |
2584 | TAD I (OPINP /WAS "/INPUT" SPECIFIED? | |
2585 | SMA CLA | |
2586 | JMP CL2S1 | |
2587 | SEND;CL2M3 /"/I" | |
2588 | CL2S1, TAD I (OPOPT /WAS "/OUTPUT" SPECIFIED? | |
2589 | SMA CLA | |
2590 | JMP CL2S2 | |
2591 | SEND;CL2M4 /"/O" | |
2592 | CL2S2, TAD I (OPTWO /WAS "/TWO" SPECIFIED? | |
2593 | SMA CLA | |
2594 | JMP CL2S3 | |
2595 | SEND;CL2M5 /"/H" | |
2596 | CL2S3, SEND;CL2M6 /"_*" | |
2597 | TAD I (OPLIB;RAL /WAS A LIBRARY SPECIFIED? | |
2598 | SMA CLA | |
2599 | JMP CL2S4 | |
2600 | OUTNAM;OPLIB+1 | |
2601 | SEND;CL2M7 /"/L_*" | |
2602 | CL2S4, TAD I (OPLIS /WAS "/LIST" SPECIFIED? | |
2603 | SMA CLA | |
2604 | JMP CL2S6 | |
2605 | TAD I (OPLIS;RAL /WAS A NAME GIVEN? | |
2606 | SPA CLA | |
2607 | JMP CL2S5 /YES | |
2608 | MOV6;BATOUT;OPLIS+1 | |
2609 | CL2S5, OUTNAM;OPLIS+1 | |
2610 | SEND;CL2M8 /"</M_*" | |
2611 | CL2S6, TAD I (OPNOA /WAS "/NOAUTO" SPECIFIED? | |
2612 | SPA CLA | |
2613 | JMP CL2S8 | |
2614 | CL2S7, JMS I (UNSNAM;NAME1 /GET A SAVED NAME | |
2615 | JMP CL2S8 /EMPTY | |
2616 | OUTNAM;NAME1 | |
2617 | SEND;CL2M6 /"_*" | |
2618 | JMP CL2S7 | |
2619 | CL2S8, TSTCR;SKP /END OF LINE? | |
2620 | JMP CL2S9 /YES | |
2621 | COLNAM;NAME1 | |
2622 | OUTNAM;NAME1 | |
2623 | SEND;CL2M6 /"_*" | |
2624 | JMP CL2S8 | |
2625 | CL2S9, SEND;CL2M9 /"$_.SAVE " | |
2626 | TAD I (OPIMAG;RAL /WAS AN IMAGE FILE NAME GIVEN? | |
2627 | SMA CLA | |
2628 | JMP CL2S10 /NO - USE DEFAULT | |
2629 | TAD I (OPIMAG+1 /WAS A DEVICE GIVEN? | |
2630 | SZA CLA | |
2631 | JMP CL2S11 /YES | |
2632 | TAD (0423 /"DS" | |
2633 | DCA I (OPIMAG+1 | |
2634 | TAD (1300 /"K" | |
2635 | DCA I (OPIMAG+2 | |
2636 | CL2S11, MOV6;OPIMAG+1;NAMELD | |
2637 | CL2S12, OUTNAM;NAMELD | |
2638 | TAD (215;OUT1 | |
2639 | JMP I CL2S | |
2640 | ||
2641 | CL2S10, MOV6;CL2SN2;NAMELD | |
2642 | DCA I (NAMCNT | |
2643 | JMP CL2S12 | |
2644 | ||
2645 | ||
2646 | /$LOAD | |
2647 | CL2, BCLIN | |
2648 | JMS CL2S | |
2649 | TAD (DATL2 /$DATA DOES NOT DO LOAD | |
2650 | DCA I (DATADR | |
2651 | JMS I (BCLHU1;TEXFIN | |
2652 | ||
2653 | ||
2654 | PAGE | |
2655 | \fBCLBUF, ZBLOCK 400 /SPACE FOR A WHOLE BUNCH OF CONTINUATION CARDS | |
2656 | BCLSIZ=.-BCLBUF | |
2657 | SAVARA, ZBLOCK 6^62 /SPACE FOR SAVED NAMES | |
2658 | SAVTOP=. | |
2659 | /OPTION LISTS | |
2660 | CDEOPT, OPBAS;OPFOR;OPNOL;0 /$DECK | |
2661 | CBAOPT, OPNOL;0 /$BASIC | |
2662 | CF4OPT, OPSRC;OPNOL;OPLIS;OPRALF;0 /$FORTRAN (F4) | |
2663 | CL4OPT, OPIMAG;OPLIS;OPLIB;OPNOA;OPSSYM;0 /$LOAD (F4) | |
2664 | CF2OPT, OPSRC;OPNOL;OPLIS;OPSABR;0 /$FORTRAN (F2) | |
2665 | CL2OPT, OPINP;OPOPT;OPTWO;OPIMAG;OPLIS;OPLIB;OPNOA;0 /$LOAD (F2) | |
2666 | /OPTIONS WITHOUT ASSOCIATED FILE NAME | |
2667 | OPBAS, 0004;TEXT "BASIC" /B | |
2668 | OPFOR, 0006;TEXT "FORTRAN" /F | |
2669 | OPNOL, 0023;TEXT "NOLIST";*.-1 /NOL | |
2670 | OPRALF, 0003;TEXT "RALF";*.-1 /R | |
2671 | OPNOA, 0023;TEXT "NOAUTO";*.-1 /NOA | |
2672 | OPSSYM, 0013;TEXT "SSYMB" /SS | |
2673 | OPSABR, 0012;TEXT "SABR";*.-1 /SA | |
2674 | OPINP, 0013;TEXT "INPUT" /IN | |
2675 | OPOPT, 0023;TEXT "OUTPUT";*.-1 /OUT | |
2676 | OPTWO, 0020;TEXT "TWO" /TWO | |
2677 | /OPTIONS WITH ASSOCIATED FILE NAME | |
2678 | OPSRC, 1002;ZBLOCK 6;TEXT "SRC" /S | |
2679 | OPLIS, 1003;ZBLOCK 6;TEXT "LIST";*.-1 /L | |
2680 | OPIMAG, 1013;ZBLOCK 6;TEXT "IMAGE" /IM | |
2681 | OPLIB, 1024;ZBLOCK 6;TEXT "LIBRARY" /LIB | |
2682 | /FILE NAMES | |
2683 | NAME1, ZBLOCK 6 | |
2684 | NAMELD, ZBLOCK 6 | |
2685 | BATOUT, ZBLOCK 6 | |
2686 | ZER6, ZBLOCK 6 | |
2687 | BATTTY, TEXT "TTY@@@@@@@@@";*.-1 | |
2688 | BATLPT, TEXT "LPT@@@@@@@@@";*.-1 | |
2689 | CDEDEF, TEXT "@@@@DECK@@@@";*.-1 | |
2690 | CBATK, TEXT "BAT@@@@@@@@@";*.-1 | |
2691 | CL4DEF, TEXT "@@@@PROG@@LD";*.-1 | |
2692 | FILNAM, TEXT "@@@@FIL@@@@@";*.-1 | |
2693 | CL2SN2, TEXT "DSK@PROG@@@@";*.-1 | |
2694 | /SPACE FOR DEVICE ASSIGNMENTS UNDER FORTRAN 4 | |
2695 | DEVASN, ZBLOCK 7^12 | |
2696 | /LISTS FOR ISIT | |
2697 | CLIS1, -"L;-"O;0 | |
2698 | CLIS2, CL4SL;CL4SO | |
2699 | DATIS1, DAT42 /"/" | |
2700 | DAT43 /<CR> | |
2701 | DATIS2, -"N;-"C;-"=;0 | |
2702 | DATIS3, DAT44;DAT45;DAT46 | |
2703 | DATIS5, DAT410;DAT410;DAT410 | |
2704 | OPTIS2, OPTIO8 /"=" | |
2705 | OPTIO9 /"," | |
2706 | OPTIO9 /"/" | |
2707 | OPTIO9 /<CR> | |
2708 | ||
2709 | OPTIS4, OPTI3A | |
2710 | OPTRET | |
2711 | ||
2712 | OPTIS1, -"= | |
2713 | DATIS4, | |
2714 | OUTIS1, -", | |
2715 | OPTIS3, | |
2716 | BCLIS1, -"/;-215 | |
2717 | /LIST MUST BE TERMINATED BY A POSITIVE WORD | |
2718 | 0 | |
2719 | ||
2720 | COLIS2, COLDEV /":" | |
2721 | COLFIL /"." | |
2722 | COLEXT /"/" | |
2723 | COLEXT /"," | |
2724 | COLEXT /<CR> | |
2725 | ||
2726 | ||
2727 | COLIS1, -":;-".;-"/;-",;-215 | |
2728 | /TERMINATE LIST WITH POSITIVE WORD | |
2729 | 0 | |
2730 | ||
2731 | BCLIS2, BCLSQ2 /"/" | |
2732 | BCLSQ3 /<CR> | |
2733 | ||
2734 | OUTIS2, OUTER2 /"," | |
2735 | OUTER2 /"/" | |
2736 | OUTER2 /<CR> | |
2737 | ||
2738 | /LIST OF BCL ROUTINE ADDRESSES | |
2739 | BCLGO, BCLEOF /FOR FINISHING UP BEFORE CLOSING FILE | |
2740 | CBAS /$BAS | |
2741 | FORADR, CF4 /$FOR | |
2742 | DATADR, DATX4 /$DATA | |
2743 | LOAADR, CL4 /$LOAD | |
2744 | CJOB /$JOB | |
2745 | CMSG /$MSG | |
2746 | CDECK /$DECK | |
2747 | CEOD /$EOD | |
2748 | CERR | |
2749 | CERR | |
2750 | CERR | |
2751 | CERR | |
2752 | /LIST OF BCL KEYWORDS | |
2753 | BCLKEY, MBAS | |
2754 | MFOR | |
2755 | MDATA | |
2756 | MLOAD | |
2757 | MJOB | |
2758 | MMSG | |
2759 | MDECK | |
2760 | MEOD | |
2761 | /ERROR MESSAGES | |
2762 | OPTERM, TEXT "?INVALID OPTION: /" | |
2763 | COLERM, TEXT "?INVALID FILE SPECIFICATION - " | |
2764 | BCL11E, TEXT "?_BCL LINE TOO LONG_" | |
2765 | /MESSAGES | |
2766 | BCLHM1, TEXT "?_" | |
2767 | BCL10E, TEXT "_$" | |
2768 | CF4M1, | |
2769 | CF2M1, | |
2770 | CDEM1, TEXT ".R PIP_*" | |
2771 | CDEM2, TEXT "<BAT:_" | |
2772 | CMEOD, TEXT "$EOD_" | |
2773 | CBAM1, TEXT ".R PIP" | |
2774 | *.-1 | |
2775 | CBAM7, TEXT "_*PROG.BA<" | |
2776 | CBAM2, TEXT "<PROG.BA" | |
2777 | *.-1 | |
2778 | CBAM8, TEXT "_" | |
2779 | CBAM3, TEXT 'FILE #3:"DATA.DA"\FILEV #4:"' | |
2780 | CBAM4, TEXT '"_' | |
2781 | CBAM5, TEXT "PROG.BA," | |
2782 | CBAM6, TEXT "BAT:," | |
2783 | PIPM1, TEXT "/T" | |
2784 | DTF4M1, | |
2785 | DATBM1, TEXT ".R PIP_*DATA.DA<BAT:_" | |
2786 | DATBM2, TEXT "$EOD_.R BCOMP_*PROG.BA_" | |
2787 | CF2M2, | |
2788 | CF4M2, TEXT "BAT:_" | |
2789 | CF4M3, TEXT "$EOD_.R F4_*" | |
2790 | CF4M4, TEXT "/F" | |
2791 | CL4SM1, TEXT ".R LOAD_*" | |
2792 | CL4SM2, TEXT "<_*" | |
2793 | CL2M7, | |
2794 | CL4SM3, TEXT "/L_*" | |
2795 | CL4SM4, TEXT "/C_*" | |
2796 | CL4SM5, TEXT "/O" | |
2797 | DTF4M3, | |
2798 | CF2M4, | |
2799 | CL2M6, | |
2800 | CL4SM6, TEXT "_*" | |
2801 | DTF4M5, | |
2802 | CL4SM7, TEXT "$_" | |
2803 | CL4SM8, TEXT "/S" | |
2804 | DTF4M2, TEXT "$EOD_.R FRTS_*" | |
2805 | DTF4M4, TEXT "/C" | |
2806 | DTF4M6, TEXT "_*DATA.DA/4_*" | |
2807 | DTF4M7, TEXT "/5" | |
2808 | DTF4M8, TEXT "_*/5=4" | |
2809 | DATNO1, TEXT "?NO PROGRAM TO RUN_" | |
2810 | CF2M3, TEXT "$EOD" | |
2811 | CF2M5, TEXT "_.R FORT_*" | |
2812 | CL2M1, TEXT ".R LOADER_*" | |
2813 | CL2M1A, TEXT ".R LOADER_*GENIOX" | |
2814 | CL2M3, TEXT "/I" | |
2815 | CL2M4, TEXT "/O" | |
2816 | CL2M5, TEXT "/H" | |
2817 | CL2M8, TEXT "</M_*" | |
2818 | CL2M9, TEXT "$_.SAVE " | |
2819 | DTF2M1, TEXT ".RUN " | |
2820 | MBAS, TEXT "$BASIC" | |
2821 | MFOR, TEXT "$FORTRAN" | |
2822 | MJOB1, TEXT ".R FOTP_*FIL???.*/D_" | |
2823 | MEOD, TEXT "$EOD" | |
2824 | MJOB, TEXT "$JOB" | |
2825 | MMSG, TEXT "$MSG" | |
2826 | MDECK, TEXT "$DECK" | |
2827 | MLOAD, TEXT "$LOAD" | |
2828 | MDATA, TEXT "$RUN" | |
2829 | \f$ |