COMPILATION LISTING OF SEGMENT total_output_requests Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1843.5 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 /* */ 13 /* Names: total_output_request, tor */ 14 /* */ 15 /* This command prints a summary of number of entries in various I/O Daemon request */ 16 /* type queues. When invoked as an active function, it returns the counts for a single */ 17 /* request type. */ 18 /* */ 19 /* Status */ 20 /* 0) Created: October 5, 1981 by G. C. Dixon */ 21 /* 1) Modified: April 29, 1982 by G. C. Dixon - to accept eor-defined request types */ 22 /* */ 23 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 24 25 total_output_requests: 26 tor: procedure; 27 28 dcl /* automatic variables */ 29 Larg fixed bin(21), /* length of input argument. */ 30 Lret fixed bin(21), /* length of output argument. */ 31 Nargs fixed bin, /* number of input arguments. */ 32 Parg ptr, /* ptr to input argument. */ 33 Pret ptr, /* ptr to output argument. */ 34 Sall bit(1), /* on if in -all mode. */ 35 Sbrief bit(1), /* on if in -brief mode. */ 36 Sinhibit_error bit(1), /* on if in -inhibit_error mode. */ 37 Sno_rqt bit(1), /* on if processing the default print rqt. */ 38 code fixed bin(35), /* a status code. */ 39 delim char(1), /* delimiter character for output msg. */ 40 dft_q fixed bin, 41 (i, j) fixed bin, /* a do-group index. */ 42 long (4) char(100), 43 pic pic"zzzzz9", 44 longest_q_name fixed bin, 45 1 s aligned, /* device rqt structure. */ 46 2 Nrqt fixed bin, /* number of request types. */ 47 2 rqt (100) char(32) unal, /* rqt name. */ 48 2 max_q (100) fixed bin, 49 2 queues (100,4), 50 3 code fixed bin(35), /* status code assoc. with rqt & queue. */ 51 3 q fixed bin; /* queue counts for request type's queues. */ 52 53 dcl /* based variables */ 54 arg char(Larg) based (Parg), 55 /* input argument. */ 56 ret char(Lret) varying based (Pret); 57 /* return argument. */ 58 59 dcl /* builtins */ 60 (dim, index, length, ltrim, max, min, rtrim, sum) 61 builtin; 62 63 dcl /* entries */ 64 active_fnc_err_ entry options (variable), 65 com_err_ entry options (variable), 66 convert_status_code_ entry (fixed bin(35), char(8), char(100)), 67 cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 68 cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 69 cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 70 dprint_$queue_contents entry (char(*), fixed bin, fixed bin, fixed bin(35)), 71 enter_output_request$default_request_type 72 entry (char(*), char(*), fixed bin, fixed bin, fixed bin(35)), 73 enter_output_request$request_type 74 entry (char(*), char(*), char(*), fixed bin, fixed bin, fixed bin(35)), 75 iod_info_$queue_data entry (char(*), fixed bin, fixed bin, fixed bin(35)), 76 iod_info_$rqt_list entry (char(32) unal, (*) char(32) unal, fixed bin, fixed bin(35)), 77 (ioa_, ioa_$nnl) entry options (variable); 78 79 dcl /* static variables */ 80 (FALSE init("0"b), 81 TRUE init("1"b)) bit(1) int static options(constant), 82 (error_table_$badopt, 83 error_table_$bigarg, 84 error_table_$id_not_found, 85 error_table_$too_many_names, 86 error_table_$wrong_no_of_args) fixed bin(35) ext static; 87 88 call cu_$af_return_arg (Nargs, Pret, Lret, code); 89 if code = 0 then do; /* Use special code if invoked as an active fcn */ 90 ret = ""; 91 if Nargs > 1 then go to wnoa; 92 if Nargs = 1 then do; 93 call cu_$af_arg_ptr (1, Parg, Larg, code); 94 call enter_output_request$request_type (arg, "", s.rqt(1), dft_q, s.max_q(1), code); 95 if code ^= 0 then go to af_undefined_request_type; 96 end; 97 else do; 98 call enter_output_request$default_request_type ("printer", s.rqt(1), dft_q, s.max_q(1), code); 99 if code ^= 0 then go to af_bad_default_request_type; 100 end; 101 102 s.max_q(1) = min(s.max_q(1),4); /* This program only supports up to 4 queues. */ 103 104 do i = 1 to s.max_q(1); 105 call dprint_$queue_contents (s.rqt(1), i, s.q(1,i), s.code(1,i)); 106 end; 107 108 if s.code(1,1) = 0 then do; /* Got count for queue 1 successfully? */ 109 pic = s.q(1,1); /* Yes, return the count. */ 110 ret = ltrim(pic); 111 end; 112 else ret = "*"; /* No, return a star for queue 1 count. */ 113 114 do i = 2 to s.max_q(1); 115 ret = ret || " "; 116 if s.code(1,i) = 0 then do; /* Do same for counts in other queues. */ 117 pic = s.q(1,i); 118 ret = ret || ltrim(pic); 119 end; 120 else ret = ret || "*"; 121 end; 122 123 return; 124 125 wnoa: call active_fnc_err_ (error_table_$wrong_no_of_args, "total_output_requests", 126 "^/Usage:^-[tor {request_type} ]"); 127 return; 128 129 af_undefined_request_type: 130 call active_fnc_err_ (code, "total_output_requests", " 131 Request type ^a undefined.", arg); 132 return; 133 134 af_bad_default_request_type: 135 call active_fnc_err_ (code, "total_output_requests", " 136 Unable to get default printer request type."); 137 return; 138 end; 139 140 else do; /* Invoked as a command. */ 141 Sall = FALSE; /* Prepare to parse arguments. */ 142 Sbrief = FALSE; 143 Sinhibit_error = FALSE; 144 s.Nrqt = 0; 145 do i = 1 to Nargs; 146 call cu_$arg_ptr (i, Parg, Larg, code); 147 if index(arg, "-") = 1 then do; 148 if arg = "-brief" | arg = "-bf" 149 then Sbrief = TRUE; 150 else if arg = "-long" | arg = "-lg" 151 then Sbrief = FALSE; 152 else if arg = "-all" | arg = "-a" 153 then Sall = TRUE; 154 else if arg = "-inhibit_error" | arg = "-ihe" 155 then Sinhibit_error = TRUE; 156 else go to badopt; 157 end; 158 else do; /* Arg is a request type name. Save it in array. */ 159 if Larg > length(s.rqt(1)) then go to longarg; 160 if s.Nrqt = dim(s.rqt,1) then go to manyarg; 161 j, s.Nrqt = s.Nrqt + 1; 162 call enter_output_request$request_type (arg, "", s.rqt(j), dft_q, s.max_q(j), code); 163 if code ^= 0 then do; 164 s.max_q(j) = 1; 165 s.code(j,1) = code; 166 s.q(j,1) = 0; 167 end; 168 else do; 169 s.q(j,*) = 0; 170 s.code(j,*) = 0; 171 end; 172 end; 173 end; 174 175 if s.Nrqt = 0 then /* No request type names were given? */ 176 if Sall then do; /* -all means all known types. Get the list. */ 177 Sno_rqt = FALSE; 178 call iod_info_$rqt_list ("", s.rqt, s.Nrqt, code); 179 if code ^= 0 then do; 180 call com_err_ (code, "total_output_requests", " 181 ^d request types exist. Only the first ^d will be printed.", s.Nrqt, dim(s.rqt,1)); 182 s.Nrqt = dim(s.rqt,1); 183 end; 184 s.q(*,*) = 0; 185 s.code(*,*) = 0; 186 do i = 1 to s.Nrqt; 187 call iod_info_$queue_data (s.rqt(i), dft_q, s.max_q(i), code); 188 if code ^= 0 then do; /* No data for entire request_type? */ 189 s.max_q(i) = 1; 190 s.code(i,1) = code; 191 end; 192 end; 193 end; 194 else do; /* Default is to list printer request_type only.*/ 195 Sno_rqt = TRUE; 196 s.Nrqt = 1; 197 s.q(1,*) = 0; 198 call enter_output_request$default_request_type ("printer", s.rqt(1), dft_q, s.max_q(1), code); 199 if code ^= 0 then do; 200 s.max_q(1) = 1; 201 s.code(1,1) = code; 202 end; 203 else s.code(1,*) = 0; 204 end; 205 else Sno_rqt = FALSE; /* request_type args were given. */ 206 207 longest_q_name = 0; /* Compute length of longest request_type name. */ 208 do i = 1 to s.Nrqt; 209 longest_q_name = max (longest_q_name, length (rtrim (s.rqt(i)))); 210 end; 211 longest_q_name = longest_q_name + length(" "); 212 213 do i = 1 to s.Nrqt; /* Get/print data for each request type. */ 214 if s.code(i,1) = 0 then 215 do j = 1 to s.max_q(i); /* Get data which is accessible. */ 216 call dprint_$queue_contents (s.rqt(i), j, s.q(i,j), s.code(i,j)); 217 end; 218 219 if Sno_rqt then do; /* Neither -all nor request_type names given? */ 220 if sum(s.code(1,*)) > 0 then /* Then suppress request type name unless */ 221 delim = ":"; /* an error was encountered while listing queues*/ 222 else do; 223 s.rqt(1) = ""; 224 delim = ""; 225 longest_q_name = 1; 226 end; 227 end; 228 else delim = ":"; 229 230 if Sbrief then /* Skip request type if no data to print & -bf */ 231 if sum(s.code(i,*)) + sum(s.q(i,*)) = 0 then 232 go to SKIP_DVC; 233 if sum(s.code(i,*)) = 0 then /* Simple case: no errors while getting totals.*/ 234 call ioa_ ("^a^a^vt^v(^5d ^)^5d", 235 s.rqt(i), delim, longest_q_name, s.max_q(i)-1, 236 s.q(i,1), s.q(i,2), s.q(i,3), s.q(i,4)); 237 else do; /* Complex case: errors occurs for some queue. */ 238 do j = 1 to s.max_q(i); 239 call convert_status_code_ (s.code(i,j), "", long(j)); 240 end; 241 call ioa_ ("^a^a^vt^v(^[^5d^;^s*****^] ^)^[^5d^;^s*****^] ", 242 s.rqt(i), delim, longest_q_name, s.max_q(i)-1, 243 (s.code(i,1) = 0), s.q(i,1), 244 (s.code(i,2) = 0), s.q(i,2), 245 (s.code(i,3) = 0), s.q(i,3), 246 (s.code(i,4) = 0), s.q(i,4)); 247 if ^Sinhibit_error then do; 248 if s.max_q(i) = 1 & s.code(i,1) = error_table_$id_not_found then 249 call ioa_ ("^-^a Request type undefined.", long(1)); 250 else call ioa_$nnl ("^v(^[^-^a ^a queue ^d.^/^;^3s^]^)", 251 s.max_q(i), 252 (s.code(i,1) ^= 0), long(1), s.rqt(i), 1, 253 (s.code(i,2) ^= 0), long(2), s.rqt(i), 2, 254 (s.code(i,3) ^= 0), long(3), s.rqt(i), 3, 255 (s.code(i,4) ^= 0), long(4), s.rqt(i), 4); 256 end; 257 end; 258 SKIP_DVC: end; 259 call ioa_ (""); 260 return; 261 262 badopt: call com_err_ (error_table_$badopt, "total_output_requests", "^a 263 Usage: total_output_requests {request_types} {-ctl_args} 264 ctl_args: -brief, -bf 265 -long, -lg 266 -all, -a 267 -inhibit_error, -ihe", arg); 268 return; 269 270 longarg: call com_err_ (error_table_$bigarg, "total_output_requests", "^a 271 A request type must be ^d characters or less in length.", 272 arg, length(s.rqt(1))); 273 return; 274 275 manyarg: call com_err_ (error_table_$too_many_names, "total_output_requests", " 276 A maximum of ^d request types may be given.", dim(s.rqt,1)); 277 return; 278 end; 279 280 end total_output_requests; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1610.8 total_output_requests.pl1 >dumps>old>recomp>total_output_requests.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. FALSE constant bit(1) initial unaligned dcl 79 ref 141 142 143 150 177 205 Larg 000100 automatic fixed bin(21,0) dcl 28 set ref 93* 94 94 129 129 146* 147 148 148 150 150 152 152 154 154 159 162 162 262 262 270 270 Lret 000101 automatic fixed bin(21,0) dcl 28 set ref 88* 90 110 112 115 118 120 Nargs 000102 automatic fixed bin(17,0) dcl 28 set ref 88* 91 92 145 Nrqt 000271 automatic fixed bin(17,0) level 2 dcl 28 set ref 144* 160 161 161* 175 178* 180* 182* 186 196* 208 213 Parg 000104 automatic pointer dcl 28 set ref 93* 94 129 146* 147 148 148 150 150 152 152 154 154 162 262 270 Pret 000106 automatic pointer dcl 28 set ref 88* 90 110 112 115 115 118 118 120 120 Sall 000110 automatic bit(1) unaligned dcl 28 set ref 141* 152* 175 Sbrief 000111 automatic bit(1) unaligned dcl 28 set ref 142* 148* 150* 230 Sinhibit_error 000112 automatic bit(1) unaligned dcl 28 set ref 143* 154* 247 Sno_rqt 000113 automatic bit(1) unaligned dcl 28 set ref 177* 195* 205* 219 TRUE constant bit(1) initial unaligned dcl 79 ref 148 152 154 195 active_fnc_err_ 000010 constant entry external dcl 63 ref 125 129 134 arg based char unaligned dcl 53 set ref 94* 129* 147 148 148 150 150 152 152 154 154 162* 262* 270* code 000114 automatic fixed bin(35,0) dcl 28 in procedure "tor" set ref 88* 89 93* 94* 95 98* 99 129* 134* 146* 162* 163 165 178* 179 180* 187* 188 190 198* 199 201 code 1605 000271 automatic fixed bin(35,0) array level 3 in structure "s" dcl 28 in procedure "tor" set ref 105* 108 116 165* 170* 185* 190* 201* 203* 214 216* 220 230 233 239* 241 241 241 241 248 250 250 250 250 com_err_ 000012 constant entry external dcl 63 ref 180 262 270 275 convert_status_code_ 000014 constant entry external dcl 63 ref 239 cu_$af_arg_ptr 000016 constant entry external dcl 63 ref 93 cu_$af_return_arg 000020 constant entry external dcl 63 ref 88 cu_$arg_ptr 000022 constant entry external dcl 63 ref 146 delim 000115 automatic char(1) unaligned dcl 28 set ref 220* 224* 228* 233* 241* dft_q 000116 automatic fixed bin(17,0) dcl 28 set ref 94* 98* 162* 187* 198* dim builtin function dcl 59 ref 160 180 180 182 275 275 dprint_$queue_contents 000024 constant entry external dcl 63 ref 105 216 enter_output_request$default_request_type 000026 constant entry external dcl 63 ref 98 198 enter_output_request$request_type 000030 constant entry external dcl 63 ref 94 162 error_table_$badopt 000042 external static fixed bin(35,0) dcl 79 set ref 262* error_table_$bigarg 000044 external static fixed bin(35,0) dcl 79 set ref 270* error_table_$id_not_found 000046 external static fixed bin(35,0) dcl 79 ref 248 error_table_$too_many_names 000050 external static fixed bin(35,0) dcl 79 set ref 275* error_table_$wrong_no_of_args 000052 external static fixed bin(35,0) dcl 79 set ref 125* i 000117 automatic fixed bin(17,0) dcl 28 set ref 104* 105* 105 105* 114* 116 117* 145* 146* 186* 187 187 189 190* 208* 209* 213* 214 214 216 216 216 230 230 233 233 233 233 233 233 233 238 239 241 241 241 241 241 241 241 241 241 241 248 248 250 250 250 250 250 250 250 250 250* index builtin function dcl 59 ref 147 ioa_ 000036 constant entry external dcl 63 ref 233 241 248 259 ioa_$nnl 000040 constant entry external dcl 63 ref 250 iod_info_$queue_data 000032 constant entry external dcl 63 ref 187 iod_info_$rqt_list 000034 constant entry external dcl 63 ref 178 j 000120 automatic fixed bin(17,0) dcl 28 set ref 161* 162 162 164 165 166 169 170 214* 216* 216 216* 238* 239 239* length builtin function dcl 59 ref 159 209 211 270 270 long 000121 automatic char(100) array unaligned dcl 28 set ref 239* 248* 250* 250* 250* 250* longest_q_name 000270 automatic fixed bin(17,0) dcl 28 set ref 207* 209* 209 211* 211 225* 233* 241* ltrim builtin function dcl 59 ref 110 118 max builtin function dcl 59 ref 209 max_q 1441 000271 automatic fixed bin(17,0) array level 2 dcl 28 set ref 94* 98* 102* 102 104 114 162* 164* 187* 189* 198* 200* 214 233 238 241 248 250* min builtin function dcl 59 ref 102 pic 000266 automatic picture(6) unaligned dcl 28 set ref 109* 110 117* 118 q 1606 000271 automatic fixed bin(17,0) array level 3 dcl 28 set ref 105* 109 117 166* 169* 184* 197* 216* 230 233* 233* 233* 233* 241* 241* 241* 241* queues 1605 000271 automatic structure array level 2 dcl 28 ret based varying char dcl 53 set ref 90* 110* 112* 115* 115 118* 118 120* 120 rqt 1 000271 automatic char(32) array level 2 packed unaligned dcl 28 set ref 94* 98* 105* 159 160 162* 178* 180 180 182 187* 198* 209 216* 223* 233* 241* 250* 250* 250* 250* 270 270 275 275 rtrim builtin function dcl 59 ref 209 s 000271 automatic structure level 1 dcl 28 sum builtin function dcl 59 ref 220 230 230 233 NAMES DECLARED BY EXPLICIT CONTEXT. SKIP_DVC 002446 constant label dcl 258 ref 230 af_bad_default_request_type 000746 constant label dcl 134 ref 99 af_undefined_request_type 000707 constant label dcl 129 ref 95 badopt 002462 constant label dcl 262 set ref 154 longarg 002521 constant label dcl 270 ref 159 manyarg 002565 constant label dcl 275 ref 160 tor 000272 constant entry external dcl 25 total_output_requests 000301 constant entry external dcl 25 wnoa 000657 constant label dcl 125 ref 91 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3066 3142 2627 3076 Length 3352 2627 54 174 237 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tor 2156 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tor 000100 Larg tor 000101 Lret tor 000102 Nargs tor 000104 Parg tor 000106 Pret tor 000110 Sall tor 000111 Sbrief tor 000112 Sinhibit_error tor 000113 Sno_rqt tor 000114 code tor 000115 delim tor 000116 dft_q tor 000117 i tor 000120 j tor 000121 long tor 000266 pic tor 000270 longest_q_name tor 000271 s tor THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ convert_status_code_ cu_$af_arg_ptr cu_$af_return_arg cu_$arg_ptr dprint_$queue_contents enter_output_request$default_request_type enter_output_request$request_type ioa_ ioa_$nnl iod_info_$queue_data iod_info_$rqt_list THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$bigarg error_table_$id_not_found error_table_$too_many_names error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000271 88 000306 89 000322 90 000324 91 000325 92 000330 93 000331 94 000350 95 000407 96 000411 98 000412 99 000445 102 000447 104 000454 105 000462 106 000507 108 000511 109 000513 110 000523 111 000545 112 000546 114 000557 115 000566 116 000576 117 000603 118 000615 119 000644 120 000645 121 000654 123 000656 125 000657 127 000706 129 000707 132 000745 134 000746 137 000775 141 000776 142 000777 143 001000 144 001001 145 001002 146 001011 147 001026 148 001042 150 001055 152 001067 154 001102 157 001114 159 001115 160 001120 161 001123 162 001126 163 001172 164 001174 165 001177 166 001202 167 001203 169 001204 170 001221 173 001236 175 001240 177 001244 178 001245 179 001275 180 001277 182 001340 184 001342 185 001365 186 001410 187 001417 188 001447 189 001451 190 001454 192 001457 193 001461 195 001462 196 001464 197 001466 198 001477 199 001532 200 001534 201 001536 202 001540 203 001541 204 001552 205 001553 207 001554 208 001555 209 001564 210 001604 211 001606 213 001610 214 001617 216 001632 217 001666 219 001670 220 001672 223 001715 224 001720 225 001722 227 001724 228 001725 230 001727 233 002000 238 002110 239 002120 240 002146 241 002150 247 002262 248 002264 250 002315 258 002446 259 002450 260 002461 262 002462 268 002520 270 002521 273 002564 275 002565 277 002622 ----------------------------------------------------------- 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