COMPILATION LISTING OF SEGMENT mu_break_structure Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-05-05_1829.71_Fri_mdt Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 /* HISTORY: 19* 20* Originally written by J. A. Weeldreyer - - December 1975 21* 22* Completely rewritten by Jim Gray - - January 1980, to 23* 1) correct handling of arrays 24* 2) generalize the structure handling to any number of levels 25* 3) put the data length/alignment routines in common code 26* 4) redo the handling of settting/getting bit offsets in pointers 27* 5) make a call to a common valid_data_type routine so packed 28* . decimal cound be handled 29* 30* 81-10-28 Davids: modified to call bit_offset_ and set_bit_offset_ 31* (new system routines that came out with MR9.0) instead of 32* mu_pointer_bit_offset$get and $set. Also changed to call 33* set_bit_offset_ only if needed (i.e. if there are pad bits before 34* the next data bit, i.e. needed_bits = 0) instead of of always 35* calling it. 36* 37* 83-04-11 Davids: Changed calls to the system procedure bit_offset_ 38* and set_bit_offset_ to references to the new pl1 builtins bitno and 39* setbitno. 40**/ 41 42 mu_break_structure: break_structure: procedure (area_ptr, input_data_ptr, input_desc_ptr, 43 arg_array_ptr, argument_count, error_code); 44 45 /* DESCRIPTION: 46* 47* the purpose of this routine is to make it possible for the user 48* to specify a structure with all attributes contained in that 49* structure, when doing a store/retrieve/etc., rather than having 50* to give individual variables for each attribute in the relation. 51* the function of this routine is to take the structure declaration 52* argument list of a data pointer and a descriptor pointer, and 53* convert them into an equivalent list of data/descriptor pointers, 54* like in an argument list, with individual structure elements 55* described by each entry in this list, so that it looks like the 56* user actually did give individual variables in his entry 57* options(variable) call to store, retrieve, etc. an area of 58* sufficient size to hold the new argument list to be built must 59* have it's pointer passed in, and a pointer to the arg_list is 60* returned, along with the total argument count. SEE PARAMETERS ON 61* NEXT PAGE. 62* 63* Note 1 difference, data pointer to varying data types point to 64* the length word instead of the first word of data. 65**/ 66 67 /* PARAMETERS: 68* 69* area_ptr - - (input) pointer, points to an area of sufficient 70* size to hold the new argument list, appoxiamately 2 * number of 71* individual variables words of storage + 4 words of overhead. 72* 73* input_data_ptr - - (input) pointer, points the the structures 74* data, this is taken from the original arg_list of the entry 75* options(variable) callee 76* 77* input_desc_ptr - - (input) pointer, points to the structures 78* descriptor, taken from the original arg_list as above. 79* 80* arg_array_ptr - - (output) pointer, points to the array portion 81* of the newly built argument list that contains the array of data 82* and descriptor pointers. 83* 84* argument_count - - (output) fixed bin, the number of data items 85* decribed by the newly built argument list. 86* 87* error_code - - (output) fixed bin(35), 0 unless an unsupported 88* data type was encountered. 89**/ 90 91 /* initialize */ 92 93 error_code = 0; 94 95 last_data_ptr = input_data_ptr; 96 last_desc_ptr = input_desc_ptr; 97 98 /* get space for the new argument list */ 99 100 argument_count = get_arg_count (); 101 102 num_ptrs = 2 * argument_count; 103 104 allocate arg_array set (arg_array_ptr) in (work_area); 105 106 al_ptr = addrel (arg_array_ptr, -2); /* use arg_list overlay for convenience */ 107 108 /* fill in the descriptor and data pointers in the new argument list */ 109 110 arg_list_index = 1; 111 112 call fill_arg_list (); 113 114 /* the argument list header would look like this, 115* if we were going to fill it in, but it is unused 116* and in fact would destory block headers in the work area if used 117* 118* arg_list.arg_count, arg_list.desc_count = 2 * argument_count ; 119* arg_list.code = 4 ; arg_list.pad = 0 ; /* normal arg list */ 120 121 122 /* give the user back the broken down argument list we built 123* pointed to by arg_array_ptr, with size of argument_count * 2 */ 124 125 return; 126 127 fill_arg_list: procedure (); 128 129 /* this is a recursive procedure to procede through the list 130* of descriptors describing, the input structure, and to fill in 131* an argument list with data and descriptor pointers, that is 132* equivalent to the user making the call, not with a structure name, 133* but with individual structure qualified references. */ 134 135 number_of_elements = fixed (string (last_desc_ptr -> descriptor.size)); 136 last_desc_ptr = addrel (last_desc_ptr, 1); /* skip over structure descriptor to first element descriptor */ 137 element_index = 1; 138 139 /* go through all elements in this structure */ 140 141 do while (element_index <= number_of_elements & error_code = 0); 142 143 desc_ptr = last_desc_ptr; 144 145 /* exit if unsupported data type found */ 146 147 if ^mu_valid_data_type$structures_arrays_ok (desc_ptr -> descriptor_overlay) then 148 error_code = mrds_error_$invalid_dm_descriptor; 149 else do; 150 151 /* make a recursive call if this is a lower level structure */ 152 153 if descriptor.type = STRUCTURE then 154 call fill_arg_list (); 155 else do; 156 157 /* set the position of the data pointer to correctly reflect 158* the required alignment on bit/char/word boundary according to it's type */ 159 160 bit_offset = bitno (last_data_ptr); 161 needed_bits = mu_data_align (desc_ptr, bit_offset); 162 if needed_bits = 0 163 then next_bit_offset = bit_offset; 164 else do; 165 next_bit_offset = bit_offset + needed_bits; 166 last_data_ptr = setbitno (last_data_ptr, next_bit_offset); 167 end; 168 169 /* fill in the next slot in the new argument list we are building, 170* with the descriptor and data pointers for this datum, 171* then set up the index for the next slot in the list */ 172 173 arg_list.arg_des_ptr (arg_list_index) = last_data_ptr; 174 arg_list.arg_des_ptr (arg_list_index + argument_count) = desc_ptr; 175 arg_list_index = arg_list_index + 1; 176 177 /* compute the space needed for this data, and advance the pointer 178* to the current end of data, so we can do proper alignment next time */ 179 180 array_elements = get_array_size (); 181 data_length = mu_data_length (desc_ptr -> descriptor_overlay); 182 183 if array_elements = 0 then 184 new_offset = next_bit_offset + data_length; 185 else do; 186 align_bits = mu_data_align (desc_ptr, next_bit_offset + data_length); 187 new_offset = next_bit_offset + data_length + 188 ((array_elements - 1) * (data_length + align_bits)); 189 end; 190 191 last_data_ptr = setbitno (last_data_ptr, new_offset); 192 193 /* advance to next descriptor for next structure element, 194* this will require skipping bounds info, if this was an array */ 195 196 last_desc_ptr = addrel (last_desc_ptr, 1 + (fixed (descriptor.number_dims) * 3)); 197 198 end; 199 200 /* go on to next structure element */ 201 202 element_index = element_index + 1; 203 204 end; 205 206 end; 207 208 209 210 declare element_index fixed bin; /* number of structure element under consideration */ 211 declare number_of_elements fixed bin (35); /* number of elements in this structure */ 212 213 end; 214 215 get_arg_count: procedure () returns (fixed bin (35)); 216 217 /* routine to calculate the total number of data items that 218* are include in all levels of a structure declaration 219* this requires an additional recursive pass through 220* the structure declaration, in order to count all 221* levels of structure elements that will occupy an arg_list slot */ 222 223 number_of_args = 0; 224 desc_ptr = last_desc_ptr; 225 226 call count_elements (); 227 228 return (number_of_args); 229 230 231 232 declare number_of_args fixed bin (35); /* number of entries needed in new arg list */ 233 234 count_elements: procedure (); 235 236 /* this is a recursive routine, that will increment the 237* number of arg_list slots needed, once for every non-structure 238* declaration element in all levels of this structure descriptor */ 239 240 structure_size = fixed (string (descriptor.size)); 241 desc_ptr = addrel (desc_ptr, 1); /* skip structure descriptor */ 242 element_count = 1; 243 244 /* count all non-structure declarations, making recursive calls 245* for any lower level structures. note that an array counts only 246* as one entry needed in the arg_list */ 247 248 do while (element_count <= structure_size); 249 250 if descriptor.type = STRUCTURE then 251 call count_elements (); 252 else do; 253 254 /* non-structure element, count it, and advance to next descriptor */ 255 256 number_of_args = number_of_args + 1; 257 258 desc_ptr = addrel (desc_ptr, 1 + (fixed (descriptor.number_dims) * 3)); 259 260 end; 261 262 /* advance to next element in structure */ 263 264 element_count = element_count + 1; 265 266 end; 267 268 269 270 declare element_count fixed bin (35); /* current position in structure descriptor */ 271 declare structure_size fixed bin (35); /* total number of structure elements */ 272 273 end; 274 275 end; 276 277 get_array_size: procedure () returns (fixed bin (35)); 278 279 /* routine to find the total number of elements involved in an array */ 280 281 num_dims = fixed (descriptor.number_dims); 282 283 if num_dims = 0 then 284 element_count = 0; /* not an array, scalar variable */ 285 else do; 286 287 element_count = 1; /* init to multiplicative identity */ 288 289 do i = 1 to num_dims; 290 291 element_count = element_count * ((upper_bound (i) - lower_bound (i) + 1)); 292 293 end; 294 295 end; 296 297 return (element_count); 298 299 300 301 declare element_count fixed bin (35); /* current count of number of array elements */ 302 303 end; 304 305 declare input_data_ptr ptr; /* input pointer to structure data */ 306 declare input_desc_ptr ptr; /* input pointer to structure descriptor */ 307 declare arg_list_index fixed bin; /* index into array of data/desc ptrs in arg list being built */ 308 declare area_ptr ptr; /* pointer to area where arg list is allocated */ 309 declare work_area area based (area_ptr); /* area for arg list to be built in */ 310 declare new_offset fixed bin (35); /* updated offset for end of data pointer */ 311 declare align_bits fixed bin; /* needed padding for array data elements */ 312 declare mu_data_length entry (bit (36)) returns (fixed bin (35)); /* calculates storage bits */ 313 declare data_length fixed bin (35); /* required storage bit length */ 314 declare array_elements fixed bin (35); /* number of elements in an array */ 315 declare needed_bits fixed bin; /* number of bits to get proper alignment */ 316 declare mu_data_align entry (ptr, fixed bin (35)) returns (fixed bin); /* gets padding for proper alignment */ 317 declare bit_offset fixed bin (35); /* true bit offset of data */ 318 declare STRUCTURE fixed bin int static options (constant) init (17); /* data type for structure */ 319 declare mrds_error_$invalid_dm_descriptor fixed bin (35) ext; /* unsupported data type */ 320 declare mu_valid_data_type$structures_arrays_ok entry (bit (36)) returns (bit (1) aligned); /* decides if type supported */ 321 declare error_code fixed bin (35); /* error status encoding */ 322 declare last_desc_ptr ptr; /* pointer to last descriptor pointer looked at */ 323 declare last_data_ptr ptr; /* last pointer to end of data */ 324 declare argument_count fixed bin; /* number of data items in structure */ 325 declare arg_array_ptr ptr; /* points to start of array of data/desc pointers */ 326 declare descriptor_overlay bit (36) unal based; /* overlay for descriptor */ 327 declare i fixed bin; /* dimension loop index */ 328 declare next_bit_offset fixed bin (35); /* bit offset after data alignment */ 329 declare arg_array (num_ptrs) ptr based (arg_array_ptr); /* array of desc/data ptrs to be passed back */ 330 dcl (bitno, setbitno, addrel, fixed, string) builtin; 331 1 1 /* BEGIN mdbm_descriptor.incl.pl1 -- jaw 5/31/78 */ 1 2 /* modified by Jim Gray - - Nov. 1979, to change type from fixed bin(5) to 1 3* unsigned fixed bin(6), so new packed decimal data types could be handled. 1 4* also the duplicate mrds_descriptor.incl.pl1 was eliminated. */ 1 5 1 6 dcl 1 descriptor based (desc_ptr), /* map of Multics descriptor */ 1 7 2 version bit (1) unal, /* DBM handles vers. 1 only */ 1 8 2 type unsigned fixed bin (6) unal, /* data type */ 1 9 2 packed bit (1) unal, /* on if data item is packed */ 1 10 2 number_dims bit (4) unal, /* dimensions */ 1 11 2 size, /* size for string data */ 1 12 3 scale bit (12) unal, /* scale for num. data */ 1 13 3 precision bit (12) unal, /* prec. for num. data */ 1 14 2 array_info (num_dims), 1 15 3 lower_bound fixed bin (35), /* lower bound of dimension */ 1 16 3 upper_bound fixed bin (35), /* upper bound of dimension */ 1 17 3 multiplier fixed bin (35); /* element separation */ 1 18 1 19 dcl desc_ptr ptr; 1 20 dcl num_dims fixed bin init (0) ; /* more useful form of number_dims */ 1 21 1 22 /* END mdbm_descriptor.incl.pl1 */ 1 23 1 24 332 333 2 1 /* BEGIN mdbm_arg_list.incl.pl1 -- jaw 5/31/78 */ 2 2 /* the duplicate mrds_arg_list.incl.pl1 was eliminated by Jim Gray, Nov. 1979 */ 2 3 2 4 /* layout of argument list for IDS and DBM entries with options (variable) */ 2 5 2 6 dcl 1 arg_list based (al_ptr), 2 7 2 arg_count fixed bin (17) unal, /* 2 * no. of args. */ 2 8 2 code fixed bin (17) unal, /* 4 => normal, 8 => special */ 2 9 2 desc_count fixed bin (17) unal, /* 2 * no. of descriptors */ 2 10 2 pad fixed bin (17) unal, /* must be 0 */ 2 11 2 arg_des_ptr (num_ptrs) ptr; /* argument/descriptor pointer */ 2 12 2 13 dcl al_ptr ptr; 2 14 dcl num_ptrs fixed bin; 2 15 2 16 /* END mdbm_arg_list.incl.pl1 */ 2 17 334 335 336 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/05/00 1829.7 mu_break_structure.pl1 >udd>sm>ds>w>ml>mu_break_structure.pl1 332 1 10/14/83 1708.6 mdbm_descriptor.incl.pl1 >ldd>incl>mdbm_descriptor.incl.pl1 334 2 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. STRUCTURE constant fixed bin(17,0) initial dcl 318 ref 153 250 addrel builtin function dcl 330 ref 106 136 196 241 258 al_ptr 000122 automatic pointer dcl 2-13 set ref 106* 173 174 align_bits 000102 automatic fixed bin(17,0) dcl 311 set ref 186* 187 area_ptr parameter pointer dcl 308 ref 42 42 104 arg_array based pointer array dcl 329 ref 104 arg_array_ptr parameter pointer dcl 325 set ref 42 42 104* 106 arg_des_ptr 2 based pointer array level 2 dcl 2-6 set ref 173* 174* arg_list based structure level 1 unaligned dcl 2-6 arg_list_index 000100 automatic fixed bin(17,0) dcl 307 set ref 110* 173 174 175* 175 argument_count parameter fixed bin(17,0) dcl 324 set ref 42 42 100* 102 174 array_elements 000104 automatic fixed bin(35,0) dcl 314 set ref 180* 183 187 array_info 1 based structure array level 2 unaligned dcl 1-6 bit_offset 000106 automatic fixed bin(35,0) dcl 317 set ref 160* 161* 162 165 bitno builtin function dcl 330 ref 160 data_length 000103 automatic fixed bin(35,0) dcl 313 set ref 181* 183 186 187 187 desc_ptr 000116 automatic pointer dcl 1-19 set ref 143* 147 153 161* 174 181 186* 196 224* 240 241* 241 250 258* 258 258 281 291 291 descriptor based structure level 1 unaligned dcl 1-6 descriptor_overlay based bit(36) packed unaligned dcl 326 set ref 147* 181* element_count 000100 automatic fixed bin(35,0) dcl 270 in procedure "count_elements" set ref 242* 248 264* 264 element_count 000110 automatic fixed bin(35,0) dcl 301 in procedure "get_array_size" set ref 283* 287* 291* 291 297 element_index 000100 automatic fixed bin(17,0) dcl 210 set ref 137* 141 202* 202 error_code parameter fixed bin(35,0) dcl 321 set ref 42 42 93* 141 147* fixed builtin function dcl 330 ref 135 196 240 258 281 i 000114 automatic fixed bin(17,0) dcl 327 set ref 289* 291 291* input_data_ptr parameter pointer dcl 305 ref 42 42 95 input_desc_ptr parameter pointer dcl 306 ref 42 42 96 last_data_ptr 000112 automatic pointer dcl 323 set ref 95* 160 166* 166 173 191* 191 last_desc_ptr 000110 automatic pointer dcl 322 set ref 96* 135 136* 136 143 196* 196 224 lower_bound 1 based fixed bin(35,0) array level 3 dcl 1-6 ref 291 mrds_error_$invalid_dm_descriptor 000014 external static fixed bin(35,0) dcl 319 ref 147 mu_data_align 000012 constant entry external dcl 316 ref 161 186 mu_data_length 000010 constant entry external dcl 312 ref 181 mu_valid_data_type$structures_arrays_ok 000016 constant entry external dcl 320 ref 147 needed_bits 000105 automatic fixed bin(17,0) dcl 315 set ref 161* 162 165 new_offset 000101 automatic fixed bin(35,0) dcl 310 set ref 183* 187* 191 next_bit_offset 000115 automatic fixed bin(35,0) dcl 328 set ref 162* 165* 166 183 186 187 num_dims 000120 automatic fixed bin(17,0) initial dcl 1-20 set ref 1-20* 281* 283 289 num_ptrs 000124 automatic fixed bin(17,0) dcl 2-14 set ref 102* 104 number_dims 0(08) based bit(4) level 2 packed packed unaligned dcl 1-6 ref 196 258 281 number_of_args 000134 automatic fixed bin(35,0) dcl 232 set ref 223* 228 256* 256 number_of_elements 000101 automatic fixed bin(35,0) dcl 211 set ref 135* 141 setbitno builtin function dcl 330 ref 166 191 size 0(12) based structure level 2 packed packed unaligned dcl 1-6 ref 135 240 string builtin function dcl 330 ref 135 240 structure_size 000101 automatic fixed bin(35,0) dcl 271 set ref 240* 248 type 0(01) based fixed bin(6,0) level 2 packed packed unsigned unaligned dcl 1-6 ref 153 250 upper_bound 2 based fixed bin(35,0) array level 3 dcl 1-6 ref 291 work_area based area(1024) dcl 309 ref 104 NAMES DECLARED BY EXPLICIT CONTEXT. break_structure 000016 constant entry external dcl 42 count_elements 000374 constant entry internal dcl 234 ref 226 250 fill_arg_list 000103 constant entry internal dcl 127 ref 112 153 get_arg_count 000356 constant entry internal dcl 215 ref 100 get_array_size 000456 constant entry internal dcl 277 ref 180 mu_break_structure 000027 constant entry external dcl 42 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 654 674 530 664 Length 1104 530 20 173 123 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME break_structure 102 external procedure is an external procedure. fill_arg_list 96 internal procedure calls itself recursively. get_arg_count internal procedure shares stack frame of external procedure break_structure. count_elements 68 internal procedure calls itself recursively. get_array_size internal procedure shares stack frame of internal procedure fill_arg_list. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME break_structure 000100 arg_list_index break_structure 000101 new_offset break_structure 000102 align_bits break_structure 000103 data_length break_structure 000104 array_elements break_structure 000105 needed_bits break_structure 000106 bit_offset break_structure 000110 last_desc_ptr break_structure 000112 last_data_ptr break_structure 000114 i break_structure 000115 next_bit_offset break_structure 000116 desc_ptr break_structure 000120 num_dims break_structure 000122 al_ptr break_structure 000124 num_ptrs break_structure 000134 number_of_args get_arg_count count_elements 000100 element_count count_elements 000101 structure_size count_elements fill_arg_list 000100 element_index fill_arg_list 000101 number_of_elements fill_arg_list 000110 element_count get_array_size THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out call_int_this call_int_other return_mac mpfx2 mpfx3 ext_entry int_entry op_alloc_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. mu_data_align mu_data_length mu_valid_data_type$structures_arrays_ok THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mrds_error_$invalid_dm_descriptor LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1 20 000005 42 000010 93 000035 95 000037 96 000042 100 000045 102 000056 104 000060 106 000071 110 000073 112 000075 125 000101 127 000102 135 000110 136 000114 137 000117 141 000121 143 000131 147 000133 153 000155 160 000171 161 000201 162 000214 165 000222 166 000226 173 000231 174 000235 175 000243 180 000244 181 000252 183 000264 186 000274 187 000313 191 000335 196 000340 202 000353 206 000354 213 000355 215 000356 223 000360 224 000361 226 000363 228 000367 234 000373 240 000401 241 000405 242 000410 248 000412 250 000415 256 000431 258 000435 264 000450 266 000454 273 000455 277 000456 281 000460 283 000465 287 000471 289 000473 291 000504 293 000522 297 000524 ----------------------------------------------------------- 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