COMPILATION LISTING OF SEGMENT ffop Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/23/89 1228.8 mst Mon Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,Flegel), 17* install(89-01-23,MR12.3-1010): 18* Commands 393 (phx16310) - fixed bug displaying small numbers when 19* ten**(prec-mag) exceeds exponent size. 20* END HISTORY COMMENTS */ 21 22 23 /* format: style4,ind3 */ 24 25 ffop: proc (string, ip, value); 26 27 dcl (ip, mag, dif, i, j, k, m, n) fixed bin (17); 28 dcl val float bin (63); 29 dcl roundit float bin (63) static internal init (0.5e0); 30 dcl ten float bin (63) static internal init (10e0); 31 dcl (num, numt) fixed bin (71); 32 dcl value float bin (27); 33 dcl numbers (0:9) char (1) static internal init ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9"); 34 dcl string char (32) aligned; 35 dcl sign char (1) aligned; 36 dcl wrk char (26) aligned; 37 dcl (prec init (6), len init (32)) fixed bin (17) internal static; 38 dcl temp float bin (63); 39 dcl (divide, log10, multiply, substr) builtin; 40 41 dcl 1 e aligned, 42 2 p bit (1) aligned, 43 2 old_mag fixed bin (17) aligned; 44 45 wrk = " "; 46 e.p = "0"b; 47 sign = " "; 48 val = value; 49 if val = 0.e0 then do; 50 mag = prec - 1; 51 go to no_log; 52 end; 53 if val < 0.e0 then do; 54 val = -val; 55 sign = "-"; 56 end; 57 mag = log10 (val); 58 if mag < 0 then mag = mag - 1; 59 if mag > prec then go to e_stuff; 60 if mag < -1 then do; 61 62 e_stuff: e.p = "1"b; 63 e.old_mag = mag; 64 65 /* fixed for phx16310 - if value if mag is small, */ 66 /* ten**(prec-mag) may generate exponent overflow; */ 67 /* multiply in two steps to prevent this condition */ 68 69 val = multiply (val, ten ** (prec), 63); 70 val = multiply (val, ten ** (-mag), 63); 71 72 num = val + roundit; 73 mag = 0; 74 dif = 0; 75 go to no_dif; 76 end; 77 if mag < 0 then mag = mag - 1; 78 79 no_log: 80 temp = 10e0 ** (prec - mag); 81 num = val * temp + roundit; 82 83 no_dif: 84 mag = mag + 18 - prec; 85 i = 18; 86 87 next_num: 88 if i = mag then do; 89 substr (wrk, i, 1) = "."; 90 i = i - 1; 91 end; 92 numt = divide (num, 10, 63, 0); 93 k = num - numt * 10; 94 num = numt; 95 substr (wrk, i, 1) = numbers (k); 96 i = i - 1; 97 if num > 0 then go to next_num; 98 if i >= mag - 1 then go to next_num; 99 substr (wrk, i, 1) = sign; 100 do j = 18 to mag by -1 while (substr (wrk, j, 1) = "0" | substr (wrk, j, 1) = "."); 101 end; 102 if e.p then do; 103 substr (wrk, j + 1, 1) = "E"; 104 if e.old_mag < 0 then do; 105 substr (wrk, j + 2, 1) = "-"; 106 e.old_mag = -e.old_mag; 107 end; 108 else substr (wrk, j + 2, 1) = "+"; 109 m = divide (e.old_mag, 100, 17); 110 n = e.old_mag - m * 100; 111 if m > 0 then do; 112 substr (wrk, j + 3, 1) = numbers (m); 113 j = j + 1; 114 end; 115 m = divide (n, 10, 17); 116 n = n - m * 10; 117 if m > 0 then do; 118 substr (wrk, j + 3, 1) = numbers (m); 119 j = j + 1; 120 end; 121 substr (wrk, j + 3, 1) = numbers (n); 122 j = j + 3; 123 end; 124 if len - ip < j - i + 1 then do; 125 substr (string, ip, len - ip) = (26)"*"; 126 ip = len + 1; 127 return; 128 end; 129 substr (string, ip, j - i + 1) = substr (wrk, i, j - i + 1); 130 ip = ip + j - i + 1; 131 return; 132 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/23/89 1228.8 ffop.pl1 >spec>install>1010>ffop.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. dif 000101 automatic fixed bin(17,0) dcl 27 set ref 74* divide builtin function dcl 39 ref 92 109 115 e 000130 automatic structure level 1 dcl 41 i 000102 automatic fixed bin(17,0) dcl 27 set ref 85* 87 89 90* 90 95 96* 96 98 99 124 129 129 129 130 ip parameter fixed bin(17,0) dcl 27 set ref 25 124 125 125 126* 129 130* 130 j 000103 automatic fixed bin(17,0) dcl 27 set ref 100* 100 100* 103 105 108 112 113* 113 118 119* 119 121 122* 122 124 129 129 130 k 000104 automatic fixed bin(17,0) dcl 27 set ref 93* 95 len constant fixed bin(17,0) initial dcl 37 ref 124 125 126 log10 builtin function dcl 39 ref 57 m 000105 automatic fixed bin(17,0) dcl 27 set ref 109* 110 111 112 115* 116 117 118 mag 000100 automatic fixed bin(17,0) dcl 27 set ref 50* 57* 58 58* 58 59 60 63 70 73* 77 77* 77 79 83* 83 87 98 100 multiply builtin function dcl 39 ref 69 70 n 000106 automatic fixed bin(17,0) dcl 27 set ref 110* 115 116* 116 121 num 000112 automatic fixed bin(71,0) dcl 31 set ref 72* 81* 92 93 94* 97 numbers 000000 constant char(1) initial array packed unaligned dcl 33 ref 95 112 118 121 numt 000114 automatic fixed bin(71,0) dcl 31 set ref 92* 93 94 old_mag 1 000130 automatic fixed bin(17,0) level 2 dcl 41 set ref 63* 104 106* 106 109 110 p 000130 automatic bit(1) level 2 dcl 41 set ref 46* 62* 102 prec constant fixed bin(17,0) initial dcl 37 ref 50 59 69 79 83 roundit 000006 constant float bin(63) initial dcl 29 ref 72 81 sign 000116 automatic char(1) dcl 35 set ref 47* 55* 99 string parameter char(32) dcl 34 set ref 25 125* 129* substr builtin function dcl 39 set ref 89* 95* 99* 100 100 103* 105* 108* 112* 118* 121* 125* 129* 129 temp 000126 automatic float bin(63) dcl 38 set ref 79* 81 ten 000004 constant float bin(63) initial dcl 30 ref 69 70 val 000110 automatic float bin(63) dcl 28 set ref 48* 49 53 54* 54 57 69* 69 70* 70 72 81 value parameter float bin(27) dcl 32 ref 25 48 wrk 000117 automatic char(26) dcl 36 set ref 45* 89* 95* 99* 100 100 103* 105* 108* 112* 118* 121* 129 NAMES DECLARED BY EXPLICIT CONTEXT. e_stuff 000064 constant label dcl 62 ref 59 ffop 000020 constant entry external dcl 25 next_num 000163 constant label dcl 87 ref 97 98 no_dif 000156 constant label dcl 83 ref 75 no_log 000120 constant label dcl 79 ref 51 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 446 460 414 456 Length 620 414 12 123 32 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ffop 148 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ffop 000100 mag ffop 000101 dif ffop 000102 i ffop 000103 j ffop 000104 k ffop 000105 m ffop 000106 n ffop 000110 val ffop 000112 num ffop 000114 numt ffop 000116 sign ffop 000117 wrk ffop 000126 temp ffop 000130 e ffop THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac fl2_to_fx1 fl2_to_fx2 mpfx2 ext_entry real_to_real_round_ divide_fx3 double_log_base_10_ double_power_integer_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. decimal_exp_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 25 000014 45 000025 46 000030 47 000031 48 000033 49 000036 50 000037 51 000041 53 000042 54 000043 55 000045 57 000047 58 000054 59 000057 60 000062 62 000064 63 000066 69 000067 70 000076 72 000106 73 000111 74 000112 75 000113 77 000114 79 000120 81 000151 83 000156 85 000161 87 000163 89 000166 90 000171 92 000173 93 000200 94 000206 95 000210 96 000215 97 000217 98 000221 99 000225 100 000231 101 000251 102 000254 103 000256 104 000261 105 000263 106 000267 107 000271 108 000272 109 000276 110 000300 111 000305 112 000307 113 000313 115 000314 116 000317 117 000323 118 000325 119 000331 121 000332 122 000337 124 000341 125 000352 126 000361 127 000363 129 000364 130 000375 131 000402 ----------------------------------------------------------- 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