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 );
+
}
%{
}
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 */
// cppcheck-suppress returnTempReference
return verify_integer(loc, *this) ? *this : zero;
}
+
+
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];
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,
__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",
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),
| 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 '.'
;
}
;
-collations: %empty
+object_computer: %empty
| char_classification
| collating_sequence
| char_classification collating_sequence
}
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
{
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;
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 );
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 );
}
;
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);
#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 = {};
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[] ) {
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;
}
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);
__func__,
3 + cbl_field_type_str(field->type),
(fmt_size_t)isym, field->name, field->data.capacity);
+ gcc_unreachable();
}
}
return 0;
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
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.
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;
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 );
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 );
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] == '!';
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);
}
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 {
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 {
-// 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
{ "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
"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)
};
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 )
{
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;
--- /dev/null
+compat/t/*
+!compat/t/Makefile
+!compat/t/*.cbl
+posix/bin/sizeofs
+posix/t/*
+!posix/t/Makefile
+!posix/t/*.cbl
+posix/udf/*.scr
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
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)
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
# Written de novo for libgcobol.
+
VPATH = @srcdir@
am__is_gnu_make = { \
if test -z '$(MAKELEVEL)'; then \
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
$(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@)
*) (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,
# 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 \
@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)
@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
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
@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$$||'`;\
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
@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
-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
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"
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
info-am:
-install-data-am:
+install-data-am: install-nobase_libsubincludeHEADERS
install-dvi: install-dvi-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
ps-am:
-uninstall-am: uninstall-toolexeclibDATA \
- uninstall-toolexeclibLTLIBRARIES
+uninstall-am: uninstall-nobase_libsubincludeHEADERS \
+ uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
.MAKE: all install-am install-strip
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
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
#ifndef CHARMAPS_H
#define CHARMAPS_H
+#include <string>
+#include <vector>
+
#include <unistd.h>
/* There are four distinct codeset domains in the COBOL compiler.
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
charmap_t *__gg__get_charmap(cbl_encoding_t encoding);
-#endif
\ No newline at end of file
+#endif
--- /dev/null
+# 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`.
+
--- /dev/null
+ >>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
--- /dev/null
+ >>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
--- /dev/null
+ >>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
--- /dev/null
+ >>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
--- /dev/null
+#
+# 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) $^
+
+
+
--- /dev/null
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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
+
/* 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
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.
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.
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,
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 )
{
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
// 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 ;
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 ;
}
};
}
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"
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:
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
{
--- /dev/null
+# 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.
--- /dev/null
+#
+# 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 $@~ $@
--- /dev/null
+#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
--- /dev/null
+#! /usr/bin/awk -f
+
+/^UNIMPLEMENTED/ {
+ exit
+}
+
+/^DESCRIPTION/ {
+ exit
+}
+
+/struct sched_param {$/ {
+ exit
+}
+
+/SYNOPSIS/,/DESCRIPTION/ {
+ if( /([.][.]|[{},;]) *$/ ) {
+ print
+ }
+}
--- /dev/null
+#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;
+}
--- /dev/null
+#! /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())
--- /dev/null
+ >> 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
--- /dev/null
+ >> 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
--- /dev/null
+ >> 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
+
+
+
+
+
+
+
+
+
--- /dev/null
+#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"
--- /dev/null
+#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 */
+};
+++ /dev/null
-#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"
+++ /dev/null
-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 */
-};
--- /dev/null
+.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))
+
+
--- /dev/null
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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.
--- /dev/null
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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.
--- /dev/null
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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.
--- /dev/null
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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.
--- /dev/null
+ 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
--- /dev/null
+ * 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.
--- /dev/null
+ 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.
--- /dev/null
+ >>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
--- /dev/null
+ >>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
*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;
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);
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;
}
}
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;
}
}
#if 0
-
static xmlEntityPtr getEntity(void * CTX,
const xmlChar * name)
{ SAYSO_DATAZ(name); }
static const char *
xmlParserErrors_str( xmlParserErrors erc, const char name[] ) {
const char *msg = "???";
+
switch( erc ) {
case XML_ERR_OK:
msg = "Success";
/* 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);
}
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();
}
}
}
-
protected:
void init() {
const char *external_entities = nullptr;
} 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)),
projects / thirdparty / gcc.git / commitdiff
