COMPILATION LISTING OF SEGMENT delete_registry Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1736.9 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 delete_registry: proc; 12 13 /* This command deletes RCP registries. */ 14 /* Written 01/03/79 by C. D. Tavares */ 15 16 /* automatic */ 17 18 dcl ap pointer, 19 al fixed bin, 20 arg char (al) based (ap), 21 argno fixed bin, 22 code fixed bin (35), 23 delete_sw bit (1) aligned, 24 dirname char (168), 25 ename char (32), 26 myname char (32), 27 nargs fixed bin, 28 star_index fixed bin, 29 suffix char (4); 30 31 /* static */ 32 33 dcl system_free_ptr pointer initial (null) static; 34 35 /* external static */ 36 37 dcl error_table_$noarg ext fixed bin (35) static; 38 39 /* based */ 40 41 dcl system_free_area area based (system_free_ptr); 42 43 /* entries */ 44 45 dcl check_star_name_$entry ext entry (char (*), fixed bin (35)), 46 com_err_ ext entry options (variable), 47 cu_$arg_count entry (fixed bin), 48 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 49 expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)), 50 hcs_$star_ ext entry (char (*), char (*), fixed bin (2), pointer, fixed bin, pointer, pointer, fixed bin (35)), 51 get_system_free_area_ ext entry returns (pointer); 52 53 dcl (rcp_admin_$delete_registry, 54 rcp_sys_$remove_registry) ext entry (char (*), char (*), fixed bin (35)); 55 56 /* builtins and conditions */ 57 58 dcl (hbound, null, sum) builtin, 59 cleanup condition; 60 1 1 /* BEGIN INCLUDE FILE . . . star_structures.incl.pl1 */ 1 2 1 3 /* This include file contains structures for the hcs_$star_, 1 4* hcs_$star_list_ and hcs_$star_dir_list_ entry points. 1 5* 1 6* Written 23 October 1978 by Monte Davidoff. 1 7* Modified January 1979 by Michael R. Jordan to use unsigned and different pointers for different structures. 1 8* Modified June 1981 by C. Hornig to count link pathnames more efficiently. 1 9**/ 1 10 1 11 /* automatic */ 1 12 1 13 declare star_branch_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching branch count */ 1 14 declare star_entry_count fixed binary; /* hcs_$star_: number of matching entries */ 1 15 declare star_entry_ptr pointer; /* hcs_$star_: pointer to array of entry information */ 1 16 declare star_list_branch_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to array of info */ 1 17 declare star_link_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching link count */ 1 18 declare star_linkx fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: index into star_links */ 1 19 declare star_names_ptr pointer; /* hcs_$star_: pointer to array of entry names */ 1 20 declare star_list_names_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to entry names */ 1 21 declare star_select_sw fixed binary (3); /* hcs_$star_list_, hcs_$star_dir_list_: what info to return */ 1 22 1 23 /* based */ 1 24 1 25 /* hcs_$star_ entry structure */ 1 26 1 27 declare 1 star_entries (star_entry_count) aligned based (star_entry_ptr), 1 28 2 type fixed binary (2) unsigned unaligned, 1 29 /* storage system type */ 1 30 2 nnames fixed binary (16) unsigned unaligned, 1 31 /* number of names of entry that match star_name */ 1 32 2 nindex fixed binary (18) unsigned unaligned; 1 33 /* index of first name in star_names */ 1 34 1 35 /* hcs_$star_ name structure */ 1 36 1 37 declare star_names (sum (star_entries (*).nnames)) char (32) based (star_names_ptr); 1 38 1 39 /* hcs_$star_list_ branch structure */ 1 40 1 41 declare 1 star_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 42 2 type fixed binary (2) unsigned unaligned, 1 43 /* storage system type */ 1 44 2 nnames fixed binary (16) unsigned unaligned, 1 45 /* number of names of entry that match star_name */ 1 46 2 nindex fixed binary (18) unsigned unaligned, 1 47 /* index of first name in star_list_names */ 1 48 2 dtcm bit (36) unaligned, /* date-time contents of branch were last modified */ 1 49 2 dtu bit (36) unaligned, /* date-time branch was last used */ 1 50 2 mode bit (5) unaligned, /* user's access mode to the branch */ 1 51 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 1 52 2 master_dir bit (1) unaligned, /* is branch a master directory */ 1 53 2 pad bit (7) unaligned, 1 54 2 records fixed binary (18) unsigned unaligned; 1 55 /* records used by branch */ 1 56 1 57 /* hcs_$star_dir_list_ branch structure */ 1 58 1 59 declare 1 star_dir_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 60 2 type fixed binary (2) unsigned unaligned, 1 61 /* storage system type */ 1 62 2 nnames fixed binary (16) unsigned unaligned, 1 63 /* number of names of entry that match star_name */ 1 64 2 nindex fixed binary (18) unsigned unaligned, 1 65 /* index of first name in star_list_names */ 1 66 2 dtem bit (36) unaligned, /* date-time directory entry of branch was last modified */ 1 67 2 pad bit (36) unaligned, 1 68 2 mode bit (5) unaligned, /* user's access mode to the branch */ 1 69 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 1 70 2 master_dir bit (1) unaligned, /* is branch a master directory */ 1 71 2 bit_count fixed binary (24) unaligned; 1 72 /* bit count of the branch */ 1 73 1 74 /* hcs_$star_list_ and hcs_$star_dir_list_ link structure */ 1 75 1 76 declare 1 star_links (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 1 77 2 type fixed binary (2) unsigned unaligned, 1 78 /* storage system type */ 1 79 2 nnames fixed binary (16) unsigned unaligned, 1 80 /* number of names of entry that match star_name */ 1 81 2 nindex fixed binary (18) unsigned unaligned, 1 82 /* index of first name in star_list_names */ 1 83 2 dtem bit (36) unaligned, /* date-time link was last modified */ 1 84 2 dtd bit (36) unaligned, /* date-time the link was last dumped */ 1 85 2 pathname_len fixed binary (18) unsigned unaligned, 1 86 /* length of the pathname of the link */ 1 87 2 pathname_index fixed binary (18) unsigned unaligned; 1 88 /* index of start of pathname in star_list_names */ 1 89 1 90 /* hcs_$star_list_ and hcs_$star_dir_list_ name array */ 1 91 1 92 declare star_list_names char (32) based (star_list_names_ptr) 1 93 dimension (star_links (star_branch_count + star_link_count).nindex 1 94 + star_links (star_branch_count + star_link_count).nnames 1 95 + divide (star_links (star_branch_count + star_link_count).pathname_len + 31, 32, 17, 0) 1 96 * binary ( 1 97 (star_links (star_branch_count + star_link_count).type = star_LINK) 1 98 & (star_select_sw >= star_LINKS_ONLY_WITH_LINK_PATHS), 1)); 1 99 1 100 /* hcs_$star_list_ and hcs_$star_dir_list_ link pathname */ 1 101 1 102 declare star_link_pathname char (star_links (star_linkx).pathname_len) 1 103 based (addr (star_list_names (star_links (star_linkx).pathname_index))); 1 104 1 105 /* internal static */ 1 106 1 107 /* star_select_sw values */ 1 108 1 109 declare star_LINKS_ONLY fixed binary (2) internal static options (constant) initial (1); 1 110 declare star_BRANCHES_ONLY fixed binary (2) internal static options (constant) initial (2); 1 111 declare star_ALL_ENTRIES fixed binary (2) internal static options (constant) initial (3); 1 112 declare star_LINKS_ONLY_WITH_LINK_PATHS 1 113 fixed binary (3) internal static options (constant) initial (5); 1 114 declare star_ALL_ENTRIES_WITH_LINK_PATHS 1 115 fixed binary (3) internal static options (constant) initial (7); 1 116 1 117 /* storage system types */ 1 118 1 119 declare star_LINK fixed binary (2) unsigned internal static options (constant) initial (0); 1 120 declare star_SEGMENT fixed binary (2) unsigned internal static options (constant) initial (1); 1 121 declare star_DIRECTORY fixed binary (2) unsigned internal static options (constant) initial (2); 1 122 1 123 /* END INCLUDE FILE . . . star_structures.incl.pl1 */ 61 62 63 64 /* delete_registry: proc; */ 65 66 delete_sw = "1"b; 67 suffix = "old"; 68 myname = "delete_registry"; 69 goto common; 70 71 remove_registry: entry; 72 73 delete_sw = ""b; 74 suffix = "rcpr"; 75 myname = "remove_registry"; 76 goto common; 77 78 common: 79 call cu_$arg_count (nargs); 80 if nargs = 0 then do; 81 call com_err_ (error_table_$noarg, myname, "Usage: ^a paths", myname); 82 return; 83 end; 84 85 86 do argno = 1 to nargs; 87 88 call cu_$arg_ptr (argno, ap, al, code); 89 if code ^= 0 then call crump (code, "Getting arg."); 90 91 call expand_pathname_$add_suffix (arg, suffix, dirname, ename, code); 92 if code ^= 0 then call crump (code, arg); 93 94 call check_star_name_$entry (ename, code); 95 if code > 2 then call crump (code, ename); 96 97 if code = 0 then call process (ename); /* not a starname */ 98 99 else do; /* starname, handle it */ 100 star_entry_ptr, star_names_ptr = null; 101 if system_free_ptr = null then 102 system_free_ptr = get_system_free_area_ (); 103 104 on cleanup call star_cleanup; 105 106 call hcs_$star_ (dirname, ename, star_BRANCHES_ONLY, system_free_ptr, 107 star_entry_count, star_entry_ptr, star_names_ptr, code); 108 109 if code ^= 0 then call crump (code, "^a>^a"); 110 111 do star_index = 1 to star_entry_count; 112 call process ((star_names (star_entries (star_index).nindex))); 113 end; 114 115 call star_cleanup; 116 117 /* ------------------------- */ 118 119 star_cleanup: proc; 120 if star_names_ptr ^= null then free star_names in (system_free_area); 121 /* remember to free names before entries! */ 122 if star_entry_ptr ^= null then free star_entries in (system_free_area); 123 end; 124 125 /* ------------------------- */ 126 127 end; 128 129 get_next_arg: 130 end; 131 132 return; 133 134 process: proc (ename); 135 136 dcl ename char (32) parameter; 137 138 dcl sleep_times (4) fixed bin (71) static options (constant) initial (1, 1, 2, 6), 139 timer_manager_$sleep ext entry (fixed bin (71), bit (2) aligned), 140 error_table_$file_busy ext fixed bin (35) static, 141 i fixed bin; 142 143 do i = 1, i+1 to hbound (sleep_times, 1) + 1 while (code = error_table_$file_busy); 144 145 if delete_sw then 146 call rcp_admin_$delete_registry (dirname, ename, code); 147 else call rcp_sys_$remove_registry (dirname, ename, code); 148 149 if code = error_table_$file_busy then 150 if i ^> hbound (sleep_times, 1) then 151 call timer_manager_$sleep (sleep_times (i), "11"b); /* relative seconds */ 152 end; 153 154 if code ^= 0 then call com_err_ (code, myname, "^a>^a", dirname, ename); 155 return; 156 end process; 157 158 crump: proc (code, reason); 159 160 dcl code fixed bin (35) parameter, 161 reason char (*) parameter; 162 163 call com_err_ (code, myname, reason, dirname, ename); 164 goto get_next_arg; 165 end crump; 166 167 end delete_registry; 168 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1522.2 delete_registry.pl1 >dumps>old>recomp>delete_registry.pl1 61 1 06/10/82 1045.5 star_structures.incl.pl1 >ldd>include>star_structures.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 000102 automatic fixed bin(17,0) dcl 18 set ref 88* 91 91 92 92 ap 000100 automatic pointer dcl 18 set ref 88* 91 92 arg based char unaligned dcl 18 set ref 91* 92* argno 000103 automatic fixed bin(17,0) dcl 18 set ref 86* 88* check_star_name_$entry 000014 constant entry external dcl 45 ref 94 cleanup 000204 stack reference condition dcl 58 ref 104 code parameter fixed bin(35,0) dcl 160 in procedure "crump" set ref 158 163* code 000104 automatic fixed bin(35,0) dcl 18 in procedure "delete_registry" set ref 88* 89 89* 91* 92 92* 94* 95 95* 97 106* 109 109* 145* 147* 149 152 154 154* com_err_ 000016 constant entry external dcl 45 ref 81 154 163 cu_$arg_count 000020 constant entry external dcl 45 ref 78 cu_$arg_ptr 000022 constant entry external dcl 45 ref 88 delete_sw 000105 automatic bit(1) dcl 18 set ref 66* 73* 145 dirname 000106 automatic char(168) unaligned dcl 18 set ref 91* 106* 145* 147* 154* 163* ename parameter char(32) unaligned dcl 136 in procedure "process" set ref 134 145* 147* 154* ename 000160 automatic char(32) unaligned dcl 18 in procedure "delete_registry" set ref 91* 94* 95* 97* 106* 163* error_table_$file_busy 000040 external static fixed bin(35,0) dcl 138 ref 149 152 error_table_$noarg 000012 external static fixed bin(35,0) dcl 37 set ref 81* expand_pathname_$add_suffix 000024 constant entry external dcl 45 ref 91 get_system_free_area_ 000030 constant entry external dcl 45 ref 101 hbound builtin function dcl 58 ref 143 149 hcs_$star_ 000026 constant entry external dcl 45 ref 106 i 000234 automatic fixed bin(17,0) dcl 138 set ref 143* 143* 149 149* myname 000170 automatic char(32) unaligned dcl 18 set ref 68* 75* 81* 81* 154* 163* nargs 000200 automatic fixed bin(17,0) dcl 18 set ref 78* 80 86 nindex 0(18) based fixed bin(18,0) array level 2 packed unsigned unaligned dcl 1-27 ref 112 nnames 0(02) based fixed bin(16,0) array level 2 packed unsigned unaligned dcl 1-27 ref 120 null builtin function dcl 58 ref 100 101 120 122 rcp_admin_$delete_registry 000032 constant entry external dcl 53 ref 145 rcp_sys_$remove_registry 000034 constant entry external dcl 53 ref 147 reason parameter char unaligned dcl 160 set ref 158 163* sleep_times 000000 constant fixed bin(71,0) initial array dcl 138 set ref 143 149 149* star_BRANCHES_ONLY 000014 constant fixed bin(2,0) initial dcl 1-110 set ref 106* star_entries based structure array level 1 dcl 1-27 ref 122 star_entry_count 000212 automatic fixed bin(17,0) dcl 1-14 set ref 106* 111 120 122 star_entry_ptr 000214 automatic pointer dcl 1-15 set ref 100* 106* 112 120 122 122 star_index 000201 automatic fixed bin(17,0) dcl 18 set ref 111* 112* star_names based char(32) array unaligned dcl 1-37 ref 112 120 star_names_ptr 000216 automatic pointer dcl 1-19 set ref 100* 106* 112 120 120 suffix 000202 automatic char(4) unaligned dcl 18 set ref 67* 74* 91* sum builtin function dcl 58 ref 120 system_free_area based area(1024) dcl 41 ref 120 122 system_free_ptr 000010 internal static pointer initial dcl 33 set ref 101 101* 106* 120 122 timer_manager_$sleep 000036 constant entry external dcl 138 ref 149 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. star_ALL_ENTRIES internal static fixed bin(2,0) initial dcl 1-111 star_ALL_ENTRIES_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-114 star_DIRECTORY internal static fixed bin(2,0) initial unsigned dcl 1-121 star_LINK internal static fixed bin(2,0) initial unsigned dcl 1-119 star_LINKS_ONLY internal static fixed bin(2,0) initial dcl 1-109 star_LINKS_ONLY_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 1-112 star_SEGMENT internal static fixed bin(2,0) initial unsigned dcl 1-120 star_branch_count automatic fixed bin(17,0) dcl 1-13 star_dir_list_branch based structure array level 1 dcl 1-59 star_link_count automatic fixed bin(17,0) dcl 1-17 star_link_pathname based char unaligned dcl 1-102 star_links based structure array level 1 dcl 1-76 star_linkx automatic fixed bin(17,0) dcl 1-18 star_list_branch based structure array level 1 dcl 1-41 star_list_branch_ptr automatic pointer dcl 1-16 star_list_names based char(32) array unaligned dcl 1-92 star_list_names_ptr automatic pointer dcl 1-20 star_select_sw automatic fixed bin(3,0) dcl 1-21 NAMES DECLARED BY EXPLICIT CONTEXT. common 000112 constant label dcl 78 ref 69 76 crump 000713 constant entry internal dcl 158 ref 89 92 95 109 delete_registry 000060 constant entry external dcl 11 get_next_arg 000461 constant label dcl 129 ref 164 process 000536 constant entry internal dcl 134 ref 97 112 remove_registry 000076 constant entry external dcl 71 star_cleanup 000465 constant entry internal dcl 119 ref 104 115 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1232 1274 1026 1242 Length 1510 1026 42 200 204 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME delete_registry 314 external procedure is an external procedure. on unit on line 104 64 on unit star_cleanup 64 internal procedure is called by several nonquick procedures. process internal procedure shares stack frame of external procedure delete_registry. crump internal procedure shares stack frame of external procedure delete_registry. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 system_free_ptr delete_registry STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME delete_registry 000100 ap delete_registry 000102 al delete_registry 000103 argno delete_registry 000104 code delete_registry 000105 delete_sw delete_registry 000106 dirname delete_registry 000160 ename delete_registry 000170 myname delete_registry 000200 nargs delete_registry 000201 star_index delete_registry 000202 suffix delete_registry 000212 star_entry_count delete_registry 000214 star_entry_ptr delete_registry 000216 star_names_ptr delete_registry 000234 i process THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return mpfx2 enable ext_entry int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_star_name_$entry com_err_ cu_$arg_count cu_$arg_ptr expand_pathname_$add_suffix get_system_free_area_ hcs_$star_ rcp_admin_$delete_registry rcp_sys_$remove_registry timer_manager_$sleep THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$file_busy error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000057 66 000065 67 000067 68 000071 69 000074 71 000075 73 000103 74 000104 75 000106 76 000111 78 000112 80 000121 81 000123 82 000155 86 000156 88 000164 89 000201 91 000212 92 000246 94 000267 95 000304 97 000312 100 000317 101 000322 104 000335 106 000357 109 000422 111 000431 112 000440 113 000453 115 000455 129 000461 132 000463 119 000464 120 000472 122 000526 123 000535 134 000536 143 000540 145 000544 147 000571 149 000613 152 000635 154 000655 155 000712 158 000713 163 000724 164 000756 ----------------------------------------------------------- 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