1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  4    *                                                         *
  5    *********************************************************** */
  6 
  7 /* format: style2,ind3 */
  8 
  9 rlm_open:
 10    proc ();
 11 
 12       return;                                               /* Not a valid entry point. */
 13 
 14 
 15 /* DESCRIPTION
 16 
 17           This routine handles open and close requests with the two entries:
 18      $open:
 19           opens a relation, sets up relation opening structures if they have
 20      not been set up by a prior open, increments the count of openings for this
 21      process for this relation, and returns the file opening id as the
 22      rel_opening_id.
 23 
 24      $close:
 25           decrements the count of openings. The relation_opening_info structure
 26      is gotten via rlm_opening_info$get_dont_refresh.  If the count of
 27      openings becomes 0, the relation_opening_info structure is freed (causing
 28      the relation_opening_info_ptr to become null) and the file is closed.
 29 */
 30 
 31 /* HISTORY:
 32 Written by Matthew Pierret, 04/28/82.
 33 Modified:
 34 10/19/82 by Matthew Pierret:  Added capability to generate and store
 35             relation_info, maintain number of openings.
 36 10/20/82 by Matthew Pierret:  Converted to use file_manager_.
 37 03/01/83 by Matthew Pierret:  Changed to use rlm_update_opening_info.
 38             Added $close.
 39 03/16/83 by Matthew Pierret:  Changed $close to use rlm_opening_info
 40             $get_dont_refresh. This is because to close a relation, the
 41             refresh-able information is not needed (or desired).
 42 05/16/83 by Lindsey L. Spratt:  Changed to call file_manager_$close in the
 43             $close entry if the call to rlm_update_opening_info$decrement*
 44             causes the relation_opening_info to be freed.
 45 04/19/84 by Lindsey L. Spratt:  Fixed to only do the $init and $refresh if the
 46             error code from $get is dm_error_$relation_not_open, otherwise if
 47             the code is non-zero then this module just returns.
 48 10/26/84 by Stanford S. Cox:  $open: Added cleanup. $close: moved fm_$close
 49             call from rlm_opening_info$free. ERROR_RETURN: modified from OPEN_=
 50             for use by $close. RETURN(added): for a common return point.
 51             FINISH(added)
 52 11/26/84 by Stanford S. Cox:  ERROR_RETURN: Added call to FINISH.
 53 */
 54 
 55 /* START OF DECLARATIONS */
 56 /* Parameter */
 57 
 58       dcl     p_rel_dir              char (*);
 59       dcl     p_rel_entry            char (*);
 60       dcl     p_rel_opening_id       bit (36) aligned;
 61       dcl     p_code                 fixed bin (35);
 62 
 63 /* Automatic */
 64 /* Based */
 65 /* Cleanup */
 66 
 67       dcl     cleanup                condition;
 68 
 69 /* Builtin */
 70 
 71       dcl     null                   builtin;
 72 
 73 /* Controlled */
 74 /* Constant */
 75 
 76       dcl     IS_OPEN_ENTRY          init ("1"b) bit (1) int static options (constant);
 77       dcl     IS_CLOSE_ENTRY         init ("0"b) bit (1) int static options (constant);
 78       dcl     myname                 init ("rlm_open") char (8) internal static options (constant);
 79 
 80 /* Entry */
 81 
 82       dcl     file_manager_$open     entry (char (*), char (*), bit (36) aligned, fixed bin (35));
 83       dcl     file_manager_$close    entry (bit (36) aligned, fixed bin (35));
 84 
 85       dcl     rlm_opening_info$get   entry (bit (36) aligned, ptr, fixed bin (35));
 86       dcl     rlm_opening_info$get_dont_refresh
 87                                      entry (bit (36) aligned, ptr, fixed bin (35));
 88       dcl     rlm_opening_info$refresh
 89                                      entry (ptr, fixed bin (35));
 90       dcl     rlm_opening_info$init  entry (bit (36) aligned, ptr, fixed bin (35));
 91       dcl     rlm_update_opening_info$increment_openings
 92                                      entry (ptr, fixed bin (35));
 93       dcl     rlm_update_opening_info$decrement_openings
 94                                      entry (ptr, fixed bin (35));
 95 
 96 /* External */
 97 
 98       dcl     error_table_$unimplemented_version
 99                                      ext fixed bin (35);
100       dcl     dm_error_$file_already_open
101                                      ext fixed bin (35);
102       dcl     dm_error_$relation_not_open
103                                      ext fixed bin (35);
104 
105 /* END OF DECLARATIONS */
106 ^L
107 open:
108    entry (p_rel_dir, p_rel_entry, p_rel_opening_id, p_code);
109 
110       p_code = 0;
111       p_rel_opening_id = "0"b;
112 
113       on cleanup call FINISH;
114       call file_manager_$open (p_rel_dir, p_rel_entry, p_rel_opening_id, p_code);
115 
116       if p_code ^= 0 & p_code ^= dm_error_$file_already_open
117       then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
118 
119       p_code = 0;
120 
121       call rlm_opening_info$get (p_rel_opening_id, relation_opening_info_ptr, p_code);
122       if p_code ^= 0
123       then if p_code ^= dm_error_$relation_not_open
124            then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
125            else
126               do;
127                  call rlm_opening_info$init (p_rel_opening_id, relation_opening_info_ptr, p_code);
128                  if p_code ^= 0
129                  then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
130 
131                  call rlm_opening_info$refresh (relation_opening_info_ptr, p_code);
132                  if p_code ^= 0
133                  then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
134               end;
135 
136 
137       call rlm_update_opening_info$increment_openings (relation_opening_info_ptr, p_code);
138       if p_code ^= 0
139       then call ERROR_RETURN (IS_OPEN_ENTRY, p_code);
140 
141 MAIN_RETURN:
142       return;
143 
144 
145 ERROR_RETURN:
146    proc (er_p_is_open_entry, er_p_code);
147 
148       dcl     er_p_is_open_entry     bit (1) parameter;
149       dcl     er_p_code              fixed bin (35);
150 
151       p_code = er_p_code;
152       if er_p_is_open_entry
153       then
154          do;
155             call FINISH ();
156             p_rel_opening_id = "0"b;
157          end;
158       call RETURN;
159    end ERROR_RETURN;
160 %skip;
161 RETURN:
162    proc ();
163       goto MAIN_RETURN;
164    end;
165 %skip;
166 FINISH:
167    proc ();
168       call file_manager_$close (p_rel_opening_id, p_code);
169    end;
170 %page;
171 close:
172    entry (p_rel_opening_id, p_code);
173 
174       call rlm_opening_info$get_dont_refresh (p_rel_opening_id, relation_opening_info_ptr, p_code);
175       if p_code ^= 0
176       then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
177 
178       call rlm_update_opening_info$decrement_openings (relation_opening_info_ptr, p_code);
179       if p_code ^= 0
180       then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
181 
182       call file_manager_$close (p_rel_opening_id, p_code);
183       if p_code ^= 0
184       then call ERROR_RETURN (IS_CLOSE_ENTRY, p_code);
185 
186       call RETURN;
187 %page;
188 %include dm_rlm_opening_info;
189 
190    end rlm_open;