1 /* the control block */
  2      dcl     indx_cb_ptr            ptr;
  3      dcl     1 indx_cb              based (indx_cb_ptr),    /* except as noted, init by create cb */
  4                2 fcb_ptr            ptr,
  5                2 file_base_ptr      ptr,
  6                2 node_length        fixed,                  /* number of bytes in node, init by create_seg_ptrs */
  7                2 half_node_length   fixed,                  /* init by create_seg_ptrs */
  8                2 max_record_size    fixed (21),             /* init by create_seg_ptrs */
  9                2 seg_ptr_array_ptr  ptr,                    /* init by create seg_ptrs */
 10                2 seg_ptr_array_limit
 11                                     fixed,                  /* init by create seg_ptrs */
 12                2 mode               fixed,
 13                2 is_sequential_open bit (1) aligned,
 14                2 is_read_only       bit (1) aligned,
 15                2 is_ks_out          bit (1) aligned,        /* position info */
 16                2 position_stack_ptr ptr,                    /* init by create_position stack */
 17                2 position_stack_height
 18                                     fixed,                  /* init by create position stack */
 19                2 root_position_ptr  ptr,                    /* init by create_position_stack */
 20                2 file_position_ptr  ptr,                    /* not init */
 21                2 change_position_ptr
 22                                     ptr,                    /* not init */
 23                                                             /* auxiliary variables  */
 24                2 rover_seg_ptr      ptr,                    /* init by create_seg_ptrs */
 25                2 index_state_ptr    ptr,                    /* init by create_seg_ptrs */
 26                2 old_index_height   fixed,
 27                2 old_last_comp_num  fixed,
 28                2 last_change_count  fixed (35),
 29                2 wait_time          fixed (35),
 30                2 old_rover_comp_num fixed,
 31                2 file_state_ptr     ptr,
 32                2 o_s_ptr            ptr,
 33                2 repeating          bit (1) aligned,
 34                2 next_substate      fixed,
 35                2 file_program_version
 36                                     fixed,                  /* used for record_lock compatibility */
 37                2 leave_locked       bit (1) aligned,        /* indicates use of set_file_lock order */
 38                2 dup_ok             bit (1) aligned,        /* if set, duplicate keys may occur */
 39                2 read_exclu         bit (1) aligned,        /* set when lock excludes readers */
 40                2 pos_incorrect      bit (1) aligned,        /* indicates index position is not current */
 41                2 saved_lock_copy    bit (36) aligned,       /* copy of process lock_id */
 42                2 min_key_len        fixed,                  /* non-zero only in old programs */
 43                2 stat               bit (1) aligned,        /* causes write_record to create stationary records */
 44                2 current_subset     fixed (34),             /* used with select order */
 45                2 last_subset        fixed (34),
 46                2 subset_count       fixed (34),             /* count of descriptors in current subset */
 47                2 temp_iocbp         ptr,                    /* temporary file used to implement select order */
 48                2 trans              bit (1) aligned,        /* set if -transaction attachment */
 49                2 transaction_code   fixed (35),             /* set for control switch only */
 50                2 tcfp               ptr,                    /* ptr to iocb for transaction control switch--if applicable */
 51                2 reflp              ptr,                    /* ptr to ref list file, set only in transaction control file */
 52                2 uid                bit (36) aligned,       /* used under -transaction */
 53                2 collection_delay_time
 54                                     fixed (35),             /* microseconds to wait before garbage removal */
 55                2 min_res            fixed (21),             /* for min_block_size order */
 56                2 min_cap            fixed (21),             /* also for min_block_size order */
 57                2 subset_selected    bit (2) aligned,        /* first bit for select, second
 58                                                                bit is for exclude */
 59                2 error,                                     /* for error_status order */
 60                  3 type             fixed,                  /* only one error type supported now */
 61                  3 requested        fixed (34),             /* skip arg given to position entry */
 62                  3 received         fixed (34),             /* actual successful skips */
 63                2 state_vars,
 64                  3 fixed_state_part,
 65                    4 shared         bit (1) aligned,
 66                    4 next_record_position
 67                                     fixed,                  /* 0, 1, or 2 */
 68                    4 current_record_is_valid
 69                                     bit (1) aligned,
 70                    4 ready_to_write bit (1) aligned,
 71                    4 at_eof_or_bof,
 72                      5 at_bof       bit (1) unal,
 73                      5 at_eof       bit (1) unal,
 74                      5 pad          bit (36) unal,
 75                    4 outside_index  bit (1) aligned,        /* set after deleting current key or after use of record_status with locate switch */
 76                    4 current_descrip
 77                                     fixed (35),             /* needed when outside index */
 78                    4 saved_descrip  fixed (35),             /* for restoring index position */
 79                    4 skip_state     fixed,                  /* controls scanning of deleted entries */
 80                  3 new_key          char (256) var;
 81 
 82      dcl     current_t_code         fixed (35) based (addr (indx_cb.tcfp -> iocb.open_data_ptr -> indx_cb.transaction_code));
 83 
 84 /* component locator structures */
 85      dcl     seg_ptr_array          (0:seg_ptr_array_limit) ptr based (seg_ptr_array_ptr);
 86      dcl     seg_ptr                ptr;
 87      dcl     seg_array              (0:262143) fixed (19) based (seg_ptr) aligned;
 88      dcl     designator             fixed (35);
 89      dcl     1 ind_des_structure    based,
 90                2 comp               fixed (17) unal,
 91                2 offset             bit (18) unal;
 92      dcl     1 stat_structure       based,
 93                2 pad                bit (26) unal,
 94                2 ref_count_after    fixed (16) unsigned unal,
 95                2 ind_comp           fixed (13) unal,
 96                2 ref_count          fixed (16) unsigned unal,
 97                2 record_lock        bit (36) aligned,
 98                2 modifier           fixed (35),
 99                2 time_stamp_words   fixed (71) aligned,
100                2 prev_mod           fixed (35),
101                2 record             char (1000000) var;
102      dcl     1 ind_structure        based,
103                2 pad                bit (26) unal,
104                2 ref_count_after    fixed (16) unsigned unal,
105                2 ind_comp           fixed (13) unal,
106                2 ref_count          fixed (16) unsigned unal,
107                2 record_lock        bit (36) aligned,
108                2 modifier           fixed (35),
109                2 time_stamp_words   fixed (71) aligned,
110                2 prev_mod           fixed (35),
111                2 prev_desc          fixed (35);
112      dcl     1 time_stamp_structure based,
113                2 ind_offset         bit (18) unal,
114                2 time_last_modified fixed (54) unsigned unal;
115      dcl     1 record_block_structure
116                                     based,
117                2 reserved           aligned,                /* data used by change_record_list */
118                  3 pad              bit (2) unal,
119                  3 block_size       fixed (19) unal,
120                  3 lock_flag        bit (1) unal,           /* record lock flag */
121                  3 stationary       bit (1) unal,
122                  3 indirect         bit (1) unal,
123                  3 after_applies    bit (1) unal,
124                  3 mbz              bit (10) unal,
125                2 block_tail,                                /* structure varies with record type */
126                  3 record           char (1000000) var;     /* non-stat record location */
127      dcl     1 designator_struct    aligned based (addr (designator)),
128                2 comp_num           fixed (17) unal,
129                2 offset             bit (18) unal;
130 
131 /* position and node templates */
132      dcl     1 position_frame       based (pos_ptr),        /* ref8 */
133                2 parent_position_ptr
134                                     ptr,
135                2 son_position_ptr   ptr,
136                2 node_ptr           ptr,
137                2 node               fixed (35),
138                2 branch_num         fixed;
139      dcl     1 node_block           based (node_ptr),       /* ref9) */
140                2 last_branch_num    fixed,
141                2 low_key_pos        fixed,
142                2 scat_space         fixed,
143                2 branch_and_descrip (1 refer (node_block.last_branch_num)),
144                                                             /* in last element only branch is used */
145                  3 branch           fixed (35),
146                  3 descrip,
147                    4 key_descrip,
148                      5 key_pos      fixed (17) unal,
149                      5 key_length   fixed (17) unal,
150                    4 record_descrip,
151                      5 record_designator
152                                     fixed (35);
153      dcl     keys                   char (4096 /* 4*node_size */) based (node_ptr);
154 
155 /* file base and states */
156      dcl     f_b_ptr                ptr;
157      dcl     1 file_base            based (f_b_ptr),        /* ref10 */
158                2 common_header,
159                  3 file_code        fixed (35),
160                  3 lock_word        bit (36) aligned,
161                  3 words            (2) fixed,
162                2 file_version       fixed,
163                2 program_version    fixed,
164                2 node_size          fixed (19),
165                2 minimum_key_length fixed,
166                2 minimum_block_size fixed (19),
167                2 max_seg_limit      fixed (19),
168                2 root_node_block,
169                  3 last_branch_num_root
170                                     fixed,                  /* =1 */
171                  3 word             fixed,
172                  3 reserved         fixed,
173                  3 only_branch_in_root
174                                     fixed (35),
175                2 file_state         fixed,
176                2 change_count       fixed (34),             /* record state info, ref12 */
177                2 old_number_of_free_blocks
178                                     fixed (34),
179                2 prior_block_size   fixed (19),
180                2 old_record_length  fixed (21),
181                2 need_new_seg       bit (1) aligned,
182                2 old_residue        fixed,
183                2 new_last_comp_num  fixed,
184                2 old_prev_free_block
185                                     fixed (18),
186                2 old_next_free_block
187                                     fixed (18),
188                2 new_record_length  fixed (21),
189                2 old_record_designator
190                                     fixed (35),
191                2 prec_block_was_free
192                                     bit (1) aligned,
193                2 next_block_was_free
194                                     bit (1) aligned,
195                2 former_block_size  fixed (19),
196                2 old_init_offset    fixed (18),
197                2 old_block_size     fixed (19),
198                2 prev_block_size    fixed (19),
199                2 former_rover_comp_num
200                                     fixed,
201                2 former_rover_offset
202                                     fixed (18),
203                2 next_block_size    fixed (19),
204                2 next_prev_free_block
205                                     fixed (18),
206                2 next_next_free_block
207                                     fixed (18),
208                2 saved_ks_out       bit (1) aligned,
209                2 new_descriptor     fixed (35),
210                2 old_last_branch_num
211                                     fixed,
212                2 old_low_key_pos    fixed,
213                2 old_scat_space     fixed,
214                2 old_key_pos        fixed,
215                2 rover_comp_num     fixed,
216                2 rover_offset       fixed (18),
217                2 old_key_length     fixed,
218                2 b_space            fixed,
219                2 last_b_num         fixed,
220                2 count              fixed,
221                2 first_count        fixed,
222                2 second_count       fixed,
223                2 split_num          fixed,
224                2 must_compact_dest  bit (1) aligned,
225                2 first_branch       fixed (35),
226                2 min_source_key_pos fixed,
227                2 min_dest_key_pos   fixed,
228                2 new_low_key_pos    fixed,
229                2 new_scat_space     fixed,
230                2 old_seg_lim        fixed (19),
231                2 old_number_of_free_nodes
232                                     fixed,
233                2 old_next_node_designator
234                                     fixed (35),
235                2 new_index_comp_num fixed,
236                2 out_of_index       bit (1) aligned,
237                2 saved_min_res      fixed (21),
238                2 saved_min_cap      fixed (21),
239                2 was_stat           bit (1) aligned,
240                2 was_ind            bit (1) aligned,
241                2 old_ind_desc       fixed (35),
242                2 after_desc         fixed (35),
243                2 old_ref_count      fixed (34),
244                2 new_ref_count      fixed (34),
245                2 old_num_free       fixed (34),
246                2 old_file_ch_count  fixed (35),
247                2 y_count,                                   /* for conversion of pre-MR6.9 files */
248                2 old_modifier       fixed (35),
249                2 was_transaction    bit (1) aligned,        /* state blocks */
250                2 index_state        fixed,
251                2 index_state_blocks (0:1),
252                  3 words            (104),
253                2 reserved           (30),                   /* this free space might come in handy */
254                2 old_prev_mod       fixed (35),
255                2 needed_blksz       fixed (35),
256                2 new_desc_val       fixed (35),
257                2 is_partial_deletion
258                                     bit (1) aligned,
259                2 reserved2          (42),
260                2 file_state_blocks  (0:1),
261                  3 words            (size (file_state_block)) fixed,
262                                                             /* component info */
263                2 max_comp_num       fixed,
264                2 last_comp_num      fixed,
265                2 first_free_comp_num,                       /* not yet supported */
266                2 comp_table_start   (size (comp_table));    /* start of comp_array */
267 
268      dcl     1 comp_table           (0:true_max_comp_num) based (addr (file_base.comp_table_start)) aligned,
269                2 seg_limit          fixed (19),             /* abs value is offset of first free word in seg, max val=max
270                                                                seg_limit and this indicates full seg */
271                2 comp_link          fixed (17) unal,
272                2 init_offset        fixed (18) unsigned unal;
273 
274      dcl     1 file_header          based (f_b_ptr),
275                2 first_three_pages  (3, 1024) fixed,
276                2 spare_node         char (4096) aligned;
277 
278 /* The File State */
279      dcl     fs_ptr                 ptr;
280      dcl     1 file_state_block     based (fs_ptr),
281                2 file_action        fixed,
282                2 file_substate      fixed,
283                2 number_of_keys     fixed (34),
284                2 duplicate_keys     fixed (34),             /* 0 if no duplications */
285                2 dup_key_bytes      fixed (34),
286                2 total_key_length   fixed (34),
287                2 number_of_records  fixed (34),
288                2 total_record_length
289                                     fixed (34),
290                2 number_of_allocated_records
291                                     fixed (34),
292                2 number_of_free_blocks
293                                     fixed (34),
294                2 words              (2) fixed;
295 
296 /* The Index State */
297      dcl     is_ptr                 ptr;
298      dcl     1 index_state_block    based (is_ptr),         /* if this declaration is changed,
299                                                                index_state_blocks must be adjusted */
300                2 number_of_nodes    fixed (34),
301                2 free_node_designator
302                                     fixed (35),
303                2 index_tail_comp_num
304                                     fixed,
305                2 index_height       fixed,
306                2 index_action       fixed,
307                2 index_substate     fixed,
308                2 current_node       fixed (35),
309                2 change_node        fixed (35),
310                2 fake_node,                                 /* equivalent to a short node because of storage map. It holds
311                                                                the new key, new record descrip, and new branch in a fashion
312                                                                convenient for overflow-underflow in change_index. */
313                  3 fake_head_and_descrip,
314                    4 word1          fixed,                  /* last_branch_num in real node */
315                    4 word2          fixed,                  /* low_key_pos in real node */
316                    4 word3          fixed,                  /* normally scat_space */
317                    4 word4          fixed,                  /* first branch in real node */
318                    4 new_key_pos    fixed (17) unal,        /* set by initializefile to denote first char
319                                                                in new_key_string, never changed */
320                    4 new_key_length fixed (17) unal,
321                    4 new_record_descrip,
322                      5 new_record_designator
323                                     fixed (35),
324                    4 new_branch     fixed (35),
325                  3 new_key_string   char (256),
326                2 branch_num_adjust  fixed,
327                2 pos_array          (10),
328                  3 saved_node       fixed (35),
329                  3 saved_branch_num fixed;
330 
331      dcl     1 old_file_base        based (f_b_ptr),
332                2 words1             (15) fixed,             /* same in both file versions */
333                2 old_file_state_blocks
334                                     (0:1),
335                  3 words            (5) fixed,
336                2 words2             (7) fixed,
337                2 record_state       fixed,
338                2 record_state_blocks
339                                     (0:1),
340                  3 words            (4) fixed,
341                2 words3             (14) fixed,             /* rover info same in both versions */
342                2 old_version_index_height
343                                     fixed,
344                2 old_version_number_of_nodes
345                                     fixed (34),
346                2 words4             (157) fixed,
347                2 old_version_index_tail_comp_num
348                                     fixed,
349                2 old_version_free_node_designator
350                                     fixed (35),
351                2 words5             (10) fixed,
352                2 old_version_comp_info
353                                     fixed,
354                2 word,
355                2 x_count            fixed;                  /* always zero in old version files */
356 
357 /* External Procedures */
358      dcl     clock_                 entry returns (fixed (71));
359      dcl     alloc_cb_file          entry (fixed,           /* size of block in words */
360                                     ptr);                   /* ptr to block */
361      dcl     free_cb_file           entry (fixed, ptr);
362      dcl     get_seg_ptr            entry (ptr, fixed) returns (ptr);
363      dcl     make_designator        entry (fixed, fixed (18), fixed (35));
364      dcl     create_seg_ptrs        entry (ptr);
365      dcl     free_seg_ptrs          entry (ptr);
366      dcl     get_new_seg            entry (ptr, fixed, ptr, fixed, label);
367      dcl     free_seg               entry (ptr, fixed, ptr);
368      dcl     set_bitcounts          entry (ptr);
369      dcl     create_position_stack  entry (ptr);
370      dcl     extend_position_stack  entry (ptr);
371      dcl     free_position_stack    entry (ptr);
372      dcl     change_index           entry (ptr, label);
373      dcl     change_record_list     entry (ptr, fixed, ptr, label);
374 
375 /* State Constants */
376 %include vfile_action_codes;
377 
378 /* Other constants */
379      dcl     true_max_comp_num      static options (constant) init (1250);
380      dcl     stat_header_size       static internal fixed options (constant) init (8);
381 
382 /* builtins */
383      dcl     (verify, reverse)      builtin;
384      dcl     addr                   builtin;
385      dcl     divide                 builtin;
386      dcl     length                 builtin;
387      dcl     null                   builtin;
388      dcl     substr                 builtin;
389      dcl     size                   builtin;
390      dcl     abs                    builtin;
391      dcl     unspec                 builtin;
392      dcl     fixed                  builtin;
393      dcl     bit                    builtin;
394      dcl     max                    builtin;
395      dcl     min                    builtin;
396      dcl     rel                    builtin;
397