Skip to content

Commit

Permalink
optimization for
Browse files Browse the repository at this point in the history 
libcob/move.c (cob_move_display_to_edited): several optimizations, the biggest one stays open, as it would need an adjusted function call from cobc (TBDL)
  • Loading branch information
sf-mensch committed Dec 16, 2022
1 parent 34052d7 commit fc58039
Show file tree
Hide file tree
Showing 4 changed files with 125 additions and 94 deletions.
17 changes: 9 additions & 8 deletions NEWS
View file
Original file line number Diff line number Diff line change
Expand Up @@ -342,15 +342,15 @@ NEWS - user visible changes -*- outline -*-

** execution times were significantly reduced for the following:
INSPECT that use big COBOL fields (multiple KB)
MOVE and comparisions (especially with enabled runtime checks, to
optimize those a re-compile is needed)
CALL data-item, and first time for each CALL
ACCEPT DATE/TIME/DAY and datetime related FUNCTIONs
MOVE with enabled runtime checks (only with re-compile)

** execution times for programs that are new generated with -fsource-location
(implied with --debug/-fec) are cut down, especially when many "simple"
statements or lot of sections/paragraphs are used; also the runtime checks
for use of LINKAGE fields and/or subscripts/reference-modification will be
much faster
runtime checks for use of LINKAGE/BASED fields and/or
subscripts/reference-modification (re-compile needed)
general: execution of programs generated with -fsource-location
(implied with --debug and -fec), especially when many "simple"
statements or lot of sections/paragraphs are used (re-compile needed)

* New build features

Expand All @@ -360,7 +360,8 @@ NEWS - user visible changes -*- outline -*-
(experimental)
** configure now checks for PERL and passes that as default to make test
** cobc handles SOURCE_DATE_EPOCH now, allowing to override timestamps in
generated code and listing files, allowing reproducible builds
generated code and listing files, allowing reproducible builds of both
GnuCOBOL (extras folder) and COBOL programs

* Obsolete features (will be removed in the next version if no explicit user
requests are raised)
Expand Down
7 changes: 7 additions & 0 deletions TODO
View file
Original file line number Diff line number Diff line change
Expand Up @@ -169,7 +169,11 @@ l_exit:
As a third alternative we can just add a flag that says
"assume I never go out of a section".

4.3 optimizing cob_move_display_to_edited

This function is relative often called in production systems and
re-calculates the picture on runtime, which the compiler already
did - pass this information along with the call.

5 Debugging support

Expand All @@ -185,6 +189,9 @@ access the COBOL data at debugging time.
Note: GnuCOBOL 3 implemented this partially, using extensions
near full GDB support is already possible.

GnuCOBOL 4 provides this quite complete at runtime, too.


6 Better user manual

Yes, we should, for now: refer to the GnuCOBOL Programmer's Guide
Expand Down
3 changes: 2 additions & 1 deletion libcob/ChangeLog
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,8 @@
by checking sign/zero and reduced number of decimal shifting
dynamic allocation
* move.c (store_common_region): minor optimization
* move.c:
* move.c (cob_move_display_to_edited): several optimizations, the
biggest one stays open, needing adjusted function call from cobc

2022-11-04 Simon Sobisch <[email protected]>

Expand Down
192 changes: 107 additions & 85 deletions libcob/move.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -677,6 +677,9 @@ cob_move_binary_to_display (cob_field *f1, cob_field *f2)

/* Edited */

/* create numeric edited field, note: non-display fields
get "unpacked" first via indirect_move, then be edited
from display using this function */
static void
cob_move_display_to_edited (cob_field *f1, cob_field *f2)
{
Expand All @@ -698,6 +701,7 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
int suppress_zero = 1;
int sign_first = 0;
int p_is_left = 0;
int has_b = 0;
int repeat;
int n;
unsigned char pad = ' ';
Expand Down Expand Up @@ -747,71 +751,22 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
}
}

src = max - COB_FIELD_SCALE(f1) - count;
src = max - COB_FIELD_SCALE (f1) - count;
for (p = COB_FIELD_PIC (f2); p->symbol; ++p) {
c = p->symbol;
n = p->times_repeated;
for (; n > 0; n--, ++dst) {
switch (c) {
case '0':
case '/':
*dst = c;
break;

case 'B':
*dst = suppress_zero ? pad : 'B';
break;

case 'P':
if (p_is_left) {
++src;
--dst;
}
break;

case '9':
*dst = (min <= src && src < max) ? *src++ : (src++, '0');
if (*dst != '0') {
x = (min <= src && src < max) ? *src++ : (src++, '0');
if (x != '0') {
is_zero = suppress_zero = 0;
}
suppress_zero = 0;
trailing_sign = 1;
trailing_curr = 1;
break;

case 'V':
--dst;
decimal_point = dst;
break;

case '.':
case ',':
if (c == dec_symbol) {
*dst = dec_symbol;
decimal_point = dst;
} else {
if (suppress_zero) {
*dst = pad;
} else {
*dst = c;
}
}
break;

case 'C':
case 'D':
end = dst;
/* Check negative and not zero */
if (neg && !is_zero) {
if (c == 'C') {
memcpy (dst, "CR", (size_t)2);
} else {
memcpy (dst, "DB", (size_t)2);
}
} else {
memset (dst, ' ', (size_t)2);
}
dst++;
*dst = x;
break;

case 'Z':
Expand All @@ -820,10 +775,10 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
if (x != '0') {
is_zero = suppress_zero = 0;
}
pad = (c == '*') ? '*' : ' ';
*dst = suppress_zero ? pad : x;
trailing_sign = 1;
trailing_curr = 1;
pad = (c == '*') ? '*' : ' ';
*dst = suppress_zero ? pad : x;
break;

case '+':
Expand Down Expand Up @@ -863,34 +818,95 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
}
break;

default:
if (c == currency) {
x = (min <= src && src < max) ? *src++ : (src++, '0');
if (x != '0') {
is_zero = suppress_zero = 0;
}
if (trailing_curr) {
*dst = currency;
--end;
} else if (dst == f2->data || suppress_zero) {
case '.':
case ',':
if (c == dec_symbol) {
*dst = dec_symbol;
decimal_point = dst;
} else {
if (suppress_zero) {
*dst = pad;
curr_symbol = currency;
} else {
*dst = x;
*dst = c;
}
if (n > 1 || last_fixed_insertion_char == c) {
floating_insertion = 1;
} else if (!trailing_curr) {
if (last_fixed_insertion_pos) {
*last_fixed_insertion_pos = last_fixed_insertion_char;
}
last_fixed_insertion_pos = dst;
last_fixed_insertion_char = c;
}
break;

case 'V':
--dst;
decimal_point = dst;
break;

case '0':
case '/':
*dst = c;
break;

case 'B':
if (suppress_zero) {
*dst = pad;
} else {
*dst = 'B';
has_b = 1;
}
break;

case 'P':
if (p_is_left) {
++src;
--dst;
}
break;

case 'C':
case 'D':
end = dst;
/* Check negative and not zero */
if (neg && !is_zero) {
if (c == 'C') {
memcpy (dst, "CR", (size_t)2);
} else {
memcpy (dst, "DB", (size_t)2);
}
} else {
memset (dst, ' ', (size_t)2);
}
dst++;
break;

default:
/* LCOV_EXCL_START */
if (c != currency) {
/* should never happen, consider remove [also the reason for not translating that] */
cob_runtime_error ("cob_move_display_to_edited: invalid PIC character %c", c);
*dst = '?'; /* Invalid PIC */
break;
}
/* LCOV_EXCL_STOP */

*dst = '?'; /* Invalid PIC */
x = (min <= src && src < max) ? *src++ : (src++, '0');
if (x != '0') {
is_zero = suppress_zero = 0;
}
if (trailing_curr) {
*dst = currency;
--end;
} else if (dst == f2->data || suppress_zero) {
*dst = pad;
curr_symbol = currency;
} else {
*dst = x;
}
if (n > 1 || last_fixed_insertion_char == c) {
floating_insertion = 1;
} else if (!trailing_curr) {
if (last_fixed_insertion_pos) {
*last_fixed_insertion_pos = last_fixed_insertion_char;
}
last_fixed_insertion_pos = dst;
last_fixed_insertion_char = c;
}
break;
}
}
}
Expand Down Expand Up @@ -930,7 +946,12 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
case '7':
case '8':
case '9':
#if 1 /* CHECKME: Why should we have a comma in here, necessary as shown in NIST NC,
(TODO: add this to the internal testsuite, must fail if commented out)
but not skip a period? */
case ',':
case '.':
#endif
case '+':
case '-':
case '/':
Expand Down Expand Up @@ -976,17 +997,18 @@ cob_move_display_to_edited (cob_field *f1, cob_field *f2)
}
}

/* Replace all 'B's by pad */
count = 0;
for (dst = f2->data; dst < end; ++dst) {
if (*dst == 'B') {
if (count == 0) {
*dst = pad;
/* Replace all leading 'B's by pad, others by space */
if (has_b) {
for (dst = f2->data; dst < end; ++dst) {
if (*dst == 'B') {
if (has_b) {
*dst = pad;
} else {
*dst = ' ';
}
} else {
*dst = ' ';
has_b = 0; /* non-starting characters seen */
}
} else {
++count;
}
}
}
Expand Down

0 comments on commit fc58039

Please sign in to comment.