1
2
3
4
5
6
7
8
9
10
11
12
13
14 chname: proc;
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35 cfile: entry (a_parent, a_ename, a_oldname, a_newname, a_code);
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 NOTE
62
63
64
65 dcl a_code fixed bin (35);
66 dcl a_ename char (*);
67 dcl a_ep ptr;
68 dcl a_newname char (*);
69 dcl a_oldname char (*);
70 dcl a_parent char (*);
71 dcl a_sp ptr;
72
73 dcl ep_known fixed bin static init (2) options (constant); ;
74 dcl file fixed bin static init (0) options (constant);
75 dcl seg fixed bin static init (1) options (constant); ;
76
77 dcl areap ptr;
78 dcl code fixed bin (35);
79 dcl ename char (32);
80 dcl entry_point fixed bin;
81 dcl just_delete_name bit (1) aligned;
82 dcl last_namep ptr;
83 dcl namecnt fixed bin (18);
84 dcl nep ptr;
85 dcl new_np ptr;
86 dcl newname char (32) aligned;
87 dcl newname_p ptr;
88 dcl next_np ptr;
89 dcl old_np ptr;
90 dcl oldname char (32) aligned;
91 dcl oldname_p ptr;
92 dcl parent char (168);
93 dcl pvid bit (36) aligned;
94 dcl save_fp bit (18);
95 dcl sp ptr;
96 dcl uid bit (36) aligned;
97 dcl vtocx fixed bin;
98
99 dcl active_hardcore_data$ensize fixed bin external;
100 dcl error_table_$bad_ring_brackets fixed bin (35) external;
101 dcl error_table_$namedup fixed bin (35) external;
102 dcl error_table_$noalloc fixed bin (35) external;
103 dcl error_table_$noentry fixed bin (35) external;
104 dcl error_table_$nonamerr fixed bin (35) external;
105 dcl error_table_$oldnamerr fixed bin (35) external;
106 dcl error_table_$segnamedup fixed bin (35) external;
107 dcl pds$processid bit (36) aligned ext;
108 dcl 1 pds$transparent aligned ext,
109 2 m bit (1) unaligned,
110 2 u bit (1) unaligned;
111 dcl sst$ast_track bit (1) aligned external;
112
113 dcl change_dtem entry (ptr);
114 dcl fs_alloc$alloc entry (ptr, fixed bin, ptr);
115 dcl fs_alloc$free entry (ptr, fixed bin, ptr);
116 dcl hash$in entry (ptr, ptr, fixed bin (35));
117 dcl hash$out entry (ptr, ptr, ptr, fixed bin (35));
118 dcl hash$search entry (ptr, ptr, ptr, fixed bin (35));
119 dcl level$get entry returns (fixed bin);
120 dcl lock$dir_unlock entry (ptr);
121 dcl lock$lock_ast entry;
122 dcl lock$unlock_ast entry;
123 dcl pathname_am$flush entry (bit (36) aligned);
124 dcl search_ast$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)) returns (ptr);
125 dcl sum$dirmod entry (ptr);
126
127 dcl (addr, bin, bit, clock, divide, fixed, null, ptr, rel, rtrim) builtin;
128 %page;
129 entry_point = file;
130 parent = a_parent;
131 ename = a_ename;
132
133 go to common;
134
135 cseg: entry (a_sp, a_oldname, a_newname, a_code);
136
137 entry_point = seg;
138 sp = a_sp;
139 goto common;
140
141 retv: entry (a_ep, a_oldname, a_newname, a_code);
142
143 ep = a_ep;
144 dp = ptr (ep, 0);
145 entry_point = ep_known;
146
147 common:
148 code = 0;
149 oldname = a_oldname;
150 newname = a_newname;
151
152 if newname = "" then just_delete_name = "1"b;
153 else just_delete_name = "0"b;
154
155 if entry_point ^= ep_known then do;
156 if entry_point = file then call dc_find$obj_status_write (parent, ename, 0, FS_OBJ_RENAME, ep, code);
157 else call dc_find$obj_status_write_ptr (sp, FS_OBJ_RENAME, ep, code);
158 dp = ptr (ep, 0);
159 if code ^= 0 then go to finale;
160
161 if entry.bs then
162 if ^(entry.dirsw) then
163 if fixed (entry.ring_brackets (1), 3) < (level$get ()) then do;
164 code = error_table_$bad_ring_brackets;
165 go to unlock;
166 end; else ;
167 else if fixed (entry.ex_ring_brackets (1), 3) < (level$get ()) then do;
168 code = error_table_$bad_ring_brackets;
169 go to unlock;
170 end; else ;
171 end;
172
173 namecnt = fixed (entry.nnames, 18);
174
175 if namecnt = 1 then if just_delete_name
176 then do;
177 code = error_table_$nonamerr;
178 go to unlock;
179 end;
180
181 areap = ptr (dp, dir.arearp);
182
183 dir.modify = pds$processid;
184
185 if just_delete_name then go to delete_name;
186
187 newname_p = addr (newname);
188 call hash$search (dp, newname_p, nep, code);
189 if code = 0 then do;
190 if ep = nep then code = error_table_$segnamedup;
191 else code = error_table_$namedup;
192 go to unlock;
193 end;
194 if code ^= error_table_$noentry then go to unlock;
195
196 call fs_alloc$alloc (areap, active_hardcore_data$ensize, new_np);
197 if new_np = null then go to noalloc_err;
198
199 new_np -> names.name = newname;
200
201 new_np -> names.entry_rp = rel (ep);
202 new_np -> names.type = NAME_TYPE;
203 new_np -> names.size = active_hardcore_data$ensize;
204 new_np -> names.owner = entry.uid;
205
206 call hash$in (dp, new_np, code);
207 if code ^= 0 then go to hash_error;
208
209 last_namep = ptr (ep, entry.name_brp);
210 new_np -> names.bp = rel (last_namep);
211 last_namep -> names.fp = rel (new_np);
212 entry.name_brp = rel (new_np);
213 namecnt = namecnt + 1;
214
215
216 delete_name: if oldname = "" then go to finish;
217
218 oldname_p = addr (oldname);
219 call hash$search (dp, oldname_p, nep, code);
220 if code ^= 0 then go to finish;
221 if ep ^= nep then go to name_err;
222
223 call hash$out (dp, oldname_p, old_np, code);
224 if code ^= 0 then do;
225 name_err: code = error_table_$oldnamerr;
226 go to finish;
227 end;
228
229 if old_np -> names.bp then do;
230 ptr (old_np, old_np -> names.bp) -> names.fp = old_np -> names.fp;
231 if old_np -> names.fp then ptr (old_np, old_np -> names.fp) -> names.bp = old_np -> names.bp;
232 else entry.name_brp = old_np -> names.bp;
233 end;
234 else do;
235
236
237
238
239
240
241
242
243 if just_delete_name then next_np = ptr (dp, old_np -> names.fp);
244 else next_np = new_np;
245
246 call hash$out (dp, addr (next_np -> names.name), next_np, code);
247 if code ^= 0 then goto finish;
248
249
250
251 if next_np -> names.fp = "0"b
252 then entry.name_brp = next_np -> names.bp;
253 else ptr (dp, next_np -> names.fp) -> names.bp = next_np -> names.bp;
254 ptr (dp, next_np -> names.bp) -> names.fp = next_np -> names.fp;
255
256
257
258 save_fp = old_np -> names.fp;
259 old_np -> names = next_np -> names;
260 old_np -> names.fp = save_fp;
261 old_np -> names.bp = "0"b;
262
263 call hash$in (dp, old_np, code);
264 if code ^= 0 then goto finish;
265 old_np = next_np;
266
267 if entry.bs & sst$ast_track then do;
268 uid = entry.uid;
269 pvid = entry.pvid;
270 vtocx = entry.vtocx;
271 temp_entry_name = newname;
272 call lock$lock_ast;
273 nm_astep = search_ast$check (uid, pvid, vtocx, (0));
274 if nm_astep ^= null then
275
276 %include make_sstnt_entry;
277 call lock$unlock_ast;
278 end;
279 end;
280
281 namecnt = namecnt - 1;
282
283 call fs_alloc$free (areap, active_hardcore_data$ensize, old_np);
284 if entry.dirsw
285 then call pathname_am$flush (entry.uid);
286
287
288 finish: entry.nnames = namecnt;
289 if ^pds$transparent.m then
290 if entry.dtem ^= bit (fixed (clock (), 52), 36) then
291 call change_dtem (ep);
292 dir.modify = "0"b;
293 call sum$dirmod (dp);
294 go to unlock1;
295
296
297
298 unlock: dir.modify = "0"b;
299 unlock1: if entry_point ^= ep_known then do;
300 if entry_point = file
301 then call dc_find$finished (dp, "1"b);
302 else call lock$dir_unlock (dp);
303 end;
304 finale: a_code = code;
305 return;
306
307 hash_error:
308 call fs_alloc$free (areap, active_hardcore_data$ensize, new_np);
309 go to unlock;
310 noalloc_err:
311 code = error_table_$noalloc;
312 go to unlock;
313
314
315
316 %page; %include aste;
317 %page; %include dc_find_dcls;
318 %page; %include dir_entry;
319 %page; %include dir_header;
320 %page; %include dir_ht;
321 %page; %include dir_name;
322 %page; %include fs_obj_access_codes;
323 %page; %include fs_types;
324 %page; %include sstnt;
325 end chname;