https://gcc.gnu.org/g:fba34a0cc55488ad89becf81cf2c9ac517d244d4
commit r16-764-gfba34a0cc55488ad89becf81cf2c9ac517d244d4
Author: Robert Dubner <rdub...@symas.com>
Date: Tue May 20 13:35:15 2025 -0400
cobol: Multiple PRs; formatting; exception processing.
The PRs mentined here have either been previously fixed, or are fixed by
this commit.
gcc/cobol/ChangeLog:
PR cobol/119770
PR cobol/119772
PR cobol/119790
PR cobol/119771
PR cobol/119810
PR cobol/119335
PR cobol/119632
* cdf-copy.cc (GLOB_BRACE): Eliminate <glob.h>.
* cdfval.h (_CDF_VAL_H_): Switch to C++ headers.
* copybook.h (class copybook_elem_t): Eliminate <glob.h>.
(class copybook_t): Likewise.
* gcobc: Numerous changes to improve utility.
* gcobol.1: Correct names in the list of functions.
* genapi.cc (compare_binary_binary): Use has_attr() function.
* lexio.cc (cdftext::lex_open): Typo; filename logic.
(cdftext::process_file): Filename logic.
* parse.y: Numerous parsing changes.
* parse_ante.h (new_alphanumeric): C++ includes; changes to
temporaries.
(new_tempnumeric): Likewise.
(new_tempnumeric_float): Likewise.
(set_real_from_capacity): Created.
* scan.l: Use yy_pop_state().
* scan_ante.h (typed_name): Find figconst from data.initial.
* symbols.cc (symbol_valid_udf_args): Eliminate.
(symbols_update): figconst processing.
(new_temporary_impl): For functions, set .initial to function name.
(temporaries_t::acquire): Likewise.
(new_alphanumeric): Likewise.
(new_temporary): Likewise.
* symbols.h (_SYMBOLS_H_): Use C++ includes.
(cbl_figconst_tok): Change handling of figconst.
(cbl_figconst_field_of): Change handling of figconst.
(symbol_valid_udf_args): Eliminate.
* symfind.cc (symbol_match2): Change declaration.
(symbol_match): Change declaration.
libgcobol/ChangeLog:
* charmaps.cc: Switch to C++ includes.
* common-defs.h: Likewise.
* constants.cc: Likewise.
* ec.h: Remove #include <assert.h>.
* gcobolio.h (GCOBOLIO_H_): Switch to C++ includes.
* gfileio.cc: Likewise.
* gmath.cc: Likewise.
* intrinsic.cc: Comment formatting; C++ includes.
* io.cc: C++ includes.
* libgcobol.cc: (__gg__stash_exceptions): Eliminate.
* valconv.cc: Switch to C++ includes.
Co-Authored-By: James K. Lowden <jklow...@cobolworx.com>
Diff:
---
gcc/cobol/cdf-copy.cc | 88 +++------------
gcc/cobol/cdfval.h | 6 +-
gcc/cobol/copybook.h | 13 +--
gcc/cobol/gcobc | 141 ++++++++++++++----------
gcc/cobol/gcobol.1 | 54 ++++-----
gcc/cobol/genapi.cc | 4 +-
gcc/cobol/lexio.cc | 7 +-
gcc/cobol/parse.y | 283 +++++++++++++++++++++++++++++++-----------------
gcc/cobol/parse_ante.h | 35 ++++--
gcc/cobol/scan.l | 2 +-
gcc/cobol/scan_ante.h | 4 +
gcc/cobol/symbols.cc | 63 +++--------
gcc/cobol/symbols.h | 19 ++--
gcc/cobol/symfind.cc | 4 +-
libgcobol/charmaps.cc | 14 ++-
libgcobol/common-defs.h | 5 +-
libgcobol/constants.cc | 19 ++--
libgcobol/ec.h | 1 -
libgcobol/gcobolio.h | 3 +-
libgcobol/gfileio.cc | 18 +--
libgcobol/gmath.cc | 19 ++--
libgcobol/intrinsic.cc | 22 ++--
libgcobol/io.cc | 11 +-
libgcobol/libgcobol.cc | 14 +--
libgcobol/valconv.cc | 7 +-
25 files changed, 456 insertions(+), 400 deletions(-)
diff --git a/gcc/cobol/cdf-copy.cc b/gcc/cobol/cdf-copy.cc
index 059596c08f41..99f5866ae86f 100644
--- a/gcc/cobol/cdf-copy.cc
+++ b/gcc/cobol/cdf-copy.cc
@@ -35,23 +35,12 @@
// We regret any confusion engendered.
#include "config.h"
-#include <glob.h>
#include "cobol-system.h"
#include "cbldiag.h"
#include "util.h"
#include "copybook.h"
-// GLOB_BRACE and GLOB_TILDE are BSD extensions. Provide fallback definitions
-// if necessary.
-#ifndef GLOB_BRACE
-#define GLOB_BRACE 0
-#endif
-
-#ifndef GLOB_TILDE
-#define GLOB_TILDE 0
-#endif
-
#define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
/*
@@ -86,7 +75,6 @@
* space. This function only applies them.
*/
-extern int yydebug;
const char * cobol_filename();
bool is_fixed_format();
bool is_reference_format();
@@ -190,12 +178,6 @@ esc( size_t len, const char input[] ) {
return buffer; // caller must strdup static buffer
}
-static int
-glob_error(const char *epath, int eerrno) {
- dbgmsg("%s: COPY file search: '%s': %s", __func__, epath, xstrerror(eerrno));
- return 0;
-}
-
void
copybook_directory_add( const char gcob_copybook[] ) {
if( !gcob_copybook ) return;
@@ -242,27 +224,15 @@ copybook_extension_add( const char ext[] ) {
copybook.extensions_add( ext, alt );
}
-extern int yydebug;
-const char * copybook_elem_t::extensions;
+std::list<const char *> copybook_elem_t::suffixes {
+ "", ".cpy", ".CPY", ".cbl", ".CBL", ".cob", ".COB"
+};
void
copybook_t::extensions_add( const char ext[], const char alt[] ) {
- char *output;
- if( alt ) {
- output = xasprintf("%s,%s", ext, alt);
- } else {
- output = xstrdup(ext);
- }
- gcc_assert(output);
- if( book.extensions ) {
- char *s = xasprintf("%s,%s", output, book.extensions);
- free(const_cast<char*>(book.extensions));
- free(output);
- book.extensions = s;
- } else {
- book.extensions = output;
- }
+ book.suffixes.push_back(ext);
+ if( alt ) book.suffixes.push_back(alt);
}
static inline ino_t
@@ -276,9 +246,7 @@ inode_of( int fd ) {
int
copybook_elem_t::open_file( const char directory[], bool literally ) {
- int erc;
- char *pattern, *copier = xstrdup(cobol_filename());
- char *dname = NULL;
+ char *dname = NULL, *copier = xstrdup(cobol_filename());
if ( directory ) {
dname = xstrdup(directory);
@@ -324,52 +292,26 @@ copybook_elem_t::open_file( const char directory[], bool
literally ) {
}
gcc_assert( ! literally );
- if( extensions ) {
- pattern = xasprintf("%s{,.cpy,.CPY,.cbl,.CBL,.cob,.COB,%s}",
- path, this->extensions);
- } else {
- pattern = xasprintf("%s{,.cpy,.CPY,.cbl,.CBL,.cob,.COB}", path);
- }
-
free(copier);
- static int flags = GLOB_MARK | GLOB_BRACE | GLOB_TILDE;
- glob_t globber;
-
- if( (erc = glob(pattern, flags, glob_error, &globber)) != 0 ) {
- switch(erc) {
- case GLOB_NOSPACE:
- yywarn("COPY file search: out of memory");
- break;
- case GLOB_ABORTED:
- yywarn("COPY file search: read error");
- break;
- case GLOB_NOMATCH:
- dbgmsg("COPY '%s': no files match %s", this->source.name, pattern);
- default:
- break; // caller says no file found
- }
- return -1;
- }
-
- free(pattern);
+ for( auto suffix : suffixes ) {
+ std::string pattern(path);
+ pattern += suffix;
+ dbgmsg("%s: trying %s", __func__, pattern.c_str());
- for( size_t i=0; i < globber.gl_pathc; i++ ) {
- auto filename = globber.gl_pathv[i];
+ auto filename = pattern.c_str();
if( (this->fd = open(filename, O_RDONLY)) != -1 ) {
dbgmsg("found copybook file %s", filename);
this->source.name = xstrdup(filename);
if( ! cobol_filename(this->source.name, inode_of(fd)) ) {
- error_msg(source.loc, "recursive copybook: '%s' includes itself",
this->source);
- (void)! close(fd);
- fd = -1;
+ error_msg(source.loc, "recursive copybook: '%s' includes itself",
this->source);
+ (void)! close(fd);
+ fd = -1;
}
- globfree(&globber);
+ dbgmsg("%s: opened %s as fd %d", __func__, source.name, fd);
return fd;
}
}
- yywarn("could not open copy source for '%s'", source);
- globfree(&globber);
return -1;
}
diff --git a/gcc/cobol/cdfval.h b/gcc/cobol/cdfval.h
index 634b5a24c1ae..76ed7dae0fdf 100644
--- a/gcc/cobol/cdfval.h
+++ b/gcc/cobol/cdfval.h
@@ -32,9 +32,9 @@
#ifndef _CDF_VAL_H_
#define _CDF_VAL_H_
-#include <assert.h>
-#include <stdint.h>
-#include <stdlib.h>
+#include <cassert>
+#include <cstdint>
+#include <cstdlib>
bool scanner_parsing();
diff --git a/gcc/cobol/copybook.h b/gcc/cobol/copybook.h
index e509bf35bb72..a4b1117f9565 100644
--- a/gcc/cobol/copybook.h
+++ b/gcc/cobol/copybook.h
@@ -65,7 +65,7 @@ class copybook_elem_t {
copybook_loc_t() : name(NULL) {}
} source, library;
bool suppress;
- static const char *extensions;
+ static std::list<const char *> suffixes;
public:
struct { bool source, library; } literally;
int fd;
@@ -91,7 +91,6 @@ class copybook_elem_t {
}
int open_file( const char dir[], bool literally = false );
- void extensions_add( const char ext[], const char alt[] );
static inline bool is_quote( const char ch ) {
return ch == '\'' || ch == '"';
@@ -185,12 +184,10 @@ class copybook_t {
this->source(loc, name);
for( auto dir : directories ) {
- if( true ) {
- dbgmsg("copybook_t::open '%s' OF '%s' %s",
- book.source.name,
- dir? dir: ".",
- book.literally.source? ", literally" : "" );
- }
+ dbgmsg("copybook_t::open '%s' OF '%s' %s",
+ book.source.name,
+ dir? dir: ".",
+ book.literally.source? ", literally" : "" );
if( (fd = book.open_file(dir, book.literally.source)) != -1 ) break;
}
return fd;
diff --git a/gcc/cobol/gcobc b/gcc/cobol/gcobc
index 6154c788e1cf..8c2245f5f82c 100755
--- a/gcc/cobol/gcobc
+++ b/gcc/cobol/gcobc
@@ -73,7 +73,7 @@ fi
exit_status=0
skip_arg=
-opts="-dialect gnu $copydir ${dialect:--dialect mf} $includes"
+opts="$copydir $includes"
mode=-shared
incomparable="has no comparable gcobol option"
@@ -103,6 +103,9 @@ $0 recognizes the following GnuCOBOL cobc output mode
options:
$0 recognizes the following GnuCOBOL cobc compilation options:
-C
-d, --debug
+ -D
+ -A
+ -Q
-E
-g
--coverage
@@ -112,24 +115,29 @@ $0 recognizes the following GnuCOBOL cobc compilation
options:
--fixed
-F, --free
-fimplicit-init
- -h, --help
- -save-temps=
- -save-temps
- -std=mvs
- -std=mf
-Options that are the same in gcobol and cobc are passed through verbatim.
-Options that have no analog in gcobol produce a warning message.
-To produce this message, use -HELP.
+ -h, --help
+ -save-temps=
+ -save-temps
+ -std=mvs -std=mvs-strict
+ -std=mf -std=mf-strict
+ -std=cobol85 -std=cobol2002 -std=cobol2014
+ Options that are the same in gcobol and cobc are passed through verbatim.
+ Options that have no analog in gcobol produce a warning message.
+ To produce this message, use -HELP.
To see the constructed cobc command-line, use -echo.
To override the default cobc, set the "cobc" environment variable.
By default, gcobc invokes the gcobol the same directory the gcobc resides.
To override, set the gcobol environment variable.
-EOF
-}
+ EOF
+ }
-#
-# Simply iterate over the command-line tokens. We can't use getopts
-# here because it's not designed for single-dash words (e.g. -shared).
+dialect="gnu"
+out_set=""
+first=""
+
+ #
+ # Simply iterate over the command-line tokens. We can't use getopts
+ # here because it's not designed for single-dash words (e.g. -shared).
#
for opt in "$@"
@@ -147,41 +155,52 @@ do
;;
esac
- opts="$opts $pending_arg $opt"
+ opts="$opts $pending_arg$opt"
pending_arg=
continue
fi
case $opt in
- -A | -Q) warn "$opt"
- ;;
+
+ # pass next parameter to GCC
+ -A)
+ pending_arg=" "
+ ;;
+
+ # pass next parameter to linker
+ -Q)
+ pending_arg=-Wl,
+ ;;
+
-b) mode="-shared"
;;
-c) mode="-c"
;;
--conf=*) warn "$opt"
- ;;
- -C) error "$opt $incomparable"
- ;;
- -d | --debug) opts="$opts -fcobol-exceptions=EC-ALL"
- warn "$opt implies -fstack-check:"
- ;;
- # -D
- -E) opts="$opts $opt -fsyntax-only"
+ ;;
+ -C) error "$opt $incomparable"
+ ;;
+ -d | -debug | --debug) opts="$opts -fcobol-exceptions=EC-ALL"
+ warn "$opt implies -fstack-check:"
+ ;;
+ # define for preprocessor, note: -D* is directly passed
+ -D)
+ pending_arg=$opt
;;
- -echo) echo="echo"
+ -E) opts="$opts $opt -fsyntax-only"
+ ;;
+ -echo) echo="echo"
;;
-fec=* | -fno-ec=*)
opt="$(echo "$opt" | sed -E
's/-f(no-)?ec=/-f\1cobol-exceptions=EC-/g')"
- opts="$opts $opt"
- ;;
- -ext)
- pending_arg=$opt
- ;;
- -ext=*) opts="$opts $(echo "$opt" | sed 's/-ext=/-copyext ./')"
- ;;
-
+ opts="$opts $opt"
+ ;;
+ -ext)
+ pending_arg="$opt "
+ ;;
+ -ext=*) opts="$opts $(echo "$opt" | sed 's/-ext=/-copyext ./')"
+ ;;
# A.3 Compiler options
-fsign=*) warn "$opt" ;;
-ffold-copy=*) warn "$opt" ;;
@@ -359,19 +378,18 @@ do
-fnot-register=*) warn "$opt" ;;
-fregister=*) warn "$opt" ;;
- -fformat=auto ) ;; # gcobol and gnucobol default
+ -fformat=auto) ;; # gcobol and gnucobol default
-fixed | --fixed | -fformat=fixed | -fformat=variable | -fformat=xcard)
# note: variable + xcard are only _more similar_ to fixed
than free,
# (with changing right-column to 250/255, which isn't
supported in gcobol, yet)
- opts="$opts -ffixed-form"
- ;;
-
- -F | -free | --free | -fformat=free | -fformat=* )
- # note: "all other formats" are only _more similar_ to
free than fixed
- opts="$opts -ffree-form"
- ;;
+ opts="$opts -ffixed-form"
+ ;;
+ -F | -free | --free | -fformat=free | -fformat=*)
+ # note: "all other formats" are only _more similar_ to
free than fixed
+ opts="$opts -ffree-form"
+ ;;
-h | --help) opts="$opts --help"
;;
@@ -413,24 +431,35 @@ do
export GCOBOL_TEMPDIR="$opt"
;;
-save-temps) export GCOBOL_TEMPDIR="${PWD:-$(pwd)}"
- ;;
- # -shared is identical
+ ;;
+ # -shared is identical
- -std=mvs) opts="$opts -dialect ibm"
+ -std=mvs | -std=mvs-strict | -std=ibm | -std=ibm-strict) dialect=ibm
+ ;;
+ -std=mf | -std=mf-strict) dialect=mf
;;
- -std=mf) opts="$opts -dialect mf"
+ -std=default) dialect=gnu # that's GnuCOBOL's default and GCC's
dialect for GnuCOBOL
+ ;;
+ -std=cobol*) dialect="" # GCC COBOL targets COBOL2024 "mostly
backward to COBOL85"
+ ;;
+ -std=*)
+ dialect=""
+ warn "$opt (unkown dialect)"
;;
- -t | -T | -tlines=* | -P | -P=* | -X | --Xref)
- warn "$opt (no listing)"
+ -P | -P=* | -X | --Xref)
+ warn "$opt (no listing)"
+ ;;
+ -t | -T)
+ # note: -P has an _optional_ arg, so we leave it above
+ ignore_arg "$opt (no listing)"
+ ;;
+ -q | --brief) warn "$opt"
+ ;;
+ -v | --verbose) opts="$opts -V"
+ ;;
+ # note: we want -dumpversion to be passed to gcc
+ -V | --version | -version) opts="$opts --version"
;;
- -q | --brief) warn "$opt"
- ;;
- -v | --verbose) opts="$opts -V"
- ;;
- # note: we want -dumpversion to be passed to gcc
- -V | --version | -version) opts="$opts --version"
- ;;
-
# pass through, strangely -Wall is not supported
-w | -W | -Wextra) opts="$opts $opt"
;;
diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index 0c3d2c123329..0ce890e97229 100644
--- a/gcc/cobol/gcobol.1
+++ b/gcc/cobol/gcobol.1
@@ -1167,54 +1167,54 @@ others. They are listed alphabetically below.
.It
ABS ACOS ANNUITY ASIN ATAN
.It
-BASECONVERT BIT_OF BIT_TO_CHAR BOOLEAN_OF_INTEGER BYTE_LENGTH
+BASECONVERT BIT-OF BIT-TO-CHAR BOOLEAN-OF-INTEGER BYTE-LENGTH
.It
-CHAR CHAR_NATIONAL COMBINED_DATETIME CONCAT CONVERT COS CURRENT_DATE
+CHAR CHAR-NATIONAL COMBINED-DATETIME CONCAT CONVERT COS CURRENT-DATE
.It
-DATE_OF_INTEGER DATE_TO_YYYYMMDD DAY_OF_INTEGER DAY_TO_YYYYDDD DISPLAY_OF
+DATE-OF-INTEGER DATE-TO-YYYYMMDD DAY-OF-INTEGER DAY-TO-YYYYDDD DISPLAY-OF
.It
-E EXCEPTION_FILE
-EXCEPTION_FILE_N EXCEPTION_LOCATION EXCEPTION_LOCATION_N
-EXCEPTION_STATEMENT EXCEPTION_STATUS EXP EXP10
+E EXCEPTION-FILE
+EXCEPTION-FILE-N EXCEPTION-LOCATION EXCEPTION-LOCATION-N
+EXCEPTION-STATEMENT EXCEPTION-STATUS EXP EXP10
.It
-FACTORIAL FIND_STRING
-FORMATTED_CURRENT_DATE FORMATTED_DATE FORMATTED_DATETIME
-FORMATTED_TIME FRACTION_PART
+FACTORIAL FIND-STRING
+FORMATTED-CURRENT-DATE FORMATTED-DATE FORMATTED-DATETIME
+FORMATTED-TIME FRACTION-PART
.It
-HEX_OF HEX_TO_CHAR HIGHEST_ALGEBRAIC
+HEX-OF HEX-TO-CHAR HIGHEST-ALGEBRAIC
.It
-INTEGER INTEGER_OF_BOOLEAN INTEGER_OF_DATE INTEGER_OF_DAY
-INTEGER_OF_FORMATTED_DATE INTEGER_PART
+INTEGER INTEGER-OF-BOOLEAN INTEGER-OF-DATE INTEGER-OF-DAY
+INTEGER-OF-FORMATTED-DATE INTEGER-PART
.It
-LENGTH LOCALE_COMPARE
-LOCALE_DATE LOCALE_TIME LOCALE_TIME_FROM_SECONDS LOG LOG10 LOWER_CASE
-LOWEST_ALGEBRAIC
+LENGTH LOCALE-COMPARE
+LOCALE-DATE LOCALE-TIME LOCALE-TIME-FROM-SECONDS LOG LOG10 LOWER-CASE
+LOWEST-ALGEBRAIC
.It
-MAX MEAN MEDIAN MIDRANGE MIN MOD MODULE_NAME
+MAX MEAN MEDIAN MIDRANGE MIN MOD MODULE-NAME
.It
-NATIONAL_OF NUMVAL NUMVAL_C NUMVAL_F ORD
+NATIONAL-OF NUMVAL NUMVAL-C NUMVAL-F ORD
.It
-ORD_MAX ORD_MIN
+ORD-MAX ORD-MIN
.It
-PI PRESENT_VALUE
+PI PRESENT-VALUE
.It
RANDOM RANGE REM REVERSE
.It
-SECONDS_FROM_FORMATTED_TIME
-SECONDS_PAST_MIDNIGHT SIGN SIN SMALLEST_ALGEBRAIC SQRT
-STANDARD_COMPARE STANDARD_DEVIATION SUBSTITUTE SUM
+SECONDS-FROM-FORMATTED-TIME
+SECONDS-PAST-MIDNIGHT SIGN SIN SMALLEST-ALGEBRAIC SQRT
+STANDARD-COMPARE STANDARD-DEVIATION SUBSTITUTE SUM
.It
-TAN TEST_DATE_YYYYMMDD TEST_DAY_YYYYDDD TEST_FORMATTED_DATETIME
-TEST_NUMVAL TEST_NUMVAL_C TEST_NUMVAL_F TRIM
+TAN TEST-DATE-YYYYMMDD TEST-DAY-YYYYDDD TEST-FORMATTED-DATETIME
+TEST-NUMVAL TEST-NUMVAL-C TEST-NUMVAL-F TRIM
.It
-ULENGTH UPOS UPPER_CASE
+ULENGTH UPOS UPPER-CASE
USUBSTR USUPPLEMENTARY UUID4 UVALID UWIDTH
.It
VARIANCE
.It
-WHEN_COMPILED
+WHEN-COMPILED
.It
-YEAR_TO_YYYY
+YEAR-TO-YYYY
.El
.
.Ss Binary floating point DISPLAY
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 1ed4cef0801f..2ce9cad5c0d6 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -1969,8 +1969,8 @@ compare_binary_binary(tree return_int,
{
gg_printf("compare_binary_binary(): using int64\n", NULL_TREE);
}
- left_side = gg_define_variable( left_side_ref->field->attr & signable_e ?
LONG : ULONG );
- right_side = gg_define_variable(right_side_ref->field->attr & signable_e ?
LONG : ULONG );
+ left_side = gg_define_variable(
left_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
+ right_side =
gg_define_variable(right_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
}
//tree dummy = gg_define_int();
diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc
index 2db1af273e9b..6b2d1fbf957e 100644
--- a/gcc/cobol/lexio.cc
+++ b/gcc/cobol/lexio.cc
@@ -1455,7 +1455,7 @@ cdftext::lex_open( const char filename[] ) {
int output = open_output();
- // Process any files supplied by the -include comamnd-line option.
+ // Process any files supplied by the -include command-line option.
for( auto name : included_files ) {
int input;
if( -1 == (input = open(name, O_RDONLY)) ) {
@@ -1466,7 +1466,10 @@ cdftext::lex_open( const char filename[] ) {
filespan_t mfile( free_form_reference_format( input ) );
process_file( mfile, output );
+
+ cobol_filename_restore(); // process_file restores only for COPY
}
+ included_files.clear();
cobol_filename(filename, inode_of(input));
filespan_t mfile( free_form_reference_format( input ) );
@@ -1831,6 +1834,7 @@ cdftext::process_file( filespan_t mfile, int output, bool
second_pass ) {
// indicate current file
static const char file_push[] = "\f#FILE PUSH ", file_pop[] = "\f#FILE
POP\f";
+ if( !included_files.empty() ) { ++nfiles; }; // force push/pop of included
filename
if( !second_pass && nfiles++ ) {
static const char delimiter[] = "\f";
const char *filename = cobol_filename();
@@ -1918,6 +1922,7 @@ cdftext::process_file( filespan_t mfile, int output, bool
second_pass ) {
std::copy(file_pop, file_pop + strlen(file_pop), ofs);
out.flush();
}
+ if( !included_files.empty() ) { --nfiles; };
}
std::list<span_t>
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index cb96c9073618..a3195fead4d9 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -375,7 +375,7 @@
LSUB "("
PARAMETER_kw "PARAMETER"
OVERRIDE READY RESET
- RSUB ")"
+ RSUB")"
SERVICE_RELOAD "SERVICE RELOAD" STAR_CBL "*CBL"
SUBSCRIPT SUPPRESS TITLE TRACE USE
@@ -662,7 +662,7 @@
%type <boolean> all optional sign_leading on_off initialized strong
is_signed
%type <number> count data_clauses data_clause
%type <number> nine nines nps relop spaces_etc reserved_value signed
-%type <number> variable_type
+%type <number> variable_type binary_type
%type <number> true_false posneg eval_posneg
%type <number> open_io alphabet_etc
%type <special_type> device_name
@@ -951,7 +951,7 @@
%printer { fprintf(yyo, "%s'%.*s'{" HOST_SIZE_T_PRINT_UNSIGNED "} %s",
$$.prefix, int($$.len), $$.data, (fmt_size_t)$$.len,
$$.symbol_name()); } <literal>
-%printer { fprintf(yyo, "%s (1st of " HOST_SIZE_T_PRINT_UNSIGNED ")",
+%printer { fprintf(yyo,"%s (1st of" HOST_SIZE_T_PRINT_UNSIGNED")",
$$->targets.empty()? "" :
$$->targets.front().refer.field->name,
(fmt_size_t)$$->targets.size() ); } <targets>
%printer { fprintf(yyo, "#" HOST_SIZE_T_PRINT_UNSIGNED ": %s",
@@ -1559,7 +1559,7 @@ opt_clause: opt_arith
| opt_entry
| opt_binary
| opt_decimal {
- cbl_unimplementedw("type FLOAT-DECIMAL was ignored");
+ cbl_unimplemented("type FLOAT-DECIMAL");
}
| opt_intermediate
| opt_init
@@ -2948,7 +2948,7 @@ fd_clause: record_desc
{
auto f = cbl_file_of(symbol_at(file_section_fd));
f->attr |= external_e;
- cbl_unimplemented("AS LITERAL ");
+ cbl_unimplemented("AS LITERAL");
}
| fd_linage
| fd_report {
@@ -3362,9 +3362,11 @@ data_descr: data_descr1
;
const_value: cce_expr
- | BYTE_LENGTH of name { $name->data.set_real_from_capacity(&$$);
}
- | LENGTH of name { $name->data.set_real_from_capacity(&$$);
}
- | LENGTH_OF of name { $name->data.set_real_from_capacity(&$$);
}
+ | BYTE_LENGTH of name { set_real_from_capacity(@name, $name,
&$$); }
+ | LENGTH of name { set_real_from_capacity(@name, $name,
&$$); }
+ | LENGTH_OF of name { set_real_from_capacity(@name, $name,
&$$); }
+ | LENGTH_OF of binary_type[type] {
+ real_from_integer(&$$, VOIDmode, $type,
SIGNED); }
;
value78: literalism
@@ -3380,6 +3382,12 @@ value78: literalism
data = build_real (float128_type_node, $1);
$$ = new cbl_field_data_t(data);
}
+ | reserved_value[value]
+ {
+ auto field = constant_of(constant_index($value));
+ $$ = new cbl_field_data_t(field->data);
+ }
+
| true_false
{
cbl_unimplemented("Boolean constant");
@@ -3413,6 +3421,21 @@ data_descr1: level_name
error_msg(@1, "%s was defined by CDF", field.name);
}
}
+
+ | level_name CONSTANT is_global as reserved_value[value]
+ {
+ cbl_field_t& field = *$1;
+ if( field.level != 1 ) {
+ error_msg(@1, "%s must be an 01-level data item",
field.name);
+ YYERROR;
+ }
+ field.attr |= constant_e;
+ if( $is_global ) field.attr |= global_e;
+ field.type = FldLiteralA;
+ auto fig = constant_of(constant_index($value));
+ field.data = fig->data;
+ }
+
| level_name CONSTANT is_global as literalism[lit]
{
cbl_field_t& field = *$1;
@@ -3452,8 +3475,8 @@ data_descr1: level_name
| LEVEL78 NAME[name] VALUE is value78[data]
{
- if( ! dialect_mf() ) {
- dialect_error(@1, "level 78", "mf");
+ if( ! (dialect_mf() || dialect_gnu()) ) {
+ dialect_error(@1, "level 78", "mf or gnu");
YYERROR;
}
struct cbl_field_t field = { 0, FldLiteralA, FldInvalid,
@@ -5038,7 +5061,7 @@ accept: accept_body end_accept {
switch( $accept_body.func ) {
case accept_done_e:
error_msg(@ec, "ON EXCEPTION valid only "
- "with ENVIRONMENT or COMAMND-LINE(n)");
+ "with ENVIRONMENT or COMMAND-LINE(n)");
break;
case accept_command_line_e:
if( $1.from->field == NULL ) { // take next command-line arg
@@ -5050,7 +5073,7 @@ accept: accept_body end_accept {
parser_move(*$1.into, *$1.from);
if( $ec.on_error || $ec.not_error ) {
error_msg(@ec, "ON EXCEPTION valid only "
- "with ENVIRONMENT or COMAMND-LINE(n)");
+ "with ENVIRONMENT or COMMAND-LINE(n)");
}
} else {
parser_accept_command_line(*$1.into, *$1.from,
@@ -7025,6 +7048,15 @@ num_value: scalar // might actually be a string
| num_literal { $$ = new_reference($1); }
| ADDRESS OF scalar {$$ = $scalar; $$->addr_of = true; }
| DETAIL OF scalar {$$ = $scalar; }
+ | LENGTH_OF binary_type[size] {
+ location_set(@1);
+ $$ = new cbl_refer_t( new_tempnumeric() );
+ $$->field->clear_attr(signable_e);
+ if( dialect_gcc() ) {
+ dialect_error(@1, "LENGTH OF", "ibm");
+ }
+ parser_set_numeric($$->field, $size);
+ }
| LENGTH_OF name[val] {
location_set(@1);
$$ = new cbl_refer_t( new_tempnumeric() );
@@ -7251,6 +7283,15 @@ signed_literal: num_literal
struct cbl_field_t *zero = constant_of(constant_index(ZERO));
parser_subtract( $$, zero, $2, current_rounded_mode() );
}
+ | LENGTH_OF binary_type[size] {
+ location_set(@1);
+ $$ = new_tempnumeric();
+ $$->clear_attr(signable_e);
+ if( dialect_gcc() ) {
+ dialect_error(@1, "LENGTH OF", "ibm");
+ }
+ parser_set_numeric($$, $size);
+ }
| LENGTH_OF name[val] {
location_set(@1);
$$ = new_tempnumeric();
@@ -7505,6 +7546,7 @@ perform_inline: perform_start statements END_PERFORM
}
}
;
+
perform_start: %empty %prec LOCATION {
perform_ec_setup();
$$ = 0;
@@ -7809,6 +7851,15 @@ varg1a: ADDRESS OF scalar {
{
$$ = new_reference(constant_of(constant_index($1)));
}
+ | LENGTH_OF binary_type[size] {
+ location_set(@1);
+ $$ = new cbl_refer_t( new_tempnumeric() );
+ $$->field->clear_attr(signable_e);
+ if( dialect_gcc() ) {
+ dialect_error(@1, "LENGTH OF", "ibm");
+ }
+ parser_set_numeric($$->field, $size);
+ }
| LENGTH_OF name[val] {
location_set(@1);
$$ = new cbl_refer_t( new_tempnumeric() );
@@ -7833,6 +7884,10 @@ varg1a: ADDRESS OF scalar {
}
;
+binary_type: BINARY_INTEGER { $$ = $1.capacity; }
+ | COMPUTATIONAL { $$ = $1.capacity; }
+ ;
+
literal: literalism
{
$$ = $1.isymbol()?
@@ -10108,7 +10163,9 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
if( ! current.udf_args_valid(L, $args->refers, params) ) {
YYERROR;
}
- $$ =
new_temporary_clone(cbl_field_of(symbol_at(L->returning)));
+ const auto returning = cbl_field_of(symbol_at(L->returning));
+ $$ = new_temporary_clone(returning);
+ $$->data.initial = returning->name; // user's name for the
field
std::vector <cbl_ffi_arg_t> args($args->refers.size());
size_t i = 0;
// Pass parameters as defined by the function.
@@ -10127,7 +10184,9 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
static cbl_ffi_arg_t *args = NULL;
auto L = cbl_label_of(symbol_at($1));
- $$ =
new_temporary_clone(cbl_field_of(symbol_at(L->returning)));
+ const auto returning = cbl_field_of(symbol_at(L->returning));
+ $$ = new_temporary_clone(returning);
+ $$->data.initial = returning->name; // user's name for the
field
auto name = new_literal(strlen(L->name), L->name, quoted_e);
ast_call( @1, name, $$, narg, args, NULL, NULL, true );
@@ -10168,7 +10227,7 @@ intrinsic: function_udf
$$ = is_numeric(args[0].field)?
new_tempnumeric_float() :
new_alphanumeric();
-
+ $$->data.initial = keyword_str($1);
parser_intrinsic_callv( $$, intrinsic_cname($1),
args.size(), args.data() );
}
@@ -10177,7 +10236,7 @@ intrinsic: function_udf
{
static char s[] = "__gg__present_value";
location_set(@1);
- $$ = new_tempnumeric_float();
+ $$ = new_tempnumeric_float("PRESENT-VALUE");
size_t n = $args->size();
assert(n > 0);
if( n < 2 ) {
@@ -10195,48 +10254,48 @@ intrinsic: function_udf
| BASECONVERT '(' varg[r1] varg[r2] varg[r3] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("BASECONVERT");
cbl_unimplemented("BASECONVERT");
if( ! intrinsic_call_3($$, BASECONVERT, $r1, $r2, $r3 ))
YYERROR;
}
| BIT_OF '(' expr[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("BIT-OF");
if( ! intrinsic_call_1($$, BIT_OF, $r1, @r1)) YYERROR;
}
| CHAR '(' expr[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric(1);
+ $$ = new_alphanumeric(1,"CHAR");
if( ! intrinsic_call_1($$, CHAR, $r1, @r1)) YYERROR;
}
| CONVERT '(' varg[r1] convert_src[src] convert_dst[dst] ')' {
location_set(@1);
- $$ = new_alphanumeric(1);
+ $$ = new_alphanumeric(1,"CONVERT");
cbl_unimplemented("CONVERT");
/* if( ! intrinsic_call_3($$, CONVERT, $r1, $src, $dst) )
YYERROR; */
}
| DISPLAY_OF '(' varg[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("DISPLAY-OF");
if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, NULL) ) YYERROR;
}
| DISPLAY_OF '(' varg[r1] varg[r2] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("DISPLAY-OF");
if( ! intrinsic_call_2($$, DISPLAY_OF, $r1, $r2) ) YYERROR;
}
| EXCEPTION_FILE filename {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-FILE");
parser_exception_file( $$, $filename );
}
| FIND_STRING '(' varg[r1] last start_after anycase ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("FIND-STRING");
/* auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e)); */
cbl_unimplemented("FIND_STRING");
/* if( ! intrinsic_call_4($$, FIND_STRING, r1, $r2) )
YYERROR; */
@@ -10244,7 +10303,7 @@ intrinsic: function_udf
| FORMATTED_DATE '(' DATE_FMT[r1] expr[r2] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATE);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATE,
"FORMATTED-DATE");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, FORMATTED_DATE, r1, $r2) )
YYERROR;
}
@@ -10253,7 +10312,7 @@ intrinsic: function_udf
| FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
expr[r3] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME,
"FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
static cbl_refer_t r3(literally_zero);
if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
@@ -10262,7 +10321,7 @@ intrinsic: function_udf
| FORMATTED_DATETIME '(' DATETIME_FMT[r1] expr[r2]
expr[r3] expr[r4] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME,
"FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_4($$, FORMATTED_DATETIME,
r1, $r2, $r3, $r4) ) YYERROR;
@@ -10273,14 +10332,14 @@ intrinsic: function_udf
| FORMATTED_TIME '(' TIME_FMT[r1] expr[r2]
expr[r3] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME,
"FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_3($$, FORMATTED_TIME,
r1, $r2, $r3) ) YYERROR;
}
| FORMATTED_TIME '(' TIME_FMT[r1] expr[r2] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_TIME,
"FORMATTED-TIME");
auto r3 = new_reference(new_literal("0"));
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_3($$, FORMATTED_TIME,
@@ -10288,21 +10347,21 @@ intrinsic: function_udf
}
| FORMATTED_CURRENT_DATE '(' DATETIME_FMT[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME);
+ $$ = new_alphanumeric(MAXLENGTH_FORMATTED_DATETIME,
"FORMATTED-CURRENT_DATE");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_1($$, FORMATTED_CURRENT_DATE, r1, @r1) )
YYERROR;
}
| TEST_FORMATTED_DATETIME '(' DATE_FMT[r1] varg[r2] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
r1, $r2) ) YYERROR;
}
| TEST_FORMATTED_DATETIME '(' TIME_FMT[r1] varg[r2] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
r1, $r2) ) YYERROR;
@@ -10310,14 +10369,14 @@ intrinsic: function_udf
| TEST_FORMATTED_DATETIME '(' DATETIME_FMT[r1] varg[r2] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("TEST-FORMATTED-DATETIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, TEST_FORMATTED_DATETIME,
r1, $r2) ) YYERROR;
}
| INTEGER_OF_FORMATTED_DATE '(' DATE_FMT[r1] varg[r2] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("INTEGER-OF-FORMATTED-DATE");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
r1, $r2) ) YYERROR;
@@ -10325,14 +10384,14 @@ intrinsic: function_udf
| INTEGER_OF_FORMATTED_DATE '(' DATETIME_FMT[r1] varg[r2] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("INTEGER-OF-FORMATTED-DATE");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, INTEGER_OF_FORMATTED_DATE,
r1, $r2) ) YYERROR;
}
| SECONDS_FROM_FORMATTED_TIME '(' TIME_FMT[r1] varg[r2] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("SECONDS-FROM-FORMATTED-TIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
r1, $r2) ) YYERROR;
@@ -10340,7 +10399,7 @@ intrinsic: function_udf
| SECONDS_FROM_FORMATTED_TIME '(' DATETIME_FMT[r1] varg[r2] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("SECONDS-FROM-FORMATTED-TIME");
auto r1 = new_reference(new_literal(strlen($r1), $r1,
quoted_e));
if( ! intrinsic_call_2($$, SECONDS_FROM_FORMATTED_TIME,
r1, $r2) ) YYERROR;
@@ -10348,85 +10407,85 @@ intrinsic: function_udf
| HEX_OF '(' varg[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("HEX-OF");
if( ! intrinsic_call_1($$, HEX_OF, $r1, @r1)) YYERROR;
}
| LENGTH '(' tableish[val] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("LENGTH");
$$->clear_attr(signable_e);
parser_set_numeric($$, $val->field->size());
if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
}
| LENGTH '(' varg1a[val] ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("LENGTH");
$$->clear_attr(signable_e);
parser_set_numeric($$, $val->field->data.capacity);
if( ! intrinsic_call_1($$, LENGTH, $val, @val)) YYERROR;
}
| lopper_case[func] '(' alpha_val[r1] ')' {
location_set(@1);
- $$ = new_alphanumeric($r1->field->data.capacity);
+ $$ = new_alphanumeric($r1->field->data.capacity,
"lopper_case[func]");
if( ! intrinsic_call_1($$, $func, $r1, @r1)) YYERROR;
}
| MODULE_NAME '(' module_type[type] ')'
{
- $$ = new_alphanumeric(sizeof(cbl_name_t));
+ $$ = new_alphanumeric(sizeof(cbl_name_t), "MODULE-NAME");
parser_module_name( $$, $type );
}
| NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("NUMVAL-C");
parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
*$r2.arg2, $anycase );
}
| ORD '(' alpha_val[r1] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("ORD");
if( ! intrinsic_call_1($$, ORD, $r1, @r1)) YYERROR;
}
| RANDOM
{
location_set(@1);
- $$ = new_tempnumeric_float();
+ $$ = new_tempnumeric_float("RANDOM");
parser_intrinsic_call_0( $$, intrinsic_cname(RANDOM) );
}
| RANDOM_SEED expr[r1] ')'
{ // left parenthesis consumed by lexer
location_set(@1);
- $$ = new_tempnumeric_float();
+ $$ = new_tempnumeric_float("RANDOM-SEED");
if( ! intrinsic_call_1($$, RANDOM, $r1, @r1)) YYERROR;
}
| STANDARD_COMPARE '(' varg[r1] varg[r2] varg[r3] varg[r4] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("STANDARD-COMPARE");
cbl_unimplemented("STANDARD-COMPARE");
/* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) )
YYERROR; */
}
| STANDARD_COMPARE '(' varg[r1] varg[r2] varg[r3] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("STANDARD-COMPARE");
cbl_unimplemented("STANDARD-COMPARE");
/* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) )
YYERROR; */
}
| STANDARD_COMPARE '(' varg[r1] varg[r2] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("STANDARD-COMPARE");
cbl_unimplemented("STANDARD-COMPARE");
/* if( ! intrinsic_call_4($$, STANDARD_COMPARE, $r1) )
YYERROR; */
}
| SUBSTITUTE '(' varg[r1] subst_inputs[inputs] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("SUBSTITUTE");
std::vector <cbl_substitute_t> args($inputs->size());
std::transform( $inputs->begin(), $inputs->end(),
args.begin(),
[]( const substitution_t& arg ) {
@@ -10442,7 +10501,7 @@ intrinsic: function_udf
| TEST_NUMVAL_C '(' varg[r1] numval_locale[r2] anycase ')' {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("parser_intrinsic_subst($$,");
parser_intrinsic_numval_c( $$, *$r1, $r2.is_locale,
*$r2.arg2, $anycase, true );
}
@@ -10469,14 +10528,14 @@ intrinsic: function_udf
YYERROR;
break;
}
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("TRIM");
cbl_refer_t * how = new_reference($trim_trailing);
if( ! intrinsic_call_2($$, TRIM, $r1, how) ) YYERROR;
}
| USUBSTR '(' alpha_val[r1] expr[r2] expr[r3] ')' {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("USUBSTR");
if( ! intrinsic_call_3($$, FORMATTED_DATETIME,
$r1, $r2, $r3) ) YYERROR;
}
@@ -10484,14 +10543,14 @@ intrinsic: function_udf
| intrinsic_I '(' expr[r1] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric(keyword_str($1));
if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
}
| intrinsic_N '(' expr[r1] ')'
{
location_set(@1);
- $$ = new_tempnumeric_float();
+ $$ = new_tempnumeric_float(keyword_str($1));
if( ! intrinsic_call_1($$, $1, $r1, @r1)) YYERROR;
}
@@ -10501,17 +10560,14 @@ intrinsic: function_udf
auto type = intrinsic_return_type($1);
switch(type) {
case FldAlphanumeric:
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric(keyword_str($1));
break;
default:
- if( $1 == NUMVAL || $1 == NUMVAL_F )
- {
- $$ = new_temporary(FldFloat);
- }
- else
- {
- $$ = new_temporary(type);
- }
+ if( $1 == NUMVAL || $1 == NUMVAL_F ) {
+ $$ = new_temporary(FldFloat, keyword_str($1));
+ } else {
+ $$ = new_temporary(type, keyword_str($1));
+ }
}
if( $1 == NUMVAL_F ) {
if( is_literal($r1->field) && !
is_numeric($r1->field->type) ) {
@@ -10526,7 +10582,7 @@ intrinsic: function_udf
| intrinsic_I2 '(' expr[r1] expr[r2] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("intrinsic_I2");
if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
}
@@ -10542,7 +10598,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
$r1, r2, r3) ) YYERROR;
}
@@ -10558,7 +10614,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
$r1, $r2, r3) ) YYERROR;
}
@@ -10567,7 +10623,7 @@ intrinsic: function_udf
expr[r2] expr[r3] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DATE_TO_YYYYMMDD");
if( ! intrinsic_call_3($$, DATE_TO_YYYYMMDD,
$r1, $r2, $r3) ) YYERROR;
}
@@ -10584,7 +10640,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DAY_TO_YYYYDDD");
if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
$r1, r2, r3) ) YYERROR;
}
@@ -10600,7 +10656,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DAY_TO_YYYYDDD");
if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
$r1, $r2, r3) ) YYERROR;
}
@@ -10609,7 +10665,7 @@ intrinsic: function_udf
expr[r2] expr[r3] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("DAY_TO_YYYYDDD");
if( ! intrinsic_call_3($$, DAY_TO_YYYYDDD,
$r1, $r2, $r3) ) YYERROR;
}
@@ -10626,7 +10682,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("YEAR_TO_YYYY");
if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
$r1, r2, r3) ) YYERROR;
}
@@ -10642,7 +10698,7 @@ intrinsic: function_udf
parser_intrinsic_call_0( r3->field, "__gg__current_date" );
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("YEAR_TO_YYYY");
if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
$r1, $r2, r3) ) YYERROR;
}
@@ -10651,7 +10707,7 @@ intrinsic: function_udf
expr[r2] expr[r3] ')'
{
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("YEAR_TO_YYYY");
if( ! intrinsic_call_3($$, YEAR_TO_YYYY,
$r1, $r2, $r3) ) YYERROR;
}
@@ -10659,25 +10715,25 @@ intrinsic: function_udf
| intrinsic_N2 '(' expr[r1] expr[r2] ')'
{
location_set(@1);
- switch($1)
- {
- case ANNUITY:
- $$ = new_tempnumeric_float();
- break;
- case COMBINED_DATETIME:
- $$ = new_tempnumeric();
- break;
- case REM:
- $$ = new_tempnumeric_float();
- break;
- }
+ switch($1) {
+ case ANNUITY:
+ $$ = new_tempnumeric_float();
+ break;
+ case COMBINED_DATETIME:
+ $$ = new_tempnumeric();
+ break;
+ case REM:
+ $$ = new_tempnumeric_float();
+ break;
+ }
+ $$->data.initial = keyword_str($1); // function name
if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
}
| intrinsic_X2 '(' varg[r1] varg[r2] ')'
{
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric(keyword_str($1));
if( ! intrinsic_call_2($$, $1, $r1, $r2) ) YYERROR;
}
| intrinsic_locale
@@ -10788,65 +10844,66 @@ trim_trailing: %empty { $$ =
new_literal("0"); } // Remove both
intrinsic0: CURRENT_DATE {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE);
+ $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE,
"CURRENT-DATE");
parser_intrinsic_call_0( $$, "__gg__current_date" );
}
| E {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("E");
parser_intrinsic_call_0( $$, "__gg__e" );
}
| EXCEPTION_FILE_N {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-FILE-N");
intrinsic_call_0( $$, EXCEPTION_FILE_N );
}
| EXCEPTION_FILE {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-FILE");
parser_exception_file( $$ );
}
| EXCEPTION_LOCATION_N {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-LOCATION-N");
intrinsic_call_0( $$, EXCEPTION_LOCATION_N );
}
| EXCEPTION_LOCATION {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-LOCATION");
intrinsic_call_0( $$, EXCEPTION_LOCATION );
}
| EXCEPTION_STATEMENT {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-STATEMENT");
intrinsic_call_0( $$, EXCEPTION_STATEMENT );
}
| EXCEPTION_STATUS {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("EXCEPTION-STATUS");
intrinsic_call_0( $$, EXCEPTION_STATUS );
}
| PI {
location_set(@1);
- $$ = new_tempnumeric_float();
+ $$ = new_tempnumeric_float("PI");
parser_intrinsic_call_0( $$, "__gg__pi" );
}
| SECONDS_PAST_MIDNIGHT {
location_set(@1);
- $$ = new_tempnumeric();
+ $$ = new_tempnumeric("SECONDS-PAST-MIDNIGHT");
intrinsic_call_0( $$, SECONDS_PAST_MIDNIGHT );
}
| UUID4 {
location_set(@1);
- $$ = new_alphanumeric();
+ $$ = new_alphanumeric("UUID4");
parser_intrinsic_call_0( $$, "__gg__uuid4" );
}
| WHEN_COMPILED {
location_set(@1);
- $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE); // Returns
YYYYMMDDhhmmssss-0500
+ // Returns YYYYMMDDhhmmssss-0500)
+ $$ = new_alphanumeric(MAXLENGTH_CALENDAR_DATE,
"WHEN-COMPILED");
parser_intrinsic_call_0( $$, "__gg__when_compiled" );
}
;
@@ -12879,6 +12936,34 @@ cbl_figconst_of( const char *value ) {
return p == eovalues? normal_value_e : p->type;
}
+int
+cbl_figconst_tok( const char *value ) {
+ struct values_t {
+ const char *value; int token;
+ } static const values[] = {
+ { constant_of(constant_index(ZERO))->data.initial, ZERO },
+ { constant_of(constant_index(SPACES))->data.initial, SPACES },
+ { constant_of(constant_index(HIGH_VALUES))->data.initial, HIGH_VALUES },
+ { constant_of(constant_index(LOW_VALUES))->data.initial, LOW_VALUES },
+ { constant_of(constant_index(QUOTES))->data.initial, QUOTES },
+ { constant_of(constant_index(NULLS))->data.initial, NULLS },
+ }, *eovalues = values + COUNT_OF(values);
+
+ auto p = std::find_if( values, eovalues,
+ [value]( const values_t& elem ) {
+ return elem.value == value;
+ } );
+
+ return p == eovalues? 0 : p->token;
+}
+
+const cbl_field_t *
+cbl_figconst_field_of( const char *value ) {
+ int token = cbl_figconst_tok(value);
+ return token == 0 ? nullptr : constant_of(constant_index(token));
+}
+
+
cbl_field_attr_t
literal_attr( const char prefix[] ) {
switch(strlen(prefix)) {
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 997ad4f4698a..f62a2f1a534b 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -28,9 +28,9 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <assert.h>
-#include <string.h>
-#include <stdio.h>
+#include <cassert>
+#include <cstring>
+#include <cstdio>
#include <algorithm>
#include <list>
@@ -109,7 +109,7 @@ void input_file_status_notify();
int yylex(void);
extern int yydebug;
-#include <stdarg.h>
+#include <cstdarg>
const char *
consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
@@ -223,7 +223,13 @@ namcpy(const YYLTYPE& loc, cbl_name_t tgt, const char *src
) {
}
cbl_field_t *
-new_alphanumeric( size_t capacity = MAXIMUM_ALPHA_LENGTH );
+new_alphanumeric( size_t capacity = MAXIMUM_ALPHA_LENGTH,
+ const cbl_name_t name = nullptr );
+
+static inline cbl_field_t *
+new_alphanumeric( const cbl_name_t name ) {
+ return new_alphanumeric(MAXIMUM_ALPHA_LENGTH, name);
+}
static inline cbl_refer_t *
new_reference( enum cbl_field_type_t type, const char *initial ) {
@@ -2439,10 +2445,14 @@ char *
normalize_picture( char picture[] );
static inline cbl_field_t *
-new_tempnumeric(void) { return new_temporary(FldNumericBin5); }
+new_tempnumeric(const cbl_name_t name = nullptr) {
+ return new_temporary(FldNumericBin5, name);
+}
static inline cbl_field_t *
-new_tempnumeric_float(void) { return new_temporary(FldFloat); }
+new_tempnumeric_float(const cbl_name_t name = nullptr) {
+ return new_temporary(FldFloat, name);
+}
uint32_t
type_capacity( enum cbl_field_type_t type, uint32_t digits );
@@ -3138,6 +3148,17 @@ current_field(cbl_field_t * field = NULL) {
return local;
}
+static void
+set_real_from_capacity( const YYLTYPE& loc,
+ cbl_field_t *field,
+ REAL_VALUE_TYPE *r ) {
+ if( field == current_field() ) {
+ error_msg(loc, "cannot define %s via self-reference", field->name);
+ return;
+ }
+ field->data.set_real_from_capacity(r);
+}
+
static struct cbl_special_name_t *
special_of( const char F[], int L, const char name[] ) {
struct symbol_elem_t *e = symbol_special(PROGRAM, name);
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index 5ca27282b23e..c11f66ef960a 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -275,7 +275,7 @@ PROCEDURE{SPC}DIVISION { yy_push_state(procedure_div);
IS { pop_return IS; }
OPTIONS { yy_pop_state(); myless(0); }
- [[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE)[[:blank:]]+DIVISION/.+\n {
+ [[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION/[[:space:].] {
yy_pop_state(); myless(0); }
[[:blank:]]*AUTHOR[[:blank:].]+{EOL}? {
// Might not have an EOL, but stop on one.
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index f60f5d52c470..d2faf5a6d92e 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -737,6 +737,10 @@ typed_name( const char name[] ) {
{
auto f = cbl_field_of(e);
if( is_constant(f) ) {
+ if( f->data.initial ) {
+ int token = cbl_figconst_tok(f->data.initial);
+ if( token ) return token;
+ }
int token = datetime_format_of(f->data.initial);
if( token ) {
yylval.string = xstrdup(f->data.initial);
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index dc91fadbf1f3..e540b40a92c5 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -257,43 +257,6 @@ cbl_ffi_arg_t( cbl_ffi_crv_t crv,
} while(0)
-cbl_field_t *
-symbol_valid_udf_args( size_t function, std::list<cbl_refer_t> args ) {
- auto L = cbl_label_of(symbol_at(function));
- if( ! L->returning ) {
- dbgmsg("logic error: %s does not define RETURNING", L->name);
- return NULL;
- }
- auto e = std::find_if( symbol_at(function), symbols_end(),
- []( auto symbol ) {
- if( symbol.type == SymDataSection ) {
- auto section(symbol.elem.section);
- return section.type == linkage_sect_e;
- }
- return false;
- } );
- for( auto arg : args ) {
- size_t iarg(1);
- e++; // skip over linkage_sect_e, which appears after the function
- if( e->type != SymField ) {
- ERROR_FIELD(arg.field,
- "FUNCTION %s has no defined parameter matching arg %zu,
'%s'",
- L->name, iarg, arg.field->name );
- return NULL;
- }
-
- auto tgt = cbl_field_of(e);
-
- if( ! valid_move(tgt, arg.field) ) {
- ERROR_FIELD(tgt, "FUNCTION %s arg %zu, '%s' cannot be passed to %s, type
%s",
- L->name, iarg, arg.field->pretty_name(),
- tgt->pretty_name(), 3 + cbl_field_type_str(tgt->type) );
- return NULL;
- }
- }
- return cbl_field_of(symbol_at(L->returning));
-}
-
static const struct cbl_occurs_t nonarray = cbl_occurs_t();
#if 0
@@ -1847,6 +1810,15 @@ symbols_update( size_t first, bool parsed_ok ) {
if( field->level == 0 && field->is_key_name() ) continue;
if( is_literal(field) && field->var_decl_node != NULL ) continue;
+ // If the field is a constant for a figconstant, just use it.
+ if( field->level != 0 && field->has_attr(constant_e) ) {
+ auto fig = cbl_figconst_field_of(field->data.initial);
+ if( fig ) {
+ field->var_decl_node = fig->var_decl_node;
+ continue;
+ }
+ }
+
if( field->is_typedef() ) {
auto isym = end_of_group( symbol_index(p) );
p = symbol_at(--isym);
@@ -3161,7 +3133,7 @@ using std::deque;
static deque<cbl_field_t*> stack;
static cbl_field_t *
-new_temporary_impl( enum cbl_field_type_t type )
+new_temporary_impl( enum cbl_field_type_t type, const cbl_name_t name =
nullptr )
{
extern int yylineno;
static int nstack, nliteral;
@@ -3238,6 +3210,8 @@ new_temporary_impl( enum cbl_field_type_t type )
snprintf(f->name, sizeof(f->name), "_stack%d",++nstack);
}
+ f->data.initial = name; // capture e.g. the function name
+
return f;
}
@@ -3360,11 +3334,11 @@ temporaries_t::reuse( cbl_field_type_t type ) {
}
cbl_field_t *
-temporaries_t::acquire( cbl_field_type_t type ) {
+temporaries_t::acquire( cbl_field_type_t type, const cbl_name_t name ) {
cbl_field_t *field = reuse(type);
if( !field ) {
- field = new_temporary_impl(type);
+ field = new_temporary_impl(type, name);
add(field);
}
return parser_symbol_add2(field); // notify of reuse
@@ -3397,8 +3371,8 @@ symbol_temporaries_free() {
}
cbl_field_t *
-new_alphanumeric( size_t capacity ) {
- cbl_field_t * field = new_temporary_impl(FldAlphanumeric);
+new_alphanumeric( size_t capacity, const cbl_name_t name = nullptr ) {
+ cbl_field_t * field = new_temporary_impl(FldAlphanumeric, name);
field->data.capacity = capacity;
temporaries.add(field);
return parser_symbol_add2(field);
@@ -3408,15 +3382,14 @@ cbl_field_t *
new_temporary( enum cbl_field_type_t type, const char *initial ) {
if( ! initial ) {
assert( ! is_literal(type) ); // Literal type must have literal value.
- return temporaries.acquire(type);
+ return temporaries.acquire(type, initial);
}
if( is_literal(type) ) {
auto field = temporaries.literal(initial,
type == FldLiteralA? quoted_e : none_e);
return field;
}
- cbl_field_t *field = new_temporary_impl(type);
- field->data.capacity = strlen(field->data.initial = initial);
+ cbl_field_t *field = new_temporary_impl(type, initial);
temporaries.add(field);
parser_symbol_add(field);
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 4a86c676a84d..059d4aa5c7f7 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -32,11 +32,11 @@
#else
#define _SYMBOLS_H_
-#include <assert.h>
-#include <limits.h>
-#include <stdint.h>
-#include <stdlib.h>
-#include <string.h>
+#include <cassert>
+#include <climits>
+#include <cstdint>
+#include <cstdlib>
+#include <cstring>
#include <algorithm>
#include <list>
@@ -149,6 +149,7 @@ is_working_storage(uint32_t attr) {
return 0 == (attr & (linkage_e | local_e));
}
+int cbl_figconst_tok( const char *value );
enum cbl_figconst_t cbl_figconst_of( const char *value );
const char * cbl_figconst_str( cbl_figconst_t fig );
@@ -631,6 +632,8 @@ struct cbl_field_t {
}
};
+const cbl_field_t * cbl_figconst_field_of( const char *value );
+
// Necessary forward referencea
struct cbl_label_t;
struct cbl_refer_t;
@@ -1191,7 +1194,7 @@ class temporaries_t {
public:
cbl_field_t * literal( const char value[], uint32_t len, cbl_field_attr_t
attr = none_e );
cbl_field_t * reuse( cbl_field_type_t type );
- cbl_field_t * acquire( cbl_field_type_t type );
+ cbl_field_t * acquire( cbl_field_type_t type, const cbl_name_t name =
nullptr );
cbl_field_t * add( cbl_field_t *field );
bool keep( cbl_field_t *field ) { return 1 ==
used[field->type].erase(field); }
void dump() const;
@@ -2353,10 +2356,6 @@ symbol_field_same_as( cbl_field_t *tgt, const
cbl_field_t *src );
size_t symbol_file_same_record_area( std::list<cbl_file_t*>& files );
-cbl_field_t *
-symbol_valid_udf_args( size_t function,
- std::list<cbl_refer_t> args = std::list<cbl_refer_t>()
);
-
bool symbol_currency_add( const char symbol[], const char sign[] = NULL );
const char * symbol_currency( char symbol );
diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc
index ef8052c00e39..b4b1b3a1c3ba 100644
--- a/gcc/cobol/symfind.cc
+++ b/gcc/cobol/symfind.cc
@@ -421,7 +421,7 @@ size_t end_of_group( size_t igroup );
static std::vector<size_t>
symbol_match2( size_t program,
- std::list<const char *> names, bool local = true )
+ const std::list<const char *>& names, bool local = true )
{
std::vector<size_t> fields;
@@ -488,7 +488,7 @@ symbol_match2( size_t program,
* N-1.
*/
static symbol_map_t
-symbol_match( size_t program, std::list<const char *> names ) {
+symbol_match( size_t program, const std::list<const char *>& names ) {
auto matched = symbol_match2( program, names );
symbol_map_t output;
diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc
index 8681f7938e98..2cdcfc065b51 100644
--- a/libgcobol/charmaps.cc
+++ b/libgcobol/charmaps.cc
@@ -29,14 +29,16 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
-#include <time.h>
+#include <iconv.h>
+
+#include <cctype>
+#include <clocale>
+#include <cstdio>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <unordered_map>
-#include <locale.h>
-#include <iconv.h>
#include <vector>
#include "ec.h"
diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
index 8c4858ccc61a..2aecc8f20bc8 100644
--- a/libgcobol/common-defs.h
+++ b/libgcobol/common-defs.h
@@ -30,8 +30,9 @@
#ifndef COMMON_DEFS_H_
#define COMMON_DEFS_H_
-#include <stdio.h>
-#include <stdint.h>
+#include <cassert>
+#include <cstdio>
+#include <cstdint>
#include <list>
#define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
diff --git a/libgcobol/constants.cc b/libgcobol/constants.cc
index 8c752707cf1c..eebfd218295f 100644
--- a/libgcobol/constants.cc
+++ b/libgcobol/constants.cc
@@ -27,16 +27,19 @@
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <errno.h>
+
#include <fcntl.h>
-#include <math.h>
-#include <fenv.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cfenv>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <unordered_map>
#include <vector>
diff --git a/libgcobol/ec.h b/libgcobol/ec.h
index 69d973113d38..4315d19ac9d0 100644
--- a/libgcobol/ec.h
+++ b/libgcobol/ec.h
@@ -33,7 +33,6 @@
#define _CBL_EC_H_
#include <set>
-#include <assert.h>
#define EC_ALL_E 0xFFFFFF00
diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h
index 76d5ab8af05d..2ca8883afc29 100644
--- a/libgcobol/gcobolio.h
+++ b/libgcobol/gcobolio.h
@@ -30,7 +30,8 @@
#ifndef GCOBOLIO_H_
#define GCOBOLIO_H_
-#include <stdio.h>
+#include <cstdio>
+
#include <map>
#include <unordered_map>
#include <vector>
diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc
index a2ad342f0c65..806f4a9c4de5 100644
--- a/libgcobol/gfileio.cc
+++ b/libgcobol/gfileio.cc
@@ -27,17 +27,19 @@
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <ctype.h>
+
#include <err.h>
-#include <errno.h>
#include <fcntl.h>
-#include <math.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <vector>
diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc
index 765a2821aeb3..e51cf9fe2da0 100644
--- a/libgcobol/gmath.cc
+++ b/libgcobol/gmath.cc
@@ -27,16 +27,19 @@
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <errno.h>
+
#include <fcntl.h>
-#include <math.h>
-#include <fenv.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <time.h>
#include <unistd.h>
+
+#include <cctype>
+#include <cerrno>
+#include <cmath>
+#include <cfenv>
+#include <cstdio>
+#include <cstdlib>
+#include <cstring>
+#include <ctime>
+
#include <algorithm>
#include <vector>
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index d6dfcb981a5e..1af4a53fce49 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -28,21 +28,21 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-/* Operational note for COBOL intrinsic functions:
-
- In general, the parameters to these functions are cblc_field_t pointers
- along with an offset, size, and for some functions the "allflags", which
- indicate that the variable is a table that was referenced as TABL(ALL)
+/* COBOL intrinsic functions.
+ *
+ * In general, the parameters to these functions are cblc_field_t pointers
+ * along with an offset, size, and for some functions the "allflags", which
+ * indicate that the variable is a table that was referenced as TABL(ALL)
+ */
+#include <langinfo.h>
- */
+#include <cctype>
+#include <cmath>
+#include <cstring>
+#include <ctime>
-#include <time.h>
-#include <math.h>
#include <algorithm>
-#include <cctype>
-#include <langinfo.h>
-#include <string.h>
#include <vector>
#include "config.h"
diff --git a/libgcobol/io.cc b/libgcobol/io.cc
index 95e1d0266861..9b07309b90e9 100644
--- a/libgcobol/io.cc
+++ b/libgcobol/io.cc
@@ -31,11 +31,12 @@
#include "config.h"
#include "io.h"
-#include "stdio.h"
-#include "stdlib.h"
-#include <errno.h>
-#include <stdbool.h>
-#include <stdint.h>
+
+#include <cstdio>
+#include <cstdlib>
+#include <cerrno>
+#include <cstdbool>
+#include <cstdint>
/*
* The Cobol runtime support is responsible to set the file status
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 6bae27a3c671..66405baf99b1 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -29,7 +29,6 @@
*/
#include <algorithm>
#include <cctype>
-#include <cerrno>
#include <cstdio>
#include <cstdlib>
#include <cstring>
@@ -45,7 +44,7 @@
#include <err.h>
#include <fcntl.h>
#include <fenv.h>
-#include <math.h> // required for fpclassify(3)
+#include <math.h> // required for fpclassify(3), not in cmath
#include <setjmp.h>
#include <signal.h>
#include <syslog.h>
@@ -11434,17 +11433,6 @@ __gg__clear_exception()
ec_stack.top().clear();
}
-// Update the list of compiler-maintained enabled exceptions.
-extern "C"
-void
-__gg__stash_exceptions( size_t nec, cbl_enabled_exception_t *ecs )
-{
- enabled_ECs = cbl_enabled_exceptions_t(nec, ecs);
-
- if( false && MATCH_DECLARATIVE )
- warnx("%s: %zu exceptions enabled", __func__, nec);
-}
-
void
cbl_enabled_exception_t::dump( int i ) const {
warnx("cbl_enabled_exception_t: %2d {%s, %s, %zu}",
diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc
index 873fa93709f9..8349b761f252 100644
--- a/libgcobol/valconv.cc
+++ b/libgcobol/valconv.cc
@@ -29,9 +29,10 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
+#include <cctype>
+#include <cstdio>
+#include <cstring>
+
#include <algorithm>
#include <unordered_map>
#include <vector>
