1
2
3
4
5
6
7
8
9
10
11
12
13 file_util: procedure;
14
15
16
17
18
19 dcl code2 fixed binary (35);
20 dcl pibp pointer;
21 dcl ap pointer;
22 dcl b36 (0: 1) based fixed binary (35);
23 dcl bit_count fixed binary (24);
24 dcl bits_per_seg fixed bin (24);
25 dcl dname based character (168) aligned;
26 dcl ename based character (32) aligned;
27 dcl entry character (32) aligned;
28 dcl ep pointer;
29 dcl error_table_$bad_ms_file external fixed binary (35);
30 dcl error_table_$moderr external fixed binary (35);
31 dcl error_table_$noentry external fixed binary (35);
32 dcl error_table_$toomanylinks external fixed binary (35);
33 dcl error_table_$seg_unknown external fixed bin (35);
34 dcl i fixed bin;
35 dcl infinity static fixed binary (35) initial (34359738367);
36 dcl kind fixed binary (2);
37 dcl max_length fixed bin (19);
38 dcl msf_sw bit (3) aligned;
39 dcl n fixed bin;
40 dcl p pointer;
41 dcl path character (168) aligned;
42 dcl suffix fixed binary;
43 dcl sys_info$max_seg_size ext fixed bin (19);
44 dcl expand_path_ entry (pointer, fixed binary, pointer, pointer, fixed binary (35));
45 dcl hcs_$get_max_length entry (char (*) aligned, char (*) aligned, fixed bin (19), fixed bin (35));
46 dcl hcs_$status_long entry (character (*) aligned, character (*) aligned, fixed binary (1), pointer,
47 pointer, fixed binary (35));
48 dcl hcs_$status_minf entry (character (*) aligned, character (*) aligned, fixed binary (1),
49 fixed binary (2), fixed binary (24), fixed binary (35));
50 dcl ioa_$rsnnl entry options (variable);
51 dcl msf_manager_$open entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)),
52 msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)),
53 msf_manager_$adjust entry (ptr, fixed bin, fixed bin (24), bit (3) aligned, fixed bin (35)),
54 msf_manager_$close entry (ptr);
55
56 dcl (addr, baseno, baseptr, bit, divide, fixed, empty, mod, null, substr) builtin;
57
58 dcl 1 branch,
59 2 ((dir, seg) bit (1), nnames bit (16), nrp bit (18)),
60 2 dtm bit (36),
61 2 dtu bit (36),
62 2 ((t, r, e, w, a) bit (1), pad1 bit (13), records bit (18)),
63 2 dtd bit (36),
64 2 dtem bit (36),
65 2 acct bit (36),
66 2 (curlen bit (12), bit_count bit (24)),
67 2 ((did, mdid) bit (4), copysw bit (1), pad2 bit (9), rb (3) bit (6)),
68 2 uid bit (36);
69
70
71 % include file_pib;
72 dcl 1 seg1 based aligned,
73 2 (no bit (18), used bit (1), key bit (17)) unaligned;
74
75 file_util$attach_file:
76 entry (pibp, code2);
77 p = pibp;
78 ap = addr (p -> pib.device_name.name_string);
79 n = p -> pib.device_name.name_size;
80 ep = addr (branch);
81 call expand_path_ (ap, n, addr (p -> pib.dir_name), addr (p -> pib.entry_name), code2);
82 if code2 ^= 0 then
83 do;
84 p -> pib.call = 1;
85 return;
86 end;
87 call hcs_$status_long (p -> pib.dir_name, p -> pib.entry_name, 1, ep, null, code2);
88 if code2 ^= 0 then
89 do;
90 if code2 = error_table_$noentry then
91 if p -> pib.w then
92 do;
93 p -> pib.level = ""b;
94
95 p -> pib.writebit, p -> pib.lastbit = 0;
96 p -> pib.bits_per_segment = sys_info$max_seg_size * 36;
97 go to attach_common;
98 end;
99 p -> pib.call = 2;
100 return;
101 end;
102 if branch.seg then
103 do;
104
105 if ^ branch.r & p -> pib.r | ^ branch.w & p -> pib.w then
106 do;
107 code2 = error_table_$moderr;
108 return;
109 end;
110 p -> pib.level = ""b;
111
112 p -> pib.writebit, p -> pib.lastbit = fixed (branch.bit_count, 35);
113 call hcs_$get_max_length (p -> pib.dir_name, p -> pib.entry_name, max_length, code2);
114 if code2 ^= 0 then do;
115 p -> pib.call = 3;
116 return;
117 end;
118 p -> pib.bits_per_segment = max_length * 36;
119 go to attach_common;
120 end;
121 if branch.dir then
122 do;
123 suffix = fixed (branch.bit_count, 24) - 1;
124 if suffix < 0 then
125 do;
126 suffix = 0;
127 go to attach_length_zero;
128 end;
129 call create_lower_level_names (null, suffix, addr (path), addr (entry));
130
131 call hcs_$status_minf (path, entry, 0, kind, bit_count, code2);
132 if code2 ^= 0 then
133 do;
134 if code2 = error_table_$noentry then
135 if p -> pib.w then
136 do;
137 attach_length_zero: bit_count = 0;
138 max_length = sys_info$max_seg_size;
139 go to attach_lower_level;
140 end;
141 p -> pib.call = 4;
142 return;
143 end;
144 if kind ^= 1 then
145 do;
146 code2 = error_table_$bad_ms_file;
147 return;
148 end;
149 call hcs_$get_max_length (path, entry, max_length, code2);
150 if code2 ^= 0 then do;
151 p -> pib.call = 5;
152 return;
153 end;
154 attach_lower_level: p -> pib.level = "1"b;
155
156 p -> pib.bits_per_segment = max_length * 36;
157 p -> pib.writebit, p -> pib.lastbit = p -> pib.bits_per_segment * suffix + bit_count;
158 go to attach_common;
159 end;
160 code2 = error_table_$toomanylinks;
161 return;
162
163 attach_common:
164 p -> pib.changed = ""b;
165 p -> pib.elsize = 9;
166 p -> pib.readbit = 0;
167 p -> pib.highbit = p -> pib.lastbit;
168 p -> pib.boundbit = infinity - mod (infinity, 9);
169 p -> pib.lastcomp = -1;
170 p -> pib.lastseg = null;
171 ap = addr (p -> pib.seg);
172 do i = 0 to 9;
173 ap -> b36 (i) = 011111111111111111b;
174 end;
175 p -> pib.search_type = 1;
176 p -> pib.nreads = 1;
177 substr (p -> pib.readlist, 1, 9) = "000001010"b;
178
179 call msf_manager_$open (p -> pib.dir_name, p -> pib.entry_name, p -> pib.fcb_ptr,
180 code2);
181 if code2 = error_table_$noentry then code2 = 0;
182
183 return;
184
185 file_util$detach_file:
186 entry (pibp, code2);
187 p = pibp;
188 bits_per_seg = p -> pib.bits_per_segment;
189 suffix = divide (p -> pib.lastbit, bits_per_seg, 17, 0);
190 bit_count = mod (p -> pib.lastbit, bits_per_seg);
191 msf_sw = p -> pib.changed || p -> pib.changed || "1"b;
192
193 call msf_manager_$adjust (p -> pib.fcb_ptr, suffix, bit_count, msf_sw, code2);
194
195 if code2 ^= 0 then
196 if code2 ^= error_table_$seg_unknown
197 & code2 ^= error_table_$noentry then return;
198
199 call msf_manager_$close (p -> pib.fcb_ptr);
200 p -> pib.fcb_ptr = null;
201
202 code2 = 0;
203 return;
204
205 find_seg_ptr:
206 entry (pibp, bv_can_create, which, seg, code5);
207
208
209
210 dcl bv_can_create bit (1) aligned parameter;
211 dcl which fixed binary;
212 dcl seg pointer;
213 dcl code5 fixed binary (35);
214
215 p = pibp;
216 i = mod (which, 10);
217 ap = addr (p -> pib.seg (i));
218 if ^ap -> seg1.used then goto skip_ck;
219 if fixed (ap -> seg1.key, 17) = which then
220 do;
221 seg = baseptr (ap -> seg1.no);
222 go to have_seg;
223 end;
224 skip_ck:
225
226 call msf_manager_$get_ptr (p -> pib.fcb_ptr, which, (bv_can_create & p -> pib.w), seg, bit_count, code5);
227 if seg = null then return;
228
229 ap = addr (p -> pib.seg (i));
230 ap -> seg1.no = baseno (seg);
231 ap -> seg1.key = bit (which, 17);
232
233
234
235 have_seg: ap -> seg1.used = "1"b;
236 code5 = 0;
237 return;
238
239 create_lower_level_names:
240 procedure (enp1, suffix, path, entry);
241 dcl enp1 pointer,
242 suffix fixed binary,
243 (path,
244 entry) pointer,
245 n fixed bin,
246 enp pointer;
247
248 if path ^= null then
249 do;
250 enp = enp1;
251 if enp = null then
252 enp = addr (p -> pib.entry_name);
253 if substr (p -> pib.dir_name, 1, 4) = "> " then
254 call ioa_$rsnnl (">^a", path -> dname, n, enp -> ename);
255 else
256 call ioa_$rsnnl ("^a>^a", path -> dname, n, p -> pib.dir_name, enp -> ename);
257 end;
258 if entry ^= null then
259 call ioa_$rsnnl ("^d", entry -> ename, n, suffix);
260 end create_lower_level_names;
261 end file_util;