1
2
3
4
5
6
7
8
9
10
11
12
13
14 fs_move: proc;
15
16
17
18
19
20
21
22 ffile: entry (a_dirname_from, a_ename_from, a_sw, a_dirname_to, a_ename_to, a_code);
23
24 dcl a_dirname_from char (*);
25 dcl a_dirname_to char (*);
26 dcl a_ename_from char (*);
27 dcl a_ename_to char (*);
28 dcl a_sw fixed bin (2);
29 dcl a_code fixed bin (35);
30
31 dcl created_seg bit (1) aligned;
32 dcl dirname_from char (168);
33 dcl dirname_to char (168);
34 dcl ename_from char (32);
35 dcl ename_to char (32);
36 dcl curlen fixed bin;
37 dcl ldirname_from fixed bin;
38 dcl ldirname_to fixed bin;
39 dcl target_len bit (12);
40 dcl entry_point fixed bin;
41 dcl options bit (2) unaligned;
42 dcl append_sw bit (1) unaligned def (options) pos (1);
43 dcl truncate_sw bit (1) unaligned def (options) pos (2);
44 dcl max_length fixed bin (19);
45 dcl words fixed bin (19);
46 dcl tcode fixed bin (35);
47 dcl code fixed bin (35);
48 dcl ptr_from ptr;
49 dcl ptr_to ptr;
50 dcl dptr ptr;
51
52 dcl copy (words) bit (36) aligned based;
53
54 dcl file fixed bin static init (0) options (constant);
55 dcl seg fixed bin static init (1) options (constant);
56
57 dcl error_table_$noentry fixed bin (35) ext static;
58 dcl error_table_$segknown fixed bin (35) ext static;
59 dcl error_table_$clnzero fixed bin (35) ext static;
60 dcl error_table_$no_s_permission fixed bin (35) ext static;
61 dcl error_table_$no_move fixed bin (35) external;
62
63 dcl append$branch entry (char (*), char (*), fixed bin (5), fixed bin (35));
64 dcl fs_get$path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
65 dcl status_$get_max_length_ptr entry (ptr, fixed bin (19), fixed bin (35));
66 dcl initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
67 dcl status_$long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
68 dcl terminate_$noname entry (ptr, fixed bin (35));
69 dcl truncate$trseg entry (ptr, fixed bin, fixed bin (35));
70 dcl quota$check_file entry (char (*), char (*), fixed bin, fixed bin (35));
71 dcl set$max_length_path entry (char (*), char (*), fixed bin (19), fixed bin (35));
72
73 dcl (addr, bit, fixed, null) builtin;
74
75 dcl 1 lbranch aligned,
76 (2 (type bit (2), nnames bit (16), nrp bit (18)),
77 2 dtm bit (36),
78 2 dtu bit (36),
79 2 (mode bit (5), pad1 bit (13), records bit (18)),
80 2 dtd bit (36),
81 2 dtem bit (36),
82 2 acct bit (36),
83 2 (curlen bit (12), bitcnt bit (24)),
84 2 (did bit (4), mdid bit (4), copysw bit (1), pad3 bit (9), rbs (0:2) bit (6)),
85 2 uid bit (36)) unaligned;
86
87 %page;
88 entry_point = file;
89 dirname_from = a_dirname_from;
90 ename_from = a_ename_from;
91 dirname_to = a_dirname_to;
92 ename_to = a_ename_to;
93 options = bit (a_sw, 2);
94 created_seg = "0"b;
95 code, tcode = 0;
96
97 call initiate (dirname_from, ename_from, "", 0, 0, ptr_from, code);
98
99
100 if code ^= 0 then if code ^= error_table_$segknown then go to fin0;
101
102 try2: call initiate (dirname_to, ename_to, "", 0, 0, ptr_to, code);
103
104
105 if code ^= 0 then if code ^= error_table_$segknown then do;
106
107 if created_seg then do;
108 if code = 0 then code = error_table_$no_move;
109 go to fin1;
110 end;
111 if code = error_table_$noentry then do;
112 if append_sw then do;
113 created_seg = "1"b;
114 call status_$get_max_length_ptr (ptr_from, max_length, code);
115 if code ^= 0 then go to fin1;
116 call append$branch (dirname_to, ename_to, 01011b, code);
117 if code ^= 0 then go to fin1;
118 call set$max_length_path (dirname_to, ename_to, max_length, code);
119 if code = 0 then go to try2;
120 end;
121 end;
122 go to fin1;
123 end;
124 go to common;
125
126 fseg: entry (a_ptr_from, a_ptr_to, a_sw, a_code);
127
128 dcl (a_ptr_from, a_ptr_to) ptr;
129
130 entry_point = seg;
131 ptr_from = a_ptr_from;
132 ptr_to = a_ptr_to;
133 options = bit (a_sw, 2);
134 code, tcode = 0;
135
136 call fs_get$path_name (ptr_from, dirname_from, ldirname_from, ename_from, code);
137
138
139 if code ^= 0 then go to fin0;
140
141 call fs_get$path_name (ptr_to, dirname_to, ldirname_to, ename_to, code);
142
143
144 if code ^= 0 then go to fin0;
145
146 common:
147 dptr = addr (lbranch);
148
149 call status_$long (dirname_to, ename_to, 1, dptr, null, code);
150
151
152 if code ^= 0 then
153 if code = error_table_$no_s_permission then code = 0;
154 else go to fin2;
155 target_len = lbranch.curlen;
156
157 if lbranch.type ^= "01"b then do;
158 badmove: code = error_table_$no_move;
159 go to fin2;
160 end;
161
162 if (lbranch.mode & "01010"b) ^= "01010"b then go to badmove;
163
164 call status_$long (dirname_from, ename_from, 1, dptr, null, code);
165
166
167 if code ^= 0 then
168 if code = error_table_$no_s_permission then code = 0;
169 else go to fin2;
170
171 if lbranch.type ^= "01"b then go to badmove;
172
173 if (lbranch.mode & "01000"b) = "0"b then go to badmove;
174
175 curlen = fixed (lbranch.curlen, 12);
176 words = curlen * 1024;
177
178 call status_$get_max_length_ptr (ptr_to, max_length, code);
179 if code ^= 0 then go to badmove;
180 if words > max_length then go to badmove;
181
182 call quota$check_file (dirname_to, ename_to, curlen, code);
183
184
185 if code ^= 0 then go to badmove;
186
187 if target_len then
188 if truncate_sw then do;
189 call truncate$trseg (ptr_to, 0, code);
190 if code ^= 0 then go to fin2;
191 end;
192 else do;
193 code = error_table_$clnzero;
194 go to fin2;
195 end;
196
197 ptr_to -> copy = ptr_from -> copy;
198
199 call truncate$trseg (ptr_from, 0, code);
200
201 fin2: if entry_point = seg then go to fin0;
202 call terminate_$noname (ptr_to, tcode);
203 if tcode ^= 0 then go to fin0;
204 fin1: if entry_point = seg then go to fin0;
205 call terminate_$noname (ptr_from, tcode);
206
207 fin0: if tcode ^= 0 then a_code = tcode;
208 else a_code = code;
209
210 return;
211
212 end;