1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16 vfs:
17 vfile_status:
18 proc (pathname_arg);
19 command_entry = "1"b;
20 report = ioa_;
21 e_ptr = null;
22 call cu_$arg_count (n_args);
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;
29 call get_star_names;
30 status_loop:
31 info.info_version = vfs_version_1;
32
33 do i = 1 to e_count;
34 if is_real_file ()
35 then if info.type = 1
36 then call proc_uns_file;
37 else if info.type = 2
38 then call proc_seq_file;
39 else if info.type = 3
40 then call proc_blk_file;
41 else if info.type = 4
42 then call proc_indx_file;
43 end;
44
45 if command_entry & ^file_found
46 then call com_err_ (0, "vfile_status", "No file found for given pathname.");
47 else do;
48 cleanup:
49 if ^command_entry
50 then code_arg = code;
51 end;
52 if e_ptr ^= null
53 then free entries, names in (a);
54 return;
55
56 print_:
57 entry (iocb_ptr, file_base_ptr, report_arg, code_arg);
58 report = report_arg;
59 command_entry = "0"b;
60 e_count = 1;
61 is_star_name = "0"b;
62 e_ptr = null;
63 go to status_loop;
64
65 get_star_names:
66 proc;
67 file_found = "0"b;
68 call expand_path_ (addr (pathname_arg), length (pathname_arg), addr (d_name), addr (e_name), code);
69
70 call check_code;
71 if index (e_name, "*") = 0
72 then do;
73 e_count = 1;
74 is_star_name = "0"b;
75 return;
76 end;
77 else is_star_name = "1"b;
78 area_ptr = get_system_free_area_ ();
79 call hcs_$star_ (d_name, e_name, 3 , area_ptr, e_count, e_ptr, n_ptr, code);
80
81 call check_code;
82 d_len = length (d_name) + 1 - verify (reverse (d_name), " ");
83
84
85 tot_names = 0;
86
87 do i = 1 to e_count;
88 tot_names = tot_names + fixed (n_names (i));
89 end;
90
91 end get_star_names;
92
93 check_code:
94 proc;
95 if code = 0
96 then return;
97 if command_entry
98 then call com_err_ (code, "vfile_status");
99 go to cleanup;
100 end check_code;
101
102 is_real_file:
103 proc returns (bit (1) aligned);
104 if is_star_name
105 then e_name = n_ptr -> names (fixed (e_ptr -> entries.n_index (i)));
106
107 if command_entry
108 then call vfile_status_ (d_name, e_name, addr (info), code);
109
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);
114 call check_code;
115 if is_star_name
116 then call report ("^a", substr (d_name, 1, d_len) || ">" || e_name);
117 file_found = "1"b;
118 return ("1"b);
119 end is_real_file;
120
121 proc_uns_file:
122 proc;
123 call report ("type: unstructured
124 bytes: ^d", uns_info.end_pos);
125 if uns_info.header_present
126 then call report ("header: ^d", uns_info.header_id);
127 end proc_uns_file;
128
129 proc_seq_file:
130 proc;
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;
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;
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);
156 if (action_code < -14) | (action_code > 3)
157 then call report ("action: unknown operation in progress");
158 else if action_code ^= 0
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;
171 if ^((info.type = 2 ) & (seq_info.version < 12))
172 then call report ("records: ^d", info.records);
173 if info.lock_status ^= "00"b
174 then if info.lock_status = "01"b
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;
183 call report ("type: indexed");
184 call print_common_info;
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
190 because of vfile_ bug. Use the vfile_adjust command to
191 correct the problem."
192 );
193
194 else call report ("version: old version
195 call report_action (indx_info.action);
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
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;