1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 /* Last modified (Date and Reason):
 10    Aug 9, 1977 by S. Webber to make better use of static storage and remove refences to obsolete dims.
 11    August 1981 by C. Hornig to make it compile again.
 12    19 August 1982 by G. Palter to make ios_$attach work as "documented"
 13 */
 14 
 15 /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
 16 
 17 ios_:
 18      procedure;
 19 
 20 /* A replacement for the old I/O switch 'ios_' which implements most of its calls
 21    via write-arounds to the new I/O system 'iox_'.  However, unknown DIMs continue to
 22    be supported in a straight-through fashion for compatibility. */
 23 
 24 
 25 /* Declarations. */
 26 
 27 /* Parameters. */
 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 /* Automatic. */
 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 /* Internal Static. */
 77 
 78 dcl  free_blks_ptr ptr int static init (null ());
 79 dcl  system_storage_ptr ptr int static init (null ());
 80 
 81 
 82 /* Procedures. */
 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 /* Constants. */
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 /* Built-in. */
143 
144 dcl  (addr, divide, length, min, null, size, substr, unspec) builtin;
145 
146 /* Based. */
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 /* End of declarations. */
165 
166 
167 
168 
169 
170 /* Beginning of entry point ..... ios_$attach(stream,dim,device,mode,status) ..... */
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 /* We know about this kind of DIM.  Use write-arounds to the new I/O system to simulate it. */
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;                                         /* leaves iocb_ptr detached */
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 /* End of entry point ..... ios_$attach(stream,dim,device,mode,status) ..... */
299 
300 
301 
302 
303 
304 
305 /* Beginning of entry point ..... ios_$detach(stream,device,mode,status) ..... */
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 /* End of entry point ..... ios_$detach(stream,device,mode,status) ..... */
366 
367 
368 
369 
370 
371 /* Beginning of entry point ..... ios_$read(stream,wsptr,offset,nelem,nelemt,status) ..... */
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 /* End of entry point ..... ios_$read(stream,wsptr,offset,nelem,nelemt,status) ..... */
389 
390 
391 
392 
393 
394 /* Beginning of entry point ..... ios_$write(stream,wsptr,offset,nelem,nelemt,status) ..... */
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 /* End of entry point ..... ios_$write(stream,wsptr,offset,nelem,nelemt,status) ..... */
414 
415 
416 
417 
418 
419 /* Beginning of entry point ..... ios_$abort(stream,oldstatus,status) ..... */
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 /* End of entry point ..... ios_$abort(stream,oldstatus,status) ..... */
434 
435 
436 
437 
438 
439 /* Beginning of entry point ..... ios_$order(stream,order,infptr,status) ..... */
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 /* End of entry point ..... ios_$order(stream,order,infptr,status) ..... */
454 
455 
456 
457 
458 
459 /* Beginning of entry point ..... ios_$resetread(stream,status) ..... */
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 /* End of entry point ..... ios_$resetread(stream,status) ..... */
474 
475 
476 
477 
478 
479 /* Beginning of entry point ..... ios_$resetwrite(stream,status) ..... */
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 /* End of entry point ..... ios_$resetwrite(stream,status) ..... */
494 
495 
496 
497 
498 
499 /* Beginning of entry point ..... ios_$setsize(stream,elemsize,status) ..... */
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 /* End of entry point ..... ios_$setsize(stream,elemsize,status) ..... */
514 
515 
516 
517 
518 
519 /* Beginning of entry point ..... ios_$getsize(stream,elemsize,status) ..... */
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 /* End of entry point ..... ios_$getsize(stream,elemsize,status) ..... */
534 
535 
536 
537 
538 
539 /* Beginning of entry point ..... ios_$setdelim(stream,nbreaks,breaklist,ndelims,delimlist,status) ..... */
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 /* End of entry point ..... ios_$setdelim(stream,nbreaks,breaklist,ndelims,delimlist,status) ..... */
554 
555 
556 
557 
558 
559 /* Beginning of entry point ..... ios_$getdelim(stream,nbreaks,breaklist,ndelims,delimlist,status) ..... */
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 /* End of entry point ..... ios_$getdelim(stream,nbreaks,breaklist,ndelims,delimlist,status) ..... */
574 
575 
576 
577 
578 
579 /* Beginning of entry point ..... ios_$seek(stream,name1,name2,amount,status) ..... */
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 /* End of entry point ..... ios_$seek(stream,name1,name2,amount,status) ..... */
594 
595 
596 
597 
598 
599 /* Beginning of entry point ios_$tell(stream,name1,name2,amount,status) ..... */
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 /* End of entry point ..... ios_$tell(stream,name1,name2,amount,status) ..... */
614 
615 
616 
617 
618 
619 /* Beginning of entry point ..... ios_$changemode(stream,newmode,oldmode,status) ..... */
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 /* End of entry point ..... ios_$changemode(stream,newmode,oldmode,status) ..... */
634 
635 
636 
637 
638 
639 /* Beginning of entry point ..... ios_$readsync(stream,mode,amount,status) ..... */
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 /* End of entry point ..... ios_$readsync(stream,mode,amount,status) ..... */
654 
655 
656 
657 
658 
659 
660 /* Beginning of entry point ..... ios_$writesync(stream,mode,amount,status) ..... */
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 /* End of entry point ..... ios_$writesync(stream,mode,amount,status) ..... */
675 
676 
677 
678 
679 
680 
681 
682 
683 
684 /* Internal procedure called by most entry points of the IOS write-arounds to clear
685    the status argument, look up the IOCB pointer, and verify that the IOCB is attached
686    and open.  If there are any errors, a non-local go-to causes the write-around
687    to return immediately to its caller. */
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 /* End of internal procedure ..... setup() ..... */
701 
702 
703 
704 
705 
706 return:
707           return;
708 
709 
710 
711 
712 
713 /* Internal procedure to handle faults while IPS interrupts
714    are masked.  While not masked, any signals are simply
715    passed on up the stack to their normal handlers.  For a
716    fault while masked, the process is terminated (with the
717    reason "unable to do critical I/O") because the I/O
718    control blocks are in an inconsistent state, and we can
719    tolerate neither spawning a command loop with interrupts
720    masked nor a restart with a possibly changed mask. */
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 /* Handler for the 'close' I/O operation--the only new I/O call permitted to an
745    old DIM.  It closes and detaches the IOCB. */
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 /* End of 'close' handler. */
799 
800 
801 
802 
803 
804 /* Beginning of entry point ..... ios_$no_entry( ... ,status) ..... */
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 /* End of entry point ..... ios_$no_entry( ... ,status) ..... */
814 
815 
816 
817 
818 
819 /* Beginning of entry point ..... ios_$read_ptr(wsptr,nelem,nelemt) ..... */
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 /* End of entry point ..... ios_$read_ptr(wsptr,nelem,nelemt) ..... */
833 
834 
835 
836 
837 
838 /* Beginning of entry point ..... ios_$write_ptr(wsptr,offset,nelem) ..... */
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 /* End of entry point ..... ios_$write_ptr(wsptr,offset,nelem) ..... */
851 
852 
853 
854 
855 
856 /* Beginning of entry point ..... ios_$ios_quick_init() ..... */
857 
858 ios_quick_init:
859      entry;
860 
861           call iox_$init_standard_iocbs;
862           return;
863 
864 /* End of entry point ..... ios_$ios_quick_init() ..... */
865 %page;
866 %include iox_dcls;
867 
868      end ios_;