mirror of git://gcc.gnu.org/git/gcc.git
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
parent
a784ed8dad
commit
08e9df2546
|
|
@ -151,6 +151,9 @@ void input_file_status_notify();
|
|||
cdfval_t operator/( const cdfval_base_t& lhs, const cdfval_base_t& rhs );
|
||||
cdfval_t negate( cdfval_base_t lhs );
|
||||
|
||||
cbl_field_t
|
||||
cdf_literalize( const std::string& name, const cdfval_t& value );
|
||||
|
||||
}
|
||||
|
||||
%{
|
||||
|
|
@ -353,6 +356,11 @@ cdf_define: CDF_DEFINE cdf_constant NAME as cdf_expr[value] override
|
|||
}
|
||||
YYERROR;
|
||||
}
|
||||
if( symbols_begin() < symbols_end() ) {
|
||||
cbl_field_t field = cdf_literalize($NAME, $value);
|
||||
symbol_field_add(current_program_index(), &field);
|
||||
}
|
||||
|
||||
}
|
||||
| CDF_DEFINE cdf_constant NAME '=' cdf_expr[value] override
|
||||
{ /* accept, but as error */
|
||||
|
|
@ -952,3 +960,5 @@ cdfval_base_t::operator()( const YDFLTYPE& loc ) {
|
|||
// cppcheck-suppress returnTempReference
|
||||
return verify_integer(loc, *this) ? *this : zero;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -5145,8 +5145,8 @@ parser_alphabet( const cbl_alphabet_t& alphabet )
|
|||
|
||||
case custom_encoding_e:
|
||||
{
|
||||
#pragma message "Use program-id to disambiguate"
|
||||
size_t alphabet_index = symbol_index(symbol_elem_of(&alphabet));
|
||||
#pragma message "Verify program-id is disambiguated"
|
||||
size_t alphabet_index = symbol_unique_index(symbol_elem_of(&alphabet));
|
||||
|
||||
unsigned char ach[256];
|
||||
|
||||
|
|
@ -7166,7 +7166,6 @@ initialize_the_data()
|
|||
build_int_cst_type(INT, current_encoding(national_encoding_e)),
|
||||
NULL_TREE);
|
||||
|
||||
__gg__currency_signs = __gg__ct_currency_signs;
|
||||
// We initialize currency both at compile time and run time
|
||||
__gg__currency_sign_init();
|
||||
gg_call(VOID,
|
||||
|
|
@ -9911,8 +9910,8 @@ parser_file_add(struct cbl_file_t *file)
|
|||
__func__);
|
||||
}
|
||||
|
||||
#pragma message "Use program-id to disambiguate"
|
||||
size_t symbol_table_index = symbol_index(symbol_elem_of(file));
|
||||
#pragma message "Verify program-id is disambiguated"
|
||||
size_t symbol_table_index = symbol_unique_index(symbol_elem_of(file));
|
||||
|
||||
gg_call(VOID,
|
||||
"__gg__file_init",
|
||||
|
|
@ -14608,6 +14607,7 @@ void
|
|||
parser_exception_file( cbl_field_t *tgt, cbl_file_t *file)
|
||||
{
|
||||
Analyze();
|
||||
RETURN_IF_PARSE_ONLY;
|
||||
gg_call(VOID,
|
||||
"__gg__func_exception_file",
|
||||
gg_get_address_of(tgt->var_decl_node),
|
||||
|
|
|
|||
|
|
@ -2397,7 +2397,7 @@ config_paragraph:
|
|||
| SOURCE_COMPUTER '.' NAME '.'
|
||||
| SOURCE_COMPUTER '.' NAME with_debug '.'
|
||||
| OBJECT_COMPUTER '.'
|
||||
| OBJECT_COMPUTER '.' NAME[computer] collations '.'
|
||||
| OBJECT_COMPUTER '.' NAME[computer] object_computer '.'
|
||||
| REPOSITORY dot
|
||||
| REPOSITORY dot repo_members '.'
|
||||
;
|
||||
|
|
@ -2528,7 +2528,7 @@ with_debug: with DEBUGGING MODE {
|
|||
}
|
||||
;
|
||||
|
||||
collations: %empty
|
||||
object_computer: %empty
|
||||
| char_classification
|
||||
| collating_sequence
|
||||
| char_classification collating_sequence
|
||||
|
|
@ -4842,13 +4842,15 @@ value_clause: VALUE all LITERAL[lit] {
|
|||
}
|
||||
if( $value != NULLS ) {
|
||||
auto fig = constant_of(constant_index($value));
|
||||
current_field()->data.initial = fig->data.initial;
|
||||
cbl_field_t *field = current_field();
|
||||
field->data.initial = fig->data.initial;
|
||||
}
|
||||
}
|
||||
| /* VALUE is */ NULLPTR
|
||||
{
|
||||
auto fig = constant_of(constant_index(NULLS));
|
||||
current_field()->data.initial = fig->data.initial;
|
||||
cbl_field_t *field = current_field();
|
||||
field->data.initial = fig->data.initial;
|
||||
}
|
||||
| VALUE error
|
||||
{
|
||||
|
|
@ -4938,10 +4940,13 @@ any_length: ANY LENGTH
|
|||
if( field->attr & any_length_e ) {
|
||||
error_msg(@1, "ANY LENGTH already set");
|
||||
}
|
||||
const char *prog_name = current.program()->name;
|
||||
bool is_compat = 0 < compat_programs.count(prog_name);
|
||||
if( ! (field->level == 1 &&
|
||||
current_data_section == linkage_datasect_e &&
|
||||
(1 < current.program_level() ||
|
||||
current.program()->is_function())) ) {
|
||||
current.program()->is_function() ||
|
||||
is_compat)) ) {
|
||||
error_msg(@1, "ANY LENGTH valid only for 01 "
|
||||
"in LINKAGE SECTION of a function or contained program");
|
||||
YYERROR;
|
||||
|
|
@ -10338,11 +10343,13 @@ go_to: GOTO labels[args]
|
|||
resume: RESUME NEXT STATEMENT
|
||||
{
|
||||
statement_begin(@1, RESUME);
|
||||
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
|
||||
parser_clear_exception();
|
||||
}
|
||||
| RESUME label_1[tgt]
|
||||
{
|
||||
statement_begin(@1, RESUME);
|
||||
if( dialect_proscribed( @1, dialect_ibm_e, "RESUME") ) YYERROR;
|
||||
parser_clear_exception();
|
||||
$tgt->used = @1.first_line;
|
||||
parser_goto( cbl_refer_t(), 1, &$tgt );
|
||||
|
|
@ -10708,11 +10715,10 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
|
|||
const auto returning = cbl_field_of(symbol_at(L->returning));
|
||||
$$ = new_temporary_clone(returning);
|
||||
$$->data.initial = returning->name; // user's name for the field
|
||||
cbl_field_attr_t call_attr
|
||||
= (cbl_field_attr_t)(quoted_e|hex_encoded_e);
|
||||
cbl_field_t *name = new_literal(strlen(L->name),
|
||||
L->name,
|
||||
call_attr);
|
||||
|
||||
// Pretend hex-encoded because that means use verbatim.
|
||||
auto attr = cbl_field_attr_t(quoted_e | hex_encoded_e);
|
||||
auto name = new_literal(strlen(L->name), L->name, attr);
|
||||
ast_call( @1, name, $$, narg, args, NULL, NULL, true );
|
||||
}
|
||||
;
|
||||
|
|
@ -12083,6 +12089,7 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returnin
|
|||
name.field->data, 77 };
|
||||
called.attr |= name.field->attr;
|
||||
snprintf(called.name, sizeof(called.name), "_%s", name.field->data.initial);
|
||||
called.attr |= name.field->attr;
|
||||
name.field = cbl_field_of(symbol_field_add(PROGRAM, &called));
|
||||
symbol_field_location(field_index(name.field), loc);
|
||||
parser_symbol_add(name.field);
|
||||
|
|
|
|||
|
|
@ -111,6 +111,15 @@ extern int yydebug;
|
|||
|
||||
#include <cstdarg>
|
||||
|
||||
// These programs in libgcobol/compat are allowed to use ANY LENGTH even though
|
||||
// they look like top-level programs.
|
||||
static const std::set<std::string> compat_programs {
|
||||
"CBL_ALLOC_MEM",
|
||||
"CBL_CHECK_FILE_EXIST",
|
||||
"CBL_DELETE_FILE",
|
||||
"CBL_FREE_MEM",
|
||||
};
|
||||
|
||||
const char *
|
||||
consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
|
||||
cbl_field_t faux = {};
|
||||
|
|
@ -180,6 +189,15 @@ has_clause( int data_clauses, data_clause_t clause ) {
|
|||
return clause == (data_clauses & clause);
|
||||
}
|
||||
|
||||
static bool
|
||||
dialect_proscribed( const YYLTYPE& loc, cbl_dialect_t dialect, const char msg[] ) {
|
||||
if( dialect == cbl_dialects ) {
|
||||
error_msg(loc, "dialect %s does not allow syntax: %qs",
|
||||
cbl_dialect_str(dialect), msg);
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
static bool
|
||||
is_cobol_charset( const char name[] ) {
|
||||
|
|
@ -2521,9 +2539,9 @@ intrinsic_call_2( cbl_field_t *tgt, int token, const cbl_refer_t *r1, cbl_refer_
|
|||
error_msg(args[n].loc, "invalid parameter '%s'", args[n].field->name);
|
||||
return false;
|
||||
}
|
||||
const char *fund = intrinsic_cname(token);
|
||||
if( !fund ) return false;
|
||||
parser_intrinsic_call_2( tgt, fund, args[0], args[1] );
|
||||
const char *func = intrinsic_cname(token);
|
||||
if( !func ) return false;
|
||||
parser_intrinsic_call_2( tgt, func, args[0], args[1] );
|
||||
return true;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -572,7 +572,7 @@ REVERSED { return REVERSED; }
|
|||
RETURN { return RETURN; }
|
||||
RESTRICTED { return RESTRICTED; }
|
||||
|
||||
RESUME {
|
||||
RESUME { // RESUME is ISO syntax, not IBM.
|
||||
if( ! dialect_ibm() ) return RESUME;
|
||||
yylval.string = xstrdup(yytext);
|
||||
return typed_name(yytext);
|
||||
|
|
|
|||
|
|
@ -1862,6 +1862,7 @@ symbols_update( size_t first, bool parsed_ok ) {
|
|||
__func__,
|
||||
3 + cbl_field_type_str(field->type),
|
||||
(fmt_size_t)isym, field->name, field->data.capacity);
|
||||
gcc_unreachable();
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
|
@ -2187,12 +2188,9 @@ symbol_field_parent_set( cbl_field_t *field )
|
|||
return NULL;
|
||||
}
|
||||
prior->type = FldGroup;
|
||||
prior->codeset.set();
|
||||
//// if( ! prior->codeset.set() ) { // maybe just ignore?
|
||||
//// Dubner sez: Ignore. This was triggering with -finternal-ebcdic
|
||||
//// ERROR_FIELD(prior, "%qs is already National", prior->name);
|
||||
//// return NULL;
|
||||
//// }
|
||||
if( ! prior->codeset.set() ) { // needs attention
|
||||
dbgmsg("'%s' is already National", prior->name);
|
||||
}
|
||||
field->attr |= numeric_group_attrs(prior);
|
||||
}
|
||||
// verify level 88 domain value
|
||||
|
|
@ -2250,6 +2248,8 @@ add_token( symbol_elem_t sym ) {
|
|||
return sym;
|
||||
}
|
||||
|
||||
const std::list<cbl_field_t> cdf_literalize();
|
||||
|
||||
/*
|
||||
* When adding special registers, be sure to create the actual cblc_field_t
|
||||
* in libgcobol/constants.cc.
|
||||
|
|
@ -2455,6 +2455,14 @@ symbol_table_init(void) {
|
|||
table.nelem = p - table.elems;
|
||||
assert(table.nelem < table.capacity);
|
||||
|
||||
// Add any CDF values already defined as literals.
|
||||
// After symbols are ready, the CDF adds them directly.
|
||||
const std::list<cbl_field_t> cdf_values = cdf_literalize();
|
||||
table.nelem += cdf_values.size();
|
||||
assert(table.nelem < table.capacity);
|
||||
|
||||
p = std::transform(cdf_values.begin(), cdf_values.end(), p, elementize);
|
||||
|
||||
// Initialize symbol table.
|
||||
symbols = table;
|
||||
|
||||
|
|
|
|||
|
|
@ -57,6 +57,17 @@ enum cbl_dialect_t {
|
|||
dialect_gnu_e = 0x04,
|
||||
};
|
||||
|
||||
static inline const char *
|
||||
cbl_dialect_str(cbl_dialect_t dialect) {
|
||||
switch(dialect) {
|
||||
case dialect_gcc_e: return "gcc";
|
||||
case dialect_ibm_e: return "ibm";
|
||||
case dialect_mf_e: return "mf";
|
||||
case dialect_gnu_e: return "gnu";
|
||||
}
|
||||
return "???";
|
||||
};
|
||||
|
||||
// Dialects may be combined.
|
||||
extern unsigned int cbl_dialects;
|
||||
void cobol_dialect_set( cbl_dialect_t dialect );
|
||||
|
|
@ -143,11 +154,6 @@ const char * cbl_field_attr_str( cbl_field_attr_t attr );
|
|||
|
||||
cbl_field_attr_t literal_attr( const char prefix[] );
|
||||
|
||||
static inline bool
|
||||
is_working_storage(uint32_t attr) {
|
||||
return 0 == (attr & (linkage_e | local_e));
|
||||
}
|
||||
|
||||
int cbl_figconst_tok( const char *value );
|
||||
enum cbl_figconst_t cbl_figconst_of( const char *value );
|
||||
const char * cbl_figconst_str( cbl_figconst_t fig );
|
||||
|
|
@ -391,6 +397,26 @@ struct cbl_field_data_t {
|
|||
return valify();
|
||||
}
|
||||
|
||||
// If initial (of Numeric Edited) has any length but capacity, adjust it.
|
||||
bool manhandle_initial() {
|
||||
assert(capacity > 0);
|
||||
assert(initial != nullptr);
|
||||
if( capacity < strlen(initial) ) {
|
||||
char *p = const_cast<char*>(initial);
|
||||
p[capacity] = '\0';
|
||||
return true;
|
||||
}
|
||||
if( strlen(initial) < capacity ) {
|
||||
auto tgt = reinterpret_cast<char *>( xmalloc(capacity + 1) );
|
||||
auto pend = tgt + capacity;
|
||||
auto p = std::copy(initial, initial + strlen(initial), tgt);
|
||||
std::fill(p, pend, 0x20);
|
||||
p = pend - 1;
|
||||
*p = '\0';
|
||||
initial = tgt;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
bool initial_within_capacity() const {
|
||||
return initial[capacity] == '\0'
|
||||
|| initial[capacity] == '!';
|
||||
|
|
@ -630,7 +656,7 @@ struct cbl_field_t {
|
|||
uint32_t level = 0, const cbl_name_t name = "", int line = 0 )
|
||||
: offset(0), type(type), usage(FldInvalid), attr(attr)
|
||||
, parent(0), our_index(0), level(level)
|
||||
, line(line), file(0), data(data)
|
||||
, line(line), name(""), file(0), data(data)
|
||||
, var_decl_node(nullptr), data_decl_node(nullptr)
|
||||
{
|
||||
gcc_assert(strlen(name) < sizeof this->name);
|
||||
|
|
@ -1539,15 +1565,6 @@ struct cbl_section_t {
|
|||
}
|
||||
gcc_unreachable();
|
||||
}
|
||||
uint32_t attr() const {
|
||||
switch(type) {
|
||||
case file_sect_e:
|
||||
case working_sect_e: return 0;
|
||||
case linkage_sect_e: return linkage_e;
|
||||
case local_sect_e: return local_e;
|
||||
}
|
||||
gcc_unreachable();
|
||||
}
|
||||
};
|
||||
|
||||
struct cbl_locale_t {
|
||||
|
|
@ -2273,6 +2290,8 @@ struct cbl_until_addresses_t {
|
|||
|
||||
size_t symbol_index(); // nth after first program symbol
|
||||
size_t symbol_index( const symbol_elem_t *e );
|
||||
size_t symbol_unique_index( const struct symbol_elem_t *e );
|
||||
|
||||
struct symbol_elem_t * symbol_at( size_t index );
|
||||
|
||||
struct cbl_options_t {
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
// generated by /home/jklowden/projects/3rd/gcc/parser/gcc/cobol/token_names.h.gen cobol/parse.h
|
||||
// Mon Oct 20 14:11:39 EDT 2025
|
||||
// generated by ./token_names.h.gen ../../build/gcc/cobol/parse.h
|
||||
// Tue Nov 11 22:26:46 EST 2025
|
||||
tokens = {
|
||||
{ "identification", IDENTIFICATION_DIV }, // 258
|
||||
{ "environment", ENVIRONMENT_DIV }, // 259
|
||||
|
|
@ -502,209 +502,210 @@ tokens = {
|
|||
{ "reserve", RESERVE }, // 751
|
||||
{ "restricted", RESTRICTED }, // 752
|
||||
{ "resume", RESUME }, // 753
|
||||
{ "reverse", REVERSE }, // 754
|
||||
{ "reversed", REVERSED }, // 755
|
||||
{ "rewind", REWIND }, // 756
|
||||
{ "rf", RF }, // 757
|
||||
{ "rh", RH }, // 758
|
||||
{ "right", RIGHT }, // 759
|
||||
{ "rounded", ROUNDED }, // 760
|
||||
{ "run", RUN }, // 761
|
||||
{ "same", SAME }, // 762
|
||||
{ "screen", SCREEN }, // 763
|
||||
{ "sd", SD }, // 764
|
||||
{ "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 765
|
||||
{ "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 766
|
||||
{ "security", SECURITY }, // 767
|
||||
{ "separate", SEPARATE }, // 768
|
||||
{ "sequence", SEQUENCE }, // 769
|
||||
{ "sequential", SEQUENTIAL }, // 770
|
||||
{ "sharing", SHARING }, // 771
|
||||
{ "simple-exit", SIMPLE_EXIT }, // 772
|
||||
{ "sign", SIGN }, // 773
|
||||
{ "sin", SIN }, // 774
|
||||
{ "size", SIZE }, // 775
|
||||
{ "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 776
|
||||
{ "source", SOURCE }, // 777
|
||||
{ "source-computer", SOURCE_COMPUTER }, // 778
|
||||
{ "special-names", SPECIAL_NAMES }, // 779
|
||||
{ "sqrt", SQRT }, // 780
|
||||
{ "stack", STACK }, // 781
|
||||
{ "standard", STANDARD }, // 782
|
||||
{ "standard-1", STANDARD_1 }, // 783
|
||||
{ "standard-deviation", STANDARD_DEVIATION }, // 784
|
||||
{ "standard-compare", STANDARD_COMPARE }, // 785
|
||||
{ "status", STATUS }, // 786
|
||||
{ "strong", STRONG }, // 787
|
||||
{ "substitute", SUBSTITUTE }, // 788
|
||||
{ "sum", SUM }, // 789
|
||||
{ "symbol", SYMBOL }, // 790
|
||||
{ "symbolic", SYMBOLIC }, // 791
|
||||
{ "synchronized", SYNCHRONIZED }, // 792
|
||||
{ "tallying", TALLYING }, // 793
|
||||
{ "tan", TAN }, // 794
|
||||
{ "terminate", TERMINATE }, // 795
|
||||
{ "test", TEST }, // 796
|
||||
{ "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 797
|
||||
{ "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 798
|
||||
{ "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 799
|
||||
{ "test-numval", TEST_NUMVAL }, // 800
|
||||
{ "test-numval-c", TEST_NUMVAL_C }, // 801
|
||||
{ "test-numval-f", TEST_NUMVAL_F }, // 802
|
||||
{ "than", THAN }, // 803
|
||||
{ "time", TIME }, // 804
|
||||
{ "times", TIMES }, // 805
|
||||
{ "to", TO }, // 806
|
||||
{ "top", TOP }, // 807
|
||||
{ "top-level", TOP_LEVEL }, // 808
|
||||
{ "tracks", TRACKS }, // 809
|
||||
{ "track-area", TRACK_AREA }, // 810
|
||||
{ "trailing", TRAILING }, // 811
|
||||
{ "transform", TRANSFORM }, // 812
|
||||
{ "trim", TRIM }, // 813
|
||||
{ "true", TRUE_kw }, // 814
|
||||
{ "try", TRY }, // 815
|
||||
{ "turn", TURN }, // 816
|
||||
{ "type", TYPE }, // 817
|
||||
{ "typedef", TYPEDEF }, // 818
|
||||
{ "ulength", ULENGTH }, // 819
|
||||
{ "unbounded", UNBOUNDED }, // 820
|
||||
{ "unit", UNIT }, // 821
|
||||
{ "units", UNITS }, // 822
|
||||
{ "unit-record", UNIT_RECORD }, // 823
|
||||
{ "until", UNTIL }, // 824
|
||||
{ "up", UP }, // 825
|
||||
{ "upon", UPON }, // 826
|
||||
{ "upos", UPOS }, // 827
|
||||
{ "upper-case", UPPER_CASE }, // 828
|
||||
{ "usage", USAGE }, // 829
|
||||
{ "using", USING }, // 830
|
||||
{ "usubstr", USUBSTR }, // 831
|
||||
{ "usupplementary", USUPPLEMENTARY }, // 832
|
||||
{ "utility", UTILITY }, // 833
|
||||
{ "uuid4", UUID4 }, // 834
|
||||
{ "uvalid", UVALID }, // 835
|
||||
{ "uwidth", UWIDTH }, // 836
|
||||
{ "validating", VALIDATING }, // 837
|
||||
{ "value", VALUE }, // 838
|
||||
{ "variance", VARIANCE }, // 839
|
||||
{ "varying", VARYING }, // 840
|
||||
{ "volatile", VOLATILE }, // 841
|
||||
{ "when-compiled", WHEN_COMPILED }, // 842
|
||||
{ "with", WITH }, // 843
|
||||
{ "working-storage", WORKING_STORAGE }, // 844
|
||||
{ "year-to-yyyy", YEAR_TO_YYYY }, // 845
|
||||
{ "yyyyddd", YYYYDDD }, // 846
|
||||
{ "yyyymmdd", YYYYMMDD }, // 847
|
||||
{ "arithmetic", ARITHMETIC }, // 848
|
||||
{ "attribute", ATTRIBUTE }, // 849
|
||||
{ "auto", AUTO }, // 850
|
||||
{ "automatic", AUTOMATIC }, // 851
|
||||
{ "away-from-zero", AWAY_FROM_ZERO }, // 852
|
||||
{ "background-color", BACKGROUND_COLOR }, // 853
|
||||
{ "bell", BELL }, // 854
|
||||
{ "binary-encoding", BINARY_ENCODING }, // 855
|
||||
{ "blink", BLINK }, // 856
|
||||
{ "capacity", CAPACITY }, // 857
|
||||
{ "center", CENTER }, // 858
|
||||
{ "classification", CLASSIFICATION }, // 859
|
||||
{ "cycle", CYCLE }, // 860
|
||||
{ "decimal-encoding", DECIMAL_ENCODING }, // 861
|
||||
{ "entry-convention", ENTRY_CONVENTION }, // 862
|
||||
{ "eol", EOL }, // 863
|
||||
{ "eos", EOS }, // 864
|
||||
{ "erase", ERASE }, // 865
|
||||
{ "expands", EXPANDS }, // 866
|
||||
{ "float-binary", FLOAT_BINARY }, // 867
|
||||
{ "float-decimal", FLOAT_DECIMAL }, // 868
|
||||
{ "foreground-color", FOREGROUND_COLOR }, // 869
|
||||
{ "forever", FOREVER }, // 870
|
||||
{ "full", FULL }, // 871
|
||||
{ "highlight", HIGHLIGHT }, // 872
|
||||
{ "high-order-left", HIGH_ORDER_LEFT }, // 873
|
||||
{ "high-order-right", HIGH_ORDER_RIGHT }, // 874
|
||||
{ "ignoring", IGNORING }, // 875
|
||||
{ "implements", IMPLEMENTS }, // 876
|
||||
{ "initialized", INITIALIZED }, // 877
|
||||
{ "intermediate", INTERMEDIATE }, // 878
|
||||
{ "lc-all", LC_ALL_kw }, // 879
|
||||
{ "lc-collate", LC_COLLATE_kw }, // 880
|
||||
{ "lc-ctype", LC_CTYPE_kw }, // 881
|
||||
{ "lc-messages", LC_MESSAGES_kw }, // 882
|
||||
{ "lc-monetary", LC_MONETARY_kw }, // 883
|
||||
{ "lc-numeric", LC_NUMERIC_kw }, // 884
|
||||
{ "lc-time", LC_TIME_kw }, // 885
|
||||
{ "lowlight", LOWLIGHT }, // 886
|
||||
{ "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 887
|
||||
{ "nearest-even", NEAREST_EVEN }, // 888
|
||||
{ "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 889
|
||||
{ "none", NONE }, // 890
|
||||
{ "normal", NORMAL }, // 891
|
||||
{ "numbers", NUMBERS }, // 892
|
||||
{ "prefixed", PREFIXED }, // 893
|
||||
{ "previous", PREVIOUS }, // 894
|
||||
{ "prohibited", PROHIBITED }, // 895
|
||||
{ "relation", RELATION }, // 896
|
||||
{ "required", REQUIRED }, // 897
|
||||
{ "reverse-video", REVERSE_VIDEO }, // 898
|
||||
{ "rounding", ROUNDING }, // 899
|
||||
{ "seconds", SECONDS }, // 900
|
||||
{ "secure", SECURE }, // 901
|
||||
{ "short", SHORT }, // 902
|
||||
{ "signed", SIGNED_kw }, // 903
|
||||
{ "standard-binary", STANDARD_BINARY }, // 904
|
||||
{ "standard-decimal", STANDARD_DECIMAL }, // 905
|
||||
{ "statement", STATEMENT }, // 906
|
||||
{ "step", STEP }, // 907
|
||||
{ "structure", STRUCTURE }, // 908
|
||||
{ "toward-greater", TOWARD_GREATER }, // 909
|
||||
{ "toward-lesser", TOWARD_LESSER }, // 910
|
||||
{ "truncation", TRUNCATION }, // 911
|
||||
{ "ucs-4", UCS_4 }, // 912
|
||||
{ "underline", UNDERLINE }, // 913
|
||||
{ "unsigned", UNSIGNED_kw }, // 914
|
||||
{ "utf-16", UTF_16 }, // 915
|
||||
{ "utf-8", UTF_8 }, // 916
|
||||
{ "xmlgenerate", XMLGENERATE }, // 917
|
||||
{ "xmlparse", XMLPARSE }, // 918
|
||||
{ "address", ADDRESS }, // 919
|
||||
{ "end-accept", END_ACCEPT }, // 920
|
||||
{ "end-add", END_ADD }, // 921
|
||||
{ "end-call", END_CALL }, // 922
|
||||
{ "end-compute", END_COMPUTE }, // 923
|
||||
{ "end-delete", END_DELETE }, // 924
|
||||
{ "end-display", END_DISPLAY }, // 925
|
||||
{ "end-divide", END_DIVIDE }, // 926
|
||||
{ "end-evaluate", END_EVALUATE }, // 927
|
||||
{ "end-multiply", END_MULTIPLY }, // 928
|
||||
{ "end-perform", END_PERFORM }, // 929
|
||||
{ "end-read", END_READ }, // 930
|
||||
{ "end-return", END_RETURN }, // 931
|
||||
{ "end-rewrite", END_REWRITE }, // 932
|
||||
{ "end-search", END_SEARCH }, // 933
|
||||
{ "end-start", END_START }, // 934
|
||||
{ "end-string", END_STRING }, // 935
|
||||
{ "end-subtract", END_SUBTRACT }, // 936
|
||||
{ "end-unstring", END_UNSTRING }, // 937
|
||||
{ "end-write", END_WRITE }, // 938
|
||||
{ "end-xml", END_XML }, // 939
|
||||
{ "end-if", END_IF }, // 940
|
||||
{ "attributes", ATTRIBUTES }, // 941
|
||||
{ "element", ELEMENT }, // 942
|
||||
{ "namespace", NAMESPACE }, // 943
|
||||
{ "namespace-prefix", NAMESPACE_PREFIX }, // 944
|
||||
{ "nonnumeric", NONNUMERIC }, // 946
|
||||
{ "xml-declaration", XML_DECLARATION }, // 947
|
||||
{ "thru", THRU }, // 949
|
||||
{ "through", THRU }, // 949
|
||||
{ "or", OR }, // 950
|
||||
{ "and", AND }, // 951
|
||||
{ "not", NOT }, // 952
|
||||
{ "ne", NE }, // 953
|
||||
{ "le", LE }, // 954
|
||||
{ "ge", GE }, // 955
|
||||
{ "pow", POW }, // 956
|
||||
{ "neg", NEG }, // 957
|
||||
{ "retry", RETRY }, // 754
|
||||
{ "reverse", REVERSE }, // 755
|
||||
{ "reversed", REVERSED }, // 756
|
||||
{ "rewind", REWIND }, // 757
|
||||
{ "rf", RF }, // 758
|
||||
{ "rh", RH }, // 759
|
||||
{ "right", RIGHT }, // 760
|
||||
{ "rounded", ROUNDED }, // 761
|
||||
{ "run", RUN }, // 762
|
||||
{ "same", SAME }, // 763
|
||||
{ "screen", SCREEN }, // 764
|
||||
{ "sd", SD }, // 765
|
||||
{ "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 766
|
||||
{ "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 767
|
||||
{ "security", SECURITY }, // 768
|
||||
{ "separate", SEPARATE }, // 769
|
||||
{ "sequence", SEQUENCE }, // 770
|
||||
{ "sequential", SEQUENTIAL }, // 771
|
||||
{ "sharing", SHARING }, // 772
|
||||
{ "simple-exit", SIMPLE_EXIT }, // 773
|
||||
{ "sign", SIGN }, // 774
|
||||
{ "sin", SIN }, // 775
|
||||
{ "size", SIZE }, // 776
|
||||
{ "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 777
|
||||
{ "source", SOURCE }, // 778
|
||||
{ "source-computer", SOURCE_COMPUTER }, // 779
|
||||
{ "special-names", SPECIAL_NAMES }, // 780
|
||||
{ "sqrt", SQRT }, // 781
|
||||
{ "stack", STACK }, // 782
|
||||
{ "standard", STANDARD }, // 783
|
||||
{ "standard-1", STANDARD_1 }, // 784
|
||||
{ "standard-deviation", STANDARD_DEVIATION }, // 785
|
||||
{ "standard-compare", STANDARD_COMPARE }, // 786
|
||||
{ "status", STATUS }, // 787
|
||||
{ "strong", STRONG }, // 788
|
||||
{ "substitute", SUBSTITUTE }, // 789
|
||||
{ "sum", SUM }, // 790
|
||||
{ "symbol", SYMBOL }, // 791
|
||||
{ "symbolic", SYMBOLIC }, // 792
|
||||
{ "synchronized", SYNCHRONIZED }, // 793
|
||||
{ "tallying", TALLYING }, // 794
|
||||
{ "tan", TAN }, // 795
|
||||
{ "terminate", TERMINATE }, // 796
|
||||
{ "test", TEST }, // 797
|
||||
{ "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 798
|
||||
{ "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 799
|
||||
{ "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 800
|
||||
{ "test-numval", TEST_NUMVAL }, // 801
|
||||
{ "test-numval-c", TEST_NUMVAL_C }, // 802
|
||||
{ "test-numval-f", TEST_NUMVAL_F }, // 803
|
||||
{ "than", THAN }, // 804
|
||||
{ "time", TIME }, // 805
|
||||
{ "times", TIMES }, // 806
|
||||
{ "to", TO }, // 807
|
||||
{ "top", TOP }, // 808
|
||||
{ "top-level", TOP_LEVEL }, // 809
|
||||
{ "tracks", TRACKS }, // 810
|
||||
{ "track-area", TRACK_AREA }, // 811
|
||||
{ "trailing", TRAILING }, // 812
|
||||
{ "transform", TRANSFORM }, // 813
|
||||
{ "trim", TRIM }, // 814
|
||||
{ "true", TRUE_kw }, // 815
|
||||
{ "try", TRY }, // 816
|
||||
{ "turn", TURN }, // 817
|
||||
{ "type", TYPE }, // 818
|
||||
{ "typedef", TYPEDEF }, // 819
|
||||
{ "ulength", ULENGTH }, // 820
|
||||
{ "unbounded", UNBOUNDED }, // 821
|
||||
{ "unit", UNIT }, // 822
|
||||
{ "units", UNITS }, // 823
|
||||
{ "unit-record", UNIT_RECORD }, // 824
|
||||
{ "until", UNTIL }, // 825
|
||||
{ "up", UP }, // 826
|
||||
{ "upon", UPON }, // 827
|
||||
{ "upos", UPOS }, // 828
|
||||
{ "upper-case", UPPER_CASE }, // 829
|
||||
{ "usage", USAGE }, // 830
|
||||
{ "using", USING }, // 831
|
||||
{ "usubstr", USUBSTR }, // 832
|
||||
{ "usupplementary", USUPPLEMENTARY }, // 833
|
||||
{ "utility", UTILITY }, // 834
|
||||
{ "uuid4", UUID4 }, // 835
|
||||
{ "uvalid", UVALID }, // 836
|
||||
{ "uwidth", UWIDTH }, // 837
|
||||
{ "validating", VALIDATING }, // 838
|
||||
{ "value", VALUE }, // 839
|
||||
{ "variance", VARIANCE }, // 840
|
||||
{ "varying", VARYING }, // 841
|
||||
{ "volatile", VOLATILE }, // 842
|
||||
{ "when-compiled", WHEN_COMPILED }, // 843
|
||||
{ "with", WITH }, // 844
|
||||
{ "working-storage", WORKING_STORAGE }, // 845
|
||||
{ "year-to-yyyy", YEAR_TO_YYYY }, // 846
|
||||
{ "yyyyddd", YYYYDDD }, // 847
|
||||
{ "yyyymmdd", YYYYMMDD }, // 848
|
||||
{ "arithmetic", ARITHMETIC }, // 849
|
||||
{ "attribute", ATTRIBUTE }, // 850
|
||||
{ "auto", AUTO }, // 851
|
||||
{ "automatic", AUTOMATIC }, // 852
|
||||
{ "away-from-zero", AWAY_FROM_ZERO }, // 853
|
||||
{ "background-color", BACKGROUND_COLOR }, // 854
|
||||
{ "bell", BELL }, // 855
|
||||
{ "binary-encoding", BINARY_ENCODING }, // 856
|
||||
{ "blink", BLINK }, // 857
|
||||
{ "capacity", CAPACITY }, // 858
|
||||
{ "center", CENTER }, // 859
|
||||
{ "classification", CLASSIFICATION }, // 860
|
||||
{ "cycle", CYCLE }, // 861
|
||||
{ "decimal-encoding", DECIMAL_ENCODING }, // 862
|
||||
{ "entry-convention", ENTRY_CONVENTION }, // 863
|
||||
{ "eol", EOL }, // 864
|
||||
{ "eos", EOS }, // 865
|
||||
{ "erase", ERASE }, // 866
|
||||
{ "expands", EXPANDS }, // 867
|
||||
{ "float-binary", FLOAT_BINARY }, // 868
|
||||
{ "float-decimal", FLOAT_DECIMAL }, // 869
|
||||
{ "foreground-color", FOREGROUND_COLOR }, // 870
|
||||
{ "forever", FOREVER }, // 871
|
||||
{ "full", FULL }, // 872
|
||||
{ "highlight", HIGHLIGHT }, // 873
|
||||
{ "high-order-left", HIGH_ORDER_LEFT }, // 874
|
||||
{ "high-order-right", HIGH_ORDER_RIGHT }, // 875
|
||||
{ "ignoring", IGNORING }, // 876
|
||||
{ "implements", IMPLEMENTS }, // 877
|
||||
{ "initialized", INITIALIZED }, // 878
|
||||
{ "intermediate", INTERMEDIATE }, // 879
|
||||
{ "lc-all", LC_ALL_kw }, // 880
|
||||
{ "lc-collate", LC_COLLATE_kw }, // 881
|
||||
{ "lc-ctype", LC_CTYPE_kw }, // 882
|
||||
{ "lc-messages", LC_MESSAGES_kw }, // 883
|
||||
{ "lc-monetary", LC_MONETARY_kw }, // 884
|
||||
{ "lc-numeric", LC_NUMERIC_kw }, // 885
|
||||
{ "lc-time", LC_TIME_kw }, // 886
|
||||
{ "lowlight", LOWLIGHT }, // 887
|
||||
{ "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 888
|
||||
{ "nearest-even", NEAREST_EVEN }, // 889
|
||||
{ "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 890
|
||||
{ "none", NONE }, // 891
|
||||
{ "normal", NORMAL }, // 892
|
||||
{ "numbers", NUMBERS }, // 893
|
||||
{ "prefixed", PREFIXED }, // 894
|
||||
{ "previous", PREVIOUS }, // 895
|
||||
{ "prohibited", PROHIBITED }, // 896
|
||||
{ "relation", RELATION }, // 897
|
||||
{ "required", REQUIRED }, // 898
|
||||
{ "reverse-video", REVERSE_VIDEO }, // 899
|
||||
{ "rounding", ROUNDING }, // 900
|
||||
{ "seconds", SECONDS }, // 901
|
||||
{ "secure", SECURE }, // 902
|
||||
{ "short", SHORT }, // 903
|
||||
{ "signed", SIGNED_kw }, // 904
|
||||
{ "standard-binary", STANDARD_BINARY }, // 905
|
||||
{ "standard-decimal", STANDARD_DECIMAL }, // 906
|
||||
{ "statement", STATEMENT }, // 907
|
||||
{ "step", STEP }, // 908
|
||||
{ "structure", STRUCTURE }, // 909
|
||||
{ "toward-greater", TOWARD_GREATER }, // 910
|
||||
{ "toward-lesser", TOWARD_LESSER }, // 911
|
||||
{ "truncation", TRUNCATION }, // 912
|
||||
{ "ucs-4", UCS_4 }, // 913
|
||||
{ "underline", UNDERLINE }, // 914
|
||||
{ "unsigned", UNSIGNED_kw }, // 915
|
||||
{ "utf-16", UTF_16 }, // 916
|
||||
{ "utf-8", UTF_8 }, // 917
|
||||
{ "xmlgenerate", XMLGENERATE }, // 918
|
||||
{ "xmlparse", XMLPARSE }, // 919
|
||||
{ "address", ADDRESS }, // 920
|
||||
{ "end-accept", END_ACCEPT }, // 921
|
||||
{ "end-add", END_ADD }, // 922
|
||||
{ "end-call", END_CALL }, // 923
|
||||
{ "end-compute", END_COMPUTE }, // 924
|
||||
{ "end-delete", END_DELETE }, // 925
|
||||
{ "end-display", END_DISPLAY }, // 926
|
||||
{ "end-divide", END_DIVIDE }, // 927
|
||||
{ "end-evaluate", END_EVALUATE }, // 928
|
||||
{ "end-multiply", END_MULTIPLY }, // 929
|
||||
{ "end-perform", END_PERFORM }, // 930
|
||||
{ "end-read", END_READ }, // 931
|
||||
{ "end-return", END_RETURN }, // 932
|
||||
{ "end-rewrite", END_REWRITE }, // 933
|
||||
{ "end-search", END_SEARCH }, // 934
|
||||
{ "end-start", END_START }, // 935
|
||||
{ "end-string", END_STRING }, // 936
|
||||
{ "end-subtract", END_SUBTRACT }, // 937
|
||||
{ "end-unstring", END_UNSTRING }, // 938
|
||||
{ "end-write", END_WRITE }, // 939
|
||||
{ "end-xml", END_XML }, // 940
|
||||
{ "end-if", END_IF }, // 941
|
||||
{ "attributes", ATTRIBUTES }, // 942
|
||||
{ "element", ELEMENT }, // 943
|
||||
{ "namespace", NAMESPACE }, // 944
|
||||
{ "namespace-prefix", NAMESPACE_PREFIX }, // 945
|
||||
{ "nonnumeric", NONNUMERIC }, // 947
|
||||
{ "xml-declaration", XML_DECLARATION }, // 948
|
||||
{ "thru", THRU }, // 950
|
||||
{ "through", THRU }, // 950
|
||||
{ "or", OR }, // 951
|
||||
{ "and", AND }, // 952
|
||||
{ "not", NOT }, // 953
|
||||
{ "ne", NE }, // 954
|
||||
{ "le", LE }, // 955
|
||||
{ "ge", GE }, // 956
|
||||
{ "pow", POW }, // 957
|
||||
{ "neg", NEG }, // 958
|
||||
};
|
||||
|
||||
// cppcheck-suppress useInitializationList
|
||||
|
|
@ -1205,206 +1206,207 @@ token_names = {
|
|||
"RESERVE", // 493 (751)
|
||||
"RESTRICTED", // 494 (752)
|
||||
"RESUME", // 495 (753)
|
||||
"REVERSE", // 496 (754)
|
||||
"REVERSED", // 497 (755)
|
||||
"REWIND", // 498 (756)
|
||||
"RF", // 499 (757)
|
||||
"RH", // 500 (758)
|
||||
"RIGHT", // 501 (759)
|
||||
"ROUNDED", // 502 (760)
|
||||
"RUN", // 503 (761)
|
||||
"SAME", // 504 (762)
|
||||
"SCREEN", // 505 (763)
|
||||
"SD", // 506 (764)
|
||||
"SECONDS-FROM-FORMATTED-TIME", // 507 (765)
|
||||
"SECONDS-PAST-MIDNIGHT", // 508 (766)
|
||||
"SECURITY", // 509 (767)
|
||||
"SEPARATE", // 510 (768)
|
||||
"SEQUENCE", // 511 (769)
|
||||
"SEQUENTIAL", // 512 (770)
|
||||
"SHARING", // 513 (771)
|
||||
"SIMPLE-EXIT", // 514 (772)
|
||||
"SIGN", // 515 (773)
|
||||
"SIN", // 516 (774)
|
||||
"SIZE", // 517 (775)
|
||||
"SMALLEST-ALGEBRAIC", // 518 (776)
|
||||
"SOURCE", // 519 (777)
|
||||
"SOURCE-COMPUTER", // 520 (778)
|
||||
"SPECIAL-NAMES", // 521 (779)
|
||||
"SQRT", // 522 (780)
|
||||
"STACK", // 523 (781)
|
||||
"STANDARD", // 524 (782)
|
||||
"STANDARD-1", // 525 (783)
|
||||
"STANDARD-DEVIATION", // 526 (784)
|
||||
"STANDARD-COMPARE", // 527 (785)
|
||||
"STATUS", // 528 (786)
|
||||
"STRONG", // 529 (787)
|
||||
"SUBSTITUTE", // 530 (788)
|
||||
"SUM", // 531 (789)
|
||||
"SYMBOL", // 532 (790)
|
||||
"SYMBOLIC", // 533 (791)
|
||||
"SYNCHRONIZED", // 534 (792)
|
||||
"TALLYING", // 535 (793)
|
||||
"TAN", // 536 (794)
|
||||
"TERMINATE", // 537 (795)
|
||||
"TEST", // 538 (796)
|
||||
"TEST-DATE-YYYYMMDD", // 539 (797)
|
||||
"TEST-DAY-YYYYDDD", // 540 (798)
|
||||
"TEST-FORMATTED-DATETIME", // 541 (799)
|
||||
"TEST-NUMVAL", // 542 (800)
|
||||
"TEST-NUMVAL-C", // 543 (801)
|
||||
"TEST-NUMVAL-F", // 544 (802)
|
||||
"THAN", // 545 (803)
|
||||
"TIME", // 546 (804)
|
||||
"TIMES", // 547 (805)
|
||||
"TO", // 548 (806)
|
||||
"TOP", // 549 (807)
|
||||
"TOP-LEVEL", // 550 (808)
|
||||
"TRACKS", // 551 (809)
|
||||
"TRACK-AREA", // 552 (810)
|
||||
"TRAILING", // 553 (811)
|
||||
"TRANSFORM", // 554 (812)
|
||||
"TRIM", // 555 (813)
|
||||
"TRUE", // 556 (814)
|
||||
"TRY", // 557 (815)
|
||||
"TURN", // 558 (816)
|
||||
"TYPE", // 559 (817)
|
||||
"TYPEDEF", // 560 (818)
|
||||
"ULENGTH", // 561 (819)
|
||||
"UNBOUNDED", // 562 (820)
|
||||
"UNIT", // 563 (821)
|
||||
"UNITS", // 564 (822)
|
||||
"UNIT-RECORD", // 565 (823)
|
||||
"UNTIL", // 566 (824)
|
||||
"UP", // 567 (825)
|
||||
"UPON", // 568 (826)
|
||||
"UPOS", // 569 (827)
|
||||
"UPPER-CASE", // 570 (828)
|
||||
"USAGE", // 571 (829)
|
||||
"USING", // 572 (830)
|
||||
"USUBSTR", // 573 (831)
|
||||
"USUPPLEMENTARY", // 574 (832)
|
||||
"UTILITY", // 575 (833)
|
||||
"UUID4", // 576 (834)
|
||||
"UVALID", // 577 (835)
|
||||
"UWIDTH", // 578 (836)
|
||||
"VALIDATING", // 579 (837)
|
||||
"VALUE", // 580 (838)
|
||||
"VARIANCE", // 581 (839)
|
||||
"VARYING", // 582 (840)
|
||||
"VOLATILE", // 583 (841)
|
||||
"WHEN-COMPILED", // 584 (842)
|
||||
"WITH", // 585 (843)
|
||||
"WORKING-STORAGE", // 586 (844)
|
||||
"YEAR-TO-YYYY", // 587 (845)
|
||||
"YYYYDDD", // 588 (846)
|
||||
"YYYYMMDD", // 589 (847)
|
||||
"ARITHMETIC", // 590 (848)
|
||||
"ATTRIBUTE", // 591 (849)
|
||||
"AUTO", // 592 (850)
|
||||
"AUTOMATIC", // 593 (851)
|
||||
"AWAY-FROM-ZERO", // 594 (852)
|
||||
"BACKGROUND-COLOR", // 595 (853)
|
||||
"BELL", // 596 (854)
|
||||
"BINARY-ENCODING", // 597 (855)
|
||||
"BLINK", // 598 (856)
|
||||
"CAPACITY", // 599 (857)
|
||||
"CENTER", // 600 (858)
|
||||
"CLASSIFICATION", // 601 (859)
|
||||
"CYCLE", // 602 (860)
|
||||
"DECIMAL-ENCODING", // 603 (861)
|
||||
"ENTRY-CONVENTION", // 604 (862)
|
||||
"EOL", // 605 (863)
|
||||
"EOS", // 606 (864)
|
||||
"ERASE", // 607 (865)
|
||||
"EXPANDS", // 608 (866)
|
||||
"FLOAT-BINARY", // 609 (867)
|
||||
"FLOAT-DECIMAL", // 610 (868)
|
||||
"FOREGROUND-COLOR", // 611 (869)
|
||||
"FOREVER", // 612 (870)
|
||||
"FULL", // 613 (871)
|
||||
"HIGHLIGHT", // 614 (872)
|
||||
"HIGH-ORDER-LEFT", // 615 (873)
|
||||
"HIGH-ORDER-RIGHT", // 616 (874)
|
||||
"IGNORING", // 617 (875)
|
||||
"IMPLEMENTS", // 618 (876)
|
||||
"INITIALIZED", // 619 (877)
|
||||
"INTERMEDIATE", // 620 (878)
|
||||
"LC-ALL", // 621 (879)
|
||||
"LC-COLLATE", // 622 (880)
|
||||
"LC-CTYPE", // 623 (881)
|
||||
"LC-MESSAGES", // 624 (882)
|
||||
"LC-MONETARY", // 625 (883)
|
||||
"LC-NUMERIC", // 626 (884)
|
||||
"LC-TIME", // 627 (885)
|
||||
"LOWLIGHT", // 628 (886)
|
||||
"NEAREST-AWAY-FROM-ZERO", // 629 (887)
|
||||
"NEAREST-EVEN", // 630 (888)
|
||||
"NEAREST-TOWARD-ZERO", // 631 (889)
|
||||
"NONE", // 632 (890)
|
||||
"NORMAL", // 633 (891)
|
||||
"NUMBERS", // 634 (892)
|
||||
"PREFIXED", // 635 (893)
|
||||
"PREVIOUS", // 636 (894)
|
||||
"PROHIBITED", // 637 (895)
|
||||
"RELATION", // 638 (896)
|
||||
"REQUIRED", // 639 (897)
|
||||
"REVERSE-VIDEO", // 640 (898)
|
||||
"ROUNDING", // 641 (899)
|
||||
"SECONDS", // 642 (900)
|
||||
"SECURE", // 643 (901)
|
||||
"SHORT", // 644 (902)
|
||||
"SIGNED", // 645 (903)
|
||||
"STANDARD-BINARY", // 646 (904)
|
||||
"STANDARD-DECIMAL", // 647 (905)
|
||||
"STATEMENT", // 648 (906)
|
||||
"STEP", // 649 (907)
|
||||
"STRUCTURE", // 650 (908)
|
||||
"TOWARD-GREATER", // 651 (909)
|
||||
"TOWARD-LESSER", // 652 (910)
|
||||
"TRUNCATION", // 653 (911)
|
||||
"UCS-4", // 654 (912)
|
||||
"UNDERLINE", // 655 (913)
|
||||
"UNSIGNED", // 656 (914)
|
||||
"UTF-16", // 657 (915)
|
||||
"UTF-8", // 658 (916)
|
||||
"XMLGENERATE", // 659 (917)
|
||||
"XMLPARSE", // 660 (918)
|
||||
"ADDRESS", // 661 (919)
|
||||
"END-ACCEPT", // 662 (920)
|
||||
"END-ADD", // 663 (921)
|
||||
"END-CALL", // 664 (922)
|
||||
"END-COMPUTE", // 665 (923)
|
||||
"END-DELETE", // 666 (924)
|
||||
"END-DISPLAY", // 667 (925)
|
||||
"END-DIVIDE", // 668 (926)
|
||||
"END-EVALUATE", // 669 (927)
|
||||
"END-MULTIPLY", // 670 (928)
|
||||
"END-PERFORM", // 671 (929)
|
||||
"END-READ", // 672 (930)
|
||||
"END-RETURN", // 673 (931)
|
||||
"END-REWRITE", // 674 (932)
|
||||
"END-SEARCH", // 675 (933)
|
||||
"END-START", // 676 (934)
|
||||
"END-STRING", // 677 (935)
|
||||
"END-SUBTRACT", // 678 (936)
|
||||
"END-UNSTRING", // 679 (937)
|
||||
"END-WRITE", // 680 (938)
|
||||
"END-XML", // 681 (939)
|
||||
"END-IF", // 682 (940)
|
||||
"ATTRIBUTES", // 683 (941)
|
||||
"ELEMENT", // 684 (942)
|
||||
"NAMESPACE", // 685 (943)
|
||||
"NAMESPACE-PREFIX", // 686 (944)
|
||||
"NONNUMERIC", // 688 (946)
|
||||
"XML-DECLARATION", // 689 (947)
|
||||
"THRU", // 691 (949)
|
||||
"OR", // 692 (950)
|
||||
"AND", // 693 (951)
|
||||
"NOT", // 694 (952)
|
||||
"NE", // 695 (953)
|
||||
"LE", // 696 (954)
|
||||
"GE", // 697 (955)
|
||||
"POW", // 698 (956)
|
||||
"NEG", // 699 (957)
|
||||
"RETRY", // 496 (754)
|
||||
"REVERSE", // 497 (755)
|
||||
"REVERSED", // 498 (756)
|
||||
"REWIND", // 499 (757)
|
||||
"RF", // 500 (758)
|
||||
"RH", // 501 (759)
|
||||
"RIGHT", // 502 (760)
|
||||
"ROUNDED", // 503 (761)
|
||||
"RUN", // 504 (762)
|
||||
"SAME", // 505 (763)
|
||||
"SCREEN", // 506 (764)
|
||||
"SD", // 507 (765)
|
||||
"SECONDS-FROM-FORMATTED-TIME", // 508 (766)
|
||||
"SECONDS-PAST-MIDNIGHT", // 509 (767)
|
||||
"SECURITY", // 510 (768)
|
||||
"SEPARATE", // 511 (769)
|
||||
"SEQUENCE", // 512 (770)
|
||||
"SEQUENTIAL", // 513 (771)
|
||||
"SHARING", // 514 (772)
|
||||
"SIMPLE-EXIT", // 515 (773)
|
||||
"SIGN", // 516 (774)
|
||||
"SIN", // 517 (775)
|
||||
"SIZE", // 518 (776)
|
||||
"SMALLEST-ALGEBRAIC", // 519 (777)
|
||||
"SOURCE", // 520 (778)
|
||||
"SOURCE-COMPUTER", // 521 (779)
|
||||
"SPECIAL-NAMES", // 522 (780)
|
||||
"SQRT", // 523 (781)
|
||||
"STACK", // 524 (782)
|
||||
"STANDARD", // 525 (783)
|
||||
"STANDARD-1", // 526 (784)
|
||||
"STANDARD-DEVIATION", // 527 (785)
|
||||
"STANDARD-COMPARE", // 528 (786)
|
||||
"STATUS", // 529 (787)
|
||||
"STRONG", // 530 (788)
|
||||
"SUBSTITUTE", // 531 (789)
|
||||
"SUM", // 532 (790)
|
||||
"SYMBOL", // 533 (791)
|
||||
"SYMBOLIC", // 534 (792)
|
||||
"SYNCHRONIZED", // 535 (793)
|
||||
"TALLYING", // 536 (794)
|
||||
"TAN", // 537 (795)
|
||||
"TERMINATE", // 538 (796)
|
||||
"TEST", // 539 (797)
|
||||
"TEST-DATE-YYYYMMDD", // 540 (798)
|
||||
"TEST-DAY-YYYYDDD", // 541 (799)
|
||||
"TEST-FORMATTED-DATETIME", // 542 (800)
|
||||
"TEST-NUMVAL", // 543 (801)
|
||||
"TEST-NUMVAL-C", // 544 (802)
|
||||
"TEST-NUMVAL-F", // 545 (803)
|
||||
"THAN", // 546 (804)
|
||||
"TIME", // 547 (805)
|
||||
"TIMES", // 548 (806)
|
||||
"TO", // 549 (807)
|
||||
"TOP", // 550 (808)
|
||||
"TOP-LEVEL", // 551 (809)
|
||||
"TRACKS", // 552 (810)
|
||||
"TRACK-AREA", // 553 (811)
|
||||
"TRAILING", // 554 (812)
|
||||
"TRANSFORM", // 555 (813)
|
||||
"TRIM", // 556 (814)
|
||||
"TRUE", // 557 (815)
|
||||
"TRY", // 558 (816)
|
||||
"TURN", // 559 (817)
|
||||
"TYPE", // 560 (818)
|
||||
"TYPEDEF", // 561 (819)
|
||||
"ULENGTH", // 562 (820)
|
||||
"UNBOUNDED", // 563 (821)
|
||||
"UNIT", // 564 (822)
|
||||
"UNITS", // 565 (823)
|
||||
"UNIT-RECORD", // 566 (824)
|
||||
"UNTIL", // 567 (825)
|
||||
"UP", // 568 (826)
|
||||
"UPON", // 569 (827)
|
||||
"UPOS", // 570 (828)
|
||||
"UPPER-CASE", // 571 (829)
|
||||
"USAGE", // 572 (830)
|
||||
"USING", // 573 (831)
|
||||
"USUBSTR", // 574 (832)
|
||||
"USUPPLEMENTARY", // 575 (833)
|
||||
"UTILITY", // 576 (834)
|
||||
"UUID4", // 577 (835)
|
||||
"UVALID", // 578 (836)
|
||||
"UWIDTH", // 579 (837)
|
||||
"VALIDATING", // 580 (838)
|
||||
"VALUE", // 581 (839)
|
||||
"VARIANCE", // 582 (840)
|
||||
"VARYING", // 583 (841)
|
||||
"VOLATILE", // 584 (842)
|
||||
"WHEN-COMPILED", // 585 (843)
|
||||
"WITH", // 586 (844)
|
||||
"WORKING-STORAGE", // 587 (845)
|
||||
"YEAR-TO-YYYY", // 588 (846)
|
||||
"YYYYDDD", // 589 (847)
|
||||
"YYYYMMDD", // 590 (848)
|
||||
"ARITHMETIC", // 591 (849)
|
||||
"ATTRIBUTE", // 592 (850)
|
||||
"AUTO", // 593 (851)
|
||||
"AUTOMATIC", // 594 (852)
|
||||
"AWAY-FROM-ZERO", // 595 (853)
|
||||
"BACKGROUND-COLOR", // 596 (854)
|
||||
"BELL", // 597 (855)
|
||||
"BINARY-ENCODING", // 598 (856)
|
||||
"BLINK", // 599 (857)
|
||||
"CAPACITY", // 600 (858)
|
||||
"CENTER", // 601 (859)
|
||||
"CLASSIFICATION", // 602 (860)
|
||||
"CYCLE", // 603 (861)
|
||||
"DECIMAL-ENCODING", // 604 (862)
|
||||
"ENTRY-CONVENTION", // 605 (863)
|
||||
"EOL", // 606 (864)
|
||||
"EOS", // 607 (865)
|
||||
"ERASE", // 608 (866)
|
||||
"EXPANDS", // 609 (867)
|
||||
"FLOAT-BINARY", // 610 (868)
|
||||
"FLOAT-DECIMAL", // 611 (869)
|
||||
"FOREGROUND-COLOR", // 612 (870)
|
||||
"FOREVER", // 613 (871)
|
||||
"FULL", // 614 (872)
|
||||
"HIGHLIGHT", // 615 (873)
|
||||
"HIGH-ORDER-LEFT", // 616 (874)
|
||||
"HIGH-ORDER-RIGHT", // 617 (875)
|
||||
"IGNORING", // 618 (876)
|
||||
"IMPLEMENTS", // 619 (877)
|
||||
"INITIALIZED", // 620 (878)
|
||||
"INTERMEDIATE", // 621 (879)
|
||||
"LC-ALL", // 622 (880)
|
||||
"LC-COLLATE", // 623 (881)
|
||||
"LC-CTYPE", // 624 (882)
|
||||
"LC-MESSAGES", // 625 (883)
|
||||
"LC-MONETARY", // 626 (884)
|
||||
"LC-NUMERIC", // 627 (885)
|
||||
"LC-TIME", // 628 (886)
|
||||
"LOWLIGHT", // 629 (887)
|
||||
"NEAREST-AWAY-FROM-ZERO", // 630 (888)
|
||||
"NEAREST-EVEN", // 631 (889)
|
||||
"NEAREST-TOWARD-ZERO", // 632 (890)
|
||||
"NONE", // 633 (891)
|
||||
"NORMAL", // 634 (892)
|
||||
"NUMBERS", // 635 (893)
|
||||
"PREFIXED", // 636 (894)
|
||||
"PREVIOUS", // 637 (895)
|
||||
"PROHIBITED", // 638 (896)
|
||||
"RELATION", // 639 (897)
|
||||
"REQUIRED", // 640 (898)
|
||||
"REVERSE-VIDEO", // 641 (899)
|
||||
"ROUNDING", // 642 (900)
|
||||
"SECONDS", // 643 (901)
|
||||
"SECURE", // 644 (902)
|
||||
"SHORT", // 645 (903)
|
||||
"SIGNED", // 646 (904)
|
||||
"STANDARD-BINARY", // 647 (905)
|
||||
"STANDARD-DECIMAL", // 648 (906)
|
||||
"STATEMENT", // 649 (907)
|
||||
"STEP", // 650 (908)
|
||||
"STRUCTURE", // 651 (909)
|
||||
"TOWARD-GREATER", // 652 (910)
|
||||
"TOWARD-LESSER", // 653 (911)
|
||||
"TRUNCATION", // 654 (912)
|
||||
"UCS-4", // 655 (913)
|
||||
"UNDERLINE", // 656 (914)
|
||||
"UNSIGNED", // 657 (915)
|
||||
"UTF-16", // 658 (916)
|
||||
"UTF-8", // 659 (917)
|
||||
"XMLGENERATE", // 660 (918)
|
||||
"XMLPARSE", // 661 (919)
|
||||
"ADDRESS", // 662 (920)
|
||||
"END-ACCEPT", // 663 (921)
|
||||
"END-ADD", // 664 (922)
|
||||
"END-CALL", // 665 (923)
|
||||
"END-COMPUTE", // 666 (924)
|
||||
"END-DELETE", // 667 (925)
|
||||
"END-DISPLAY", // 668 (926)
|
||||
"END-DIVIDE", // 669 (927)
|
||||
"END-EVALUATE", // 670 (928)
|
||||
"END-MULTIPLY", // 671 (929)
|
||||
"END-PERFORM", // 672 (930)
|
||||
"END-READ", // 673 (931)
|
||||
"END-RETURN", // 674 (932)
|
||||
"END-REWRITE", // 675 (933)
|
||||
"END-SEARCH", // 676 (934)
|
||||
"END-START", // 677 (935)
|
||||
"END-STRING", // 678 (936)
|
||||
"END-SUBTRACT", // 679 (937)
|
||||
"END-UNSTRING", // 680 (938)
|
||||
"END-WRITE", // 681 (939)
|
||||
"END-XML", // 682 (940)
|
||||
"END-IF", // 683 (941)
|
||||
"ATTRIBUTES", // 684 (942)
|
||||
"ELEMENT", // 685 (943)
|
||||
"NAMESPACE", // 686 (944)
|
||||
"NAMESPACE-PREFIX", // 687 (945)
|
||||
"NONNUMERIC", // 689 (947)
|
||||
"XML-DECLARATION", // 690 (948)
|
||||
"THRU", // 692 (950)
|
||||
"OR", // 693 (951)
|
||||
"AND", // 694 (952)
|
||||
"NOT", // 695 (953)
|
||||
"NE", // 696 (954)
|
||||
"LE", // 697 (955)
|
||||
"GE", // 698 (956)
|
||||
"POW", // 699 (957)
|
||||
"NEG", // 700 (958)
|
||||
};
|
||||
|
|
|
|||
|
|
@ -259,6 +259,46 @@ void cdf_pop_dictionary() { cdf_directives.dictionary.pop(); }
|
|||
void cdf_pop_enabled_exceptions() { cdf_directives.enabled_exceptions.pop(); }
|
||||
void cdf_pop_source_format() { cdf_directives.source_format.pop(); }
|
||||
|
||||
/*
|
||||
* Construct a cbl_field_t from a CDF literal, to be installed in the symbol table.
|
||||
*/
|
||||
cbl_field_t
|
||||
cdf_literalize( const std::string& name, const cdfval_t& value ) {
|
||||
cbl_field_t field;
|
||||
|
||||
if( value.is_numeric() ) {
|
||||
auto initial = xasprintf("%ld", (long)value.as_number());
|
||||
auto len = strlen(initial);
|
||||
cbl_field_data_t data(len, len);
|
||||
data.initial = initial;
|
||||
data.valify();
|
||||
field = cbl_field_t{ FldLiteralN, constant_e, data, 0, name.c_str()};
|
||||
} else {
|
||||
auto len = strlen(value.string);
|
||||
cbl_field_data_t data(len, len);
|
||||
data.initial = xstrdup(value.string);
|
||||
field = cbl_field_t{ FldLiteralA, constant_e, data, 0, name.c_str() };
|
||||
field.set_attr(quoted_e);
|
||||
}
|
||||
field.codeset.set();
|
||||
|
||||
return field;
|
||||
}
|
||||
|
||||
const std::list<cbl_field_t>
|
||||
cdf_literalize() {
|
||||
std::list<cbl_field_t> fields;
|
||||
auto dict = cdf_dictionary();
|
||||
|
||||
for( auto elem : dict ) {
|
||||
std::string name(elem.first);
|
||||
const cdfval_t& value(elem.second);
|
||||
|
||||
fields.push_back(cdf_literalize(name, value));
|
||||
}
|
||||
return fields;
|
||||
}
|
||||
|
||||
const char *
|
||||
symbol_type_str( enum symbol_type_t type )
|
||||
{
|
||||
|
|
@ -2089,6 +2129,19 @@ cobol_filename_restore() {
|
|||
linemap_add(line_table, LC_LEAVE, sysp, NULL, 0);
|
||||
}
|
||||
|
||||
size_t
|
||||
symbol_unique_index( const struct symbol_elem_t *e ) {
|
||||
assert(e);
|
||||
size_t usym = symbol_index(e);
|
||||
#if READY_FOR_INODE
|
||||
if( ! input_filenames.empty() ) {
|
||||
size_t inode = input_filenames.top().inode;
|
||||
usym = usym ^ inode;
|
||||
}
|
||||
#endif
|
||||
return usym;
|
||||
}
|
||||
|
||||
static int first_line_minus_1 = 0;
|
||||
static location_t token_location_minus_1 = 0;
|
||||
static location_t token_location = 0;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -30,6 +30,8 @@ if BUILD_LIBGCOBOL
|
|||
toolexeclib_LTLIBRARIES = libgcobol.la
|
||||
toolexeclib_DATA = libgcobol.spec
|
||||
|
||||
libsubincludedir = $(libdir)/gcc/cobol/$(target_noncanonical)/$(gcc_version)
|
||||
|
||||
##
|
||||
## 2.2.12 Automatic Dependency Tracking
|
||||
## Automake generates code for automatic dependency tracking by default
|
||||
|
|
@ -43,18 +45,31 @@ libgcobol_la_SOURCES = \
|
|||
intrinsic.cc \
|
||||
io.cc \
|
||||
libgcobol.cc \
|
||||
posix/errno.cc \
|
||||
posix/localtime.cc \
|
||||
posix/stat.cc \
|
||||
posix/shim/errno.cc \
|
||||
posix/shim/localtime.cc \
|
||||
posix/shim/stat.cc \
|
||||
stringbin.cc \
|
||||
valconv.cc \
|
||||
xmlparse.cc
|
||||
|
||||
libgcobol_la_LIBADD = -lxml2
|
||||
|
||||
nobase_libsubinclude_HEADERS = \
|
||||
posix/cpy/posix-errno.cbl \
|
||||
posix/cpy/statbuf.cpy \
|
||||
posix/udf/posix-exit.cbl \
|
||||
posix/udf/posix-localtime.cbl \
|
||||
posix/udf/posix-mkdir.cbl \
|
||||
posix/udf/posix-stat.cbl \
|
||||
posix/udf/posix-unlink.cbl \
|
||||
compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \
|
||||
compat/lib/gnu/CBL_ALLOC_MEM.cbl \
|
||||
compat/lib/gnu/CBL_DELETE_FILE.cbl \
|
||||
compat/lib/gnu/CBL_FREE_MEM.cbl
|
||||
|
||||
WARN_CFLAGS = -W -Wall -Wwrite-strings
|
||||
|
||||
AM_CPPFLAGS = -I. -I$(srcdir) -I$(srcdir)/posix $(LIBQUADINCLUDE)
|
||||
AM_CPPFLAGS = -I. -I posix/shim $(LIBQUADINCLUDE)
|
||||
AM_CPPFLAGS += -I /usr/include/libxml2
|
||||
|
||||
AM_CFLAGS = $(XCFLAGS)
|
||||
|
|
@ -73,7 +88,7 @@ endif
|
|||
libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
|
||||
version_arg = -version-info $(LIBGCOBOL_VERSION)
|
||||
libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \
|
||||
$(extra_ldflags_libgcobol) $(LIBS) -lxml2 $(version_arg)
|
||||
$(extra_ldflags_libgcobol) $(LIBS) $(version_arg)
|
||||
libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
|
||||
|
||||
endif BUILD_LIBGCOBOL
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@
|
|||
# Written de novo for libgcobol.
|
||||
|
||||
|
||||
|
||||
VPATH = @srcdir@
|
||||
am__is_gnu_make = { \
|
||||
if test -z '$(MAKELEVEL)'; then \
|
||||
|
|
@ -140,7 +141,7 @@ am__aclocal_m4_deps = $(top_srcdir)/../config/clang-plugin.m4 \
|
|||
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
|
||||
$(ACLOCAL_M4)
|
||||
DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \
|
||||
$(am__configure_deps)
|
||||
$(am__configure_deps) $(am__nobase_libsubinclude_HEADERS_DIST)
|
||||
am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
|
||||
configure.lineno config.status.lineno
|
||||
mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
|
||||
|
|
@ -175,15 +176,16 @@ am__uninstall_files_from_dir = { \
|
|||
$(am__cd) "$$dir" && rm -f $$files; }; \
|
||||
}
|
||||
am__installdirs = "$(DESTDIR)$(toolexeclibdir)" \
|
||||
"$(DESTDIR)$(toolexeclibdir)"
|
||||
"$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(libsubincludedir)"
|
||||
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
|
||||
am__dirstamp = $(am__leading_dot)dirstamp
|
||||
@BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_OBJECTS = charmaps.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ constants.lo gfileio.lo gmath.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ intrinsic.lo io.lo libgcobol.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/errno.lo posix/localtime.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/stat.lo stringbin.lo valconv.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ xmlparse.lo
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.lo stringbin.lo \
|
||||
@BUILD_LIBGCOBOL_TRUE@ valconv.lo xmlparse.lo
|
||||
libgcobol_la_OBJECTS = $(am_libgcobol_la_OBJECTS)
|
||||
@BUILD_LIBGCOBOL_TRUE@am_libgcobol_la_rpath = -rpath $(toolexeclibdir)
|
||||
AM_V_P = $(am__v_P_@AM_V@)
|
||||
|
|
@ -231,6 +233,15 @@ am__can_run_installinfo = \
|
|||
*) (install-info --version) >/dev/null 2>&1;; \
|
||||
esac
|
||||
DATA = $(toolexeclib_DATA)
|
||||
am__nobase_libsubinclude_HEADERS_DIST = posix/cpy/posix-errno.cbl \
|
||||
posix/cpy/statbuf.cpy posix/udf/posix-exit.cbl \
|
||||
posix/udf/posix-localtime.cbl posix/udf/posix-mkdir.cbl \
|
||||
posix/udf/posix-stat.cbl posix/udf/posix-unlink.cbl \
|
||||
compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \
|
||||
compat/lib/gnu/CBL_ALLOC_MEM.cbl \
|
||||
compat/lib/gnu/CBL_DELETE_FILE.cbl \
|
||||
compat/lib/gnu/CBL_FREE_MEM.cbl
|
||||
HEADERS = $(nobase_libsubinclude_HEADERS)
|
||||
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
|
||||
$(LISP)config.h.in
|
||||
# Read a list of newline-separated strings from the standard input,
|
||||
|
|
@ -402,6 +413,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
|
|||
# Skip the whole process if we are not building libgcobol.
|
||||
@BUILD_LIBGCOBOL_TRUE@toolexeclib_LTLIBRARIES = libgcobol.la
|
||||
@BUILD_LIBGCOBOL_TRUE@toolexeclib_DATA = libgcobol.spec
|
||||
@BUILD_LIBGCOBOL_TRUE@libsubincludedir = $(libdir)/gcc/cobol/$(target_noncanonical)/$(gcc_version)
|
||||
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_SOURCES = \
|
||||
@BUILD_LIBGCOBOL_TRUE@ charmaps.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ constants.cc \
|
||||
|
|
@ -410,16 +422,29 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
|
|||
@BUILD_LIBGCOBOL_TRUE@ intrinsic.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ io.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ libgcobol.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/errno.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/localtime.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/stat.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/errno.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/localtime.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/shim/stat.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ stringbin.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ valconv.cc \
|
||||
@BUILD_LIBGCOBOL_TRUE@ xmlparse.cc
|
||||
|
||||
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LIBADD = -lxml2
|
||||
@BUILD_LIBGCOBOL_TRUE@nobase_libsubinclude_HEADERS = \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/cpy/posix-errno.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/cpy/statbuf.cpy \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-exit.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-localtime.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-mkdir.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-stat.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ posix/udf/posix-unlink.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_CHECK_FILE_EXIST.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_ALLOC_MEM.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_DELETE_FILE.cbl \
|
||||
@BUILD_LIBGCOBOL_TRUE@ compat/lib/gnu/CBL_FREE_MEM.cbl
|
||||
|
||||
@BUILD_LIBGCOBOL_TRUE@WARN_CFLAGS = -W -Wall -Wwrite-strings
|
||||
@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I$(srcdir) -I$(srcdir)/posix \
|
||||
@BUILD_LIBGCOBOL_TRUE@AM_CPPFLAGS = -I. -I posix/shim \
|
||||
@BUILD_LIBGCOBOL_TRUE@ $(LIBQUADINCLUDE) -I \
|
||||
@BUILD_LIBGCOBOL_TRUE@ /usr/include/libxml2
|
||||
@BUILD_LIBGCOBOL_TRUE@AM_CFLAGS = $(XCFLAGS)
|
||||
|
|
@ -430,7 +455,7 @@ gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER)
|
|||
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LINK = $(CXXLINK) $(libgcobol_la_LDFLAGS)
|
||||
@BUILD_LIBGCOBOL_TRUE@version_arg = -version-info $(LIBGCOBOL_VERSION)
|
||||
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_LDFLAGS = $(LTLDFLAGS) $(LIBQUADLIB) $(LTLIBICONV) \
|
||||
@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) -lxml2 $(version_arg)
|
||||
@BUILD_LIBGCOBOL_TRUE@ $(extra_ldflags_libgcobol) $(LIBS) $(version_arg)
|
||||
|
||||
@BUILD_LIBGCOBOL_TRUE@libgcobol_la_DEPENDENCIES = libgcobol.spec $(LIBQUADLIB_DEP)
|
||||
all: config.h
|
||||
|
|
@ -523,24 +548,26 @@ clean-toolexeclibLTLIBRARIES:
|
|||
echo rm -f $${locs}; \
|
||||
rm -f $${locs}; \
|
||||
}
|
||||
posix/$(am__dirstamp):
|
||||
@$(MKDIR_P) posix
|
||||
@: > posix/$(am__dirstamp)
|
||||
posix/$(DEPDIR)/$(am__dirstamp):
|
||||
@$(MKDIR_P) posix/$(DEPDIR)
|
||||
@: > posix/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/errno.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/localtime.lo: posix/$(am__dirstamp) \
|
||||
posix/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/stat.lo: posix/$(am__dirstamp) posix/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/shim/$(am__dirstamp):
|
||||
@$(MKDIR_P) posix/shim
|
||||
@: > posix/shim/$(am__dirstamp)
|
||||
posix/shim/$(DEPDIR)/$(am__dirstamp):
|
||||
@$(MKDIR_P) posix/shim/$(DEPDIR)
|
||||
@: > posix/shim/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/shim/errno.lo: posix/shim/$(am__dirstamp) \
|
||||
posix/shim/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/shim/localtime.lo: posix/shim/$(am__dirstamp) \
|
||||
posix/shim/$(DEPDIR)/$(am__dirstamp)
|
||||
posix/shim/stat.lo: posix/shim/$(am__dirstamp) \
|
||||
posix/shim/$(DEPDIR)/$(am__dirstamp)
|
||||
|
||||
libgcobol.la: $(libgcobol_la_OBJECTS) $(libgcobol_la_DEPENDENCIES) $(EXTRA_libgcobol_la_DEPENDENCIES)
|
||||
$(AM_V_GEN)$(libgcobol_la_LINK) $(am_libgcobol_la_rpath) $(libgcobol_la_OBJECTS) $(libgcobol_la_LIBADD) $(LIBS)
|
||||
|
||||
mostlyclean-compile:
|
||||
-rm -f *.$(OBJEXT)
|
||||
-rm -f posix/*.$(OBJEXT)
|
||||
-rm -f posix/*.lo
|
||||
-rm -f posix/shim/*.$(OBJEXT)
|
||||
-rm -f posix/shim/*.lo
|
||||
|
||||
distclean-compile:
|
||||
-rm -f *.tab.c
|
||||
|
|
@ -555,9 +582,9 @@ distclean-compile:
|
|||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stringbin.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/valconv.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xmlparse.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/errno.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/localtime.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/$(DEPDIR)/stat.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/errno.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/localtime.Plo@am__quote@
|
||||
@AMDEP_TRUE@@am__include@ @am__quote@posix/shim/$(DEPDIR)/stat.Plo@am__quote@
|
||||
|
||||
.cc.o:
|
||||
@am__fastdepCXX_TRUE@ $(AM_V_CXX)depbase=`echo $@ | sed 's|[^/]*$$|$(DEPDIR)/&|;s|\.o$$||'`;\
|
||||
|
|
@ -588,7 +615,7 @@ mostlyclean-libtool:
|
|||
|
||||
clean-libtool:
|
||||
-rm -rf .libs _libs
|
||||
-rm -rf posix/.libs posix/_libs
|
||||
-rm -rf posix/shim/.libs posix/shim/_libs
|
||||
|
||||
distclean-libtool:
|
||||
-rm -f libtool config.lt
|
||||
|
|
@ -613,6 +640,30 @@ uninstall-toolexeclibDATA:
|
|||
@list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \
|
||||
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
|
||||
dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir)
|
||||
install-nobase_libsubincludeHEADERS: $(nobase_libsubinclude_HEADERS)
|
||||
@$(NORMAL_INSTALL)
|
||||
@list='$(nobase_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \
|
||||
if test -n "$$list"; then \
|
||||
echo " $(MKDIR_P) '$(DESTDIR)$(libsubincludedir)'"; \
|
||||
$(MKDIR_P) "$(DESTDIR)$(libsubincludedir)" || exit 1; \
|
||||
fi; \
|
||||
$(am__nobase_list) | while read dir files; do \
|
||||
xfiles=; for file in $$files; do \
|
||||
if test -f "$$file"; then xfiles="$$xfiles $$file"; \
|
||||
else xfiles="$$xfiles $(srcdir)/$$file"; fi; done; \
|
||||
test -z "$$xfiles" || { \
|
||||
test "x$$dir" = x. || { \
|
||||
echo " $(MKDIR_P) '$(DESTDIR)$(libsubincludedir)/$$dir'"; \
|
||||
$(MKDIR_P) "$(DESTDIR)$(libsubincludedir)/$$dir"; }; \
|
||||
echo " $(INSTALL_HEADER) $$xfiles '$(DESTDIR)$(libsubincludedir)/$$dir'"; \
|
||||
$(INSTALL_HEADER) $$xfiles "$(DESTDIR)$(libsubincludedir)/$$dir" || exit $$?; }; \
|
||||
done
|
||||
|
||||
uninstall-nobase_libsubincludeHEADERS:
|
||||
@$(NORMAL_UNINSTALL)
|
||||
@list='$(nobase_libsubinclude_HEADERS)'; test -n "$(libsubincludedir)" || list=; \
|
||||
$(am__nobase_strip_setup); files=`$(am__nobase_strip)`; \
|
||||
dir='$(DESTDIR)$(libsubincludedir)'; $(am__uninstall_files_from_dir)
|
||||
|
||||
ID: $(am__tagged_files)
|
||||
$(am__define_uniq_tagged_files); mkid -fID $$unique
|
||||
|
|
@ -674,9 +725,9 @@ distclean-tags:
|
|||
-rm -f cscope.out cscope.in.out cscope.po.out cscope.files
|
||||
check-am: all-am
|
||||
check: check-am
|
||||
all-am: Makefile $(LTLIBRARIES) $(DATA) config.h
|
||||
all-am: Makefile $(LTLIBRARIES) $(DATA) $(HEADERS) config.h
|
||||
installdirs:
|
||||
for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \
|
||||
for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(libsubincludedir)"; do \
|
||||
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
|
||||
done
|
||||
install: install-am
|
||||
|
|
@ -705,8 +756,8 @@ clean-generic:
|
|||
distclean-generic:
|
||||
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
|
||||
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
|
||||
-rm -f posix/$(DEPDIR)/$(am__dirstamp)
|
||||
-rm -f posix/$(am__dirstamp)
|
||||
-rm -f posix/shim/$(DEPDIR)/$(am__dirstamp)
|
||||
-rm -f posix/shim/$(am__dirstamp)
|
||||
|
||||
maintainer-clean-generic:
|
||||
@echo "This command is intended for maintainers to use"
|
||||
|
|
@ -718,7 +769,7 @@ clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
|
|||
|
||||
distclean: distclean-am
|
||||
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
|
||||
-rm -rf ./$(DEPDIR) posix/$(DEPDIR)
|
||||
-rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR)
|
||||
-rm -f Makefile
|
||||
distclean-am: clean-am distclean-compile distclean-generic \
|
||||
distclean-hdr distclean-libtool distclean-tags
|
||||
|
|
@ -735,7 +786,7 @@ info: info-am
|
|||
|
||||
info-am:
|
||||
|
||||
install-data-am:
|
||||
install-data-am: install-nobase_libsubincludeHEADERS
|
||||
|
||||
install-dvi: install-dvi-am
|
||||
|
||||
|
|
@ -767,7 +818,7 @@ installcheck-am:
|
|||
maintainer-clean: maintainer-clean-am
|
||||
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
|
||||
-rm -rf $(top_srcdir)/autom4te.cache
|
||||
-rm -rf ./$(DEPDIR) posix/$(DEPDIR)
|
||||
-rm -rf ./$(DEPDIR) posix/shim/$(DEPDIR)
|
||||
-rm -f Makefile
|
||||
maintainer-clean-am: distclean-am maintainer-clean-generic
|
||||
|
||||
|
|
@ -784,8 +835,8 @@ ps: ps-am
|
|||
|
||||
ps-am:
|
||||
|
||||
uninstall-am: uninstall-toolexeclibDATA \
|
||||
uninstall-toolexeclibLTLIBRARIES
|
||||
uninstall-am: uninstall-nobase_libsubincludeHEADERS \
|
||||
uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
|
||||
|
||||
.MAKE: all install-am install-strip
|
||||
|
||||
|
|
@ -797,14 +848,15 @@ uninstall-am: uninstall-toolexeclibDATA \
|
|||
html-am info info-am install install-am install-data \
|
||||
install-data-am install-dvi install-dvi-am install-exec \
|
||||
install-exec-am install-html install-html-am install-info \
|
||||
install-info-am install-man install-pdf install-pdf-am \
|
||||
install-info-am install-man \
|
||||
install-nobase_libsubincludeHEADERS install-pdf install-pdf-am \
|
||||
install-ps install-ps-am install-strip install-toolexeclibDATA \
|
||||
install-toolexeclibLTLIBRARIES installcheck installcheck-am \
|
||||
installdirs maintainer-clean maintainer-clean-generic \
|
||||
mostlyclean mostlyclean-compile mostlyclean-generic \
|
||||
mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \
|
||||
uninstall-am uninstall-toolexeclibDATA \
|
||||
uninstall-toolexeclibLTLIBRARIES
|
||||
uninstall-am uninstall-nobase_libsubincludeHEADERS \
|
||||
uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES
|
||||
|
||||
.PRECIOUS: Makefile
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ int __gg__decimal_separator = ',' ;
|
|||
int __gg__quote_character = '"' ;
|
||||
int __gg__low_value_character = 0x00 ;
|
||||
int __gg__high_value_character = 0xFF ;
|
||||
char **__gg__currency_signs ;
|
||||
std::vector<std::string> __gg__currency_signs(256) ;
|
||||
int __gg__default_currency_sign;
|
||||
char *__gg__ct_currency_signs[256]; // Compile-time currency signs
|
||||
|
||||
|
|
|
|||
|
|
@ -31,6 +31,9 @@
|
|||
#ifndef CHARMAPS_H
|
||||
#define CHARMAPS_H
|
||||
|
||||
#include <string>
|
||||
#include <vector>
|
||||
|
||||
#include <unistd.h>
|
||||
|
||||
/* There are four distinct codeset domains in the COBOL compiler.
|
||||
|
|
@ -108,11 +111,10 @@ extern int __gg__decimal_separator ;
|
|||
extern int __gg__quote_character ;
|
||||
extern int __gg__low_value_character ;
|
||||
extern int __gg__high_value_character ;
|
||||
extern char **__gg__currency_signs ;
|
||||
extern std::vector<std::string> __gg__currency_signs ;
|
||||
extern int __gg__default_currency_sign;
|
||||
extern cbl_encoding_t __gg__display_encoding ;
|
||||
extern cbl_encoding_t __gg__national_encoding ;
|
||||
extern char *__gg__ct_currency_signs[256]; // Compile-time currency signs
|
||||
|
||||
#define NULLCH ('\0')
|
||||
#define DEGENERATE_HIGH_VALUE 0xFF
|
||||
|
|
|
|||
|
|
@ -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`.
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
`
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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) $^
|
||||
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -55,6 +55,9 @@
|
|||
/* Define to 1 if you have the `random_r' function. */
|
||||
#undef HAVE_RANDOM_R
|
||||
|
||||
/* Define to 1 if you have the `xmlParseChunk' function. */
|
||||
#undef HAVE_SAX_XML_PARSER
|
||||
|
||||
/* Define to 1 if you have the `setstate_r' function. */
|
||||
#undef HAVE_SETSTATE_R
|
||||
|
||||
|
|
|
|||
|
|
@ -17650,6 +17650,100 @@ if test "$ac_res" != no; then :
|
|||
fi
|
||||
|
||||
|
||||
# These are libxml2.
|
||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xmlSAXUserParseMemory in -lxml2" >&5
|
||||
$as_echo_n "checking for xmlSAXUserParseMemory in -lxml2... " >&6; }
|
||||
if ${ac_cv_lib_xml2_xmlSAXUserParseMemory+:} false; then :
|
||||
$as_echo_n "(cached) " >&6
|
||||
else
|
||||
ac_check_lib_save_LIBS=$LIBS
|
||||
LIBS="-lxml2 $LIBS"
|
||||
if test x$gcc_no_link = xyes; then
|
||||
as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
|
||||
fi
|
||||
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
||||
/* end confdefs.h. */
|
||||
|
||||
/* Override any GCC internal prototype to avoid an error.
|
||||
Use char because int might match the return type of a GCC
|
||||
builtin and then its argument prototype would still apply. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
#endif
|
||||
char xmlSAXUserParseMemory ();
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return xmlSAXUserParseMemory ();
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
if ac_fn_cxx_try_link "$LINENO"; then :
|
||||
ac_cv_lib_xml2_xmlSAXUserParseMemory=yes
|
||||
else
|
||||
ac_cv_lib_xml2_xmlSAXUserParseMemory=no
|
||||
fi
|
||||
rm -f core conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
LIBS=$ac_check_lib_save_LIBS
|
||||
fi
|
||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_xmlSAXUserParseMemory" >&5
|
||||
$as_echo "$ac_cv_lib_xml2_xmlSAXUserParseMemory" >&6; }
|
||||
if test "x$ac_cv_lib_xml2_xmlSAXUserParseMemory" = xyes; then :
|
||||
LIBS="-lxml2 $LIBS"
|
||||
|
||||
$as_echo "#define HAVE_SAX_XML_PARSER 1" >>confdefs.h
|
||||
|
||||
fi
|
||||
|
||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xmlParseChunk in -lxml2" >&5
|
||||
$as_echo_n "checking for xmlParseChunk in -lxml2... " >&6; }
|
||||
if ${ac_cv_lib_xml2_xmlParseChunk+:} false; then :
|
||||
$as_echo_n "(cached) " >&6
|
||||
else
|
||||
ac_check_lib_save_LIBS=$LIBS
|
||||
LIBS="-lxml2 $LIBS"
|
||||
if test x$gcc_no_link = xyes; then
|
||||
as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5
|
||||
fi
|
||||
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
||||
/* end confdefs.h. */
|
||||
|
||||
/* Override any GCC internal prototype to avoid an error.
|
||||
Use char because int might match the return type of a GCC
|
||||
builtin and then its argument prototype would still apply. */
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
#endif
|
||||
char xmlParseChunk ();
|
||||
int
|
||||
main ()
|
||||
{
|
||||
return xmlParseChunk ();
|
||||
;
|
||||
return 0;
|
||||
}
|
||||
_ACEOF
|
||||
if ac_fn_cxx_try_link "$LINENO"; then :
|
||||
ac_cv_lib_xml2_xmlParseChunk=yes
|
||||
else
|
||||
ac_cv_lib_xml2_xmlParseChunk=no
|
||||
fi
|
||||
rm -f core conftest.err conftest.$ac_objext \
|
||||
conftest$ac_exeext conftest.$ac_ext
|
||||
LIBS=$ac_check_lib_save_LIBS
|
||||
fi
|
||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_xmlParseChunk" >&5
|
||||
$as_echo "$ac_cv_lib_xml2_xmlParseChunk" >&6; }
|
||||
if test "x$ac_cv_lib_xml2_xmlParseChunk" = xyes; then :
|
||||
LIBS="-lxml2 $LIBS"
|
||||
|
||||
$as_echo "#define HAVE_SAX_XML_PARSER 1" >>confdefs.h
|
||||
|
||||
fi
|
||||
|
||||
|
||||
# Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner
|
||||
# At least for glibc, clock_gettime is in librt. But don't pull that
|
||||
# in if it still doesn't give us the function we want.
|
||||
|
|
|
|||
|
|
@ -232,6 +232,16 @@ AC_SEARCH_LIBS([sinf128], [c m], libgcobol_have_sinf128=yes)
|
|||
libgcobol_have_cacosf128=no
|
||||
AC_SEARCH_LIBS([cacosf128], [c m], libgcobol_have_cacosf128=yes)
|
||||
|
||||
# These are libxml2.
|
||||
AC_CHECK_LIB(xml2, xmlSAXUserParseMemory,
|
||||
[LIBS="-lxml2 $LIBS"
|
||||
AC_DEFINE(HAVE_SAX_XML_PARSER, 1,
|
||||
[Define to 1 if you have the `xmlSAXUserParseMemory' function.])])
|
||||
AC_CHECK_LIB(xml2, xmlParseChunk,
|
||||
[LIBS="-lxml2 $LIBS"
|
||||
AC_DEFINE(HAVE_SAX_XML_PARSER, 1,
|
||||
[Define to 1 if you have the `xmlParseChunk' function.])])
|
||||
|
||||
# Copied from gcc/configure.ac. 2025-06-05 R.J.Dubner
|
||||
# At least for glibc, clock_gettime is in librt. But don't pull that
|
||||
# in if it still doesn't give us the function we want.
|
||||
|
|
|
|||
|
|
@ -2714,8 +2714,8 @@ numval_c( cblc_field_t *dest,
|
|||
|
||||
char *currency_in_ascii;
|
||||
|
||||
char *currency_start;
|
||||
char *currency_end;
|
||||
const char *currency_start;
|
||||
const char *currency_end;
|
||||
if( crcy )
|
||||
{
|
||||
converted = __gg__iconverter(crcy->encoding,
|
||||
|
|
@ -2736,7 +2736,7 @@ numval_c( cblc_field_t *dest,
|
|||
currency_start = currency_in_ascii;
|
||||
currency_end = currency_start + strlen(currency_start);
|
||||
|
||||
char *pcurrency = currency_start;
|
||||
const char *pcurrency = currency_start;
|
||||
// Trim off spaces from the currency:
|
||||
while( *pcurrency == ascii_space && pcurrency < currency_end )
|
||||
{
|
||||
|
|
|
|||
|
|
@ -461,13 +461,13 @@ struct program_state
|
|||
int rt_quote_character;
|
||||
int rt_low_value_character;
|
||||
int rt_high_value_character;
|
||||
char *rt_currency_signs[256];
|
||||
std::vector<std::string> rt_currency_signs;
|
||||
const unsigned short *rt_collation; // Points to a table of 256 values;
|
||||
cbl_encoding_t rt_display_encoding;
|
||||
cbl_encoding_t rt_national_encoding;
|
||||
char *rt_program_name;
|
||||
|
||||
program_state()
|
||||
program_state() : rt_currency_signs(256)
|
||||
{
|
||||
// IBM defaults to the \" QUOTE compiler option. quote_character must
|
||||
// be set to \' when the APOST compiler option is in effect
|
||||
|
|
@ -486,8 +486,6 @@ struct program_state
|
|||
|
||||
// Set all the currency_sign pointers to NULL:
|
||||
|
||||
memset(rt_currency_signs, 0, sizeof(rt_currency_signs));
|
||||
|
||||
rt_display_encoding = __gg__display_encoding;
|
||||
rt_national_encoding = __gg__national_encoding;
|
||||
rt_collation = __gg__one_to_one_values;
|
||||
|
|
@ -495,6 +493,7 @@ struct program_state
|
|||
}
|
||||
|
||||
program_state(const program_state &ps)
|
||||
: rt_currency_signs(ps.rt_currency_signs)
|
||||
{
|
||||
rt_decimal_point = ps.rt_decimal_point ;
|
||||
rt_decimal_separator = ps.rt_decimal_separator ;
|
||||
|
|
@ -507,33 +506,8 @@ struct program_state
|
|||
rt_display_encoding = ps.rt_display_encoding ;
|
||||
rt_national_encoding = ps.rt_national_encoding ;
|
||||
rt_collation = ps.rt_collation ;
|
||||
|
||||
for( int i=0; i<256; i++ )
|
||||
{
|
||||
if( ps.rt_currency_signs[i] )
|
||||
{
|
||||
rt_currency_signs[i] = strdup(ps.rt_currency_signs[i]);
|
||||
}
|
||||
else
|
||||
{
|
||||
rt_currency_signs[i] = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
rt_program_name = ps.rt_program_name ;
|
||||
}
|
||||
|
||||
~program_state()
|
||||
{
|
||||
for(int symbol=0; symbol<256; symbol++)
|
||||
{
|
||||
if( rt_currency_signs[symbol] )
|
||||
{
|
||||
free(rt_currency_signs[symbol]);
|
||||
rt_currency_signs[symbol] = NULL;
|
||||
}
|
||||
}
|
||||
}
|
||||
};
|
||||
|
||||
static std::vector<program_state> program_states;
|
||||
|
|
@ -584,10 +558,10 @@ __gg__get_decimal_separator()
|
|||
}
|
||||
|
||||
extern "C"
|
||||
char *
|
||||
const char *
|
||||
__gg__get_default_currency_string()
|
||||
{
|
||||
return currency_signs(__gg__default_currency_sign);
|
||||
return currency_signs(__gg__default_currency_sign).c_str();
|
||||
}
|
||||
|
||||
extern "C"
|
||||
|
|
@ -8132,9 +8106,20 @@ __gg__inspect_format_2(int backward, size_t integers[])
|
|||
size_t id1_s = __gg__treeplet_1s[cblc_index];
|
||||
cblc_index += 1;
|
||||
|
||||
#if 0
|
||||
fprintf(stderr, "%s:%d: '%.*s' id1_o %zu, id1_s %zu\n", __func__, __LINE__,
|
||||
int(id1_s), (char*)id1->data, id1_o, id1_s);
|
||||
#endif
|
||||
|
||||
// normalize it, according to the language specification.
|
||||
normalized_operand normalized_id_1
|
||||
= normalize_id(id1, id1_o, id1_s, id1->encoding);
|
||||
#if 0
|
||||
fprintf(stderr, "%s:%d: normalized_id_1 '%s' offset %zu, length %zu\n", __func__, __LINE__,
|
||||
normalized_id_1.the_characters.c_str(),
|
||||
normalized_id_1.offset,
|
||||
normalized_id_1.length );
|
||||
#endif
|
||||
|
||||
std::vector<comparand> comparands;
|
||||
|
||||
|
|
|
|||
|
|
@ -96,7 +96,7 @@ extern "C" void __gg__double_to_target( cblc_field_t *tgt,
|
|||
cbl_round_t rounded);
|
||||
extern "C" char __gg__get_decimal_separator();
|
||||
extern "C" char __gg__get_decimal_point();
|
||||
extern "C" char * __gg__get_default_currency_string();
|
||||
extern "C" const char * __gg__get_default_currency_string();
|
||||
|
||||
struct cbl_timespec
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
@ -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 $@~ $@
|
||||
|
|
@ -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
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
#! /usr/bin/awk -f
|
||||
|
||||
/^UNIMPLEMENTED/ {
|
||||
exit
|
||||
}
|
||||
|
||||
/^DESCRIPTION/ {
|
||||
exit
|
||||
}
|
||||
|
||||
/struct sched_param {$/ {
|
||||
exit
|
||||
}
|
||||
|
||||
/SYNOPSIS/,/DESCRIPTION/ {
|
||||
if( /([.][.]|[{},;]) *$/ ) {
|
||||
print
|
||||
}
|
||||
}
|
||||
|
|
@ -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;
|
||||
}
|
||||
|
|
@ -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())
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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,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"
|
||||
|
|
@ -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 */
|
||||
};
|
||||
|
|
@ -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"
|
||||
|
|
@ -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 */
|
||||
};
|
||||
|
|
@ -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))
|
||||
|
||||
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -145,7 +145,7 @@ expand_picture(char *dest, const char *picture)
|
|||
*d++ = ch;
|
||||
}
|
||||
|
||||
if( __gg__currency_signs[ch] )
|
||||
if( ! __gg__currency_signs[ch].empty() )
|
||||
{
|
||||
// We are going to be mapping ch to a string in the final result:
|
||||
prior_ch = ch;
|
||||
|
|
@ -160,8 +160,9 @@ expand_picture(char *dest, const char *picture)
|
|||
|
||||
if( currency_symbol )
|
||||
{
|
||||
size_t sign_length = strlen(__gg__currency_signs[currency_symbol]) - 1;
|
||||
if( sign_length )
|
||||
size_t sign_length = __gg__currency_signs[currency_symbol].size();
|
||||
assert(0 < sign_length);
|
||||
if( --sign_length )
|
||||
{
|
||||
char *pcurrency = strchr(dest, currency_symbol);
|
||||
assert(pcurrency);
|
||||
|
|
@ -279,10 +280,10 @@ __gg__string_to_numeric_edited( char * const dest,
|
|||
for(int i=0; i<dlength; i++)
|
||||
{
|
||||
int ch = (unsigned int)dest[i] & 0xFF;
|
||||
if( __gg__currency_signs[ch] )
|
||||
if( ! __gg__currency_signs[ch].empty() )
|
||||
{
|
||||
currency_picture = ch;
|
||||
currency_sign = __gg__currency_signs[ch];
|
||||
currency_sign = __gg__currency_signs[ch].c_str();
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
@ -1276,15 +1277,10 @@ __gg__string_to_alpha_edited( char *dest,
|
|||
|
||||
extern "C"
|
||||
void
|
||||
__gg__currency_sign_init()
|
||||
__gg__currency_sign_init() // This duplicates the constructor.
|
||||
{
|
||||
for(int symbol=0; symbol<256; symbol++)
|
||||
{
|
||||
if( __gg__currency_signs[symbol] )
|
||||
{
|
||||
free(__gg__currency_signs[symbol]);
|
||||
__gg__currency_signs[symbol] = NULL;
|
||||
}
|
||||
for( auto str : __gg__currency_signs ) {
|
||||
str.clear();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1292,7 +1288,7 @@ extern "C"
|
|||
void
|
||||
__gg__currency_sign(int symbol, const char *sign)
|
||||
{
|
||||
__gg__currency_signs[symbol] = strdup(sign);
|
||||
__gg__currency_signs[symbol] = sign;
|
||||
__gg__default_currency_sign = *sign;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -408,7 +408,6 @@ static void fatalError(void * CTX, const char * msg, ...)
|
|||
}
|
||||
|
||||
#if 0
|
||||
|
||||
static xmlEntityPtr getEntity(void * CTX,
|
||||
const xmlChar * name)
|
||||
{ SAYSO_DATAZ(name); }
|
||||
|
|
@ -618,6 +617,7 @@ xmlchar_of( const char input[] ) {
|
|||
static const char *
|
||||
xmlParserErrors_str( xmlParserErrors erc, const char name[] ) {
|
||||
const char *msg = "???";
|
||||
|
||||
switch( erc ) {
|
||||
case XML_ERR_OK:
|
||||
msg = "Success";
|
||||
|
|
@ -675,7 +675,8 @@ static class context_t {
|
|||
/* Avoid a NULL entry. */
|
||||
static const char * const ident = "unnamed_COBOL_program";
|
||||
#endif
|
||||
// TODO: Program to set option in library via command-line and/or environment.
|
||||
// TODO: Program to set option in library via command-line and/or
|
||||
// environment.
|
||||
// Library listens to program, not to the environment.
|
||||
openlog(ident, option, facility);
|
||||
|
||||
|
|
@ -683,7 +684,9 @@ static class context_t {
|
|||
}
|
||||
|
||||
void
|
||||
push( cblc_field_t *input_field, size_t input_offset, size_t len, bool done ) {
|
||||
push( const cblc_field_t *input_field,
|
||||
size_t input_offset,
|
||||
size_t len, bool done ) {
|
||||
if( ! ctxt ) {
|
||||
init();
|
||||
}
|
||||
|
|
@ -712,7 +715,6 @@ static class context_t {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
protected:
|
||||
void init() {
|
||||
const char *external_entities = nullptr;
|
||||
|
|
@ -724,7 +726,7 @@ static class context_t {
|
|||
} context;
|
||||
|
||||
static int
|
||||
xml_push_parse( cblc_field_t *input_field,
|
||||
xml_push_parse( const cblc_field_t *input_field,
|
||||
size_t input_offset,
|
||||
size_t len,
|
||||
cblc_field_t *encoding __attribute__ ((unused)),
|
||||
|
|
|
|||
Loading…
Reference in New Issue