COMPILATION LISTING OF SEGMENT plus Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-06-29_1716.02_Thu_mdt Options: optimize list 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 /* Arithmetic active functions 14* 15* FUNCTION VALUE 16* plus A1 A2 ... An 0 + A1 + A2 + ... + An 17* minus A1 A2 A1 - A2 or -A1 if A2 is not specified 18* times A1 A2 ... An 1 * A1 * A2 * ... * An 19* divide A1 A2 trunc(A1 / A2) 20* quotient A1 A2 A1 / A2 21* mod A1 A2 mod(A1,A2) 22* max A1 A2 ... An max(A1,A2, ..., An) 23* min A1 A2 ... An min(A1,A2, ..., An) 24* trunc A1 trunc(A1) 25* floor A1 floor(A1) 26* ceil A1 ceil(A1) 27* 28* Each Ai is the character string representation of a valid PL/I decimal number, 29* either fixed or float. Calculations are performed internally using float dec(59) 30* arithmetic. The result is in I-, F-, or E-format depending on its value. All of 31* these active functions can be called as functions or as commands, in which case 32* they print the result. 33* 34* Initial Version: 27 January 1974 by Barry L. Wolman */ 35 36 /* Modified 7/8/76 by S. Herbst */ 37 /* Fixed min and others with no args 07/07/81 S. Herbst */ 38 39 plus: proc; 40 41 dcl op char(8) aligned, 42 (number1,number2) float dec(59), 43 result char(72) varying, 44 code fixed bin(35), 45 not_active_function bit(1), 46 (i,count) fixed bin, 47 get_arg variable entry(fixed bin,ptr,fixed bin,fixed bin(35)), 48 (ap,ap1) ptr, 49 (al,al1) fixed bin, 50 answer char(al1) varying based(ap1), 51 arg char(al) based(ap), 52 (mod,max,min,fixed,convert,string,trunc,floor,ceil) builtin, 53 (conversion, overflow, underflow, zerodivide) condition; 54 55 dcl (cu_$arg_ptr,cu_$af_arg_ptr,cu_$af_return_arg) entry(fixed bin,ptr,fixed bin,fixed bin(35)), 56 cu_$arg_count entry returns(fixed bin), 57 numeric_to_ascii_ entry(float dec(59),fixed bin,char(72) varying), 58 (ioa_,com_err_,active_fnc_err_) options(variable); 59 60 dcl (error_table_$not_act_fnc, 61 error_table_$wrong_no_of_args) fixed bin(35) ext static; 62 63 dcl 1 op_type, 64 2 multi bit(1) unaligned, 65 2 unary bit(1) unaligned; 66 67 op = "plus"; 68 string(op_type) = "11"b; 69 goto join; 70 71 minus: entry; 72 73 op = "minus"; 74 string(op_type) = "00"b; 75 goto join; 76 77 times: entry; 78 79 op = "times"; 80 string(op_type) = "11"b; 81 goto join; 82 83 divide: entry; 84 85 op = "divide"; 86 string(op_type) = "00"b; 87 goto join; 88 89 quotient: entry; 90 91 op = "quotient"; 92 string(op_type) = "00"b; 93 goto join; 94 95 mod: entry; 96 97 op = "mod"; 98 string(op_type) = "00"b; 99 goto join; 100 101 max: entry; 102 103 op = "max"; 104 string(op_type) = "10"b; 105 goto join; 106 107 min: entry; 108 109 op = "min"; 110 string(op_type) = "10"b; 111 goto join; 112 113 trunc: entry; 114 115 op = "trunc"; 116 string(op_type) = "01"b; 117 goto join; 118 119 floor: entry; 120 121 op = "floor"; 122 string(op_type) = "01"b; 123 goto join; 124 125 ceil: entry; 126 127 op = "ceil"; 128 string(op_type) = "01"b; 129 goto join; 130 131 join: call cu_$af_return_arg(count,ap1,al1,code); 132 133 not_active_function = code = error_table_$not_act_fnc; 134 135 if not_active_function 136 then do; 137 count = cu_$arg_count(); 138 get_arg = cu_$arg_ptr; 139 code = 0; 140 end; 141 else do; 142 if code ^= 0 then go to simple_err; 143 144 get_arg = cu_$af_arg_ptr; 145 end; 146 147 if count = 0 then do; 148 if op = "plus" | op = "minus" then number1 = 0; 149 else if op = "times" then number1 = 1; 150 else go to wrong_args; 151 go to output; 152 end; 153 154 if (count ^= 1 & unary & ^ multi) 155 | (count < 2 & ^ unary & op ^= "minus") 156 | (count > 2 & ^ multi) 157 then do; 158 wrong_args: code = error_table_$wrong_no_of_args; 159 simple_err: if not_active_function then call com_err_ (code, op); 160 else call active_fnc_err_ (code, op); 161 go to exit; 162 end; 163 164 on conversion goto not_numeric; 165 on overflow goto too_big; 166 on underflow goto too_small; 167 on zerodivide goto zero_divide; 168 169 call get_arg(1,ap,al,code); 170 171 if code ^= 0 then call gripe(""); 172 173 number1 = convert(number1,arg); 174 175 if count = 1 & op = "minus" then number1 = -number1; 176 177 if unary 178 then do; 179 if op = "trunc" then number1 = trunc(number1); 180 if op = "floor" then number1 = floor(number1); 181 if op = "ceil" then number1 = ceil(number1); 182 end; 183 184 do i = 2 to count; 185 call get_arg(i,ap,al,code); 186 187 if code ^= 0 then call gripe(""); 188 189 number2 = convert(number2,arg); 190 191 if op = "plus" then number1 = number1 + number2; 192 if op = "minus" then number1 = number1 - number2; 193 if op = "times" then number1 = number1 * number2; 194 if op = "divide" then number1 = trunc (number1 / number2); 195 if op = "quotient" then number1 = number1 / number2; 196 if op = "mod" then number1 = mod(number1, number2); 197 if op = "max" then number1 = max(number1, number2); 198 if op = "min" then number1 = min(number1, number2); 199 200 end; 201 202 output: 203 call numeric_to_ascii_(number1,0,result); 204 if substr (result, 1, 1) = "0" & length (result) > 60 then do; /* trim it so it will work better */ 205 result = substr (result, 1, length (result) - 1); 206 end; 207 208 if not_active_function then call ioa_(result); 209 else answer = result; 210 211 return; 212 213 zero_divide: 214 if not_active_function then call com_err_(0,op,"Attempt to divide by zero."); 215 else call active_fnc_err_(0,op,"Attempt to divide by zero."); 216 return; 217 218 not_numeric: 219 call gripe("""^a"" is non-numeric"); 220 return; 221 222 too_big: 223 call gripe("overflow"); 224 return; 225 226 too_small: 227 call gripe("underflow"); 228 return; 229 230 gripe: proc(s); 231 232 dcl s char(*); 233 234 if not_active_function then call com_err_(code,op,s,arg); 235 else call active_fnc_err_(code,op,s,arg); 236 237 goto exit; 238 end; 239 240 exit: end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/29/00 1716.0 plus.pl1 >udd>sm>ds>w>ml>plus.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. active_fnc_err_ 000026 constant entry external dcl 55 ref 160 215 235 al 000202 automatic fixed bin(17,0) dcl 41 set ref 169* 173 185* 189 234 234 235 235 al1 000203 automatic fixed bin(17,0) dcl 41 set ref 131* 209 answer based varying char dcl 41 set ref 209* ap 000176 automatic pointer dcl 41 set ref 169* 173 185* 189 234 235 ap1 000200 automatic pointer dcl 41 set ref 131* 209 arg based char packed unaligned dcl 41 set ref 173 189 234* 235* ceil builtin function dcl 41 ref 181 code 000165 automatic fixed bin(35,0) dcl 41 set ref 131* 133 139* 142 158* 159* 160* 169* 171 185* 187 234* 235* com_err_ 000024 constant entry external dcl 55 ref 159 213 234 conversion 000204 stack reference condition dcl 41 ref 164 convert builtin function dcl 41 ref 173 189 count 000170 automatic fixed bin(17,0) dcl 41 set ref 131* 137* 147 154 154 154 175 184 cu_$af_arg_ptr 000012 constant entry external dcl 55 ref 144 cu_$af_return_arg 000014 constant entry external dcl 55 ref 131 cu_$arg_count 000016 constant entry external dcl 55 ref 137 cu_$arg_ptr 000010 constant entry external dcl 55 ref 138 error_table_$not_act_fnc 000030 external static fixed bin(35,0) dcl 60 ref 133 error_table_$wrong_no_of_args 000032 external static fixed bin(35,0) dcl 60 ref 158 floor builtin function dcl 41 ref 180 get_arg 000172 automatic entry variable dcl 41 set ref 138* 144* 169 185 i 000167 automatic fixed bin(17,0) dcl 41 set ref 184* 185* ioa_ 000022 constant entry external dcl 55 ref 208 max builtin function dcl 41 ref 197 min builtin function dcl 41 ref 198 mod builtin function dcl 41 ref 196 multi 000234 automatic bit(1) level 2 packed packed unaligned dcl 63 set ref 154 154 not_active_function 000166 automatic bit(1) packed unaligned dcl 41 set ref 133* 135 159 208 213 234 number1 000102 automatic float dec(59) dcl 41 set ref 148* 149* 173* 173 175* 175 179* 179 180* 180 181* 181 191* 191 192* 192 193* 193 194* 194 195* 195 196* 196 197* 197 198* 198 202* number2 000122 automatic float dec(59) dcl 41 set ref 189* 189 191 192 193 194 195 196 197 198 numeric_to_ascii_ 000020 constant entry external dcl 55 ref 202 op 000100 automatic char(8) dcl 41 set ref 67* 73* 79* 85* 91* 97* 103* 109* 115* 121* 127* 148 148 149 154 159* 160* 175 179 180 181 191 192 193 194 195 196 197 198 213* 215* 234* 235* op_type 000234 automatic structure level 1 packed packed unaligned dcl 63 set ref 68* 74* 80* 86* 92* 98* 104* 110* 116* 122* 128* overflow 000212 stack reference condition dcl 41 ref 165 result 000142 automatic varying char(72) dcl 41 set ref 202* 204 204 205* 205 205 208* 209 s parameter char packed unaligned dcl 232 set ref 230 234* 235* string builtin function dcl 41 set ref 68* 74* 80* 86* 92* 98* 104* 110* 116* 122* 128* trunc builtin function dcl 41 ref 179 194 unary 0(01) 000234 automatic bit(1) level 2 packed packed unaligned dcl 63 set ref 154 154 177 underflow 000220 stack reference condition dcl 41 ref 166 zerodivide 000226 stack reference condition dcl 41 ref 167 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fixed builtin function dcl 41 NAMES DECLARED BY EXPLICIT CONTEXT. ceil 000276 constant entry external dcl 125 divide 000151 constant entry external dcl 83 exit 001251 constant label dcl 240 ref 161 237 floor 000261 constant entry external dcl 119 gripe 001252 constant entry internal dcl 230 ref 171 187 218 222 226 join 000312 constant label dcl 131 ref 69 75 81 87 93 99 105 111 117 123 129 max 000212 constant entry external dcl 101 min 000227 constant entry external dcl 107 minus 000123 constant entry external dcl 71 mod 000177 constant entry external dcl 95 not_numeric 001223 constant label dcl 218 ref 164 output 001067 constant label dcl 202 set ref 151 plus 000110 constant entry external dcl 39 quotient 000164 constant entry external dcl 89 simple_err 000445 constant label dcl 159 ref 142 times 000136 constant entry external dcl 77 too_big 001232 constant label dcl 222 ref 165 too_small 001240 constant label dcl 226 ref 166 trunc 000244 constant entry external dcl 113 wrong_args 000443 constant label dcl 158 ref 149 zero_divide 001145 constant label dcl 213 ref 167 NAMES DECLARED BY CONTEXT OR IMPLICATION. length builtin function ref 204 205 substr builtin function ref 204 205 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1664 1720 1422 1674 Length 2122 1422 34 166 242 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME plus 384 external procedure is an external procedure. on unit on line 164 64 on unit on unit on line 165 64 on unit on unit on line 166 64 on unit on unit on line 167 64 on unit gripe internal procedure shares stack frame of external procedure plus. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME plus 000100 op plus 000102 number1 plus 000122 number2 plus 000142 result plus 000165 code plus 000166 not_active_function plus 000167 i plus 000170 count plus 000172 get_arg plus 000176 ap plus 000200 ap1 plus 000202 al plus 000203 al1 plus 000234 op_type plus THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ent_var call_ext_out_desc call_ext_out return_mac tra_ext_1 enable_op ext_entry int_entry any_to_any_round_ ceil floor truncate mod THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ cu_$af_arg_ptr cu_$af_return_arg cu_$arg_count cu_$arg_ptr ioa_ numeric_to_ascii_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_act_fnc error_table_$wrong_no_of_args CONSTANTS 001354 aa 000002000000 001355 aa 000002000000 001356 aa 600000000041 001357 aa 000244000000 001360 ta 000002000000 001361 aa 000000000000 001362 aa 000002000000 001363 aa 000002000000 001364 aa 600000000041 001365 aa 000552000000 001366 ta 000013000000 001367 aa 000000000000 001370 aa 000002000000 001371 aa 000002000000 001372 aa 600000000041 001373 aa 000244000000 001374 ta 000003000000 001375 aa 000000000000 001376 aa 600102000075 001377 aa 600102000075 001400 aa 600122000075 001402 aa 600102000075 001403 aa 600532000075 001404 aa 600102000075 001405 aa 600102000075 001406 aa 055 061 000 000 -1 001410 aa 000002000000 001411 aa 000002000000 001412 aa 600000000041 001413 aa 000257000000 001414 ta 000012000000 001415 aa 000000000000 001416 aa 077777000043 001417 aa 000001000000 001420 aa 177777777777 000000 aa 526000000000 000001 aa 526077777777 000002 aa 524000000011 000003 aa 524000000023 000004 aa 524000000032 000005 aa 404000000005 000006 aa 530000000110 000007 aa 155 151 156 000 min 000010 aa 155 141 170 000 max 000011 aa 155 157 144 000 mod 000012 aa 524000000000 000013 aa 524000000010 000014 aa 404000000043 001421 aa 053061000000 000015 aa 053060177000 000016 aa 404000000021 000020 aa 144 151 166 151 divi 000021 aa 144 145 000 000 de 000022 aa 146 154 157 157 floo 000023 aa 162 000 000 000 r 000024 aa 164 162 165 156 trun 000025 aa 143 000 000 000 c 000026 aa 164 151 155 145 time 000027 aa 163 000 000 000 s 000030 aa 155 151 156 165 minu 000031 aa 163 000 000 000 s 000032 aa 143 145 151 154 ceil 000033 aa 040 040 040 040 000034 aa 146 154 157 157 floo 000035 aa 162 040 040 040 r 000036 aa 164 162 165 156 trun 000037 aa 143 040 040 040 c 000040 aa 155 151 156 040 min 000041 aa 040 040 040 040 000042 aa 155 141 170 040 max 000043 aa 040 040 040 040 000044 aa 155 157 144 040 mod 000045 aa 040 040 040 040 000046 aa 161 165 157 164 quot 000047 aa 151 145 156 164 ient 000050 aa 144 151 166 151 divi 000051 aa 144 145 040 040 de 000052 aa 164 151 155 145 time 000053 aa 163 040 040 040 s 000054 aa 155 151 156 165 minu 000055 aa 163 040 040 040 s 000056 aa 160 154 165 163 plus 000057 aa 040 040 040 040 000060 aa 157 166 145 162 over 000061 aa 146 154 157 167 flow 000062 aa 172 145 162 157 zero 000063 aa 144 151 166 151 divi 000064 aa 144 145 000 000 de 000065 aa 165 156 144 145 unde 000066 aa 162 146 154 157 rflo 000067 aa 167 000 000 000 w 000070 aa 143 157 156 166 conv 000071 aa 145 162 163 151 ersi 000072 aa 157 156 000 000 on 000073 aa 042 136 141 042 "^a" 000074 aa 040 151 163 040 is 000075 aa 156 157 156 055 non- 000076 aa 156 165 155 145 nume 000077 aa 162 151 143 000 ric 000100 aa 101 164 164 145 Atte 000101 aa 155 160 164 040 mpt 000102 aa 164 157 040 144 to d 000103 aa 151 166 151 144 ivid 000104 aa 145 040 142 171 e by 000105 aa 040 172 145 162 zer 000106 aa 157 056 000 000 o. BEGIN PROCEDURE plus ENTRY TO plus STATEMENT 1 ON LINE 39 plus: proc; 000107 da 000124200000 000110 aa 000600 6270 00 eax7 384 000111 aa 7 00034 3521 20 epp2 pr7|28,* 000112 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000113 aa 000000000000 000114 aa 000000000000 STATEMENT 1 ON LINE 67 op = "plus"; 000115 aa 777741 2370 04 ldaq -31,ic 000056 = 160154165163 040040040040 000116 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 68 string(op_type) = "11"b; 000117 aa 600000 2350 03 lda 196608,du 000120 aa 6 00234 2551 00 orsa pr6|156 STATEMENT 1 ON LINE 69 goto join; 000121 aa 000171 7100 04 tra 121,ic 000312 ENTRY TO minus STATEMENT 1 ON LINE 71 minus: entry; 000122 da 000131200000 000123 aa 000600 6270 00 eax7 384 000124 aa 7 00034 3521 20 epp2 pr7|28,* 000125 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000126 aa 000000000000 000127 aa 000000000000 STATEMENT 1 ON LINE 73 op = "minus"; 000130 aa 777724 2370 04 ldaq -44,ic 000054 = 155151156165 163040040040 000131 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 74 string(op_type) = "00"b; 000132 aa 001266 2350 04 lda 694,ic 001420 = 177777777777 000133 aa 6 00234 3551 00 ansa pr6|156 STATEMENT 1 ON LINE 75 goto join; 000134 aa 000156 7100 04 tra 110,ic 000312 ENTRY TO times STATEMENT 1 ON LINE 77 times: entry; 000135 da 000136200000 000136 aa 000600 6270 00 eax7 384 000137 aa 7 00034 3521 20 epp2 pr7|28,* 000140 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000141 aa 000000000000 000142 aa 000000000000 STATEMENT 1 ON LINE 79 op = "times"; 000143 aa 777707 2370 04 ldaq -57,ic 000052 = 164151155145 163040040040 000144 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 80 string(op_type) = "11"b; 000145 aa 600000 2350 03 lda 196608,du 000146 aa 6 00234 2551 00 orsa pr6|156 STATEMENT 1 ON LINE 81 goto join; 000147 aa 000143 7100 04 tra 99,ic 000312 ENTRY TO divide STATEMENT 1 ON LINE 83 divide: entry; 000150 da 000143200000 000151 aa 000600 6270 00 eax7 384 000152 aa 7 00034 3521 20 epp2 pr7|28,* 000153 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000154 aa 000000000000 000155 aa 000000000000 STATEMENT 1 ON LINE 85 op = "divide"; 000156 aa 777672 2370 04 ldaq -70,ic 000050 = 144151166151 144145040040 000157 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 86 string(op_type) = "00"b; 000160 aa 001240 2350 04 lda 672,ic 001420 = 177777777777 000161 aa 6 00234 3551 00 ansa pr6|156 STATEMENT 1 ON LINE 87 goto join; 000162 aa 000130 7100 04 tra 88,ic 000312 ENTRY TO quotient STATEMENT 1 ON LINE 89 quotient: entry; 000163 da 000151200000 000164 aa 000600 6270 00 eax7 384 000165 aa 7 00034 3521 20 epp2 pr7|28,* 000166 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000167 aa 000000000000 000170 aa 000000000000 STATEMENT 1 ON LINE 91 op = "quotient"; 000171 aa 777655 2370 04 ldaq -83,ic 000046 = 161165157164 151145156164 000172 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 92 string(op_type) = "00"b; 000173 aa 001225 2350 04 lda 661,ic 001420 = 177777777777 000174 aa 6 00234 3551 00 ansa pr6|156 STATEMENT 1 ON LINE 93 goto join; 000175 aa 000115 7100 04 tra 77,ic 000312 ENTRY TO mod STATEMENT 1 ON LINE 95 mod: entry; 000176 da 000155200000 000177 aa 000600 6270 00 eax7 384 000200 aa 7 00034 3521 20 epp2 pr7|28,* 000201 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000202 aa 000000000000 000203 aa 000000000000 STATEMENT 1 ON LINE 97 op = "mod"; 000204 aa 777640 2370 04 ldaq -96,ic 000044 = 155157144040 040040040040 000205 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 98 string(op_type) = "00"b; 000206 aa 001212 2350 04 lda 650,ic 001420 = 177777777777 000207 aa 6 00234 3551 00 ansa pr6|156 STATEMENT 1 ON LINE 99 goto join; 000210 aa 000102 7100 04 tra 66,ic 000312 ENTRY TO max STATEMENT 1 ON LINE 101 max: entry; 000211 da 000161200000 000212 aa 000600 6270 00 eax7 384 000213 aa 7 00034 3521 20 epp2 pr7|28,* 000214 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000215 aa 000000000000 000216 aa 000000000000 STATEMENT 1 ON LINE 103 op = "max"; 000217 aa 777623 2370 04 ldaq -109,ic 000042 = 155141170040 040040040040 000220 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 104 string(op_type) = "10"b; 000221 aa 400000 2350 03 lda 131072,du 000222 aa 6 00234 6751 00 era pr6|156 000223 aa 0 00004 3751 00 ana pr0|4 = 600000000000 000224 aa 6 00234 6551 00 ersa pr6|156 STATEMENT 1 ON LINE 105 goto join; 000225 aa 000065 7100 04 tra 53,ic 000312 ENTRY TO min STATEMENT 1 ON LINE 107 min: entry; 000226 da 000165200000 000227 aa 000600 6270 00 eax7 384 000230 aa 7 00034 3521 20 epp2 pr7|28,* 000231 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000232 aa 000000000000 000233 aa 000000000000 STATEMENT 1 ON LINE 109 op = "min"; 000234 aa 777604 2370 04 ldaq -124,ic 000040 = 155151156040 040040040040 000235 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 110 string(op_type) = "10"b; 000236 aa 400000 2350 03 lda 131072,du 000237 aa 6 00234 6751 00 era pr6|156 000240 aa 0 00004 3751 00 ana pr0|4 = 600000000000 000241 aa 6 00234 6551 00 ersa pr6|156 STATEMENT 1 ON LINE 111 goto join; 000242 aa 000050 7100 04 tra 40,ic 000312 ENTRY TO trunc STATEMENT 1 ON LINE 113 trunc: entry; 000243 da 000172200000 000244 aa 000600 6270 00 eax7 384 000245 aa 7 00034 3521 20 epp2 pr7|28,* 000246 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000247 aa 000000000000 000250 aa 000000000000 STATEMENT 1 ON LINE 115 op = "trunc"; 000251 aa 777565 2370 04 ldaq -139,ic 000036 = 164162165156 143040040040 000252 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 116 string(op_type) = "01"b; 000253 aa 200000 2350 03 lda 65536,du 000254 aa 6 00234 6751 00 era pr6|156 000255 aa 0 00004 3751 00 ana pr0|4 = 600000000000 000256 aa 6 00234 6551 00 ersa pr6|156 STATEMENT 1 ON LINE 117 goto join; 000257 aa 000033 7100 04 tra 27,ic 000312 ENTRY TO floor STATEMENT 1 ON LINE 119 floor: entry; 000260 da 000177200000 000261 aa 000600 6270 00 eax7 384 000262 aa 7 00034 3521 20 epp2 pr7|28,* 000263 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000264 aa 000000000000 000265 aa 000000000000 STATEMENT 1 ON LINE 121 op = "floor"; 000266 aa 777546 2370 04 ldaq -154,ic 000034 = 146154157157 162040040040 000267 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 122 string(op_type) = "01"b; 000270 aa 200000 2350 03 lda 65536,du 000271 aa 6 00234 6751 00 era pr6|156 000272 aa 0 00004 3751 00 ana pr0|4 = 600000000000 000273 aa 6 00234 6551 00 ersa pr6|156 STATEMENT 1 ON LINE 123 goto join; 000274 aa 000016 7100 04 tra 14,ic 000312 ENTRY TO ceil STATEMENT 1 ON LINE 125 ceil: entry; 000275 da 000204200000 000276 aa 000600 6270 00 eax7 384 000277 aa 7 00034 3521 20 epp2 pr7|28,* 000300 aa 2 01045 2721 00 tsp2 pr2|549 ext_entry 000301 aa 000000000000 000302 aa 000000000000 STATEMENT 1 ON LINE 127 op = "ceil"; 000303 aa 777527 2370 04 ldaq -169,ic 000032 = 143145151154 040040040040 000304 aa 6 00100 7571 00 staq pr6|64 op STATEMENT 1 ON LINE 128 string(op_type) = "01"b; 000305 aa 200000 2350 03 lda 65536,du 000306 aa 6 00234 6751 00 era pr6|156 000307 aa 0 00004 3751 00 ana pr0|4 = 600000000000 000310 aa 6 00234 6551 00 ersa pr6|156 STATEMENT 1 ON LINE 129 goto join; 000311 aa 000001 7100 04 tra 1,ic 000312 STATEMENT 1 ON LINE 131 join: call cu_$af_return_arg(count,ap1,al1,code); 000312 aa 6 00170 3521 00 epp2 pr6|120 count 000313 aa 6 00246 2521 00 spri2 pr6|166 000314 aa 6 00200 3521 00 epp2 pr6|128 ap1 000315 aa 6 00250 2521 00 spri2 pr6|168 000316 aa 6 00203 3521 00 epp2 pr6|131 al1 000317 aa 6 00252 2521 00 spri2 pr6|170 000320 aa 6 00165 3521 00 epp2 pr6|117 code 000321 aa 6 00254 2521 00 spri2 pr6|172 000322 aa 6 00244 6211 00 eax1 pr6|164 000323 aa 020000 4310 07 fld 8192,dl 000324 aa 6 00044 3701 20 epp4 pr6|36,* 000325 la 4 00014 3521 20 epp2 pr4|12,* cu_$af_return_arg 000326 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 133 not_active_function = code = error_table_$not_act_fnc; 000327 aa 6 00165 2361 00 ldq pr6|117 code 000330 aa 6 00044 3701 20 epp4 pr6|36,* 000331 la 4 00030 1161 20 cmpq pr4|24,* error_table_$not_act_fnc 000332 aa 0 00512 7001 00 tsx0 pr0|330 r_e_as 000333 aa 6 00166 7551 00 sta pr6|118 not_active_function STATEMENT 1 ON LINE 135 if not_active_function then do; 000334 aa 000016 6000 04 tze 14,ic 000352 STATEMENT 1 ON LINE 137 count = cu_$arg_count(); 000335 aa 6 00170 3521 00 epp2 pr6|120 count 000336 aa 6 00246 2521 00 spri2 pr6|166 000337 aa 6 00244 6211 00 eax1 pr6|164 000340 aa 004000 4310 07 fld 2048,dl 000341 la 4 00016 3521 20 epp2 pr4|14,* cu_$arg_count 000342 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 138 get_arg = cu_$arg_ptr; 000343 aa 6 00044 3701 20 epp4 pr6|36,* 000344 la 4 00010 3521 20 epp2 pr4|8,* cu_$arg_ptr 000345 aa 6 00172 2521 00 spri2 pr6|122 get_arg 000346 aa 001050 2370 04 ldaq 552,ic 001416 = 077777000043 000001000000 000347 aa 6 00174 7571 00 staq pr6|124 get_arg STATEMENT 1 ON LINE 139 code = 0; 000350 aa 6 00165 4501 00 stz pr6|117 code STATEMENT 1 ON LINE 140 end; 000351 aa 000007 7100 04 tra 7,ic 000360 STATEMENT 1 ON LINE 141 else do; STATEMENT 1 ON LINE 142 if code ^= 0 then go to simple_err; 000352 aa 6 00165 2361 00 ldq pr6|117 code 000353 aa 000072 6010 04 tnz 58,ic 000445 STATEMENT 1 ON LINE 144 get_arg = cu_$af_arg_ptr; 000354 la 4 00012 3521 20 epp2 pr4|10,* cu_$af_arg_ptr 000355 aa 6 00172 2521 00 spri2 pr6|122 get_arg 000356 aa 001040 2370 04 ldaq 544,ic 001416 = 077777000043 000001000000 000357 aa 6 00174 7571 00 staq pr6|124 get_arg STATEMENT 1 ON LINE 145 end; STATEMENT 1 ON LINE 147 if count = 0 then do; 000360 aa 6 00170 2361 00 ldq pr6|120 count 000361 aa 000026 6010 04 tnz 22,ic 000407 STATEMENT 1 ON LINE 148 if op = "plus" | op = "minus" then number1 = 0; 000362 aa 777474 2350 04 lda -196,ic 000056 = 160154165163 000363 aa 0 00110 3771 00 anaq pr0|72 = 777777777777 000000000000 000364 aa 0 00450 2771 00 oraq pr0|296 = 000000000000 040040040040 000365 aa 6 00100 1171 00 cmpaq pr6|64 op 000366 aa 000005 6000 04 tze 5,ic 000373 000367 aa 777441 2370 04 ldaq -223,ic 000030 = 155151156165 163000000000 000370 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000371 aa 6 00100 1171 00 cmpaq pr6|64 op 000372 aa 000005 6010 04 tnz 5,ic 000377 000373 aa 000 300 300 404 mvn (ic),(pr),round 000374 aa 777422 00 0003 desc9fl -238,3 000015 = 053060177000 000375 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 000376 aa 000471 7100 04 tra 313,ic 001067 STATEMENT 1 ON LINE 149 else if op = "times" then number1 = 1; 000377 aa 777427 2370 04 ldaq -233,ic 000026 = 164151155145 163000000000 000400 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000401 aa 6 00100 1171 00 cmpaq pr6|64 op 000402 aa 000041 6010 04 tnz 33,ic 000443 000403 aa 000 300 300 404 mvn (ic),(pr),round 000404 aa 001016 00 0003 desc9fl 526,3 001421 = 053061000000 000405 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 151 go to output; 000406 aa 000461 7100 04 tra 305,ic 001067 STATEMENT 1 ON LINE 152 end; STATEMENT 1 ON LINE 154 if (count ^= 1 & unary & ^ multi) | (count < 2 & ^ unary & op ^= "minus") | (count > 2 & ^ multi) then do; 000407 aa 6 00234 2351 00 lda pr6|156 op_type.unary 000410 aa 000001 7350 00 als 1 000411 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 000412 aa 6 00256 7551 00 sta pr6|174 op_type.unary 000413 aa 6 00234 2351 00 lda pr6|156 op_type.multi 000414 aa 0 00002 3771 00 anaq pr0|2 = 400000000000 000000000000 000415 aa 0 00002 6751 00 era pr0|2 = 400000000000 000416 aa 6 00257 7551 00 sta pr6|175 000417 aa 000006 6000 04 tze 6,ic 000425 000420 aa 6 00170 2361 00 ldq pr6|120 count 000421 aa 000001 1160 07 cmpq 1,dl 000422 aa 000003 6000 04 tze 3,ic 000425 000423 aa 6 00256 2351 00 lda pr6|174 op_type.unary 000424 aa 000017 6010 04 tnz 15,ic 000443 000425 aa 6 00170 2361 00 ldq pr6|120 count 000426 aa 000002 1160 07 cmpq 2,dl 000427 aa 000007 6050 04 tpl 7,ic 000436 000430 aa 6 00256 2351 00 lda pr6|174 op_type.unary 000431 aa 000005 6010 04 tnz 5,ic 000436 000432 aa 777376 2370 04 ldaq -258,ic 000030 = 155151156165 163000000000 000433 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000434 aa 6 00100 1171 00 cmpaq pr6|64 op 000435 aa 000006 6010 04 tnz 6,ic 000443 000436 aa 6 00257 2351 00 lda pr6|175 000437 aa 000042 6000 04 tze 34,ic 000501 000440 aa 6 00170 2361 00 ldq pr6|120 count 000441 aa 000002 1160 07 cmpq 2,dl 000442 aa 000037 6044 04 tmoz 31,ic 000501 STATEMENT 1 ON LINE 158 wrong_args: code = error_table_$wrong_no_of_args; 000443 la 4 00032 2361 20 ldq pr4|26,* error_table_$wrong_no_of_args 000444 aa 6 00165 7561 00 stq pr6|117 code STATEMENT 1 ON LINE 159 simple_err: if not_active_function then call com_err_ (code, op); 000445 aa 6 00166 2351 00 lda pr6|118 not_active_function 000446 aa 000016 6000 04 tze 14,ic 000464 000447 aa 6 00165 3521 00 epp2 pr6|117 code 000450 aa 6 00246 2521 00 spri2 pr6|166 000451 aa 6 00100 3521 00 epp2 pr6|64 op 000452 aa 6 00250 2521 00 spri2 pr6|168 000453 aa 777341 3520 04 epp2 -287,ic 000014 = 404000000043 000454 aa 6 00252 2521 00 spri2 pr6|170 000455 aa 777336 3520 04 epp2 -290,ic 000013 = 524000000010 000456 aa 6 00254 2521 00 spri2 pr6|172 000457 aa 6 00244 6211 00 eax1 pr6|164 000460 aa 010000 4310 07 fld 4096,dl 000461 la 4 00024 3521 20 epp2 pr4|20,* com_err_ 000462 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 000463 aa 000566 7100 04 tra 374,ic 001251 STATEMENT 1 ON LINE 160 else call active_fnc_err_ (code, op); 000464 aa 6 00165 3521 00 epp2 pr6|117 code 000465 aa 6 00246 2521 00 spri2 pr6|166 000466 aa 6 00100 3521 00 epp2 pr6|64 op 000467 aa 6 00250 2521 00 spri2 pr6|168 000470 aa 777324 3520 04 epp2 -300,ic 000014 = 404000000043 000471 aa 6 00252 2521 00 spri2 pr6|170 000472 aa 777321 3520 04 epp2 -303,ic 000013 = 524000000010 000473 aa 6 00254 2521 00 spri2 pr6|172 000474 aa 6 00244 6211 00 eax1 pr6|164 000475 aa 010000 4310 07 fld 4096,dl 000476 la 4 00026 3521 20 epp2 pr4|22,* active_fnc_err_ 000477 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 161 go to exit; 000500 aa 000551 7100 04 tra 361,ic 001251 STATEMENT 1 ON LINE 162 end; STATEMENT 1 ON LINE 164 on conversion goto not_numeric; 000501 aa 000012 7260 07 lxl6 10,dl 000502 aa 777366 3520 04 epp2 -266,ic 000070 = 143157156166 000503 aa 0 00717 7001 00 tsx0 pr0|463 enable_op 000504 aa 000004 7100 04 tra 4,ic 000510 000505 aa 000204000000 000506 aa 000012 7100 04 tra 10,ic 000520 BEGIN CONDITION conversion.1 ENTRY TO conversion.1 STATEMENT 1 ON LINE 164 on conversion goto not_numeric; 000507 da 000213200000 000510 aa 000100 6270 00 eax7 64 000511 aa 7 00034 3521 20 epp2 pr7|28,* 000512 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 000513 aa 000000000000 000514 aa 000000000000 000515 aa 000506 3520 04 epp2 326,ic 001223 = 000100100404 000516 aa 000001 7270 07 lxl7 1,dl 000517 aa 0 00657 7101 00 tra pr0|431 tra_ext_1 END CONDITION conversion.1 STATEMENT 1 ON LINE 165 on overflow goto too_big; 000520 aa 000010 7260 07 lxl6 8,dl 000521 aa 777337 3520 04 epp2 -289,ic 000060 = 157166145162 000522 aa 0 00717 7001 00 tsx0 pr0|463 enable_op 000523 aa 000004 7100 04 tra 4,ic 000527 000524 aa 000212000000 000525 aa 000012 7100 04 tra 10,ic 000537 BEGIN CONDITION overflow.2 ENTRY TO overflow.2 STATEMENT 1 ON LINE 165 on overflow goto too_big; 000526 da 000221200000 000527 aa 000100 6270 00 eax7 64 000530 aa 7 00034 3521 20 epp2 pr7|28,* 000531 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 000532 aa 000000000000 000533 aa 000000000000 000534 aa 000476 3520 04 epp2 318,ic 001232 = 776626237004 000535 aa 000001 7270 07 lxl7 1,dl 000536 aa 0 00657 7101 00 tra pr0|431 tra_ext_1 END CONDITION overflow.2 STATEMENT 1 ON LINE 166 on underflow goto too_small; 000537 aa 000011 7260 07 lxl6 9,dl 000540 aa 777325 3520 04 epp2 -299,ic 000065 = 165156144145 000541 aa 0 00717 7001 00 tsx0 pr0|463 enable_op 000542 aa 000004 7100 04 tra 4,ic 000546 000543 aa 000220000000 000544 aa 000012 7100 04 tra 10,ic 000556 BEGIN CONDITION underflow.3 ENTRY TO underflow.3 STATEMENT 1 ON LINE 166 on underflow goto too_small; 000545 da 000227200000 000546 aa 000100 6270 00 eax7 64 000547 aa 7 00034 3521 20 epp2 pr7|28,* 000550 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 000551 aa 000000000000 000552 aa 000000000000 000553 aa 000465 3520 04 epp2 309,ic 001240 = 776625235004 000554 aa 000001 7270 07 lxl7 1,dl 000555 aa 0 00657 7101 00 tra pr0|431 tra_ext_1 END CONDITION underflow.3 STATEMENT 1 ON LINE 167 on zerodivide goto zero_divide; 000556 aa 000012 7260 07 lxl6 10,dl 000557 aa 777303 3520 04 epp2 -317,ic 000062 = 172145162157 000560 aa 0 00717 7001 00 tsx0 pr0|463 enable_op 000561 aa 000004 7100 04 tra 4,ic 000565 000562 aa 000226000000 000563 aa 000012 7100 04 tra 10,ic 000575 BEGIN CONDITION zerodivide.4 ENTRY TO zerodivide.4 STATEMENT 1 ON LINE 167 on zerodivide goto zero_divide; 000564 da 000236200000 000565 aa 000100 6270 00 eax7 64 000566 aa 7 00034 3521 20 epp2 pr7|28,* 000567 aa 2 01047 2721 00 tsp2 pr2|551 int_entry 000570 aa 000000000000 000571 aa 000000000000 000572 aa 000353 3520 04 epp2 235,ic 001145 = 600166235100 000573 aa 000001 7270 07 lxl7 1,dl 000574 aa 0 00657 7101 00 tra pr0|431 tra_ext_1 END CONDITION zerodivide.4 STATEMENT 1 ON LINE 169 call get_arg(1,ap,al,code); 000575 aa 000001 2360 07 ldq 1,dl 000576 aa 6 00257 7561 00 stq pr6|175 000577 aa 6 00257 3521 00 epp2 pr6|175 000600 aa 6 00262 2521 00 spri2 pr6|178 000601 aa 6 00176 3521 00 epp2 pr6|126 ap 000602 aa 6 00264 2521 00 spri2 pr6|180 000603 aa 6 00202 3521 00 epp2 pr6|130 al 000604 aa 6 00266 2521 00 spri2 pr6|182 000605 aa 6 00165 3521 00 epp2 pr6|117 code 000606 aa 6 00270 2521 00 spri2 pr6|184 000607 aa 6 00260 6211 00 eax1 pr6|176 000610 aa 020000 4310 07 fld 8192,dl 000611 aa 6 00172 3521 00 epp2 pr6|122 get_arg 000612 aa 0 00617 7001 00 tsx0 pr0|399 call_ent_var STATEMENT 1 ON LINE 171 if code ^= 0 then call gripe(""); 000613 aa 6 00165 2361 00 ldq pr6|117 code 000614 aa 000004 6000 04 tze 4,ic 000620 000615 aa 000573 3520 04 epp2 379,ic 001410 = 000002000000 000616 aa 2 00000 2351 00 lda pr2|0 000617 aa 000433 6700 04 tsp4 283,ic 001252 STATEMENT 1 ON LINE 173 number1 = convert(number1,arg); 000620 aa 6 00176 3535 20 epp3 pr6|126,* arg 000621 aa 6 00202 2361 00 ldq pr6|130 al 000622 aa 000053 7270 07 lxl7 43,dl 000623 aa 6 00102 3515 00 epp1 pr6|66 number1 000624 aa 000073 2350 07 lda 59,dl 000625 aa 000024 7260 07 lxl6 20,dl 000626 aa 6 00274 3715 00 epp5 pr6|188 000627 aa 0 01256 7001 00 tsx0 pr0|686 any_to_any_round_ STATEMENT 1 ON LINE 175 if count = 1 & op = "minus" then number1 = -number1; 000630 aa 6 00170 2361 00 ldq pr6|120 count 000631 aa 000001 1160 07 cmpq 1,dl 000632 aa 000010 6010 04 tnz 8,ic 000642 000633 aa 777175 2370 04 ldaq -387,ic 000030 = 155151156165 163000000000 000634 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000635 aa 6 00100 1171 00 cmpaq pr6|64 op 000636 aa 000004 6010 04 tnz 4,ic 000642 000637 aa 000 300 206 404 mp2d (ic),(pr),round 000640 aa 000547 01 0002 desc9ls 359,2,0 001406 = 055061000000 000641 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 177 if unary then do; 000642 aa 6 00234 2351 00 lda pr6|156 op_type.unary 000643 aa 200000 3150 03 cana 65536,du 000644 aa 000027 6000 04 tze 23,ic 000673 STATEMENT 1 ON LINE 179 if op = "trunc" then number1 = trunc(number1); 000645 aa 777157 2370 04 ldaq -401,ic 000024 = 164162165156 143000000000 000646 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000647 aa 6 00100 1171 00 cmpaq pr6|64 op 000650 aa 000004 6010 04 tnz 4,ic 000654 000651 aa 6 00274 3515 00 epp1 pr6|188 000652 aa 000532 3520 04 epp2 346,ic 001404 = 600102000075 000653 aa 0 01370 7001 00 tsx0 pr0|760 truncate STATEMENT 1 ON LINE 180 if op = "floor" then number1 = floor(number1); 000654 aa 777146 2370 04 ldaq -410,ic 000022 = 146154157157 162000000000 000655 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000656 aa 6 00100 1171 00 cmpaq pr6|64 op 000657 aa 000004 6010 04 tnz 4,ic 000663 000660 aa 6 00274 3515 00 epp1 pr6|188 000661 aa 000523 3520 04 epp2 339,ic 001404 = 600102000075 000662 aa 0 01365 7001 00 tsx0 pr0|757 floor STATEMENT 1 ON LINE 181 if op = "ceil" then number1 = ceil(number1); 000663 aa 777147 2350 04 lda -409,ic 000032 = 143145151154 000664 aa 0 00110 3771 00 anaq pr0|72 = 777777777777 000000000000 000665 aa 0 00450 2771 00 oraq pr0|296 = 000000000000 040040040040 000666 aa 6 00100 1171 00 cmpaq pr6|64 op 000667 aa 000004 6010 04 tnz 4,ic 000673 000670 aa 6 00274 3515 00 epp1 pr6|188 000671 aa 000513 3520 04 epp2 331,ic 001404 = 600102000075 000672 aa 0 01364 7001 00 tsx0 pr0|756 ceil STATEMENT 1 ON LINE 182 end; STATEMENT 1 ON LINE 184 do i = 2 to count; 000673 aa 6 00170 2361 00 ldq pr6|120 count 000674 aa 6 00235 7561 00 stq pr6|157 000675 aa 000002 2360 07 ldq 2,dl 000676 aa 6 00167 7561 00 stq pr6|119 i 000677 aa 000000 0110 03 nop 0,du 000700 aa 6 00167 2361 00 ldq pr6|119 i 000701 aa 6 00235 1161 00 cmpq pr6|157 000702 aa 000165 6054 04 tpnz 117,ic 001067 STATEMENT 1 ON LINE 185 call get_arg(i,ap,al,code); 000703 aa 6 00167 3521 00 epp2 pr6|119 i 000704 aa 6 00262 2521 00 spri2 pr6|178 000705 aa 6 00176 3521 00 epp2 pr6|126 ap 000706 aa 6 00264 2521 00 spri2 pr6|180 000707 aa 6 00202 3521 00 epp2 pr6|130 al 000710 aa 6 00266 2521 00 spri2 pr6|182 000711 aa 6 00165 3521 00 epp2 pr6|117 code 000712 aa 6 00270 2521 00 spri2 pr6|184 000713 aa 6 00260 6211 00 eax1 pr6|176 000714 aa 020000 4310 07 fld 8192,dl 000715 aa 6 00172 3521 00 epp2 pr6|122 get_arg 000716 aa 0 00617 7001 00 tsx0 pr0|399 call_ent_var STATEMENT 1 ON LINE 187 if code ^= 0 then call gripe(""); 000717 aa 6 00165 2361 00 ldq pr6|117 code 000720 aa 000004 6000 04 tze 4,ic 000724 000721 aa 000467 3520 04 epp2 311,ic 001410 = 000002000000 000722 aa 2 00000 2351 00 lda pr2|0 000723 aa 000327 6700 04 tsp4 215,ic 001252 STATEMENT 1 ON LINE 189 number2 = convert(number2,arg); 000724 aa 6 00176 3535 20 epp3 pr6|126,* arg 000725 aa 6 00202 2361 00 ldq pr6|130 al 000726 aa 000053 7270 07 lxl7 43,dl 000727 aa 6 00122 3515 00 epp1 pr6|82 number2 000730 aa 000073 2350 07 lda 59,dl 000731 aa 000024 7260 07 lxl6 20,dl 000732 aa 6 00274 3715 00 epp5 pr6|188 000733 aa 0 01256 7001 00 tsx0 pr0|686 any_to_any_round_ STATEMENT 1 ON LINE 191 if op = "plus" then number1 = number1 + number2; 000734 aa 777122 2350 04 lda -430,ic 000056 = 160154165163 000735 aa 0 00110 3771 00 anaq pr0|72 = 777777777777 000000000000 000736 aa 0 00450 2771 00 oraq pr0|296 = 000000000000 040040040040 000737 aa 6 00100 1171 00 cmpaq pr6|64 op 000740 aa 000004 6010 04 tnz 4,ic 000744 000741 aa 000 300 202 500 ad2d (pr),(pr),round 000742 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 000743 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 192 if op = "minus" then number1 = number1 - number2; 000744 aa 777064 2370 04 ldaq -460,ic 000030 = 155151156165 163000000000 000745 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000746 aa 6 00100 1171 00 cmpaq pr6|64 op 000747 aa 000004 6010 04 tnz 4,ic 000753 000750 aa 000 300 203 500 sb2d (pr),(pr),round 000751 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 000752 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 193 if op = "times" then number1 = number1 * number2; 000753 aa 777053 2370 04 ldaq -469,ic 000026 = 164151155145 163000000000 000754 aa 0 00452 2771 00 oraq pr0|298 = 000000000000 000040040040 000755 aa 6 00100 1171 00 cmpaq pr6|64 op 000756 aa 000004 6010 04 tnz 4,ic 000762 000757 aa 000 300 206 500 mp2d (pr),(pr),round 000760 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 000761 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 194 if op = "divide" then number1 = trunc (number1 / number2); 000762 aa 777036 2370 04 ldaq -482,ic 000020 = 144151166151 144145000000 000763 aa 0 00454 2771 00 oraq pr0|300 = 000000000000 000000040040 000764 aa 6 00100 1171 00 cmpaq pr6|64 op 000765 aa 000013 6010 04 tnz 11,ic 001000 000766 aa 100 100 227 500 dv3d (pr),(pr),(pr) 000767 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 000770 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 000771 aa 6 00274 00 0077 desc9fl pr6|188,63 000772 aa 000 300 300 500 mvn (pr),(pr),round 000773 aa 6 00274 00 0077 desc9fl pr6|188,63 000774 aa 6 00532 00 0075 desc9fl pr6|346,61 000775 aa 6 00274 3515 00 epp1 pr6|188 000776 aa 000404 3520 04 epp2 260,ic 001402 = 600102000075 000777 aa 0 01370 7001 00 tsx0 pr0|760 truncate STATEMENT 1 ON LINE 195 if op = "quotient" then number1 = number1 / number2; 001000 aa 6 00100 2371 00 ldaq pr6|64 op 001001 aa 777045 1170 04 cmpaq -475,ic 000046 = 161165157164 151145156164 001002 aa 000010 6010 04 tnz 8,ic 001012 001003 aa 100 100 227 500 dv3d (pr),(pr),(pr) 001004 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 001005 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 001006 aa 6 00532 00 0077 desc9fl pr6|346,63 001007 aa 000 300 300 500 mvn (pr),(pr),round 001010 aa 6 00532 00 0077 desc9fl pr6|346,63 001011 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 STATEMENT 1 ON LINE 196 if op = "mod" then number1 = mod(number1, number2); 001012 aa 776777 2350 04 lda -513,ic 000011 = 155157144000 001013 aa 0 00066 3771 00 anaq pr0|54 = 777777777000 000000000000 001014 aa 0 00446 2771 00 oraq pr0|294 = 000000000040 040040040040 001015 aa 6 00100 1171 00 cmpaq pr6|64 op 001016 aa 000003 6010 04 tnz 3,ic 001021 001017 aa 000357 3520 04 epp2 239,ic 001376 = 600102000075 001020 aa 0 01371 7001 00 tsx0 pr0|761 mod STATEMENT 1 ON LINE 197 if op = "max" then number1 = max(number1, number2); 001021 aa 776767 2350 04 lda -521,ic 000010 = 155141170000 001022 aa 0 00066 3771 00 anaq pr0|54 = 777777777000 000000000000 001023 aa 0 00446 2771 00 oraq pr0|294 = 000000000040 040040040040 001024 aa 6 00100 1171 00 cmpaq pr6|64 op 001025 aa 000016 6010 04 tnz 14,ic 001043 001026 aa 000 300 300 500 mvn (pr),(pr),round 001027 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 001030 aa 6 00532 00 0075 desc9fl pr6|346,61 001031 aa 000 100 303 500 cmpn (pr),(pr) 001032 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 001033 aa 6 00532 00 0075 desc9fl pr6|346,61 001034 aa 000004 6050 04 tpl 4,ic 001040 001035 aa 000 300 300 500 mvn (pr),(pr),round 001036 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 001037 aa 6 00532 00 0075 desc9fl pr6|346,61 001040 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001041 aa 6 00532 00 0100 desc9a pr6|346,64 001042 aa 6 00102 00 0100 desc9a pr6|66,64 number1 STATEMENT 1 ON LINE 198 if op = "min" then number1 = min(number1, number2); 001043 aa 776744 2350 04 lda -540,ic 000007 = 155151156000 001044 aa 0 00066 3771 00 anaq pr0|54 = 777777777000 000000000000 001045 aa 0 00446 2771 00 oraq pr0|294 = 000000000040 040040040040 001046 aa 6 00100 1171 00 cmpaq pr6|64 op 001047 aa 000016 6010 04 tnz 14,ic 001065 001050 aa 000 300 300 500 mvn (pr),(pr),round 001051 aa 6 00102 00 0075 desc9fl pr6|66,61 number1 001052 aa 6 00532 00 0075 desc9fl pr6|346,61 001053 aa 000 100 303 500 cmpn (pr),(pr) 001054 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 001055 aa 6 00532 00 0075 desc9fl pr6|346,61 001056 aa 000004 6044 04 tmoz 4,ic 001062 001057 aa 000 300 300 500 mvn (pr),(pr),round 001060 aa 6 00122 00 0075 desc9fl pr6|82,61 number2 001061 aa 6 00532 00 0075 desc9fl pr6|346,61 001062 aa 000 100 100 500 mlr (pr),(pr),fill(000) 001063 aa 6 00532 00 0100 desc9a pr6|346,64 001064 aa 6 00102 00 0100 desc9a pr6|66,64 number1 STATEMENT 1 ON LINE 200 end; 001065 aa 6 00167 0541 00 aos pr6|119 i 001066 aa 777612 7100 04 tra -118,ic 000700 STATEMENT 1 ON LINE 202 output: call numeric_to_ascii_(number1,0,result); 001067 aa 6 00257 4501 00 stz pr6|175 001070 aa 6 00102 3521 00 epp2 pr6|66 number1 001071 aa 6 00246 2521 00 spri2 pr6|166 001072 aa 6 00257 3521 00 epp2 pr6|175 001073 aa 6 00250 2521 00 spri2 pr6|168 001074 aa 6 00143 3521 00 epp2 pr6|99 result 001075 aa 6 00252 2521 00 spri2 pr6|170 001076 aa 6 00244 6211 00 eax1 pr6|164 001077 aa 014000 4310 07 fld 6144,dl 001100 aa 6 00044 3701 20 epp4 pr6|36,* 001101 la 4 00020 3521 20 epp2 pr4|16,* numeric_to_ascii_ 001102 aa 0 00623 7001 00 tsx0 pr0|403 call_ext_out STATEMENT 1 ON LINE 204 if substr (result, 1, 1) = "0" & length (result) > 60 then do; 001103 aa 6 00143 2351 00 lda pr6|99 result 001104 aa 0 00022 3771 00 anaq pr0|18 = 777000000000 000000000000 001105 aa 060000 1150 03 cmpa 24576,du 001106 aa 000011 6010 04 tnz 9,ic 001117 001107 aa 6 00142 2361 00 ldq pr6|98 result 001110 aa 000074 1160 07 cmpq 60,dl 001111 aa 000006 6044 04 tmoz 6,ic 001117 STATEMENT 1 ON LINE 205 result = substr (result, 1, length (result) - 1); 001112 aa 000001 1760 07 sbq 1,dl 001113 aa 000110 1160 07 cmpq 72,dl 001114 aa 000002 6040 04 tmi 2,ic 001116 001115 aa 000110 2360 07 ldq 72,dl 001116 aa 6 00142 7561 00 stq pr6|98 result STATEMENT 1 ON LINE 206 end; STATEMENT 1 ON LINE 208 if not_active_function then call ioa_(result); 001117 aa 6 00166 2351 00 lda pr6|118 not_active_function 001120 aa 000013 6000 04 tze 11,ic 001133 001121 aa 6 00143 3521 00 epp2 pr6|99 result 001122 aa 6 00246 2521 00 spri2 pr6|166 001123 aa 776663 3520 04 epp2 -589,ic 000006 = 530000000110 001124 aa 6 00250 2521 00 spri2 pr6|168 001125 aa 6 00244 6211 00 eax1 pr6|164 001126 aa 004000 4310 07 fld 2048,dl 001127 aa 6 00044 3701 20 epp4 pr6|36,* 001130 la 4 00022 3521 20 epp2 pr4|18,* ioa_ 001131 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001132 aa 000012 7100 04 tra 10,ic 001144 STATEMENT 1 ON LINE 209 else answer = result; 001133 aa 6 00142 2361 00 ldq pr6|98 result 001134 aa 6 00203 1161 00 cmpq pr6|131 al1 001135 aa 000002 6040 04 tmi 2,ic 001137 001136 aa 6 00203 2361 00 ldq pr6|131 al1 001137 aa 6 00200 7561 20 stq pr6|128,* answer 001140 aa 6 00200 3735 20 epp7 pr6|128,* ap1 001141 aa 040 140 100 540 mlr (pr,rl),(pr,rl),fill(040) 001142 aa 6 00143 00 0006 desc9a pr6|99,ql result 001143 aa 7 00001 00 0006 desc9a pr7|1,ql answer STATEMENT 1 ON LINE 211 return; 001144 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 213 zero_divide: if not_active_function then call com_err_(0,op,"Attempt to divide by zero."); 001145 aa 6 00166 2351 00 lda pr6|118 not_active_function 001146 aa 000027 6000 04 tze 23,ic 001175 001147 aa 6 00257 4501 00 stz pr6|175 001150 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001151 aa 776730 00 0034 desc9a -552,28 000100 = 101164164145 001152 aa 6 00244 00 0034 desc9a pr6|164,28 001153 aa 6 00257 3521 00 epp2 pr6|175 001154 aa 6 00534 2521 00 spri2 pr6|348 001155 aa 6 00100 3521 00 epp2 pr6|64 op 001156 aa 6 00536 2521 00 spri2 pr6|350 001157 aa 6 00244 3521 00 epp2 pr6|164 001160 aa 6 00540 2521 00 spri2 pr6|352 001161 aa 776624 3520 04 epp2 -620,ic 000005 = 404000000005 001162 aa 6 00542 2521 00 spri2 pr6|354 001163 aa 776630 3520 04 epp2 -616,ic 000013 = 524000000010 001164 aa 6 00544 2521 00 spri2 pr6|356 001165 aa 776617 3520 04 epp2 -625,ic 000004 = 524000000032 001166 aa 6 00546 2521 00 spri2 pr6|358 001167 aa 6 00532 6211 00 eax1 pr6|346 001170 aa 014000 4310 07 fld 6144,dl 001171 aa 6 00044 3701 20 epp4 pr6|36,* 001172 la 4 00024 3521 20 epp2 pr4|20,* com_err_ 001173 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001174 aa 000026 7100 04 tra 22,ic 001222 STATEMENT 1 ON LINE 215 else call active_fnc_err_(0,op,"Attempt to divide by zero."); 001175 aa 6 00257 4501 00 stz pr6|175 001176 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001177 aa 776702 00 0034 desc9a -574,28 000100 = 101164164145 001200 aa 6 00244 00 0034 desc9a pr6|164,28 001201 aa 6 00257 3521 00 epp2 pr6|175 001202 aa 6 00534 2521 00 spri2 pr6|348 001203 aa 6 00100 3521 00 epp2 pr6|64 op 001204 aa 6 00536 2521 00 spri2 pr6|350 001205 aa 6 00244 3521 00 epp2 pr6|164 001206 aa 6 00540 2521 00 spri2 pr6|352 001207 aa 776576 3520 04 epp2 -642,ic 000005 = 404000000005 001210 aa 6 00542 2521 00 spri2 pr6|354 001211 aa 776602 3520 04 epp2 -638,ic 000013 = 524000000010 001212 aa 6 00544 2521 00 spri2 pr6|356 001213 aa 776571 3520 04 epp2 -647,ic 000004 = 524000000032 001214 aa 6 00546 2521 00 spri2 pr6|358 001215 aa 6 00532 6211 00 eax1 pr6|346 001216 aa 014000 4310 07 fld 6144,dl 001217 aa 6 00044 3701 20 epp4 pr6|36,* 001220 la 4 00026 3521 20 epp2 pr4|22,* active_fnc_err_ 001221 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 216 return; 001222 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 218 not_numeric: call gripe("""^a"" is non-numeric"); 001223 aa 000 100 100 404 mlr (ic),(pr),fill(000) 001224 aa 776650 00 0024 desc9a -600,20 000073 = 042136141042 001225 aa 6 00244 00 0024 desc9a pr6|164,20 001226 aa 000142 3520 04 epp2 98,ic 001370 = 000002000000 001227 aa 2 00000 2351 00 lda pr2|0 001230 aa 000022 6700 04 tsp4 18,ic 001252 STATEMENT 1 ON LINE 220 return; 001231 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 222 too_big: call gripe("overflow"); 001232 aa 776626 2370 04 ldaq -618,ic 000060 = 157166145162 146154157167 001233 aa 6 00552 7571 00 staq pr6|362 001234 aa 000126 3520 04 epp2 86,ic 001362 = 000002000000 001235 aa 2 00000 2351 00 lda pr2|0 001236 aa 000014 6700 04 tsp4 12,ic 001252 STATEMENT 1 ON LINE 224 return; 001237 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 226 too_small: call gripe("underflow"); 001240 aa 776625 2350 04 lda -619,ic 000065 = 165156144145 001241 aa 776625 2360 04 ldq -619,ic 000066 = 162146154157 001242 aa 6 00244 7571 00 staq pr6|164 001243 aa 167000 2350 03 lda 60928,du 001244 aa 6 00246 7551 00 sta pr6|166 001245 aa 000107 3520 04 epp2 71,ic 001354 = 000002000000 001246 aa 2 00000 2351 00 lda pr2|0 001247 aa 000003 6700 04 tsp4 3,ic 001252 STATEMENT 1 ON LINE 228 return; 001250 aa 0 00631 7101 00 tra pr0|409 return_mac STATEMENT 1 ON LINE 240 exit: end; 001251 aa 0 00631 7101 00 tra pr0|409 return_mac BEGIN PROCEDURE gripe ENTRY TO gripe STATEMENT 1 ON LINE 230 gripe: proc(s); 001252 aa 6 00236 6501 00 spri4 pr6|158 001253 aa 6 00240 2521 00 spri2 pr6|160 001254 aa 2 00002 3521 01 epp2 pr2|2,au 001255 aa 6 00242 2521 00 spri2 pr6|162 001256 aa 2 00000 2361 20 ldq pr2|0,* 001257 aa 000002 6040 04 tmi 2,ic 001261 001260 aa 777777 3760 07 anq 262143,dl 001261 aa 0 00250 3761 00 anq pr0|168 = 000077777777 001262 aa 6 00554 7561 00 stq pr6|364 STATEMENT 1 ON LINE 234 if not_active_function then call com_err_(code,op,s,arg); 001263 aa 6 00166 2351 00 lda pr6|118 not_active_function 001264 aa 000034 6000 04 tze 28,ic 001320 001265 aa 6 00202 2361 00 ldq pr6|130 al 001266 aa 526000 2760 03 orq 175104,du 001267 aa 6 00555 7561 00 stq pr6|365 001270 aa 6 00165 3521 00 epp2 pr6|117 code 001271 aa 6 00560 2521 00 spri2 pr6|368 001272 aa 6 00100 3521 00 epp2 pr6|64 op 001273 aa 6 00562 2521 00 spri2 pr6|370 001274 aa 6 00240 3735 20 epp7 pr6|160,* 001275 aa 7 00002 3521 20 epp2 pr7|2,* s 001276 aa 6 00564 2521 00 spri2 pr6|372 001277 aa 6 00176 3521 20 epp2 pr6|126,* arg 001300 aa 6 00566 2521 00 spri2 pr6|374 001301 aa 776513 3520 04 epp2 -693,ic 000014 = 404000000043 001302 aa 6 00570 2521 00 spri2 pr6|376 001303 aa 776510 3520 04 epp2 -696,ic 000013 = 524000000010 001304 aa 6 00572 2521 00 spri2 pr6|378 001305 aa 6 00242 3715 20 epp5 pr6|162,* 001306 aa 5 00000 3521 20 epp2 pr5|0,* 001307 aa 6 00574 2521 00 spri2 pr6|380 001310 aa 6 00555 3521 00 epp2 pr6|365 001311 aa 6 00576 2521 00 spri2 pr6|382 001312 aa 6 00556 6211 00 eax1 pr6|366 001313 aa 020000 4310 07 fld 8192,dl 001314 aa 6 00044 3701 20 epp4 pr6|36,* 001315 la 4 00024 3521 20 epp2 pr4|20,* com_err_ 001316 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc 001317 aa 000033 7100 04 tra 27,ic 001352 STATEMENT 1 ON LINE 235 else call active_fnc_err_(code,op,s,arg); 001320 aa 6 00202 2361 00 ldq pr6|130 al 001321 aa 526000 2760 03 orq 175104,du 001322 aa 6 00555 7561 00 stq pr6|365 001323 aa 6 00165 3521 00 epp2 pr6|117 code 001324 aa 6 00560 2521 00 spri2 pr6|368 001325 aa 6 00100 3521 00 epp2 pr6|64 op 001326 aa 6 00562 2521 00 spri2 pr6|370 001327 aa 6 00240 3735 20 epp7 pr6|160,* 001330 aa 7 00002 3521 20 epp2 pr7|2,* s 001331 aa 6 00564 2521 00 spri2 pr6|372 001332 aa 6 00176 3521 20 epp2 pr6|126,* arg 001333 aa 6 00566 2521 00 spri2 pr6|374 001334 aa 776460 3520 04 epp2 -720,ic 000014 = 404000000043 001335 aa 6 00570 2521 00 spri2 pr6|376 001336 aa 776455 3520 04 epp2 -723,ic 000013 = 524000000010 001337 aa 6 00572 2521 00 spri2 pr6|378 001340 aa 6 00242 3715 20 epp5 pr6|162,* 001341 aa 5 00000 3521 20 epp2 pr5|0,* 001342 aa 6 00574 2521 00 spri2 pr6|380 001343 aa 6 00555 3521 00 epp2 pr6|365 001344 aa 6 00576 2521 00 spri2 pr6|382 001345 aa 6 00556 6211 00 eax1 pr6|366 001346 aa 020000 4310 07 fld 8192,dl 001347 aa 6 00044 3701 20 epp4 pr6|36,* 001350 la 4 00026 3521 20 epp2 pr4|22,* active_fnc_err_ 001351 aa 0 00622 7001 00 tsx0 pr0|402 call_ext_out_desc STATEMENT 1 ON LINE 237 goto exit; 001352 aa 777677 7100 04 tra -65,ic 001251 STATEMENT 1 ON LINE 238 end; END PROCEDURE gripe END PROCEDURE plus ----------------------------------------------------------- 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