COMPILATION LISTING OF SEGMENT numeric_to_ascii_base_ 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 1012.6 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 numeric_to_ascii_base_: proc (Aval, Aprec, Base, ans); 9 10 dcl Aval float dec (59), /* value to be converted. (In) */ 11 Aprec fixed bin, /* precision of result. (In) */ 12 /* 0 ==> as many digits as a required will */ 13 /* appear in final result. */ 14 /* <0 ==> truncate to specified no of digits */ 15 /* >0 ==> round to specified number of digits */ 16 /* see numeric_to_ascii_ for description of */ 17 /* allowed values. */ 18 Base fixed bin, /* base to which conversion is to be done */ 19 ans char (72) varying; /* resulting number. (Out) */ 20 21 /* This is copied from numeric_to_ascii_ */ 22 /* Modified: 10/24/83 by C Spitzer. phx15636, replace out_of_bounds condition 23* with call to sub_err_ */ 24 25 dcl (new_quotient, product, quotient, saved_val, val) 26 float dec (59), 27 (Isignificant, exp, n, nzeros, ndigits, prec) 28 fixed bin (17), 29 char1 char (1), 30 chars char (200) varying, 31 char_exp pic "999"; 32 dcl sub_err_ entry() options(variable); 33 dcl dig_ch (0:15) char (1) int static init ( 34 "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f"); 35 dcl base float dec (3); 36 37 dcl 1 val_overlay aligned based (addr (val)), 38 2 sign char (1) unal, 39 2 digits char (59) unal, 40 2 skip bit (1) unal, 41 2 exponent fixed bin (7) unal; 42 43 dcl (abs, divide, index, length, mod, null, reverse, substr, trunc, verify) builtin; 44 45 dcl move_r_or_t_ entry (float dec (59), float dec (59), fixed bin); 46 1 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 1 2 /* format: style3 */ 1 3 1 4 /* These constants are to be used for the flags argument of sub_err_ */ 1 5 /* They are just "string (condition_info_header.action_flags)" */ 1 6 1 7 declare ( 1 8 ACTION_CAN_RESTART init (""b), 1 9 ACTION_CANT_RESTART init ("1"b), 1 10 ACTION_DEFAULT_RESTART 1 11 init ("01"b), 1 12 ACTION_QUIET_RESTART 1 13 init ("001"b), 1 14 ACTION_SUPPORT_SIGNAL 1 15 init ("0001"b) 1 16 ) bit (36) aligned internal static options (constant); 1 17 1 18 /* End include file */ 47 48 49 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 50 51 52 if (Base < 2) 53 | (Base > 16) 54 then do; 55 call sub_err_ (0, "numeric_to_ascii_base_", ACTION_CANT_RESTART, null, 0, 56 "The base ""^d"" is outside of the range 2 to 16.", Base); 57 end; 58 base = convert (base, Base); 59 prec = Aprec; 60 if prec ^= 0 then do; 61 call move_r_or_t_ (val, Aval, prec); 62 prec = abs (prec); 63 end; 64 else do; 65 val = Aval; 66 prec = 59; 67 end; 68 69 if val = 0 then ans = "0"; 70 else do; 71 72 if val > 0 then ans = ""; 73 else do; 74 val = abs (val); 75 ans = "-"; 76 end; 77 78 n = verify (digits, "0"); 79 nzeros = verify (reverse (digits), "0"); 80 ndigits = 61 - n - nzeros; 81 exp = exponent + nzeros - 1; 82 83 if exp >= 0 then do; /* integer value */ 84 quotient = val; 85 chars = ""; 86 do while (quotient >= 1); /* use method of dividing successive */ 87 /* quotients by radix, using remainders as */ 88 /* digits of result (low-order first). */ 89 new_quotient = trunc (divide (quotient, base, 59)); 90 char1 = dig_ch (quotient - (base * new_quotient)); 91 chars = chars || char1; 92 quotient = new_quotient; 93 end; 94 chars = reverse (chars); 95 96 if length (chars) > prec then call e_format (); 97 else ans = ans || chars; 98 end; 99 100 else do; /* integer/fractional value */ 101 nzeros = ndigits + exp; 102 103 if nzeros <= 0 then do; /* fraction only value */ 104 product = val; 105 ans = ans || "0."; 106 do n = 1 to prec; 107 product = base * product; 108 char1 = dig_ch (trunc (product)); 109 product = product - trunc (product); 110 ans = ans || char1; 111 end; 112 n = verify (reverse (ans), "0"); 113 if n > 1 then ans = substr (ans, 1, length (ans) - (n-1)); 114 end; 115 116 else do; /* both integer and fraction parts */ 117 saved_val = val; 118 119 substr (val_overlay.digits, nzeros+n) = (59)"0"; 120 quotient = val; 121 chars = ""; 122 do while (quotient >= 1); 123 new_quotient = trunc (divide (quotient, base, 59)); 124 char1 = dig_ch (quotient - (base * new_quotient)); 125 chars = chars || char1; 126 quotient = new_quotient; 127 end; 128 chars = reverse (chars); 129 chars = chars || "."; 130 131 val = saved_val; 132 substr (val_overlay.digits, 1, nzeros+n-1) = (59)"0"; 133 product = val; 134 do n = 1 to prec - (length (chars)-1); 135 product = base * product; 136 char1 = dig_ch (trunc (product)); 137 product = product - trunc (product); 138 chars = chars || char1; 139 end; 140 n = verify (reverse (chars), "0"); 141 if n > 1 then chars = substr (chars, 1, length (chars) - (n-1)); 142 143 if length (chars)-1 > prec then call e_format (); 144 else ans = ans || chars; 145 end; 146 end; 147 end; 148 return; 149 150 e_format: procedure; 151 152 exp = index (chars, ".") - 1; 153 if exp = -1 then exp = length (chars); 154 else chars = substr (chars, 1, exp) || substr (chars, exp+2); 155 156 ans = ans || substr (chars, 1, 1); 157 ans = ans || "."; 158 ans = ans || substr (chars, 2, prec-1); 159 160 ans = ans || "e"; 161 if exp-1 < 0 then 162 ans = ans || "-"; 163 else ans = ans || "+"; 164 char_exp = exp-1; 165 Isignificant = verify (char_exp, "0"); 166 ans = ans || substr (char_exp, Isignificant); 167 168 end e_format; 169 170 end numeric_to_ascii_base_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.8 numeric_to_ascii_base_.pl1 >spec>install>1111>numeric_to_ascii_base_.pl1 47 1 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ACTION_CANT_RESTART 000000 constant bit(36) initial dcl 1-7 set ref 55* Aprec parameter fixed bin(17,0) dcl 10 ref 8 59 Aval parameter float dec(59) dcl 10 set ref 8 61* 65 Base parameter fixed bin(17,0) dcl 10 set ref 8 52 52 55* 58 Isignificant 000220 automatic fixed bin(17,0) dcl 25 set ref 165* 166 abs builtin function dcl 43 ref 62 74 ans parameter varying char(72) dcl 10 set ref 8 69* 72* 75* 97* 97 105* 105 110* 110 112 113* 113 113 144* 144 156* 156 157* 157 158* 158 160* 160 161* 161 163* 163 166* 166 base 000314 automatic float dec(3) dcl 35 set ref 58* 58 89 90 107 123 124 135 char1 000226 automatic char(1) packed unaligned dcl 25 set ref 90* 91 108* 110 124* 125 136* 138 char_exp 000312 automatic picture(3) packed unaligned dcl 25 set ref 164* 165 166 chars 000227 automatic varying char(200) dcl 25 set ref 85* 91* 91 94* 94 96 97 121* 125* 125 128* 128 129* 129 134 138* 138 140 141* 141 141 143 144 152 153 154* 154 154 156 158 dig_ch 000001 constant char(1) initial array packed unaligned dcl 33 ref 90 108 124 136 digits 0(09) based char(59) level 2 packed packed unaligned dcl 37 set ref 78 79 119* 132* divide builtin function dcl 43 ref 89 123 exp 000221 automatic fixed bin(17,0) dcl 25 set ref 81* 83 101 152* 153 153* 154 154 161 164 exponent 17(01) based fixed bin(7,0) level 2 packed packed unaligned dcl 37 ref 81 index builtin function dcl 43 ref 152 length builtin function dcl 43 ref 96 113 134 141 143 153 move_r_or_t_ 000012 constant entry external dcl 45 ref 61 n 000222 automatic fixed bin(17,0) dcl 25 set ref 78* 80 106* 112* 113 113 119 132 134* 140* 141 141 ndigits 000224 automatic fixed bin(17,0) dcl 25 set ref 80* 101 new_quotient 000100 automatic float dec(59) dcl 25 set ref 89* 90 92 123* 124 126 null builtin function dcl 43 ref 55 55 nzeros 000223 automatic fixed bin(17,0) dcl 25 set ref 79* 80 81 101* 103 119 132 prec 000225 automatic fixed bin(17,0) dcl 25 set ref 59* 60 61* 62* 62 66* 96 106 134 143 158 product 000120 automatic float dec(59) dcl 25 set ref 104* 107* 107 108 109* 109 109 133* 135* 135 136 137* 137 137 quotient 000140 automatic float dec(59) dcl 25 set ref 84* 86 89 90 92* 120* 122 123 124 126* reverse builtin function dcl 43 ref 79 94 112 128 140 saved_val 000160 automatic float dec(59) dcl 25 set ref 117* 131 sub_err_ 000010 constant entry external dcl 32 ref 55 substr builtin function dcl 43 set ref 113 119* 132* 141 154 154 156 158 166 trunc builtin function dcl 43 ref 89 108 109 123 136 137 val 000200 automatic float dec(59) dcl 25 set ref 61* 65* 69 72 74* 74 78 79 81 84 104 117 119 120 131* 132 133 val_overlay based structure level 1 dcl 37 verify builtin function dcl 43 ref 78 79 112 140 165 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 1-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 1-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 1-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 1-7 mod builtin function dcl 43 NAMES DECLARED BY EXPLICIT CONTEXT. e_format 001010 constant entry internal dcl 150 ref 96 143 numeric_to_ascii_base_ 000047 constant entry external dcl 8 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 78 79 81 119 132 convert builtin function ref 58 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1314 1330 1247 1324 Length 1522 1247 14 155 44 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME numeric_to_ascii_base_ 284 external procedure is an external procedure. e_format internal procedure shares stack frame of external procedure numeric_to_ascii_base_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME numeric_to_ascii_base_ 000100 new_quotient numeric_to_ascii_base_ 000120 product numeric_to_ascii_base_ 000140 quotient numeric_to_ascii_base_ 000160 saved_val numeric_to_ascii_base_ 000200 val numeric_to_ascii_base_ 000220 Isignificant numeric_to_ascii_base_ 000221 exp numeric_to_ascii_base_ 000222 n numeric_to_ascii_base_ 000223 nzeros numeric_to_ascii_base_ 000224 ndigits numeric_to_ascii_base_ 000225 prec numeric_to_ascii_base_ 000226 char1 numeric_to_ascii_base_ 000227 chars numeric_to_ascii_base_ 000312 char_exp numeric_to_ascii_base_ 000314 base numeric_to_ascii_base_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out return_mac shorten_stack ext_entry reverse_cs set_chars_eis truncate THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. move_r_or_t_ sub_err_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 8 000042 52 000054 55 000062 58 000136 59 000146 60 000150 61 000151 62 000164 63 000171 65 000172 66 000176 69 000200 72 000213 74 000223 75 000226 78 000234 79 000246 80 000260 81 000264 83 000272 84 000273 85 000276 86 000277 89 000304 90 000316 91 000341 92 000350 93 000353 94 000354 96 000370 97 000376 98 000412 101 000413 103 000415 104 000416 105 000421 106 000433 107 000443 108 000446 109 000464 110 000467 111 000500 112 000502 113 000517 114 000531 117 000532 119 000535 120 000547 121 000552 122 000553 123 000560 124 000572 125 000615 126 000624 127 000627 128 000630 129 000644 131 000654 132 000657 133 000665 134 000670 135 000703 136 000706 137 000724 138 000727 139 000736 140 000740 141 000753 143 000765 144 000773 148 001007 150 001010 152 001011 153 001022 154 001027 156 001055 157 001067 158 001076 160 001113 161 001122 163 001136 164 001145 165 001155 166 001167 168 001207 ----------------------------------------------------------- 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