COMPILATION LISTING OF SEGMENT gcos_list_patchfile Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 09/09/83 1059.3 mst Fri 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 /* ******************************************************************************************* 12* ******************************************************************************************* 13* * 14* * 15* * Written by M. R. Jordan, September 1977 16* * 17* ******************************************************************************************* 18* ******************************************************************************************* */ 19 20 21 22 23 gcos_list_patchfile: glp: proc (); 24 25 dcl ME char (19) static internal options (constant) init ("gcos_list_patchfile"); 26 dcl addr builtin; 27 dcl arg char (arg_len) based (arg_ptr); 28 dcl arg_index fixed bin; 29 dcl arg_len fixed bin; 30 dcl arg_ptr ptr; 31 dcl ascii_module_name char (6); 32 dcl bcd_to_ascii_ entry (bit (*), char (*)); 33 dcl code fixed bin (35); 34 dcl com_err_ entry options (variable); 35 dcl cu_$arg_count entry (fixed bin); 36 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 37 dcl dirname char (168); 38 dcl ename char (32); 39 dcl error_table_$bigarg fixed bin (35) ext; 40 dcl error_table_$improper_data_format fixed bin (35) ext; 41 dcl error_table_$noarg fixed bin (35) ext; 42 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 43 dcl gcos_cv_ascii_gebcd_ entry (ptr, fixed bin, ptr, fixed bin); 44 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 45 dcl i fixed bin; 46 dcl ioa_ entry options (variable); 47 dcl ioa_$rsnnl entry options (variable); 48 dcl length builtin; 49 dcl module_name bit (36); 50 dcl module_name_index fixed bin; 51 dcl nargs fixed bin; 52 dcl null builtin; 53 dcl number_of_patches fixed bin; 54 dcl patch_file_ptr ptr; 55 dcl patch_location char (12) varying; 56 dcl patch_ptr ptr; 57 dcl ptr builtin; 58 dcl substr builtin; 59 60 dcl 1 patch (number_of_patches) aligned based (patch_ptr), 61 2 location fixed bin (17), 62 2 content fixed bin (35); 63 64 65 dcl 1 patch_file aligned based (patch_file_ptr), 66 2 version fixed bin, 67 2 number_of_names fixed bin, 68 2 module (130560), 69 3 name bit (36) unal, 70 3 first_patch_offset bit (18) unal, 71 3 number_of_patches fixed bin (17) unal; 72 73 call cu_$arg_count (nargs); 74 if nargs < 1 then do; 75 call com_err_ (error_table_$noarg, ME, "^/Usage is: gcos_list_patchfile patchfile {modulename ...}"); 76 return; 77 end; 78 79 80 call cu_$arg_ptr (1, arg_ptr, arg_len, code); 81 if code ^= 0 then do; 82 call com_err_ (code, ME, "referencing argument 1"); 83 return; 84 end; 85 86 call Process_Patchfile_Name (); 87 if code ^= 0 then return; 88 89 90 if nargs = 1 then call Print_Patch_Cards (); 91 else do; 92 93 call ioa_ ("^2/_m_o_d_u_l_e _l_o_c_a_t_i_o_n _c_o_n_t_e_n_t"); 94 95 do arg_index = 2 to nargs; 96 97 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code); 98 if code ^= 0 then do; 99 call com_err_ (code, ME, "referencing argument ^d", arg_index); 100 return; 101 end; 102 103 if length (arg) > length (ascii_module_name) then do; 104 code = error_table_$bigarg; 105 call com_err_ (code, ME, """^a""", arg); 106 end; 107 108 ascii_module_name = arg; 109 call gcos_cv_ascii_gebcd_ (addr (ascii_module_name), 6, addr (module_name), i); 110 111 call Get_Module_Name_Index (); 112 call List_Patches (); 113 114 end; 115 116 end; 117 118 119 return; 120 121 Process_Patchfile_Name: proc (); 122 123 124 call expand_pathname_ (arg, dirname, ename, code); 125 if code ^= 0 then do; 126 call com_err_ (code, ME, """^a""", arg); 127 return; 128 end; 129 130 131 call hcs_$initiate (dirname, ename, "", 0, 0, patch_file_ptr, code); 132 if patch_file_ptr = null () then do; 133 call com_err_ (code, ME, """^a^[>^]^a""", dirname, (dirname ^= ">"), ename); 134 return; 135 end; 136 else code = 0; 137 138 139 if patch_file.version ^= 1 then do; 140 code = error_table_$improper_data_format; 141 call com_err_ (code, ME, "patchfile version number is bad"); 142 return; 143 end; 144 145 146 return; 147 148 149 end Process_Patchfile_Name; 150 151 Print_Patch_Cards: proc (); 152 153 154 do module_name_index = 1 to patch_file.number_of_names; 155 156 157 call bcd_to_ascii_ (patch_file.module (module_name_index).name, ascii_module_name); 158 patch_ptr = ptr (patch_file_ptr, patch_file.module (module_name_index).first_patch_offset); 159 number_of_patches = patch_file.module (module_name_index).number_of_patches; 160 161 162 do i = 1 to number_of_patches; 163 164 call ioa_$rsnnl ("^w", patch_location, 0, patch (i).location); 165 patch_location = substr (patch_location, 7, 6); 166 call ioa_ ("^6a^1xoctal^3x^w^45x^6a", patch_location, patch (i).content, ascii_module_name); 167 168 end; 169 170 171 end; 172 173 174 return; 175 176 177 end Print_Patch_Cards; 178 179 Get_Module_Name_Index: proc (); 180 181 182 dcl l fixed bin; 183 dcl u fixed bin; 184 dcl floor builtin; 185 dcl divide builtin; 186 187 188 l = 1; 189 u = patch_file.number_of_names; 190 191 192 do while (u >= l); 193 194 module_name_index = floor (divide ((l+u), 2, 17)); 195 196 if module_name < patch_file.module (module_name_index).name then u = module_name_index-1; 197 else if module_name > patch_file.module (module_name_index).name then l = module_name_index+1; 198 else return; 199 200 end; 201 202 203 module_name_index = 0; 204 205 206 return; 207 208 209 end Get_Module_Name_Index; 210 211 List_Patches: proc (); 212 213 214 if module_name_index > patch_file.number_of_names | module_name_index < 1 then do; 215 call ioa_ ("^2/^6a^3xNO PATCHES", ascii_module_name); 216 return; 217 end; 218 219 220 patch_ptr = ptr (patch_file_ptr, patch_file.module (module_name_index).first_patch_offset); 221 number_of_patches = patch_file.module (module_name_index).number_of_patches; 222 223 224 call ioa_ ("^2/^6a^3x^6o^3x^w", ascii_module_name, patch (1).location, patch (1).content); 225 226 227 do i = 2 to number_of_patches; 228 229 call ioa_ ("^9x^6o^3x^w", patch (i).location, patch (i).content); 230 231 end; 232 233 234 return; 235 236 237 end List_Patches; 238 239 240 end gcos_list_patchfile; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/09/83 1006.5 gcos_list_patchfile.pl1 >spec>on>09/07/83-gcos>gcos_list_patchfile.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. ME 000000 constant char(19) initial unaligned dcl 25 set ref 75* 82* 99* 105* 126* 133* 141* addr builtin function dcl 26 ref 109 109 109 109 arg based char unaligned dcl 27 set ref 103 105* 108 124* 126* arg_index 000100 automatic fixed bin(17,0) dcl 28 set ref 95* 97* 99* arg_len 000101 automatic fixed bin(17,0) dcl 29 set ref 80* 97* 103 105 105 108 124 124 126 126 arg_ptr 000102 automatic pointer dcl 30 set ref 80* 97* 103 105 108 124 126 ascii_module_name 000104 automatic char(6) unaligned dcl 31 set ref 103 108* 109 109 157* 166* 215* 224* bcd_to_ascii_ 000010 constant entry external dcl 32 ref 157 code 000106 automatic fixed bin(35,0) dcl 33 set ref 80* 81 82* 87 97* 98 99* 104* 105* 124* 125 126* 131* 133* 136* 140* 141* com_err_ 000012 constant entry external dcl 34 ref 75 82 99 105 126 133 141 content 1 based fixed bin(35,0) array level 2 dcl 60 set ref 166* 224* 229* cu_$arg_count 000014 constant entry external dcl 35 ref 73 cu_$arg_ptr 000016 constant entry external dcl 36 ref 80 97 dirname 000107 automatic char(168) unaligned dcl 37 set ref 124* 131* 133* 133 divide builtin function dcl 185 ref 194 ename 000161 automatic char(32) unaligned dcl 38 set ref 124* 131* 133* error_table_$bigarg 000020 external static fixed bin(35,0) dcl 39 ref 104 error_table_$improper_data_format 000022 external static fixed bin(35,0) dcl 40 ref 140 error_table_$noarg 000024 external static fixed bin(35,0) dcl 41 set ref 75* expand_pathname_ 000026 constant entry external dcl 42 ref 124 first_patch_offset 3 based bit(18) array level 3 packed unaligned dcl 65 ref 158 220 floor builtin function dcl 184 ref 194 gcos_cv_ascii_gebcd_ 000030 constant entry external dcl 43 ref 109 hcs_$initiate 000032 constant entry external dcl 44 ref 131 i 000171 automatic fixed bin(17,0) dcl 45 set ref 109* 162* 164 166* 227* 229 229* ioa_ 000034 constant entry external dcl 46 ref 93 166 215 224 229 ioa_$rsnnl 000036 constant entry external dcl 47 ref 164 l 000234 automatic fixed bin(17,0) dcl 182 set ref 188* 192 194 197* length builtin function dcl 48 ref 103 103 location based fixed bin(17,0) array level 2 dcl 60 set ref 164* 224* 229* module 2 based structure array level 2 dcl 65 module_name 000172 automatic bit(36) unaligned dcl 49 set ref 109 109 196 197 module_name_index 000173 automatic fixed bin(17,0) dcl 50 set ref 154* 157 158 159* 194* 196 196 197 197 203* 214 214 220 221 name 2 based bit(36) array level 3 packed unaligned dcl 65 set ref 157* 196 197 nargs 000174 automatic fixed bin(17,0) dcl 51 set ref 73* 74 90 95 null builtin function dcl 52 ref 132 number_of_names 1 based fixed bin(17,0) level 2 dcl 65 ref 154 189 214 number_of_patches 3(18) based fixed bin(17,0) array level 3 in structure "patch_file" packed unaligned dcl 65 in procedure "glp" ref 159 221 number_of_patches 000175 automatic fixed bin(17,0) dcl 53 in procedure "glp" set ref 159* 162 221* 227 patch based structure array level 1 dcl 60 patch_file based structure level 1 dcl 65 patch_file_ptr 000176 automatic pointer dcl 54 set ref 131* 132 139 154 157 158 158 159 189 196 197 214 220 220 221 patch_location 000200 automatic varying char(12) dcl 55 set ref 164* 165* 165 166* patch_ptr 000204 automatic pointer dcl 56 set ref 158* 164 166 220* 224 224 229 229 ptr builtin function dcl 57 ref 158 220 substr builtin function dcl 58 ref 165 u 000235 automatic fixed bin(17,0) dcl 183 set ref 189* 192 194 196* version based fixed bin(17,0) level 2 dcl 65 ref 139 NAMES DECLARED BY EXPLICIT CONTEXT. Get_Module_Name_Index 001127 constant entry internal dcl 179 ref 111 List_Patches 001167 constant entry internal dcl 211 ref 112 Print_Patch_Cards 000746 constant entry internal dcl 151 ref 90 Process_Patchfile_Name 000505 constant entry internal dcl 121 ref 86 gcos_list_patchfile 000165 constant entry external dcl 23 glp 000156 constant entry external dcl 23 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1516 1556 1341 1526 Length 1756 1341 40 163 155 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME glp 342 external procedure is an external procedure. Process_Patchfile_Name internal procedure shares stack frame of external procedure glp. Print_Patch_Cards internal procedure shares stack frame of external procedure glp. Get_Module_Name_Index internal procedure shares stack frame of external procedure glp. List_Patches internal procedure shares stack frame of external procedure glp. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME glp 000100 arg_index glp 000101 arg_len glp 000102 arg_ptr glp 000104 ascii_module_name glp 000106 code glp 000107 dirname glp 000161 ename glp 000171 i glp 000172 module_name glp 000173 module_name_index glp 000174 nargs glp 000175 number_of_patches glp 000176 patch_file_ptr glp 000200 patch_location glp 000204 patch_ptr glp 000234 l Get_Module_Name_Index 000235 u Get_Module_Name_Index THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. bcd_to_ascii_ com_err_ cu_$arg_count cu_$arg_ptr expand_pathname_ gcos_cv_ascii_gebcd_ hcs_$initiate ioa_ ioa_$rsnnl THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bigarg error_table_$improper_data_format error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000155 73 000172 74 000200 75 000203 76 000227 80 000230 81 000247 82 000251 83 000300 86 000301 87 000302 90 000304 93 000311 95 000325 97 000335 98 000352 99 000354 100 000407 103 000410 104 000413 105 000416 108 000447 109 000455 111 000500 112 000501 114 000502 119 000504 121 000505 124 000506 125 000536 126 000540 127 000572 131 000573 132 000636 133 000642 134 000711 136 000712 139 000713 140 000716 141 000721 142 000744 146 000745 151 000746 154 000747 157 000757 158 000776 159 001005 162 001011 164 001017 165 001054 166 001062 168 001122 171 001124 174 001126 179 001127 188 001130 189 001132 192 001135 194 001141 196 001144 197 001155 198 001163 200 001164 203 001165 206 001166 211 001167 214 001170 215 001176 216 001216 220 001217 221 001226 224 001232 227 001272 229 001301 231 001335 234 001337 ----------------------------------------------------------- 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