COMPILATION LISTING OF SEGMENT update_pl1_version Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-05-05_1833.12_Fri_mdt 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 /* A tool to update pl1_version information in bound_pl1_ directly */ 12 13 update_pl1_version: 14 procedure; 15 16 /* Written: 12 Dec 1979 by Peter Krupp */ 17 18 /* external entries */ 19 20 dcl ioa_ entry options(variable); 21 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 22 dcl cu_$arg_count entry() returns (fixed bin); 23 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 24 dcl com_err_ entry options (variable); 25 dcl com_err_$suppress_name entry options(variable); 26 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 27 dcl component_info_$name entry (ptr, char(32), ptr, fixed bin(35)); 28 dcl gen_pl1_version_ entry (1 structure, 2 char(256) var aligned, 2 char(3) var aligned, char(3) var, fixed bin(35)); 29 dcl get_group_id_ entry () returns (char (32)); 30 dcl hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 31 dcl hcs_$delete_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 32 dcl hcs_$list_acl entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)); 33 dcl hcs_$terminate_noname entry (ptr, fixed bin(35)); 34 35 /* automatic */ 36 37 dcl ACCESS_NAME char(32) aligned; 38 dcl release char(3) var; 39 dcl release_arg_length fixed bin; 40 dcl release_arg_ptr ptr; 41 dcl path_arg_length fixed bin; 42 dcl path_arg_ptr ptr; 43 dcl object_dir char(168); 44 dcl object_entry char(32); 45 dcl nargs fixed bin; 46 dcl code fixed bin(35); 47 dcl null_ref_name char(0); 48 dcl bound_seg_ptr ptr init(null()); 49 dcl area_ret_ptr ptr; 50 dcl cleanup_access bit(1) aligned initial("0"b); 51 dcl call_restore_acl_and_terminate bit(1) aligned initial("0"b); 52 53 dcl 1 old_acl_entry aligned, 54 2 access_name char(32), 55 2 modes bit(36), 56 2 zero_pad bit(36), 57 2 status_code fixed bin(35); 58 dcl 1 new_acl_entry like old_acl_entry aligned; 59 60 /* internal static */ 61 62 dcl (my_name char(18) initial("update_pl1_version"), 63 release_arg_no fixed bin init(2), 64 path_arg_no fixed bin init(1), 65 copy_sw fixed bin(2) init(0), 66 seg_sw fixed bin(1) init(0), 67 acl_count fixed bin init(1), 68 component_name char(32) init("pl1_version")) int static options(constant); 69 70 /* external static */ 71 72 dcl error_table_$user_not_found fixed bin(35) ext; 73 74 /* based */ 75 76 dcl path_arg char(path_arg_length) based(path_arg_ptr); 77 dcl release_arg char(release_arg_length) based(release_arg_ptr); 78 dcl 1 pl1_version_struc based, 79 2 pl1_version char(256) var, 80 2 pl1_release char(3) var; 81 82 /* builtin */ 83 84 dcl (addr,null,length) builtin; 85 86 /* condition */ 87 88 dcl cleanup condition; 89 90 /* include files */ 91 1 1 /* BEGIN INCLUDE SEGMENT ... component_info.incl.pl1 M. Weaver 4/26/72 */ 1 2 1 3 declare 1 ci aligned, 1 4 2 dcl_version fixed bin, /* version number of this structure */ 1 5 2 name char(32) aligned, /* objectname of component segment */ 1 6 2 text_start pointer, /* ptr to component's section of text */ 1 7 2 stat_start pointer, /* pointer to component's section of internal static */ 1 8 2 symb_start pointer, /* pointer to component's first symbol block */ 1 9 2 defblock_ptr pointer, /* ptr to component's definition block */ 1 10 2 text_lng fixed bin, /* length of text section */ 1 11 2 stat_lng fixed bin, /* length of internal static */ 1 12 2 symb_lng fixed bin, /* length of symbol section */ 1 13 2 n_blocks fixed bin, /* number of symbol blocks in component's symbol section */ 1 14 2 standard bit(1) aligned, /* indicates whether component is in standard (new) format */ 1 15 2 compiler char(8) aligned, /* name of component's compiler */ 1 16 2 compile_time fixed bin(71), /* time component was compiled */ 1 17 2 userid char(32) aligned, /* id of creator of component */ 1 18 2 cvers aligned, /* version of component's compiler in printable form */ 1 19 3 offset bit(18) unaligned, /* offset in words relative to symb_start */ 1 20 3 length bit(18) unaligned, /* length of name in characters */ 1 21 2 comment aligned, /* component's comment */ 1 22 3 offset bit(18) unaligned, /* offset in words relative to symb_start */ 1 23 3 length bit(18) unaligned, /* length of comment in characters */ 1 24 2 source_map fixed bin; /* offset, rel to beg of symbol block, of component's source map */ 1 25 1 26 /* END INCLUDE SEGMENT ... component_info.incl.pl1 */ 92 93 94 /* program */ 95 96 on cleanup 97 begin; 98 if call_restore_acl_and_terminate 99 then call restore_acl_and_terminate; 100 end; 101 102 103 /* Determine number of arguments in command invocation */ 104 105 nargs = cu_$arg_count(); 106 if nargs ^= 2 107 then do; 108 call com_err_$suppress_name(0,my_name,"Usage: update pl1_version { | EXL}"); 109 return; 110 end; 111 112 /* Get the pathname and validate it */ 113 114 call cu_$arg_ptr(path_arg_no,path_arg_ptr,path_arg_length,code); 115 call expand_pathname_(path_arg,object_dir,object_entry,code); 116 if code ^= 0 117 then go to ERROR; 118 119 /* Get the release and validate its length */ 120 121 call cu_$arg_ptr(release_arg_no,release_arg_ptr,release_arg_length,code); 122 release = release_arg; 123 124 if length(release) > 3 125 then do; 126 call com_err_(0,my_name,"The length of release may not be greater than 3"); 127 return; 128 end; 129 130 /* Get current acl of bound segment if it exists */ 131 132 ACCESS_NAME = get_group_id_(); 133 old_acl_entry.access_name = ACCESS_NAME; 134 call hcs_$list_acl(object_dir,object_entry,null(),area_ret_ptr,addr(old_acl_entry),acl_count,code); 135 136 if code ^= 0 137 then go to ERROR; 138 139 if old_acl_entry.status_code ^= error_table_$user_not_found 140 then cleanup_access = "1"b; 141 142 /* Get pointer to segment and component */ 143 144 call_restore_acl_and_terminate = "1"b; 145 call hcs_$initiate(object_dir,object_entry,null_ref_name,seg_sw,copy_sw,bound_seg_ptr,code); 146 147 if bound_seg_ptr = null() 148 then go to ERROR; 149 150 ci.dcl_version = 1; 151 call component_info_$name(bound_seg_ptr,component_name,addr(ci),code); 152 if code ^= 0 153 then go to ERROR; 154 155 /* Now try to get rw access to bound segment */ 156 157 new_acl_entry.access_name = ACCESS_NAME; 158 new_acl_entry.modes = "101"b; /* rw */ 159 new_acl_entry.zero_pad = "0"b; 160 call hcs_$add_acl_entries(object_dir,object_entry,addr(new_acl_entry),acl_count,code); 161 162 if code ^= 0 163 then go to ERROR; 164 165 /* At this point update_pl1_version has rw access to the bound segment (usually bound_pl1_) */ 166 /* and may alter it. */ 167 168 call gen_pl1_version_(ci.text_start -> pl1_version_struc,release,code); 169 170 if code ^= 0 171 then go to ERROR; 172 173 call ioa_("^a: pl1_version=""^a""",my_name,ci.text_start -> pl1_version); 174 call ioa_("^a: pl1_release=""^a""",my_name,ci.text_start -> pl1_release); 175 176 /* Restore acl to original state */ 177 178 call restore_acl_and_terminate; 179 return; 180 181 /* Error exit: print a message and quit */ 182 183 ERROR: 184 call com_err_(code,my_name); 185 186 if call_restore_acl_and_terminate 187 then call restore_acl_and_terminate; 188 189 return; 190 191 192 /* Delete new acl entry and restore the old acl entry if one existed */ 193 194 restore_acl_and_terminate: 195 procedure; 196 197 /* automatic */ 198 199 dcl 1 delete_acl aligned, 200 2 access_name char(32), 201 2 status_code fixed bin(35); 202 203 /* program */ 204 205 delete_acl.access_name = ACCESS_NAME; 206 call hcs_$delete_acl_entries(object_dir,object_entry,addr(delete_acl),acl_count,code); 207 208 if cleanup_access 209 then call hcs_$add_acl_entries(object_dir,object_entry, 210 addr(old_acl_entry),acl_count,code); 211 212 if bound_seg_ptr ^= null() 213 then call hcs_$terminate_noname(bound_seg_ptr,code); 214 215 end /* restore_acl_and_terminate */; 216 217 end /* update_pl1_version */; 218 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/05/00 1833.1 update_pl1_version.pl1 >udd>sm>ds>w>ml>update_pl1_version.pl1 92 1 05/06/74 1841.0 component_info.incl.pl1 >ldd>incl>component_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. ACCESS_NAME 000100 automatic char(32) dcl 37 set ref 132* 133 157 205 access_name 000100 automatic char(32) level 2 in structure "delete_acl" dcl 199 in procedure "restore_acl_and_terminate" set ref 205* access_name 000227 automatic char(32) level 2 in structure "new_acl_entry" dcl 58 in procedure "update_pl1_version" set ref 157* access_name 000214 automatic char(32) level 2 in structure "old_acl_entry" dcl 53 in procedure "update_pl1_version" set ref 133* acl_count 000034 constant fixed bin(17,0) initial dcl 62 set ref 134* 160* 206* 208* addr builtin function dcl 84 ref 134 134 151 151 160 160 206 206 208 208 area_ret_ptr 000210 automatic pointer dcl 49 set ref 134* bound_seg_ptr 000206 automatic pointer initial dcl 48 set ref 48* 145* 147 151* 212 212* call_restore_acl_and_terminate 000213 automatic bit(1) initial dcl 51 set ref 51* 98 144* 186 ci 000250 automatic structure level 1 dcl 1-3 set ref 151 151 cleanup 000242 stack reference condition dcl 88 ref 96 cleanup_access 000212 automatic bit(1) initial dcl 50 set ref 50* 139* 208 code 000205 automatic fixed bin(35,0) dcl 46 set ref 114* 115* 116 121* 134* 136 145* 151* 152 160* 162 168* 170 183* 206* 208* 212* com_err_ 000020 constant entry external dcl 24 ref 126 183 com_err_$suppress_name 000022 constant entry external dcl 25 ref 108 component_info_$name 000026 constant entry external dcl 27 ref 151 component_name 000000 constant char(32) initial packed unaligned dcl 62 set ref 151* copy_sw 000032 constant fixed bin(2,0) initial dcl 62 set ref 145* cu_$arg_count 000014 constant entry external dcl 22 ref 105 cu_$arg_ptr 000012 constant entry external dcl 21 ref 114 121 dcl_version 000250 automatic fixed bin(17,0) level 2 dcl 1-3 set ref 150* delete_acl 000100 automatic structure level 1 dcl 199 set ref 206 206 error_table_$user_not_found 000044 external static fixed bin(35,0) dcl 72 ref 139 expand_pathname_ 000016 constant entry external dcl 23 ref 115 gen_pl1_version_ 000030 constant entry external dcl 28 ref 168 get_group_id_ 000032 constant entry external dcl 29 ref 132 hcs_$add_acl_entries 000034 constant entry external dcl 30 ref 160 208 hcs_$delete_acl_entries 000036 constant entry external dcl 31 ref 206 hcs_$initiate 000024 constant entry external dcl 26 ref 145 hcs_$list_acl 000040 constant entry external dcl 32 ref 134 hcs_$terminate_noname 000042 constant entry external dcl 33 ref 212 ioa_ 000010 constant entry external dcl 20 ref 173 174 length builtin function dcl 84 ref 124 modes 10 000227 automatic bit(36) level 2 dcl 58 set ref 158* my_name 000010 constant char(18) initial packed unaligned dcl 62 set ref 108* 126* 173* 174* 183* nargs 000204 automatic fixed bin(17,0) dcl 45 set ref 105* 106 new_acl_entry 000227 automatic structure level 1 dcl 58 set ref 160 160 null builtin function dcl 84 ref 48 134 134 147 212 null_ref_name 000206 automatic char packed unaligned dcl 47 set ref 145* object_dir 000122 automatic char(168) packed unaligned dcl 43 set ref 115* 134* 145* 160* 206* 208* object_entry 000174 automatic char(32) packed unaligned dcl 44 set ref 115* 134* 145* 160* 206* 208* old_acl_entry 000214 automatic structure level 1 dcl 53 set ref 134 134 208 208 path_arg based char packed unaligned dcl 76 set ref 115* path_arg_length 000116 automatic fixed bin(17,0) dcl 41 set ref 114* 115 115 path_arg_no 000034 constant fixed bin(17,0) initial dcl 62 set ref 114* path_arg_ptr 000120 automatic pointer dcl 42 set ref 114* 115 pl1_release 101 based varying char(3) level 2 dcl 78 set ref 174* pl1_version based varying char(256) level 2 dcl 78 set ref 173* pl1_version_struc based structure level 1 unaligned dcl 78 set ref 168* release 000110 automatic varying char(3) dcl 38 set ref 122* 124 168* release_arg based char packed unaligned dcl 77 ref 122 release_arg_length 000112 automatic fixed bin(17,0) dcl 39 set ref 121* 122 release_arg_no 000033 constant fixed bin(17,0) initial dcl 62 set ref 121* release_arg_ptr 000114 automatic pointer dcl 40 set ref 121* 122 seg_sw 000032 constant fixed bin(1,0) initial dcl 62 set ref 145* status_code 12 000214 automatic fixed bin(35,0) level 2 dcl 53 set ref 139 text_start 12 000250 automatic pointer level 2 dcl 1-3 set ref 168 173 174 zero_pad 11 000227 automatic bit(36) level 2 dcl 58 set ref 159* NAMES DECLARED BY EXPLICIT CONTEXT. ERROR 000657 constant label dcl 183 ref 116 136 147 152 162 170 restore_acl_and_terminate 000704 constant entry internal dcl 194 ref 98 178 186 update_pl1_version 000110 constant entry external dcl 13 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1250 1316 1024 1260 Length 1532 1024 46 200 224 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME update_pl1_version 292 external procedure is an external procedure. on unit on line 96 64 on unit restore_acl_and_terminate 98 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME restore_acl_and_terminate 000100 delete_acl restore_acl_and_terminate update_pl1_version 000100 ACCESS_NAME update_pl1_version 000110 release update_pl1_version 000112 release_arg_length update_pl1_version 000114 release_arg_ptr update_pl1_version 000116 path_arg_length update_pl1_version 000120 path_arg_ptr update_pl1_version 000122 object_dir update_pl1_version 000174 object_entry update_pl1_version 000204 nargs update_pl1_version 000205 code update_pl1_version 000206 null_ref_name update_pl1_version 000206 bound_seg_ptr update_pl1_version 000210 area_ret_ptr update_pl1_version 000212 cleanup_access update_pl1_version 000213 call_restore_acl_and_terminate update_pl1_version 000214 old_acl_entry update_pl1_version 000227 new_acl_entry update_pl1_version 000250 ci update_pl1_version THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this call_int_other return_mac enable_op ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ com_err_$suppress_name component_info_$name cu_$arg_count cu_$arg_ptr expand_pathname_ gen_pl1_version_ get_group_id_ hcs_$add_acl_entries hcs_$delete_acl_entries hcs_$initiate hcs_$list_acl hcs_$terminate_noname ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$user_not_found LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 13 000107 48 000115 50 000117 51 000120 96 000121 98 000135 100 000145 105 000146 106 000155 108 000160 109 000205 114 000206 115 000223 116 000253 121 000255 122 000272 124 000303 126 000306 127 000333 132 000334 133 000346 134 000351 136 000414 139 000416 144 000424 145 000426 147 000466 150 000472 151 000474 152 000513 157 000515 158 000520 159 000522 160 000523 162 000556 168 000560 170 000573 173 000575 174 000622 178 000652 179 000656 183 000657 186 000674 189 000702 194 000703 205 000711 206 000715 208 000747 212 001005 215 001023 ----------------------------------------------------------- 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