https://gcc.gnu.org/g:dfb1ec753c8ad9601f0c14eeb40b54b498d37f7f
commit r17-5351-gdfb1ec753c8ad9601f0c14eeb40b54b498d37f7f Author: James K. Lowden <[email protected]> Date: Fri Oct 16 21:43:00 2026 -0400 cobol: Miscellaneous small fixes. Update message for Werrno. Remove vertical positioning from SEQUENTIAL files. ADVANCING on such files is ignored. Update I/O plugin facility to support veritical positioning at runtime. Support #line directive (again). Introduce support for GnuCOBOL DEFLIT directive. Fix bug wherein -ffree-from command-line option had no effect. gcc/cobol/ChangeLog: * cobol1.cc (cobol_langhook_handle_option): Use ParErrno for Werrno. * lexio.cc (parse_replace_pairs): Whitespace. (parse_copy_directive): Same. (inode_of): Same. (cdftext::lex_open): Use new cmd_line::source_format. (valid_sequence_area): Whitespace (cdftext::free_form_reference_format): Use new cmd_line::source_format. (output_segment): Whitespace. (cdftext::process_file): Same. * lexio.h (struct bytespan_t): Same. (struct filespan_t): Same. (class cdftext): Remove command_line_indicator_column. * parse.y: Associate messasge with Werror. * scan.l: Support DEFLIT directive. libgcobol/ChangeLog: * gcobolio.h (class gcobol_io_t): Class is public for plugin use. (__gg__file_io_funcs): New function. * gfileio.cc (class gcobol_io_t): Use header-file definition. Diff: --- gcc/cobol/cobol1.cc | 2 +- gcc/cobol/lexio.cc | 54 +++++++++++--------------- gcc/cobol/lexio.h | 18 ++++----- gcc/cobol/parse.y | 5 ++- gcc/cobol/scan.l | 1 + libgcobol/gcobolio.h | 88 +++++++++++++++++++++++++++++++++++++++++ libgcobol/gfileio.cc | 108 --------------------------------------------------- 7 files changed, 122 insertions(+), 154 deletions(-) diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 7ea8839654e9..bc49f6059d42 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -733,7 +733,7 @@ cobol_langhook_handle_option (size_t scode, return true; case OPT_Werrno: - cobol_warning(ParNumstrW, cobol_errno, warning_as_error); + cobol_warning(ParErrno, cobol_errno, warning_as_error); return true; case OPT_Wiconv_error: diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index 4c18736eefe4..7138dd657d2a 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -809,7 +809,7 @@ parse_replace_pairs( const char *stmt, const char *estmt, std::list<replace_t> pairs ; static const char any_ch[] = ""; - // lexio replaces 'D' with 0x8D for a Debug indicator, which scan.l recognizes. + // lexio replaces 'D' with 0x8D for a Debug indicator, which scan.l recognizes. static const char nonword_ch[] = "[^[:alnum:]\x8D\"'$_-]"; // Pattern to find one REPLACE pseudo-text pair @@ -987,7 +987,7 @@ parse_copy_directive( filespan_t& mfile, const source_format_t& source_format ) size_t nst = 1 + count_newlines(copy_stmt.p, copy_stmt.pend); dbgmsg("%s:%d: %s:" HOST_SIZE_T_PRINT_UNSIGNED ": COPY directive is " HOST_SIZE_T_PRINT_UNSIGNED " lines '%.*s'", - __func__, __LINE__, cobol_filename(), + __func__, __LINE__, cobol_filename(), (fmt_size_t)nnl, (fmt_size_t)nst, copy_stmt.size(), copy_stmt.p); } } @@ -1498,6 +1498,10 @@ inode_of( int fd ) { return sb.st_ino; } +namespace cmd_line { + static source_format_t source_format; +} + FILE * cdftext::lex_open( const char filename[] ) { /* @@ -1507,21 +1511,17 @@ cdftext::lex_open( const char filename[] ) { * redundant. */ + source_format_stack_t source_format; + source_format.push(cmd_line::source_format); + int input = open_input( filename ); if( input == -1 ) return NULL; int output = open_output(); - size_t n =0; - + size_t n = 0; + // Process any files supplied by the -include command-line option. for( auto name : included_files ) { - source_format_stack_t source_format; - source_format_t format; // free-form by default - if( command_line_indicator_column || explicit_format ) { - format.indicator_column_set(command_line_indicator_column); - } - source_format.push(format); - int input; // cppcheck-suppress shadowVariable if( -1 == (input = open(name, O_RDONLY)) ) { cbl_message(LexIncludeE, "cannot open %<-include%> file %qs", name); @@ -1537,13 +1537,6 @@ cdftext::lex_open( const char filename[] ) { dbgmsg("lex_open: processed %zu of %zu: '%s'", n, included_files.size(), name); cobol_filename_restore(); // process_file restores only for COPY } - source_format_stack_t source_format; - source_format_t format; // free-form by default - if( command_line_indicator_column || explicit_format ) { - format.indicator_column_set(command_line_indicator_column); - } - source_format.push(format); - included_files.clear(); dbgmsg("lex_open: '%s'", filename); @@ -1708,7 +1701,7 @@ valid_sequence_area( const char *data, const char *eodata ) { p++ ) { auto eol = std::find(p, eodata, '\n'); - if( p == data || ISSPACE(p[-1]) ) { // start-of-buffer or preceded by space. + if( p == data || ISSPACE(p[-1]) ) { // start-of-buffer or preceded by space. if( is_program_id(p, eol) ) { // found program-id token const char *bol = p; for( ; data <= bol-1 && bol[-1] != '\n'; --bol ) @@ -1780,7 +1773,7 @@ cdftext::free_form_reference_format( int input, if( mfile.is_blank_line() ) continue; // indcol is true only for fixed format - char *indcol = format.top().indicated(mfile.cur, mfile.eol); + char *indcol = format.top().indicated(mfile.cur, mfile.eol); if( format.top().is_fixed() && !indcol ) { // short line erase_source(mfile.cur, mfile.eol); @@ -1873,16 +1866,13 @@ cdftext::free_form_reference_format( int input, } bool cdftext::please_push_filename = false; -int cdftext::command_line_indicator_column = 0; -bool cdftext::explicit_format = false; void cobol_set_indicator_column( int column ) { - cdftext::command_line_indicator_column = column; - cdftext::explicit_format = true; - source_format_t local; - local.indicator_column_set(column); - dbgmsg("%s: format now %s", __func__, local.description()); + source_format_t& format( cmd_line::source_format ); + + format.indicator_column_set(column); + dbgmsg("%s: format now %s", __func__, format.description()); } static inline void @@ -1897,7 +1887,7 @@ output_segment(const char *beg, const char *end, if (*p == '\t') { std::generate_n(ofs, 8, [](){ return ' '; }); continue; - } + } *ofs = *p; } #endif @@ -1947,12 +1937,12 @@ cdftext::output_push_directive( const char filename[], * cobol filename and yylineno. */ void -cdftext::process_file( filespan_t mfile, int output, - source_format_stack_t source_format, +cdftext::process_file( filespan_t mfile, int output, + source_format_stack_t source_format, bool second_pass ) { static size_t nfiles = 0; - + __gnu_cxx::stdio_filebuf<char> outbuf(fdopen(output, "a"), std::ios::out); std::ostream out(&outbuf); std::ostream_iterator<char> ofs(out); @@ -2020,7 +2010,7 @@ cdftext::process_file( filespan_t mfile, int output, */ cobol_filename_restore(); unsigned long n = std::count(copied.erased_lines.p, copied.erased_lines.pend, '\n'); - std::copy_if(copied.erased_lines.p, copied.erased_lines.pend, ofs, + std::copy_if(copied.erased_lines.p, copied.erased_lines.pend, ofs, []( char ch ) { return ch == '\n'; } ); dbgmsg("%s:%d: %lu blank lines erased", __func__, __LINE__, n); } diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h index 742e28eb18de..e920bec3b304 100644 --- a/gcc/cobol/lexio.h +++ b/gcc/cobol/lexio.h @@ -71,7 +71,7 @@ struct bytespan_t { char *data, *eodata; bytespan_t() : data( nullptr), eodata(nullptr) {} - + bytespan_t( char *data, char *eodata ) : data(data), eodata(eodata) { @@ -204,7 +204,6 @@ struct filespan_t : public bytespan_t { loc.first_column = loc.last_column = 1 + icol; return loc; } - }; #if USE_STD_REGEX @@ -307,7 +306,7 @@ public: } left = column; } - + char * indicated( char *bol, const char *eol, char ch = '\0' ); bool inference_pending() { @@ -319,13 +318,13 @@ public: inline bool is_fixed() const { return left == 7; } inline bool is_reffmt() const { return is_fixed() && right == 73; } inline bool is_free() const { return ! is_fixed(); } - + const char * description() const { if( is_reffmt() ) return "REFERENCE"; if( is_fixed() ) return "FIXED"; if( is_free() ) return "FREE"; gcc_unreachable(); - } + } inline int left_margin() { return left == 0? left : left - 1; @@ -350,15 +349,12 @@ typedef std::stack<source_format_t> source_format_stack_t; #include <cstdio> + class cdftext { static bool please_push_filename; - static int command_line_indicator_column; - static bool explicit_format; - - friend void cobol_set_indicator_column( int column ); - static void process_file( filespan_t mfile, int output, - source_format_stack_t source_format, + static void process_file( filespan_t mfile, int output, + source_format_stack_t source_format, bool second_pass = false ) ; static filespan_t free_form_reference_format( int fd, source_format_stack_t& ); diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 8e63105cc688..18cf8374fea2 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -4091,8 +4091,9 @@ level_name: LEVEL ctx_name if( !namcpy(@ctx_name, field.name, $2) ) YYERROR; if( 0 == strcasecmp(field.name, "errno") ) { - warn_msg(@ctx_name, "%<errno%> does not refer to the C variable, " - "see posix-errno function"); + cbl_message(@ctx_name, ParErrno, + "%<errno%> does not refer to the C variable, " + "see posix-errno function"); } $$ = field_add(@$, &field); diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 9c5008683dd5..c7afdd262a70 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -2797,6 +2797,7 @@ BASIS { yy_push_state(basis); return BASIS; } ^[ ]*[$]{OBLANK}SET({SPC}CONSTANT)? { dialect_ok(yylloc, MfCdfDollar, yytext); PUSH_CDF_STATE; return CDF_DEFINE; } + ^[ ]*[#]DEFLIT { PUSH_CDF_STATE; return CDF_DEFINE; } ^[ ]*[$]{OBLANK}DISPLAY { dialect_ok(yylloc, MfCdfDollar, yytext); PUSH_CDF_STATE; return CDF_DISPLAY; } diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h index 028c97c93d6c..f6dbae7025f4 100644 --- a/libgcobol/gcobolio.h +++ b/libgcobol/gcobolio.h @@ -154,4 +154,92 @@ typedef struct cblc_file_t #define FILE_BUFFER_SIZE (64 * 1024) +/* + * The following is a public API for gcobol I/O. + * + * The class gcobol_io_t may be used by any library that provides an I/O + * implementation. + * + * The library constructs the class, providing its own pointers, and supplies a + * known function. It calls __gg__file_io_funcs() to return the default + * implementation, and overwrites it with one or more of its own functions. + * gcobol-compiled programs call the functions through the pointers. + * + * This design makes it possible to run the same code, unaltered, simply by + * relinking. It is commonly used, and is similar to the one used in GnuCOBOL. + * One difference is that the file status is captured in the cblc_file_t, + * whereas in GnuCOBOL it is the return value. + * + * There is no provision for using more than one implementation at + * a time in the same program. + */ + +class gcobol_io_t { +public: + static const char constexpr marquee[64] = "libgcobol: gfileio.cc"; + + typedef void (open_t)( cblc_file_t *file, + const char *filename, + int mode_char); + typedef void (close_t)( cblc_file_t *file, + int how ); + typedef void (start_t)( cblc_file_t *file, + int relop, // needs enum + int first_last_key, + size_t length ); + typedef void (read_t)( cblc_file_t *file, + int where ); + typedef void (write_t)( cblc_file_t *file, + const unsigned char *location, + size_t length, + int after, + int lines, + int is_random ); + typedef void (rewrite_t)(cblc_file_t *file, + size_t length, bool is_random ); + typedef void (delete_t)(cblc_file_t *file, + bool is_random ); + typedef void (remove_t)(cblc_file_t *file, + const char *filename); + open_t *Open; + close_t *Close; + start_t *Start; + read_t *Read; + write_t *Write; + rewrite_t *Rewrite; + delete_t *Delete; + remove_t *Remove; + + gcobol_io_t() + : Open(NULL) + , Close(NULL) + , Start(NULL) + , Read(NULL) + , Write(NULL) + , Rewrite(NULL) + , Delete(NULL) + , Remove(NULL) + {} + + gcobol_io_t( open_t *Open, + close_t *Close, + start_t *Start, + read_t *Read, + write_t *Write, + rewrite_t *Rewrite, + delete_t *Delete, + remove_t *Remove) + : Open(Open) + , Close(Close) + , Start(Start) + , Read(Read) + , Write(Write) + , Rewrite(Rewrite) + , Delete(Delete) + , Remove(Remove) + {} +}; + +gcobol_io_t * __gg__file_io_funcs(); + #endif diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc index 0fa1187f3e56..db66b274f0fc 100644 --- a/libgcobol/gfileio.cc +++ b/libgcobol/gfileio.cc @@ -5345,114 +5345,6 @@ __gg__file_stash( cblc_file_t *file ) ::stashed = file; } - /* - * The following constitutes a proposal for a public API to gcobol I/O. - * - * The class gcobol_io_t would be in a public header file that - * would be used by any library that provides an I/O - * implementation. Additionally, that header would be where - * cblc_file_t is defined, and where the valid file status values - * (and relops) are enumerated. - * - * The library constructs the class, providing its own pointers, - * and supplies a known function, gcobol_fileops, to return - * it. gcobol-compiled programs call the functions, or others - * supplied by a different implementation, through the pointers. - * - * This design makes it possible to run the same code, unaltered, - * simply by relinking. - * - * This design is commonly used, and is similar to the one used in - * GnuCOBOL. One difference is that the file status is captured - * in the cblc_file_t, whereas in GnuCOBOL it is the return value. - * - * There is no provision for using more than one implementation at - * a time in the same program, as would be needed for CODE-SET - * support. To achieve that in C++ without dynamic linking, there - * would have to be a set of known implementations, each with its - * own namespace, in which gcobol_fileops would be defined. - */ - -class gcobol_io_t { -public: - static const char constexpr marquee[64] = "libgcobol: gfileio.cc"; - - typedef void (open_t)( cblc_file_t *file, - const char *filename, - int mode_char); - typedef void (close_t)( cblc_file_t *file, - int how ); - typedef void (start_t)( cblc_file_t *file, - int relop, // needs enum - int first_last_key, - size_t length ); - typedef void (read_t)( cblc_file_t *file, - int where ); - typedef void (write_t)( cblc_file_t *file, - const unsigned char *location, - size_t length, - int after, - int lines, - int is_random ); - typedef void (rewrite_t)(cblc_file_t *file, - size_t length, bool is_random ); - typedef void (delete_t)(cblc_file_t *file, - bool is_random ); - typedef void (remove_t)(cblc_file_t *file, - const char *filename); - open_t *Open; - close_t *Close; - start_t *Start; - read_t *Read; - write_t *Write; - rewrite_t *Rewrite; - delete_t *Delete; - remove_t *Remove; - - gcobol_io_t() - : Open(NULL) - , Close(NULL) - , Start(NULL) - , Read(NULL) - , Write(NULL) - , Rewrite(NULL) - , Delete(NULL) - , Remove(NULL) - {} - - gcobol_io_t( open_t *Open, - close_t *Close, - start_t *Start, - read_t *Read, - write_t *Write, - rewrite_t *Rewrite, - delete_t *Delete, - remove_t *Remove) - : Open(Open) - , Close(Close) - , Start(Start) - , Read(Read) - , Write(Write) - , Rewrite(Rewrite) - , Delete(Delete) - , Remove(Remove) - {} - -#if FILE_IO_IMPLEMENTED - int read_next(); - int fildelete(); - void ioinit(); - void ioexit(); - int iofork(); - int iosync(); - int commit(); - int rollback(); - int iounlock(); - char * ioversion(); -#endif -}; - - // Our implementation returns this populated structure gcobol_io_t*
