right_side_ref->field,
refer_offset(*right_side_ref),
hilo_right);
+
IF( hilo_left, eq_op, integer_one_node )
{
// left side is hi-value
NULL_TREE));
// compared = true; // Commented out to quiet cppcheck
}
-
-// gg_printf(" result is %d\n", return_int, NULL_TREE);
}
static void
mh_numeric_display( const cbl_refer_t &destref,
const cbl_refer_t &sourceref,
const TREEPLET &tsource,
- tree size_error)
+ tree size_error)
{
bool moved = false;
&& !(sourceref.field->attr & scaled_e) )
{
Analyze();
- // I believe that there are 225 pathways through the following code. That's
- // because there are five different valid combination of signable_e,
+ // I believe that there are 450 pathways through the following code.
+ // That's because there are five different valid combination of signable_e,
// separate_e, and leading_e. There are three possibilities for
- // sender/receiver rdigits (too many, too few, and just right), and the same
- // for ldigits. 5 * 5 * 3 * 3 = 225.
+ // sender/receiver rdigits (too many, too few, and just right), and the
+ // same for ldigits. 5 * 5 * 3 * 3 * 2 = 450.
// Fasten your seat belts.
- // In order to simplify processing of a signable internal sender, we are
- // going to pick up the sign byte and temporarily turn off the sign bit in
- // the source data. At the end, we will restore that value. This
- // reflexively makes me a bit nervous (it isn't, for example, thread-safe),
- // but it makes life easier.
-
- static tree source_sign_loc = gg_define_variable(UCHAR_P, "..mhnd_sign_loc", vs_file_static);
- static tree source_sign_byte = gg_define_variable(UCHAR, "..mhnd_sign_byte", vs_file_static);
- static tree dest_p = gg_define_variable(UCHAR_P, "..mhnd_dest", vs_file_static); // The destination data pointer
- static tree source_p = gg_define_variable(UCHAR_P, "..mhnd_source", vs_file_static); // The source data pointer
- static tree source_ep = gg_define_variable(UCHAR_P, "..mhnd_source_e", vs_file_static); // When we need an end pointer
+ // This routine is complicated by the fact that although I had several
+ // false starts of putting this into libgcobol, I keep coming back to the
+ // fact that assignment of zoned values is common. And, so, there are all
+ // kinds of things that are known at compile time that would turn into
+ // execution-time decisions if I moved them to the library. So, complex
+ // or not, I am doing all this code here at compile time because it will
+ // minimize the code at execution time.
+
+ // One thing to keep in mind is the problem caused by a source value being
+ // internally signed. That turns an ASCII "123" into "12t", and we
+ // very probably don't want that "t" to find its way into the destination
+ // value. The internal sign characteristic of ASCII is that the high
+ // nybble of the sign location is 0x30 or 0x70. For EBCDIC, the high
+ // nybble is 0xC0 for positive values, and 0xD0 for negative; all other
+ // digits are 0x70.
+
+ static tree source_sign_loc = gg_define_variable(UCHAR_P,
+ "..mhnd_sign_loc",
+ vs_file_static);
+ static tree source_sign_byte = gg_define_variable(UCHAR,
+ "..mhnd_sign_byte",
+ vs_file_static);
+ // The destination data pointer
+ static tree dest_p = gg_define_variable( UCHAR_P,
+ "..mhnd_dest",
+ vs_file_static);
+ // The source data pointer
+ static tree source_p = gg_define_variable( UCHAR_P,
+ "..mhnd_source",
+ vs_file_static);
+ // When we need an end pointer
+ static tree source_ep = gg_define_variable( UCHAR_P,
+ "..mhnd_source_e",
+ vs_file_static);
gg_assign(dest_p, qualified_data_location(destref));
gg_assign(source_p, gg_add(member(sourceref.field, "data"),
tsource.offset));
- if( sourceref.field->attr & signable_e )
+ bool source_is_signable = sourceref.field->attr & signable_e;
+ bool source_is_leading = sourceref.field->attr & leading_e;
+ bool source_is_separate = sourceref.field->attr & separate_e;
+
+ bool dest_is_signable = destref.field->attr & signable_e;
+ bool dest_is_leading = destref.field->attr & leading_e;
+ bool dest_is_separate = destref.field->attr & separate_e;
+
+ if( source_is_signable )
{
- // The source is signable
+ // The source is signable, so we are going to calculate the location of
+ // the source sign information.
+
+ gg_assign(source_sign_loc,
+ gg_add(member(sourceref.field->var_decl_node, "data"),
+ tsource.offset));
- if( !(sourceref.field->attr & leading_e) )
+ if( (source_is_leading) )
{
- // The sign location is trailing. Whether separate or not, the location
- // is the final byte of the data:
- gg_assign(source_sign_loc, gg_add(member( sourceref.field->var_decl_node, "data"),
- tsource.offset)),
- gg_assign(source_sign_loc,
- gg_add(source_sign_loc,
- build_int_cst_type(SIZE_T,
- sourceref.field->data.capacity-1)));
- if( (sourceref.field->attr & separate_e) )
- {
- // We have trailing separate
- }
- else
+ // The source sign location is in the leading position.
+ if( source_is_separate )
{
- // We have trailing internal
+ // We have LEADING SEPARATE, so the first actual digit is at
+ // source_p+1.
+ gg_increment(source_p);
}
}
else
{
- // The source sign location is in the leading position.
+ // The sign location is trailing. Whether separate or not, the
+ // location is the final byte of the data:
gg_assign(source_sign_loc,
- gg_add(member(sourceref.field->var_decl_node, "data"),
- tsource.offset));
- if( (sourceref.field->attr & separate_e) )
- {
- // We have leading separate, so the first actual digit is at
- // source_p+1.
- gg_increment(source_p);
- }
- else
- {
- // We have leading internal
- }
+ gg_add(source_sign_loc,
+ build_int_cst_type(SIZE_T,
+ sourceref.field->data.capacity-1)));
}
// Pick up the byte that contains the sign data, whether internal or
// external:
gg_assign(source_sign_byte, gg_indirect(source_sign_loc));
- if( !(sourceref.field->attr & separate_e) )
+ if( !source_is_separate )
{
- // This is signable and internal, so we want to turn off the sign bit
- // in the original source data
- if( internal_codeset_is_ebcdic() )
- {
- gg_assign(gg_indirect(source_sign_loc),
- gg_bitwise_or(source_sign_byte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
- }
- else
- {
- gg_assign(gg_indirect(source_sign_loc),
- gg_bitwise_and( source_sign_byte,
- build_int_cst_type( UCHAR,
- ~NUMERIC_DISPLAY_SIGN_BIT)));
- }
+ // The source is signable and internal. We will modify the zone of
+ // the source sign byte to force it to be plain vanilla positive.
+
+ // When the move is done, we will replace that byte with the original
+ // value.
+ gg_assign(gg_indirect(source_sign_loc),
+ gg_bitwise_or(build_int_cst_type(UCHAR, ZONED_ZERO),
+ gg_bitwise_and( source_sign_byte,
+ build_int_cst_type( UCHAR, 0x0F))));
}
}
- else
- {
- // The number is unsigned, so do nothing.
- }
// Let the shenanigans begin.
// The first thing to do is see if we need to output a leading sign
// character
- if( (destref.field->attr & signable_e)
- && (destref.field->attr & leading_e)
- && (destref.field->attr & separate_e) )
+ if( dest_is_signable
+ && dest_is_leading
+ && dest_is_separate )
{
// The output is signed, separate, and leading, so the first character
// needs to be either '+' or '-'
- if( (sourceref.field->attr & separate_e) )
+ if( source_is_separate )
{
- // The source is signable/separate
- // Oooh. Shiny. We already have that character.
+ // The source and dest are both signable/separate.
+ // Oooh. Shiny. We already have the sign character from the source,
+ // so we assign that to the destination.
gg_assign(gg_indirect(dest_p), source_sign_byte);
}
else
{
- // The source is internal. Not that up above we set source_sign_byte
- // even for source values that aren't signable
- if( internal_codeset_is_ebcdic() )
+ // The source is internal.
+ if( source_is_signable )
{
- // We are working in EBCDIC
- if( sourceref.field->attr & signable_e )
+ IF( gg_bitwise_and( source_sign_byte,
+ build_int_cst_type( UCHAR,
+ NUMERIC_DISPLAY_SIGN_BIT)),
+ ne_op,
+ build_int_cst_type( UCHAR, 0) )
{
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- eq_op,
- build_int_cst_type( UCHAR, 0) )
- {
- // The source was negative
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, EBCDIC_MINUS));
+ // The source was negative
+ gg_assign(gg_indirect(dest_p),
+ build_int_cst_type( UCHAR, SEPARATE_MINUS));
- }
- ELSE
- {
- // The source was positive
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, EBCDIC_PLUS));
- }
- ENDIF
}
- else
+ ELSE
{
- // The source is not signable, so the result is positive
+ // The source was positive
gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, EBCDIC_PLUS));
+ build_int_cst_type( UCHAR, SEPARATE_PLUS));
}
+ ENDIF
}
else
{
- // We are working in ASCII
- if( sourceref.field->attr & signable_e )
- {
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- ne_op,
- build_int_cst_type( UCHAR, 0) )
- {
- // The source was negative
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, '-'));
-
- }
- ELSE
- {
- // The source was positive
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, '+'));
- }
- ENDIF
- }
- else
- {
- // The source is not signable, so the result is positive
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, '+'));
- }
+ // The source is not signable, so the signed becomes positive no
+ // matter what the sign of the source.
+ gg_assign(gg_indirect(dest_p),
+ build_int_cst_type( UCHAR, SEPARATE_PLUS));
}
}
gg_increment(dest_p);
// The destination has more ldigits than the source, and needs some
// leading zeroes:
picky_memset( dest_p,
- internal_codeset_is_ebcdic() ?
- EBCDIC_ZERO : '0' ,
+ ZONED_ZERO ,
dest_ldigits - source_ldigits);
// With the leading zeros set, copy over the ldigits:
digit_count = source_ldigits;
IF( gg_indirect(source_p),
ne_op,
build_int_cst_type( UCHAR,
- internal_codeset_is_ebcdic() ?
- EBCDIC_ZERO : '0') )
+ ZONED_ZERO) )
{
set_exception_code(ec_size_truncation_e);
gg_assign(size_error, integer_one_node);
// over only the necessary rdigits, discarding the ones to the right.
digit_count += dest_rdigits;
}
-
picky_memcpy(dest_p, source_p, digit_count);
picky_memset( dest_p,
- internal_codeset_is_ebcdic() ?
- EBCDIC_ZERO : '0' ,
+ ZONED_ZERO ,
trailing_zeros);
// With the digits in place, we need to sort out what to do if the target
// is signable:
- if( destref.field->attr & signable_e )
+ if( dest_is_signable )
{
- if( (destref.field->attr & separate_e)
- && !(destref.field->attr & leading_e) )
+ if( dest_is_separate
+ && !dest_is_leading )
{
// The target is separate/trailing, so we need to tack a '+'
// or '-' character
- if( sourceref.field->attr & separate_e )
+ if( source_is_separate )
{
- // The source was separate, so we already have what we need in t
+ // The source was separate, so we already have what we need in the
// source_sign_byte:
gg_assign(gg_indirect(dest_p), source_sign_byte);
gg_increment(dest_p);
else
{
// The source is either internal, or unsigned
- if( sourceref.field->attr & signable_e )
+ if( source_is_signable )
{
// The source is signable/internal, so we need to extract the
// sign bit from source_sign_byte
- if( internal_codeset_is_ebcdic() )
+ IF( gg_bitwise_and( source_sign_byte,
+ build_int_cst_type( UCHAR,
+ NUMERIC_DISPLAY_SIGN_BIT)),
+ ne_op,
+ build_int_cst_type( UCHAR, 0) )
{
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- eq_op,
- build_int_cst_type( UCHAR, 0) )
- {
- // The source was negative
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, EBCDIC_MINUS));
+ // The source was negative
+ gg_assign(gg_indirect(dest_p),
+ build_int_cst_type( UCHAR, SEPARATE_MINUS));
- }
- ELSE
- {
- // The source was positive
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, EBCDIC_PLUS));
- }
- ENDIF
}
- else
+ ELSE
{
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type( UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- ne_op,
- build_int_cst_type( UCHAR, 0) )
- {
- // The source was negative
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, '-'));
-
- }
- ELSE
- {
- // The source was positive
- gg_assign(gg_indirect(dest_p),
- build_int_cst_type( UCHAR, '+'));
- }
- ENDIF
+ // The source was positive
+ gg_assign(gg_indirect(dest_p),
+ build_int_cst_type( UCHAR, SEPARATE_PLUS));
}
+ ENDIF
}
else
{
// The source is unsigned, so dest is positive
gg_assign(gg_indirect(dest_p),
build_int_cst_type( UCHAR,
- internal_codeset_is_ebcdic() ?
- EBCDIC_PLUS : '+' ));
+ SEPARATE_PLUS));
}
}
gg_increment(dest_p);
}
- else if( !(destref.field->attr & separate_e) )
+ else if( !dest_is_separate )
{
// The destination is signed/internal
- if( destref.field->attr & leading_e )
+ if( dest_is_leading )
{
// The sign bit goes into the first byte:
gg_assign(dest_p, qualified_data_location(destref));
// The sign bit goes into the last byte:
gg_decrement(dest_p);
}
- if( sourceref.field->attr & signable_e )
+ // dest_p now points to the internal sign location
+ if( internal_codeset_is_ebcdic() )
{
- if( sourceref.field->attr & separate_e )
+ // For EBCDIC, the zone is going to end up being 0xC0 or 0xD0
+ gg_assign(gg_indirect(dest_p),
+ gg_bitwise_and(gg_indirect(dest_p),
+ build_int_cst_type(UCHAR,
+ ZONE_SIGNED_EBCDIC+0x0F)));
+ }
+
+ if( source_is_signable )
+ {
+ if( source_is_separate )
{
// The source is separate, so source_sign_byte is '+' or '-'
IF( source_sign_byte,
eq_op,
- build_int_cst_type(UCHAR,
- internal_codeset_is_ebcdic() ?
- EBCDIC_MINUS : '-') )
+ build_int_cst_type(UCHAR, SEPARATE_MINUS) )
{
- // The source is negative, so turn the ASCII bit on
- if( !internal_codeset_is_ebcdic() )
- {
- gg_assign(gg_indirect(dest_p),
- gg_bitwise_or(gg_indirect(dest_p),
- build_int_cst_type(
- UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
-
- }
- else
- {
- // It's ebcdic, so turn the sign bit OFF
- gg_assign(gg_indirect(dest_p),
- gg_bitwise_and(gg_indirect(dest_p),
- build_int_cst_type(
- UCHAR,
- ~NUMERIC_DISPLAY_SIGN_BIT)));
- }
+ // The source is negative, so turn on the internal "is minus" bit
+ gg_assign(gg_indirect(dest_p),
+ gg_bitwise_or(gg_indirect(dest_p),
+ build_int_cst_type(
+ UCHAR,
+ NUMERIC_DISPLAY_SIGN_BIT)));
}
ELSE
- {
- // The source is positive, so turn the EBCDIC bit ON:
- if( internal_codeset_is_ebcdic() )
- {
- gg_assign(gg_indirect(dest_p),
- gg_bitwise_or(gg_indirect(dest_p),
- build_int_cst_type(
- UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
- }
- }
ENDIF
}
else
{
// The source is signable/internal, so the sign bit is in
// source_sign_byte. Whatever it is, it has to go into dest_p:
- if( internal_codeset_is_ebcdic() )
- {
- // This is EBCDIC, so if the source_sign_byte bit is LOW, we
- // clear that bit in dest_p high.
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type(
- UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- eq_op,
- build_int_cst_type(UCHAR, 0) )
- {
- // The source was negative, so make the dest negative
- gg_assign(gg_indirect(dest_p),
- gg_bitwise_and(gg_indirect(dest_p),
- build_int_cst_type(
- UCHAR,
- ~NUMERIC_DISPLAY_SIGN_BIT)));
- }
- ELSE
- ENDIF
- }
- else
+ IF( gg_bitwise_and( source_sign_byte,
+ build_int_cst_type(
+ UCHAR,
+ NUMERIC_DISPLAY_SIGN_BIT)),
+ ne_op,
+ build_int_cst_type(UCHAR, 0) )
{
- // This is ASCII, so if the source_sign_byte bit is high, we
- // set that bit in dest_p high.
- IF( gg_bitwise_and( source_sign_byte,
- build_int_cst_type(
- UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)),
- ne_op,
- build_int_cst_type(UCHAR, 0) )
- {
- // The source was negative, so make the dest negative
- gg_assign(gg_indirect(dest_p),
- gg_bitwise_or(gg_indirect(dest_p),
- build_int_cst_type(
- UCHAR,
- NUMERIC_DISPLAY_SIGN_BIT)));
- }
- ELSE
- ENDIF
+ // The source was negative, so make the dest negative
+ gg_assign(gg_indirect(dest_p),
+ gg_bitwise_or(gg_indirect(dest_p),
+ build_int_cst_type(
+ UCHAR,
+ NUMERIC_DISPLAY_SIGN_BIT)));
}
+ ELSE
+ ENDIF
}
}
}
}
- if( (sourceref.field->attr & signable_e)
- && !(sourceref.field->attr & separate_e))
+ if( source_is_signable
+ && !source_is_separate)
{
// The source is signable internal, so we need to restore the original
// sign byte in the original source data:
moved = true;
}
return moved;
- }
+ } //NUMERIC_DISPLAY_SIGN
static bool
mh_little_endian( const cbl_refer_t &destref,
bool negative;
if( real_isneg (&value) )
{
- negative = true;
- value = real_value_negate (&value);
+ negative = true;
+ value = real_value_negate (&value);
}
else
{
- negative = false;
+ negative = false;
}
digits_from_float128(ach, field, field->data.digits, rdigits, value);
&& (field->attr & separate_e)
&& (field->attr & leading_e ) )
{
+ // This zoned decimal value is signable, separate, and leading.
if( negative )
{
*pretval++ = internal_minus;
}
for(size_t i=0; i<field->data.digits; i++)
{
+ // Start by assuming its an value that can't be signed
*pretval++ = internal_zero + ((*digits++) & 0x0F);
}
if( (field->attr & signable_e)
&& (field->attr & separate_e)
&& !(field->attr & leading_e ) )
{
+ // The value is signable, separate, and trailing
if( negative )
{
*pretval++ = internal_minus;
}
}
if( (field->attr & signable_e)
- && !(field->attr & separate_e)
- && negative)
+ && !(field->attr & separate_e) )
{
- if( field->attr & leading_e )
+ // This value is signable, and not separate. So, the sign information
+ // goes into the first or last byte:
+ char *sign_location = field->attr & leading_e ?
+ retval : retval + field->data.digits - 1 ;
+ if( internal_codeset_is_ebcdic() )
{
- if( internal_is_ebcdic )
- {
- retval[0] &= ~NUMERIC_DISPLAY_SIGN_BIT;
- }
- else
- {
- retval[0] |= NUMERIC_DISPLAY_SIGN_BIT;
- }
+ // Change the zone from 0xFO to 0xC0
+ *sign_location &= (ZONE_SIGNED_EBCDIC + 0x0F);
}
- else
+ if( negative )
{
- if( internal_is_ebcdic )
- {
- pretval[-1] &= ~NUMERIC_DISPLAY_SIGN_BIT;
- }
- else
- {
- pretval[-1] |= NUMERIC_DISPLAY_SIGN_BIT;
- }
+ // Turn on the sign bit:
+ *sign_location |= NUMERIC_DISPLAY_SIGN_BIT;
}
}
break;
{
if( internal_is_ebcdic )
{
- *location &= ~NUMERIC_DISPLAY_SIGN_BIT;
+ *location = (*location & 0xF) + 0xD0;
}
else
{
- *location |= NUMERIC_DISPLAY_SIGN_BIT;
+ *location = (*location & 0xF) + 0x70;
}
}
{
if( internal_is_ebcdic )
{
- *location |= NUMERIC_DISPLAY_SIGN_BIT;
+ *location = (*location & 0xF) + 0xF0;
}
else
{
- *location &= ~NUMERIC_DISPLAY_SIGN_BIT;
+ *location = (*location & 0xF) + 0x30;
}
}
}
else
{
- if( internal_is_ebcdic )
- {
- retval = (ch & NUMERIC_DISPLAY_SIGN_BIT) == 0;
- }
- else
- {
- retval = (ch & NUMERIC_DISPLAY_SIGN_BIT) != 0;
- }
+ retval = (ch & NUMERIC_DISPLAY_SIGN_BIT) != 0;
}
return retval;
}
case FldNumericDisplay:
if( var->attr & signable_e )
{
+ /* There is a regrettable plethora of possibilities, here. */
+
+
// Things get exciting when a numeric-display value is signable
if( var->attr & separate_e )
// The sign character goes into the first location
size_error =
__gg__binary_to_string_internal(PTRCAST(char, location+1),
- length-1, value);
+ length-1,
+ value);
location[0] = sign_ch;
}
else
}
else
{
- // The sign information is not separate, so we put it into
- // the number
+ /* The sign information is not separate. The sign information
+ goes into the first byte for LEADING, or the last byte for
+ TRAILING. For ASCII, the zone will be 0x30. For EBCDIC,
+ the the zone is 0xC0. Those get modified, respectively, to
+ 0x70 and 0xD0 when the value is negative. */
+
+ // First, convert the binary value to the correct-length string
size_error =
__gg__binary_to_string_internal(PTRCAST(char, location),
- length, value);
+ length,
+ value);
+ // Check for a size error on a negative value. It conceivably
+ // was truncated down to zero, in which case we need to
+ // suppress this is_negative flag.
if( size_error && is_negative )
{
// If all of the digits are zero, then the result is zero, and
}
}
+ unsigned char *sign_location =
+ var->attr & leading_e ? location : location + length - 1;
+
+ if( internal_is_ebcdic )
+ {
+ // Change the sign location from 0xF0 to 0xC0.
+ *sign_location &= (ZONE_SIGNED_EBCDIC + 0xF);
+ }
+
if( is_negative )
{
- if( var->attr & leading_e )
- {
- // The sign bit goes into the first digit:
- turn_sign_bit_on(&location[0]);
- }
- else
- {
- // The sign bit goes into the last digit:
- turn_sign_bit_on(&location[length-1]);
- }
+ *sign_location |= NUMERIC_DISPLAY_SIGN_BIT;
}
}
}
else
{
// It's a simple positive number
- size_error = __gg__binary_to_string_internal( PTRCAST(char,
- location),
- length, value);
+ size_error = __gg__binary_to_string_internal(
+ PTRCAST(char, location),
+ length,
+ value);
}
break;
{
__int128 retval = 0;
- unsigned char ch;
switch( resolved_var->type )
{
-#if 1
case FldLiteralA :
fprintf(stderr, "%s(): is trying to handle a FldLiteralA\n", __func__);
abort();
// resolved_length,
// rdigits );
break;
-#endif
case FldGroup :
case FldAlphanumeric :
rdigits );
break;
- case FldNumericDisplay :
+ case FldNumericDisplay:
+ {
if( resolved_location[resolved_length-1] == DEGENERATE_HIGH_VALUE )
{
// This is a degenerate case, which violates the language
}
else
{
- // Pick up the sign byte, and force our value to be positive
unsigned char *sign_byte_location;
- if( (resolved_var->attr & separate_e )
- && (resolved_var->attr & leading_e ) )
+ unsigned char ch;
+ if( resolved_var->attr & signable_e )
{
- sign_byte_location = resolved_location;
- ch = *sign_byte_location;
- *sign_byte_location = internal_plus;
- }
- else if( (resolved_var->attr & separate_e)
- && !(resolved_var->attr & leading_e ) )
- {
- sign_byte_location = resolved_location + resolved_length - 1;
- ch = *sign_byte_location;
- *sign_byte_location = internal_plus;
+ // Pick up the sign byte, and force our value to be positive
+ if( (resolved_var->attr & separate_e )
+ && (resolved_var->attr & leading_e ) )
+ {
+ // LEADING SEPARATE
+ sign_byte_location = resolved_location;
+ resolved_location += 1;
+ resolved_length -= 1;
+ ch = *sign_byte_location;
+ *sign_byte_location = internal_plus;
+ }
+ else if( (resolved_var->attr & separate_e)
+ && !(resolved_var->attr & leading_e ) )
+ {
+ // TRAILING SEPARATE
+ sign_byte_location = resolved_location + resolved_length - 1;
+ resolved_length -= 1;
+ ch = *sign_byte_location;
+ *sign_byte_location = internal_plus;
+ }
+ else if( (resolved_var->attr & leading_e) )
+ {
+ // LEADING
+ sign_byte_location = resolved_location;
+ ch = *sign_byte_location;
+ turn_sign_bit_off(sign_byte_location);
+ }
+ else // if( !(resolved_var->attr & leading_e) )
+ {
+ // TRAILING
+ sign_byte_location = resolved_location + resolved_length - 1;
+ ch = *sign_byte_location;
+ turn_sign_bit_off(sign_byte_location);
+ }
}
- else if( (resolved_var->attr & leading_e) )
- {
- sign_byte_location = resolved_location;
- ch = *sign_byte_location;
- turn_sign_bit_off(sign_byte_location);
+
+ // We know where the decimal point is because of rdigits. Because
+ // we know that we have a clean string of digits (either ASCII or
+ // EBCDIC), we can just build up the result:
+
+ static const uint8_t from_ebcdic[256] =
+ {
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x00
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x10
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x20
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x30
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x40
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x50
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x60
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x70
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x80
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x90
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xa0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xb0
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0xc0
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0xd0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xe0
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0xf0
+ };
+
+ static const uint8_t from_ascii[256] =
+ {
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x00
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x10
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x20
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0x30
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x40
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x50
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x60
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0x70
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x80
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x90
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xa0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xb0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xc0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xd0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xe0
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xf0
+ };
+
+ if( internal_is_ebcdic )
+ {
+ for(size_t i=0; i<resolved_length; i++)
+ {
+ retval *= 10;
+ retval += from_ebcdic[resolved_location[i]];
+ }
}
- else // if( !(resolved_var->attr & leading_e) )
+ else
{
- sign_byte_location = resolved_location + resolved_length - 1;
- ch = *sign_byte_location;
- turn_sign_bit_off(sign_byte_location);
+ for(size_t i=0; i<resolved_length; i++)
+ {
+ retval *= 10;
+ retval += from_ascii[resolved_location[i]];
+ }
}
- // We know where the decimal point is because of rdigits. Because
- // we know that it a clean string of ASCII digits, we can use the
- // dirty converter:
- retval = __gg__dirty_to_binary_internal(PTRCAST(const char,
- resolved_location),
- resolved_length,
- rdigits );
*rdigits = resolved_var->rdigits;
- // Restore the sign byte
- *sign_byte_location = ch;
-
- if( ch == internal_minus || is_sign_bit_on(ch) )
+ if( resolved_var->attr & signable_e )
{
- retval = -retval;
+ // Restore the sign byte
+ *sign_byte_location = ch;
+
+ // And if the source is flagged negative, make our result negative
+ if( ch == internal_minus )
+ {
+ retval = -retval;
+ }
+ else
+ {
+ if( internal_is_ebcdic )
+ {
+ // EBCDIC characters:
+ if( (ch & 0xF0) == 0xD0 )
+ {
+ retval = -retval;
+ }
+ }
+ else
+ {
+ // ASCII characters:
+ if( (ch & 0xF0) == 0x70 )
+ {
+ retval = -retval;
+ }
+ }
+ }
}
}
break;
+ }
case FldNumericEdited :
retval = edited_to_binary( PTRCAST(char, resolved_location),
case FldNumericDisplay:
{
+ // Because a NumericDisplay can have any damned thing as a character,
+ // we are going force things that aren't digits to display as '0'
+ static const uint8_t ascii_chars[256] =
+ {
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x00
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x10
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x20
+ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '0', '0', '0', '0', '0', // 0x30
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x40
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x50
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x60
+ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', '0', '0', '0', '0', '0', // 0x70
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x80
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0x90
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xa0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xb0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xc0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xd0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xe0
+ '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', '0', // 0xf0
+ };
+ static const uint8_t ebcdic_chars[256] =
+ {
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x00
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x10
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x20
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x30
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x40
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x50
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x60
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x70
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x80
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0x90
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xa0
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xb0
+ 0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xc0
+ 0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xd0
+ 0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xe0
+ 0xf0,0xf1,0xf2,0xf3,0xf4,0xf5,0xf6,0xf7,0xf8,0xf9,0xf0,0xf0,0xf0,0xf0,0xf0,0xf0, // 0xf0
+ } ;
+
// We are going to make use of fact that a NumericDisplay's data is
// almost already in the format we need. We have to add a decimal point,
// if necessary, in the right place, and we need to tack on leading or
}
}
- {//xxx
- // copy over the characters to the left of the decimal point:
- for(int i=0; i<ldigits; i++ )
- {
- char ch = *running_location++;
+ // copy over the characters to the left of the decimal point:
+ for(int i=0; i<ldigits; i++ )
+ {
+ unsigned char ch = *running_location++;
- // The default HIGH-VALUE of 0xFF runs afoul of the
- // NumericDisplay sign bit 0f 0x40 when running in
- // ASCII mode. The following test handles that problem
- // when HIGH-VALUE is still 0xFF. That HIGH-VALUE can
- // be changed by the SPECIAL-NAMES ALPHABET clause. But
+ // Welcome to COBOL. We might be dealing with a HIGH-VALUE, which
+ // is usually, but not always 0xFF. I am going to handle the 0xFF
+ // case. When the programmer messes with HIGH-VALUE in the
+ // SPECIAL-NAMES ALPHABET clause, then it becomes their problem.
- // I have decided that the onus of that problem is on
- // the user.
- if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
+ // But when it isn't HIGH-VALUE, we don't want to see the effects
+ // of the internal sign.
+ if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
+ {
+ // Another tricky thing, though, is that for various reasons
+ // the string of digits might not be digits. There can be
+ // REDEFINES, or the middle of the number might have been changed
+ // with an INITIALIZE into spaces. But we do want numbers to
+ // look like numbers. So, we do what we can:
+
+ if( internal_is_ebcdic )
{
- turn_sign_bit_off( PTRCAST(unsigned char, &ch));
+ ch = ebcdic_chars[ch];
+ }
+ else
+ {
+ ch = ascii_chars[ch];
}
- (*dest)[index++] = ch;
}
- if( rdigits )
- {
- // Lay down a decimal point
- (*dest)[index++] = ascii_to_internal(__gg__decimal_point);
+ (*dest)[index++] = ch;
+ }
+ if( rdigits )
+ {
+ // Lay down a decimal point
+ (*dest)[index++] = ascii_to_internal(__gg__decimal_point);
- if( ldigits < 0 )
+ if( ldigits < 0 )
+ {
+ // This is a scaled_e value, and we need that many zeroes:
+ for( int i=0; i<-ldigits; i++ )
{
- // This is a scaled_e value, and we need that many zeroes:
- for( int i=0; i<-ldigits; i++ )
- {
- (*dest)[index++] = internal_zero;
- }
+ (*dest)[index++] = internal_zero;
}
+ }
- // And the digits to the right
- for(int i=0; i<rdigits; i++ )
- {
- char ch = *running_location++;
+ // And the digits to the right
+ for(int i=0; i<rdigits; i++ )
+ {
+ unsigned char ch = *running_location++;
if( (*dest)[index-1] != (char)DEGENERATE_HIGH_VALUE )
{
- turn_sign_bit_off(PTRCAST(unsigned char, &ch));
+ if( internal_is_ebcdic )
+ {
+ ch = ebcdic_chars[ch];
+ }
+ else
+ {
+ ch = ascii_chars[ch];
}
- (*dest)[index++] = ch;
}
+ (*dest)[index++] = ch;
}
}
// At this point, for a 999PPP number, we need to tack on the zeroes
{
// These are the characters of the string. When the field is NumericDisplay
// any leading or trailing +/- characters are removed, and any embedded
- // NUMERIC_DISPLAY_SIGN_BIT bits are removed.
+ // minus bits are removed.
std::string the_characters;
size_t offset; // Usually zero. One when there is a leading sign.
size_t length; // Usually the same as the original. But it is one less
for( size_t i=retval.offset; i<retval.length; i++ )
{
// Because we are dealing with a NumericDisplay that might have
- // the NUMERIC_DISPLAY_SIGN_BIT turned on, we need to mask it off
+ // the minus bit turned on, we need to mask it off
unsigned char ch = data[i];
turn_sign_bit_off(&ch);
retval.the_characters += ch;
// We are now set up to accomplish the data flow described
// in the language specification. We loop through the
// the character positions in normalized_id_1:
- const char *leftmost
- = normalized_id_1.the_characters.c_str();
- const char *rightmost
- = leftmost + normalized_id_1.length;
+ const char *leftmost = normalized_id_1.the_characters.c_str();
+ const char *rightmost = leftmost + normalized_id_1.length;
while( leftmost < rightmost )
{
break;
case bound_characters_e:
- match = 1;
+ match = true;
break;
case bound_all_e:
projects / thirdparty / gcc.git / commitdiff
