Skip to content

Commit

Permalink
Post-merge fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddeclerck
ddeclerck committed Dec 19, 2024
1 parent c5d7f55 commit d08ecdb
Show file tree
Hide file tree
Showing 5 changed files with 88 additions and 28 deletions.
4 changes: 4 additions & 0 deletions TODO
View file
Original file line number Diff line number Diff line change
Expand Up @@ -249,3 +249,7 @@ https://sourceforge.net/p/gnucobol/code/HEAD/tree/external-doc/guide/
- Check what we should do about the casts used to remove const on open_mode in fileio.c and others (eg. in cob_file_open)

- Investigate failed manual tests "CRT STATUS clause" and "X/Open CRT STATUS clause" (see r4180)

- Check use of new integer optimization in cb_build_optim_sub and cb_build_optim_add - those may be slower than cob_add_packed_int/cob_add_packed_int64

- If there's a reasonable performance benefit for the integer optimizations for BCD/DISPLAY: add an option -funsigned-zero which never stores a sign in those (or in one of those, depending on a perf stat result) to provide the option to still use this optimization
18 changes: 16 additions & 2 deletions cobc/typeck.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7728,11 +7728,13 @@ cb_build_optim_add (cb_tree v, cb_tree n)
{
if (CB_REF_OR_FIELD_P (v)) {
const struct cb_field *f = CB_FIELD_PTR (v);
#if 0 /* CHECKME: this breaks FLD0370B in data_display.at ADD/SUB w/o SIZE ERROR */
if (cb_is_integer_field(f)
&& cb_is_integer_expr (n)
&& cb_binary_truncate) {
return cb_build_assign (v, cb_build_binary_op (v, '+', n));
}
#endif
if (!f->pic
|| f->pic->scale ) {
return CB_BUILD_FUNCALL_3 ("cob_add_int", v,
Expand Down Expand Up @@ -7806,6 +7808,13 @@ cb_build_optim_add (cb_tree v, cb_tree n)
v, cb_build_cast_llint (n));
}
}
/* we may want negative/positive zero,
which prevents a direct integer calculation */
if ((f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_DISPLAY)
&& (f->pic && f->pic->have_sign)) {
return CB_BUILD_FUNCALL_3 ("cob_add_int", v,
cb_build_cast_int (n), cb_int0);
}
if (CB_NUMERIC_LITERAL_P (n)
&& (f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_DISPLAY)
&& (f->pic && f->pic->scale == 0)
Expand Down Expand Up @@ -7910,7 +7919,13 @@ cb_build_optim_sub (cb_tree v, cb_tree n)
v, n_negative);
}
}
#if 0 /* CHECKME: this breaks FLD0370B in data_display.at ADD/SUB w/o SIZE ERROR */
/* we may want negative/positive zero,
which prevents a direct integer calculation */
if ((f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_DISPLAY)
&& (f->pic && f->pic->have_sign)) {
return CB_BUILD_FUNCALL_3 ("cob_sub_int", v,
cb_build_cast_int (n), cb_int0);
}
if (CB_NUMERIC_LITERAL_P (n)
&& (f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_DISPLAY)
&& (f->pic && f->pic->scale == 0)
Expand All @@ -7923,7 +7938,6 @@ cb_build_optim_sub (cb_tree v, cb_tree n)
&& cb_is_integer_expr (n)) {
return cb_build_assign (v, cb_build_binary_op (v, '-', n));
}
#endif
}
return CB_BUILD_FUNCALL_3 ("cob_sub_int", v,
cb_build_cast_int (n), cb_int0);
Expand Down
7 changes: 6 additions & 1 deletion libcob/numeric.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3543,7 +3543,12 @@ cob_add_int (cob_field *f, const int n, const int opt)
}
#endif
/* n is single digit value added to positive field */
if (n > -10
if (
#if 0 /* CHECKME: this does not work for negative numbers */
n > -10
#else
n > 0
#endif
&& n < 10
&& COB_FIELD_SCALE (f) == 0) {
if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_PACKED
Expand Down
37 changes: 37 additions & 0 deletions tests/testsuite.src/data_display.at
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29025,3 +29025,40 @@ AT_CHECK([$COMPILE prog2.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], [])

AT_CLEANUP


AT_SETUP([DISPLAY: ADD and SUBTRACT with negative numbers])
AT_KEYWORDS([display])

AT_DATA([prog.cob], [
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION HEX-OF INTRINSIC.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 PZ PIC S9 VALUE +0.
77 M6 PIC S9 VALUE -6.
77 X PIC S9 VALUE -0.
77 Y PIC S9 VALUE -0.
77 Z PIC S9 VALUE +0.
PROCEDURE DIVISION.
ADD PZ TO X.
DISPLAY "X(1:) = " X(1:).
SUBTRACT PZ FROM Y.
DISPLAY "Y(1:) = " Y(1:).
ADD M6 TO Z.
DISPLAY "Z(1:) = " Z(1:).
STOP RUN.
])

AT_CHECK([$COMPILE prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[X(1:) = p
Y(1:) = p
Z(1:) = v
])

AT_CLEANUP
50 changes: 25 additions & 25 deletions tests/testsuite.src/run_file.at
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11790,8 +11790,8 @@ AT_DATA([prog.cob], [
MOVE 5 TO FCD-MIN-REC-LENGTH.
MOVE 5 TO FCD-MAX-REC-LENGTH.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2.

* READ RECORD
MOVE OP-READ-NEXT TO OPCODE.
Expand All @@ -11800,15 +11800,15 @@ AT_DATA([prog.cob], [
MOVE SPACE TO EX-RECORD-BUFFER
CALL "EXTFH" USING OPCODE, FCD
DISPLAY "READ NEXT STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2
DISPLAY "DATA:" EX-RECORD-BUFFER(1:10) '-'
END-PERFORM.

* CLOSE FILE
MOVE OP-CLOSE TO OPCODE.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2.

* OPEN second file
MOVE fcd--line-sequential-org TO FCD-ORGANIZATION.
Expand All @@ -11819,8 +11819,8 @@ AT_DATA([prog.cob], [
MOVE 10 TO FCD-MIN-REC-LENGTH.
MOVE 10 TO FCD-MAX-REC-LENGTH.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
DISPLAY "OPEN STATUS:"
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2.

* READ RECORD
MOVE OP-READ-NEXT TO OPCODE.
Expand All @@ -11829,15 +11829,15 @@ AT_DATA([prog.cob], [
MOVE SPACE TO EX-RECORD-BUFFER
CALL "EXTFH" USING OPCODE, FCD
DISPLAY "READ NEXT STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2
DISPLAY "DATA:" EX-RECORD-BUFFER(1:10) '-'
END-PERFORM.

* CLOSE FILE
MOVE OP-CLOSE TO OPCODE.
CALL "EXTFH" USING OPCODE, FCD.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-BINARY.
DISPLAY "CLOSE STATUS:"
FCD-STATUS-KEY-1 "/" FCD-STATUS-KEY-2.

MAIN-EXT.
STOP RUN.
Expand All @@ -11846,32 +11846,32 @@ AT_DATA([prog.cob], [
AT_CHECK([$COMPILE prog.cob], [0], [], [])

AT_CHECK([$COBCRUN_DIRECT ./prog], [0],
[OPEN STATUS:0/048
READ NEXT STATUS:0/048
[OPEN STATUS:0/0
READ NEXT STATUS:0/0
DATA:SEQ01 -
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:SEQ02 -
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:SEQ03 -
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:SEQ04 -
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:SEQ05 -
READ NEXT STATUS:1/048
READ NEXT STATUS:1/0
DATA: -
CLOSE STATUS:0/048
OPEN STATUS:0/048
READ NEXT STATUS:0/048
CLOSE STATUS:0/0
OPEN STATUS:0/0
READ NEXT STATUS:0/0
DATA:TXTA123456-
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:TXTB123456-
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:TXTC123456-
READ NEXT STATUS:0/048
READ NEXT STATUS:0/0
DATA:TXTD123456-
READ NEXT STATUS:1/048
READ NEXT STATUS:1/0
DATA: -
CLOSE STATUS:0/048
CLOSE STATUS:0/0
], [])

AT_CLEANUP
Expand Down

0 comments on commit d08ecdb

Please sign in to comment.