Trailing-Edge
-
PDP-10 Archives
-
BB-H348C-RM_1982
-
swskit-v21/listings/tkb-vnp/fio10.bpt
There are no other files named fio10.bpt in the archive.
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
1 !<TKB-VNP>FIO10.BLI.3, 13-Jun-79 08:11:59, Edit by SROBINSON
2 !<SAUTER.TKB20>FIO10.BLI.2, 28-Nov-78 11:31:47, Edit by SROBINSON
3 !<SAUTER.TKB20>FIO.BLI.10, 15-Nov-78 11:05:23, Edit by SROBINSON
4 MODULE FIO10 ( ! FILE I/O
5 IDENT = 'X0.3'
6 ) =
7 BEGIN
8 !
9 !
10 !
11 ! COPYRIGHT (C) 1978, 1979 BY
12 ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
13 !
14 !
15 ! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
16 ! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
17 ! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
18 ! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
19 ! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
20 ! TRANSFERRED.
21 !
22 !
23 ! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
24 ! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
25 ! CORPORATION.
26 !
27 ! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
28 ! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
29 !
30
31 !++
32 ! FACILITY: TKB-20 AND VNP-20
33 !
34 ! ABSTRACT:
35 !
36 !
37 ! THIS MODULE DOES FILE I/O FOR THE TASK BUILDER.
38 !
39 ! THE CALLS ARE: OPEN, CLOSE, INPUT AND OUTPUT.
40 ! ALL TAKE A 'CHANNEL' ARGUMENT. CHANNEL NUMBERS ARE BETWEEN
41 ! 0 AND 15. CHANNEL 0 IS ALWAYS OPEN TO THE TERMINAL.
42 !
43 !
44 ! ENVIRONMENT: TOPS-10 USER MODE
45 !
46 ! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
47 !
48 ! MODIFIED BY:
49 !
50 ! Scott G. Robinson, 15-NOV-78 : VERSION X0.1-2A
51 ! - Add %C' ' to the break set for file names
52 !
53 ! Scott G. Robinson, 28-NOV-78 : VERSION X0.2
54 ! - Make this module FIO10 because it is for a
55 ! TOPS-10 I/O Scheme
56 !
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
57 ! Scott G. Robinson, 13-JUN-79 : VERSITON X0.3
58 ! - Add routine STOP_PROGRAM
59 !
60 ! , : VERSION
61 ! 01 -
62 !--
63
64 !<BLF/PAGE>
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
65 !
66 ! TABLE OF CONTENTS:
67 !
68
69 FORWARD ROUTINE
70 RESET_ALL : NOVALUE, !RESET ALL I/O
71 SIXBIT, !TRANSLATE ASCII TO SIXBIT
72 OPEN, !OPEN A FILE (GLOBAL)
73 CLOSE : NOVALUE, !CLOSE A FILE (GLOBAL)
74 INPUT, !READ FROM A FILE (GLOBAL)
75 OUTPUT : NOVALUE, !WRITE ON A FILE (GLOBAL)
76 STOP_PROGRAM : NOVALUE; !TERMINATE PROGRAM
77
78 !
79 ! INCLUDE FILES:
80 !
81 ! NONE
82 !
83 ! MACROS:
84 !
85 ! NONE
86 !
87 ! EQUATED SYMBOLS:
88 !
89
90 LITERAL
91 DEBUG = 0;
92
93 !
94 ! OWN STORAGE:
95 !
96
97 OWN
98 CHAN_STATUS : VECTOR [16],
99 CHAN_HEADER : VECTOR [16],
100 CHAN_BUFFER : VECTOR [16],
101 CHAN_WORD : VECTOR [16],
102 CHAN_CTR : VECTOR [16],
103 CHAN_DIRECTION : VECTOR [16];
104
105 LITERAL
106 FILE_NAME_LEN = CH$ALLOCATION (40);
107
108 OWN
109 CHAN_FNAME : VECTOR [16*FILE_NAME_LEN];
110
111 !
112 ! EXTERNAL REFERENCES:
113 !
114
115 EXTERNAL ROUTINE
116 ERROR, !PROGRAMMING ERROR
117 ERRMSG, !ERROR MESSAGE PRINTER
118 GETSTG, !GET STORAGE FROM FREE LIST
119 FRESTG; !RETURN STORAGE TO FREE LIST
120
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
121 GLOBAL ROUTINE RESET_ALL : NOVALUE = !RESET ALL I/O
122
123 !++
124 ! FUNCTIONAL DESCRIPTION:
125 !
126 !
127 ! ROUTINE TO RESET ALL I/O. IT DOES THIS BY ISSUEING THE
128 ! TOPS-10 "RESET" UUO.
129 !
130 !
131 ! FORMAL PARAMETERS:
132 !
133 ! NONE
134 !
135 ! IMPLICIT INPUTS:
136 !
137 ! NONE
138 !
139 ! IMPLICIT OUTPUTS:
140 !
141 ! NONE
142 !
143 ! ROUTINE VALUE:
144 !
145 ! NONE
146 !
147 ! SIDE EFFECTS
148 !
149 ! RESETS ALL I/O
150 !
151 !--
152
153 BEGIN
154
155 BUILTIN
156 UUO;
157
158 UUO (0, %O'047', 0, 0);
159 END; !OF RESET_ALL
160
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
161 ROUTINE SIXBIT (ASCII_PTR) = !ASCII TO SIXBIT
162
163 !++
164 ! FUNCTIONAL DESCRIPTION:
165 !
166 !
167 ! ROUTINE TO CONVERT UP TO SIX CHARACTERS OF ASCII STRING TO
168 ! SIXBIT.
169 !
170 !
171 ! FORMAL PARAMETERS:
172 !
173 ! ASCII_PTR - POINTER TO ASCII STRING
174 !
175 ! IMPLICIT INPUTS:
176 !
177 ! NONE
178 !
179 ! IMPLICIT OUTPUTS:
180 !
181 ! NONE
182 !
183 ! ROUTINE VALUE:
184 !
185 ! THE VALUE OF THE STRING, IN SIXBIT.
186 !
187 ! SIDE EFFECTS
188 !
189 ! NONE
190 !
191 !--
192
193 BEGIN
194
195 LOCAL
196 OUTPTR,
197 INPTR,
198 CHAR,
199 CHAR_CTR,
200 RESULT;
201
202 !
203 RESULT = 0;
204 OUTPTR = CH$PTR (RESULT, -1, 6);
205 INPTR = CH$PTR (.ASCII_PTR, -1, 7);
206 CHAR = 0;
207 CHAR_CTR = 0;
208 !
209
210 DO
211 BEGIN
212 CHAR = CH$A_RCHAR (INPTR);
213
214 IF ((.CHAR GEQ %C' ') AND (.CHAR LEQ %C'_')) THEN CH$A_WCHAR (.CHAR - %O'40', OUTPTR);
215
216 CHAR_CTR = .CHAR_CTR + 1;
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
217 END
218 UNTIL ((.CHAR EQL 0) OR (.CHAR_CTR GEQ 6));
219
220 .RESULT
221 END;
222
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
223 GLOBAL ROUTINE OPEN (CHANX, FNAME, MODE, IO, DEFEXT) : = !OPEN A FILE
224
225 !++
226 ! FUNCTIONAL DESCRIPTION:
227 !
228 !
229 !
230 ! OPEN A FILE.
231 !
232 !
233 ! FORMAL PARAMETERS:
234 !
235 ! CHANX - THE CHANNEL NUMBER TO OPEN.
236 ! FNAME - POINTER TO FILE NAME STRING.
237 ! MODE - I/O MODE: 1 = CHARACTER, 2 = WORD.
238 ! IO - 0 = INPUT, 1 = OUTPUT.
239 ! DEFEXT - POINTER TO DEFAULT EXTENSION (3 CHARS)
240 !
241 ! IMPLICIT INPUTS:
242 !
243 ! NONE
244 !
245 ! IMPLICIT OUTPUTS:
246 !
247 ! NONE
248 !
249 ! ROUTINE VALUE:
250 !
251 ! 1 IF OPEN SUCCESSFUL, 0 IF NOT.
252 !
253 ! SIDE EFFECTS
254 !
255 ! ASSOCIATES CHANNEL NUMBER WITH DEVICE BY DOING UUOS
256 ! AND MODIFYING OWN STORAGE.
257 !
258 !--
259
260 BEGIN
261
262 BIND
263 ROUTINE_NAME = UPLIT (%ASCIZ'OPEN');
264
265 LOCAL
266 ACCUM,
267 ACCUM_CTR,
268 ACCUM_PTR,
269 BUF_PTR,
270 CHAN,
271 CHAR,
272 DEV_NAME,
273 END_SCAN,
274 FILE_NAME,
275 FILE_EXT,
276 FILN_PTR,
277 FIL_PTR,
278 HEADER_PTR,
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
279 LOOKUP_BLOCK : VECTOR [4],
280 OPEN_BLOCK : VECTOR [3],
281 RESULT,
282 SAVEJOBFF,
283 SUCCESS;
284
285 EXTERNAL LITERAL
286 %NAME ('.JBFF');
287
288 BUILTIN
289 UUO;
290
291 CHAN = .CHANX;
292 RESULT = 0;
293
294 IF (.CHAN EQL 0)
295 THEN
296 ERROR (UPLIT (%ASCIZ'MAY NOT OPEN CHANNEL 0 - OPEN'))
297 ELSE
298
299 IF ((.CHAN GTR 15) OR (.CHAN LSS 0))
300 THEN
301 ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - OPEN'))
302 ELSE
303
304 IF (.CHAN_STATUS [.CHAN] NEQ 0)
305 THEN
306 ERROR (UPLIT (%ASCIZ'CHANNEL ALREADY OPEN - OPEN'))
307 ELSE
308
309 IF ((.MODE NEQ 1) AND (.MODE NEQ 2))
310 THEN
311 ERROR (UPLIT (%ASCIZ'ILLEGAL MODE - OPEN'))
312 ELSE
313 BEGIN !THINGS SEEM OK.
314 DEV_NAME = 0;
315 FILE_NAME = 0;
316 FILE_EXT = 0;
317 ACCUM = 0;
318 END_SCAN = 0;
319 !
320 FIL_PTR = CH$PTR (.FNAME, -1, 7);
321 FILN_PTR = CH$PTR (CHAN_FNAME [.CHAN*FILE_NAME_LEN], -1, 7);
322 ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
323 ACCUM_CTR = 0;
324 !
325
326 DO
327 BEGIN !SCAN THE FILE NAME STRING
328 CHAR = CH$A_RCHAR (FIL_PTR);
329 CH$A_WCHAR (.CHAR, FILN_PTR);
330
331 SELECTONE .CHAR OF
332 SET
333
334 [0,%C' '] :
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
335 END_SCAN = 1;
336
337 [%C'A' TO %C'Z', %C'0' TO %C'9', %C'A' + %O'40' TO %C'Z' + %O'40'] :
338 BEGIN !ALPHANUMERIC
339
340 IF ((ACCUM_CTR = .ACCUM_CTR + 1) GTR 6)
341 THEN
342 ERRMSG (0, 2, ROUTINE_NAME,
343 .FNAME, 0, 0, 0)
344 ELSE
345 CH$A_WCHAR (.CHAR - %O'40', ACCUM_PTR);
346
347 END;
348
349 [%C':'] :
350 BEGIN ! WE HAVE SCANNED A DEVICE NAME
351 DEV_NAME = .ACCUM;
352 ACCUM = 0;
353 ACCUM_CTR = 0;
354 ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
355 END;
356
357 [%C'.'] :
358 BEGIN ! WE HAVE SCANNED A FILE NAME
359 FILE_NAME = .ACCUM;
360 ACCUM = 0;
361 ACCUM_CTR = 0;
362 ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
363 END;
364
365 [OTHERWISE] :
366 ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0);
367 TES;
368
369 END
370 WHILE (.END_SCAN EQL 0);
371
372 !
373 ! SUBSTITUTE THE DEFAULTS
374 !
375
376 IF (.FILE_NAME EQL 0)
377 THEN
378 BEGIN !NAME IS ZERO, CHECK FOR UNDELIMITED NAME
379 FILE_NAME = .ACCUM;
380 ACCUM = 0;
381 ACCUM_CTR = 0;
382 END;
383
384 IF (.FILE_EXT EQL 0)
385 THEN
386 BEGIN !EXTENSION IS ZERO, USE LAST NAME PROVIDED.
387 FILE_EXT = .ACCUM;
388
389 IF (.ACCUM_CTR GTR 3) THEN ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0);
390
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
391 ACCUM = 0;
392 ACCUM_CTR = 0;
393 END;
394
395 IF (.DEV_NAME EQL 0) THEN DEV_NAME = SIXBIT (UPLIT (%ASCIZ'DSK'));
396
397 IF (.FILE_EXT EQL 0) THEN FILE_EXT = SIXBIT (.DEFEXT);
398
399 IF (.FILE_NAME EQL 0)
400 THEN
401 ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0)
402 ELSE
403 BEGIN
404 OPEN_BLOCK [0] = (.MODE - 1)*%O'14'; !CHAR = 0, WORD = 14 OCTAL.
405 OPEN_BLOCK [1] = .DEV_NAME;
406
407 IF ((HEADER_PTR = GETSTG (3)) EQL 0)
408 THEN
409 ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
410 ELSE
411 BEGIN
412
413 IF (.IO NEQ 0)
414 THEN
415 OPEN_BLOCK [2] = (.HEADER_PTR)^18
416 ELSE
417 OPEN_BLOCK [2] = (.HEADER_PTR);
418
419 CHAN_HEADER [.CHAN] = .HEADER_PTR;
420
421 IF (UUO (1, %O'050', .CHAN, OPEN_BLOCK) EQL 0) THEN ! ISSUE OPEN UUO
422 ERRMSG (0, 3, ROUTINE_NAME, .FNAME, 0, 0, 0)
423 ELSE
424 BEGIN !OPEN UUO SUCCEEDED.
425
426 IF ((BUF_PTR = GETSTG (%O'203')) EQL 0)
427 THEN
428 ERRMSG (0, 1, ROUTINE_NAME, 0,
429 0, 0, 0)
430 ELSE
431 BEGIN
432 SAVEJOBFF = .(%NAME ('.JBFF'));
433 %NAME ('.JBFF') = .BUF_PTR;
434 CHAN_BUFFER [.CHAN] = .BUF_PTR;
435 LOOKUP_BLOCK [0] = .FILE_NAME;
436 LOOKUP_BLOCK [1] = .FILE_EXT;
437 LOOKUP_BLOCK [2] = LOOKUP_BLOCK [3] = 0;
438
439 IF (.IO NEQ 0)
440 THEN
441 UUO (0, %O'065', .CHAN, 1) !OUTBUF
442 ELSE
443 UUO (0, %O'064', .CHAN, 1); !INBUF
444
445 %NAME ('.JBFF') = .SAVEJOBFF;
446
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
447 IF (.IO NEQ 0)
448 THEN
449 SUCCESS = UUO (1, %O'077', .CHAN, LOOKUP_BLOCK) !ENTER
450 ELSE
451 SUCCESS = UUO (1, %O'076', .CHAN, LOOKUP_BLOCK); !LOOKUP
452
453 IF (.SUCCESS EQL 0)
454 THEN
455 ERRMSG (0, 4, ROUTINE_NAME, .FNAME,
456 .LOOKUP_BLOCK [3], 0, 0)
457 ELSE
458 BEGIN
459 CHAN_STATUS [.CHAN] = .MODE;
460 CHAN_DIRECTION [.CHAN] = .IO;
461 CHAN_CTR [.CHAN] = 0;
462 RESULT = 1; !FLAG SUCCESSFUL OPEN
463 END; !OF LOOKUP/ENTER SUCCEEDED
464
465 END; !OF BUFFER STORAGE OBTAINED
466
467 END; !OF OPEN UUO SUCCEEDED
468
469 END; !OF HEADER STORAGE OBTAINED
470
471 END; !OF FILE NAME PROVIDED
472
473 END; !OF PARMS SEEM OK
474
475 .RESULT
476 END; !OF ROUTINE OPEN
477
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
478 GLOBAL ROUTINE CLOSE (CHANX) : NOVALUE = ! CLOSE A CHANNEL
479
480 !++
481 ! FUNCTIONAL DESCRIPTION:
482 !
483 ! THE CLOSE ROUTINE CLOSES A CHANNEL.
484 !
485 ! FORMAL PARAMETERS:
486 !
487 ! CHANX - THE CHANNEL TO CLOSE.
488 !
489 ! IMPLICIT INPUTS:
490 !
491 ! NONE
492 !
493 ! IMPLICIT OUTPUTS:
494 !
495 ! NONE
496 !
497 ! ROUTINE VALUE:
498 !
499 ! NONE
500 !
501 ! SIDE EFFECTS
502 !
503 ! CLOSES THE CHANNEL BY DOING UUOS AND MODIFYING OWN STORAGE
504 !
505 !--
506
507 BEGIN
508
509 LOCAL
510 CHAN;
511
512 BUILTIN
513 UUO;
514
515 CHAN = .CHANX;
516
517 IF (.CHAN EQL 0)
518 THEN
519 ERROR (UPLIT (%ASCIZ'YOU MAY NOT CLOSE CHANNEL 0 - CLOSE'))
520 ELSE
521
522 IF ((.CHAN LSS 0) OR (.CHAN GTR 15))
523 THEN
524 ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - CLOSE'))
525 ELSE
526
527 IF (.CHAN_STATUS [.CHAN] EQL 0)
528 THEN
529 ERROR (UPLIT (%ASCIZ'CHANNEL IS NOT OPEN - CLOSE'))
530 ELSE
531 BEGIN !CHANNEL NUMBER SEEMS OK
532
533 IF (.CHAN_DIRECTION [.CHAN] EQL 1)
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
534 THEN
535 BEGIN !ADJUST BYTE POINTER TO LAST BYTE
536
537 INCR COUNTER FROM 1 TO 8 DO
538 OUTPUT (.CHAN, 0);
539
540 END;
541
542 UUO (0, %O'070', .CHAN, 0); !CLOSE
543 FRESTG (.CHAN_BUFFER [.CHAN], %O'203');
544 FRESTG (.CHAN_HEADER [.CHAN], 3);
545 CHAN_STATUS [.CHAN] = 0;
546 END; !CHANNEL NUMBER OK
547
548 END; !OF ROUTINE CLOSE
549
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
550 GLOBAL ROUTINE INPUT (CHANX) = ! READ FROM AN I/O DEVICE
551
552 !++
553 ! FUNCTIONAL DESCRIPTION:
554 !
555 ! READ A BYTE OR WORD FROM THE SPECIFIED CHANNEL
556 ! EOF OR ERROR RETURNS A -1
557 !
558 ! FORMAL PARAMETERS:
559 !
560 ! CHANX - THE CHANNEL OVER WHICH TO READ THE BYTE OR WORD
561 !
562 ! IMPLICIT INPUTS:
563 !
564 ! NONE
565 !
566 ! IMPLICIT OUTPUTS:
567 !
568 ! NONE
569 !
570 ! ROUTINE VALUE:
571 !
572 ! THE BYTE OR WORD READ
573 !
574 ! SIDE EFFECTS
575 !
576 ! REMOVES ONE BYTE OR WORD FROM THE INPUT STRING
577 !
578 !--
579
580 BEGIN
581
582 LOCAL
583 CHAN,
584 CHAN_WORD_TMP,
585 CHARACTER,
586 FILI : REF VECTOR [3],
587 STATUS;
588
589 BUILTIN
590 UUO;
591
592 CHAN = .CHANX;
593 CHARACTER = 0;
594
595 IF ((.CHAN LSS 0) OR (.CHAN GTR 15))
596 THEN
597 ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - INPUT'))
598 ELSE
599
600 IF (.CHAN EQL 0)
601 THEN
602 BEGIN !CHANNEL 0 IS THE TERMINAL
603 UUO (0, %O'051', 4, CHARACTER); !INCHWL
604 END
605 ELSE
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
606 BEGIN !NOT CHANNEL 0
607
608 IF (.CHAN_STATUS [.CHAN] EQL 0)
609 THEN
610 ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN - INPUT'))
611 ELSE
612
613 IF (.CHAN_DIRECTION [.CHAN] NEQ 0)
614 THEN
615 ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN FOR INPUT - INPUT'))
616 ELSE
617 BEGIN !LOOKS OK
618 CHAN_WORD_TMP = .CHAN_WORD [.CHAN];
619
620 IF (.CHAN_CTR [.CHAN] NEQ 0)
621 THEN
622 BEGIN !TAKE A BYTE FROM CURRENT WORD
623 CHARACTER = .CHAN_WORD_TMP<(CASE .CHAN_CTR [.CHAN] FROM 1 TO 3 OF
624 SET
625 [1] : 26;
626 [2] : 0;
627 [3] : 8;
628 TES), 8>;
629 CHAN_CTR [.CHAN] = .CHAN_CTR [.CHAN] + 1;
630
631 IF (.CHAN_CTR [.CHAN] EQL 4) THEN CHAN_CTR [.CHAN] = 0;
632
633 END
634 ELSE
635 BEGIN !NEED A NEW WORD
636 FILI = .CHAN_HEADER [.CHAN];
637
638 IF ((FILI [2] = .FILI [2] - 1) LEQ 0)
639 THEN
640 BEGIN !NEED A NEW BUFFER
641
642 IF (UUO (1, %O'056', .CHAN, 0) NEQ 0) !IN UUO
643 THEN
644 BEGIN
645 BEGIN
646
647 IF (UUO (1, %O'063', .CHAN, %O'20000') NEQ 0) !STATZ UUO
648 THEN
649 BEGIN
650 UUO (0, %O'062', .CHAN, STATUS); ! GETSTS
651 ERRMSG (0, 5, UPLIT (%ASCIZ'INPUT'), CHAN_FNAME [.CHAN*FILE_NAME_LEN],
652 .STATUS, 0, 0);
653 END;
654
655 END;
656 CHARACTER = -1; !THIS VALUE RETURNED ON EOF OR ERROR
657 END
658 ELSE
659 BEGIN
660 FILI [1] = CH$PLUS (.FILI [1], -1);
661 CHARACTER = CH$A_RCHAR (FILI [1]);
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
662 END
663
664 END
665 ELSE
666 CHARACTER = CH$A_RCHAR (FILI [1]);
667
668 IF ((.CHAN_STATUS [.CHAN] EQL 2) AND (.CHARACTER GEQ 0))
669 THEN
670 BEGIN !WORD INPUT MODE, NOT EOF
671 CHAN_WORD [.CHAN] = .CHARACTER;
672 CHAN_WORD_TMP = .CHARACTER;
673 CHAN_CTR [.CHAN] = 1;
674 CHARACTER = .CHAN_WORD_TMP<18, 8>;
675 END;
676
677 END; !OF NEED NEW LONG WORD
678
679 END; !OF "LOOKS OK"
680
681 END; !OF NOT CHANNEL 0
682
683 .CHARACTER
684 END; !OF INPUT ROUTINE
685
DSK:FIO10.XRF[4,31]PPPPPPPPPPPPPP31-Aug-79P14:42PPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPPZ'OUTPUT'), CHANFNAME [.CHAN*FILENAMELEN],
787 .STATUS, 0, 0);
788 END
789 ELSE
790 FILI [1] = CH$PLUS (.FILI [1], -1);
791
792 END;
793
794 CH$A_WCHAR (.CHAN_WORD_TMP, FILI [1]);
795 END; !OF NEED TO WRITE LONG WORD
796
797 CHAN_WORD [.CHAN] = .CHAN_WORD_TMP;
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
798 END; !OF "LOOKS OK"
799
800 END; !OF NOT CHANNEL 0
801
802 END; !OF OUTPUT ROUTINE
803
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
804 GLOBAL ROUTINE STOP_PROGRAM : NOVALUE = !TERMINATE PROGRAM
805
806 !++
807 ! FUNCTIONAL DESCRIPTION:
808 !
809 !
810 ! TERMINATE PROGRAM EXECUTION PROBABLY DUE TO SOME FATAL
811 ! ERROR. USES "EXIT" UUO.
812 !
813 !
814 ! FORMAL PARAMETERS:
815 !
816 ! NONE
817 !
818 ! IMPLICIT INPUTS:
819 !
820 ! NONE
821 !
822 ! IMPLICIT OUTPUTS:
823 !
824 ! NONE
825 !
826 ! ROUTINE VALUE:
827 !
828 ! NONE
829 !
830 ! SIDE EFFECTS
831 !
832 ! HALTS THE PROGRAM
833 !
834 !--
835
836 BEGIN
837
838 BUILTIN
839 UUO;
840
841 UUO (0, %O'047', 1, %O'12');
842 END; !OF STOP_PROGRAM
843
844 !
845 END
846
847 ELUDOM
848 ! Local Modes:
849 ! Comment Start:!
850 ! Comment Column:36
851 ! Auto Save Mode:2
852 ! Mode:Fundamental
853 ! End:
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
ACCUM_CTR 267 323# 340# 353# 361# 381# 389
392#
ACCUM_PTR 268 322# 345 354# 362#
ACCUM 266 317# 322 351 352# 354 359
360# 362 379 380# 387 391#
ASCII_PTR 161 205
BUF_PTR 269 426# 433 434
CHAN 270 291# 294 299 304 321 419
421 434 441 443 449 451 459
460 461 510 515# 517 522 527
533 538 542 543 544 545 583
592# 595 600 608 613 618 620
623 629 631 636 642 647 650
651 668 671 673 719 728# 730
735 743 748 753 755 758 765
767 773 776 782 785 786 797
CHANX 223 291 478 515 550 592 686
728
CHAN_BUFFER 100 434# 543
CHAN_CTR 102 461# 620 623 629# 631# 673#
758 765# 767# 773
CHAN_DIRECTION 103 460# 533 613 748
CHAN_FNAME 109 321 651 786
CHAN_HEADER 99 419# 544 636 776
CHAN_STATUS 98 304 459# 527 545# 608 668
743 755
CHAN_WORD 101 618 671# 753 797#
CHAN_WORD_TMP 584 618# 623 672# 674 720 753#
758# 771# 794 797
CHAR 198 206# 212# 214 218 271 328#
329 331 345
CHARACTER 585 593# 603 623# 656# 661# 666#
668 671 672 674# 683 721
CHAR_CTR 199 207# 216# 218
CLOSE 73 478*
COUNTER 537
DEFEXT 223 397
DEV_NAME 272 314# 351# 395# 405
END_SCAN 273 318# 335# 370
ERRMSG 117 342 366 389 401 409 422
428 455 651 786
ERROR 116* 296 301 306 311 519 524
529 597 610 615 732 745 750
FILE_EXT 275 316# 384 387# 397# 436
FILE_NAME 274 315# 359# 376 379# 399 435
FILE_NAME_LEN 106# 109 321 651 786
FILI 586 636# 638# 660# 661 666 722
776# 778# 790# 794
FILN_PTR 276 321# 329
FIL_PTR 277 320# 328
FIO10 4#
FNAME 223 320 343 366 389 401 422
455
FRESTG 119 543 544
GETSTG 118 407 426
DSK:FIO10.XRF[4,31] 31-Aug-79 14:42
HEADER_PTR 278 407# 415 417 419
INPTR 197 205# 212
INPUT 74 550*
IO 223 413 439 447 460
LOOKUP_BLOCK 279 435# 436# 437# 449 451 456
MODE 223 309 404 459
OPEN 72 223*
OPEN_BLOCK 280 404# 405# 415# 417# 421
OUTPTR 196 204# 214
OUTPUT 75 538 686*
OUTWRD 686 738 764 771
RESET_ALL 70 121*
RESULT 200 203# 204 220 281 292# 462#
475
ROUTINE_NAME 263# 342 366 389 401 409 422
428 455
SAVEJOBFF 282 432# 445
SIXBIT 71 161* 395 397
STATUS 587 650 652 723 785 787
STOP_PROGRAM 76# 804*
SUCCESS 283 449# 451# 453
UUO 156 158 289 421 441 443# 449
451 513 542 590 603 642 647
650 726 738 782 785 839 841