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 vacate_pv: proc (a_pvtx, a_pvid, a_code);
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 dcl a_code fixed bin (35);
44 dcl a_dirname char (*);
45 dcl a_ename char (*);
46 dcl a_pvid bit (36) aligned;
47 dcl a_pvtx fixed bin;
48 dcl a_segptr ptr;
49
50
51
52 dcl error_table_$argerr fixed bin (35) ext;
53 dcl error_table_$bad_index fixed bin (33) ext;
54 dcl error_table_$segknown fixed bin (35) ext;
55 dcl pvt$n_entries fixed bin ext;
56
57
58
59 dcl called_find bit (1) aligned init ("0"b);
60 dcl code fixed bin (35);
61 dcl dir char (168);
62 dcl dp ptr;
63 dcl ent char (32);
64 dcl 1 mkinf aligned like makeknown_info;
65 dcl pvid bit (36) aligned;
66 dcl pvtx fixed bin;
67 dcl segno fixed bin;
68 dcl segptr ptr;
69
70
71
72 dcl activate entry (ptr, fixed bin (35)) returns (ptr);
73 dcl lock$dir_unlock entry (ptr);
74 dcl makeknown_ entry (ptr, fixed bin, fixed bin, fixed bin (35));
75 dcl makeunknown_ entry (fixed bin, bit (36) aligned, bit (1) aligned, fixed bin (35));
76 dcl segment_mover$demand_segmove entry (ptr, ptr, fixed bin, fixed bin (35));
77
78
79
80 dcl (addr, ptr, unspec) builtin;
81 %page;
82
83
84
85 pvtx = a_pvtx;
86 pvt_arrayp = addr (pvt$array);
87 pvid = a_pvid;
88 code = 0;
89 if pvtx <= 0 | pvtx > pvt$n_entries then do;
90 a_code = error_table_$bad_index;
91 return;
92 end;
93 pvtep = addr (pvt_array (pvtx));
94
95 if pvte.being_demounted | (pvte.pvid ^= pvid) then
96 code = error_table_$argerr;
97 else if pvte.storage_system & pvte.used & pvid = pvte.pvid then
98 pvte.vacating = "1"b;
99 else code = error_table_$argerr;
100
101 a_code = code;
102 return;
103
104 stop_vacate: entry (a_pvtx, a_pvid, a_code);
105
106 pvt_arrayp = addr (pvt$array);
107 pvid = a_pvid;
108 pvtx = a_pvtx;
109 code = 0;
110 if pvtx <= 0 | pvtx > pvt$n_entries then do;
111 a_code = error_table_$bad_index;
112 return;
113 end;
114 pvtep = addr (pvt_array (pvtx));
115 if pvte.used & pvte.storage_system & pvte.vacating & (pvte.pvid = pvid) then
116 pvte.vacating = "0"b;
117 else code = error_table_$argerr;
118 a_code = code;
119 return;
120 %page;
121 move_seg_file: entry (a_dirname, a_ename, a_code);
122
123
124
125 dir = a_dirname;
126 ent = a_ename;
127 code = 0;
128
129 call dc_find$obj_status_write_priv (dir, ent, DC_FIND_CHASE, FS_OBJ_SEG_MOVE, ep, code);
130 if code ^= 0 then go to finale;
131 called_find = "1"b;
132 go to join;
133
134 move_seg_seg: entry (a_segptr, a_code);
135
136 segptr = a_segptr;
137 code = 0;
138 call dc_find$obj_status_write_priv_ptr (segptr, FS_OBJ_SEG_MOVE, ep, code);
139 if code ^= 0 then go to finale;
140
141 join: dp = ptr (ep, 0);
142
143 makeknown_infop = addr (mkinf);
144 unspec (makeknown_info) = ""b;
145 makeknown_info.uid = entry.uid;
146 makeknown_info.dirsw = entry.dirsw;
147 makeknown_info.entryp = ep;
148 call makeknown_ (makeknown_infop, segno, (0), code);
149 if code = 0 | code = error_table_$segknown then do;
150 astep = activate (ep, code);
151
152 if code = 0 then do;
153 aste.pack_ovfl = "1"b;
154 call segment_mover$demand_segmove (astep, ep, segno, code);
155 end;
156 call makeunknown_ (segno, "0"b, ("0"b), (0));
157 end;
158 if called_find then call dc_find$finished (dp, "1"b);
159 else call lock$dir_unlock (dp);
160 finale: a_code = code;
161 return;
162 %page; %include aste;
163 %page; %include dc_find_dcls;
164 %page; %include dir_entry;
165 %page; %include fs_obj_access_codes;
166 %page; %include makeknown_info;
167 %page; %include pvte;
168 end;