diff --git a/gcc/cobol/cdf_text.h b/gcc/cobol/cdf_text.h
index 4f2c281f23c51a20d86aaa2ffce07ae9e8d7d1f1..8c86bc770db7d034d01462523099a9d0904850dc 100644
--- a/gcc/cobol/cdf_text.h
+++ b/gcc/cobol/cdf_text.h
@@ -28,7 +28,51 @@
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
+static const char *
+find_filter( const char filter[] ) {
+
+ if( 0 == access(filter, X_OK) ) {
+ return filter;
+ }
+
+ const char *path = getenv("PATH");
+ if( ! path ) return NULL;
+ char *p = strdup(path), *eopath = p + strlen(p);
+
+ while( *p != '\0' ) {
+ auto pend = std::find( p, eopath, ':' );
+ if( *pend == ':' ) *pend++ = '\0';
+
+ static char name[PATH_MAX];
+
+ snprintf( name, sizeof(name), "%s/%s", p, filter );
+
+ if( 0 == access(name, X_OK) ) {
+ return name;
+ }
+ p = pend;
+ }
+ return NULL;
+}
+
+bool verbose_file_reader = false;
+static std::list<char *> preprocessor_filters;
+
#include "lexio.h"
+
+#include <sys/types.h>
+#include <sys/wait.h>
+
+bool preprocess_filter_add( const char filter[] ) {
+ auto filename = find_filter(filter);
+ if( !filename ) {
+ warnx("error: preprocessor '%s/%s' not found", getcwd(NULL, 0), filter);
+ return false;
+ }
+ preprocessor_filters.push_back( strdup(filename) );
+ return true;
+}
+
FILE *
cdftext::lex_open( const char filename[] ) {
int input = open_input( filename );
@@ -39,6 +83,29 @@ cdftext::lex_open( const char filename[] ) {
cobol_filename(filename);
process_file( mfile, output );
+ for( auto filter : preprocessor_filters ) {
+ input = output;
+ output = open_output();
+
+ pid_t pid = fork();
+
+ switch(pid){
+ case -1: err(EXIT_FAILURE, "%s", __func__);
+ case 0: // child
+ if( -1 == dup2(input, STDIN_FILENO) ) {
+ errx(EXIT_FAILURE, "%s: could not dup input", __func__);
+ }
+ if( -1 == dup2(output, STDOUT_FILENO) ) {
+ errx(EXIT_FAILURE, "%s: could not dup output", __func__);
+ }
+ _exit( execl( filter, filter, "/dev/stdin", NULL ) );
+ }
+ int status;
+ if( pid != wait(&status) ) {
+ err(EXIT_FAILURE, "error: %s failed with exit status %d", filter, status);
+ }
+ }
+
return fdopen( output, "r");
}
@@ -49,6 +116,12 @@ cdftext::open_input( const char filename[] ) {
if( fd == -1 ) {
if( yydebug ) warn( "error: could not open '%s'", filename );
}
+
+ verbose_file_reader = NULL != getenv("GCOBOL_TEMPDIR");
+
+ if( verbose_file_reader ) {
+ warnx("verbose: opening %s for input", filename);
+ }
return fd;
}
@@ -58,7 +131,7 @@ cdftext::open_output() {
char *name = getenv("GCOBOL_TEMPDIR");
int fd;
- if( name ) {
+ if( name && 0 != strcmp(name, "/") ) {
sprintf(stem, "%sXXXXXX", name);
if( -1 == (fd = mkstemp(stem)) ) {
err(EXIT_FAILURE,
diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index 3eaa25a32e4809298bf29e375068079b92f163ca..4cc4f3c9e7e4253c549526b0e056063d5b79babc 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -155,6 +155,8 @@ void parser_internal_is_ebcdic(bool is_ebcdic);
bool use_static_call( bool yn );
void add_cobol_exception( int );
+bool preprocess_filter_add( const char filter[] );
+
bool max_errors_exceeded( int nerr ) {
return flag_max_errors != 0 && flag_max_errors <= nerr;
}
@@ -252,7 +254,7 @@ cobol_langhook_handle_option (size_t scode,
return true;
case OPT_preprocess:
- ////preprocess_filter_add(arg);
+ preprocess_filter_add(arg);
return true;
case OPT_main:
diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index ed930fc5e0362493314a88f61af7e60d6b4c7e69..b7ec1cef5010a67be7629efe8c2d3113f4578909 100644
--- a/gcc/cobol/gcobol.1
+++ b/gcc/cobol/gcobol.1
@@ -19,6 +19,7 @@
.Op Fl findicator-column
.Op Fl finternal-ebcdic
.Op Fl dialect Ar dialect-name
+.Op Fl preprocess Ar preprocess-filter
.Op Fl fflex-debug
.Op Fl fyacc-debug
.Ar filename Op ...
@@ -228,6 +229,25 @@ Only a few such non-standard constructs are accepted, and
makes no claim or aspiration to emulate other compilers. But to the
extent that a feature is popular but nonstandard, this
option provides a way to support it, or add it.
+.
+.It Fl preprocess Ar preprocess-filter
+After all CDF text-manipulation has been applied, and before the
+prepared \*[lang] is sent to the cobol1 compiler, the input may be
+further altered by one or more filters. In the tradition of
+.Xr sed 1 ,
+each
+.Ar preprocess-filter
+reads from standard input and writes to standard output.
+No options or arguments are supported for
+.Ar preprocess-filter .
+.Nm
+searches the current working directory and the PATH environment
+variable directories for the existence of an executable file whose
+name matches
+.Ar preprocess-filter .
+The first one found is used. If none is found, an error is reported
+and the compiler is not invoked.
+.
.It Fl fflex-debug Ns Li , Fl fyacc-debug
produce messages useful for compiler development. The
.Fl fflex-debug
@@ -875,7 +895,8 @@ through
where 0-7 indicates a bit position. The value of the UPSI switches is
taken from the
.Ev UPSI
-environment variable, whose value is a string of up to eight 1's and 0's. The first character represents the value of
+environment variable, whose value is a string of up to eight 1's and
+0's. The first character represents the value of
.Sy UPSI-0 ,
and missing values are assigned 0. For example,
.Sy UPSI=1000011
@@ -885,6 +906,15 @@ in the environment sets bits 0, 5, and 6 on, which means that
and
.Sy UPSI-6
are on.
+.It Ev GCOBOL_TEMPDIR
+causes any temporary files created during CDF processing to be written
+to a file whose name is specified in the value of
+.Ev GCOBOL_TEMPDIR .
+If the value is just
+.Dq / ,
+the effect is different: each copybook read is reported on standard
+error. This feature is meant to help diagnose mysterious copybook
+errors.
.El
.
.Sh FILES
diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h
index e619d853abfd4e80ae6ba0ced714b356c4870e45..2deca53c15c92f6bfc077f87c119111e6a45ac3d 100644
--- a/gcc/cobol/lexio.h
+++ b/gcc/cobol/lexio.h
@@ -230,13 +230,6 @@ struct replace_t {
#include <list>
class cdftext {
- ////std::stack< std::list<replace_t> > replace_directives;
-
- //// bool parse_copy_directive( filespan_t& mfile );
- //// bool parse_replace_last_off( filespan_t& mfile );
- //// bool parse_replace_text( filespan_t& mfile, size_t current_lineno );
- //// parse_replace_directive( filespan_t& mfile, size_t current_lineno );
-
static filespan_t free_form_reference_format( int fd );
static void process_file( filespan_t, int output, bool second_pass = false );
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index a8d00f6408a01dfa8fecfd829fbad065b61d0306..67cbd6fea55f78d5356bbfdba87305be350868df 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -2938,11 +2938,11 @@ data_descr1: level_name
assert($field == current_field());
if( $data_clauses == value_clause_e ) { // only VALUE, no PIC
// Error unless VALUE is a figurative constant or (quoted) string.
- if( !has_field_attr($field->attr, quoted_e) &&
+ if( $field->type != FldPointer &&
+ ! has_field_attr($field->attr, quoted_e) &&
normal_value_e == cbl_figconst_of($field->data.initial) )
{
- yyerrorv("syntax error: "
- "%s numeric VALUE %s requires PICTURE",
+ yyerrorv("error: %s numeric VALUE %s requires PICTURE",
$field->name, $field->data.initial);
}
$field->type = FldAlphanumeric;
@@ -3172,10 +3172,11 @@ data_clauses: data_clause
YYERROR;
}
cbl_field_t *field = current_field();
+#if 0
if( symbol_redefines(field) ) {
redefine_field(field);
}
-
+#endif
const int globex = (global_e | external_e);
if( (($$ | $2) & globex) == globex ) {
yyerror("GLOBAL and EXTERNAL specified");
@@ -3513,7 +3514,25 @@ usage_clause1: usage COMPUTATIONAL[comp] native
$$ = symbol_field_index_set( current_field() )->type;
}
// We should enforce data/code pointers with a different type.
- | usage POINTER { $$ = FldPointer; }
+ | usage POINTER
+ {
+ $$ = FldPointer;
+ auto field = current_field();
+ auto redefined = symbol_redefines(field);
+
+ field->data.capacity = sizeof(void *);
+
+ if( dialect_ibm() && redefined &&
+ is_numeric(redefined->type) && redefined->size() == 4) {
+ // For now, we allow POINTER to expand a 32-bit item to 64 bits.
+ if( yydebug ) {
+ warnx("%s: expanding #%zu %s capacity %u => %u", __func__,
+ field_index(redefined), redefined->name,
+ redefined->data.capacity, field->data.capacity);
+ }
+ redefined->data.capacity = field->data.capacity;
+ }
+ }
| usage POINTER TO error
{
yyerror("error: unimplemented: TYPEDEF");
@@ -3626,6 +3645,7 @@ redefines_clause: REDEFINES NAME[orig]
orig->level, name_of(orig),
field->level, name_of(field));
}
+
if( valid_redefine(field, orig) ) {
/*
* Defer "inheriting" the parent's description until the
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 865dd1c11b0d4da8ee4945f43c60c513bf95539c..b04c1cbe08e75731c92aa5dd7b8b83b22a1e4ab1 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -2166,12 +2166,17 @@ valid_redefine( const cbl_field_t *field, const cbl_field_t *orig ) {
*/
if( field->type != FldGroup && orig->type != FldGroup ) {
if( orig->size() < field->size() ) {
- if( orig->level > 1 || has_field_attr(orig->attr, external_e) )
+ if( orig->level > 1 || has_field_attr(orig->attr, external_e) ) {
+ if( yydebug ) {
+ yyerrorv( "size error orig: %s", field_str(orig) );
+ yyerrorv( "size error redef: %s", field_str(field) );
+ }
yyerrorv( "error: %s (%s size %u) larger than REDEFINES %s (%s size %u)",
field->name,
3 + cbl_field_type_str(field->type), field->size(),
orig->name,
3 + cbl_field_type_str(orig->type), orig->size() );
+ }
}
}
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 110c3f038255721950cb5d98adf463a29c3e9550..98644f11b586d48aee6fa8fa254db1fc073e5736 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -1266,31 +1266,35 @@ static struct symbol_elem_t *
* referenced by data- name-2 has been specified with level
* number 1 and without the EXTERNAL clause.
*/
- if( redefined && redefined->type == FldGroup && redefined->level > 1 ) {
- if( field->type != FldGroup && redefined->type != FldGroup ) {
- if( field_memsize(redefined) < field_memsize(field) ) {
- yyerrorv("error: line %d: %s (size %u) larger than REDEFINES %s (size %u)",
- field->line,
- field->name, field_memsize(field),
- redefined->name, field_memsize(redefined));
+ if( redefined ) {
+ if( redefined->type == FldGroup && redefined->level > 1 ) {
+ if( field->type != FldGroup && redefined->type != FldGroup ) {
+ assert(false);
+ // don't know what this intended, but redefined->type can't be FldGroup and not.
+ if( field_memsize(redefined) < field_memsize(field) ) {
+ yyerrorv("error: line %d: %s (size %u) larger than REDEFINES %s (size %u)",
+ field->line,
+ field->name, field_memsize(field),
+ redefined->name, field_memsize(redefined));
+ }
}
}
- }
+
+ if( redefined != group) {
+ if( group->our_index != redefined->parent ) {
+ if( yydebug ) yyerrorv("%s:%d: our index %zu != redefined parent %zu",
+ __func__, __LINE__, group->our_index, redefined->parent);
+ continue;
+ }
- if( redefined && redefined != group) {
- if( group->our_index != redefined->parent ) {
- if( yydebug ) yyerrorv("%s:%d: our index %zu != redefined parent %zu",
- __func__, __LINE__, group->our_index, redefined->parent);
+ redefined->data.memsize = std::max(field_memsize(redefined),
+ field_memsize(field));
+ field->data.memsize = 0;
+ if( redefined->data.memsize == redefined->data.capacity ) {
+ redefined->data.memsize = 0;
+ }
continue;
}
-
- redefined->data.memsize = std::max(field_memsize(redefined),
- field_memsize(field));
- field->data.memsize = 0;
- if( redefined->data.memsize == redefined->data.capacity ) {
- redefined->data.memsize = 0;
- }
- continue;
}
members.push_back(field);
@@ -1312,7 +1316,9 @@ static struct symbol_elem_t *
if( redefined ) {
assert( group == redefined );
max_memsize = std::max(max_memsize, field_memsize(field));
- field->data.memsize = 0;
+ if( redefined->data.memsize == redefined->data.capacity ) {
+ redefined->data.memsize = 0;
+ }
continue;
}
group->data.capacity += field_size(field);
@@ -1328,7 +1334,9 @@ static struct symbol_elem_t *
if( group->data.memsize == group->data.capacity ) group->data.memsize = 0;
if( 0 < group->data.memsize && group->data.memsize < group->data.capacity ) {
- warnx( "%s:%d: small capacity?\n\t%s", __func__, __LINE__, field_str(group) );
+ if( yydebug ) {
+ warnx( "%s:%d: small capacity?\n\t%s", __func__, __LINE__, field_str(group) );
+ }
group->data.memsize = group->data.capacity;
}
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index bbc3e7824c9d56824e10f4e149eed1800de043c0..7f94c2e8d9ccc425e8f3afc7b20b89443cf51917 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -752,7 +752,7 @@ redefine_field( cbl_field_t *field ) {
}
if( field->data.capacity == 0 ) field->data = primary->data;
-
+
if( is_numeric(field->type) && field->usage == FldDisplay ) {
fOK = symbol_field_type_update(field, FldNumericDisplay, false);
}