COMPILATION LISTING OF SEGMENT iodd_misc_cmds Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1702.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 iodd_misc_cmds: proc; 12 13 return; /* illegal entry point */ 14 15 /* This is a procedure to collect several external commands for the driver's use */ 16 17 /* written by J. C. Whitmore 9/78 */ 18 19 20 dcl normal fixed bin int static options (constant) init (1); 21 dcl slave fixed bin int static options (constant) init (2); 22 23 dcl iod_val_segp ptr int static init (null); 24 dcl last_sender char (64) int static init (""); 25 26 dcl ap ptr; 27 dcl al fixed bin; 28 dcl bchr char (al) unal based (ap); 29 30 dcl answer char (168) varying; 31 dcl bvcs char (al) varying based (ap); 32 dcl count fixed bin; 33 dcl ec fixed bin (35); 34 dcl idx fixed bin; 35 dcl not_af bit (1) init ("1"b); /* default assumption is not an active function */ 36 dcl string char (168) aligned; 37 dcl msg_pfx char (80); 38 dcl (first, last) fixed bin; 39 40 dcl (null, substr, length, rtrim) builtin; 41 42 dcl active_fnc_err_ entry options (variable); 43 dcl com_err_ entry options (variable); 44 dcl cu_$arg_count entry (fixed bin); 45 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 46 dcl cu_$af_arg_count entry (fixed bin, fixed bin (35)); 47 dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 48 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)); 49 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); 50 dcl ioa_ entry options (variable); 51 dcl iodd_msg_ entry options (variable); 52 53 dcl error_table_$wrong_no_of_args fixed bin (35) ext; 54 dcl error_table_$not_act_fnc fixed bin (35) ext; 55 56 dcl 1 valueseg based (iod_val_segp) aligned, 57 2 laste fixed bin, 58 2 freep fixed bin, 59 2 pad (6) fixed bin, 60 2 arry (1000), 61 3 name char (32), 62 3 valu char (168), 63 3 lth fixed bin, 64 3 chain fixed bin; 65 66 67 /* === Entry for drivers to get messages via send_message === */ 68 69 /* Usage: accept_messages -pn -bf -call iod_driver_message */ 70 71 iod_driver_message: entry (a_number, a_sender, a_time, a_message, a_mbx_seg); 72 73 dcl (a_number, a_sender, a_time, a_message, a_mbx_seg) char (*); 74 75 76 if a_sender = last_sender then msg_pfx = "="; /* same as last sender, be brief */ 77 else do; 78 79 /* the sender is formatted like this: Person.Project (sent from) at */ 80 /* we are most concerned with "sent from" since Person and Project of all drivers is usually equal. */ 81 82 first = index (a_sender, "("); /* look for start of "(sent from)" field */ 83 if first = 0 then do; /* not there, use the whole thing */ 84 first = 1; 85 last = length (rtrim (a_sender)); 86 end; 87 else do; /* sent from is defined */ 88 first = first + 1; /* want the char after the "(" */ 89 last = index (a_sender, ")"); /* look for the close */ 90 if last = 0 then last = length (rtrim (a_sender)); /* missing, take all */ 91 else last = last - 1; 92 end; 93 94 msg_pfx = "From " || substr (a_sender, first, last - first + 1); /* this is the first part */ 95 end; 96 97 idx = length (rtrim (msg_pfx)); /* how much was defined */ 98 99 msg_pfx = substr (msg_pfx, 1, idx) || " (" || substr (a_time, 11, 6) || ")"; /* the last part */ 100 101 call iodd_msg_ (normal, slave, 0, msg_pfx, a_message); 102 103 last_sender = a_sender; /* save last sender's identity */ 104 105 return; 106 107 /* === Entry to return per process values from an active function == */ 108 109 /* Usage: [iod_val keyword] */ 110 /* returns the value associated with the keyword which was last set by the set_iod_val entry. */ 111 /* If no value has been set, the string "undefined!" is returned. */ 112 113 iod_val: entry; 114 115 not_af = "0"b; /* assume we were called as an active function */ 116 117 call cu_$af_arg_count (count, ec); 118 if ec ^= 0 then 119 if ec = error_table_$not_act_fnc then do; 120 not_af = "1"b; /* not an active function */ 121 call cu_$arg_count (count); 122 end; 123 else go to error; 124 125 if count ^= 1 then do; 126 ec = error_table_$wrong_no_of_args; 127 go to error; 128 end; 129 130 if iod_val_segp = null then do; 131 call get_temp_segment_ ("iod_val", iod_val_segp, ec); 132 if ec ^= 0 | iod_val_segp = null then do; 133 error: if not_af then call com_err_ (ec, "iod_val"); 134 else call active_fnc_err_ (ec, "iod_val"); 135 return; 136 end; 137 end; 138 139 if not_af then call cu_$arg_ptr (1, ap, al, ec); 140 else call cu_$af_arg_ptr (1, ap, al, ec); 141 if ec ^= 0 then go to error; 142 143 do idx = 1 to laste; 144 if chain (idx) = 0 then if name (idx) ^= "" then 145 if bchr = name (idx) then do; 146 answer = substr (valu (idx), 1, lth (idx)); 147 go to give; 148 end; 149 end; 150 answer = "undefined!"; 151 give: if not_af then call ioa_ (answer); 152 else do; 153 call cu_$af_return_arg (1, ap, al, ec); 154 if ec ^= 0 then go to error; 155 bvcs = answer; 156 end; 157 return; 158 159 160 /* === Entry to define keywords and set values for them (returned by iod_val entry) === */ 161 162 /* Usage: set_iod_val keyword {new_value} */ 163 /* if new value is missing, keyword is "undefined!" */ 164 165 set_iod_val: entry; 166 167 if iod_val_segp = null then do; 168 call get_temp_segment_ ("iod_val", iod_val_segp, ec); 169 if ec ^= 0 | iod_val_segp = null then go to error; 170 end; 171 172 call cu_$arg_ptr (1, ap, al, ec); 173 if ec ^= 0 then go to error; 174 string = bchr; 175 176 call cu_$arg_ptr (2, ap, al, ec); 177 if ec ^= 0 then do; 178 do idx = 1 to laste; 179 if string = name (idx) then do; 180 chain (idx) = freep; 181 freep = idx; 182 name (idx) = ""; 183 end; 184 end; 185 return; 186 end; 187 188 do idx = 1 to laste; 189 if chain (idx) = 0 then if name (idx) ^= "" then 190 if name (idx) = string then do; 191 go to f1; 192 end; 193 end; 194 if freep = 0 then idx, laste = laste + 1; 195 else do; 196 idx = freep; 197 freep = chain (idx); 198 end; 199 name (idx) = string; 200 f1: valu (idx) = bchr; 201 chain (idx) = 0; 202 lth (idx) = al; 203 204 return; 205 206 end iodd_misc_cmds; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1508.3 iodd_misc_cmds.pl1 >dumps>old>recomp>iodd_misc_cmds.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. a_mbx_seg parameter char unaligned dcl 73 ref 71 a_message parameter char unaligned dcl 73 set ref 71 101* a_number parameter char unaligned dcl 73 ref 71 a_sender parameter char unaligned dcl 73 ref 71 76 82 85 89 90 94 103 a_time parameter char unaligned dcl 73 ref 71 99 active_fnc_err_ 000032 constant entry external dcl 42 ref 134 al 000102 automatic fixed bin(17,0) dcl 27 set ref 139* 140* 144 153* 155 172* 174 176* 200 202 answer 000103 automatic varying char(168) dcl 30 set ref 146* 150* 151* 155 ap 000100 automatic pointer dcl 26 set ref 139* 140* 144 153* 155 172* 174 176* 200 arry 10 based structure array level 2 dcl 56 bchr based char unaligned dcl 28 ref 144 174 200 bvcs based varying char dcl 31 set ref 155* chain 73 based fixed bin(17,0) array level 3 dcl 56 set ref 144 180* 189 197 201* com_err_ 000034 constant entry external dcl 43 ref 133 count 000156 automatic fixed bin(17,0) dcl 32 set ref 117* 121* 125 cu_$af_arg_count 000042 constant entry external dcl 46 ref 117 cu_$af_arg_ptr 000044 constant entry external dcl 47 ref 140 cu_$af_return_arg 000046 constant entry external dcl 48 ref 153 cu_$arg_count 000036 constant entry external dcl 44 ref 121 cu_$arg_ptr 000040 constant entry external dcl 45 ref 139 172 176 ec 000157 automatic fixed bin(35,0) dcl 33 set ref 117* 118 118 126* 131* 132 133* 134* 139* 140* 141 153* 154 168* 169 172* 173 176* 177 error_table_$not_act_fnc 000060 external static fixed bin(35,0) dcl 54 ref 118 error_table_$wrong_no_of_args 000056 external static fixed bin(35,0) dcl 53 ref 126 first 000260 automatic fixed bin(17,0) dcl 38 set ref 82* 83 84* 88* 88 94 94 freep 1 based fixed bin(17,0) level 2 dcl 56 set ref 180 181* 194 196 197* get_temp_segment_ 000050 constant entry external dcl 49 ref 131 168 idx 000160 automatic fixed bin(17,0) dcl 34 set ref 97* 99 143* 144 144 144 146 146* 178* 179 180 181 182* 188* 189 189 189* 194* 196* 197 199 200 201 202 ioa_ 000052 constant entry external dcl 50 ref 151 iod_val_segp 000010 internal static pointer initial dcl 23 set ref 130 131* 132 143 144 144 144 146 146 167 168* 169 178 179 180 180 181 182 188 189 189 189 194 194 194 196 197 197 199 200 201 202 iodd_msg_ 000054 constant entry external dcl 51 ref 101 last 000261 automatic fixed bin(17,0) dcl 38 set ref 85* 89* 90 90* 91* 91 94 last_sender 000012 internal static char(64) initial unaligned dcl 24 set ref 76 103* laste based fixed bin(17,0) level 2 dcl 56 set ref 143 178 188 194 194* length builtin function dcl 40 ref 85 90 97 lth 72 based fixed bin(17,0) array level 3 dcl 56 set ref 146 202* msg_pfx 000234 automatic char(80) unaligned dcl 37 set ref 76* 94* 97 99* 99 101* name 10 based char(32) array level 3 dcl 56 set ref 144 144 179 182* 189 189 199* normal 000011 constant fixed bin(17,0) initial dcl 20 set ref 101* not_af 000161 automatic bit(1) initial unaligned dcl 35 set ref 35* 115* 120* 133 139 151 null builtin function dcl 40 ref 130 132 167 169 rtrim builtin function dcl 40 ref 85 90 97 slave 000007 constant fixed bin(17,0) initial dcl 21 set ref 101* string 000162 automatic char(168) dcl 36 set ref 174* 179 189 199 substr builtin function dcl 40 ref 94 99 99 146 valu 20 based char(168) array level 3 dcl 56 set ref 146 200* valueseg based structure level 1 dcl 56 NAMES DECLARED BY EXPLICIT CONTEXT. error 000437 constant label dcl 133 ref 118 127 141 154 169 173 f1 001115 constant label dcl 200 ref 191 give 000617 constant label dcl 151 ref 147 iod_driver_message 000045 constant entry external dcl 71 iod_val 000335 constant entry external dcl 113 iodd_misc_cmds 000031 constant entry external dcl 11 set_iod_val 000667 constant entry external dcl 165 NAME DECLARED BY CONTEXT OR IMPLICATION. index builtin function ref 82 89 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1330 1412 1135 1340 Length 1614 1135 62 166 172 22 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME iodd_misc_cmds 214 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 iod_val_segp iodd_misc_cmds 000012 last_sender iodd_misc_cmds STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME iodd_misc_cmds 000100 ap iodd_misc_cmds 000102 al iodd_misc_cmds 000103 answer iodd_misc_cmds 000156 count iodd_misc_cmds 000157 ec iodd_misc_cmds 000160 idx iodd_misc_cmds 000161 not_af iodd_misc_cmds 000162 string iodd_misc_cmds 000234 msg_pfx iodd_misc_cmds 000260 first iodd_misc_cmds 000261 last iodd_misc_cmds THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_count cu_$af_arg_ptr cu_$af_return_arg cu_$arg_count cu_$arg_ptr get_temp_segment_ ioa_ iodd_msg_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_act_fnc error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 35 000024 11 000030 13 000037 71 000040 76 000105 82 000121 83 000132 84 000133 85 000135 86 000147 88 000150 89 000151 90 000162 91 000176 94 000200 95 000221 97 000222 99 000234 101 000272 103 000324 105 000333 113 000334 115 000343 117 000344 118 000355 120 000362 121 000364 125 000372 126 000375 127 000400 130 000401 131 000406 132 000430 133 000437 134 000461 135 000500 139 000501 140 000522 141 000540 143 000542 144 000552 146 000574 147 000607 149 000610 150 000612 151 000617 153 000633 154 000652 155 000654 157 000665 165 000666 167 000675 168 000702 169 000724 172 000733 173 000751 174 000753 176 000760 177 000777 178 001001 179 001011 180 001022 181 001026 182 001030 184 001034 185 001036 188 001037 189 001047 191 001067 193 001070 194 001072 196 001103 197 001104 199 001107 200 001115 201 001125 202 001126 204 001131 ----------------------------------------------------------- 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