1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17 ios_:
18 procedure;
19
20
21
22
23
24
25
26
27
28
29 dcl amount fixed (21);
30 dcl breaklist (*) bit (*);
31 dcl delimlist (*) bit (*);
32 dcl device char (*);
33 dcl dim char (*);
34 dcl elemsize fixed (21);
35 dcl infptr ptr;
36 dcl iocb_ptr_ ptr;
37 dcl mode char (*);
38 dcl name1 char (*);
39 dcl name2 char (*);
40 dcl nbreaks fixed;
41 dcl ndelims fixed;
42 dcl nelem fixed (21);
43 dcl nelemt fixed (21);
44 dcl newmode char (*);
45 dcl offset fixed (21);
46 dcl oldmode char (*);
47 dcl 1 oldstatus aligned like status;
48 dcl order char (*);
49 dcl 1 status aligned,
50 2 code fixed (35),
51 2 bits bit (36);
52 dcl stream char (*);
53 dcl wsptr ptr;
54
55
56
57 dcl actual_iocb_ptr ptr;
58 dcl arg0 (zero) char (0) varying;
59 dcl blkptr ptr;
60 dcl caller_ptr ptr;
61 dcl code fixed (35);
62 dcl i fixed;
63 dcl 1 ics aligned,
64 2 sdbptr ptr,
65 2 dimptr ptr,
66 2 entry fixed;
67 dcl iocb_ptr ptr;
68 dcl mask fixed (35);
69 dcl 1 mystatus aligned like status;
70 dcl old_attachment pointer;
71 dcl p ptr;
72 dcl 1 ti aligned,
73 2 version fixed,
74 2 code fixed (35);
75
76
77
78 dcl free_blks_ptr ptr int static init (null ());
79 dcl system_storage_ptr ptr int static init (null ());
80
81
82
83
84 dcl cu_$arg_list_ptr ext entry () returns (ptr);
85 dcl cu_$caller_ptr entry (ptr);
86 dcl cu_$grow_stack_frame ext entry (fixed, ptr) returns (fixed (35));
87 dcl default_handler_$set ext entry (entry);
88 dcl hcs_$make_ptr ext entry (ptr, char (*), char (*), ptr) returns (fixed (35));
89 dcl get_system_free_area_ entry (ptr);
90 dcl hcs_$set_ips_mask ext entry (fixed (35), fixed (35));
91 dcl hcs_$reset_ips_mask ext entry (fixed (35), fixed (35));
92 dcl discard_$discard_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
93 dcl mr_$mr_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
94 dcl netd_$netd_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
95 dcl ocd_$ocd_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
96 dcl syn_$syn_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
97 dcl tty_$tty_attach ext entry (ptr, (*) char (*) varying, bit (1), fixed bin (35));
98 dcl iox_$init_standard_iocbs entry;
99 dcl iox_$ios_call ext entry options (variable);
100 dcl iox_$ios_call_attach ext entry options (variable);
101 dcl ios_signal_ ext entry (char (32), fixed (35));
102 dcl terminate_process_ ext entry (char (*), ptr);
103 dcl unique_chars_ entry (bit (*)) returns (char (15));
104
105
106
107 dcl zero fixed int static init (0);
108 dcl detached_status bit (36) int static init ("0000000000000001"b);
109 dcl error_table_$end_of_info fixed (35) ext;
110 dcl error_table_$ioname_not_active fixed (35) ext;
111 dcl error_table_$long_record fixed (35) ext;
112 dcl error_table_$ioname_not_found fixed (35) ext;
113 dcl error_table_$ionmat fixed (35) ext;
114 dcl error_table_$missent fixed (35) ext;
115 dcl error_table_$typename_not_found fixed (35) ext;
116 dcl iox_$err_old_dim ext entry options (variable);
117 dcl ios_write_around_$ios_write_around_get_line ext entry options (variable);
118 dcl ios_write_around_$ios_write_around_get_chars ext entry options (variable);
119 dcl ios_write_around_$ios_write_around_put_chars ext entry options (variable);
120 dcl ios_write_around_$ios_write_around_control ext entry options (variable);
121 dcl ios_write_around_$ios_write_around_modes ext entry options (variable);
122 dcl ios_write_around_$ios_write_around_position ext entry options (variable);
123 dcl detach_offset fixed int static init (1);
124 dcl read_offset fixed int static init (2);
125 dcl write_offset fixed int static init (3);
126 dcl abort_offset fixed int static init (4);
127 dcl order_offset fixed int static init (5);
128 dcl resetread_offset fixed int static init (6);
129 dcl resetwrite_offset fixed int static init (7);
130 dcl setsize_offset fixed int static init (8);
131 dcl getsize_offset fixed int static init (9);
132 dcl setdelim_offset fixed int static init (10);
133 dcl getdelim_offset fixed int static init (11);
134 dcl seek_offset fixed int static init (12);
135 dcl tell_offset fixed int static init (13);
136 dcl changemode_offset fixed int static init (14);
137 dcl readsync_offset fixed int static init (19);
138 dcl writesync_offset fixed int static init (20);
139 dcl stream_output_mode fixed int static init (2);
140 dcl stream_input_output_mode fixed int static init (3);
141
142
143
144 dcl (addr, divide, length, min, null, size, substr, unspec) builtin;
145
146
147
148 dcl system_storage area based (system_storage_ptr);
149 dcl 1 aligned_based aligned based,
150 2 char (0:9999) char (1) unaligned;
151 dcl arg (1) char (length (device)) varying based (p);
152 dcl 1 args aligned based (p),
153 2 nargs fixed (16) unaligned,
154 2 other fixed,
155 2 arg (0 refer (args.nargs)) ptr;
156 dcl fixed_aligned_based fixed (35) aligned based;
157 dcl 1 blk aligned based (blkptr),
158 2 sdbptr ptr,
159 2 dimptr ptr,
160 2 attach char (234) varying,
161 2 open char (50) varying;
162 %include iocbx;
163
164
165
166
167
168
169
170
171
172 attach:
173 entry (stream, dim, device, mode, status);
174
175 if system_storage_ptr = null then call get_system_free_area_ (system_storage_ptr);
176 unspec (status) = "0"b;
177 call iox_$find_iocb (stream, iocb_ptr, status.code);
178 if status.code ^= 0 then return;
179 mask = 0;
180 call default_handler_$set (handler);
181 if dim = "syn" then go to new;
182 else if dim = "tw_" then go to new;
183 else if dim = "ntw_" then go to new;
184 else if dim = "mrd_" then go to new;
185 else if dim = "oc_" then go to new;
186 else if dim = "discard_output_" then go to new;
187 call cu_$caller_ptr (caller_ptr);
188 i = hcs_$make_ptr (caller_ptr, dim, rtrim (dim) || "module", ics.dimptr);
189 call hcs_$set_ips_mask (0, mask);
190 if ics.dimptr = null () then status.code = error_table_$typename_not_found;
191 else if iocb_ptr -> iocb.attach_descrip_ptr = null () then ics.sdbptr = null ();
192 else if iocb_ptr -> iocb.actual_iocb_ptr ^= iocb_ptr then ics.sdbptr = null ();
193 else if iocb_ptr -> iocb.ios_compatibility ^= ics.dimptr then status.code = error_table_$ionmat;
194 else ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
195 call hcs_$reset_ips_mask (mask, mask);
196 if status.code ^= 0 then return;
197 call iox_$ios_call_attach (stream, dim, device, mode, status, addr (ics));
198 if status.bits & detached_status then return;
199 call hcs_$set_ips_mask (0, mask);
200 if iocb_ptr -> iocb.attach_descrip_ptr = null () then go to fill_iocb;
201 else if iocb_ptr -> iocb.actual_iocb_ptr ^= iocb_ptr then do;
202 call iocb_ptr -> iocb.detach_iocb (iocb_ptr, (0));
203 fill_iocb:
204 blkptr = free_blks_ptr;
205 if blkptr ^= null ()
206 then free_blks_ptr = blkptr -> blk.sdbptr;
207 else do;
208 allocate blk in (system_storage) set (blkptr);
209 end;
210 if blkptr = null () then do;
211 call hcs_$reset_ips_mask (mask, mask);
212 return;
213 end;
214 blkptr -> blk.sdbptr = ics.sdbptr;
215 blkptr -> blk.dimptr = ics.dimptr;
216 blkptr -> blk.attach = rtrim (dim) || " " || substr (device, 1, min (201, length (device)));
217 blkptr -> blk.open = "IOS compatibility";
218 if mode ^= ""
219 then blkptr -> blk.open = blkptr -> blk.open || " " || substr (mode, 1, min (32, length (mode)));
220 iocb_ptr -> iocb.attach_descrip_ptr = addr (blkptr -> blk.attach);
221 iocb_ptr -> iocb.attach_data_ptr = blkptr;
222 iocb_ptr -> iocb.open_descrip_ptr = addr (blkptr -> blk.open);
223 iocb_ptr -> iocb.open_data_ptr = ics.sdbptr;
224 iocb_ptr -> iocb.detach_iocb = iox_$err_old_dim;
225 iocb_ptr -> iocb.open = iox_$err_old_dim;
226 iocb_ptr -> iocb.close = iox_close;
227 iocb_ptr -> iocb.get_line = ios_write_around_$ios_write_around_get_line;
228 iocb_ptr -> iocb.get_chars = ios_write_around_$ios_write_around_get_chars;
229 iocb_ptr -> iocb.put_chars = ios_write_around_$ios_write_around_put_chars;
230 iocb_ptr -> iocb.modes = ios_write_around_$ios_write_around_modes;
231 iocb_ptr -> iocb.position = ios_write_around_$ios_write_around_position;
232 iocb_ptr -> iocb.control = ios_write_around_$ios_write_around_control;
233 iocb_ptr -> iocb.read_record = iox_$err_old_dim;
234 iocb_ptr -> iocb.write_record = iox_$err_old_dim;
235 iocb_ptr -> iocb.rewrite_record = iox_$err_old_dim;
236 iocb_ptr -> iocb.delete_record = iox_$err_old_dim;
237 iocb_ptr -> iocb.seek_key = iox_$err_old_dim;
238 iocb_ptr -> iocb.read_key = iox_$err_old_dim;
239 iocb_ptr -> iocb.read_length = iox_$err_old_dim;
240 iocb_ptr -> iocb.ios_compatibility = ics.dimptr;
241 call iox_$propagate (iocb_ptr);
242 end;
243 call hcs_$reset_ips_mask (mask, mask);
244 return;
245
246
247
248 new:
249 status.code = cu_$grow_stack_frame (divide (length (device) + 7, 4, 17, 0), p);
250 if status.code ^= 0 then return;
251 p -> arg (1) = device;
252 call hcs_$set_ips_mask (0, mask);
253 old_attachment = null ();
254 if iocb_ptr -> iocb.actual_iocb_ptr ^= iocb_ptr then do;
255 call iox_$find_iocb (unique_chars_ (""b), old_attachment, status.code);
256 if status.code ^= 0 then return;
257 call iox_$move_attach (iocb_ptr, old_attachment, status.code);
258 if status.code ^= 0 then return;
259 end;
260 if iocb_ptr -> iocb.attach_descrip_ptr ^= null () then status.code = error_table_$ionmat;
261 else if dim = "syn" then do;
262 call syn_$syn_attach (iocb_ptr, arg, "0"b, status.code);
263 end;
264 else if dim = "tw_" then do;
265 call tty_$tty_attach (iocb_ptr, arg, "0"b, status.code);
266 if status.code = 0 then call iox_$open (iocb_ptr, stream_input_output_mode, "0"b, (0));
267 if status.code = 0 then call iox_$modes (iocb_ptr, mode, "", status.code);
268 end;
269 else if dim = "ntw_" then do;
270 call netd_$netd_attach (iocb_ptr, arg, "0"b, status.code);
271 if status.code = 0 then call iox_$open (iocb_ptr, stream_input_output_mode, "0"b, (0));
272 if status.code = 0 then call iox_$modes (iocb_ptr, mode, "", (0));
273 end;
274 else if dim = "mrd_" then do;
275 call mr_$mr_attach (iocb_ptr, arg, "0"b, status.code);
276 if status.code = 0 then call iox_$open (iocb_ptr, stream_input_output_mode, "0"b, (0));
277 if status.code = 0 then call iox_$modes (iocb_ptr, mode, "", (0));
278 end;
279 else if dim = "oc_" then do;
280 call ocd_$ocd_attach (iocb_ptr, arg, "0"b, status.code);
281 if status.code = 0 then call iox_$open (iocb_ptr, stream_input_output_mode, "0"b, (0));
282 if status.code = 0 then call iox_$modes (iocb_ptr, mode, "", (0));
283 end;
284 else if dim = "discard_output_" then do;
285 call discard_$discard_attach (iocb_ptr, arg0, "0"b, status.code);
286 if status.code = 0 then call iox_$open (iocb_ptr, stream_output_mode, "0"b, (0));
287 end;
288 else status.code = error_table_$typename_not_found;
289 if old_attachment ^= null () then do;
290 if status.code = 0
291 then call iox_$detach_iocb (old_attachment, (0));
292 else call iox_$move_attach (old_attachment, iocb_ptr, (0));
293 call iox_$destroy_iocb (old_attachment, (0));
294 end;
295 call hcs_$reset_ips_mask (mask, mask);
296 return;
297
298
299
300
301
302
303
304
305
306
307 detach:
308 entry (stream, device, mode, status);
309 unspec (status) = "0"b;
310 call iox_$look_iocb (stream, iocb_ptr, status.code);
311 mask = 0;
312 call default_handler_$set (handler);
313 call hcs_$set_ips_mask (0, mask);
314 if status.code ^= 0 then status.code = error_table_$ioname_not_found;
315 else if iocb_ptr -> iocb.attach_descrip_ptr = null () then status.code = error_table_$ioname_not_found;
316 else if iocb_ptr -> iocb.actual_iocb_ptr ^= iocb_ptr then do;
317 call iocb_ptr -> iocb.detach_iocb (iocb_ptr, status.code);
318 if status.code = 0 then status.bits = detached_status;
319 end;
320 else if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
321 blkptr = iocb_ptr -> iocb.attach_data_ptr;
322 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
323 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
324 ics.entry = detach_offset;
325 call hcs_$reset_ips_mask (mask, mask);
326 call iox_$ios_call (addr (ics), device, mode, status);
327 call hcs_$set_ips_mask (0, mask);
328 if iocb_ptr -> iocb.attach_descrip_ptr = null () then status.code = error_table_$ioname_not_found;
329 else if iocb_ptr -> iocb.actual_iocb_ptr ^= iocb_ptr then status.code = error_table_$ionmat;
330 else if iocb_ptr -> iocb.ios_compatibility = null () then status.code = error_table_$ionmat;
331 else if status.bits & detached_status then do;
332 blkptr -> blk.sdbptr = free_blks_ptr;
333 free_blks_ptr = blkptr;
334 iocb_ptr -> iocb.attach_descrip_ptr, iocb_ptr -> iocb.attach_data_ptr,
335 iocb_ptr -> iocb.open_descrip_ptr, iocb_ptr -> iocb.open_data_ptr = null ();
336 iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached;
337 iocb_ptr -> iocb.open = iox_$err_not_attached;
338 iocb_ptr -> iocb.close = iox_$err_not_open;
339 iocb_ptr -> iocb.get_line = iox_$err_not_open;
340 iocb_ptr -> iocb.get_chars = iox_$err_not_open;
341 iocb_ptr -> iocb.put_chars = iox_$err_not_open;
342 iocb_ptr -> iocb.control = iox_$err_not_open;
343 iocb_ptr -> iocb.modes = iox_$err_not_open;
344 iocb_ptr -> iocb.read_record = iox_$err_not_open;
345 iocb_ptr -> iocb.write_record = iox_$err_not_open;
346 iocb_ptr -> iocb.rewrite_record = iox_$err_not_open;
347 iocb_ptr -> iocb.delete_record = iox_$err_not_open;
348 iocb_ptr -> iocb.position = iox_$err_not_open;
349 iocb_ptr -> iocb.seek_key = iox_$err_not_open;
350 iocb_ptr -> iocb.read_key = iox_$err_not_open;
351 iocb_ptr -> iocb.read_length = iox_$err_not_open;
352 iocb_ptr -> iocb.ios_compatibility = null ();
353 call iox_$propagate (iocb_ptr);
354 end;
355 end;
356 else do;
357 if iocb_ptr -> iocb.open_descrip_ptr ^= null () then call iocb_ptr -> iocb.close (iocb_ptr, status.code);
358 if iocb_ptr -> iocb.attach_descrip_ptr ^= null ()
359 then call iocb_ptr -> iocb.detach_iocb (iocb_ptr, status.code);
360 if iocb_ptr -> iocb.attach_descrip_ptr = null () then status.bits = detached_status;
361 end;
362 call hcs_$reset_ips_mask (mask, mask);
363 return;
364
365
366
367
368
369
370
371
372
373 read:
374 entry (stream, wsptr, offset, nelem, nelemt, status);
375 call setup ();
376 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
377 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
378 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
379 ics.entry = read_offset;
380 call iox_$ios_call (addr (ics), wsptr, offset, nelem, nelemt, status);
381 end;
382 else do;
383 call iox_$get_line (iocb_ptr, addr (wsptr -> aligned_based.char (offset)), nelem, nelemt, status.code);
384 if status.code = error_table_$long_record then status.code = 0;
385 end;
386 return;
387
388
389
390
391
392
393
394
395
396 write:
397 entry (stream, wsptr, offset, nelem, nelemt, status);
398 call setup ();
399 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
400 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
401 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
402 ics.entry = write_offset;
403 call iox_$ios_call (addr (ics), wsptr, offset, nelem, nelemt, status);
404 end;
405 else do;
406 call iox_$put_chars (iocb_ptr, addr (wsptr -> aligned_based.char (offset)), nelem, status.code);
407 if status.code = 0
408 then nelemt = nelem;
409 else nelemt = 0;
410 end;
411 return;
412
413
414
415
416
417
418
419
420
421 abort:
422 entry (stream, oldstatus, status);
423 call setup ();
424 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
425 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
426 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
427 ics.entry = abort_offset;
428 call iox_$ios_call (addr (ics), oldstatus, status);
429 end;
430 else call iox_$control (iocb_ptr, "abort", null (), status.code);
431 return;
432
433
434
435
436
437
438
439
440
441 order:
442 entry (stream, order, infptr, status);
443 call setup ();
444 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
445 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
446 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
447 ics.entry = order_offset;
448 call iox_$ios_call (addr (ics), order, infptr, status);
449 end;
450 else call iox_$control (iocb_ptr, order, infptr, status.code);
451 return;
452
453
454
455
456
457
458
459
460
461 resetread:
462 entry (stream, status);
463 call setup ();
464 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
465 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
466 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
467 ics.entry = resetread_offset;
468 call iox_$ios_call (addr (ics), status);
469 end;
470 else call iox_$control (iocb_ptr, "resetread", null (), status.code);
471 return;
472
473
474
475
476
477
478
479
480
481 resetwrite:
482 entry (stream, status);
483 call setup ();
484 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
485 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
486 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
487 ics.entry = resetwrite_offset;
488 call iox_$ios_call (addr (ics), status);
489 end;
490 else call iox_$control (iocb_ptr, "resetwrite", null (), status.code);
491 return;
492
493
494
495
496
497
498
499
500
501 setsize:
502 entry (stream, elemsize, status);
503 call setup ();
504 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
505 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
506 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
507 ics.entry = setsize_offset;
508 call iox_$ios_call (addr (ics), elemsize, status);
509 end;
510 else status.code = error_table_$missent;
511 return;
512
513
514
515
516
517
518
519
520
521 getsize:
522 entry (stream, elemsize, status);
523 call setup ();
524 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
525 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
526 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
527 ics.entry = getsize_offset;
528 call iox_$ios_call (addr (ics), elemsize, status);
529 end;
530 else elemsize = 9;
531 return;
532
533
534
535
536
537
538
539
540
541 setdelim:
542 entry (stream, nbreaks, breaklist, ndelims, delimlist, status);
543 call setup ();
544 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
545 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
546 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
547 ics.entry = setdelim_offset;
548 call iox_$ios_call (addr (ics), nbreaks, breaklist, ndelims, delimlist, status);
549 end;
550 else status.code = error_table_$missent;
551 return;
552
553
554
555
556
557
558
559
560
561 getdelim:
562 entry (stream, nbreaks, breaklist, ndelims, delimlist, status);
563 call setup ();
564 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
565 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
566 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
567 ics.entry = getdelim_offset;
568 call iox_$ios_call (addr (ics), nbreaks, breaklist, ndelims, delimlist, status);
569 end;
570 else status.code = error_table_$missent;
571 return;
572
573
574
575
576
577
578
579
580
581 seek:
582 entry (stream, name1, name2, amount, status);
583 call setup ();
584 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
585 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
586 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
587 ics.entry = seek_offset;
588 call iox_$ios_call (addr (ics), name1, name2, amount, status);
589 end;
590 else status.code = error_table_$missent;
591 return;
592
593
594
595
596
597
598
599
600
601 tell:
602 entry (stream, name1, name2, amount, status);
603 call setup ();
604 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
605 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
606 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
607 ics.entry = tell_offset;
608 call iox_$ios_call (addr (ics), name1, name2, amount, status);
609 end;
610 else status.code = error_table_$missent;
611 return;
612
613
614
615
616
617
618
619
620
621 changemode:
622 entry (stream, newmode, oldmode, status);
623 call setup ();
624 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
625 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
626 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
627 ics.entry = changemode_offset;
628 call iox_$ios_call (addr (ics), newmode, oldmode, status);
629 end;
630 else call iox_$modes (iocb_ptr, newmode, oldmode, status.code);
631 return;
632
633
634
635
636
637
638
639
640
641 readsync:
642 entry (stream, mode, amount, status);
643 call setup ();
644 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
645 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
646 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
647 ics.entry = readsync_offset;
648 call iox_$ios_call (addr (ics), mode, amount, status);
649 end;
650 else status.code = error_table_$missent;
651 return;
652
653
654
655
656
657
658
659
660
661
662 writesync:
663 entry (stream, mode, amount, status);
664 call setup ();
665 if iocb_ptr -> iocb.ios_compatibility ^= null () then do;
666 ics.sdbptr = iocb_ptr -> iocb.open_data_ptr;
667 ics.dimptr = iocb_ptr -> iocb.ios_compatibility;
668 ics.entry = writesync_offset;
669 call iox_$ios_call (addr (ics), mode, amount, status);
670 end;
671 else status.code = error_table_$missent;
672 return;
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689 setup:
690 proc;
691 unspec (status) = "0"b;
692 call iox_$look_iocb (stream, iocb_ptr, status.code);
693 if status.code ^= 0 then status.code = error_table_$ioname_not_found;
694 else if iocb_ptr -> iocb.attach_descrip_ptr = null () then status.code = error_table_$ioname_not_found;
695 else if iocb_ptr -> iocb.open_descrip_ptr = null () then status.code = error_table_$ioname_not_active;
696 else return;
697 go to return;
698 end setup;
699
700
701
702
703
704
705
706 return:
707 return;
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722 handler:
723 proc (p1, name, p2, p3, continue);
724
725 dcl (p1, p2, p3) ptr;
726 dcl name char (*);
727 dcl continue bit (1) aligned;
728 dcl error_table_$unable_to_do_io fixed (35) ext;
729 dcl addr builtin;
730
731 if mask ^= 0 then do;
732 ti.version = 0;
733 ti.code = error_table_$unable_to_do_io;
734 call terminate_process_ ("fatal_error", addr (ti));
735 end;
736 if name ^= "cleanup" then continue = "1"b;
737
738 end handler;
739
740
741
742
743
744
745
746
747 iox_close:
748 entry (iocb_ptr_) returns (fixed);
749 mask = 0;
750 call default_handler_$set (handler);
751 call hcs_$set_ips_mask (0, mask);
752 if iocb_ptr_ -> iocb.close ^= iox_close then do;
753 call hcs_$reset_ips_mask (mask, mask);
754 call iox_$close (iocb_ptr_, code);
755 return (code);
756 end;
757 actual_iocb_ptr = iocb_ptr_ -> iocb.actual_iocb_ptr;
758 blkptr = actual_iocb_ptr -> iocb.attach_data_ptr;
759 ics.sdbptr = blkptr -> blk.sdbptr;
760 ics.dimptr = blkptr -> blk.dimptr;
761 ics.entry = detach_offset;
762 call hcs_$reset_ips_mask (mask, mask);
763 call iox_$ios_call (addr (ics), "", "", mystatus);
764 call hcs_$set_ips_mask (0, mask);
765 if iocb_ptr_ -> iocb.close ^= iox_close then do;
766 call hcs_$reset_ips_mask (mask, mask);
767 call iocb_ptr -> iocb.close (iocb_ptr_, code);
768 return (code);
769 end;
770 if mystatus.bits & detached_status then do;
771 blkptr -> blk.sdbptr = free_blks_ptr;
772 free_blks_ptr = blkptr;
773 actual_iocb_ptr -> iocb.attach_descrip_ptr, actual_iocb_ptr -> iocb.attach_data_ptr,
774 actual_iocb_ptr -> iocb.open_descrip_ptr, actual_iocb_ptr -> iocb.open_data_ptr = null ();
775 actual_iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached;
776 actual_iocb_ptr -> iocb.open = iox_$err_not_attached;
777 actual_iocb_ptr -> iocb.close = iox_$err_not_open;
778 actual_iocb_ptr -> iocb.get_line = iox_$err_not_open;
779 actual_iocb_ptr -> iocb.get_chars = iox_$err_not_open;
780 actual_iocb_ptr -> iocb.put_chars = iox_$err_not_open;
781 actual_iocb_ptr -> iocb.modes = iox_$err_not_open;
782 actual_iocb_ptr -> iocb.position = iox_$err_not_open;
783 actual_iocb_ptr -> iocb.control = iox_$err_not_open;
784 actual_iocb_ptr -> iocb.read_record = iox_$err_not_open;
785 actual_iocb_ptr -> iocb.write_record = iox_$err_not_open;
786 actual_iocb_ptr -> iocb.rewrite_record = iox_$err_not_open;
787 actual_iocb_ptr -> iocb.delete_record = iox_$err_not_open;
788 actual_iocb_ptr -> iocb.seek_key = iox_$err_not_open;
789 actual_iocb_ptr -> iocb.read_key = iox_$err_not_open;
790 actual_iocb_ptr -> iocb.read_length = iox_$err_not_open;
791 actual_iocb_ptr -> iocb.ios_compatibility = null ();
792 call iox_$propagate (actual_iocb_ptr);
793 mystatus.code = 0;
794 end;
795 call hcs_$reset_ips_mask (mask, mask);
796 return (mystatus.code);
797
798
799
800
801
802
803
804
805
806 no_entry:
807 entry;
808 p = cu_$arg_list_ptr ();
809 i = p -> args.nargs;
810 if i ^= 0 then p -> args.arg (i) -> fixed_aligned_based = error_table_$missent;
811 return;
812
813
814
815
816
817
818
819
820
821 read_ptr:
822 entry (wsptr, nelem, nelemt);
823 rloop:
824 call iox_$get_line (iox_$user_input, wsptr, nelem, nelemt, code);
825 if code ^= 0
826 then if code ^= error_table_$long_record & code ^= error_table_$end_of_info then do;
827 call ios_signal_ ("user_input", code);
828 go to rloop;
829 end;
830 return;
831
832
833
834
835
836
837
838
839
840 write_ptr:
841 entry (wsptr, offset, nelem);
842 wloop:
843 call iox_$put_chars (iox_$user_output, addr (wsptr -> aligned_based.char (offset)), nelem, code);
844 if code ^= 0 then do;
845 call ios_signal_ ("user_output", code);
846 go to wloop;
847 end;
848 return;
849
850
851
852
853
854
855
856
857
858 ios_quick_init:
859 entry;
860
861 call iox_$init_standard_iocbs;
862 return;
863
864
865 %page;
866 %include iox_dcls;
867
868 end ios_;