https://gcc.gnu.org/g:08e9df25462097cb5f0bf8d5156fa059d1bd7ec5
commit r16-5210-g08e9df25462097cb5f0bf8d5156fa059d1bd7ec5 Author: James K. Lowden <[email protected]> Date: Wed Nov 12 17:48:34 2025 -0500 cobol: Introduce vendor-compatibility layer as user-defined functions. Install COBOL UDFs in a target directory that includes the GCC version in its path, to permit side-by-side installation. Support compat library with COBOL POSIX bindings; support those binding with C functions in libgcobol as needed. Changes to the compiler to support POSIX binding and testing. Include developer conveniences -- Makefiles, bin/ and t/ directories -- to ensure UDFs compile and return reasonable results. These are not installed and do not affect how libgcobol is built. gcc/cobol/ChangeLog: * cdf.y: Install literals in symbol table. * genapi.cc (parser_alphabet): Use std::string for currency. (initialize_the_data): Rely on constructor. (parser_file_add): Better #pragma message. (parser_exception_file): Return early if not generating code. * parse.y: Allow library programs to act as functions. * parse_ante.h (dialect_proscribed): Standardize message. (intrinsic_call_2): Correct s/fund/func/ misspelling. * scan.l: Comment. * symbols.cc (symbols_update): Add unreachable assertion. (symbol_field_parent_set): Reduce error to debug message. (cdf_literalize): Declare. (symbol_table_init): Insert CDF constants as literals. * symbols.h (cbl_dialect_str): Provide string values for enum. (is_working_storage): Remove function. (struct cbl_field_data_t): Add manhandle_initial for Numeric Edited. (struct cbl_field_t): Initialize name to zeros. (struct cbl_section_t): Delete unused attr() function. (symbol_unique_index): Declare. * token_names.h: Regenerate. * util.cc (cdf_literalize): Construct a cbl_field_t from a CDF literal. (symbol_unique_index): Supply "globally" unique number for a program. libgcobol/ChangeLog: * Makefile.am: Move UDF-support to posix/shim, add install targets * Makefile.in: Regenerate * charmaps.cc (__gg__currency_signs): Use std::string. * charmaps.h: Include string and vector headers. (class charmap_t): Use std::string and vector for currency. * config.h.in: Regenerate. * configure: Regenerate. * configure.ac: Check for libxml2. * intrinsic.cc (numval_c): Constify. * libgcobol.cc (struct program_state): Use std::string and vector. (__gg__inspect_format_2): Add debug messages. * libgcobol.h (__gg__get_default_currency_string): Constify. * valconv.cc (expand_picture): Use std::string and vector. (__gg__string_to_numeric_edited): Use std::string and vector. (__gg__currency_sign_init): Use std::string and vector. (__gg__currency_sign): Use std::string and vector. * xmlparse.cc (xml_push_parse): Reformat. * posix/stat.cc: Removed. * posix/stat.h: Removed. * .gitignore: New file. * compat/README.md: New file. * compat/lib/gnu/CBL_ALLOC_MEM.cbl: New file. * compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl: New file. * compat/lib/gnu/CBL_DELETE_FILE.cbl: New file. * compat/lib/gnu/CBL_FREE_MEM.cbl: New file. * compat/t/Makefile: New file. * compat/t/smoke.cbl: New file. * posix/README.md: New file. * posix/bin/Makefile: New file for UDF-developer. * posix/bin/headers: New file. * posix/bin/scrape.awk: New file. * posix/bin/sizeofs.c: New file. * posix/bin/udf-gen: New file. * posix/cpy/posix-errno.cbl: New file. * posix/cpy/statbuf.cpy: New file. * posix/cpy/tm.cpy: New file. * posix/errno.cc: Removed. * posix/localtime.cc: Removed. * posix/shim/stat.cc: New file. * posix/shim/stat.h: New file. * posix/t/Makefile: New file. * posix/t/errno.cbl: New file. * posix/t/exit.cbl: New file. * posix/t/localtime.cbl: New file. * posix/t/stat.cbl: New file. * posix/tm.h: Removed. * posix/udf/posix-exit.cbl: New file. * posix/udf/posix-localtime.cbl: New file. * posix/udf/posix-mkdir.cbl: New file. * posix/udf/posix-stat.cbl: New file. * posix/udf/posix-unlink.cbl: New file. Diff: --- gcc/cobol/cdf.y | 10 + gcc/cobol/genapi.cc | 10 +- gcc/cobol/parse.y | 27 +- gcc/cobol/parse_ante.h | 24 +- gcc/cobol/scan.l | 2 +- gcc/cobol/symbols.cc | 20 +- gcc/cobol/symbols.h | 49 +- gcc/cobol/token_names.h | 816 +++++++++++----------- gcc/cobol/util.cc | 53 ++ libgcobol/.gitignore | 8 + libgcobol/Makefile.am | 25 +- libgcobol/Makefile.in | 128 +++- libgcobol/charmaps.cc | 2 +- libgcobol/charmaps.h | 8 +- libgcobol/compat/README.md | 25 + libgcobol/compat/lib/gnu/CBL_ALLOC_MEM.cbl | 41 ++ libgcobol/compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl | 47 ++ libgcobol/compat/lib/gnu/CBL_DELETE_FILE.cbl | 30 + libgcobol/compat/lib/gnu/CBL_FREE_MEM.cbl | 26 + libgcobol/compat/t/Makefile | 27 + libgcobol/compat/t/smoke.cbl | 95 +++ libgcobol/config.h.in | 3 + libgcobol/configure | 94 +++ libgcobol/configure.ac | 10 + libgcobol/intrinsic.cc | 6 +- libgcobol/libgcobol.cc | 53 +- libgcobol/libgcobol.h | 2 +- libgcobol/posix/README.md | 105 +++ libgcobol/posix/bin/Makefile | 18 + libgcobol/posix/bin/headers | 37 + libgcobol/posix/bin/scrape.awk | 19 + libgcobol/posix/bin/sizeofs.c | 27 + libgcobol/posix/bin/udf-gen | 350 ++++++++++ libgcobol/posix/cpy/posix-errno.cbl | 27 + libgcobol/posix/cpy/statbuf.cpy | 22 + libgcobol/posix/cpy/tm.cpy | 27 + libgcobol/posix/{ => shim}/errno.cc | 0 libgcobol/posix/{ => shim}/localtime.cc | 0 libgcobol/posix/shim/stat.cc | 80 +++ libgcobol/posix/shim/stat.h | 42 ++ libgcobol/posix/{ => shim}/tm.h | 0 libgcobol/posix/stat.cc | 90 --- libgcobol/posix/stat.h | 15 - libgcobol/posix/t/Makefile | 36 + libgcobol/posix/t/errno.cbl | 31 + libgcobol/posix/t/exit.cbl | 20 + libgcobol/posix/t/localtime.cbl | 52 ++ libgcobol/posix/t/stat.cbl | 29 + libgcobol/posix/udf/posix-exit.cbl | 12 + libgcobol/posix/udf/posix-localtime.cbl | 35 + libgcobol/posix/udf/posix-mkdir.cbl | 21 + libgcobol/posix/udf/posix-stat.cbl | 62 ++ libgcobol/posix/udf/posix-unlink.cbl | 32 + libgcobol/valconv.cc | 26 +- libgcobol/xmlparse.cc | 12 +- 55 files changed, 2211 insertions(+), 657 deletions(-) diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index 2d3f8192bc61..ea3e8c6fb6ff 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -151,6 +151,9 @@ void input_file_status_notify(); cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs ); cdfval_t negate( cdfval_base_t lhs ); + cbl_field_t + cdf_literalize( const std::string& name, const cdfval_t& value ); + } %{ @@ -353,6 +356,11 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override } YYERROR; } + if( symbols_begin() < symbols_end() ) { + cbl_field_t field = cdf_literalize($NAME, $value); + symbol_field_add(current_program_index(), &field); + } + } | CDF_DEFINE cdf_constant NAME '=' cdf_expr[value] override { /* accept, but as error */ @@ -952,3 +960,5 @@ cdfval_base_t::operator()( const YDFLTYPE& loc ) { // cppcheck-suppress returnTempReference return verify_integer(loc, *this) ? *this : zero; } + + diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 8c5f28ac07d8..031d1e1dc77e 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -5145,8 +5145,8 @@ parser_alphabet( const cbl_alphabet_t& alphabet ) case custom_encoding_e: { -#pragma message "Use program-id to disambiguate" - size_t alphabet_index = symbol_index(symbol_elem_of(&alphabet)); +#pragma message "Verify program-id is disambiguated" + size_t alphabet_index = symbol_unique_index(symbol_elem_of(&alphabet)); unsigned char ach[256]; @@ -7166,7 +7166,6 @@ initialize_the_data() build_int_cst_type(INT, current_encoding(national_encoding_e)), NULL_TREE); - __gg__currency_signs = __gg__ct_currency_signs; // We initialize currency both at compile time and run time __gg__currency_sign_init(); gg_call(VOID, @@ -9911,8 +9910,8 @@ parser_file_add(struct cbl_file_t *file) __func__); } -#pragma message "Use program-id to disambiguate" - size_t symbol_table_index = symbol_index(symbol_elem_of(file)); +#pragma message "Verify program-id is disambiguated" + size_t symbol_table_index = symbol_unique_index(symbol_elem_of(file)); gg_call(VOID, "__gg__file_init", @@ -14608,6 +14607,7 @@ void parser_exception_file( cbl_field_t *tgt, cbl_file_t *file) { Analyze(); + RETURN_IF_PARSE_ONLY; gg_call(VOID, "__gg__func_exception_file", gg_get_address_of(tgt->var_decl_node), diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index d54a686511f5..46d7a96bb0af 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -2397,7 +2397,7 @@ config_paragraph: | SOURCE_COMPUTER '.' NAME '.' | SOURCE_COMPUTER '.' NAME with_debug '.' | OBJECT_COMPUTER '.' - | OBJECT_COMPUTER '.' NAME[computer] collations '.' + | OBJECT_COMPUTER '.' NAME[computer] object_computer '.' | REPOSITORY dot | REPOSITORY dot repo_members '.' ; @@ -2528,7 +2528,7 @@ with_debug: with DEBUGGING MODE { } ; -collations: %empty +object_computer: %empty | char_classification | collating_sequence | char_classification collating_sequence @@ -4842,13 +4842,15 @@ value_clause: VALUE all LITERAL[lit] { } if( $value != NULLS ) { auto fig = constant_of(constant_index($value)); - current_field()->data.initial = fig->data.initial; + cbl_field_t *field = current_field(); + field->data.initial = fig->data.initial; } } | /* VALUE is */ NULLPTR { auto fig = constant_of(constant_index(NULLS)); - current_field()->data.initial = fig->data.initial; + cbl_field_t *field = current_field(); + field->data.initial = fig->data.initial; } | VALUE error { @@ -4938,10 +4940,13 @@ any_length: ANY LENGTH if( field->attr & any_length_e ) { error_msg(@1, "ANY LENGTH already set"); } + const char *prog_name = current.program()->name; + bool is_compat = 0 < compat_programs.count(prog_name); if( ! (field->level == 1 && current_data_section == linkage_datasect_e && (1 < current.program_level() || - current.program()->is_function())) ) { + current.program()->is_function() || + is_compat)) ) { error_msg(@1, "ANY LENGTH valid only for 01 " "in LINKAGE SECTION of a function or contained program"); YYERROR; @@ -10338,11 +10343,13 @@ go_to: GOTO labels[args] resume: RESUME NEXT STATEMENT { statement_begin(@1, RESUME); + if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR; parser_clear_exception(); } | RESUME label_1[tgt] { statement_begin(@1, RESUME); + if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR; parser_clear_exception(); $tgt->used = @1.first_line; parser_goto( cbl_refer_t(), 1, &$tgt ); @@ -10708,11 +10715,10 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' { const auto returning = cbl_field_of(symbol_at(L->returning)); $$ = new_temporary_clone(returning); $$->data.initial = returning->name; // user's name for the field - cbl_field_attr_t call_attr - = (cbl_field_attr_t)(quoted_e|hex_encoded_e); - cbl_field_t *name = new_literal(strlen(L->name), - L->name, - call_attr); + + // Pretend hex-encoded because that means use verbatim. + auto attr = cbl_field_attr_t(quoted_e | hex_encoded_e); + auto name = new_literal(strlen(L->name), L->name, attr); ast_call( @1, name, $$, narg, args, NULL, NULL, true ); } ; @@ -12083,6 +12089,7 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returnin name.field->data, 77 }; called.attr |= name.field->attr; snprintf(called.name, sizeof(called.name), "_%s", name.field->data.initial); + called.attr |= name.field->attr; name.field = cbl_field_of(symbol_field_add(PROGRAM, &called)); symbol_field_location(field_index(name.field), loc); parser_symbol_add(name.field); diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index 99c9cefae465..b838240e65c0 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -111,6 +111,15 @@ extern int yydebug; #include <cstdarg> +// These programs in libgcobol/compat are allowed to use ANY LENGTH even though +// they look like top-level programs. +static const std::set<std::string> compat_programs { + "CBL_ALLOC_MEM", + "CBL_CHECK_FILE_EXIST", + "CBL_DELETE_FILE", + "CBL_FREE_MEM", +}; + const char * consistent_encoding_check( const YYLTYPE& loc, const char input[] ) { cbl_field_t faux = {}; @@ -180,6 +189,15 @@ has_clause( int data_clauses, data_clause_t clause ) { return clause == (data_clauses & clause); } +static bool +dialect_proscribed( const YYLTYPE& loc, cbl_dialect_t dialect, const char msg[] ) { + if( dialect == cbl_dialects ) { + error_msg(loc, "dialect %s does not allow syntax: %qs", + cbl_dialect_str(dialect), msg); + return true; + } + return false; +} static bool is_cobol_charset( const char name[] ) { @@ -2521,9 +2539,9 @@ intrinsic_call_2( cbl_field_t *tgt, int token, const cbl_refer_t *r1, cbl_refer_ error_msg(args[n].loc, "invalid parameter '%s'", args[n].field->name); return false; } - const char *fund = intrinsic_cname(token); - if( !fund ) return false; - parser_intrinsic_call_2( tgt, fund, args[0], args[1] ); + const char *func = intrinsic_cname(token); + if( !func ) return false; + parser_intrinsic_call_2( tgt, func, args[0], args[1] ); return true; } diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 643d099f3899..9d24daab829d 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -572,7 +572,7 @@ REVERSED { return REVERSED; } RETURN { return RETURN; } RESTRICTED { return RESTRICTED; } -RESUME { +RESUME { // RESUME is ISO syntax, not IBM. if( ! dialect_ibm() ) return RESUME; yylval.string = xstrdup(yytext); return typed_name(yytext); diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 07dc0e65f14b..6851c60fd76d 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1862,6 +1862,7 @@ symbols_update( size_t first, bool parsed_ok ) { __func__, 3 + cbl_field_type_str(field->type), (fmt_size_t)isym, field->name, field->data.capacity); + gcc_unreachable(); } } return 0; @@ -2187,12 +2188,9 @@ symbol_field_parent_set( cbl_field_t *field ) return NULL; } prior->type = FldGroup; - prior->codeset.set(); -//// if( ! prior->codeset.set() ) { // maybe just ignore? -//// Dubner sez: Ignore. This was triggering with -finternal-ebcdic -//// ERROR_FIELD(prior, "%qs is already National", prior->name); -//// return NULL; -//// } + if( ! prior->codeset.set() ) { // needs attention + dbgmsg("'%s' is already National", prior->name); + } field->attr |= numeric_group_attrs(prior); } // verify level 88 domain value @@ -2250,6 +2248,8 @@ add_token( symbol_elem_t sym ) { return sym; } +const std::list<cbl_field_t> cdf_literalize(); + /* * When adding special registers, be sure to create the actual cblc_field_t * in libgcobol/constants.cc. @@ -2455,6 +2455,14 @@ symbol_table_init(void) { table.nelem = p - table.elems; assert(table.nelem < table.capacity); + // Add any CDF values already defined as literals. + // After symbols are ready, the CDF adds them directly. + const std::list<cbl_field_t> cdf_values = cdf_literalize(); + table.nelem += cdf_values.size(); + assert(table.nelem < table.capacity); + + p = std::transform(cdf_values.begin(), cdf_values.end(), p, elementize); + // Initialize symbol table. symbols = table; diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 6d29d060a051..2f3cb9a0a780 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -57,6 +57,17 @@ enum cbl_dialect_t { dialect_gnu_e = 0x04, }; +static inline const char * +cbl_dialect_str(cbl_dialect_t dialect) { + switch(dialect) { + case dialect_gcc_e: return "gcc"; + case dialect_ibm_e: return "ibm"; + case dialect_mf_e: return "mf"; + case dialect_gnu_e: return "gnu"; + } + return "???"; +}; + // Dialects may be combined. extern unsigned int cbl_dialects; void cobol_dialect_set( cbl_dialect_t dialect ); @@ -143,11 +154,6 @@ const char * cbl_field_attr_str( cbl_field_attr_t attr ); cbl_field_attr_t literal_attr( const char prefix[] ); -static inline bool -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 ); @@ -391,6 +397,26 @@ struct cbl_field_data_t { return valify(); } + // If initial (of Numeric Edited) has any length but capacity, adjust it. + bool manhandle_initial() { + assert(capacity > 0); + assert(initial != nullptr); + if( capacity < strlen(initial) ) { + char *p = const_cast<char*>(initial); + p[capacity] = '\0'; + return true; + } + if( strlen(initial) < capacity ) { + auto tgt = reinterpret_cast<char *>( xmalloc(capacity + 1) ); + auto pend = tgt + capacity; + auto p = std::copy(initial, initial + strlen(initial), tgt); + std::fill(p, pend, 0x20); + p = pend - 1; + *p = '\0'; + initial = tgt; + } + return false; + } bool initial_within_capacity() const { return initial[capacity] == '\0' || initial[capacity] == '!'; @@ -630,7 +656,7 @@ struct cbl_field_t { uint32_t level = 0, const cbl_name_t name = "", int line = 0 ) : offset(0), type(type), usage(FldInvalid), attr(attr) , parent(0), our_index(0), level(level) - , line(line), file(0), data(data) + , line(line), name(""), file(0), data(data) , var_decl_node(nullptr), data_decl_node(nullptr) { gcc_assert(strlen(name) < sizeof this->name); @@ -1539,15 +1565,6 @@ struct cbl_section_t { } gcc_unreachable(); } - uint32_t attr() const { - switch(type) { - case file_sect_e: - case working_sect_e: return 0; - case linkage_sect_e: return linkage_e; - case local_sect_e: return local_e; - } - gcc_unreachable(); - } }; struct cbl_locale_t { @@ -2273,6 +2290,8 @@ struct cbl_until_addresses_t { size_t symbol_index(); // nth after first program symbol size_t symbol_index( const symbol_elem_t *e ); +size_t symbol_unique_index( const struct symbol_elem_t *e ); + struct symbol_elem_t * symbol_at( size_t index ); struct cbl_options_t { diff --git a/gcc/cobol/token_names.h b/gcc/cobol/token_names.h index 6d3de71a8f65..ceb277713f44 100644 --- a/gcc/cobol/token_names.h +++ b/gcc/cobol/token_names.h @@ -1,5 +1,5 @@ -// generated by /home/jklowden/projects/3rd/gcc/parser/gcc/cobol/token_names.h.gen cobol/parse.h -// Mon Oct 20 14:11:39 EDT 2025 +// generated by ./token_names.h.gen ../../build/gcc/cobol/parse.h +// Tue Nov 11 22:26:46 EST 2025 tokens = { { "identification", IDENTIFICATION_DIV }, // 258 { "environment", ENVIRONMENT_DIV }, // 259 @@ -502,209 +502,210 @@ tokens = { { "reserve", RESERVE }, // 751 { "restricted", RESTRICTED }, // 752 { "resume", RESUME }, // 753 - { "reverse", REVERSE }, // 754 - { "reversed", REVERSED }, // 755 - { "rewind", REWIND }, // 756 - { "rf", RF }, // 757 - { "rh", RH }, // 758 - { "right", RIGHT }, // 759 - { "rounded", ROUNDED }, // 760 - { "run", RUN }, // 761 - { "same", SAME }, // 762 - { "screen", SCREEN }, // 763 - { "sd", SD }, // 764 - { "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 765 - { "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 766 - { "security", SECURITY }, // 767 - { "separate", SEPARATE }, // 768 - { "sequence", SEQUENCE }, // 769 - { "sequential", SEQUENTIAL }, // 770 - { "sharing", SHARING }, // 771 - { "simple-exit", SIMPLE_EXIT }, // 772 - { "sign", SIGN }, // 773 - { "sin", SIN }, // 774 - { "size", SIZE }, // 775 - { "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 776 - { "source", SOURCE }, // 777 - { "source-computer", SOURCE_COMPUTER }, // 778 - { "special-names", SPECIAL_NAMES }, // 779 - { "sqrt", SQRT }, // 780 - { "stack", STACK }, // 781 - { "standard", STANDARD }, // 782 - { "standard-1", STANDARD_1 }, // 783 - { "standard-deviation", STANDARD_DEVIATION }, // 784 - { "standard-compare", STANDARD_COMPARE }, // 785 - { "status", STATUS }, // 786 - { "strong", STRONG }, // 787 - { "substitute", SUBSTITUTE }, // 788 - { "sum", SUM }, // 789 - { "symbol", SYMBOL }, // 790 - { "symbolic", SYMBOLIC }, // 791 - { "synchronized", SYNCHRONIZED }, // 792 - { "tallying", TALLYING }, // 793 - { "tan", TAN }, // 794 - { "terminate", TERMINATE }, // 795 - { "test", TEST }, // 796 - { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 797 - { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 798 - { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 799 - { "test-numval", TEST_NUMVAL }, // 800 - { "test-numval-c", TEST_NUMVAL_C }, // 801 - { "test-numval-f", TEST_NUMVAL_F }, // 802 - { "than", THAN }, // 803 - { "time", TIME }, // 804 - { "times", TIMES }, // 805 - { "to", TO }, // 806 - { "top", TOP }, // 807 - { "top-level", TOP_LEVEL }, // 808 - { "tracks", TRACKS }, // 809 - { "track-area", TRACK_AREA }, // 810 - { "trailing", TRAILING }, // 811 - { "transform", TRANSFORM }, // 812 - { "trim", TRIM }, // 813 - { "true", TRUE_kw }, // 814 - { "try", TRY }, // 815 - { "turn", TURN }, // 816 - { "type", TYPE }, // 817 - { "typedef", TYPEDEF }, // 818 - { "ulength", ULENGTH }, // 819 - { "unbounded", UNBOUNDED }, // 820 - { "unit", UNIT }, // 821 - { "units", UNITS }, // 822 - { "unit-record", UNIT_RECORD }, // 823 - { "until", UNTIL }, // 824 - { "up", UP }, // 825 - { "upon", UPON }, // 826 - { "upos", UPOS }, // 827 - { "upper-case", UPPER_CASE }, // 828 - { "usage", USAGE }, // 829 - { "using", USING }, // 830 - { "usubstr", USUBSTR }, // 831 - { "usupplementary", USUPPLEMENTARY }, // 832 - { "utility", UTILITY }, // 833 - { "uuid4", UUID4 }, // 834 - { "uvalid", UVALID }, // 835 - { "uwidth", UWIDTH }, // 836 - { "validating", VALIDATING }, // 837 - { "value", VALUE }, // 838 - { "variance", VARIANCE }, // 839 - { "varying", VARYING }, // 840 - { "volatile", VOLATILE }, // 841 - { "when-compiled", WHEN_COMPILED }, // 842 - { "with", WITH }, // 843 - { "working-storage", WORKING_STORAGE }, // 844 - { "year-to-yyyy", YEAR_TO_YYYY }, // 845 - { "yyyyddd", YYYYDDD }, // 846 - { "yyyymmdd", YYYYMMDD }, // 847 - { "arithmetic", ARITHMETIC }, // 848 - { "attribute", ATTRIBUTE }, // 849 - { "auto", AUTO }, // 850 - { "automatic", AUTOMATIC }, // 851 - { "away-from-zero", AWAY_FROM_ZERO }, // 852 - { "background-color", BACKGROUND_COLOR }, // 853 - { "bell", BELL }, // 854 - { "binary-encoding", BINARY_ENCODING }, // 855 - { "blink", BLINK }, // 856 - { "capacity", CAPACITY }, // 857 - { "center", CENTER }, // 858 - { "classification", CLASSIFICATION }, // 859 - { "cycle", CYCLE }, // 860 - { "decimal-encoding", DECIMAL_ENCODING }, // 861 - { "entry-convention", ENTRY_CONVENTION }, // 862 - { "eol", EOL }, // 863 - { "eos", EOS }, // 864 - { "erase", ERASE }, // 865 - { "expands", EXPANDS }, // 866 - { "float-binary", FLOAT_BINARY }, // 867 - { "float-decimal", FLOAT_DECIMAL }, // 868 - { "foreground-color", FOREGROUND_COLOR }, // 869 - { "forever", FOREVER }, // 870 - { "full", FULL }, // 871 - { "highlight", HIGHLIGHT }, // 872 - { "high-order-left", HIGH_ORDER_LEFT }, // 873 - { "high-order-right", HIGH_ORDER_RIGHT }, // 874 - { "ignoring", IGNORING }, // 875 - { "implements", IMPLEMENTS }, // 876 - { "initialized", INITIALIZED }, // 877 - { "intermediate", INTERMEDIATE }, // 878 - { "lc-all", LC_ALL_kw }, // 879 - { "lc-collate", LC_COLLATE_kw }, // 880 - { "lc-ctype", LC_CTYPE_kw }, // 881 - { "lc-messages", LC_MESSAGES_kw }, // 882 - { "lc-monetary", LC_MONETARY_kw }, // 883 - { "lc-numeric", LC_NUMERIC_kw }, // 884 - { "lc-time", LC_TIME_kw }, // 885 - { "lowlight", LOWLIGHT }, // 886 - { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 887 - { "nearest-even", NEAREST_EVEN }, // 888 - { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 889 - { "none", NONE }, // 890 - { "normal", NORMAL }, // 891 - { "numbers", NUMBERS }, // 892 - { "prefixed", PREFIXED }, // 893 - { "previous", PREVIOUS }, // 894 - { "prohibited", PROHIBITED }, // 895 - { "relation", RELATION }, // 896 - { "required", REQUIRED }, // 897 - { "reverse-video", REVERSE_VIDEO }, // 898 - { "rounding", ROUNDING }, // 899 - { "seconds", SECONDS }, // 900 - { "secure", SECURE }, // 901 - { "short", SHORT }, // 902 - { "signed", SIGNED_kw }, // 903 - { "standard-binary", STANDARD_BINARY }, // 904 - { "standard-decimal", STANDARD_DECIMAL }, // 905 - { "statement", STATEMENT }, // 906 - { "step", STEP }, // 907 - { "structure", STRUCTURE }, // 908 - { "toward-greater", TOWARD_GREATER }, // 909 - { "toward-lesser", TOWARD_LESSER }, // 910 - { "truncation", TRUNCATION }, // 911 - { "ucs-4", UCS_4 }, // 912 - { "underline", UNDERLINE }, // 913 - { "unsigned", UNSIGNED_kw }, // 914 - { "utf-16", UTF_16 }, // 915 - { "utf-8", UTF_8 }, // 916 - { "xmlgenerate", XMLGENERATE }, // 917 - { "xmlparse", XMLPARSE }, // 918 - { "address", ADDRESS }, // 919 - { "end-accept", END_ACCEPT }, // 920 - { "end-add", END_ADD }, // 921 - { "end-call", END_CALL }, // 922 - { "end-compute", END_COMPUTE }, // 923 - { "end-delete", END_DELETE }, // 924 - { "end-display", END_DISPLAY }, // 925 - { "end-divide", END_DIVIDE }, // 926 - { "end-evaluate", END_EVALUATE }, // 927 - { "end-multiply", END_MULTIPLY }, // 928 - { "end-perform", END_PERFORM }, // 929 - { "end-read", END_READ }, // 930 - { "end-return", END_RETURN }, // 931 - { "end-rewrite", END_REWRITE }, // 932 - { "end-search", END_SEARCH }, // 933 - { "end-start", END_START }, // 934 - { "end-string", END_STRING }, // 935 - { "end-subtract", END_SUBTRACT }, // 936 - { "end-unstring", END_UNSTRING }, // 937 - { "end-write", END_WRITE }, // 938 - { "end-xml", END_XML }, // 939 - { "end-if", END_IF }, // 940 - { "attributes", ATTRIBUTES }, // 941 - { "element", ELEMENT }, // 942 - { "namespace", NAMESPACE }, // 943 - { "namespace-prefix", NAMESPACE_PREFIX }, // 944 - { "nonnumeric", NONNUMERIC }, // 946 - { "xml-declaration", XML_DECLARATION }, // 947 - { "thru", THRU }, // 949 - { "through", THRU }, // 949 - { "or", OR }, // 950 - { "and", AND }, // 951 - { "not", NOT }, // 952 - { "ne", NE }, // 953 - { "le", LE }, // 954 - { "ge", GE }, // 955 - { "pow", POW }, // 956 - { "neg", NEG }, // 957 + { "retry", RETRY }, // 754 + { "reverse", REVERSE }, // 755 + { "reversed", REVERSED }, // 756 + { "rewind", REWIND }, // 757 + { "rf", RF }, // 758 + { "rh", RH }, // 759 + { "right", RIGHT }, // 760 + { "rounded", ROUNDED }, // 761 + { "run", RUN }, // 762 + { "same", SAME }, // 763 + { "screen", SCREEN }, // 764 + { "sd", SD }, // 765 + { "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 766 + { "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 767 + { "security", SECURITY }, // 768 + { "separate", SEPARATE }, // 769 + { "sequence", SEQUENCE }, // 770 + { "sequential", SEQUENTIAL }, // 771 + { "sharing", SHARING }, // 772 + { "simple-exit", SIMPLE_EXIT }, // 773 + { "sign", SIGN }, // 774 + { "sin", SIN }, // 775 + { "size", SIZE }, // 776 + { "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 777 + { "source", SOURCE }, // 778 + { "source-computer", SOURCE_COMPUTER }, // 779 + { "special-names", SPECIAL_NAMES }, // 780 + { "sqrt", SQRT }, // 781 + { "stack", STACK }, // 782 + { "standard", STANDARD }, // 783 + { "standard-1", STANDARD_1 }, // 784 + { "standard-deviation", STANDARD_DEVIATION }, // 785 + { "standard-compare", STANDARD_COMPARE }, // 786 + { "status", STATUS }, // 787 + { "strong", STRONG }, // 788 + { "substitute", SUBSTITUTE }, // 789 + { "sum", SUM }, // 790 + { "symbol", SYMBOL }, // 791 + { "symbolic", SYMBOLIC }, // 792 + { "synchronized", SYNCHRONIZED }, // 793 + { "tallying", TALLYING }, // 794 + { "tan", TAN }, // 795 + { "terminate", TERMINATE }, // 796 + { "test", TEST }, // 797 + { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 798 + { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 799 + { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 800 + { "test-numval", TEST_NUMVAL }, // 801 + { "test-numval-c", TEST_NUMVAL_C }, // 802 + { "test-numval-f", TEST_NUMVAL_F }, // 803 + { "than", THAN }, // 804 + { "time", TIME }, // 805 + { "times", TIMES }, // 806 + { "to", TO }, // 807 + { "top", TOP }, // 808 + { "top-level", TOP_LEVEL }, // 809 + { "tracks", TRACKS }, // 810 + { "track-area", TRACK_AREA }, // 811 + { "trailing", TRAILING }, // 812 + { "transform", TRANSFORM }, // 813 + { "trim", TRIM }, // 814 + { "true", TRUE_kw }, // 815 + { "try", TRY }, // 816 + { "turn", TURN }, // 817 + { "type", TYPE }, // 818 + { "typedef", TYPEDEF }, // 819 + { "ulength", ULENGTH }, // 820 + { "unbounded", UNBOUNDED }, // 821 + { "unit", UNIT }, // 822 + { "units", UNITS }, // 823 + { "unit-record", UNIT_RECORD }, // 824 + { "until", UNTIL }, // 825 + { "up", UP }, // 826 + { "upon", UPON }, // 827 + { "upos", UPOS }, // 828 + { "upper-case", UPPER_CASE }, // 829 + { "usage", USAGE }, // 830 + { "using", USING }, // 831 + { "usubstr", USUBSTR }, // 832 + { "usupplementary", USUPPLEMENTARY }, // 833 + { "utility", UTILITY }, // 834 + { "uuid4", UUID4 }, // 835 + { "uvalid", UVALID }, // 836 + { "uwidth", UWIDTH }, // 837 + { "validating", VALIDATING }, // 838 + { "value", VALUE }, // 839 + { "variance", VARIANCE }, // 840 + { "varying", VARYING }, // 841 + { "volatile", VOLATILE }, // 842 + { "when-compiled", WHEN_COMPILED }, // 843 + { "with", WITH }, // 844 + { "working-storage", WORKING_STORAGE }, // 845 + { "year-to-yyyy", YEAR_TO_YYYY }, // 846 + { "yyyyddd", YYYYDDD }, // 847 + { "yyyymmdd", YYYYMMDD }, // 848 + { "arithmetic", ARITHMETIC }, // 849 + { "attribute", ATTRIBUTE }, // 850 + { "auto", AUTO }, // 851 + { "automatic", AUTOMATIC }, // 852 + { "away-from-zero", AWAY_FROM_ZERO }, // 853 + { "background-color", BACKGROUND_COLOR }, // 854 + { "bell", BELL }, // 855 + { "binary-encoding", BINARY_ENCODING }, // 856 + { "blink", BLINK }, // 857 + { "capacity", CAPACITY }, // 858 + { "center", CENTER }, // 859 + { "classification", CLASSIFICATION }, // 860 + { "cycle", CYCLE }, // 861 + { "decimal-encoding", DECIMAL_ENCODING }, // 862 + { "entry-convention", ENTRY_CONVENTION }, // 863 + { "eol", EOL }, // 864 + { "eos", EOS }, // 865 + { "erase", ERASE }, // 866 + { "expands", EXPANDS }, // 867 + { "float-binary", FLOAT_BINARY }, // 868 + { "float-decimal", FLOAT_DECIMAL }, // 869 + { "foreground-color", FOREGROUND_COLOR }, // 870 + { "forever", FOREVER }, // 871 + { "full", FULL }, // 872 + { "highlight", HIGHLIGHT }, // 873 + { "high-order-left", HIGH_ORDER_LEFT }, // 874 + { "high-order-right", HIGH_ORDER_RIGHT }, // 875 + { "ignoring", IGNORING }, // 876 + { "implements", IMPLEMENTS }, // 877 + { "initialized", INITIALIZED }, // 878 + { "intermediate", INTERMEDIATE }, // 879 + { "lc-all", LC_ALL_kw }, // 880 + { "lc-collate", LC_COLLATE_kw }, // 881 + { "lc-ctype", LC_CTYPE_kw }, // 882 + { "lc-messages", LC_MESSAGES_kw }, // 883 + { "lc-monetary", LC_MONETARY_kw }, // 884 + { "lc-numeric", LC_NUMERIC_kw }, // 885 + { "lc-time", LC_TIME_kw }, // 886 + { "lowlight", LOWLIGHT }, // 887 + { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 888 + { "nearest-even", NEAREST_EVEN }, // 889 + { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 890 + { "none", NONE }, // 891 + { "normal", NORMAL }, // 892 + { "numbers", NUMBERS }, // 893 + { "prefixed", PREFIXED }, // 894 + { "previous", PREVIOUS }, // 895 + { "prohibited", PROHIBITED }, // 896 + { "relation", RELATION }, // 897 + { "required", REQUIRED }, // 898 + { "reverse-video", REVERSE_VIDEO }, // 899 + { "rounding", ROUNDING }, // 900 + { "seconds", SECONDS }, // 901 + { "secure", SECURE }, // 902 + { "short", SHORT }, // 903 + { "signed", SIGNED_kw }, // 904 + { "standard-binary", STANDARD_BINARY }, // 905 + { "standard-decimal", STANDARD_DECIMAL }, // 906 + { "statement", STATEMENT }, // 907 + { "step", STEP }, // 908 + { "structure", STRUCTURE }, // 909 + { "toward-greater", TOWARD_GREATER }, // 910 + { "toward-lesser", TOWARD_LESSER }, // 911 + { "truncation", TRUNCATION }, // 912 + { "ucs-4", UCS_4 }, // 913 + { "underline", UNDERLINE }, // 914 + { "unsigned", UNSIGNED_kw }, // 915 + { "utf-16", UTF_16 }, // 916 + { "utf-8", UTF_8 }, // 917 + { "xmlgenerate", XMLGENERATE }, // 918 + { "xmlparse", XMLPARSE }, // 919 + { "address", ADDRESS }, // 920 + { "end-accept", END_ACCEPT }, // 921 + { "end-add", END_ADD }, // 922 + { "end-call", END_CALL }, // 923 + { "end-compute", END_COMPUTE }, // 924 + { "end-delete", END_DELETE }, // 925 + { "end-display", END_DISPLAY }, // 926 + { "end-divide", END_DIVIDE }, // 927 + { "end-evaluate", END_EVALUATE }, // 928 + { "end-multiply", END_MULTIPLY }, // 929 + { "end-perform", END_PERFORM }, // 930 + { "end-read", END_READ }, // 931 + { "end-return", END_RETURN }, // 932 + { "end-rewrite", END_REWRITE }, // 933 + { "end-search", END_SEARCH }, // 934 + { "end-start", END_START }, // 935 + { "end-string", END_STRING }, // 936 + { "end-subtract", END_SUBTRACT }, // 937 + { "end-unstring", END_UNSTRING }, // 938 + { "end-write", END_WRITE }, // 939 + { "end-xml", END_XML }, // 940 + { "end-if", END_IF }, // 941 + { "attributes", ATTRIBUTES }, // 942 + { "element", ELEMENT }, // 943 + { "namespace", NAMESPACE }, // 944 + { "namespace-prefix", NAMESPACE_PREFIX }, // 945 + { "nonnumeric", NONNUMERIC }, // 947 + { "xml-declaration", XML_DECLARATION }, // 948 + { "thru", THRU }, // 950 + { "through", THRU }, // 950 + { "or", OR }, // 951 + { "and", AND }, // 952 + { "not", NOT }, // 953 + { "ne", NE }, // 954 + { "le", LE }, // 955 + { "ge", GE }, // 956 + { "pow", POW }, // 957 + { "neg", NEG }, // 958 }; // cppcheck-suppress useInitializationList @@ -1205,206 +1206,207 @@ token_names = { "RESERVE", // 493 (751) "RESTRICTED", // 494 (752) "RESUME", // 495 (753) - "REVERSE", // 496 (754) - "REVERSED", // 497 (755) - "REWIND", // 498 (756) - "RF", // 499 (757) - "RH", // 500 (758) - "RIGHT", // 501 (759) - "ROUNDED", // 502 (760) - "RUN", // 503 (761) - "SAME", // 504 (762) - "SCREEN", // 505 (763) - "SD", // 506 (764) - "SECONDS-FROM-FORMATTED-TIME", // 507 (765) - "SECONDS-PAST-MIDNIGHT", // 508 (766) - "SECURITY", // 509 (767) - "SEPARATE", // 510 (768) - "SEQUENCE", // 511 (769) - "SEQUENTIAL", // 512 (770) - "SHARING", // 513 (771) - "SIMPLE-EXIT", // 514 (772) - "SIGN", // 515 (773) - "SIN", // 516 (774) - "SIZE", // 517 (775) - "SMALLEST-ALGEBRAIC", // 518 (776) - "SOURCE", // 519 (777) - "SOURCE-COMPUTER", // 520 (778) - "SPECIAL-NAMES", // 521 (779) - "SQRT", // 522 (780) - "STACK", // 523 (781) - "STANDARD", // 524 (782) - "STANDARD-1", // 525 (783) - "STANDARD-DEVIATION", // 526 (784) - "STANDARD-COMPARE", // 527 (785) - "STATUS", // 528 (786) - "STRONG", // 529 (787) - "SUBSTITUTE", // 530 (788) - "SUM", // 531 (789) - "SYMBOL", // 532 (790) - "SYMBOLIC", // 533 (791) - "SYNCHRONIZED", // 534 (792) - "TALLYING", // 535 (793) - "TAN", // 536 (794) - "TERMINATE", // 537 (795) - "TEST", // 538 (796) - "TEST-DATE-YYYYMMDD", // 539 (797) - "TEST-DAY-YYYYDDD", // 540 (798) - "TEST-FORMATTED-DATETIME", // 541 (799) - "TEST-NUMVAL", // 542 (800) - "TEST-NUMVAL-C", // 543 (801) - "TEST-NUMVAL-F", // 544 (802) - "THAN", // 545 (803) - "TIME", // 546 (804) - "TIMES", // 547 (805) - "TO", // 548 (806) - "TOP", // 549 (807) - "TOP-LEVEL", // 550 (808) - "TRACKS", // 551 (809) - "TRACK-AREA", // 552 (810) - "TRAILING", // 553 (811) - "TRANSFORM", // 554 (812) - "TRIM", // 555 (813) - "TRUE", // 556 (814) - "TRY", // 557 (815) - "TURN", // 558 (816) - "TYPE", // 559 (817) - "TYPEDEF", // 560 (818) - "ULENGTH", // 561 (819) - "UNBOUNDED", // 562 (820) - "UNIT", // 563 (821) - "UNITS", // 564 (822) - "UNIT-RECORD", // 565 (823) - "UNTIL", // 566 (824) - "UP", // 567 (825) - "UPON", // 568 (826) - "UPOS", // 569 (827) - "UPPER-CASE", // 570 (828) - "USAGE", // 571 (829) - "USING", // 572 (830) - "USUBSTR", // 573 (831) - "USUPPLEMENTARY", // 574 (832) - "UTILITY", // 575 (833) - "UUID4", // 576 (834) - "UVALID", // 577 (835) - "UWIDTH", // 578 (836) - "VALIDATING", // 579 (837) - "VALUE", // 580 (838) - "VARIANCE", // 581 (839) - "VARYING", // 582 (840) - "VOLATILE", // 583 (841) - "WHEN-COMPILED", // 584 (842) - "WITH", // 585 (843) - "WORKING-STORAGE", // 586 (844) - "YEAR-TO-YYYY", // 587 (845) - "YYYYDDD", // 588 (846) - "YYYYMMDD", // 589 (847) - "ARITHMETIC", // 590 (848) - "ATTRIBUTE", // 591 (849) - "AUTO", // 592 (850) - "AUTOMATIC", // 593 (851) - "AWAY-FROM-ZERO", // 594 (852) - "BACKGROUND-COLOR", // 595 (853) - "BELL", // 596 (854) - "BINARY-ENCODING", // 597 (855) - "BLINK", // 598 (856) - "CAPACITY", // 599 (857) - "CENTER", // 600 (858) - "CLASSIFICATION", // 601 (859) - "CYCLE", // 602 (860) - "DECIMAL-ENCODING", // 603 (861) - "ENTRY-CONVENTION", // 604 (862) - "EOL", // 605 (863) - "EOS", // 606 (864) - "ERASE", // 607 (865) - "EXPANDS", // 608 (866) - "FLOAT-BINARY", // 609 (867) - "FLOAT-DECIMAL", // 610 (868) - "FOREGROUND-COLOR", // 611 (869) - "FOREVER", // 612 (870) - "FULL", // 613 (871) - "HIGHLIGHT", // 614 (872) - "HIGH-ORDER-LEFT", // 615 (873) - "HIGH-ORDER-RIGHT", // 616 (874) - "IGNORING", // 617 (875) - "IMPLEMENTS", // 618 (876) - "INITIALIZED", // 619 (877) - "INTERMEDIATE", // 620 (878) - "LC-ALL", // 621 (879) - "LC-COLLATE", // 622 (880) - "LC-CTYPE", // 623 (881) - "LC-MESSAGES", // 624 (882) - "LC-MONETARY", // 625 (883) - "LC-NUMERIC", // 626 (884) - "LC-TIME", // 627 (885) - "LOWLIGHT", // 628 (886) - "NEAREST-AWAY-FROM-ZERO", // 629 (887) - "NEAREST-EVEN", // 630 (888) - "NEAREST-TOWARD-ZERO", // 631 (889) - "NONE", // 632 (890) - "NORMAL", // 633 (891) - "NUMBERS", // 634 (892) - "PREFIXED", // 635 (893) - "PREVIOUS", // 636 (894) - "PROHIBITED", // 637 (895) - "RELATION", // 638 (896) - "REQUIRED", // 639 (897) - "REVERSE-VIDEO", // 640 (898) - "ROUNDING", // 641 (899) - "SECONDS", // 642 (900) - "SECURE", // 643 (901) - "SHORT", // 644 (902) - "SIGNED", // 645 (903) - "STANDARD-BINARY", // 646 (904) - "STANDARD-DECIMAL", // 647 (905) - "STATEMENT", // 648 (906) - "STEP", // 649 (907) - "STRUCTURE", // 650 (908) - "TOWARD-GREATER", // 651 (909) - "TOWARD-LESSER", // 652 (910) - "TRUNCATION", // 653 (911) - "UCS-4", // 654 (912) - "UNDERLINE", // 655 (913) - "UNSIGNED", // 656 (914) - "UTF-16", // 657 (915) - "UTF-8", // 658 (916) - "XMLGENERATE", // 659 (917) - "XMLPARSE", // 660 (918) - "ADDRESS", // 661 (919) - "END-ACCEPT", // 662 (920) - "END-ADD", // 663 (921) - "END-CALL", // 664 (922) - "END-COMPUTE", // 665 (923) - "END-DELETE", // 666 (924) - "END-DISPLAY", // 667 (925) - "END-DIVIDE", // 668 (926) - "END-EVALUATE", // 669 (927) - "END-MULTIPLY", // 670 (928) - "END-PERFORM", // 671 (929) - "END-READ", // 672 (930) - "END-RETURN", // 673 (931) - "END-REWRITE", // 674 (932) - "END-SEARCH", // 675 (933) - "END-START", // 676 (934) - "END-STRING", // 677 (935) - "END-SUBTRACT", // 678 (936) - "END-UNSTRING", // 679 (937) - "END-WRITE", // 680 (938) - "END-XML", // 681 (939) - "END-IF", // 682 (940) - "ATTRIBUTES", // 683 (941) - "ELEMENT", // 684 (942) - "NAMESPACE", // 685 (943) - "NAMESPACE-PREFIX", // 686 (944) - "NONNUMERIC", // 688 (946) - "XML-DECLARATION", // 689 (947) - "THRU", // 691 (949) - "OR", // 692 (950) - "AND", // 693 (951) - "NOT", // 694 (952) - "NE", // 695 (953) - "LE", // 696 (954) - "GE", // 697 (955) - "POW", // 698 (956) - "NEG", // 699 (957) + "RETRY", // 496 (754) + "REVERSE", // 497 (755) + "REVERSED", // 498 (756) + "REWIND", // 499 (757) + "RF", // 500 (758) + "RH", // 501 (759) + "RIGHT", // 502 (760) + "ROUNDED", // 503 (761) + "RUN", // 504 (762) + "SAME", // 505 (763) + "SCREEN", // 506 (764) + "SD", // 507 (765) + "SECONDS-FROM-FORMATTED-TIME", // 508 (766) + "SECONDS-PAST-MIDNIGHT", // 509 (767) + "SECURITY", // 510 (768) + "SEPARATE", // 511 (769) + "SEQUENCE", // 512 (770) + "SEQUENTIAL", // 513 (771) + "SHARING", // 514 (772) + "SIMPLE-EXIT", // 515 (773) + "SIGN", // 516 (774) + "SIN", // 517 (775) + "SIZE", // 518 (776) + "SMALLEST-ALGEBRAIC", // 519 (777) + "SOURCE", // 520 (778) + "SOURCE-COMPUTER", // 521 (779) + "SPECIAL-NAMES", // 522 (780) + "SQRT", // 523 (781) + "STACK", // 524 (782) + "STANDARD", // 525 (783) + "STANDARD-1", // 526 (784) + "STANDARD-DEVIATION", // 527 (785) + "STANDARD-COMPARE", // 528 (786) + "STATUS", // 529 (787) + "STRONG", // 530 (788) + "SUBSTITUTE", // 531 (789) + "SUM", // 532 (790) + "SYMBOL", // 533 (791) + "SYMBOLIC", // 534 (792) + "SYNCHRONIZED", // 535 (793) + "TALLYING", // 536 (794) + "TAN", // 537 (795) + "TERMINATE", // 538 (796) + "TEST", // 539 (797) + "TEST-DATE-YYYYMMDD", // 540 (798) + "TEST-DAY-YYYYDDD", // 541 (799) + "TEST-FORMATTED-DATETIME", // 542 (800) + "TEST-NUMVAL", // 543 (801) + "TEST-NUMVAL-C", // 544 (802) + "TEST-NUMVAL-F", // 545 (803) + "THAN", // 546 (804) + "TIME", // 547 (805) + "TIMES", // 548 (806) + "TO", // 549 (807) + "TOP", // 550 (808) + "TOP-LEVEL", // 551 (809) + "TRACKS", // 552 (810) + "TRACK-AREA", // 553 (811) + "TRAILING", // 554 (812) + "TRANSFORM", // 555 (813) + "TRIM", // 556 (814) + "TRUE", // 557 (815) + "TRY", // 558 (816) + "TURN", // 559 (817) + "TYPE", // 560 (818) + "TYPEDEF", // 561 (819) + "ULENGTH", // 562 (820) + "UNBOUNDED", // 563 (821) + "UNIT", // 564 (822) + "UNITS", // 565 (823) + "UNIT-RECORD", // 566 (824) + "UNTIL", // 567 (825) + "UP", // 568 (826) + "UPON", // 569 (827) + "UPOS", // 570 (828) + "UPPER-CASE", // 571 (829) + "USAGE", // 572 (830) + "USING", // 573 (831) + "USUBSTR", // 574 (832) + "USUPPLEMENTARY", // 575 (833) + "UTILITY", // 576 (834) + "UUID4", // 577 (835) + "UVALID", // 578 (836) + "UWIDTH", // 579 (837) + "VALIDATING", // 580 (838) + "VALUE", // 581 (839) + "VARIANCE", // 582 (840) + "VARYING", // 583 (841) + "VOLATILE", // 584 (842) + "WHEN-COMPILED", // 585 (843) + "WITH", // 586 (844) + "WORKING-STORAGE", // 587 (845) + "YEAR-TO-YYYY", // 588 (846) + "YYYYDDD", // 589 (847) + "YYYYMMDD", // 590 (848) + "ARITHMETIC", // 591 (849) + "ATTRIBUTE", // 592 (850) + "AUTO", // 593 (851) + "AUTOMATIC", // 594 (852) + "AWAY-FROM-ZERO", // 595 (853) + "BACKGROUND-COLOR", // 596 (854) + "BELL", // 597 (855) + "BINARY-ENCODING", // 598 (856) + "BLINK", // 599 (857) + "CAPACITY", // 600 (858) + "CENTER", // 601 (859) + "CLASSIFICATION", // 602 (860) + "CYCLE", // 603 (861) + "DECIMAL-ENCODING", // 604 (862) + "ENTRY-CONVENTION", // 605 (863) + "EOL", // 606 (864) + "EOS", // 607 (865) + "ERASE", // 608 (866) + "EXPANDS", // 609 (867) + "FLOAT-BINARY", // 610 (868) + "FLOAT-DECIMAL", // 611 (869) + "FOREGROUND-COLOR", // 612 (870) + "FOREVER", // 613 (871) + "FULL", // 614 (872) + "HIGHLIGHT", // 615 (873) + "HIGH-ORDER-LEFT", // 616 (874) + "HIGH-ORDER-RIGHT", // 617 (875) + "IGNORING", // 618 (876) + "IMPLEMENTS", // 619 (877) + "INITIALIZED", // 620 (878) + "INTERMEDIATE", // 621 (879) + "LC-ALL", // 622 (880) + "LC-COLLATE", // 623 (881) + "LC-CTYPE", // 624 (882) + "LC-MESSAGES", // 625 (883) + "LC-MONETARY", // 626 (884) + "LC-NUMERIC", // 627 (885) + "LC-TIME", // 628 (886) + "LOWLIGHT", // 629 (887) + "NEAREST-AWAY-FROM-ZERO", // 630 (888) + "NEAREST-EVEN", // 631 (889) + "NEAREST-TOWARD-ZERO", // 632 (890) + "NONE", // 633 (891) + "NORMAL", // 634 (892) + "NUMBERS", // 635 (893) + "PREFIXED", // 636 (894) + "PREVIOUS", // 637 (895) + "PROHIBITED", // 638 (896) + "RELATION", // 639 (897) + "REQUIRED", // 640 (898) + "REVERSE-VIDEO", // 641 (899) + "ROUNDING", // 642 (900) + "SECONDS", // 643 (901) + "SECURE", // 644 (902) + "SHORT", // 645 (903) + "SIGNED", // 646 (904) + "STANDARD-BINARY", // 647 (905) + "STANDARD-DECIMAL", // 648 (906) + "STATEMENT", // 649 (907) + "STEP", // 650 (908) + "STRUCTURE", // 651 (909) + "TOWARD-GREATER", // 652 (910) + "TOWARD-LESSER", // 653 (911) + "TRUNCATION", // 654 (912) + "UCS-4", // 655 (913) + "UNDERLINE", // 656 (914) + "UNSIGNED", // 657 (915) + "UTF-16", // 658 (916) + "UTF-8", // 659 (917) + "XMLGENERATE", // 660 (918) + "XMLPARSE", // 661 (919) + "ADDRESS", // 662 (920) + "END-ACCEPT", // 663 (921) + "END-ADD", // 664 (922) + "END-CALL", // 665 (923) + "END-COMPUTE", // 666 (924) + "END-DELETE", // 667 (925) + "END-DISPLAY", // 668 (926) + "END-DIVIDE", // 669 (927) + "END-EVALUATE", // 670 (928) + "END-MULTIPLY", // 671 (929) + "END-PERFORM", // 672 (930) + "END-READ", // 673 (931) + "END-RETURN", // 674 (932) + "END-REWRITE", // 675 (933) + "END-SEARCH", // 676 (934) + "END-START", // 677 (935) + "END-STRING", // 678 (936) + "END-SUBTRACT", // 679 (937) + "END-UNSTRING", // 680 (938) + "END-WRITE", // 681 (939) + "END-XML", // 682 (940) + "END-IF", // 683 (941) + "ATTRIBUTES", // 684 (942) + "ELEMENT", // 685 (943) + "NAMESPACE", // 686 (944) + "NAMESPACE-PREFIX", // 687 (945) + "NONNUMERIC", // 689 (947) + "XML-DECLARATION", // 690 (948) + "THRU", // 692 (950) + "OR", // 693 (951) + "AND", // 694 (952) + "NOT", // 695 (953) + "NE", // 696 (954) + "LE", // 697 (955) + "GE", // 698 (956) + "POW", // 699 (957) + "NEG", // 700 (958) }; diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 0e6ec8cfb246..0724595403bf 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -259,6 +259,46 @@ void cdf_pop_dictionary() { cdf_directives.dictionary.pop(); } void cdf_pop_enabled_exceptions() { cdf_directives.enabled_exceptions.pop(); } void cdf_pop_source_format() { cdf_directives.source_format.pop(); } +/* + * Construct a cbl_field_t from a CDF literal, to be installed in the symbol table. + */ +cbl_field_t +cdf_literalize( const std::string& name, const cdfval_t& value ) { + cbl_field_t field; + + if( value.is_numeric() ) { + auto initial = xasprintf("%ld", (long)value.as_number()); + auto len = strlen(initial); + cbl_field_data_t data(len, len); + data.initial = initial; + data.valify(); + field = cbl_field_t{ FldLiteralN, constant_e, data, 0, name.c_str()}; + } else { + auto len = strlen(value.string); + cbl_field_data_t data(len, len); + data.initial = xstrdup(value.string); + field = cbl_field_t{ FldLiteralA, constant_e, data, 0, name.c_str() }; + field.set_attr(quoted_e); + } + field.codeset.set(); + + return field; +} + +const std::list<cbl_field_t> +cdf_literalize() { + std::list<cbl_field_t> fields; + auto dict = cdf_dictionary(); + + for( auto elem : dict ) { + std::string name(elem.first); + const cdfval_t& value(elem.second); + + fields.push_back(cdf_literalize(name, value)); + } + return fields; +} + const char * symbol_type_str( enum symbol_type_t type ) { @@ -2089,6 +2129,19 @@ cobol_filename_restore() { linemap_add(line_table, LC_LEAVE, sysp, NULL, 0); } +size_t +symbol_unique_index( const struct symbol_elem_t *e ) { + assert(e); + size_t usym = symbol_index(e); +#if READY_FOR_INODE + if( ! input_filenames.empty() ) { + size_t inode = input_filenames.top().inode; + usym = usym ^ inode; + } +#endif + return usym; +} + static int first_line_minus_1 = 0; static location_t token_location_minus_1 = 0; static location_t token_location = 0; diff --git a/libgcobol/.gitignore b/libgcobol/.gitignore new file mode 100644 index 000000000000..cf81477422ad --- /dev/null +++ b/libgcobol/.gitignore @@ -0,0 +1,8 @@ +compat/t/* +!compat/t/Makefile +!compat/t/*.cbl +posix/bin/sizeofs +posix/t/* +!posix/t/Makefile +!posix/t/*.cbl +posix/udf/*.scr diff --git a/libgcobol/Makefile.am b/libgcobol/Makefile.am index f42bfce23807..c6772a701d6e 100644 --- a/libgcobol/Makefile.am +++ b/libgcobol/Makefile.am @@ -30,6 +30,8 @@ if BUILD_LIBGCOBOL toolexeclib_LTLIBRARIES = libgcobol.la toolexeclib_DATA = libgcobol.spec +libsubincludedir = $(libdir)/gcc/cobol/$(target_noncanonical)/$(gcc_version) + ## ## 2.2.12 Automatic Dependency Tracking ## Automake generates code for automatic dependency tracking by default @@ -43,18 +45,31 @@ libgcobol_la_SOURCES = \ intrinsic.cc \ io.cc \ libgcobol.cc \ - posix/errno.cc \ - posix/localtime.cc \ - posix/stat.cc \ + posix/shim/errno.cc \ + posix/shim/localtime.cc \ + posix/shim/stat.cc \ stringbin.cc \ valconv.cc \ xmlparse.cc libgcobol_la_LIBADD = -lxml2 +nobase_libsubinclude_HEADERS = \ + posix/cpy/posix-errno.cbl \ + posix/cpy/statbuf.cpy \ + posix/udf/posix-exit.cbl \ + posix/udf/posix-localtime.cbl \ + posix/udf/posix-mkdir.cbl \ + posix/udf/posix-stat.cbl \ + posix/udf/posix-unlink.cbl \ + compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \ + compat/lib/gnu/CBL_ALLOC_MEM.cbl \ + compat/lib/gnu/CBL_DELETE_FILE.cbl \ + compat/lib/gnu/CBL_FREE_MEM.cbl + WARN_CFLAGS = -W -Wall -Wwrite-strings -AM_CPPFLAGS = -I. -I$(srcdir) -I$(srcdir)/posix $(LIBQUADINCLUDE) +AM_CPPFLAGS = -I. -I posix/shim $(LIBQUADINCLUDE) AM_CPPFLAGS += -I /usr/include/libxml2 AM_CFLAGS = $(XCFLAGS) @@ -73,7 +88,7 @@ endif libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS) version_arg = -version-info $(LIBGCOBOL_VERSION) libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \ - $(extra_ldflags_libgcobol) $(LIBS) -lxml2 $(version_arg) + $(extra_ldflags_libgcobol) $(LIBS) $(version_arg) libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP) endif BUILD_LIBGCOBOL diff --git a/libgcobol/Makefile.in b/libgcobol/Makefile.in index 880fa1f40a65..3dbf310f81a7 100644 --- a/libgcobol/Makefile.in +++ b/libgcobol/Makefile.in @@ -36,6 +36,7 @@ # Written de novo for libgcobol. + VPATH = @srcdir@ am__is_gnu_make = { \ if test -z '$(MAKELEVEL)'; then \ @@ -140,7 +141,7 @@ am__aclocal_m4_deps = $(top_srcdir)/../config/clang-plugin.m4 \ am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ - $(am__configure_deps) + $(am__configure_deps) $(am__nobase_libsubinclude_HEADERS_DIST) am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ configure.lineno config.status.lineno mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs @@ -175,15 +176,16 @@ am__uninstall_files_from_dir = { \ $(am__cd) "$$dir" && rm -f $$files; }; \ } am__installdirs = "$(DESTDIR)$(toolexeclibdir)" \ - "$(DESTDIR)$(toolexeclibdir)" + "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(libsubincludedir)" LTLIBRARIES = $(toolexeclib_LTLIBRARIES) am__dirstamp = $(am__leading_dot)dirstamp @BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_OBJECTS = charmaps.lo \ @BUILD_LIBGCOBOL_TRUE@ constants.lo gfileio.lo gmath.lo \ @BUILD_LIBGCOBOL_TRUE@ intrinsic.lo io.lo libgcobol.lo \ -@BUILD_LIBGCOBOL_TRUE@ posix/errno.lo posix/localtime.lo \ -@BUILD_LIBGCOBOL_TRUE@ posix/stat.lo stringbin.lo valconv.lo \ -@BUILD_LIBGCOBOL_TRUE@ xmlparse.lo +@BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.lo \ +@BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.lo \ +@BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.lo stringbin.lo \ +@BUILD_LIBGCOBOL_TRUE@ valconv.lo xmlparse.lo libgcobol_la_OBJECTS = $(am_libgcobol_la_OBJECTS) @BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_rpath = -rpath $(toolexeclibdir) AM_V_P = $(am__v_P_@AM_V@) @@ -231,6 +233,15 @@ am__can_run_installinfo = \ *) (install-info --version) >/dev/null 2>&1;; \ esac DATA = $(toolexeclib_DATA) +am__nobase_libsubinclude_HEADERS_DIST = posix/cpy/posix-errno.cbl \ + posix/cpy/statbuf.cpy posix/udf/posix-exit.cbl \ + posix/udf/posix-localtime.cbl posix/udf/posix-mkdir.cbl \ + posix/udf/posix-stat.cbl posix/udf/posix-unlink.cbl \ + compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \ + compat/lib/gnu/CBL_ALLOC_MEM.cbl \ + compat/lib/gnu/CBL_DELETE_FILE.cbl \ + compat/lib/gnu/CBL_FREE_MEM.cbl +HEADERS = $(nobase_libsubinclude_HEADERS) am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \ $(LISP)config.h.in # Read a list of newline-separated strings from the standard input, @@ -402,6 +413,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) # Skip the whole process if we are not building libgcobol. @BUILD_LIBGCOBOL_TRUE@toolexeclib_LTLIBRARIES = libgcobol.la @BUILD_LIBGCOBOL_TRUE@toolexeclib_DATA = libgcobol.spec +@BUILD_LIBGCOBOL_TRUE@libsubincludedir = $(libdir)/gcc/cobol/$(target_noncanonical)/$(gcc_version) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_SOURCES = \ @BUILD_LIBGCOBOL_TRUE@ charmaps.cc \ @BUILD_LIBGCOBOL_TRUE@ constants.cc \ @@ -410,16 +422,29 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) @BUILD_LIBGCOBOL_TRUE@ intrinsic.cc \ @BUILD_LIBGCOBOL_TRUE@ io.cc \ @BUILD_LIBGCOBOL_TRUE@ libgcobol.cc \ -@BUILD_LIBGCOBOL_TRUE@ posix/errno.cc \ -@BUILD_LIBGCOBOL_TRUE@ posix/localtime.cc \ -@BUILD_LIBGCOBOL_TRUE@ posix/stat.cc \ +@BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.cc \ +@BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.cc \ +@BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.cc \ @BUILD_LIBGCOBOL_TRUE@ stringbin.cc \ @BUILD_LIBGCOBOL_TRUE@ valconv.cc \ @BUILD_LIBGCOBOL_TRUE@ xmlparse.cc @BUILD_LIBGCOBOL_TRUE@libgcobol_la_LIBADD = -lxml2 +@BUILD_LIBGCOBOL_TRUE@nobase_libsubinclude_HEADERS = \ +@BUILD_LIBGCOBOL_TRUE@ posix/cpy/posix-errno.cbl \ +@BUILD_LIBGCOBOL_TRUE@ posix/cpy/statbuf.cpy \ +@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-exit.cbl \ +@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-localtime.cbl \ +@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-mkdir.cbl \ +@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-stat.cbl \ +@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-unlink.cbl \ +@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \ +@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_ALLOC_MEM.cbl \ +@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_DELETE_FILE.cbl \ +@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_FREE_MEM.cbl + @BUILD_LIBGCOBOL_TRUE@WARN_CFLAGS = -W -Wall -Wwrite-strings -@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I$(srcdir) -I$(srcdir)/posix \ +@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I posix/shim \ @BUILD_LIBGCOBOL_TRUE@ $(LIBQUADINCLUDE) -I \ @BUILD_LIBGCOBOL_TRUE@ /usr/include/libxml2 @BUILD_LIBGCOBOL_TRUE@AM_CFLAGS = $(XCFLAGS) @@ -430,7 +455,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS) @BUILD_LIBGCOBOL_TRUE@version_arg = -version-info $(LIBGCOBOL_VERSION) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \ -@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) -lxml2 $(version_arg) +@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) $(version_arg) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP) all: config.h @@ -523,24 +548,26 @@ clean-toolexeclibLTLIBRARIES: echo rm -f $${locs}; \ rm -f $${locs}; \ } -posix/$(am__dirstamp): - @$(MKDIR_P) posix - @: > posix/$(am__dirstamp) -posix/$(DEPDIR)/$(am__dirstamp): - @$(MKDIR_P) posix/$(DEPDIR) - @: > posix/$(DEPDIR)/$(am__dirstamp) -posix/errno.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(am__dirstamp) -posix/localtime.lo: posix/$(am__dirstamp) \ - posix/$(DEPDIR)/$(am__dirstamp) -posix/stat.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(am__dirstamp) +posix/shim/$(am__dirstamp): + @$(MKDIR_P) posix/shim + @: > posix/shim/$(am__dirstamp) +posix/shim/$(DEPDIR)/$(am__dirstamp): + @$(MKDIR_P) posix/shim/$(DEPDIR) + @: > posix/shim/$(DEPDIR)/$(am__dirstamp) +posix/shim/errno.lo: posix/shim/$(am__dirstamp) \ + posix/shim/$(DEPDIR)/$(am__dirstamp) +posix/shim/localtime.lo: posix/shim/$(am__dirstamp) \ + posix/shim/$(DEPDIR)/$(am__dirstamp) +posix/shim/stat.lo: posix/shim/$(am__dirstamp) \ + posix/shim/$(DEPDIR)/$(am__dirstamp) libgcobol.la: $(libgcobol_la_OBJECTS) $(libgcobol_la_DEPENDENCIES) $(EXTRA_libgcobol_la_DEPENDENCIES) $(AM_V_GEN)$(libgcobol_la_LINK) $(am_libgcobol_la_rpath) $(libgcobol_la_OBJECTS) $(libgcobol_la_LIBADD) $(LIBS) mostlyclean-compile: -rm -f *.$(OBJEXT) - -rm -f posix/*.$(OBJEXT) - -rm -f posix/*.lo + -rm -f posix/shim/*.$(OBJEXT) + -rm -f posix/shim/*.lo distclean-compile: -rm -f *.tab.c @@ -555,9 +582,9 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stringbin.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/valconv.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xmlparse.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/errno.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/localtime.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/stat.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/errno.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/localtime.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/stat.Plo@am__quote@ .cc.o: @am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\ @@ -588,7 +615,7 @@ mostlyclean-libtool: clean-libtool: -rm -rf .libs _libs - -rm -rf posix/.libs posix/_libs + -rm -rf posix/shim/.libs posix/shim/_libs distclean-libtool: -rm -f libtool config.lt @@ -613,6 +640,30 @@ uninstall-toolexeclibDATA: @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir) +install-nobase_libsubincludeHEADERS: $(nobase_libsubinclude_HEADERS) + @$(NORMAL_INSTALL) + @list='$(nobase_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(libsubincludedir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(libsubincludedir)" || exit 1; \ + fi; \ + $(am__nobase_list) | while read dir files; do \ + xfiles=; for file in $$files; do \ + if test -f "$$file"; then xfiles="$$xfiles $$file"; \ + else xfiles="$$xfiles $(srcdir)/$$file"; fi; done; \ + test -z "$$xfiles" || { \ + test "x$$dir" = x. || { \ + echo " $(MKDIR_P) '$(DESTDIR)$(libsubincludedir)/$$dir'"; \ + $(MKDIR_P) "$(DESTDIR)$(libsubincludedir)/$$dir"; }; \ + echo " $(INSTALL_HEADER) $$xfiles '$(DESTDIR)$(libsubincludedir)/$$dir'"; \ + $(INSTALL_HEADER) $$xfiles "$(DESTDIR)$(libsubincludedir)/$$dir" || exit $$?; }; \ + done + +uninstall-nobase_libsubincludeHEADERS: + @$(NORMAL_UNINSTALL) + @list='$(nobase_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \ + $(am__nobase_strip_setup); files=`$(am__nobase_strip)`; \ + dir='$(DESTDIR)$(libsubincludedir)'; $(am__uninstall_files_from_dir) ID: $(am__tagged_files) $(am__define_uniq_tagged_files); mkid -fID $$unique @@ -674,9 +725,9 @@ distclean-tags: -rm -f cscope.out cscope.in.out cscope.po.out cscope.files check-am: all-am check: check-am -all-am: Makefile $(LTLIBRARIES) $(DATA) config.h +all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS) config.h installdirs: - for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \ + for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(libsubincludedir)"; do \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \ done install: install-am @@ -705,8 +756,8 @@ clean-generic: distclean-generic: -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -rm -f posix/$(DEPDIR)/$(am__dirstamp) - -rm -f posix/$(am__dirstamp) + -rm -f posix/shim/$(DEPDIR)/$(am__dirstamp) + -rm -f posix/shim/$(am__dirstamp) maintainer-clean-generic: @echo "This command is intended for maintainers to use" @@ -718,7 +769,7 @@ clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \ distclean: distclean-am -rm -f $(am__CONFIG_DISTCLEAN_FILES) - -rm -rf ./$(DEPDIR) posix/$(DEPDIR) + -rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR) -rm -f Makefile distclean-am: clean-am distclean-compile distclean-generic \ distclean-hdr distclean-libtool distclean-tags @@ -735,7 +786,7 @@ info: info-am info-am: -install-data-am: +install-data-am: install-nobase_libsubincludeHEADERS install-dvi: install-dvi-am @@ -767,7 +818,7 @@ installcheck-am: maintainer-clean: maintainer-clean-am -rm -f $(am__CONFIG_DISTCLEAN_FILES) -rm -rf $(top_srcdir)/autom4te.cache - -rm -rf ./$(DEPDIR) posix/$(DEPDIR) + -rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR) -rm -f Makefile maintainer-clean-am: distclean-am maintainer-clean-generic @@ -784,8 +835,8 @@ ps: ps-am ps-am: -uninstall-am: uninstall-toolexeclibDATA \ - uninstall-toolexeclibLTLIBRARIES +uninstall-am: uninstall-nobase_libsubincludeHEADERS \ + uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES .MAKE: all install-am install-strip @@ -797,14 +848,15 @@ uninstall-am: uninstall-toolexeclibDATA \ html-am info info-am install install-am install-data \ install-data-am install-dvi install-dvi-am install-exec \ install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ + install-info-am install-man \ + install-nobase_libsubincludeHEADERS install-pdf install-pdf-am \ install-ps install-ps-am install-strip install-toolexeclibDATA \ install-toolexeclibLTLIBRARIES installcheck installcheck-am \ installdirs maintainer-clean maintainer-clean-generic \ mostlyclean mostlyclean-compile mostlyclean-generic \ mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ - uninstall-am uninstall-toolexeclibDATA \ - uninstall-toolexeclibLTLIBRARIES + uninstall-am uninstall-nobase_libsubincludeHEADERS \ + uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES .PRECIOUS: Makefile diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc index d40846543198..d5220aecf397 100644 --- a/libgcobol/charmaps.cc +++ b/libgcobol/charmaps.cc @@ -55,7 +55,7 @@ int __gg__decimal_separator = ',' ; int __gg__quote_character = '"' ; int __gg__low_value_character = 0x00 ; int __gg__high_value_character = 0xFF ; -char **__gg__currency_signs ; +std::vector<std::string> __gg__currency_signs(256) ; int __gg__default_currency_sign; char *__gg__ct_currency_signs[256]; // Compile-time currency signs diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h index f48c063e60ba..60068a7fb711 100644 --- a/libgcobol/charmaps.h +++ b/libgcobol/charmaps.h @@ -31,6 +31,9 @@ #ifndef CHARMAPS_H #define CHARMAPS_H +#include <string> +#include <vector> + #include <unistd.h> /* There are four distinct codeset domains in the COBOL compiler. @@ -108,11 +111,10 @@ extern int __gg__decimal_separator ; extern int __gg__quote_character ; extern int __gg__low_value_character ; extern int __gg__high_value_character ; -extern char **__gg__currency_signs ; +extern std::vector<std::string> __gg__currency_signs ; extern int __gg__default_currency_sign; extern cbl_encoding_t __gg__display_encoding ; extern cbl_encoding_t __gg__national_encoding ; -extern char *__gg__ct_currency_signs[256]; // Compile-time currency signs #define NULLCH ('\0') #define DEGENERATE_HIGH_VALUE 0xFF @@ -492,4 +494,4 @@ class charmap_t charmap_t *__gg__get_charmap(cbl_encoding_t encoding); -#endif \ No newline at end of file +#endif diff --git a/libgcobol/compat/README.md b/libgcobol/compat/README.md new file mode 100644 index 000000000000..15f5a0e4731c --- /dev/null +++ b/libgcobol/compat/README.md @@ -0,0 +1,25 @@ +# GCC COBOL Compatibility Functions + +## Purpose + +It seems every COBOL compiler includes a library of functions intended +to make the COBOL programer's life easier. All of them, as we +demonstrate here, can be written in COBOL. They are supplied in COBOL +form, not as a library. The user is free to compile them into a +utility library. + +Some of the functions defined here require runtime support from libgcobol. + +## Fri Oct 10 16:01:58 2025 + +At the time of this writing, the functions of greatest concern are +those that are defined by Rocket Software (formerly MicroFocus) and +emulated by GnuCOBOL. Those are implemented in +`gcc/cobol/compat/lib/gnu`. Any calls they would otherwise make to +the C library are effected through COBOL POSIX bindings supplied by +`gcc/cobol/posix/udf`. + +As an aid to the developer, a simple example of how these functions +are used is found in `gcc/cobol/compat/t/smoke.cbl`. It may by +compiled using `gcc/cobol/compat/Makefile`. + diff --git a/libgcobol/compat/lib/gnu/CBL_ALLOC_MEM.cbl b/libgcobol/compat/lib/gnu/CBL_ALLOC_MEM.cbl new file mode 100644 index 000000000000..9d9d37b4e5b9 --- /dev/null +++ b/libgcobol/compat/lib/gnu/CBL_ALLOC_MEM.cbl @@ -0,0 +1,41 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH) + * This function is in the public domain. + * Contributed by James K. Lowden + * + * CALL "CBL_ALLOC_MEM" using mem-pointer + * by value mem-size + * by value flags + * returning status-code + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + IDENTIFICATION DIVISION. + PROGRAM-ID. CBL_ALLOC_MEM. + + DATA DIVISION. + + LINKAGE SECTION. + 01 MEMORY-REQUESTED PIC X(8) COMP-5. + 01 MEMORY-ALLOCATED USAGE IS POINTER. + 01 FLAGS PIC X(8) COMP-5. + 77 STATUS-CODE BINARY-LONG SIGNED VALUE 0. + + PROCEDURE DIVISION USING MEMORY-ALLOCATED, + BY VALUE MEMORY-REQUESTED, + BY VALUE FLAGS + RETURNING STATUS-CODE. + + D Display 'MEMORY-REQUESTED: ' MEMORY-REQUESTED + D ' CHARACTERS INITIALIZED' + + ALLOCATE MEMORY-REQUESTED CHARACTERS INITIALIZED, + RETURNING MEMORY-ALLOCATED. + + D IF MEMORY-ALLOCATED = NULLS THEN MOVE 1 TO STATUS-CODE. + + END PROGRAM CBL_ALLOC_MEM. + + >> POP SOURCE FORMAT \ No newline at end of file diff --git a/libgcobol/compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl b/libgcobol/compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl new file mode 100644 index 000000000000..4338cf000ec7 --- /dev/null +++ b/libgcobol/compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl @@ -0,0 +1,47 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + * Include the posix-stat function + COPY posix-stat. + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH) + * This function is in the public domain. + * Contributed by James K. Lowden of Cobolworx in August 2024 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + IDENTIFICATION DIVISION. + PROGRAM-ID. CBL_CHECK_FILE_EXIST. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 FUNC-RETURN-VALUE PIC 9(8) COMP-5. + 01 STAT-BUFFER. + COPY statbuf. + LINKAGE SECTION. + 77 RETURN-CODE PIC 9(8) COMP-5. + 01 FILE-PATH PIC X ANY LENGTH. + 01 FI-FILE-INFO. + 05 FI-FILE-SIZE-IN-BYTES PIC 9(8) COMP-4. + 05 FI-FILE-MOD-DATE-TIME. + 10 FI-FILE-DATE PIC 9(8) COMP-4. + 10 FI-FILE-TIME PIC 9(8) COMP-4. + + PROCEDURE DIVISION USING FILE-PATH, FI-FILE-INFO, + RETURNING RETURN-CODE. + MOVE FUNCTION posix-stat(FILE-PATH, STAT-BUFFER) + TO FUNC-RETURN-VALUE. + + IF FUNC-RETURN-VALUE = ZERO + THEN + MOVE ZERO TO RETURN-CODE + MOVE st_size TO FI-FILE-SIZE-IN-BYTES + MOVE st_mtime TO FI-FILE-MOD-DATE-TIME + ELSE + MOVE 1 TO RETURN-CODE + MOVE ZERO TO FI-FILE-SIZE-IN-BYTES + MOVE ZERO TO FI-FILE-DATE + MOVE ZERO TO FI-FILE-TIME. + + END PROGRAM CBL_CHECK_FILE_EXIST. + + >> POP SOURCE FORMAT +` \ No newline at end of file diff --git a/libgcobol/compat/lib/gnu/CBL_DELETE_FILE.cbl b/libgcobol/compat/lib/gnu/CBL_DELETE_FILE.cbl new file mode 100644 index 000000000000..7440b70b3dae --- /dev/null +++ b/libgcobol/compat/lib/gnu/CBL_DELETE_FILE.cbl @@ -0,0 +1,30 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + * Include the posix-unlink function + COPY posix-unlink. + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH) + * This function is in the public domain. + * Contributed by + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + IDENTIFICATION DIVISION. + PROGRAM-ID. CBL_DELETE_FILE. + DATA DIVISION. + WORKING-STORAGE SECTION. + 77 BUFSIZE USAGE BINARY-LONG. + LINKAGE SECTION. + 77 RETURN-CODE PIC 9(8) COMP-5. + 01 FILE-PATH PIC X ANY LENGTH. + + PROCEDURE DIVISION USING FILE-PATH, RETURNING RETURN-CODE. + + INSPECT FILE-PATH + REPLACING TRAILING SPACE BY LOW-VALUE + + MOVE FUNCTION posix-unlink(FILE-PATH) TO RETURN-CODE. + + END PROGRAM CBL_DELETE_FILE. + + >> POP SOURCE FORMAT \ No newline at end of file diff --git a/libgcobol/compat/lib/gnu/CBL_FREE_MEM.cbl b/libgcobol/compat/lib/gnu/CBL_FREE_MEM.cbl new file mode 100644 index 000000000000..6808d140475f --- /dev/null +++ b/libgcobol/compat/lib/gnu/CBL_FREE_MEM.cbl @@ -0,0 +1,26 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH) + * This function is in the public domain. + * Contributed by + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + IDENTIFICATION DIVISION. + PROGRAM-ID. CBL_FREE_MEM. + + DATA DIVISION. + LINKAGE SECTION. + 77 RETURN-CODE PIC 9(8) COMP. + 01 MEMORY-ADDRESS USAGE IS POINTER. + + PROCEDURE DIVISION USING MEMORY-ADDRESS, + RETURNING RETURN-CODE. + + FREE MEMORY-ADDRESS. + MOVE ZERO TO RETURN-CODE. + + END PROGRAM CBL_FREE_MEM. + + >> POP SOURCE FORMAT \ No newline at end of file diff --git a/libgcobol/compat/t/Makefile b/libgcobol/compat/t/Makefile new file mode 100644 index 000000000000..ed7ff26cab28 --- /dev/null +++ b/libgcobol/compat/t/Makefile @@ -0,0 +1,27 @@ +# +# A simple Makefile to demonstrate how the compat/lib programs are used. +# + +COBC = gcobol -g -O0 + +INCLUDE = ../../posix/cpy ../../posix/udf + +FLAGS = -dialect mf $(addprefix -I,$(INCLUDE)) + +COMPAT = $(subst .cbl,.o,$(wildcard ../lib/gnu/*.cbl)) + +test: smoke + ./$^ + +smoke: smoke.cbl $(COMPAT) + $(ENV) $(COBC) -o $@ \ + $(FLAGS) $(COBCFLAGS) $(LDFLAGS) $^ + +%.o : %.cbl + $(ENV) $(COBC) -c -o $@ $(FLAGS) $(COBCFLAGS) $^ + +% : %.cbl + $(ENV) $(COBC) -o $@ $(FLAGS) $(COBCFLAGS) $(LDFLAGS) $^ + + + diff --git a/libgcobol/compat/t/smoke.cbl b/libgcobol/compat/t/smoke.cbl new file mode 100644 index 000000000000..8dd685a0f95d --- /dev/null +++ b/libgcobol/compat/t/smoke.cbl @@ -0,0 +1,95 @@ + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This function is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + COPY posix-errno. + + IDENTIFICATION DIVISION. + PROGRAM-ID. gcobol-smoke-test. + + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SOURCE-COMPUTER. + GNU-Linux. + OBJECT-COMPUTER. + GNU-Linux. + + >>Define FILENAME as "/tmp/smoke.empty" + + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT EXPENDABLE + ACCESS MODE IS SEQUENTIAL + SEQUENTIAL + ASSIGN TO FILENAME. + + DATA DIVISION. + FILE SECTION. + * FD not required per ISO but fails under gcobol. + FD EXPENDABLE. + 01 Extraneous PIC X. + + WORKING-STORAGE SECTION. + 77 File-Name PIC X(100) VALUE FILENAME. + 77 status-code BINARY-LONG SIGNED. + + * CBL_ALLOC_MEM + 01 mem-pointer usage pointer. + 77 mem-size pic x(8) comp-5 VALUE 64. + 77 flags pic x(8) comp-5 VALUE 0. + + * CBL_CHECK_FILE_EXIST + 01 file-info. + 03 file-modification-day. + 05 File-Size-In-Bytes PIC 9(18) COMP. + 05 Mod-DD PIC 9(2) COMP. *> Modification Date + 05 Mod-MO PIC 9(2) COMP. + 05 Mod-YYYY PIC 9(4) COMP. + 03 file-modification-time. + 05 Mod-HH PIC 9(2) COMP. *> Modification Time + 05 Mod-MM PIC 9(2) COMP. + 05 Mod-SS PIC 9(2) COMP. + 05 FILLER PIC 9(2) COMP. *> Always 00 + + PROCEDURE DIVISION. + + Display 'Allocating ' mem-size ' bytes ... ' with No Advancing. + + Call "CBL_ALLOC_MEM" using + mem-pointer + by value mem-size + by value flags + returning status-code. + + Display 'CBL_ALLOC_MEM status: ' status-code. + + Display 'Checking on ' Function Trim(File-Name) ' ... ' + with No Advancing. + + Call "CBL_CHECK_FILE_EXIST" using File-Name + file-info + returning status-code. + + Display 'CBL_CHECK_FILE_EXIST status: ' status-code. + + Display 'Deleting ' Function Trim(File-Name) ' ... ' + with No Advancing. + + Call "CBL_DELETE_FILE" using File-Name + returning status-code. + + Display 'CBL_DELETE_FILE status: ' status-code. + + Display 'Freeing ' mem-size ' bytes ... ' with No Advancing. + + Call "CBL_FREE_MEM" using by value mem-pointer + returning status-code. + + Display 'CBL_FREE_MEM status: ' status-code. + + >>IF CBL_READ_FILE is defined + Call "CBL_READ_FILE" + using handle, offset, count, flags, buf + returning status-code. + >>END-IF + diff --git a/libgcobol/config.h.in b/libgcobol/config.h.in index 1b511d0330d5..9f988369febc 100644 --- a/libgcobol/config.h.in +++ b/libgcobol/config.h.in @@ -55,6 +55,9 @@ /* Define to 1 if you have the `random_r' function. */ #undef HAVE_RANDOM_R +/* Define to 1 if you have the `xmlParseChunk' function. */ +#undef HAVE_SAX_XML_PARSER + /* Define to 1 if you have the `setstate_r' function. */ #undef HAVE_SETSTATE_R diff --git a/libgcobol/configure b/libgcobol/configure index 48ccf3685b1a..4a57b0303507 100755 --- a/libgcobol/configure +++ b/libgcobol/configure @@ -17650,6 +17650,100 @@ if test "$ac_res" != no; then : fi +# These are libxml2. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xmlSAXUserParseMemory in -lxml2" >&5 +$as_echo_n "checking for xmlSAXUserParseMemory in -lxml2... " >&6; } +if ${ac_cv_lib_xml2_xmlSAXUserParseMemory+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lxml2 $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char xmlSAXUserParseMemory (); +int +main () +{ +return xmlSAXUserParseMemory (); + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + ac_cv_lib_xml2_xmlSAXUserParseMemory=yes +else + ac_cv_lib_xml2_xmlSAXUserParseMemory=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_xmlSAXUserParseMemory" >&5 +$as_echo "$ac_cv_lib_xml2_xmlSAXUserParseMemory" >&6; } +if test "x$ac_cv_lib_xml2_xmlSAXUserParseMemory" = xyes; then : + LIBS="-lxml2 $LIBS" + +$as_echo "#define HAVE_SAX_XML_PARSER 1" >>confdefs.h + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xmlParseChunk in -lxml2" >&5 +$as_echo_n "checking for xmlParseChunk in -lxml2... " >&6; } +if ${ac_cv_lib_xml2_xmlParseChunk+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lxml2 $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char xmlParseChunk (); +int +main () +{ +return xmlParseChunk (); + ; + return 0; +} +_ACEOF +if ac_fn_cxx_try_link "$LINENO"; then : + ac_cv_lib_xml2_xmlParseChunk=yes +else + ac_cv_lib_xml2_xmlParseChunk=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_xmlParseChunk" >&5 +$as_echo "$ac_cv_lib_xml2_xmlParseChunk" >&6; } +if test "x$ac_cv_lib_xml2_xmlParseChunk" = xyes; then : + LIBS="-lxml2 $LIBS" + +$as_echo "#define HAVE_SAX_XML_PARSER 1" >>confdefs.h + +fi + + # Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner # At least for glibc, clock_gettime is in librt. But don't pull that # in if it still doesn't give us the function we want. diff --git a/libgcobol/configure.ac b/libgcobol/configure.ac index acfca7e68e43..8062601da716 100644 --- a/libgcobol/configure.ac +++ b/libgcobol/configure.ac @@ -232,6 +232,16 @@ AC_SEARCH_LIBS([sinf128], [c m], libgcobol_have_sinf128=yes) libgcobol_have_cacosf128=no AC_SEARCH_LIBS([cacosf128], [c m], libgcobol_have_cacosf128=yes) +# These are libxml2. +AC_CHECK_LIB(xml2, xmlSAXUserParseMemory, + [LIBS="-lxml2 $LIBS" + AC_DEFINE(HAVE_SAX_XML_PARSER, 1, + [Define to 1 if you have the `xmlSAXUserParseMemory' function.])]) +AC_CHECK_LIB(xml2, xmlParseChunk, + [LIBS="-lxml2 $LIBS" + AC_DEFINE(HAVE_SAX_XML_PARSER, 1, + [Define to 1 if you have the `xmlParseChunk' function.])]) + # Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner # At least for glibc, clock_gettime is in librt. But don't pull that # in if it still doesn't give us the function we want. diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc index bb03f629d0a9..bf9396ea0bbe 100644 --- a/libgcobol/intrinsic.cc +++ b/libgcobol/intrinsic.cc @@ -2714,8 +2714,8 @@ numval_c( cblc_field_t *dest, char *currency_in_ascii; - char *currency_start; - char *currency_end; + const char *currency_start; + const char *currency_end; if( crcy ) { converted = __gg__iconverter(crcy->encoding, @@ -2736,7 +2736,7 @@ numval_c( cblc_field_t *dest, currency_start = currency_in_ascii; currency_end = currency_start + strlen(currency_start); - char *pcurrency = currency_start; + const char *pcurrency = currency_start; // Trim off spaces from the currency: while( *pcurrency == ascii_space && pcurrency < currency_end ) { diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index f587fbfa06f9..20fc9751d8a1 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -461,13 +461,13 @@ struct program_state int rt_quote_character; int rt_low_value_character; int rt_high_value_character; - char *rt_currency_signs[256]; + std::vector<std::string> rt_currency_signs; const unsigned short *rt_collation; // Points to a table of 256 values; cbl_encoding_t rt_display_encoding; cbl_encoding_t rt_national_encoding; char *rt_program_name; - program_state() + program_state() : rt_currency_signs(256) { // IBM defaults to the \" QUOTE compiler option. quote_character must // be set to \' when the APOST compiler option is in effect @@ -486,15 +486,14 @@ struct program_state // Set all the currency_sign pointers to NULL: - memset(rt_currency_signs, 0, sizeof(rt_currency_signs)); - rt_display_encoding = __gg__display_encoding; rt_national_encoding = __gg__national_encoding; rt_collation = __gg__one_to_one_values; rt_program_name = NULL; } - program_state(const program_state &ps) + program_state(const program_state &ps) + : rt_currency_signs(ps.rt_currency_signs) { rt_decimal_point = ps.rt_decimal_point ; rt_decimal_separator = ps.rt_decimal_separator ; @@ -507,32 +506,7 @@ struct program_state rt_display_encoding = ps.rt_display_encoding ; rt_national_encoding = ps.rt_national_encoding ; rt_collation = ps.rt_collation ; - - for( int i=0; i<256; i++ ) - { - if( ps.rt_currency_signs[i] ) - { - rt_currency_signs[i] = strdup(ps.rt_currency_signs[i]); - } - else - { - rt_currency_signs[i] = NULL; - } - } - - rt_program_name = ps.rt_program_name ; - } - - ~program_state() - { - for(int symbol=0; symbol<256; symbol++) - { - if( rt_currency_signs[symbol] ) - { - free(rt_currency_signs[symbol]); - rt_currency_signs[symbol] = NULL; - } - } + rt_program_name = ps.rt_program_name ; } }; @@ -584,10 +558,10 @@ __gg__get_decimal_separator() } extern "C" -char * +const char * __gg__get_default_currency_string() { - return currency_signs(__gg__default_currency_sign); + return currency_signs(__gg__default_currency_sign).c_str(); } extern "C" @@ -8132,10 +8106,21 @@ __gg__inspect_format_2(int backward, size_t integers[]) size_t id1_s = __gg__treeplet_1s[cblc_index]; cblc_index += 1; +#if 0 + fprintf(stderr, "%s:%d: '%.*s' id1_o %zu, id1_s %zu\n", __func__, __LINE__, + int(id1_s), (char*)id1->data, id1_o, id1_s); +#endif + // normalize it, according to the language specification. normalized_operand normalized_id_1 = normalize_id(id1, id1_o, id1_s, id1->encoding); - +#if 0 + fprintf(stderr, "%s:%d: normalized_id_1 '%s' offset %zu, length %zu\n", __func__, __LINE__, + normalized_id_1.the_characters.c_str(), + normalized_id_1.offset, + normalized_id_1.length ); +#endif + std::vector<comparand> comparands; // Pick up the count of operations: diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h index b137f36166c5..9fe6bf2a5249 100644 --- a/libgcobol/libgcobol.h +++ b/libgcobol/libgcobol.h @@ -96,7 +96,7 @@ extern "C" void __gg__double_to_target( cblc_field_t *tgt, cbl_round_t rounded); extern "C" char __gg__get_decimal_separator(); extern "C" char __gg__get_decimal_point(); -extern "C" char * __gg__get_default_currency_string(); +extern "C" const char * __gg__get_default_currency_string(); struct cbl_timespec { diff --git a/libgcobol/posix/README.md b/libgcobol/posix/README.md new file mode 100644 index 000000000000..2cd02f921bfb --- /dev/null +++ b/libgcobol/posix/README.md @@ -0,0 +1,105 @@ +# GCC COBOL Posix Functions and Adapter + +## Purpose + +GCC COBOL provides COBOL bindings for some POSIX functions. Feel free +to contribute more. Insofar as possible, the functions take the same +parameters and return the same values as defined by POSIX. Among +others, they are used by the COBOL compatibility library (see +libgcobol/compat/lib/gnu). They are installed in source form. The +user may choose to compile them to a library. + +ISO COBOL does not specify any relationship to any particular +operating system, and does not reference POSIX. The raw capability is +there, of course, via the `CALL` statement. But that's not very +convenient, and offers no parameter validation. + +For simple functions, e.g. **unlink**(2), the UDFs simply call the +underlying C library. More complex functions, though, +e.g. **stat**(2), pass or return a buffer. That buffer is normally +defined by what members must exist, but its exact layout is left up to +the C implementation and defined by the C header files, which are not +parsed by GCC COBOL. Consequently we do not know, at the COBOL level, +how to define the `struct stat` buffer required by **stat**(2). For +such functions, we use a C "shim" function that accepts a buffer +defined by GCC COBOL. That buffer has the members defined by POSIX +and a layout defined by GCC COBOL. The COBOL application calls the +COBOL POSIX binding, which uses the shim function to call the C +library. + +To take **stat**(2) as an example, + + COBOL program uses + COPY posix-stat. + 01 stat-buf. + COPY posix-statbuf. *> gcc/cobol/posix/cpy + FUNCTION POSIX-STAT(filename, stat-buf) + libgcobol/posix/udf/posix-stat.cbl + passes stat-buf to + posix_stat in libgcobol + posix_stat calls stat(2), + and copies the returned values to its input buffer + +## Contents + +The installed POSIX bindings and associated copybooks are in `cpy` and `udf`: + +- `cpy/` copybooks used by functions in `udf` +- `udf/` COBOL POSIX bindings +- `t/` simple tests demonstrating use of functions in `udf` + +Any buffer shared between the COBOL application and a COBOL POSIX +function is defined in `cpy/`. While these buffers meet the POSIX +descriptions -- meaning they have members matching the standard -- +they probably do not match the buffer defined by the C library in +`/usr/include`. GCC COBOL does not parse C, and therefore does not +parse C header files, and so has no access to those C buffer definitions. + +The machine-shop tools are in `bin/`. + +- `bin/` developer tools to aid creation of POSIX bindings + - `scrape.awk` extracts function prototypes from the SYNOPSIS of a + man page. + - `udf-gen` reads function declarations and, for each one, produces + a COBOL User Defined Function (UDF) that calls the function. + +Finally, + +- `shim/` C support for POSIX bindings, incorporated in libgcobol + +## Prerequisites +### for developers, to generate COBOL POSIX bindings + +To use the POSIX bindings, just use the COPY statement. + +To create new ones, use `udf-gen`. `udf-gen` is a Python program that +imports the [PLY pycparser module](http://www.dabeaz.com/ply/) module, +which must be installed. + +`udf-gen` is lightly documented, use `udf-gen --help`. It can be a +little tedious to set up the first time, but if you want to use more a +few functions, it will be faster than doing the work by hand. + +## Limitations + +`udf-gen` does not + +- generate a working UDF for function parameters of type `struct`, + such as is used by **stat**(2). This is because the information is + not available in a standardized way in the SYNOPSIS of a man page. +- define helpful Level 88 values for "magic" numbers, such as + permission bits in **chmod**(2). + +None of this is particularly difficult; it's just a matter of time and +need. The `scrape.awk` script finds 560 functions in the Ubuntu LTS +22.04 manual. Which of those is important is for users to decide. + +## Other Options + +IBM and MicroFocus both supply intrinsic functions to interface with +the OS, each in their own way. GnuCOBOL implements some of those functions. + +## Portability + +The UDF produced by `udf-gen` is pure ISO COBOL. The code should be +compilable by any ISO COBOL compiler. diff --git a/libgcobol/posix/bin/Makefile b/libgcobol/posix/bin/Makefile new file mode 100644 index 000000000000..335f205068b4 --- /dev/null +++ b/libgcobol/posix/bin/Makefile @@ -0,0 +1,18 @@ +# +# Demonstrate how to generate a new COBOL binding from a man page. +# + +posix-mkdir.cbl: + man 2 mkdir | ./scrape.awk | \ + ../udf-gen -D mode_t=unsigned\ long > $@~ + @mv $@~ $@ + +# ... or + +posix-stat-many.scr: + man 2 stat | col -b | ./scrape.awk > $@~ + @mv $@~ $@ + +.scr.cbl: + ./udf-gen -D mode_t=unsigned\ long $^ > $@~ + @mv $@~ $@ diff --git a/libgcobol/posix/bin/headers b/libgcobol/posix/bin/headers new file mode 100644 index 000000000000..b17c0f30cb38 --- /dev/null +++ b/libgcobol/posix/bin/headers @@ -0,0 +1,37 @@ +#include <stddef.h> +#include <stdio.h> +#include <stddef.h> +#include <unistd.h> +#define loff_t ssize_t +#define socklen_t size_t +#define fd_set struct fd_set +#define id_t unsigned int +// typedef int mqd_t; +#define mqd_t int +// typedef unsigned long int nfds_t; +#define nfds_t unsigned long int + +#if 0 +typedef struct +{ + unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))]; +} __sigset_t; +define struct py_sigset_t \ +{ \ + unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))]; \ +}; +#else +#define kernel_sigset_t sigset_t +#define old_kernel_sigset_t sigset_t +#endif + +#if 0 +typedef enum +{ + P_ALL, + P_PID, + P_PGID +} idtype_t; +#else +#define idtype_t int +#endif diff --git a/libgcobol/posix/bin/scrape.awk b/libgcobol/posix/bin/scrape.awk new file mode 100755 index 000000000000..4d244d0ee3db --- /dev/null +++ b/libgcobol/posix/bin/scrape.awk @@ -0,0 +1,19 @@ +#! /usr/bin/awk -f + +/^UNIMPLEMENTED/ { + exit +} + +/^DESCRIPTION/ { + exit +} + +/struct sched_param {$/ { + exit +} + +/SYNOPSIS/,/DESCRIPTION/ { + if( /([.][.]|[{},;]) *$/ ) { + print + } +} diff --git a/libgcobol/posix/bin/sizeofs.c b/libgcobol/posix/bin/sizeofs.c new file mode 100644 index 000000000000..7f5f534aadb3 --- /dev/null +++ b/libgcobol/posix/bin/sizeofs.c @@ -0,0 +1,27 @@ +#include <fcntl.h> /* Definition of AT_* constants */ +#include <stdio.h> +#include <time.h> +#include <unistd.h> + +#include <sys/stat.h> +#include <sys/stat.h> +#include <sys/types.h> + +int +main(int argc, char *argv[]) +{ + printf( "size of dev_t is %zu\n", sizeof(dev_t)); + printf( "size of ino_t is %zu\n", sizeof(ino_t)); + printf( "size of mode_t is %zu\n", sizeof(mode_t)); + printf( "size of nlink_t is %zu\n", sizeof(nlink_t)); + printf( "size of uid_t is %zu\n", sizeof(uid_t)); + printf( "size of gid_t is %zu\n", sizeof(gid_t)); + printf( "size of dev_t is %zu\n", sizeof(dev_t)); + printf( "size of off_t is %zu\n", sizeof(off_t)); + printf( "size of blksize_t is %zu\n", sizeof(blksize_t)); + printf( "size of blkcnt_t is %zu\n", sizeof(blkcnt_t)); + printf( "size of time_t is %zu\n", sizeof(time_t)); + printf( "size of struct timespec is %zu\n", sizeof(struct timespec)); + + return 0; +} diff --git a/libgcobol/posix/bin/udf-gen b/libgcobol/posix/bin/udf-gen new file mode 100755 index 000000000000..4ad9f7fffe75 --- /dev/null +++ b/libgcobol/posix/bin/udf-gen @@ -0,0 +1,350 @@ +#! /usr/bin/python3 + +# Copyright (c) Symas Corporation +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are +# met: +# +# * Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# * Redistributions in binary form must reproduce the above +# copyright notice, this list of conditions and the following disclaimer +# in the documentation and/or other materials provided with the +# distribution. +# * Neither the name of the Symas Corporation nor the names of its +# contributors may be used to endorse or promote products derived from +# this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +import sys, os, getopt, re, copy +from pycparser import c_parser, c_generator, c_ast, parse_file + +def starify(param): + stars = "" + while( isinstance(param, c_ast.PtrDecl) ): + q = ' '.join(param.quals) + stars = '*' + ' '.join((stars, q)) + param = param.type + if( isinstance(param.type, c_ast.PtrDecl) ): + (stars, param) = starify(param.type) + if( isinstance(param, c_ast.TypeDecl) ): + return (stars, param) + return (stars, param.type) + +def linkage_str( i, name, param ) -> str: + if name == 'execve': + param.show() + if( isinstance(param, c_ast.EllipsisParam) ): + return (None, None, '...') # COBOL syntax error: no variadic UDF + + is_array = False; + node = param + + if( isinstance(node, c_ast.Decl) ): + node = node.type + + if( isinstance(node, c_ast.ArrayDecl) ): + is_array = True; + node = node.type + + (stars, node) = starify(node) + + if( isinstance(node, c_ast.TypeDecl) ): + level = 1 + item_name = '' + picture = '' + usage = '' + if node.declname: + item_name = 'Lk-' + node.declname + + if is_array: # ignore level + if stars: + usage = 'Usage POINTER' + output = '01 FILLER.\n 02 %s %s %s OCCURS 100' \ + % (item_name, picture, usage) + return (None, None, output) + + if( isinstance(node.type, c_ast.Struct) ): + stars = None + + if isinstance(node.type, c_ast.IdentifierType): + ctype = node.type.names[-1] + if ctype == 'void': + if not stars and not item_name: + return (None, None, None) + if ctype == 'char': + picture = 'X' + if stars[0] == '*': + picture = 'X ANY LENGTH' + if ctype == 'int' or \ + ctype == 'long' or \ + ctype == 'mode_t' or \ + ctype == 'off_t' or \ + ctype == 'size_t': + picture = '9(8)' + usage = 'Usage COMP' + stars = None + + output = "%02d %s" % (level, ' '.join((item_name, 'PIC ' + picture, usage))) + return (stars, item_name, output) + + node.show() + return (None, None, '???') + +def using_str( i, name, param ) -> str: + item_name = '' + if( isinstance(param, c_ast.EllipsisParam) ): + return '...' # COBOL syntax error: no variadic UDF + node = param + + if( isinstance(node, c_ast.Decl) ): + node = node.type + + if( isinstance(node, c_ast.ArrayDecl) ): + node = node.type + + (stars, node) = starify(node) + + if( isinstance(node, c_ast.TypeDecl) ): + item_name = '' + + if isinstance(node.type, c_ast.IdentifierType): + ctype = node.type.names[-1] + how = 'By Reference' + if ctype == 'int' or \ + ctype == 'long' or \ + ctype == 'mode_t' or \ + ctype == 'off_t' or \ + ctype == 'size_t': + how = 'By Value' + if node.declname: + item_name = '%s Lk-%s' % (how, node.declname) + + return item_name + +def parameter_str( i, name, param ) -> str: + if( isinstance(param, c_ast.EllipsisParam) ): + return '...' + + t = [0, 1, 2] # qual, type, name + is_array = False; + node = param + + if( isinstance(node, c_ast.Decl) ): + node = node.type + + if( isinstance(node, c_ast.ArrayDecl) ): + is_array = True; + node = node.type + + (stars, node) = starify(node) + + if( isinstance(node, c_ast.TypeDecl) ): + t[0] = ' '.join(node.quals) + item_name = '' + if node.declname: + item_name = 'Lk-' + node.declname + t[2] = ' '.join((stars, item_name)) + if( node.declname == None ): + t[2] = '' + if( isinstance(node.type, c_ast.IdentifierType) ): + try: + t[1] = ' '.join(node.type.names) + except: + print("oops: node.type of %s is %s" % (name, str(node.type))) + return "could not parse %s arg[%d]" % (name, i) + if( isinstance(node.type, c_ast.Struct) ): + t[0] = ' '.join(node.quals) + t[1] = "struct " + node.type.name + if( isinstance(node, c_ast.ArrayDecl) ): + return parameter_str(i, name, node.type) + '[]' + + try: + return ' '.join(t) + except: + print("oops: %s[%d]: {%s}" % (name, i, str(t)) ) + param.show() + +class VisitPrototypes(c_ast.NodeVisitor): + def __init__(self): + self.done = set() + + def type_of(self, node): + while( not isinstance(node.type, c_ast.TypeDecl) ): + node = node.type + return node.type.type.name + + def visit_Decl(self, node): + name = node.name + if name in self.done: + return + self.done.add(name) + + params = [] + cbl_args = [] + linkage_items = [] + string_items = [] + returns = '???' + + if False and isinstance(node.type, c_ast.FuncDecl): + function_decl = node.type + print('Function: %s' % node.name) + if( node.type.args == None ): + print(' (no arguments)') + else: + for param_decl in node.type.args.params: + if( isinstance(param_decl, c_ast.EllipsisParam) ): + param_decl.show(offset=6) + continue + print(' Arg name: %s' % param_decl.name) + print(' Type:') + param_decl.type.show(offset=6) + + if isinstance(node.type, c_ast.FuncDecl): + args = node.type.args + if isinstance(args, c_ast.ParamList): + #rint("params are %s (type %s)" % (str(args.params), type(args.params))) + if( args == None ): + params.append('') + else: + for (i, param) in enumerate(args.params): + params.append(parameter_str(i, name, param)) + cbl_args.append(using_str(i, name, param)) + (stars, item, definition) = linkage_str(i, name, param) + if definition: + if stars: + string_items.append(item) + linkage_items.append(definition) + + (stars, rets) = starify(node.type) + + if isinstance(rets, c_ast.TypeDecl): + q = ' '.join(rets.quals) + if( isinstance(rets.type, c_ast.Struct) ): + t = "struct " + rets.type.name + else: + t = ' '.join(rets.type.names) + returns = ' '.join((q, t, stars)) + + if name == None: + return + + # print the C version as a comment + cparams = [ x.replace('Lk-', '') for x in params ] + print( " * %s %s(%s)" + % (returns, name, ', '.join(cparams)) ) + + # print the UDF + print( ' Identification Division.') + sname = name + if( sname[0] == '_' ): + sname = sname[1:] + print( ' Function-ID. posix-%s.' % sname) + + print( ' Data Division.') + print( ' Linkage Section.') + print( ' 77 Return-Value Binary-Long.') + for item in linkage_items: + print( ' %s.' % item.strip()) + args = ',\n '.join(cbl_args) + args = 'using\n %s\n ' % args + print( ' Procedure Division %s Returning Return-Value.' + % args ) + for item in string_items: + print( ' Inspect Backward %s ' % item + + 'Replacing Leading Space By Low-Value' ) + using_args = '' + if args: + using_args = '%s' % args + print( ' Call "%s" %s Returning Return-Value.' + % (name, using_args) ) + print( ' Goback.') + print( ' End Function posix-%s.' % sname) + +# Hard code a path to the fake includes +# if not using cpp(1) environment variables. +cpp_args = ['-I/home/jklowden/projects/3rd/pycparser/utils/fake_libc_include'] + +for var in ('CPATH', 'C_INCLUDE_PATH'): + dir = os.getenv(var) + if dir: + cpp_args = '' + +def process(srcfile): + ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args) + # print(c_generator.CGenerator().visit(ast)) + v = VisitPrototypes() + v.visit(ast) + +__doc__ = """ +SYNOPSIS + udf-gen [-I include-path] [header-file ...] + +DESCRIPTION + For each C function declared in header-file, +produce an ISO COBOL user-defined function definition to call it. +If no filename is supplied, declarations are read from standard input. +All output is written to standard output. + + This Python script uses the PLY pycparser module, +(http://www.dabeaz.com/ply/), which supplies a set of simplified "fake +header files" to avoid parsing the (very complex) standard C header +files. These alost suffice for parsing the Posix function +declarations in Section 2 of the manual. + + Use the -I option or the cpp(1) environment variables to direct +the preprocessor to use the fake header files instead of the system +header files. + +LIMITATIONS + udf-gen does not recognize C struct parameters, such as used by stat(2). + + No attempt has been made to define "magic" values, such as would +be needed for example by chmod(2). +""" + +def main( argv=None ): + global cpp_args + if argv is None: + argv = sys.argv + # parse command line options + try: + opts, args = getopt.getopt(sys.argv[1:], "D:hI:m:", ["help"]) + except getopt.error as msg: + print(msg) + print("for help use --help") + sys.exit(2) + + # process options + astfile = None + + for opt, arg in opts: + if opt in ("-h", "--help"): + print(__doc__) + sys.exit(0) + if opt == '-D': + cpp_args.append('-D%s ' % arg) + if opt == '-I': + cpp_args[0] = '-I' + arg + + # process arguments + if not args: + args = ('/dev/stdin',) + + for arg in args: + process(arg) + +if __name__ == "__main__": + sys.exit(main()) diff --git a/libgcobol/posix/cpy/posix-errno.cbl b/libgcobol/posix/cpy/posix-errno.cbl new file mode 100644 index 000000000000..3fd897f8511c --- /dev/null +++ b/libgcobol/posix/cpy/posix-errno.cbl @@ -0,0 +1,27 @@ + >> PUSH source format + >>SOURCE format is fixed + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This function is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025. + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + Identification Division. + Function-ID. posix-errno. + + Data Division. + Linkage Section. + 77 Return-Value Binary-Long. + 01 Error-Msg PIC X ANY LENGTH. + + Procedure Division + using Error-Msg + Returning Return-Value. + CALL "posix_errno" + returning Return-Value. + CALL "strerror" + using by value Return-Value + returning error-msg. + Goback. + END FUNCTION posix-errno. + >> POP source format diff --git a/libgcobol/posix/cpy/statbuf.cpy b/libgcobol/posix/cpy/statbuf.cpy new file mode 100644 index 000000000000..0500385fb271 --- /dev/null +++ b/libgcobol/posix/cpy/statbuf.cpy @@ -0,0 +1,22 @@ + >> PUSH source format + >>SOURCE format is fixed + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This stat(2) buffer definition is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025. + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + 05 st_dev Usage is Binary-Double Unsigned. + 05 st_ino Usage is Binary-Double Unsigned. + 05 st_mode Usage is Binary-Double Unsigned. + 05 st_nlink Usage is Binary-Double Unsigned. + 05 st_uid Usage is Binary-Double Unsigned. + 05 st_gid Usage is Binary-Double Unsigned. + 05 st_rdev Usage is Binary-Double Unsigned. + 05 st_size Usage is Binary-Double Unsigned. + 05 st_blksize Usage is Binary-Double Unsigned. + 05 st_blocks Usage is Binary-Double Unsigned. + 05 st_atime Usage is Binary-Double Unsigned. + 05 st_mtime Usage is Binary-Double Unsigned. + 05 st_ctime Usage is Binary-Double Unsigned. + >> POP source format diff --git a/libgcobol/posix/cpy/tm.cpy b/libgcobol/posix/cpy/tm.cpy new file mode 100644 index 000000000000..05a8545fe86a --- /dev/null +++ b/libgcobol/posix/cpy/tm.cpy @@ -0,0 +1,27 @@ + >> PUSH source format + >>SOURCE format is fixed + + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This function is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025. + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + 02 tm_sec Usage is Binary-Long. + 02 tm_min Usage is Binary-Long. + 02 tm_hour Usage is Binary-Long. + 02 tm_mday Usage is Binary-Long. + 02 tm_mon Usage is Binary-Long. + 02 tm_year Usage is Binary-Long. + 02 tm_wday Usage is Binary-Long. + 02 tm_yday Usage is Binary-Long. + 02 tm_isdst Usage is Binary-Long. + >> POP source format + + + + + + + + + diff --git a/libgcobol/posix/errno.cc b/libgcobol/posix/shim/errno.cc similarity index 100% rename from libgcobol/posix/errno.cc rename to libgcobol/posix/shim/errno.cc diff --git a/libgcobol/posix/localtime.cc b/libgcobol/posix/shim/localtime.cc similarity index 100% rename from libgcobol/posix/localtime.cc rename to libgcobol/posix/shim/localtime.cc diff --git a/libgcobol/posix/shim/stat.cc b/libgcobol/posix/shim/stat.cc new file mode 100644 index 000000000000..7d2613a03c30 --- /dev/null +++ b/libgcobol/posix/shim/stat.cc @@ -0,0 +1,80 @@ +#include <assert.h> +#include <stddef.h> +#include <stdio.h> +#include <unistd.h> + +#include <sys/types.h> +#include <sys/stat.h> + +#define offsetof(TYPE, MEMBER) __builtin_offsetof (TYPE, MEMBER) + +extern "C" { + +#include "stat.h" + +#define offset_assert(name, offset) do { \ + if( offsetof(posix_stat_t, name) != offset ) { \ + fprintf(stderr, "C posix_stat_t offset for %s %zu != COBOL offset %d\n", \ + #name, offsetof(posix_stat_t, name), offset); \ + assert(offsetof(posix_stat_t, name) == offset); \ + } \ + } while(false); + +int +posix_stat(const char *pathname, posix_stat_t *statbuf, size_t size) { + struct stat sb; + int erc = stat(pathname, &sb); + + if( sizeof(posix_stat_t) != size ) { + fprintf(stderr, "%s:%d: %lu != received size %lu\n", __func__, __LINE__, + (unsigned long)sizeof(struct posix_stat_t), + (unsigned long)size); + fflush(stdout); + fflush(stderr); + } + if( statbuf == nullptr ) { + fprintf(stderr, "%s:%d: received NULL statbuf\n", __func__, __LINE__); + fflush(stdout); + fflush(stderr); + } + + if( true ) { // Verify last known reported COBOL offsets agree with C offsets. + offset_assert( st_dev, 0 ); + offset_assert( st_ino , 8 ); + offset_assert( st_mode , 16 ); + offset_assert( st_nlink , 24 ); + offset_assert( st_uid , 32 ); + offset_assert( st_gid , 40 ); + offset_assert( st_rdev , 48 ); + offset_assert( st_size , 56 ); + offset_assert( st_blksize , 64 ); + offset_assert( st_blocks , 72 ); + offset_assert( psx_atime , 80 ); + offset_assert( psx_mtime , 88 ); + offset_assert( psx_ctime , 96 ); + } + + assert(statbuf); + + if( erc == 0 ) { + statbuf->st_dev = sb.st_dev; + statbuf->st_ino = sb.st_ino; + statbuf->st_mode = sb.st_mode; + statbuf->st_nlink = sb.st_nlink; + statbuf->st_uid = sb.st_uid; + statbuf->st_gid = sb.st_gid; + statbuf->st_rdev = sb.st_rdev; + statbuf->st_size = sb.st_size; + statbuf->st_blksize = sb.st_blksize; + statbuf->st_blocks = sb.st_blocks; + statbuf->psx_atime = sb.st_atime; + statbuf->psx_mtime = sb.st_mtime; + statbuf->psx_ctime = sb.st_ctime; + } + + return erc; + + +} + +} // extern "C" diff --git a/libgcobol/posix/shim/stat.h b/libgcobol/posix/shim/stat.h new file mode 100644 index 000000000000..66f103aa9db5 --- /dev/null +++ b/libgcobol/posix/shim/stat.h @@ -0,0 +1,42 @@ +#include <cstdint> + +/* + * This buffer definition matches the one in libgcobol/posix/cpy/statbuf.cpy. + * It is shared between + * + * libgcobol/posix/udf/posix-stat.cbl + * and + * libgcobol/posix/shim/stat.cc + * + * stat.cc copies information from the OS-defined stat buffer to this one. + */ + +namespace cbl { + typedef uint64_t blkcnt_t; + typedef uint64_t blksize_t; + typedef uint64_t dev_t; + typedef uint64_t gid_t; + typedef uint64_t ino_t; + typedef uint64_t mode_t; + typedef uint64_t nlink_t; + typedef uint64_t off_t; + typedef uint64_t time_t; + typedef uint64_t uid_t; +}; + +struct posix_stat_t { + cbl::dev_t st_dev; /* ID of device containing file */ + cbl::ino_t st_ino; /* Inode number */ + cbl::mode_t st_mode; /* File type and mode */ + cbl::nlink_t st_nlink; /* Number of hard links */ + cbl::uid_t st_uid; /* User ID of owner */ + cbl::gid_t st_gid; /* Group ID of owner */ + cbl::dev_t st_rdev; /* Device ID (if special file) */ + cbl::off_t st_size; /* Total size, in bytes */ + cbl::blksize_t st_blksize; /* Block size for filesystem I/O */ + cbl::blkcnt_t st_blocks; /* Number of 512B blocks allocated */ + // Cannot use st_atime etc because they are defined in the preprocessor. + cbl::time_t psx_atime; /* Time of last access */ + cbl::time_t psx_mtime; /* Time of last modification */ + cbl::time_t psx_ctime; /* Time of last status change */ +}; diff --git a/libgcobol/posix/tm.h b/libgcobol/posix/shim/tm.h similarity index 100% rename from libgcobol/posix/tm.h rename to libgcobol/posix/shim/tm.h diff --git a/libgcobol/posix/stat.cc b/libgcobol/posix/stat.cc deleted file mode 100644 index fc34f7b2753d..000000000000 --- a/libgcobol/posix/stat.cc +++ /dev/null @@ -1,90 +0,0 @@ -#include <assert.h> -#include <stddef.h> -#include <stdio.h> -#include <unistd.h> - -#include <sys/types.h> -#include <sys/stat.h> - -extern "C" { - -#include "stat.h" - -int -posix_stat(const char *pathname, struct posix_stat_t *statbuf, size_t size) { - struct stat sb; - int erc = stat(pathname, &sb); - - if( sizeof(struct posix_stat_t) != size ) { - fprintf(stderr, "posix_stat %lu != received size %lu\n", - (unsigned long)sizeof(struct posix_stat_t), - (unsigned long)size); - } - - assert(sizeof(struct posix_stat_t) == size); - assert(statbuf); - - if( erc == 0 ) { - statbuf->st_dev = sb.st_dev; - statbuf->st_ino = sb.st_ino; - statbuf->st_mode = sb.st_mode; - statbuf->st_nlink = sb.st_nlink; - statbuf->st_uid = sb.st_uid; - statbuf->st_gid = sb.st_gid; - statbuf->st_rdev = sb.st_rdev; - statbuf->st_size = sb.st_size; - statbuf->st_blksize = sb.st_blksize; - statbuf->st_blocks = sb.st_blocks; - statbuf->st_atim = sb.st_atim.tv_sec; - statbuf->st_mtim = sb.st_mtim.tv_sec; - statbuf->st_ctim = sb.st_ctim.tv_sec; - } - - if( 0 ) { - printf("%4lu: st_dev: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_dev), - (unsigned long)statbuf->st_dev, (unsigned long)sb.st_dev); - printf("%4lu: st_ino: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_ino), - (unsigned long)statbuf->st_ino, (unsigned long)sb.st_ino); - printf("%4lu: st_mode: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_mode), - (unsigned long)statbuf->st_mode, (unsigned long)sb.st_mode); - printf("%4lu: st_nlink: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_nlink), - (unsigned long)statbuf->st_nlink, (unsigned long)sb.st_nlink); - printf("%4lu: st_uid: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_uid), - (unsigned long)statbuf->st_uid, (unsigned long)sb.st_uid); - printf("%4lu: st_gid: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_gid), - (unsigned long)statbuf->st_gid, (unsigned long)sb.st_gid); - printf("%4lu: st_rdev: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_rdev), - (unsigned long)statbuf->st_rdev, (unsigned long)sb.st_rdev); - printf("%4lu: st_size: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_size), - (unsigned long)statbuf->st_size, (unsigned long)sb.st_size); - printf("%4lu: st_blksize: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_blksize), - (unsigned long)statbuf->st_blksize, (unsigned long)sb.st_blksize); - printf("%4lu: st_blocks: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_blocks), - (unsigned long)statbuf->st_blocks, (unsigned long)sb.st_blocks); - printf("%4lu: st_atim: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_atim), - (unsigned long)statbuf->st_atim, (unsigned long)sb.st_atim.tv_sec); - printf("%4lu: st_mtim: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_mtim), - (unsigned long)statbuf->st_mtim, (unsigned long)sb.st_mtim.tv_sec); - printf("%4lu: st_ctim: %lu = %lu\n", - (unsigned long)offsetof(struct posix_stat_t, st_ctim), - (unsigned long)statbuf->st_ctim, (unsigned long)sb.st_ctim.tv_sec); - } - - return erc; - - -} - -} // extern "C" diff --git a/libgcobol/posix/stat.h b/libgcobol/posix/stat.h deleted file mode 100644 index 4def867c2b88..000000000000 --- a/libgcobol/posix/stat.h +++ /dev/null @@ -1,15 +0,0 @@ -struct posix_stat_t { - dev_t st_dev; /* ID of device containing file */ - ino_t st_ino; /* Inode number */ - mode_t st_mode; /* File type and mode */ - nlink_t st_nlink; /* Number of hard links */ - uid_t st_uid; /* User ID of owner */ - gid_t st_gid; /* Group ID of owner */ - dev_t st_rdev; /* Device ID (if special file) */ - off_t st_size; /* Total size, in bytes */ - blksize_t st_blksize; /* Block size for filesystem I/O */ - blkcnt_t st_blocks; /* Number of 512B blocks allocated */ - time_t st_atim; /* Time of last access */ - time_t st_mtim; /* Time of last modification */ - time_t st_ctim; /* Time of last status change */ -}; diff --git a/libgcobol/posix/t/Makefile b/libgcobol/posix/t/Makefile new file mode 100644 index 000000000000..2da74a7aee87 --- /dev/null +++ b/libgcobol/posix/t/Makefile @@ -0,0 +1,36 @@ +.SUFFIXES: .scr .cbl + +# +# Ensure UDFs compile and run without crashing. +# + +# COBCFLAGS is defined by the user + +COBC = gcobol +LDFLAGS = -L $$(pwd) -Wl,-rpath -Wl,$$(pwd) + +TESTS = errno exit localtime stat + +# Default target builds the tests +all: $(TESTS) + +% : %.cbl + $(COBC) -o $@ $(COBCFLAGS) -I. -I../cpy -I../udf $(LDFLAGS) $< + + +exit: ../udf/posix-exit.cbl + +errno: ../udf/posix-mkdir.cbl + +stat: ../udf/posix-stat.cbl + +localtime: ../udf/posix-stat.cbl + +# Run the tests +test: $(TESTS) + @$(foreach P,$(TESTS),echo $(P):; ./$(P);) + +clean: + rm -f *.o $(basename $(wildcard *.cbl)) + + diff --git a/libgcobol/posix/t/errno.cbl b/libgcobol/posix/t/errno.cbl new file mode 100644 index 000000000000..52eceabc0f81 --- /dev/null +++ b/libgcobol/posix/t/errno.cbl @@ -0,0 +1,31 @@ + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This program is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + COPY posix-mkdir. + COPY posix-errno. + + Identification Division. + Program-ID. test-errno. + Data Division. + Working-Storage Section. + 77 Return-Value Binary-Long. + 77 Exit-Status Binary-Long Value 1. + 77 error-msg PIC X(100). + 77 errnum Binary-Long. + 77 Filename PIC X(100) Value '/'. + + Procedure Division. + Display 'calling posix-mkdir with a foolish name ...' + Move Function posix-mkdir(Filename, 0) to Return-Value. + If Return-Value <> 0 + Display 'calling posix-errno ...' + Move Function posix-errno(error-msg) to errnum + Display 'error: "' Filename '": ' error-msg ' (' errnum ')' + Goback with Error Status errnum + Else + Display 'Return-Value is ' Return-Value + End-If. + + Goback. diff --git a/libgcobol/posix/t/exit.cbl b/libgcobol/posix/t/exit.cbl new file mode 100644 index 000000000000..18d0a2a183ea --- /dev/null +++ b/libgcobol/posix/t/exit.cbl @@ -0,0 +1,20 @@ + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This program is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + COPY posix-exit. + + Identification Division. + Program-ID. test-exit. + Data Division. + Working-Storage Section. + 77 Return-Value Binary-Long. + 77 Exit-Status Binary-Long Value 1. + + Procedure Division. + Display 'calling posix-exit ...' + Move Function posix-exit(Exit-Status) to Return-Value. + * Does not return, Does not print + Display 'How did we get here?' + Goback. diff --git a/libgcobol/posix/t/localtime.cbl b/libgcobol/posix/t/localtime.cbl new file mode 100644 index 000000000000..9017a09486c6 --- /dev/null +++ b/libgcobol/posix/t/localtime.cbl @@ -0,0 +1,52 @@ + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This program is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + * Include the posix-stat and posix-localtime functions. + COPY posix-stat. + COPY posix-localtime. + COPY posix-errno. + + Identification Division. + Program-ID. test-localtime. + Data Division. + Working-Storage Section. + 77 Return-Value Usage Binary-Long. + 77 Stat-Status Usage Binary-Long Value 1. + 77 Filename Pic x(80) Value 'Makefile'. + 77 Msg Pic x(100). + 01 Lk-statbuf. + COPY statbuf. + 01 Lk-tm. + COPY tm. + 01 Today. + 02 tm_year PIC 9999. + 02 tm_mon PIC 99. + 02 tm_wday PIC 99. + + Procedure Division. + Display 'calling posix-stat for ' Function Trim(Filename) ' ...' + Move Function posix-stat(Filename, lk-statbuf) to Return-Value. + Display 'posix-stat returned: ' Return-Value. + If Return-Value < 0 then + Display Function Trim(Filename) ': ' + 'errno ', Function posix-errno(Msg), ': ' Msg + Goback. + + Display 'calling posix-localtime ...' + Move Function posix-localtime(st_mtime, lk-tm) to Return-Value. + Display 'posix-localtime returned: ' Return-Value. + If Return-Value < 0 then + Display 'posix-localtime: ', Function Trim(Filename) ': ' + 'errno ', Function posix-errno(Msg), ': ' Msg + ' (st_mtime ' st_mtime ')' + Goback. + Move Corresponding Lk-tm to Today. + Add 1900 to tm_year of Today. + Display "'" Function trim(Filename) "'" + ' (st_mtime ' st_mtime ') modified ' + tm_year of Today '-' + tm_mon of Today '-' + tm_wday of Today. + Goback. diff --git a/libgcobol/posix/t/stat.cbl b/libgcobol/posix/t/stat.cbl new file mode 100644 index 000000000000..822140a5d6b2 --- /dev/null +++ b/libgcobol/posix/t/stat.cbl @@ -0,0 +1,29 @@ + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This program is in the public domain. + * Contributed by James K. Lowden of Cobolworx in October 2025 + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + + * Include the posix-stat function + COPY posix-stat. + COPY posix-errno. + + Identification Division. + Program-ID. test-stat. + Data Division. + Working-Storage Section. + 77 Return-Value Usage Binary-Long. + 77 Stat-Status Usage Binary-Long Value 1. + 77 Filename Pic x(80) Value 'Makefile'. + 77 Msg Pic x(100). + 01 Lk-statbuf. + COPY statbuf. + + Procedure Division. + Display 'calling posix-stat ...' + Move Function posix-stat(Filename, lk-statbuf) to Return-Value. + Display 'posix-stat return value:' Return-Value. + If Return-Value < 0 then + Display Function Trim(Filename) ': ' + 'errno ', Function posix-errno(Msg), ': ' Msg. + + Goback. diff --git a/libgcobol/posix/udf/posix-exit.cbl b/libgcobol/posix/udf/posix-exit.cbl new file mode 100644 index 000000000000..cd2ac1857e9f --- /dev/null +++ b/libgcobol/posix/udf/posix-exit.cbl @@ -0,0 +1,12 @@ + Identification Division. + Function-ID. posix-exit. + + Data Division. + Linkage Section. + 77 Return-Value Binary-Long. + 77 Exit-Status Binary-Long. + + Procedure Division using Exit-Status Returning Return-Value. + CALL "_exit" using by value Exit-Status. + Goback. + END FUNCTION posix-exit. \ No newline at end of file diff --git a/libgcobol/posix/udf/posix-localtime.cbl b/libgcobol/posix/udf/posix-localtime.cbl new file mode 100644 index 000000000000..3c5ab48a2d5c --- /dev/null +++ b/libgcobol/posix/udf/posix-localtime.cbl @@ -0,0 +1,35 @@ + * int stat(const char * pathname, struct stat * statbuf) + Identification Division. + Function-ID. posix-localtime. + Data Division. + Working-Storage Section. + 77 bufsize Usage Binary-Long. + 77 Tm-pointer Usage Pointer. + 01 Lk-tm-posix Based. + COPY tm. + Linkage Section. + 77 Return-Value Usage Binary-Long. + 01 Lk-timep Usage Binary-Long. + 01 Lk-tm. + COPY tm. + + Procedure Division using + By Reference Lk-timep, + By Reference Lk-tm, + Returning Return-Value. + + Move Function Length(Lk-tm-posix) to bufsize. + Call "posix_localtime" using + By Reference Lk-timep, + By Value bufsize, + Returning tm-pointer. + + If tm-pointer = NULL + move -1 to Return-Value + Else + move 0 to Return-Value + set address of lk-tm-posix to tm-pointer + move lk-tm-posix to lk-tm. + + Goback. + End Function posix-localtime. diff --git a/libgcobol/posix/udf/posix-mkdir.cbl b/libgcobol/posix/udf/posix-mkdir.cbl new file mode 100644 index 000000000000..6de543ea957c --- /dev/null +++ b/libgcobol/posix/udf/posix-mkdir.cbl @@ -0,0 +1,21 @@ + Identification Division. + Function-ID. posix-mkdir. + Data Division. + Working-Storage Section. + 77 bufsize Usage Binary-Long. + Linkage Section. + 77 Return-Value Binary-Long. + 01 Lk-pathname PIC X ANY LENGTH. + 01 Lk-Mode Binary-Long. + + Procedure Division using + By Reference Lk-pathname, + By Value Lk-Mode, + Returning Return-Value. + Inspect Backward Lk-pathname Replacing Leading Space By Low-Value + Call "mkdir" using + By Reference Lk-pathname, + By Value Lk-Mode, + Returning Return-Value. + Goback. + End Function posix-mkdir. diff --git a/libgcobol/posix/udf/posix-stat.cbl b/libgcobol/posix/udf/posix-stat.cbl new file mode 100644 index 000000000000..dff54c872f4d --- /dev/null +++ b/libgcobol/posix/udf/posix-stat.cbl @@ -0,0 +1,62 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + * int stat(const char * pathname, struct stat * statbuf) + Identification Division. + Function-ID. posix-stat. + + Environment Division. + Configuration Section. + Source-Computer. Alpha-Romeo + >>IF DEBUGGING-MODE is Defined + With Debugging Mode + >>END-IF + . + + Data Division. + Working-Storage Section. + 77 bufsize Usage Binary-Long. + 77 Ws-pathname PIC X(8192). + Linkage Section. + 77 Return-Value Binary-Long. + 01 Lk-pathname PIC X ANY LENGTH. + 01 Lk-statbuf. + COPY statbuf. + + Procedure Division using + By Reference Lk-pathname, + By Reference Lk-statbuf, + Returning Return-Value. + + Move Lk-pathname To Ws-pathname. + Inspect Ws-pathname + Replacing Trailing Space By Low-Value + + Move Function Byte-Length(Lk-statbuf) to bufsize. + + D Display 'posix-stat: Ws-pathname ', Ws-pathname. + D Display 'posix-stat: Lk-statbuf has ', bufsize ' bytes'. + + Call "posix_stat" using Ws-pathname, Lk-statbuf + By Value bufsize + Returning Return-Value. + D Perform Show-Statbuf. + Goback. + + Show-Statbuf Section. + + Display 'st_dev: ' st_dev. + Display 'st_ino: ' st_ino. + Display 'st_mode: ' st_mode. + Display 'st_nlink: ' st_nlink. + Display 'st_uid: ' st_uid. + Display 'st_gid: ' st_gid. + Display 'st_rdev: ' st_rdev. + Display 'st_size: ' st_size. + Display 'st_blksize: ' st_blksize. + Display 'st_blocks: ' st_blocks. + Display 'st_atime: ' st_atime. + Display 'st_mtime: ' st_mtime. + Display 'st_ctime: ' st_ctime. + + End Function posix-stat. + >> POP SOURCE FORMAT diff --git a/libgcobol/posix/udf/posix-unlink.cbl b/libgcobol/posix/udf/posix-unlink.cbl new file mode 100644 index 000000000000..16dab3eebaac --- /dev/null +++ b/libgcobol/posix/udf/posix-unlink.cbl @@ -0,0 +1,32 @@ + >>PUSH SOURCE FORMAT + >>SOURCE FIXED + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * This function is in the public domain. + * Contributed by + * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + Identification Division. + Function-ID. posix-unlink. + Data Division. + Working-Storage Section. + 77 bufsize Usage Binary-Long. + 77 Ws-pathname PIC X(8192). + Linkage Section. + 77 Return-Value Binary-Long. + 01 Lk-pathname PIC X ANY LENGTH. + + Procedure Division using + By Reference Lk-pathname, + Returning Return-Value. + + Move Lk-pathname To Ws-pathname. + Inspect Ws-pathname + Replacing Trailing Space By Low-Value + + Inspect Backward Ws-pathname Replacing Leading Space, + - By Low-Value. + Call "unlink" using + By Reference Ws-pathname, + Returning Return-Value. + Goback. + End Function posix-unlink. + >> POP SOURCE FORMAT diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc index de4e6f7b35bd..00fa986bda5a 100644 --- a/libgcobol/valconv.cc +++ b/libgcobol/valconv.cc @@ -145,7 +145,7 @@ expand_picture(char *dest, const char *picture) *d++ = ch; } - if( __gg__currency_signs[ch] ) + if( ! __gg__currency_signs[ch].empty() ) { // We are going to be mapping ch to a string in the final result: prior_ch = ch; @@ -160,8 +160,9 @@ expand_picture(char *dest, const char *picture) if( currency_symbol ) { - size_t sign_length = strlen(__gg__currency_signs[currency_symbol]) - 1; - if( sign_length ) + size_t sign_length = __gg__currency_signs[currency_symbol].size(); + assert(0 < sign_length); + if( --sign_length ) { char *pcurrency = strchr(dest, currency_symbol); assert(pcurrency); @@ -279,10 +280,10 @@ __gg__string_to_numeric_edited( char * const dest, for(int i=0; i<dlength; i++) { int ch = (unsigned int)dest[i] & 0xFF; - if( __gg__currency_signs[ch] ) + if( ! __gg__currency_signs[ch].empty() ) { currency_picture = ch; - currency_sign = __gg__currency_signs[ch]; + currency_sign = __gg__currency_signs[ch].c_str(); break; } } @@ -1276,23 +1277,18 @@ __gg__string_to_alpha_edited( char *dest, extern "C" void -__gg__currency_sign_init() +__gg__currency_sign_init() // This duplicates the constructor. { - for(int symbol=0; symbol<256; symbol++) - { - if( __gg__currency_signs[symbol] ) - { - free(__gg__currency_signs[symbol]); - __gg__currency_signs[symbol] = NULL; - } - } + for( auto str : __gg__currency_signs ) { + str.clear(); + } } extern "C" void __gg__currency_sign(int symbol, const char *sign) { - __gg__currency_signs[symbol] = strdup(sign); + __gg__currency_signs[symbol] = sign; __gg__default_currency_sign = *sign; } diff --git a/libgcobol/xmlparse.cc b/libgcobol/xmlparse.cc index d89d48022c07..19524307d245 100644 --- a/libgcobol/xmlparse.cc +++ b/libgcobol/xmlparse.cc @@ -408,7 +408,6 @@ static void fatalError(void * CTX, const char * msg, ...) } #if 0 - static xmlEntityPtr getEntity(void * CTX, const xmlChar * name) { SAYSO_DATAZ(name); } @@ -618,6 +617,7 @@ xmlchar_of( const char input[] ) { static const char * xmlParserErrors_str( xmlParserErrors erc, const char name[] ) { const char *msg = "???"; + switch( erc ) { case XML_ERR_OK: msg = "Success"; @@ -675,7 +675,8 @@ static class context_t { /* Avoid a NULL entry. */ static const char * const ident = "unnamed_COBOL_program"; #endif - // TODO: Program to set option in library via command-line and/or environment. + // TODO: Program to set option in library via command-line and/or + // environment. // Library listens to program, not to the environment. openlog(ident, option, facility); @@ -683,7 +684,9 @@ static class context_t { } void - push( cblc_field_t *input_field, size_t input_offset, size_t len, bool done ) { + push( const cblc_field_t *input_field, + size_t input_offset, + size_t len, bool done ) { if( ! ctxt ) { init(); } @@ -712,7 +715,6 @@ static class context_t { } } - protected: void init() { const char *external_entities = nullptr; @@ -724,7 +726,7 @@ static class context_t { } context; static int -xml_push_parse( cblc_field_t *input_field, +xml_push_parse( const cblc_field_t *input_field, size_t input_offset, size_t len, cblc_field_t *encoding __attribute__ ((unused)),
