COMPILATION LISTING OF SEGMENT linus_set_scope Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1118.3 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 10 /* ****************************************************** 11* * * 12* * * 13* * Copyright (c) 1972 by Massachusetts Institute of * 14* * Technology and Honeywell Information Systems, Inc. * 15* * * 16* * * 17* ****************************************************** */ 18 19 linus_set_scope: 20 proc (sci_ptr, lcb_ptr); 21 22 /* DESCRIPTION: 23* 24* This procedure calls linus_scope to set scope after first processing the 25* control arguments. 26* 27* 28* 29* HISTORY: 30* 31* 78-10-01 J. C. C. Jagernauth: Initially Written. 32* 33* 80-03-14 Rickie E. Brinegar: Modified to use a work area defined on 34* lcb.linus_area_ptr instead of getting system free area. 35* 36* 80-06-01 Jim Gray: Modified to correctly detect no db open, or no args 37* given. 38* 39* 80-06-02 Jim Gray: Modified to correctly process arguments and issue 40* meaningful error messages, for unknown control arg, bad permit/prevent ops, 41* or wait_time not in conversion range. 42* 43* 80-06-03 Jim Gray: Modified to let the user know temp tables are not valid 44* arguments for set_scope. 45* 46* 80-06-04 Jim Gray: Modified to ignore the "n" permit/prevent op code, unless 47* it is given by itself, in accordance will how mrds works. 48* 49* 80-12-22 Jim Gray: changed r-u to r-s-m-d scope modes, and renamed modes for 50* security acl comptibility, thus r-a-m-d with s and u still accepted. 51* 52* 80-12-23 Jim Gray: changed ch_argl.arg.arg_len from being set to a constant, 53* into a check of the non-blank actual length of the passed permit/prevent 54* modes. 55* 56* 80-12-31 Jim Gray: added setting of touched bit in scope_data any time a 57* scope request is made. this allows proper scope display. 58* 59* 81-01-12 Jim Gray: changed handling of touched bit now that in flags section 60* of scope_data. 61* 62* 81-04-07 Rickie E. Brinegar: changed r-a-m-d back to r-s-m-d as there is no 63* reason for LINUS to use "a" as a scope when scopes are defined to be for 64* specific operations and "a" does not match any LINUS operations. 65* 66* 81-04-09 Rickie E. Brinegar: changes made after an audit. The major 67* changes include: 68* . 69* . 1) changing the check for version 4 databases to use lcb.new_version 70* . instead of looking to see if sd_ptr (pointer to scope_data structure) 71* . is null. 72* . 73* . 2) consolidating the contents of the three loops that went from i = 1 to 74* . temp_char_argl_nargs by 3 into one loop that checks the existance of 75* . the relation name, gets the scope for the relation, and fills in the 76* . argument list to be sent to linus_set_fscope for new version 77* . database (version 4). 78* . 79* . 3) set_up_fscope_permits and set_up_fscope_prevents were collapsed into 80* . set_up_fscope_ops, taking a pointer to scope_data.rel.flags.(permits 81* . prevents) over which set_up_fscope_ops will lay the ops (short for 82* . operations) structure. 83* . 84* . 4) The unneeded tidy_up procedure was removed. 85* 86* 81-05-12 Rickie E. Brinegar: The following changes were made as a result of 87* an audit by Jim Gray: 88* . 89* . 1) An ^= was changed to = when checking to see if an invalid control 90* . argument exist. 91* . 92* . 2) Checking for an invalid wait time was moved into the checking 93* . section. 94* 95* 81-06-14 Rickie E. Brinegar: Removed calls to to linus_v1_set_scope and 96* linus_set_fscope. The strategy is to call dsl_$set_scope and let it 97* determine what version of database is currently open and act appropriately. 98* Thus LINUS does not need to know about database versions. 99* 100* 81-07-08 Rickie E. Brinegar: Modified to take more than one relation in a 101* set_scope operation. 102* 103* 81-11-16 Rickie E. Brinegar: added timing of dsl_ calls. 104* 105* 81-11-17 Rickie E. Brinegar: changed to pass the dsl_ entry instead of an 106* entry pointer to the dsl_ entry. This was done to allow use of 107* cu_$generate_call instead of cu_$gen_call in linus_scope. 108* 109* 82-02-08 Paul W. Benjamin: Conversion to ssu_. 110* 111* 82-09-03 DJ Schimke: Added call to dsl_$get_pn so that the user 112* sees a more meaningful error message if she tries to set scopes 113* with an "exclusive" opening mode. This is in response to phx13742. 114* 115* 83-01-03 Al Dupuis: Added the flag scope_call_has_been_started and code 116* to initialize it and set it only when the module is about to call 117* linus_scope. This removes a bug where all scope was deleted if a person 118* who has scope set used this request to try to set additional scope. Now 119* the additional scope request is still refused as before, but the existing 120* scope isn't deleted. 121**/ 122 1 1 /* BEGIN INCLUDE FILE linus_lcb.incl.pl1 -- jaw 8/30/77 */ 1 2 1 3 /* HISTORY: 1 4* 1 5* 78-09-29 J. C. C. Jagernauth: Modified for MR7.0. 1 6* 1 7* 81-05-11 Rickie E. Brinegar: added security bit and andministrator bit as 1 8* a part of the attribute level control work. 1 9* 1 10* 81-06-17 Rickie E. Brinegar: deleted the sd_ptr as a part of removing the 1 11* scope_data structure from LINUS. LINUS now depends totally on MRDS for 1 12* scope information. 1 13* 1 14* 81-11-11 Rickie E. Brinegar: added the timing bit and three fields for 1 15* retaining various vcpu times to be collected when in timing mode. The 1 16* times to be collected are: LINUS parsing time, LINUS processing time, and 1 17* MRDS processing time. 1 18* 1 19* 82-01-15 DJ Schimke: Added the build_increment and build_start fields as 1 20* part of the line numbering implementation. This allows for possible later 1 21* LINUS control of the build defaults. 1 22* 1 23* 82-03-01 Paul W. Benjamin: Removed linus_prompt_chars_ptr, as that 1 24* information is now retained by ssu_. Removed parse_timer as no longer 1 25* meaningful. Added linus_version. Added iteration bit. Added 6 entry 1 26* variables for ssu_ replaceable procedures. Added actual_input_iocbp. 1 27* 1 28* 82-06-23 Al Dupuis: Added subsystem_control_info_ptr, 1 29* subsystem_invocation_level, and selection_expression_identifier. 1 30* 1 31* 82-08-26 DJ Schimke: Added report_control_info_ptr, and 1 32* table_control_info_ptr. 1 33* 1 34* 82-10-19 DJ Schimke: Added ssu_abort_line. 1 35* 1 36* 83-06-06 Bert Moberg: Added print_search_order (pso) and no_optimize (no_ot) 1 37* 1 38* 83-04-07 DJ Schimke: Added temp_seg_info_ptr. 1 39* 1 40* 83-08-26 Al Dupuis: Added query_temp_segment_ptr. 1 41**/ 1 42 1 43 dcl 1 lcb aligned based (lcb_ptr), /* LINUS control block */ 1 44 2 db_index fixed bin (35), /* index of open data base, or 0 */ 1 45 2 rb_len fixed bin (21), /* length of request buffer */ 1 46 2 lila_count fixed bin (35), /* number of LILA text lines */ 1 47 2 lila_chars fixed bin (35), /* number of LILA source test chars */ 1 48 2 trans_id fixed bin (35), /* used by checkpoint and rollback facilities (MR7.0) */ 1 49 2 lila_fn char (32) unal, /* entry name of lila data file */ 1 50 2 prompt_flag bit (1) unal, /* on if in prompt mode */ 1 51 2 test_flag bit (1) unal, /* on if in test mode */ 1 52 2 new_version bit (1) unal init (1), /* on for new version data base (MR7.0) */ 1 53 2 secured_db bit (1) unal, /* on if the db is in a secure state */ 1 54 2 administrator bit (1) unal, /* on if the user is a db administrator */ 1 55 2 timing_mode bit (1) unal, /* on if timing is to be done */ 1 56 2 iteration bit (1) unal, /* interpret parens as iteration sets */ 1 57 2 pso_flag bit (1) unal, /* add print_search_order to select */ 1 58 2 no_ot_flag bit (1) unal, /* add no_optimize to select */ 1 59 2 reserved bit (27) unal, 1 60 2 liocb_ptr ptr, /* iocb ptr for lila file */ 1 61 2 rb_ptr ptr, /* ptr to request buffer */ 1 62 2 is_ptr ptr, /* iocb ptr for currentinput stream switch */ 1 63 2 cal_ptr ptr, /* ptr to current arg list for invoke (or null) */ 1 64 2 ttn_ptr ptr, /* pointer to table info structure */ 1 65 2 sfr_ptr ptr, /* structure pointer to force retrieve scope operation */ 1 66 2 lv_ptr ptr, /* pointer linus variables */ 1 67 2 si_ptr ptr, /* pointer to select_info structure */ 1 68 2 setfi_ptr ptr, /* pointer to set function information */ 1 69 2 sclfi_ptr ptr, /* pointer to user declared scalar fun. names */ 1 70 2 ivs_ptr ptr, /* pointer to stack of invoke iocb pointers */ 1 71 2 lit_ptr ptr, /* pointer to literal pool */ 1 72 2 lvv_ptr ptr, /* pointer to linus variable alloc. pool */ 1 73 2 rd_ptr ptr, /* point to readied files mode information (MR7.0) */ 1 74 2 rt_ptr ptr, /* point to table of relation names and their readied modes 1 75* (MR7.0) */ 1 76 2 actual_input_iocbp ptr, /* ptr to input while in macros */ 1 77 2 lila_promp_chars_ptr ptr, /* pointer to the prompt characters for lila */ 1 78 2 linus_area_ptr ptr, /* LINUS temporary segment pointer */ 1 79 2 lila_area_ptr ptr, /* LILA temporary segment pointer */ 1 80 2 i_o_area_ptr ptr, /* temporary segment pointer used by write, print, create_list */ 1 81 2 rel_array_ptr ptr, /* ptr to array of names rslt info structure 1 82* for current lila expression */ 1 83 2 unused_timer float bin (63), /* future expansion */ 1 84 2 request_time float bin (63), /* How much request time was spent 1 85* in LINUS. (-1 = user has just enabled 1 86* timing, do not report) */ 1 87 2 mrds_time float bin (63), /* How much time was spent in MRDS */ 1 88 2 build_increment fixed bin, /* default increment for build mode */ 1 89 2 build_start fixed bin, /* default start count for build mode */ 1 90 2 linus_version char (4), /* current version of LINUS */ 1 91 2 subsystem_control_info_ptr ptr, /* the same ptr passed by ssu_ to each request procedure */ 1 92 2 subsystem_invocation_level fixed bin, /* identifies this invocation of LINUS */ 1 93 2 selection_expression_identifier fixed bin, /* identifies the current processed selection expression */ 1 94 2 report_control_info_ptr ptr, /* pointer to linus_report_control_info structure */ 1 95 2 table_control_info_ptr ptr, /* pointer to linus_table control structure */ 1 96 2 temp_seg_info_ptr ptr, /* pointer to linus_temp_seg_mgr control structure */ 1 97 2 query_temp_segment_ptr ptr, /* points to temp seg used for manipulating query */ 1 98 2 word_pad (8) bit (36) unal, 1 99 /* procedures that will be optionally */ 1 100 /* replaced by the user. Saved so they */ 1 101 /* can be reinstated if desired. */ 1 102 2 ssu_abort_line entry options (variable), 1 103 2 ssu_post_request_line variable entry (ptr), 1 104 2 ssu_pre_request_line variable entry (ptr), 1 105 1 106 2 curr_lit_offset fixed bin (35), /* index of first free bit in lit. pool */ 1 107 2 curr_lv_val_offset fixed bin (35), /* index of first free bit lv. val. pool */ 1 108 2 static_area area (sys_info$max_seg_size - fixed (rel (addr (lcb.static_area))) + 1); 1 109 1 110 dcl lcb_ptr ptr; 1 111 1 112 /* END INCLUDE FILE linus_lcb.incl.pl1 */ 123 124 2 1 /* BEGIN INCLUDE FILE linus_char_argl.incl.pl1 -- jaw 2/11/77 */ 2 2 2 3 /* HISTORY: 2 4* 2 5* 82-02-05 Paul W. Benjamin: Changed arg_len to fixed bin (21). 2 6* 2 7**/ 2 8 2 9 dcl 1 char_argl aligned based (ca_ptr), /* structure for general char. arg. list */ 2 10 2 nargs fixed bin, /* number of args */ 2 11 2 arg (nargs_init refer (char_argl.nargs)), 2 12 3 arg_ptr ptr, /* ptr to first char. of arg */ 2 13 3 arg_len fixed bin (21); /* no. of chars. in arg */ 2 14 2 15 dcl ca_ptr ptr; 2 16 dcl nargs_init fixed bin; 2 17 2 18 /* END INCLUDE FILE linus_char_argl.incl.pl1 */ 125 126 3 1 /* BEGIN mdbm_scope_info.incl.pl1 -- odf 8/8/78 */ 3 2 3 3 /* WARNING 3 4* If the scope_info or scope_flags structure is changed then the 3 5* mrds_data_ item saved_res_version MUST be incremented to invalidate 3 6* all existing saved resultants 3 7**/ 3 8 3 9 /* Modified by Jim Gray - - 80-11-17, to add back store/delete/modify permissions */ 3 10 3 11 /* 80-12-10 Jim Gray : change name of store to append_tuple, delete to delete_tuple, 3 12* modify to modify_attr, retrieve to read_attr, remvoe update, put level 4 3 13* qualifiers for permit/prevent modes and to put pads in standard format */ 3 14 3 15 /* 80-12-11 Jim Gray : added submodel version of file/rel name for convenience */ 3 16 3 17 /* 80-12-22 Jim Gray : added like referenced structure so linus_scope_data.incl 3 18* could make use of it for compatibility. */ 3 19 3 20 /* 81-1-11 Jim Gray : added touched bit to scope_flags, so that 3 21* the fact that null scope has been set can be displayed */ 3 22 3 23 /* 85-04-14 Thanh Nguyen: Made scope_flags to be aligned so we could access the 3 24* prevent flags from any pointer which directly pointed to scope_flags itself 3 25* (i.e rm_rel_info.scope_flags_ptr). */ 3 26 3 27 /* this structure is to be allocated in the mrds_dbcb.incl.pl1 static area, 3 28* and is used to maintain the scope mechanism for file access. 3 29* It contains the scope permit/prevent operations that this user 3 30* has set in his view for this opening instance. */ 3 31 3 32 dcl 1 scope_info aligned based (scope_ptr), /* array of scope tuples for this user */ 3 33 2 mbz1 bit (144), /* Reserved for future use */ 3 34 2 nfiles fixed bin, /* Number of scope tuples in user's scope */ 3 35 2 active_scopes fixed bin, /* number of scopes currently active for a given user */ 3 36 2 scope (max_file_init refer (scope_info.nfiles)), /* defines user's scope of access to files */ 3 37 3 name char (30) aligned, /* filename */ 3 38 3 sm_name char (32), /* name of file(rel) in submodel */ 3 39 3 flags like scope_flags ; 3 40 3 41 3 42 declare 1 scope_flags aligned based, /* common layout of scope flag bits */ 3 43 2 permits, /* modes to permit this user */ 3 44 3 read_attr bit (1) unal, /* read_attr access to this file in scope */ 3 45 3 append_tuple bit (1) unal, /* append_tuple concnrrency permission */ 3 46 3 delete_tuple bit (1) unal, /* delete_tuple concurrency permission on rel */ 3 47 3 modify_attr bit (1) unal, /* modify_attr concurrency permission */ 3 48 3 mbz2 bit (10) unal, /* for expansion of permit ops */ 3 49 2 prevents, /* modes to be denyed to other users */ 3 50 3 read_attr bit (1) unal, /* on if user has prevent on read_attr for this file */ 3 51 3 append_tuple bit (1) unal, /* prevent of append_tuple concurrency */ 3 52 3 delete_tuple bit (1) unal, /* prevent of delete_tuple concurrency */ 3 53 3 modify_attr bit (1) unal, /* prevent of modify_attr concurrency */ 3 54 3 mbz3 bit (10) unal, /* for future prevent concurrency modes */ 3 55 2 touched bit (1) unal, /* on => scope set for this relation */ 3 56 2 mbz4 bit (7) unal ; /* for future flags */ 3 57 3 58 dcl max_file_init fixed bin; /* nbr. of files in data base */ 3 59 dcl scope_ptr ptr init (null ()); /* points to scope_info array */ 3 60 dcl scope_rdy bit (6) unal init ("000011"b) int static options (constant); /* scope file ready modes (5 or 6) */ 3 61 dcl scope_rdy_array (6) bit (1) unal based; /* array format of scope_rdy string */ 3 62 3 63 /* END mdbm_scope_info.incl.pl1 */ 127 128 129 dcl sci_ptr ptr; /* for ssu_ */ 130 131 dcl (rel_name_index, i, k, l, m, num_args, temp_char_argl_nargs) fixed bin; 132 133 dcl initial_mrds_vclock float bin (63); 134 135 dcl db_path char (168); 136 dcl mode char (20); 137 dcl (ds_flag, tm_flag) bit (1); 138 dcl scope_call_has_been_started bit (1); 139 140 dcl ( 141 ch_ptr init (null), 142 e_ptr init (null), 143 env_ptr init (null), 144 rel_name_ptr init (null), 145 permits_ptr init (null), 146 prevents_ptr init (null) 147 ) ptr; 148 149 dcl ( 150 code, 151 icode, 152 out_code, 153 wait_time init (0) 154 ) fixed bin (35); /* for checking valid wait time */ 155 156 157 dcl arg char (char_argl.arg.arg_len (l)) based (char_argl.arg.arg_ptr (l)); 158 dcl rel_names (num_args) char (32) unal based (rel_name_ptr); 159 dcl permits (num_args) char (5) unal based (permits_ptr); 160 dcl prevents (num_args) char (5) unal based (prevents_ptr); 161 162 dcl SCOPE_MODES char (6) init ("nsrmdu") int static options (constant); 163 /* accepted scope modes */ 164 165 dcl 1 ch_argl aligned based (ch_ptr), /* like char_argl */ 166 2 nargs fixed bin, 167 2 arg (nargs_init refer (ch_argl.nargs)), 168 3 arg_ptr ptr, 169 3 arg_len fixed bin; 170 171 dcl cleanup condition; 172 173 dcl (addr, fixed, length, null, rel, rtrim, search, substr, verify, vclock) 174 builtin; 175 176 dcl ( 177 linus_data_$ss_id, 178 linus_error_$ill_scp_op, 179 linus_error_$inv_arg, 180 linus_error_$inv_table, 181 linus_error_$no_db, 182 linus_error_$no_input_arg, 183 linus_error_$too_few_args, 184 mrds_error_$scope_not_empty, 185 mrds_error_$unshared_opening, 186 sys_info$max_seg_size 187 ) fixed bin (35) ext; 188 189 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr); 190 /* this is a non-freeing area */ 191 192 dcl dsl_$dl_scope_all entry (fixed bin (35), fixed bin (35)); 193 dcl dsl_$get_pn entry (fixed bin (35), char (168), char (20), fixed bin (35)); 194 dcl dsl_$get_scope_info entry (fixed bin (35), ptr, ptr, fixed bin (35)); 195 dcl dsl_$set_scope entry options (variable); 196 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35)); 197 dcl linus_scope 198 entry (ptr, ptr, entry, bit (1), fixed bin (35), fixed bin (35)); 199 dcl ssu_$abort_line entry options (variable); 200 dcl ssu_$arg_count entry (ptr, fixed bin); 201 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 202 203 ca_ptr = null; 204 scope_call_has_been_started = "0"b; 205 206 on cleanup 207 begin; 208 if ca_ptr ^= null 209 then free char_argl; 210 if lcb.timing_mode then 211 initial_mrds_vclock = vclock; 212 if scope_call_has_been_started 213 then call dsl_$dl_scope_all (lcb.db_index, icode); 214 if lcb.timing_mode then 215 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 216 end; 217 218 rel_name_index, icode, code = 0; 219 220 tm_flag = "0"b; 221 222 if lcb.db_index = 0 then 223 call error (linus_error_$no_db, ""); 224 225 call ssu_$arg_count (sci_ptr, nargs_init); 226 227 if nargs_init = 0 then 228 call error (linus_error_$no_input_arg, ""); 229 230 allocate char_argl in (lcb.static_area); 231 do i = 1 to nargs_init; 232 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 233 end; 234 235 temp_char_argl_nargs = char_argl.nargs; 236 l = char_argl.nargs - 1; /* check for control arg */ 237 if substr (arg, 1, 1) = "-" then do; /* control arg */ 238 if arg = "-tm" | arg = "-time" then do; 239 temp_char_argl_nargs = temp_char_argl_nargs - 2; 240 tm_flag = "1"b; 241 end; 242 else call 243 error (linus_error_$inv_arg, 244 "Unknown control argument. " || arg); 245 end; 246 else do; 247 l = char_argl.nargs; /* check for last arg being a control arg */ 248 if arg = "-tm" | arg = "-time" then 249 call 250 error (linus_error_$too_few_args, 251 "no seconds given for -time control"); 252 else if substr (arg, 1, 1) = "-" then 253 call 254 error (linus_error_$inv_arg, 255 "Unknown control argument. " || arg); 256 end; 257 num_args = temp_char_argl_nargs / 3; 258 if num_args * 3 ^= temp_char_argl_nargs then 259 call error (linus_error_$too_few_args, ""); 260 261 if tm_flag then do; 262 l = char_argl.nargs; 263 if verify (arg, "0123456789") ^= 0 | length (arg) > 9 then 264 wait_time = fixed (arg); 265 else call 266 error (linus_error_$inv_arg, 267 "wait time not integer >= 0 and <= 999999999"); 268 end; 269 270 nargs_init = temp_char_argl_nargs + 2 * fixed (tm_flag); 271 /* number of scope triplets + 2 if there is a wait time argument */ 272 if lcb.timing_mode then 273 initial_mrds_vclock = vclock; 274 call 275 dsl_$get_scope_info (lcb.db_index, lcb.linus_area_ptr, scope_ptr, 276 icode); 277 if lcb.timing_mode then 278 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 279 if icode ^= 0 then 280 call error (icode, ""); 281 if scope_info.active_scopes > 0 then do; 282 call dsl_$get_pn (lcb.db_index, db_path, mode, code); 283 if substr (mode, 1, 9) = "exclusive" then 284 call error (mrds_error_$unshared_opening, ""); 285 else call error (mrds_error_$scope_not_empty, ""); 286 end; 287 allocate rel_names in (work_area); 288 allocate permits in (work_area); 289 allocate prevents in (work_area); 290 do i = 1 to num_args; 291 rel_names (i), permits (i), prevents (i) = ""; 292 end; 293 allocate ch_argl in (work_area); 294 rel_name_index = 0; 295 296 do i = 1 to temp_char_argl_nargs by 3; /* make sure all relations exist */ 297 l = i; /* point to relation name */ 298 299 do k = 1 to scope_info.nfiles 300 while (arg ^= scope_info.scope.sm_name (k)); 301 end; 302 if k > scope_info.nfiles then /* could not find rel name in scope info */ 303 call 304 error (linus_error_$inv_table, 305 """" || arg 306 || """ is either a temp table, or an unknown table name."); 307 308 if rel_name_index = 0 then do; /* this is the first entry */ 309 rel_name_index, m = 1; 310 rel_names (rel_name_index) = scope_info.scope.sm_name (k); 311 end; 312 else do; 313 do m = 1 to rel_name_index 314 while (rel_names (m) ^= scope_info.scope.sm_name (k)); 315 end; 316 if m > rel_name_index then do; /* filename did not occur before */ 317 rel_name_index = m; /* so, enter new name */ 318 rel_names (m) = scope_info.scope.sm_name (k); 319 end; 320 end; 321 322 l = i + 1; /* point to permit ops */ 323 if verify (arg, SCOPE_MODES) ^= 0 then 324 call 325 error (linus_error_$ill_scp_op, "permit op " || arg); 326 /* set equivalent file permit ops */ 327 if search (arg, "r") ^= 0 then 328 permits (m) = "r"; 329 330 if search (arg, "u") ^= 0 then 331 permits (m) = rtrim (permits (m)) || "msd"; 332 else do; 333 if search (arg, "m") ^= 0 then 334 permits (m) = rtrim (permits (m)) || "m"; 335 if search (arg, "s") ^= 0 then 336 permits (m) = rtrim (permits (m)) || "s"; 337 if search (arg, "d") ^= 0 then 338 permits (m) = rtrim (permits (m)) || "d"; 339 end; 340 341 if search (arg, "n") ^= 0 & permits (m) = "" then 342 permits (m) = "n"; 343 344 l = i + 2; /* point to prevent ops */ 345 if verify (arg, SCOPE_MODES) ^= 0 then 346 call 347 error (linus_error_$ill_scp_op, "prevent op " || arg); 348 /* set equivalent file prevent ops */ 349 if search (arg, "r") ^= 0 then 350 prevents (m) = "r"; 351 352 if search (arg, "u") ^= 0 then 353 prevents (m) = rtrim (prevents (m)) || "msd"; 354 else do; 355 if search (arg, "m") ^= 0 then 356 prevents (m) = rtrim (prevents (m)) || "m"; 357 if search (arg, "s") ^= 0 then 358 prevents (m) = rtrim (prevents (m)) || "s"; 359 if search (arg, "d") ^= 0 then 360 prevents (m) = rtrim (prevents (m)) || "d"; 361 end; 362 363 if search (arg, "n") ^= 0 & prevents (m) = "" then 364 prevents (m) = "n"; 365 366 ch_argl.arg.arg_ptr (i) = addr (rel_names (rel_name_index)); 367 ch_argl.arg.arg_len (i) = length (rel_names (rel_name_index)); 368 ch_argl.arg.arg_ptr (i + 1) = addr (permits (rel_name_index)); 369 /* init permit ops */ 370 ch_argl.arg.arg_ptr (i + 2) = addr (prevents (rel_name_index)); 371 /* init prevent ops */ 372 ch_argl.arg.arg_len (i + 1) = 373 length (rtrim (permits (rel_name_index))); 374 ch_argl.arg.arg_len (i + 2) = 375 length (rtrim (prevents (rel_name_index))); 376 end; /* input arg processing loop */ 377 if tm_flag then do; 378 ch_argl.nargs = ch_argl.nargs + 1; 379 ch_argl.arg.arg_len (ch_argl.nargs) = 380 char_argl.arg.arg_len (char_argl.nargs - 1); 381 ch_argl.arg.arg_ptr (ch_argl.nargs) = 382 char_argl.arg.arg_ptr (char_argl.nargs - 1); 383 ch_argl.nargs = ch_argl.nargs + 1; 384 ch_argl.arg.arg_len (ch_argl.nargs) = 385 char_argl.arg.arg_len (char_argl.nargs); 386 ch_argl.arg.arg_ptr (ch_argl.nargs) = 387 char_argl.arg.arg_ptr (char_argl.nargs); 388 end; 389 390 ds_flag = "0"b; 391 scope_call_has_been_started = "1"b; 392 call 393 linus_scope (lcb_ptr, ch_ptr, dsl_$set_scope, ds_flag, wait_time, 394 icode); 395 if icode ^= 0 then 396 call error (icode, ""); 397 exit: 398 return; 399 400 error: 401 proc (err_code, string); 402 403 dcl err_code fixed bin (35); 404 dcl string char (*); 405 406 if ca_ptr ^= null 407 then free char_argl; 408 call linus_convert_code (err_code, out_code, linus_data_$ss_id); 409 call ssu_$abort_line (sci_ptr, out_code, string); 410 411 end error; 412 413 end linus_set_scope; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 1000.0 linus_set_scope.pl1 >special_ldd>online>mrds.pbf-04/18/85>linus_set_scope.pl1 123 1 09/16/83 1338.1 linus_lcb.incl.pl1 >ldd>include>linus_lcb.incl.pl1 125 2 11/23/82 1327.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 127 3 04/18/85 0918.3 mdbm_scope_info.incl.pl1 >special_ldd>online>mrds.pbf-04/18/85>mdbm_scope_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. SCOPE_MODES 000000 constant char(6) initial unaligned dcl 162 ref 323 345 active_scopes 5 based fixed bin(17,0) level 2 dcl 3-32 ref 281 addr builtin function dcl 173 ref 366 368 370 arg 2 based structure array level 2 in structure "ch_argl" dcl 165 in procedure "linus_set_scope" arg based char unaligned dcl 157 in procedure "linus_set_scope" ref 237 238 238 242 248 248 252 252 263 263 263 299 302 323 323 327 330 333 335 337 341 345 345 349 352 355 357 359 363 arg 2 based structure array level 2 in structure "char_argl" dcl 2-9 in procedure "linus_set_scope" arg_len 4 based fixed bin(17,0) array level 3 in structure "ch_argl" dcl 165 in procedure "linus_set_scope" set ref 367* 372* 374* 379* 384* arg_len 4 based fixed bin(21,0) array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_set_scope" set ref 232* 237 238 238 242 248 248 252 252 263 263 263 299 302 323 323 327 330 333 335 337 341 345 345 349 352 355 357 359 363 379 384 arg_ptr 2 based pointer array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_set_scope" set ref 232* 237 238 238 242 248 248 252 252 263 263 263 299 302 323 323 327 330 333 335 337 341 345 345 349 352 355 357 359 363 381 386 arg_ptr 2 based pointer array level 3 in structure "ch_argl" dcl 165 in procedure "linus_set_scope" set ref 366* 368* 370* 381* 386* ca_ptr 000100 automatic pointer dcl 2-15 set ref 203* 208 208 230* 232 232 235 236 237 237 238 238 238 238 242 242 247 248 248 248 248 252 252 252 252 262 263 263 263 263 263 263 299 299 302 302 323 323 323 323 327 327 330 330 333 333 335 335 337 337 341 341 345 345 345 345 349 349 352 352 355 355 357 357 359 359 363 363 379 379 381 381 384 384 386 386 406 406 ch_argl based structure level 1 dcl 165 set ref 293 ch_ptr 000202 automatic pointer initial dcl 140 set ref 140* 293* 366 367 368 370 372 374 378 378 379 379 381 381 383 383 384 384 386 386 392* char_argl based structure level 1 dcl 2-9 set ref 208 230 406 cleanup 000222 stack reference condition dcl 171 ref 206 code 000216 automatic fixed bin(35,0) dcl 149 set ref 218* 282* db_index based fixed bin(35,0) level 2 dcl 1-43 set ref 212* 222 274* 282* db_path 000120 automatic char(168) unaligned dcl 135 set ref 282* ds_flag 000177 automatic bit(1) unaligned dcl 137 set ref 390* 392* dsl_$dl_scope_all 000032 constant entry external dcl 192 ref 212 dsl_$get_pn 000034 constant entry external dcl 193 ref 282 dsl_$get_scope_info 000036 constant entry external dcl 194 ref 274 dsl_$set_scope 000040 constant entry external dcl 195 ref 392 392 e_ptr 000204 automatic pointer initial dcl 140 set ref 140* env_ptr 000206 automatic pointer initial dcl 140 set ref 140* err_code parameter fixed bin(35,0) dcl 403 set ref 400 408* fixed builtin function dcl 173 ref 263 270 i 000107 automatic fixed bin(17,0) dcl 131 set ref 231* 232* 232 232* 290* 291 291 291* 296* 297 322 344 366 367 368 370 372 374* icode 000217 automatic fixed bin(35,0) dcl 149 set ref 212* 218* 274* 279 279* 392* 395 395* initial_mrds_vclock 000116 automatic float bin(63) dcl 133 set ref 210* 214 272* 277 k 000110 automatic fixed bin(17,0) dcl 131 set ref 299* 299* 302 310 313 318 l 000111 automatic fixed bin(17,0) dcl 131 set ref 236* 237 237 238 238 238 238 242 242 247* 248 248 248 248 252 252 252 252 262* 263 263 263 263 263 263 297* 299 299 302 302 322* 323 323 323 323 327 327 330 330 333 333 335 335 337 337 341 341 344* 345 345 345 345 349 349 352 352 355 355 357 357 359 359 363 363 lcb based structure level 1 dcl 1-43 lcb_ptr parameter pointer dcl 1-110 set ref 19 210 212 214 214 214 222 230 272 274 274 277 277 277 282 287 288 289 293 392* length builtin function dcl 173 ref 263 367 372 374 linus_area_ptr 60 based pointer level 2 dcl 1-43 set ref 274* 287 288 289 293 linus_convert_code 000042 constant entry external dcl 196 ref 408 linus_data_$ss_id 000010 external static fixed bin(35,0) dcl 176 set ref 408* linus_error_$ill_scp_op 000012 external static fixed bin(35,0) dcl 176 set ref 323* 345* linus_error_$inv_arg 000014 external static fixed bin(35,0) dcl 176 set ref 242* 252* 265* linus_error_$inv_table 000016 external static fixed bin(35,0) dcl 176 set ref 302* linus_error_$no_db 000020 external static fixed bin(35,0) dcl 176 set ref 222* linus_error_$no_input_arg 000022 external static fixed bin(35,0) dcl 176 set ref 227* linus_error_$too_few_args 000024 external static fixed bin(35,0) dcl 176 set ref 248* 258* linus_scope 000044 constant entry external dcl 197 ref 392 m 000112 automatic fixed bin(17,0) dcl 131 set ref 309* 313* 313* 316 317 318 327 330 330 333 333 335 335 337 337 341 341 349 352 352 355 355 357 357 359 359 363 363 mode 000172 automatic char(20) unaligned dcl 136 set ref 282* 283 mrds_error_$scope_not_empty 000026 external static fixed bin(35,0) dcl 176 set ref 285* mrds_error_$unshared_opening 000030 external static fixed bin(35,0) dcl 176 set ref 283* mrds_time 74 based float bin(63) level 2 dcl 1-43 set ref 214* 214 277* 277 nargs based fixed bin(17,0) level 2 in structure "ch_argl" dcl 165 in procedure "linus_set_scope" set ref 293* 378* 378 379 381 383* 383 384 386 nargs based fixed bin(17,0) level 2 in structure "char_argl" dcl 2-9 in procedure "linus_set_scope" set ref 208 230* 235 236 247 262 379 381 384 386 406 nargs_init 000102 automatic fixed bin(17,0) dcl 2-16 set ref 225* 227 230 230 231 270* 293 293 nfiles 4 based fixed bin(17,0) level 2 dcl 3-32 ref 299 302 null builtin function dcl 173 ref 203 3-59 140 140 140 140 140 140 208 406 num_args 000113 automatic fixed bin(17,0) dcl 131 set ref 257* 258 287 288 289 290 out_code 000220 automatic fixed bin(35,0) dcl 149 set ref 408* 409* permits based char(5) array unaligned dcl 159 set ref 288 291* 327* 330* 330 333* 333 335* 335 337* 337 341 341* 368 372 permits_ptr 000212 automatic pointer initial dcl 140 set ref 140* 288* 291 327 330 330 333 333 335 335 337 337 341 341 368 372 prevents based char(5) array unaligned dcl 160 set ref 289 291* 349* 352* 352 355* 355 357* 357 359* 359 363 363* 370 374 prevents_ptr 000214 automatic pointer initial dcl 140 set ref 140* 289* 291 349 352 352 355 355 357 357 359 359 363 363 370 374 rel_name_index 000106 automatic fixed bin(17,0) dcl 131 set ref 218* 294* 308 309* 310 313 316 317* 366 367 368 370 372 374 rel_name_ptr 000210 automatic pointer initial dcl 140 set ref 140* 287* 291 310 313 318 366 367 rel_names based char(32) array unaligned dcl 158 set ref 287 291* 310* 313 318* 366 367 rtrim builtin function dcl 173 ref 330 333 335 337 352 355 357 359 372 374 sci_ptr parameter pointer dcl 129 set ref 19 225* 232* 409* scope 6 based structure array level 2 dcl 3-32 scope_call_has_been_started 000201 automatic bit(1) unaligned dcl 138 set ref 204* 212 391* scope_flags based structure level 1 dcl 3-42 scope_info based structure level 1 dcl 3-32 scope_ptr 000104 automatic pointer initial dcl 3-59 set ref 274* 281 299 299 302 310 313 318 3-59* search builtin function dcl 173 ref 327 330 333 335 337 341 349 352 355 357 359 363 sm_name 16 based char(32) array level 3 dcl 3-32 ref 299 310 313 318 ssu_$abort_line 000046 constant entry external dcl 199 ref 409 ssu_$arg_count 000050 constant entry external dcl 200 ref 225 ssu_$arg_ptr 000052 constant entry external dcl 201 ref 232 static_area 144 based area level 2 dcl 1-43 ref 230 string parameter char unaligned dcl 404 set ref 400 409* substr builtin function dcl 173 ref 237 252 283 temp_char_argl_nargs 000114 automatic fixed bin(17,0) dcl 131 set ref 235* 239* 239 257 258 270 296 timing_mode 15(05) based bit(1) level 2 packed unaligned dcl 1-43 ref 210 214 272 277 tm_flag 000200 automatic bit(1) unaligned dcl 137 set ref 220* 240* 261 270 377 vclock builtin function dcl 173 ref 210 214 272 277 verify builtin function dcl 173 ref 263 323 345 wait_time 000221 automatic fixed bin(35,0) initial dcl 149 set ref 149* 263* 392* work_area based area dcl 189 ref 287 288 289 293 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. max_file_init automatic fixed bin(17,0) dcl 3-58 rel builtin function dcl 173 scope_rdy internal static bit(6) initial unaligned dcl 3-60 scope_rdy_array based bit(1) array unaligned dcl 3-61 sys_info$max_seg_size external static fixed bin(35,0) dcl 176 NAMES DECLARED BY EXPLICIT CONTEXT. error 002532 constant entry internal dcl 400 ref 222 227 242 248 252 258 265 279 283 285 302 323 345 395 exit 002530 constant label dcl 397 linus_set_scope 000116 constant entry external dcl 19 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5070 5144 4632 5100 Length 5434 4632 54 253 236 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_set_scope 360 external procedure is an external procedure. on unit on line 206 70 on unit error 88 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_set_scope 000100 ca_ptr linus_set_scope 000102 nargs_init linus_set_scope 000104 scope_ptr linus_set_scope 000106 rel_name_index linus_set_scope 000107 i linus_set_scope 000110 k linus_set_scope 000111 l linus_set_scope 000112 m linus_set_scope 000113 num_args linus_set_scope 000114 temp_char_argl_nargs linus_set_scope 000116 initial_mrds_vclock linus_set_scope 000120 db_path linus_set_scope 000172 mode linus_set_scope 000177 ds_flag linus_set_scope 000200 tm_flag linus_set_scope 000201 scope_call_has_been_started linus_set_scope 000202 ch_ptr linus_set_scope 000204 e_ptr linus_set_scope 000206 env_ptr linus_set_scope 000210 rel_name_ptr linus_set_scope 000212 permits_ptr linus_set_scope 000214 prevents_ptr linus_set_scope 000216 code linus_set_scope 000217 icode linus_set_scope 000220 out_code linus_set_scope 000221 wait_time linus_set_scope THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc return mpfx2 enable shorten_stack ext_entry int_entry int_entry_desc trunc_fx2 any_to_any_tr divide_fx1 alloc_based free_based vclock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. dsl_$dl_scope_all dsl_$get_pn dsl_$get_scope_info dsl_$set_scope linus_convert_code linus_scope ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_data_$ss_id linus_error_$ill_scp_op linus_error_$inv_arg linus_error_$inv_table linus_error_$no_db linus_error_$no_input_arg linus_error_$too_few_args mrds_error_$scope_not_empty mrds_error_$unshared_opening LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 19 000112 3 59 000123 140 000125 149 000133 203 000134 204 000135 206 000136 208 000152 210 000164 212 000200 214 000213 216 000231 218 000232 220 000235 222 000236 225 000257 227 000271 230 000310 231 000324 232 000333 233 000353 235 000355 236 000357 237 000361 238 000371 239 000402 240 000404 241 000406 242 000407 245 000442 247 000444 248 000446 252 000503 256 000542 257 000543 258 000552 261 000572 262 000574 263 000576 265 000636 270 000656 272 000666 274 000700 277 000715 279 000731 281 000747 282 000752 283 000771 285 001013 287 001030 288 001041 289 001054 290 001067 291 001077 292 001117 293 001121 294 001135 296 001136 297 001145 299 001146 301 001175 302 001177 308 001252 309 001255 310 001260 311 001273 313 001274 315 001317 316 001321 317 001324 318 001325 322 001340 323 001343 327 001415 330 001444 332 001516 333 001517 335 001566 337 001637 339 001710 341 001711 344 001740 345 001743 349 002014 352 002043 354 002115 355 002116 357 002165 359 002236 361 002307 363 002310 366 002337 367 002350 368 002352 370 002362 372 002366 374 002401 376 002414 377 002417 378 002421 379 002422 381 002432 383 002442 384 002443 386 002452 390 002461 391 002462 392 002464 395 002512 397 002530 400 002531 406 002545 408 002557 409 002574 411 002621 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved