COMPILATION LISTING OF SEGMENT hc_exponent_control Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1022.9 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /* hc_exponent_control 15* 16* ring zero program to get/set the pds variables that control 17* the fim's action on overflow and underflow and use of 18* hexadecimal floating point exponent. 19* 20**/ 21 22 /* format: style4 */ 23 hc_exponent_control: 24 proc; 25 26 return; /* never called here */ 27 28 /* Coded February 80 Benson I. Margulies */ 29 /* Modified February 83 E. N. Kittlitz. hexfp */ 30 /* Modified March 83 E. N. Kittlitz (age 28) make hexfp use 2 bits */ 31 /* Modified June 83 E. N. Kittlitz (still, but not for long) use pmut$load_mode_reg instead of ring_alarm */ 32 /* Modified 831120 E. N. Kittlitz for hex exponent fault/restart control */ 33 /* Modified Nov 1 84 by M. Sharpe to control access to HFP mechanism using an access control segment */ 34 35 dcl a_code fixed bin (35) aligned parameter; 36 dcl a_max_value bit (72) aligned parameter; 37 dcl a_new_hfp_sw bit (2) aligned parameter; 38 dcl a_old_hfp_sw bit (2) aligned parameter; 39 dcl a_restart_overflow bit (1) aligned parameter; 40 dcl a_restart_underflow bit (1) aligned parameter; 41 42 dcl control_bit_index fixed bin; 43 dcl hfp_raw_mode bit (36) aligned automatic; 44 dcl max_value bit (72) aligned; 45 dcl new_hfp_sw bit (2) aligned; 46 dcl restart_overflow bit (1) aligned; 47 dcl restart_underflow bit (1) aligned; 48 dcl val fixed bin (17); 49 50 dcl substr builtin; 51 52 dcl pds$exp_undfl_rest bit (2) aligned external static; 53 dcl pds$exp_ovfl_rest bit (2) aligned external static; 54 dcl pds$eovfl_value bit (72) aligned external static; 55 dcl pds$hex_eovfl_value bit (72) aligned external static; 56 dcl pds$initial_ring fixed bin (3) aligned external static; 57 dcl pds$hfp_exponent_enabled bit (1) aligned external static; 58 dcl sys_info$hfp_exponent_available bit (1) aligned external static; 59 60 dcl error_table_$action_not_performed fixed bin (35) aligned external static; 61 62 dcl acs_dir char (14) internal static options (constant) init (">sc1>admin_acs"); 63 dcl acs_seg char (15) internal static options (constant) init ("Fortran_hfp.acs"); 64 65 dcl level$get returns (fixed bin (17)); 66 dcl pmut$load_mode_reg entry; 67 dcl status_$get_user_raw_mode entry (char (*), char (*), char (*), bit (36) aligned, fixed bin (35)); 68 69 70 /**** ************************************************************************* 71* * Usage: * 72* * * 73* * declare hc_exponent_control$exponent_control_get * 74* * entry (bit (1) aligned, bit (1) aligned, bit (72) aligned); * 75* * ditto: hc_exponent_control$hex_exponent_control_get * 76* * * 77* * call hc_exponent_control$exponent_control_get (restart_underflow, * 78* * restart_overflow, overflow_value); * 79* * * 80* * declare hc_exponent_control$exponent_control_set * 81* * entry (bit (1) aligned, bit (1) aligned, bit (72) aligned, * 82* * fixed bin (35) aligned); * 83* * ditto: hc_exponent_control$hex_exponent_control_set * 84* * * 85* * call hc_exponent_control$exponent_control_set (restart_underflow, * 86* * restart_overflow, overflow_value, code); * 87* * * 88* * * 89* * All arguments are Output for get and Input for set. * 90* * * 91* * restart_overflow "1"b to make the fim restart underflows with * 92* * a zero result, "0"b to fault. * 93* * * 94* * restart_overflow "1"b to make the fim restart overflows with * 95* * a defined result, "0"b to fault. * 96* * * 97* * overflow_value value to use for result of restarted overflow * 98* * if overflows are to be restarted. * 99* * * 100* * code standard status code. * 101* * * 102* ************************************************************************* */ 103 104 105 106 exponent_control_get: 107 entry (a_restart_underflow, a_restart_overflow, a_max_value); 108 109 control_bit_index = 1; 110 a_max_value = pds$eovfl_value; 111 go to ecg_join; 112 113 hex_exponent_control_get: 114 entry (a_restart_underflow, a_restart_overflow, a_max_value); 115 116 control_bit_index = 2; 117 a_max_value = pds$hex_eovfl_value; 118 119 ecg_join: a_restart_underflow = substr (pds$exp_undfl_rest, control_bit_index, 1); 120 a_restart_overflow = substr (pds$exp_ovfl_rest, control_bit_index, 1); 121 return; 122 123 exponent_control_set: 124 entry (a_restart_underflow, a_restart_overflow, a_max_value, a_code); 125 126 control_bit_index = 1; 127 go to ecs_join; 128 129 hex_exponent_control_set: 130 entry (a_restart_underflow, a_restart_overflow, a_max_value, a_code); 131 132 control_bit_index = 2; 133 134 ecs_join: val = level$get (); /* get validation level */ 135 if val > pds$initial_ring then do; 136 a_code = error_table_$action_not_performed; 137 return; 138 end; 139 140 a_code = 0; 141 restart_overflow = a_restart_overflow; 142 restart_underflow = a_restart_underflow; 143 max_value = a_max_value; 144 145 /* ********************************************************** 146* * That copy may seem superfluous, but if someday * 147* * anybody else wants to actually do something with * 148* * these values other than just copying them * 149* * directly into the pds then this assures that they * 150* * wont accidently introduce a 2 reference security * 151* * problem. * 152* ******************************************************** */ 153 154 substr (pds$exp_undfl_rest, control_bit_index, 1) = restart_underflow; 155 substr (pds$exp_ovfl_rest, control_bit_index, 1) = restart_overflow; 156 if control_bit_index = 1 then pds$eovfl_value = max_value; 157 else pds$hex_eovfl_value = max_value; 158 return; 159 160 /* Per-process control of use of hexadecimal exponent floating point. 161* 162* Interpretation of switch values: 163* 164* "10"b -> disable hex exponent 165* "11"b -> enable hex exponent 166* 167* All other values ("00"b, "01"b) provide a handy method for determining the 168* current value of the switch, or for setting a_code to a known non-zero value. 169**/ 170 171 set_hexfp_control: entry (a_new_hfp_sw, a_old_hfp_sw, a_code); 172 173 new_hfp_sw = a_new_hfp_sw; /* copy input arg */ 174 a_old_hfp_sw = "1"b || pds$hfp_exponent_enabled; /* whip this out right away */ 175 val = level$get (); /* get validation level */ 176 if val > pds$initial_ring | /* got the oomph? */ 177 substr (new_hfp_sw, 1, 1) ^= "1"b then do; /* got the style? */ 178 a_code = error_table_$action_not_performed; /* sorry, kid. */ 179 return; 180 end; 181 if substr (new_hfp_sw, 2, 1) = pds$hfp_exponent_enabled then do; /* no change */ 182 a_code = 0; /* hardcoresse oblige */ 183 return; 184 end; 185 if substr (new_hfp_sw, 2, 1) = "1"b then do; /* wants to turn it on */ 186 if ^sys_info$hfp_exponent_available then do; /* smart boy wanted */ 187 a_code = error_table_$action_not_performed; 188 return; 189 end; 190 call status_$get_user_raw_mode (acs_dir, acs_seg, "", hfp_raw_mode, a_code); 191 if a_code ^= 0 192 then do; 193 a_code = error_table_$action_not_performed; 194 return; 195 end; 196 197 if (hfp_raw_mode & RW_ACCESS) = RW_ACCESS /* has access to acs segment */ 198 then pds$hfp_exponent_enabled = "1"b; 199 else do; 200 a_code = error_table_$action_not_performed; 201 return; 202 end; 203 end; 204 205 else pds$hfp_exponent_enabled = ""b; /* turn it off */ 206 207 208 a_code = 0; /* no objections */ 209 call pmut$load_mode_reg; /* zap - last of that exponent base */ 210 return; 211 212 213 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 213 214 215 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0808.5 hc_exponent_control.pl1 >spec>install>1112>hc_exponent_control.pl1 213 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.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. RW_ACCESS constant bit(3) initial packed unaligned dcl 1-11 ref 197 197 a_code parameter fixed bin(35,0) dcl 35 set ref 123 129 136* 140* 171 178* 182* 187* 190* 191 193* 200* 208* a_max_value parameter bit(72) dcl 36 set ref 106 110* 113 117* 123 129 143 a_new_hfp_sw parameter bit(2) dcl 37 ref 171 173 a_old_hfp_sw parameter bit(2) dcl 38 set ref 171 174* a_restart_overflow parameter bit(1) dcl 39 set ref 106 113 120* 123 129 141 a_restart_underflow parameter bit(1) dcl 40 set ref 106 113 119* 123 129 142 acs_dir 000004 constant char(14) initial packed unaligned dcl 62 set ref 190* acs_seg 000000 constant char(15) initial packed unaligned dcl 63 set ref 190* control_bit_index 000100 automatic fixed bin(17,0) dcl 42 set ref 109* 116* 119 120 126* 132* 154 155 156 error_table_$action_not_performed 000026 external static fixed bin(35,0) dcl 60 ref 136 178 187 193 200 hfp_raw_mode 000101 automatic bit(36) dcl 43 set ref 190* 197 level$get 000030 constant entry external dcl 65 ref 134 175 max_value 000102 automatic bit(72) dcl 44 set ref 143* 156 157 new_hfp_sw 000104 automatic bit(2) dcl 45 set ref 173* 176 181 185 pds$eovfl_value 000014 external static bit(72) dcl 54 set ref 110 156* pds$exp_ovfl_rest 000012 external static bit(2) dcl 53 set ref 120 155* pds$exp_undfl_rest 000010 external static bit(2) dcl 52 set ref 119 154* pds$hex_eovfl_value 000016 external static bit(72) dcl 55 set ref 117 157* pds$hfp_exponent_enabled 000022 external static bit(1) dcl 57 set ref 174 181 197* 205* pds$initial_ring 000020 external static fixed bin(3,0) dcl 56 ref 135 176 pmut$load_mode_reg 000032 constant entry external dcl 66 ref 209 restart_overflow 000105 automatic bit(1) dcl 46 set ref 141* 155 restart_underflow 000106 automatic bit(1) dcl 47 set ref 142* 154 status_$get_user_raw_mode 000034 constant entry external dcl 67 ref 190 substr builtin function dcl 50 set ref 119 120 154* 155* 176 181 185 sys_info$hfp_exponent_available 000024 external static bit(1) dcl 58 ref 186 val 000107 automatic fixed bin(17,0) dcl 48 set ref 134* 135 175* 176 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 R_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 W_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 NAMES DECLARED BY EXPLICIT CONTEXT. ecg_join 000075 constant label dcl 119 ref 111 ecs_join 000147 constant label dcl 134 ref 127 exponent_control_get 000034 constant entry external dcl 106 exponent_control_set 000120 constant entry external dcl 123 hc_exponent_control 000022 constant entry external dcl 23 hex_exponent_control_get 000056 constant entry external dcl 113 hex_exponent_control_set 000135 constant entry external dcl 129 set_hexfp_control 000233 constant entry external dcl 171 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 642 700 377 652 Length 1122 377 36 205 242 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME hc_exponent_control 102 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME hc_exponent_control 000100 control_bit_index hc_exponent_control 000101 hfp_raw_mode hc_exponent_control 000102 max_value hc_exponent_control 000104 new_hfp_sw hc_exponent_control 000105 restart_overflow hc_exponent_control 000106 restart_underflow hc_exponent_control 000107 val hc_exponent_control THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. level$get pmut$load_mode_reg status_$get_user_raw_mode THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed pds$eovfl_value pds$exp_ovfl_rest pds$exp_undfl_rest pds$hex_eovfl_value pds$hfp_exponent_enabled pds$initial_ring sys_info$hfp_exponent_available LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000021 26 000027 106 000030 109 000041 110 000043 111 000053 113 000054 116 000063 117 000065 119 000075 120 000104 121 000112 123 000113 126 000130 127 000132 129 000133 132 000145 134 000147 135 000156 136 000162 137 000164 140 000165 141 000166 142 000172 143 000175 154 000201 155 000206 156 000212 157 000222 158 000226 171 000227 173 000243 174 000247 175 000254 176 000262 178 000272 179 000274 181 000275 182 000303 183 000304 185 000305 186 000307 187 000311 188 000313 190 000314 191 000344 193 000346 194 000351 197 000352 200 000362 201 000365 203 000366 205 000367 208 000370 209 000371 210 000376 ----------------------------------------------------------- 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