1 /* BEGIN INCLUDE FILE - dm_comp_vec_str_proc.incl.pl1 */
  2 
  3 
  4 
  5 /****^  HISTORY COMMENTS:
  6   1) change(87-05-06,Dupuis), approve(87-05-29,MCR7695), audit(87-06-02,Blair),
  7      install(87-07-17,MR12.1-1042):
  8      Added a check to determine if the values were aligned correctly before
  9      doing the comparisons. Although the calling program was supposed to take
 10      care of alignment, this wasn't always the case (phx20843). This check can
 11      be taken out in the future (for performance reasons) once we know we are
 12      bug free.
 13                                                    END HISTORY COMMENTS */
 14 
 15 
 16 /* DESCRIPTION:
 17 
 18    This internal routine is contained in an include file so that critical
 19    execution paths may save the time that would have been spent on the
 20    overhead of making an external call.  The time to execute this routine is
 21    very small, much less than the time required in making an external call and
 22    setting up an argument list.
 23 
 24    Modules which include this routine must follow strict guidelines in the
 25    naming of certain variables, as this internal routine assumes the caller
 26    has global variables set up so as to simulate the calling sequence:
 27 
 28    call COMPARE_VALUES_INTERNAL_PROC
 29         (cv_p_descriptor_ptr, cv_p_vector_value_ptr,
 30          cv_p_field_value_ptr, cv_p_field_value_length,
 31          cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code);
 32 
 33    These variables must be declared in the calling routine as described
 34    under Parameters.
 35 
 36    This routine compares two values and returns information about whether the
 37    first is less than, equal to, or greater than, the second.  Both values
 38    must be of the same data-type, however the storage conventions for varying
 39    string data for the second value are slightly different from the Multics
 40    standard format.  This difference consists solely in that the length of the
 41    varying string is not stored as the initial piece of information in the
 42    string.  The length of varying string values in fields is passed in as a
 43    parameter.
 44 
 45    The first value is referred to as the "vector" value, since it usually is
 46    the value of a dimension of a typed_vector.  The second value is referred
 47    to as the "field" value, since it is usually the value of a field of a key.
 48    If cv_p_vector_value_is_in_field_format is OFF, the vector value is in the
 49    Multics standard format; if ON, the vector value is in same format as the
 50    field value.  The field value format is the format described above.
 51 */
 52 
 53 /* HISTORY:
 54 Written by Matthew Pierret, 04/18/84.
 55   (Extracted from dmu_compare_values.pl1)
 56 Modified:
 57 05/14/84 by Matthew Pierret:  Changed to assume that values in field format
 58             are properly aligned.
 59 12/07/84 by M. Sharpe:  to correct format and dcls.
 60 */
 61 
 62 /* format: style2,ind3 */
 63 %page;
 64 
 65 COMPARE_VALUES:
 66    proc (cv_p_vector_value_is_in_field_format);
 67 
 68 /* START OF DECLARATIONS */
 69 
 70 /* Parameter */
 71 
 72       dcl     cv_p_vector_value_is_in_field_format
 73                                      bit (1) aligned;
 74 
 75 /*  The following must be declared in the calling routine:
 76 
 77       dcl     cv_p_descriptor_ptr             /* points to the descriptor for
 78                                         ptr;  /* the vector/field value
 79       dcl     cv_p_vector_value_ptr     ptr;  /* points to the vector value
 80       dcl     cv_p_vector_value_length  fixed bin (35);
 81                                               /* length of vector value in bits
 82       dcl     cv_p_field_value_ptr      ptr;  /* points to the field value
 83       dcl     cv_p_field_value_length   fixed bin (35);
 84                                               /* length of field value in bits
 85       dcl     cv_p_vector_equal_to_key  bit (1) aligned;
 86                                               /* is set by this routine to ON
 87                                               /* if the values are equal
 88       dcl     cv_p_vector_less_than_key bit (1) aligned;
 89                                               /* is set by this routine to ON
 90                                               /* if the vector value is less
 91                                               /* than the field value.
 92       dcl     cv_p_code                 fixed bin (35);
 93 
 94 */
 95 
 96 /* Automatic */
 97       dcl     cv_local_vector_real_fix_bin_1
 98                                      fixed bin (35) aligned;
 99       dcl     cv_local_field_real_fix_bin_1
100                                      fixed bin (35) aligned;
101       dcl     cv_local_vector_real_fix_bin_2
102                                      fixed bin (71) aligned;
103       dcl     cv_local_field_real_fix_bin_2
104                                      fixed bin (71) aligned;
105 
106       dcl     cv_local_vector_real_flt_bin_1
107                                      float bin (27) aligned;
108       dcl     cv_local_field_real_flt_bin_1
109                                      float bin (27) aligned;
110       dcl     cv_local_vector_real_flt_bin_2
111                                      float bin (63) aligned;
112       dcl     cv_local_field_real_flt_bin_2
113                                      float bin (63) aligned;
114 
115       dcl     cv_local_vector_real_fix_bin_1_uns
116                                      fixed bin (35) aligned unsigned;
117       dcl     cv_local_field_real_fix_bin_1_uns
118                                      fixed bin (35) aligned unsigned;
119       dcl     cv_local_vector_real_fix_bin_2_uns
120                                      fixed bin (71) aligned unsigned;
121       dcl     cv_local_field_real_fix_bin_2_uns
122                                      fixed bin (71) aligned unsigned;
123 
124       dcl     (cv_vector_real_part_value_ptr, cv_vector_imaginary_part_value_ptr, cv_field_real_part_value_ptr,
125               cv_field_imaginary_part_value_ptr)
126                                      ptr init (null);
127 
128       dcl     1 cv_local_arg_descriptor
129                                      like arg_descriptor;
130       dcl     1 cv_local_fixed_arg_descriptor
131                                      like fixed_arg_descriptor;
132 
133 /* Based */
134 
135       dcl     cv_bit_string          bit (sys_info$max_seg_size * 36) based;
136       dcl     cv_char_string         char (sys_info$max_seg_size * 4) based;
137 
138       dcl     cv_based_real_fix_bin_1a
139                                      fixed bin (35) based aligned;
140       dcl     cv_based_real_fix_bin_2a
141                                      fixed bin (71) based aligned;
142       dcl     cv_based_real_fix_bin_1u
143                                      fixed bin (35) based unaligned;
144       dcl     cv_based_real_fix_bin_2u
145                                      fixed bin (71) based unaligned;
146 
147       dcl     cv_based_real_flt_bin_1a
148                                      float bin (27) based aligned;
149       dcl     cv_based_real_flt_bin_2a
150                                      float bin (63) based aligned;
151       dcl     cv_based_real_flt_bin_1u
152                                      float bin (27) based unaligned;
153       dcl     cv_based_real_flt_bin_2u
154                                      float bin (63) based unaligned;
155 
156       dcl     cv_based_real_fix_bin_1_unsa
157                                      fixed bin (35) based aligned unsigned;
158       dcl     cv_based_real_fix_bin_2_unsa
159                                      fixed bin (71) based aligned unsigned;
160       dcl     cv_based_real_fix_bin_1_unsu
161                                      fixed bin (35) based unaligned unsigned;
162       dcl     cv_based_real_fix_bin_2_unsu
163                                      fixed bin (71) based unaligned unsigned;
164 
165 /* Builtin */
166 
167       dcl     (addbitno, addcharno, ceil, copy, substr, null, unspec)
168                                      builtin;
169 
170 /* Constant */
171 
172       dcl     myname                 init ("dmu_compare_values") char (32) varying internal static options (constant);
173 
174       dcl     (
175               BITS_PER_WORD          init (36),
176               BYTES_PER_WORD         init (4),
177               BITS_PER_EXPONENT      init (8),
178               BIT4_DECIMAL_EXPONENT  init (2),
179               BIT9_DECIMAL_EXPONENT  init (1),
180               SIGN                   init (1),
181               DEFAULT_LENGTH         init (-1),
182               HIGHEST_SUPPORTED_DATA_TYPE
183                                      init (44)
184               )                      fixed bin (17) internal static options (constant);
185       dcl     NEED_TO_CHECK_FOR_ALIGNMENT (46) bit (1) internal static options (constant) init (
186               "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, /* 1 to 12 */
187               "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, /* 13 to 19 */
188               "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, /* 20 to 32 */
189               "1"b, "1"b, /* 33 to 34 */ "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, "0"b, /* 35 to 42 */
190               "1"b, "1"b, "1"b, "1"b /* 43 to 46 */);
191 
192       dcl     REQUIRED_ALIGNMENT (46) fixed bin internal static options (constant) init (
193               36, 72, 36, 72, 72, 72, 72, 72, 36, 36, 36, 36, /* 1 to 12 */
194               0, 0, 0, 0, 0, 0, 0, /* 13 to 19 */
195               0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 20 to 32 */
196               36, 72, /* 33 to 34 */ 0, 0, 0, 0, 0, 0, 0, 0, /* 35 to 42 */
197               36, 36, 36, 36 ); /* 43 to 46 */
198 
199 /* Entry */
200 
201       dcl     dmu_compare_values     entry (ptr, ptr, ptr, fixed bin (35), bit (1) aligned, bit (1) aligned,
202                                      fixed bin (35));
203       dcl     dmu_compare_decimal_values$dmu_compare_dec9ls
204                                      entry (fixed bin (17), ptr, ptr, bit (1) aligned, bit (1) aligned);
205       dcl     dmu_compare_decimal_values$dmu_compare_dec9fl
206                                      entry (fixed bin (17), ptr, ptr, bit (1) aligned, bit (1) aligned);
207       dcl     dmu_compare_decimal_values$dmu_compare_dec4fl
208                                      entry (fixed bin (17), ptr, ptr, bit (1) aligned, bit (1) aligned);
209       dcl     dmu_compare_decimal_values$dmu_compare_dec4ls
210                                      entry (fixed bin (17), ptr, ptr, bit (1) aligned, bit (1) aligned);
211       dcl     sub_err_               entry () options (variable);
212 
213 /* External */
214 
215       dcl     sys_info$max_seg_size  fixed bin (35) ext static;
216       dcl     error_table_$bad_arg   fixed bin (35) ext;
217       dcl     dm_error_$unimplemented_data_type
218                                      fixed bin (35) ext;
219 
220 /* END OF DECLARATIONS */
221 ^L
222       cv_p_code = 0;
223 
224       arg_descriptor_ptr = cv_p_descriptor_ptr;
225 
226       if arg_descriptor.type < 1 | arg_descriptor.type > HIGHEST_SUPPORTED_DATA_TYPE
227       then call
228               sub_err_ (error_table_$bad_arg, myname, ACTION_CANT_RESTART, null, 0,
229               "^/The caller-provided descriptor has an invalid type, ^d. Valid types
230 are between 1 and ^d.", arg_descriptor.type, HIGHEST_SUPPORTED_DATA_TYPE);
231 
232       if ^arg_descriptor.packed & NEED_TO_CHECK_FOR_ALIGNMENT (arg_descriptor.type)
233       then if mod (bitno (cv_p_vector_value_ptr), REQUIRED_ALIGNMENT (arg_descriptor.type)) ^= 0
234       then call sub_err_ (error_table_$bad_arg, myname, ACTION_CANT_RESTART, null, 0,
235            "^/The vector_value pointer (^p) has an invalid alignment.^/It's address should have been divisible by ^d.",
236            cv_p_vector_value_ptr, REQUIRED_ALIGNMENT (arg_descriptor.type));
237       else if mod (bitno (cv_p_field_value_ptr), REQUIRED_ALIGNMENT (arg_descriptor.type)) ^= 0
238       then call sub_err_ (error_table_$bad_arg, myname, ACTION_CANT_RESTART, null, 0,
239            "^/The field_value pointer (^p) has an invalid alignment.^/It's address should have been divisible by ^d.",
240            cv_p_field_value_ptr, REQUIRED_ALIGNMENT (arg_descriptor.type));
241 
242       goto CV_TYPE (arg_descriptor.type);
243 CV_TYPE (1):                                                /* real_fix_bin_1 (short) */
244       if arg_descriptor.packed
245       then
246          do;
247             if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, 1)
248             then unspec (cv_local_vector_real_fix_bin_1) =
249                     copy ("1"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
250                     || substr (cv_p_vector_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
251             else unspec (cv_local_vector_real_fix_bin_1) =
252                     copy ("0"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
253                     || substr (cv_p_vector_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
254             if substr (cv_p_field_value_ptr -> cv_bit_string, 1, 1)
255             then unspec (cv_local_field_real_fix_bin_1) =
256                     copy ("1"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
257                     || substr (cv_p_field_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
258             else unspec (cv_local_field_real_fix_bin_1) =
259                     copy ("0"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
260                     || substr (cv_p_field_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
261             if cv_local_vector_real_fix_bin_1 = cv_local_field_real_fix_bin_1
262             then goto CV_RETURN_EQUAL;
263             else if cv_local_vector_real_fix_bin_1 < cv_local_field_real_fix_bin_1
264             then goto CV_RETURN_LESS;
265             else goto CV_RETURN_GREATER;
266          end;
267       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_1a = cv_p_field_value_ptr -> cv_based_real_fix_bin_1a
268       then goto CV_RETURN_EQUAL;
269       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_1a < cv_p_field_value_ptr -> cv_based_real_fix_bin_1a
270       then goto CV_RETURN_LESS;
271       else goto CV_RETURN_GREATER;
272 
273 
274 CV_TYPE (2):                                                /* real_fix_bin_2 (long) */
275       if arg_descriptor.packed
276       then
277          do;
278             if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, 1)
279             then unspec (cv_local_vector_real_fix_bin_2) =
280                     copy ("1"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
281                     || substr (cv_p_vector_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
282             else unspec (cv_local_vector_real_fix_bin_2) =
283                     copy ("0"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
284                     || substr (cv_p_vector_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
285             if substr (cv_p_field_value_ptr -> cv_bit_string, 1, 1)
286             then unspec (cv_local_field_real_fix_bin_2) =
287                     copy ("1"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
288                     || substr (cv_p_field_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
289             else unspec (cv_local_field_real_fix_bin_2) =
290                     copy ("0"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
291                     || substr (cv_p_field_value_ptr -> cv_bit_string, 2, fixed_arg_descriptor.precision);
292             if cv_local_vector_real_fix_bin_2 = cv_local_field_real_fix_bin_2
293             then goto CV_RETURN_EQUAL;
294             else if cv_local_vector_real_fix_bin_2 < cv_local_field_real_fix_bin_2
295             then goto CV_RETURN_LESS;
296             else goto CV_RETURN_GREATER;
297          end;
298       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_2a = cv_p_field_value_ptr -> cv_based_real_fix_bin_2a
299       then goto CV_RETURN_EQUAL;
300       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_2a < cv_p_field_value_ptr -> cv_based_real_fix_bin_2a
301       then goto CV_RETURN_LESS;
302       else goto CV_RETURN_GREATER;
303 
304 
305 CV_TYPE (3):                                                /* real_flt_bin_1 (short) */
306       if arg_descriptor.packed
307       then
308          do;
309             unspec (cv_local_vector_real_flt_bin_1) =
310                substr (cv_p_vector_value_ptr -> cv_bit_string, 1, BITS_PER_EXPONENT + SIGN + arg_descriptor.size)
311                || copy ("0"b, (BITS_PER_WORD - (BITS_PER_EXPONENT + arg_descriptor.size + SIGN)));
312             unspec (cv_local_field_real_flt_bin_1) =
313                substr (cv_p_field_value_ptr -> cv_bit_string, 1, BITS_PER_EXPONENT + SIGN + arg_descriptor.size)
314                || copy ("0"b, (BITS_PER_WORD - (BITS_PER_EXPONENT + arg_descriptor.size + SIGN)));
315 
316 
317             if cv_local_vector_real_flt_bin_1 = cv_local_field_real_flt_bin_1
318             then goto CV_RETURN_EQUAL;
319             else if cv_local_vector_real_flt_bin_1 < cv_local_field_real_flt_bin_1
320             then goto CV_RETURN_LESS;
321             else goto CV_RETURN_GREATER;
322          end;
323       else if cv_p_vector_value_ptr -> cv_based_real_flt_bin_1a = cv_p_field_value_ptr -> cv_based_real_flt_bin_1a
324       then goto CV_RETURN_EQUAL;
325       else if cv_p_vector_value_ptr -> cv_based_real_flt_bin_1a < cv_p_field_value_ptr -> cv_based_real_flt_bin_1a
326       then goto CV_RETURN_LESS;
327       else goto CV_RETURN_GREATER;
328 
329 CV_TYPE (4):                                                /* real_flt_bin_2 (long) */
330       if arg_descriptor.packed
331       then
332          do;
333             unspec (cv_local_vector_real_flt_bin_2) =
334                substr (cv_p_vector_value_ptr -> cv_bit_string, 1, BITS_PER_EXPONENT + SIGN + arg_descriptor.size)
335                || copy ("0"b, (BITS_PER_WORD - (BITS_PER_EXPONENT + arg_descriptor.size + SIGN)));
336             unspec (cv_local_field_real_flt_bin_2) =
337                substr (cv_p_field_value_ptr -> cv_bit_string, 1, BITS_PER_EXPONENT + SIGN + arg_descriptor.size)
338                || copy ("0"b, (BITS_PER_WORD - (BITS_PER_EXPONENT + arg_descriptor.size + SIGN)));
339 
340             if cv_local_vector_real_flt_bin_2 = cv_local_field_real_flt_bin_2
341             then goto CV_RETURN_EQUAL;
342             else if cv_local_vector_real_flt_bin_2 < cv_local_field_real_flt_bin_2
343             then goto CV_RETURN_LESS;
344             else goto CV_RETURN_GREATER;
345          end;
346       else if cv_p_vector_value_ptr -> cv_based_real_flt_bin_2a = cv_p_field_value_ptr -> cv_based_real_flt_bin_2a
347       then goto CV_RETURN_EQUAL;
348       else if cv_p_vector_value_ptr -> cv_based_real_flt_bin_2a < cv_p_field_value_ptr -> cv_based_real_flt_bin_2a
349       then goto CV_RETURN_LESS;
350       else goto CV_RETURN_GREATER;
351 
352 CV_TYPE (5):                                                /*cplx_fix_bin_1*/
353       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
354       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
355       if arg_descriptor.packed
356       then
357          do;
358             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, fixed_arg_descriptor.precision + SIGN);
359             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, fixed_arg_descriptor.precision + SIGN);
360          end;
361       else
362          do;
363             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, BITS_PER_WORD);
364             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, BITS_PER_WORD);
365          end;
366       cv_local_fixed_arg_descriptor = fixed_arg_descriptor;
367       cv_local_fixed_arg_descriptor.type = real_fix_bin_1_dtype;
368       call
369          dmu_compare_values (addr (cv_local_fixed_arg_descriptor), cv_vector_real_part_value_ptr,
370          cv_field_real_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code);
371       if cv_p_code ^= 0
372       then return;
373       if cv_p_vector_equal_to_key
374       then call
375               dmu_compare_values (addr (cv_local_fixed_arg_descriptor), cv_vector_imaginary_part_value_ptr,
376               cv_field_imaginary_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key,
377               cv_p_code);
378       return;
379 
380 CV_TYPE (6):                                                /*cplx_fix_bin_2*/
381       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
382       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
383       if arg_descriptor.packed
384       then
385          do;
386             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, fixed_arg_descriptor.precision + SIGN);
387             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, fixed_arg_descriptor.precision + SIGN);
388          end;
389       else
390          do;
391             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, 2 * BITS_PER_WORD);
392             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, 2 * BITS_PER_WORD);
393          end;
394       cv_local_fixed_arg_descriptor = fixed_arg_descriptor;
395       cv_local_fixed_arg_descriptor.type = real_fix_bin_2_dtype;
396       call
397          dmu_compare_values (addr (cv_local_fixed_arg_descriptor), cv_vector_real_part_value_ptr,
398          cv_field_real_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code);
399       if cv_p_code ^= 0
400       then return;
401       if cv_p_vector_equal_to_key
402       then call
403               dmu_compare_values (addr (cv_local_fixed_arg_descriptor), cv_vector_imaginary_part_value_ptr,
404               cv_field_imaginary_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key,
405               cv_p_code);
406       return;
407 
408 CV_TYPE (7):                                                /*cplx_flt_bin_1*/
409       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
410       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
411       if arg_descriptor.packed
412       then
413          do;
414             cv_vector_imaginary_part_value_ptr =
415                addbitno (cv_p_vector_value_ptr, BITS_PER_EXPONENT + SIGN + arg_descriptor.size);
416             cv_field_imaginary_part_value_ptr =
417                addbitno (cv_p_field_value_ptr, BITS_PER_EXPONENT + SIGN + arg_descriptor.size);
418          end;
419       else
420          do;
421             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, BITS_PER_WORD);
422             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, BITS_PER_WORD);
423          end;
424       cv_local_arg_descriptor = arg_descriptor;
425       cv_local_arg_descriptor.type = real_flt_bin_1_dtype;
426       call
427          dmu_compare_values (addr (cv_local_arg_descriptor), cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr,
428          (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code);
429       if cv_p_code ^= 0
430       then return;
431       if cv_p_vector_equal_to_key
432       then call
433               dmu_compare_values (addr (cv_local_arg_descriptor), cv_vector_imaginary_part_value_ptr,
434               cv_field_imaginary_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key,
435               cv_p_code);
436       return;
437 
438 CV_TYPE (8):                                                /*cplx_flt_bin_2*/
439       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
440       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
441       if arg_descriptor.packed
442       then
443          do;
444             cv_vector_imaginary_part_value_ptr =
445                addbitno (cv_p_vector_value_ptr, BITS_PER_EXPONENT + SIGN + arg_descriptor.size);
446             cv_field_imaginary_part_value_ptr =
447                addbitno (cv_p_field_value_ptr, BITS_PER_EXPONENT + SIGN + arg_descriptor.size);
448          end;
449       else
450          do;
451             cv_vector_imaginary_part_value_ptr = addbitno (cv_p_vector_value_ptr, 2 * BITS_PER_WORD);
452             cv_field_imaginary_part_value_ptr = addbitno (cv_p_field_value_ptr, 2 * BITS_PER_WORD);
453          end;
454       cv_local_arg_descriptor = arg_descriptor;
455       cv_local_arg_descriptor.type = real_flt_bin_2_dtype;
456       call
457          dmu_compare_values (addr (cv_local_arg_descriptor), cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr,
458          (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key, cv_p_code);
459       if cv_p_code ^= 0
460       then return;
461       if cv_p_vector_equal_to_key
462       then call
463               dmu_compare_values (addr (cv_local_arg_descriptor), cv_vector_imaginary_part_value_ptr,
464               cv_field_imaginary_part_value_ptr, (DEFAULT_LENGTH), cv_p_vector_equal_to_key, cv_p_vector_less_than_key,
465               cv_p_code);
466       return;
467 
468 CV_TYPE (9):                                                /* real_fix_dec_9bit_ls */
469       call
470          dmu_compare_decimal_values$dmu_compare_dec9ls ((fixed_arg_descriptor.precision + SIGN), cv_p_vector_value_ptr,
471          cv_p_field_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key);
472       return;
473 
474 CV_TYPE (10):                                               /* real_flt_dec_9bit */
475       call
476          dmu_compare_decimal_values$dmu_compare_dec9fl ((arg_descriptor.size + SIGN + BIT9_DECIMAL_EXPONENT),
477          cv_p_vector_value_ptr, cv_p_field_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key);
478       return;
479 
480 CV_TYPE (11):                                               /* cplx_fix_dec_9bit_ls */
481       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
482       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
483       cv_vector_imaginary_part_value_ptr = addcharno (cv_p_vector_value_ptr, fixed_arg_descriptor.precision + SIGN);
484       cv_field_imaginary_part_value_ptr = addcharno (cv_p_field_value_ptr, fixed_arg_descriptor.precision + SIGN);
485       call
486          dmu_compare_decimal_values$dmu_compare_dec9ls ((fixed_arg_descriptor.precision + SIGN),
487          cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key)
488          ;
489       if cv_p_vector_equal_to_key
490       then call
491               dmu_compare_decimal_values$dmu_compare_dec9ls ((fixed_arg_descriptor.precision + SIGN),
492               cv_vector_imaginary_part_value_ptr, cv_field_imaginary_part_value_ptr, cv_p_vector_equal_to_key,
493               cv_p_vector_less_than_key);
494       return;
495 
496 CV_TYPE (12):                                               /* cplx_flt_dec_9bit */
497       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
498       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
499       cv_vector_imaginary_part_value_ptr =
500          addcharno (cv_p_vector_value_ptr, arg_descriptor.size + SIGN + BIT9_DECIMAL_EXPONENT);
501       cv_field_imaginary_part_value_ptr =
502          addcharno (cv_p_field_value_ptr, arg_descriptor.size + SIGN + BIT9_DECIMAL_EXPONENT);
503 
504       call
505          dmu_compare_decimal_values$dmu_compare_dec9fl ((arg_descriptor.size + SIGN + BIT9_DECIMAL_EXPONENT),
506          cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key)
507          ;
508       if cv_p_vector_equal_to_key
509       then call
510               dmu_compare_decimal_values$dmu_compare_dec9fl ((arg_descriptor.size + SIGN + BIT9_DECIMAL_EXPONENT),
511               cv_vector_imaginary_part_value_ptr, cv_field_imaginary_part_value_ptr, cv_p_vector_equal_to_key,
512               cv_p_vector_less_than_key);
513       return;
514 
515 CV_TYPE (19):                                               /* bit (nonvarying) */
516       if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, arg_descriptor.size)
517          = substr (cv_p_field_value_ptr -> cv_bit_string, 1, arg_descriptor.size)
518       then goto CV_RETURN_EQUAL;
519       else if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, arg_descriptor.size)
520               < substr (cv_p_field_value_ptr -> cv_bit_string, 1, arg_descriptor.size)
521       then goto CV_RETURN_LESS;
522       else goto CV_RETURN_GREATER;
523 
524 
525 CV_TYPE (20):                                               /* varying_bit */
526       if cv_p_vector_value_is_in_field_format
527       then if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, cv_p_vector_value_length)
528               = substr (cv_p_field_value_ptr -> cv_bit_string, 1, cv_p_field_value_length)
529            then goto CV_RETURN_EQUAL;
530            else if substr (cv_p_vector_value_ptr -> cv_bit_string, 1, cv_p_vector_value_length)
531                    < substr (cv_p_field_value_ptr -> cv_bit_string, 1, cv_p_field_value_length)
532            then goto CV_RETURN_LESS;
533            else goto CV_RETURN_GREATER;
534       else if substr (cv_p_vector_value_ptr -> cv_bit_string, BITS_PER_WORD + 1,
535               cv_p_vector_value_ptr -> cv_based_real_fix_bin_1u)
536               = substr (cv_p_field_value_ptr -> cv_bit_string, 1, cv_p_field_value_length)
537       then goto CV_RETURN_EQUAL;
538       else if substr (cv_p_vector_value_ptr -> cv_bit_string, BITS_PER_WORD + 1,
539               cv_p_vector_value_ptr -> cv_based_real_fix_bin_1u)
540               < substr (cv_p_field_value_ptr -> cv_bit_string, 1, cv_p_field_value_length)
541       then goto CV_RETURN_LESS;
542       else goto CV_RETURN_GREATER;
543 
544 CV_TYPE (21):                                               /* char (nonvarying) */
545       if substr (cv_p_vector_value_ptr -> cv_char_string, 1, arg_descriptor.size)
546          = substr (cv_p_field_value_ptr -> cv_char_string, 1, arg_descriptor.size)
547       then goto CV_RETURN_EQUAL;
548       else if substr (cv_p_vector_value_ptr -> cv_char_string, 1, arg_descriptor.size)
549               < substr (cv_p_field_value_ptr -> cv_char_string, 1, arg_descriptor.size)
550       then goto CV_RETURN_LESS;
551       else goto CV_RETURN_GREATER;
552 
553 CV_TYPE (22):                                               /* varying_char */
554       if cv_p_vector_value_is_in_field_format
555       then if substr (cv_p_vector_value_ptr -> cv_char_string, 1, cv_p_vector_value_length)
556               = substr (cv_p_field_value_ptr -> cv_char_string, 1, cv_p_field_value_length)
557            then goto CV_RETURN_EQUAL;
558            else if substr (cv_p_vector_value_ptr -> cv_char_string, 1, cv_p_vector_value_length)
559                    < substr (cv_p_field_value_ptr -> cv_char_string, 1, cv_p_field_value_length)
560            then goto CV_RETURN_LESS;
561            else goto CV_RETURN_GREATER;
562       else if substr (cv_p_vector_value_ptr -> cv_char_string, BYTES_PER_WORD + 1,
563               cv_p_vector_value_ptr -> cv_based_real_fix_bin_1u)
564               = substr (cv_p_field_value_ptr -> cv_char_string, 1, cv_p_field_value_length)
565       then goto CV_RETURN_EQUAL;
566       else if substr (cv_p_vector_value_ptr -> cv_char_string, BYTES_PER_WORD + 1,
567               cv_p_vector_value_ptr -> cv_based_real_fix_bin_1u)
568               < substr (cv_p_field_value_ptr -> cv_char_string, 1, cv_p_field_value_length)
569       then goto CV_RETURN_LESS;
570       else goto CV_RETURN_GREATER;
571 
572 CV_TYPE (33):                                               /* real_fix_bin_1_uns */
573       if arg_descriptor.packed
574       then
575          do;
576             unspec (cv_local_vector_real_fix_bin_1_uns) =
577                copy ("0"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
578                || substr (cv_p_vector_value_ptr -> cv_bit_string, 1, fixed_arg_descriptor.precision);
579             unspec (cv_local_field_real_fix_bin_1_uns) =
580                copy ("0"b, BITS_PER_WORD - fixed_arg_descriptor.precision)
581                || substr (cv_p_field_value_ptr -> cv_bit_string, 1, fixed_arg_descriptor.precision);
582             if cv_local_vector_real_fix_bin_1_uns = cv_local_field_real_fix_bin_1_uns
583             then goto CV_RETURN_EQUAL;
584             else if cv_local_vector_real_fix_bin_1_uns < cv_local_field_real_fix_bin_1_uns
585             then goto CV_RETURN_LESS;
586             else goto CV_RETURN_GREATER;
587          end;
588       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_1_unsa = cv_p_field_value_ptr -> cv_based_real_fix_bin_1_unsa
589       then goto CV_RETURN_EQUAL;
590       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_1_unsa < cv_p_field_value_ptr -> cv_based_real_fix_bin_1_unsa
591       then goto CV_RETURN_LESS;
592       else goto CV_RETURN_GREATER;
593 
594 CV_TYPE (34):                                               /* real_fix_bin_2_uns */
595       if arg_descriptor.packed
596       then
597          do;
598             unspec (cv_local_vector_real_fix_bin_2_uns) =
599                copy ("0"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
600                || substr (cv_p_vector_value_ptr -> cv_bit_string, 1, fixed_arg_descriptor.precision);
601             unspec (cv_local_field_real_fix_bin_2_uns) =
602                copy ("0"b, 2 * BITS_PER_WORD - fixed_arg_descriptor.precision)
603                || substr (cv_p_field_value_ptr -> cv_bit_string, 1, fixed_arg_descriptor.precision);
604             if cv_local_vector_real_fix_bin_2_uns = cv_local_field_real_fix_bin_2_uns
605             then goto CV_RETURN_EQUAL;
606             else if cv_local_vector_real_fix_bin_2_uns < cv_local_field_real_fix_bin_2_uns
607             then goto CV_RETURN_LESS;
608             else goto CV_RETURN_GREATER;
609          end;
610       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_2_unsa = cv_p_field_value_ptr -> cv_based_real_fix_bin_2_unsa
611       then goto CV_RETURN_EQUAL;
612       else if cv_p_vector_value_ptr -> cv_based_real_fix_bin_2_unsa < cv_p_field_value_ptr -> cv_based_real_fix_bin_2_unsa
613       then goto CV_RETURN_LESS;
614       else goto CV_RETURN_GREATER;
615 
616 CV_TYPE (43):                                               /* real_fix_dec_4bit_bytealigned_ls */
617       call
618          dmu_compare_decimal_values$dmu_compare_dec4ls (fixed_arg_descriptor.precision + SIGN, cv_p_vector_value_ptr,
619          cv_p_field_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key);
620       return;
621 
622 CV_TYPE (44):                                               /* real_flt_dec_4bit_byte_alig ned_dtype */
623       call
624          dmu_compare_decimal_values$dmu_compare_dec4fl (arg_descriptor.size + SIGN + BIT4_DECIMAL_EXPONENT,
625          cv_p_vector_value_ptr, cv_p_field_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key);
626       return;
627 
628 CV_TYPE (45):                                               /* cplx_fix_dec_4bit_bytealigned_ls */
629       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
630       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
631 
632       cv_vector_imaginary_part_value_ptr =
633          addcharno (cv_p_vector_value_ptr, ceil (divide (fixed_arg_descriptor.precision + 2, 2, 35, 18)));
634       cv_field_imaginary_part_value_ptr =
635          addcharno (cv_p_field_value_ptr, ceil (divide (fixed_arg_descriptor.precision + 2, 2, 35, 18)));
636 
637       call
638          dmu_compare_decimal_values$dmu_compare_dec4ls (fixed_arg_descriptor.precision + SIGN,
639          cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key)
640          ;
641       if cv_p_vector_equal_to_key
642       then call
643               dmu_compare_decimal_values$dmu_compare_dec4ls (fixed_arg_descriptor.precision + SIGN,
644               cv_vector_imaginary_part_value_ptr, cv_field_imaginary_part_value_ptr, cv_p_vector_equal_to_key,
645               cv_p_vector_less_than_key);
646 
647       return;
648 
649 CV_TYPE (46):                                               /* cplx_flt_dec_4bit_bytealigned */
650       cv_vector_real_part_value_ptr = cv_p_vector_value_ptr;
651       cv_field_real_part_value_ptr = cv_p_field_value_ptr;
652 
653       cv_vector_imaginary_part_value_ptr =
654          addcharno (cv_p_vector_value_ptr, ceil (divide (fixed_arg_descriptor.precision + 4, 2, 35, 18)));
655       cv_field_imaginary_part_value_ptr =
656          addcharno (cv_p_field_value_ptr, ceil (divide (fixed_arg_descriptor.precision + 4, 2, 35, 18)));
657 
658       call
659          dmu_compare_decimal_values$dmu_compare_dec4fl (arg_descriptor.size + SIGN + BIT4_DECIMAL_EXPONENT,
660          cv_vector_real_part_value_ptr, cv_field_real_part_value_ptr, cv_p_vector_equal_to_key, cv_p_vector_less_than_key)
661          ;
662       if cv_p_vector_equal_to_key
663       then call
664               dmu_compare_decimal_values$dmu_compare_dec4fl (arg_descriptor.size + SIGN + BIT4_DECIMAL_EXPONENT,
665               cv_vector_imaginary_part_value_ptr, cv_field_imaginary_part_value_ptr, cv_p_vector_equal_to_key,
666               cv_p_vector_less_than_key);
667 
668       return;
669 
670 
671 CV_TYPE (13):
672 CV_TYPE (14):
673 CV_TYPE (15):
674 CV_TYPE (16):
675 CV_TYPE (17):
676 CV_TYPE (18):
677 CV_TYPE (23):
678 CV_TYPE (24):
679 CV_TYPE (25):
680 CV_TYPE (26):
681 CV_TYPE (27):
682 CV_TYPE (28):
683 CV_TYPE (29):
684 CV_TYPE (30):
685 CV_TYPE (31):
686 CV_TYPE (32):
687 CV_TYPE (35):
688 CV_TYPE (36):
689 CV_TYPE (37):
690 CV_TYPE (38):
691 CV_TYPE (39):
692 CV_TYPE (40):
693 CV_TYPE (41):
694 CV_TYPE (42):
695       cv_p_code = dm_error_$unimplemented_data_type;
696       return;
697 
698 CV_RETURN_EQUAL:
699       cv_p_vector_equal_to_key = "1"b;
700       cv_p_vector_less_than_key = "0"b;
701       return;
702 
703 CV_RETURN_LESS:
704       cv_p_vector_equal_to_key = "0"b;
705       cv_p_vector_less_than_key = "1"b;
706       return;
707 
708 CV_RETURN_GREATER:
709       cv_p_vector_equal_to_key = "0"b;
710       cv_p_vector_less_than_key = "0"b;
711       return;
712 ^L
713 %include arg_descriptor;
714 %page;
715 %include std_descriptor_types;
716 %page;
717 %include sub_err_flags;
718    end COMPARE_VALUES;
719 
720 /* END INCLUDE FILE - dm_comp_vec_str_proc.incl.pl1 */