COMPILATION LISTING OF SEGMENT cv_float_ 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 1007.4 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* * 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(89-04-28,Vu), approve(89-04-28,MCR8099), audit(89-06-12,Lee), 17* install(89-09-29,MR12.3-1074): 18* Modify cv_float_.pl1 to accept a string that contains a decimal 19* point followed by an exponential character. 20* The following builtin functions are now declared explicitly: 21* addr, divide, fixed, float, length, mod, substr. 22* END HISTORY COMMENTS */ 23 24 25 cv_float_: proc(string, code) returns (float bin); 26 27 /* This procedure converts a number in character string form into floating point form */ 28 /* initially coded by M Weaver 23 June 1970 */ 29 /* last modified by M. Weaver 28 August 1970 18:25 */ 30 /* minor bug fix by steve tepper 24 nov 71 */ 31 /* Modified 09/04/84 by Jim Lippard to use returns (float bin) */ 32 33 dcl (len, i, j, k, cstart, exp, digit) fixed bin; 34 dcl code fixed bin (35); 35 dcl cv_dec_check_ entry (char(*), fixed bin(35)) returns (fixed bin); 36 dcl fltval float bin(63); /* tempoary for accumulating number */ 37 dcl rflt1 float bin, rflt2 float bin(63); /* return arguments */ 38 39 dcl fxval fixed bin(35); 40 dcl (neg_bit, dbsw) bit(1) aligned; /* indicates positive or negative number */ 41 dcl lsw bit(1) aligned int static init("1"b); /* indicates whether to initialize labels */ 42 dcl p ptr; 43 dcl string char(*) parm; /* contains input string */ 44 45 dcl retlab(0:1) label local int static; 46 dcl fini(0:1) label local int static; 47 dcl 1 c based, /* used to reference string and digit */ 48 2 s(0:63) char(1); 49 50 dcl (max, rank, verify) builtin; 51 dcl (addr, divide, fixed, float, length, mod, substr) builtin; 52 53 54 /* * * * * * * * * * * * * * * * * * * * * * * * * * */ 55 56 rflt1 = 0.0e0; 57 dbsw = "0"b; /* single precision argument */ 58 go to init; 59 60 cv_float_double_: entry(string, code) returns (float bin(63)); 61 62 rflt2 = 0.0e0; 63 dbsw = "1"b; /* double precision argument */ 64 65 /* initialize */ 66 init: p = addr(digit); 67 68 if lsw then do; 69 retlab(0) = ret0; retlab(1) = ret1; 70 fini(0) = finish; fini(1) = ret1; 71 lsw = "0"b; 72 end; 73 74 digit, code, fltval, exp = 0; 75 neg_bit = "0"b; /* assume positive */ 76 len = length(string) - 1; /* get length of input string */ 77 p = addr(string); 78 cstart = verify (string, " ") - 1; /* skip over leading blanks */ 79 cstart = max (0, cstart); 80 k = 0; /* want first set of labels */ 81 go to convert; /* evaluate part of number before decimal point, if any, or before exponent */ 82 83 ret0: /* get here if we are still in the middle of string */ 84 if p->c.s(i) ^= "." then go to tryexp; /* here the only non-digit can be "." */ 85 k = 1; /* use second set of labels */ 86 cstart = i + 1; /* continue with next character */ 87 go to convert; 88 89 ret1: 90 if i > cstart then exp = cstart - i; /* had a fraction */ 91 if i > len then go to reduce; /* there is no explicit exponent */ 92 if p->c.s(i) = " " then go to reduce; 93 94 tryexp: if p->c.s(i) ^= "e" then go to error; /* explicit exponent must start with "e" */ 95 96 /**** vp: phx19667; a string that contains the decimal point followed 97* immediately by an exponential character (ie. 1.e3) is valid. ****/ 98 99 if i=len then go to error; /* can't have a number ending in "e" */ 100 if i=cstart then do; /* can't have a number starting in "e" or ".e" or "+.e" or "-.e" */ 101 if i=0 | i =1 then go to error; 102 if i=2 & (p->c.s(0) = "-" | p->c.s(0) = "+") then go to error; 103 end; 104 105 digit = cv_dec_check_(substr(string, i+2), code); /* get value of exponent which is an integer */ 106 if code > 0 then do; /* check code from cv_dec_check_ */ 107 code = i + code + 1; /* set code to appropriate value for floating pt. number */ 108 return ((0)); 109 end; 110 exp = exp + digit; /* add explicit to implicit exponent */ 111 112 reduce: /* finish evaluating the number */ 113 if fltval < 1.0e8 then do; /* temporary value is single precision */ 114 /* many fractions, such as .25 and .0625, can be expressed exactly in binary form but 115* this won't happen with ordinary floating point conversion; thus for up to 5 iterations, 116* we will divide by 5 (fixed point), multiply by 10 and divide by 2 (floating point) */ 117 118 fxval = fixed(fltval, 35); 119 do j = 1 to 5 while(mod(fxval,5) = 0); 120 fxval = divide(fxval,5,35,0); 121 exp = exp + 1; 122 end; 123 fltval = float(fxval, 63); 124 end; 125 else j = 1; /* number can't necessarily be represented exactly 126* as a floating point number in binary form */ 127 128 /* Because the decimal places are kept in the exponent, and because of the above adjustment 129* for even powers of 2, the exponent may appear to be out of range even though the input 130* number is within range. In this case, the number is partially evaluated first. */ 131 132 if exp > 38 then do; 133 fltval = fltval * 10.0e0 ** 38; 134 exp = exp - 38; 135 end; 136 if exp < -38 then do; 137 fltval = fltval * 10.0e0 ** -38; 138 exp = exp + 38; 139 end; 140 141 /* finish evaluating number; using the expontiation operator, **, produces results different 142* from dividing ot multiplying by 10. */ 143 if exp ^= 0 then fltval = fltval * 10.0e0 ** exp; 144 if j > 1 then fltval = fltval / 2.0e0 ** (j-1); 145 146 147 finish: 148 if neg_bit then fltval = -fltval; 149 if dbsw then do; 150 rflt2 = fltval; /* return double precision */ 151 return (rflt2); 152 end; 153 else do; 154 rflt1 = fltval; /* return single precision */ 155 return (rflt1); 156 end; 157 158 /* section to actually do the conversion from character string to floating point */ 159 160 convert: 161 do i = cstart to len; 162 digit = rank (p->c.s(i)); /* copy character into digit */ 163 if digit >= 48 then do; /* could be a digit */ 164 if digit > 57 then if digit = 101 then go to retlab(k); /* "e" */ 165 else go to error; /* not a digit */ 166 fltval = fltval * 10 + digit - 48; /* update temporary */ 167 end; 168 else do; /* not a digit; check for special characters */ 169 if digit = 46 then go to retlab(k); /* decimal point or error */ 170 if digit = 32 /* blank */ then if substr(string,i+1) = " " /* ignore trailing blanks */ 171 then go to fini(k); 172 else go to error; 173 if k = 0 then if i = cstart then do; /* look for + or - only at beg of number */ 174 if digit = 45 then neg_bit = "1"b; /* minus */ 175 else if digit ^= 43 /* plus */ then go to error; 176 go to end_conv; /* continue processing string */ 177 end; 178 go to error; /* bad character */ 179 end; 180 end_conv: end; /* end of loop on characters */ 181 go to fini(k); 182 183 error: code = i + 1; /* set error code */ 184 return ((0)); 185 186 end cv_float_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0803.9 cv_float_.pl1 >spec>install>1110>cv_float_.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. addr builtin function dcl 51 ref 66 77 c based structure level 1 packed packed unaligned dcl 47 code parameter fixed bin(35,0) dcl 34 set ref 25 60 74* 105* 106 107* 107 183* cstart 000104 automatic fixed bin(17,0) dcl 33 set ref 78* 79* 79 86* 89 89 100 160 173 cv_dec_check_ 000034 constant entry external dcl 35 ref 105 dbsw 000120 automatic bit(1) dcl 40 set ref 57* 63* 149 digit 000106 automatic fixed bin(17,0) dcl 33 set ref 66 74* 105* 110 162* 163 164 164 166 169 170 174 175 divide builtin function dcl 51 ref 120 exp 000105 automatic fixed bin(17,0) dcl 33 set ref 74* 89* 110* 110 121* 121 132 134* 134 136 138* 138 143 143 fini 000022 internal static label variable local array dcl 46 set ref 70* 70* 170 181 fixed builtin function dcl 51 ref 118 float builtin function dcl 51 ref 123 fltval 000110 automatic float bin(63) dcl 36 set ref 74* 112 118 123* 133* 133 137* 137 143* 143 144* 144 147* 147 150 154 166* 166 fxval 000116 automatic fixed bin(35,0) dcl 39 set ref 118* 119 120* 120 123 i 000101 automatic fixed bin(17,0) dcl 33 set ref 83 86 89 89 91 92 94 99 100 101 101 102 105 105 107 160* 162 170 173* 183 j 000102 automatic fixed bin(17,0) dcl 33 set ref 119* 125* 144 144 k 000103 automatic fixed bin(17,0) dcl 33 set ref 80* 85* 164 169 170 173 181 len 000100 automatic fixed bin(17,0) dcl 33 set ref 76* 91 99 160 length builtin function dcl 51 ref 76 lsw 000010 internal static bit(1) initial dcl 41 set ref 68 71* max builtin function dcl 50 ref 79 mod builtin function dcl 51 ref 119 neg_bit 000117 automatic bit(1) dcl 40 set ref 75* 147 174* p 000122 automatic pointer dcl 42 set ref 66* 77* 83 92 94 102 102 162 rank builtin function dcl 50 ref 162 retlab 000012 internal static label variable local array dcl 45 set ref 69* 69* 164 169 rflt1 000112 automatic float bin(27) dcl 37 set ref 56* 154* 155 rflt2 000114 automatic float bin(63) dcl 37 set ref 62* 150* 151 s based char(1) array level 2 packed packed unaligned dcl 47 ref 83 92 94 102 102 162 string parameter char packed unaligned dcl 43 set ref 25 60 76 77 78 105 105 170 substr builtin function dcl 51 ref 105 105 170 verify builtin function dcl 50 ref 78 NAMES DECLARED BY EXPLICIT CONTEXT. convert 000601 constant label dcl 160 ref 81 87 cv_float_ 000020 constant entry external dcl 25 cv_float_double_ 000045 constant entry external dcl 60 end_conv 000710 constant label dcl 180 ref 176 error 000716 constant label dcl 183 ref 94 99 101 102 165 172 175 178 finish 000542 constant label dcl 147 ref 70 init 000065 constant label dcl 66 ref 58 reduce 000310 constant label dcl 112 ref 91 92 ret0 000144 constant label dcl 83 ref 69 ret1 000160 constant label dcl 89 ref 69 70 tryexp 000176 constant label dcl 94 ref 83 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1014 1052 741 1024 Length 1224 741 36 136 52 22 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cv_float_ 202 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 lsw cv_float_ 000012 retlab cv_float_ 000022 fini cv_float_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cv_float_ 000100 len cv_float_ 000101 i cv_float_ 000102 j cv_float_ 000103 k cv_float_ 000104 cstart cv_float_ 000105 exp cv_float_ 000106 digit cv_float_ 000110 fltval cv_float_ 000112 rflt1 cv_float_ 000114 rflt2 cv_float_ 000116 fxval cv_float_ 000117 neg_bit cv_float_ 000120 dbsw cv_float_ 000122 p cv_float_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 alloc_char_temp call_ext_out_desc call_ext_out return_mac fl2_to_fx1 mdfx1 shorten_stack ext_entry_desc real_to_real_round_ single_power_single_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_check_ 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 56 000035 57 000037 58 000040 60 000041 62 000061 63 000063 66 000065 68 000067 69 000072 69 000075 70 000100 70 000103 71 000106 74 000107 75 000115 76 000116 77 000121 78 000123 79 000136 80 000142 81 000143 83 000144 85 000152 86 000154 87 000157 89 000160 91 000166 92 000171 94 000176 99 000203 100 000206 101 000210 102 000214 105 000226 106 000265 107 000271 108 000276 110 000306 112 000310 118 000313 119 000316 120 000327 121 000332 122 000333 123 000335 124 000340 125 000341 132 000343 133 000346 134 000402 136 000404 137 000407 138 000447 143 000451 144 000504 147 000542 149 000547 150 000551 151 000553 154 000565 155 000567 160 000601 162 000611 163 000617 164 000621 165 000631 166 000632 167 000641 169 000642 170 000650 172 000670 173 000671 174 000676 175 000704 176 000706 178 000707 180 000710 181 000712 183 000716 184 000722 ----------------------------------------------------------- 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