COMPILATION LISTING OF SEGMENT probe_check_ptr_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 10/24/88 1547.8 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(88-09-07,WAAnderson), approve(88-09-30,MCR7952), 16* audit(88-09-30,JRGray), install(88-10-24,MR12.2-1184): 17* Added format control comment to make the source more readable. 18* END HISTORY COMMENTS */ 19 20 21 /* format: style1,insnl,ifthendo,indthenelse,^indnoniterdo,^inditerdo,indcom,^indthenbegin,^indprocbody,ind2,ll78,initcol0,dclind4,idind24,struclvlind1,comcol41 */ 22 23 /**** * * * * * * * * * * * * * * * * * * * * * * * */ 24 25 probe_check_ptr_: 26 proc (); 27 28 /* * This procedure converts the pointer value P_xxx_pointerter into a character string, 29* * interpreting appropriately and including error messages describing any problems 30* * with it 31* * Modified: 22 Sept 79 JRD to not require pad bits to be zero, because some Multics stack frame ptrs 32* * keep information in these bits, and the hardware doesn't care. 33**/ 34 /* Entry point $indirectable added 09/11/81 S. Herbst */ 35 /* Fixed to catch illegal_modifier that slipped through before; 06/01/82 S. Herbst */ 36 37 dcl ( 38 P_its_pointer pointer aligned parameter, 39 P_packed_pointer pointer unaligned parameter, 40 P_flags bit (*), 41 P_code fixed bin (35) 42 ) parameter; 43 44 dcl return_str char (256) varying; 45 dcl dname char (168); 46 dcl ename char (32); 47 dcl long_info char (100) aligned; 48 dcl test_pointer pointer; 49 dcl code fixed bin (35); 50 51 dcl its_ptr_ptr pointer; 52 dcl 1 its_ptr aligned based (its_ptr_ptr) like its_unsigned; 53 54 dcl 1 flags aligned, /* P_flags overlays onto this */ 55 2 dont_include_pathname 56 bit (1) unaligned; 57 58 dcl process_dir_names (2) char (64) varying internal static 59 init ("", ""); 60 /* long and short name of users pdir */ 61 dcl initialized bit (1) aligned internal static init ("0"b); 62 63 dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, 64 char (100) aligned); 65 dcl get_pdir_ entry () returns (char (168)); 66 dcl hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35)); 67 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), 68 fixed bin (35)); 69 dcl ioa_$rsnnl entry options (variable); 70 71 dcl ( 72 error_table_$bad_ptr, 73 error_table_$invalidsegno 74 ) fixed bin (35) external static; 75 76 dcl probe_et_$null_ptr fixed bin (35) ext; 77 78 dcl (addr, binary, length, null, rtrim, string, substr) 79 builtin; 80 81 dcl illegal_modifier condition; 82 /* */ 83 84 probe_check_ptr_$convert: 85 entry (P_its_pointer, P_flags) returns (char (256) varying); 86 87 if ^initialized 88 then call initialize (); /* initialize static copies of process dir names */ 89 90 call ioa_$rsnnl ("^o|^o^[(^d)^]", return_str, (0), 91 addr (P_its_pointer) -> its_ptr.segno, 92 addr (P_its_pointer) -> its_ptr.offset, 93 (addr (P_its_pointer) -> its_ptr.bit_offset ^= 0), 94 addr (P_its_pointer) -> its_ptr.bit_offset); 95 96 call check_its_pointer (); /* find out whether it's wholesome or not */ 97 if code = 0 98 then test_pointer = P_its_pointer; /* assign it for use later */ 99 else test_pointer = null (); 100 101 goto CONVERT_POINTER_COMMON; 102 103 104 probe_check_ptr_$convert_packed: 105 entry (P_packed_pointer, P_flags) returns (char (256) varying); 106 107 if ^initialized 108 then call initialize (); /* initialize static copies of process dir names */ 109 110 call ioa_$rsnnl ("^p", return_str, (0), P_packed_pointer); 111 112 call check_packed_pointer (); /* find out if its any good */ 113 if code = 0 114 then test_pointer = P_packed_pointer; 115 /* assign it for use later */ 116 else test_pointer = null (); 117 118 goto CONVERT_POINTER_COMMON; 119 120 121 CONVERT_POINTER_COMMON: /* common code for converting */ 122 string (flags) = P_flags; /* copy the flags */ 123 124 if code ^= 0 then do; /* bad pointer -- set by check_xxx_pointer */ 125 return_str = return_str || " (Invalid pointer.)"; 126 return (return_str); 127 end; 128 129 if test_pointer = null () 130 then /* null */ 131 return ("null"); 132 133 dcl bit_1_unaligned_array (100) bit (1) unaligned; 134 /* Stupid bug in pl1 24c makes this arbitrarily difficult */ 135 dcl stupid_idx fixed bin; 136 137 stupid_idx = 73; 138 bit_1_unaligned_array (stupid_idx) = flags.dont_include_pathname; 139 if bit_1_unaligned_array (stupid_idx) 140 then 141 /* don't bother getting pathname */ 142 return (return_str); 143 144 call hcs_$fs_get_path_name (test_pointer, dname, (0), ename, code); 145 if code = error_table_$invalidsegno then do; 146 return_str = return_str || " (Invalid segment number)"; 147 return (return_str); 148 end; 149 150 else if code ^= 0 then do; 151 call convert_status_code_ (code, (""), long_info); 152 /* get a string describing error */ 153 return_str = return_str || " (Error: "; 154 return_str = return_str || rtrim (long_info); 155 return_str = return_str || ")"; 156 return (return_str); 157 end; 158 159 return_str = return_str || " "; /* append the pathname */ 160 if dname = process_dir_names (1) 161 then /* construct the pathname to return */ 162 return_str = return_str || "[pd]"; 163 else if dname = process_dir_names (2) 164 then 165 return_str = return_str || "[pd]"; 166 else return_str = return_str || rtrim (dname); 167 168 if dname ^= ">" 169 then /* it's not the ROOT */ 170 return_str = return_str || ">"; 171 172 return_str = return_str || rtrim (ename); 173 /* add the entryname */ 174 175 return (return_str); /* all done converting pointer */ 176 177 /* */ 178 179 probe_check_ptr_$check: 180 entry (P_its_pointer, P_code); 181 182 /* * This entry validates the supplied pointer */ 183 call check_its_pointer (); 184 185 P_code = code; /* copy the code */ 186 return; /* end of code for $check entrypoint */ 187 188 189 probe_check_ptr_$check_packed: 190 entry (P_packed_pointer, P_code); 191 192 /* * just like the above, only for packed pointers */ 193 194 call check_packed_pointer (); 195 196 P_code = code; 197 return; /* end of code for $check_packed entrypoint */ 198 199 200 probe_check_ptr_$indirectable: 201 entry (P_its_pointer, P_code); 202 203 /* Makes sure you can indirect through the supplied pointer */ 204 205 206 if P_its_pointer = null 207 then P_code = probe_et_$null_ptr; 208 else do; 209 code = 0; 210 call hcs_$fs_get_mode (P_its_pointer, 0, code); 211 P_code = code; 212 end; 213 return; 214 /* */ 215 216 check_its_pointer: 217 proc (); 218 219 /* * This procedure tests the validity of P_its_pointer, and sets code 220* * accordingly. */ 221 222 dcl test_ptr ptr; 223 224 225 code = 0; /* assume it's good */ 226 its_ptr_ptr = addr (P_its_pointer); 227 228 if its_ptr.its_mod ^= "43"b3 229 then goto BAD_ITS_POINTER; 230 231 if its_ptr.segno > binary ("7777"b3) & its_ptr.segno < binary ("77776"b3) 232 then 233 goto BAD_ITS_POINTER; /* segno out of range */ 234 if its_ptr.bit_offset > 35 235 then goto BAD_ITS_POINTER; 236 237 on illegal_modifier go to BAD_ITS_POINTER; 238 test_ptr = P_its_pointer; 239 revert illegal_modifier; 240 241 code = 0; 242 return; /* success */ 243 244 BAD_ITS_POINTER: 245 code = error_table_$bad_ptr; /* failure */ 246 return; 247 end; /* check_its_pointer internal procedure */ 248 249 /* */ 250 251 check_packed_pointer: 252 proc (); 253 254 /* * This procedure tests the validity of P_packed_pointer, and sets code 255* * accordingly. */ 256 257 dcl packed_ptr_ptr pointer; 258 dcl 1 packed_ptr aligned based (packed_ptr_ptr), 259 /* our own version of this, with unsigned binary */ 260 ( 261 2 bit_offset fixed bin (6) unsigned, 262 2 segno fixed bin (12) unsigned, 263 2 offset fixed bin (18) unsigned 264 ) unaligned; 265 266 267 code = 0; /* assume it's good */ 268 packed_ptr_ptr = addr (P_packed_pointer); 269 270 if packed_ptr.bit_offset > 35 271 then code = error_table_$bad_ptr; /* there's not much you can check about one of these */ 272 else code = 0; 273 return; 274 end; /* check_packed_pointer internal procedure */ 275 276 /* */ 277 278 initialize: 279 proc (); 280 281 /* * This procedure initializes the process_dir_names array to be the 282* * the long and short names of this processes process dir; i.e., 283* * >process_dir_dir>[unique] and >pdd>[unique], so that the convert 284* * entrypoints can replace that directory name with [pd]. */ 285 286 287 if process_dir_names (1) = "" then do;/* initialize them */ 288 process_dir_names (1) = get_pdir_ (); 289 /* the real name */ 290 if substr (process_dir_names (1), 1, length (">process_dir_dir")) = 291 ">process_dir_dir" then do; 292 process_dir_names (2) = ">pdd"; 293 /* make one with >pdd at the front */ 294 process_dir_names (2) = process_dir_names (2) || 295 substr (process_dir_names (1), length (">process_dir_dir") + 1) 296 ; 297 end; 298 else process_dir_names (2) = process_dir_names (1); 299 end; 300 return; 301 end; /* internal procedure initialize */ 302 303 /* */ 304 1 1 /* BEGIN INCLUDE FILE its.incl.pl1 1 2* modified 27 July 79 by JRDavis to add its_unsigned 1 3* Internal format of ITS pointer, including ring-number field for follow-on processor */ 1 4 1 5 dcl 1 its based aligned, /* declaration for ITS type pointer */ 1 6 2 pad1 bit (3) unaligned, 1 7 2 segno bit (15) unaligned, /* segment number within the pointer */ 1 8 2 ringno bit (3) unaligned, /* ring number within the pointer */ 1 9 2 pad2 bit (9) unaligned, 1 10 2 its_mod bit (6) unaligned, /* should be 43(8) */ 1 11 1 12 2 offset bit (18) unaligned, /* word offset within the addressed segment */ 1 13 2 pad3 bit (3) unaligned, 1 14 2 bit_offset bit (6) unaligned, /* bit offset within the word */ 1 15 2 pad4 bit (3) unaligned, 1 16 2 mod bit (6) unaligned; /* further modification */ 1 17 1 18 dcl 1 itp based aligned, /* declaration for ITP type pointer */ 1 19 2 pr_no bit (3) unaligned, /* number of pointer register to use */ 1 20 2 pad1 bit (27) unaligned, 1 21 2 itp_mod bit (6) unaligned, /* should be 41(8) */ 1 22 1 23 2 offset bit (18) unaligned, /* word offset from pointer register word offset */ 1 24 2 pad2 bit (3) unaligned, 1 25 2 bit_offset bit (6) unaligned, /* bit offset relative to new word offset */ 1 26 2 pad3 bit (3) unaligned, 1 27 2 mod bit (6) unaligned; /* further modification */ 1 28 1 29 1 30 dcl 1 its_unsigned based aligned, /* just like its, but with unsigned binary */ 1 31 2 pad1 bit (3) unaligned, 1 32 2 segno fixed bin (15) unsigned unaligned, 1 33 2 ringno fixed bin (3) unsigned unaligned, 1 34 2 pad2 bit (9) unaligned, 1 35 2 its_mod bit (6) unaligned, 1 36 1 37 2 offset fixed bin (18) unsigned unaligned, 1 38 2 pad3 bit (3) unaligned, 1 39 2 bit_offset fixed bin (6) unsigned unaligned, 1 40 2 pad4 bit (3) unaligned, 1 41 2 mod bit (6) unaligned; 1 42 1 43 dcl 1 itp_unsigned based aligned, /* just like itp, but with unsigned binary where appropriate */ 1 44 2 pr_no fixed bin (3) unsigned unaligned, 1 45 2 pad1 bit (27) unaligned, 1 46 2 itp_mod bit (6) unaligned, 1 47 1 48 2 offset fixed bin (18) unsigned unaligned, 1 49 2 pad2 bit (3) unaligned, 1 50 2 bit_offset fixed bin (6) unsigned unaligned, 1 51 2 pad3 bit (3) unaligned, 1 52 2 mod bit (6) unaligned; 1 53 1 54 1 55 dcl ITS_MODIFIER bit (6) unaligned internal static options (constant) init ("43"b3); 1 56 dcl ITP_MODIFIER bit (6) unaligned internal static options (constant) init ("41"b3); 1 57 1 58 /* END INCLUDE FILE its.incl.pl1 */ 305 306 end; /* external procedure probe_check_ptr_ */ SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/24/88 1339.1 probe_check_ptr_.pl1 >special_ldd>install>MR12.2-1184>probe_check_ptr_.pl1 305 1 11/26/79 1320.6 its.incl.pl1 >ldd>include>its.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. P_code parameter fixed bin(35,0) dcl 37 set ref 179 185* 189 196* 200 206* 211* P_flags parameter bit packed unaligned dcl 37 ref 84 104 121 P_its_pointer parameter pointer dcl 37 set ref 84 90 90 90 90 97 179 200 206 210* 226 238 P_packed_pointer parameter pointer packed unaligned dcl 37 set ref 104 110* 113 189 268 addr builtin function dcl 78 ref 90 90 90 90 226 268 binary builtin function dcl 78 ref 231 231 bit_1_unaligned_array 000323 automatic bit(1) array packed unaligned dcl 133 set ref 138* 139 bit_offset based fixed bin(6,0) level 2 in structure "packed_ptr" packed packed unsigned unaligned dcl 258 in procedure "check_packed_pointer" ref 270 bit_offset 1(21) based fixed bin(6,0) level 2 in structure "its_ptr" packed packed unsigned unaligned dcl 52 in procedure "probe_check_ptr_" set ref 90 90* 234 code 000316 automatic fixed bin(35,0) dcl 49 set ref 97 113 124 144* 145 150 151* 185 196 209* 210* 211 225* 241* 244* 267* 270* 272* convert_status_code_ 000052 constant entry external dcl 63 ref 151 dname 000201 automatic char(168) packed unaligned dcl 45 set ref 144* 160 163 166 168 dont_include_pathname 000322 automatic bit(1) level 2 packed packed unaligned dcl 54 set ref 138 ename 000253 automatic char(32) packed unaligned dcl 46 set ref 144* 172 error_table_$bad_ptr 000064 external static fixed bin(35,0) dcl 71 ref 244 270 error_table_$invalidsegno 000066 external static fixed bin(35,0) dcl 71 ref 145 flags 000322 automatic structure level 1 dcl 54 set ref 121* get_pdir_ 000054 constant entry external dcl 65 ref 288 hcs_$fs_get_mode 000056 constant entry external dcl 66 ref 210 hcs_$fs_get_path_name 000060 constant entry external dcl 67 ref 144 illegal_modifier 000000 stack reference condition dcl 81 ref 237 239 initialized constant bit(1) initial dcl 61 ref 87 107 ioa_$rsnnl 000062 constant entry external dcl 69 ref 90 110 its_mod 0(30) based bit(6) level 2 packed packed unaligned dcl 52 ref 228 its_ptr based structure level 1 dcl 52 its_ptr_ptr 000320 automatic pointer dcl 51 set ref 226* 228 231 231 234 its_unsigned based structure level 1 dcl 1-30 length builtin function dcl 78 ref 290 294 long_info 000263 automatic char(100) dcl 47 set ref 151* 154 null builtin function dcl 78 ref 99 116 129 206 offset 1 based fixed bin(18,0) level 2 packed packed unsigned unaligned dcl 52 set ref 90* packed_ptr based structure level 1 dcl 258 packed_ptr_ptr 000336 automatic pointer dcl 257 set ref 268* 270 probe_et_$null_ptr 000070 external static fixed bin(35,0) dcl 76 ref 206 process_dir_names 000010 internal static varying char(64) initial array dcl 58 set ref 160 163 287 288* 290 292* 294* 294 294 298* 298 return_str 000100 automatic varying char(256) dcl 44 set ref 90* 110* 125* 125 126 139 146* 146 147 153* 153 154* 154 155* 155 156 159* 159 160* 160 163* 163 166* 166 168* 168 172* 172 175 rtrim builtin function dcl 78 ref 154 166 172 segno 0(03) based fixed bin(15,0) level 2 packed packed unsigned unaligned dcl 52 set ref 90* 231 231 string builtin function dcl 78 set ref 121* stupid_idx 000326 automatic fixed bin(17,0) dcl 135 set ref 137* 138 139 substr builtin function dcl 78 ref 290 294 test_pointer 000314 automatic pointer dcl 48 set ref 97* 99* 113* 116* 129 144* test_ptr 000100 automatic pointer dcl 222 set ref 238* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ITP_MODIFIER internal static bit(6) initial packed unaligned dcl 1-56 ITS_MODIFIER internal static bit(6) initial packed unaligned dcl 1-55 itp based structure level 1 dcl 1-18 itp_unsigned based structure level 1 dcl 1-43 its based structure level 1 dcl 1-5 NAMES DECLARED BY EXPLICIT CONTEXT. BAD_ITS_POINTER 001206 constant label dcl 244 ref 228 231 234 237 CONVERT_POINTER_COMMON 000322 constant label dcl 121 ref 101 118 check_its_pointer 001120 constant entry internal dcl 216 ref 96 183 check_packed_pointer 001213 constant entry internal dcl 251 ref 112 194 initialize 001232 constant entry internal dcl 278 ref 87 107 probe_check_ptr_ 000074 constant entry external dcl 25 probe_check_ptr_$check 000773 constant entry external dcl 179 probe_check_ptr_$check_packed 001024 constant entry external dcl 189 probe_check_ptr_$convert 000110 constant entry external dcl 84 probe_check_ptr_$convert_packed 000234 constant entry external dcl 104 probe_check_ptr_$indirectable 001050 constant entry external dcl 200 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1604 1676 1314 1614 Length 2126 1314 72 213 270 42 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME probe_check_ptr_ 317 external procedure is an external procedure. check_its_pointer 73 internal procedure enables or reverts conditions. on unit on line 237 64 on unit check_packed_pointer internal procedure shares stack frame of external procedure probe_check_ptr_. initialize internal procedure shares stack frame of external procedure probe_check_ptr_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 process_dir_names probe_check_ptr_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_its_pointer 000100 test_ptr check_its_pointer probe_check_ptr_ 000100 return_str probe_check_ptr_ 000201 dname probe_check_ptr_ 000253 ename probe_check_ptr_ 000263 long_info probe_check_ptr_ 000314 test_pointer probe_check_ptr_ 000316 code probe_check_ptr_ 000320 its_ptr_ptr probe_check_ptr_ 000322 flags probe_check_ptr_ 000323 bit_1_unaligned_array probe_check_ptr_ 000326 stupid_idx probe_check_ptr_ 000336 packed_ptr_ptr check_packed_pointer THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc call_ext_out call_int_this return_mac tra_ext_1 signal_op enable_op ext_entry ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_status_code_ get_pdir_ hcs_$fs_get_mode hcs_$fs_get_path_name ioa_$rsnnl THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_ptr error_table_$invalidsegno probe_et_$null_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000073 84 000103 87 000124 90 000127 96 000212 97 000216 99 000225 101 000227 104 000230 107 000250 110 000253 112 000304 113 000305 116 000317 118 000321 121 000322 124 000331 125 000333 126 000345 129 000362 137 000402 138 000404 139 000407 144 000430 145 000462 146 000466 147 000500 150 000516 151 000520 153 000534 154 000546 155 000572 156 000601 159 000617 160 000626 163 000646 166 000666 168 000712 172 000725 175 000751 179 000767 183 001002 185 001006 186 001011 189 001020 194 001033 196 001034 197 001037 200 001046 206 001057 209 001070 210 001071 211 001105 213 001110 216 001117 225 001125 226 001127 228 001132 231 001136 234 001152 237 001157 238 001176 239 001203 241 001204 242 001205 244 001206 246 001212 251 001213 267 001214 268 001215 270 001220 272 001230 273 001231 278 001232 287 001233 288 001241 290 001255 292 001261 294 001265 297 001302 298 001303 300 001310 ----------------------------------------------------------- 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