COMPILATION LISTING OF SEGMENT gate_sw Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1725.8 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 gate_sw: proc (name, switch) ; 12 dcl name char (*), switch char (*) ; 13 14 /* created by A Kobziar to allow the dynamic switching of a gate to one that has calls to user 15* proceedures rather than system proceedures, for the purpose of testing the user enviroment. 16* USAGE: call gate_sw(name,function); 17* 18* 1. name char(*) path name of the gate segment, to be found using standard search rules. 19* 20* 2. function char(*) specification of which function to be performed from the following options: 21* 22* "sim_init" this will initialize the user's gate, make the system's gate known by the 23* name "real_(name of gate)", and set switch to make calls to user's proceedures. 24* 25* "sim" this will set the switch in the user's gate to make calls to user proceedures. 26* 27* "real" this will set the switch in the user's gate to make calls to system proceedures. 28* 29* "revert" this will terminate the user's gate and initiate system's gate with "(gate's name)". 30* This allows the return to system enviroment without doing a new_proc. 31* 32* The old gate is made known to the process by the refname "real_|name|. 33* Switching back and forth is permitted. */ 34 35 /* NOTES: 36* 1. "sim_init" must be the first function executed if the user wants to replace a system gate. 37* Otherwize the "sim" and "real" functions can be used for a private switchable gate. 38* 2. any number of switchable gates can coexist. 39* 3. Works because kst is hashed with gate name and ring no. 40* */ 41 42 dcl (save_p, p, gate_ptr, pnamep, dirp, gatedirp, enamep, refp) ptr ; 43 dcl (hcs_sw, reset_sw) bit (1) aligned; 44 dcl (pnamel, len) fixed bin ; 45 dcl code fixed bin (35); 46 dcl (dirname, gatedir) char (168), (refname, ename) char (32) ; 47 dcl schar char (4) ; 48 dcl whoami char (8) aligned ; 49 dcl (addr, length, null) builtin; 50 51 dcl 1 ret_struc aligned, 52 2 num fixed bin, 53 2 names (22) char (168) aligned ; 54 55 dcl 1 lib_sr_struc aligned, 56 2 num fixed bin, 57 2 name char (168) aligned ; 58 59 /* the following ext entry names, except for hcs_, cannot be used as name of user's gate */ 60 dcl hcs_$get_search_rules ext entry (ptr) ; 61 dcl hcs_$initiate_search_rules ext entry (ptr, fixed bin(35)) ; 62 dcl (hcs_$make_ptr, real_hcs_$make_ptr) ext entry (ptr, char (*), char (*), ptr, fixed bin (35)); 63 dcl (hcs_$initiate, real_hcs_$initiate) ext entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 64 dcl (hcs_$terminate_name, real_hcs_$terminate_name) ext entry (char (*), fixed bin (35)); 65 dcl term_$nomakeunknown ext entry (ptr, fixed bin(35)) ; 66 dcl (cu_$ptr_call, com_err_) ext entry options (variable); 67 dcl expand_path_ ext entry (ptr, fixed bin, ptr, ptr, fixed bin(35)) ; 68 dcl (hcs_$fs_get_path_name, real_hcs_$fs_get_path_name) ext entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 69 dcl (hcs_$fs_get_seg_ptr, real_hcs_$fs_get_seg_ptr) ext entry (char(*), ptr, fixed bin (35)); 70 dcl (error_table_$segknown, error_table_$name_not_found) ext fixed bin (35); 71 72 73 hcs_sw, reset_sw = "0"b ; /* initialize for gate name not hcs_ */ 74 whoami = "gate_sw" ; 75 76 77 pnamep = addr (name) ; 78 pnamel = length (name) ; /* set up for expand path */ 79 dirp = addr (dirname) ; 80 enamep = addr (ename) ; 81 refp = addr (refname) ; 82 gatedirp = addr (gatedir) ; 83 84 call expand_path_ (pnamep, pnamel, dirp, enamep, code) ; 85 if code ^= 0 then do ; 86 call com_err_ (code, whoami, "Expand_path err on ^a", name) ; 87 return ; 88 end ; 89 90 if ename = "hcs_" then hcs_sw = "1"b ; /* gate is hcs_ */ 91 92 if switch = "sim_init" then do ; 93 refname = "real_"||ename ; /* name original gate real_|name| */ 94 save_p = addr (ret_struc) ; 95 p = addr (lib_sr_struc) ; 96 lib_sr_struc.num = 1 ; 97 lib_sr_struc.name = "system_libraries" ; 98 99 /* must get the pathname of the real gate, which may not be known to process */ 100 call hcs_$get_search_rules (save_p) ; /* pick up user's search rules for safekeeping */ 101 102 call hcs_$initiate_search_rules (p, code) ; /* search only the sys libraries */ 103 if code ^= 0 then do ; 104 call com_err_ (code, whoami, "Setting search rule error") ; 105 reset_sw = "1"b; 106 goto sr_rl; /* restor user's search rules */ 107 end ; 108 109 call hcs_$make_ptr (null, ename, "", gate_ptr, code) ; /* get ptr to real gate */ 110 if code ^= 0 then do ; 111 call com_err_ (code, whoami, "Err on init of real gate ^a", ename) ; 112 reset_sw = "1"b; 113 goto sr_rl; 114 end ; 115 116 call hcs_$fs_get_path_name (gate_ptr, gatedir, len, ename, code); /* get name of real gate */ 117 if code ^= 0 then do ; 118 call com_err_ (code, whoami, "Cannot get real gate pathname, ^a", ename) ; 119 reset_sw = "1"b; 120 goto sr_rl; 121 end ; 122 123 call hcs_$initiate (gatedir, ename, refname, 0, 1, gate_ptr, code) ; /* add refname real_(name) to old gate */ 124 if code ^= error_table_$segknown then 125 if code ^= 0 then do ; 126 call com_err_ (code, whoami, "Unable to add refname ^a to ^a", refname, ename) ; 127 reset_sw = "1"b; 128 goto sr_rl; 129 end ; 130 131 sr_rl: call hcs_$initiate_search_rules (save_p, code) ; /* reset user's search rules */ 132 if code ^= 0 then do ; 133 call com_err_ (code, whoami, "Unable to reset user's search rules") ; 134 end ; 135 if reset_sw then return ; /* errors above - quit */ 136 137 call term_$nomakeunknown (enamep, code) ; /* unlinking references to old gate (name) */ 138 if code ^= 0 then do ; 139 call com_err_ (code, whoami, "Err on term of ^a", ename) ; 140 return ; 141 end ; 142 143 if hcs_sw then call real_hcs_$terminate_name (ename, code) ; /* removing reference (name) from old gate */ 144 else call hcs_$terminate_name (ename, code) ; 145 146 if code ^= 0 then if code ^= error_table_$name_not_found then do; 147 call com_err_ (code, whoami, "Unable to remove refname ^a", ename) ; 148 return ; 149 end ; 150 151 152 /* now must initiate user's gate */ 153 if hcs_sw then call real_hcs_$initiate (dirname, ename, ename, 0, 1, p, code) ; 154 else call hcs_$initiate (dirname, ename, ename, 0, 1, p, code) ; 155 if code ^= 0 then do ; 156 call com_err_ (code, whoami, "Unable to initiate new gate ^a", ename) ; 157 reset: 158 /* must now init the old gate */ 159 if hcs_sw then call real_hcs_$initiate (gatedir, ename, ename, 0, 1, p, code) ; 160 else call hcs_$initiate (gatedir, ename, ename, 0, 1, p, code) ; 161 if code ^= 0 then do ; 162 call com_err_ (code, whoami, "Unable to reinit real_^a with name", ename); 163 return ; 164 end; 165 call com_err_ (0, whoami, "Real gate reestablished") ; 166 return ; 167 end ; 168 169 schar = "sim" ; 170 /* get entry ptr to switch in the user's gate */ 171 setsym: if hcs_sw then call real_hcs_$make_ptr (p, ename, schar, gate_ptr, code) ; 172 else call hcs_$make_ptr (p, ename, schar, gate_ptr, code) ; 173 if code ^= 0 then do ; 174 call com_err_ (code, whoami, "Unable to find entry real in ^a", name) ; 175 goto reset ; 176 end ; 177 178 call cu_$ptr_call (gate_ptr) ; /* set switch in user's gate for function schar */ 179 180 return ; 181 end; 182 183 /* the next call must be performed for all other functions */ 184 /* get a pointer to user's gate */ 185 if hcs_sw then call real_hcs_$initiate (dirname, ename, ename, 0, 1, p, code) ; /* get ptr to user's gate */ 186 else call hcs_$initiate (dirname, ename, ename, 0, 1, p, code) ; 187 if code ^= error_table_$segknown then 188 if code ^= 0 then do ; 189 call com_err_ (code, whoami, "Unable to get ptr to ^a", ename) ; 190 return ; 191 end ; 192 193 if switch = "sim" then do ; 194 schar = "sim" ; 195 goto setsym ; 196 end ; 197 198 if switch = "real" then do ; 199 schar = "real" ; 200 goto setsym ; 201 end ; 202 203 if switch = "revert" then do ; /* want to reestablish old gate */ 204 /* p pts to user's gate ename in dir dirname */ 205 206 refname = "real_"||ename ; 207 if hcs_sw then call real_hcs_$fs_get_seg_ptr (refname, save_p, code) ; /* pick up ptr to old gate */ 208 else call hcs_$fs_get_seg_ptr (refname, save_p, code) ; 209 if code ^= 0 then do ; 210 call com_err_ (code, whoami, "Unable to get ptr to ^a", refname) ; 211 return ; 212 end ; 213 214 if hcs_sw then call real_hcs_$fs_get_path_name (save_p, gatedir, len, ename, code) ; 215 else call hcs_$fs_get_path_name (save_p, gatedir, len, ename, code) ; 216 if code ^= 0 then do ; 217 call com_err_ (code, whoami, "Unable to get pathname ^p", save_p) ; 218 return ; 219 end ; 220 221 222 223 if hcs_sw then call real_hcs_$terminate_name (ename, code) ; /* terminating user's gate */ 224 else call hcs_$terminate_name (ename, code) ; 225 if code ^= 0 then do ; 226 call com_err_ (code, whoami, "Unable to terminate gate ^a", ename) ; 227 return ; 228 end ; 229 230 /* must initiate the system gate with refname of |ename| */ 231 232 if hcs_sw then call real_hcs_$initiate (gatedir, ename, ename, 0, 1, p, code) ; 233 else call hcs_$initiate (gatedir, ename, ename, 0, 1, p, code) ; 234 if code ^= error_table_$segknown then 235 if code ^= 0 then do ; 236 call com_err_ (code, whoami, "Initiate err on ^a", ename) ; 237 return ; 238 end ; 239 /* now will remove name "real_|ename| from sys gate */ 240 call hcs_$terminate_name (refname, code) ; 241 if code ^= 0 then do ; 242 call com_err_ (code, whoami, "Unable to term name ^a on sys gate", refname) ; 243 return ; 244 end ; 245 246 return ; 247 248 end; 249 250 call com_err_ (0, whoami, "Unable to recognize switch setting desired,please consult documentation for correct name") ; 251 return ; 252 end gate_sw ; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1515.4 gate_sw.pl1 >dumps>old>recomp>gate_sw.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. addr builtin function dcl 49 ref 77 79 80 81 82 94 95 code 000124 automatic fixed bin(35,0) dcl 45 set ref 84* 85 86* 102* 103 104* 109* 110 111* 116* 117 118* 123* 124 124 126* 131* 132 133* 137* 138 139* 143* 144* 146 146 147* 153* 154* 155 156* 157* 160* 161 162* 171* 172* 173 174* 185* 186* 187 187 189* 207* 208* 209 210* 214* 215* 216 217* 223* 224* 225 226* 232* 233* 234 234 236* 240* 241 242* com_err_ 000034 constant entry external dcl 66 ref 86 104 111 118 126 133 139 147 156 162 165 174 189 210 217 226 236 242 250 cu_$ptr_call 000032 constant entry external dcl 66 ref 178 dirname 000125 automatic char(168) unaligned dcl 46 set ref 79 153* 154* 185* 186* dirp 000110 automatic pointer dcl 42 set ref 79* 84* ename 000261 automatic char(32) unaligned dcl 46 set ref 80 90 93 109* 111* 116* 118* 123* 126* 139* 143* 144* 147* 153* 153* 154* 154* 156* 157* 157* 160* 160* 162* 171* 172* 185* 185* 186* 186* 189* 206 214* 215* 223* 224* 226* 232* 232* 233* 233* 236* enamep 000114 automatic pointer dcl 42 set ref 80* 84* 137* error_table_$name_not_found 000052 external static fixed bin(35,0) dcl 70 ref 146 error_table_$segknown 000050 external static fixed bin(35,0) dcl 70 ref 124 187 234 expand_path_ 000036 constant entry external dcl 67 ref 84 gate_ptr 000104 automatic pointer dcl 42 set ref 109* 116* 123* 171* 172* 178* gatedir 000177 automatic char(168) unaligned dcl 46 set ref 82 116* 123* 157* 160* 214* 215* 232* 233* gatedirp 000112 automatic pointer dcl 42 set ref 82* hcs_$fs_get_path_name 000040 constant entry external dcl 68 ref 116 215 hcs_$fs_get_seg_ptr 000044 constant entry external dcl 69 ref 208 hcs_$get_search_rules 000010 constant entry external dcl 60 ref 100 hcs_$initiate 000020 constant entry external dcl 63 ref 123 154 160 186 233 hcs_$initiate_search_rules 000012 constant entry external dcl 61 ref 102 131 hcs_$make_ptr 000014 constant entry external dcl 62 ref 109 172 hcs_$terminate_name 000024 constant entry external dcl 64 ref 144 224 240 hcs_sw 000120 automatic bit(1) dcl 43 set ref 73* 90* 143 153 157 171 185 207 214 223 232 len 000123 automatic fixed bin(17,0) dcl 44 set ref 116* 214* 215* length builtin function dcl 49 ref 78 lib_sr_struc 002131 automatic structure level 1 dcl 55 set ref 95 name 1 002131 automatic char(168) level 2 in structure "lib_sr_struc" dcl 55 in procedure "gate_sw" set ref 97* name parameter char unaligned dcl 12 in procedure "gate_sw" set ref 11 77 78 86* 174* null builtin function dcl 49 ref 109 109 num 002131 automatic fixed bin(17,0) level 2 dcl 55 set ref 96* p 000102 automatic pointer dcl 42 set ref 95* 102* 153* 154* 157* 160* 171* 172* 185* 186* 232* 233* pnamel 000122 automatic fixed bin(17,0) dcl 44 set ref 78* 84* pnamep 000106 automatic pointer dcl 42 set ref 77* 84* real_hcs_$fs_get_path_name 000042 constant entry external dcl 68 ref 214 real_hcs_$fs_get_seg_ptr 000046 constant entry external dcl 69 ref 207 real_hcs_$initiate 000022 constant entry external dcl 63 ref 153 157 185 232 real_hcs_$make_ptr 000016 constant entry external dcl 62 ref 171 real_hcs_$terminate_name 000026 constant entry external dcl 64 ref 143 223 refname 000251 automatic char(32) unaligned dcl 46 set ref 81 93* 123* 126* 206* 207* 208* 210* 240* 242* refp 000116 automatic pointer dcl 42 set ref 81* reset_sw 000121 automatic bit(1) dcl 43 set ref 73* 105* 112* 119* 127* 135 ret_struc 000274 automatic structure level 1 dcl 51 set ref 94 save_p 000100 automatic pointer dcl 42 set ref 94* 100* 131* 207* 208* 214* 215* 217* schar 000271 automatic char(4) unaligned dcl 47 set ref 169* 171* 172* 194* 199* switch parameter char unaligned dcl 12 ref 11 92 193 198 203 term_$nomakeunknown 000030 constant entry external dcl 65 ref 137 whoami 000272 automatic char(8) dcl 48 set ref 74* 86* 104* 111* 118* 126* 133* 139* 147* 156* 162* 165* 174* 189* 210* 217* 226* 236* 242* 250* NAMES DECLARED BY EXPLICIT CONTEXT. gate_sw 000277 constant entry external dcl 11 reset 001354 constant label dcl 157 ref 175 setsym 001551 constant label dcl 171 ref 195 200 sr_rl 001014 constant label dcl 131 ref 106 113 120 128 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3102 3156 2672 3112 Length 3372 2672 54 177 210 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gate_sw 1244 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gate_sw 000100 save_p gate_sw 000102 p gate_sw 000104 gate_ptr gate_sw 000106 pnamep gate_sw 000110 dirp gate_sw 000112 gatedirp gate_sw 000114 enamep gate_sw 000116 refp gate_sw 000120 hcs_sw gate_sw 000121 reset_sw gate_sw 000122 pnamel gate_sw 000123 len gate_sw 000124 code gate_sw 000125 dirname gate_sw 000177 gatedir gate_sw 000251 refname gate_sw 000261 ename gate_sw 000271 schar gate_sw 000272 whoami gate_sw 000274 ret_struc gate_sw 002131 lib_sr_struc gate_sw THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$ptr_call expand_path_ hcs_$fs_get_path_name hcs_$fs_get_seg_ptr hcs_$get_search_rules hcs_$initiate hcs_$initiate_search_rules hcs_$make_ptr hcs_$terminate_name real_hcs_$fs_get_path_name real_hcs_$fs_get_seg_ptr real_hcs_$initiate real_hcs_$make_ptr real_hcs_$terminate_name term_$nomakeunknown THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$name_not_found error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000273 73 000317 74 000321 77 000323 78 000326 79 000330 80 000332 81 000334 82 000336 84 000340 85 000356 86 000360 87 000415 90 000416 92 000424 93 000433 94 000446 95 000451 96 000453 97 000455 100 000460 102 000467 103 000500 104 000502 105 000526 106 000530 109 000531 110 000563 111 000565 112 000615 113 000617 116 000620 117 000651 118 000653 119 000703 120 000705 123 000706 124 000751 126 000757 127 001011 128 001013 131 001014 132 001025 133 001027 135 001053 137 001055 138 001066 139 001070 140 001120 143 001121 144 001141 146 001156 147 001163 148 001212 153 001213 154 001260 155 001322 156 001324 157 001354 160 001421 161 001463 162 001465 163 001515 165 001516 166 001546 169 001547 171 001551 172 001604 173 001634 174 001636 175 001670 178 001671 180 001702 185 001703 186 001750 187 002012 189 002020 190 002052 193 002053 194 002062 195 002064 198 002065 199 002071 200 002073 203 002074 206 002100 207 002113 208 002137 209 002157 210 002161 211 002214 214 002215 215 002251 216 002302 217 002304 218 002334 223 002335 224 002355 225 002372 226 002374 227 002424 232 002425 233 002472 234 002534 236 002542 237 002574 240 002575 241 002611 242 002613 243 002643 246 002644 250 002645 251 002671 ----------------------------------------------------------- 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