1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(87-07-01,GWMay), approve(87-07-01,MCR7730), audit(87-08-10,JRGray),
 17      install(87-09-10,MR12.1-1104):
 18      Added the -truncate, -tc argument so that the -extend arg can be
 19      overriden.
 20                                                    END HISTORY COMMENTS */
 21 
 22 
 23 /* format: style2,ind3 */
 24 vfile_attach:
 25    proc (iocb_ptr_arg, option_array, command_switch, code);
 26 
 27 /* Modified:
 28 04/05/82 by Lindsey Spratt:  Changed to correctly report the blocking value,
 29             the wait-time for the share option, and the identifier for the
 30             unstructured header.  If more than one of these was present in the
 31             attach options, the values for all of them would be reported as
 32             being the same as the value for the last one given.  Also, changed
 33             "-exclu" to "-exclusive" in the attach description, as -exclu is
 34             not a valid attach option.
 35 */
 36 /* Declarations and general comments are at the end
 37    of the program. */
 38 
 39       iocb_ptr = iocb_ptr_arg;
 40       call verify_and_interpret_args;
 41       if trans_opt & (code = 0)                             /* -transaction attachment */
 42       then
 43          do;
 44             call iox_$look_iocb ((tcf_name), tcf_ptr, code);
 45             if code = 0
 46             then if tcf_ptr -> iocb.actual_iocb_ptr -> iocb.attach_descrip_ptr ^= null
 47                  then if index (tcf_ptr -> iocb.actual_iocb_ptr -> iocb.attach_descrip_ptr -> attach_descrip_string,
 48                            "-stationary") ^= 0
 49                       then
 50                          do;                                /* complain */
 51                             code = error_table_$incompatible_attach;
 52                             call sub_err_ (code, "vfile_", "c", null,
 53                                  "The tcf switch must not be attached with the -stationary option.");
 54                          end;
 55          end;
 56       if code = 0
 57       then call create_attach_block;
 58       if code = 0
 59       then
 60          do;                                                /* set pointers, entries in iocb */
 61             attach_data_ptr = attach_block_ptr;
 62             attach_descrip_ptr = addr (attach_descrip);
 63             open = open_file;
 64             control = control_file;                         /* file_status supported with switch closed */
 65             detach_iocb = detach_file;
 66             call iox_$propagate (iocb_ptr);
 67          end;
 68       else if command_switch
 69       then call com_err_ (code, "vfile_", "^a", name);
 70       return;
 71 
 72 verify_and_interpret_args:
 73    proc;
 74       if attach_descrip_ptr ^= null
 75       then code = error_table_$not_detached;
 76       else if length (option_array (1)) > 168
 77       then code = error_table_$pathlong;
 78       else
 79          do;
 80             code = 0;
 81             n_opts = hbound (option_array, 1);
 82             if n_opts > 10
 83             then code = error_table_$bad_arg;
 84             else
 85                do i = 2 to n_opts while (code = 0);
 86                   if option_array (i) = "-extend"
 87                   then extend_attach_option = "1"b;
 88                   else if option_array (i) = "-truncate" | option_array (i) = "-tc"
 89                   then extend_attach_option = "0"b;
 90 
 91                   else if option_array (i) = "-share"
 92                   then
 93                      do;                                    /* pick up wait_time */
 94                         shared_option = "1"b;
 95                         call get_n_opt (wait_time_option);  /* pick up number */
 96                         if wait_time_option < -1
 97                         then code = error_table_$bad_arg;
 98                      end;
 99                   else if option_array (i) = "-blocked"     /* blocked file */
100                   then
101                      do;                                    /* pick up max_rec_len if given */
102                         blocked_option = "1"b;
103                         call get_n_opt (max_recl);          /* get optional number */
104                         if max_recl < 0
105                         then code = error_table_$negative_nelem;
106                      end;
107                   else if option_array (i) = "-append"
108                   then append_option = "1"b;
109                   else if option_array (i) = "-no_trunc"
110                   then no_trunc_option = "1"b;
111                   else if option_array (i) = "-header"
112                   then
113                      do;                                    /* set header info */
114                         header_option = "1"b;
115                         call get_n_opt (identifier);        /* pick up optional ident number */
116                      end;
117                   else if option_array (i) = "-old"
118                   then old_option = "1"b;                   /* prevents creation */
119                   else if option_array (i) = "-ssf"
120                   then ssf_option = "1"b;
121                   else if option_array (i) = "-dup_ok"
122                   then dup_ok_opt = "1"b;
123                   else if (option_array (i) = "-stationary") | (option_array (i) = "-stat")
124                   then stat_opt = "1"b;
125                   else if option_array (i) = "-no_end"
126                   then noend_option = "1"b;                 /* allows positioning beyond eof */
127                   else if option_array (i) = "-exclusive"
128                   then exclu_option = "1"b;
129                   else if (option_array (i) = "-transaction") | (option_array (i) = "-trans")
130                   then if i >= n_opts                       /* no more args */
131                        then code = error_table_$noarg;
132                        else
133                           do;                               /* get tcf switch name */
134                              i = i + 1;                     /* skip over next arg */
135                              tcf_name = option_array (i);
136                              trans_opt = "1"b;
137                           end;
138                   else if (option_array (i) = "-checkpoint")
139                   then checkpoint_opt = "1"b;
140                   else code = error_table_$bad_arg;
141                end;
142          end;
143       if code = 0
144       then
145          do;
146             rel_pathname = option_array (1);
147             rel_pathname_length = length (option_array (1));
148             if ((extend_attach_option & (append_option | no_trunc_option)) | (append_option & no_trunc_option)
149                  | (header_option & (checkpoint_opt | blocked_option | exclu_option | shared_option))
150                  | (blocked_option & (checkpoint_opt | no_trunc_option))
151                  | ((dup_ok_opt | stat_opt | trans_opt)
152                  & (checkpoint_opt | ssf_option | blocked_option | no_trunc_option | append_option | noend_option))
153                  | (shared_option & (no_trunc_option | exclu_option)))
154             then code = error_table_$bad_arg;
155          end;
156       return;
157    end;                                                     /* end verify args */
158 
159 get_n_opt:
160    proc (n);                                                /* used to pick up optional numerical argument */
161       if i < n_opts
162       then
163          do;                                                /* another option exists--look at it */
164             num = cv_dec_check_ ((option_array (i + 1)), er_code);
165             if er_code = 0                                  /* valid integer */
166             then
167                do;                                          /* grab next option */
168                   i = i + 1;                                /* advance option_array index */
169                   saved_i = i;                              /* save element number */
170                   n = num;                                  /* set the argument */
171                end;
172          end;
173       dcl     (n, num)               fixed (35);
174    end get_n_opt;
175 
176 create_attach_block:
177    proc;
178       dname, ename = " ";
179       call expand_path_ (addr (rel_pathname), rel_pathname_length, addr (dname), addr (ename), code);
180       if code = 0
181       then
182          do;
183             call alloc_cb_file (size (attach_block), attach_block_ptr);
184             dup_ok_sw = dup_ok_opt;
185             noend_sw = noend_option;
186             exclu_sw = exclu_option;
187             stat_sw = stat_opt;
188             trans_sw = trans_opt;
189             checkpoint_sw = checkpoint_opt;
190             ssf = ssf_option;
191             old = old_option;
192             blocked = blocked_option;
193             max_rec_len = max_recl;
194             header_present = header_option;
195             header_id = identifier;
196             no_trunc = no_trunc_option;
197             appending = append_option;
198             extend_attach = extend_attach_option | appending | no_trunc | old;
199             shared = shared_option;
200             wait_time = 1000000 * wait_time_option;
201             interp = 0;                                     /* this option may be supported in future */
202             dname_len = length (dname) + 1 - verify (reverse (dname), " ");
203             ename_len = length (ename) + 1 - verify (reverse (ename), " ");
204             string = "vfile_ " || substr (dname, 1, dname_len) || ">";
205             string = string || substr (ename, 1, ename_len);
206             if no_trunc
207             then string = string || " -no_trunc";
208             if appending
209             then string = string || " -append";
210             if extend_attach_option
211             then string = string || " -extend";
212             if noend_sw
213             then string = string || " -no_end";
214             if interp = 1
215             then string = string || " -raw";
216             if old
217             then string = string || " -old";
218             if ssf                                          /* limited to single-segment files */
219             then string = string || " -ssf";
220             if dup_ok_sw
221             then string = string || " -dup_ok";
222             if stat_sw
223             then string = string || " -stationary";
224             if trans_sw
225             then
226                do;
227                   string = string || " -transaction " || tcf_name;
228                   attach_block.tcf_iocbp = tcf_ptr;
229                end;
230             if checkpoint_sw
231             then string = string || " -checkpoint";
232             if header_present
233             then
234                do;
235                   string = string || " -header";
236                   string = string || " " || ltrim (char (identifier));
237                end;
238             if blocked
239             then
240                do;
241                   string = string || " -blocked";
242                   string = string || " " || ltrim (char (max_rec_len));
243                end;
244             if exclu_sw
245             then string = string || " -exclusive";
246             if shared
247             then
248                do;
249                   string = string || " -share ";
250                   string = string || ltrim (char (wait_time_option));
251                end;
252             attach_descrip_len = length (string);
253             attach_descrip_string = string;
254          end;
255 
256       dcl     ename                  char (32) aligned;
257       dcl     expand_path_           external entry (ptr,   /* ptr to relative pathname */
258                                      fixed bin,             /* length of relative pathname */
259                                      ptr,                   /* ptr to char(l68) aligned to hold expanded
260                                                                directory name */
261                                      ptr,                   /* ptr to char(32) aligned to hold expanded
262                                                                entry name */
263                                      fixed bin (35));       /* status code */
264       dcl     dname                  char (168) aligned;
265       dcl     string                 char (256) varying;
266    end;                                                     /* end create_attach_block */
267 
268 open_file:
269    entry (iocb_ptr_arg, mode_arg, extend_arg, code);
270       begin;
271          iocb_ptr = iocb_ptr_arg -> actual_iocb_ptr;
272          attach_block_ptr = attach_data_ptr;
273          was_msf = "0"b;
274          i_set_lock = "0"b;                                 /* will unlock file only if I locked it */
275          fcb_ptr, first_seg_ptr = null;                     /* will cleanup if non-null */
276          mode = mode_arg;
277          call verify_open_args_set_descrip;
278          if code = 0
279          then call get_file_base;
280          if code = 0
281          then call check_set_file_type;
282          if code = 0
283          then call check_set_file_already_open;
284          if (code = 0) & (^is_msf) & (file_type = 2 /* indexed */)
285          then call open_msf;                                /* always use msf_manager with indexed files */
286          if code = 0
287          then
288             do;
289                if file_type = 0
290                then open_x = open_uns_file;
291                else if file_type = 1
292                then open_x = open_seq_file;
293                else if file_type = 2
294                then open_x = open_indx_file;
295                else if file_type = 3
296                then open_x = open_blk_file;
297                call open_x (iocb_ptr, fcb_ptr, first_seg_ptr, is_new_file, mode, close_x, first_seg_bitcount,
298                     max_component_size, code);
299             end;
300          if code = 0
301          then
302             do;
303                close = close_file;
304                open_descrip_ptr = addr (open_descrip);
305                call iox_$propagate (iocb_ptr);
306             end;
307          else
308             do;
309                if first_seg_ptr ^= null
310                then if i_set_lock
311                     then call set_lock_$unlock (open_lock, foo);
312                call cleanup;
313             end;
314          return;                                            /* end of opening main routine */
315 
316 verify_open_args_set_descrip:
317    proc;
318       if (mode <= 0) | (mode > 13)
319       then code = error_table_$bad_arg;
320       else if (interp = 1) & (mode ^= 1)
321       then code = error_table_$incompatible_attach;
322       else if (((blocked | checkpoint_sw) & ((mode < 4) | (mode > 7))) | ((ssf | noend_sw) & (mode > 7))
323            | (exclu_sw & is_input_only_mode (mode))
324            | ((trans_sw | shared | exclu_sw | dup_ok_sw | stat_sw)
325            & ((mode < 4) | (^(extend_arg | extend_attach) & ((mode = 5) | (mode = 6)))))
326            | ((no_trunc | header_present) & (mode > 3)))
327       then code = error_table_$incompatible_attach;
328       else
329          do;
330             code = 0;
331             open_descrip_len = length (mode_descrip (mode));
332             open_descrip_string = mode_descrip (mode);
333          end;
334 
335       dcl     string                 char (32) varying;
336    end;                                                     /* end verify_open_args_set_descrip */
337 
338 get_file_base:
339    proc;
340       branch_info.bit_count = "0"b;
341       is_msf = "0"b;
342       attach_block.last_comp = 0;
343       call hcs_$status_long (substr (attach_descrip_string, 8, dname_len),
344            substr (attach_descrip_string, 9 + dname_len, ename_len), 1, addr (branch_info), null, foo);
345       if foo ^= 0
346       then if foo = error_table_$no_s_permission
347            then foo = 0;                                    /* we don't need any missing info */
348       if (type = "10"b) & (bit_count = "0"b) & (foo = 0)
349       then
350          do;                                                /* entry is a directory--flag the error */
351             code = error_table_$dirseg;
352             return;                                         /* unsuccessfulopening */
353          end;
354       else if (type = "10"b) & (foo = 0)                    /* must be an msf */
355       then if ssf                                           /* -ssf option was specified--no msf's allowed */
356            then
357               do;                                           /* flag the error */
358                  code = error_table_$incompatible_attach;
359                  return;
360               end;
361            else
362               do;
363                  was_msf = "1"b;
364                  attach_block.last_comp = fixed (bit_count) - 1;
365                  call open_msf;
366                  call msf_manager_$get_ptr (fcb_ptr, 0, "0"b, first_seg_ptr, first_seg_bitcount, foo);
367               end;
368       is_new_file =
369            (is_output_mode (mode) & ^extend_attach & ^extend_arg)
370            | ((branch_info.bit_count = "0"b) & ^is_input_only_mode (mode) & ^old);
371       if ^is_msf
372       then
373          do;                                                /* get pointer to base of single segment file */
374             first_seg_bitcount = fixed (branch_info.bit_count, 24, 0);
375             if is_new_file
376             then call hcs_$make_seg (substr (attach_descrip_string, 8, dname_len),
377                       substr (attach_descrip_string, 9 + dname_len, ename_len), "", 01010b /* rw access */, first_seg_ptr,
378                       foo);
379             else call hcs_$initiate (substr (attach_descrip_string, 8, dname_len),
380                       substr (attach_descrip_string, 9 + dname_len, ename_len), "", 0, 1, first_seg_ptr, foo);
381          end;
382       if first_seg_ptr = null
383       then code = foo;
384       if code = 0
385       then
386          do;                                                /* check access */
387             access_mode = 0;
388             call hcs_$fs_get_mode (first_seg_ptr, access_mode, foo);
389             if (access_required (mode) & ^bit (access_mode)) ^= "0"b
390             then code = error_table_$moderr;
391          end;
392       if code = 0
393       then
394          do;
395             call hcs_$get_max_length_seg (first_seg_ptr, max_component_size, foo);
396             if is_new_file
397             then
398                do;
399                   if ^is_msf                                /* single segment */
400                   then call hcs_$truncate_seg (first_seg_ptr, 0, foo);
401                   else call msf_manager_$adjust (fcb_ptr, 0, 0, "010"b, foo);
402                                                             /* truncate file, which leaves first
403                                                                page set to zero */
404                   call hcs_$set_bc_seg (first_seg_ptr, 0, foo);
405                   first_seg_bitcount = 0;
406                end;
407          end;
408 
409       dcl     access_mode            fixed bin (5);
410       dcl     hcs_$fs_get_mode       external entry (ptr, fixed bin (5), fixed bin (35));
411                                                             /* second arg
412                                                                interpreted as bit(5), second bit = read access,
413                                                                fourth bit is write access, other bits irrelevant here */
414       dcl     hcs_$get_max_length_seg
415                                      entry (ptr,            /* ptr to seg */
416                                      fixed bin (19),        /* max length in words */
417                                      fixed bin (35));       /* code */
418       dcl     hcs_$set_bc_seg        entry (ptr,            /* ptr to segment */
419                                      fixed bin (24),        /* bitcount */
420                                      fixed bin (35));       /* status code */
421    end get_file_base;
422 
423 check_set_file_type:
424    proc;
425       if mode < 4
426       then
427          do;
428             file_type = 0;
429             if is_new_file & header_present
430             then file_code = file_code_table (0);
431          end;
432       else if is_new_file
433       then
434          do;
435             if mode < 8
436             then if blocked
437                  then file_type = 3;
438                  else file_type = 1;                        /* normal sequential file */
439             else file_type = 2;
440             call check_type;
441             if code = 0
442             then file_code = file_code_table (file_type);
443          end;
444       else
445          do;
446             if file_code = file_code_table (1)
447             then file_type = 1;
448             else if file_code = file_code_table (2)
449             then file_type = 2;
450             else if file_code = file_code_table (3)
451             then file_type = 3;
452             else code = error_table_$bad_file;
453             if code = 0
454             then call check_type;
455          end;
456       return;                                               /* end of check_set_file_type main routine */
457 
458 check_type:
459    proc;
460       if ^substr (compatible_types (mode), file_type, 1) | ((file_type = 2) & ssf)
461            | (((file_type = 1) | (file_type = 2)) & noend_sw) | (checkpoint_sw & ^(file_type = 1))
462            | ((dup_ok_sw | stat_sw | trans_sw) & (file_type ^= 2)) | ((shared | exclu_sw) & (file_type < 2))
463       then code = error_table_$incompatible_attach;
464    end check_type;
465 
466       dcl     compatible_types       (4:13) bit (3) static
467                                      init ("111"b, "101"b, "101"b, "111"b, "010"b, "010"b, "010"b, "010"b, "010"b, "010"b)
468                                      ;
469       dcl     file_code_table        (0:3) static internal fixed bin init (31191, 83711, 7129, 22513);
470    end;                                                     /* end check_set_file_type */
471 
472 open_msf:
473    proc;                                                    /* opens ssf as msf for indexed file */
474       is_msf = "1"b;
475       call msf_manager_$open (substr (attach_descrip_string, 8, dname_len),
476            substr (attach_descrip_string, 9 + dname_len, ename_len), fcb_ptr, foo);
477                                                             /* creates msf control block */
478       if (fcb_ptr = null) & (foo ^= 0)
479       then code = foo;                                      /* unexpected error */
480    end open_msf;
481 
482 check_set_file_already_open:
483    proc;
484       if file_type ^= 0
485       then
486          do;
487             if is_input_only_mode (mode)
488             then
489                do;
490                   if ^shared & (open_lock ^= "0"b)
491                   then code = error_table_$file_busy;
492                end;
493             else
494                do;
495                   call set_lock_$lock (open_lock, divide (wait_time + 500000, 1000000, 35, 0), foo);
496                   if foo ^= 0
497                   then if foo = error_table_$invalid_lock_reset
498                                                             /* locked by dead proc */
499                        then
500                           do;
501                              inv_lock_reset = "1"b;
502                              i_set_lock = "1"b;
503                           end;
504                        else code = error_table_$file_busy;
505                   else
506                      do;
507                         inv_lock_reset = "0"b;
508                         i_set_lock = "1"b;
509                      end;
510                end;
511          end;
512 
513    end;                                                     /* end check_set_file_already_open */
514 
515          dcl     i_set_lock             bit (1) aligned;
516          dcl     first_seg_bitcount     fixed bin (24);
517          dcl     is_new_file            bit (1) aligned;
518          dcl     open_x                 variable entry (ptr,/* iocb_ptr, input */
519                                         ptr,                /* fcb_ptr, input */
520                                         ptr,                /* first_seg_ptr, input */
521                                         bit (1) aligned,    /* is_new_file, input */
522                                         fixed bin,          /* mode */
523                                         entry,              /* close_x, output */
524                                         fixed bin (24),     /* first seg bitcount */
525                                         fixed bin (19),     /* max_component_size */
526                                         fixed bin (35));    /* code, if not 0, open_x leaves iocb as is */
527          dcl     open_uns_file          entry external;
528          dcl     open_seq_file          entry external;
529          dcl     open_blk_file          entry external;
530          dcl     open_indx_file         entry external;
531       end;                                                  /* end of open_file routine */
532 
533 cleanup:
534    proc;
535       if fcb_ptr ^= null
536       then call msf_manager_$close (fcb_ptr);
537       if (^was_msf) & (first_seg_ptr ^= null)
538       then call hcs_$terminate_noname (first_seg_ptr, foo);
539    end cleanup;
540 
541 control_file:
542    entry (iocb_ptr_arg, order, info_ptr, code);
543       iocb_ptr = iocb_ptr_arg -> iocb.actual_iocb_ptr;
544 
545 
546       if order = "file_status"
547       then call vfile_status_$seg (iocb_ptr, (null), info_ptr, code);
548 
549       else if order = "io_call"
550       then call vfile_io_control (iocb_ptr, (null), info_ptr, code);
551 
552       else code = error_table_$no_operation;
553       return;                                               /* end of control operation supported with switch closed */
554 
555 close_file:
556    entry (iocb_ptr_arg, code);
557       code = 0;
558       iocb_ptr = iocb_ptr_arg -> actual_iocb_ptr;
559       attach_block_ptr = attach_data_ptr;
560       call close_x (iocb_ptr);
561       if (file_type = 1 /* seq */) & (^is_input_only_mode (mode))
562       then call set_lock_$unlock (open_lock, foo);
563       iocb.control = control_file;
564       open_descrip_ptr = null;
565       open = open_file;
566       detach_iocb = detach_file;
567       call iox_$propagate (iocb_ptr);
568       call cleanup;
569       return;                                               /* end of close routine */
570 
571 detach_file:
572    entry (iocb_ptr_arg, code);
573       begin;
574          iocb_ptr = iocb_ptr_arg;
575          attach_block_ptr = attach_data_ptr;
576          code = 0;
577          attach_descrip_ptr = null;
578          call iox_$propagate (iocb_ptr);
579          call free_cb_file (size (attach_block), attach_block_ptr);
580       end;
581       return;                                               /* end detach routine */
582 
583 /* DECLARATIONS FOR COMPLETE PROGRAM */
584       dcl     sub_err_               entry options (variable);
585 
586       dcl     info_ptr               ptr;
587       dcl     order                  char (*);
588       dcl     vfile_status_$seg      entry (ptr, ptr, ptr, fixed (35));
589       dcl     vfile_io_control       entry (ptr, ptr, ptr, fixed (35));
590       dcl     1 branch_info          aligned,               /* info returned by hcs_$status_long */
591                 2 type               bit (2) unal,
592                 2 pad0               bit (34) unal,
593                 2 words1             (6) fixed,             /* of no interest */
594                 2 pad1               bit (12) unal,
595                 2 bit_count          bit (24) unal,         /* distinguishes msf and dir */
596                 2 words2             (2);
597       dcl     hcs_$status_long       entry (char (*), char (*), fixed (1), ptr, ptr, fixed (35));
598       dcl     hcs_$initiate          entry (char (*), char (*), char (*), fixed (1), fixed (2), ptr, fixed (35));
599       dcl     hcs_$terminate_noname  entry (ptr, fixed (35));
600       dcl     hcs_$truncate_seg      entry (ptr, fixed (18), fixed (35));
601       dcl     hcs_$make_seg          entry (char (*), char (*), char (*), fixed (5), ptr, fixed (35));
602       dcl     msf_manager_$close     external entry (ptr);  /* This entry frees the msf file control block
603                                                                and terminates all initiated components */
604       dcl     msf_manager_$adjust    external entry (ptr,   /* fcb_ptr input */
605                                      fixed bin,             /* component number, input */
606                                      fixed bin (24),        /* bit count, input */
607                                      bit (3),               /* "010"b implies don't set bit counts (use hcs_$set_bc_seg), truncate
608                                                                seg, don't terminate seg */
609                                      fixed bin (35));       /* code, output */
610       dcl     msf_manager_$get_ptr   external entry (ptr,   /* fcb_ptr, input */
611                                      fixed bin,             /* create switch, input */
612                                      bit (1),               /* create switch, input */
613                                      ptr,                   /* pointer to seg., output, null if error */
614                                      fixed bin (24),        /* bit count, output */
615                                      fixed bin (35));       /* code, output */
616       dcl     msf_manager_$open      external entry (char (*),
617                                                             /* directory pathname, input */
618                                      char (*),              /* entry name, input */
619                                      ptr,                   /* fcb_ptr, output, good unless code is
620                                                                error_table_$dirseg */
621                                      fixed bin (35));       /* code, output */
622       dcl     (extend_attach_option, shared_option, blocked_option, append_option, old_option, dup_ok_opt, exclu_option,
623               noend_option, stat_opt, trans_opt, checkpoint_opt)
624                                      bit (1) aligned init ("0"b);
625       dcl     tcf_name               char (32) var;
626       dcl     tcf_ptr                ptr;
627       dcl     (no_trunc_option, ssf_option, header_option)
628                                      bit (1) aligned init ("0"b);
629       dcl     wait_time_option       fixed (35) init (1);
630       dcl     identifier             fixed (35) init (0);
631       dcl     max_recl               fixed (35) init (0);
632       dcl     (n, i, n_opts, er_code);
633       dcl     saved_i                fixed init (0);
634       dcl     cv_dec_check_          entry (char (*), fixed) returns (fixed (35));
635       dcl     access_required        (13) bit (5) static internal
636                                      init ("01000"b, "00010"b, "01010"b, "01000"b, "01010"b, "01010"b, "01010"b, "01000"b,
637                                      "01010"b, "01010"b, "01000"b, "01010"b, "01010"b);
638                                                             /* second bit is r access, fourth bit is w access */
639       dcl     addr                   builtin;
640       dcl     alloc_cb_file          external entry (fixed bin,
641                                                             /* size of block in words, input */
642                                      ptr);                  /* pointer to block, output */
643       dcl     1 attach_block         based (attach_block_ptr),
644                                                             /* the following are set by attach_file */
645                 2 flags              aligned,
646                   3 (extend_attach, appending, no_trunc, old, ssf, header_present, blocked, shared, was_msf, is_msf,
647                        inv_lock_reset, dup_ok_sw, trans_sw, noend_sw, exclu_sw, stat_sw, checkpoint_sw)
648                                      bit (1) unal,
649                   3 pad              bit (19) unal,
650                 2 wait_time          fixed (35),
651                 2 interp             fixed,
652                 2 max_rec_len        fixed (35),
653                 2 header_id          fixed (35),
654                 2 attach_descrip,
655                   3 attach_descrip_len
656                                      fixed bin (35),        /* < = 256 */
657                   3 attach_descrip_string
658                                      char (256),            /* "-pn " (4 chars), the directory
659                                                                pathname (dname_len chars), ">", the entry
660                                                                name (ename_len chars), " -extend" (optional 8 chars),
661                                                                and " -raw" or " -extend"(optional 8 chars) */
662                 2 dname_len          fixed bin,             /* < = l68 */
663                 2 ename_len          fixed bin,             /* < = 32 */
664                                                             /* The following are set by open_file */
665                 2 open_descrip,
666                   3 open_descrip_len fixed bin (35),        /* < = 31 */
667                   3 open_descrip_string
668                                      char (32),             /* The string
669                                                                contains the opening mode, e.g., "stream output",
670                                                                (< = 23 chars) and " -extend" (8chars optional) */
671                 2 mode               fixed bin,             /* opening mode 1 <= 13 */
672                 2 file_type          fixed bin,             /* 0 = uns, 1 = seq, 2 = indx, 3 = blk */
673                 2 fcb_ptr            ptr,                   /* pointer to msf_manager control block */
674                 2 first_seg_ptr      ptr,                   /* pointer to first component
675                                                                of the file.  Thie pointer is valid throughout the
676                                                                file opening */
677                 2 close_x            entry (ptr),           /* routine to perform operations required
678                                                                for closing specific type of file obtained from open_x see
679                                                                open_file */
680                 2 last_comp          fixed,                 /* msf component number at open */
681                 2 tcf_iocbp          ptr;                   /* iocb ptr for transaction control switch */
682       dcl     attach_block_ptr       ptr;
683       dcl     bit                    builtin;
684       dcl     code                   fixed bin (35);        /* status code argument */
685       dcl     com_err_               entry options (variable);
686       dcl     command_switch         bit (1) aligned;
687       dcl     1 common_header        based (first_seg_ptr), /* This
688                                                                header is used for all seq and indx files.  Its contents
689                                                                are manipulated by open_file and close_file but not by the
690                                                                specific access methods.  Its size is 4 words */
691                 2 file_code          fixed bin (35),
692                 2 open_lock          bit (36) aligned,      /* nonzero if file open unless shared */
693                 2 reserved           (2) fixed bin;
694       dcl     extend_arg             bit (1) aligned;
695       dcl     foo                    fixed bin (35);        /* used when output parameters value is to
696                                                                beignored */
697       dcl     hbound                 builtin;
698       dcl     iocb_ptr               ptr;
699       dcl     iocb_ptr_arg           ptr;
700       dcl     is_input_only_mode     (13) static internal bit (1)
701                                      init ("1"b, "0"b, "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, "1"b, "0"b, "0"b);
702       dcl     is_output_mode         (13) static internal bit (1)
703                                      init ("0"b, "1"b, "1"b, "0"b, "1"b, "1"b, "0"b, "0"b, "1"b, "0"b, "0"b, "1"b, "0"b);
704       dcl     length                 builtin;
705       dcl     max_component_size     fixed bin (19);
706       dcl     mode_arg               fixed bin;
707       dcl     mode_descrip           (13) char (24) varying static internal
708                                      init ("stream_input", "stream_output", "stream_input_output", "sequential_input",
709                                      "sequential_output", "sequential_input_output", "sequential_update",
710                                      "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update",
711                                      "direct_input", "direct_output", "direct_update");
712       dcl     null                   builtin;
713       dcl     option_array           (*) char (*) varying;
714       dcl     iox_$propagate         entry (ptr);
715       dcl     iox_$look_iocb         entry (char (*), ptr, fixed (35));
716       dcl     rel_pathname           char (168);
717       dcl     rel_pathname_length    fixed bin;
718       dcl     reverse                builtin;
719       dcl     set_lock_$lock         entry (bit (36) aligned,
720                                                             /* lock word */
721                                      fixed bin,             /* num of seconds to wait */
722                                      fixed bin (35));       /* code=0 or et_$invalid_lock_reset are success codes */
723       dcl     set_lock_$unlock       entry (bit (36) aligned,
724                                                             /* lock word */
725                                      fixed bin (35));       /* code */
726       dcl     size                   builtin;
727       dcl     substr                 builtin;
728       dcl     verify                 builtin;
729       dcl     error_table_$negative_nelem
730                                      external fixed (35);
731       dcl     error_table_$noarg     external fixed (35);
732       dcl     error_table_$no_s_permission
733                                      external fixed (35);
734       dcl     error_table_$no_operation
735                                      fixed (35) external;
736       dcl     error_table_$bad_arg   external fixed bin (35);
737       dcl     error_table_$pathlong  external fixed bin (35);
738       dcl     error_table_$moderr    external fixed bin (35);
739       dcl     error_table_$dirseg    external fixed bin (35);
740       dcl     error_table_$not_detached
741                                      external fixed bin (35);
742       dcl     error_table_$bad_file  external fixed bin (35);
743       dcl     error_table_$file_busy external fixed bin (35);
744       dcl     error_table_$incompatible_attach
745                                      external fixed bin (35);
746       dcl     error_table_$invalid_lock_reset
747                                      external fixed bin (35);
748       dcl     free_cb_file           external entry (fixed bin,
749                                                             /* size of block in words, input */
750                                      ptr);                  /* pointer to block); input */
751 %include iocbv;
752 
753 /* GENERAL COMMENTS
754    This external procedure implements file attachment and the
755    i-o operations open, close and detach for this attachment
756    (entries: open_file, close_file, detach_file).  The code for
757    each entry immediately follows the entry and terminates with
758    a return statement.
759 
760    Before reading the code familiarize yourself with the general
761    conventions for implementing attachments (see the MPM) and read
762    the declarations of attach_block and common header.
763 
764    The whole thing can be considered a single program in which attach,
765    open, close, and detach are done in that order.  The difficult operation
766    is open.  It does that which is common to the various types of
767    files.  The specific access method is called (via open_x) to set up its
768    control block and perform any special file initialization.  open_file will
769    have to be changed when file types are put in the directory branches. */
770    end /* end of vfile_attach program */;