COMPILATION LISTING OF SEGMENT linus_del_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 1117.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 linus_del_scope: 19 proc (sci_ptr, lcb_ptr); 20 21 /* NOTES: 22* 23* This procedure calls linus_scope to delete scope after first processing the 24* control arguments. 25* 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 based on 34* lcb.linus_area_ptr instead of getting system free area. 35* 36* 80-06-01 Jim Gray: Modified to make the del_scope_all options, a force all 37* scope off, even if none is set, so that if reset outside linus, linus will 38* not think it still has scope. 39* 40* 80-06-02 Jim Gray: Modified to improve error messages, and to ignore the "n" 41* permit/prevent op, except when given by itself. 42* 43* 80-06-03 Jim Gray: Modified to make delete of "n" legal for partial deletes, 44* and to remove "u" from the file permit/prevent when last of s, m, or d is 45* gone. 46* 47* 80-06-04 Jim Gray: Modified to correctly handle duplicate relation names, 48* instead of not deleting any scope, and resetting scope_data. Also added 49* capture of del_scope on a exclusive open mode. 50* 51* 80-12-22 Jim Gray : changed r-u to r-s-m-d scope modes, and renamed for 52* security compatibility, thus r-a-m-d. s and u still accepted. 53* 54* 80-12-23 Jim Gray : changed ch_argl.arg.arg_len from being set to a 55* constant, into calculation of actual non-blank length of pervent/permit 56* modes. 57* 58* 80-12-31 Jim Gray : changed detection of deletion of improper subset of 59* scope into a mrds detectable item, to get sub_err_ specifics, and added 60* management of touched bit in scope_data structure. Also fixed bug with 61* deleting scope when non had been set that didn't report the error. 62* 63* 81-1-12 Jim Gray : changed handling of touched bit in scope_data, now that 64* part of flags section. 65* 66* 81-04-21 Rickie E. Brinegar: Changed r-a-m-d to r-s-m-d as scopes in LINUS 67* are defined as operation prevention and permission and the LINUS request is 68* store, not append. 69* 70* 81-05-27 Rickie E. Brinegar: Modified to use dsl_$get_pn instead of 71* mdbm_util_$get_resultant_model_ptr. LINUS no longer directly mucks with 72* the resultant model. It gets information from the resultant model. 73* 74* 81-11-17 Rickie E. Brinegar: Added timing of dsl calls and changed to pass 75* linus_scope the dsl_$dl_scope entry instead of an entry pointer to 76* dsl_$dl_scope. 77* 78* 82-02-10 Paul W. Benjamin: ssu_ conversion. 79* 80* 82-06-21 Al Dupuis: removed unnecessary call to ssu_$abort_subsystem. 81* 82**/ 83 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 */ 84 85 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 */ 86 87 3 1 /* BEGIN INCLUDE FILE linus_force_ret.incl.pl1 -- jccj 4/29/77 */ 3 2 3 3 dcl 1 force_ret aligned based (sfr_ptr), /* Structure for forced retrievals */ 3 4 2 nargs fixed bin, /* Number of relations */ 3 5 2 arg (ret_nargs_init refer (force_ret.nargs)), 3 6 3 rel_name char (32), /* relation name */ 3 7 3 ret_flag bit (1); /* 1 = retrieve was forced */ 3 8 3 9 dcl sfr_ptr ptr; 3 10 dcl ret_nargs_init fixed bin; 3 11 3 12 /* END INCLUDE FILE linus_force_ret.incl.pl1 */ 88 89 4 1 /* BEGIN mdbm_scope_info.incl.pl1 -- odf 8/8/78 */ 4 2 4 3 /* WARNING 4 4* If the scope_info or scope_flags structure is changed then the 4 5* mrds_data_ item saved_res_version MUST be incremented to invalidate 4 6* all existing saved resultants 4 7**/ 4 8 4 9 /* Modified by Jim Gray - - 80-11-17, to add back store/delete/modify permissions */ 4 10 4 11 /* 80-12-10 Jim Gray : change name of store to append_tuple, delete to delete_tuple, 4 12* modify to modify_attr, retrieve to read_attr, remvoe update, put level 4 4 13* qualifiers for permit/prevent modes and to put pads in standard format */ 4 14 4 15 /* 80-12-11 Jim Gray : added submodel version of file/rel name for convenience */ 4 16 4 17 /* 80-12-22 Jim Gray : added like referenced structure so linus_scope_data.incl 4 18* could make use of it for compatibility. */ 4 19 4 20 /* 81-1-11 Jim Gray : added touched bit to scope_flags, so that 4 21* the fact that null scope has been set can be displayed */ 4 22 4 23 /* 85-04-14 Thanh Nguyen: Made scope_flags to be aligned so we could access the 4 24* prevent flags from any pointer which directly pointed to scope_flags itself 4 25* (i.e rm_rel_info.scope_flags_ptr). */ 4 26 4 27 /* this structure is to be allocated in the mrds_dbcb.incl.pl1 static area, 4 28* and is used to maintain the scope mechanism for file access. 4 29* It contains the scope permit/prevent operations that this user 4 30* has set in his view for this opening instance. */ 4 31 4 32 dcl 1 scope_info aligned based (scope_ptr), /* array of scope tuples for this user */ 4 33 2 mbz1 bit (144), /* Reserved for future use */ 4 34 2 nfiles fixed bin, /* Number of scope tuples in user's scope */ 4 35 2 active_scopes fixed bin, /* number of scopes currently active for a given user */ 4 36 2 scope (max_file_init refer (scope_info.nfiles)), /* defines user's scope of access to files */ 4 37 3 name char (30) aligned, /* filename */ 4 38 3 sm_name char (32), /* name of file(rel) in submodel */ 4 39 3 flags like scope_flags ; 4 40 4 41 4 42 declare 1 scope_flags aligned based, /* common layout of scope flag bits */ 4 43 2 permits, /* modes to permit this user */ 4 44 3 read_attr bit (1) unal, /* read_attr access to this file in scope */ 4 45 3 append_tuple bit (1) unal, /* append_tuple concnrrency permission */ 4 46 3 delete_tuple bit (1) unal, /* delete_tuple concurrency permission on rel */ 4 47 3 modify_attr bit (1) unal, /* modify_attr concurrency permission */ 4 48 3 mbz2 bit (10) unal, /* for expansion of permit ops */ 4 49 2 prevents, /* modes to be denyed to other users */ 4 50 3 read_attr bit (1) unal, /* on if user has prevent on read_attr for this file */ 4 51 3 append_tuple bit (1) unal, /* prevent of append_tuple concurrency */ 4 52 3 delete_tuple bit (1) unal, /* prevent of delete_tuple concurrency */ 4 53 3 modify_attr bit (1) unal, /* prevent of modify_attr concurrency */ 4 54 3 mbz3 bit (10) unal, /* for future prevent concurrency modes */ 4 55 2 touched bit (1) unal, /* on => scope set for this relation */ 4 56 2 mbz4 bit (7) unal ; /* for future flags */ 4 57 4 58 dcl max_file_init fixed bin; /* nbr. of files in data base */ 4 59 dcl scope_ptr ptr init (null ()); /* points to scope_info array */ 4 60 dcl scope_rdy bit (6) unal init ("000011"b) int static options (constant); /* scope file ready modes (5 or 6) */ 4 61 dcl scope_rdy_array (6) bit (1) unal based; /* array format of scope_rdy string */ 4 62 4 63 /* END mdbm_scope_info.incl.pl1 */ 90 91 92 dcl sci_ptr ptr; /* for ssu_ */ 93 94 dcl (rel_names_index, i, k, l, m, num_args, trel_names_index) fixed bin; 95 /* file name loop index */ 96 97 dcl ( 98 code, 99 icode, 100 out_code, 101 wait_time init (0) 102 ) fixed bin (35); 103 104 dcl initial_mrds_vclock float bin (63); 105 106 dcl mrds_error_$unshared_opening fixed bin (35) ext; 107 108 dcl ds_flag bit (1); 109 110 dcl ( 111 ch_ptr init (null), 112 e_ptr init (null), 113 env_ptr init (null), 114 rel_names_ptr init (null), 115 permits_ptr init (null), 116 prevents_ptr init (null), 117 temp_sd_ptr init (null) 118 ) ptr; /* points to temp copy of scope data */ 119 120 dcl db_path char (168); 121 122 dcl mode char (20); 123 124 dcl arg char (char_argl.arg.arg_len (l)) based (char_argl.arg.arg_ptr (l)); 125 dcl rel_names (num_args) char (32) unal based (rel_names_ptr); 126 dcl permits (num_args) char (5) unal based (permits_ptr); 127 dcl prevents (num_args) char (5) unal based (prevents_ptr); 128 129 dcl 1 ch_argl aligned based (ch_ptr), /* like char_argl */ 130 2 nargs fixed bin, 131 2 arg (nargs_init refer (ch_argl.nargs)), 132 3 arg_ptr ptr, 133 3 arg_len fixed bin; 134 135 dcl (addr, fixed, length, null, rel, rtrim, search, substr, verify, vclock) 136 builtin; 137 138 dcl cleanup condition; 139 140 dcl mode_temp char (5) varying; /* for building fscope request */ 141 142 dcl SCOPE_MODES char (6) init ("nsrmdu") int static options (constant); 143 /* leagl scope modes */ 144 145 dcl ( 146 linus_data_$ss_id, 147 linus_error_$ill_scp_op, 148 linus_error_$inv_table, 149 linus_error_$no_db, 150 linus_error_$no_input_arg, 151 linus_error_$too_few_args, 152 sys_info$max_seg_size 153 ) fixed bin (35) ext; 154 155 dcl dsl_$dl_scope entry options (variable); 156 dcl dsl_$dl_scope_all entry (fixed bin (35), fixed bin (35)); 157 dcl dsl_$get_pn entry (fixed bin (35), char (168), char (20), fixed bin (35)); 158 dcl dsl_$get_scope_info entry options (variable); 159 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35)); 160 dcl linus_scope 161 entry (ptr, ptr, entry, bit (1), fixed bin (35), fixed bin (35)); 162 dcl ssu_$abort_line entry options (variable); 163 dcl ssu_$arg_count entry (ptr, fixed bin); 164 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 165 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr); 166 167 ca_ptr, rel_names_ptr, ch_ptr, permits_ptr, prevents_ptr = null; 168 169 rel_names_index, icode, code = 0; 170 171 if lcb.db_index = 0 then 172 call error (linus_error_$no_db, ""); 173 call ssu_$arg_count (sci_ptr, nargs_init); 174 if nargs_init = 0 then 175 call error (linus_error_$no_input_arg, ""); 176 177 l = 1; 178 179 /* make sure this is a shared open mode */ 180 181 if lcb.timing_mode then 182 initial_mrds_vclock = vclock; 183 allocate char_argl in (lcb.static_area); 184 on cleanup begin; 185 if ca_ptr ^= null 186 then free char_argl; 187 end; 188 do i = 1 to nargs_init; 189 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 190 end; 191 call dsl_$get_pn (lcb.db_index, db_path, mode, code); 192 if lcb.timing_mode then 193 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 194 if code ^= 0 then 195 call error (code, ""); 196 if substr (mode, 1, 9) = "exclusive" then 197 call error (mrds_error_$unshared_opening, ""); 198 if char_argl.nargs = 1 & arg = "*" then 199 call del_scope; 200 else do; 201 num_args = char_argl.nargs / 3; 202 if num_args * 3 ^= char_argl.nargs then 203 call error (linus_error_$too_few_args, ""); 204 allocate rel_names in (work_area); 205 allocate permits in (work_area); 206 allocate prevents in (work_area); 207 208 do i = 1 to num_args; 209 rel_names (i), permits (i), prevents (i) = ""; 210 end; 211 212 call get_scope; /* build list of file scopes */ 213 214 do i = 1 to rel_names_index; /* make sure scopes are valid */ 215 if permits (i) = "" | prevents (i) = "" then 216 call error (linus_error_$ill_scp_op, ""); 217 end; 218 219 nargs_init = char_argl.nargs; 220 allocate ch_argl in (work_area); 221 trel_names_index = rel_names_index; /* remember original number of files */ 222 rel_names_index = 0; 223 do i = 1 to ch_argl.nargs by 3; 224 rel_names_index = rel_names_index + 1; /* get next filename */ 225 do rel_names_index = rel_names_index to trel_names_index 226 while (rel_names (rel_names_index) = ""); 227 end; /* skip file names not to be used */ 228 ch_argl.arg.arg_ptr (i) = addr (rel_names (rel_names_index)); 229 ch_argl.arg.arg_len (i) = length (rel_names (rel_names_index)); 230 ch_argl.arg.arg_ptr (i + 1) = addr (permits (rel_names_index)); 231 /* init permit ops */ 232 ch_argl.arg.arg_ptr (i + 2) = addr (prevents (rel_names_index)); 233 /* init prevent ops */ 234 ch_argl.arg.arg_len (i + 2) = 235 length (rtrim (prevents (rel_names_index))); 236 ch_argl.arg.arg_len (i + 1) = 237 length (rtrim (permits (rel_names_index))); 238 end; 239 240 call del_scope; 241 end; 242 243 if ca_ptr ^= null 244 then free char_argl; 245 246 return; 247 248 del_scope: 249 proc; 250 ds_flag = "1"b; 251 if char_argl.nargs = 1 & arg = "*" then do; 252 253 if lcb.sfr_ptr ^= null then do; 254 free lcb.sfr_ptr -> force_ret; 255 lcb.sfr_ptr = null; 256 end; 257 if lcb.timing_mode then 258 initial_mrds_vclock = vclock; 259 call dsl_$dl_scope_all (lcb.db_index, icode); 260 if lcb.timing_mode then 261 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 262 if icode ^= 0 then 263 call error (icode, ""); 264 end; 265 else do; 266 if lcb.timing_mode then 267 initial_mrds_vclock = vclock; 268 call 269 linus_scope (lcb_ptr, ch_ptr, dsl_$dl_scope, ds_flag, wait_time, 270 icode); 271 if lcb.timing_mode then 272 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 273 if icode ^= 0 then 274 call error (icode, ""); 275 end; 276 277 end del_scope; 278 279 get_scope: 280 proc; 281 282 /* list of files containing relations specified is built and scope settings are verified */ 283 284 if lcb.timing_mode then 285 initial_mrds_vclock = vclock; 286 call 287 dsl_$get_scope_info (lcb.db_index, lcb.linus_area_ptr, scope_ptr, 288 icode); 289 if lcb.timing_mode then 290 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 291 if icode ^= 0 then 292 call error (icode, ""); 293 294 do i = 1 to char_argl.nargs by 3; /* for all input args */ 295 l = i; /* point to relation name */ 296 do k = 1 to scope_info.nfiles /* find relation name */ 297 while (arg ^= scope_info.scope.sm_name (k)); 298 end; 299 if k > scope_info.nfiles then 300 call 301 error (linus_error_$inv_table, 302 """" || arg || """ is either a temp table " 303 || "or an unknown table name."); 304 if rel_names_index = 0 then do; /* this is the first entry */ 305 rel_names_index, m = 1; 306 rel_names (rel_names_index) = scope_info.scope.sm_name (k); 307 end; 308 else do; 309 do m = 1 to rel_names_index 310 while (rel_names (m) ^= scope_info.scope.sm_name (k)); 311 end; 312 if m > rel_names_index then do; /* filename did not occur before */ 313 rel_names_index = m; /* so, enter new name */ 314 rel_names (m) = scope_info.scope.sm_name (k); 315 end; 316 end; 317 318 call verify_scope; 319 320 end; /* input arg processing loop */ 321 322 323 end get_scope; 324 325 verify_scope: 326 proc; 327 328 /* if verify bit is on scope is verified and rel_names, permits & prevents 329* arrays are updated. else scope is reset. */ 330 331 permits (m), prevents (m) = ""; /* initialize in case of dup rel names */ 332 333 l = i + 1; /* point to permit ops */ 334 if verify (arg, SCOPE_MODES) ^= 0 then 335 call error (linus_error_$ill_scp_op, "permit op " || arg); 336 337 mode_temp = ""; 338 339 if search (arg, "r") ^= 0 then 340 mode_temp = mode_temp || "r"; 341 342 if search (arg, "u") ^= 0 then 343 mode_temp = mode_temp || "msd"; 344 else do; 345 if search (arg, "s") ^= 0 then 346 mode_temp = mode_temp || "s"; 347 if search (arg, "d") ^= 0 then 348 mode_temp = mode_temp || "d"; 349 if search (arg, "m") ^= 0 then 350 mode_temp = mode_temp || "m"; 351 end; 352 353 permits (m) = mode_temp; 354 355 if search (arg, "n") ^= 0 & permits (m) = "" then 356 permits (m) = "n"; /* can always delete null part of current scope */ 357 358 l = i + 2; /* point to prevent ops */ 359 if verify (arg, SCOPE_MODES) ^= 0 then 360 call error (linus_error_$ill_scp_op, "prevent op " || arg); 361 /* set equivalent file prevent ops */ 362 363 mode_temp = ""; 364 365 if search (arg, "r") ^= 0 then 366 mode_temp = mode_temp || "r"; 367 368 if search (arg, "u") ^= 0 then 369 mode_temp = mode_temp || "msd"; 370 else do; 371 if search (arg, "s") ^= 0 then 372 mode_temp = mode_temp || "s"; 373 if search (arg, "d") ^= 0 then 374 mode_temp = mode_temp || "d"; 375 if search (arg, "m") ^= 0 then 376 mode_temp = mode_temp || "m"; 377 end; 378 379 prevents (m) = mode_temp; 380 381 if search (arg, "n") ^= 0 & prevents (m) = "" then 382 prevents (m) = "n"; /* can always delete null portion */ 383 384 end verify_scope; 385 386 error: 387 proc (err_code, string); 388 389 dcl err_code fixed bin (35); 390 dcl string char (*); 391 392 if ca_ptr ^= null 393 then free char_argl; 394 call linus_convert_code (err_code, out_code, linus_data_$ss_id); 395 call ssu_$abort_line (sci_ptr, out_code, string); 396 397 end error; 398 399 400 end linus_del_scope; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0959.9 linus_del_scope.pl1 >special_ldd>online>mrds.pbf-04/18/85>linus_del_scope.pl1 84 1 09/16/83 1338.1 linus_lcb.incl.pl1 >ldd>include>linus_lcb.incl.pl1 86 2 11/23/82 1327.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 88 3 03/27/82 0434.5 linus_force_ret.incl.pl1 >ldd>include>linus_force_ret.incl.pl1 90 4 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 142 ref 334 359 addr builtin function dcl 135 ref 228 230 232 arg 2 based structure array level 2 in structure "ch_argl" dcl 129 in procedure "linus_del_scope" arg 2 based structure array level 2 in structure "char_argl" dcl 2-9 in procedure "linus_del_scope" arg based char unaligned dcl 124 in procedure "linus_del_scope" ref 198 251 296 299 334 334 339 342 345 347 349 355 359 359 365 368 371 373 375 381 arg_len 4 based fixed bin(21,0) array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_del_scope" set ref 189* 198 251 296 299 334 334 339 342 345 347 349 355 359 359 365 368 371 373 375 381 arg_len 4 based fixed bin(17,0) array level 3 in structure "ch_argl" dcl 129 in procedure "linus_del_scope" set ref 229* 234* 236* arg_ptr 2 based pointer array level 3 in structure "ch_argl" dcl 129 in procedure "linus_del_scope" set ref 228* 230* 232* arg_ptr 2 based pointer array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_del_scope" set ref 189* 198 251 296 299 334 334 339 342 345 347 349 355 359 359 365 368 371 373 375 381 ca_ptr 000100 automatic pointer dcl 2-15 set ref 167* 183* 185 185 189 189 198 198 198 201 202 219 243 243 251 251 251 294 296 296 299 299 334 334 334 334 339 339 342 342 345 345 347 347 349 349 355 355 359 359 359 359 365 365 368 368 371 371 373 373 375 375 381 381 392 392 ch_argl based structure level 1 dcl 129 set ref 220 ch_ptr 000126 automatic pointer initial dcl 110 set ref 110* 167* 220* 223 228 229 230 232 234 236 268* char_argl based structure level 1 dcl 2-9 set ref 183 185 243 392 cleanup 000224 stack reference condition dcl 138 ref 184 code 000115 automatic fixed bin(35,0) dcl 97 set ref 169* 191* 194 194* db_index based fixed bin(35,0) level 2 dcl 1-43 set ref 171 191* 259* 286* db_path 000144 automatic char(168) unaligned dcl 120 set ref 191* ds_flag 000124 automatic bit(1) unaligned dcl 108 set ref 250* 268* dsl_$dl_scope 000026 constant entry external dcl 155 ref 268 268 dsl_$dl_scope_all 000030 constant entry external dcl 156 ref 259 dsl_$get_pn 000032 constant entry external dcl 157 ref 191 dsl_$get_scope_info 000034 constant entry external dcl 158 ref 286 e_ptr 000130 automatic pointer initial dcl 110 set ref 110* env_ptr 000132 automatic pointer initial dcl 110 set ref 110* err_code parameter fixed bin(35,0) dcl 389 set ref 386 394* force_ret based structure level 1 dcl 3-3 ref 254 i 000107 automatic fixed bin(17,0) dcl 94 set ref 188* 189* 189 189* 208* 209 209 209* 214* 215 215* 223* 228 229 230 232 234 236* 294* 295* 333 358 icode 000116 automatic fixed bin(35,0) dcl 97 set ref 169* 259* 262 262* 268* 273 273* 286* 291 291* initial_mrds_vclock 000122 automatic float bin(63) dcl 104 set ref 181* 192 257* 260 266* 271 284* 289 k 000110 automatic fixed bin(17,0) dcl 94 set ref 296* 296* 299 306 309 314 l 000111 automatic fixed bin(17,0) dcl 94 set ref 177* 198 198 251 251 295* 296 296 299 299 333* 334 334 334 334 339 339 342 342 345 345 347 347 349 349 355 355 358* 359 359 359 359 365 365 368 368 371 371 373 373 375 375 381 381 lcb based structure level 1 dcl 1-43 lcb_ptr parameter pointer dcl 1-110 set ref 18 171 181 183 191 192 192 192 204 205 206 220 253 254 255 257 259 260 260 260 266 268* 271 271 271 284 286 286 289 289 289 length builtin function dcl 135 ref 229 234 236 linus_area_ptr 60 based pointer level 2 dcl 1-43 set ref 204 205 206 220 286* linus_convert_code 000036 constant entry external dcl 159 ref 394 linus_data_$ss_id 000012 external static fixed bin(35,0) dcl 145 set ref 394* linus_error_$ill_scp_op 000014 external static fixed bin(35,0) dcl 145 set ref 215* 334* 359* linus_error_$inv_table 000016 external static fixed bin(35,0) dcl 145 set ref 299* linus_error_$no_db 000020 external static fixed bin(35,0) dcl 145 set ref 171* linus_error_$no_input_arg 000022 external static fixed bin(35,0) dcl 145 set ref 174* linus_error_$too_few_args 000024 external static fixed bin(35,0) dcl 145 set ref 202* linus_scope 000040 constant entry external dcl 160 ref 268 m 000112 automatic fixed bin(17,0) dcl 94 set ref 305* 309* 309* 312 313 314 331 331 353 355 355 379 381 381 mode 000216 automatic char(20) unaligned dcl 122 set ref 191* 196 mode_temp 000232 automatic varying char(5) dcl 140 set ref 337* 339* 339 342* 342 345* 345 347* 347 349* 349 353 363* 365* 365 368* 368 371* 371 373* 373 375* 375 379 mrds_error_$unshared_opening 000010 external static fixed bin(35,0) dcl 106 set ref 196* mrds_time 74 based float bin(63) level 2 dcl 1-43 set ref 192* 192 260* 260 271* 271 289* 289 nargs based fixed bin(17,0) level 2 in structure "char_argl" dcl 2-9 in procedure "linus_del_scope" set ref 183* 185 198 201 202 219 243 251 294 392 nargs based fixed bin(17,0) level 2 in structure "force_ret" dcl 3-3 in procedure "linus_del_scope" ref 254 nargs based fixed bin(17,0) level 2 in structure "ch_argl" dcl 129 in procedure "linus_del_scope" set ref 220* 223 nargs_init 000102 automatic fixed bin(17,0) dcl 2-16 set ref 173* 174 183 183 188 219* 220 220 nfiles 4 based fixed bin(17,0) level 2 dcl 4-32 ref 296 299 null builtin function dcl 135 ref 167 243 4-59 110 110 110 110 110 110 110 185 253 255 392 num_args 000113 automatic fixed bin(17,0) dcl 94 set ref 201* 202 204 205 206 208 out_code 000117 automatic fixed bin(35,0) dcl 97 set ref 394* 395* permits based char(5) array unaligned dcl 126 set ref 205 209* 215 230 236 331* 353* 355 355* permits_ptr 000136 automatic pointer initial dcl 110 set ref 110* 167* 205* 209 215 230 236 331 353 355 355 prevents based char(5) array unaligned dcl 127 set ref 206 209* 215 232 234 331* 379* 381 381* prevents_ptr 000140 automatic pointer initial dcl 110 set ref 110* 167* 206* 209 215 232 234 331 379 381 381 rel_names based char(32) array unaligned dcl 125 set ref 204 209* 225 228 229 306* 309 314* rel_names_index 000106 automatic fixed bin(17,0) dcl 94 set ref 169* 214 221 222* 224* 224 225* 225 225* 228 229 230 232 234 236 304 305* 306 309 312 313* rel_names_ptr 000134 automatic pointer initial dcl 110 set ref 110* 167* 204* 209 225 228 229 306 309 314 rtrim builtin function dcl 135 ref 234 236 sci_ptr parameter pointer dcl 92 set ref 18 173* 189* 395* scope 6 based structure array level 2 dcl 4-32 scope_flags based structure level 1 dcl 4-42 scope_info based structure level 1 dcl 4-32 scope_ptr 000104 automatic pointer initial dcl 4-59 set ref 4-59* 286* 296 296 299 306 309 314 search builtin function dcl 135 ref 339 342 345 347 349 355 365 368 371 373 375 381 sfr_ptr 30 based pointer level 2 dcl 1-43 set ref 253 254 255* sm_name 16 based char(32) array level 3 dcl 4-32 ref 296 306 309 314 ssu_$abort_line 000042 constant entry external dcl 162 ref 395 ssu_$arg_count 000044 constant entry external dcl 163 ref 173 ssu_$arg_ptr 000046 constant entry external dcl 164 ref 189 static_area 144 based area level 2 dcl 1-43 ref 183 string parameter char unaligned dcl 390 set ref 386 395* substr builtin function dcl 135 ref 196 temp_sd_ptr 000142 automatic pointer initial dcl 110 set ref 110* timing_mode 15(05) based bit(1) level 2 packed unaligned dcl 1-43 ref 181 192 257 260 266 271 284 289 trel_names_index 000114 automatic fixed bin(17,0) dcl 94 set ref 221* 225 vclock builtin function dcl 135 ref 181 192 257 260 266 271 284 289 verify builtin function dcl 135 ref 334 359 wait_time 000120 automatic fixed bin(35,0) initial dcl 97 set ref 97* 268* work_area based area dcl 165 ref 204 205 206 220 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fixed builtin function dcl 135 max_file_init automatic fixed bin(17,0) dcl 4-58 rel builtin function dcl 135 ret_nargs_init automatic fixed bin(17,0) dcl 3-10 scope_rdy internal static bit(6) initial unaligned dcl 4-60 scope_rdy_array based bit(1) array unaligned dcl 4-61 sfr_ptr automatic pointer dcl 3-9 sys_info$max_seg_size external static fixed bin(35,0) dcl 145 NAMES DECLARED BY EXPLICIT CONTEXT. del_scope 000725 constant entry internal dcl 248 ref 198 240 error 002207 constant entry internal dcl 386 ref 171 174 194 196 202 215 262 273 291 299 334 359 get_scope 001140 constant entry internal dcl 279 ref 212 linus_del_scope 000053 constant entry external dcl 18 verify_scope 001447 constant entry internal dcl 325 ref 318 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4334 4404 4111 4344 Length 4704 4111 50 264 222 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_del_scope 276 external procedure is an external procedure. on unit on line 184 64 on unit del_scope internal procedure shares stack frame of external procedure linus_del_scope. get_scope internal procedure shares stack frame of external procedure linus_del_scope. verify_scope internal procedure shares stack frame of external procedure linus_del_scope. error 88 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_del_scope 000100 ca_ptr linus_del_scope 000102 nargs_init linus_del_scope 000104 scope_ptr linus_del_scope 000106 rel_names_index linus_del_scope 000107 i linus_del_scope 000110 k linus_del_scope 000111 l linus_del_scope 000112 m linus_del_scope 000113 num_args linus_del_scope 000114 trel_names_index linus_del_scope 000115 code linus_del_scope 000116 icode linus_del_scope 000117 out_code linus_del_scope 000120 wait_time linus_del_scope 000122 initial_mrds_vclock linus_del_scope 000124 ds_flag linus_del_scope 000126 ch_ptr linus_del_scope 000130 e_ptr linus_del_scope 000132 env_ptr linus_del_scope 000134 rel_names_ptr linus_del_scope 000136 permits_ptr linus_del_scope 000140 prevents_ptr linus_del_scope 000142 temp_sd_ptr linus_del_scope 000144 db_path linus_del_scope 000216 mode linus_del_scope 000232 mode_temp linus_del_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 enable shorten_stack ext_entry int_entry int_entry_desc trunc_fx2 divide_fx1 alloc_based free_based vclock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. dsl_$dl_scope dsl_$dl_scope_all dsl_$get_pn dsl_$get_scope_info 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_table linus_error_$no_db linus_error_$no_input_arg linus_error_$too_few_args mrds_error_$unshared_opening LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000047 4 59 000060 97 000062 110 000063 167 000072 169 000100 171 000103 173 000123 174 000135 177 000154 181 000156 183 000170 184 000204 185 000220 187 000232 188 000233 189 000243 190 000263 191 000265 192 000304 194 000320 196 000336 198 000357 201 000377 202 000405 204 000425 205 000436 206 000451 208 000464 209 000473 210 000513 212 000515 214 000516 215 000525 217 000556 219 000560 220 000562 221 000576 222 000600 223 000601 224 000611 225 000612 227 000630 228 000632 229 000643 230 000645 232 000655 234 000661 236 000674 238 000707 240 000712 243 000713 246 000724 248 000725 250 000726 251 000730 253 000746 254 000755 255 000762 257 000767 259 001001 260 001012 262 001026 264 001044 266 001045 268 001057 271 001105 273 001121 277 001137 279 001140 284 001141 286 001153 289 001176 291 001212 294 001230 295 001237 296 001240 298 001267 299 001271 304 001354 305 001357 306 001362 307 001375 309 001376 311 001421 312 001423 313 001426 314 001427 318 001442 320 001443 323 001446 325 001447 331 001450 333 001462 334 001465 337 001537 339 001541 342 001570 345 001615 347 001636 349 001657 353 001700 355 001707 358 001734 359 001737 363 002010 365 002012 368 002041 371 002066 373 002107 375 002130 379 002151 381 002160 384 002205 386 002206 392 002222 394 002234 395 002251 397 002276 ----------------------------------------------------------- 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