1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Information Systems Inc., 1981 *
  4         *                                                         *
  5         * Copyright (c) 1972 by Massachusetts Institute of        *
  6         * Technology and Honeywell Information Systems, Inc.      *
  7         *                                                         *
  8         *********************************************************** */
  9 
 10 
 11 
 12 /****^  HISTORY COMMENTS:
 13   1) change(86-01-10,Dupuis), approve(86-01-10,MCR7188), audit(86-07-23,GWMay),
 14      install(86-07-29,MR12.0-1106):
 15      Corrected the following problems: (1) No usage message when 0 args are
 16      supplied. (2) No usage message when 1 arg is supplied. (3) No usage
 17      message when more than 2 args are supplied, and an incorrect message
 18      is printed. (4) No usage message when an invalid opening mode is supplied.
 19   2) change(86-01-10,Dupuis), approve(86-05-23,MCR7404), audit(86-07-23,GWMay),
 20      install(86-07-29,MR12.0-1106):
 21      Changed to work as an active request and cleaned up minor problems.
 22      Returns true if database could be opened, false otherwise.
 23                                                    END HISTORY COMMENTS */
 24 
 25 
 26 linus_open:
 27      proc (sci_ptr, lcb_ptr);
 28 
 29 /* DESCRIPTION:
 30 
 31    The data base is opened in the user specified mode via a call to dsl_$open.
 32    Multiple data base opens are not allowed.
 33 
 34    LINUS request:     open data_path mode, o data_path mode
 35 
 36    data_path is the pathname of a MRDS data base or a data submodel associated
 37    with that data data base.
 38 
 39    mode is one of the following:
 40 
 41    retrieval, r
 42    update, u
 43    exclusive_retrieval, er
 44    exclusive_update, eu
 45 
 46 
 47    HISTORY:
 48 
 49    77-03-01 J. C. C. Jagernauth: Initially written.
 50 
 51    78-09-01 J. C. C. Jagernauth: Modified for MR7.0.
 52 
 53    79-11-28  Rickie E.  Brinegar: Modified to determine old or new data models
 54    from the data model headers through the rm_db_info structure.
 55 
 56    79-12-18  Rickie  E.  Brinegar: Modified to set scope for exclusive opening
 57    modes, and to require an opening mode.
 58 
 59    80-03-12 Rickie E.  Brinegar: Modified to use the temporary segment defined
 60    on lcb.linus_area_ptr rather than getting system free area.
 61 
 62    80-06-01  Jim Gray : Modified to capture a bad opening mode itself, instead
 63    of  passing a phony mode to dsl_$open, and getting a error message that has
 64    little meaning to the linus user.
 65 
 66    80-12-22  Jim Gray : changed r-u scope file modes to r-s-m-d usage now that
 67    mrds    handles    these    modes    for   real.    Also   added   use   of
 68    mrds_opening_modes_.incl
 69 
 70    80-12-31 Jim Gray : added init of touched bit in scope_data structure.
 71 
 72    81-01-12  Jim Gray : changed handling of touched bit now that part of flags
 73    section of scope_data.
 74 
 75    81-01-27  Jim  Gray  : removed reference to mdbm_data_$current_version, and
 76    replace with a constant instead.
 77 
 78    81-05-12 Rickie E.  Brinegar: Modified to not call mdbm_util_$get_rslt_info
 79    to   get  the  version  number  but  to  use  dsl_$get_db_version  instead.
 80    mdbm_util_$get_rslt_info  should  not  be  available  outside  of  MRDS for
 81    security reasons.
 82 
 83    81-05-13  Rickie  E.   Brinegar:  Added  the code to set the secured_db and
 84    administrator bits in lcb structure.
 85 
 86    81-06-19 Rickie E. Brinegar: Removed call to dsl_$get_rels.
 87 
 88    81-11-16 Rickie E. Brinegar: added timing of dsl calls.
 89 
 90    82-02-05 Paul W. Benjamin: ssu_ conversion
 91 
 92    83-02-04 Al Dupuis: Changed call to com_err_ to ssu_$print_message.
 93 
 94 */
 95 ^L
 96 %include linus_lcb;
 97 %page;
 98 %include linus_char_argl;
 99 %page;
100 %include linus_ready_data;
101 %page;
102 %include linus_ready_table;
103 %page;
104 %include linus_scal_fn_info;
105 %page;
106 %include linus_set_fn_info;
107 %page;
108 %include mrds_model_relations;
109 %page;
110 %include mrds_opening_modes_;
111 %page;
112 %include mrds_security_info;
113 ^L
114           dcl     sci_ptr                ptr;               /* needed by ssu_ */
115           dcl     (
116                   db_version,
117                   i,
118                   j,
119                   open_mode,
120                   retrieval_mode         init (2)
121                   )                      fixed bin;
122 
123           dcl     code fixed bin (35);
124 
125           dcl     error_codes (2) fixed bin (35);
126 
127           dcl     initial_mrds_vclock    float bin (63);
128 
129           dcl     cleanup                condition;
130           dcl     cleanup_has_been_signalled bit (1) aligned;
131 
132           dcl     (
133                   data_model_ptr         init (null),
134                   free_setfi_ptr         init (null),
135                   last_setfi_ptr         init (null)
136                   )                      ptr;
137 
138           dcl     mode                   char (char_argl.arg.arg_len (2)) based (char_argl.arg.arg_ptr (2));
139                                                             /* Mode for linus open */
140           dcl     open_mode_value        (9) fixed bin int static options (constant) init (
141                                          /* Codes for valid open modes */
142                                          1, 1, 2, 2, 3, 3, 4, 4, 5); /* 5 is the only invalid open mode */
143           dcl     opened_mode            char (20);         /* need to call dsl_$get_pn */
144           dcl     path_name              char (char_argl.arg.arg_len (1))
145                                          based (char_argl.arg.arg_ptr (1)); /* Path_Name for linus open */
146 
147           dcl     (
148                   db_path_name,                             /* the absolute path name of the db */
149                   out_path_name
150                   )                      char (168);        /* a dummy argument to dsl_$get_db_version */
151 
152           dcl     valid_open_mode        (8) char (19) int static options (constant) init (
153                                          /* Valid open modes */
154                                          "r", "retrieval", "u", "update", "er", "exclusive_retrieval", "eu",
155                                          "exclusive_update");
156 
157           dcl     active_request_flag bit (1) aligned;
158           dcl     return_value char (return_value_length) varying based (return_value_ptr);
159           dcl     return_value_length fixed bin (21);
160           dcl     return_value_ptr ptr;
161 
162           dcl     (addr, fixed, hbound, null, rel, vclock) builtin;
163 
164           dcl     (
165                   linus_error_$cant_ref_fun,                /* Linus error codes */
166                   linus_error_$inv_mode,
167                   linus_error_$no_input_arg,
168                   linus_error_$too_few_args,
169                   linus_error_$too_many_dbs,
170                   mrds_error_$db_busy,
171                   mrds_error_$quiesced_db,
172                   sys_info$max_seg_size
173                   )                      ext fixed bin (35);
174 
175           dcl     error_table_$too_many_args fixed bin(35) ext static;
176           dcl     dsl_$close             entry() options(variable);
177           dcl     dsl_$declare           entry options (variable);
178           dcl     dsl_$get_db_version
179                                          entry (char (168), char (168), fixed bin, fixed bin (35));
180           dcl     dsl_$get_rslt_rels     entry (fixed bin (35), ptr, ptr, fixed bin (35));
181           dcl     dsl_$get_pn            entry (fixed bin (35), char (168), char (20), fixed bin (35));
182           dcl     dsl_$get_security_info entry (fixed bin (35), ptr, ptr, fixed bin (35));
183           dcl     dsl_$open              entry options (variable); /* MRDS Subroutine */
184           dcl     linus_stifle_mrds_sub_error entry ((*) fixed bin(35));
185           dcl     ssu_$abort_line        entry options (variable);
186           dcl     ssu_$return_arg entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(21));
187           dcl     ssu_$arg_ptr           entry (ptr, fixed bin, ptr, fixed bin (21));
188           dcl     ssu_$print_message     entry() options(variable);
189           dcl     sub_error_             condition;
190           dcl     USAGE char (36) internal static options (constant) init (
191 "^/Usage: open pathname opening_mode");
192 
193 ^L
194           ca_ptr = null;
195           mr_ptr = null;
196 
197           on cleanup begin;
198                cleanup_has_been_signalled = "1"b;
199                call clean_up;
200           end;
201 
202           lcb.trans_id, rd_nfiles_init = 0;
203           call ssu_$return_arg (sci_ptr, nargs_init,
204                active_request_flag, return_value_ptr, return_value_length);
205           if active_request_flag
206           then return_value = "false";
207           if lcb.db_index ^= 0 then
208                call ssu_$abort_line (sci_ptr, linus_error_$too_many_dbs);       /* Only one data base can
209                                                                be open */
210           if nargs_init = 0 then
211                call ssu_$abort_line (sci_ptr, linus_error_$no_input_arg, USAGE);  /* Some argument must
212                                                                be passed */
213           if nargs_init < 2 then
214                call ssu_$abort_line (sci_ptr, linus_error_$too_few_args, USAGE);
215           if nargs_init > 2 then
216                call ssu_$abort_line (sci_ptr, error_table_$too_many_args, USAGE);
217           allocate char_argl in (lcb.static_area);
218           do i = 1 to 2;
219                call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i));
220           end;
221           do i = 1 to 8 while (mode ^= valid_open_mode (i));/* Find open mode */
222           end;
223           if i > hbound (valid_open_mode, 1) then
224                call
225                     ssu_$abort_line (sci_ptr, linus_error_$inv_mode,
226                     "Unrecognizable opening mode ^a.^a", mode, USAGE);
227           open_mode = open_mode_value (i);                  /* Set open mode for MRDS call */
228           if active_request_flag
229           then do;
230                error_codes (1) = mrds_error_$db_busy;
231                error_codes (2) = mrds_error_$quiesced_db;
232                on sub_error_ call linus_stifle_mrds_sub_error (error_codes);
233           end;
234           if lcb.timing_mode then
235                initial_mrds_vclock = vclock;
236           call dsl_$open (path_name, lcb.db_index, open_mode, code);
237                                                             /* Try to open data base */
238           if lcb.timing_mode then
239                lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
240           if active_request_flag
241           then revert sub_error_;
242           if code ^= 0
243           then if active_request_flag & (code = mrds_error_$db_busy | code = mrds_error_$quiesced_db)
244                then do;
245                     call clean_up;
246                     return;
247                end;
248                else call ssu_$abort_line (sci_ptr, code);
249           else if active_request_flag
250                then return_value = "true";
251                else;
252 
253           if lcb.timing_mode then
254                initial_mrds_vclock = vclock;
255           call dsl_$get_pn (lcb.db_index, db_path_name, opened_mode, code);
256           if lcb.timing_mode then
257                lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
258           if code ^= 0 then
259                call ssu_$abort_line (sci_ptr, code);
260 
261           if lcb.timing_mode then
262                initial_mrds_vclock = vclock;
263           call dsl_$get_db_version (db_path_name, out_path_name, db_version, code);
264           if lcb.timing_mode then
265                lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
266           if code ^= 0 then
267                call ssu_$abort_line (sci_ptr, code);
268           if db_version > 3 then
269                lcb.new_version = "1"b;
270           else lcb.new_version = "0"b;
271 
272           if lcb.timing_mode then
273                initial_mrds_vclock = vclock;
274           call
275                dsl_$get_security_info (lcb.db_index, lcb.linus_area_ptr,
276                mrds_security_info_ptr, code);
277           if lcb.timing_mode then
278                lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
279           if code ^= 0 then
280                call ssu_$abort_line (sci_ptr, code);
281           lcb.administrator = mrds_security_info.administrator;
282           lcb.secured_db = mrds_security_info.db_secure;
283 
284           if lcb.sclfi_ptr ^= null then do;                 /* Declare user defined scalar functions */
285                     sclfi_ptr = lcb.sclfi_ptr;
286                     do while (sclfi_ptr ^= null);
287                          if lcb.timing_mode then
288                               initial_mrds_vclock = vclock;
289                          call dsl_$declare (lcb.db_index, scal_fn_info.name, code);
290                          if lcb.timing_mode then
291                               lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
292                          if code ^= 0 then
293                               call ssu_$abort_line (sci_ptr, code);
294                          sclfi_ptr = scal_fn_info.fwd_ptr;
295                     end;
296                end;
297 
298           if lcb.setfi_ptr ^= null then do;
299                     free_setfi_ptr = null;
300                     last_setfi_ptr = lcb.setfi_ptr;
301                     linus_set_fn_info_ptr = lcb.setfi_ptr;
302                     do linus_set_fn_info_ptr = lcb.setfi_ptr
303                          repeat linus_set_fn_info.fwd_ptr
304                          while (linus_set_fn_info.fwd_ptr ^= null);
305                          if ^linus_set_fn_info.init_entry_set then do;
306                                    call
307                                         ssu_$print_message (linus_error_$cant_ref_fun, "open",
308                                         "^/The set function ^a does not have an ""_init"" entry ^/point and has been removed from the declared set functions list."
309                                         , linus_set_fn_info.name);
310                                    if lcb.setfi_ptr = last_setfi_ptr then do;
311                                              lcb.setfi_ptr = linus_set_fn_info.fwd_ptr;
312                                              last_setfi_ptr = linus_set_fn_info.fwd_ptr;
313                                         end;
314                                    linus_set_fn_info.fwd_ptr = free_setfi_ptr;
315                                    free_setfi_ptr = linus_set_fn_info_ptr;
316                               end;
317                          else last_setfi_ptr = linus_set_fn_info_ptr;
318                     end;
319                     do linus_set_fn_info_ptr = free_setfi_ptr repeat free_setfi_ptr
320                          while (free_setfi_ptr ^= null);
321                          free_setfi_ptr = linus_set_fn_info.fwd_ptr;
322                          free linus_set_fn_info;
323                     end;
324                end;
325 
326           lcb.rt_ptr, lcb.rd_ptr = null;
327 
328           if lcb.timing_mode then
329                initial_mrds_vclock = vclock;
330           call dsl_$get_rslt_rels (lcb.db_index, lcb.linus_area_ptr, mr_ptr, code);
331           if lcb.timing_mode then
332                lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock);
333           if code ^= 0 then
334                call ssu_$abort_line (sci_ptr, code);
335 
336           call init_ready_data;
337           call init_ready_table;
338 
339           return;
340 ^L
341 init_ready_data:
342      proc;
343 
344 /* fill ready_data structure */
345 
346           rd_nfiles_init = model_relations.nrels;
347           allocate ready_data in (lcb.static_area);
348           lcb.rd_ptr = rd_ptr;
349           ready_data.mode = RETRIEVAL;
350 
351           do j = 1 to model_relations.nrels;
352                ready_data.file.name (j) = model_relations.relation_name (j);
353                ready_data.file.active (j) = "0"b;
354           end;
355 
356 
357      end init_ready_data;
358 ^L
359 init_ready_table:
360      proc;
361 
362           ntabs_init = model_relations.nrels;
363           allocate ready_table in (lcb.static_area);
364           lcb.rt_ptr = rt_ptr;
365           do i = 1 to ntabs_init;
366                ready_table.tab.name (i) = model_relations.relation_name (i);
367                ready_table.tab.active (i) = "0"b;
368           end;
369           mr_ptr = null;
370 
371      end init_ready_table;
372 ^L
373 clean_up:
374      proc;
375 
376           if ca_ptr ^= null
377           then free char_argl;
378           if lcb.db_index ^= 0 & cleanup_has_been_signalled
379           then call dsl_$close (lcb.db_index, code);
380 
381      end clean_up;
382 
383 
384      end linus_open;