1 set_current_image_info:
 2      proc;                                                  /* passively determines the transaction code
 3                                                                and indirect descriptor which currently apply to this record */
 4                                                             /* The validity of this algorithm while records are subject to asynch
 5                                                                changes is guaranteed by the strict observance of a standard modification
 6                                                                protocol */
 7 
 8           do while ("1"b);                                  /* loops on detecting asynch changes */
 9                time_stamp = fixed (time_stamp_struct.time_last_modified);
10                                                             /* to detect asynch change */
11                cur_mod = stat_struct.prev_mod;
12                ref_cnt = block_ptr -> stat_struct.ref_count;
13                if cur_mod = -3                              /* creation in progress */
14                then ind_desc = -1;
15                else if block_ptr -> record_block.indirect
16                then ind_desc = ind_struct.prev_desc;
17                else if block_ptr -> record_block.after_applies
18                then do;
19                          ind_des.comp = stat_struct.ind_comp;
20                          ind_des.offset = time_stamp_struct.ind_offset;
21                          mod = stat_struct.modifier;
22                          cur_mod = mod;
23                          ref_cnt = stat_struct.ref_count_after;
24                          go to check_time;                  /* validate snapshot */
25                     end;
26                else ind_desc = current_descrip;             /* compact case */
27                mod = stat_struct.modifier;
28                if block_ptr -> record_block.lock_flag       /* before image may not be valid */
29                then if mod > 0                              /* transaction may be in progress on this record */
30                     then if mod ^= cur_mod                  /* before and after are different */
31                          then do;
32                                    new_ind_des.comp = stat_struct.ind_comp;
33                                    new_ind_des.offset = time_stamp_struct.ind_offset;
34                                    if cur_mod = stat_struct.prev_mod
35                                                             /* in case of asynch change */
36                                    then do;                 /* must look in tcf to see which applies */
37                                              if ^transaction/* no tcf available */
38                                              then do;       /* abort with non-zero code */
39                                                        code = error_table_$higher_inconsistency;
40                                                             /* can't tell which image
41                                                                is the one to use */
42                                                        return;
43                                                             /* abort */
44                                                   end;
45                                              unspec (gk_inf.flags) = "0"b;
46                                              gk_inf.input_key = "1"b;
47                                              gk_inf.key_len = 4;
48                                              gk_inf.head_size = 4;
49                                              gk_key = mod;  /* current transaction using this record */
50                                              call iox_$control (tcfp, "get_key", addr (gk_inf), er_code);
51                                              if er_code = 0
52                                              then if gk_inf.descrip = -1
53                                                             /* past checkpoint */
54                                                   then do;  /* use after image info */
55                                                             cur_mod = mod;
56                                                             ind_desc = new_ind_desc;
57                                                             ref_cnt = stat_struct.ref_count_after;
58                                                             return;
59                                                             /* done */
60                                                        end;
61                                                   else ;
62                                              else if er_code = error_table_$no_key
63                                              then code = error_table_$higher_inconsistency;
64                                         end;
65                               end;
66                if cur_mod = stat_struct.prev_mod            /* same as at previous reference */
67                then if cur_mod > 0                          /* modifier is unique for this record image */
68                     then return;
69                     else do;
70 check_time:
71                               if fixed (time_stamp_struct.time_last_modified) = time_stamp
72                               then return;                  /* will use time_stamp for verification */
73                          end;
74                if clock () > timeout                        /* time limit is exhausted */
75                then do;
76                          code = error_table_$record_busy;
77                          return;
78                     end;
79           end;                                              /* keep trying until reference succeeds */
80 
81           dcl     er_code                fixed (35);
82           dcl     1 new_ind_des          based (addr (new_ind_desc)),
83                     2 comp               fixed (17) unal,
84                     2 offset             bit (18) unal;
85           dcl     new_ind_desc           fixed (35);
86           dcl     gk_key                 fixed (35) based (addr (gk_inf.key));
87           dcl     1 gk_inf,
88                     2 header             like gk_header,
89                     2 key                char (4);
90      end set_current_image_info;
91 
92      dcl     1 ind_des              like ind_des_structure based (addr (ind_desc));
93      dcl     1 stat_struct          like stat_structure based (block_ptr);
94      dcl     1 ind_struct           like ind_structure based (block_ptr);
95      dcl     1 time_stamp_struct    like time_stamp_structure based (addr (stat_struct.time_stamp_words));
96      dcl     1 record_block         like record_block_structure based (block_ptr);