COMPILATION LISTING OF SEGMENT carry_dump_dp Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1601.5 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 carry_dump_dp: procedure ( dir_path, map_dir_name, sys_map_name, err_file_name ); 12 13 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 14 /* */ 15 /* This procedure dprints the user maps made */ 16 /* during a carry_dump run. */ 17 /* */ 18 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 19 20 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 21 /* */ 22 /* Declarations */ 23 /* */ 24 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 25 26 declare ( dir_path, /* pathname of outer directory */ 27 map_dir_name, /* entry name of user map directory */ 28 sys_map_name, /* entry name of system map */ 29 err_file_name ) char(*); /* entry name of error file */ 30 31 declare ( map_dir_path, /* path name of user map directory */ 32 sys_map_path, /* path name of system map */ 33 err_file_path, /* path name of error file */ 34 name_path, /* path name of a user map */ 35 dir_name ) char(168); /* name of old user map directory */ 36 37 declare header char(200) aligned, /* dp header for user maps */ 38 header_len fixed bin; /* length of user headers */ 39 40 declare user_map char(user_map_len) based(user_map_ptr); 41 42 declare ( dir_len, /* real length of a dir pathname */ 43 name_len ) fixed bin; /* real length of an entry name */ 44 45 declare (i, j, k, start, user_map_len) fixed bin; 46 47 declare code fixed bin(35); /* standard status code */ 48 49 declare (time1, time2, one_day) fixed bin(71); 50 51 declare type fixed bin(2), /* for call to status_minf */ 52 bit_count fixed bin(24); /* = */ 53 54 declare rings(3) fixed bin(5) internal static initial ( 4, 4, 4 ); /* for call to set_ring_brackets */ 55 56 declare area_ptr pointer, /* pointer to area for star_ */ 57 eptr pointer, /* pointer to star_ entry array */ 58 nptr pointer, /* pointer to star_ name array */ 59 user_map_ptr pointer, 60 ecount fixed bin, /* star_ entry count */ 61 62 1 entry(ecount) based(eptr), /* star_ entry array structure */ 63 2 type bit(2) unaligned, /* entry type */ 64 2 nnames bit(16) unaligned, /* number of names on entry */ 65 2 nindex bit(18) unaligned, /* index of first name in name array */ 66 67 name(2) char(32) based(nptr); /* star_ name array */ 68 69 declare 1 branch_status aligned, 70 ( 2 type bit(2), 71 2 nnames fixed bin(15), 72 2 nrp bit(18), 73 2 dtcm bit(36), 74 2 dtu bit(36), 75 2 mode bit(5), 76 2 pad bit(13), 77 2 records fixed bin(17)) unaligned; 78 79 declare error_table_$noentry fixed bin (35) ext; 80 81 declare area_ entry ( fixed bin, ptr ), /* external procedures */ 82 clock_ entry returns ( fixed bin(71) ), 83 com_err_ entry options ( variable ) , 84 convert_date_to_binary_ entry(char(*),fixed bin(71),fixed bin(35)), 85 delete_$path entry ( char(*), char(*), bit(6), char(*), fixed bin(35) ), 86 dprint$dp entry options ( variable ) , 87 hcs_$delentry_file entry (char (*), char (*), fixed bin(35) ), 88 hcs_$delentry_seg entry ( ptr, fixed bin(35) ), 89 hcs_$initiate_count entry(char(*),char(*),char(*),fixed bin(24),fixed bin(1),ptr,fixed bin(35)), 90 hcs_$make_seg entry ( char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35) ), 91 hcs_$set_ring_brackets entry ( char(*), char(*), (3) fixed bin(5), fixed bin(35) ), 92 hcs_$star_ entry ( char(*), char(*), fixed bin(2), ptr, fixed bin, ptr, ptr, fixed bin(35) ), 93 hcs_$status_ entry ( char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35) ), 94 hcs_$status_minf entry ( char(*), char(*), fixed bin(1), fixed bin(2), fixed bin(24), fixed bin(35) ), 95 hcs_$terminate_seg entry(ptr,fixed bin(1),fixed bin(35)), 96 ioa_$rsnnl entry options ( variable ); 97 98 declare ( addr, /* builtin functions */ 99 fixed, 100 index, 101 null, 102 substr ) builtin; 103 104 /* */ 105 106 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 107 /* */ 108 /* Create the various pathnames for the user map */ 109 /* directory, the system map, and the error file */ 110 /* */ 111 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 112 113 dir_len = index ( dir_path, " " ) - 1; /* get length of directory portion */ 114 115 name_len = index ( map_dir_name, " " ) - 1; /* get length of map dir entry name */ 116 if name_len = -1 /* is it 32 characters ? */ 117 then name_len = 32; /* yes, make it so */ 118 map_dir_path = substr ( dir_path, 1, dir_len ) /* make up the full pathname */ 119 || ">" 120 || substr ( map_dir_name, 1, name_len ); 121 122 name_len = index ( sys_map_name, " " ) - 1; /* get length of sys map entry name */ 123 if name_len = -1 /* is it 32 characters ? */ 124 then name_len = 32; /* yes, make it so */ 125 sys_map_path = substr ( dir_path, 1, dir_len ) /* make up the full pathname */ 126 || ">" 127 || substr ( sys_map_name, 1, name_len ); 128 129 name_len = index ( err_file_name, " " ) - 1; /* get length of err file entry name */ 130 if name_len = -1 /* is it 32 characters ? */ 131 then name_len = 32; /* yes, make it so */ 132 err_file_path = substr ( dir_path, 1, dir_len ) /* make up the full pathname */ 133 || ">" 134 || substr ( err_file_name, 1, name_len ); 135 136 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 137 /* */ 138 /* dprint the system map and error file if they */ 139 /* actually exist. */ 140 /* */ 141 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 142 /* see if the system map exists */ 143 call hcs_$status_minf ( dir_path, sys_map_name, 1, type, bit_count, code ); 144 if code ^= 0 /* is it there ? */ 145 then go to get_err_file ; /* no, don't dprint it */ 146 /* set the ring brackets properly */ 147 call hcs_$set_ring_brackets ( dir_path, sys_map_name, rings, code ); 148 149 get_err_file: /* check to see if the error file is there */ 150 call hcs_$status_minf ( dir_path, err_file_name, 1, type , bit_count, code); 151 if code = error_table_$noentry then go to get_user_maps; 152 call hcs_$set_ring_brackets ( err_file_path, "", rings, code ); 153 if bit_count = 0 then call hcs_$delentry_file ( err_file_path, "", code ); 154 /* */ 155 /* * * * * * * * * * * * * * * * * * * * * * * * */ 156 /* */ 157 /* Get set up to dprint the user maps. */ 158 /* */ 159 /* * * * * * * * * * * * * * * * * * * * * * * * */ 160 161 get_user_maps: /* first get a seg for star area */ 162 call hcs_$make_seg( "", "carry_dump_area_", "", 01111b, area_ptr, code ); 163 if area_ptr = null() 164 then do; 165 call com_err_ ( code, "carry_dump_dp", 166 "^/Unable to create area segment, unable to dprint user maps."); 167 return; 168 end; 169 170 call area_ (60000, area_ptr); /* initialize the allocation area */ 171 172 /* get the entry list */ 173 call hcs_$star_ (map_dir_path, "**", 3, area_ptr, ecount, eptr, nptr, code ); 174 if code ^= 0 /* error getting names ? */ 175 then do; /* yes, then complain and leave */ 176 call com_err_ ( code, "carry_dump_dp", 177 "^/Unable to obtain names of user maps, unable to dprint user maps." ); 178 go to delete_old_dirs; 179 end; 180 /* are there entries ? */ 181 if ecount = 0 182 then go to delete_old_dirs; /* no, leave */ 183 184 dir_len = index ( map_dir_path, " " ) - 1; /* get length of user map dir path */ 185 186 /* */ 187 188 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 189 /* */ 190 /* Having set everything up, loop through the maps */ 191 /* printing them for the users. */ 192 /* */ 193 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 194 195 do i = 1 to ecount; 196 197 j = fixed ( eptr->entry(i).nindex ); /* get offset in name array */ 198 /* generate header string */ 199 call ioa_$rsnnl ( "^a", header, header_len, nptr->name(j) ); 200 201 name_len = index ( nptr->name(j), " ") - 1; /* get length of user name */ 202 if name_len = -1 /* is it 32 characters ? */ 203 then name_len = 32; /* yes, make it so */ 204 205 name_path = substr ( map_dir_path, 1, dir_len) /* make up map path name */ 206 || ">" 207 || substr (nptr->name(j), 1, name_len); 208 /* set the proper ring brackets */ 209 call hcs_$set_ring_brackets ( map_dir_path, nptr->name(j), rings, code ); 210 211 /* Dprint this user map only if there were errors */ 212 213 call hcs_$initiate_count(name_path,"","",bit_count,0,user_map_ptr,code); 214 if user_map_ptr=null then do; 215 dprint_map: call dprint$dp("-bf","-dl","-he",substr(header,1,header_len),name_path); 216 end; 217 else do; 218 if bit_count^=0 then do; 219 user_map_len = divide(bit_count,9,17,0); 220 start = 1; 221 do while(start>0); 222 k = index(substr(user_map,start),":"); 223 if k=0 then start = 0; 224 else do; 225 if k<11 | substr(user_map,start+k-11,11)^="Tape label:" then do; 226 call hcs_$terminate_seg(user_map_ptr,0,code); 227 go to dprint_map; 228 end; 229 start = start+k; 230 end; 231 end; 232 end; 233 call delete_$path(name_path,"","000101"b,"",code); 234 end; 235 236 end; 237 238 /* */ 239 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 240 /* */ 241 /* Delete all old user map directories. */ 242 /* */ 243 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 244 245 246 delete_old_dirs: 247 call hcs_$star_ (dir_path, "**.map_dir", 2, area_ptr, ecount, eptr, nptr, code); 248 if code^=0 | ecount<2 then go to delete_area; 249 250 do i = 1 to ecount; 251 dir_name = nptr->name(fixed(eptr->entry(i).nindex)); 252 if eptr->entry(i).type="10"b then 253 if dir_name^=map_dir_name then do; 254 call hcs_$status_(dir_path,dir_name,1,addr(branch_status),null,code); 255 if code=0 then do; 256 time1 = fixed(branch_status.dtcm)*2**16; /* microseconds, */ 257 time2 = clock_(); /* microseconds, */ 258 call convert_date_to_binary_("1 day",one_day,code); 259 if time2-time1>one_day then 260 call delete_$path (dir_path, dir_name, "011000"b, "carry_dump", code); 261 end; 262 end; 263 end; 264 265 266 267 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 268 /* */ 269 /* All done. Delete the area seg and leave. */ 270 /* */ 271 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 272 273 274 delete_area: 275 call hcs_$delentry_seg (area_ptr, code ); /* that's got it */ 276 277 return; 278 279 end carry_dump_dp; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1459.0 carry_dump_dp.pl1 >dumps>old>recomp>carry_dump_dp.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 98 ref 254 254 area_ 000020 constant entry external dcl 81 ref 170 area_ptr 000526 automatic pointer dcl 56 set ref 161* 163 170* 173* 246* 274* bit_count 000525 automatic fixed bin(24,0) dcl 51 set ref 143* 149* 153 213* 218 219 branch_status 000537 automatic structure level 1 dcl 69 set ref 254 254 clock_ 000022 constant entry external dcl 81 ref 257 code 000514 automatic fixed bin(35,0) dcl 47 set ref 143* 144 147* 149* 151 152* 153* 161* 165* 173* 174 176* 209* 213* 226* 233* 246* 248 254* 255 258* 259* 274* com_err_ 000024 constant entry external dcl 81 ref 165 176 convert_date_to_binary_ 000026 constant entry external dcl 81 ref 258 delete_$path 000030 constant entry external dcl 81 ref 233 259 dir_len 000505 automatic fixed bin(17,0) dcl 42 set ref 113* 118 125 132 184* 205 dir_name 000350 automatic char(168) unaligned dcl 31 set ref 251* 252 254* 259* dir_path parameter char unaligned dcl 26 set ref 11 113 118 125 132 143* 147* 149* 246* 254* 259* dprint$dp 000032 constant entry external dcl 81 ref 215 dtcm 1 000537 automatic bit(36) level 2 packed unaligned dcl 69 set ref 256 ecount 000536 automatic fixed bin(17,0) dcl 56 set ref 173* 181 195 246* 248 250 entry based structure array level 1 packed unaligned dcl 56 eptr 000530 automatic pointer dcl 56 set ref 173* 197 246* 251 252 err_file_name parameter char unaligned dcl 26 set ref 11 129 132 149* err_file_path 000224 automatic char(168) unaligned dcl 31 set ref 132* 152* 153* error_table_$noentry 000016 external static fixed bin(35,0) dcl 79 ref 151 fixed builtin function dcl 98 ref 197 251 256 hcs_$delentry_file 000034 constant entry external dcl 81 ref 153 hcs_$delentry_seg 000036 constant entry external dcl 81 ref 274 hcs_$initiate_count 000040 constant entry external dcl 81 ref 213 hcs_$make_seg 000042 constant entry external dcl 81 ref 161 hcs_$set_ring_brackets 000044 constant entry external dcl 81 ref 147 152 209 hcs_$star_ 000046 constant entry external dcl 81 ref 173 246 hcs_$status_ 000050 constant entry external dcl 81 ref 254 hcs_$status_minf 000052 constant entry external dcl 81 ref 143 149 hcs_$terminate_seg 000054 constant entry external dcl 81 ref 226 header 000422 automatic char(200) dcl 37 set ref 199* 215 215 header_len 000504 automatic fixed bin(17,0) dcl 37 set ref 199* 215 215 i 000507 automatic fixed bin(17,0) dcl 45 set ref 195* 197* 250* 251 252* index builtin function dcl 98 ref 113 115 122 129 184 201 222 ioa_$rsnnl 000056 constant entry external dcl 81 ref 199 j 000510 automatic fixed bin(17,0) dcl 45 set ref 197* 199 201 205 209 k 000511 automatic fixed bin(17,0) dcl 45 set ref 222* 223 225 225 229 map_dir_name parameter char unaligned dcl 26 ref 11 115 118 252 map_dir_path 000100 automatic char(168) unaligned dcl 31 set ref 118* 173* 184 205 209* name based char(32) array unaligned dcl 56 set ref 199* 201 205 209* 251 name_len 000506 automatic fixed bin(17,0) dcl 42 set ref 115* 116 116* 118 122* 123 123* 125 129* 130 130* 132 201* 202 202* 205 name_path 000276 automatic char(168) unaligned dcl 31 set ref 205* 213* 215* 233* nindex 0(18) based bit(18) array level 2 packed unaligned dcl 56 ref 197 251 nptr 000532 automatic pointer dcl 56 set ref 173* 199 201 205 209 246* 251 null builtin function dcl 98 ref 163 214 254 254 one_day 000522 automatic fixed bin(71,0) dcl 49 set ref 258* 259 rings 000010 internal static fixed bin(5,0) initial array dcl 54 set ref 147* 152* 209* start 000512 automatic fixed bin(17,0) dcl 45 set ref 220* 221 222 223* 225 229* 229 substr builtin function dcl 98 ref 118 118 125 125 132 132 205 205 215 215 222 225 sys_map_name parameter char unaligned dcl 26 set ref 11 122 125 143* 147* sys_map_path 000152 automatic char(168) unaligned dcl 31 set ref 125* time1 000516 automatic fixed bin(71,0) dcl 49 set ref 256* 259 time2 000520 automatic fixed bin(71,0) dcl 49 set ref 257* 259 type based bit(2) array level 2 in structure "entry" packed unaligned dcl 56 in procedure "carry_dump_dp" ref 252 type 000524 automatic fixed bin(2,0) dcl 51 in procedure "carry_dump_dp" set ref 143* 149* user_map based char unaligned dcl 40 ref 222 225 user_map_len 000513 automatic fixed bin(17,0) dcl 45 set ref 219* 222 225 user_map_ptr 000534 automatic pointer dcl 56 set ref 213* 214 222 225 226* NAMES DECLARED BY EXPLICIT CONTEXT. carry_dump_dp 000130 constant entry external dcl 11 delete_area 001734 constant label dcl 274 ref 248 delete_old_dirs 001411 constant label dcl 246 ref 178 181 dprint_map 001226 constant label dcl 215 ref 227 get_err_file 000440 constant label dcl 149 ref 144 get_user_maps 000554 constant label dcl 161 ref 151 NAME DECLARED BY CONTEXT OR IMPLICATION. divide builtin function ref 219 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2172 2252 1753 2202 Length 2454 1753 60 166 216 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME carry_dump_dp 470 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 rings carry_dump_dp STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME carry_dump_dp 000100 map_dir_path carry_dump_dp 000152 sys_map_path carry_dump_dp 000224 err_file_path carry_dump_dp 000276 name_path carry_dump_dp 000350 dir_name carry_dump_dp 000422 header carry_dump_dp 000504 header_len carry_dump_dp 000505 dir_len carry_dump_dp 000506 name_len carry_dump_dp 000507 i carry_dump_dp 000510 j carry_dump_dp 000511 k carry_dump_dp 000512 start carry_dump_dp 000513 user_map_len carry_dump_dp 000514 code carry_dump_dp 000516 time1 carry_dump_dp 000520 time2 carry_dump_dp 000522 one_day carry_dump_dp 000524 type carry_dump_dp 000525 bit_count carry_dump_dp 000526 area_ptr carry_dump_dp 000530 eptr carry_dump_dp 000532 nptr carry_dump_dp 000534 user_map_ptr carry_dump_dp 000536 ecount carry_dump_dp 000537 branch_status carry_dump_dp THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return mpfx2 mpfx3 shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. area_ clock_ com_err_ convert_date_to_binary_ decimal_exp_ delete_$path dprint$dp hcs_$delentry_file hcs_$delentry_seg hcs_$initiate_count hcs_$make_seg hcs_$set_ring_brackets hcs_$star_ hcs_$status_ hcs_$status_minf hcs_$terminate_seg ioa_$rsnnl THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$noentry LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000123 113 000162 115 000175 116 000207 118 000213 122 000242 123 000255 125 000261 129 000305 130 000320 132 000324 143 000350 144 000407 147 000411 149 000440 151 000501 152 000505 153 000531 161 000554 163 000620 165 000624 167 000656 170 000657 173 000672 174 000741 176 000743 178 000775 181 000776 184 001000 195 001010 197 001017 199 001027 201 001061 202 001074 205 001100 209 001133 213 001161 214 001222 215 001226 216 001272 218 001274 219 001276 220 001300 221 001302 222 001304 223 001323 225 001326 226 001335 227 001351 229 001352 231 001354 233 001355 236 001407 246 001411 248 001465 250 001472 251 001500 252 001520 254 001535 255 001600 256 001602 257 001633 258 001642 259 001665 263 001732 274 001734 277 001745 ----------------------------------------------------------- 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