COMPILATION LISTING OF SEGMENT exponent_control Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1818.9 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 /* exponent_control 13* 14* Command interface for fim exponent flags 15* 16**/ 17 18 exponent_control: 19 procedure options (variable); 20 21 /* Date Changed (and reason) */ 22 /* Coded February 28 1980 Benson I. Margulies */ 23 24 dcl hcs_$get_exponent_control entry (bit (1) aligned, bit (1) aligned, bit (72) aligned); 25 dcl hcs_$set_exponent_control entry (bit (1) aligned, bit (1) aligned, bit (72) aligned, fixed bin (35)); 26 27 dcl cu_$arg_count entry () returns (fixed bin); 28 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 29 dcl com_err_ entry options (variable); 30 dcl ioa_ entry options (variable); 31 32 dcl arg_ptr ptr; 33 dcl arg_len fixed bin (21); 34 dcl argument char (arg_len) based (arg_ptr); 35 36 dcl nargs fixed bin; 37 dcl current_argument fixed bin; 38 dcl code fixed bin (35); 39 dcl (looking_for, processing) fixed bin; 40 dcl print_sw bit (1) aligned; 41 dcl put_reqd bit (1) aligned; 42 dcl happy bit (1) aligned; /* no further arguments required */ 43 44 dcl (restart_underflow, restart_overflow) bit (1) aligned; 45 dcl overflow_value float bin (63); 46 47 dcl (error_table_$bad_conversion, 48 error_table_$bad_arg, 49 error_table_$inconsistent, 50 error_table_$noarg) static external fixed bin (35); 51 dcl conversion condition; 52 53 dcl ((Control_argument init (1), 54 Keyword init (2), 55 Control_argument_or_keyword init (3), 56 Value_or_control_argument init (4), 57 Restart init (5), 58 Fault init (6), 59 Value init (7)) fixed bin, /* not really used at the moment */ 60 Myname init ("exponent_control") character (16)) internal static options (constant); 61 1 1 1 2 /* BEGIN INCLUDE FILE ... exponent_control_info.incl.pl1 */ 1 3 1 4 /* Created by Benson I. Margulies 2-80 */ 1 5 1 6 declare Default_exponent_control_overflow_value float bin (63) aligned 1 7 internal static options (constant) init 1 8 (0.111111111111111111111111111111111111111111111111111111111111111e+127b); 1 9 1 10 /* END INCLUDE FILE ... exponent_control_info.incl.pl1 */ 1 11 62 63 64 dcl (convert, unspec) builtin; 65 66 /* */ 67 call GET_CURRENT_VALUES; /* almost always the command needs them */ 68 nargs = cu_$arg_count (); 69 if nargs = 0 then do; 70 call com_err_ (error_table_$noarg, Myname, 71 "^/Usage: exponent_control {-pr}|{-rt|-flt overflow|underflow} {-ovfv value}"); 72 return; 73 end; 74 happy = ""b; 75 put_reqd, print_sw = ""b; 76 looking_for = Control_argument; 77 do current_argument = 1 to nargs; 78 call get_argument; 79 if /* case */ looking_for = Control_argument_or_keyword then 80 if substr (argument, 1, 1) = "-" then goto CONTROL_ARG; 81 else goto KEYWORD; 82 83 else if looking_for = Value_or_control_argument then 84 if substr (argument, 1, 1) = "-" then goto CONTROL_ARG; 85 else goto VALUE; 86 87 else if looking_for = Control_argument then do; 88 if substr (argument, 1, 1) ^= "-" then do; 89 call com_err_ (error_table_$bad_arg, Myname, "Unknown or misplaced keyword ^a.", argument); 90 goto ERROR; 91 end; 92 CONTROL_ARG: if argument = "-restart" | argument = "-rt" then call process_restart; 93 else if argument = "-fault" | argument = "-flt" then call process_fault; 94 else if argument = "-overflow_value" | argument = "-ovfv" then call process_value; 95 else if argument = "-print" | argument = "-pr" then call process_print; 96 else do; 97 call com_err_ (error_table_$bad_arg, Myname, 98 "unrecognized control argument ^a.", argument); 99 goto ERROR; 100 end; 101 end; 102 else if looking_for = Keyword then do; 103 KEYWORD: looking_for = Control_argument_or_keyword; 104 happy = "1"b; /* having found a keyword nothing else required */ 105 if argument = "overflow" then 106 if processing = Restart then restart_overflow = "1"b; 107 else restart_overflow = "0"b; 108 else if argument = "underflow" then 109 if processing = Restart then restart_underflow = "1"b; 110 else restart_underflow = "0"b; 111 else do; 112 call com_err_ (error_table_$bad_arg, Myname, "Unrecognized keyword ^a.", argument); 113 goto ERROR; 114 end; 115 end; 116 else if looking_for = Value then do; 117 VALUE: looking_for = Control_argument; 118 happy = "1"b; 119 on conversion begin; 120 call com_err_ (error_table_$bad_conversion, 121 Myname, "Could not convert ^a to a floating point value.", argument); 122 goto ERROR; 123 end; 124 overflow_value = convert (overflow_value, argument); 125 end; 126 end; 127 if ^happy then do; 128 call com_err_ (error_table_$noarg, Myname, "The ^a control argument requires a value.", argument); 129 goto ERROR; 130 end; 131 132 if print_sw & put_reqd then do; /* can't do both */ 133 call com_err_ (error_table_$inconsistent, Myname, 134 "Can't print while setting any value."); 135 return; 136 end; 137 else if print_sw then 138 call ioa_ ("Underflows are ^[restart^;fault^]ed;^/Overflows are ^[restart^;fault^]ed;^/Overflow value is ^f.", 139 restart_underflow, restart_overflow, overflow_value); 140 else call PUT_CURRENT_VALUES; 141 return; 142 143 GET_CURRENT_VALUES: 144 procedure; 145 146 dcl overflow_bits bit (72) aligned; 147 148 call hcs_$get_exponent_control (restart_underflow, restart_overflow, overflow_bits); 149 unspec (overflow_value) = overflow_bits; 150 return; 151 152 PUT_CURRENT_VALUES: 153 entry; 154 155 overflow_bits = unspec (overflow_value); 156 call hcs_$set_exponent_control (restart_underflow, restart_overflow, overflow_bits, code); 157 if code ^= 0 then do; 158 call com_err_ (code, Myname, "When setting new values."); 159 goto ERROR; 160 end; 161 return; 162 end; 163 /* */ 164 process_restart: 165 procedure; 166 happy = ""b; 167 looking_for = Keyword; 168 processing = Restart; 169 put_reqd = "1"b; 170 return; 171 end; 172 173 process_fault: 174 procedure; 175 happy = ""b; 176 looking_for = Keyword; 177 processing = Fault; 178 put_reqd = "1"b; 179 return; 180 end; 181 182 process_value: 183 procedure; 184 happy = "1"b; /* we have a default */ 185 overflow_value = Default_exponent_control_overflow_value; 186 looking_for = Value_or_control_argument; 187 put_reqd = "1"b; 188 return; 189 end; 190 191 process_print: 192 procedure; 193 happy = "1"b; 194 looking_for = Control_argument; 195 print_sw = "1"b; 196 return; 197 end; 198 199 get_argument: 200 procedure; 201 if current_argument > nargs then do; 202 call com_err_ (error_table_$noarg, Myname, "following ^a.", argument); 203 goto ERROR; 204 end; 205 call cu_$arg_ptr (current_argument, arg_ptr, arg_len, code); 206 if code ^= 0 then do; 207 call com_err_ (code, Myname, "Error on argument # ^d.", current_argument); 208 goto ERROR; 209 end; 210 return; 211 end; 212 213 ERROR: return; /* regardless of where in the internal procs */ 214 215 end; 216 217 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1627.8 exponent_control.pl1 >dumps>old>recomp>exponent_control.pl1 62 1 06/30/80 1354.4 exponent_control_info.incl.pl1 >ldd>include>exponent_control_info.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. Control_argument constant fixed bin(17,0) initial dcl 53 ref 76 87 117 194 Control_argument_or_keyword constant fixed bin(17,0) initial dcl 53 ref 79 103 Default_exponent_control_overflow_value 000000 constant float bin(63) initial dcl 1-6 ref 185 Fault constant fixed bin(17,0) initial dcl 53 ref 177 Keyword constant fixed bin(17,0) initial dcl 53 ref 102 167 176 Myname 000002 constant char(16) initial unaligned dcl 53 set ref 70* 89* 97* 112* 120* 128* 133* 158* 202* 207* Restart constant fixed bin(17,0) initial dcl 53 ref 105 108 168 Value constant fixed bin(17,0) initial dcl 53 ref 116 Value_or_control_argument constant fixed bin(17,0) initial dcl 53 ref 83 186 arg_len 000102 automatic fixed bin(21,0) dcl 33 set ref 79 83 88 89 89 92 92 93 93 94 94 95 95 97 97 105 108 112 112 120 120 124 128 128 202 202 205* arg_ptr 000100 automatic pointer dcl 32 set ref 79 83 88 89 92 92 93 93 94 94 95 95 97 105 108 112 120 124 128 202 205* argument based char unaligned dcl 34 set ref 79 83 88 89* 92 92 93 93 94 94 95 95 97* 105 108 112* 120* 124 128* 202* code 000105 automatic fixed bin(35,0) dcl 38 set ref 156* 157 158* 205* 206 207* com_err_ 000020 constant entry external dcl 29 ref 70 89 97 112 120 128 133 158 202 207 conversion 000120 stack reference condition dcl 51 ref 119 convert builtin function dcl 64 ref 124 cu_$arg_count 000014 constant entry external dcl 27 ref 68 cu_$arg_ptr 000016 constant entry external dcl 28 ref 205 current_argument 000104 automatic fixed bin(17,0) dcl 37 set ref 77* 201 205* 207* error_table_$bad_arg 000026 external static fixed bin(35,0) dcl 47 set ref 89* 97* 112* error_table_$bad_conversion 000024 external static fixed bin(35,0) dcl 47 set ref 120* error_table_$inconsistent 000030 external static fixed bin(35,0) dcl 47 set ref 133* error_table_$noarg 000032 external static fixed bin(35,0) dcl 47 set ref 70* 128* 202* happy 000112 automatic bit(1) dcl 42 set ref 74* 104* 118* 127 166* 175* 184* 193* hcs_$get_exponent_control 000010 constant entry external dcl 24 ref 148 hcs_$set_exponent_control 000012 constant entry external dcl 25 ref 156 ioa_ 000022 constant entry external dcl 30 ref 137 looking_for 000106 automatic fixed bin(17,0) dcl 39 set ref 76* 79 83 87 102 103* 116 117* 167* 176* 186* 194* nargs 000103 automatic fixed bin(17,0) dcl 36 set ref 68* 69 77 201 overflow_bits 000136 automatic bit(72) dcl 146 set ref 148* 149 155* 156* overflow_value 000116 automatic float bin(63) dcl 45 set ref 124* 124 137* 149* 155 185* print_sw 000110 automatic bit(1) dcl 40 set ref 75* 132 137 195* processing 000107 automatic fixed bin(17,0) dcl 39 set ref 105 108 168* 177* put_reqd 000111 automatic bit(1) dcl 41 set ref 75* 132 169* 178* 187* restart_overflow 000114 automatic bit(1) dcl 44 set ref 105* 107* 137* 148* 156* restart_underflow 000113 automatic bit(1) dcl 44 set ref 108* 110* 137* 148* 156* unspec builtin function dcl 64 set ref 149* 155 NAMES DECLARED BY EXPLICIT CONTEXT. CONTROL_ARG 000406 constant label dcl 92 ref 79 83 ERROR 001026 constant label dcl 213 ref 90 99 113 122 129 159 203 208 GET_CURRENT_VALUES 001027 constant entry internal dcl 143 ref 67 KEYWORD 000516 constant label dcl 103 set ref 81 PUT_CURRENT_VALUES 001046 constant entry internal dcl 152 ref 140 VALUE 000613 constant label dcl 117 ref 85 exponent_control 000241 constant entry external dcl 18 get_argument 001164 constant entry internal dcl 199 ref 78 process_fault 001132 constant entry internal dcl 173 ref 93 process_print 001155 constant entry internal dcl 191 ref 95 process_restart 001121 constant entry internal dcl 164 ref 92 process_value 001143 constant entry internal dcl 182 ref 94 NAME DECLARED BY CONTEXT OR IMPLICATION. substr builtin function ref 79 83 88 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1446 1502 1302 1456 Length 1714 1302 34 175 144 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME exponent_control 396 external procedure is an external procedure. on unit on line 119 96 on unit GET_CURRENT_VALUES internal procedure shares stack frame of external procedure exponent_control. process_restart internal procedure shares stack frame of external procedure exponent_control. process_fault internal procedure shares stack frame of external procedure exponent_control. process_value internal procedure shares stack frame of external procedure exponent_control. process_print internal procedure shares stack frame of external procedure exponent_control. get_argument internal procedure shares stack frame of external procedure exponent_control. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME exponent_control 000100 arg_ptr exponent_control 000102 arg_len exponent_control 000103 nargs exponent_control 000104 current_argument exponent_control 000105 code exponent_control 000106 looking_for exponent_control 000107 processing exponent_control 000110 print_sw exponent_control 000111 put_reqd exponent_control 000112 happy exponent_control 000113 restart_underflow exponent_control 000114 restart_overflow exponent_control 000116 overflow_value exponent_control 000136 overflow_bits GET_CURRENT_VALUES THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return tra_ext enable ext_entry int_entry any_to_any_rd THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr hcs_$get_exponent_control hcs_$set_exponent_control ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$bad_conversion error_table_$inconsistent error_table_$noarg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000240 67 000246 68 000247 69 000256 70 000260 72 000304 74 000305 75 000306 76 000310 77 000312 78 000321 79 000322 81 000332 83 000333 85 000342 87 000343 88 000345 89 000352 90 000405 92 000406 93 000421 94 000433 95 000445 97 000457 99 000512 101 000513 102 000514 103 000516 104 000520 105 000522 107 000535 108 000537 110 000550 112 000552 113 000607 115 000610 116 000611 117 000613 118 000615 119 000617 120 000633 122 000666 124 000671 126 000701 127 000703 128 000705 129 000740 132 000741 133 000745 135 000771 137 000772 140 001024 141 001025 213 001026 143 001027 148 001030 149 001043 150 001045 152 001046 155 001047 156 001051 157 001066 158 001070 159 001117 161 001120 164 001121 166 001122 167 001123 168 001125 169 001127 170 001131 173 001132 175 001133 176 001134 177 001136 178 001140 179 001142 182 001143 184 001144 185 001146 186 001150 187 001152 188 001154 191 001155 193 001156 194 001160 195 001162 196 001163 199 001164 201 001165 202 001170 203 001224 205 001225 206 001242 207 001244 208 001277 210 001300 ----------------------------------------------------------- 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