Skip to content

Commit

Permalink
Merge SVN 5166
Browse files Browse the repository at this point in the history
  • Loading branch information
ddeclerck committed Jan 27, 2025
1 parent 874afa9 commit 47cb2ba
Show file tree
Hide file tree
Showing 5 changed files with 63 additions and 54 deletions.
16 changes: 15 additions & 1 deletion NEWS
Original file line number Diff line number Diff line change
Expand Up @@ -92,6 +92,20 @@ Open Plans:
* "indent" run
* ...

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

GnuCOBOL 3.3 (planned December 2023)

work in progress

* New GnuCOBOL features

work in progress

* Important Bugfixes

** #904: MOVE PACKED-DECIMAL unsigned to signed led to bad sign

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

GnuCOBOL 3.2
Expand Down Expand Up @@ -436,7 +450,7 @@ Open Plans:

** the -P flag accepts - as argument for stdout

* Important Bugfixes:
* Important Bugfixes

** for dialects other than the GnuCOBOL default different reserved "alias" words
were not usable, for example SYNCHRONIZED or COMPUTATIONAL. This was fixed
Expand Down
7 changes: 6 additions & 1 deletion libcob/ChangeLog
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,11 @@
* fisam.c: Updated to set index field type for 'short' & 'int'
Enabled support for variable length records is using V-ISAM/D-ISAM

2023-08-17 Simon Sobisch <[email protected]>

* numeric.c (cob_move_bcd): fix bug #904 unsigned to signed must write
positive sign

2023-07-28 Simon Sobisch <[email protected]>

* screenio.c, common.c: replace use of NCURSES_MOUSE_VERSION by
Expand Down Expand Up @@ -6503,7 +6508,7 @@ after suggestions by Chuck Haatvedt <[email protected]>
2005-04-13 Keisuke Nishida <[email protected]>

* byteswap.h: #include <sys/types.h>. Use u_int16_t, u_int32_t, and
u_int64_t instead of unsigned short, etc.
u_int64_t instead of unsigned short, etc.

2005-03-03 Roger While <[email protected]>

Expand Down
22 changes: 12 additions & 10 deletions libcob/common.c
Original file line number Diff line number Diff line change
Expand Up @@ -1642,21 +1642,20 @@ cob_get_sign_ebcdic (unsigned char *p)
*p = sign_nibble;
}
switch (sign_nibble) {
/* negative */
/* positive */
case 0xC0:
/* negative, non-preferred */
/* positive, non-preferred */
case 0xA0:
case 0xE0:
return 1;
/* positive */
/* negative */
case 0xD0:
/* positive, non-preferred */
/* negative, non-preferred */
case 0xB0:
return -1;
/* unsigned */
case 0xF0:
return 0;
return -1;
default:
/* What to do here outside of sign nibbles? */
return 1;
Expand Down Expand Up @@ -4348,25 +4347,28 @@ cob_is_numeric (const cob_field *f)
{
const char sign = *end & 0x0F;
if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
/* COMP-6 - Check last nibble */
/* COMP-6 - check low nibble as digit */
if (sign > 0x09) {
return 0;
}
} else if (COB_FIELD_HAVE_SIGN (f)) {
if (COB_MODULE_PTR->flag_host_sign
&& sign == 0x0F) {
/* all fine, go on */
/* hostsign: "no sign" == "positive", so go on */
} else
if (sign != 0x0C
&& sign != 0x0D) {
/* expect explicit "positive" 0x0C
or "negative" 0x0D sign */
return 0;
}
} else if (sign != 0x0F) {
/* unsigned must be "no sign" 0x0F */
return 0;
}
}

/* Check high nibble of last byte */
/* Check high nibble of last byte for digit */
if ((*end & 0xF0) > 0x90) {
return 0;
}
Expand Down Expand Up @@ -6609,7 +6611,7 @@ cob_sys_system (const void *cmdline)
while GNU/Linux returns -1 */
status = system (command);
if (cobglobptr->cob_screen_initialized) {
cob_screen_set_mode (1U);
cob_screen_set_mode (1);
}
#ifdef WIFSIGNALED
if (WIFSIGNALED (status)) {
Expand Down Expand Up @@ -7188,7 +7190,7 @@ get_sleep_nanoseconds_from_seconds (cob_field *decimal_seconds) {
}
if (seconds >= MAX_SLEEP_TIME) {
return (cob_s64_t)MAX_SLEEP_TIME * 1000000000;
} else {
} else {
cob_s64_t nanoseconds;
cob_field temp;
temp.size = 8;
Expand Down
68 changes: 28 additions & 40 deletions libcob/numeric.c
Original file line number Diff line number Diff line change
Expand Up @@ -1058,7 +1058,7 @@ cob_set_packed_zero (cob_field *f)
static void
cob_decimal_set_packed (cob_decimal *d, cob_field *f)
{
register unsigned char *p = f->data;
register unsigned char *p = f->data;
const int nibtest = !!COB_FIELD_NO_SIGN_NIBBLE (f);
const unsigned char *endp = p + f->size - 1 + nibtest;
cob_uli_t byteval;
Expand Down Expand Up @@ -1091,13 +1091,6 @@ cob_decimal_set_packed (cob_decimal *d, cob_field *f)
p++;
}
}
if (byteval == 0) {
while (p < endp
&& *p == 0x00) { /* Skip leading ZEROs */
digits -= 2;
p++;
}
}
if (digits < MAX_LLI_DIGITS_PLUS_1) {
/* note: similar logic in move.c (packed_get_long_long, packed_get_int)
so for all adjustments here - check there, too */
Expand All @@ -1109,7 +1102,7 @@ cob_decimal_set_packed (cob_decimal *d, cob_field *f)

if (!nibtest) {
val = val * 10
+ (*p >> 4);
+ (*p >> 4);
}
#ifdef COB_LI_IS_LL
mpz_set_ui (d->value, (cob_uli_t)val);
Expand Down Expand Up @@ -2352,7 +2345,6 @@ cob_addsub_optimized (cob_field *f1, cob_field *f2,
return 0;
}


void
cob_add (cob_field *f1, cob_field *f2, const int opt)
{
Expand Down Expand Up @@ -2473,8 +2465,8 @@ cob_shift_left_nibble (unsigned char *ptr_buff, unsigned char *ptr_start_data_by
unsigned char carry_nibble;
unsigned char move_nibble = 0xFF;

/* calculate the length of data to be shifted */
const int len1 = 48 - (ptr_start_data_byte - ptr_buff);
/* calculate the length of data to be shifted, never much */
const int len1 = 48 - (int)(ptr_start_data_byte - ptr_buff);

/* add one to ensure the carry nibble is moved */
register int shift_cntr = len1 + 1;
Expand Down Expand Up @@ -2536,8 +2528,8 @@ cob_shift_right_nibble (unsigned char *ptr_buff, unsigned char *ptr_start_data_b
cob_u64_t carry_nibble;
cob_u64_t move_nibble = 0xFF;

/* calculate the length of data to be shifted */
const int len1 = 48 - (ptr_start_data_byte - ptr_buff);
/* calculate the length of data to be shifted, never much */
const int len1 = 48 - (int)(ptr_start_data_byte - ptr_buff);

register int shift_cntr = len1;

Expand Down Expand Up @@ -2614,7 +2606,7 @@ cob_move_bcd (cob_field *f1, cob_field *f2)
if (COB_FIELD_NO_SIGN_NIBBLE (f1)) {
fld1_sign = 0x00;
} else {
fld1_sign = *(fld1 + fld1_size - 1) & 0X0F;
fld1_sign = *(fld1 + fld1_size - 1) & 0x0F;
}

/************************************************************/
Expand Down Expand Up @@ -2706,26 +2698,21 @@ cob_move_bcd (cob_field *f1, cob_field *f2)
}

if (f2_has_no_sign_nibble) {
/************************************************************/
/* The following will clear the "pad" nibble if present */
/************************************************************/
/* clear pad nibble, if present */
if (COB_FIELD_DIGITS (f2) & 1 /* -> digits % 2 == 1 */) {
*fld2 &= 0x0F;
}
} else {
/* set sign nibble */
unsigned char *pos = fld2 + fld2_size - 1;
if (COB_FIELD_HAVE_SIGN (f2)) {
if (!fld1_sign) {
*pos &= 0xF0;
*pos |= 0x0C;
} else {
*pos &= 0xF0;
*pos |= fld1_sign;
}
} else {
*pos &= 0xF0;
if (!COB_FIELD_HAVE_SIGN (f2)) {
*pos |= 0x0F;
} else if (fld1_sign == 0x0D) {
*pos = (*pos & 0xF0) | 0x0D;
} else {
*pos = (*pos & 0xF0) | 0x0C;
}
/* clear pad nibble, if present */
if (!(COB_FIELD_DIGITS (f2) & 1) /* -> digits % 2 == 0 */) {
*fld2 &= 0x0F;
}
Expand Down Expand Up @@ -2908,7 +2895,7 @@ static int
check_overflow_and_set_sign (cob_field *f, const int opt,
int final_positive, unsigned char *buff, unsigned char *pos)
{
const int buff_size = 48 - (pos - buff);
const int buff_size = 48 - (int)(pos - buff);
const int fsize = (int)f->size;
int cmp_size = buff_size - fsize;
unsigned char *last_buff_pos = buff + 48 - 1;
Expand Down Expand Up @@ -3026,9 +3013,9 @@ cob_add_bcd (cob_field *fdst,
const unsigned char *src2_data = COB_FIELD_DATA (fsrc2);

unsigned char fld1_sign = COB_FIELD_NO_SIGN_NIBBLE (fsrc1) ? 0x00
: *(src1_data + fld1_size - 1) & 0X0F;
: *(src1_data + fld1_size - 1) & 0x0F;
const unsigned char fld2_sign = COB_FIELD_NO_SIGN_NIBBLE (fsrc2) ? 0x00
: *(src2_data + fld2_size - 1) & 0X0F;
: *(src2_data + fld2_size - 1) & 0x0F;

const signed short src1_scale = COB_FIELD_SCALE (fsrc1);
const signed short src2_scale = COB_FIELD_SCALE (fsrc2);
Expand Down Expand Up @@ -3156,9 +3143,9 @@ cob_add_bcd (cob_field *fdst,

/* find the length of the longer buffer data */
if (fld1 - fld1_buff > fld2 - fld2_buff) {
loop_limit = 48 - (fld2 - fld2_buff) + 1;
loop_limit = 48 - (int)(fld2 - fld2_buff) + 1;
} else {
loop_limit = 48 - (fld1 - fld1_buff) + 1;
loop_limit = 48 - (int)(fld1 - fld1_buff) + 1;
}

/* note: both fl1 and fld2 point at the _last_ position of the
Expand Down Expand Up @@ -3486,17 +3473,18 @@ cob_display_add_int (cob_field *f, int n, const int opt)
}

if (scale < 0) {
/* PIC 9(n)P(m) */
/* PIC 9(n)P(m) -> adjust "val"
by applying the same scale (cut integer positions) */
if (-scale < 10) {
/* Fix optimizer bug */
while (scale) {
++scale;
n /= 10;
}
} else {
scale = 0;
n = 0;
}
scale = 0;
if (n == 0) {
return 0;
}
Expand Down Expand Up @@ -3673,9 +3661,9 @@ cob_add_int (cob_field *f, const int n, const int opt)
if (scale < 0) {
/* PIC 9(n)P(m) */
if (-scale < 10) {
while (scale++) {
val /= 10;
}
while (scale++) {
val /= 10;
}
} else {
val = 0;
}
Expand Down Expand Up @@ -3873,8 +3861,8 @@ packed_is_negative (cob_field *f)
checking backwards from before sign until end == start */
while (data != end) {
if (*--end != 0) {
return 1;
}
return 1;
}
}
/* all zero -> not negative, even with the sign telling so */
return 0;
Expand Down
4 changes: 2 additions & 2 deletions tests/testsuite.src/data_packed.at
Original file line number Diff line number Diff line change
Expand Up @@ -5781,7 +5781,7 @@ AT_DATA([prog.cob], [
MOVE FLD0498A TO FLD0498C.
MOVE FLD0499A TO FLD0499C.

4000-COMPARE.
*4000-COMPARE.

IF FLD0001C (1:) NOT EQUAL XPC-FLD0001C
DISPLAY 'FLD0001C ==> ' HEX-OF (FLD0001C)
Expand Down Expand Up @@ -10821,7 +10821,7 @@ AT_DATA([prog2.cob], [
MOVE FLD0998A TO FLD0998C.
MOVE FLD0999A TO FLD0999C.

4000-COMPARE.
*4000-COMPARE.

IF FLD0500C (1:) NOT EQUAL XPC-FLD0500C
DISPLAY 'FLD0500C ==> ' HEX-OF (FLD0500C)
Expand Down

0 comments on commit 47cb2ba

Please sign in to comment.