COMPILATION LISTING OF SEGMENT gtss_mcfc_delete Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/10/84 1355.0 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 gtss_mcfc_delete: mcfcdl: proc; 10 11 /* Delete whole mcfc file chain, 12* or one file on a chain, 13* or one caller of file. 14* 15* Input arguments are one or more values of forms: 16* chain or chain-file or chain-file-caller. 17* The values "chain", "file" and "caller" are 18* unsigned positive integers reflecting 19* values output from gtss_mcfc_dump designating the 20* corresponding entries. 21* The caller will be queried for a "yes" or "no" BEFORE 22* each entry is actually deleted. 23* 24* Author: Dave Ward 08/08/79 25**/ 26 sub_entry = "0"b; 27 goto cont; 28 29 arg_ptr: entry (pap); 30 31 /* Subroutine entry given pointer to arguments. 32**/ 33 dcl pap ptr parm; 34 sub_entry = "1"b; 35 36 cont: ; 37 38 call gtss_mcfc_init_ (r); 39 if r = "false" then 40 fail: return; 41 42 do argn = 1 by 1; 43 if sub_entry then 44 call cu_$arg_ptr_rel (argn, ap, al, code, pap); 45 else 46 call cu_$arg_ptr (argn, ap, al, code); 47 if code ^= 0 then do; /* Concludion of input arguments. */ 48 if argn<2 then 49 call com_err_ ( 50 code 51 , "gtss_mcfc_delete" 52 , "One or more: c[-f[-u]]. c, f, u are integers for chain, file and caller from gtss_mcfc_dump." 53 ); 54 return; 55 end; 56 call del (arg); 57 next_arg: ; 58 end; 59 60 del: proc (cfc); 61 62 /* Delete entry named by cfc parameter. */ 63 dcl cfc char(*)parm; 64 65 /* Obtain 3 integers for chain, file and caller. 66**/ 67 chain, file, caller = -1; 68 call get_int (1, cfc, chain); 69 70 /* Isolate and lock chain. */ 71 if (chainhbound (mcfc.start_list, 1)) then do; 72 call com_err_ ( 73 0 74 , "gtss_mcfc_delete" 75 , "Arg ^i (^a), chain ^i out of range ^i...^i. Skipped." 76 , argn 77 , arg 78 , chain 79 , lbound (mcfc.start_list, 1) 80 , hbound (mcfc.start_list, 1) 81 ); 82 goto next_arg; 83 end; 84 85 /* Lock chain. */ 86 call set_lock_$lock ( 87 mcfc.start_list (chain).files.lock 88 , 60 /* Wait up to 60 seconds. */ 89 , code 90 ); 91 if code = 0 then do; 92 cont_del: ; 93 call del_file (chain, file, caller); 94 95 /* Unlock chain. */ 96 call set_lock_$unlock ( 97 mcfc.start_list (chain).files.lock 98 , code 99 ); 100 if code ^= 0 then do; 101 call com_err_ ( 102 code 103 , "gtss_mcfc_delete" 104 , "Unlocking chain ^i (Arg ^i ""^a""). Quitting." 105 , chain 106 , argn 107 , arg 108 ); 109 goto fail; 110 end; 111 return; 112 end; 113 if code = error_table_$invalid_lock_reset then do; 114 call com_err_ ( 115 code 116 , "gtss_mcfc_delete" 117 , "For chain ^i (Arg ^i ""^a"")." 118 , chain 119 , argn 120 , arg 121 ); 122 goto cont_del; 123 end; 124 125 /* Could not lock. */ 126 if code = error_table_$lock_wait_time_exceeded then do; 127 call com_err_ ( 128 code 129 , "gtss_mcfc_delete" 130 , "Could not wait to lock chain ^i (Arg ^i ""^a""). Skipped." 131 , chain 132 , argn 133 , arg 134 ); 135 return; 136 end; 137 call com_err_ ( 138 code 139 , "gtss_mcfc_delete" 140 , "ENEXPECTED ERROR processing chain ^i (Arg ^i ""^a""). Quitting." 141 , chain 142 , argn 143 , arg 144 ); 145 goto fail; 146 147 148 get_int: proc (i, s, v); 149 150 /* Obtain 3 integer values. */ 151 dcl i fixed bin(24) parm; 152 dcl s char(*)parm; 153 dcl v fixed bin(24) parm; 154 if i>3 then return; 155 k = search (s, "-"); 156 if k = 0 then do; /* Contains no (more) minus signs. */ 157 if verify (s, "0123456789")>0 then do; 158 bad_arg: ; 159 call com_err_ ( 160 0 161 , "gtss_mcfc_delete" 162 , "Argument ^i, ""^a"", not integer-integer-integer, skipped." 163 , argn 164 , arg 165 ); 166 goto next_arg; 167 end; 168 v = fixed (s, 24); 169 return; 170 end; 171 if verify (substr (s, 1, k-1), "0123456789")>0 then goto bad_arg; 172 v = fixed (substr (s, 1, k-1), 24); 173 if i = 1 then 174 call get_int (i+1, substr (s, k+1), file); 175 else 176 call get_int (i+1, substr (s, k+1), caller); 177 return; 178 dcl k fixed bin(24); 179 end /* get_int */; 180 dcl chain fixed bin(24); 181 dcl file fixed bin(24); 182 dcl caller fixed bin(24); 183 end /* del */; 184 185 del_file: proc (c, f, u); 186 187 /* Delete caller u of file f on chain c. 188**/ 189 dcl c fixed bin(24)parm; 190 dcl f fixed bin(24)parm; 191 dcl u fixed bin(24)parm; 192 if (f ^= -1)| (u ^= -1) then do; 193 call com_err_ ( 194 0 195 , "gtss_mcfc_delete" 196 , "Only delete chain implemented, arg ^i ""^a""" 197 , argn 198 , arg 199 ); 200 return; 201 end; 202 ln = -c; 203 n = mcfc.start_list (c).files.first; 204 205 if f = -1 then do; /* => delete chain. */ 206 query_info.yes_or_no_sw = "1"b; /* Demand yes or no. */ 207 query_info.suppress_name_sw = "0"b; /* Display caller name. */ 208 query_info.status_code, 209 query_info.query_code = 0; 210 call command_query_ ( 211 addr (query_info) 212 , ans 213 , "gtss_mcfc_delete" 214 , "Can ALL chain ^i be deleted?" 215 , c 216 ); 217 dcl command_query_ entry options(variable); 218 if ans = "no" then return; 219 dcl ans char(3)var; 220 mcfc.start_list (c).files.first = 0; /* Make chain c available. */ 221 end; 222 223 do while (n>0); 224 fn = n; /* File index. */ 225 dcl fn fixed bin(24); 226 227 /* Link to next file in chain. */ 228 ln = n; 229 n = file_entry (n).link; 230 if f = -1 then do; 231 232 /* Delete any file on chain c. */ 233 call return_entry (c, fn); 234 end; 235 else do; 236 if n = f then do; /* File entry found. */ 237 if u = -1 then do; /* Delete all callers for file. */ 238 /**MORE**/ 239 end; 240 241 /* Delete only caller u. */ 242 /**MORE**/ 243 return; 244 end; 245 end; 246 end; 247 248 /* File f not found. */ 249 /**MORE**/ 250 return; 251 252 dcl n fixed bin(24); 253 dcl ln fixed bin(24); 254 end /* del_file */; 255 256 return_entry: proc (h, u); 257 258 /* Return file entry u to an available list. */ 259 dcl h fixed bin(24) parm; 260 dcl u fixed bin(24) parm; 261 do i = h to hbound (mcfc.start_list, 1), 262 lbound (mcfc.start_list, 1) to (h-1); 263 if ^can_not_lock ("avail", i, mcfc.start_list (i).avail.lock) then do; 264 if mcfc.start_list (i).avail.first = 0 then do; 265 call can_not_unlock ("avail", i, mcfc.start_list (i).avail.lock); 266 goto cont; 267 end; 268 unspec (file_entry (u)) = "0"b; 269 file_entry (u).link = mcfc.start_list (i).avail.first; 270 mcfc.start_list (i).avail.first = u; 271 call can_not_unlock ("avail", i, mcfc.start_list (i).avail.lock); 272 return; 273 end; 274 275 cont: ; 276 end; 277 278 /* Could not find ANY available entries. */ 279 call com_err_ ( 280 0 281 , "gtss_mcfc_" 282 , "NO AVAILABLE CHAIN TO RETURN TO (from ^i for ^i)" 283 , h 284 , u 285 ); 286 goto fail; 287 dcl i fixed bin(24); 288 end /* return_entry */; 289 290 can_not_lock: proc (en, e, lw)returns (bit (1)); 291 292 /* Lock word lw, for list named en at entry e. 293* Return "1"b if can NOT lock, else return "0"b. 294**/ 295 dcl en char(*)parm; 296 dcl e fixed bin(24) parm; 297 dcl lw bit(36)aligned; 298 call set_lock_$lock ( 299 lw 300 , gtss_ext_$mcfc.wait_time 301 , c 302 ); 303 if c = 0 then return ("0"b); 304 305 if c = error_table_$invalid_lock_reset then do; 306 return ("0"b); 307 end; 308 309 /* Could not lock. */ 310 if c = error_table_$lock_wait_time_exceeded then do; 311 call com_err_ ( 312 c 313 , "gtss_mcfc_delete" 314 , "(^a ^i)" 315 , en 316 , e 317 ); 318 return ("1"b); 319 end; 320 if c = error_table_$locked_by_this_process then do; 321 call com_err_ ( 322 c 323 , "gtss_mcfc_delete" 324 , "BUG? Will not proceed (^a ^i)." 325 , en 326 , e 327 ); 328 goto fail; 329 end; 330 call com_err_ ( 331 c 332 , "gtss_mcfc_delete" 333 , "UNEXPECTED LOCK ERROR? (^1 ^i)" 334 , en 335 , e 336 ); 337 goto fail; 338 dcl c fixed bin(35); 339 end /* can_not_lock */; 340 341 can_not_unlock: proc (en, e, lw); 342 343 /* Unlock word lw. In en named chain, entry e. 344**/ 345 dcl en char(*)parm; 346 dcl e fixed bin(24)parm; 347 dcl lw bit(36)aligned parm; 348 call set_lock_$unlock ( 349 lw 350 , c 351 ); 352 if c = 0 then return; 353 354 /* Could not unlock. */ 355 if (c = error_table_$lock_not_locked) | 356 (c = error_table_$locked_by_other_process) then 357 call com_err_ ( 358 c 359 , "gtss_mcfc_delete" 360 , "BUG? Will not proceed (^a ^i)." 361 , en 362 , e 363 ); 364 else 365 call com_err_ ( 366 c 367 , "gtss_mcfc_delete" 368 , "UNEXPECTED LOCK ERROR? (^a ^i)" 369 , en 370 , e 371 ); 372 goto fail; 373 dcl c fixed bin(35); 374 end /* can_not_unlock */; 375 376 /* Variables for gtss_mcfc_delete: 377* IDENTIFIER ATTRIBUTES */ 378 dcl al fixed bin(24); 379 dcl ap ptr; 380 dcl arg char(al)unal based(ap); 381 dcl argn fixed bin(24); 382 dcl code fixed bin(35); 383 dcl com_err_ entry options(variable); 384 dcl cu_$arg_ptr entry(fixed bin(24),ptr,fixed bin(24),fixed bin(35)); 385 dcl cu_$arg_ptr_rel entry(fixed bin(24),ptr,fixed bin(24),fixed bin(35),ptr); 386 dcl empty builtin; 387 dcl error_table_$invalid_lock_reset fixed bin(35)ext; 388 dcl error_table_$locked_by_other_process fixed bin(35)ext; 389 dcl error_table_$locked_by_this_process fixed bin(35)ext; 390 dcl error_table_$lock_not_locked fixed bin(35)ext; 391 dcl error_table_$lock_wait_time_exceeded fixed bin(35)ext; 392 dcl get_lock_id_ entry(bit(36)aligned); 393 dcl gtss_mcfc_init_ entry(char(*)var); 394 dcl i fixed bin(24); 395 dcl lid bit(36)aligned; 396 dcl n fixed bin; 397 dcl null builtin; 398 dcl r char(5)var; 399 dcl set_lock_$lock entry(bit(36)aligned,fixed bin,fixed bin(35)); 400 dcl set_lock_$unlock entry(bit(36)aligned,fixed bin(35)); 401 dcl sll fixed bin; 402 dcl sub_entry bit(1); 403 1 1 /* BEGIN INCLUDE FILE gtss_mcfc.incl.pl1 */ 1 2 /* 1 3* Created: (Wardd Multics) 08/01/79 1454.6 mst Wed 1 4**/ 1 5 /* Changed: Dave Ward, Mel Wilson 11/14/79 providing concurrency lock for names area 1 6**/ 1 7 1 8 /** Data structures used to regulate gcos 1 9* simulator "callers" of files (multiple caller file control - mcfc). 1 10* 1 11* Given: gcos file (D => Multics directory, E => entry, 1 12* U => Multics unique file id) 1 13* h=mod(U,size(start_list)) 1 14* start_list(h) => start of chain for list of files 1 15* (file_entry's) and a lock word to 1 16* regulate use of the chain, corresponding 1 17* values for list of available entries. 1 18**/ 1 19 1 20 dcl 1 mcfc aligned based(gtss_ext_$mcfc.files_ptr) 1 21 , 2 version fixed bin 1 22 1 23 , 2 start_list (0:1020) 1 24 , 3 files 1 25 , 4 lock bit(36) 1 26 , 4 first fixed bin(24) 1 27 , 3 avail like mcfc.start_list.files 1 28 1 29 , 2 file_entry (8000) 1 30 , 3 link fixed bin(24) 1 31 , 3 nameo offset(names) 1 32 , 3 namel fixed bin 1 33 , 3 unique_id bit(36) 1 34 , 3 file_lock bit(36) 1 35 , 3 number_callers fixed bin(24) 1 36 , 3 delete bit unal 1 37 , 3 fill bit (17) unal 1 38 , 3 number_who_could_not_call fixed bin (18) unsigned unal 1 39 ; 1 40 1 41 dcl caller_ptr ptr; 1 42 dcl 1 caller (0:1999)aligned based(caller_ptr) 1 43 , 2 lock_id (0:99)bit(36) 1 44 , 2 gcos_access (0:99)bit(6)unal 1 45 ; 1 46 1 47 dcl 1 mcfc_names aligned based (gtss_ext_$mcfc.names_ptr), 1 48 2 names_lock bit (36), 1 49 2 pad bit (36), 1 50 2 names area (261118); 1 51 1 52 /* END INCLUDE FILE gtss_mcfc.incl.pl1 */ 404 405 2 1 /* BEGIN INCLUDE FILE gtss_ext_.incl.pl1 */ 2 2 /* 2 3* Created: (Wardd Multics) 05/20/78 1307.6 mst Sat 2 4* Modified: Ward 1981 add suspended_process dcl 2 5* Modified: Ron Barstad 83-07-21 Fixed level number on mcfc to 3 2 6* Modified: Ron Barstad 83-07-25 Fixed derail range in statistics to 4js3 number 2 7**/ 2 8 dcl gtss_ext_$aem fixed bin static ext /* >0 Print "additional" error information. */; 2 9 dcl gtss_ext_$bad_drl_rtrn static ext label /* Default for drl_rtrn. */; 2 10 dcl gtss_ext_$db (72)bit(1)unal static ext; 2 11 dcl gtss_ext_$deferred_catalogs_ptr ptr ext; 2 12 dcl gtss_ext_$dispose_of_drl static ext label /* quit handlers for some derails use this label to abort */; 2 13 dcl gtss_ext_$drl_rtrn (4)static ext label /* where to return at subsystem end */; 2 14 dcl gtss_ext_$drm_path char(168)static ext /* gtss_expand_pathname_stores drm_path */; 2 15 dcl gtss_ext_$drun_jid char (5) static ext /* valid only for DRUN executing under absentee */; 2 16 dcl gtss_ext_$event_channel fixed bin (71) static ext /* used for DABT signals */; 2 17 dcl gtss_ext_$finished static ext label /* Return to gtss for normal conclusion. */; 2 18 dcl gtss_ext_$gdb_name char(8)ext /* Name H* module to debug. */; 2 19 dcl gtss_ext_$get_line entry(ptr,ptr,fixed bin(21),fixed bin(21),fixed bin(35))variable ext /* Build mode input procedure. */; 2 20 dcl gtss_ext_$gtss_slave_area_seg (4) ext static ptr /* pointer to gtss slave area segment */; 2 21 dcl gtss_ext_$hcs_work_area_ptr ptr ext static /* Temp seg for acl lists. */; 2 22 dcl gtss_ext_$homedir char (64) static ext /* user's home dir */; 2 23 dcl gtss_ext_$last_k_was_out bit (1)aligned ext static /* "1"b => last tty output was output. */; 2 24 dcl gtss_ext_$pdir char (168) varying ext static /* pathname of process directory */; 2 25 dcl gtss_ext_$popup_from_pi static ext label /* transfer to this label after pi simulates popup primitive */; 2 26 dcl gtss_ext_$process_type fixed bin (17) static ext; 2 27 dcl gtss_ext_$put_chars entry(ptr,ptr,fixed bin(24),fixed bin(35)) variable ext /* Terminal output procedure. */; 2 28 dcl gtss_ext_$restart_from_pi static ext label /* transfer to this label after pi restores machine conditions */; 2 29 dcl gtss_ext_$restart_seg_ptr ptr static ext /* points to DRUN restart file when exec under absentee */; 2 30 dcl gtss_ext_$sig_ptr ext static ptr /* saved ptr to signal_ */; 2 31 dcl gtss_ext_$stack_level_ fixed bin ext static; 2 32 dcl gtss_ext_$suspended_process bit(1) ext static; 2 33 dcl gtss_ext_$SYstarstar_file_no fixed bin (24) static ext; 2 34 dcl gtss_ext_$user_id char (26)var ext; 2 35 dcl gtss_ext_$work_area_ptr ptr ext; 2 36 2 37 dcl 1 gtss_ext_$CFP_bits aligned static external 2 38 , 3 no_input_yet bit (1) unaligned /* used in gtss_CFP_input_, gtss_read_starCFP_ */ 2 39 , 3 rtn_bits bit (4) unaligned /* used in gtss_CFP_input_, gtss_CFP_output_ */ 2 40 , 3 cpos_called bit (1) unaligned /* used in gtss_CFP_input_, gtss_drl_t_cfio_, gtss_abandon_CFP_ */ 2 41 , 3 cout_called bit (1) unaligned /* used in gtss_read_starCFP_, gtss_abandon_CFP_ */ 2 42 , 3 build_mode bit (1) unaligned /* used in gtss_build_, gtss_dsd_process_ */ 2 43 ; 2 44 2 45 dcl 1 gtss_ext_$com_reg aligned static ext, 2 46 3 tsdmx, 2 47 4 dst fixed bin (18) unsigned unaligned, 2 48 4 dit fixed bin (18) unsigned unaligned, 2 49 3 tsdpt fixed bin (36) unsigned unaligned, 2 50 3 tsddt fixed bin (36) unsigned unaligned, 2 51 3 tsdid bit (72) unaligned, 2 52 3 tsdsd bit (36) unaligned, 2 53 3 tsdst fixed bin (36) unsigned unaligned, 2 54 3 tsdjb fixed bin (35) unaligned, 2 55 3 tsdgt, 2 56 4 ust_loc fixed bin (18) unsigned unaligned, 2 57 4 gating_ctl fixed bin (18) unsigned unaligned, 2 58 3 tcdfr bit (36) unaligned; 2 59 2 60 dcl 1 gtss_ext_$flags aligned static ext 2 61 , 3 dispose_of_drl_on_pi bit (01) unal /* 1 => drl that should be aborted after quit-pi sequence */ 2 62 , 3 drl_in_progress bit (01) unal /* 1 => drl handler executing; 0 => gcos code executing */ 2 63 , 3 popup_from_pi bit (01) unal /* 1 => derail processor will simulate Gcos break instead of returning */ 2 64 , 3 unfinished_drl bit (01) unal /* 1 => subsystem is handling breaks and quit was raised during a drl */ 2 65 , 3 ss_time_limit_set bit (01) unal /* 1 => exec time limit set for subsystem */ 2 66 , 3 timer_ranout bit (01) unal /* 1 => user is executing timer runout code */ 2 67 , 3 gtss_com_err_sw bit (01) unal /* 1 => stop com_err_ string from going to terminal */ 2 68 , 3 available bit (65) unal 2 69 ; 2 70 2 71 2 72 dcl 1 gtss_ext_$statistics aligned static ext, /* Derail usage statistics */ 2 73 3 total_time (-10:71)fixed bin (71), 2 74 3 count (-10:71)fixed bin (17); 2 75 2 76 /* Declaration of Available File Table 2 77* */ 2 78 dcl 1 gtss_ext_$aft aligned ext, /* aft structure */ 2 79 2 80 3 start_list (0:102) fixed bin (24), /* >0 => 1st aft_entry row to start of next entry chain. */ 2 81 2 82 3 aft_entry (20), 2 83 4 altname char (8), /* altname name for attaching this file */ 2 84 4 next_entry fixed bin (24), /* Next aft_entry in hash chain. */ 2 85 4 previous_add fixed bin (24), /* Previously added entry. */ 2 86 4 next_add fixed bin (24), /* Entry added after this one. */ 2 87 4 used bit (1) unal, /* "1"b => aft_entry contains AFT value. */ 2 88 4 forced bit(1) unal, /* "1"b => gtss_verify_access_ forced access on this file. */ 2 89 2 90 3 free_space fixed bin (24), /* Index of start of free space list for aft entries. */ 2 91 3 first_added fixed bin (24), /* >0 => start of chain in add order. */ 2 92 3 last_added fixed bin (24) /* >0 => end of chain in added order. */; 2 93 2 94 dcl gtss_ext_$ppt ptr ext /* switch name for tapein drl */; 2 95 /** Data structure to provide access to installed 2 96* subsystems fast library load. 2 97* **/ 2 98 dcl 1 gtss_ext_$fast_lib aligned ext 2 99 , 3 fast_lib_fcb ptr /* Pointer to msf fcb. */ 2 100 , 3 fast_lib_ncp fixed bin (24) /* Number of components. */ 2 101 , 3 comp_ptr (0:9)ptr /* Pointer to component. */ 2 102 , 3 comp_wds (0:9)fixed bin (24) /* Component length (words). */ 2 103 ; 2 104 2 105 /* Pointers to segments to regulate multipler 2 106* callers to files. Same segments are used to regulate 2 107* all simulator callers. 2 108**/ 2 109 dcl 1 gtss_ext_$mcfc aligned ext, 2 110 3 multics_lock_id bit(36), 2 111 3 wait_time fixed bin, 2 112 3 files_ptr ptr, 2 113 3 names_ptr ptr, 2 114 3 callers_ptr (0:3)ptr 2 115 ; 2 116 2 117 /* END INCLUDE FILE gtss_ext_.incl.pl1 */ 406 407 3 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 3 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 3 3 /* version number changed to 4, 08/10/78 WOS */ 3 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 3 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 3 6 3 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 3 8 2 version fixed bin, /* version of this structure - must be set, see below */ 3 9 2 switches aligned, /* various bit switch values */ 3 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 3 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 3 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 3 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 3 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 3 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 3 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 3 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 3 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 3 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 3 20 3 21 /* Limit of data defined for version 2 */ 3 22 3 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 3 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 3 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 3 26 /* minimum of 30 seconds required for repeat */ 3 27 /* otherwise, no repeat will occur */ 3 28 /* Limit of data defined for version 4 */ 3 29 3 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 3 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 3 32 3 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 3 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 3 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 3 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 3 37 3 38 /* END INCLUDE FILE query_info.incl.pl1 */ 408 409 end /* gtss_mcfc_delete */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/10/84 1044.3 gtss_mcfc_delete.pl1 >spec>on>7105>gtss_mcfc_delete.pl1 404 1 09/09/83 1714.0 gtss_mcfc.incl.pl1 >ldd>include>gtss_mcfc.incl.pl1 406 2 09/09/83 1713.8 gtss_ext_.incl.pl1 >ldd>include>gtss_ext_.incl.pl1 408 3 03/11/83 1204.3 query_info.incl.pl1 >ldd>include>query_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. al 000100 automatic fixed bin(24,0) dcl 378 set ref 43* 45* 56 56 72 72 101 101 114 114 127 127 137 137 159 159 193 193 ans 000150 automatic varying char(3) dcl 219 set ref 210* 218 answer_iocbp 6 000112 automatic pointer initial level 2 dcl 3-7 set ref 3-7* ap 000102 automatic pointer dcl 379 set ref 43* 45* 56 72 101 114 127 137 159 193 arg based char unaligned dcl 380 set ref 56* 72* 101* 114* 127* 137* 159* 193* argn 000104 automatic fixed bin(24,0) dcl 381 set ref 42* 43* 45* 48* 72* 101* 114* 127* 137* 159* 193* avail 3 based structure array level 3 dcl 1-20 c 000200 automatic fixed bin(35,0) dcl 338 in procedure "can_not_lock" set ref 298* 303 305 310 311* 320 321* 330* c 000210 automatic fixed bin(35,0) dcl 373 in procedure "can_not_unlock" set ref 348* 352 355 355 355* 364* c parameter fixed bin(24,0) dcl 189 in procedure "del_file" set ref 185 202 203 210* 220 233* caller 000140 automatic fixed bin(24,0) dcl 182 set ref 67* 93* 175* cfc parameter char unaligned dcl 63 set ref 60 68* chain 000136 automatic fixed bin(24,0) dcl 180 set ref 67* 68* 71 71 72* 86 93* 96 101* 114* 127* 137* code 000105 automatic fixed bin(35,0) dcl 382 set ref 43* 45* 47 48* 86* 91 96* 100 101* 113 114* 126 127* 137* com_err_ 000010 constant entry external dcl 383 ref 48 72 101 114 127 137 159 193 279 311 321 330 355 364 command_query_ 000040 constant entry external dcl 217 ref 210 cp_escape_control 1(02) 000112 automatic bit(2) initial level 3 packed unaligned dcl 3-7 set ref 3-7* cu_$arg_ptr 000012 constant entry external dcl 384 ref 45 cu_$arg_ptr_rel 000014 constant entry external dcl 385 ref 43 e parameter fixed bin(24,0) dcl 296 in procedure "can_not_lock" set ref 290 311* 321* 330* e parameter fixed bin(24,0) dcl 346 in procedure "can_not_unlock" set ref 341 355* 364* en parameter char unaligned dcl 345 in procedure "can_not_unlock" set ref 341 355* 364* en parameter char unaligned dcl 295 in procedure "can_not_lock" set ref 290 311* 321* 330* error_table_$invalid_lock_reset 000016 external static fixed bin(35,0) dcl 387 ref 113 305 error_table_$lock_not_locked 000024 external static fixed bin(35,0) dcl 390 ref 355 error_table_$lock_wait_time_exceeded 000026 external static fixed bin(35,0) dcl 391 ref 126 310 error_table_$locked_by_other_process 000020 external static fixed bin(35,0) dcl 388 ref 355 error_table_$locked_by_this_process 000022 external static fixed bin(35,0) dcl 389 ref 320 explanation_len 14 000112 automatic fixed bin(21,0) initial level 2 dcl 3-7 set ref 3-7* explanation_ptr 12 000112 automatic pointer initial level 2 dcl 3-7 set ref 3-7* f parameter fixed bin(24,0) dcl 190 ref 185 192 205 230 236 file 000137 automatic fixed bin(24,0) dcl 181 set ref 67* 93* 173* file_entry 7765 based structure array level 2 dcl 1-20 set ref 268* files 1 based structure array level 3 dcl 1-20 files_ptr 2 000036 external static pointer level 2 dcl 2-109 ref 71 71 72 72 72 72 86 96 203 220 229 261 261 263 264 265 268 269 269 270 271 first 4 based fixed bin(24,0) array level 4 in structure "mcfc" dcl 1-20 in procedure "mcfcdl" set ref 264 269 270* first 2 based fixed bin(24,0) array level 4 in structure "mcfc" dcl 1-20 in procedure "mcfcdl" set ref 203 220* fn 000152 automatic fixed bin(24,0) dcl 225 set ref 224* 233* gtss_ext_$mcfc 000036 external static structure level 1 dcl 2-109 gtss_mcfc_init_ 000030 constant entry external dcl 393 ref 38 h parameter fixed bin(24,0) dcl 259 set ref 256 261 261 279* i 000164 automatic fixed bin(24,0) dcl 287 in procedure "return_entry" set ref 261* 263* 263 264 265* 265 269 270 271* 271* i parameter fixed bin(24,0) dcl 151 in procedure "get_int" ref 148 154 173 173 175 k 000100 automatic fixed bin(24,0) dcl 178 set ref 155* 156 171 172 173 173 175 175 link 7765 based fixed bin(24,0) array level 3 dcl 1-20 set ref 229 269* literal_sw 1(05) 000112 automatic bit(1) initial level 3 packed unaligned dcl 3-7 set ref 3-7* ln 000154 automatic fixed bin(24,0) dcl 253 set ref 202* 228* lock 3 based bit(36) array level 4 in structure "mcfc" dcl 1-20 in procedure "mcfcdl" set ref 263* 265* 271* lock 1 based bit(36) array level 4 in structure "mcfc" dcl 1-20 in procedure "mcfcdl" set ref 86* 96* lw parameter bit(36) dcl 297 in procedure "can_not_lock" set ref 290 298* lw parameter bit(36) dcl 347 in procedure "can_not_unlock" set ref 341 348* mcfc based structure level 1 dcl 1-20 n 000153 automatic fixed bin(24,0) dcl 252 set ref 203* 223 224 228 229* 229 236 null builtin function dcl 397 ref 3-7 3-7 3-7 padding 1(07) 000112 automatic bit(29) initial level 3 packed unaligned dcl 3-7 set ref 3-7* pap parameter pointer dcl 33 set ref 29 43* prompt_after_explanation 1(06) 000112 automatic bit(1) initial level 3 packed unaligned dcl 3-7 set ref 3-7* query_code 3 000112 automatic fixed bin(35,0) initial level 2 dcl 3-7 set ref 3-7* 208* query_info 000112 automatic structure level 1 dcl 3-7 set ref 210 210 question_iocbp 4 000112 automatic pointer initial level 2 dcl 3-7 set ref 3-7* r 000106 automatic varying char(5) dcl 398 set ref 38* 39 repeat_time 10 000112 automatic fixed bin(71,0) initial level 2 dcl 3-7 set ref 3-7* s parameter char unaligned dcl 152 ref 148 155 157 168 171 172 173 173 175 175 set_lock_$lock 000032 constant entry external dcl 399 ref 86 298 set_lock_$unlock 000034 constant entry external dcl 400 ref 96 348 start_list 1 based structure array level 2 dcl 1-20 set ref 71 71 72 72 72 72 261 261 status_code 2 000112 automatic fixed bin(35,0) initial level 2 dcl 3-7 set ref 3-7* 208* sub_entry 000111 automatic bit(1) unaligned dcl 402 set ref 26* 34* 43 suppress_name_sw 1(01) 000112 automatic bit(1) initial level 3 packed unaligned dcl 3-7 set ref 3-7* 207* suppress_spacing 1(04) 000112 automatic bit(1) initial level 3 packed unaligned dcl 3-7 set ref 3-7* switches 1 000112 automatic structure level 2 dcl 3-7 u parameter fixed bin(24,0) dcl 191 in procedure "del_file" ref 185 192 237 u parameter fixed bin(24,0) dcl 260 in procedure "return_entry" set ref 256 268 269 270 279* v parameter fixed bin(24,0) dcl 153 set ref 148 168* 172* wait_time 1 000036 external static fixed bin(17,0) level 2 dcl 2-109 set ref 298* yes_or_no_sw 1 000112 automatic bit(1) initial level 3 packed unaligned dcl 3-7 set ref 3-7* 206* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. caller based structure array level 1 dcl 1-42 caller_ptr automatic pointer dcl 1-41 empty builtin function dcl 386 get_lock_id_ 000000 constant entry external dcl 392 gtss_ext_$CFP_bits external static structure level 1 dcl 2-37 gtss_ext_$SYstarstar_file_no external static fixed bin(24,0) dcl 2-33 gtss_ext_$aem external static fixed bin(17,0) dcl 2-8 gtss_ext_$aft external static structure level 1 dcl 2-78 gtss_ext_$bad_drl_rtrn external static label variable dcl 2-9 gtss_ext_$com_reg external static structure level 1 dcl 2-45 gtss_ext_$db external static bit(1) array unaligned dcl 2-10 gtss_ext_$deferred_catalogs_ptr external static pointer dcl 2-11 gtss_ext_$dispose_of_drl external static label variable dcl 2-12 gtss_ext_$drl_rtrn external static label variable array dcl 2-13 gtss_ext_$drm_path external static char(168) unaligned dcl 2-14 gtss_ext_$drun_jid external static char(5) unaligned dcl 2-15 gtss_ext_$event_channel external static fixed bin(71,0) dcl 2-16 gtss_ext_$fast_lib external static structure level 1 dcl 2-98 gtss_ext_$finished external static label variable dcl 2-17 gtss_ext_$flags external static structure level 1 dcl 2-60 gtss_ext_$gdb_name external static char(8) unaligned dcl 2-18 gtss_ext_$get_line external static entry variable dcl 2-19 gtss_ext_$gtss_slave_area_seg external static pointer array dcl 2-20 gtss_ext_$hcs_work_area_ptr external static pointer dcl 2-21 gtss_ext_$homedir external static char(64) unaligned dcl 2-22 gtss_ext_$last_k_was_out external static bit(1) dcl 2-23 gtss_ext_$pdir external static varying char(168) dcl 2-24 gtss_ext_$popup_from_pi external static label variable dcl 2-25 gtss_ext_$ppt external static pointer dcl 2-94 gtss_ext_$process_type external static fixed bin(17,0) dcl 2-26 gtss_ext_$put_chars external static entry variable dcl 2-27 gtss_ext_$restart_from_pi external static label variable dcl 2-28 gtss_ext_$restart_seg_ptr external static pointer dcl 2-29 gtss_ext_$sig_ptr external static pointer dcl 2-30 gtss_ext_$stack_level_ external static fixed bin(17,0) dcl 2-31 gtss_ext_$statistics external static structure level 1 dcl 2-72 gtss_ext_$suspended_process external static bit(1) unaligned dcl 2-32 gtss_ext_$user_id external static varying char(26) dcl 2-34 gtss_ext_$work_area_ptr external static pointer dcl 2-35 i automatic fixed bin(24,0) dcl 394 lid automatic bit(36) dcl 395 mcfc_names based structure level 1 dcl 1-47 n automatic fixed bin(17,0) dcl 396 query_info_version_3 internal static fixed bin(17,0) initial dcl 3-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 3-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 3-35 query_info_version_6 internal static fixed bin(17,0) initial dcl 3-36 sll automatic fixed bin(17,0) dcl 401 NAMES DECLARED BY EXPLICIT CONTEXT. arg_ptr 000365 constant entry external dcl 29 bad_arg 001235 constant label dcl 158 set ref 171 can_not_lock 002126 constant entry internal dcl 290 ref 263 can_not_unlock 002353 constant entry internal dcl 341 ref 265 271 cont 000375 constant label dcl 36 in procedure "mcfcdl" ref 27 cont 002043 constant label dcl 275 in procedure "return_entry" ref 266 cont_del 000705 constant label dcl 92 ref 122 del 000535 constant entry internal dcl 60 ref 56 del_file 001462 constant entry internal dcl 185 ref 93 fail 000414 constant label dcl 39 ref 109 145 286 328 337 372 get_int 001167 constant entry internal dcl 148 ref 68 173 175 gtss_mcfc_delete 000352 constant entry external dcl 9 mcfcdl 000342 constant entry external dcl 9 next_arg 000531 constant label dcl 57 ref 82 166 return_entry 001677 constant entry internal dcl 256 ref 233 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 210 210 fixed builtin function ref 168 172 hbound builtin function ref 71 72 72 261 lbound builtin function ref 71 72 72 261 search builtin function ref 155 substr builtin function ref 171 172 173 173 175 175 unspec builtin function ref 268 verify builtin function ref 157 171 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3340 3402 3132 3350 Length 3654 3132 42 236 206 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mcfcdl 456 external procedure is an external procedure. del internal procedure shares stack frame of external procedure mcfcdl. get_int 270 internal procedure is called during a stack extension. del_file internal procedure shares stack frame of external procedure mcfcdl. return_entry internal procedure shares stack frame of external procedure mcfcdl. can_not_lock internal procedure shares stack frame of external procedure mcfcdl. can_not_unlock internal procedure shares stack frame of external procedure mcfcdl. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_int 000100 k get_int mcfcdl 000100 al mcfcdl 000102 ap mcfcdl 000104 argn mcfcdl 000105 code mcfcdl 000106 r mcfcdl 000111 sub_entry mcfcdl 000112 query_info mcfcdl 000136 chain del 000137 file del 000140 caller del 000150 ans del_file 000152 fn del_file 000153 n del_file 000154 ln del_file 000164 i return_entry 000200 c can_not_lock 000210 c can_not_unlock THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_other_desc return tra_ext shorten_stack ext_entry int_entry_desc any_to_any_tr THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ cu_$arg_ptr cu_$arg_ptr_rel gtss_mcfc_init_ set_lock_$lock set_lock_$unlock THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$invalid_lock_reset error_table_$lock_not_locked error_table_$lock_wait_time_exceeded error_table_$locked_by_other_process error_table_$locked_by_this_process gtss_ext_$mcfc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3 7 000307 9 000341 26 000360 27 000361 29 000362 34 000373 36 000375 38 000376 39 000407 42 000415 43 000420 45 000443 47 000460 48 000462 54 000515 56 000516 57 000531 58 000532 409 000534 60 000535 67 000546 68 000552 71 000575 72 000601 82 000661 86 000662 91 000703 92 000705 93 000706 96 000710 100 000725 101 000727 109 000775 111 000776 113 000777 114 001002 122 001047 126 001050 127 001052 135 001117 137 001120 145 001165 148 001166 154 001202 155 001206 156 001222 157 001223 158 001235 159 001236 166 001303 168 001306 169 001323 171 001324 172 001340 173 001355 175 001420 177 001460 185 001462 192 001464 193 001472 200 001536 202 001537 203 001541 205 001550 206 001553 207 001555 208 001557 210 001561 218 001623 220 001631 223 001640 224 001642 228 001643 229 001644 230 001652 233 001656 234 001666 236 001667 237 001671 243 001674 246 001675 250 001676 256 001677 261 001701 263 001711 264 001747 265 001757 266 002002 268 002003 269 002012 270 002016 271 002020 272 002042 275 002043 276 002044 279 002064 286 002125 290 002126 298 002137 303 002154 305 002164 306 002167 310 002175 311 002177 318 002237 320 002245 321 002247 328 002310 330 002311 337 002352 341 002353 348 002364 352 002376 355 002401 364 002450 372 002511 ----------------------------------------------------------- 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