ASSEMBLY LISTING OF SEGMENT >special_ldd>on>apl.1129>apl_format_util_.alm ASSEMBLED ON: 11/29/83 1615.2 mst Tue OPTIONS USED: list ASSEMBLED BY: ALM Version 6.6 November 1982 ASSEMBLER CREATED: 09/21/83 1227.3 mst Wed  1 " ******************************************************  2 " * *  3 " * *  4 " * Copyright (c) 1972 by Massachusetts Institute of *  5 " * Technology and Honeywell Information Systems, Inc. *  6 " * *  7 " * *  8 " ******************************************************  9  10 " Written 781114 by PG  11 " Modified 781206 by PG to fix 361 (round_fixed computed temp length wrong) 12 " Modified 790305 by PG to fix 369 (round_fixed had test reversed in 0_or_1 case)  13 " Modified 790319 by PG to fix 378 (round_fixed lost negative sign in 0_or_1 case)  14 " Modified 791127 by PG to add split entry. 15 " Modified 810125 by WMY to fix bug 453b, the sign is occasionally dropped in  16 " the split entrypoint. 17 "  000000 18 name apl_format_util_  000000 19 segdef round  000013 20 segdef round_fixed 000110 21 segdef split  22 " 23 " Usage:  24 " declare apl_format_util_$round entry (float dec (19), fixed bin, char (21));  25 "  26 " call apl_format_util_$round (value, n_digits, buffer);  27 "  28 " We assume that 0 < n_digits < 20  29 "  30 " Subroutine to implement a useful round builtin, since the 31 " PL/I round builtin only takes constant arguments to tell it  32 " how many digits to keep!  33 "  000002 34 equ P_value,2  000004 35 equ P_digits,4 000006 36 equ P_buffer,6 37 "  38 " We round to a specified number of decimal digits. This case is easy;  39 " we just assign to a float decimal temp that has as many digits as we  40 " wish to keep. The hardware performs the rounding during assignment.  41 "  000000 42 round:  000000 aa 0 00002 3515 20 43 epp1 pr0|P_value,* get ptr to value to round  000001 aa 0 00004 2361 20 44 ldq pr0|P_digits,* get number of digits  000002 aa 000002 0760 07 45 adq 2,dl account for sign and exponent  000003 aa 0 00006 3521 20 46 epp2 pr0|P_buffer,* get ptr to temporary space 000004 aa 0 00340 3005 00 47 mvn (pr),(pr,rl),round move rounded into buffer  000005 aa 100000 000025 48 desc9fl pr1|0,21 source  000006 aa 200000 000006 49 desc9fl pr2|0,ql target  000007 aa 0 00100 3005 40 50 mvn (pr,rl),(pr) move back into input arg  000010 aa 200000 000006 51 desc9fl pr2|0,ql source  000011 aa 100000 000025 52 desc9fl pr1|0,21 target  000012 aa 7 00044 7101 20 53 short_return  54 " 55 " Usage:  56 " declare apl_format_util_$round_fixed entry (float dec (19),  57 " fixed bin, char (21));  58 "  59 " call apl_format_util_$round_fixed (value, n_digits, buffer);  60 "  61 " We round to a specified number of decimal places. This is accomplished  62 " by computing the precision of an intermediate floating decimal temp,  63 " and assigning to it, thus rounding to that number of digits.  64 " The precision of the temp has enough digits to hold the integral part of the  65 " result, as well as the correct number of fractional digits.  66 "  67 " The length of the temporary is:  68 " #integral_digits + #decimal_places + 2  69 "  70 " = (19 - #leading_zeros + exponent) + #decimal_places + 2  71 "  72 " = -#leading_zeros + 21 + exponent + #decimal_places  73 "  000013 74 round_fixed:  000013 aa 0 00002 3515 20 75 epp1 pr0|P_value,* get ptr to value to round  000014 aa 0 00006 3521 20 76 epp2 pr0|P_buffer,* get ptr to temporary space 000015 aa 000024 6270 00 77 eax7 20 byte offset of exponent  000016 aa 0 00100 1005 17 78 mlr (pr,x7),(pr) extract exponent  000017 aa 100000 000001 79 desc9a pr1|0,1 source 000020 aa 200000 000001 80 desc9a pr2|0,1 target 000021 aa 2 00000 2351 00 81 lda pr2|0 get exponent  000022 aa 000001 7350 00 82 als 1 shift sign into place  000023 aa 000034 7310 00 83 ars 28 extend sign, shift number down 000024 aa 2 00000 7551 00 84 sta pr2|0 save exponent  000025 aa 0 00000 1645 00 85 tct (pr) count leading zeros  000026 aa 100000 200023 86 desc9a pr1|0(1),19 in decimal value  000027 0a 000071 0000 00 87 arg zero_table table is here  000030 aa 2 00001 0001 00 88 arg pr2|1 flag || count goes here 000031 0a 000043 6064 00 89 ttn all_zero value is 0e0 000032 aa 2 00001 2351 00 90 lda pr2|1 get flag & count word  000033 0a 000156 3750 00 91 ana =o000077777777 keep count only 000034 aa 2 00001 7551 00 92 sta pr2|1 put it back for later  000035 aa 000000 5310 00 93 neg 0 form -count 000036 aa 000025 0750 07 94 ada 21,dl form -count + 21  000037 aa 2 00000 0751 00 95 ada pr2|0 form -count + 21 + exponent 000040 aa 0 00004 0751 20 96 ada pr0|P_digits,* form -count + 21 + exponent + decimal_places  000041 aa 000025 1150 07 97 cmpa 21,dl prec(temp) >= prec(input)? 000042 aa 000002 6040 04 98 tmi 2,ic no  99 "  000043 100 all_zero:  000043 aa 7 00044 7101 20 101 short_return yes...nothing to do  000044 aa 000002 1150 07 102 cmpa 2,dl prec(temp) <= 2?  000045 0a 000056 6040 00 103 tmi return_zero <2 ... no digits left  000046 0a 000063 6000 00 104 tze return_0_or_1 =2 ... one (new) digit left  000047 aa 0 00340 3005 00 105 mvn (pr),(pr,rl),round move rounded into buffer  000050 aa 100000 000025 106 desc9fl pr1|0,21 source  000051 aa 200000 000005 107 desc9fl pr2|0,al target  000052 aa 0 00300 3005 40 108 mvn (pr,rl),(pr),round move rounded into input 000053 aa 200000 000005 109 desc9fl pr2|0,al source  000054 aa 100000 000025 110 desc9fl pr1|0,21 target  000055 aa 7 00044 7101 20 111 short_return  112 "  000056 113 return_zero:  000056 aa 000100 3004 00 114 mvn (),(pr) store zero  000057 0a 000062 010002 115 desc9ls fixed_zero,2 source  000060 aa 100000 000025 116 desc9fl pr1|0,21 target  000061 aa 7 00044 7101 20 117 short_return  118 "  000062 119 fixed_zero: 000062 aa 053 060 000 000 120 aci "+0"  121 "  122 " In this case, we are rounding away all of the digits in the original value.  123 " For example, if the value was .555, we are rounding to an integer, and the  124 " result is 1.0. The intermediate length in this case is 2...no digits at  125 " all. Thus, we cannot just assign to the intermediate temp.  126 " We end up converting a number of the form:  127 " s000...0DDD...D x 10 ** exp  128 " to:  129 " s000...1000...0 x 10 ** exp  130 " which normalizes to:  131 " s000..........1 x 10 ** (exp + length (DDD...D))  132 "  133 " thus, new_exp = old_exp + (19 - #leading_zeros)  134 "  000063 135 return_0_or_1:  000063 aa 2 00001 7271 00 136 lxl7 pr2|1 get number of leading zeros  000064 aa 0 65000 1065 17 137 cmpc (pr,x7),(),fill(065) is the leading digit less than 5?  000065 aa 100000 200001 138 desc9a pr1|0(1),1 the digit  000066 aa 000000 000000 139 desc9a 0,0 a "5" 000067 0a 000056 6020 00 140 tnc return_zero yes...return zero  000070 aa 0 61100 1005 00 141 mlr (pr),(pr),fill(061) move sign and "1" into temp  000071 aa 100000 000001 142 desc9a pr1|0,1 source 000072 aa 200002 000002 143 desc9a pr2|2,2 target 000073 aa 2 00000 2351 00 144 lda pr2|0 get exponent  000074 aa 000023 0750 07 145 ada 19,dl form exp + 19  000075 aa 2 00001 1751 00 146 sba pr2|1 form exp + 19 - #zeros  000076 aa 000034 7350 00 147 als 28 fixup sign 000077 aa 000023 7710 00 148 arl 1+18 byte-align, move to byte 3.  000100 aa 2 00002 5511 10 149 stba pr2|2,10 store exponent  000101 aa 0 00100 3005 00 150 mvn (pr),(pr) move into parameter 000102 aa 200002 000003 151 desc9fl pr2|2,3 source  000103 aa 100000 000025 152 desc9fl pr1|0,21 target  000104 aa 7 00044 7101 20 153 short_return  154 "  000105 155 zero_tab:  000105 aa 000001 002003 156 vfd 9/0,9/1,9/2,9/3 TCT table to skip 060's.  000106 aa 004005 006007 157 vfd 9/4,9/5,9/6,9/7  000107 aa 010011 000000 158 vfd 9/8,9/9,9/0,9/0  159 "  000071 160 equ zero_table,zero_tab-12 since only 060-071 can ever appear  161 " we don't need full table.  162 " 163 " Usage:  164 " declare apl_format_util_$split entry (float dec (19), fixed dec (19), fixed bin,  165 " char (21));  166 "  167 " call apl_format_util_$split (decimal_value, integer_value, exponent, round_buffer);  168 "  169 " We take a floating-point, decimal value and split it into two parts: an integer decimal  170 " value that contains the digits, and an integer binary value that contains the adjusted  171 " exponent (adjusted so that it is the true exponent for scientific form).  172 "  173 " equ P_value,2 000004 174 equ P_integer_value,4  000006 175 equ P_exponent,6  000010 176 equ P_buffer4,8  177 "  000110 178 split:  000110 aa 0 00002 3515 20 179 epp1 pr0|P_value,* get ptr to value to split  000111 aa 0 00004 3701 20 180 epp4 pr0|P_integer_value,* get ptr to output value 000112 aa 0 00006 3521 20 181 epp2 pr0|P_exponent,* get ptr to exponent value  000113 aa 0 00010 3535 20 182 epp3 pr0|P_buffer4,* get ptr to buffer in arg 4  000114 aa 000024 6270 00 183 eax7 20 byte offset of exponent  000115 aa 0 00100 1005 17 184 mlr (pr,x7),(pr) extract exponent  000116 aa 100000 000001 185 desc9a pr1|0,1 source 000117 aa 300000 000001 186 desc9a pr3|0,1 target 000120 aa 3 00000 2351 00 187 lda pr3|0 get exponent  000121 aa 000001 7350 00 188 als 1 shift sign into place  000122 aa 000034 7310 00 189 ars 28 extend sign, shift number down 000123 aa 3 00000 7551 00 190 sta pr3|0 save exponent  000124 aa 0 00000 1645 00 191 tct (pr) count leading zeroes 000125 aa 100000 200023 192 desc9a pr1|0(1),19 in decimal value  000126 0a 000071 0000 00 193 arg zero_table table is here  000127 aa 3 00001 0001 00 194 arg pr3|1 flag || count goes here 000130 aa 000000 2350 07 195 lda 0,dl get ready for zero case  000131 0a 000140 6064 00 196 ttn split.all_zero value is 0e0  000132 aa 3 00001 2351 00 197 lda pr3|1 get flag & count word  000133 0a 000156 3750 00 198 ana =o000077777777 keep count only 000134 aa 3 00001 7551 00 199 sta pr3|1 save count of leading zeros 000135 aa 3 00000 2351 00 200 lda pr3|0 compute true exponent  000136 aa 000022 0750 07 201 ada 18,dl ..  000137 aa 3 00001 1751 00 202 sba pr3|1 = exp + 18 - n_leading_zeros  203 "  000140 204 split.all_zero: 000140 aa 2 00000 7551 00 205 sta pr2|0 save in exponent  206 " Now take the digits out of the floating-point decimal number, and slide  207 " them left so that the first non-zero digit of the source becomes the very first digit 208 " of the integer.  209 "  000141 aa 000100 3004 00 210 mvn (),(pr) initialize target 000142 0a 000062 010002 211 desc9ls fixed_zero,2 source  000143 aa 400000 010024 212 desc9ls pr4|0,20 target  000144 aa 000023 2350 07 213 lda 19,dl compute # significant digits  000145 aa 3 00001 1751 00 214 sba pr3|1 = 19 - n_leading_zeros  000146 aa 3 00001 2361 00 215 ldq pr3|1 offset of first digit is just n_leading_zeros  000147 aa 0 00140 1005 46 216 mlr (pr,rl,ql),(pr,rl) move digits into position  000150 aa 100000 200005 217 desc9a pr1|0(1),al source (step over sign) 000151 aa 400000 200005 218 desc9a pr4|0(1),al target (step over sign)  000152 aa 0 00100 1005 00 219 mlr (pr),(pr) transfer sign from source to target  000153 aa 100000 000001 220 desc9a pr1|0,1 000154 aa 400000 000001 221 desc9a pr4|0,1 000155 aa 7 00044 7101 20 222 short_return  223 "  224 end  LITERALS 000156 aa 000077 777777 NAME DEFINITIONS FOR ENTRY POINTS AND SEGDEFS 000157 5a 000003 000000 000160 5a 000042 600000 000161 aa 000000 000000 000162 55 000013 000002 000163 5a 000002 400003 000164 55 000006 000013 000165 aa 020 141 160 154 000166 aa 137 146 157 162 000167 aa 155 141 164 137 000170 aa 165 164 151 154 000171 aa 137 000 000 000 000172 55 000020 000003 000173 0a 000110 400000 000174 55 000016 000003 000175 aa 005 163 160 154 split  000176 aa 151 164 000 000 000177 55 000026 000013 000200 0a 000013 400000 000201 55 000023 000003 000202 aa 013 162 157 165 round_fixed 000203 aa 156 144 137 146 000204 aa 151 170 145 144 000205 55 000033 000020 000206 0a 000000 400000 000207 55 000031 000003 000210 aa 005 162 157 165 round  000211 aa 156 144 000 000 000212 55 000002 000026 000213 6a 000000 400002 000214 55 000036 000003 000215 aa 014 163 171 155 symbol_table  000216 aa 142 157 154 137 000217 aa 164 141 142 154 000220 aa 145 000 000 000 DEFINITIONS HASH TABLE  000221 aa 000000 000015 000222 5a 000026 000000 000223 aa 000000 000000 000224 aa 000000 000000 000225 aa 000000 000000 000226 aa 000000 000000 000227 aa 000000 000000 000230 5a 000033 000000 000231 aa 000000 000000 000232 5a 000013 000000 000233 5a 000020 000000 000234 aa 000000 000000 000235 aa 000000 000000 000236 aa 000000 000000 NO EXTERNAL NAMES  NO TRAP POINTER WORDS  TYPE PAIR BLOCKS  000237 aa 000001 000000 000240 aa 000000 000000 INTERNAL EXPRESSION WORDS 000241 aa 000000 000000 LINKAGE INFORMATION 000000 aa 000000 000000 000001 0a 000157 000000 000002 aa 000000 000000 000003 aa 000000 000000 000004 aa 000000 000000 000005 aa 000000 000000 000006 22 000010 000010 000007 a2 000000 000000 SYMBOL INFORMATION SYMBOL TABLE HEADER  000000 aa 000000 000001 000001 aa 163171 155142 000002 aa 164162 145145 000003 aa 000000 000004 000004 aa 000000 112143 000005 aa 305203 523135 000006 aa 000000 112272 000007 aa 254434 331571 000010 aa 141154 155040 000011 aa 040040 040040 000012 aa 000024 000040 000013 aa 000034 000040 000014 aa 000044 000100 000015 aa 000002 000002 000016 aa 000064 000000 000017 aa 000000 000131 000020 aa 000000 000106 000021 aa 000000 000120 000022 aa 000123 000106 000023 aa 000064 000000 000024 aa 101114 115040 000025 aa 126145 162163 000026 aa 151157 156040 000027 aa 040066 056066 000030 aa 040040 116157 000031 aa 166145 155142 000032 aa 145162 040061 000033 aa 071070 062040 000034 aa 115141 162164 000035 aa 151156 163157 000036 aa 156056 123171 000037 aa 163115 141151 000040 aa 156164 056155 000041 aa 040040 040040 000042 aa 040040 040040 000043 aa 040040 040040 000044 aa 154151 163164 000045 aa 040040 040040 000046 aa 040040 040040 000047 aa 040040 040040 000050 aa 040040 040040 000051 aa 040040 040040 000052 aa 040040 040040 000053 aa 040040 040040 000054 aa 040040 040040 000055 aa 040040 040040 000056 aa 040040 040040 000057 aa 040040 040040 000060 aa 040040 040040 000061 aa 040040 040040 000062 aa 040040 040040 000063 aa 040040 040040 000064 aa 000000 000001 000065 aa 000000 000001 000066 aa 000072 000055 000067 aa 122721 262555 000070 aa 000000 112272 000071 aa 152007 000000 000072 aa 076163 160145 >special_ldd>on>apl.1129>apl_format_util_.alm  000073 aa 143151 141154 000074 aa 137154 144144 000075 aa 076157 156076 000076 aa 141160 154056 000077 aa 061061 062071 000100 aa 076141 160154 000101 aa 137146 157162 000102 aa 155141 164137 000103 aa 165164 151154 000104 aa 137056 141154 000105 aa 155040 040040 MULTICS ASSEMBLY CROSS REFERENCE LISTING Value Symbol Source file Line number  43 all_zero apl_format_util_: 89, 100. 62 fixed_zero apl_format_util_: 115, 119, 211.  6 P_buffer apl_format_util_: 36, 46, 76.  10 P_buffer4 apl_format_util_: 176, 182. 4 P_digits apl_format_util_: 35, 44, 96.  6 P_exponent apl_format_util_: 175, 181. 4 P_integer_value apl_format_util_: 174, 180. 2 P_value apl_format_util_: 34, 43, 75, 179. 63 return_0_or_1 apl_format_util_: 104, 135. 56 return_zero apl_format_util_: 103, 113, 140.  0 round apl_format_util_: 19, 42. 13 round_fixed apl_format_util_: 20, 74. 110 split apl_format_util_: 21, 178. 140 split.all_zero apl_format_util_: 196, 204. 105 zero_tab apl_format_util_: 155, 160. 71 zero_table apl_format_util_: 87, 160, 193.  NO FATAL ERRORS  ----------------------------------------------------------- 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