COMPILATION LISTING OF SEGMENT vrmu_convert Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/21/84 1436.2 mst Wed 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 19 /* BEGIN DESCRIPTION 20* 21* This procedure converts data located by the source_ptr with a descriptor 22* located by source_desc_ptr, to the data located by target_ptr and described 23* by the descriptor located by target_desc_ptr. 24* 25* The conversion is done using assign_round_. 26* NOTE: assign_ currently only handles data types 1-12, 19-22, 33-34, & 41-46. 27* 28* Error conditions are returned as mrds_error codes, for example, 29* the conversion condition is returned as the error code 30* mrds_error_$conversion_condition. 31* 32* END DESCRIPTION 33**/ 34 35 /* HISTORY 36* Written by R. D. Lackey June 1979 37* Modified by Jim Gray Oct. 1979 to add illegal_procedure condition capture. 38* Modified by Rickie E. Brinegar December 8, 1979 to have each condition captured use its own error code. 39* Modified by Jim Gray Dec. 1979, to correct the length parameter handling 40* for assign_, when the data type is string 41* Modified by M Pierret 8 October 1980 to combine all condition handlers into one. 42* Modified by D. Woodka 07/02/82 to change the any-other condition to continue 43* instead of doing a goto EXIT. 44* 45* 82-09-10 Roger Lackey: changed to vrmu_convert 46* 47* 48**/ 49 50 vrmu_convert: 51 52 proc (a_source_ptr, a_source_desc_ptr, a_target_ptr, a_target_desc_ptr, 53 a_code); 54 55 56 /* PARAMETERS 57* 58* a_source_ptr ptr Pointer to source data 59* a_source_desc_ptr ptr Pointer to source descriptor 60* a_target_ptr ptr Pointer to targer data 61* a_target_desc_ptr ptr Pointer to target descriptor 62* a_code fixed bin (35) Error code 63**/ 64 65 a_code = 0; 66 source_ptr = a_source_ptr; /* copy arguments */ 67 source_desc_ptr = a_source_desc_ptr; 68 target_ptr = a_target_ptr; 69 target_desc_ptr = a_target_desc_ptr; 70 71 target_type = 72 2 * target_desc_ptr -> descriptor.type 73 + fixed (target_desc_ptr -> descriptor.packed); 74 75 if target_desc_ptr -> descriptor.type >= 19 76 & target_desc_ptr -> descriptor.type <= 22 then 77 target_length = fixed (string (target_desc_ptr -> descriptor.size)); 78 else do; 79 target_len.scale = 80 addr (target_desc_ptr -> descriptor.scale) -> signed_scale; 81 target_len.precision = fixed (target_desc_ptr -> descriptor.precision); 82 end; 83 84 source_type = 85 2 * source_desc_ptr -> descriptor.type 86 + fixed (source_desc_ptr -> descriptor.packed); 87 88 if source_desc_ptr -> descriptor.type >= 19 89 & source_desc_ptr -> descriptor.type <= 22 then 90 source_length = fixed (string (source_desc_ptr -> descriptor.size)); 91 else do; 92 source_len.scale = 93 addr (source_desc_ptr -> descriptor.scale) -> signed_scale; 94 source_len.precision = fixed (source_desc_ptr -> descriptor.precision); 95 end; 96 97 on any_other 98 begin; 99 100 call find_condition_info_ ((null), addr (cond_info), a_code); 101 do cond_idx = 1 to 7 102 while (cond_info.condition_name ^= cond_name (cond_idx)); 103 end; 104 if cond_idx > 7 then 105 call continue_to_signal_ (a_code); 106 107 goto COND (cond_idx); 108 109 COND (1): /* size */ 110 a_code = mrds_error_$size_condition; 111 goto EXIT; 112 113 COND (2): /* conversion */ 114 a_code = mrds_error_$conversion_condition; 115 goto EXIT; 116 117 118 COND (3): /* fixedoverflow */ 119 a_code = mrds_error_$fixedoverflow_condition; 120 goto EXIT; 121 122 COND (4): /* error */ 123 a_code = mrds_error_$error_condition; 124 goto EXIT; 125 126 COND (5): /* illegal_procedure */ 127 a_code = mrds_error_$illegal_procedure_condition; 128 goto EXIT; 129 130 COND (6): /* overflow */ 131 a_code = mrds_error_$overflow_condition; 132 goto EXIT; 133 134 COND (7): /* underflow */ 135 a_code = mrds_error_$underflow_condition; 136 goto EXIT; 137 138 end; /* end of condition handler */ 139 140 141 call 142 assign_round_ (target_ptr, target_type, target_length, source_ptr, 143 source_type, source_length); 144 145 EXIT: 146 return; 147 148 /* PARAMETERS */ 149 150 dcl a_source_ptr ptr; /* (INPUT) Pointer to source data */ 151 dcl a_source_desc_ptr ptr; /* (INPUT) Pointer to source descriptor */ 152 dcl a_target_ptr ptr; /* (INPUT) Pointer to target data */ 153 dcl a_target_desc_ptr ptr; /* (INPUT) Pointer to target descriptor */ 154 dcl a_code fixed bin (35); /* (OUTPUT) Error code */ 155 156 /* OTHERS */ 157 158 dcl source_desc_ptr ptr; 159 dcl target_desc_ptr ptr; 160 161 dcl source_ptr ptr; 162 dcl target_ptr ptr; 163 164 dcl source_type fixed bin; 165 dcl target_type fixed bin; 166 dcl cond_idx fixed bin; 167 168 dcl source_length fixed bin (35); 169 170 dcl 1 source_len aligned based (addr (source_length)), /* Length of source */ 171 2 scale fixed bin (17) unal, 172 2 precision fixed bin (17) unal; 173 174 declare signed_scale fixed bin (11) unal based; /* signed fixed binary version of bit(12) */ 175 176 dcl target_length fixed bin (35); 177 178 dcl 1 target_len aligned based (addr (target_length)), /* Length of target */ 179 2 scale fixed bin (17) unal, 180 2 precision fixed bin (17) unal; 181 182 dcl 1 cond_info aligned, 183 2 mc_ptr ptr, 184 2 version fixed bin, 185 2 condition_name char (32) varying, 186 2 info_ptr ptr, 187 2 wc_ptr ptr, 188 2 loc_ptr ptr, 189 2 flags aligned, 190 3 crawlout bit (1) unal, 191 3 mbz1 bit (35) unal, 192 2 mbz2 bit (36) aligned, 193 2 user_loc_ptr ptr, 194 2 mbz (4) bit (36) aligned; 195 196 dcl cond_name (7) char (32) varying int static options (constant) 197 init ("size", "conversion", "fixedoverflow", "error", 198 "illegal_procedure", "overflow", "underflow"); 199 200 /* Builtin */ 201 202 dcl (addr, fixed, null, string) builtin; 203 204 /* External Entries */ 205 206 dcl assign_round_ 207 entry (ptr, fixed bin, fixed bin (35), ptr, fixed bin, fixed bin (35)); 208 dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); 209 dcl continue_to_signal_ entry (fixed bin (35)); 210 211 /* External */ 212 213 dcl ( 214 mrds_error_$conversion_condition, 215 mrds_error_$error_condition, 216 mrds_error_$fixedoverflow_condition, 217 mrds_error_$illegal_procedure_condition, 218 mrds_error_$overflow_condition, 219 mrds_error_$size_condition, 220 mrds_error_$underflow_condition 221 ) ext fixed bin (35); 222 dcl any_other condition; 223 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 224 225 226 end vrmu_convert; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/21/84 0934.0 vrmu_convert.pl1 >special_ldd>online>mrds_install>vrmu_convert.pl1 224 1 10/14/83 1608.6 mdbm_descriptor.incl.pl1 >ldd>include>mdbm_descriptor.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. a_code parameter fixed bin(35,0) dcl 154 set ref 50 65* 100* 104* 109* 113* 118* 122* 126* 130* 134* a_source_desc_ptr parameter pointer dcl 151 ref 50 67 a_source_ptr parameter pointer dcl 150 ref 50 66 a_target_desc_ptr parameter pointer dcl 153 ref 50 69 a_target_ptr parameter pointer dcl 152 ref 50 68 addr builtin function dcl 202 ref 79 79 81 92 92 94 100 100 any_other 000150 stack reference condition dcl 222 ref 97 assign_round_ 000010 constant entry external dcl 206 ref 141 cond_idx 000112 automatic fixed bin(17,0) dcl 166 set ref 101* 101* 104 107 cond_info 000116 automatic structure level 1 dcl 182 set ref 100 100 cond_name 000007 constant varying char(32) initial array dcl 196 ref 101 condition_name 3 000116 automatic varying char(32) level 2 dcl 182 set ref 101 continue_to_signal_ 000014 constant entry external dcl 209 ref 104 descriptor based structure level 1 unaligned dcl 1-6 find_condition_info_ 000012 constant entry external dcl 208 ref 100 fixed builtin function dcl 202 ref 71 75 81 84 88 94 mrds_error_$conversion_condition 000016 external static fixed bin(35,0) dcl 213 ref 113 mrds_error_$error_condition 000020 external static fixed bin(35,0) dcl 213 ref 122 mrds_error_$fixedoverflow_condition 000022 external static fixed bin(35,0) dcl 213 ref 118 mrds_error_$illegal_procedure_condition 000024 external static fixed bin(35,0) dcl 213 ref 126 mrds_error_$overflow_condition 000026 external static fixed bin(35,0) dcl 213 ref 130 mrds_error_$size_condition 000030 external static fixed bin(35,0) dcl 213 ref 109 mrds_error_$underflow_condition 000032 external static fixed bin(35,0) dcl 213 ref 134 null builtin function dcl 202 ref 100 num_dims 000156 automatic fixed bin(17,0) initial dcl 1-20 set ref 1-20* packed 0(07) based bit(1) level 2 packed unaligned dcl 1-6 ref 71 84 precision 0(18) based fixed bin(17,0) level 2 in structure "source_len" packed unaligned dcl 170 in procedure "vrmu_convert" set ref 94* precision 0(24) based bit(12) level 3 in structure "descriptor" packed unaligned dcl 1-6 in procedure "vrmu_convert" ref 81 94 precision 0(18) based fixed bin(17,0) level 2 in structure "target_len" packed unaligned dcl 178 in procedure "vrmu_convert" set ref 81* scale based fixed bin(17,0) level 2 in structure "source_len" packed unaligned dcl 170 in procedure "vrmu_convert" set ref 92* scale 0(12) based bit(12) level 3 in structure "descriptor" packed unaligned dcl 1-6 in procedure "vrmu_convert" set ref 79 92 scale based fixed bin(17,0) level 2 in structure "target_len" packed unaligned dcl 178 in procedure "vrmu_convert" set ref 79* signed_scale based fixed bin(11,0) unaligned dcl 174 ref 79 92 size 0(12) based structure level 2 packed unaligned dcl 1-6 set ref 75 88 source_desc_ptr 000100 automatic pointer dcl 158 set ref 67* 84 84 88 88 88 92 94 source_len based structure level 1 dcl 170 source_length 000113 automatic fixed bin(35,0) dcl 168 set ref 88* 92 94 141* source_ptr 000104 automatic pointer dcl 161 set ref 66* 141* source_type 000110 automatic fixed bin(17,0) dcl 164 set ref 84* 141* string builtin function dcl 202 ref 75 88 target_desc_ptr 000102 automatic pointer dcl 159 set ref 69* 71 71 75 75 75 79 81 target_len based structure level 1 dcl 178 target_length 000114 automatic fixed bin(35,0) dcl 176 set ref 75* 79 81 141* target_ptr 000106 automatic pointer dcl 162 set ref 68* 141* target_type 000111 automatic fixed bin(17,0) dcl 165 set ref 71* 141* type 0(01) based fixed bin(6,0) level 2 packed unsigned unaligned dcl 1-6 ref 71 75 75 84 88 88 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. desc_ptr automatic pointer dcl 1-19 NAMES DECLARED BY EXPLICIT CONTEXT. COND 000000 constant label array(7) dcl 109 set ref 107 EXIT 000432 constant label dcl 145 ref 111 115 120 124 128 132 136 vrmu_convert 000122 constant entry external dcl 50 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 614 650 433 624 Length 1054 433 34 167 160 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME vrmu_convert 128 external procedure is an external procedure. on unit on line 97 76 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME vrmu_convert 000100 source_desc_ptr vrmu_convert 000102 target_desc_ptr vrmu_convert 000104 source_ptr vrmu_convert 000106 target_ptr vrmu_convert 000110 source_type vrmu_convert 000111 target_type vrmu_convert 000112 cond_idx vrmu_convert 000113 source_length vrmu_convert 000114 target_length vrmu_convert 000116 cond_info vrmu_convert 000156 num_dims vrmu_convert THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_round_ continue_to_signal_ find_condition_info_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mrds_error_$conversion_condition mrds_error_$error_condition mrds_error_$fixedoverflow_condition mrds_error_$illegal_procedure_condition mrds_error_$overflow_condition mrds_error_$size_condition mrds_error_$underflow_condition LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 50 000115 1 20 000127 65 000130 66 000132 67 000135 68 000140 69 000143 71 000146 75 000161 79 000172 81 000176 84 000201 88 000214 92 000225 94 000231 97 000234 100 000250 101 000271 103 000310 104 000312 107 000325 109 000330 111 000334 113 000337 115 000343 118 000346 120 000352 122 000355 124 000361 126 000364 128 000370 130 000373 132 000377 134 000402 136 000406 141 000411 145 000432 ----------------------------------------------------------- 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