COMPILATION LISTING OF SEGMENT list_ref_names Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 02/07/84 1248.8 mst Tue 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 list_ref_names: lrn: proc; 12 13 /* This command lists the reference names of segments */ 14 /* initially coded Jan 1971 by Dan Bricklin */ 15 /* last modified by Dan B. March 1971 */ 16 /* Fixed to abort for invalid -from and -to, Steve Herbst 11/8/77 */ 17 /* Fixed to not make copy in [pd] if copy switch is on 03/20/80 S. Herbst */ 18 /* Changed to always print segno, path, and refnames 12/13/83 S. Herbst */ 19 /* Fixed to rtrim the refnames it prints 12/14/83 S. Herbst */ 20 21 dcl 22 (i, alen, from_seg, to_seg, argno, seg_no, num_null) fixed bin, 23 code fixed bin (35), 24 error_table_$badopt fixed bin (35) ext, 25 error_table_$segknown fixed bin (35) ext, 26 (aptr, segptr) ptr, 27 (brief, prt, allsw, no_zero) bit (1) aligned, 28 which char (16) init ("list_ref_names") int static aligned, 29 dirname char (168) aligned, 30 ename char (32) aligned, 31 arg char (alen) based (aptr), 32 ret label init (end_loop), 33 plural char (1) aligned, 34 35 1 p aligned, 36 2 ignore char (31) unaligned, 37 2 rname char (32) unaligned, 38 2 nl char (1) unaligned, 39 40 cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)), 41 cv_oct_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin (35)), 42 expand_pathname_ ext entry (char (*), char (*) aligned, char (*) aligned, fixed bin (35)), 43 hcs_$initiate ext entry (char (*)aligned, char (*)aligned, char (*)aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), 44 com_err_ ext entry options (variable), 45 ioa_ ext entry options (variable), 46 hcs_$terminate_noname ext entry (ptr, fixed bin (35)), 47 hcs_$fs_get_path_name ext entry (ptr, char (*)aligned, fixed bin, char (*)aligned, fixed bin (35)), 48 hcs_$high_low_seg_count ext entry (fixed bin, fixed bin), 49 hcs_$fs_get_ref_name ext entry (ptr, fixed bin, char (*), fixed bin (35)), 50 ring0_get_$name ext entry (char (*)aligned, char (*)aligned, ptr, fixed bin (35)), 51 iox_$user_output ptr ext; 52 53 dcl (addr, baseno, baseptr, fixed, length, substr) builtin; 54 55 allsw, brief, no_zero = "0"b; /* assume print ring-0, and not all and brief options */ 56 nl = " 57 "; /* set nl equal to a newline char */ 58 argno = 1; /* start with first argument */ 59 60 do i = 1 by 1; /* look at all arguments */ 61 call cu_$arg_ptr (i, aptr, alen, code); /* for the -all and -brief options */ 62 if code ^= 0 then go to next; /* end of argument list */ 63 if arg = "-brief" | arg = "-bf" then brief = "1"b; /* found a brief option */ 64 if arg = "-all" | arg = "-a" then allsw = "1"b; /* found an all option, so set switch to remember */ 65 end; 66 67 next: from_seg = 0; /* default from segment number is zero */ 68 69 call cu_$arg_ptr (argno, aptr, alen, code); /* get next argument */ 70 71 if code ^= 0 then do; /* end of argument list */ 72 if argno = 1 | argno = 2 & brief then do; /* if nothing was given, print all non-ring zero */ 73 no_zero = "1"b; /* don't print ring zero ones */ 74 go to all; 75 end; 76 return; /* else return to caller */ 77 end; 78 79 if arg = "-to" then do; /* if the -to option is encountered, do */ 80 argno = argno + 1; /* look at next argument */ 81 to_sec: call cu_$arg_ptr (argno, aptr, alen, code); 82 if code ^= 0 then do; /* if not there then it is an error */ 83 error: call com_err_ (code, which); /* print message */ 84 return; /* end of arg list, so return */ 85 end; 86 87 to_seg = cv_oct_check_ (arg, code); /* convert to number */ 88 89 if code ^= 0 | to_seg < 0 then do; 90 call com_err_ (0, which, "Invalid -to argument ^a", arg); 91 return; 92 end; 93 94 got_to: if from_seg>to_seg then do; /* if lower bound > upper bound then error */ 95 call com_err_ (0, which, "Lower segment number bound ^o greater than upper bound ^o", 96 from_seg, to_seg); 97 return; 98 end; 99 100 num_print: /* given segment number, print info */ 101 prt = "0"b; /* nothing printed yet */ 102 103 do seg_no = from_seg to to_seg; /* do for each segment number in range */ 104 105 call hcs_$fs_get_path_name (baseptr (seg_no), dirname, i, ename, code); /* get path name */ 106 if code ^= 0 then do; /* if unable then try the following */ 107 if no_zero then go to end_loop; /* if no ring-0 ones to be printed, don't even check */ 108 call ring0_get_$name (dirname, ename, baseptr (seg_no), code); /* is it in ring 0 ? */ 109 if code ^= 0 then go to end_loop; /* if not, then ignore it for now */ 110 111 if dirname = "" then call ioa_ (" ^o ^a (ring 0)", seg_no, ename); /* no dir */ 112 113 else do; 114 115 if dirname = ">" then dirname = ""; /* don't have two >'s on root */ 116 117 call ioa_ (" ^o ^a>^a (ring 0)", seg_no, dirname, ename); /* print info */ 118 119 end; 120 121 prt = "1"b; 122 123 go to printed; /* skip around regular print routine */ 124 end; 125 126 if i = 1 then dirname = ""; /* if name is only >, then remove it, since we have one */ 127 128 prt = "1"b; /* we printed something */ 129 130 call ioa_ ("^/ ^o ^a>^a", seg_no, dirname, ename); /* print number and path */ 131 132 printed: if ^brief then do; /* print reference names, if not brief */ 133 134 ret = end_loop; /* pseudo call */ 135 136 go to ref_print; 137 138 end; 139 140 end_loop: end; /* end of loop for each segment number */ 141 142 if ^prt then 143 if to_seg = from_seg then call com_err_ (0, which, "Invalid segment number ^o", from_seg); 144 else call com_err_ (0, which, "Invalid segment numbers ^o and ^o", from_seg, to_seg); 145 146 argno = argno + 1; 147 go to next; 148 end; 149 150 if arg = "-from" | arg = "-fm" then do; /* if -from option encountered */ 151 argno = argno + 1; /* look for number after it */ 152 call cu_$arg_ptr (argno, aptr, alen, code); 153 if code ^= 0 then go to error; /* not found is an error */ 154 155 from_seg = cv_oct_check_ (arg, code); /* make it a number */ 156 157 if code ^= 0 | from_seg < 0 then do; 158 call com_err_ (0, which, "Invalid -from argument ^a", arg); 159 return; 160 end; 161 162 call cu_$arg_ptr (argno + 1, aptr, alen, code); /* look for a "-to" after the from number */ 163 164 165 all: call hcs_$high_low_seg_count (to_seg, i); /* get last allocated segment number */ 166 to_seg = to_seg + i; /* by adding high hc to number after hardcore */ 167 if from_seg>to_seg then do; /* starting after last seg */ 168 call com_err_ (0, which, "Lower bound ^o greater than highest segment number ^o.", 169 from_seg, to_seg); 170 171 return; 172 173 end; 174 175 if code = 0 then if arg = "-to" then do; 176 argno = argno + 2; 177 go to to_sec; 178 end; 179 180 181 go to got_to; 182 183 184 end; 185 186 if arg = "-name" | arg = "-nm" then do; /* if name option */ 187 argno = argno + 1; /* get next argument */ 188 call cu_$arg_ptr (argno, aptr, alen, code); /* and treat it as a character string */ 189 if code = 0 then go to no_num; /* regardless of how it looks */ 190 else go to error; /* if none there, then error */ 191 end; 192 193 if arg = "-brief" | arg = "-bf" then do; /* ignore brief options since we already processed it */ 194 argno = argno + 1; 195 go to next; 196 end; 197 198 if allsw then do; /* if all option was present */ 199 from_seg = 0; /* simulate -from 0 */ 200 go to all; 201 end; 202 203 if substr (arg, 1, 1) = "-" then do; /* look for option type args which we can't identify */ 204 call com_err_ (error_table_$badopt, which, "^a", arg); 205 return; 206 end; 207 208 seg_no = cv_oct_check_ (arg, code); /* see if argument can be seen as a number */ 209 210 if code = 0 then do; /* if so, then do */ 211 to_seg, from_seg = seg_no; /* pretend that it is: -from num -to num */ 212 go to num_print; /* go to numbered segment printing routine */ 213 end; 214 215 no_num: call expand_pathname_ (arg, dirname, ename, code); 216 if code ^= 0 then go to error; 217 218 call hcs_$initiate (dirname, ename, "", 0, 1, segptr, code); /* see if it is there already and where */ 219 220 if code = 0 then do; /* wasn't known in advance, no good */ 221 call com_err_ (0, which, "Segment not known. ^a^[>^]^a", dirname, dirname ^= ">", ename); 222 call hcs_$terminate_noname (segptr, code); /* terminate the reference */ 223 argno = argno + 1; /* try next argument */ 224 go to next; 225 end; 226 227 if code ^= error_table_$segknown then do; /* if it wasn't known, another error */ 228 call com_err_ (code, which, "^a^[>^]^a", dirname, dirname ^= ">", ename); 229 argno = argno + 1; /* try again */ 230 go to next; 231 end; 232 233 seg_no = fixed (baseno (segptr)); /* get segment number part of pointer */ 234 235 call hcs_$terminate_noname (segptr, code); /* this reference dosn't count, so end it */ 236 237 call ioa_ ("^/ ^o ^a>^a", seg_no, dirname, ename); /* print number and path */ 238 239 argno = argno + 1; /* get ready for next argument */ 240 241 if brief then go to next; /* skip ref name printing */ 242 243 ret = next; /* pseudo call */ 244 245 ref_print: 246 num_null = 0; /* no null reference names found so far for this segment */ 247 248 do i = 1 by 1; /* look at all reference names */ 249 call hcs_$fs_get_ref_name (baseptr (seg_no), i, p.rname, code); /* get reference names from this entry */ 250 if code ^= 0 then go to fin; /* when ended, then go to fin */ 251 252 /* if not null, write structure with it and newline */ 253 if p.rname ^= "" then 254 call ioa_ ("^a", p.rname); 255 256 else num_null = num_null + 1; /* else count number of null refs */ 257 258 end; 259 260 fin: if num_null>0 then do; /* print number of null refs if > zero */ 261 if num_null = 1 then plural = " "; /* de-pluralize word */ 262 else plural = "s"; /* pluralize word */ 263 call ioa_ ("^d null reference name^a", num_null, plural); 264 end; 265 266 go to ret; /* pseudo return */ 267 268 269 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/07/84 1248.5 list_ref_names.pl1 >special_ldd>on>6621>list_ref_names.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. alen 000101 automatic fixed bin(17,0) dcl 21 set ref 61* 63 63 64 64 69* 79 81* 87 87 90 90 150 150 152* 155 155 158 158 162* 175 186 186 188* 193 193 203 204 204 208 208 215 215 allsw 000116 automatic bit(1) dcl 21 set ref 55* 64* 198 aptr 000110 automatic pointer dcl 21 set ref 61* 63 63 64 64 69* 79 81* 87 90 150 150 152* 155 158 162* 175 186 186 188* 193 193 203 204 208 215 arg based char unaligned dcl 21 set ref 63 63 64 64 79 87* 90* 150 150 155* 158* 175 186 186 193 193 203 204* 208* 215* argno 000104 automatic fixed bin(17,0) dcl 21 set ref 58* 69* 72 72 80* 80 81* 146* 146 151* 151 152* 162 176* 176 187* 187 188* 194* 194 223* 223 229* 229 239* 239 baseno builtin function dcl 53 ref 233 baseptr builtin function dcl 53 ref 105 105 108 108 249 249 brief 000114 automatic bit(1) dcl 21 set ref 55* 63* 72 132 241 code 000107 automatic fixed bin(35,0) dcl 21 set ref 61* 62 69* 71 81* 82 83* 87* 89 105* 106 108* 109 152* 153 155* 157 162* 175 188* 189 208* 210 215* 216 218* 220 222* 227 228* 235* 249* 250 com_err_ 000030 constant entry external dcl 21 ref 83 90 95 142 144 158 168 204 221 228 cu_$arg_ptr 000020 constant entry external dcl 21 ref 61 69 81 152 162 188 cv_oct_check_ 000022 constant entry external dcl 21 ref 87 155 208 dirname 000120 automatic char(168) dcl 21 set ref 105* 108* 111 115 115* 117* 126* 130* 215* 218* 221* 221 228* 228 237* ename 000172 automatic char(32) dcl 21 set ref 105* 108* 111* 117* 130* 215* 218* 221* 228* 237* error_table_$badopt 000014 external static fixed bin(35,0) dcl 21 set ref 204* error_table_$segknown 000016 external static fixed bin(35,0) dcl 21 ref 227 expand_pathname_ 000024 constant entry external dcl 21 ref 215 fixed builtin function dcl 53 ref 233 from_seg 000102 automatic fixed bin(17,0) dcl 21 set ref 67* 94 95* 103 142 142* 144* 155* 157 167 168* 199* 211* hcs_$fs_get_path_name 000036 constant entry external dcl 21 ref 105 hcs_$fs_get_ref_name 000042 constant entry external dcl 21 ref 249 hcs_$high_low_seg_count 000040 constant entry external dcl 21 ref 165 hcs_$initiate 000026 constant entry external dcl 21 ref 218 hcs_$terminate_noname 000034 constant entry external dcl 21 ref 222 235 i 000100 automatic fixed bin(17,0) dcl 21 set ref 60* 61* 105* 126 165* 166 248* 249* ioa_ 000032 constant entry external dcl 21 ref 111 117 130 237 253 263 nl 17(27) 000207 automatic char(1) level 2 packed unaligned dcl 21 set ref 56* no_zero 000117 automatic bit(1) dcl 21 set ref 55* 73* 107 num_null 000106 automatic fixed bin(17,0) dcl 21 set ref 245* 256* 256 260 261 263* p 000207 automatic structure level 1 dcl 21 plural 000206 automatic char(1) dcl 21 set ref 261* 262* 263* prt 000115 automatic bit(1) dcl 21 set ref 100* 121* 128* 142 ret 000202 automatic label variable initial dcl 21 set ref 21* 134* 243* 266 ring0_get_$name 000044 constant entry external dcl 21 ref 108 rname 7(27) 000207 automatic char(32) level 2 packed unaligned dcl 21 set ref 249* 253 253* seg_no 000105 automatic fixed bin(17,0) dcl 21 set ref 103* 105 105 108 108 111* 117* 130* 208* 211 233* 237* 249 249 segptr 000112 automatic pointer dcl 21 set ref 218* 222* 233 235* substr builtin function dcl 53 ref 203 to_seg 000103 automatic fixed bin(17,0) dcl 21 set ref 87* 89 94 95* 103 142 144* 165* 166* 166 167 168* 211* which 000010 internal static char(16) initial dcl 21 set ref 83* 90* 95* 142* 144* 158* 168* 204* 221* 228* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addr builtin function dcl 53 iox_$user_output external static pointer dcl 21 length builtin function dcl 53 NAMES DECLARED BY EXPLICIT CONTEXT. all 001240 constant label dcl 165 ref 74 200 end_loop 001003 constant label dcl 140 ref 21 107 109 134 error 000364 constant label dcl 83 ref 153 190 216 fin 002072 constant label dcl 260 ref 250 got_to 000470 constant label dcl 94 ref 181 list_ref_names 000215 constant entry external dcl 11 lrn 000205 constant entry external dcl 11 next 000303 constant label dcl 67 ref 62 147 195 224 230 241 243 no_num 001470 constant label dcl 215 ref 189 num_print 000530 constant label dcl 100 ref 212 printed 000775 constant label dcl 132 ref 123 ref_print 002000 constant label dcl 245 ref 136 to_sec 000345 constant label dcl 81 ref 177 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2324 2372 2134 2334 Length 2602 2134 46 174 167 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lrn 252 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 which lrn STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lrn 000100 i lrn 000101 alen lrn 000102 from_seg lrn 000103 to_seg lrn 000104 argno lrn 000105 seg_no lrn 000106 num_null lrn 000107 code lrn 000110 aptr lrn 000112 segptr lrn 000114 brief lrn 000115 prt lrn 000116 allsw lrn 000117 no_zero lrn 000120 dirname lrn 000172 ename lrn 000202 ret lrn 000206 plural lrn 000207 p lrn THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc call_ext_out return tra_label_var ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cv_oct_check_ expand_pathname_ hcs_$fs_get_path_name hcs_$fs_get_ref_name hcs_$high_low_seg_count hcs_$initiate hcs_$terminate_noname ioa_ ring0_get_$name THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$segknown LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000177 11 000204 55 000223 56 000226 58 000230 60 000232 61 000234 62 000251 63 000253 64 000267 65 000301 67 000303 69 000304 71 000321 72 000323 73 000332 74 000334 76 000335 79 000336 80 000344 81 000345 82 000362 83 000364 84 000401 87 000402 89 000427 90 000433 91 000467 94 000470 95 000473 97 000527 100 000530 103 000531 105 000541 106 000575 107 000577 108 000601 109 000632 111 000634 115 000670 117 000677 121 000727 123 000731 126 000732 128 000740 130 000742 132 000775 134 000777 136 001002 140 001003 142 001005 144 001044 146 001100 147 001101 150 001102 151 001112 152 001113 153 001130 155 001132 157 001157 158 001163 159 001217 162 001220 165 001240 166 001251 167 001253 168 001256 171 001312 175 001313 176 001323 177 001325 181 001326 186 001327 187 001337 188 001340 189 001355 190 001357 193 001360 194 001370 195 001371 198 001372 199 001374 200 001375 203 001376 204 001402 205 001434 208 001435 210 001462 211 001464 212 001467 215 001470 216 001520 218 001522 220 001566 221 001570 222 001636 223 001647 224 001650 227 001651 228 001654 229 001721 230 001722 233 001723 235 001727 237 001737 239 001772 241 001773 243 001775 245 002000 248 002001 249 002004 250 002037 253 002041 256 002067 258 002070 260 002072 261 002074 262 002101 263 002103 266 002127 ----------------------------------------------------------- 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