1 /* ***********************************************************
   2    *                                                         *
   3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4    *                                                         *
   5    * Copyright (c) 1972 by Massachusetts Institute of        *
   6    * Technology and Honeywell Information Systems, Inc.      *
   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);                     /* the change cycle */
  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;                                    /* end insert action */
  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;                          /* end delete action */
  47                          else do;                           /* replace action */
  48                                    x = old_key_length - new_key_length;
  49                                    if x = 0
  50                                    then do;
  51                                              record_designator (branch_num) = new_record_designator;
  52                                                             /* should use record_descrip, but compiler problems */
  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;       /* key will fit */
  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;       /* key won't fit, turn into overflow-insert */
  68                                                        call set_new_branch;
  69                                                        call simple_delete;
  70                                                        call overflow;
  71                                                   end;
  72                                         end;
  73                               end;                          /* end replace action */
  74                     end;
  75                call switch_index_state;
  76           end;                                              /* end change cycle */
  77           return;                                           /* end change_index routine */
  78 
  79 prepare_next_state:
  80      proc;                                                  /* sets up alternate index state variables */
  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;                                 /* don't alter permanent substate vars */
 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;                                          /* restore header variables */
 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                          /* not replacing non-leaf key */
 126                then go to switch;
 127           change_position_ptr = parent_position_ptr;        /* pop change position */
 128           a_s_ptr -> change_node = node;
 129           call save_position_stack;
 130 switch:
 131           index_state = 1 - index_state;                    /* switch states */
 132           index_state_ptr = a_s_ptr;
 133           is_ptr = index_state_ptr;
 134           return;                                           /* end of switch_state routine */
 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;                                                   /* end simple insert */
 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                                                             /* should use record_descrip, but compiler problems */
 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;                                                   /* end simple delete */
 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;                                           /* end move_bytes main routine */
 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;                                          /* make room for larger key */
 268                     call zero_key;
 269                     call compact_node (node_ptr);
 270                end;
 271           call insert_key (branch_num);
 272           return;                                           /* end of replace_key routine */
 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;                                           /* end of compaction routine */
 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;                                                   /* end compact node */
 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);         /* sets change position to new frame */
 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;                               /* avoids unnecessary compaction */
 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;                                                   /* end insert_at_root */
 376 
 377 overflow:
 378      proc;
 379           is_overflow = "1"b;
 380           num_of_keys = last_branch_num;                    /* num of keys in node + 1 for inserted key */
 381           call get_parent;
 382           if is_ks_out
 383           then do;                                          /* create right brother but don't balance */
 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;                                          /* try rotate right */
 390                     call get_right_brother;
 391                     call rotate_right;                      /* sets count */
 392                     if first_count > 0
 393                     then do;
 394                               call adjust_position_right;
 395                               return;
 396                          end;
 397                end;
 398                                                             /* rotate left or split */
 399           if p_b_num > 1
 400           then do;                                          /* try left brother */
 401                     call get_left_brother;
 402                     call rotate_left;                       /* sets count */
 403                     if second_count > 0
 404                     then do;
 405                               call adjust_position_left;
 406                               return;
 407                          end;
 408                end;
 409                                                             /* must split node, p_b_num irrelevant(no pivot),split sets b_n_ptr */
 410           call find_split_num;
 411           call split (split_num);                           /* split_num is num of key after last included in space */
 412           call adjust_position_right;
 413           return;                                           /* end overflow code */
 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;                                           /* end of get_right_brother routine */
 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;                                           /* end of get_left_brother routine */
 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                                                                balance or combine with right brother */
 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;                                          /* balance or combine with left brother */
 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 /* the parent node is the root node */
 500                if last_branch_num = 1                       /* height of tree decreases */
 501           then call underflow_to_root;
 502           else call adjust_branch_num;
 503           return;                                           /* end of underflow code */
 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;                                           /* end of underflow_to_root routine */
 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 /* Declarations */
 532           dcl     is_new_key             bit (1) aligned;
 533           dcl     is_overflow            bit (1) aligned;
 534           dcl     (p_n_ptr, b_n_ptr)     ptr;               /* parent,brother nodes */
 535           dcl     b_node                 fixed (35);        /* brother node designator */
 536           dcl     last_b_num_left        fixed;             /* used in combining node with left brother */
 537           dcl     p_b_num                fixed;             /* branch num for pivot kay is parent */
 538           dcl     n_ptr                  ptr;
 539           dcl     (dest_np, np1, np2)    ptr;
 540           dcl     i                      fixed;
 541           dcl     num_of_keys            fixed;             /* number of keys available for rotation,
 542                                                                includes new key in overflow case */
 543 
 544 get_key:
 545      proc (i, p, k);                                        /* locates the node(p)and branch_num(k)for the ith key"in"
 546                                                                the source node. Allows for new key. This routine is used in rotate_x and
 547                                                                split */
 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;                                /* use new key */
 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;             /* 1<=i<=num_of_keys */
 564           dcl     k                      fixed;
 565           dcl     p                      ptr;
 566      end;                                                   /* end get_key */
 567 
 568 split:
 569      proc (n);                                              /* creates new right brother */
 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;                                           /* end of split routine */
 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;             /* index of first key to be moved */
 604           dcl     b_num                  fixed;
 605           dcl     n_ptr                  ptr;
 606      end;                                                   /* end split */
 607 
 608 move_adjust:
 609      proc;                                                  /* adjust low_key_pos and free space count in source */
 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;                                                 /* moves key and bd_words from source node to dest node */
 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;                                                   /* end set-new_key */
 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;                                  /* defines first key to be moved */
 650           di = -1;
 651           call compute_count;
 652           call set_first_count;
 653           if first_count ^= 0
 654           then do;                                          /* rotation is possible */
 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;                                           /* end rotate_right code */
 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;                                            /* defines first key to be moved */
 713           di = 1;
 714           call compute_count;
 715           call set_second_count;
 716           if second_count ^= 0
 717           then do;                                          /* rotation is possible */
 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;                                           /* end rotate_left */
 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;             /* indexes keys "in" source node-including inserted keys */
 749           dcl     di                     fixed;             /* defines order to take keys from source node */
 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);    /* parent key is first to be moved */
 769           count = 0;
 770           call get_key (i, p, k);
 771           dx = bd_len + p -> key_length (k);
 772           do while (i > 0);                                 /* i=0 just a convienient stop flag */
 773                if dy > y
 774                then i = 0;
 775                else do;                                     /* key will fit */
 776                          count = count + 1;
 777                          y = y - dy;
 778                          x = x + dx;
 779                          if x >= y
 780                          then i = 0;                        /* nodes are more or less balanced */
 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;                                   /* can not move enough keys to correct overflow */
 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;             /* x is space in source node,y in target node.
 799                                                                Initially x<y. Indeed, is overflow case x<o. routine finds count
 800 
 801                                                                of keys to be moved such that x>=y if possible. Constraint is y>=o */
 802           dcl     (dx, dy)               fixed;
 803      end;                                                   /* end compute_count_set_nps */
 804 
 805      end;                                                   /* end rotate_right */
 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;                                                  /* called after split or right rotate */
 859           call set_source_vars;
 860           if is_overflow
 861           then /* main node is left one */
 862                if branch_num <= last_branch_num
 863                then do;                                     /* new key must be inserted */
 864                          call set_new_cont_space;
 865                          call simple_insert (branch_num);
 866                     end;
 867                else /* new key was moved */
 868                     np1 -> last_branch_num = np1 -> last_branch_num + 1;
 869      end;                                                   /* end finish_left_node */
 870 
 871 finish_right_node:
 872      proc;                                                  /* called after left rotate */
 873           call set_source_vars;
 874           if is_overflow
 875           then do;                                          /* main node is right one */
 876                     if branch_num <= count
 877                     then do;                                /* new key was moved */
 878                               np1 -> last_branch_num = np1 -> last_branch_num + 1;
 879                               call left_shift (count - 1);
 880                          end;
 881                     else do;                                /* new key must be inserted */
 882                               call left_shift (count);
 883                               call set_new_cont_space;
 884                               call simple_insert (branch_num - count);
 885                          end;
 886                end;
 887           else /* underflow case,brother node is right one */
 888                call left_shift (count);
 889      end;                                                   /* end finish_right_node */
 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);                                              /* shifts descriptors n places left within node */
 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;                                                   /* end left_shift */
 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);                               /* moves key  in parent and all keys in node 2 (the right node)
 920                                                                into node 1 (movement to left), deletes node 2 */
 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                                                             /* delete right node */
 929           return;                                           /* end of combine routine */
 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;                                                   /* end combine */
 955 
 956 adjust_position_right:
 957      proc;                                                  /* used after split or right rotation for overflow */
 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;                                                   /* end adjust_position_right */
 970 
 971 adjust_position_left:
 972      proc;                                                  /* used after left rotation for overflow */
 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               /* position moves to parent */
 977                then do;
 978                          call set_current_node_to_parent;
 979                          return;
 980                     end;
 981           if branch_num <= 0                                /* position is in left node */
 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;            /* position is in right node */
 987           return;
 988      end;                                                   /* end adjust_position_left */
 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;                                                   /* end overflow_underflow */
1006 
1007 create_node:
1008      proc (designator, node_ptr_arg);                       /* ref17 */
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;                                     /* grab a free node from the list */
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;                                     /* use this free node */
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;                                          /* use next available page of index tail */
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;                                          /* get a new index file component */
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;                                           /* end create node code */
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;                                          /* at least one free node exists */
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;                                /* add new entry to free list */
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;                                           /* end of free_node routine */
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 /* really node-size-2 */) 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;                            /* execution resumes normally */
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 /* Arguments */
1104           dcl     iocb_ptr               ptr;
1105           dcl     abort_exit             label;
1106 
1107 /* Local Variables */
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 /* Constants Depending on Node Structure */
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                                                             /* includes first branch */
1125 
1126 %include vfile_indx;
1127 %include iocbv;
1128      end change_index;