1
2
3
4
5
6
7
8
9
10
11 change_index:
12 proc (iocb_ptr, abort_exit);
13 indx_cb_ptr = iocb_ptr -> iocb.open_data_ptr;
14 f_b_ptr = file_base_ptr;
15 fs_ptr = indx_cb.file_state_ptr;
16 is_ptr = indx_cb.index_state_ptr;
17 call initialize_substate;
18 do while (index_action ^= 0);
19 pos_ptr = change_position_ptr;
20 call prepare_next_state;
21 call save_node_head;
22 if index_action = insert_action
23 then do;
24 if last_branch_num = 1
25 then call insert_at_root;
26 else do;
27 call set_new_cont_space;
28 space = scat_space + new_cont_space;
29 if space < 0
30 then call overflow;
31 else do;
32 call simple_insert (branch_num);
33 call adjust_branch_num;
34 end;
35 end;
36 end;
37 else do;
38 call set_old_key_info;
39 if index_action = delete_action
40 then do;
41 call simple_delete;
42 space = cont_space (node_ptr) + scat_space;
43 if space > half_node_length
44 then call underflow;
45 else call adjust_branch_num;
46 end;
47 else do;
48 x = old_key_length - new_key_length;
49 if x = 0
50 then do;
51 record_designator (branch_num) = new_record_designator;
52
53 substr (keys, key_pos (branch_num), new_key_length) =
54 substr (new_key_string, 1, new_key_length);
55 call adjust_branch_num;
56 end;
57 else do;
58 y = cont_space (node_ptr);
59 space = y + scat_space + x;
60 if space >= 0
61 then do;
62 call replace_key;
63 if space > half_node_length
64 then call underflow;
65 else call adjust_branch_num;
66 end;
67 else do;
68 call set_new_branch;
69 call simple_delete;
70 call overflow;
71 end;
72 end;
73 end;
74 end;
75 call switch_index_state;
76 end;
77 return;
78
79 prepare_next_state:
80 proc;
81 a_s_ptr = addr (index_state_blocks (1 - index_state));
82 a_s_ptr -> index_action = 0;
83 a_s_ptr -> index_substate = 0;
84 a_s_ptr -> branch_num_adjust = 0;
85 a_s_ptr -> index_height = index_height;
86 a_s_ptr -> current_node = file_position_ptr -> node;
87 a_s_ptr -> number_of_nodes = number_of_nodes;
88 a_s_ptr -> index_tail_comp_num = index_tail_comp_num;
89 a_s_ptr -> free_node_designator = free_node_designator;
90 end prepare_next_state;
91
92 initialize_substate:
93 proc;
94 if repeating
95 then do;
96 if index_substate = 0
97 then repeating = "0"b;
98 else next_substate = 0;
99 return;
100 end;
101 branch_num_adjust = 0;
102 index_substate = 0;
103 file_substate = file_substate + 1;
104 end initialize_substate;
105
106 save_node_head:
107 proc;
108 if repeating
109 then do;
110 call check_index_substate;
111 last_branch_num = old_last_branch_num;
112 low_key_pos = old_low_key_pos;
113 scat_space = old_scat_space;
114 return;
115 end;
116 old_last_branch_num = last_branch_num;
117 old_low_key_pos = low_key_pos;
118 old_scat_space = scat_space;
119 index_substate = index_substate + 1;
120 end save_node_head;
121
122 switch_index_state:
123 proc;
124 if a_s_ptr -> index_action = 0
125 then if new_desc_val = 0
126 then go to switch;
127 change_position_ptr = parent_position_ptr;
128 a_s_ptr -> change_node = node;
129 call save_position_stack;
130 switch:
131 index_state = 1 - index_state;
132 index_state_ptr = a_s_ptr;
133 is_ptr = index_state_ptr;
134 return;
135
136 save_position_stack:
137 proc;
138 p = root_position_ptr;
139
140 do i = 1 to a_s_ptr -> index_height;
141 p = p -> son_position_ptr;
142 a_s_ptr -> saved_node (i) = p -> node;
143 a_s_ptr -> saved_branch_num (i) = p -> branch_num;
144 end;
145
146 dcl p ptr;
147 dcl i fixed;
148 end save_position_stack;
149
150 end switch_index_state;
151
152 simple_insert:
153 proc (b_num);
154 if new_cont_space < 0
155 then call compact_node (node_ptr);
156 if b_num < last_branch_num
157 then call move_bytes (node_ptr, 5 + bd_len * b_num, bd_len, bd_len * (last_branch_num - b_num));
158 call insert_key (b_num);
159 last_branch_num = last_branch_num + 1;
160 branch (b_num + 1) = new_branch;
161 return;
162 dcl i fixed;
163 dcl b_num fixed;
164 end;
165
166 insert_key:
167 proc (br_num);
168 low_key_pos = low_key_pos - new_key_length;
169 if repeating
170 then do;
171 call check_index_substate;
172 return;
173 end;
174 record_designator (br_num) = new_record_designator;
175
176 key_length (br_num) = new_key_length;
177 key_pos (br_num) = low_key_pos;
178 substr (keys, low_key_pos, new_key_length) = substr (new_key_string, 1, new_key_length);
179 index_substate = index_substate + 1;
180 dcl br_num fixed;
181 end insert_key;
182
183 simple_delete:
184 proc;
185 call free_key_space;
186 last_branch_num = last_branch_num - 1;
187 if branch_num < last_branch_num
188 then call move_bytes (node_ptr, 5 + bd_len * (branch_num + 1), -bd_len, bd_len * (last_branch_num - branch_num));
189 return;
190
191 dcl len fixed;
192 end;
193
194 adjust_branch_num:
195 proc;
196 branch_num = branch_num + branch_num_adjust;
197 end;
198
199 move_bytes:
200 proc (np, source_offset, displacement, n_bytes);
201 dest_offset = source_offset + displacement;
202 call save_new_string;
203 call set_new_string;
204 return;
205
206 save_new_string:
207 proc;
208 if repeating
209 then do;
210 call check_index_substate;
211 return;
212 end;
213 substr (spare_node, dest_offset, n_bytes) = substr (np -> keys, source_offset, n_bytes);
214 index_substate = index_substate + 1;
215 end;
216
217 set_new_string:
218 proc;
219 if repeating
220 then do;
221 call check_index_substate;
222 return;
223 end;
224 substr (np -> keys, dest_offset, n_bytes) = substr (spare_node, dest_offset, n_bytes);
225 index_substate = index_substate + 1;
226 end;
227
228 dcl np ptr;
229 dcl (source_offset, displacement, n_bytes, dest_offset)
230 fixed;
231 end move_bytes;
232
233 set_new_branch:
234 proc;
235 if repeating
236 then do;
237 call check_index_substate;
238 return;
239 end;
240 new_branch = branch (branch_num + 1);
241 index_substate = index_substate + 1;
242 end;
243
244 set_old_key_info:
245 proc;
246 if repeating
247 then do;
248 call check_index_substate;
249 return;
250 end;
251 old_key_pos = key_pos (branch_num);
252 old_key_length = key_length (branch_num);
253 index_substate = index_substate + 1;
254 end;
255
256 free_key_space:
257 proc;
258 if old_key_pos = low_key_pos
259 then low_key_pos = low_key_pos + old_key_length;
260 else scat_space = scat_space + old_key_length;
261 end;
262
263 replace_key:
264 proc;
265 call free_key_space;
266 if new_key_length > y
267 then do;
268 call zero_key;
269 call compact_node (node_ptr);
270 end;
271 call insert_key (branch_num);
272 return;
273
274 zero_key:
275 proc;
276 if repeating
277 then do;
278 call check_index_substate;
279 return;
280 end;
281 key_length (branch_num) = 0;
282 index_substate = index_substate + 1;
283 end zero_key;
284
285 end replace_key;
286
287 compact_node:
288 proc (n_ptr);
289 np = n_ptr;
290 call make_compact_copy;
291 call set_compacted_node;
292 np -> low_key_pos = new_low_key_pos;
293 np -> scat_space = 0;
294 return;
295
296 make_compact_copy:
297 proc;
298 if repeating
299 then do;
300 call check_index_substate;
301 return;
302 end;
303 n_keys = np -> last_branch_num - 1;
304 len = n_keys * bd_len + node_head_length;
305 substr (spare_node, 1, len) = substr (np -> keys, 1, len);
306 k = node_length + 1;
307
308 do i = 1 to n_keys;
309 m = np -> key_length (i);
310 if m > 0
311 then do;
312 k = k - m;
313 substr (spare_node, k, m) = substr (np -> keys, np -> key_pos (i), m);
314 addr (spare_node) -> key_pos (i) = k;
315 end;
316 end;
317
318 new_low_key_pos = k;
319 index_substate = index_substate + 1;
320 dcl (n_keys, len) fixed;
321 end make_compact_copy;
322
323 set_compacted_node:
324 proc;
325 if repeating
326 then do;
327 call check_index_substate;
328 return;
329 end;
330 substr (np -> keys, 1, node_length) = substr (spare_node, 1, node_length);
331 index_substate = index_substate + 1;
332 end;
333
334 dcl (np, n_ptr) ptr;
335 dcl (i, k, m) fixed;
336 end;
337
338 set_new_cont_space:
339 proc;
340 new_cont_space = cont_space (node_ptr) - new_key_length - bd_len;
341 end set_new_cont_space;
342
343 cont_space:
344 proc (np) returns (fixed);
345 return (np -> low_key_pos - 1 - node_head_length + bd_len - np -> last_branch_num * bd_len);
346 dcl np ptr;
347 end cont_space;
348
349 insert_at_root:
350 proc;
351 call extend_position_stack (indx_cb_ptr);
352 pos_ptr = change_position_ptr;
353 call create_node (node, node_ptr);
354 call set_first_branch;
355 only_branch_in_root = node;
356 a_s_ptr -> index_height = index_height + 1;
357 a_s_ptr -> current_node = file_position_ptr -> node;
358 old_index_height = a_s_ptr -> index_height;
359 branch_num = 1;
360 new_cont_space = 0;
361 call simple_insert (1);
362 call adjust_branch_num;
363 return;
364
365 set_first_branch:
366 proc;
367 if repeating
368 then do;
369 call check_index_substate;
370 return;
371 end;
372 branch (1) = only_branch_in_root;
373 index_substate = index_substate + 1;
374 end;
375 end;
376
377 overflow:
378 proc;
379 is_overflow = "1"b;
380 num_of_keys = last_branch_num;
381 call get_parent;
382 if is_ks_out
383 then do;
384 call split (num_of_keys - 1);
385 call adjust_position_right;
386 return;
387 end;
388 if p_b_num < p_n_ptr -> last_branch_num
389 then do;
390 call get_right_brother;
391 call rotate_right;
392 if first_count > 0
393 then do;
394 call adjust_position_right;
395 return;
396 end;
397 end;
398
399 if p_b_num > 1
400 then do;
401 call get_left_brother;
402 call rotate_left;
403 if second_count > 0
404 then do;
405 call adjust_position_left;
406 return;
407 end;
408 end;
409
410 call find_split_num;
411 call split (split_num);
412 call adjust_position_right;
413 return;
414
415 get_parent:
416 proc;
417 p_n_ptr = parent_position_ptr -> node_ptr;
418 p_b_num = parent_position_ptr -> branch_num;
419 end;
420
421 get_right_brother:
422 proc;
423 b_node = p_n_ptr -> branch (p_b_num + 1);
424 b_n_ptr = get_ptr (b_node);
425 call set_b_vars;
426 return;
427
428 get_left_brother:
429 entry;
430 p_b_num = p_b_num - 1;
431 b_node = p_n_ptr -> branch (p_b_num);
432 b_n_ptr = get_ptr (b_node);
433 call set_b_vars;
434 return;
435
436 set_b_vars:
437 proc;
438 if repeating
439 then do;
440 call check_index_substate;
441 return;
442 end;
443 b_space = cont_space (b_n_ptr) + b_n_ptr -> scat_space;
444 last_b_num = b_n_ptr -> last_branch_num;
445 index_substate = index_substate + 1;
446 end set_b_vars;
447
448 end get_right_brother;
449
450 find_split_num:
451 proc;
452 if repeating
453 then do;
454 call check_index_substate;
455 return;
456 end;
457 space = node_head_length;
458
459 do split_num = 1 repeat (split_num + 1) while (space < half_node_length);
460 space = space + bd_len + key_length (split_num);
461 end;
462
463 index_substate = index_substate + 1;
464 end find_split_num;
465
466 underflow:
467 entry;
468 is_overflow = "0"b;
469 call get_parent;
470 if p_b_num < p_n_ptr -> last_branch_num
471 then do;
472
473 call get_right_brother;
474 num_of_keys = last_b_num - 1;
475 dest_np = node_ptr;
476 if is_combination_possible ()
477 then call combine (node_ptr, b_n_ptr);
478 else call rotate_left;
479 call adjust_branch_num;
480 end;
481 else if p_b_num > 1
482 then do;
483 call get_left_brother;
484 num_of_keys = last_b_num - 1;
485 parent_position_ptr -> branch_num = p_b_num;
486 dest_np = b_n_ptr;
487 if is_combination_possible ()
488 then do;
489 call combine (b_n_ptr, node_ptr);
490 call set_node_to_brother;
491 branch_num = last_b_num + branch_num + branch_num_adjust;
492 end;
493 else do;
494 call rotate_right;
495 branch_num = branch_num + branch_num_adjust + count;
496 a_s_ptr -> branch_num_adjust = 1;
497 end;
498 end;
499 else
500 if last_branch_num = 1
501 then call underflow_to_root;
502 else call adjust_branch_num;
503 return;
504
505 underflow_to_root:
506 proc;
507 call set_root_branch;
508 call free_node (node, node_ptr);
509 a_s_ptr -> index_height = index_height - 1;
510 old_index_height = a_s_ptr -> index_height;
511 node_ptr = parent_position_ptr -> node_ptr;
512 node = parent_position_ptr -> node;
513 a_s_ptr -> current_node = file_position_ptr -> node;
514 branch_num = 1;
515 root_position_ptr = pos_ptr;
516 return;
517
518 set_root_branch:
519 proc;
520 if repeating
521 then do;
522 call check_index_substate;
523 return;
524 end;
525 only_branch_in_root = branch (1);
526 index_substate = index_substate + 1;
527 end;
528
529 end underflow_to_root;
530
531
532 dcl is_new_key bit (1) aligned;
533 dcl is_overflow bit (1) aligned;
534 dcl (p_n_ptr, b_n_ptr) ptr;
535 dcl b_node fixed (35);
536 dcl last_b_num_left fixed;
537 dcl p_b_num fixed;
538 dcl n_ptr ptr;
539 dcl (dest_np, np1, np2) ptr;
540 dcl i fixed;
541 dcl num_of_keys fixed;
542
543
544 get_key:
545 proc (i, p, k);
546
547
548 p = np1;
549 k = i;
550 if is_overflow
551 then if i >= branch_num
552 then if i = branch_num
553 then do;
554 p = addr (fake_node);
555 k = 1;
556 is_new_key = "1"b;
557 return;
558 end;
559 else k = k - 1;
560 is_new_key = "0"b;
561 return;
562
563 dcl i fixed;
564 dcl k fixed;
565 dcl p ptr;
566 end;
567
568 split:
569 proc (n);
570 count = num_of_keys - n + 1;
571 call create_node (b_node, b_n_ptr);
572 a_s_ptr -> new_branch = b_node;
573 a_s_ptr -> index_action = insert_action;
574 call set_nps;
575 call split_keys;
576 np2 -> last_branch_num = 0;
577 call finish_dest_node;
578 call finish_left_node;
579 return;
580
581 split_keys:
582 proc;
583 if repeating
584 then do;
585 call check_index_substate;
586 return;
587 end;
588 call get_key (n, p, k);
589 call set_upbound_key;
590 np2 -> branch (1) = first_branch;
591 call set_dest_node_info;
592 dest_b_num = num_of_keys - n;
593
594 do i = num_of_keys to n + 1 by -1;
595 call get_key (i, source_n_ptr, source_b_num);
596 call move_adjust;
597 dest_b_num = dest_b_num - 1;
598 end;
599
600 index_substate = index_substate + 1;
601 end split_keys;
602
603 dcl n fixed;
604 dcl b_num fixed;
605 dcl n_ptr ptr;
606 end;
607
608 move_adjust:
609 proc;
610 source_key_pos = source_n_ptr -> key_pos (source_b_num);
611 source_key_len = source_n_ptr -> key_length (source_b_num);
612 if source_key_pos > min_source_key_pos
613 then new_scat_space = new_scat_space + source_key_len;
614 else if ^is_new_key
615 then min_source_key_pos = min_source_key_pos + source_key_len;
616 move:
617 entry;
618 dest_bd_words = source_bd_words;
619 min_dest_key_pos = min_dest_key_pos - source_key_len;
620 dest_n_ptr -> key_pos (dest_b_num) = min_dest_key_pos;
621 substr (dest_n_ptr -> keys, min_dest_key_pos, source_key_len) =
622 substr (source_n_ptr -> keys, source_key_pos, source_key_len);
623 dcl source_bd_words (branch_and_descrip_size) based (addr (source_n_ptr -> descrip (source_b_num)))
624 fixed;
625 dcl dest_bd_words (branch_and_descrip_size) based (addr (dest_n_ptr -> descrip (dest_b_num))) fixed;
626 end move_adjust;
627
628 set_new_key_and_descrip:
629 proc (n_ptr, b_num);
630 a_s_ptr -> new_key_length = n_ptr -> key_length (b_num);
631 substr (a_s_ptr -> new_key_string, 1, a_s_ptr -> new_key_length) =
632 substr (n_ptr -> keys, n_ptr -> key_pos (b_num), a_s_ptr -> new_key_length);
633 a_s_ptr -> new_record_designator = n_ptr -> record_designator (b_num);
634 return;
635
636 dcl n_ptr ptr;
637 dcl b_num fixed;
638 end;
639
640 compact_if_nec:
641 proc;
642 b_n_ptr -> last_branch_num = last_b_num;
643 if must_compact_dest
644 then call compact_node (np2);
645 end;
646
647 rotate_right:
648 proc;
649 i = num_of_keys;
650 di = -1;
651 call compute_count;
652 call set_first_count;
653 if first_count ^= 0
654 then do;
655 a_s_ptr -> index_action = replace_action;
656 call compact_if_nec;
657 call move_bytes (np2, bd_len + 1, count * bd_len, bd_len * (np2 -> last_branch_num - 1) + 4);
658 call rotate_keys_right;
659 np2 -> branch (1) = first_branch;
660 call finish_dest_node;
661 call finish_left_node;
662 end;
663 return;
664
665 rotate_keys_right:
666 proc;
667 if repeating
668 then do;
669 call check_index_substate;
670 return;
671 end;
672 call set_dest_node_info;
673 dest_b_num = count;
674 call move_key_down;
675 np2 -> branch (count + 1) = np2 -> branch (1);
676 call get_key (num_of_keys + 1 - count, p, k);
677 call set_upbound_key;
678
679 do i = 1 to count - 1;
680 call get_key (num_of_keys + 1 - i, source_n_ptr, source_b_num);
681 dest_b_num = dest_b_num - 1;
682 call move_adjust;
683 end;
684
685 index_substate = index_substate + 1;
686 end rotate_keys_right;
687
688 set_first_count:
689 proc;
690 if repeating
691 then do;
692 call check_index_substate;
693 return;
694 end;
695 first_count = count;
696 index_substate = index_substate + 1;
697 end;
698
699 set_second_count:
700 proc;
701 if repeating
702 then do;
703 call check_index_substate;
704 return;
705 end;
706 second_count = count;
707 index_substate = index_substate + 1;
708 end;
709
710 rotate_left:
711 entry;
712 i = 1;
713 di = 1;
714 call compute_count;
715 call set_second_count;
716 if second_count ^= 0
717 then do;
718 a_s_ptr -> index_action = replace_action;
719 call compact_if_nec;
720 call rotate_keys_left;
721 np1 -> branch (1) = first_branch;
722 call finish_dest_node;
723 call finish_right_node;
724 end;
725 return;
726
727 rotate_keys_left:
728 proc;
729 if repeating
730 then do;
731 call check_index_substate;
732 return;
733 end;
734 call set_dest_node_info;
735 call move_key_down;
736 call get_key (count, p, k);
737 call set_upbound_key;
738
739 do i = 1 to count - 1;
740 call get_key (i, source_n_ptr, source_b_num);
741 dest_b_num = dest_b_num + 1;
742 call move_adjust;
743 end;
744
745 index_substate = index_substate + 1;
746 end rotate_keys_left;
747
748 dcl i fixed;
749 dcl di fixed;
750
751 compute_count:
752 proc;
753 call set_nps;
754 if repeating
755 then do;
756 call check_index_substate;
757 return;
758 end;
759 if is_overflow
760 then do;
761 x = space;
762 y = b_space;
763 end;
764 else do;
765 x = b_space;
766 y = space;
767 end;
768 dy = bd_len + p_n_ptr -> key_length (p_b_num);
769 count = 0;
770 call get_key (i, p, k);
771 dx = bd_len + p -> key_length (k);
772 do while (i > 0);
773 if dy > y
774 then i = 0;
775 else do;
776 count = count + 1;
777 y = y - dy;
778 x = x + dx;
779 if x >= y
780 then i = 0;
781 else do;
782 dy = dx;
783 i = i + di;
784 call get_key (i, p, k);
785 dx = bd_len + p -> key_length (k);
786 end;
787 end;
788 end;
789 if x < 0
790 then count = 0;
791 else if count > 0
792 then if y < np2 -> scat_space
793 then must_compact_dest = "1"b;
794 else must_compact_dest = "0"b;
795 index_substate = index_substate + 1;
796 return;
797
798 dcl (x, y) fixed;
799
800
801
802 dcl (dx, dy) fixed;
803 end;
804
805 end;
806
807 set_dest_node_info:
808 proc;
809 dest_n_ptr = np2;
810 dest_b_num = np2 -> last_branch_num;
811 min_dest_key_pos = np2 -> low_key_pos;
812 end;
813
814 move_key_down:
815 proc;
816 source_n_ptr = p_n_ptr;
817 source_b_num = p_b_num;
818 source_key_pos = source_n_ptr -> key_pos (source_b_num);
819 source_key_len = source_n_ptr -> key_length (source_b_num);
820 call move;
821 np2 -> branch (dest_b_num + 1) = np1 -> branch (1);
822 end move_key_down;
823
824 set_upbound_key:
825 proc;
826 call set_new_key_and_descrip (p, k);
827 first_branch = p -> branch (k + 1);
828 min_source_key_pos = np1 -> low_key_pos;
829 new_scat_space = np1 -> scat_space;
830 key_len = p -> key_length (k);
831 if p -> key_pos (k) > min_source_key_pos
832 then new_scat_space = new_scat_space + key_len;
833 else if ^is_new_key
834 then min_source_key_pos = min_source_key_pos + key_len;
835 dcl key_len fixed;
836 end;
837
838 finish_dest_node:
839 proc;
840 np2 -> low_key_pos = min_dest_key_pos;
841 np2 -> last_branch_num = np2 -> last_branch_num + count;
842 end;
843
844 set_nps:
845 proc;
846 if is_overflow
847 then do;
848 np1 = node_ptr;
849 np2 = b_n_ptr;
850 end;
851 else do;
852 np1 = b_n_ptr;
853 np2 = node_ptr;
854 end;
855 end set_nps;
856
857 finish_left_node:
858 proc;
859 call set_source_vars;
860 if is_overflow
861 then
862 if branch_num <= last_branch_num
863 then do;
864 call set_new_cont_space;
865 call simple_insert (branch_num);
866 end;
867 else
868 np1 -> last_branch_num = np1 -> last_branch_num + 1;
869 end;
870
871 finish_right_node:
872 proc;
873 call set_source_vars;
874 if is_overflow
875 then do;
876 if branch_num <= count
877 then do;
878 np1 -> last_branch_num = np1 -> last_branch_num + 1;
879 call left_shift (count - 1);
880 end;
881 else do;
882 call left_shift (count);
883 call set_new_cont_space;
884 call simple_insert (branch_num - count);
885 end;
886 end;
887 else
888 call left_shift (count);
889 end;
890
891 set_source_vars:
892 proc;
893 np1 -> last_branch_num = np1 -> last_branch_num - count;
894 np1 -> low_key_pos = min_source_key_pos;
895 np1 -> scat_space = new_scat_space;
896 end;
897
898 left_shift:
899 proc (n);
900 disp = n * bd_len;
901 call move_bytes (np1, 1 + node_head_length + disp, -disp, bd_len * (np1 -> last_branch_num - 1));
902 dcl (disp, n) fixed;
903 end;
904
905 is_combination_possible:
906 proc returns (bit (1));
907 spare_space = space + b_space + node_head_length - node_length - p_n_ptr -> key_length (p_b_num) - bd_len;
908 if spare_space >= 0
909 then do;
910 if spare_space < dest_np -> scat_space
911 then must_compact_dest = "1"b;
912 else must_compact_dest = "0"b;
913 return ("1"b);
914 end;
915 return ("0"b);
916 end is_combination_possible;
917
918 combine:
919 proc (n_ptr_1, n_ptr_2);
920
921 a_s_ptr -> index_action = delete_action;
922 np1 = n_ptr_2;
923 np2 = n_ptr_1;
924 call compact_if_nec;
925 call combine_keys;
926 call finish_dest_node;
927 call free_node (p_n_ptr -> branch (p_b_num + 1), np1);
928
929 return;
930
931 combine_keys:
932 proc;
933 if repeating
934 then do;
935 call check_index_substate;
936 return;
937 end;
938 call set_dest_node_info;
939 call move_key_down;
940 count = np1 -> last_branch_num;
941 source_n_ptr = np1;
942
943 do source_b_num = 1 to count - 1;
944 dest_b_num = dest_b_num + 1;
945 source_key_pos = source_n_ptr -> key_pos (source_b_num);
946 source_key_len = source_n_ptr -> key_length (source_b_num);
947 call move;
948 end;
949
950 index_substate = index_substate + 1;
951 end combine_keys;
952
953 dcl (n_ptr_1, n_ptr_2) ptr;
954 end;
955
956 adjust_position_right:
957 proc;
958 call adjust_branch_num;
959 if branch_num > last_branch_num
960 then do;
961 branch_num = branch_num - last_branch_num;
962 call set_node_to_brother;
963 a_s_ptr -> branch_num_adjust = 1;
964 end;
965 else if branch_num = last_branch_num
966 then if file_position_ptr = pos_ptr
967 then call set_current_node_to_parent;
968 return;
969 end;
970
971 adjust_position_left:
972 proc;
973 parent_position_ptr -> branch_num = p_b_num;
974 branch_num = branch_num + branch_num_adjust - count;
975 if branch_num = 0
976 then if file_position_ptr = pos_ptr
977 then do;
978 call set_current_node_to_parent;
979 return;
980 end;
981 if branch_num <= 0
982 then do;
983 call set_node_to_brother;
984 branch_num = last_branch_num + branch_num;
985 end;
986 else a_s_ptr -> branch_num_adjust = 1;
987 return;
988 end;
989
990 set_node_to_brother:
991 proc;
992 node = b_node;
993 node_ptr = b_n_ptr;
994 a_s_ptr -> current_node = file_position_ptr -> node;
995 end;
996
997 set_current_node_to_parent:
998 proc;
999 file_position_ptr = parent_position_ptr;
1000 a_s_ptr -> current_node = parent_position_ptr -> node;
1001 end;
1002
1003 dcl p ptr;
1004 dcl k fixed;
1005 end;
1006
1007 create_node:
1008 proc (designator, node_ptr_arg);
1009 a_s_ptr -> number_of_nodes = number_of_nodes + 1;
1010 free_node_ptr = get_ptr (free_node_designator);
1011 call save_create_free_info;
1012 if free_node_designator ^= 0
1013 then if old_number_of_free_nodes > 0
1014 then do;
1015 designator = nodes (old_number_of_free_nodes);
1016 number_of_free_nodes = old_number_of_free_nodes - 1;
1017 node_ptr_arg = get_ptr (designator);
1018 end;
1019 else do;
1020 designator = free_node_designator;
1021 node_ptr_arg = free_node_ptr;
1022 a_s_ptr -> free_node_designator = old_next_node_designator;
1023 end;
1024 else if old_seg_lim + node_size <= max_seg_limit
1025 then do;
1026 call make_designator (index_tail_comp_num, (old_seg_lim), designator);
1027 node_ptr_arg = get_ptr (designator);
1028 seg_limit (index_tail_comp_num) = old_seg_lim + node_size;
1029 end;
1030 else do;
1031 a_s_ptr -> index_tail_comp_num = new_index_comp_num;
1032 call get_new_seg (iocb_ptr, a_s_ptr -> index_tail_comp_num, node_ptr_arg, index_substate, abort_exit);
1033 comp_link (a_s_ptr -> index_tail_comp_num) = index_tail_comp_num;
1034 call make_designator (a_s_ptr -> index_tail_comp_num, 0, designator);
1035 seg_limit (a_s_ptr -> index_tail_comp_num) = node_size;
1036 end;
1037 node_ptr_arg -> last_branch_num = 1;
1038 node_ptr_arg -> low_key_pos = node_length + 1;
1039 node_ptr_arg -> scat_space = 0;
1040 return;
1041
1042 save_create_free_info:
1043 proc;
1044 if repeating
1045 then do;
1046 call check_index_substate;
1047 return;
1048 end;
1049 old_seg_lim = abs (seg_limit (index_tail_comp_num));
1050 old_number_of_free_nodes = number_of_free_nodes;
1051 old_next_node_designator = next_node_designator;
1052 new_index_comp_num = last_comp_num + 1;
1053 index_substate = index_substate + 1;
1054 end save_create_free_info;
1055
1056 free_node:
1057 entry (designator, node_ptr_arg);
1058 a_s_ptr -> number_of_nodes = number_of_nodes - 1;
1059 if free_node_designator ^= 0
1060 then do;
1061 free_node_ptr = get_ptr (free_node_designator);
1062 call save_create_free_info;
1063 if old_number_of_free_nodes < (node_size - 2)
1064 then do;
1065 number_of_free_nodes = old_number_of_free_nodes + 1;
1066 nodes (number_of_free_nodes) = designator;
1067 unspec (node_words) = "0"b;
1068 return;
1069 end;
1070 end;
1071 free_node_ptr = node_ptr_arg;
1072 number_of_free_nodes = 0;
1073 next_node_designator = free_node_designator;
1074 a_s_ptr -> free_node_designator = designator;
1075 return;
1076
1077 dcl 1 free_node based (free_node_ptr),
1078 2 number_of_free_nodes
1079 fixed,
1080 2 next_node_designator
1081 fixed (35),
1082 2 nodes (1 ) fixed (35);
1083 dcl designator fixed (35);
1084 dcl node_ptr_arg ptr;
1085 dcl node_words (node_size) fixed based (node_ptr_arg);
1086 dcl free_node_ptr ptr;
1087 end create_node;
1088
1089 check_index_substate:
1090 proc;
1091 next_substate = next_substate + 1;
1092 if index_substate = next_substate
1093 then repeating = "0"b;
1094 end check_index_substate;
1095
1096 get_ptr:
1097 proc (descriptor) returns (ptr);
1098 return (addr (seg_ptr_array (desc.comp_num) -> seg_array (fixed (desc.offset))));
1099 dcl descriptor fixed (35);
1100 dcl 1 desc like designator_struct aligned based (addr (descriptor));
1101 end get_ptr;
1102
1103
1104 dcl iocb_ptr ptr;
1105 dcl abort_exit label;
1106
1107
1108 dcl (source_n_ptr, dest_n_ptr)
1109 ptr;
1110 dcl (source_b_num, source_key_pos, source_key_len, dest_b_num)
1111 fixed;
1112 dcl pos_ptr ptr;
1113 dcl spare_space fixed;
1114 dcl new_cont_space fixed;
1115 dcl space fixed;
1116 dcl (x, y) fixed;
1117 dcl a_s_ptr ptr;
1118
1119
1120 dcl bd_len static options (constant) fixed init (12);
1121 dcl branch_and_descrip_size
1122 static options (constant) fixed init (3);
1123 dcl node_head_length static options (constant) fixed init (16);
1124
1125
1126 %include vfile_indx;
1127 %include iocbv;
1128 end change_index;