COMPILATION LISTING OF SEGMENT archive_aux_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1727.4 mst Thu 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 /* 12*auxilliary subroutines used by the archive command 13*for special case handling. 14* 15* listwdir used to list the working directory 16* inwdir used to find whether entry is in wdir 17* free used to free storage allocated by listwdir 18* 19* active used to note to user attempt to use recursively 20* 21**/ 22 /* 23*12/03/70 coded J.W. Gintell 24*07/07/71 modified 25*Bug fixed 04/18/79 S. Herbst 26**/ 27 archive_aux_: proc; 28 29 dcl (addr, bin, null, substr) builtin; 30 /* 31* */ 32 33 listwdir: entry(auxw_ptr,code); 34 35 dcl auxw_ptr ptr; /* pointer to structure */ 36 dcl code fixed bin(35); 37 38 dcl (get_system_free_area_, freen_) entry(ptr); 39 dcl hcs_$star_list_ external entry(char(*),char(*),fixed bin(3),ptr,fixed bin, 40 fixed bin,ptr,ptr,fixed bin(35)); 41 dcl hcs_$status_long entry(char(*), char(*), fixed bin, ptr, ptr, fixed bin(35)); 42 43 declare 1 stat aligned, /* Structure for status_long call */ 44 2 (type bit(2), 45 pad bit(34)) unaligned, 46 2 dtm bit(36), 47 2 pad1(5) fixed bin, 48 2 (curlen bit(12), 49 bitcnt bit(24)) unaligned, 50 2 pad2(2) fixed bin; 51 52 declare 1 wstructure aligned based(auxw_ptr), 53 2 mustfree bit(1), /* set to one after allocation complete */ 54 2 ecount fixed bin, /* Number of entries in directory */ 55 2 wdir char(168) unaligned, /* Working directory unaligned, filled by caller */ 56 2 eptr ptr, /* pointer to entry structure */ 57 2 nptr ptr; /* pointer to name structure */ 58 59 dcl area area based (areap); /* for freeing */ 60 dcl areap ptr; /* pointer to area */ 61 dcl lcount fixed bin(17); /* number of links */ 62 dcl (j,k) fixed bin(17); 63 64 dcl 1 branches(ecount) based(eptr) aligned, /* returned by star_ in area */ 65 (2 type bit(2), /* ask for segs only */ 66 2 nname bit(16), /* number of names */ 67 2 nindex bit(18), /* index to names array */ 68 2 dtm bit(36), /* date-time mod */ 69 2 dtu bit(36), 70 2 mode bit(5), 71 2 pad bit(13), 72 2 records bit(18)) unaligned; 73 74 dcl names (5000) char(32) aligned based (nptr); /* Illegal PL/I but easier than computing # of names */ 75 76 77 call get_system_free_area_(areap); /* get area for star handler */ 78 79 call hcs_$star_list_(wdir,"**",3,areap,ecount,lcount,eptr,nptr,code); 80 ecount = ecount + lcount; /* Update by number of links, to get total entries */ 81 if ecount > 0 then mustfree = "1"b; 82 83 return; 84 85 86 87 88 inwdir: entry(auxw_ptr,component_name,dtm,type,found) ; 89 90 dcl component_name char(32); 91 dcl type bit(2) aligned; 92 dcl dtm bit(36) aligned; 93 dcl found bit(1) aligned; 94 95 dcl xcode fixed bin(35); 96 97 98 do k = 1 to ecount; /* look at all branches */ 99 do j = 1 to bin(eptr->branches.nname(k), 17); /* look at all names */ 100 if component_name = nptr->names(j+bin(eptr->branches.nindex(k), 17)-1) then do; 101 type = eptr->branches.type(k); 102 if type then dtm = eptr->branches.dtm(k); /* Is branch (really should check non-dir) */ 103 else do; /* Link, chase it */ 104 call hcs_$status_long(wdir, component_name, 1, addr(stat), null, xcode); 105 if xcode ^= 0 then go to nfnd; /* Link target empty */ 106 dtm = stat.dtm; /* Set date-time-seg updated */ 107 end; 108 found = "1"b; 109 return; 110 end; 111 end; 112 end; 113 114 nfnd: found = ""b; 115 return; 116 117 118 free: entry(auxw_ptr); 119 120 if eptr ^= null then free eptr -> branches in (area); 121 if nptr ^= null then free nptr -> names in (area); 122 return; 123 124 /* */ 125 active: entry(activeind); 126 127 dcl buffer char(120) varying; 128 129 dcl command_query_ entry options(variable); 130 131 declare 1 query_info aligned, /* structure for command_query_ */ 132 2 version fixed bin init(1), 133 2 yes_or_no_sw bit(1) unal init("1"b), /* require yes or no */ 134 2 suppress_name_sw bit(1) unal init("0"b), /* print name with question */ 135 2 status_code fixed bin(35), /* set to code of prompting question */ 136 2 query_code fixed bin(35) init(0); 137 138 dcl activeind bit(1) aligned; 139 140 query_info.status_code = 0; 141 call command_query_(addr(query_info),buffer,"archive", 142 "Pending work in previous invocation will be lost if you proceed;^/do you wish to proceed?",""); 143 144 if substr(buffer,1,3) = "yes" then activeind = ""b; 145 else activeind = "1"b; 146 147 end archive_aux_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1619.7 archive_aux_.pl1 >dumps>old>recomp>archive_aux_.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. activeind parameter bit(1) dcl 138 set ref 125 144* 145* addr builtin function dcl 29 ref 104 104 141 141 area based area(1024) dcl 59 ref 120 121 areap 000112 automatic pointer dcl 60 set ref 77* 79* 120 121 auxw_ptr parameter pointer dcl 35 ref 33 79 79 79 79 80 80 81 81 88 98 99 100 100 101 102 104 118 120 120 120 121 121 bin builtin function dcl 29 ref 99 100 branches based structure array level 1 dcl 64 ref 120 buffer 000120 automatic varying char(120) dcl 127 set ref 141* 144 code parameter fixed bin(35,0) dcl 36 set ref 33 79* command_query_ 000016 constant entry external dcl 129 ref 141 component_name parameter char(32) unaligned dcl 90 set ref 88 100 104* dtm parameter bit(36) dcl 92 in procedure "archive_aux_" set ref 88 102* 106* dtm 1 based bit(36) array level 2 in structure "branches" packed unaligned dcl 64 in procedure "archive_aux_" ref 102 dtm 1 000100 automatic bit(36) level 2 in structure "stat" dcl 43 in procedure "archive_aux_" set ref 106 ecount 1 based fixed bin(17,0) level 2 dcl 52 set ref 79* 80* 80 81 98 120 eptr 54 based pointer level 2 dcl 52 set ref 79* 99 100 101 102 120 120 found parameter bit(1) dcl 93 set ref 88 108* 114* get_system_free_area_ 000010 constant entry external dcl 38 ref 77 hcs_$star_list_ 000012 constant entry external dcl 39 ref 79 hcs_$status_long 000014 constant entry external dcl 41 ref 104 j 000115 automatic fixed bin(17,0) dcl 62 set ref 99* 100* k 000116 automatic fixed bin(17,0) dcl 62 set ref 98* 99 100 101 102* lcount 000114 automatic fixed bin(17,0) dcl 61 set ref 79* 80 mustfree based bit(1) level 2 dcl 52 set ref 81* names based char(32) array dcl 74 ref 100 121 nindex 0(18) based bit(18) array level 2 packed unaligned dcl 64 ref 100 nname 0(02) based bit(16) array level 2 packed unaligned dcl 64 ref 99 nptr 56 based pointer level 2 dcl 52 set ref 79* 100 121 121 null builtin function dcl 29 ref 104 104 120 121 query_code 3 000157 automatic fixed bin(35,0) initial level 2 dcl 131 set ref 131* query_info 000157 automatic structure level 1 dcl 131 set ref 141 141 stat 000100 automatic structure level 1 dcl 43 set ref 104 104 status_code 2 000157 automatic fixed bin(35,0) level 2 dcl 131 set ref 140* substr builtin function dcl 29 ref 144 suppress_name_sw 1(01) 000157 automatic bit(1) initial level 2 packed unaligned dcl 131 set ref 131* type based bit(2) array level 2 in structure "branches" packed unaligned dcl 64 in procedure "archive_aux_" ref 101 type parameter bit(2) dcl 91 in procedure "archive_aux_" set ref 88 101* 102 version 000157 automatic fixed bin(17,0) initial level 2 dcl 131 set ref 131* wdir 2 based char(168) level 2 packed unaligned dcl 52 set ref 79* 104* wstructure based structure level 1 dcl 52 xcode 000117 automatic fixed bin(35,0) dcl 95 set ref 104* 105 yes_or_no_sw 1 000157 automatic bit(1) initial level 2 packed unaligned dcl 131 set ref 131* NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. freen_ 000000 constant entry external dcl 38 NAMES DECLARED BY EXPLICIT CONTEXT. active 000426 constant entry external dcl 125 archive_aux_ 000066 constant entry external dcl 27 free 000370 constant entry external dcl 118 inwdir 000212 constant entry external dcl 88 listwdir 000101 constant entry external dcl 33 nfnd 000362 constant label dcl 114 ref 105 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 622 642 511 632 Length 1020 511 20 141 110 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME archive_aux_ 188 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME archive_aux_ 000100 stat archive_aux_ 000112 areap archive_aux_ 000114 lcount archive_aux_ 000115 j archive_aux_ 000116 k archive_aux_ 000117 xcode archive_aux_ 000120 buffer archive_aux_ 000157 query_info archive_aux_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. command_query_ get_system_free_area_ hcs_$star_list_ hcs_$status_long NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 131 000054 27 000065 33 000074 77 000107 79 000116 80 000173 81 000200 83 000204 88 000205 98 000220 99 000232 100 000250 101 000273 102 000300 104 000304 105 000346 106 000350 108 000353 109 000355 111 000356 112 000360 114 000362 115 000364 118 000365 120 000376 121 000411 122 000422 125 000423 140 000434 141 000435 144 000475 145 000504 147 000507 ----------------------------------------------------------- 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