1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* This routine prints information about storage system
 12    files given a pathname (star convention permitted).
 13    Info provided includes the file's apparent type
 14    and various statistics */
 15 
 16 vfs:
 17 vfile_status:
 18      proc (pathname_arg);
 19           command_entry = "1"b;
 20           report = ioa_;                                    /* differs for subroutine entry */
 21           e_ptr = null;                                     /* won't free unless non-null */
 22           call cu_$arg_count (n_args);                      /* args with which command was invoked */
 23           if n_args <= 0
 24           then code = error_table_$noarg;
 25           else if n_args > 1
 26           then code = error_table_$too_many_args;
 27           else code = 0;
 28           call check_code;                                  /* aborts on error */
 29           call get_star_names;                              /* interprets pathname_arg */
 30 status_loop:
 31           info.info_version = vfs_version_1;
 32 
 33           do i = 1 to e_count;                              /* check each entry matching star_name */
 34                if is_real_file ()                           /* don't consider directories */
 35                then if info.type = 1                        /* unstructured */
 36                     then call proc_uns_file;
 37                     else if info.type = 2                   /* sequential */
 38                     then call proc_seq_file;
 39                     else if info.type = 3                   /* blocked */
 40                     then call proc_blk_file;
 41                     else if info.type = 4                   /* indexed */
 42                     then call proc_indx_file;               /* must be indexed */
 43           end;
 44 
 45           if command_entry & ^file_found                    /* only directories or empty files found */
 46           then call com_err_ (0, "vfile_status", "No file found for given pathname.");
 47           else do;
 48 cleanup:
 49                     if ^command_entry                       /* set return code */
 50                     then code_arg = code;
 51                end;
 52           if e_ptr ^= null
 53           then free entries, names in (a);
 54           return;                                           /* end of main file status routine */
 55 
 56 print_:
 57      entry (iocb_ptr, file_base_ptr, report_arg, code_arg);
 58           report = report_arg;                              /* set by io_call */
 59           command_entry = "0"b;
 60           e_count = 1;                                      /* one file only */
 61           is_star_name = "0"b;
 62           e_ptr = null;                                     /* prevents attempt to cleanup */
 63           go to status_loop;                                /* print status of file */
 64 
 65 get_star_names:
 66      proc;                                                  /* expands argument in star convention */
 67           file_found = "0"b;                                /* will be set if non-null, non-dir seg is found */
 68           call expand_path_ (addr (pathname_arg), length (pathname_arg), addr (d_name), addr (e_name), code);
 69                                                             /* gets full path and ent names */
 70           call check_code;                                  /* aborts on non-zero error code */
 71           if index (e_name, "*") = 0                        /* not a star name */
 72           then do;
 73                     e_count = 1;                            /* only one entry to consider */
 74                     is_star_name = "0"b;                    /* suppresses printout of pathname */
 75                     return;
 76                end;
 77           else is_star_name = "1"b;
 78           area_ptr = get_system_free_area_ ();              /* temp space for star_name info */
 79           call hcs_$star_ (d_name, e_name, 3 /* all types of entries */, area_ptr, e_count, e_ptr, n_ptr, code);
 80                                                             /* finds matching entries */
 81           call check_code;
 82           d_len = length (d_name) + 1 - verify (reverse (d_name), " ");
 83                                                             /* directory
 84                                                                pathname length */
 85           tot_names = 0;                                    /* will be set in following loop */
 86 
 87           do i = 1 to e_count;                              /* get total extent of names structure allocated */
 88                tot_names = tot_names + fixed (n_names (i));
 89           end;
 90 
 91      end get_star_names;
 92 
 93 check_code:
 94      proc;                                                  /* aborts if nonzero error code detected */
 95           if code = 0
 96           then return;
 97           if command_entry                                  /* first print message */
 98           then call com_err_ (code, "vfile_status");        /* prints error info */
 99           go to cleanup;                                    /* frees allocated system storage and closes msf */
100      end check_code;
101 
102 is_real_file:
103      proc returns (bit (1) aligned);                        /* non-dir seg */
104           if is_star_name                                   /* get an entry name */
105           then e_name = n_ptr -> names (fixed (e_ptr -> entries.n_index (i)));
106                                                             /* the i'th entry name */
107           if command_entry
108           then call vfile_status_ (d_name, e_name, addr (info), code);
109                                                             /* gets file info */
110           else call vfile_status_$seg (iocb_ptr, file_base_ptr, addr (info), code);
111           if (code = error_table_$dirseg) | (code = error_table_$noentry)
112           then if command_entry
113                then return ("0"b);                          /* ignore directories and non-existing entries */
114           call check_code;
115           if is_star_name                                   /* print pathname */
116           then call report ("^a", substr (d_name, 1, d_len) || ">" || e_name);
117           file_found = "1"b;
118           return ("1"b);                                    /* indicates real data file found for i'th entry */
119      end is_real_file;
120 
121 proc_uns_file:
122      proc;                                                  /* prints info about unstructured files */
123           call report ("type: unstructured
124 bytes: ^d", uns_info.end_pos);
125           if uns_info.header_present                        /* header is optional */
126           then call report ("header: ^d", uns_info.header_id);
127      end proc_uns_file;
128 
129 proc_seq_file:
130      proc;                                                  /* prints info about sequential files */
131           call report ("type: sequential");
132           call print_common_info;
133           if seq_info.version < 12
134           then call report ("version: old (no record count)");
135           else if seq_info.version < current_seq_version
136           then call report ("version: old (pre-MR6.0)");
137           call report_action (seq_info.action);
138      end proc_seq_file;
139 
140 proc_blk_file:
141      proc;                                                  /* prints info about blocked files */
142           call report ("type: blocked");
143           call print_common_info;
144           if blk_info.version < current_blk_version
145           then call report ("version: old (pre-MR6.0)");
146           else do;                                          /* version supports time_stamp */
147                     call date_time_ (blk_info.time_last_modified, date_time);
148                     call report ("last changed: ^a", date_time);
149                end;
150           call report_action (blk_info.action);
151           call report ("max recl: ^d bytes", blk_info.max_rec_len);
152      end proc_blk_file;
153 
154 report_action:
155      proc (action_code);                                    /* routine deciphers action codes for updates in progress */
156           if (action_code < -14) | (action_code > 3)        /* unknown code */
157           then call report ("action: unknown operation in progress");
158           else if action_code ^= 0                          /* operation in progress */
159           then call report ("action: ^a in progress", operation (-1 * (action_code)));
160           dcl     operation              (-3:14) char (24) var static options (constant)
161                                          init ("checkpoint", "non-checkpoint opening", "truncate", "", "write_record",
162                                          "rewrite_record", "delete_record", "add_key", "delete_key", "record_status(create)",
163                                          "exclusive opening", "reassign_key", "write_record (truncate)",
164                                          "delete_record (non-eof)", "unshared opening", "adjust_record",
165                                          "adjust_record (rollback)", "recovery");
166           dcl     action_code            fixed;
167      end report_action;
168 
169 print_common_info:
170      proc;                                                  /* if file is locked, info is printed out; also record count */
171           if ^((info.type = 2 /* sequential */) & (seq_info.version < 12))
172           then call report ("records: ^d", info.records);   /* end pos in same loc for all struc files */
173           if info.lock_status ^= "00"b                      /* file is locked */
174           then if info.lock_status = "01"b                  /* busy in another process */
175                then call report ("state: locked by another process");
176                else if info.lock_status = "10"b
177                then call report ("state: locked by this process");
178                else call report ("state: locked by dead process");
179      end print_common_info;
180 
181 proc_indx_file:
182      proc;                                                  /* prints info about indexed files */
183           call report ("type: indexed");
184           call print_common_info;                           /* record count and lock status */
185           if (indx_info.program_version < 33)
186           then if ((indx_info.program_version = 21) | ((indx_info.program_version < 21) & (indx_info.file_version = 20)))
187                then call report
188                          (
189                          "version: Warning--total record length statistic is bad
190 because of vfile_ bug.  Use the vfile_adjust command to
191 correct the problem."
192                          );                                 /* opening the file for modification also will
193                                                                automatically adjust the bad statistic */
194                else call report ("version: old version--does not support even-word aligned records.");
195           call report_action (indx_info.action);            /* prints if file inconsistent */
196           if (indx_info.non_null_recs ^= indx_info.records)
197                & ((indx_info.program_version >= 23) | (indx_info.file_version = 10))
198           then call report ("alloc recs: ^d", indx_info.non_null_recs);
199           if (indx_info.records ^= 0) | (indx_info.record_bytes ^= 0)
200           then call report ("record bytes: ^d", indx_info.record_bytes);
201           if (indx_info.records ^= 0) | (indx_info.free_blocks ^= 0)
202           then call report ("free blocks: ^d", indx_info.free_blocks);
203           if (indx_info.num_keys ^= 0) | (indx_info.nodes ^= 0) | (indx_info.index_height ^= 0) | (indx_info.key_bytes ^= 0)
204           then call report ("index height: ^d
205 nodes: ^d
206 key bytes: ^d", indx_info.index_height, indx_info.nodes,
207                     indx_info.key_bytes);
208           if indx_info.num_keys ^= indx_info.records
209           then call report ("keys: ^d", indx_info.num_keys);
210           if indx_info.dup_keys ^= 0
211           then call report ("dup keys: ^d
212 dup key bytes: ^d", indx_info.dup_keys, indx_info.dup_key_bytes);
213      end proc_indx_file;
214 
215 /* declarations for entire program */
216           dcl     code_arg               fixed (35);
217           dcl     is_star_name           bit (1) aligned;
218           dcl     command_entry          bit (1) aligned;
219           dcl     file_base_ptr          ptr;
220           dcl     iocb_ptr               ptr;
221           dcl     vfile_status_          entry (char (*) aligned, char (*) aligned, ptr, fixed (35));
222           dcl     vfile_status_$seg      entry (ptr, ptr, ptr, fixed (35));
223           dcl     a                      area based (area_ptr);
224           dcl     cu_$arg_count          entry (fixed);
225           dcl     n_args                 fixed;
226           dcl     (error_table_$noarg, error_table_$noentry, error_table_$too_many_args)
227                                          external fixed (35);
228           dcl     pathname_arg           char (*);
229           dcl     (i, e_count)           fixed;
230           dcl     report                 entry variable options (variable);
231           dcl     (ioa_, report_arg)     entry options (variable);
232           dcl     code                   fixed (35);
233           dcl     (null, index, fixed)   builtin;
234           dcl     file_found             bit (1) aligned;
235           dcl     (e_ptr, n_ptr)         ptr;
236           dcl     expand_path_           entry (ptr, fixed, ptr, ptr, fixed (35));
237           dcl     (addr, length)         builtin;
238           dcl     d_name                 char (168) aligned;
239           dcl     e_name                 char (32) aligned;
240           dcl     area_ptr               ptr;
241           dcl     get_system_free_area_  entry returns (ptr);
242           dcl     hcs_$star_             entry (char (*) aligned, char (*) aligned, fixed (2), ptr, fixed, ptr, ptr,
243                                          fixed (35));
244           dcl     d_len                  fixed;
245           dcl     (verify, reverse)      builtin;
246           dcl     com_err_               entry options (variable);
247           dcl     names                  (tot_names) char (32) aligned based (n_ptr);
248           dcl     tot_names              fixed;
249           dcl     1 entries              (e_count) aligned based (e_ptr),
250                   ( 2 type               bit (2),
251                     2 n_names            bit (16),
252                     2 n_index            bit (18)
253                     )                    unal;
254           dcl     error_table_$dirseg    external fixed (35);
255           dcl     substr                 builtin;
256           dcl     current_indx_version   static options (constant) internal fixed init (40);
257           dcl     current_blk_version    static options (constant) internal fixed init (1);
258           dcl     current_seq_version    static options (constant) internal fixed init (13);
259           dcl     abs                    builtin;
260           dcl     truncating             fixed static options (constant) internal init (1);
261           dcl     1 info                 like indx_info;
262           dcl     date_time_             entry (fixed (71), char (*));
263           dcl     date_time              char (24);
264 %include vfs_info;
265 
266      end vfile_status;