COMPILATION LISTING OF SEGMENT carry_total Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1602.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 carry_total: ct: proc; 12 13 /* This active function returns the number of carry requests in a given queue. 14* 15* Usage: 16* [carry_total {-control_args}] 17* 18* where control args can be: 19* 20* -admin 21* to include all requests. By default, only the user's own requests 22* are included. 23* -destination XXXX, -ds XXXX 24* to specify a destination and thereby the queue XXXX.carry.ms. 25* -queue_dir path, -qd path 26* to specify the pathname of a carry queue. 27* 28* Steve Herbst 9/21/76 */ 29 30 31 dcl mseg_dir char(168) init(">daemon_dir_dir>carry_dir"); 32 dcl mseg_name char(32) init("carry.ms"); 33 34 dcl arg char(arg_len) based(arg_ptr); 35 dcl return_arg char(return_len) varying based(return_ptr); 36 dcl message char(mseg_args.ms_len) based(mseg_args.ms_ptr); 37 dcl buffer char(8) aligned; 38 39 dcl (active_function, admin_mode) bit(1) aligned; 40 41 dcl area area based(area_ptr); 42 43 dcl (area_ptr, arg_ptr, return_ptr) ptr; 44 45 dcl (arg_count, arg_len, i, j, message_count, mseg_index, return_len) fixed bin; 46 dcl code fixed bin(35); 47 48 dcl error_table_$badopt fixed bin(35) ext; 49 dcl error_table_$entlong fixed bin(35) ext; 50 dcl error_table_$no_message fixed bin(35) ext; 51 dcl error_table_$no_s_permission fixed bin(35) ext; 52 dcl error_table_$not_act_fnc fixed bin(35) ext; 53 1 1 /* BEGIN INCLUDE FILE . . . mseg_return_args.incl.pl1 */ 1 2 1 3 1 4 /* structure returned when message is read from a message segment */ 1 5 1 6 1 7 dcl ms_arg_ptr ptr; 1 8 1 9 dcl 1 mseg_return_args based (ms_arg_ptr) aligned, 1 10 2 ms_ptr ptr, /* pointer to message */ 1 11 2 ms_len fixed bin (24), /* length of message in bits */ 1 12 2 sender_id char (32) unaligned, /* process-group ID of sender */ 1 13 2 level fixed bin, /* validation level of sender */ 1 14 2 ms_id bit (72), /* unique ID of message */ 1 15 2 sender_authorization bit (72), /* access authorization of message sender */ 1 16 2 access_class bit (72); /* message access class */ 1 17 1 18 1 19 /* END INCLUDE FILE . . . mseg_return_args.incl.pl1 */ 54 55 dcl 1 mseg_args like mseg_return_args; 56 57 dcl complain entry variable options(variable); 58 59 dcl active_fnc_err_ entry options(variable); 60 dcl com_err_ entry options(variable); 61 dcl cu_$af_return_arg entry(fixed bin,ptr,fixed bin,fixed bin(35)); 62 dcl cu_$arg_ptr entry(fixed bin,ptr,fixed bin,fixed bin(35)); 63 dcl expand_path_ entry(ptr,fixed bin,ptr,ptr,fixed bin(35)); 64 dcl get_system_free_area_ entry returns(ptr); 65 dcl hcs_$status_minf entry(char(*),char(*),fixed bin(1),fixed bin(2),fixed bin(24),fixed bin(35)); 66 dcl ioa_ entry options(variable); 67 dcl ioa_$rsnnl entry options(variable); 68 dcl message_segment_$close entry(fixed bin,fixed bin(35)); 69 dcl message_segment_$get_message_count_index entry(fixed bin,fixed bin,fixed bin(35)); 70 dcl message_segment_$open entry(char(*),char(*),fixed bin,fixed bin(35)); 71 dcl message_segment_$own_incremental_read_index entry(fixed bin,ptr,bit(2),bit(72),ptr,fixed bin(35)); 72 dcl message_segment_$own_read_index entry(fixed bin,ptr,bit(1),ptr,fixed bin(35)); 73 74 dcl (addr, length, null, reverse, substr, verify) builtin; 75 /* */ 76 call cu_$af_return_arg(arg_count,return_ptr,return_len,code); 77 if code=error_table_$not_act_fnc then do; 78 active_function = "0"b; 79 complain = com_err_; 80 end; 81 else do; 82 active_function = "1"b; 83 complain = active_fnc_err_; 84 end; 85 admin_mode = "0"b; 86 87 do i = 1 to arg_count; 88 89 call cu_$arg_ptr(i,arg_ptr,arg_len,code); 90 91 if substr(arg,1,1)^="-" then do; 92 USAGE: if active_function then call active_fnc_err_(0,"", 93 "Usage: [carry_total {-control_args}]"); 94 else call com_err_(0,"","Usage: carry_total -control_args-"); 95 return; 96 end; 97 else if arg="-admin" then admin_mode = "1"b; 98 else if arg="-destination" | arg="-ds" then do; 99 i = i+1; 100 call cu_$arg_ptr(i,arg_ptr,arg_len,code); 101 if code^=0 then do; 102 call complain(0,"carry_total","Destination missing."); 103 return; 104 end; 105 mseg_name = arg || ".carry.ms"; 106 call hcs_$status_minf(mseg_dir,mseg_name,1,(0),(0),code); 107 if code^=0 & code^=error_table_$no_s_permission then do; 108 call complain(0,"carry_total","Invalid destination ^a",arg); 109 return; 110 end; 111 end; 112 else if arg="-queue_dir" | arg="-qd" then do; 113 i = i+1; 114 call cu_$arg_ptr(i,arg_ptr,arg_len,code); 115 if code^=0 then do; 116 call complain(0,"carry_total","Queue directory pathname missing."); 117 return; 118 end; 119 call expand_path_(arg_ptr,arg_len,addr(mseg_dir),null,code); 120 if code^=0 then do; 121 call complain(code,"carry_total","^a",arg); 122 return; 123 end; 124 end; 125 else do; 126 call complain(error_table_$badopt,"carry_total","^a",arg); 127 return; 128 end; 129 end; 130 /* */ 131 call message_segment_$open(mseg_dir,mseg_name,mseg_index,code); 132 if mseg_index=0 then do; 133 call complain(code,"carry_total","^a>^a",mseg_dir,mseg_name); 134 return; 135 end; 136 137 if admin_mode then do; 138 call message_segment_$get_message_count_index(mseg_index,message_count,code); 139 if code^=0 then do; 140 MSEG_ERROR: call complain(code,"carry_total","^a>^a",mseg_dir,mseg_name); 141 go to CLOSE; 142 end; 143 end; 144 145 else do; 146 area_ptr = get_system_free_area_(); 147 message_count = 0; 148 call message_segment_$own_read_index(mseg_index,area_ptr,"0"b,addr(mseg_args),code); 149 150 do while(code=0); 151 message_count = message_count+1; 152 free mseg_args.ms_ptr->message in(area); 153 call message_segment_$own_incremental_read_index 154 (mseg_index,area_ptr,"01"b,mseg_args.ms_id,addr(mseg_args),code); 155 end; 156 157 if code^=error_table_$no_message then go to MSEG_ERROR; 158 end; 159 160 if active_function then do; 161 call ioa_$rsnnl("^d",buffer,j,message_count); 162 return_arg = substr(buffer,1,j); 163 end; 164 else if admin_mode then call ioa_("There are ^d carry requests in ^a>^a", 165 message_count,mseg_dir,mseg_name); 166 else call ioa_("You have ^d carry requests in ^a>^a",message_count,mseg_dir,mseg_name); 167 168 CLOSE: call message_segment_$close(mseg_index,code); 169 170 end carry_total; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1459.2 carry_total.pl1 >dumps>old>recomp>carry_total.pl1 54 1 05/17/82 1411.5 mseg_return_args.incl.pl1 >ldd>include>mseg_return_args.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. active_fnc_err_ 000020 constant entry external dcl 59 ref 83 92 active_function 000164 automatic bit(1) dcl 39 set ref 78* 82* 92 160 addr builtin function dcl 74 ref 119 119 148 148 153 153 admin_mode 000165 automatic bit(1) dcl 39 set ref 85* 97* 137 164 area based area(1024) dcl 41 ref 152 area_ptr 000166 automatic pointer dcl 43 set ref 146* 148* 152 153* arg based char unaligned dcl 34 set ref 91 97 98 98 105 108* 112 112 121* 126* arg_count 000174 automatic fixed bin(17,0) dcl 45 set ref 76* 87 arg_len 000175 automatic fixed bin(17,0) dcl 45 set ref 89* 91 97 98 98 100* 105 108 108 112 112 114* 119* 121 121 126 126 arg_ptr 000170 automatic pointer dcl 43 set ref 89* 91 97 98 98 100* 105 108 112 112 114* 119* 121 126 buffer 000162 automatic char(8) dcl 37 set ref 161* 162 code 000203 automatic fixed bin(35,0) dcl 46 set ref 76* 77 89* 100* 101 106* 107 107 114* 115 119* 120 121* 131* 133* 138* 139 140* 148* 150 153* 157 168* com_err_ 000022 constant entry external dcl 60 ref 79 94 complain 000226 automatic entry variable dcl 57 set ref 79* 83* 102 108 116 121 126 133 140 cu_$af_return_arg 000024 constant entry external dcl 61 ref 76 cu_$arg_ptr 000026 constant entry external dcl 62 ref 89 100 114 error_table_$badopt 000010 external static fixed bin(35,0) dcl 48 set ref 126* error_table_$no_message 000012 external static fixed bin(35,0) dcl 50 ref 157 error_table_$no_s_permission 000014 external static fixed bin(35,0) dcl 51 ref 107 error_table_$not_act_fnc 000016 external static fixed bin(35,0) dcl 52 ref 77 expand_path_ 000030 constant entry external dcl 63 ref 119 get_system_free_area_ 000032 constant entry external dcl 64 ref 146 hcs_$status_minf 000034 constant entry external dcl 65 ref 106 i 000176 automatic fixed bin(17,0) dcl 45 set ref 87* 89* 99* 99 100* 113* 113 114* ioa_ 000036 constant entry external dcl 66 ref 164 166 ioa_$rsnnl 000040 constant entry external dcl 67 ref 161 j 000177 automatic fixed bin(17,0) dcl 45 set ref 161* 162 message based char unaligned dcl 36 ref 152 message_count 000200 automatic fixed bin(17,0) dcl 45 set ref 138* 147* 151* 151 161* 164* 166* message_segment_$close 000042 constant entry external dcl 68 ref 168 message_segment_$get_message_count_index 000044 constant entry external dcl 69 ref 138 message_segment_$open 000046 constant entry external dcl 70 ref 131 message_segment_$own_incremental_read_index 000050 constant entry external dcl 71 ref 153 message_segment_$own_read_index 000052 constant entry external dcl 72 ref 148 ms_id 14 000204 automatic bit(72) level 2 packed unaligned dcl 55 set ref 153* ms_len 2 000204 automatic fixed bin(24,0) level 2 dcl 55 set ref 152 152 ms_ptr 000204 automatic pointer level 2 dcl 55 set ref 152 mseg_args 000204 automatic structure level 1 unaligned dcl 55 set ref 148 148 153 153 mseg_dir 000100 automatic char(168) initial unaligned dcl 31 set ref 31* 106* 119 119 131* 133* 140* 164* 166* mseg_index 000201 automatic fixed bin(17,0) dcl 45 set ref 131* 132 138* 148* 153* 168* mseg_name 000152 automatic char(32) initial unaligned dcl 32 set ref 32* 105* 106* 131* 133* 140* 164* 166* mseg_return_args based structure level 1 dcl 1-9 null builtin function dcl 74 ref 119 119 return_arg based varying char dcl 35 set ref 162* return_len 000202 automatic fixed bin(17,0) dcl 45 set ref 76* 162 return_ptr 000172 automatic pointer dcl 43 set ref 76* 162 substr builtin function dcl 74 ref 91 162 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. error_table_$entlong external static fixed bin(35,0) dcl 49 length builtin function dcl 74 ms_arg_ptr automatic pointer dcl 1-7 reverse builtin function dcl 74 verify builtin function dcl 74 NAMES DECLARED BY EXPLICIT CONTEXT. CLOSE 001367 constant label dcl 168 ref 141 MSEG_ERROR 001106 constant label dcl 140 set ref 157 USAGE 000273 constant label dcl 92 carry_total 000176 constant entry external dcl 11 ct 000166 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 1636 1712 1405 1646 Length 2130 1405 54 201 231 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ct 230 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ct 000100 mseg_dir ct 000152 mseg_name ct 000162 buffer ct 000164 active_function ct 000165 admin_mode ct 000166 area_ptr ct 000170 arg_ptr ct 000172 return_ptr ct 000174 arg_count ct 000175 arg_len ct 000176 i ct 000177 j ct 000200 message_count ct 000201 mseg_index ct 000202 return_len ct 000203 code ct 000204 mseg_args ct 000226 complain ct THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_var_desc call_ext_out_desc call_ext_out return shorten_stack ext_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_return_arg cu_$arg_ptr expand_path_ get_system_free_area_ hcs_$status_minf ioa_ ioa_$rsnnl message_segment_$close message_segment_$get_message_count_index message_segment_$open message_segment_$own_incremental_read_index message_segment_$own_read_index THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$no_message error_table_$no_s_permission error_table_$not_act_fnc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 31 000155 32 000160 11 000165 76 000204 77 000221 78 000225 79 000226 80 000232 82 000233 83 000235 85 000241 87 000242 89 000251 91 000266 92 000273 94 000323 95 000350 97 000351 98 000361 99 000371 100 000372 101 000407 102 000411 103 000444 105 000445 106 000463 107 000525 108 000532 109 000571 111 000572 112 000573 113 000603 114 000604 115 000621 116 000623 117 000653 119 000654 120 000677 121 000701 122 000736 124 000737 126 000740 127 000776 129 000777 131 001001 132 001026 133 001030 134 001066 137 001067 138 001071 139 001104 140 001106 141 001144 143 001145 146 001146 147 001155 148 001156 150 001201 151 001203 152 001204 153 001211 155 001236 157 001237 160 001242 161 001244 162 001272 163 001303 164 001304 166 001337 168 001367 170 001400 ----------------------------------------------------------- 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