git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

cobol: Introduce vendor-compatibility layer as user-defined functions. 

Install COBOL UDFs in a target directory that includes the GCC version
in its path, to permit side-by-side installation. Support compat
library with COBOL POSIX bindings; support those binding with C
functions in libgcobol as needed.

Changes to the compiler to support POSIX binding and testing.

Include developer conveniences -- Makefiles, bin/ and t/ directories --
to ensure UDFs compile and return reasonable results.  These are
not installed and do not affect how libgcobol is built.

gcc/cobol/ChangeLog:

	* cdf.y: Install literals in symbol table.
	* genapi.cc (parser_alphabet): Use std::string for currency.
	(initialize_the_data): Rely on constructor.
	(parser_file_add): Better #pragma message.
	(parser_exception_file): Return early if not generating code.
	* parse.y: Allow library programs to act as functions.
	* parse_ante.h (dialect_proscribed): Standardize message.
	(intrinsic_call_2): Correct s/fund/func/ misspelling.
	* scan.l: Comment.
	* symbols.cc (symbols_update): Add unreachable assertion.
	(symbol_field_parent_set): Reduce error to debug message.
	(cdf_literalize): Declare.
	(symbol_table_init): Insert CDF constants as literals.
	* symbols.h (cbl_dialect_str): Provide string values for enum.
	(is_working_storage): Remove function.
	(struct cbl_field_data_t): Add manhandle_initial for Numeric Edited.
	(struct cbl_field_t): Initialize name to zeros.
	(struct cbl_section_t): Delete unused attr() function.
	(symbol_unique_index): Declare.
	* token_names.h: Regenerate.
	* util.cc (cdf_literalize): Construct a cbl_field_t from a CDF literal.
	(symbol_unique_index): Supply "globally" unique number for a program.

libgcobol/ChangeLog:

	* Makefile.am: Move UDF-support to posix/shim, add install targets
	* Makefile.in: Regenerate
	* charmaps.cc (__gg__currency_signs): Use std::string.
	* charmaps.h: Include string and vector headers.
	(class charmap_t): Use std::string and vector for currency.
	* config.h.in: Regenerate.
	* configure: Regenerate.
	* configure.ac: Check for libxml2.
	* intrinsic.cc (numval_c): Constify.
	* libgcobol.cc (struct program_state): Use std::string and vector.
	(__gg__inspect_format_2): Add debug messages.
	* libgcobol.h (__gg__get_default_currency_string): Constify.
	* valconv.cc (expand_picture): Use std::string and vector.
	(__gg__string_to_numeric_edited): Use std::string and vector.
	(__gg__currency_sign_init): Use std::string and vector.
	(__gg__currency_sign): Use std::string and vector.
	* xmlparse.cc (xml_push_parse): Reformat.
	* posix/stat.cc: Removed.
	* posix/stat.h: Removed.
	* .gitignore: New file.
	* compat/README.md: New file.
	* compat/lib/gnu/CBL_ALLOC_MEM.cbl: New file.
	* compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl: New file.
	* compat/lib/gnu/CBL_DELETE_FILE.cbl: New file.
	* compat/lib/gnu/CBL_FREE_MEM.cbl: New file.
	* compat/t/Makefile: New file.
	* compat/t/smoke.cbl: New file.
	* posix/README.md: New file.
	* posix/bin/Makefile: New file for UDF-developer.
	* posix/bin/headers: New file.
	* posix/bin/scrape.awk: New file.
	* posix/bin/sizeofs.c: New file.
	* posix/bin/udf-gen: New file.
	* posix/cpy/posix-errno.cbl: New file.
	* posix/cpy/statbuf.cpy: New file.
	* posix/cpy/tm.cpy: New file.
	* posix/errno.cc: Removed.
	* posix/localtime.cc: Removed.
	* posix/shim/stat.cc: New file.
	* posix/shim/stat.h: New file.
	* posix/t/Makefile: New file.
	* posix/t/errno.cbl: New file.
	* posix/t/exit.cbl: New file.
	* posix/t/localtime.cbl: New file.
	* posix/t/stat.cbl: New file.
	* posix/tm.h: Removed.
	* posix/udf/posix-exit.cbl: New file.
	* posix/udf/posix-localtime.cbl: New file.
	* posix/udf/posix-mkdir.cbl: New file.
	* posix/udf/posix-stat.cbl: New file.
	* posix/udf/posix-unlink.cbl: New file.
This commit is contained in:
James K. Lowden 2025-11-12 17:48:34 -05:00
parent a784ed8dad
commit 08e9df2546
55 changed files with 2211 additions and 657 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/cobol/cdf.y
View File

@ -151,6 +151,9 @@ void input_file_status_notify();
cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs ); cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs );
cdfval_t negate( cdfval_base_t lhs ); cdfval_t negate( cdfval_base_t lhs );
cbl_field_t
cdf_literalize( const std::string& name, const cdfval_t& value );
} }
%{ %{
@ -353,6 +356,11 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override
} }
YYERROR; 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 | CDF_DEFINE cdf_constant NAME '=' cdf_expr[value] override
{ /* accept, but as error */ { /* accept, but as error */
@ -952,3 +960,5 @@ cdfval_base_t::operator()( const YDFLTYPE& loc ) {
// cppcheck-suppress returnTempReference // cppcheck-suppress returnTempReference
return verify_integer(loc, *this) ? *this : zero; return verify_integer(loc, *this) ? *this : zero;
} }

10
gcc/cobol/genapi.cc
View File

@ -5145,8 +5145,8 @@ parser_alphabet( const cbl_alphabet_t& alphabet )
case custom_encoding_e: case custom_encoding_e:
{ {
#pragma message "Use program-id to disambiguate" #pragma message "Verify program-id is disambiguated"
size_t alphabet_index = symbol_index(symbol_elem_of(&alphabet)); size_t alphabet_index = symbol_unique_index(symbol_elem_of(&alphabet));
unsigned char ach[256]; unsigned char ach[256];
@ -7166,7 +7166,6 @@ initialize_the_data()
build_int_cst_type(INT, current_encoding(national_encoding_e)), build_int_cst_type(INT, current_encoding(national_encoding_e)),
NULL_TREE); NULL_TREE);
__gg__currency_signs = __gg__ct_currency_signs;
// We initialize currency both at compile time and run time // We initialize currency both at compile time and run time
__gg__currency_sign_init(); __gg__currency_sign_init();
gg_call(VOID, gg_call(VOID,
@ -9911,8 +9910,8 @@ parser_file_add(struct cbl_file_t *file)
__func__); __func__);
} }
#pragma message "Use program-id to disambiguate" #pragma message "Verify program-id is disambiguated"
size_t symbol_table_index = symbol_index(symbol_elem_of(file)); size_t symbol_table_index = symbol_unique_index(symbol_elem_of(file));
gg_call(VOID, gg_call(VOID,
"__gg__file_init", "__gg__file_init",
@ -14608,6 +14607,7 @@ void
parser_exception_file( cbl_field_t *tgt, cbl_file_t *file) parser_exception_file( cbl_field_t *tgt, cbl_file_t *file)
{ {
Analyze(); Analyze();
RETURN_IF_PARSE_ONLY;
gg_call(VOID, gg_call(VOID,
"__gg__func_exception_file", "__gg__func_exception_file",
gg_get_address_of(tgt->var_decl_node), gg_get_address_of(tgt->var_decl_node),

27
gcc/cobol/parse.y
View File

@ -2397,7 +2397,7 @@ config_paragraph:
| SOURCE_COMPUTER '.' NAME '.' | SOURCE_COMPUTER '.' NAME '.'
| SOURCE_COMPUTER '.' NAME with_debug '.' | SOURCE_COMPUTER '.' NAME with_debug '.'
| OBJECT_COMPUTER '.' | OBJECT_COMPUTER '.'
| OBJECT_COMPUTER '.' NAME[computer] collations '.' | OBJECT_COMPUTER '.' NAME[computer] object_computer '.'
| REPOSITORY dot | REPOSITORY dot
| REPOSITORY dot repo_members '.' | REPOSITORY dot repo_members '.'
; ;
@ -2528,7 +2528,7 @@ with_debug: with DEBUGGING MODE {
} }
; ;
collations: %empty object_computer: %empty
| char_classification | char_classification
| collating_sequence | collating_sequence
| char_classification collating_sequence | char_classification collating_sequence
@ -4842,13 +4842,15 @@ value_clause: VALUE all LITERAL[lit] {
} }
if( $value != NULLS ) { if( $value != NULLS ) {
auto fig = constant_of(constant_index($value)); 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 | /* VALUE is */ NULLPTR
{ {
auto fig = constant_of(constant_index(NULLS)); 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 | VALUE error
{ {
@ -4938,10 +4940,13 @@ any_length: ANY LENGTH
if( field->attr & any_length_e ) { if( field->attr & any_length_e ) {
error_msg(@1, "ANY LENGTH already set"); 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 && if( ! (field->level == 1 &&
current_data_section == linkage_datasect_e && current_data_section == linkage_datasect_e &&
(1 < current.program_level() || (1 < current.program_level() ||
current.program()->is_function())) ) { current.program()->is_function() ||
is_compat)) ) {
error_msg(@1, "ANY LENGTH valid only for 01 " error_msg(@1, "ANY LENGTH valid only for 01 "
"in LINKAGE SECTION of a function or contained program"); "in LINKAGE SECTION of a function or contained program");
YYERROR; YYERROR;
@ -10338,11 +10343,13 @@ go_to: GOTO labels[args]
resume: RESUME NEXT STATEMENT resume: RESUME NEXT STATEMENT
{ {
statement_begin(@1, RESUME); statement_begin(@1, RESUME);
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
parser_clear_exception(); parser_clear_exception();
} }
| RESUME label_1[tgt] | RESUME label_1[tgt]
{ {
statement_begin(@1, RESUME); statement_begin(@1, RESUME);
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
parser_clear_exception(); parser_clear_exception();
$tgt->used = @1.first_line; $tgt->used = @1.first_line;
parser_goto( cbl_refer_t(), 1, &$tgt ); parser_goto( cbl_refer_t(), 1, &$tgt );
@ -10708,11 +10715,10 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
const auto returning = cbl_field_of(symbol_at(L->returning)); const auto returning = cbl_field_of(symbol_at(L->returning));
$$ = new_temporary_clone(returning); $$ = new_temporary_clone(returning);
$$->data.initial = returning->name; // user's name for the field $$->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); // Pretend hex-encoded because that means use verbatim.
cbl_field_t *name = new_literal(strlen(L->name), auto attr = cbl_field_attr_t(quoted_e | hex_encoded_e);
L->name, auto name = new_literal(strlen(L->name), L->name, attr);
call_attr);
ast_call( @1, name, $$, narg, args, NULL, NULL, true ); ast_call( @1, name, $$, narg, args, NULL, NULL, true );
} }
; ;
@ -12083,6 +12089,7 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returnin
name.field->data, 77 }; name.field->data, 77 };
called.attr |= name.field->attr; called.attr |= name.field->attr;
snprintf(called.name, sizeof(called.name), "_%s", name.field->data.initial); 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)); name.field = cbl_field_of(symbol_field_add(PROGRAM, &called));
symbol_field_location(field_index(name.field), loc); symbol_field_location(field_index(name.field), loc);
parser_symbol_add(name.field); parser_symbol_add(name.field);

24
gcc/cobol/parse_ante.h
View File

@ -111,6 +111,15 @@ extern int yydebug;
#include <cstdarg> #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 * const char *
consistent_encoding_check( const YYLTYPE& loc, const char input[] ) { consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
cbl_field_t faux = {}; cbl_field_t faux = {};
@ -180,6 +189,15 @@ has_clause( int data_clauses, data_clause_t clause ) {
return clause == (data_clauses & clause); return clause == (data_clauses & clause);
} }
static bool
dialect_proscribed( const YYLTYPE& loc, cbl_dialect_t dialect, const char msg[] ) {
if( dialect == cbl_dialects ) {
error_msg(loc, "dialect %s does not allow syntax: %qs",
cbl_dialect_str(dialect), msg);
return true;
}
return false;
}
static bool static bool
is_cobol_charset( const char name[] ) { is_cobol_charset( const char name[] ) {
@ -2521,9 +2539,9 @@ intrinsic_call_2( cbl_field_t *tgt, int token, const cbl_refer_t *r1, cbl_refer_
error_msg(args[n].loc, "invalid parameter '%s'", args[n].field->name); error_msg(args[n].loc, "invalid parameter '%s'", args[n].field->name);
return false; return false;
} }
const char *fund = intrinsic_cname(token); const char *func = intrinsic_cname(token);
if( !fund ) return false; if( !func ) return false;
parser_intrinsic_call_2( tgt, fund, args[0], args[1] ); parser_intrinsic_call_2( tgt, func, args[0], args[1] );
return true; return true;
} }

2
gcc/cobol/scan.l
View File

@ -572,7 +572,7 @@ REVERSED { return REVERSED; }
RETURN { return RETURN; } RETURN { return RETURN; }
RESTRICTED { return RESTRICTED; } RESTRICTED { return RESTRICTED; }
RESUME { RESUME { // RESUME is ISO syntax, not IBM.
if( ! dialect_ibm() ) return RESUME; if( ! dialect_ibm() ) return RESUME;
yylval.string = xstrdup(yytext); yylval.string = xstrdup(yytext);
return typed_name(yytext); return typed_name(yytext);

20
gcc/cobol/symbols.cc
View File

@ -1862,6 +1862,7 @@ symbols_update( size_t first, bool parsed_ok ) {
__func__, __func__,
3 + cbl_field_type_str(field->type), 3 + cbl_field_type_str(field->type),
(fmt_size_t)isym, field->name, field->data.capacity); (fmt_size_t)isym, field->name, field->data.capacity);
gcc_unreachable();
} }
} }
return 0; return 0;
@ -2187,12 +2188,9 @@ symbol_field_parent_set( cbl_field_t *field )
return NULL; return NULL;
} }
prior->type = FldGroup; prior->type = FldGroup;
prior->codeset.set(); if( ! prior->codeset.set() ) { // needs attention
//// if( ! prior->codeset.set() ) { // maybe just ignore? dbgmsg("'%s' is already National", prior->name);
//// Dubner sez: Ignore. This was triggering with -finternal-ebcdic }
//// ERROR_FIELD(prior, "%qs is already National", prior->name);
//// return NULL;
//// }
field->attr |= numeric_group_attrs(prior); field->attr |= numeric_group_attrs(prior);
} }
// verify level 88 domain value // verify level 88 domain value
@ -2250,6 +2248,8 @@ add_token( symbol_elem_t sym ) {
return sym; return sym;
} }
const std::list<cbl_field_t> cdf_literalize();
/* /*
* When adding special registers, be sure to create the actual cblc_field_t * When adding special registers, be sure to create the actual cblc_field_t
* in libgcobol/constants.cc. * in libgcobol/constants.cc.
@ -2455,6 +2455,14 @@ symbol_table_init(void) {
table.nelem = p - table.elems; table.nelem = p - table.elems;
assert(table.nelem < table.capacity); 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. // Initialize symbol table.
symbols = table; symbols = table;

49
gcc/cobol/symbols.h
View File

@ -57,6 +57,17 @@ enum cbl_dialect_t {
dialect_gnu_e = 0x04, 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. // Dialects may be combined.
extern unsigned int cbl_dialects; extern unsigned int cbl_dialects;
void cobol_dialect_set( cbl_dialect_t dialect ); void cobol_dialect_set( cbl_dialect_t dialect );
@ -143,11 +154,6 @@ const char * cbl_field_attr_str( cbl_field_attr_t attr );
cbl_field_attr_t literal_attr( const char prefix[] ); 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 ); int cbl_figconst_tok( const char *value );
enum cbl_figconst_t cbl_figconst_of( const char *value ); enum cbl_figconst_t cbl_figconst_of( const char *value );
const char * cbl_figconst_str( cbl_figconst_t fig ); const char * cbl_figconst_str( cbl_figconst_t fig );
@ -391,6 +397,26 @@ struct cbl_field_data_t {
return valify(); 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 { bool initial_within_capacity() const {
return initial[capacity] == '\0' return initial[capacity] == '\0'
|| initial[capacity] == '!'; || initial[capacity] == '!';
@ -630,7 +656,7 @@ struct cbl_field_t {
uint32_t level = 0, const cbl_name_t name = "", int line = 0 ) uint32_t level = 0, const cbl_name_t name = "", int line = 0 )
: offset(0), type(type), usage(FldInvalid), attr(attr) : offset(0), type(type), usage(FldInvalid), attr(attr)
, parent(0), our_index(0), level(level) , 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) , var_decl_node(nullptr), data_decl_node(nullptr)
{ {
gcc_assert(strlen(name) < sizeof this->name); gcc_assert(strlen(name) < sizeof this->name);
@ -1539,15 +1565,6 @@ struct cbl_section_t {
} }
gcc_unreachable(); 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 { struct cbl_locale_t {
@ -2273,6 +2290,8 @@ struct cbl_until_addresses_t {
size_t symbol_index(); // nth after first program symbol size_t symbol_index(); // nth after first program symbol
size_t symbol_index( const symbol_elem_t *e ); 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 symbol_elem_t * symbol_at( size_t index );
struct cbl_options_t { struct cbl_options_t {

816
gcc/cobol/token_names.h
View File

@ -1,5 +1,5 @@
// generated by /home/jklowden/projects/3rd/gcc/parser/gcc/cobol/token_names.h.gen cobol/parse.h // generated by ./token_names.h.gen ../../build/gcc/cobol/parse.h
// Mon Oct 20 14:11:39 EDT 2025 // Tue Nov 11 22:26:46 EST 2025
tokens = { tokens = {
{ "identification", IDENTIFICATION_DIV }, // 258 { "identification", IDENTIFICATION_DIV }, // 258
{ "environment", ENVIRONMENT_DIV }, // 259 { "environment", ENVIRONMENT_DIV }, // 259
@ -502,209 +502,210 @@ tokens = {
{ "reserve", RESERVE }, // 751 { "reserve", RESERVE }, // 751
{ "restricted", RESTRICTED }, // 752 { "restricted", RESTRICTED }, // 752
{ "resume", RESUME }, // 753 { "resume", RESUME }, // 753
{ "reverse", REVERSE }, // 754 { "retry", RETRY }, // 754
{ "reversed", REVERSED }, // 755 { "reverse", REVERSE }, // 755
{ "rewind", REWIND }, // 756 { "reversed", REVERSED }, // 756
{ "rf", RF }, // 757 { "rewind", REWIND }, // 757
{ "rh", RH }, // 758 { "rf", RF }, // 758
{ "right", RIGHT }, // 759 { "rh", RH }, // 759
{ "rounded", ROUNDED }, // 760 { "right", RIGHT }, // 760
{ "run", RUN }, // 761 { "rounded", ROUNDED }, // 761
{ "same", SAME }, // 762 { "run", RUN }, // 762
{ "screen", SCREEN }, // 763 { "same", SAME }, // 763
{ "sd", SD }, // 764 { "screen", SCREEN }, // 764
{ "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 765 { "sd", SD }, // 765
{ "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 766 { "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 766
{ "security", SECURITY }, // 767 { "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 767
{ "separate", SEPARATE }, // 768 { "security", SECURITY }, // 768
{ "sequence", SEQUENCE }, // 769 { "separate", SEPARATE }, // 769
{ "sequential", SEQUENTIAL }, // 770 { "sequence", SEQUENCE }, // 770
{ "sharing", SHARING }, // 771 { "sequential", SEQUENTIAL }, // 771
{ "simple-exit", SIMPLE_EXIT }, // 772 { "sharing", SHARING }, // 772
{ "sign", SIGN }, // 773 { "simple-exit", SIMPLE_EXIT }, // 773
{ "sin", SIN }, // 774 { "sign", SIGN }, // 774
{ "size", SIZE }, // 775 { "sin", SIN }, // 775
{ "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 776 { "size", SIZE }, // 776
{ "source", SOURCE }, // 777 { "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 777
{ "source-computer", SOURCE_COMPUTER }, // 778 { "source", SOURCE }, // 778
{ "special-names", SPECIAL_NAMES }, // 779 { "source-computer", SOURCE_COMPUTER }, // 779
{ "sqrt", SQRT }, // 780 { "special-names", SPECIAL_NAMES }, // 780
{ "stack", STACK }, // 781 { "sqrt", SQRT }, // 781
{ "standard", STANDARD }, // 782 { "stack", STACK }, // 782
{ "standard-1", STANDARD_1 }, // 783 { "standard", STANDARD }, // 783
{ "standard-deviation", STANDARD_DEVIATION }, // 784 { "standard-1", STANDARD_1 }, // 784
{ "standard-compare", STANDARD_COMPARE }, // 785 { "standard-deviation", STANDARD_DEVIATION }, // 785
{ "status", STATUS }, // 786 { "standard-compare", STANDARD_COMPARE }, // 786
{ "strong", STRONG }, // 787 { "status", STATUS }, // 787
{ "substitute", SUBSTITUTE }, // 788 { "strong", STRONG }, // 788
{ "sum", SUM }, // 789 { "substitute", SUBSTITUTE }, // 789
{ "symbol", SYMBOL }, // 790 { "sum", SUM }, // 790
{ "symbolic", SYMBOLIC }, // 791 { "symbol", SYMBOL }, // 791
{ "synchronized", SYNCHRONIZED }, // 792 { "symbolic", SYMBOLIC }, // 792
{ "tallying", TALLYING }, // 793 { "synchronized", SYNCHRONIZED }, // 793
{ "tan", TAN }, // 794 { "tallying", TALLYING }, // 794
{ "terminate", TERMINATE }, // 795 { "tan", TAN }, // 795
{ "test", TEST }, // 796 { "terminate", TERMINATE }, // 796
{ "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 797 { "test", TEST }, // 797
{ "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 798 { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 798
{ "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 799 { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 799
{ "test-numval", TEST_NUMVAL }, // 800 { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 800
{ "test-numval-c", TEST_NUMVAL_C }, // 801 { "test-numval", TEST_NUMVAL }, // 801
{ "test-numval-f", TEST_NUMVAL_F }, // 802 { "test-numval-c", TEST_NUMVAL_C }, // 802
{ "than", THAN }, // 803 { "test-numval-f", TEST_NUMVAL_F }, // 803
{ "time", TIME }, // 804 { "than", THAN }, // 804
{ "times", TIMES }, // 805 { "time", TIME }, // 805
{ "to", TO }, // 806 { "times", TIMES }, // 806
{ "top", TOP }, // 807 { "to", TO }, // 807
{ "top-level", TOP_LEVEL }, // 808 { "top", TOP }, // 808
{ "tracks", TRACKS }, // 809 { "top-level", TOP_LEVEL }, // 809
{ "track-area", TRACK_AREA }, // 810 { "tracks", TRACKS }, // 810
{ "trailing", TRAILING }, // 811 { "track-area", TRACK_AREA }, // 811
{ "transform", TRANSFORM }, // 812 { "trailing", TRAILING }, // 812
{ "trim", TRIM }, // 813 { "transform", TRANSFORM }, // 813
{ "true", TRUE_kw }, // 814 { "trim", TRIM }, // 814
{ "try", TRY }, // 815 { "true", TRUE_kw }, // 815
{ "turn", TURN }, // 816 { "try", TRY }, // 816
{ "type", TYPE }, // 817 { "turn", TURN }, // 817
{ "typedef", TYPEDEF }, // 818 { "type", TYPE }, // 818
{ "ulength", ULENGTH }, // 819 { "typedef", TYPEDEF }, // 819
{ "unbounded", UNBOUNDED }, // 820 { "ulength", ULENGTH }, // 820
{ "unit", UNIT }, // 821 { "unbounded", UNBOUNDED }, // 821
{ "units", UNITS }, // 822 { "unit", UNIT }, // 822
{ "unit-record", UNIT_RECORD }, // 823 { "units", UNITS }, // 823
{ "until", UNTIL }, // 824 { "unit-record", UNIT_RECORD }, // 824
{ "up", UP }, // 825 { "until", UNTIL }, // 825
{ "upon", UPON }, // 826 { "up", UP }, // 826
{ "upos", UPOS }, // 827 { "upon", UPON }, // 827
{ "upper-case", UPPER_CASE }, // 828 { "upos", UPOS }, // 828
{ "usage", USAGE }, // 829 { "upper-case", UPPER_CASE }, // 829
{ "using", USING }, // 830 { "usage", USAGE }, // 830
{ "usubstr", USUBSTR }, // 831 { "using", USING }, // 831
{ "usupplementary", USUPPLEMENTARY }, // 832 { "usubstr", USUBSTR }, // 832
{ "utility", UTILITY }, // 833 { "usupplementary", USUPPLEMENTARY }, // 833
{ "uuid4", UUID4 }, // 834 { "utility", UTILITY }, // 834
{ "uvalid", UVALID }, // 835 { "uuid4", UUID4 }, // 835
{ "uwidth", UWIDTH }, // 836 { "uvalid", UVALID }, // 836
{ "validating", VALIDATING }, // 837 { "uwidth", UWIDTH }, // 837
{ "value", VALUE }, // 838 { "validating", VALIDATING }, // 838
{ "variance", VARIANCE }, // 839 { "value", VALUE }, // 839
{ "varying", VARYING }, // 840 { "variance", VARIANCE }, // 840
{ "volatile", VOLATILE }, // 841 { "varying", VARYING }, // 841
{ "when-compiled", WHEN_COMPILED }, // 842 { "volatile", VOLATILE }, // 842
{ "with", WITH }, // 843 { "when-compiled", WHEN_COMPILED }, // 843
{ "working-storage", WORKING_STORAGE }, // 844 { "with", WITH }, // 844
{ "year-to-yyyy", YEAR_TO_YYYY }, // 845 { "working-storage", WORKING_STORAGE }, // 845
{ "yyyyddd", YYYYDDD }, // 846 { "year-to-yyyy", YEAR_TO_YYYY }, // 846
{ "yyyymmdd", YYYYMMDD }, // 847 { "yyyyddd", YYYYDDD }, // 847
{ "arithmetic", ARITHMETIC }, // 848 { "yyyymmdd", YYYYMMDD }, // 848
{ "attribute", ATTRIBUTE }, // 849 { "arithmetic", ARITHMETIC }, // 849
{ "auto", AUTO }, // 850 { "attribute", ATTRIBUTE }, // 850
{ "automatic", AUTOMATIC }, // 851 { "auto", AUTO }, // 851
{ "away-from-zero", AWAY_FROM_ZERO }, // 852 { "automatic", AUTOMATIC }, // 852
{ "background-color", BACKGROUND_COLOR }, // 853 { "away-from-zero", AWAY_FROM_ZERO }, // 853
{ "bell", BELL }, // 854 { "background-color", BACKGROUND_COLOR }, // 854
{ "binary-encoding", BINARY_ENCODING }, // 855 { "bell", BELL }, // 855
{ "blink", BLINK }, // 856 { "binary-encoding", BINARY_ENCODING }, // 856
{ "capacity", CAPACITY }, // 857 { "blink", BLINK }, // 857
{ "center", CENTER }, // 858 { "capacity", CAPACITY }, // 858
{ "classification", CLASSIFICATION }, // 859 { "center", CENTER }, // 859
{ "cycle", CYCLE }, // 860 { "classification", CLASSIFICATION }, // 860
{ "decimal-encoding", DECIMAL_ENCODING }, // 861 { "cycle", CYCLE }, // 861
{ "entry-convention", ENTRY_CONVENTION }, // 862 { "decimal-encoding", DECIMAL_ENCODING }, // 862
{ "eol", EOL }, // 863 { "entry-convention", ENTRY_CONVENTION }, // 863
{ "eos", EOS }, // 864 { "eol", EOL }, // 864
{ "erase", ERASE }, // 865 { "eos", EOS }, // 865
{ "expands", EXPANDS }, // 866 { "erase", ERASE }, // 866
{ "float-binary", FLOAT_BINARY }, // 867 { "expands", EXPANDS }, // 867
{ "float-decimal", FLOAT_DECIMAL }, // 868 { "float-binary", FLOAT_BINARY }, // 868
{ "foreground-color", FOREGROUND_COLOR }, // 869 { "float-decimal", FLOAT_DECIMAL }, // 869
{ "forever", FOREVER }, // 870 { "foreground-color", FOREGROUND_COLOR }, // 870
{ "full", FULL }, // 871 { "forever", FOREVER }, // 871
{ "highlight", HIGHLIGHT }, // 872 { "full", FULL }, // 872
{ "high-order-left", HIGH_ORDER_LEFT }, // 873 { "highlight", HIGHLIGHT }, // 873
{ "high-order-right", HIGH_ORDER_RIGHT }, // 874 { "high-order-left", HIGH_ORDER_LEFT }, // 874
{ "ignoring", IGNORING }, // 875 { "high-order-right", HIGH_ORDER_RIGHT }, // 875
{ "implements", IMPLEMENTS }, // 876 { "ignoring", IGNORING }, // 876
{ "initialized", INITIALIZED }, // 877 { "implements", IMPLEMENTS }, // 877
{ "intermediate", INTERMEDIATE }, // 878 { "initialized", INITIALIZED }, // 878
{ "lc-all", LC_ALL_kw }, // 879 { "intermediate", INTERMEDIATE }, // 879
{ "lc-collate", LC_COLLATE_kw }, // 880 { "lc-all", LC_ALL_kw }, // 880
{ "lc-ctype", LC_CTYPE_kw }, // 881 { "lc-collate", LC_COLLATE_kw }, // 881
{ "lc-messages", LC_MESSAGES_kw }, // 882 { "lc-ctype", LC_CTYPE_kw }, // 882
{ "lc-monetary", LC_MONETARY_kw }, // 883 { "lc-messages", LC_MESSAGES_kw }, // 883
{ "lc-numeric", LC_NUMERIC_kw }, // 884 { "lc-monetary", LC_MONETARY_kw }, // 884
{ "lc-time", LC_TIME_kw }, // 885 { "lc-numeric", LC_NUMERIC_kw }, // 885
{ "lowlight", LOWLIGHT }, // 886 { "lc-time", LC_TIME_kw }, // 886
{ "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 887 { "lowlight", LOWLIGHT }, // 887
{ "nearest-even", NEAREST_EVEN }, // 888 { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 888
{ "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 889 { "nearest-even", NEAREST_EVEN }, // 889
{ "none", NONE }, // 890 { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 890
{ "normal", NORMAL }, // 891 { "none", NONE }, // 891
{ "numbers", NUMBERS }, // 892 { "normal", NORMAL }, // 892
{ "prefixed", PREFIXED }, // 893 { "numbers", NUMBERS }, // 893
{ "previous", PREVIOUS }, // 894 { "prefixed", PREFIXED }, // 894
{ "prohibited", PROHIBITED }, // 895 { "previous", PREVIOUS }, // 895
{ "relation", RELATION }, // 896 { "prohibited", PROHIBITED }, // 896
{ "required", REQUIRED }, // 897 { "relation", RELATION }, // 897
{ "reverse-video", REVERSE_VIDEO }, // 898 { "required", REQUIRED }, // 898
{ "rounding", ROUNDING }, // 899 { "reverse-video", REVERSE_VIDEO }, // 899
{ "seconds", SECONDS }, // 900 { "rounding", ROUNDING }, // 900
{ "secure", SECURE }, // 901 { "seconds", SECONDS }, // 901
{ "short", SHORT }, // 902 { "secure", SECURE }, // 902
{ "signed", SIGNED_kw }, // 903 { "short", SHORT }, // 903
{ "standard-binary", STANDARD_BINARY }, // 904 { "signed", SIGNED_kw }, // 904
{ "standard-decimal", STANDARD_DECIMAL }, // 905 { "standard-binary", STANDARD_BINARY }, // 905
{ "statement", STATEMENT }, // 906 { "standard-decimal", STANDARD_DECIMAL }, // 906
{ "step", STEP }, // 907 { "statement", STATEMENT }, // 907
{ "structure", STRUCTURE }, // 908 { "step", STEP }, // 908
{ "toward-greater", TOWARD_GREATER }, // 909 { "structure", STRUCTURE }, // 909
{ "toward-lesser", TOWARD_LESSER }, // 910 { "toward-greater", TOWARD_GREATER }, // 910
{ "truncation", TRUNCATION }, // 911 { "toward-lesser", TOWARD_LESSER }, // 911
{ "ucs-4", UCS_4 }, // 912 { "truncation", TRUNCATION }, // 912
{ "underline", UNDERLINE }, // 913 { "ucs-4", UCS_4 }, // 913
{ "unsigned", UNSIGNED_kw }, // 914 { "underline", UNDERLINE }, // 914
{ "utf-16", UTF_16 }, // 915 { "unsigned", UNSIGNED_kw }, // 915
{ "utf-8", UTF_8 }, // 916 { "utf-16", UTF_16 }, // 916
{ "xmlgenerate", XMLGENERATE }, // 917 { "utf-8", UTF_8 }, // 917
{ "xmlparse", XMLPARSE }, // 918 { "xmlgenerate", XMLGENERATE }, // 918
{ "address", ADDRESS }, // 919 { "xmlparse", XMLPARSE }, // 919
{ "end-accept", END_ACCEPT }, // 920 { "address", ADDRESS }, // 920
{ "end-add", END_ADD }, // 921 { "end-accept", END_ACCEPT }, // 921
{ "end-call", END_CALL }, // 922 { "end-add", END_ADD }, // 922
{ "end-compute", END_COMPUTE }, // 923 { "end-call", END_CALL }, // 923
{ "end-delete", END_DELETE }, // 924 { "end-compute", END_COMPUTE }, // 924
{ "end-display", END_DISPLAY }, // 925 { "end-delete", END_DELETE }, // 925
{ "end-divide", END_DIVIDE }, // 926 { "end-display", END_DISPLAY }, // 926
{ "end-evaluate", END_EVALUATE }, // 927 { "end-divide", END_DIVIDE }, // 927
{ "end-multiply", END_MULTIPLY }, // 928 { "end-evaluate", END_EVALUATE }, // 928
{ "end-perform", END_PERFORM }, // 929 { "end-multiply", END_MULTIPLY }, // 929
{ "end-read", END_READ }, // 930 { "end-perform", END_PERFORM }, // 930
{ "end-return", END_RETURN }, // 931 { "end-read", END_READ }, // 931
{ "end-rewrite", END_REWRITE }, // 932 { "end-return", END_RETURN }, // 932
{ "end-search", END_SEARCH }, // 933 { "end-rewrite", END_REWRITE }, // 933
{ "end-start", END_START }, // 934 { "end-search", END_SEARCH }, // 934
{ "end-string", END_STRING }, // 935 { "end-start", END_START }, // 935
{ "end-subtract", END_SUBTRACT }, // 936 { "end-string", END_STRING }, // 936
{ "end-unstring", END_UNSTRING }, // 937 { "end-subtract", END_SUBTRACT }, // 937
{ "end-write", END_WRITE }, // 938 { "end-unstring", END_UNSTRING }, // 938
{ "end-xml", END_XML }, // 939 { "end-write", END_WRITE }, // 939
{ "end-if", END_IF }, // 940 { "end-xml", END_XML }, // 940
{ "attributes", ATTRIBUTES }, // 941 { "end-if", END_IF }, // 941
{ "element", ELEMENT }, // 942 { "attributes", ATTRIBUTES }, // 942
{ "namespace", NAMESPACE }, // 943 { "element", ELEMENT }, // 943
{ "namespace-prefix", NAMESPACE_PREFIX }, // 944 { "namespace", NAMESPACE }, // 944
{ "nonnumeric", NONNUMERIC }, // 946 { "namespace-prefix", NAMESPACE_PREFIX }, // 945
{ "xml-declaration", XML_DECLARATION }, // 947 { "nonnumeric", NONNUMERIC }, // 947
{ "thru", THRU }, // 949 { "xml-declaration", XML_DECLARATION }, // 948
{ "through", THRU }, // 949 { "thru", THRU }, // 950
{ "or", OR }, // 950 { "through", THRU }, // 950
{ "and", AND }, // 951 { "or", OR }, // 951
{ "not", NOT }, // 952 { "and", AND }, // 952
{ "ne", NE }, // 953 { "not", NOT }, // 953
{ "le", LE }, // 954 { "ne", NE }, // 954
{ "ge", GE }, // 955 { "le", LE }, // 955
{ "pow", POW }, // 956 { "ge", GE }, // 956
{ "neg", NEG }, // 957 { "pow", POW }, // 957
{ "neg", NEG }, // 958
}; };
// cppcheck-suppress useInitializationList // cppcheck-suppress useInitializationList
@ -1205,206 +1206,207 @@ token_names = {
"RESERVE", // 493 (751) "RESERVE", // 493 (751)
"RESTRICTED", // 494 (752) "RESTRICTED", // 494 (752)
"RESUME", // 495 (753) "RESUME", // 495 (753)
"REVERSE", // 496 (754) "RETRY", // 496 (754)
"REVERSED", // 497 (755) "REVERSE", // 497 (755)
"REWIND", // 498 (756) "REVERSED", // 498 (756)
"RF", // 499 (757) "REWIND", // 499 (757)
"RH", // 500 (758) "RF", // 500 (758)
"RIGHT", // 501 (759) "RH", // 501 (759)
"ROUNDED", // 502 (760) "RIGHT", // 502 (760)
"RUN", // 503 (761) "ROUNDED", // 503 (761)
"SAME", // 504 (762) "RUN", // 504 (762)
"SCREEN", // 505 (763) "SAME", // 505 (763)
"SD", // 506 (764) "SCREEN", // 506 (764)
"SECONDS-FROM-FORMATTED-TIME", // 507 (765) "SD", // 507 (765)
"SECONDS-PAST-MIDNIGHT", // 508 (766) "SECONDS-FROM-FORMATTED-TIME", // 508 (766)
"SECURITY", // 509 (767) "SECONDS-PAST-MIDNIGHT", // 509 (767)
"SEPARATE", // 510 (768) "SECURITY", // 510 (768)
"SEQUENCE", // 511 (769) "SEPARATE", // 511 (769)
"SEQUENTIAL", // 512 (770) "SEQUENCE", // 512 (770)
"SHARING", // 513 (771) "SEQUENTIAL", // 513 (771)
"SIMPLE-EXIT", // 514 (772) "SHARING", // 514 (772)
"SIGN", // 515 (773) "SIMPLE-EXIT", // 515 (773)
"SIN", // 516 (774) "SIGN", // 516 (774)
"SIZE", // 517 (775) "SIN", // 517 (775)
"SMALLEST-ALGEBRAIC", // 518 (776) "SIZE", // 518 (776)
"SOURCE", // 519 (777) "SMALLEST-ALGEBRAIC", // 519 (777)
"SOURCE-COMPUTER", // 520 (778) "SOURCE", // 520 (778)
"SPECIAL-NAMES", // 521 (779) "SOURCE-COMPUTER", // 521 (779)
"SQRT", // 522 (780) "SPECIAL-NAMES", // 522 (780)
"STACK", // 523 (781) "SQRT", // 523 (781)
"STANDARD", // 524 (782) "STACK", // 524 (782)
"STANDARD-1", // 525 (783) "STANDARD", // 525 (783)
"STANDARD-DEVIATION", // 526 (784) "STANDARD-1", // 526 (784)
"STANDARD-COMPARE", // 527 (785) "STANDARD-DEVIATION", // 527 (785)
"STATUS", // 528 (786) "STANDARD-COMPARE", // 528 (786)
"STRONG", // 529 (787) "STATUS", // 529 (787)
"SUBSTITUTE", // 530 (788) "STRONG", // 530 (788)
"SUM", // 531 (789) "SUBSTITUTE", // 531 (789)
"SYMBOL", // 532 (790) "SUM", // 532 (790)
"SYMBOLIC", // 533 (791) "SYMBOL", // 533 (791)
"SYNCHRONIZED", // 534 (792) "SYMBOLIC", // 534 (792)
"TALLYING", // 535 (793) "SYNCHRONIZED", // 535 (793)
"TAN", // 536 (794) "TALLYING", // 536 (794)
"TERMINATE", // 537 (795) "TAN", // 537 (795)
"TEST", // 538 (796) "TERMINATE", // 538 (796)
"TEST-DATE-YYYYMMDD", // 539 (797) "TEST", // 539 (797)
"TEST-DAY-YYYYDDD", // 540 (798) "TEST-DATE-YYYYMMDD", // 540 (798)
"TEST-FORMATTED-DATETIME", // 541 (799) "TEST-DAY-YYYYDDD", // 541 (799)
"TEST-NUMVAL", // 542 (800) "TEST-FORMATTED-DATETIME", // 542 (800)
"TEST-NUMVAL-C", // 543 (801) "TEST-NUMVAL", // 543 (801)
"TEST-NUMVAL-F", // 544 (802) "TEST-NUMVAL-C", // 544 (802)
"THAN", // 545 (803) "TEST-NUMVAL-F", // 545 (803)
"TIME", // 546 (804) "THAN", // 546 (804)
"TIMES", // 547 (805) "TIME", // 547 (805)
"TO", // 548 (806) "TIMES", // 548 (806)
"TOP", // 549 (807) "TO", // 549 (807)
"TOP-LEVEL", // 550 (808) "TOP", // 550 (808)
"TRACKS", // 551 (809) "TOP-LEVEL", // 551 (809)
"TRACK-AREA", // 552 (810) "TRACKS", // 552 (810)
"TRAILING", // 553 (811) "TRACK-AREA", // 553 (811)
"TRANSFORM", // 554 (812) "TRAILING", // 554 (812)
"TRIM", // 555 (813) "TRANSFORM", // 555 (813)
"TRUE", // 556 (814) "TRIM", // 556 (814)
"TRY", // 557 (815) "TRUE", // 557 (815)
"TURN", // 558 (816) "TRY", // 558 (816)
"TYPE", // 559 (817) "TURN", // 559 (817)
"TYPEDEF", // 560 (818) "TYPE", // 560 (818)
"ULENGTH", // 561 (819) "TYPEDEF", // 561 (819)
"UNBOUNDED", // 562 (820) "ULENGTH", // 562 (820)
"UNIT", // 563 (821) "UNBOUNDED", // 563 (821)
"UNITS", // 564 (822) "UNIT", // 564 (822)
"UNIT-RECORD", // 565 (823) "UNITS", // 565 (823)
"UNTIL", // 566 (824) "UNIT-RECORD", // 566 (824)
"UP", // 567 (825) "UNTIL", // 567 (825)
"UPON", // 568 (826) "UP", // 568 (826)
"UPOS", // 569 (827) "UPON", // 569 (827)
"UPPER-CASE", // 570 (828) "UPOS", // 570 (828)
"USAGE", // 571 (829) "UPPER-CASE", // 571 (829)
"USING", // 572 (830) "USAGE", // 572 (830)
"USUBSTR", // 573 (831) "USING", // 573 (831)
"USUPPLEMENTARY", // 574 (832) "USUBSTR", // 574 (832)
"UTILITY", // 575 (833) "USUPPLEMENTARY", // 575 (833)
"UUID4", // 576 (834) "UTILITY", // 576 (834)
"UVALID", // 577 (835) "UUID4", // 577 (835)
"UWIDTH", // 578 (836) "UVALID", // 578 (836)
"VALIDATING", // 579 (837) "UWIDTH", // 579 (837)
"VALUE", // 580 (838) "VALIDATING", // 580 (838)
"VARIANCE", // 581 (839) "VALUE", // 581 (839)
"VARYING", // 582 (840) "VARIANCE", // 582 (840)
"VOLATILE", // 583 (841) "VARYING", // 583 (841)
"WHEN-COMPILED", // 584 (842) "VOLATILE", // 584 (842)
"WITH", // 585 (843) "WHEN-COMPILED", // 585 (843)
"WORKING-STORAGE", // 586 (844) "WITH", // 586 (844)
"YEAR-TO-YYYY", // 587 (845) "WORKING-STORAGE", // 587 (845)
"YYYYDDD", // 588 (846) "YEAR-TO-YYYY", // 588 (846)
"YYYYMMDD", // 589 (847) "YYYYDDD", // 589 (847)
"ARITHMETIC", // 590 (848) "YYYYMMDD", // 590 (848)
"ATTRIBUTE", // 591 (849) "ARITHMETIC", // 591 (849)
"AUTO", // 592 (850) "ATTRIBUTE", // 592 (850)
"AUTOMATIC", // 593 (851) "AUTO", // 593 (851)
"AWAY-FROM-ZERO", // 594 (852) "AUTOMATIC", // 594 (852)
"BACKGROUND-COLOR", // 595 (853) "AWAY-FROM-ZERO", // 595 (853)
"BELL", // 596 (854) "BACKGROUND-COLOR", // 596 (854)
"BINARY-ENCODING", // 597 (855) "BELL", // 597 (855)
"BLINK", // 598 (856) "BINARY-ENCODING", // 598 (856)
"CAPACITY", // 599 (857) "BLINK", // 599 (857)
"CENTER", // 600 (858) "CAPACITY", // 600 (858)
"CLASSIFICATION", // 601 (859) "CENTER", // 601 (859)
"CYCLE", // 602 (860) "CLASSIFICATION", // 602 (860)
"DECIMAL-ENCODING", // 603 (861) "CYCLE", // 603 (861)
"ENTRY-CONVENTION", // 604 (862) "DECIMAL-ENCODING", // 604 (862)
"EOL", // 605 (863) "ENTRY-CONVENTION", // 605 (863)
"EOS", // 606 (864) "EOL", // 606 (864)
"ERASE", // 607 (865) "EOS", // 607 (865)
"EXPANDS", // 608 (866) "ERASE", // 608 (866)
"FLOAT-BINARY", // 609 (867) "EXPANDS", // 609 (867)
"FLOAT-DECIMAL", // 610 (868) "FLOAT-BINARY", // 610 (868)
"FOREGROUND-COLOR", // 611 (869) "FLOAT-DECIMAL", // 611 (869)
"FOREVER", // 612 (870) "FOREGROUND-COLOR", // 612 (870)
"FULL", // 613 (871) "FOREVER", // 613 (871)
"HIGHLIGHT", // 614 (872) "FULL", // 614 (872)
"HIGH-ORDER-LEFT", // 615 (873) "HIGHLIGHT", // 615 (873)
"HIGH-ORDER-RIGHT", // 616 (874) "HIGH-ORDER-LEFT", // 616 (874)
"IGNORING", // 617 (875) "HIGH-ORDER-RIGHT", // 617 (875)
"IMPLEMENTS", // 618 (876) "IGNORING", // 618 (876)
"INITIALIZED", // 619 (877) "IMPLEMENTS", // 619 (877)
"INTERMEDIATE", // 620 (878) "INITIALIZED", // 620 (878)
"LC-ALL", // 621 (879) "INTERMEDIATE", // 621 (879)
"LC-COLLATE", // 622 (880) "LC-ALL", // 622 (880)
"LC-CTYPE", // 623 (881) "LC-COLLATE", // 623 (881)
"LC-MESSAGES", // 624 (882) "LC-CTYPE", // 624 (882)
"LC-MONETARY", // 625 (883) "LC-MESSAGES", // 625 (883)
"LC-NUMERIC", // 626 (884) "LC-MONETARY", // 626 (884)
"LC-TIME", // 627 (885) "LC-NUMERIC", // 627 (885)
"LOWLIGHT", // 628 (886) "LC-TIME", // 628 (886)
"NEAREST-AWAY-FROM-ZERO", // 629 (887) "LOWLIGHT", // 629 (887)
"NEAREST-EVEN", // 630 (888) "NEAREST-AWAY-FROM-ZERO", // 630 (888)
"NEAREST-TOWARD-ZERO", // 631 (889) "NEAREST-EVEN", // 631 (889)
"NONE", // 632 (890) "NEAREST-TOWARD-ZERO", // 632 (890)
"NORMAL", // 633 (891) "NONE", // 633 (891)
"NUMBERS", // 634 (892) "NORMAL", // 634 (892)
"PREFIXED", // 635 (893) "NUMBERS", // 635 (893)
"PREVIOUS", // 636 (894) "PREFIXED", // 636 (894)
"PROHIBITED", // 637 (895) "PREVIOUS", // 637 (895)
"RELATION", // 638 (896) "PROHIBITED", // 638 (896)
"REQUIRED", // 639 (897) "RELATION", // 639 (897)
"REVERSE-VIDEO", // 640 (898) "REQUIRED", // 640 (898)
"ROUNDING", // 641 (899) "REVERSE-VIDEO", // 641 (899)
"SECONDS", // 642 (900) "ROUNDING", // 642 (900)
"SECURE", // 643 (901) "SECONDS", // 643 (901)
"SHORT", // 644 (902) "SECURE", // 644 (902)
"SIGNED", // 645 (903) "SHORT", // 645 (903)
"STANDARD-BINARY", // 646 (904) "SIGNED", // 646 (904)
"STANDARD-DECIMAL", // 647 (905) "STANDARD-BINARY", // 647 (905)
"STATEMENT", // 648 (906) "STANDARD-DECIMAL", // 648 (906)
"STEP", // 649 (907) "STATEMENT", // 649 (907)
"STRUCTURE", // 650 (908) "STEP", // 650 (908)
"TOWARD-GREATER", // 651 (909) "STRUCTURE", // 651 (909)
"TOWARD-LESSER", // 652 (910) "TOWARD-GREATER", // 652 (910)
"TRUNCATION", // 653 (911) "TOWARD-LESSER", // 653 (911)
"UCS-4", // 654 (912) "TRUNCATION", // 654 (912)
"UNDERLINE", // 655 (913) "UCS-4", // 655 (913)
"UNSIGNED", // 656 (914) "UNDERLINE", // 656 (914)
"UTF-16", // 657 (915) "UNSIGNED", // 657 (915)
"UTF-8", // 658 (916) "UTF-16", // 658 (916)
"XMLGENERATE", // 659 (917) "UTF-8", // 659 (917)
"XMLPARSE", // 660 (918) "XMLGENERATE", // 660 (918)
"ADDRESS", // 661 (919) "XMLPARSE", // 661 (919)
"END-ACCEPT", // 662 (920) "ADDRESS", // 662 (920)
"END-ADD", // 663 (921) "END-ACCEPT", // 663 (921)
"END-CALL", // 664 (922) "END-ADD", // 664 (922)
"END-COMPUTE", // 665 (923) "END-CALL", // 665 (923)
"END-DELETE", // 666 (924) "END-COMPUTE", // 666 (924)
"END-DISPLAY", // 667 (925) "END-DELETE", // 667 (925)
"END-DIVIDE", // 668 (926) "END-DISPLAY", // 668 (926)
"END-EVALUATE", // 669 (927) "END-DIVIDE", // 669 (927)
"END-MULTIPLY", // 670 (928) "END-EVALUATE", // 670 (928)
"END-PERFORM", // 671 (929) "END-MULTIPLY", // 671 (929)
"END-READ", // 672 (930) "END-PERFORM", // 672 (930)
"END-RETURN", // 673 (931) "END-READ", // 673 (931)
"END-REWRITE", // 674 (932) "END-RETURN", // 674 (932)
"END-SEARCH", // 675 (933) "END-REWRITE", // 675 (933)
"END-START", // 676 (934) "END-SEARCH", // 676 (934)
"END-STRING", // 677 (935) "END-START", // 677 (935)
"END-SUBTRACT", // 678 (936) "END-STRING", // 678 (936)
"END-UNSTRING", // 679 (937) "END-SUBTRACT", // 679 (937)
"END-WRITE", // 680 (938) "END-UNSTRING", // 680 (938)
"END-XML", // 681 (939) "END-WRITE", // 681 (939)
"END-IF", // 682 (940) "END-XML", // 682 (940)
"ATTRIBUTES", // 683 (941) "END-IF", // 683 (941)
"ELEMENT", // 684 (942) "ATTRIBUTES", // 684 (942)
"NAMESPACE", // 685 (943) "ELEMENT", // 685 (943)
"NAMESPACE-PREFIX", // 686 (944) "NAMESPACE", // 686 (944)
"NONNUMERIC", // 688 (946) "NAMESPACE-PREFIX", // 687 (945)
"XML-DECLARATION", // 689 (947) "NONNUMERIC", // 689 (947)
"THRU", // 691 (949) "XML-DECLARATION", // 690 (948)
"OR", // 692 (950) "THRU", // 692 (950)
"AND", // 693 (951) "OR", // 693 (951)
"NOT", // 694 (952) "AND", // 694 (952)
"NE", // 695 (953) "NOT", // 695 (953)
"LE", // 696 (954) "NE", // 696 (954)
"GE", // 697 (955) "LE", // 697 (955)
"POW", // 698 (956) "GE", // 698 (956)
"NEG", // 699 (957) "POW", // 699 (957)
"NEG", // 700 (958)
}; };

53
gcc/cobol/util.cc
View File

@ -259,6 +259,46 @@ void cdf_pop_dictionary() { cdf_directives.dictionary.pop(); }
void cdf_pop_enabled_exceptions() { cdf_directives.enabled_exceptions.pop(); } void cdf_pop_enabled_exceptions() { cdf_directives.enabled_exceptions.pop(); }
void cdf_pop_source_format() { cdf_directives.source_format.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 * const char *
symbol_type_str( enum symbol_type_t type ) symbol_type_str( enum symbol_type_t type )
{ {
@ -2089,6 +2129,19 @@ cobol_filename_restore() {
linemap_add(line_table, LC_LEAVE, sysp, NULL, 0); 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 int first_line_minus_1 = 0;
static location_t token_location_minus_1 = 0; static location_t token_location_minus_1 = 0;
static location_t token_location = 0; static location_t token_location = 0;

8
libgcobol/.gitignore vendored Normal file
View File

@ -0,0 +1,8 @@
compat/t/*
!compat/t/Makefile
!compat/t/*.cbl
posix/bin/sizeofs
posix/t/*
!posix/t/Makefile
!posix/t/*.cbl
posix/udf/*.scr

25
libgcobol/Makefile.am
View File

@ -30,6 +30,8 @@ if BUILD_LIBGCOBOL
toolexeclib_LTLIBRARIES = libgcobol.la toolexeclib_LTLIBRARIES = libgcobol.la
toolexeclib_DATA = libgcobol.spec toolexeclib_DATA = libgcobol.spec
libsubincludedir = $(libdir)/gcc/cobol/$(target_noncanonical)/$(gcc_version)
## ##
## 2.2.12 Automatic Dependency Tracking ## 2.2.12 Automatic Dependency Tracking
## Automake generates code for automatic dependency tracking by default ## Automake generates code for automatic dependency tracking by default
@ -43,18 +45,31 @@ libgcobol_la_SOURCES = \
intrinsic.cc \ intrinsic.cc \
io.cc \ io.cc \
libgcobol.cc \ libgcobol.cc \
posix/errno.cc \ posix/shim/errno.cc \
posix/localtime.cc \ posix/shim/localtime.cc \
posix/stat.cc \ posix/shim/stat.cc \
stringbin.cc \ stringbin.cc \
valconv.cc \ valconv.cc \
xmlparse.cc xmlparse.cc
libgcobol_la_LIBADD = -lxml2 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 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_CPPFLAGS += -I /usr/include/libxml2
AM_CFLAGS = $(XCFLAGS) AM_CFLAGS = $(XCFLAGS)
@ -73,7 +88,7 @@ endif
libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS) libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
version_arg = -version-info $(LIBGCOBOL_VERSION) version_arg = -version-info $(LIBGCOBOL_VERSION)
libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \ 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) libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
endif BUILD_LIBGCOBOL endif BUILD_LIBGCOBOL

128
libgcobol/Makefile.in
View File

@ -36,6 +36,7 @@
# Written de novo for libgcobol. # Written de novo for libgcobol.
VPATH = @srcdir@ VPATH = @srcdir@
am__is_gnu_make = { \ am__is_gnu_make = { \
if test -z '$(MAKELEVEL)'; then \ if test -z '$(MAKELEVEL)'; then \
@ -140,7 +141,7 @@ am__aclocal_m4_deps = $(top_srcdir)/../config/clang-plugin.m4 \
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4) $(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ 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 \ am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno configure.lineno config.status.lineno
mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
@ -175,15 +176,16 @@ am__uninstall_files_from_dir = { \
$(am__cd) "$$dir" && rm -f $$files; }; \ $(am__cd) "$$dir" && rm -f $$files; }; \
} }
am__installdirs = "$(DESTDIR)$(toolexeclibdir)" \ am__installdirs = "$(DESTDIR)$(toolexeclibdir)" \
"$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(libsubincludedir)"
LTLIBRARIES = $(toolexeclib_LTLIBRARIES) LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
am__dirstamp = $(am__leading_dot)dirstamp am__dirstamp = $(am__leading_dot)dirstamp
@BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_OBJECTS = charmaps.lo \ @BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_OBJECTS = charmaps.lo \
@BUILD_LIBGCOBOL_TRUE@ constants.lo gfileio.lo gmath.lo \ @BUILD_LIBGCOBOL_TRUE@ constants.lo gfileio.lo gmath.lo \
@BUILD_LIBGCOBOL_TRUE@ intrinsic.lo io.lo libgcobol.lo \ @BUILD_LIBGCOBOL_TRUE@ intrinsic.lo io.lo libgcobol.lo \
@BUILD_LIBGCOBOL_TRUE@ posix/errno.lo posix/localtime.lo \ @BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.lo \
@BUILD_LIBGCOBOL_TRUE@ posix/stat.lo stringbin.lo valconv.lo \ @BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.lo \
@BUILD_LIBGCOBOL_TRUE@ xmlparse.lo @BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.lo stringbin.lo \
@BUILD_LIBGCOBOL_TRUE@ valconv.lo xmlparse.lo
libgcobol_la_OBJECTS = $(am_libgcobol_la_OBJECTS) libgcobol_la_OBJECTS = $(am_libgcobol_la_OBJECTS)
@BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_rpath = -rpath $(toolexeclibdir) @BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_rpath = -rpath $(toolexeclibdir)
AM_V_P = $(am__v_P_@AM_V@) AM_V_P = $(am__v_P_@AM_V@)
@ -231,6 +233,15 @@ am__can_run_installinfo = \
*) (install-info --version) >/dev/null 2>&1;; \ *) (install-info --version) >/dev/null 2>&1;; \
esac esac
DATA = $(toolexeclib_DATA) 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) \ am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
$(LISP)config.h.in $(LISP)config.h.in
# Read a list of newline-separated strings from the standard input, # Read a list of newline-separated strings from the standard input,
@ -402,6 +413,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
# Skip the whole process if we are not building libgcobol. # Skip the whole process if we are not building libgcobol.
@BUILD_LIBGCOBOL_TRUE@toolexeclib_LTLIBRARIES = libgcobol.la @BUILD_LIBGCOBOL_TRUE@toolexeclib_LTLIBRARIES = libgcobol.la
@BUILD_LIBGCOBOL_TRUE@toolexeclib_DATA = libgcobol.spec @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@libgcobol_la_SOURCES = \
@BUILD_LIBGCOBOL_TRUE@ charmaps.cc \ @BUILD_LIBGCOBOL_TRUE@ charmaps.cc \
@BUILD_LIBGCOBOL_TRUE@ constants.cc \ @BUILD_LIBGCOBOL_TRUE@ constants.cc \
@ -410,16 +422,29 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
@BUILD_LIBGCOBOL_TRUE@ intrinsic.cc \ @BUILD_LIBGCOBOL_TRUE@ intrinsic.cc \
@BUILD_LIBGCOBOL_TRUE@ io.cc \ @BUILD_LIBGCOBOL_TRUE@ io.cc \
@BUILD_LIBGCOBOL_TRUE@ libgcobol.cc \ @BUILD_LIBGCOBOL_TRUE@ libgcobol.cc \
@BUILD_LIBGCOBOL_TRUE@ posix/errno.cc \ @BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.cc \
@BUILD_LIBGCOBOL_TRUE@ posix/localtime.cc \ @BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.cc \
@BUILD_LIBGCOBOL_TRUE@ posix/stat.cc \ @BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.cc \
@BUILD_LIBGCOBOL_TRUE@ stringbin.cc \ @BUILD_LIBGCOBOL_TRUE@ stringbin.cc \
@BUILD_LIBGCOBOL_TRUE@ valconv.cc \ @BUILD_LIBGCOBOL_TRUE@ valconv.cc \
@BUILD_LIBGCOBOL_TRUE@ xmlparse.cc @BUILD_LIBGCOBOL_TRUE@ xmlparse.cc
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LIBADD = -lxml2 @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@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@ $(LIBQUADINCLUDE) -I \
@BUILD_LIBGCOBOL_TRUE@ /usr/include/libxml2 @BUILD_LIBGCOBOL_TRUE@ /usr/include/libxml2
@BUILD_LIBGCOBOL_TRUE@AM_CFLAGS = $(XCFLAGS) @BUILD_LIBGCOBOL_TRUE@AM_CFLAGS = $(XCFLAGS)
@ -430,7 +455,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
@BUILD_LIBGCOBOL_TRUE@version_arg = -version-info $(LIBGCOBOL_VERSION) @BUILD_LIBGCOBOL_TRUE@version_arg = -version-info $(LIBGCOBOL_VERSION)
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \ @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) @BUILD_LIBGCOBOL_TRUE@libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
all: config.h all: config.h
@ -523,24 +548,26 @@ clean-toolexeclibLTLIBRARIES:
echo rm -f $${locs}; \ echo rm -f $${locs}; \
rm -f $${locs}; \ rm -f $${locs}; \
} }
posix/$(am__dirstamp): posix/shim/$(am__dirstamp):
@$(MKDIR_P) posix @$(MKDIR_P) posix/shim
@: > posix/$(am__dirstamp) @: > posix/shim/$(am__dirstamp)
posix/$(DEPDIR)/$(am__dirstamp): posix/shim/$(DEPDIR)/$(am__dirstamp):
@$(MKDIR_P) posix/$(DEPDIR) @$(MKDIR_P) posix/shim/$(DEPDIR)
@: > posix/$(DEPDIR)/$(am__dirstamp) @: > posix/shim/$(DEPDIR)/$(am__dirstamp)
posix/errno.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(am__dirstamp) posix/shim/errno.lo: posix/shim/$(am__dirstamp) \
posix/localtime.lo: posix/$(am__dirstamp) \ posix/shim/$(DEPDIR)/$(am__dirstamp)
posix/$(DEPDIR)/$(am__dirstamp) posix/shim/localtime.lo: posix/shim/$(am__dirstamp) \
posix/stat.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(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) 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) $(AM_V_GEN)$(libgcobol_la_LINK) $(am_libgcobol_la_rpath) $(libgcobol_la_OBJECTS) $(libgcobol_la_LIBADD) $(LIBS)
mostlyclean-compile: mostlyclean-compile:
-rm -f *.$(OBJEXT) -rm -f *.$(OBJEXT)
-rm -f posix/*.$(OBJEXT) -rm -f posix/shim/*.$(OBJEXT)
-rm -f posix/*.lo -rm -f posix/shim/*.lo
distclean-compile: distclean-compile:
-rm -f *.tab.c -rm -f *.tab.c
@ -555,9 +582,9 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stringbin.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stringbin.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/valconv.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@./$(DEPDIR)/xmlparse.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/errno.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/errno.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/localtime.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(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)/stat.Plo@am__quote@
.cc.o: .cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\ @am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\
@ -588,7 +615,7 @@ mostlyclean-libtool:
clean-libtool: clean-libtool:
-rm -rf .libs _libs -rm -rf .libs _libs
-rm -rf posix/.libs posix/_libs -rm -rf posix/shim/.libs posix/shim/_libs
distclean-libtool: distclean-libtool:
-rm -f libtool config.lt -rm -f libtool config.lt
@ -613,6 +640,30 @@ uninstall-toolexeclibDATA:
@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir) 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) ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique $(am__define_uniq_tagged_files); mkid -fID $$unique
@ -674,9 +725,9 @@ distclean-tags:
-rm -f cscope.out cscope.in.out cscope.po.out cscope.files -rm -f cscope.out cscope.in.out cscope.po.out cscope.files
check-am: all-am check-am: all-am
check: check-am check: check-am
all-am: Makefile $(LTLIBRARIES) $(DATA) config.h all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS) config.h
installdirs: 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"; \ test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done done
install: install-am install: install-am
@ -705,8 +756,8 @@ clean-generic:
distclean-generic: distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
-rm -f posix/$(DEPDIR)/$(am__dirstamp) -rm -f posix/shim/$(DEPDIR)/$(am__dirstamp)
-rm -f posix/$(am__dirstamp) -rm -f posix/shim/$(am__dirstamp)
maintainer-clean-generic: maintainer-clean-generic:
@echo "This command is intended for maintainers to use" @echo "This command is intended for maintainers to use"
@ -718,7 +769,7 @@ clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
distclean: distclean-am distclean: distclean-am
-rm -f $(am__CONFIG_DISTCLEAN_FILES) -rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf ./$(DEPDIR) posix/$(DEPDIR) -rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR)
-rm -f Makefile -rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \ distclean-am: clean-am distclean-compile distclean-generic \
distclean-hdr distclean-libtool distclean-tags distclean-hdr distclean-libtool distclean-tags
@ -735,7 +786,7 @@ info: info-am
info-am: info-am:
install-data-am: install-data-am: install-nobase_libsubincludeHEADERS
install-dvi: install-dvi-am install-dvi: install-dvi-am
@ -767,7 +818,7 @@ installcheck-am:
maintainer-clean: maintainer-clean-am maintainer-clean: maintainer-clean-am
-rm -f $(am__CONFIG_DISTCLEAN_FILES) -rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf $(top_srcdir)/autom4te.cache -rm -rf $(top_srcdir)/autom4te.cache
-rm -rf ./$(DEPDIR) posix/$(DEPDIR) -rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR)
-rm -f Makefile -rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic maintainer-clean-am: distclean-am maintainer-clean-generic
@ -784,8 +835,8 @@ ps: ps-am
ps-am: ps-am:
uninstall-am: uninstall-toolexeclibDATA \ uninstall-am: uninstall-nobase_libsubincludeHEADERS \
uninstall-toolexeclibLTLIBRARIES uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
.MAKE: all install-am install-strip .MAKE: all install-am install-strip
@ -797,14 +848,15 @@ uninstall-am: uninstall-toolexeclibDATA \
html-am info info-am install install-am install-data \ html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \ install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \ 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-ps install-ps-am install-strip install-toolexeclibDATA \
install-toolexeclibLTLIBRARIES installcheck installcheck-am \ install-toolexeclibLTLIBRARIES installcheck installcheck-am \
installdirs maintainer-clean maintainer-clean-generic \ installdirs maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-compile mostlyclean-generic \ mostlyclean mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
uninstall-am uninstall-toolexeclibDATA \ uninstall-am uninstall-nobase_libsubincludeHEADERS \
uninstall-toolexeclibLTLIBRARIES uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
.PRECIOUS: Makefile .PRECIOUS: Makefile

2
libgcobol/charmaps.cc
View File

@ -55,7 +55,7 @@ int __gg__decimal_separator = ',' ;
int __gg__quote_character = '"' ; int __gg__quote_character = '"' ;
int __gg__low_value_character = 0x00 ; int __gg__low_value_character = 0x00 ;
int __gg__high_value_character = 0xFF ; int __gg__high_value_character = 0xFF ;
char **__gg__currency_signs ; std::vector<std::string> __gg__currency_signs(256) ;
int __gg__default_currency_sign; int __gg__default_currency_sign;
char *__gg__ct_currency_signs[256]; // Compile-time currency signs char *__gg__ct_currency_signs[256]; // Compile-time currency signs

8
libgcobol/charmaps.h
View File

@ -31,6 +31,9 @@
#ifndef CHARMAPS_H #ifndef CHARMAPS_H
#define CHARMAPS_H #define CHARMAPS_H
#include <string>
#include <vector>
#include <unistd.h> #include <unistd.h>
/* There are four distinct codeset domains in the COBOL compiler. /* There are four distinct codeset domains in the COBOL compiler.
@ -108,11 +111,10 @@ extern int __gg__decimal_separator ;
extern int __gg__quote_character ; extern int __gg__quote_character ;
extern int __gg__low_value_character ; extern int __gg__low_value_character ;
extern int __gg__high_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 int __gg__default_currency_sign;
extern cbl_encoding_t __gg__display_encoding ; extern cbl_encoding_t __gg__display_encoding ;
extern cbl_encoding_t __gg__national_encoding ; extern cbl_encoding_t __gg__national_encoding ;
extern char *__gg__ct_currency_signs[256]; // Compile-time currency signs
#define NULLCH ('\0') #define NULLCH ('\0')
#define DEGENERATE_HIGH_VALUE 0xFF #define DEGENERATE_HIGH_VALUE 0xFF
@ -492,4 +494,4 @@ class charmap_t
charmap_t *__gg__get_charmap(cbl_encoding_t encoding); charmap_t *__gg__get_charmap(cbl_encoding_t encoding);
#endif #endif

25
libgcobol/compat/README.md Normal file
View File

@ -0,0 +1,25 @@
# GCC COBOL Compatibility Functions
## Purpose
It seems every COBOL compiler includes a library of functions intended
to make the COBOL programer's life easier. All of them, as we
demonstrate here, can be written in COBOL. They are supplied in COBOL
form, not as a library. The user is free to compile them into a
utility library.
Some of the functions defined here require runtime support from libgcobol.
## Fri Oct 10 16:01:58 2025
At the time of this writing, the functions of greatest concern are
those that are defined by Rocket Software (formerly MicroFocus) and
emulated by GnuCOBOL. Those are implemented in
`gcc/cobol/compat/lib/gnu`. Any calls they would otherwise make to
the C library are effected through COBOL POSIX bindings supplied by
`gcc/cobol/posix/udf`.
As an aid to the developer, a simple example of how these functions
are used is found in `gcc/cobol/compat/t/smoke.cbl`. It may by
compiled using `gcc/cobol/compat/Makefile`.

41
libgcobol/compat/lib/gnu/CBL_ALLOC_MEM.cbl Normal file
View File

@ -0,0 +1,41 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH)
* This function is in the public domain.
* Contributed by James K. Lowden
*
* CALL "CBL_ALLOC_MEM" using mem-pointer
* by value mem-size
* by value flags
* returning status-code
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. CBL_ALLOC_MEM.
DATA DIVISION.
LINKAGE SECTION.
01 MEMORY-REQUESTED PIC X(8) COMP-5.
01 MEMORY-ALLOCATED USAGE IS POINTER.
01 FLAGS PIC X(8) COMP-5.
77 STATUS-CODE BINARY-LONG SIGNED VALUE 0.
PROCEDURE DIVISION USING MEMORY-ALLOCATED,
BY VALUE MEMORY-REQUESTED,
BY VALUE FLAGS
RETURNING STATUS-CODE.
D Display 'MEMORY-REQUESTED: ' MEMORY-REQUESTED
D ' CHARACTERS INITIALIZED'
ALLOCATE MEMORY-REQUESTED CHARACTERS INITIALIZED,
RETURNING MEMORY-ALLOCATED.
D IF MEMORY-ALLOCATED = NULLS THEN MOVE 1 TO STATUS-CODE.
END PROGRAM CBL_ALLOC_MEM.
>> POP SOURCE FORMAT

47
libgcobol/compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl Normal file
View File

@ -0,0 +1,47 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* Include the posix-stat function
COPY posix-stat.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH)
* This function is in the public domain.
* Contributed by James K. Lowden of Cobolworx in August 2024
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. CBL_CHECK_FILE_EXIST.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 FUNC-RETURN-VALUE PIC 9(8) COMP-5.
01 STAT-BUFFER.
COPY statbuf.
LINKAGE SECTION.
77 RETURN-CODE PIC 9(8) COMP-5.
01 FILE-PATH PIC X ANY LENGTH.
01 FI-FILE-INFO.
05 FI-FILE-SIZE-IN-BYTES PIC 9(8) COMP-4.
05 FI-FILE-MOD-DATE-TIME.
10 FI-FILE-DATE PIC 9(8) COMP-4.
10 FI-FILE-TIME PIC 9(8) COMP-4.
PROCEDURE DIVISION USING FILE-PATH, FI-FILE-INFO,
RETURNING RETURN-CODE.
MOVE FUNCTION posix-stat(FILE-PATH, STAT-BUFFER)
TO FUNC-RETURN-VALUE.
IF FUNC-RETURN-VALUE = ZERO
THEN
MOVE ZERO TO RETURN-CODE
MOVE st_size TO FI-FILE-SIZE-IN-BYTES
MOVE st_mtime TO FI-FILE-MOD-DATE-TIME
ELSE
MOVE 1 TO RETURN-CODE
MOVE ZERO TO FI-FILE-SIZE-IN-BYTES
MOVE ZERO TO FI-FILE-DATE
MOVE ZERO TO FI-FILE-TIME.
END PROGRAM CBL_CHECK_FILE_EXIST.
>> POP SOURCE FORMAT
`

30
libgcobol/compat/lib/gnu/CBL_DELETE_FILE.cbl Normal file
View File

@ -0,0 +1,30 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* Include the posix-unlink function
COPY posix-unlink.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH)
* This function is in the public domain.
* Contributed by
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. CBL_DELETE_FILE.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 BUFSIZE USAGE BINARY-LONG.
LINKAGE SECTION.
77 RETURN-CODE PIC 9(8) COMP-5.
01 FILE-PATH PIC X ANY LENGTH.
PROCEDURE DIVISION USING FILE-PATH, RETURNING RETURN-CODE.
INSPECT FILE-PATH
REPLACING TRAILING SPACE BY LOW-VALUE
MOVE FUNCTION posix-unlink(FILE-PATH) TO RETURN-CODE.
END PROGRAM CBL_DELETE_FILE.
>> POP SOURCE FORMAT

26
libgcobol/compat/lib/gnu/CBL_FREE_MEM.cbl Normal file
View File

@ -0,0 +1,26 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* MODIFY AFTER SUCCESSFUL TESTING / IMPLEMENTATION (VPH)
* This function is in the public domain.
* Contributed by
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
IDENTIFICATION DIVISION.
PROGRAM-ID. CBL_FREE_MEM.
DATA DIVISION.
LINKAGE SECTION.
77 RETURN-CODE PIC 9(8) COMP.
01 MEMORY-ADDRESS USAGE IS POINTER.
PROCEDURE DIVISION USING MEMORY-ADDRESS,
RETURNING RETURN-CODE.
FREE MEMORY-ADDRESS.
MOVE ZERO TO RETURN-CODE.
END PROGRAM CBL_FREE_MEM.
>> POP SOURCE FORMAT

27
libgcobol/compat/t/Makefile Normal file
View File

@ -0,0 +1,27 @@
#
# A simple Makefile to demonstrate how the compat/lib programs are used.
#
COBC = gcobol -g -O0
INCLUDE = ../../posix/cpy ../../posix/udf
FLAGS = -dialect mf $(addprefix -I,$(INCLUDE))
COMPAT = $(subst .cbl,.o,$(wildcard ../lib/gnu/*.cbl))
test: smoke
./$^
smoke: smoke.cbl $(COMPAT)
$(ENV) $(COBC) -o $@ \
$(FLAGS) $(COBCFLAGS) $(LDFLAGS) $^
%.o : %.cbl
$(ENV) $(COBC) -c -o $@ $(FLAGS) $(COBCFLAGS) $^
% : %.cbl
$(ENV) $(COBC) -o $@ $(FLAGS) $(COBCFLAGS) $(LDFLAGS) $^

95
libgcobol/compat/t/smoke.cbl Normal file
View File

@ -0,0 +1,95 @@
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This function is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
COPY posix-errno.
IDENTIFICATION DIVISION.
PROGRAM-ID. gcobol-smoke-test.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.
GNU-Linux.
OBJECT-COMPUTER.
GNU-Linux.
>>Define FILENAME as "/tmp/smoke.empty"
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT EXPENDABLE
ACCESS MODE IS SEQUENTIAL
SEQUENTIAL
ASSIGN TO FILENAME.
DATA DIVISION.
FILE SECTION.
* FD not required per ISO but fails under gcobol.
FD EXPENDABLE.
01 Extraneous PIC X.
WORKING-STORAGE SECTION.
77 File-Name PIC X(100) VALUE FILENAME.
77 status-code BINARY-LONG SIGNED.
* CBL_ALLOC_MEM
01 mem-pointer usage pointer.
77 mem-size pic x(8) comp-5 VALUE 64.
77 flags pic x(8) comp-5 VALUE 0.
* CBL_CHECK_FILE_EXIST
01 file-info.
03 file-modification-day.
05 File-Size-In-Bytes PIC 9(18) COMP.
05 Mod-DD PIC 9(2) COMP. *> Modification Date
05 Mod-MO PIC 9(2) COMP.
05 Mod-YYYY PIC 9(4) COMP.
03 file-modification-time.
05 Mod-HH PIC 9(2) COMP. *> Modification Time
05 Mod-MM PIC 9(2) COMP.
05 Mod-SS PIC 9(2) COMP.
05 FILLER PIC 9(2) COMP. *> Always 00
PROCEDURE DIVISION.
Display 'Allocating ' mem-size ' bytes ... ' with No Advancing.
Call "CBL_ALLOC_MEM" using
mem-pointer
by value mem-size
by value flags
returning status-code.
Display 'CBL_ALLOC_MEM status: ' status-code.
Display 'Checking on ' Function Trim(File-Name) ' ... '
with No Advancing.
Call "CBL_CHECK_FILE_EXIST" using File-Name
file-info
returning status-code.
Display 'CBL_CHECK_FILE_EXIST status: ' status-code.
Display 'Deleting ' Function Trim(File-Name) ' ... '
with No Advancing.
Call "CBL_DELETE_FILE" using File-Name
returning status-code.
Display 'CBL_DELETE_FILE status: ' status-code.
Display 'Freeing ' mem-size ' bytes ... ' with No Advancing.
Call "CBL_FREE_MEM" using by value mem-pointer
returning status-code.
Display 'CBL_FREE_MEM status: ' status-code.
>>IF CBL_READ_FILE is defined
Call "CBL_READ_FILE"
using handle, offset, count, flags, buf
returning status-code.
>>END-IF

3
libgcobol/config.h.in
View File

@ -55,6 +55,9 @@
/* Define to 1 if you have the `random_r' function. */ /* Define to 1 if you have the `random_r' function. */
#undef HAVE_RANDOM_R #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. */ /* Define to 1 if you have the `setstate_r' function. */
#undef HAVE_SETSTATE_R #undef HAVE_SETSTATE_R

94
libgcobol/configure vendored
View File

@ -17650,6 +17650,100 @@ if test "$ac_res" != no; then :
fi 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 # 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 # 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. # in if it still doesn't give us the function we want.

10
libgcobol/configure.ac
View File

@ -232,6 +232,16 @@ AC_SEARCH_LIBS([sinf128], [c m], libgcobol_have_sinf128=yes)
libgcobol_have_cacosf128=no libgcobol_have_cacosf128=no
AC_SEARCH_LIBS([cacosf128], [c m], libgcobol_have_cacosf128=yes) 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 # 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 # 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. # in if it still doesn't give us the function we want.

6
libgcobol/intrinsic.cc
View File

@ -2714,8 +2714,8 @@ numval_c( cblc_field_t *dest,
char *currency_in_ascii; char *currency_in_ascii;
char *currency_start; const char *currency_start;
char *currency_end; const char *currency_end;
if( crcy ) if( crcy )
{ {
converted = __gg__iconverter(crcy->encoding, converted = __gg__iconverter(crcy->encoding,
@ -2736,7 +2736,7 @@ numval_c( cblc_field_t *dest,
currency_start = currency_in_ascii; currency_start = currency_in_ascii;
currency_end = currency_start + strlen(currency_start); currency_end = currency_start + strlen(currency_start);
char *pcurrency = currency_start; const char *pcurrency = currency_start;
// Trim off spaces from the currency: // Trim off spaces from the currency:
while( *pcurrency == ascii_space && pcurrency < currency_end ) while( *pcurrency == ascii_space && pcurrency < currency_end )
{ {

53
libgcobol/libgcobol.cc
View File

@ -461,13 +461,13 @@ struct program_state
int rt_quote_character; int rt_quote_character;
int rt_low_value_character; int rt_low_value_character;
int rt_high_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; const unsigned short *rt_collation; // Points to a table of 256 values;
cbl_encoding_t rt_display_encoding; cbl_encoding_t rt_display_encoding;
cbl_encoding_t rt_national_encoding; cbl_encoding_t rt_national_encoding;
char *rt_program_name; char *rt_program_name;
program_state() program_state() : rt_currency_signs(256)
{ {
// IBM defaults to the \" QUOTE compiler option. quote_character must // IBM defaults to the \" QUOTE compiler option. quote_character must
// be set to \' when the APOST compiler option is in effect // be set to \' when the APOST compiler option is in effect
@ -486,15 +486,14 @@ struct program_state
// Set all the currency_sign pointers to NULL: // Set all the currency_sign pointers to NULL:
memset(rt_currency_signs, 0, sizeof(rt_currency_signs));
rt_display_encoding = __gg__display_encoding; rt_display_encoding = __gg__display_encoding;
rt_national_encoding = __gg__national_encoding; rt_national_encoding = __gg__national_encoding;
rt_collation = __gg__one_to_one_values; rt_collation = __gg__one_to_one_values;
rt_program_name = NULL; 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_point = ps.rt_decimal_point ;
rt_decimal_separator = ps.rt_decimal_separator ; rt_decimal_separator = ps.rt_decimal_separator ;
@ -507,32 +506,7 @@ struct program_state
rt_display_encoding = ps.rt_display_encoding ; rt_display_encoding = ps.rt_display_encoding ;
rt_national_encoding = ps.rt_national_encoding ; rt_national_encoding = ps.rt_national_encoding ;
rt_collation = ps.rt_collation ; rt_collation = ps.rt_collation ;
rt_program_name = ps.rt_program_name ;
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;
}
}
} }
}; };
@ -584,10 +558,10 @@ __gg__get_decimal_separator()
} }
extern "C" extern "C"
char * const char *
__gg__get_default_currency_string() __gg__get_default_currency_string()
{ {
return currency_signs(__gg__default_currency_sign); return currency_signs(__gg__default_currency_sign).c_str();
} }
extern "C" extern "C"
@ -8132,10 +8106,21 @@ __gg__inspect_format_2(int backward, size_t integers[])
size_t id1_s = __gg__treeplet_1s[cblc_index]; size_t id1_s = __gg__treeplet_1s[cblc_index];
cblc_index += 1; 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. // normalize it, according to the language specification.
normalized_operand normalized_id_1 normalized_operand normalized_id_1
= normalize_id(id1, id1_o, id1_s, id1->encoding); = 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; std::vector<comparand> comparands;
// Pick up the count of operations: // Pick up the count of operations:

2
libgcobol/libgcobol.h
View File

@ -96,7 +96,7 @@ extern "C" void __gg__double_to_target( cblc_field_t *tgt,
cbl_round_t rounded); cbl_round_t rounded);
extern "C" char __gg__get_decimal_separator(); extern "C" char __gg__get_decimal_separator();
extern "C" char __gg__get_decimal_point(); 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 struct cbl_timespec
{ {

105
libgcobol/posix/README.md Normal file
View File

@ -0,0 +1,105 @@
# GCC COBOL Posix Functions and Adapter
## Purpose
GCC COBOL provides COBOL bindings for some POSIX functions. Feel free
to contribute more. Insofar as possible, the functions take the same
parameters and return the same values as defined by POSIX. Among
others, they are used by the COBOL compatibility library (see
libgcobol/compat/lib/gnu). They are installed in source form. The
user may choose to compile them to a library.
ISO COBOL does not specify any relationship to any particular
operating system, and does not reference POSIX. The raw capability is
there, of course, via the `CALL` statement. But that's not very
convenient, and offers no parameter validation.
For simple functions, e.g. **unlink**(2), the UDFs simply call the
underlying C library. More complex functions, though,
e.g. **stat**(2), pass or return a buffer. That buffer is normally
defined by what members must exist, but its exact layout is left up to
the C implementation and defined by the C header files, which are not
parsed by GCC COBOL. Consequently we do not know, at the COBOL level,
how to define the `struct stat` buffer required by **stat**(2). For
such functions, we use a C "shim" function that accepts a buffer
defined by GCC COBOL. That buffer has the members defined by POSIX
and a layout defined by GCC COBOL. The COBOL application calls the
COBOL POSIX binding, which uses the shim function to call the C
library.
To take **stat**(2) as an example,
COBOL program uses
COPY posix-stat.
01 stat-buf.
COPY posix-statbuf. *> gcc/cobol/posix/cpy
FUNCTION POSIX-STAT(filename, stat-buf)
libgcobol/posix/udf/posix-stat.cbl
passes stat-buf to
posix_stat in libgcobol
posix_stat calls stat(2),
and copies the returned values to its input buffer
## Contents
The installed POSIX bindings and associated copybooks are in `cpy` and `udf`:
- `cpy/` copybooks used by functions in `udf`
- `udf/` COBOL POSIX bindings
- `t/` simple tests demonstrating use of functions in `udf`
Any buffer shared between the COBOL application and a COBOL POSIX
function is defined in `cpy/`. While these buffers meet the POSIX
descriptions -- meaning they have members matching the standard --
they probably do not match the buffer defined by the C library in
`/usr/include`. GCC COBOL does not parse C, and therefore does not
parse C header files, and so has no access to those C buffer definitions.
The machine-shop tools are in `bin/`.
- `bin/` developer tools to aid creation of POSIX bindings
- `scrape.awk` extracts function prototypes from the SYNOPSIS of a
man page.
- `udf-gen` reads function declarations and, for each one, produces
a COBOL User Defined Function (UDF) that calls the function.
Finally,
- `shim/` C support for POSIX bindings, incorporated in libgcobol
## Prerequisites
### for developers, to generate COBOL POSIX bindings
To use the POSIX bindings, just use the COPY statement.
To create new ones, use `udf-gen`. `udf-gen` is a Python program that
imports the [PLY pycparser module](http://www.dabeaz.com/ply/) module,
which must be installed.
`udf-gen` is lightly documented, use `udf-gen --help`. It can be a
little tedious to set up the first time, but if you want to use more a
few functions, it will be faster than doing the work by hand.
## Limitations
`udf-gen` does not
- generate a working UDF for function parameters of type `struct`,
such as is used by **stat**(2). This is because the information is
not available in a standardized way in the SYNOPSIS of a man page.
- define helpful Level 88 values for "magic" numbers, such as
permission bits in **chmod**(2).
None of this is particularly difficult; it's just a matter of time and
need. The `scrape.awk` script finds 560 functions in the Ubuntu LTS
22.04 manual. Which of those is important is for users to decide.
## Other Options
IBM and MicroFocus both supply intrinsic functions to interface with
the OS, each in their own way. GnuCOBOL implements some of those functions.
## Portability
The UDF produced by `udf-gen` is pure ISO COBOL. The code should be
compilable by any ISO COBOL compiler.

18
libgcobol/posix/bin/Makefile Normal file
View File

@ -0,0 +1,18 @@
#
# Demonstrate how to generate a new COBOL binding from a man page.
#
posix-mkdir.cbl:
man 2 mkdir | ./scrape.awk | \
../udf-gen -D mode_t=unsigned\ long > $@~
@mv $@~ $@
# ... or
posix-stat-many.scr:
man 2 stat | col -b | ./scrape.awk > $@~
@mv $@~ $@
.scr.cbl:
./udf-gen -D mode_t=unsigned\ long $^ > $@~
@mv $@~ $@

37
libgcobol/posix/bin/headers Normal file
View File

@ -0,0 +1,37 @@
#include <stddef.h>
#include <stdio.h>
#include <stddef.h>
#include <unistd.h>
#define loff_t ssize_t
#define socklen_t size_t
#define fd_set struct fd_set
#define id_t unsigned int
// typedef int mqd_t;
#define mqd_t int
// typedef unsigned long int nfds_t;
#define nfds_t unsigned long int
#if 0
typedef struct
{
unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))];
} __sigset_t;
define struct py_sigset_t \
{ \
unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))]; \
};
#else
#define kernel_sigset_t sigset_t
#define old_kernel_sigset_t sigset_t
#endif
#if 0
typedef enum
{
P_ALL,
P_PID,
P_PGID
} idtype_t;
#else
#define idtype_t int
#endif

19
libgcobol/posix/bin/scrape.awk Executable file
View File

@ -0,0 +1,19 @@
#! /usr/bin/awk -f
/^UNIMPLEMENTED/ {
exit
}
/^DESCRIPTION/ {
exit
}
/struct sched_param {$/ {
exit
}
/SYNOPSIS/,/DESCRIPTION/ {
if( /([.][.]|[{},;]) *$/ ) {
print
}
}

27
libgcobol/posix/bin/sizeofs.c Normal file
View File

@ -0,0 +1,27 @@
#include <fcntl.h> /* Definition of AT_* constants */
#include <stdio.h>
#include <time.h>
#include <unistd.h>
#include <sys/stat.h>
#include <sys/stat.h>
#include <sys/types.h>
int
main(int argc, char *argv[])
{
printf( "size of dev_t is %zu\n", sizeof(dev_t));
printf( "size of ino_t is %zu\n", sizeof(ino_t));
printf( "size of mode_t is %zu\n", sizeof(mode_t));
printf( "size of nlink_t is %zu\n", sizeof(nlink_t));
printf( "size of uid_t is %zu\n", sizeof(uid_t));
printf( "size of gid_t is %zu\n", sizeof(gid_t));
printf( "size of dev_t is %zu\n", sizeof(dev_t));
printf( "size of off_t is %zu\n", sizeof(off_t));
printf( "size of blksize_t is %zu\n", sizeof(blksize_t));
printf( "size of blkcnt_t is %zu\n", sizeof(blkcnt_t));
printf( "size of time_t is %zu\n", sizeof(time_t));
printf( "size of struct timespec is %zu\n", sizeof(struct timespec));
return 0;
}

350
libgcobol/posix/bin/udf-gen Executable file
View File

@ -0,0 +1,350 @@
#! /usr/bin/python3
# Copyright (c) Symas Corporation
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
#
# * Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above
# copyright notice, this list of conditions and the following disclaimer
# in the documentation and/or other materials provided with the
# distribution.
# * Neither the name of the Symas Corporation nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
import sys, os, getopt, re, copy
from pycparser import c_parser, c_generator, c_ast, parse_file
def starify(param):
stars = ""
while( isinstance(param, c_ast.PtrDecl) ):
q = ' '.join(param.quals)
stars = '*' + ' '.join((stars, q))
param = param.type
if( isinstance(param.type, c_ast.PtrDecl) ):
(stars, param) = starify(param.type)
if( isinstance(param, c_ast.TypeDecl) ):
return (stars, param)
return (stars, param.type)
def linkage_str( i, name, param ) -> str:
if name == 'execve':
param.show()
if( isinstance(param, c_ast.EllipsisParam) ):
return (None, None, '...') # COBOL syntax error: no variadic UDF
is_array = False;
node = param
if( isinstance(node, c_ast.Decl) ):
node = node.type
if( isinstance(node, c_ast.ArrayDecl) ):
is_array = True;
node = node.type
(stars, node) = starify(node)
if( isinstance(node, c_ast.TypeDecl) ):
level = 1
item_name = ''
picture = ''
usage = ''
if node.declname:
item_name = 'Lk-' + node.declname
if is_array: # ignore level
if stars:
usage = 'Usage POINTER'
output = '01 FILLER.\n 02 %s %s %s OCCURS 100' \
% (item_name, picture, usage)
return (None, None, output)
if( isinstance(node.type, c_ast.Struct) ):
stars = None
if isinstance(node.type, c_ast.IdentifierType):
ctype = node.type.names[-1]
if ctype == 'void':
if not stars and not item_name:
return (None, None, None)
if ctype == 'char':
picture = 'X'
if stars[0] == '*':
picture = 'X ANY LENGTH'
if ctype == 'int' or \
ctype == 'long' or \
ctype == 'mode_t' or \
ctype == 'off_t' or \
ctype == 'size_t':
picture = '9(8)'
usage = 'Usage COMP'
stars = None
output = "%02d %s" % (level, ' '.join((item_name, 'PIC ' + picture, usage)))
return (stars, item_name, output)
node.show()
return (None, None, '???')
def using_str( i, name, param ) -> str:
item_name = ''
if( isinstance(param, c_ast.EllipsisParam) ):
return '...' # COBOL syntax error: no variadic UDF
node = param
if( isinstance(node, c_ast.Decl) ):
node = node.type
if( isinstance(node, c_ast.ArrayDecl) ):
node = node.type
(stars, node) = starify(node)
if( isinstance(node, c_ast.TypeDecl) ):
item_name = ''
if isinstance(node.type, c_ast.IdentifierType):
ctype = node.type.names[-1]
how = 'By Reference'
if ctype == 'int' or \
ctype == 'long' or \
ctype == 'mode_t' or \
ctype == 'off_t' or \
ctype == 'size_t':
how = 'By Value'
if node.declname:
item_name = '%s Lk-%s' % (how, node.declname)
return item_name
def parameter_str( i, name, param ) -> str:
if( isinstance(param, c_ast.EllipsisParam) ):
return '...'
t = [0, 1, 2] # qual, type, name
is_array = False;
node = param
if( isinstance(node, c_ast.Decl) ):
node = node.type
if( isinstance(node, c_ast.ArrayDecl) ):
is_array = True;
node = node.type
(stars, node) = starify(node)
if( isinstance(node, c_ast.TypeDecl) ):
t[0] = ' '.join(node.quals)
item_name = ''
if node.declname:
item_name = 'Lk-' + node.declname
t[2] = ' '.join((stars, item_name))
if( node.declname == None ):
t[2] = ''
if( isinstance(node.type, c_ast.IdentifierType) ):
try:
t[1] = ' '.join(node.type.names)
except:
print("oops: node.type of %s is %s" % (name, str(node.type)))
return "could not parse %s arg[%d]" % (name, i)
if( isinstance(node.type, c_ast.Struct) ):
t[0] = ' '.join(node.quals)
t[1] = "struct " + node.type.name
if( isinstance(node, c_ast.ArrayDecl) ):
return parameter_str(i, name, node.type) + '[]'
try:
return ' '.join(t)
except:
print("oops: %s[%d]: {%s}" % (name, i, str(t)) )
param.show()
class VisitPrototypes(c_ast.NodeVisitor):
def __init__(self):
self.done = set()
def type_of(self, node):
while( not isinstance(node.type, c_ast.TypeDecl) ):
node = node.type
return node.type.type.name
def visit_Decl(self, node):
name = node.name
if name in self.done:
return
self.done.add(name)
params = []
cbl_args = []
linkage_items = []
string_items = []
returns = '???'
if False and isinstance(node.type, c_ast.FuncDecl):
function_decl = node.type
print('Function: %s' % node.name)
if( node.type.args == None ):
print(' (no arguments)')
else:
for param_decl in node.type.args.params:
if( isinstance(param_decl, c_ast.EllipsisParam) ):
param_decl.show(offset=6)
continue
print(' Arg name: %s' % param_decl.name)
print(' Type:')
param_decl.type.show(offset=6)
if isinstance(node.type, c_ast.FuncDecl):
args = node.type.args
if isinstance(args, c_ast.ParamList):
#rint("params are %s (type %s)" % (str(args.params), type(args.params)))
if( args == None ):
params.append('')
else:
for (i, param) in enumerate(args.params):
params.append(parameter_str(i, name, param))
cbl_args.append(using_str(i, name, param))
(stars, item, definition) = linkage_str(i, name, param)
if definition:
if stars:
string_items.append(item)
linkage_items.append(definition)
(stars, rets) = starify(node.type)
if isinstance(rets, c_ast.TypeDecl):
q = ' '.join(rets.quals)
if( isinstance(rets.type, c_ast.Struct) ):
t = "struct " + rets.type.name
else:
t = ' '.join(rets.type.names)
returns = ' '.join((q, t, stars))
if name == None:
return
# print the C version as a comment
cparams = [ x.replace('Lk-', '') for x in params ]
print( " * %s %s(%s)"
% (returns, name, ', '.join(cparams)) )
# print the UDF
print( ' Identification Division.')
sname = name
if( sname[0] == '_' ):
sname = sname[1:]
print( ' Function-ID. posix-%s.' % sname)
print( ' Data Division.')
print( ' Linkage Section.')
print( ' 77 Return-Value Binary-Long.')
for item in linkage_items:
print( ' %s.' % item.strip())
args = ',\n '.join(cbl_args)
args = 'using\n %s\n ' % args
print( ' Procedure Division %s Returning Return-Value.'
% args )
for item in string_items:
print( ' Inspect Backward %s ' % item +
'Replacing Leading Space By Low-Value' )
using_args = ''
if args:
using_args = '%s' % args
print( ' Call "%s" %s Returning Return-Value.'
% (name, using_args) )
print( ' Goback.')
print( ' End Function posix-%s.' % sname)
# Hard code a path to the fake includes
# if not using cpp(1) environment variables.
cpp_args = ['-I/home/jklowden/projects/3rd/pycparser/utils/fake_libc_include']
for var in ('CPATH', 'C_INCLUDE_PATH'):
dir = os.getenv(var)
if dir:
cpp_args = ''
def process(srcfile):
ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args)
# print(c_generator.CGenerator().visit(ast))
v = VisitPrototypes()
v.visit(ast)
__doc__ = """
SYNOPSIS
udf-gen [-I include-path] [header-file ...]
DESCRIPTION
For each C function declared in header-file,
produce an ISO COBOL user-defined function definition to call it.
If no filename is supplied, declarations are read from standard input.
All output is written to standard output.
This Python script uses the PLY pycparser module,
(http://www.dabeaz.com/ply/), which supplies a set of simplified "fake
header files" to avoid parsing the (very complex) standard C header
files. These alost suffice for parsing the Posix function
declarations in Section 2 of the manual.
Use the -I option or the cpp(1) environment variables to direct
the preprocessor to use the fake header files instead of the system
header files.
LIMITATIONS
udf-gen does not recognize C struct parameters, such as used by stat(2).
No attempt has been made to define "magic" values, such as would
be needed for example by chmod(2).
"""
def main( argv=None ):
global cpp_args
if argv is None:
argv = sys.argv
# parse command line options
try:
opts, args = getopt.getopt(sys.argv[1:], "D:hI:m:", ["help"])
except getopt.error as msg:
print(msg)
print("for help use --help")
sys.exit(2)
# process options
astfile = None
for opt, arg in opts:
if opt in ("-h", "--help"):
print(__doc__)
sys.exit(0)
if opt == '-D':
cpp_args.append('-D%s ' % arg)
if opt == '-I':
cpp_args[0] = '-I' + arg
# process arguments
if not args:
args = ('/dev/stdin',)
for arg in args:
process(arg)
if __name__ == "__main__":
sys.exit(main())

27
libgcobol/posix/cpy/posix-errno.cbl Normal file
View File

@ -0,0 +1,27 @@
>> PUSH source format
>>SOURCE format is fixed
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This function is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Identification Division.
Function-ID. posix-errno.
Data Division.
Linkage Section.
77 Return-Value Binary-Long.
01 Error-Msg PIC X ANY LENGTH.
Procedure Division
using Error-Msg
Returning Return-Value.
CALL "posix_errno"
returning Return-Value.
CALL "strerror"
using by value Return-Value
returning error-msg.
Goback.
END FUNCTION posix-errno.
>> POP source format

22
libgcobol/posix/cpy/statbuf.cpy Normal file
View File

@ -0,0 +1,22 @@
>> PUSH source format
>>SOURCE format is fixed
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This stat(2) buffer definition is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
05 st_dev Usage is Binary-Double Unsigned.
05 st_ino Usage is Binary-Double Unsigned.
05 st_mode Usage is Binary-Double Unsigned.
05 st_nlink Usage is Binary-Double Unsigned.
05 st_uid Usage is Binary-Double Unsigned.
05 st_gid Usage is Binary-Double Unsigned.
05 st_rdev Usage is Binary-Double Unsigned.
05 st_size Usage is Binary-Double Unsigned.
05 st_blksize Usage is Binary-Double Unsigned.
05 st_blocks Usage is Binary-Double Unsigned.
05 st_atime Usage is Binary-Double Unsigned.
05 st_mtime Usage is Binary-Double Unsigned.
05 st_ctime Usage is Binary-Double Unsigned.
>> POP source format

27
libgcobol/posix/cpy/tm.cpy Normal file
View File

@ -0,0 +1,27 @@
>> PUSH source format
>>SOURCE format is fixed
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This function is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
02 tm_sec Usage is Binary-Long.
02 tm_min Usage is Binary-Long.
02 tm_hour Usage is Binary-Long.
02 tm_mday Usage is Binary-Long.
02 tm_mon Usage is Binary-Long.
02 tm_year Usage is Binary-Long.
02 tm_wday Usage is Binary-Long.
02 tm_yday Usage is Binary-Long.
02 tm_isdst Usage is Binary-Long.
>> POP source format

0
libgcobol/posix/errno.cc → libgcobol/posix/shim/errno.cc
View File

0
libgcobol/posix/localtime.cc → libgcobol/posix/shim/localtime.cc
View File

80
libgcobol/posix/shim/stat.cc Normal file
View File

@ -0,0 +1,80 @@
#include <assert.h>
#include <stddef.h>
#include <stdio.h>
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
#define offsetof(TYPE, MEMBER) __builtin_offsetof (TYPE, MEMBER)
extern "C" {
#include "stat.h"
#define offset_assert(name, offset) do { \
if( offsetof(posix_stat_t, name) != offset ) { \
fprintf(stderr, "C posix_stat_t offset for %s %zu != COBOL offset %d\n", \
#name, offsetof(posix_stat_t, name), offset); \
assert(offsetof(posix_stat_t, name) == offset); \
} \
} while(false);
int
posix_stat(const char *pathname, posix_stat_t *statbuf, size_t size) {
struct stat sb;
int erc = stat(pathname, &sb);
if( sizeof(posix_stat_t) != size ) {
fprintf(stderr, "%s:%d: %lu != received size %lu\n", __func__, __LINE__,
(unsigned long)sizeof(struct posix_stat_t),
(unsigned long)size);
fflush(stdout);
fflush(stderr);
}
if( statbuf == nullptr ) {
fprintf(stderr, "%s:%d: received NULL statbuf\n", __func__, __LINE__);
fflush(stdout);
fflush(stderr);
}
if( true ) { // Verify last known reported COBOL offsets agree with C offsets.
offset_assert( st_dev, 0 );
offset_assert( st_ino , 8 );
offset_assert( st_mode , 16 );
offset_assert( st_nlink , 24 );
offset_assert( st_uid , 32 );
offset_assert( st_gid , 40 );
offset_assert( st_rdev , 48 );
offset_assert( st_size , 56 );
offset_assert( st_blksize , 64 );
offset_assert( st_blocks , 72 );
offset_assert( psx_atime , 80 );
offset_assert( psx_mtime , 88 );
offset_assert( psx_ctime , 96 );
}
assert(statbuf);
if( erc == 0 ) {
statbuf->st_dev = sb.st_dev;
statbuf->st_ino = sb.st_ino;
statbuf->st_mode = sb.st_mode;
statbuf->st_nlink = sb.st_nlink;
statbuf->st_uid = sb.st_uid;
statbuf->st_gid = sb.st_gid;
statbuf->st_rdev = sb.st_rdev;
statbuf->st_size = sb.st_size;
statbuf->st_blksize = sb.st_blksize;
statbuf->st_blocks = sb.st_blocks;
statbuf->psx_atime = sb.st_atime;
statbuf->psx_mtime = sb.st_mtime;
statbuf->psx_ctime = sb.st_ctime;
}
return erc;
}
} // extern "C"

42
libgcobol/posix/shim/stat.h Normal file
View File

@ -0,0 +1,42 @@
#include <cstdint>
/*
* This buffer definition matches the one in libgcobol/posix/cpy/statbuf.cpy.
* It is shared between
*
* libgcobol/posix/udf/posix-stat.cbl
* and
* libgcobol/posix/shim/stat.cc
*
* stat.cc copies information from the OS-defined stat buffer to this one.
*/
namespace cbl {
typedef uint64_t blkcnt_t;
typedef uint64_t blksize_t;
typedef uint64_t dev_t;
typedef uint64_t gid_t;
typedef uint64_t ino_t;
typedef uint64_t mode_t;
typedef uint64_t nlink_t;
typedef uint64_t off_t;
typedef uint64_t time_t;
typedef uint64_t uid_t;
};
struct posix_stat_t {
cbl::dev_t st_dev; /* ID of device containing file */
cbl::ino_t st_ino; /* Inode number */
cbl::mode_t st_mode; /* File type and mode */
cbl::nlink_t st_nlink; /* Number of hard links */
cbl::uid_t st_uid; /* User ID of owner */
cbl::gid_t st_gid; /* Group ID of owner */
cbl::dev_t st_rdev; /* Device ID (if special file) */
cbl::off_t st_size; /* Total size, in bytes */
cbl::blksize_t st_blksize; /* Block size for filesystem I/O */
cbl::blkcnt_t st_blocks; /* Number of 512B blocks allocated */
// Cannot use st_atime etc because they are defined in the preprocessor.
cbl::time_t psx_atime; /* Time of last access */
cbl::time_t psx_mtime; /* Time of last modification */
cbl::time_t psx_ctime; /* Time of last status change */
};

0
libgcobol/posix/tm.h → libgcobol/posix/shim/tm.h
View File

90
libgcobol/posix/stat.cc
View File

@ -1,90 +0,0 @@
#include <assert.h>
#include <stddef.h>
#include <stdio.h>
#include <unistd.h>
#include <sys/types.h>
#include <sys/stat.h>
extern "C" {
#include "stat.h"
int
posix_stat(const char *pathname, struct posix_stat_t *statbuf, size_t size) {
struct stat sb;
int erc = stat(pathname, &sb);
if( sizeof(struct posix_stat_t) != size ) {
fprintf(stderr, "posix_stat %lu != received size %lu\n",
(unsigned long)sizeof(struct posix_stat_t),
(unsigned long)size);
}
assert(sizeof(struct posix_stat_t) == size);
assert(statbuf);
if( erc == 0 ) {
statbuf->st_dev = sb.st_dev;
statbuf->st_ino = sb.st_ino;
statbuf->st_mode = sb.st_mode;
statbuf->st_nlink = sb.st_nlink;
statbuf->st_uid = sb.st_uid;
statbuf->st_gid = sb.st_gid;
statbuf->st_rdev = sb.st_rdev;
statbuf->st_size = sb.st_size;
statbuf->st_blksize = sb.st_blksize;
statbuf->st_blocks = sb.st_blocks;
statbuf->st_atim = sb.st_atim.tv_sec;
statbuf->st_mtim = sb.st_mtim.tv_sec;
statbuf->st_ctim = sb.st_ctim.tv_sec;
}
if( 0 ) {
printf("%4lu: st_dev: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_dev),
(unsigned long)statbuf->st_dev, (unsigned long)sb.st_dev);
printf("%4lu: st_ino: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_ino),
(unsigned long)statbuf->st_ino, (unsigned long)sb.st_ino);
printf("%4lu: st_mode: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_mode),
(unsigned long)statbuf->st_mode, (unsigned long)sb.st_mode);
printf("%4lu: st_nlink: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_nlink),
(unsigned long)statbuf->st_nlink, (unsigned long)sb.st_nlink);
printf("%4lu: st_uid: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_uid),
(unsigned long)statbuf->st_uid, (unsigned long)sb.st_uid);
printf("%4lu: st_gid: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_gid),
(unsigned long)statbuf->st_gid, (unsigned long)sb.st_gid);
printf("%4lu: st_rdev: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_rdev),
(unsigned long)statbuf->st_rdev, (unsigned long)sb.st_rdev);
printf("%4lu: st_size: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_size),
(unsigned long)statbuf->st_size, (unsigned long)sb.st_size);
printf("%4lu: st_blksize: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_blksize),
(unsigned long)statbuf->st_blksize, (unsigned long)sb.st_blksize);
printf("%4lu: st_blocks: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_blocks),
(unsigned long)statbuf->st_blocks, (unsigned long)sb.st_blocks);
printf("%4lu: st_atim: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_atim),
(unsigned long)statbuf->st_atim, (unsigned long)sb.st_atim.tv_sec);
printf("%4lu: st_mtim: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_mtim),
(unsigned long)statbuf->st_mtim, (unsigned long)sb.st_mtim.tv_sec);
printf("%4lu: st_ctim: %lu = %lu\n",
(unsigned long)offsetof(struct posix_stat_t, st_ctim),
(unsigned long)statbuf->st_ctim, (unsigned long)sb.st_ctim.tv_sec);
}
return erc;
}
} // extern "C"

15
libgcobol/posix/stat.h
View File

@ -1,15 +0,0 @@
struct posix_stat_t {
dev_t st_dev; /* ID of device containing file */
ino_t st_ino; /* Inode number */
mode_t st_mode; /* File type and mode */
nlink_t st_nlink; /* Number of hard links */
uid_t st_uid; /* User ID of owner */
gid_t st_gid; /* Group ID of owner */
dev_t st_rdev; /* Device ID (if special file) */
off_t st_size; /* Total size, in bytes */
blksize_t st_blksize; /* Block size for filesystem I/O */
blkcnt_t st_blocks; /* Number of 512B blocks allocated */
time_t st_atim; /* Time of last access */
time_t st_mtim; /* Time of last modification */
time_t st_ctim; /* Time of last status change */
};

36
libgcobol/posix/t/Makefile Normal file
View File

@ -0,0 +1,36 @@
.SUFFIXES: .scr .cbl
#
# Ensure UDFs compile and run without crashing.
#
# COBCFLAGS is defined by the user
COBC = gcobol
LDFLAGS = -L $$(pwd) -Wl,-rpath -Wl,$$(pwd)
TESTS = errno exit localtime stat
# Default target builds the tests
all: $(TESTS)
% : %.cbl
$(COBC) -o $@ $(COBCFLAGS) -I. -I../cpy -I../udf $(LDFLAGS) $<
exit: ../udf/posix-exit.cbl
errno: ../udf/posix-mkdir.cbl
stat: ../udf/posix-stat.cbl
localtime: ../udf/posix-stat.cbl
# Run the tests
test: $(TESTS)
@$(foreach P,$(TESTS),echo $(P):; ./$(P);)
clean:
rm -f *.o $(basename $(wildcard *.cbl))

31
libgcobol/posix/t/errno.cbl Normal file
View File

@ -0,0 +1,31 @@
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This program is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
COPY posix-mkdir.
COPY posix-errno.
Identification Division.
Program-ID. test-errno.
Data Division.
Working-Storage Section.
77 Return-Value Binary-Long.
77 Exit-Status Binary-Long Value 1.
77 error-msg PIC X(100).
77 errnum Binary-Long.
77 Filename PIC X(100) Value '/'.
Procedure Division.
Display 'calling posix-mkdir with a foolish name ...'
Move Function posix-mkdir(Filename, 0) to Return-Value.
If Return-Value <> 0
Display 'calling posix-errno ...'
Move Function posix-errno(error-msg) to errnum
Display 'error: "' Filename '": ' error-msg ' (' errnum ')'
Goback with Error Status errnum
Else
Display 'Return-Value is ' Return-Value
End-If.
Goback.

20
libgcobol/posix/t/exit.cbl Normal file
View File

@ -0,0 +1,20 @@
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This program is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
COPY posix-exit.
Identification Division.
Program-ID. test-exit.
Data Division.
Working-Storage Section.
77 Return-Value Binary-Long.
77 Exit-Status Binary-Long Value 1.
Procedure Division.
Display 'calling posix-exit ...'
Move Function posix-exit(Exit-Status) to Return-Value.
* Does not return, Does not print
Display 'How did we get here?'
Goback.

52
libgcobol/posix/t/localtime.cbl Normal file
View File

@ -0,0 +1,52 @@
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This program is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Include the posix-stat and posix-localtime functions.
COPY posix-stat.
COPY posix-localtime.
COPY posix-errno.
Identification Division.
Program-ID. test-localtime.
Data Division.
Working-Storage Section.
77 Return-Value Usage Binary-Long.
77 Stat-Status Usage Binary-Long Value 1.
77 Filename Pic x(80) Value 'Makefile'.
77 Msg Pic x(100).
01 Lk-statbuf.
COPY statbuf.
01 Lk-tm.
COPY tm.
01 Today.
02 tm_year PIC 9999.
02 tm_mon PIC 99.
02 tm_wday PIC 99.
Procedure Division.
Display 'calling posix-stat for ' Function Trim(Filename) ' ...'
Move Function posix-stat(Filename, lk-statbuf) to Return-Value.
Display 'posix-stat returned: ' Return-Value.
If Return-Value < 0 then
Display Function Trim(Filename) ': '
'errno ', Function posix-errno(Msg), ': ' Msg
Goback.
Display 'calling posix-localtime ...'
Move Function posix-localtime(st_mtime, lk-tm) to Return-Value.
Display 'posix-localtime returned: ' Return-Value.
If Return-Value < 0 then
Display 'posix-localtime: ', Function Trim(Filename) ': '
'errno ', Function posix-errno(Msg), ': ' Msg
' (st_mtime ' st_mtime ')'
Goback.
Move Corresponding Lk-tm to Today.
Add 1900 to tm_year of Today.
Display "'" Function trim(Filename) "'"
' (st_mtime ' st_mtime ') modified '
tm_year of Today '-'
tm_mon of Today '-'
tm_wday of Today.
Goback.

29
libgcobol/posix/t/stat.cbl Normal file
View File

@ -0,0 +1,29 @@
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This program is in the public domain.
* Contributed by James K. Lowden of Cobolworx in October 2025
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* Include the posix-stat function
COPY posix-stat.
COPY posix-errno.
Identification Division.
Program-ID. test-stat.
Data Division.
Working-Storage Section.
77 Return-Value Usage Binary-Long.
77 Stat-Status Usage Binary-Long Value 1.
77 Filename Pic x(80) Value 'Makefile'.
77 Msg Pic x(100).
01 Lk-statbuf.
COPY statbuf.
Procedure Division.
Display 'calling posix-stat ...'
Move Function posix-stat(Filename, lk-statbuf) to Return-Value.
Display 'posix-stat return value:' Return-Value.
If Return-Value < 0 then
Display Function Trim(Filename) ': '
'errno ', Function posix-errno(Msg), ': ' Msg.
Goback.

12
libgcobol/posix/udf/posix-exit.cbl Normal file
View File

@ -0,0 +1,12 @@
Identification Division.
Function-ID. posix-exit.
Data Division.
Linkage Section.
77 Return-Value Binary-Long.
77 Exit-Status Binary-Long.
Procedure Division using Exit-Status Returning Return-Value.
CALL "_exit" using by value Exit-Status.
Goback.
END FUNCTION posix-exit.

35
libgcobol/posix/udf/posix-localtime.cbl Normal file
View File

@ -0,0 +1,35 @@
* int stat(const char * pathname, struct stat * statbuf)
Identification Division.
Function-ID. posix-localtime.
Data Division.
Working-Storage Section.
77 bufsize Usage Binary-Long.
77 Tm-pointer Usage Pointer.
01 Lk-tm-posix Based.
COPY tm.
Linkage Section.
77 Return-Value Usage Binary-Long.
01 Lk-timep Usage Binary-Long.
01 Lk-tm.
COPY tm.
Procedure Division using
By Reference Lk-timep,
By Reference Lk-tm,
Returning Return-Value.
Move Function Length(Lk-tm-posix) to bufsize.
Call "posix_localtime" using
By Reference Lk-timep,
By Value bufsize,
Returning tm-pointer.
If tm-pointer = NULL
move -1 to Return-Value
Else
move 0 to Return-Value
set address of lk-tm-posix to tm-pointer
move lk-tm-posix to lk-tm.
Goback.
End Function posix-localtime.

21
libgcobol/posix/udf/posix-mkdir.cbl Normal file
View File

@ -0,0 +1,21 @@
Identification Division.
Function-ID. posix-mkdir.
Data Division.
Working-Storage Section.
77 bufsize Usage Binary-Long.
Linkage Section.
77 Return-Value Binary-Long.
01 Lk-pathname PIC X ANY LENGTH.
01 Lk-Mode Binary-Long.
Procedure Division using
By Reference Lk-pathname,
By Value Lk-Mode,
Returning Return-Value.
Inspect Backward Lk-pathname Replacing Leading Space By Low-Value
Call "mkdir" using
By Reference Lk-pathname,
By Value Lk-Mode,
Returning Return-Value.
Goback.
End Function posix-mkdir.

62
libgcobol/posix/udf/posix-stat.cbl Normal file
View File

@ -0,0 +1,62 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* int stat(const char * pathname, struct stat * statbuf)
Identification Division.
Function-ID. posix-stat.
Environment Division.
Configuration Section.
Source-Computer. Alpha-Romeo
>>IF DEBUGGING-MODE is Defined
With Debugging Mode
>>END-IF
.
Data Division.
Working-Storage Section.
77 bufsize Usage Binary-Long.
77 Ws-pathname PIC X(8192).
Linkage Section.
77 Return-Value Binary-Long.
01 Lk-pathname PIC X ANY LENGTH.
01 Lk-statbuf.
COPY statbuf.
Procedure Division using
By Reference Lk-pathname,
By Reference Lk-statbuf,
Returning Return-Value.
Move Lk-pathname To Ws-pathname.
Inspect Ws-pathname
Replacing Trailing Space By Low-Value
Move Function Byte-Length(Lk-statbuf) to bufsize.
D Display 'posix-stat: Ws-pathname ', Ws-pathname.
D Display 'posix-stat: Lk-statbuf has ', bufsize ' bytes'.
Call "posix_stat" using Ws-pathname, Lk-statbuf
By Value bufsize
Returning Return-Value.
D Perform Show-Statbuf.
Goback.
Show-Statbuf Section.
Display 'st_dev: ' st_dev.
Display 'st_ino: ' st_ino.
Display 'st_mode: ' st_mode.
Display 'st_nlink: ' st_nlink.
Display 'st_uid: ' st_uid.
Display 'st_gid: ' st_gid.
Display 'st_rdev: ' st_rdev.
Display 'st_size: ' st_size.
Display 'st_blksize: ' st_blksize.
Display 'st_blocks: ' st_blocks.
Display 'st_atime: ' st_atime.
Display 'st_mtime: ' st_mtime.
Display 'st_ctime: ' st_ctime.
End Function posix-stat.
>> POP SOURCE FORMAT

32
libgcobol/posix/udf/posix-unlink.cbl Normal file
View File

@ -0,0 +1,32 @@
>>PUSH SOURCE FORMAT
>>SOURCE FIXED
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This function is in the public domain.
* Contributed by
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Identification Division.
Function-ID. posix-unlink.
Data Division.
Working-Storage Section.
77 bufsize Usage Binary-Long.
77 Ws-pathname PIC X(8192).
Linkage Section.
77 Return-Value Binary-Long.
01 Lk-pathname PIC X ANY LENGTH.
Procedure Division using
By Reference Lk-pathname,
Returning Return-Value.
Move Lk-pathname To Ws-pathname.
Inspect Ws-pathname
Replacing Trailing Space By Low-Value
Inspect Backward Ws-pathname Replacing Leading Space,
- By Low-Value.
Call "unlink" using
By Reference Ws-pathname,
Returning Return-Value.
Goback.
End Function posix-unlink.
>> POP SOURCE FORMAT

26
libgcobol/valconv.cc
View File

@ -145,7 +145,7 @@ expand_picture(char *dest, const char *picture)
*d++ = ch; *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: // We are going to be mapping ch to a string in the final result:
prior_ch = ch; prior_ch = ch;
@ -160,8 +160,9 @@ expand_picture(char *dest, const char *picture)
if( currency_symbol ) if( currency_symbol )
{ {
size_t sign_length = strlen(__gg__currency_signs[currency_symbol]) - 1; size_t sign_length = __gg__currency_signs[currency_symbol].size();
if( sign_length ) assert(0 < sign_length);
if( --sign_length )
{ {
char *pcurrency = strchr(dest, currency_symbol); char *pcurrency = strchr(dest, currency_symbol);
assert(pcurrency); assert(pcurrency);
@ -279,10 +280,10 @@ __gg__string_to_numeric_edited( char * const dest,
for(int i=0; i<dlength; i++) for(int i=0; i<dlength; i++)
{ {
int ch = (unsigned int)dest[i] & 0xFF; int ch = (unsigned int)dest[i] & 0xFF;
if( __gg__currency_signs[ch] ) if( ! __gg__currency_signs[ch].empty() )
{ {
currency_picture = ch; currency_picture = ch;
currency_sign = __gg__currency_signs[ch]; currency_sign = __gg__currency_signs[ch].c_str();
break; break;
} }
} }
@ -1276,23 +1277,18 @@ __gg__string_to_alpha_edited( char *dest,
extern "C" extern "C"
void void
__gg__currency_sign_init() __gg__currency_sign_init() // This duplicates the constructor.
{ {
for(int symbol=0; symbol<256; symbol++) for( auto str : __gg__currency_signs ) {
{ str.clear();
if( __gg__currency_signs[symbol] ) }
{
free(__gg__currency_signs[symbol]);
__gg__currency_signs[symbol] = NULL;
}
}
} }
extern "C" extern "C"
void void
__gg__currency_sign(int symbol, const char *sign) __gg__currency_sign(int symbol, const char *sign)
{ {
__gg__currency_signs[symbol] = strdup(sign); __gg__currency_signs[symbol] = sign;
__gg__default_currency_sign = *sign; __gg__default_currency_sign = *sign;
} }

12
libgcobol/xmlparse.cc
View File

@ -408,7 +408,6 @@ static void fatalError(void * CTX, const char * msg, ...)
} }
#if 0 #if 0
static xmlEntityPtr getEntity(void * CTX, static xmlEntityPtr getEntity(void * CTX,
const xmlChar * name) const xmlChar * name)
{ SAYSO_DATAZ(name); } { SAYSO_DATAZ(name); }
@ -618,6 +617,7 @@ xmlchar_of( const char input[] ) {
static const char * static const char *
xmlParserErrors_str( xmlParserErrors erc, const char name[] ) { xmlParserErrors_str( xmlParserErrors erc, const char name[] ) {
const char *msg = "???"; const char *msg = "???";
switch( erc ) { switch( erc ) {
case XML_ERR_OK: case XML_ERR_OK:
msg = "Success"; msg = "Success";
@ -675,7 +675,8 @@ static class context_t {
/* Avoid a NULL entry. */ /* Avoid a NULL entry. */
static const char * const ident = "unnamed_COBOL_program"; static const char * const ident = "unnamed_COBOL_program";
#endif #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. // Library listens to program, not to the environment.
openlog(ident, option, facility); openlog(ident, option, facility);
@ -683,7 +684,9 @@ static class context_t {
} }
void 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 ) { if( ! ctxt ) {
init(); init();
} }
@ -712,7 +715,6 @@ static class context_t {
} }
} }
protected: protected:
void init() { void init() {
const char *external_entities = nullptr; const char *external_entities = nullptr;
@ -724,7 +726,7 @@ static class context_t {
} context; } context;
static int 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 input_offset,
size_t len, size_t len,
cblc_field_t *encoding __attribute__ ((unused)), cblc_field_t *encoding __attribute__ ((unused)),