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 restart:
28 proc (iocb_ptr, code);
29 indx_cb_ptr = open_data_ptr;
30 f_b_ptr = file_base_ptr;
31 fs_ptr = file_state_ptr;
32 call save_restart_proc_info;
33 on cleanup
34 call restore_restart_proc_info;
35 indx_cb.mode = 10;
36 indx_cb.min_res = saved_min_res;
37 indx_cb.min_cap = saved_min_cap;
38 indx_cb.outside_index = file_base.out_of_index;
39 indx_cb.current_descrip = file_base.old_record_designator;
40 indx_cb.stat = file_base.was_stat;
41 indx_cb.trans = "0"b;
42 repeating = "1"b;
43 indx_cb.shared = "0"b;
44 indx_cb.subset_selected = "00"b;
45 indx_cb.current_record_is_valid = "1"b;
46 pos_incorrect = "0"b;
47 indx_cb.dup_ok = "1"b;
48 indx_cb.next_record_position = 1;
49 if (file_action = adjust_action) | (file_action = rollback_action)
50 then do;
51 if ^((file_action = rollback_action) & (file_base.old_prev_mod = -3) & (file_base.old_ref_count <= 0))
52
53 then call lock_record (file_base.old_record_designator);
54 call open_indx_file$adjust_record (iocb_ptr, file_base.old_record_designator, 0, code);
55 end;
56 else if file_action = replace_action
57 then call restart_replacement;
58 else if file_action = reassigning_key
59 then call restart_reassignment;
60 else do;
61 call restore_old_proc_info;
62 if file_action = insert_action
63 then call restart_insertion;
64 else if file_action = delete_action
65 then do;
66 if file_base.was_stat
67 & (file_base.is_partial_deletion | (file_base.old_modifier > 0)
68 | (file_base.old_ref_count > fixed (^file_base.out_of_index)))
69
70
71 then call lock_record (file_base.old_record_designator);
72
73 call open_indx_file$delete_indx_file (iocb_ptr, code);
74 end;
75 else if file_action = adding_key
76 then call restart_add_key;
77 else if file_action = deleting_key
78 then do;
79 indx_cb.outside_index = "0"b;
80 if file_base.was_stat
81 then call lock_record (file_base.old_record_designator);
82 call open_indx_file$control_indx_file (iocb_ptr, "delete_key", null, code);
83 end;
84 else if file_action = adding_record
85 then call restart_rs_create;
86 else if file_action = bumping_count
87 then do;
88 file_base.change_count = file_base.old_file_ch_count + 1;
89 file_action = 0;
90 end;
91 else code = error_table_$bad_file;
92 end;
93 call restore_restart_proc_info;
94 if indx_cb.file_state_ptr -> file_action = 0
95 then code = 0;
96 else if code = 0
97 then code = error_table_$bad_file;
98 return;
99
100 save_restart_proc_info:
101 proc;
102 saved_state = indx_cb.state_vars;
103 saved_subset_selected = indx_cb.subset_selected;
104 was_ks_out = is_ks_out;
105 my_min_res = indx_cb.min_res;
106 my_min_cap = indx_cb.min_cap;
107 was_stat = indx_cb.stat;
108 was_dup_ok = indx_cb.dup_ok;
109 was_trans = indx_cb.trans;
110 old_mode = indx_cb.mode;
111 return;
112
113 restore_restart_proc_info:
114 entry;
115 indx_cb.state_vars = saved_state;
116 indx_cb.subset_selected = saved_subset_selected;
117 repeating = "0"b;
118 is_ks_out = was_ks_out;
119 indx_cb.min_res = my_min_res;
120 indx_cb.min_cap = my_min_cap;
121 file_base.max_comp_num = true_max_comp_num;
122 indx_cb.pos_incorrect = "1"b;
123 indx_cb.stat = was_stat;
124 indx_cb.dup_ok = was_dup_ok;
125 indx_cb.trans = was_trans;
126 indx_cb.mode = old_mode;
127 end save_restart_proc_info;
128
129 restore_old_proc_info:
130 proc;
131 if ^(indx_cb.outside_index & ((file_action = delete_action) | (file_action = adding_record)))
132 then do;
133 is_ptr = index_state_ptr;
134 p = root_position_ptr;
135 file_position_ptr = p;
136 change_position_ptr = p;
137
138 do i = 1 to index_height;
139 p = p -> son_position_ptr;
140 p -> node = saved_node (i);
141 p -> branch_num = saved_branch_num (i);
142 p -> node_ptr = get_ptr (p -> node);
143 if p -> node = current_node
144 then file_position_ptr = p;
145 if p -> node = change_node
146 then change_position_ptr = p;
147 end;
148
149 end;
150 is_ks_out = saved_ks_out;
151 indx_cb.ready_to_write = "1"b;
152 dcl p ptr;
153 dcl i fixed;
154 end restore_old_proc_info;
155
156 restart_add_key:
157 proc;
158 indx_cb.current_descrip = file_base.new_descriptor;
159 if file_base.was_stat
160 then call lock_record (indx_cb.current_descrip);
161 indx_cb.outside_index = "0"b;
162 string (ak_inf.flags) = "00"b;
163 call open_indx_file$control_indx_file (iocb_ptr, "add_key", addr (ak_inf), code);
164 end restart_add_key;
165
166 restart_rs_create:
167 proc;
168 if file_base.out_of_index
169 then do;
170 if file_substate = 0
171 then indx_cb.repeating = "0"b;
172 else indx_cb.next_substate = 0;
173 call change_record_list (iocb_ptr, allocate_action, null, abort_exit);
174 file_base.old_record_designator = file_base.new_descriptor;
175 file_base.old_ref_count = 0;
176 file_base.change_count = file_base.old_file_ch_count + 1;
177 call change_record_list (iocb_ptr, delete_action, null, abort_exit);
178 file_action = 0;
179 return;
180 end;
181 if file_base.was_stat
182 then call lock_record (file_base.new_descriptor);
183 rs_inf.record_length = new_record_length;
184 rs_inf.max_rec_len = saved_min_cap;
185 unspec (rs_inf.flags) = "0"b;
186 rs_inf.inc_ref_count = (file_base.was_stat & (file_base.old_ref_count = 2));
187 rs_inf.create_sw = "1"b;
188 rs_inf.locate_sw = out_of_index;
189 rs_inf.version = rs_info_version_2;
190 call open_indx_file$control_indx_file (iocb_ptr, "record_status", addr (rs_inf), code);
191 end restart_rs_create;
192
193 restart_replacement:
194 proc;
195 call reinit_rewrite_proc;
196 if ^file_base.was_stat
197 then do;
198 old_rec_ptr = get_rec_ptr (old_record_designator);
199 if (fixed (old_rec_des.offset) + 2 + divide (new_record_length + 3, 4, 21, 0)) > max_seg_limit
200 then new_rec_ptr = file_base_ptr;
201 else new_rec_ptr = old_rec_ptr;
202 if ((old_record_length ^= new_record_length) | (file_substate > 1)
203 | (old_record_designator ^= new_descriptor)) & (new_record_length > 0)
204 then if ^indx_cb.outside_index
205 then call sub_err_ (0, "vfile_", "c", null, code, "Record contents may be incorrect for key: ^a",
206 substr (keys, key_pos (branch_num), key_length (branch_num)));
207 else call sub_err_ (0, "vfile_", "c", null, code,
208 "Record contents may be incorrect for record with descriptor: ^o", old_record_designator);
209 end;
210 else do;
211 call lock_record (file_base.old_record_designator);
212 if file_base.change_count = file_base.old_file_ch_count
213
214 then do;
215 if file_base.new_record_length + indx_cb.min_res + indx_cb.min_cap > 0
216 then do;
217 if file_substate = 1
218 then indx_cb.repeating = "0"b;
219 else indx_cb.next_substate = 1;
220 call change_record_list (iocb_ptr, allocate_action, f_b_ptr, abort_exit);
221 call change_record_list (iocb_ptr, free_action, null, abort_exit);
222 end;
223 block_ptr -> stat_block.lock_flag = "0"b;
224 block_ptr -> stat_structure.modifier = -1;
225 file_action = bumping_count;
226 file_base.change_count = file_base.old_file_ch_count + 1;
227 file_action = 0;
228
229 block_ptr = get_pointer (file_base.old_record_designator);
230 block_ptr -> stat_block.modifier = 0;
231 if stacq (block_ptr -> stat_block.record_lock, "0"b, indx_cb.saved_lock_copy)
232
233 then ;
234 return;
235 end;
236 else if file_base.new_descriptor > 0
237 then new_rec_ptr = get_rec_ptr (file_base.new_descriptor);
238 else new_rec_ptr = null;
239 end;
240 call open_indx_file$rewrite_indx_file (iocb_ptr, new_rec_ptr, new_record_length, code);
241 end restart_replacement;
242
243 reinit_rewrite_proc:
244 proc;
245 file_position_ptr = root_position_ptr -> son_position_ptr;
246 node = first_branch;
247 branch_num = count;
248 node_ptr = get_ptr (node);
249 end reinit_rewrite_proc;
250
251 restart_reassignment:
252 proc;
253 if file_base.was_stat
254 then do;
255 block_ptr = get_pointer (file_base.old_record_designator);
256 if block_ptr ^= null
257 then if block_ptr -> record_block_structure.stationary
258 then call lock_record (file_base.old_record_designator);
259 new_block_ptr = get_pointer (file_base.new_descriptor);
260 if new_block_ptr ^= null
261 then if new_block_ptr -> record_block_structure.stationary
262 then call lock_record (file_base.new_descriptor);
263 end;
264 indx_cb.outside_index = "0"b;
265 string (rk_inf.flags) = "001"b;
266 rk_inf.new_descrip = file_base.new_descriptor;
267 call reinit_rewrite_proc;
268 call open_indx_file$control_indx_file (iocb_ptr, "reassign_key", addr (rk_inf), code);
269 end restart_reassignment;
270
271 restart_insertion:
272 proc;
273 if file_base.change_count = file_base.old_file_ch_count
274
275 then do;
276 if file_base.was_stat
277 | (file_base.new_record_length + file_base.saved_min_cap + file_base.saved_min_res > 0)
278
279 then do;
280 if file_substate = 1
281 then indx_cb.repeating = "0"b;
282 else indx_cb.next_substate = 1;
283
284 call change_record_list (iocb_ptr, insert_action, null, abort_exit);
285 file_base.old_record_designator = file_base.new_descriptor;
286 file_base.out_of_index = "0"b;
287 file_base.is_partial_deletion = "0"b;
288 call change_record_list (iocb_ptr, delete_action, null, abort_exit);
289 end;
290 file_action = bumping_count;
291 file_base.change_count = file_base.old_file_ch_count + 1;
292 file_action = 0;
293 return;
294 end;
295 if file_base.new_descriptor <= 0
296 then new_rec_ptr = null;
297 else do;
298 new_rec_ptr = get_rec_ptr (file_base.new_descriptor);
299 if file_base.was_stat
300 then new_rec_ptr = addrel (new_rec_ptr, 6);
301
302 end;
303 call open_indx_file$write_indx_file (iocb_ptr, new_rec_ptr, new_record_length, code);
304 end restart_insertion;
305
306 get_ptr:
307 proc (designator_arg) returns (ptr);
308 return (addr (seg_ptr_array (des_arg.comp_num) -> seg_array (fixed (des_arg.offset))));
309 dcl designator_arg fixed (35);
310 dcl 1 des_arg like designator_struct aligned based (addr (designator_arg));
311 end;
312
313 get_rec_ptr:
314 proc (designator_arg) returns (ptr);
315 return (addrel (get_pointer (designator_arg), 2));
316 dcl designator_arg fixed (35);
317 end get_rec_ptr;
318
319 get_pointer:
320 proc (designator_arg) returns (ptr);
321 return (addr (get_seg_ptr (iocb_ptr, (des_arg.comp_num)) -> seg_array (fixed (des_arg.offset))));
322 dcl designator_arg fixed (35);
323 dcl 1 des_arg like designator_struct aligned based (addr (designator_arg));
324 end get_pointer;
325
326 lock_record:
327 proc (designator_arg);
328 if designator_arg <= 0
329 then return;
330 blockp = get_pointer (designator_arg);
331 if blockp = null
332 then return;
333 call set_lock_$lock (blockp -> stat_structure.record_lock, 0, code);
334 if (code = 0) | (code = error_table_$invalid_lock_reset) | (code = error_table_$locked_by_this_process)
335 then do;
336 code = 0;
337 return;
338 end;
339 if file_action = reassigning_key
340 then if block_ptr ^= null
341 then if block_ptr -> record_block_structure.stationary
342 then if stacq (block_ptr -> stat_structure.record_lock, (36)"1"b, indx_cb.saved_lock_copy)
343 then ;
344 code = error_table_$file_busy;
345 call restore_restart_proc_info;
346 go to exit;
347 dcl designator_arg fixed (35);
348 dcl blockp ptr;
349 end lock_record;
350
351 abort_exit:
352 code = error_table_$file_is_full;
353 call restore_restart_proc_info;
354 if (file_action ^= replace_action)
355 then return;
356 block_ptr = get_pointer (file_base.old_record_designator);
357 if stacq (block_ptr -> stat_block.record_lock, (36)"1"b, indx_cb.saved_lock_copy)
358 then ;
359 exit:
360 return;
361
362 dcl current_program_version
363 static options (constant) internal fixed init (31);
364 dcl block_ptr ptr;
365 dcl new_block_ptr ptr;
366 dcl 1 stat_block based (block_ptr),
367 2 pad bit (22) unal,
368 2 lock_flag bit (1) unal,
369 2 pad2 bit (13) unal,
370 2 word,
371 2 record_lock bit (36) aligned,
372 2 modifier fixed (35);
373 %include rs_info;
374 %include ak_info;
375 dcl 1 rk_inf,
376 2 header like rk_header;
377 dcl 1 ak_inf based (addr (rk_inf)),
378 2 header like ak_header;
379 dcl 1 rs_inf like rs_info;
380 dcl sub_err_ entry options (variable);
381 %include vfile_error_codes;
382 dcl pos_ptr ptr defined (file_position_ptr);
383 dcl code fixed (35);
384 dcl iocb_ptr ptr;
385 dcl open_indx_file$rewrite_indx_file
386 entry (ptr, ptr, fixed (21), fixed (35));
387 dcl open_indx_file$adjust_record
388 entry (ptr, fixed (35), fixed (35), fixed (35));
389 dcl open_indx_file$write_indx_file
390 entry (ptr, ptr, fixed (21), fixed (35));
391 dcl open_indx_file$delete_indx_file
392 entry (ptr, fixed (35));
393 dcl open_indx_file$control_indx_file
394 entry (ptr, char (*), ptr, fixed (35));
395 dcl (old_rec_ptr, new_rec_ptr)
396 ptr;
397 dcl 1 old_rec_des like designator_struct aligned based (addr (old_record_designator));
398 dcl was_ks_out bit (1) aligned;
399 dcl saved_subset_selected bit (2) aligned;
400 dcl my_min_res fixed (21);
401 dcl my_min_cap fixed (19);
402 dcl was_stat bit (1) aligned;
403 dcl was_dup_ok bit (1) aligned;
404 dcl was_trans bit (1) aligned;
405 dcl 1 saved_state like indx_cb.state_vars;
406 dcl old_mode fixed;
407 %include iocbv;
408 %include vfile_indx;
409 dcl cleanup condition;
410 dcl set_lock_$lock entry (bit (36) aligned, fixed, fixed (35));
411 dcl (addrel, stacq, string) builtin;
412
413 end restart;