1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34 fs_get: proc;
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144 dcl a_code fixed bin (35) parameter;
145 dcl a_dirname char (*) parameter;
146 dcl a_ename char (*) parameter;
147 dcl a_ex_mode bit (*) parameter;
148 dcl a_ex_modes bit (36) aligned parameter;
149 dcl a_ldir char (*) parameter;
150 dcl a_lentry char (*) parameter;
151 dcl a_lnd fixed bin (17) parameter;
152 dcl a_mode fixed bin (5) parameter;
153 dcl a_name char (*) parameter;
154 dcl a_namecnt fixed bin (17) parameter;
155 dcl a_new_mode bit (36) aligned parameter;
156 dcl a_newsw fixed bin (17) parameter;
157 dcl a_oldsw fixed bin (17) parameter;
158 dcl a_ptr ptr parameter;
159 dcl a_refname char (*) parameter;
160 dcl a_rings (3) fixed bin (3) parameter;
161 dcl a_rname char (*) parameter;
162 dcl a_segptr ptr parameter;
163
164
165
166 dcl access_modes fixed bin static options (constant) init (5);
167 dcl brackets fixed bin static options (constant) init (3);
168 dcl ex_mode_name fixed bin static options (constant) init (4);
169 dcl just_mode fixed bin static options (constant) init (0);
170
171
172
173 dcl aptr ptr;
174 dcl code fixed bin (35);
175 dcl dirsw bit (1) aligned;
176 dcl dlen fixed bin (17);
177 dcl end_rule fixed bin (17);
178 dcl entry_point fixed bin;
179 dcl extended_mode bit (36) aligned;
180 dcl i fixed bin;
181 dcl l fixed bin;
182 dcl ldir char (168);
183 dcl lentry char (32);
184 dcl mode bit (36) aligned;
185 dcl namecnt fixed bin (17);
186 dcl newsw fixed bin (17);
187 dcl oldsw fixed bin (17);
188 dcl pathname char (201) varying;
189 dcl rb (3) fixed bin (3);
190 dcl return_ename bit (1) aligned;
191 dcl ring fixed bin;
192 dcl rname char (32) varying;
193 dcl segnum fixed bin (17);
194 dcl segptr ptr;
195 dcl srpp ptr;
196
197
198
199 dcl 1 ret_struc based aligned,
200 2 num fixed bin,
201 2 names (21) char (168);
202
203 dcl 1 sr (22) based aligned,
204 2 segno fixed bin (17) unaligned,
205 2 offset fixed bin (17) unaligned,
206 2 uid bit (36);
207
208
209
210 dcl error_table_$dirseg fixed bin (35) external;
211 dcl error_table_$noentry fixed bin (35) external;
212 dcl error_table_$root fixed bin (35) external;
213 dcl pds$stacks (0:7) ptr external;
214 dcl pds$transparent bit (2) external aligned;
215
216
217
218 dcl get_pathname_ entry (fixed bin (17), char (*) varying, fixed bin (35));
219 dcl level$get entry returns (fixed bin);
220 dcl ref_name_$get_refname entry (fixed bin (17), fixed bin (17), char (*) varying, fixed bin (35));
221 dcl ref_name_$get_segno entry (char (32) varying, fixed bin (17), fixed bin (35));
222
223
224
225 dcl (baseno, baseptr, binary, fixed, hbound, index, lbound, length, max, null, reverse, segno, substr) builtin;
226 %page;
227 mode: entry (a_segptr, a_mode, a_code);
228
229 entry_point = just_mode;
230 go to join_mode;
231
232 brackets: entry (a_segptr, a_mode, a_rings, a_code);
233
234 entry_point = brackets;
235 go to join_mode;
236
237 access_modes:
238 entry (a_segptr, a_new_mode, a_ex_modes, a_code);
239
240 entry_point = access_modes;
241 go to join_mode;
242
243 ex_mode_name:
244 entry (a_segptr, a_mode, a_rings, a_ex_mode, a_name, a_code);
245
246 entry_point = ex_mode_name;
247 join_mode:
248 segptr = a_segptr;
249
250 call dc_find$obj_modes_ptr (segptr, mode, extended_mode, rb, code);
251 if code ^= 0 then
252 if code = error_table_$dirseg then do;
253 code = 0;
254 dirsw = "1"b;
255 end;
256 else go to err0;
257 else dirsw = "0"b;
258
259 if (entry_point = brackets) | (entry_point = ex_mode_name) then do;
260 a_rings = rb;
261 if entry_point = ex_mode_name then do;
262 a_ex_mode = extended_mode;
263 a_name = "";
264 end;
265 end;
266 if entry_point = access_modes then do;
267 if dirsw then code = error_table_$dirseg;
268 else do;
269 a_new_mode = mode;
270 a_ex_modes = extended_mode;
271 end;
272 end;
273 else do;
274 if dirsw then mode = substr (mode, 1, 1) || "1"b || substr (mode, 2, 2);
275 a_mode = fixed (substr (mode, 1, 4), 5);
276 end;
277
278 err0:
279 a_code = code;
280 return;
281 %page;
282
283
284
285 seg_ptr: entry (a_rname, a_segptr, a_code);
286
287 call ref_name_$get_segno ((a_rname), segnum, code);
288 if code = 0 then a_segptr = baseptr (segnum);
289 else a_segptr = null ();
290 a_code = code;
291 return;
292
293
294 search_rules: entry (a_ptr);
295
296 aptr = a_ptr;
297 ring = level$get ();
298 rntp = pds$stacks (ring) -> stack_header.rnt_ptr;
299 srpp = rntp -> rnt.srulep;
300 end_rule = binary (END_RULE);
301 do i = lbound (srpp -> sr, 1) to hbound (srpp -> sr, 1) while (srpp -> sr (i).offset ^= end_rule);
302 if srpp -> sr (i).offset ^= 0 then aptr -> ret_struc.names (i) = search_rule_names (srpp -> sr (i).offset);
303 else do;
304 segnum = srpp -> sr (i).segno;
305 segptr = baseptr (segnum);
306 call dc_find$obj_existence_ptr (segptr, ep, code);
307 if code ^= 0 then aptr -> ret_struc.names (i) = "invalid search rule pointer";
308 else do;
309 call get_pathname_ (segnum, pathname, code);
310 if code ^= 0 then aptr -> ret_struc.names (i) = "invalid search rule pointer";
311 else aptr -> ret_struc.names (i) = pathname;
312 call dc_find$finished (ep, DC_FIND_UNLOCK_DIR);
313 end;
314 end;
315 end;
316 aptr -> ret_struc.num = i - 1;
317 return;
318
319
320
321 get_link_target:
322 entry (a_ldir, a_lentry, a_dirname, a_ename, a_code);
323
324 ldir = a_ldir;
325 lentry = a_lentry;
326
327 a_dirname = "";
328 a_ename = "";
329
330 call dc_find$link_target (ldir, lentry, code);
331
332 if code = 0 | code = error_table_$noentry then do;
333 a_dirname = ldir;
334 a_ename = lentry;
335 end;
336
337 a_code = code;
338 return;
339
340
341
342 path_name: entry (a_segptr, a_dirname, a_lnd, a_ename, a_code);
343 return_ename = "1"b;
344 goto name_join;
345
346 dir_name: entry (a_segptr, a_dirname, a_lnd, a_code);
347 return_ename = "0"b;
348
349 name_join:
350 code = 0;
351 segptr = a_segptr;
352 call dc_find$obj_existence_ptr (segptr, ep, code);
353 if code = 0 then do;
354 call get_pathname_ (segno (segptr), pathname, code);
355 call dc_find$finished (ep, DC_FIND_UNLOCK_DIR);
356 end;
357 else if code = error_table_$root then do;
358 code = 0;
359 pathname = ">";
360 end;
361 else goto name_return;
362
363 i = index (reverse (pathname), ">");
364 l = length (pathname);
365 dlen = max (l - i, 1);
366 if return_ename then if dlen = 1 then dlen = 0;
367 a_dirname = substr (pathname, 1, dlen);
368 a_lnd = dlen;
369 if return_ename then a_ename = substr (pathname, l + 2 - i, i - 1);
370 name_return:
371 a_code = code;
372 return;
373
374
375
376 ref_name: entry (a_segptr, a_namecnt, a_refname, a_code);
377
378 namecnt = max(a_namecnt, 1);
379
380 segnum = fixed (baseno (a_segptr), 17);
381 call ref_name_$get_refname (segnum, namecnt, rname, code);
382 if code = 0 then do;
383 a_refname = rname;
384 a_code = 0;
385 end;
386 else a_code = code;
387
388 return;
389
390
391
392 trans_sw: entry (a_newsw, a_oldsw);
393
394 newsw = a_newsw;
395 oldsw = fixed (pds$transparent, 2);
396 if newsw > 3 then go to fin2;
397 if newsw < 0 then go to fin2;
398 if newsw = 0 then pds$transparent = "0"b;
399 else if newsw = 1 then pds$transparent = "01"b;
400 else pds$transparent = "11"b;
401
402 fin2: a_oldsw = oldsw;
403 return;
404 %page; %include dc_find_dcls;
405 %page; %include dir_entry;
406 %page; %include dir_name;
407 %page; %include fs_types;
408 %page; %include rnt;
409 %page; %include sdw;
410 %page; %include search_rule_flags;
411 %page; %include stack_header;
412 end fs_get;