Skip to content

Commit

Permalink
On-the-fly BCD normalization
Browse files Browse the repository at this point in the history
  • Loading branch information
ddeclerck committed Dec 19, 2024
1 parent afb68b3 commit 2aab2f2
Show file tree
Hide file tree
Showing 26 changed files with 272 additions and 20 deletions.
5 changes: 5 additions & 0 deletions cobc/ChangeLog
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,11 @@

* cobc.c (process_command_line): fix leak for --copy and -include parsing

2024-12-05 David Declerck <[email protected]>

* config.def: new normalize-bcd dialect option
* codegen.c (output_module_init_function): initialize flag_normalize_bcd

2024-10-30 Chuck Haatvedt <[email protected]>

* typeck.c: define [WITH_EXTENDED_SCREENIO] for any curses headers
Expand Down
1 change: 1 addition & 0 deletions cobc/codegen.c
Original file line number Diff line number Diff line change
Expand Up @@ -11391,6 +11391,7 @@ output_module_init_function (struct cb_program *prog)
} else {
output_line ("module->module_sources = NULL;");
}
output_line ("module->flag_normalize_bcd = %d;", cb_normalize_bcd);

output_block_close ();
output_newline ();
Expand Down
3 changes: 3 additions & 0 deletions cobc/config.def
Original file line number Diff line number Diff line change
Expand Up @@ -203,6 +203,9 @@ CB_CONFIG_BOOLEAN (cb_areacheck, "areacheck",
" * statements must not start in Area A; and\n"
" * separator periods must not be within Area A"))

CB_CONFIG_BOOLEAN (cb_normalize_bcd, "normalize-bcd",
_("normalize BCD on-the-fly"))

/* Support flags */

CB_CONFIG_SUPPORT (cb_comment_paragraphs, "comment-paragraphs",
Expand Down
4 changes: 4 additions & 0 deletions config/ChangeLog
Original file line number Diff line number Diff line change
@@ -1,4 +1,8 @@

2024-12-05 David Declerck <[email protected]>

* general: add the normalize-bcd dialect option (active only for GCOS)

2024-08-17 Ammar Almoris <[email protected]>

FR #474: add runtime configuration to hide cursor for extended screenio
Expand Down
3 changes: 3 additions & 0 deletions config/acu-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -202,6 +202,9 @@ subscript-check: max
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/bs2000-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -200,6 +200,9 @@ subscript-check: max # not verified, may need "record"
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/cobol2002.conf
Original file line number Diff line number Diff line change
Expand Up @@ -199,6 +199,9 @@ subscript-check: full
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/cobol2014.conf
Original file line number Diff line number Diff line change
Expand Up @@ -199,6 +199,9 @@ subscript-check: full
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/cobol85.conf
Original file line number Diff line number Diff line change
Expand Up @@ -199,6 +199,9 @@ subscript-check: full
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/default.conf
Original file line number Diff line number Diff line change
Expand Up @@ -219,6 +219,9 @@ subscript-check: full
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/gcos-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -198,6 +198,9 @@ subscript-check: max # not verified, may need "record"
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: yes # TODO: verify

# Normalize BCD on-the-fly
normalize-bcd: yes

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/ibm-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -198,6 +198,9 @@ subscript-check: max # TODO: "record"
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: yes

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/mf-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -201,6 +201,9 @@ subscript-check: max
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/mvs-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -198,6 +198,9 @@ subscript-check: max # TODO: "record"
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: yes

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/realia-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -202,6 +202,9 @@ subscript-check: full # not verified yet
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/rm-strict.conf
Original file line number Diff line number Diff line change
Expand Up @@ -205,6 +205,9 @@ subscript-check: max
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
3 changes: 3 additions & 0 deletions config/xopen.conf
Original file line number Diff line number Diff line change
Expand Up @@ -212,6 +212,9 @@ subscript-check: full
# Functionality of JUSTIFY for INITIALIZE verb and initialization of storage
init-justify: no

# Normalize BCD on-the-fly
normalize-bcd: no

# Dialect features
# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error',
# 'unconformable'
Expand Down
9 changes: 9 additions & 0 deletions libcob/ChangeLog
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,15 @@
* screenio.c [WITH_PANELS]: replace use of ncurses extension ceiling_panel()
with X/Open Curses function panel_below()

2024-12-05 David Declerck <[email protected]>

* common.h: new flag_normalize_bcd field in cob_module
* common.c, coblocal.h (cob_get_sign_from_alnum): new function
to retrieve the "sign" of an ALPHANUMERIC field
* move.c (cob_move_alphanum_to_display),
numeric.c (cob_decimal_set_display): perform BCD
normalization when flag_normalize_bcd is set

2024-11-22 David Declerck <[email protected]>

* move.c (optimized_move_display_to_edited): minor refactoring
Expand Down
1 change: 1 addition & 0 deletions libcob/coblocal.h
Original file line number Diff line number Diff line change
Expand Up @@ -483,6 +483,7 @@ COB_HIDDEN FILE *cob_create_tmpfile (const char *);
COB_HIDDEN int cob_check_numval_f (const cob_field *);

COB_HIDDEN int cob_real_get_sign (cob_field *, const int);
COB_HIDDEN int cob_get_sign_from_alnum (cob_field *);
COB_HIDDEN void cob_real_put_sign (cob_field *, const int);

#ifndef COB_WITHOUT_DECIMAL
Expand Down
19 changes: 19 additions & 0 deletions libcob/common.c
Original file line number Diff line number Diff line change
Expand Up @@ -3843,6 +3843,25 @@ cob_real_get_sign (cob_field *f, const int adjust_ebcdic)
return 0;
}

/* get the "sign" from an alphanumeric field, as if the field
was numeric display with non-separate trailing sign */
int
cob_get_sign_from_alnum (cob_field *f)
{
int sign;
cob_field_attr attr;
cob_field field;
COB_FIELD_INIT (COB_FIELD_SIZE (f), COB_FIELD_DATA (f), &attr);
COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, COB_FIELD_SIZE (f), 0, COB_FLAG_HAVE_SIGN, NULL);
sign = cob_real_get_sign (&field, 0);
if (sign < 0) {
return -1;
} else if (sign > 0) {
return 1;
}
return 0;
}

/* store sign to DISPLAY/PACKED fields */
void
cob_real_put_sign (cob_field *f, const int sign)
Expand Down
2 changes: 2 additions & 0 deletions libcob/common.h
Original file line number Diff line number Diff line change
Expand Up @@ -1337,6 +1337,8 @@ typedef struct __cob_module {
const char *paragraph_name; /* name of current active pagagraph */
enum cob_statement statement; /* statement currently executed */

unsigned char flag_normalize_bcd; /* Should BCD be normalized on-the-fly ? */

} cob_module;


Expand Down
81 changes: 65 additions & 16 deletions libcob/move.c
Original file line number Diff line number Diff line change
Expand Up @@ -309,6 +309,7 @@ cob_move_alphanum_to_display (cob_field *f1, cob_field *f2)
const unsigned char *e2 = s2 + COB_FIELD_SIZE (f2);
const unsigned char dec_pt = COB_MODULE_PTR->decimal_point;
const unsigned char num_sep = COB_MODULE_PTR->numeric_separator;
unsigned char last;
int sign;
int count;
int size;
Expand All @@ -325,21 +326,34 @@ cob_move_alphanum_to_display (cob_field *f1, cob_field *f2)

/* Check for sign */
sign = 0;
if (s1 != e1) {
if (*s1 == '+' || *s1 == '-') {
sign = (*s1++ == '+') ? 1 : -1;
if (!COB_MODULE_PTR->flag_normalize_bcd) {
if (s1 != e1) {
if (*s1 == '+' || *s1 == '-') {
sign = (*s1++ == '+') ? 1 : -1;
}
}
} else {
last = f1->data[f1->size - 1];
sign = cob_get_sign_from_alnum (f1);
}

/* Count the number of digits before decimal point */
count = 0;
{
register unsigned char *p;
for (p = s1; p < e1 && *p != dec_pt; ++p) {
if (!COB_MODULE_PTR->flag_normalize_bcd) {
for (p = s1; p < e1 && *p != dec_pt; ++p) {
/* note: as isdigit is locale-aware (slower and not what we want),
we use a range check instead */
if (*p >= '0' && *p <= '9') {
++count;
if (*p >= '0' && *p <= '9') {
++count;
}
}
} else {
for (p = s1; p < e1 && *p != dec_pt; ++p) {
if (COB_D2I (*p) >= 0 && COB_D2I (*p) <= 9) {
++count;
}
}
}
}
Expand All @@ -349,34 +363,69 @@ cob_move_alphanum_to_display (cob_field *f1, cob_field *f2)
if (count < size) {
s2 += size - count;
} else {
while (count-- > size) {
while (*s1 < '0' || *s1 > '9') {
if (!COB_MODULE_PTR->flag_normalize_bcd) {
while (count-- > size) {
while (*s1 < '0' || *s1 > '9') {
s1++;
}
s1++;
}
} else {
while (count-- > size) {
while (COB_D2I (*s1) < 0 || COB_D2I (*s1) > 9) {
s1++;
}
s1++;
}
s1++;
}
}

/* Move */
count = 0;
for (; s1 < e1 && s2 < e2; ++s1) {
if (*s1 >= '0' && *s1 <= '9') {
*s2++ = *s1;
} else if (*s1 == dec_pt) {
if (count++ > 0) {
if (!COB_MODULE_PTR->flag_normalize_bcd) {
for (; s1 < e1 && s2 < e2; ++s1) {
if (*s1 >= '0' && *s1 <= '9') {
*s2++ = *s1;
} else if (*s1 == dec_pt) {
if (count++ > 0) {
goto error;
}
} else if (!(isspace (*s1) || *s1 == num_sep)) {
goto error;
}
}
} else {
for (; s1 < e1 && s2 < e2; ++s1) {
if (COB_D2I (*s1) >= 0 && COB_D2I (*s1) <= 9) {
#ifndef COB_EBCDIC_MACHINE
*s2++ = (COB_D2I (*s1) | 0x30);
#else
*s2++ = (COB_D2I (*s1) | 0xF0);
#endif
} else if (*s1 == dec_pt) {
if (count++ > 0) {
goto error;
}
} else if (!(isspace (*s1) || *s1 == num_sep)) {
goto error;
}
} else if (!(isspace (*s1) || *s1 == num_sep)) {
goto error;
}
}

COB_PUT_SIGN (f2, sign);
if (COB_MODULE_PTR->flag_normalize_bcd
&& !COB_FIELD_CONSTANT (f1)) {
f1->data[f1->size - 1] = last;
}
return;

error:
memset (f2->data, '0', f2->size);
COB_PUT_SIGN (f2, 0);
if (COB_MODULE_PTR->flag_normalize_bcd
&& !COB_FIELD_CONSTANT (f1)) {
f1->data[f1->size - 1] = last;
}
}

static void
Expand Down
18 changes: 16 additions & 2 deletions libcob/numeric.c
Original file line number Diff line number Diff line change
Expand Up @@ -1446,7 +1446,16 @@ cob_decimal_set_display (cob_decimal *d, cob_field *f)

register unsigned char *data = COB_FIELD_DATA (f);
register unsigned int size = (unsigned int) COB_FIELD_SIZE (f);
const int sign = COB_GET_SIGN_ADJUST (f);
unsigned char last;
int sign;

if (COB_MODULE_PTR->flag_normalize_bcd
&& COB_FIELD_IS_ANY_ALNUM (f)) {
last = f->data[f->size - 1];
sign = cob_get_sign_from_alnum (f);
} else {
sign = COB_GET_SIGN_ADJUST (f);
}

/* TODO: document special cases here */
if (unlikely (*data == 255)) {
Expand Down Expand Up @@ -1540,7 +1549,12 @@ cob_decimal_set_display (cob_decimal *d, cob_field *f)
}
d->scale = COB_FIELD_SCALE (f);

COB_PUT_SIGN_ADJUSTED (f, sign);
if (COB_MODULE_PTR->flag_normalize_bcd
&& COB_FIELD_IS_ANY_ALNUM (f)) {
f->data[f->size - 1] = last;
} else {
COB_PUT_SIGN_ADJUSTED (f, sign);
}
}

/* store value from decimal into field of type numeric DISPLAY */
Expand Down
Loading

0 comments on commit 2aab2f2

Please sign in to comment.