COMPILATION LISTING OF SEGMENT complex_decimal_op_ Compiled by: Multics PL/I Compiler, Release 28d, of September 14, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/03/83 1434.0 mst Mon Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 10 complex_decimal_op_: procedure(poperation, pop3, pdesc3, pop1, pdesc1, pop2, pdesc2); 11 12 /* Program to implement PL/I Version II runtime complex decimal operators 13* 14* Initial Version: 28 April 1972 by Paul Green 15* Modified: 19 October 1972 by Richard A. Barnes 16**/ 17 18 dcl poperation fixed bin, 19 pop3 char(1) unal, 20 pdesc3 bit(36) aligned, 21 pop1 char(1) unal, 22 pdesc1 bit(36) aligned, 23 pop2 char(1) unal, 24 pdesc2 bit(36) aligned; 25 26 dcl ( desc1,desc2,desc3) bit(36) aligned; 27 dcl operation fixed bin; 28 dcl based_fb based fixed bin; 29 dcl based_ch based char(1) unal; 30 dcl ( a based(p), 31 b based(q), 32 c based(r), 33 d based(s), 34 e based(t), 35 f based(u)) char(1) unal; 36 dcl ( p,q,r,s,t,u) ptr; 37 dcl zero char(65) internal static initial("+000000000000000000000000000000000000000000000000000000000000000"); 38 dcl adj(0:l1) char(1) based unal; 39 dcl ( l1,l2,l3) fixed bin; 40 dcl ( binary, substr, addr) builtin; 41 dcl desc_fix bit(36) aligned int static init("100100100000000000000000000000000000"b); 42 dcl desc_flt bit(36) aligned int static init("100101000000000000000000000000000000"b); 43 dcl desc bit(36) aligned; 44 dcl d1 bit(36) aligned defined(desc); 45 dcl (d2,d3,d4) bit(36) aligned; 46 dcl decimal_op_ entry(fixed bin,char(1)unal,bit(36)aligned,char(1)unal,bit(36)aligned,char(1)unal,bit(36)aligned); 47 dcl decimal_sqrt_ entry(char(1),bit(36) aligned,char(1),bit(36) aligned); 48 dcl ( t1 defined (t11), 49 t2 defined (t22), 50 t3 defined (t33), 51 t4 defined (t44), 52 t5 defined (t55), 53 t6 defined (t66)) char(1) unaligned; 54 dcl ( t11,t22,t33,t44,t55,t66) char(65) unaligned; 55 dcl azero defined(zero) char(1) unal; 56 dcl ( comparision initial(0), 57 addition initial(1), 58 subtraction initial(2), 59 multiplication initial(3), 60 division initial(4), 61 negate initial(5), 62 real_fun initial(6), 63 imag_fun initial(7), 64 round_fun initial(8), 65 complex_fun initial(9), 66 abs_fun initial(10), 67 conjg_fun initial(11)) fixed binary internal static; 68 69 /* (e + fi) = pop3 70* (a + bi) = pop1 71* (c + di) = pop2 72* 73* (a + bi) + (c + di) = ((a + c) + (b + d)i) 74* (a + bi) - (c + di) = ((a - c) + (b - d)i) 75* (a + bi) * (c + di) = ((a*c - b*d) + (a*d + b*c)i) 76* (a + bi) / (c + di) = ((__a*__c_+___b*__d)_ + (__b*__c_-___a*__d)__i) 77* (c*c + d*d) (c*c + d*d) 78* abs((a + bi)) = sqrt(a*a + b*b) 79* round((a + bi),pdesc2) = (round(a,pdesc2) + (round(b,pdesc2)i) 80* - (a + bi) = (-a - bi) 81**/ 82 begin: 83 operation = poperation; 84 desc3 = pdesc3; 85 l3 = binary(substr(desc3,25,12),12) + 1; 86 87 if substr(desc3,5,3) = "011"b /* complex fixed dec */ 88 then do; 89 substr(desc3,5,3) = "001"b; /* real fixed decimal */ 90 desc = desc_fix; 91 end; 92 else do; 93 substr(desc3,5,3) = "010"b; /* real float dec */ 94 desc = desc_flt; 95 l3 = l3 + 1; 96 end; 97 t = addr(pop3); 98 u = addr(t->adj(l3)); 99 100 desc1 = pdesc1; 101 l1 = binary(substr(desc1,25,12),12) + 1; 102 if substr(desc1,5,3) = "011"b /* complex fixed dec */ 103 then substr(desc1,5,3) = "001"b; /* real fixed dec */ 104 else if substr(desc1,5,3) = "100"b /* complex float dec */ 105 then do; 106 substr(desc1,5,3) = "010"b; /* real float decimal */ 107 l1 = l1 + 1; 108 end; 109 else if substr(desc1,5,3) = "001"b | substr(desc1,5,3) = "010"b /* real (fixed|float) decimal */ 110 then do; 111 p = addr(pop1); 112 q = addr(zero); 113 go to check_opnd2; 114 end; 115 p = addr(pop1); 116 q = addr(p->adj(l1)); 117 118 check_opnd2: 119 if operation < negate | operation = complex_fun 120 then do; 121 desc2 = pdesc2; 122 l2 = binary(substr(desc2,25,12),12) + 1; 123 if substr(desc2,5,3) = "011"b /* complex fixed decimal */ 124 then substr(desc2,5,3) = "001"b; /* real fixed decimal */ 125 else if substr(desc2,5,3) = "100"b /* complex float dec */ 126 then do; 127 substr(desc2,5,3) = "010"b; /* real float decimal */ 128 l2 = l2 + 1; 129 end; 130 else if substr(desc2,5,3) = "001"b | substr(desc2,5,3) = "010"b /* real (fixed|float) dec */ 131 then do; 132 r = addr(pop2); 133 s = addr(zero); 134 go to operate; 135 end; 136 r = addr(pop2); 137 s = addr(r->adj(l2)); 138 end; 139 140 operate: 141 if operation = negate 142 then do; 143 call decimal_op_(operation,e,desc3,a,desc1,a,desc1); 144 call decimal_op_(operation,f,desc3,b,desc1,b,desc1); 145 return; 146 end; 147 148 if operation = addition | operation = subtraction 149 then do; 150 call decimal_op_(operation,e,desc3,a,desc1,c,desc2); 151 call decimal_op_(operation,f,desc3,b,desc1,d,desc2); 152 return; 153 end; 154 155 if operation = multiplication | operation = division 156 then do; 157 d2 = d1; 158 call decimal_op_(multiplication,t1,d1,a,desc1,c,desc2); 159 call decimal_op_(multiplication,t2,d1,b,desc1,d,desc2); 160 call decimal_op_(multiplication,t3,d1,a,desc1,d,desc2); 161 call decimal_op_(multiplication,t4,d1,b,desc1,c,desc2); 162 end; 163 164 if operation = multiplication 165 then do; 166 call decimal_op_(subtraction,e,desc3,t1,d1,t2,d1); 167 call decimal_op_(addition,f,desc3,t3,d1,t4,d1); 168 return; 169 end; 170 171 if operation = division 172 then do; 173 d3,d4 = d2; 174 call decimal_op_(multiplication,t5,d2,c,desc2,c,desc2); 175 call decimal_op_(multiplication,t6,d2,d,desc2,d,desc2); 176 call decimal_op_(addition,t5,d3,t5,d2,t6,d2); 177 call decimal_op_(addition,t1,d4,t1,d1,t2,d1); 178 call decimal_op_(subtraction,t3,d4,t4,d1,t3,d1); 179 call decimal_op_(division,e,desc3,t1,d4,t5,d3); 180 call decimal_op_(division,f,desc3,t3,d4,t5,d3); 181 return; 182 end; 183 184 if operation = round_fun 185 then do; 186 call decimal_op_(operation,e,desc3,a,desc1,a,pdesc2); 187 call decimal_op_(operation,f,desc3,b,desc1,a,pdesc2); 188 return; 189 end; 190 191 if operation = real_fun then 192 do; 193 call decimal_op_(addition,e,desc3,a,desc1,azero,desc1); 194 return; 195 end; 196 197 if operation = imag_fun then 198 do; 199 call decimal_op_(addition,e,desc3,b,desc1,azero,desc1); 200 return; 201 end; 202 203 if operation = complex_fun then 204 do; 205 call decimal_op_(addition,e,desc3,a,desc1,azero,desc1); 206 call decimal_op_(addition,f,desc3,c,desc2,azero,desc2); 207 return; 208 end; 209 210 if operation = abs_fun 211 then do; 212 d2 = d1; 213 call decimal_op_(multiplication,t1,d1,a,desc1,a,desc1); 214 call decimal_op_(multiplication,t2,d1,b,desc1,b,desc1); 215 call decimal_op_(addition,t1,d2,t1,d1,t2,d1); 216 call decimal_sqrt_(e,desc3,t1,d2); 217 return; 218 end; 219 220 if operation = conjg_fun then 221 do; 222 call decimal_op_(addition,e,desc3,a,desc1,azero,desc1); 223 call decimal_op_(negate,f,desc3,b,desc1,b,desc1); 224 return; 225 end; 226 227 if operation = comparision 228 then do; 229 call decimal_op_(operation,addr(l1)->based_ch,desc1,a,desc1,c,desc2); 230 call decimal_op_(operation,addr(l2)->based_ch,desc1,b,desc1,d,desc2); 231 if l1 = 0 & l2 = 0 232 then l3 = 0; /* = */ 233 else l3 = 1; /* /= */ 234 t -> based_fb = l3; 235 return; 236 end; 237 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/03/83 1005.7 complex_decimal_op_.pl1 >spec>on>pl128d>complex_decimal_op_.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. a based char(1) unaligned dcl 30 set ref 143* 143* 150* 158* 160* 186* 186* 187* 193* 205* 213* 213* 222* 229* abs_fun constant fixed bin(17,0) initial dcl 56 ref 210 addition 000031 internal static fixed bin(17,0) initial dcl 56 set ref 148 167* 176* 177* 193* 199* 205* 206* 215* 222* addr builtin function dcl 40 ref 97 98 111 112 115 116 132 133 136 137 229 230 adj based char(1) array unaligned dcl 38 set ref 98 116 137 azero defined char(1) unaligned dcl 55 set ref 193* 199* 205* 206* 222* b based char(1) unaligned dcl 30 set ref 144* 144* 151* 159* 161* 187* 199* 214* 214* 223* 223* 230* based_ch based char(1) unaligned dcl 29 set ref 229* 230* based_fb based fixed bin(17,0) dcl 28 set ref 234* binary builtin function dcl 40 ref 85 101 122 c based char(1) unaligned dcl 30 set ref 150* 158* 161* 174* 174* 206* 229* comparision constant fixed bin(17,0) initial dcl 56 ref 227 complex_fun constant fixed bin(17,0) initial dcl 56 ref 118 203 conjg_fun constant fixed bin(17,0) initial dcl 56 ref 220 d based char(1) unaligned dcl 30 set ref 151* 159* 160* 175* 175* 230* d1 defined bit(36) dcl 44 set ref 157 158* 159* 160* 161* 166* 166* 167* 167* 177* 177* 178* 178* 212 213* 214* 215* 215* d2 000124 automatic bit(36) dcl 45 set ref 157* 173 174* 175* 176* 176* 212* 215* 216* d3 000125 automatic bit(36) dcl 45 set ref 173* 176* 179* 180* d4 000126 automatic bit(36) dcl 45 set ref 173* 177* 178* 179* 180* decimal_op_ 000036 constant entry external dcl 46 ref 143 144 150 151 158 159 160 161 166 167 174 175 176 177 178 179 180 186 187 193 199 205 206 213 214 215 222 223 229 230 decimal_sqrt_ 000040 constant entry external dcl 47 ref 216 desc 000123 automatic bit(36) dcl 43 set ref 90* 94* 157 157 158 158 159 159 160 160 161 161 166 166 166 166 167 167 167 167 177 177 177 177 178 178 178 178 212 212 213 213 214 214 215 215 215 215 desc1 000100 automatic bit(36) dcl 26 set ref 100* 101 102 102* 104 106* 109 109 143* 143* 144* 144* 150* 151* 158* 159* 160* 161* 186* 187* 193* 193* 199* 199* 205* 205* 213* 213* 214* 214* 222* 222* 223* 223* 229* 229* 230* 230* desc2 000101 automatic bit(36) dcl 26 set ref 121* 122 123 123* 125 127* 130 130 150* 151* 158* 159* 160* 161* 174* 174* 175* 175* 206* 206* 229* 230* desc3 000102 automatic bit(36) dcl 26 set ref 84* 85 87 89* 93* 143* 144* 150* 151* 166* 167* 179* 180* 186* 187* 193* 199* 205* 206* 216* 222* 223* desc_fix constant bit(36) initial dcl 41 ref 90 desc_flt constant bit(36) initial dcl 42 ref 94 division 000034 internal static fixed bin(17,0) initial dcl 56 set ref 155 171 179* 180* e based char(1) unaligned dcl 30 set ref 143* 150* 166* 179* 186* 193* 199* 205* 216* 222* f based char(1) unaligned dcl 30 set ref 144* 151* 167* 180* 187* 206* 223* imag_fun constant fixed bin(17,0) initial dcl 56 ref 197 l1 000120 automatic fixed bin(17,0) dcl 39 set ref 101* 107* 107 116 229 231 l2 000121 automatic fixed bin(17,0) dcl 39 set ref 122* 128* 128 137 230 231 l3 000122 automatic fixed bin(17,0) dcl 39 set ref 85* 95* 95 98 231* 233* 234 multiplication 000033 internal static fixed bin(17,0) initial dcl 56 set ref 155 158* 159* 160* 161* 164 174* 175* 213* 214* negate 000035 internal static fixed bin(17,0) initial dcl 56 set ref 118 140 223* operation 000103 automatic fixed bin(17,0) dcl 27 set ref 82* 118 118 140 143* 144* 148 148 150* 151* 155 155 164 171 184 186* 187* 191 197 203 210 220 227 229* 230* p 000104 automatic pointer dcl 36 set ref 111* 115* 116 143 143 150 158 160 186 186 187 193 205 213 213 222 229 pdesc1 parameter bit(36) dcl 18 ref 10 100 pdesc2 parameter bit(36) dcl 18 set ref 10 121 186* 187* pdesc3 parameter bit(36) dcl 18 ref 10 84 pop1 parameter char(1) unaligned dcl 18 set ref 10 111 115 pop2 parameter char(1) unaligned dcl 18 set ref 10 132 136 pop3 parameter char(1) unaligned dcl 18 set ref 10 97 poperation parameter fixed bin(17,0) dcl 18 ref 10 82 q 000106 automatic pointer dcl 36 set ref 112* 116* 144 144 151 159 161 187 199 214 214 223 223 230 r 000110 automatic pointer dcl 36 set ref 132* 136* 137 150 158 161 174 174 206 229 real_fun constant fixed bin(17,0) initial dcl 56 ref 191 round_fun constant fixed bin(17,0) initial dcl 56 ref 184 s 000112 automatic pointer dcl 36 set ref 133* 137* 151 159 160 175 175 230 substr builtin function dcl 40 set ref 85 87 89* 93* 101 102 102* 104 106* 109 109 122 123 123* 125 127* 130 130 subtraction 000032 internal static fixed bin(17,0) initial dcl 56 set ref 148 166* 178* t 000114 automatic pointer dcl 36 set ref 97* 98 143 150 166 179 186 193 199 205 216 222 234 t1 defined char(1) unaligned dcl 48 set ref 158* 166* 177* 177* 179* 213* 215* 215* 216* t11 000127 automatic char(65) unaligned dcl 54 ref 158 158 166 166 177 177 177 177 179 179 213 213 215 215 215 215 216 216 t2 defined char(1) unaligned dcl 48 set ref 159* 166* 177* 214* 215* t22 000150 automatic char(65) unaligned dcl 54 ref 159 159 166 166 177 177 214 214 215 215 t3 defined char(1) unaligned dcl 48 set ref 160* 167* 178* 178* 180* t33 000171 automatic char(65) unaligned dcl 54 ref 160 160 167 167 178 178 178 178 180 180 t4 defined char(1) unaligned dcl 48 set ref 161* 167* 178* t44 000212 automatic char(65) unaligned dcl 54 ref 161 161 167 167 178 178 t5 defined char(1) unaligned dcl 48 set ref 174* 176* 176* 179* 180* t55 000233 automatic char(65) unaligned dcl 54 ref 174 174 176 176 176 176 179 179 180 180 t6 defined char(1) unaligned dcl 48 set ref 175* 176* t66 000254 automatic char(65) unaligned dcl 54 ref 175 175 176 176 u 000116 automatic pointer dcl 36 set ref 98* 144 151 167 180 187 206 223 zero 000010 internal static char(65) initial unaligned dcl 37 set ref 112 133 193 193 199 199 205 205 206 206 222 222 NAMES DECLARED BY EXPLICIT CONTEXT. begin 000016 constant label dcl 82 check_opnd2 000126 constant label dcl 118 ref 113 complex_decimal_op_ 000011 constant entry external dcl 10 operate 000202 constant label dcl 140 ref 134 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1436 1500 1373 1446 Length 1706 1373 42 172 43 26 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME complex_decimal_op_ 206 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 zero complex_decimal_op_ 000031 addition complex_decimal_op_ 000032 subtraction complex_decimal_op_ 000033 multiplication complex_decimal_op_ 000034 division complex_decimal_op_ 000035 negate complex_decimal_op_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME complex_decimal_op_ 000100 desc1 complex_decimal_op_ 000101 desc2 complex_decimal_op_ 000102 desc3 complex_decimal_op_ 000103 operation complex_decimal_op_ 000104 p complex_decimal_op_ 000106 q complex_decimal_op_ 000110 r complex_decimal_op_ 000112 s complex_decimal_op_ 000114 t complex_decimal_op_ 000116 u complex_decimal_op_ 000120 l1 complex_decimal_op_ 000121 l2 complex_decimal_op_ 000122 l3 complex_decimal_op_ 000123 desc complex_decimal_op_ 000124 d2 complex_decimal_op_ 000125 d3 complex_decimal_op_ 000126 d4 complex_decimal_op_ 000127 t11 complex_decimal_op_ 000150 t22 complex_decimal_op_ 000171 t33 complex_decimal_op_ 000212 t44 complex_decimal_op_ 000233 t55 complex_decimal_op_ 000254 t66 complex_decimal_op_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. decimal_op_ decimal_sqrt_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000003 82 000016 84 000021 85 000023 87 000027 89 000034 90 000040 91 000042 93 000043 94 000047 95 000051 97 000052 98 000054 100 000057 101 000061 102 000065 104 000100 106 000102 107 000106 108 000107 109 000110 111 000114 112 000116 113 000120 115 000121 116 000123 118 000126 121 000133 122 000135 123 000141 125 000154 127 000156 128 000162 129 000163 130 000164 132 000170 133 000172 134 000174 136 000175 137 000177 140 000202 143 000205 144 000227 145 000252 148 000253 150 000257 151 000301 152 000324 155 000325 157 000331 158 000333 159 000355 160 000400 161 000423 164 000446 166 000452 167 000474 168 000517 171 000520 173 000522 174 000525 175 000547 176 000572 177 000615 178 000640 179 000663 180 000706 181 000731 184 000732 186 000734 187 000757 188 001003 191 001004 193 001006 194 001030 197 001031 199 001033 200 001055 203 001056 205 001060 206 001102 207 001125 210 001126 212 001130 213 001132 214 001154 215 001177 216 001222 217 001237 220 001240 222 001242 223 001264 224 001307 227 001310 229 001312 230 001334 231 001357 233 001365 234 001367 235 001371 237 001372 ----------------------------------------------------------- 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