COMPILATION LISTING OF SEGMENT dm_vu_merge_tva Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/05/85 0851.0 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* *********************************************************** */ 6 7 /* DESCRIPTION 8* 9* This routine takes a typed_vector_array and creates a new 10* typed_vector_array using using the caller provided id_list. 11* The extent of the new dimension_table will 12* be p_number_of_dimensions. This argument may be used to create "null" 13* entries at the end of the dimension_table for later use. If more 14* dimension ids are suplied than the requested number_of_dimensions or 15* the extent of the old dimension_table, the remaining dimension_ids are 16* ignored. 17**/ 18 19 /* HISTORY: 20* 21*Written by Matthew Pierret 05/06/82. 22*Modified: 23*09/23/82 by Matthew Pierret: Changed to use id_list instead of *-extent 24* p_dimension_id array. 25*12/20/84 by Lindsey L. Spratt: Moved the proc stmt to standard location. 26* Updated DESCRIPTION, standardized the HISTORY section. Changed 27* null_info complaint to use error_table_$null_info_ptr and to be 28* specific about which pointer is null. Added cleanup handler, 29* ERROR_FINISH (which frees the tva), and ERROR_RETURN. Updated the 30* sub_err_ calling sequence. Commented the use of the (nosubrg) 31* prefix. Fixed CHECK_VERSION proc to have the cv_ prefix on its 32* variables. 33**/ 34 35 /* format: style2,ind3 */ 36 dm_vu_merge_tva: 37 proc (p_work_area_ptr, p_number_of_dimensions, p_id_list_ptr, p_input_typed_vector_array_ptr, 38 p_output_typed_vector_array_ptr, p_code); 39 40 /* START OF DECLARATIONS */ 41 /* Parameter */ 42 43 dcl p_work_area_ptr ptr; 44 dcl p_number_of_dimensions fixed bin (17); 45 dcl p_id_list_ptr ptr; 46 dcl p_input_typed_vector_array_ptr 47 ptr; 48 dcl p_output_typed_vector_array_ptr 49 ptr; 50 dcl p_code fixed bin (35); 51 52 /* Automatic */ 53 54 dcl accept_all_dimensions bit (1) aligned init ("0"b); 55 dcl dimension_idx fixed bin; 56 dcl input_typed_vector_array_ptr 57 ptr; 58 dcl work_area_ptr ptr; 59 60 /* Based */ 61 62 /* Builtin */ 63 64 dcl (hbound, null, unspec) builtin; 65 66 /* Condition */ 67 68 dcl cleanup condition; 69 70 /* Constant */ 71 72 dcl myname init ("dm_vu_merge_tva") char (32) varying; 73 74 /* Entry */ 75 76 dcl dm_vector_util_$init_typed_vector_array 77 entry options (variable); 78 dcl sub_err_ entry options (variable); 79 80 /* External */ 81 82 dcl error_table_$null_info_ptr 83 ext fixed bin (35); 84 dcl error_table_$unimplemented_version 85 ext fixed bin (35); 86 87 /* END OF DECLARATIONS */ 88 89 typed_vector_array_ptr = null; 90 p_code = 0; 91 work_area_ptr = p_work_area_ptr; 92 input_typed_vector_array_ptr = p_input_typed_vector_array_ptr; 93 94 on cleanup call ERROR_FINISH (); 95 96 if input_typed_vector_array_ptr = null | work_area_ptr = null 97 then call sub_err_ (error_table_$null_info_ptr, myname, ACTION_CANT_RESTART, null, 0, 98 "^/A null value was provided for^[ the work_area_ptr^;^]^[ and also^;^]^[ the input_typed_vector_array_ptr^;^]." 99 , (work_area_ptr = null), (work_area_ptr = null & input_typed_vector_array_ptr = null), 100 (input_typed_vector_array_ptr = null)); 101 102 if p_id_list_ptr = null 103 then accept_all_dimensions = "1"b; 104 else 105 do; 106 id_list_ptr = p_id_list_ptr; 107 call CHECK_VERSION ((id_list.version), (ID_LIST_VERSION_1), "id_list"); 108 end; 109 110 call dm_vector_util_$init_typed_vector_array (work_area_ptr, 0, p_number_of_dimensions, 111 input_typed_vector_array_ptr -> typed_vector_array.maximum_dimension_name_length, typed_vector_array_ptr, 112 p_code); 113 if p_code ^= 0 114 then call ERROR_RETURN (p_code); 115 116 unspec (typed_vector_array.dimension_table) = ""b; 117 118 /* The (nosubrg) prefix is used below to avoid a compiler bug in the 119*subscriptrange check, when checking an assignment of a single array element 120*between different based versions of the same structure. 121*(The check assumes the two version must have the same bounds.) 122**/ 123 124 if accept_all_dimensions 125 then 126 do dimension_idx = 1 to input_typed_vector_array_ptr -> typed_vector_array.number_of_dimensions; 127 (nosubrg): 128 typed_vector_array.dimension_table (dimension_idx) = 129 input_typed_vector_array_ptr -> typed_vector_array.dimension_table (dimension_idx); 130 end; 131 else 132 do dimension_idx = 1 to hbound (id_list.id, 1) 133 while (dimension_idx <= input_typed_vector_array_ptr -> typed_vector_array.number_of_dimensions); 134 (nosubrg): 135 typed_vector_array.dimension_table (dimension_idx) = 136 input_typed_vector_array_ptr -> typed_vector_array.dimension_table (id_list.id (dimension_idx)); 137 end; 138 139 p_output_typed_vector_array_ptr = typed_vector_array_ptr; 140 141 MAIN_RETURN: 142 return; 143 144 145 ERROR_RETURN: 146 proc (er_p_code); 147 dcl er_p_code fixed bin (35) parm; 148 call ERROR_FINISH (); 149 p_code = er_p_code; 150 goto MAIN_RETURN; 151 end ERROR_RETURN; 152 153 154 ERROR_FINISH: 155 proc (); 156 if typed_vector_array_ptr ^= null 157 then free typed_vector_array; 158 end ERROR_FINISH; 159 160 161 CHECK_VERSION: 162 proc (cv_p_received_version, cv_p_expected_version, cv_p_structure_name); 163 164 dcl cv_p_received_version fixed bin (35); 165 dcl cv_p_expected_version fixed bin (35); 166 dcl cv_p_structure_name char (*); 167 168 if cv_p_received_version ^= cv_p_expected_version 169 then call sub_err_ (error_table_$unimplemented_version, myname, ACTION_CANT_RESTART, null, 0, 170 "^/Expected version ^d of the ^a structure. 171 Received version ^d, instead.", cv_p_expected_version, cv_p_structure_name, cv_p_received_version); 172 173 end CHECK_VERSION; 174 1 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 1 2 /* format: style3 */ 1 3 1 4 /* These constants are to be used for the flags argument of sub_err_ */ 1 5 /* They are just "string (condition_info_header.action_flags)" */ 1 6 1 7 declare ( 1 8 ACTION_CAN_RESTART init (""b), 1 9 ACTION_CANT_RESTART init ("1"b), 1 10 ACTION_DEFAULT_RESTART 1 11 init ("01"b), 1 12 ACTION_QUIET_RESTART 1 13 init ("001"b), 1 14 ACTION_SUPPORT_SIGNAL 1 15 init ("0001"b) 1 16 ) bit (36) aligned internal static options (constant); 1 17 1 18 /* End include file */ 175 176 2 1 /* *********************************************************** 2 2* * * 2 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 2 4* * * 2 5* *********************************************************** */ 2 6 /* BEGIN INCLUDE FILE vu_typed_vector_array.incl.pl1 */ 2 7 2 8 /* Written by Lindsey Spratt, 03/04/82. 2 9*Modified: 2 10*06/23/82 by Lindsey Spratt: Changed to version 2. The cv entry declarations 2 11* were altered. cv_to_typed now takes ptr to the descriptor, ptr to 2 12* the print_vector value (char varying), ptr to the typed_vector 2 13* value location, and a code. cv_to_print now takes ptr to the 2 14* descriptor, ptr to the typed_vector value, the print_vector value 2 15* (char(*) varying), the maximum allowed length for the print_vector 2 16* value, a temp_seg to put the value in if its to big to fit into 2 17* the print_vector, and a code. 2 18**/ 2 19 2 20 /* format: style2,ind3 */ 2 21 dcl 1 typed_vector_array based (typed_vector_array_ptr) aligned, 2 22 2 version fixed bin (35), 2 23 2 number_of_dimensions 2 24 fixed bin (17), 2 25 2 number_of_vectors fixed bin (17), 2 26 2 number_of_vector_slots 2 27 fixed bin (17), 2 28 2 maximum_dimension_name_length 2 29 fixed bin (17), 2 30 2 dimension_table (tva_number_of_dimensions refer (typed_vector_array.number_of_dimensions)), 2 31 3 name char (tva_maximum_dimension_name_length 2 32 refer (typed_vector_array.maximum_dimension_name_length)) varying, 2 33 3 descriptor_ptr ptr, /* call cv_to_print (descriptor_ptr, typed_value_ptr, */ 2 34 /* temp_seg_ptr, max_length_for_print_value, */ 2 35 /* print_value, code) */ 2 36 3 cv_to_print entry (ptr, ptr, ptr, fixed bin (35), char (*) varying, fixed bin (35)), 2 37 /* call cv_to_typed (descriptor_ptr, area_ptr, */ 2 38 /* print_value_ptr, typed_value_ptr, code) */ 2 39 3 cv_to_typed entry (ptr, ptr, ptr, ptr, fixed bin (35)), 2 40 2 vector_slot (tva_number_of_vector_slots refer (typed_vector_array.number_of_vector_slots)) 2 41 pointer; 2 42 2 43 dcl typed_vector_array_ptr ptr; 2 44 dcl tva_number_of_vector_slots 2 45 fixed bin; 2 46 dcl tva_number_of_dimensions 2 47 fixed bin; 2 48 dcl tva_maximum_dimension_name_length 2 49 fixed bin; 2 50 dcl TYPED_VECTOR_ARRAY_VERSION_2 2 51 fixed bin (35) int static options (constant) init (2); 2 52 2 53 /* END INCLUDE FILE vu_typed_vector_array.incl.pl1 */ 177 178 3 1 /* BEGIN INCLUDE FILE - dm_id_list.incl.pl1 */ 3 2 3 3 /* DESCRIPTION 3 4* The id_list structure is used to identify attributes, fields and 3 5* dimensions by various modules of the Data Management System. 3 6**/ 3 7 3 8 /* HISTORY: 3 9*Written by Matthew Pierret, '82. 3 10*Modified: 3 11*08/17/83 by Matthew Pierret: Made version constant 'internal static options 3 12* (constant)' and to initialize automatic variables. 3 13**/ 3 14 3 15 /* format: style2,ind3 */ 3 16 dcl 1 id_list aligned based (id_list_ptr), 3 17 2 version fixed bin (35), 3 18 2 number_of_ids fixed bin (17), 3 19 2 id (il_number_of_ids refer (id_list.number_of_ids)) fixed bin (17); 3 20 3 21 dcl id_list_ptr ptr init (null); 3 22 dcl il_number_of_ids fixed bin (17) init (-1); 3 23 dcl ID_LIST_VERSION_1 fixed bin (17) init (1) internal static options (constant); 3 24 3 25 /* END INCLUDE FILE - dm_id_list.incl.pl1 */ 179 180 181 end dm_vu_merge_tva; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/05/85 0756.0 dm_vu_merge_tva.pl1 >spec>on>7138.pbf>dm_vu_merge_tva.pl1 175 1 04/16/82 0958.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.incl.pl1 177 2 10/14/83 1609.1 vu_typed_vector_array.incl.pl1 >ldd>include>vu_typed_vector_array.incl.pl1 179 3 10/14/83 1609.1 dm_id_list.incl.pl1 >ldd>include>dm_id_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. ACTION_CANT_RESTART 000003 constant bit(36) initial dcl 1-7 set ref 96* 168* ID_LIST_VERSION_1 constant fixed bin(17,0) initial dcl 3-23 ref 107 accept_all_dimensions 000100 automatic bit(1) initial dcl 54 set ref 54* 102* 124 cleanup 000106 stack reference condition dcl 68 ref 94 cv_p_expected_version parameter fixed bin(35,0) dcl 165 set ref 161 168 168* cv_p_received_version parameter fixed bin(35,0) dcl 164 set ref 161 168 168* cv_p_structure_name parameter char unaligned dcl 166 set ref 161 168* dimension_idx 000101 automatic fixed bin(17,0) dcl 55 set ref 124* 127 127* 131* 131* 134 134* dimension_table 6 based structure array level 2 dcl 2-21 set ref 116* 127* 127 134* 134 dm_vector_util_$init_typed_vector_array 000010 constant entry external dcl 76 ref 110 er_p_code parameter fixed bin(35,0) dcl 147 ref 145 149 error_table_$null_info_ptr 000014 external static fixed bin(35,0) dcl 82 set ref 96* error_table_$unimplemented_version 000016 external static fixed bin(35,0) dcl 84 set ref 168* hbound builtin function dcl 64 ref 131 id 2 based fixed bin(17,0) array level 2 dcl 3-16 ref 131 134 id_list based structure level 1 dcl 3-16 id_list_ptr 000130 automatic pointer initial dcl 3-21 set ref 106* 107 131 134 3-21* il_number_of_ids 000132 automatic fixed bin(17,0) initial dcl 3-22 set ref 3-22* input_typed_vector_array_ptr 000102 automatic pointer dcl 56 set ref 92* 96 96 96 110 124 127 131 134 maximum_dimension_name_length 4 based fixed bin(17,0) level 2 dcl 2-21 set ref 110* 116 127 127 127 127 127 134 134 134 134 134 156 myname 000114 automatic varying char(32) initial dcl 72 set ref 72* 96* 168* null builtin function dcl 64 ref 89 96 96 96 96 96 96 96 96 102 3-21 156 168 168 number_of_dimensions 1 based fixed bin(17,0) level 2 dcl 2-21 ref 116 124 131 156 number_of_ids 1 based fixed bin(17,0) level 2 dcl 3-16 ref 131 number_of_vector_slots 3 based fixed bin(17,0) level 2 dcl 2-21 ref 156 p_code parameter fixed bin(35,0) dcl 50 set ref 36 90* 110* 113 113* 149* p_id_list_ptr parameter pointer dcl 45 ref 36 102 106 p_input_typed_vector_array_ptr parameter pointer dcl 46 ref 36 92 p_number_of_dimensions parameter fixed bin(17,0) dcl 44 set ref 36 110* p_output_typed_vector_array_ptr parameter pointer dcl 48 set ref 36 139* p_work_area_ptr parameter pointer dcl 43 ref 36 91 sub_err_ 000012 constant entry external dcl 78 ref 96 168 typed_vector_array based structure level 1 dcl 2-21 set ref 156 typed_vector_array_ptr 000126 automatic pointer dcl 2-43 set ref 89* 110* 116 127 134 139 156 156 unspec builtin function dcl 64 set ref 116* version based fixed bin(35,0) level 2 dcl 3-16 ref 107 work_area_ptr 000104 automatic pointer dcl 58 set ref 91* 96 96 96 110* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 1-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 1-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 1-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 1-7 TYPED_VECTOR_ARRAY_VERSION_2 internal static fixed bin(35,0) initial dcl 2-50 tva_maximum_dimension_name_length automatic fixed bin(17,0) dcl 2-48 tva_number_of_dimensions automatic fixed bin(17,0) dcl 2-46 tva_number_of_vector_slots automatic fixed bin(17,0) dcl 2-44 NAMES DECLARED BY EXPLICIT CONTEXT. CHECK_VERSION 000635 constant entry internal dcl 161 ref 107 ERROR_FINISH 000576 constant entry internal dcl 154 ref 94 148 ERROR_RETURN 000562 constant entry internal dcl 145 ref 113 MAIN_RETURN 000561 constant label dcl 141 ref 150 dm_vu_merge_tva 000112 constant entry external dcl 36 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1062 1102 750 1072 Length 1326 750 20 210 111 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dm_vu_merge_tva 238 external procedure is an external procedure. on unit on line 94 64 on unit ERROR_RETURN internal procedure shares stack frame of external procedure dm_vu_merge_tva. ERROR_FINISH 65 internal procedure is called by several nonquick procedures. CHECK_VERSION internal procedure shares stack frame of external procedure dm_vu_merge_tva. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dm_vu_merge_tva 000100 accept_all_dimensions dm_vu_merge_tva 000101 dimension_idx dm_vu_merge_tva 000102 input_typed_vector_array_ptr dm_vu_merge_tva 000104 work_area_ptr dm_vu_merge_tva 000114 myname dm_vu_merge_tva 000126 typed_vector_array_ptr dm_vu_merge_tva 000130 id_list_ptr dm_vu_merge_tva 000132 il_number_of_ids dm_vu_merge_tva THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as call_ext_out_desc call_int_this call_int_other return enable ext_entry int_entry free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. dm_vector_util_$init_typed_vector_array sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$null_info_ptr error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 36 000104 54 000117 72 000120 3 21 000125 3 22 000127 89 000131 90 000133 91 000135 92 000140 94 000143 96 000165 102 000274 106 000304 107 000307 110 000320 113 000356 116 000367 124 000410 127 000423 130 000467 131 000472 134 000506 137 000554 139 000556 141 000561 145 000562 148 000564 149 000570 150 000574 154 000575 156 000603 158 000634 161 000635 168 000646 173 000730 ----------------------------------------------------------- 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