COMPILATION LISTING OF SEGMENT upd_print_names_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1724.6 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 upd_print_names_: procedure (np, n, asw); 12 13 14 /* 15* 16* This procedure is used within the Multics Online Updater to 17* print standard updater-format name lists on the user's terminal. 18* Options allow suppression of error messages which correspond 19* to the process and restore status codes. 20* 21* P. Bos, May 1972 22* 23**/ 24 25 dcl np ptr, /* pointer to name array */ 26 n fixed bin, /* size of array */ 27 asw bit(*); /* option switches */ 28 29 dcl check_fs_errcode_ entry (fixed bin(35), char(8) aligned, char(100) aligned), 30 ios_$write entry (char(*), ptr, fixed bin, fixed bin, fixed bin, bit(72) aligned); 31 32 dcl (addr, null, length) builtin; 33 34 dcl error_table_$not_done ext fixed bin(35); 35 36 dcl (p, sp) ptr; 37 38 dcl code fixed bin(35), 39 status_code bit(72) aligned; 40 41 dcl chars char(j) based (p), /* char string overlay */ 42 (dummy char(8), 43 info char(100), 44 line char(266)) aligned; 45 46 dcl sws bit(2) aligned; /* copy of asw */ 47 48 dcl 1 s based (sp), /* overlaid on sws */ 49 (2 psw bit(1), /* non-zero if to interpret process code */ 50 2 rsw bit(1)) unal; /* non-zero if to interpret restore code */ 51 52 dcl 1 names (n) aligned based (np), /* updater-format names array */ 53 2 name char(32), /* segment name */ 54 2 pcode fixed bin(35), /* status code during processing */ 55 2 rcode fixed bin(35); /* status code during restore */ 56 57 dcl empty char(21) aligned init (" Name list is empty. 58 "); 59 dcl (i, j, l, ll, lmax, nelemt) fixed bin; 60 61 /* */ 62 63 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 64 65 66 if np ^= null then if n ^= 0 then /* see if null name list */ 67 go to skip; /* no, go print it */ 68 call ios_$write ("installation_list_", addr (empty), 0, 21, nelemt, status_code); 69 /* yes, print message saying this, */ 70 return; /* and exit */ 71 72 skip: sws = asw; /* align option bits */ 73 sp = addr (sws); /* get pointer for overlay */ 74 lmax = length (line); /* set max. line length for addchr */ 75 do i = 1 to n; /* once over lightly */ 76 line = " "; /* blank out line image and start with a tab */ 77 l = 1; /* nothing in it yet */ 78 p = addr (names(i).name); /* get pointer to this name */ 79 j = 32; /* and length */ 80 call adjust (p, j); /* strip blanks */ 81 call addchr (chars); /* and insert into output line */ 82 if s.psw then do; /* user want process code? */ 83 code = names(i).pcode; /* copy status code */ 84 if code = 0 then /* nothing there */ 85 go to skip1; /* well, don't put it in then */ 86 if l < 30 then /* most names will fit in 30 chars */ 87 l = 30; /* make error message fall on tab stop */ 88 else /* big name */ 89 l = l + 1; /* add a blank */ 90 call check_fs_errcode_(code, dummy, info); /* get error_table_ message */ 91 p = addr (info); /* get pointer to it */ 92 j = 100; /* and length */ 93 call adjust (p, j); /* pajamas too big? */ 94 call addchr (chars); /* just right, now */ 95 end; 96 skip1: if s.rsw then do; /* want restore code? */ 97 code = names(i).rcode; /* copy it */ 98 if code ^= 0 then if code ^= error_table_$not_done then do; 99 call check_fs_errcode_(code, dummy, info); /* expand message */ 100 call addchr (" 101 (restore) "); /* 20 blanks on end */ 102 p = addr (info); /* get pointer to message */ 103 j = 100; /* and length */ 104 call adjust (p, j); /* strip blanks */ 105 call addchr (chars); /* and insert it */ 106 end; 107 end; 108 call addchr (" 109 "); call ios_$write ("installation_list_", addr (line), 0, l, nelemt, status_code); 110 /* append and write it on listing stream. */ 111 end; 112 113 return; /* done, exit */ 114 115 /* */ 116 117 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 118 119 120 addchr: procedure (arg); /* procedure to add arg to line */ 121 122 123 dcl arg char(*); /* char string to insert into line */ 124 125 dcl (length, substr) builtin; 126 127 dcl t fixed bin; /* temp */ 128 129 130 t = length (arg); /* get size of string to add */ 131 if t > lmax - l then /* maximum of lmax chars in message */ 132 t = lmax - l; /* make sure we don't run off end */ 133 if t ^= 0 then do; /* still room, put it in */ 134 substr (line, l+1, t) = arg; /* after what's already there */ 135 l = l + t; /* line got longer */ 136 end; 137 return; /* done */ 138 139 end addchr; 140 141 142 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 143 144 145 adjust: procedure (argp, argl); /* procedure to strip leading, trailing blanks */ 146 147 148 dcl argp ptr, /* pointer to char string */ 149 argl fixed bin; /* length of string */ 150 151 dcl t fixed bin; /* temp */ 152 153 dcl 1 c based (argp), /* char array overlaid on string */ 154 2 char (argl) char(1) unal; /* makes better code than substr */ 155 156 157 do t = 1 to argl; /* scan from front for first non-blank */ 158 if c.char(t) ^= " " then /* non-blank? */ 159 go to first; /* yes, exit loop */ 160 end; 161 first: argp = addr (c.char(t)); /* adjust pointer to point to it */ 162 argl = argl - t + 1; /* adjust length */ 163 if argl ^= 0 then do; /* if string not all blank */ 164 do t = argl to 1 by -1; /* scan from end for last non-blank */ 165 if c.char(t) ^= " " then /* found it? */ 166 go to last; /* yes, skip */ 167 end; 168 last: argl = t; /* set new length */ 169 end; 170 return; /* bye... */ 171 172 end adjust; 173 174 175 end upd_print_names_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1514.5 upd_print_names_.pl1 >dumps>old>recomp>upd_print_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. addr builtin function dcl 32 ref 68 68 73 78 91 102 109 109 161 arg parameter char unaligned dcl 123 ref 120 130 134 argl parameter fixed bin(17,0) dcl 148 set ref 145 157 162* 162 163 164 168* argp parameter pointer dcl 148 set ref 145 158 161* 161 165 asw parameter bit unaligned dcl 25 ref 11 72 c based structure level 1 packed unaligned dcl 153 char based char(1) array level 2 packed unaligned dcl 153 set ref 158 161 165 chars based char unaligned dcl 41 set ref 81* 94* 105* check_fs_errcode_ 000010 constant entry external dcl 29 ref 90 99 code 000104 automatic fixed bin(35,0) dcl 38 set ref 83* 84 90* 97* 98 98 99* dummy 000110 automatic char(8) dcl 41 set ref 90* 99* empty 000247 automatic char(21) initial dcl 57 set ref 57* 68 68 error_table_$not_done 000014 external static fixed bin(35,0) dcl 34 ref 98 i 000255 automatic fixed bin(17,0) dcl 59 set ref 75* 78 83 97* info 000112 automatic char(100) dcl 41 set ref 90* 91 99* 102 ios_$write 000012 constant entry external dcl 29 ref 68 109 j 000256 automatic fixed bin(17,0) dcl 59 set ref 79* 80* 81 81 92* 93* 94 94 103* 104* 105 105 l 000257 automatic fixed bin(17,0) dcl 59 set ref 77* 86 86* 88* 88 109* 131 131 134 135* 135 length builtin function dcl 32 in procedure "upd_print_names_" ref 74 length builtin function dcl 125 in procedure "addchr" ref 130 line 000143 automatic char(266) dcl 41 set ref 74 76* 109 109 134* lmax 000260 automatic fixed bin(17,0) dcl 59 set ref 74* 131 131 n parameter fixed bin(17,0) dcl 25 ref 11 66 75 name based char(32) array level 2 dcl 52 set ref 78 names based structure array level 1 dcl 52 nelemt 000261 automatic fixed bin(17,0) dcl 59 set ref 68* 109* np parameter pointer dcl 25 ref 11 66 78 83 97 null builtin function dcl 32 ref 66 p 000100 automatic pointer dcl 36 set ref 78* 80* 81 91* 93* 94 102* 104* 105 pcode 10 based fixed bin(35,0) array level 2 dcl 52 ref 83 psw based bit(1) level 2 packed unaligned dcl 48 ref 82 rcode 11 based fixed bin(35,0) array level 2 dcl 52 ref 97 rsw 0(01) based bit(1) level 2 packed unaligned dcl 48 ref 96 s based structure level 1 packed unaligned dcl 48 sp 000102 automatic pointer dcl 36 set ref 73* 82 96 status_code 000106 automatic bit(72) dcl 38 set ref 68* 109* substr builtin function dcl 125 set ref 134* sws 000246 automatic bit(2) dcl 46 set ref 72* 73 t 000302 automatic fixed bin(17,0) dcl 151 in procedure "adjust" set ref 157* 158* 161 162 164* 165* 168 t 000272 automatic fixed bin(17,0) dcl 127 in procedure "addchr" set ref 130* 131 131* 133 134 135 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ll automatic fixed bin(17,0) dcl 59 NAMES DECLARED BY EXPLICIT CONTEXT. addchr 000427 constant entry internal dcl 120 ref 81 94 100 105 108 adjust 000463 constant entry internal dcl 145 ref 80 93 104 first 000505 constant label dcl 161 ref 158 last 000537 constant label dcl 168 ref 165 skip 000136 constant label dcl 72 set ref 66 skip1 000272 constant label dcl 96 ref 84 upd_print_names_ 000043 constant entry external dcl 11 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 646 664 566 656 Length 1036 566 16 135 57 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME upd_print_names_ 233 external procedure is an external procedure. addchr internal procedure shares stack frame of external procedure upd_print_names_. adjust internal procedure shares stack frame of external procedure upd_print_names_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME upd_print_names_ 000100 p upd_print_names_ 000102 sp upd_print_names_ 000104 code upd_print_names_ 000106 status_code upd_print_names_ 000110 dummy upd_print_names_ 000112 info upd_print_names_ 000143 line upd_print_names_ 000246 sws upd_print_names_ 000247 empty upd_print_names_ 000255 i upd_print_names_ 000256 j upd_print_names_ 000257 l upd_print_names_ 000260 lmax upd_print_names_ 000261 nelemt upd_print_names_ 000272 t addchr 000302 t adjust THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_fs_errcode_ ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_done LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000037 57 000056 66 000061 68 000070 70 000135 72 000136 73 000144 74 000146 75 000150 76 000157 77 000162 78 000164 79 000173 80 000175 81 000177 82 000212 83 000217 84 000226 86 000227 88 000235 90 000236 91 000251 92 000253 93 000255 94 000257 96 000272 97 000277 98 000306 99 000312 100 000324 102 000332 103 000334 104 000336 105 000340 108 000353 109 000360 111 000424 113 000426 120 000427 130 000440 131 000441 133 000450 134 000452 135 000461 137 000462 145 000463 157 000465 158 000474 160 000503 161 000505 162 000514 163 000520 164 000521 165 000525 167 000534 168 000537 170 000541 ----------------------------------------------------------- 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