COMPILATION LISTING OF SEGMENT disklow Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/18/84 1208.6 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 disklow: proc; 12 13 /* This program prints out a listing of projects 14* whose disk usage is near their limits, 15* from the disk usage figures in "projfile" 16* which were placed there by "charge_disk". 17* 18* It is based on the program print_disk, and it 19* prints the same information, but only for projects 20* selected by the arguments (or the defaults). 21* 22* The arguments are number_left and percent_full. 23* The defaults are 20 pages and 90%, respectively. 24* 25* THVV 4/70 26* Modified June 1979 by C. Hornig to make it legal PL/1. 27* Modified Feb 1980 by M. B. Armstrong to implement multiple rate structures. 28* */ 29 30 dcl (hp, pp) ptr, /* pointer to input */ 31 dummy (0: 7) float bin, 32 dummy1 float bin, 33 disk_price (0:9) float bin, 34 ap pointer, /* argument pointer */ 35 al fixed bin, /* argument length */ 36 bchr char (al) based (ap) unal, 37 cs char (16) aligned, 38 tid char (9) aligned, 39 PERCENT_FULL float bin init (0.90e0), 40 NUMBER_LEFT fixed bin init (20), 41 nlow fixed bin init (0), 42 rs_number fixed bin, 43 rs_name char (32), 44 rs_count fixed bin, 45 temp fixed bin (71), /* temp for disk use */ 46 dols float bin, /* dollar charge */ 47 tdols float bin init (0.0e0), /* total charge */ 48 tqta fixed bin (35) init (0), /* total quota */ 49 tuse fixed bin (35) init (0), /* total use */ 50 qta fixed bin (35), /* project quota */ 51 use fixed bin (35), /* project use */ 52 (i, np) fixed bin; /* misc */ 53 dcl ec fixed bin (35); 54 55 dcl system_info_$rs_name entry (fixed bin, char (*), fixed bin (35)), 56 system_info_$prices_rs entry (fixed bin, 57 (0: 7) float bin, (0: 7) float bin, (0: 7) float bin, (0: 7) float bin, float bin, float bin), 58 system_info_$max_rs_number entry (fixed bin), 59 search_sat_$rs_number entry (char (*), fixed bin, fixed bin (35)), 60 search_sat_$clean_up entry, 61 get_wdir_ entry () returns (char (168)), 62 cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)), 63 cv_dec_check_ ext entry (char (*), fixed bin (35)) returns (fixed bin (35)), 64 ioa_ ext entry options (variable), /* output printing procedure */ 65 hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin, ptr, fixed bin (35)), 66 hcs_$terminate_noname entry (ptr, fixed bin (35)), /* file system */ 67 com_err_ ext entry options (variable); /* error reporter */ 68 dcl error_table_$noentry external fixed bin (35); 69 70 dcl (addr, hbound, null) builtin; 71 72 dcl format char (24) int static aligned options (constant) init /* output formats */ 73 ("^9a^4x^6d^4x^6d^4x^15.2f"); 74 1 1 /* BEGIN INCLUDE FILE .. projfile.incl.pl1 */ 1 2 /* Modified by T. Casey April 1976 to change disk_infs (obsolete) to dir_disk_use */ 1 3 /* Modified 1984-07-09 BIM for dir_disk_quota, version */ 1 4 /* Modified 1984-09-14 BIM for reasonable array size */ 1 5 1 6 dcl 1 projfile based (pp) aligned, /* Project history file */ 1 7 2 nproj fixed bin (35), /* number of entries */ 1 8 2 version fixed bin, 1 9 2 projfilexx0 (6) bit (36) aligned, 1 10 2 projfiletab (3000), /* in seg limit */ 1 11 3 id char (12) unal, /* project ID */ 1 12 3 title char (52) unal, /* project title */ 1 13 3 inv char (32) unal, /* name of principal investigator */ 1 14 3 inv_addr char (32) unal, /* address */ 1 15 3 sup char (32) unal, /* name of supervisor */ 1 16 3 sup_addr char (32) unal, /* address */ 1 17 3 sup_phone char (16) unal, /* telephone */ 1 18 3 on fixed bin (71), /* date on */ 1 19 3 off fixed bin (71), /* date off */ 1 20 3 disk_psec fixed bin (71), /* project disk page-seconds */ 1 21 3 disk_quota fixed bin (35), /* project disk quota */ 1 22 3 dir_disk_quota fixed bin (35), /* project dir disk quota */ 1 23 3 disk_use fixed bin (35), /* total segment pages used */ 1 24 3 dir_disk_use fixed bin (35), /* total directory pages used */ 1 25 3 misc_charges float bin, /* manuals, etc */ 1 26 3 n_misc fixed bin, /* number of entries */ 1 27 3 processed fixed bin, /* temp for usage-report */ 1 28 3 pad bit (36) aligned; /* out to even number of words */ 1 29 1 30 dcl loph int static fixed bin (17) options (constant) init (8), /* lth of projfile header */ 1 31 lope int static fixed bin (17) options (constant) init (66); /* lth of projflile entry */ 1 32 1 33 dcl PROJFILE_VERSION fixed bin init (3) int static options (constant); 1 34 1 35 /* END INCLUDE FILE ... projfile.incl.pl1 */ 75 76 77 /* - - - - */ 78 79 call system_info_$max_rs_number (rs_count); /* see if site has multiple rate structures */ 80 ap = addr (ap); /* initialize ap to dummy address */ 81 82 call cu_$arg_ptr (1, ap, al, ec); /* get arg 1 */ 83 if ec = 0 then do; 84 i = cv_dec_check_ (bchr, ec); /* number? */ 85 if ec ^= 0 then do; 86 dec_err: call com_err_ (0, "disklow", "^a is non-numeric.", bchr); 87 return; 88 end; 89 NUMBER_LEFT = i; 90 call cu_$arg_ptr (2, ap, al, ec); /* get arg 2 */ 91 if ec = 0 then do; 92 i = cv_dec_check_ (bchr, ec); 93 if ec ^= 0 then go to dec_err; 94 PERCENT_FULL = i/100.0e0; 95 end; 96 end; 97 98 cs = "projfile"; 99 call hcs_$initiate ((get_wdir_ ()), cs, "", 0, 1, pp, ec); 100 if pp = null then do; 101 err: call com_err_ (ec, "disklow", cs); /* complain */ 102 return; 103 end; 104 105 do rs_number = 0 to hbound (disk_price, 1); /* get all the prices */ 106 call system_info_$rs_name (rs_number, rs_name, ec); /* this is just used to find if the rs exists */ 107 if ec ^= 0 then disk_price (rs_number) = disk_price (0); /* assumes default will be defined aok */ 108 else call system_info_$prices_rs (rs_number, dummy, dummy, dummy, dummy, disk_price (rs_number), dummy1); 109 end; 110 111 np = projfile.nproj; /* get number of projects */ 112 113 call ioa_ ("Project quota used dollar charge"); 114 do i = 1 to np; /* loop on all projects */ 115 if id (i) = "" then go to skip; 116 if off (i) ^= 0 then if disk_psec (i) = 0 then go to skip; 117 else tid = "*" || id (i); 118 else tid = id (i); 119 qta = disk_quota (i); /* extract project quota */ 120 use = disk_use (i); /* use */ 121 temp = disk_psec (i); /* page-seconds */ 122 if rs_count > 0 then do; /* only if site has multiple rate structures */ 123 call search_sat_$rs_number ((id (i)), rs_number, ec); /* get rate index */ 124 if ec ^= 0 then 125 if ec = error_table_$noentry then 126 call com_err_ (ec, "disklow", 127 "Trying to locate project ""^a"". Default rates will be used.", 128 id (i)); 129 else call com_err_ (ec, "disklow", "Accessing the sat. Default rates will be used"); 130 end; 131 else rs_number = 0; 132 dols = temp * disk_price (rs_number); /* compute charge */ 133 tdols = tdols + dols; /* accumulate totals */ 134 tqta = tqta + qta; 135 tuse = tuse + use; 136 if use = 0 then go to skip; /* should we print record */ 137 if qta - use < NUMBER_LEFT then go to p1; 138 if (1.0e0 * use) / qta > PERCENT_FULL then go to p1; 139 go to skip; 140 p1: call ioa_ (format, tid, qta, use, dols); 141 nlow = nlow + 1; 142 skip: end; 143 if nlow = 0 then call ioa_ ("All projects OK."); 144 call ioa_ (""); 145 call ioa_ (format, "TOTAL", tqta, tuse, tdols); 146 call hcs_$terminate_noname (pp, ec); /* terminate input */ 147 if rs_count > 0 then call search_sat_$clean_up; /* tidy up */ 148 149 end disklow; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/18/84 0755.8 disklow.pl1 >special_ldd>online>09/18/84>disklow.pl1 75 1 09/18/84 1000.6 projfile.incl.pl1 >special_ldd>online>09/18/84>projfile.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. NUMBER_LEFT 000141 automatic fixed bin(17,0) initial dcl 30 set ref 30* 89* 137 PERCENT_FULL 000140 automatic float bin(27) initial dcl 30 set ref 30* 94* 138 addr builtin function dcl 70 ref 80 al 000130 automatic fixed bin(17,0) dcl 30 set ref 82* 84 84 86 86 90* 92 92 ap 000126 automatic pointer dcl 30 set ref 80* 80 82* 84 86 90* 92 bchr based char unaligned dcl 30 set ref 84* 86* 92* com_err_ 000036 constant entry external dcl 55 ref 86 101 124 129 cs 000131 automatic char(16) dcl 30 set ref 98* 99* 101* cu_$arg_ptr 000024 constant entry external dcl 55 ref 82 90 cv_dec_check_ 000026 constant entry external dcl 55 ref 84 92 disk_price 000113 automatic float bin(27) array dcl 30 set ref 105 107* 107 108* 132 disk_psec 100 based fixed bin(71,0) array level 3 dcl 1-6 ref 116 121 disk_quota 102 based fixed bin(35,0) array level 3 dcl 1-6 ref 119 disk_use 104 based fixed bin(35,0) array level 3 dcl 1-6 ref 120 dols 000160 automatic float bin(27) dcl 30 set ref 132* 133 140* dummy 000102 automatic float bin(27) array dcl 30 set ref 108* 108* 108* 108* dummy1 000112 automatic float bin(27) dcl 30 set ref 108* ec 000170 automatic fixed bin(35,0) dcl 53 set ref 82* 83 84* 85 90* 91 92* 93 99* 101* 106* 107 123* 124 124 124* 129* 146* error_table_$noentry 000040 external static fixed bin(35,0) dcl 68 ref 124 format 000000 constant char(24) initial dcl 72 set ref 140* 145* get_wdir_ 000022 constant entry external dcl 55 ref 99 hbound builtin function dcl 70 ref 105 hcs_$initiate 000032 constant entry external dcl 55 ref 99 hcs_$terminate_noname 000034 constant entry external dcl 55 ref 146 i 000166 automatic fixed bin(17,0) dcl 30 set ref 84* 89 92* 94 114* 115 116 116 117 118 119 120 121 123 124* id 10 based char(12) array level 3 packed unaligned dcl 1-6 set ref 115 117 118 123 124* ioa_ 000030 constant entry external dcl 55 ref 113 140 143 144 145 nlow 000142 automatic fixed bin(17,0) initial dcl 30 set ref 30* 141* 141 143 np 000167 automatic fixed bin(17,0) dcl 30 set ref 111* 114 nproj based fixed bin(35,0) level 2 dcl 1-6 ref 111 null builtin function dcl 70 ref 100 off 76 based fixed bin(71,0) array level 3 dcl 1-6 ref 116 pp 000100 automatic pointer dcl 30 set ref 99* 100 111 115 116 116 117 118 119 120 121 123 124 146* projfile based structure level 1 dcl 1-6 projfiletab 10 based structure array level 2 dcl 1-6 qta 000164 automatic fixed bin(35,0) dcl 30 set ref 119* 134 137 138 140* rs_count 000154 automatic fixed bin(17,0) dcl 30 set ref 79* 122 147 rs_name 000144 automatic char(32) unaligned dcl 30 set ref 106* rs_number 000143 automatic fixed bin(17,0) dcl 30 set ref 105* 106* 107 108* 108* 123* 131* 132 search_sat_$clean_up 000020 constant entry external dcl 55 ref 147 search_sat_$rs_number 000016 constant entry external dcl 55 ref 123 system_info_$max_rs_number 000014 constant entry external dcl 55 ref 79 system_info_$prices_rs 000012 constant entry external dcl 55 ref 108 system_info_$rs_name 000010 constant entry external dcl 55 ref 106 tdols 000161 automatic float bin(27) initial dcl 30 set ref 30* 133* 133 145* temp 000156 automatic fixed bin(71,0) dcl 30 set ref 121* 132 tid 000135 automatic char(9) dcl 30 set ref 117* 118* 140* tqta 000162 automatic fixed bin(35,0) initial dcl 30 set ref 30* 134* 134 145* tuse 000163 automatic fixed bin(35,0) initial dcl 30 set ref 30* 135* 135 145* use 000165 automatic fixed bin(35,0) dcl 30 set ref 120* 135 136 137 138 140* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. PROJFILE_VERSION internal static fixed bin(17,0) initial dcl 1-33 hp automatic pointer dcl 30 lope internal static fixed bin(17,0) initial dcl 1-30 loph internal static fixed bin(17,0) initial dcl 1-30 NAMES DECLARED BY EXPLICIT CONTEXT. dec_err 000223 constant label dcl 86 ref 93 disklow 000125 constant entry external dcl 11 err 000427 constant label dcl 101 p1 001021 constant label dcl 140 ref 137 138 skip 001052 constant label dcl 142 ref 115 116 136 139 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1340 1402 1160 1350 Length 1612 1160 42 174 157 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME disklow 257 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME disklow 000100 pp disklow 000102 dummy disklow 000112 dummy1 disklow 000113 disk_price disklow 000126 ap disklow 000130 al disklow 000131 cs disklow 000135 tid disklow 000140 PERCENT_FULL disklow 000141 NUMBER_LEFT disklow 000142 nlow disklow 000143 rs_number disklow 000144 rs_name disklow 000154 rs_count disklow 000156 temp disklow 000160 dols disklow 000161 tdols disklow 000162 tqta disklow 000163 tuse disklow 000164 qta disklow 000165 use disklow 000166 i disklow 000167 np disklow 000170 ec disklow THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cv_dec_check_ get_wdir_ hcs_$initiate hcs_$terminate_noname ioa_ search_sat_$clean_up search_sat_$rs_number system_info_$max_rs_number system_info_$prices_rs system_info_$rs_name 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 000124 30 000132 79 000143 80 000151 82 000153 83 000172 84 000174 85 000221 86 000223 87 000264 89 000265 90 000267 91 000306 92 000310 93 000335 94 000337 98 000343 99 000346 100 000423 101 000427 102 000452 105 000453 106 000457 107 000500 108 000506 109 000527 111 000531 113 000533 114 000547 115 000557 116 000567 117 000575 118 000613 119 000622 120 000625 121 000627 122 000631 123 000633 124 000661 129 000722 130 000747 131 000750 132 000751 133 000757 134 000761 135 000765 136 000771 137 000773 138 001005 139 001020 140 001021 141 001051 142 001052 143 001054 144 001073 145 001104 146 001136 147 001147 149 001156 ----------------------------------------------------------- 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