Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /UTILITY SUBROUTINE PACKAGE OS8 FORTRAN II LIBRARY |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 1974,1977 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 MANUAL. | |
26 | / | |
27 | /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER | |
28 | /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED | |
29 | /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH | |
30 | /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. | |
31 | / | |
32 | /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE | |
33 | /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY | |
34 | /DIGITAL. | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | / | |
41 | / | |
42 | / | |
43 | / | |
44 | / | |
45 | /UTILITY SUBROUTINE PACKAGE OS8 FORTRAN II LIBRARY | |
46 | \f/ VERSION 10A (APRIL 28, 1977) | |
47 | / VERSION NUMBER IS AVAILABLE AT ENTRY POINTS | |
48 | / | |
49 | ENTRY OPEN /INITIALIZING AND FLAG SETTING ROUTINE | |
50 | ENTRY GENIO | |
51 | ENTRY EXIT /EXIT TO DISK MONITOR SYSTEM | |
52 | ENTRY ERROR | |
53 | ENTRY CKIO /USELESS ROUTINE | |
54 | OPDEF KRS 6034 | |
55 | OPDEF KCC 6032 | |
56 | OPDEF TADI 1400 | |
57 | OPDEF DCAI 3400 | |
58 | OPDEF JMSI 4400 | |
59 | OPDEF JMPI 5400 | |
60 | / CARD READER IOT'S | |
61 | OPDEF RCSE 6672 | |
62 | OPDEF RCSP 6671 | |
63 | OPDEF RCSF 6631 | |
64 | OPDEF RCRA 6632 | |
65 | /LINE PRINTER IOT'S | |
66 | OPDEF LLB 6666 | |
67 | OPDEF LSF 6661 | |
68 | ||
69 | LAP | |
70 | ||
71 | U17, 17 /*** MUST BE FIRST LOC IN PAGE *** | |
72 | ||
73 | IOER, 1117 | |
74 | 0522 /"IOER" ERROR | |
75 | GENIO, BLOCK 1 | |
76 | 10 /GENERAL INPUT/OUTPUT ROUTINE | |
77 | DCA 7 /SAVE ENTRY AC | |
78 | GENLP, TAD 7 | |
79 | RTL | |
80 | RTL | |
81 | RAL | |
82 | U200, AND U17 | |
83 | TAD JMPITB | |
84 | DCA DSPACH /INDEX JUMP TABLE BY DEVICE NUMBER | |
85 | TAD U200 | |
86 | KRS | |
87 | TAD UM203 | |
88 | SNA CLA | |
89 | KSF /CHECK FOR ^C ON TELETYPE | |
90 | DSPACH, NOP /NO ^C - DISPATCH TO I/O ROUTINE | |
91 | CALL 0,EXIT | |
92 | ||
93 | JMPITB, JMPI DEVTAB | |
94 | DEVTAB, TTYOUT | |
95 | HSPOUT | |
96 | LPTOUT | |
97 | GENOUT | |
98 | TTYIN | |
99 | HSRIN | |
100 | CDRIN | |
101 | GENIN | |
102 | TTYFUJ /FUDGE - SEE TELETYPE INPUT ROUTINE | |
103 | IOERR | |
104 | IOERR | |
105 | IOERR | |
106 | IOERR | |
107 | IOERR | |
108 | IOERR | |
109 | IOERR | |
110 | ||
111 | HSPOUT, PSF | |
112 | JMP GENLP | |
113 | TAD 7 | |
114 | PLS | |
115 | GENRTN, CLA | |
116 | RETRN GENIO | |
117 | ||
118 | TTYIN, KSF | |
119 | JMP GENLP | |
120 | CLA CLL CML RTR /****DEPENDS ON NUMBER OF DEVICES **** | |
121 | JMP GENLP /TEST FOR ^C ONE LAST TIME | |
122 | ||
123 | HSRIN, ISZ T1 | |
124 | JMP HSRSF | |
125 | TAD U336 /TIME OUT-PRINT '^' | |
126 | TLS | |
127 | HLP, KSF | |
128 | JMP HLP | |
129 | AND U200 /GET 200 INTO AC | |
130 | KRS /READ THE CHAR. | |
131 | TAD UM203 | |
132 | SZA CLA /IS IT CONTROL C? | |
133 | KCC /NO-CLEAR FLAG | |
134 | RFC /USER TYPED-TICKLE RDR-FALL THRU RFC | |
135 | HSRSF, RSF | |
136 | JMP GENLP | |
137 | DCA T1 | |
138 | RRB RFC | |
139 | JMP GENRTN# | |
140 | U336, 336 | |
141 | T1, 0 | |
142 | ||
143 | UM203, -203 | |
144 | PCDRGC, CDRGCH /USED TO FORCE DF=CURRENT WHEN NECESSARY | |
145 | CDR215, 215 | |
146 | CDR100, 100 | |
147 | CDR240, 240 | |
148 | PCDRTB, CDRTBL /CONVERSION FROM CARD CODE TO ASCII-240 | |
149 | CDRCT, 0 | |
150 | CDRLEN, 0 | |
151 | CDRIN, TAD CDRCT | |
152 | SNA CLA | |
153 | JMP CDRNXT /NEW CARD NECESSARY | |
154 | ISZ CDRCT /ADVANCE TO NEXT COLUMN | |
155 | JMP CDRGET | |
156 | TAD CDR215 /NO MORE - SEND A CARRIAGE RETURN | |
157 | JMP GENRTN# | |
158 | ||
159 | CDREST, KSF | |
160 | JMP CDRTST | |
161 | KCC | |
162 | CDRNXT, RCSE | |
163 | JMP GENLP /CHECK FOR ^C WHILE WAITING FOR NEXT CARD | |
164 | CDRTST, RCSP | |
165 | JMP CDRCOL /NOT END OF CARD YET | |
166 | TAD CDRCT /END OF CARD - SET UP FOR EXTRACTION OF CHARS | |
167 | CIA | |
168 | DCA CDRLEN | |
169 | CDRGET, TAD CDRCT | |
170 | TAD CDRLEN /FORM CHAR POINTER INTO TABLE AT 10100 | |
171 | CLL RAR | |
172 | TAD CDR100 | |
173 | 6211 | |
174 | JMSI PCDRGCH /INDEX TABLE AND PULL OUT CHAR (DF=10) | |
175 | TAD CDR240 /CHANGE TO ASCII | |
176 | JMP GENRTN# /RETURN | |
177 | CDRCOL, RCSF /ANYTHING YET? | |
178 | JMP CDREST /KEEP LOOKING | |
179 | RCRA /READ IT | |
180 | CLL RAR | |
181 | TAD PCDRTB | |
182 | JMS I PCDRGC /GET TABLE ENTRY, FORCING DATA FIELD CURRENT | |
183 | DCA CDRLEN /SAVE IT TEMPORARILY | |
184 | TAD CDRCT | |
185 | CIA | |
186 | CLL RAR | |
187 | TAD CDR100 /INDEX TABLE AT LOC 10100 | |
188 | DCA DSPACH | |
189 | 6211 /CDF 10 | |
190 | TAD CDRLEN | |
191 | SZL /WHICH HALF? | |
192 | JMP CDNORT /RIGHT HALF | |
193 | RTL | |
194 | RTL | |
195 | RTL | |
196 | SKP | |
197 | CDNORT, TADI DSPACH /ADD EXISTING LEFT HALF | |
198 | DCAI DSPACH /SAVE UPDATED ENTRY | |
199 | CLA CMA | |
200 | TAD CDRCT | |
201 | DCA CDRCT /UPDATE COLUMN POINTER | |
202 | JMP CDRCOL | |
203 | ||
204 | ||
205 | PAGE | |
206 | \fU377, 377 /MUST BE FIRST LOC IN THIS PAGE | |
207 | GENIN, 6201 | |
208 | TADI IHNDLR | |
209 | SNA CLA /OPEN INPUT FILE? | |
210 | JMP IOERR /NO | |
211 | 6202 | |
212 | JMS I FICHAR /GET A CHAR | |
213 | JMP IOERR /INPUT ERROR | |
214 | UU200, AND U377 | |
215 | GRTN2, RETRN GENIO | |
216 | ||
217 | GENOUT, 6201 | |
218 | TADI OHNDLR | |
219 | SNA CLA /OPEN OUTPUT FILE? | |
220 | JMP IOERR /NO | |
221 | 6202 | |
222 | TAD 7 /GET CHAR TO BE OUTPUT | |
223 | AND U377 | |
224 | JMS I FOCHAR /PUT A CHARACTER | |
225 | JMP IOERR /OUTPUT ERROR | |
226 | JMP GRTN2 | |
227 | ||
228 | IHNDLR, 122 /***ALL THESE LOCATIONS ARE VERY VOLATILE!! *** | |
229 | FICHAR, 606 /******* | |
230 | OHNDLR, 121 /******* | |
231 | FOCHAR, 651 /****************** | |
232 | ||
233 | / | |
234 | / INITIALIZING SUBROUTINE CALLED BY FORTRAN | |
235 | / CLEARS FLOATING AC AND SETS FLAGS | |
236 | / | |
237 | OPEN, BLOCK 1 | |
238 | 10 | |
239 | TAD (212 | |
240 | TLS /PUT LINE-FEED ON TTY | |
241 | LLB /INITIALIZE LPT | |
242 | KCC /CLEAR KEYBOARD FLAG (AND AC) | |
243 | PLS | |
244 | RFC | |
245 | CALL 0,CLEAR | |
246 | 6201 | |
247 | DCAI IHNDLR | |
248 | DCAI OHNDLR /ZERO DEVICE-INDEPENDENT IO FLAGS | |
249 | RETRN OPEN | |
250 | ||
251 | ||
252 | LPTOUT, LSF | |
253 | JMP GENLP | |
254 | TAD 7 | |
255 | ISZ PFSTCH | |
256 | JMP NOFST | |
257 | TAD (-1262 /LOOK FOR CONTROL CHARS IN PRINT POSITION 1 | |
258 | CLL IAC | |
259 | IAC | |
260 | SNL | |
261 | JMP DCACH | |
262 | CLL RAL | |
263 | TAD (212 | |
264 | NOFST, LLB | |
265 | TAD (-1212 | |
266 | DCACH, SNA CLA /IF LINE FEED | |
267 | CMA /SET "FIRST CHAR" SWITCH ON | |
268 | DCA PFSTCH | |
269 | JMP GRTN2 | |
270 | PFSTCH, -1 | |
271 | ||
272 | TTYFUJ, TAD UU200 | |
273 | KRS | |
274 | DCA 7 /SAVE KEYBOARD CHAR | |
275 | KCC /CLEAR FLAG | |
276 | TAD 7 | |
277 | TAD (-212 | |
278 | SZA CLA | |
279 | JMS TYPE | |
280 | TAD 7 | |
281 | TAD (-215 | |
282 | SZA CLA | |
283 | JMP TYRTN | |
284 | CLA CLL CMA RTL | |
285 | JMS TYPE | |
286 | TYRTN, TAD 7 | |
287 | JMP GRTN2 /RETURN WITH CHAR IN AC | |
288 | ||
289 | TYPE, 0 | |
290 | TAD 7 | |
291 | TYPELP, TSF | |
292 | JMP TYPELP | |
293 | TLS | |
294 | CLA | |
295 | JMPI TYPE | |
296 | ||
297 | TTYOUT, JMS TYPE | |
298 | JMP GRTN2 | |
299 | ||
300 | IOERR, CALL 1,ERROR | |
301 | ARG IOER | |
302 | ||
303 | CDRTBL, 0021;2223;2425;2627 | |
304 | 3031;3203;4007;3502 | |
305 | 2017;6364;6566;6770 | |
306 | 7172;7514;0577;3637 | |
307 | 1552;5354;5556;5760 | |
308 | 6162;0104;1211;3374 | |
309 | 0641;4243;4445;4647 | |
310 | 5051;7316;3410;1376 | |
311 | ||
312 | PAGE | |
313 | \f | |
314 | PMESG, MESG | |
315 | MESG, 7777 | |
316 | 7777 | |
317 | 4005 | |
318 | 2222 | |
319 | 1722 | |
320 | 4001 | |
321 | 2440 | |
322 | 1417 | |
323 | 0340 | |
324 | LIT7, 0007 | |
325 | ||
326 | ERROR, BLOCK 1 | |
327 | 10 /ERROR PROCESSOR | |
328 | U7600, 7600 | |
329 | TAD ERROR | |
330 | DCA TEM1 | |
331 | TEM1, NOP /SET DATA FIELD OF "CALL ERROR" | |
332 | TADI ERROR# | |
333 | DCA TEM3 | |
334 | INC ERROR# | |
335 | E60, CLA CMA CML /CML IS WINDOW DRESSING | |
336 | TADI ERROR# | |
337 | DCA 10 | |
338 | INC ERROR# | |
339 | TEM3, NOP /DATA FIELD OF MESSAGE&ENTRY POINT | |
340 | DCA CKIO /ZERO "FATAL ERROR" FLAG | |
341 | TADI 10 | |
342 | RAL | |
343 | SZL /NON-FATAL BIT ON? | |
344 | ISZ CKIO /YES - SET "FATAL FLAG" TO NON-FATAL | |
345 | CLL RAR /STRIP NON-FATAL BIT FROM MESSAGE | |
346 | DCA MESG | |
347 | TADI 10 /SECOND WORD OF MESSAGE | |
348 | DCA MESG# | |
349 | TADI 10 | |
350 | DCA TEM1 | |
351 | TADI 10 | |
352 | DCA TEM3 /CALLING ADDRESS | |
353 | TAD PMESG | |
354 | DCA TEM2 | |
355 | ||
356 | ERLP, TAD I TEM2 | |
357 | RTR | |
358 | RTR | |
359 | RTR | |
360 | JMS PR6BIT | |
361 | TAD I TEM2 | |
362 | JMS PR6BIT | |
363 | INC TEM2 | |
364 | JMP ERLP | |
365 | ||
366 | PRLOC, TAD TEM1 | |
367 | RTR | |
368 | RTR | |
369 | JMS ERTTY /PRINT CALLING FIELD | |
370 | TAD (-4 | |
371 | DCA TEM2 | |
372 | NUMLP, TAD TEM3 | |
373 | RTL | |
374 | RAL | |
375 | DCA TEM3 | |
376 | TAD TEM3 | |
377 | JMS ERTTY | |
378 | ISZ TEM2 | |
379 | JMP NUMLP | |
380 | TAD (215 | |
381 | DCA 7 | |
382 | JMS TYPE | |
383 | CLA CLL CMA RTL | |
384 | JMS TYPE | |
385 | TAD CKIO /GET THE FATAL ERROR FLAG | |
386 | SNA CLA /WHADDOWEDO?? | |
387 | JMP EXITX | |
388 | RETRN ERROR /HE SAYS ITS NON-FATAL - LET HIM HANDLE IT | |
389 | ||
390 | ERTTY, 0 /DIGIT PRINTING ROUTINE | |
391 | RAL | |
392 | AND LIT7 | |
393 | TAD E60 | |
394 | JMS PR6BIT | |
395 | JMP I ERTTY | |
396 | ||
397 | PR6BIT, 0 /6BIT TO 8BIT CONVERTOR | |
398 | AND (77 | |
399 | SNA | |
400 | JMP PRLOC /MESSAGE OVER | |
401 | TAD (7740 | |
402 | SPA | |
403 | TAD (100 | |
404 | TAD (240 | |
405 | CALL 0,GENIO /LOOK FOR ^C WHILE TYPING | |
406 | JMP I PR6BIT | |
407 | ||
408 | / | |
409 | /EXIT TO DISK MONITOR SYSTEM | |
410 | / | |
411 | EXIT, BLOCK 1 | |
412 | 10 | |
413 | EXITX, CALL 0,CKIO | |
414 | 6203 | |
415 | JMPI U7600 /RETURN TO MONITOR | |
416 | ||
417 | CKIO, 0 | |
418 | TEM2, 10 /DUMMY SUBROUTINE TO WAIT FOR I/O COMPLETE | |
419 | CKWAIT, 6041 | |
420 | JMP CKWAIT | |
421 | RETRN CKIO | |
422 | ||
423 | CDRGCH, 0 /GET A CHAR FROM A PACKED TABLE | |
424 | DCA TEM2 /WORD PTR IN AC, LEFT/RIGHT SW IN LINK | |
425 | TADI TEM2 /PRESERVE ENTRY FIELD | |
426 | SZL | |
427 | JMP CDRAND /RIGHT HALF | |
428 | RTR | |
429 | RTR | |
430 | RTR | |
431 | CDRAND, AND CDR77 | |
432 | JMP I CDRGCH /RESTORE CURRENT FIELD AND GET OUT | |
433 | CDR77, 77 | |
434 | ||
435 | END | |
436 | \f |