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 
 46 mu_convert:
 47 convert_data:
 48      proc (a_source_ptr, a_source_desc_ptr, a_target_ptr, a_target_desc_ptr,
 49           a_code);
 50 
 51 
 52 /*        PARAMETERS
 53 
 54    a_source_ptr         ptr             Pointer to source data
 55    a_source_desc_ptr    ptr             Pointer to source descriptor
 56    a_target_ptr         ptr             Pointer to targer data
 57    a_target_desc_ptr    ptr             Pointer to target descriptor
 58    a_code fixed bin (35)                Error code
 59 */
 60 %page;
 61           a_code = 0;
 62           source_ptr = a_source_ptr;                        /* copy arguments */
 63           source_desc_ptr = a_source_desc_ptr;
 64           target_ptr = a_target_ptr;
 65           target_desc_ptr = a_target_desc_ptr;
 66 
 67           target_type =
 68                2 * target_desc_ptr -> descriptor.type
 69                + fixed (target_desc_ptr -> descriptor.packed);
 70 
 71           if target_desc_ptr -> descriptor.type >= 19
 72                & target_desc_ptr -> descriptor.type <= 22 then
 73                target_length = fixed (string (target_desc_ptr -> descriptor.size));
 74           else do;
 75                     target_len.scale =
 76                          addr (target_desc_ptr -> descriptor.scale) -> signed_scale;
 77                     target_len.precision = fixed (target_desc_ptr -> descriptor.precision);
 78                end;
 79 
 80           source_type =
 81                2 * source_desc_ptr -> descriptor.type
 82                + fixed (source_desc_ptr -> descriptor.packed);
 83 
 84           if source_desc_ptr -> descriptor.type >= 19
 85                & source_desc_ptr -> descriptor.type <= 22 then
 86                source_length = fixed (string (source_desc_ptr -> descriptor.size));
 87           else do;
 88                     source_len.scale =
 89                          addr (source_desc_ptr -> descriptor.scale) -> signed_scale;
 90                     source_len.precision = fixed (source_desc_ptr -> descriptor.precision);
 91                end;
 92 ^L
 93           on any_other
 94                begin;
 95 
 96                     call find_condition_info_ ((null), addr (cond_info), a_code);
 97                     do cond_idx = 1 to 7
 98                          while (cond_info.condition_name ^= cond_name (cond_idx));
 99                     end;
100                     if cond_idx > 7 then
101                          call continue_to_signal_ (a_code);
102 
103                     goto COND (cond_idx);
104 
105 COND (1):                                                   /* size */
106                     a_code = mrds_error_$size_condition;
107                     goto EXIT;
108 
109 COND (2):                                                   /* conversion */
110                     a_code = mrds_error_$conversion_condition;
111                     goto EXIT;
112 
113 
114 COND (3):                                                   /* fixedoverflow */
115                     a_code = mrds_error_$fixedoverflow_condition;
116                     goto EXIT;
117 
118 COND (4):                                                   /* error */
119                     a_code = mrds_error_$error_condition;
120                     goto EXIT;
121 
122 COND (5):                                                   /* illegal_procedure */
123                     a_code = mrds_error_$illegal_procedure_condition;
124                     goto EXIT;
125 
126 COND (6):                                                   /*  overflow */
127                     a_code = mrds_error_$overflow_condition;
128                     goto EXIT;
129 
130 COND (7):                                                   /* underflow */
131                     a_code = mrds_error_$underflow_condition;
132                     goto EXIT;
133 
134 COND (8):                                                   /* any other */
135                     call continue_to_signal_ (a_code);
136 
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 ^L
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 
224 %include mdbm_descriptor;
225 
226      end mu_convert;