COMPILATION LISTING OF SEGMENT linus_builtin_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1112.77_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(90-04-23,Leskiw), approve(90-10-05,MCR8202), 16* audit(90-10-11,Bubric), install(90-10-14,MR12.4-1039): 17* Fixed rounding by changing calls from assign_ to assign_round_. 18* END HISTORY COMMENTS */ 19 20 21 linus_builtin_: 22 proc; 23 24 25 /* DESCRIPTION: 26* 27* This procedure contains entries that implement the LINUS set builtin 28* functions. 29* 30* 31* 32* HISTORY: 33* 34* 77-06-01 J. C. C. Jagernauth: Intially written. 35* 36* 80-01-09 Rickie E. Brinegar: Modified to make use of the 37* mdbm_util_$(complex number)_data_class entry points. 38* 39* 80-02-04 Rickie E. Brinegar: Modified to avoid a zero divide condition in 40* avg_assign. 41* 42* 81-07-10 Rickie E. Brinegar: Modified to allow the use of character 43* strings for avg and sum. This is in accordance with TR 9259. 44* 45* 83-01-25 Dave Schimke: Added code to initialize num_ptrs which is the extent 46* of the arg_list.arg_desc array to fix a subscript range error. 47* 48**/ 49 1 1 /* BEGIN mdbm_arg_list.incl.pl1 -- jaw 5/31/78 */ 1 2 /* the duplicate mrds_arg_list.incl.pl1 was eliminated by Jim Gray, Nov. 1979 */ 1 3 1 4 /* layout of argument list for IDS and DBM entries with options (variable) */ 1 5 1 6 dcl 1 arg_list based (al_ptr), 1 7 2 arg_count fixed bin (17) unal, /* 2 * no. of args. */ 1 8 2 code fixed bin (17) unal, /* 4 => normal, 8 => special */ 1 9 2 desc_count fixed bin (17) unal, /* 2 * no. of descriptors */ 1 10 2 pad fixed bin (17) unal, /* must be 0 */ 1 11 2 arg_des_ptr (num_ptrs) ptr; /* argument/descriptor pointer */ 1 12 1 13 dcl al_ptr ptr; 1 14 dcl num_ptrs fixed bin; 1 15 1 16 /* END mdbm_arg_list.incl.pl1 */ 1 17 50 51 52 dcl 1 arg_descs aligned based (ad_ptr), 53 2 ndescs fixed bin, 54 2 desc (0 refer (arg_descs.ndescs)) bit (36); 55 56 dcl assign_desc bit (36) based (arg_list.arg_des_ptr (2)); 57 dcl rslt_desc bit (36) aligned; /* Output: result descriptor */ 58 59 dcl data_out1 float dec (59) based (arg_list.arg_des_ptr (1)); 60 dcl data_out2 complex float dec (59) based (arg_list.arg_des_ptr (1)); 61 62 dcl data_in1 float dec (59); 63 dcl data_in2 complex float dec (59); 64 65 dcl FD59 bit (36) aligned int static options (constant) init ("100101000000000000000000000000111011"b); 66 /* Float Decimal */ 67 dcl CFD59 bit (36) aligned int static options (constant) init ("100110000000000000000000000000111011"b); 68 /* 69* Complex Float Decimal */ 70 dcl FIB35 bit (36) aligned int static options (constant) init ("100000100000000000000000000000100011"b); 71 72 dcl ( 73 target_typeFD init (20), 74 target_typeCFD init (24) 75 ) fixed bin int static options (constant); 76 77 dcl target_len fixed bin (35) int static options (constant) init (59); 78 79 dcl source_type fixed bin; 80 dcl source_len fixed bin (35); 81 82 dcl count_rslt fixed bin (35) based (arg_list.arg_des_ptr (1)); 83 84 dcl ad_ptr ptr; /* Input: points to input descriptors */ 85 86 dcl count_calc fixed bin (35) int static init (0); 87 dcl set_fn_real_flag fixed bin (2) int static init (0); 88 89 90 dcl data_calc4 float dec (59) int static init (-99999999999999999999999999999999999999999999999999999999); 91 dcl data_const4 float dec (59) int static options (constant) 92 init (-99999999999999999999999999999999999999999999999999999999); 93 94 dcl data_calc1 float dec (59) int static init (0); 95 dcl data_calc2 complex float dec (59) int static init (0); 96 97 dcl data_calc3 float dec (59) int static init (99999999999999999999999999999999999999999999999999999999); 98 dcl data_const3 float dec (59) int static options (constant) init (99999999999999999999999999999999999999999999999999999999); 99 100 dcl cu_$arg_list_ptr entry (ptr); 101 dcl assign_round_ entry (ptr, fixed bin, fixed bin (35), ptr, fixed bin, fixed bin (35)); 102 dcl linus_assign_data entry (bit (36), fixed bin, fixed bin (35)); 103 dcl ( 104 mdbm_util_$complex_data_class, 105 mdbm_util_$number_data_class 106 ) entry (ptr) returns (bit (1)); 107 108 dcl addr builtin; 109 110 return; /* Should never use linus_builtin_ entry */ 111 112 count_calc: 113 entry; /* Calc entry for the count set function */ 114 115 num_ptrs = 0; 116 count_calc = count_calc + 1; /* Perform count */ 117 return; 118 119 120 count_assign: 121 entry; /* Assign entry for the count set function */ 122 123 call cu_$arg_list_ptr (al_ptr); /* Get pointer to argument list */ 124 count_rslt = count_calc; /* Assign result */ 125 return; 126 127 count_init: 128 entry; /* Init for the this use of the count set function */ 129 count_calc = 0; 130 return; 131 132 133 count_info: 134 entry (ad_ptr, rslt_desc); /* Info entry for the count set function */ 135 136 rslt_desc = FIB35; /* Always return a count. */ 137 138 return; 139 140 avg_calc: 141 entry; /* Calc entry for the avg set function */ 142 143 call avg_sum_calc; /* The avg and sum set functions use acommon procedure */ 144 count_calc = count_calc + 1; /* Keep track of number of calls to calculate average value */ 145 return; 146 147 148 avg_assign: 149 entry; /* Assign entry for the avg set function */ 150 151 call cu_$arg_list_ptr (al_ptr); /* Get pointer to argument list */ 152 if set_fn_real_flag = 1 then do; /* Assign real result */ 153 if count_calc = 0 then 154 data_out1 = 0; 155 else data_out1 = data_calc1 / count_calc; 156 end; 157 else do; /* Else assign complex result */ 158 if count_calc = 0 then 159 data_out2 = 0; 160 else data_out2 = data_calc2 / count_calc; 161 end; 162 return; 163 164 avg_init: 165 entry; /* Init for the this use of the avg set function */ 166 count_calc, data_calc1, data_calc2, set_fn_real_flag = 0; 167 return; 168 169 170 avg_info: 171 sum_info: 172 entry (ad_ptr, rslt_desc); /* Info entry for the avg & sum set functions */ 173 174 if arg_descs.ndescs ^= 1 then 175 rslt_desc = "0"b; /* Must be one desriptor */ 176 else if ^mdbm_util_$complex_data_class (addr (arg_descs.desc (1))) then 177 rslt_desc = FD59; /* Result descriptor is Real Float Decimal (59) */ 178 else rslt_desc = CFD59; /* Result descriptor is Complex Float Decimal (59) */ 179 return; 180 181 sum_calc: 182 entry; /* Calc entry for the sum set function */ 183 184 call avg_sum_calc; /* The avg and sum set functions use a common procedure */ 185 return; 186 187 sum_assign: 188 entry; /* Assign entry for the sum set function */ 189 190 call cu_$arg_list_ptr (al_ptr); /* Get pointer to argument list */ 191 if set_fn_real_flag = 1 then 192 data_out1 = data_calc1; /* Assign real result */ 193 else data_out2 = data_calc2; /* Assign complex result */ 194 return; 195 196 sum_init: 197 entry; /* Init for the this use of the sum set function */ 198 data_calc1, data_calc2, set_fn_real_flag = 0; 199 return; 200 201 max_calc: 202 entry; /* Calc entry for the max set function */ 203 204 call cu_$arg_list_ptr (al_ptr); /* Get pointer to argument list */ 205 num_ptrs = arg_list.arg_count; 206 call linus_assign_data (assign_desc, source_type, source_len); 207 call assign_round_ (addr (data_in1), target_typeFD, target_len, arg_list.arg_des_ptr (1), source_type, source_len); 208 if data_calc4 < data_in1 then 209 data_calc4 = data_in1; /* Find max value */ 210 return; 211 212 213 max_assign: 214 entry; /* Assign entry for max set function */ 215 216 call cu_$arg_list_ptr (al_ptr); 217 data_out1 = data_calc4; /* Assign max value */ 218 return; 219 220 max_init: 221 entry; /* Init for the this use of the max set function */ 222 data_calc4 = data_const4; 223 return; 224 225 226 max_info: 227 min_info: 228 entry (ad_ptr, rslt_desc); /* Info entry for the max & min set functions */ 229 230 if arg_descs.ndescs ^= 1 then 231 rslt_desc = "0"b; /* Must be one descriptor. */ 232 else do; 233 if ^mdbm_util_$number_data_class (addr (arg_descs.desc (1))) then 234 rslt_desc = "0"b; /* Type must be arithmetic */ 235 else if ^mdbm_util_$complex_data_class (addr (arg_descs.desc (1))) then 236 rslt_desc = FD59; /* Result descriptor is Real Float Decimal (59) */ 237 else rslt_desc = "0"b; /* Complex Float Decimal is not valid */ 238 end; 239 return; 240 241 min_calc: 242 entry; /* Calc entry for the min set function */ 243 244 call cu_$arg_list_ptr (al_ptr); /* Get pointer to the argument list */ 245 num_ptrs = arg_list.arg_count; 246 call linus_assign_data (assign_desc, source_type, source_len); 247 call assign_round_ (addr (data_in1), target_typeFD, target_len, arg_list.arg_des_ptr (1), source_type, source_len); 248 if data_calc3 > data_in1 then 249 data_calc3 = data_in1; /* Find min value */ 250 return; 251 252 253 min_assign: 254 entry; /* Assign entry for the min set function */ 255 256 call cu_$arg_list_ptr (al_ptr); 257 data_out1 = data_calc3; /* Assign min value */ 258 return; 259 260 min_init: 261 entry; /* Init for this use of the min set function */ 262 data_calc3 = data_const3; 263 return; 264 265 avg_sum_calc: 266 proc; /* Calc procedure for both avg and sum entries. */ 267 call cu_$arg_list_ptr (al_ptr); /* Get pointer to argument list */ 268 num_ptrs = arg_list.arg_count; 269 if set_fn_real_flag = 0 then do; /* First time through? */ 270 if ^mdbm_util_$complex_data_class (arg_list.arg_des_ptr (2)) then 271 set_fn_real_flag = 1; /* Type is real */ 272 else set_fn_real_flag = 2; /* Type is complex */ 273 end; 274 call linus_assign_data (assign_desc, source_type, source_len); 275 if set_fn_real_flag = 1 then do; 276 call assign_round_ (addr (data_in1), target_typeFD, target_len, arg_list.arg_des_ptr (1), source_type, source_len); 277 data_calc1 = data_calc1 + data_in1; /* Sum real values */ 278 end; 279 else do; 280 call assign_round_ (addr (data_in2), target_typeCFD, target_len, arg_list.arg_des_ptr (1), source_type, source_len); 281 data_calc2 = data_calc2 + data_in2; /* Sum complex values */ 282 end; 283 284 end avg_sum_calc; 285 286 287 end linus_builtin_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1112.7 linus_builtin_.pl1 >udd>sm>ds>w>ml>linus_builtin_.pl1 50 1 10/14/83 1709.0 mdbm_arg_list.incl.pl1 >ldd>incl>mdbm_arg_list.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. CFD59 000044 constant bit(36) initial dcl 67 ref 178 FD59 000045 constant bit(36) initial dcl 65 ref 176 235 FIB35 000043 constant bit(36) initial dcl 70 ref 136 ad_ptr parameter pointer dcl 84 ref 133 170 170 174 176 176 226 226 230 233 233 235 235 addr builtin function dcl 108 ref 176 176 207 207 233 233 235 235 247 247 276 276 280 280 al_ptr 000100 automatic pointer dcl 1-13 set ref 123* 124 151* 153 155 158 160 190* 191 193 204* 205 206 207 216* 217 244* 245 246 247 256* 257 267* 268 270 274 276 280 arg_count based fixed bin(17,0) level 2 packed packed unaligned dcl 1-6 ref 205 245 268 arg_des_ptr 2 based pointer array level 2 dcl 1-6 set ref 124 153 155 158 160 191 193 206 207* 217 246 247* 257 270* 274 276* 280* arg_descs based structure level 1 dcl 52 arg_list based structure level 1 unaligned dcl 1-6 assign_desc based bit(36) packed unaligned dcl 56 set ref 206* 246* 274* assign_round_ 000134 constant entry external dcl 101 ref 207 247 276 280 count_calc 000010 internal static fixed bin(35,0) initial dcl 86 set ref 116* 116 124 129* 144* 144 153 155 158 160 166* count_rslt based fixed bin(35,0) dcl 82 set ref 124* cu_$arg_list_ptr 000132 constant entry external dcl 100 ref 123 151 190 204 216 244 256 267 data_calc1 000032 internal static float dec(59) initial dcl 94 set ref 155 166* 191 198* 277* 277 data_calc2 000052 internal static complex float dec(59) initial dcl 95 set ref 160 166* 193 198* 281* 281 data_calc3 000111 internal static float dec(59) initial dcl 97 set ref 248 248* 257 262* data_calc4 000012 internal static float dec(59) initial dcl 90 set ref 208 208* 217 222* data_const3 000000 constant float dec(59) initial dcl 98 ref 262 data_const4 000020 constant float dec(59) initial dcl 91 ref 222 data_in1 000103 automatic float dec(59) dcl 62 set ref 207 207 208 208 247 247 248 248 276 276 277 data_in2 000123 automatic complex float dec(59) dcl 63 set ref 280 280 281 data_out1 based float dec(59) dcl 59 set ref 153* 155* 191* 217* 257* data_out2 based complex float dec(59) dcl 60 set ref 158* 160* 193* desc 1 based bit(36) array level 2 dcl 52 set ref 176 176 233 233 235 235 linus_assign_data 000136 constant entry external dcl 102 ref 206 246 274 mdbm_util_$complex_data_class 000140 constant entry external dcl 103 ref 176 235 270 mdbm_util_$number_data_class 000142 constant entry external dcl 103 ref 233 ndescs based fixed bin(17,0) level 2 dcl 52 ref 174 230 num_ptrs 000102 automatic fixed bin(17,0) dcl 1-14 set ref 115* 205* 245* 268* rslt_desc parameter bit(36) dcl 57 set ref 133 136* 170 170 174* 176* 178* 226 226 230* 233* 235* 237* set_fn_real_flag 000011 internal static fixed bin(2,0) initial dcl 87 set ref 152 166* 191 198* 269 270* 272* 275 source_len 000163 automatic fixed bin(35,0) dcl 80 set ref 206* 207* 246* 247* 274* 276* 280* source_type 000162 automatic fixed bin(17,0) dcl 79 set ref 206* 207* 246* 247* 274* 276* 280* target_len 000040 constant fixed bin(35,0) initial dcl 77 set ref 207* 247* 276* 280* target_typeCFD 000041 constant fixed bin(17,0) initial dcl 72 set ref 280* target_typeFD 000042 constant fixed bin(17,0) initial dcl 72 set ref 207* 247* 276* NAMES DECLARED BY EXPLICIT CONTEXT. avg_assign 000166 constant entry external dcl 148 avg_calc 000151 constant entry external dcl 140 avg_info 000364 constant entry external dcl 170 avg_init 000330 constant entry external dcl 164 avg_sum_calc 001076 constant entry internal dcl 265 ref 143 184 count_assign 000101 constant entry external dcl 120 count_calc 000064 constant entry external dcl 112 count_info 000137 constant entry external dcl 133 count_init 000123 constant entry external dcl 127 linus_builtin_ 000055 constant entry external dcl 21 max_assign 000610 constant entry external dcl 213 max_calc 000517 constant entry external dcl 201 max_info 000660 constant entry external dcl 226 max_init 000634 constant entry external dcl 220 min_assign 001040 constant entry external dcl 253 min_calc 000747 constant entry external dcl 241 min_info 000650 constant entry external dcl 226 min_init 001064 constant entry external dcl 260 sum_assign 000440 constant entry external dcl 187 sum_calc 000430 constant entry external dcl 181 sum_info 000354 constant entry external dcl 170 sum_init 000475 constant entry external dcl 196 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1544 1712 1244 1554 Length 2162 1244 146 233 300 122 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_builtin_ 198 external procedure is an external procedure. avg_sum_calc internal procedure shares stack frame of external procedure linus_builtin_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 count_calc linus_builtin_ 000011 set_fn_real_flag linus_builtin_ 000012 data_calc4 linus_builtin_ 000032 data_calc1 linus_builtin_ 000052 data_calc2 linus_builtin_ 000111 data_calc3 linus_builtin_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_builtin_ 000100 al_ptr linus_builtin_ 000102 num_ptrs linus_builtin_ 000103 data_in1 linus_builtin_ 000123 data_in2 linus_builtin_ 000162 source_type linus_builtin_ 000163 source_len linus_builtin_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 call_ext_out return_mac ext_entry real_to_real_round_ any_to_any_round_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_round_ complex_binary_op_ cu_$arg_list_ptr linus_assign_data mdbm_util_$complex_data_class mdbm_util_$number_data_class NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 21 000054 110 000062 112 000063 115 000071 116 000072 117 000077 120 000100 123 000106 124 000115 125 000121 127 000122 129 000130 130 000132 133 000133 136 000144 138 000147 140 000150 143 000156 144 000157 145 000164 148 000165 151 000173 152 000202 153 000206 155 000216 156 000244 158 000245 160 000260 162 000326 164 000327 166 000335 167 000351 170 000352 174 000371 176 000400 178 000423 179 000426 181 000427 184 000435 185 000436 187 000437 190 000445 191 000454 193 000466 194 000473 196 000474 198 000502 199 000515 201 000516 204 000524 205 000533 206 000536 207 000552 208 000576 210 000606 213 000607 216 000615 217 000624 218 000632 220 000633 222 000641 223 000645 226 000646 230 000665 233 000674 235 000716 237 000743 239 000745 241 000746 244 000754 245 000763 246 000766 247 001002 248 001026 250 001036 253 001037 256 001045 257 001054 258 001062 260 001063 262 001071 263 001075 265 001076 267 001077 268 001106 269 001111 270 001114 272 001134 274 001137 275 001152 276 001156 277 001201 278 001205 280 001206 281 001231 284 001240 ----------------------------------------------------------- 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