diff --git a/cobc/codegen.c b/cobc/codegen.c index a9ba045b0..011f6be40 100644 --- a/cobc/codegen.c +++ b/cobc/codegen.c @@ -1287,6 +1287,9 @@ output_data (cb_tree x) output (")->data"); } break; + case CB_TAG_DIRECT: + output ("%s", CB_DIRECT (x)->line); + break; /* LCOV_EXCL_START */ default: CB_TREE_TAG_UNEXPECTED_ABORT (x); diff --git a/libcob/ChangeLog b/libcob/ChangeLog index 7fdcb3a72..24d46086a 100644 --- a/libcob/ChangeLog +++ b/libcob/ChangeLog @@ -78,6 +78,11 @@ * termio.c (pretty_display_numeric), mlio.c (get_num): changed to use the attributes of the receiving field +2024-07-19 Simon Sobisch + + * coblocal.h (COB_TLS): add a new attribute for thread local static. + * common.h, common.c (cob_cleanup_thread): add a cleanup function for threads + 2024-05-15 Simon Sobisch * profiling.c: fix compile warnings @@ -117,6 +122,10 @@ * common.c: add missing include libxml/parser.h +2024-02-26 Boris Eng + FR #488: using state structures instead of state vars for strings + * strings.c: moved static variables to structures + 2024-01-25 David Declerck FR #459: support COLLATING SEQUENCE clause on SELECT / INDEXED files diff --git a/libcob/coblocal.h b/libcob/coblocal.h index 46dfcc576..1b0e0e6b2 100644 --- a/libcob/coblocal.h +++ b/libcob/coblocal.h @@ -258,6 +258,20 @@ Note: also defined together with __clang__ in both frontends: #define COB_MOUSE_INTERVAL cobsetptr->cob_mouse_interval #define COB_USE_ESC cobsetptr->cob_use_esc +#if defined(COB_TLS) + /* already defined, for example as static to explicit disable TLS */ +#elif defined(_WIN32) + #define COB_TLS __declspec(thread) +#elif defined(__GNUC__) && (__GNUC__ >= 4) || defined(__clang__) || \ + defined(__hpux) || defined(_AIX) || defined(__sun) + #define COB_TLS static __thread +#elif defined(__STDC_VERSION__) && __STDC_VERSION__ >= 201112L + #include + #define COB_TLS thread_local +#else + #define COB_TLS static /* fallback definition */ +#endif + /* Global settings structure */ typedef struct __cob_settings { @@ -324,7 +338,6 @@ typedef struct __cob_settings { unsigned int cob_exit_wait; /* wait on program exit if no ACCEPT came after last DISPLAY */ const char *cob_exit_msg; /* message for cob_exit_wait */ - /* reportio.c */ unsigned int cob_col_just_lrc; /* Justify data in column LEFT/RIGHT/CENTER */ diff --git a/libcob/common.c b/libcob/common.c index 427995006..231f68e45 100644 --- a/libcob/common.c +++ b/libcob/common.c @@ -11206,3 +11206,8 @@ init_statement_list (void) #undef COB_STATEMENT } #endif + +void cob_cleanup_thread () +{ + cob_exit_strings (); +} diff --git a/libcob/common.h b/libcob/common.h index b24458ac8..cbdbadff6 100644 --- a/libcob/common.h +++ b/libcob/common.h @@ -1682,6 +1682,8 @@ COB_EXPIMP void cob_runtime_hint (const char *, ...) COB_A_FORMAT12; COB_EXPIMP void cob_runtime_error (const char *, ...) COB_A_FORMAT12; COB_EXPIMP void cob_runtime_warning (const char *, ...) COB_A_FORMAT12; +COB_EXPIMP void cob_cleanup_thread (); + /* General functions */ COB_EXPIMP int cob_is_initialized (void); diff --git a/libcob/strings.c b/libcob/strings.c index 0db2c8f23..f107cfdb0 100644 --- a/libcob/strings.c +++ b/libcob/strings.c @@ -1,6 +1,7 @@ /* Copyright (C) 2002-2014, 2016-2020, 2022-2024 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Edward Hart, Simon Sobisch + Written by Keisuke Nishida, Roger While, Edward Hart, Simon Sobisch, Boris + Eng This file is part of GnuCOBOL. @@ -33,10 +34,11 @@ #include "coblocal.h" enum inspect_type { - INSPECT_ALL = 0, - INSPECT_LEADING = 1, - INSPECT_FIRST = 2, - INSPECT_TRAILING = 3 + INSPECT_UNSET = 0, + INSPECT_ALL, + INSPECT_LEADING, + INSPECT_FIRST, + INSPECT_TRAILING }; #define DLM_DEFAULT_NUM 8U @@ -45,6 +47,45 @@ struct dlm_struct { cob_u32_t uns_all; }; +struct cob_inspect_state { + cob_field *var; + unsigned char *data; + unsigned char *start; + unsigned char *end; + unsigned char *mark; /* buffer to marker only: 0/1 */ + size_t mark_size; /* size of internal marker elements, increased up to + the maximum needed (biggest target field size) */ + size_t mark_min; /* min. position of the marker set by the last initialize */ + size_t mark_max; /* max. position of the marker set by the last initialize */ + unsigned char *repdata; /* contains data for REPLACING which is applied at end */ + size_t repdata_size; /* size of internal repdata buffer, increased up to + the maximum needed (biggest target field size) */ + size_t size; + cob_u32_t replacing; /* marker about current operation being INSPECT REPLACING */ + int sign; + enum inspect_type type; +}; + +struct cob_string_state { + cob_field *dst; + cob_field *ptr; + cob_field *dlm; + int offset; /* value associated with WITH POINTER clauses */ +}; + +struct cob_unstring_state { + struct dlm_struct *dlm_list; + cob_field *src; + cob_field *ptr; + size_t dlm_list_size; /* size of internal delimiter elements, increased up to + the maximum needed (amount of DELIMITED BY), + actual size of dlm_list is calculated by + dlm_list_size * sizeof(dlm_struct) */ + int offset; + unsigned int count; + unsigned int ndlms; +}; + /* Local variables */ static cob_global *cobglobptr = NULL; @@ -54,43 +95,10 @@ static const cob_field_attr const_alpha_attr = static const cob_field_attr const_strall_attr = {COB_TYPE_ALPHANUMERIC_ALL, 0, 0, 0, NULL}; -static cob_field *inspect_var; -static unsigned char *inspect_data; -static unsigned char *inspect_start; -static unsigned char *inspect_end; -static unsigned char *inspect_mark; /* buffer to marker only: 0/1 */ -static size_t inspect_mark_size; /* size of internal marker elements, increased up to - the maximum needed (biggest target field size) */ -static size_t inspect_mark_min; /* min. position of the marker set by the last initialize */ -static size_t inspect_mark_max; /* max. position of the marker set by the last initialize */ -static unsigned char *inspect_repdata; /* contains data for REPLACING which is applied at end */ -static size_t inspect_repdata_size; /* size of internal repdata buffer, increased up to - the maximum needed (biggest target field size) */ -static size_t inspect_size; -static cob_u32_t inspect_replacing; /* marker about current operation being INSPECT REPLACING */ -static int inspect_sign; -static cob_field inspect_var_copy; - -static cob_field *string_dst; -static cob_field *string_ptr; -static cob_field *string_dlm; -static cob_field string_dst_copy; -static cob_field string_ptr_copy; -static cob_field string_dlm_copy; -static int string_offset; - -static struct dlm_struct *dlm_list; -static cob_field *unstring_src; -static cob_field *unstring_ptr; -static size_t dlm_list_size; /* size of internal delimiter elements, increased up to - the maximum needed (amount of DELIMITED BY), - actual size of dlm_list is calculated by - dlm_list_size * sizeof(dlm_struct) */ -static cob_field unstring_src_copy; -static cob_field unstring_ptr_copy; -static int unstring_offset; -static int unstring_count; -static int unstring_ndlms; +/* Static structures for backward compatibility */ +COB_TLS struct cob_inspect_state share_inspect_state; +COB_TLS struct cob_string_state share_string_state; +COB_TLS struct cob_unstring_state share_unstring_state; static unsigned char *figurative_ptr; static size_t figurative_size; @@ -169,40 +177,40 @@ alloc_figurative (const cob_field *f1, const cob_field *f2) changed to correctly handle multiple replacements with BEFORE/AFTER clauses */ static COB_INLINE COB_A_INLINE void -setup_repdata (void) +setup_repdata (struct cob_inspect_state *st) { /* implementation note: - A version that memcpy'd the complete inspect_data to inspect_repdata + A version that memcpy'd the complete data to repdata on first use, then memcpy back in cob_inspect_finish was tested but dropped. While it has the benefit that memory breakpoints in the COBOL data are only triggered once and always shows the result-to-be and uses an optimized memcpy instead of a manual loop it involves much more memory operations than commonly necessary - because normally only a small percentage of the data is actually replaced. - A version that used inspect_repdata for CONVERTING was also dropped as + A version that used repdata for CONVERTING was also dropped as we don't need the additional memory there. */ - if (inspect_size > inspect_repdata_size) { - if (inspect_repdata) { - cob_free (inspect_repdata); - inspect_repdata_size = inspect_size; - } else if (inspect_size < COB_NORMAL_BUFF) { - inspect_repdata_size = COB_NORMAL_BUFF; + if (st->size > st->repdata_size) { + if (st->repdata) { + cob_free (st->repdata); + st->repdata_size = st->size; + } else if (st->size < COB_NORMAL_BUFF) { + st->repdata_size = COB_NORMAL_BUFF; } else { - inspect_repdata_size = inspect_size; + st->repdata_size = st->size; } /* data content does not matter as we only used marked positions at end */ - inspect_repdata = cob_fast_malloc (inspect_repdata_size + 1); + st->repdata = cob_fast_malloc (st->repdata_size + 1); } } static COB_INLINE COB_A_INLINE unsigned char * -inspect_find_data (const cob_field *str) +inspect_find_data (struct cob_inspect_state *st, const cob_field *str) { const unsigned char *data = str->data; const size_t len = str->size; - register unsigned char *p = inspect_start; - unsigned char *const end_p = inspect_end - len + 1; + register unsigned char *p = st->start; + unsigned char *const end_p = st->end - len + 1; if (p > end_p) { return NULL; @@ -218,32 +226,36 @@ inspect_find_data (const cob_field *str) } static COB_INLINE COB_A_INLINE void -set_inspect_mark (const size_t pos, const size_t length) +set_inspect_mark ( + struct cob_inspect_state *st, + const size_t pos, + const size_t length +) { const size_t pos_end = pos + length - 1; - memset (inspect_mark + pos, 1, length); - if ((inspect_mark_min == 0 && inspect_mark[inspect_mark_min] == 0) - || pos < inspect_mark_min) { - inspect_mark_min = pos; + memset (st->mark + pos, 1, length); + if ((st->mark_min == 0 && st->mark[st->mark_min] == 0) + || pos < st->mark_min) { + st->mark_min = pos; } - if (pos_end > inspect_mark_max) { - inspect_mark_max = pos_end; + if (pos_end > st->mark_max) { + st->mark_max = pos_end; } } /* check for an area in the marker to be non-zero */ static COB_INLINE COB_A_INLINE int -is_marked (size_t pos, size_t length) +is_marked (struct cob_inspect_state *st, size_t pos, size_t length) { /* no need to check further if there's no mark or no possible overlap ... */ - if (inspect_mark[inspect_mark_min] == 0 - || inspect_mark_max < pos - || inspect_mark_min >= pos + length) { + if (st->mark[st->mark_min] == 0 + || st->mark_max < pos + || st->mark_min >= pos + length) { return 0; } /* ... or if the minimal/max mark are within the range to check */ - if (inspect_mark_min >= pos - || inspect_mark_max < pos + length) { + if (st->mark_min >= pos + || st->mark_max < pos + length) { return 1; } @@ -252,7 +264,7 @@ is_marked (size_t pos, size_t length) register size_t i; for (i = 0; i < length; ++i) { - if (inspect_mark[pos + i] != 0) { + if (st->mark[pos + i] != 0) { return 1; } } @@ -261,20 +273,25 @@ is_marked (size_t pos, size_t length) } static void -inspect_common_no_replace (cob_field *f1, cob_field *f2, - const enum inspect_type type, const size_t pos, const size_t inspect_len) +inspect_common_no_replace ( + struct cob_inspect_state *st, + cob_field *f1, + cob_field *f2, + const size_t pos, + const size_t len +) { register size_t i; int n = 0; - if (type == INSPECT_TRAILING) { - const size_t i_max = inspect_len - f2->size; /* no + 1 here */ + if (st->type == INSPECT_TRAILING) { + const size_t i_max = len - f2->size; /* no + 1 here */ size_t first_marker = 0; for (i = i_max; ; --i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { /* when not marked yet: count, mark and skip handled positions */ - if (!is_marked (pos + i, f2->size)) { + if (!is_marked (st, pos + i, f2->size)) { n++; first_marker = i; i -= f2->size - 1; @@ -288,16 +305,16 @@ inspect_common_no_replace (cob_field *f1, cob_field *f2, } /* set the marker so we won't iterate over this area again */ if (n) { - set_inspect_mark (pos + first_marker, inspect_len - first_marker); + set_inspect_mark (st, pos + first_marker, len - first_marker); } - } else if (type == INSPECT_LEADING) { - const size_t i_max = inspect_len - f2->size + 1; + } else if (st->type == INSPECT_LEADING) { + const size_t i_max = len - f2->size + 1; size_t last_marker = 0; for (i = 0; i < i_max; ++i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { /* when not marked yet: count, skip handled positions and set mark pos */ - if (!is_marked (pos + i, f2->size)) { + if (!is_marked (st, pos + i, f2->size)) { n++; i += f2->size - 1; last_marker = i; @@ -308,22 +325,22 @@ inspect_common_no_replace (cob_field *f1, cob_field *f2, } /* set the marker so we won't iterate over this area again */ if (n) { - set_inspect_mark (pos, last_marker); + set_inspect_mark (st, pos, last_marker); } /* note: same code as for LEADING, moved out as we don't need to check LEADING for _every_ byte in that tight loop */ } else { - const size_t i_max = inspect_len - f2->size + 1; + const size_t i_max = len - f2->size + 1; for (i = 0; i < i_max; ++i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { const size_t checked_pos = pos + i; /* when not marked yet: count, mark and skip handled positions */ - if (!is_marked (checked_pos, f2->size)) { + if (!is_marked (st, checked_pos, f2->size)) { n++; /* set the marker so we won't iterate over this area again */ - set_inspect_mark (checked_pos, f2->size); - if (type == INSPECT_FIRST) { + set_inspect_mark (st, checked_pos, f2->size); + if (st->type == INSPECT_FIRST) { break; } i += f2->size - 1; @@ -338,37 +355,47 @@ inspect_common_no_replace (cob_field *f1, cob_field *f2, } static COB_INLINE COB_A_INLINE int -do_mark (const size_t pos, const size_t length, unsigned char *replace_data) +do_mark ( + struct cob_inspect_state *st, + const size_t pos, + const size_t length, + unsigned char *replace_data +) { - if (is_marked (pos, length)) { + if (is_marked (st, pos, length)) { return 0; /* it is, nothing to do here */ } /* nothing done there yet, so: */ /* 1 - handle possible replacing */ - setup_repdata (); - memcpy (inspect_repdata + pos, replace_data, length); + setup_repdata (st); + memcpy (st->repdata + pos, replace_data, length); /* 2 - set the marker so we won't iterate over this area again */ - set_inspect_mark (pos, length); + set_inspect_mark (st, pos, length); /* 3 - let the caller handle pos adjustment */ return 1; } static void -inspect_common_replacing (cob_field *f1, cob_field *f2, - const enum inspect_type type, const size_t pos, const size_t inspect_len) +inspect_common_replacing ( + struct cob_inspect_state *st, + cob_field *f1, + cob_field *f2, + const size_t pos, + const size_t len +) { register size_t i; - if (type == INSPECT_TRAILING) { - const size_t i_max = inspect_len - f2->size; /* no + 1 here */ + if (st->type == INSPECT_TRAILING) { + const size_t i_max = len - f2->size; /* no + 1 here */ for (i = i_max; ; --i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { /* when not marked yet: count, mark and skip handled positions */ - if (do_mark (pos + i, f2->size, f1->data)) { + if (do_mark (st, pos + i, f2->size, f1->data)) { i -= f2->size - 1; } if (i == 0) { @@ -378,13 +405,13 @@ inspect_common_replacing (cob_field *f1, cob_field *f2, break; } } - } else if (type == INSPECT_LEADING) { - const size_t i_max = inspect_len - f2->size + 1; + } else if (st->type == INSPECT_LEADING) { + const size_t i_max = len - f2->size + 1; for (i = 0; i < i_max; ++i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { /* when not marked yet: count, mark and skip handled positions */ - if (do_mark (pos + i, f2->size, f1->data)) { + if (do_mark (st, pos + i, f2->size, f1->data)) { i += f2->size - 1; } } else { @@ -394,13 +421,13 @@ inspect_common_replacing (cob_field *f1, cob_field *f2, /* note: same code as for LEADING, moved out as we don't need to check LEADING for _every_ byte in that tight loop */ } else { - const size_t i_max = inspect_len - f2->size + 1; + const size_t i_max = len - f2->size + 1; for (i = 0; i < i_max; ++i) { /* Find matching substring */ - if (memcmp (i + inspect_start, f2->data, f2->size) == 0) { + if (memcmp (i + st->start, f2->data, f2->size) == 0) { /* when not marked yet: count, mark and skip handled positions */ - if (do_mark (pos + i, f2->size, f1->data)) { - if (type == INSPECT_FIRST) { + if (do_mark (st, pos + i, f2->size, f1->data)) { + if (st->type == INSPECT_FIRST) { break; } i += f2->size - 1; @@ -411,12 +438,16 @@ inspect_common_replacing (cob_field *f1, cob_field *f2, } static void -inspect_common (cob_field *f1, cob_field *f2, const enum inspect_type type) +inspect_common ( + struct cob_inspect_state *st, + cob_field *f1, + cob_field *f2 +) { - const size_t pos = inspect_start - inspect_data; - const size_t inspect_len = inspect_end - inspect_start; + const size_t pos = st->start - st->data; + const size_t len = st->end - st->start; - if (inspect_len == 0) { + if (len == 0) { /* inspecting either a zero-length field or AFTER ... has not found a place to start the conversion */ return; @@ -433,11 +464,11 @@ inspect_common (cob_field *f1, cob_field *f2, const enum inspect_type type) of its code; still moved out as this allows for further optimizations; only optimization left: separate entry function and codegen for single target as this does not need a marker at all */ - if (!inspect_replacing) { - if (f2->size > inspect_len) { + if (!st->replacing) { + if (f2->size > len) { return; } - inspect_common_no_replace (f1, f2, type, pos, inspect_len); + inspect_common_no_replace (st, f1, f2, pos, len); } else { if (f1->size != f2->size) { if (COB_FIELD_TYPE (f1) == COB_TYPE_ALPHANUMERIC_ALL) { @@ -448,10 +479,10 @@ inspect_common (cob_field *f1, cob_field *f2, const enum inspect_type type) return; } } - if (f2->size > inspect_len) { + if (f2->size > len) { return; } - inspect_common_replacing (f1, f2, type, pos, inspect_len); + inspect_common_replacing (st, f1, f2, pos, len); } } @@ -461,122 +492,146 @@ inspect_common (cob_field *f1, cob_field *f2, const enum inspect_type type) /* an INSPECT is split into multiple parts: one-time cob_inspect_init (setting up memory and markers) multiple: - cob_inspect_start (setting inspect_start/end) - cob_inspect_before (optional, adjusting inspect_end) - cob_inspect_after (optional, adjusting inspect_start) + cob_inspect_start (setting start/end) + cob_inspect_before (optional, adjusting end) + cob_inspect_after (optional, adjusting start) one of: cob_inspect_characters/cob_inspect_converting (until 3.2)/cob_inspect_all/ cob_inspect_leading/cob_inspect_trailing/cob_inspect_first one-time cob_inspect_finish (copying the REPLACING characters back) */ static COB_INLINE COB_A_INLINE void -cob_inspect_init_common (cob_field *var) +cob_inspect_init_common_intern (struct cob_inspect_state *st, cob_field *var) { if (COB_FIELD_HAVE_SIGN (var) && !COB_FIELD_SIGN_SEPARATE(var)) { /* it is allowed to TRANSFORM / INSPECT a numeric display signed element; if it isn't stored separately we need to "remove" it here and add it back in inspect_finish; note: we only handle NUMERIC DISPLAY here */ - inspect_var_copy = *var; - inspect_var = &inspect_var_copy; - inspect_sign = cob_real_get_sign (var, 0); + st->var = var; + st->sign = cob_real_get_sign (var, 0); } else { - inspect_var = NULL; + st->var = NULL; } - inspect_size = COB_FIELD_SIZE (var); - inspect_data = COB_FIELD_DATA (var); - inspect_start = NULL; - inspect_end = NULL; + st->size = COB_FIELD_SIZE (var); + st->data = COB_FIELD_DATA (var); + st->start = NULL; + st->end = NULL; + st->mark_size = 0; + st->repdata_size = 0; cobglobptr->cob_exception_code = 0; } -void -cob_inspect_init (cob_field *var, const cob_u32_t replacing) +static void +cob_inspect_init_intern (struct cob_inspect_state *st, cob_field *var, const cob_u32_t replacing) { - cob_inspect_init_common (var); - inspect_replacing = replacing; - - if (inspect_size > inspect_mark_size) { - if (inspect_mark) { - cob_free (inspect_mark); - inspect_mark_size = inspect_size; - } else if (inspect_size < COB_NORMAL_BUFF) { - inspect_mark_size = COB_NORMAL_BUFF; + cob_inspect_init_common_intern (st, var); + st->replacing = replacing; + + if (st->size > st->mark_size) { + if (st->mark) { + cob_free (st->mark); + st->mark_size = st->size; + } else if (st->size < COB_NORMAL_BUFF) { + st->mark_size = COB_NORMAL_BUFF; } else { - inspect_mark_size = inspect_size; + st->mark_size = st->size; } /* initialize to zero */ - inspect_mark = cob_malloc (inspect_mark_size + 1); - } else if (inspect_mark_size != 0 && inspect_mark[inspect_mark_min] != 0) { - const size_t init_len = inspect_mark_max - inspect_mark_min + 1; - memset (inspect_mark + inspect_mark_min, 0, init_len); + st->mark = cob_malloc (st->mark_size + 1); + } else if (st->mark_size != 0 && st->mark[st->mark_min] != 0) { + const size_t init_len = st->mark_max - st->mark_min + 1; + memset (st->mark + st->mark_min, 0, init_len); } - inspect_mark_min = inspect_mark_max = 0; + st->mark_min = st->mark_max = 0; +} +void +cob_inspect_init (cob_field *var, const cob_u32_t replacing) +{ + cob_inspect_init_intern (&share_inspect_state, var, replacing); } /* an INSPECT CONVERTING / TRANSFORM is split into multiple parts: one-time cob_inspect_init_converting --> cob_inspect_init_common (setting up memory) multiple: - cob_inspect_start (setting inspect_start/end) - cob_inspect_before (optional, adjusting inspect_end) - cob_inspect_after (optional, adjusting inspect_start) + cob_inspect_start (setting start/end) + cob_inspect_before (optional, adjusting end) + cob_inspect_after (optional, adjusting start) one-time cob_inspect_converting/cob_inspect_translating (actual converstion) */ +static void +cob_inspect_init_converting_intern (struct cob_inspect_state *st, cob_field *var) +{ + cob_inspect_init_common_intern (st, var); + st->replacing = 0; /* only set for pre 3.2 compat because of cob_inspect_finish */ +} void cob_inspect_init_converting (cob_field *var) { - cob_inspect_init_common (var); - inspect_replacing = 0; /* only set for pre 3.2 compat because of cob_inspect_finish */ + cob_inspect_init_converting_intern (&share_inspect_state, var); } +static void +cob_inspect_start_intern (struct cob_inspect_state *st) +{ + st->start = st->data; + st->end = st->data + st->size; +} void cob_inspect_start (void) { - inspect_start = inspect_data; - inspect_end = inspect_data + inspect_size; + cob_inspect_start_intern (&share_inspect_state); } +static void +cob_inspect_before_intern (struct cob_inspect_state *st, const cob_field *str) +{ + unsigned char *data_pos = inspect_find_data (st, str); + if (data_pos) + st->end = data_pos; +} void cob_inspect_before (const cob_field *str) { - unsigned char *data_pos = inspect_find_data (str); - if (data_pos) { - inspect_end = data_pos; - } + cob_inspect_before_intern (&share_inspect_state, str); } +static void +cob_inspect_after_intern (struct cob_inspect_state *st, const cob_field *str) +{ + unsigned char *data_pos = inspect_find_data (st, str); + if (data_pos) + st->start = data_pos + str->size; + else + st->start = st->end; +} void cob_inspect_after (const cob_field *str) { - unsigned char *data_pos = inspect_find_data (str); - if (data_pos) { - inspect_start = data_pos + str->size; - } else { - inspect_start = inspect_end; - } + cob_inspect_after_intern (&share_inspect_state, str); } -void -cob_inspect_characters (cob_field *f1) +static void +cob_inspect_characters_intern (struct cob_inspect_state *st, cob_field *f1) { - const size_t pos = inspect_start - inspect_data; - const size_t inspect_len = inspect_end - inspect_start; - const unsigned char *mark_pos = inspect_mark + pos; - const unsigned char * const mark_end = mark_pos + inspect_len; + const size_t pos = st->start - st->data; + const size_t len = st->end - st->start; + const unsigned char *mark_pos = st->mark + pos; + const unsigned char * const mark_end = mark_pos + len; - if (inspect_len == 0) { + if (len == 0) { /* inspecting either a zero-length field or AFTER ... has not found a place to start the conversion */ return; } - if (inspect_replacing) { + if (st->replacing) { /* INSPECT REPLACING CHARACTERS BY f1 (= size 1) */ const unsigned char repl_by = *f1->data; unsigned char *repdata; - setup_repdata (); - repdata = inspect_repdata + pos; - if (is_marked (pos, inspect_len)) { + setup_repdata (st); + repdata = st->repdata + pos; + if (is_marked (st, pos, len)) { /* at least a partial marking - so iterate */ while (mark_pos != mark_end) { /* replace all positions in the original data where @@ -588,11 +643,11 @@ cob_inspect_characters (cob_field *f1) } } else { /* that area is "free to go", so memset */ - memset (repdata, repl_by, inspect_len); + memset (repdata, repl_by, len); } } else { /* INSPECT TALLYING f1 CHARACTERS */ - if (is_marked (pos, inspect_len)) { + if (is_marked (st, pos, len)) { /* at least a partial marking - so iterate */ int n = 0; /* Note: field->size and therefore INSPECT target's size are @@ -607,42 +662,75 @@ cob_inspect_characters (cob_field *f1) } } else { /* common case: no markers in the length to check */ - cob_add_int (f1, (int)inspect_len, 0); + cob_add_int (f1, (int)len, 0); } } - set_inspect_mark (pos, inspect_len); + set_inspect_mark (st, pos, len); +} +void +cob_inspect_characters (cob_field *f1) +{ + cob_inspect_characters_intern(&share_inspect_state, f1); } +static void +cob_inspect_all_intern (struct cob_inspect_state *st, cob_field *f1, cob_field *f2) +{ + st->type = INSPECT_ALL; + inspect_common (st, f1, f2); +} void cob_inspect_all (cob_field *f1, cob_field *f2) { - inspect_common (f1, f2, INSPECT_ALL); + cob_inspect_all_intern (&share_inspect_state, f1, f2); } +static void +cob_inspect_leading_intern (struct cob_inspect_state *st, cob_field *f1, cob_field *f2) +{ + st->type = INSPECT_LEADING; + inspect_common (st, f1, f2); +} void cob_inspect_leading (cob_field *f1, cob_field *f2) { - inspect_common (f1, f2, INSPECT_LEADING); + cob_inspect_leading_intern (&share_inspect_state, f1, f2); } +static void +cob_inspect_first_intern (struct cob_inspect_state *st, cob_field *f1, cob_field *f2) +{ + st->type = INSPECT_FIRST; + inspect_common (st, f1, f2); +} void cob_inspect_first (cob_field *f1, cob_field *f2) { - inspect_common (f1, f2, INSPECT_FIRST); + cob_inspect_first_intern (&share_inspect_state, f1, f2); } +static void +cob_inspect_trailing_intern (struct cob_inspect_state *st, cob_field *f1, cob_field *f2) +{ + st->type = INSPECT_TRAILING; + inspect_common (st, f1, f2); +} void cob_inspect_trailing (cob_field *f1, cob_field *f2) { - inspect_common (f1, f2, INSPECT_TRAILING); + cob_inspect_trailing_intern (&share_inspect_state, f1, f2); } -void -cob_inspect_converting (const cob_field *f1, const cob_field *f2) +static void +cob_inspect_converting_intern ( + struct cob_inspect_state *st, + const cob_field *f1, + const cob_field *f2 +) { - const size_t inspect_len = inspect_end - inspect_start; + const size_t len = st->end - st->start; - if (inspect_len == 0) { + if (len == 0) { /* our task is to convert either a zero-length field or AFTER ... has not found a place to start the conversion */ goto end; @@ -667,8 +755,8 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) /* test _all_ positions of the inspect target against all entries of CONVERTING position by position */ { - unsigned char * cur_data = inspect_data + (inspect_start - inspect_data); - unsigned char * const cur_data_end = cur_data + inspect_len; + unsigned char * cur_data = st->data + (st->start - st->data); + unsigned char * const cur_data_end = cur_data + len; #if 1 /* table-approach, _much faster_, _should_ be portable */ /* pre-filled conversion table */ @@ -737,28 +825,33 @@ cob_inspect_converting (const cob_field *f1, const cob_field *f2) end: /* note: copied here for 3.2+ as cob_inspect_finish is not generated for TRANSFORM/INSPECT CONVERTING any more */ - if (inspect_var) { + if (st->var) { /* FIXME: needs test cases for all "goto end" cases above, ideally with a SIGN SEPARATE variable */ - cob_real_put_sign (inspect_var, inspect_sign); + cob_real_put_sign (st->var, st->sign); } } +void +cob_inspect_converting (const cob_field *f1, const cob_field *f2) +{ + cob_inspect_converting_intern (&share_inspect_state, f1, f2); +} /* note: currently not used by cobc (disabled unfinished prototype) */ -void -cob_inspect_translating (const unsigned char *conv_table) +static void +cob_inspect_translating_intern (struct cob_inspect_state *st, const unsigned char *conv_table) { - const size_t inspect_len = inspect_end - inspect_start; + const size_t len = st->end - st->start; - if (inspect_len == 0) { + if (len == 0) { /* our task is to convert either a zero-length field or AFTER ... has not found a place to start the conversion --> nothing to do here */ } else { /* directly convert _all_ positions of the inspect target using the pre-generated conversion table */ - unsigned char * cur_data = inspect_data + (inspect_start - inspect_data); - unsigned char * const cur_data_end = cur_data + inspect_len; + unsigned char * cur_data = st->data + (st->start - st->data); + unsigned char * const cur_data_end = cur_data + len; /* iterate over target converting with full table */ while (cur_data < cur_data_end) { @@ -767,40 +860,51 @@ cob_inspect_translating (const unsigned char *conv_table) } } - if (inspect_var) { - cob_real_put_sign (inspect_var, inspect_sign); + if (st->var) { + cob_real_put_sign (st->var, st->sign); } } - void -cob_inspect_finish (void) +cob_inspect_translating (const unsigned char* conv_table) +{ + cob_inspect_translating_intern (&share_inspect_state, conv_table); +} + +static void +cob_inspect_finish_intern (struct cob_inspect_state *st) { /* Note: this is not called any more for TRANSFORM/INSPECT CONVERTING since GnuCOBOL 3.2 codegen (only for "old modules")! */ - if (inspect_replacing - && inspect_repdata_size != 0 /* check for first INSPECT REPLACING having zero length */ - && inspect_mark[inspect_mark_min] != 0) { + if (st->replacing + && st->repdata_size != 0 /* check for first INSPECT REPLACING having zero length */ + && st->mark[st->mark_min] != 0) { /* copy over replace data from first to last changed position */ size_t i; - for (i = inspect_mark_min; i <= inspect_mark_max; ++i) { - if (inspect_mark[i] != 0) { - inspect_data[i] = inspect_repdata[i]; + for (i = st->mark_min; i <= st->mark_max; ++i) { + if (st->mark[i] != 0) { + st->data[i] = st->repdata[i]; } } #if 0 /* drop data copy because of security issues [may only be done upon request]; if not active and that contains sensitive data do an INSPECT against a field of the same size to overwrite the buffer */ - memset (inspect_repdata + inspect_mark_min, 0, - inspect_mark_max - inspect_mark_min + 1); + memset (st->repdata + st->mark_min, 0, + st->mark_max - st->mark_min + 1); #endif } - if (inspect_var) { - cob_real_put_sign (inspect_var, inspect_sign); + if (st->var) { + cob_real_put_sign (st->var, st->sign); } } +void +cob_inspect_finish (void) +{ + cob_inspect_finish_intern (&share_inspect_state); +} + /* STRING */ /* a STRING is split into multiple parts: @@ -811,41 +915,44 @@ cob_inspect_finish (void) cob_string_append (to handle a single source) one-time cob_string_finish (setting the string pointer) */ -void -cob_string_init (cob_field *dst, cob_field *ptr) +static void +cob_string_init_intern (struct cob_string_state *st, cob_field *dst, cob_field *ptr) { - string_dst_copy = *dst; - string_dst = &string_dst_copy; - string_ptr = NULL; - if (ptr) { - string_ptr_copy = *ptr; - string_ptr = &string_ptr_copy; - } - string_offset = 0; + st->dst = dst; + st->ptr = ptr; + st->offset = 0; cobglobptr->cob_exception_code = 0; - if (string_ptr) { - string_offset = cob_get_int (string_ptr) - 1; - if (string_offset < 0 - || string_offset >= (int)string_dst->size) { + if (st->ptr) { + st->offset = cob_get_int (st->ptr) - 1; + if (st->offset < 0 || st->offset >= (int)st->dst->size) { cob_set_exception (COB_EC_OVERFLOW_STRING); } } } - void -cob_string_delimited (cob_field *dlm) +cob_string_init (cob_field *dst, cob_field *ptr) +{ + cob_string_init_intern (&share_string_state, dst, ptr); +} + +static void +cob_string_delimited_intern (struct cob_string_state *st, cob_field *dlm) { if (dlm) { - string_dlm_copy = *dlm; - string_dlm = &string_dlm_copy; + st->dlm = dlm; } else { - string_dlm = NULL; + st->dlm = NULL; } } - void -cob_string_append (cob_field *src) +cob_string_delimited (cob_field *dlm) +{ + cob_string_delimited_intern (&share_string_state, dlm); +} + +static void +cob_string_append_intern (struct cob_string_state *st, cob_field *src) { size_t src_size; int i; @@ -859,34 +966,44 @@ cob_string_append (cob_field *src) if (!src_size) { return; } - if (string_dlm) { - size = (int)(src_size - string_dlm->size + 1); + if (st->dlm) { + size = (int)(src_size - st->dlm->size + 1); for (i = 0; i < size; ++i) { - if (memcmp (src->data + i, string_dlm->data, - string_dlm->size) == 0) { + if (memcmp (src->data + i, st->dlm->data, + st->dlm->size) == 0) { src_size = i; break; } } } - if (src_size <= string_dst->size - string_offset) { - memcpy (string_dst->data + string_offset, src->data, src_size); - string_offset += (int) src_size; + if (src_size <= st->dst->size - st->offset) { + memcpy (st->dst->data + st->offset, src->data, src_size); + st->offset += (int) src_size; } else { - size = (int)(string_dst->size - string_offset); - memcpy (string_dst->data + string_offset, src->data, (size_t)size); - string_offset += size; + size = (int)(st->dst->size - st->offset); + memcpy (st->dst->data + st->offset, src->data, (size_t)size); + st->offset += size; cob_set_exception (COB_EC_OVERFLOW_STRING); } } +void +cob_string_append (cob_field *src) +{ + cob_string_append_intern (&share_string_state, src); +} +static void +cob_string_finish_intern (struct cob_string_state *st) +{ + if (st->ptr) { + cob_set_int (st->ptr, st->offset + 1); + } +} void cob_string_finish (void) { - if (string_ptr) { - cob_set_int (string_ptr, string_offset + 1); - } + cob_string_finish_intern (&share_string_state); } /* UNSTRING */ @@ -901,51 +1018,71 @@ cob_string_finish (void) cob_unstring_tallying setting TALLYING (amount of targets set) one-time cob_unstring_finish (setting the string pointer / overflow exception) */ -void -cob_unstring_init (cob_field *src, cob_field *ptr, const size_t num_dlm) +static void +cob_unstring_init_intern ( + struct cob_unstring_state *st, + cob_field *src, + cob_field *ptr, + const size_t num_dlm +) { - unstring_src_copy = *src; - unstring_src = &unstring_src_copy; - unstring_ptr = NULL; - if (ptr) { - unstring_ptr_copy = *ptr; - unstring_ptr = &unstring_ptr_copy; - } + st->src = src; + st->ptr = ptr; - unstring_offset = 0; - unstring_count = 0; - unstring_ndlms = 0; + st->offset = 0; + st->count = 0; + st->ndlms = 0; + st->dlm_list_size = 0; cobglobptr->cob_exception_code = 0; - if (num_dlm > dlm_list_size) { - if (dlm_list) { - cob_free (dlm_list); - dlm_list_size = num_dlm; + if (num_dlm > st->dlm_list_size) { + if (st->dlm_list) { + cob_free (st->dlm_list); + st->dlm_list_size = num_dlm; } else if (num_dlm < DLM_DEFAULT_NUM) { - dlm_list_size = DLM_DEFAULT_NUM; + st->dlm_list_size = DLM_DEFAULT_NUM; } else { - dlm_list_size = num_dlm; + st->dlm_list_size = num_dlm; } - dlm_list = cob_malloc (dlm_list_size * sizeof(struct dlm_struct)); + st->dlm_list = cob_malloc (st->dlm_list_size * sizeof(struct dlm_struct)); } - if (unstring_ptr) { - unstring_offset = cob_get_int (unstring_ptr) - 1; - if (unstring_offset < 0 || unstring_offset >= (int)unstring_src->size) { + if (st->ptr) { + st->offset = cob_get_int (st->ptr) - 1; + if (st->offset < 0 || st->offset >= (int)st->src->size) { cob_set_exception (COB_EC_OVERFLOW_UNSTRING); } } } +void +cob_unstring_init ( + cob_field *src, + cob_field *ptr, + const size_t num_dlm +) +{ + cob_unstring_init_intern (&share_unstring_state, src, ptr, num_dlm); +} +static void +cob_unstring_delimited_intern (struct cob_unstring_state *st, cob_field *dlm, const cob_u32_t all) +{ + st->dlm_list[st->ndlms].uns_dlm = *dlm; + st->dlm_list[st->ndlms].uns_all = all; + st->ndlms++; +} void cob_unstring_delimited (cob_field *dlm, const cob_u32_t all) { - dlm_list[unstring_ndlms].uns_dlm = *dlm; - dlm_list[unstring_ndlms].uns_all = all; - unstring_ndlms++; + cob_unstring_delimited_intern (&share_unstring_state, dlm, all); } -void -cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) +static void +cob_unstring_into_intern ( + struct cob_unstring_state *st, + cob_field *dst, + cob_field *dlm, + cob_field *cnt +) { unsigned char *dlm_data; unsigned char *start; @@ -960,45 +1097,45 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) return; } - if (unstring_offset >= (int)unstring_src->size) { + if (st->offset >= (int)st->src->size) { /* overflow from the last iteration (multiple INTO targets) */ return; } dlm_data = NULL; - start = unstring_src->data + unstring_offset; + start = st->src->data + st->offset; /* no delimiter - just split into DELIMITED BY SIZE */ - if (unstring_ndlms == 0) { + if (st->ndlms == 0) { /* necessary for correct unstring offset: minimal size */ /* Note: field->size and therefore offset are guaranteed to be < INT_MAX by cobc */ match_size = cob_min_int ((int)COB_FIELD_SIZE (dst), - (int)unstring_src->size - unstring_offset); + (int)st->src->size - st->offset); cob_str_memcpy (dst, start, match_size); - unstring_offset += match_size; + st->offset += match_size; /* DELIMITED BY [ALL] x [.. OR [ALL] z] */ } else { - const int srsize = (int)unstring_src->size; + const int srsize = (int)st->src->size; unsigned char *p; unsigned char *dp; int found = 0; /* note: duplicate code for performance as most cases have either none or a single delimiter */ - if (unstring_ndlms == 1) { - const struct dlm_struct dlms = dlm_list[0]; + if (st->ndlms == 1) { + const struct dlm_struct dlms = st->dlm_list[0]; const int dlsize = (int) dlms.uns_dlm.size; - const unsigned char *s = unstring_src->data + srsize - dlsize + 1; + const unsigned char *s = st->src->data + srsize - dlsize + 1; dp = dlms.uns_dlm.data; for (p = start; p < s; ++p) { if (!memcmp (p, dp, (size_t)dlsize)) { /* delimiter matches */ match_size = (int)(p - start); /* count in */ cob_str_memcpy (dst, start, match_size); /* into */ - unstring_offset += match_size + dlsize; /* with pointer */ + st->offset += match_size + dlsize; /* with pointer */ dlm_data = dp; dlm_size = dlsize; if (dlms.uns_all) { /* delimited by all */ @@ -1006,7 +1143,7 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) if (memcmp (p, dp, (size_t)dlsize)) { break; } - unstring_offset += dlsize; + st->offset += dlsize; } } found = 1; @@ -1014,11 +1151,11 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) } } } else { - const unsigned char *s = unstring_src->data + srsize; + const unsigned char *s = st->src->data + srsize; int i; for (p = start; p < s; ++p) { - for (i = 0; i < unstring_ndlms; ++i) { - const struct dlm_struct dlms = dlm_list[i]; + for (i = 0; i < st->ndlms; ++i) { + const struct dlm_struct dlms = st->dlm_list[i]; const int dlsize = (int)dlms.uns_dlm.size; const unsigned char *s2 = s - dlsize + 1; if (p > s2) { @@ -1028,7 +1165,7 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) if (!memcmp (p, dp, (size_t)dlsize)) { /* delimiter matches */ match_size = (int)(p - start); /* count in */ cob_str_memcpy (dst, start, match_size); /* into */ - unstring_offset += match_size + dlsize; /* with pointer */ + st->offset += match_size + dlsize; /* with pointer */ dlm_data = dp; dlm_size = dlsize; if (dlms.uns_all) { /* delimited by all */ @@ -1036,7 +1173,7 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) if (memcmp (p, dp, (size_t)dlsize)) { break; } - unstring_offset += dlsize; + st->offset += dlsize; } } found = 1; @@ -1051,12 +1188,12 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) /* if none of the delimiters matched, match to end */ if (!found) { - match_size = (int)(unstring_src->size - unstring_offset); + match_size = (int)(st->src->size - st->offset); cob_str_memcpy (dst, start, match_size); - unstring_offset = (int) unstring_src->size; + st->offset = (int) st->src->size; } } - unstring_count++; + st->count++; /* note: per any known dialect both DELIMITER IN and COUNT IN are only allowed if there is a DELIMITED BY phrase; the GnuCOBOL parser @@ -1078,47 +1215,69 @@ cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) cob_set_int (cnt, match_size); } } +void +cob_unstring_into ( + cob_field *dst, + cob_field *dlm, + cob_field *cnt +) +{ + cob_unstring_into_intern (&share_unstring_state, dst, dlm, cnt); +} +static void +cob_unstring_tallying_intern (struct cob_unstring_state *st, cob_field *f) +{ + cob_add_int (f, st->count, 0); +} void cob_unstring_tallying (cob_field *f) { - cob_add_int (f, unstring_count, 0); + cob_unstring_tallying_intern (&share_unstring_state, f); } -void -cob_unstring_finish (void) +static void +cob_unstring_finish_intern (struct cob_unstring_state *st) { - if (unstring_offset < (int)unstring_src->size) { + if (st->offset < (int)st->src->size) { /* overflow from any iteration -> overflow exception */ cob_set_exception (COB_EC_OVERFLOW_UNSTRING); } - if (unstring_ptr) { - cob_set_int (unstring_ptr, unstring_offset + 1); + if (st->ptr) { + cob_set_int (st->ptr, st->offset + 1); } } +void +cob_unstring_finish (void) +{ + cob_unstring_finish_intern (&share_unstring_state); +} /* Initialization/Termination */ void -cob_exit_strings (void) +cob_exit_strings () { - if (inspect_mark) { - cob_free (inspect_mark); - inspect_mark = NULL; + struct cob_inspect_state *sti = &share_inspect_state; + struct cob_unstring_state *stu = &share_unstring_state; + + if (sti->mark) { + cob_free (sti->mark); + sti->mark = NULL; } - inspect_mark_size = inspect_mark_min = inspect_mark_max = 0; - if (inspect_repdata) { - cob_free (inspect_repdata); - inspect_repdata = NULL; + sti->mark_size = sti->mark_min = sti->mark_max = 0; + if (sti->repdata) { + cob_free (sti->repdata); + sti->repdata = NULL; } - inspect_repdata_size = 0; + sti->repdata_size = 0; - if (dlm_list) { - cob_free (dlm_list); - dlm_list = NULL; + if (stu->dlm_list) { + cob_free (stu->dlm_list); + stu->dlm_list = NULL; } - dlm_list_size = 0; + stu->dlm_list_size = 0; if (figurative_ptr) { cob_free (figurative_ptr); diff --git a/tests/ChangeLog b/tests/ChangeLog index 767e43a2c..94eb7191a 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -27,6 +27,11 @@ or if --enable-debug was specified during configure * testsuite.src: adjusted several tests to use that option +2024-02-26 Boris Eng + + * testsuite.at: added a new test suite to test the backward compatibility + of strings functions (INSPECT, STRING, UNSTRING) + 2023-02-21 Fabrice Le Fessant * testsuite.src/syn_literals.at: move syntax checks on literals diff --git a/tests/Makefile.am b/tests/Makefile.am index c4acdbff9..002be9b2c 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -1,7 +1,7 @@ # # Makefile gnucobol/tests # -# Copyright (C) 2003-2012, 2014-2019, 2022-2023 Free Software Foundation, Inc. +# Copyright (C) 2003-2012, 2014-2019, 2022-2024 Free Software Foundation, Inc. # Written by Keisuke Nishida, Roger While, Simon Sobisch # # This file is part of GnuCOBOL. @@ -63,6 +63,7 @@ testsuite_sources = \ testsuite.src/data_display.at \ testsuite.src/data_packed.at \ testsuite.src/data_pointer.at \ + testsuite.src/backcomp.at \ testsuite.src/numeric-dump.cob \ testsuite.src/numeric-display.cob diff --git a/tests/testsuite.at b/tests/testsuite.at index 1b1c2baf7..3b8e4c35b 100644 --- a/tests/testsuite.at +++ b/tests/testsuite.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2014-2023 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2014-2024 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch ## ## This file is part of GnuCOBOL. @@ -81,3 +81,7 @@ m4_include([data_binary.at]) # USAGE BINARY m4_include([data_display.at]) # USAGE DISPLAY m4_include([data_packed.at]) # USAGE PACKED-DECIMAL m4_include([data_pointer.at]) # USAGE POINTER + +## Test for backward compatibility +AT_BANNER([Backward compatibility]) +m4_include([backcomp.at]) diff --git a/tests/testsuite.src/backcomp.at b/tests/testsuite.src/backcomp.at new file mode 100644 index 000000000..f20f08ba7 --- /dev/null +++ b/tests/testsuite.src/backcomp.at @@ -0,0 +1,3873 @@ +## Copyright (C) 2024 Free Software Foundation, Inc. +## Written by Boris Eng +## +## This file is part of GnuCOBOL. +## +## The GnuCOBOL compiler is free software: you can redistribute it +## and/or modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation, either version 3 of the +## License, or (at your option) any later version. +## +## GnuCOBOL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with GnuCOBOL. If not, see . + +### GnuCOBOL Test Suite for backward compatibility +## +## Tests in this file are used to check that the C code coming from COBOL +## programs compiled with previous versions of GnuCOBOL are still executed +## correctly with newer versions of the compiler. +## It is useful when implementing new features in order to prevent the loss of +## compatibility with programs compiled with previous versions. +## +## To add new tests, +## 1. Choose a COBOL program; +## 2. Compile it with GnuCOBOL 2.2 (minimal compatibility ensured) and the +## flags -Cx and -fno-computed-goto (to generated more portable C code). +## Additional flags may be added if needed. +## - If it does not work for compatibility reasons (unsupported feature), +## return to step 2 with the next version of the compiler; +## - If it does not work because of some unrecognized or conflicting code, +## it may be necessary to inline some functions (typically, specialized +## comparison functions such as cob_cmp_s32 which can be replaced by the +## general comparison function cob_cmp_int); +## 3. For more convenience, if the generated program is prog.c, inline the +## headers by replacing #include "prog.c.h" and #include "prog.c.l.h" +## by the content of the files prog.c.h and prog.c.l.h respectively; +## 4. Although not mandatory, it is wiser to polish the code by removing +## useless headers or portions of code. + +AT_SETUP([STRING WITH POINTER ON OVERFLOW with DELIMITER]) +AT_KEYWORDS([backcomp runmisc exceptions]) + +AT_DATA([prog.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:21:18 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "avril 23 2024 11:21:18" +#define COB_MODULE_DATE 20240423 +#define COB_MODULE_TIME 112118 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:21:18 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x10, 2, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + +static const cob_field_attr cob_all_attr = {0x22, 0, 0, 0, NULL}; + + +/* Constants */ +static const cob_field c_1 = {1, (cob_u8_ptr)"A", &a_3}; +static const cob_field c_2 = {1, (cob_u8_ptr)"B", &a_3}; +static const cob_field c_3 = {1, (cob_u8_ptr)"C", &a_3}; +static const cob_field c_4 = {27, (cob_u8_ptr)"Case A: Should not overflow", &a_3}; +static const cob_field c_5 = {16, (cob_u8_ptr)"A: TRTG-STRING <", &a_3}; +static const cob_field c_6 = {10, (cob_u8_ptr)"> != ", &a_3}; +static const cob_field c_7 = {16, (cob_u8_ptr)"A: STR-POINTER <", &a_3}; +static const cob_field c_8 = {9, (cob_u8_ptr)"> != <04>", &a_3}; +static const cob_field c_9 = {23, (cob_u8_ptr)"Case B: Should overflow", &a_3}; +static const cob_field c_10 = {16, (cob_u8_ptr)"B: TRTG-STRING <", &a_3}; +static const cob_field c_11 = {11, (cob_u8_ptr)"> != SPACES", &a_3}; +static const cob_field c_12 = {16, (cob_u8_ptr)"B: STR-POINTER <", &a_3}; +static const cob_field c_13 = {9, (cob_u8_ptr)"> != <00>", &a_3}; +static const cob_field c_14 = {23, (cob_u8_ptr)"Case C: Should overflow", &a_3}; +static const cob_field c_15 = {16, (cob_u8_ptr)"C: TRTG-STRING <", &a_3}; +static const cob_field c_16 = {16, (cob_u8_ptr)"C: STR-POINTER <", &a_3}; +static const cob_field c_17 = {3, (cob_u8_ptr)"1|2", &a_3}; +static const cob_field c_18 = {3, (cob_u8_ptr)"A|B", &a_3}; +static const cob_field c_19 = {3, (cob_u8_ptr)"C|D", &a_3}; +static const cob_field c_20 = {16, (cob_u8_ptr)"D: TRGT-STRING <", &a_3}; +static const cob_field c_21 = {10, (cob_u8_ptr)"> != <1AC>", &a_3}; + +static cob_field cob_all_space = {1, (cob_u8_ptr)" ", &cob_all_attr}; + +/* Function prototypes */ + +static int StringTest (); +static int StringTest_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (StringTest ()); +} + +/* Functions */ + +/* PROGRAM-ID 'StringTest' */ + +/* ENTRY 'StringTest' */ + +static int +StringTest () +{ + return StringTest_ (0); +} + +static int +StringTest_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at avril 23 2024 11:21:18 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'StringTest' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[3] __attribute__((aligned)); /* TRGT-STRING */ + static cob_u8_t b_7[2] __attribute__((aligned)); /* STR-POINTER */ + static cob_u8_t b_8[1] __attribute__((aligned)); /* SRC-DELIM */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_6 = {3, b_6, &a_1}; /* TRGT-STRING */ + static cob_field f_7 = {2, b_7, &a_2}; /* STR-POINTER */ + static cob_field f_8 = {1, b_8, &a_1}; /* SRC-DELIM */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 21 : Entry StringTest : prog.cob */ + l_2:; + + /* Line: 21 : MOVE : prog.cob */ + memcpy (b_7, "01", 2); + + /* Line: 22 : STRING : prog.cob */ + cob_glob_ptr->cob_exception_code = 0; + cob_string_init (&f_6, &f_7); + cob_string_delimited (NULL); + cob_string_append ((cob_field *)&c_1); + cob_string_append ((cob_field *)&c_2); + cob_string_append ((cob_field *)&c_3); + cob_string_finish (); + if (unlikely ((cob_glob_ptr->cob_exception_code & 0xff00) == 0x0a00)) + { + + /* Line: 26 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_4); + } + + /* Line: 28 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"ABC", 3) != 0)) + { + + /* Line: 29 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_5, &f_6, &c_6); + } + + /* Line: 30 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_7, 2, 4LL, 0) != 0)) + { + + /* Line: 31 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_7, &f_7, &c_8); + } + + /* Line: 34 : MOVE : prog.cob */ + memset (b_7, 48, 2); + + /* Line: 35 : MOVE : prog.cob */ + memset (b_6, 32, 3); + + /* Line: 36 : STRING : prog.cob */ + cob_glob_ptr->cob_exception_code = 0; + cob_string_init (&f_6, &f_7); + cob_string_delimited (NULL); + cob_string_append ((cob_field *)&c_1); + cob_string_append ((cob_field *)&c_2); + cob_string_append ((cob_field *)&c_3); + cob_string_finish (); + if (!cob_glob_ptr->cob_exception_code) + { + + /* Line: 40 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_9); + } + + /* Line: 42 : IF : prog.cob */ + if (((int)cob_cmp (&f_6, &cob_all_space) != 0)) + { + + /* Line: 43 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_10, &f_6, &c_11); + } + + /* Line: 44 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_7, 2, 0LL, 0) != 0)) + { + + /* Line: 45 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_12, &f_7, &c_13); + } + + /* Line: 48 : MOVE : prog.cob */ + memcpy (b_7, "04", 2); + + /* Line: 49 : MOVE : prog.cob */ + memset (b_6, 32, 3); + + /* Line: 50 : STRING : prog.cob */ + cob_glob_ptr->cob_exception_code = 0; + cob_string_init (&f_6, &f_7); + cob_string_delimited (NULL); + cob_string_append ((cob_field *)&c_1); + cob_string_append ((cob_field *)&c_2); + cob_string_append ((cob_field *)&c_3); + cob_string_finish (); + if (!cob_glob_ptr->cob_exception_code) + { + + /* Line: 54 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_14); + } + + /* Line: 56 : IF : prog.cob */ + if (((int)cob_cmp (&f_6, &cob_all_space) != 0)) + { + + /* Line: 57 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_15, &f_6, &c_11); + } + + /* Line: 58 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_7, 2, 4LL, 0) != 0)) + { + + /* Line: 59 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_16, &f_7, &c_8); + } + + /* Line: 62 : MOVE : prog.cob */ + memcpy (b_7, "01", 2); + + /* Line: 63 : MOVE : prog.cob */ + *(b_8) = 124; + + /* Line: 64 : MOVE : prog.cob */ + memset (b_6, 32, 3); + + /* Line: 65 : STRING : prog.cob */ + cob_string_init (&f_6, &f_7); + cob_string_delimited (&f_8); + cob_string_append ((cob_field *)&c_17); + cob_string_append ((cob_field *)&c_18); + cob_string_append ((cob_field *)&c_19); + cob_string_finish (); + + /* Line: 69 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"1AC", 3) != 0)) + { + + /* Line: 70 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_20, &f_6, &c_21); + } + + /* Line: 72 : GOBACK : prog.cob */ + goto exit_program; + + /* Program exit */ + + exit_program: + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "StringTest"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())StringTest; + module->module_cancel.funcptr = (void *(*)())StringTest_; + module->collating_sequence = NULL; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memset (b_6, 32, 3); + memset (b_7, 48, 2); + *(cob_u8_ptr)(b_8) = 32; + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'StringTest' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE prog.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([UNSTRING DELIMITED POINTER]) +AT_KEYWORDS([backcomp runmisc]) + +AT_DATA([prog.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:30:26 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "avril 23 2024 11:30:26" +#define COB_MODULE_DATE 20240423 +#define COB_MODULE_TIME 113026 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:30:26 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x1000, NULL}; +static const cob_field_attr a_2 = {0x10, 2, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x0000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {18, (cob_u8_ptr)"Expected 48 - Got ", &a_1}; +static const cob_field c_2 = {18, (cob_u8_ptr)"Expected 62 - Got ", &a_1}; +static const cob_field c_3 = {18, (cob_u8_ptr)"Expected 63 - Got ", &a_1}; +static const cob_field c_4 = {5, (cob_u8_ptr)" PIC ", &a_1}; +static const cob_field c_5 = {7, (cob_u8_ptr)" COMP-3", &a_1}; +static const cob_field c_6 = {1, (cob_u8_ptr)".", &a_1}; + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at avril 23 2024 11:30:26 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[66] __attribute__((aligned)); /* WS-LAY-RECORD */ + static cob_u8_t b_7[50] __attribute__((aligned)); /* WS-DUMMY */ + static cob_u8_t b_8[32] __attribute__((aligned)); /* WS-KEYWORD */ + static cob_u8_t b_9[2] __attribute__((aligned)); /* WS-POINTER */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_6 = {66, b_6, &a_3}; /* WS-LAY-RECORD */ + static cob_field f_7 = {50, b_7, &a_3}; /* WS-DUMMY */ + static cob_field f_8 = {32, b_8, &a_3}; /* WS-KEYWORD */ + static cob_field f_9 = {2, b_9, &a_2}; /* WS-POINTER */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 11 : Entry prog : prog.cob */ + l_2:; + + /* Line: 11 : MOVE : prog.cob */ + memcpy (b_6, " 10 AF-RECORD-TYPE-SEQUENCE-04 PIC 9(05) COMP-3. ", 66); + + /* Line: 14 : MOVE : prog.cob */ + memcpy (b_9, "01", 2); + + /* Line: 15 : PERFORM : prog.cob */ + /* PERFORM 0001-SUB */ + frame_ptr++; + frame_ptr->perform_through = 5; + frame_ptr->return_address_num = 0; + goto l_5; + l_6: + frame_ptr--; + + /* Line: 16 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_9, 2, 48LL, 0) != 0)) + { + + /* Line: 17 : DISPLAY : prog.cob */ + cob_display (0, 1, 2, &c_1, &f_9); + } + + /* Line: 18 : ADD : prog.cob */ + cob_add_int (&f_9, 7, 0); + + /* Line: 20 : PERFORM : prog.cob */ + /* PERFORM 0001-SUB */ + frame_ptr++; + frame_ptr->perform_through = 5; + frame_ptr->return_address_num = 1; + goto l_5; + l_7: + frame_ptr--; + + /* Line: 21 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_9, 2, 62LL, 0) != 0)) + { + + /* Line: 22 : DISPLAY : prog.cob */ + cob_display (0, 1, 2, &c_2, &f_9); + } + + /* Line: 23 : PERFORM : prog.cob */ + /* PERFORM 0001-SUB */ + frame_ptr++; + frame_ptr->perform_through = 5; + frame_ptr->return_address_num = 2; + goto l_5; + l_8: + frame_ptr--; + + /* Line: 24 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_9, 2, 63LL, 0) != 0)) + { + + /* Line: 25 : DISPLAY : prog.cob */ + cob_display (0, 1, 2, &c_3, &f_9); + } + + /* Line: 26 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Line: 27 : Paragraph 0001-SUB : prog.cob */ + l_5:; + + /* Line: 28 : UNSTRING : prog.cob */ + cob_unstring_init (&f_6, &f_9, 3); + cob_unstring_delimited ((cob_field *)&c_4, 0); + cob_unstring_delimited ((cob_field *)&c_5, 0); + cob_unstring_delimited ((cob_field *)&c_6, 0); + cob_unstring_into (&f_7, &f_8, 0); + cob_unstring_finish (); + + /* Implicit PERFORM return */ + if (frame_ptr->perform_through == 5) + goto P_switch; + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + switch (frame_ptr->return_address_num) { + case 2: + goto l_8; + case 1: + goto l_7; + case 0: + goto l_6; + } + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = NULL; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memset (b_6, 32, 66); + memset (b_7, 32, 50); + memset (b_8, 32, 32); + memset (b_9, 48, 2); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE prog.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([UNSTRING with FUNCTION / literal]) +AT_KEYWORDS([backcomp runmisc]) + +AT_DATA([prog.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:33:04 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "avril 23 2024 11:33:04" +#define COB_MODULE_DATE 20240423 +#define COB_MODULE_TIME 113304 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at avril 23 2024 11:33:04 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x1000, NULL}; +static const cob_field_attr a_2 = {0x21, 0, 0, 0x0000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {19, (cob_u8_ptr)"The,Quick,Brown,Fox", &a_1}; +static const cob_field c_2 = {1, (cob_u8_ptr)",", &a_1}; +static const cob_field c_3 = {10, (cob_u8_ptr)"PRM(1) is ", &a_1}; +static const cob_field c_4 = {1, (cob_u8_ptr)":", &a_1}; +static const cob_field c_5 = {10, (cob_u8_ptr)"PRM(2) is ", &a_1}; +static const cob_field c_6 = {10, (cob_u8_ptr)"PRM(3) is ", &a_1}; +static const cob_field c_7 = {10, (cob_u8_ptr)"PRM(4) is ", &a_1}; +static const cob_field c_8 = {20, (cob_u8_ptr)"Now using UPPER-CASE", &a_1}; +static const cob_field c_9 = {25, (cob_u8_ptr)"Daddy,was,a,Rolling stone", &a_1}; +static const cob_field c_10 = {17, (cob_u8_ptr)"Now using Literal", &a_1}; +static const cob_field c_11 = {30, (cob_u8_ptr)"Now using Literal + LOWER-CASE", &a_1}; + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at avril 23 2024 11:33:04 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[543] __attribute__((aligned)); /* FILLER 1 */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {479, b_6, &a_2}; /* TSTUNS */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 9 : Entry prog : prog.cob */ + l_2:; + + /* Line: 9 : MOVE : prog.cob */ + cob_move ((cob_field *)&c_1, &f_7); + + /* Line: 10 : UNSTRING : prog.cob */ + cob_unstring_init (&f_7, NULL, 1); + cob_unstring_delimited ((cob_field *)&c_2, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), 0, 0); + cob_unstring_finish (); + + /* Line: 12 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_3, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), &c_4); + + /* Line: 13 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_5, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), &c_4); + + /* Line: 14 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_6, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), &c_4); + + /* Line: 15 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_7, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), &c_4); + + /* Line: 16 : UNSTRING : prog.cob */ + cob_unstring_init (cob_intr_upper_case (0, 0, &f_7), NULL, 1); + cob_unstring_delimited ((cob_field *)&c_2, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), 0, 0); + cob_unstring_finish (); + + /* Line: 18 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_8); + + /* Line: 19 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_3, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), &c_4); + + /* Line: 20 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_5, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), &c_4); + + /* Line: 21 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_6, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), &c_4); + + /* Line: 22 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_7, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), &c_4); + + /* Line: 23 : UNSTRING : prog.cob */ + cob_unstring_init ((cob_field *)&c_9, NULL, 1); + cob_unstring_delimited ((cob_field *)&c_2, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), 0, 0); + cob_unstring_finish (); + + /* Line: 25 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_10); + + /* Line: 26 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_3, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), &c_4); + + /* Line: 27 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_5, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), &c_4); + + /* Line: 28 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_6, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), &c_4); + + /* Line: 29 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_7, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), &c_4); + + /* Line: 30 : UNSTRING : prog.cob */ + cob_unstring_init (cob_intr_lower_case (0, 0, (cob_field *)&c_9), NULL, 1); + cob_unstring_delimited ((cob_field *)&c_2, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), 0, 0); + cob_unstring_into (COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), 0, 0); + cob_unstring_finish (); + + /* Line: 33 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_11); + + /* Line: 34 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_3, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 0, &a_2), &c_4); + + /* Line: 35 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_5, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 1, &a_2), &c_4); + + /* Line: 36 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_6, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 2, &a_2), &c_4); + + /* Line: 37 : DISPLAY : prog.cob */ + cob_display (0, 1, 3, &c_7, COB_SET_FLD(f0, 16, b_6 + 479 + 16 * 3, &a_2), &c_4); + + /* Line: 38 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = NULL; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memset (b_6, 32, 543); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE prog.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], +[PRM(1) is The : +PRM(2) is Quick : +PRM(3) is Brown : +PRM(4) is Fox : +Now using UPPER-CASE +PRM(1) is THE : +PRM(2) is QUICK : +PRM(3) is BROWN : +PRM(4) is FOX : +Now using Literal +PRM(1) is Daddy : +PRM(2) is was : +PRM(3) is a : +PRM(4) is Rolling stone : +Now using Literal + LOWER-CASE +PRM(1) is daddy : +PRM(2) is was : +PRM(3) is a : +PRM(4) is rolling stone : +], []) + +AT_CLEANUP + + +AT_SETUP([SORT: EBCDIC table]) +AT_KEYWORDS([runmisc SORT ALPHABET OBJECT-COMPUTER]) + +AT_DATA([prog.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 16:25:46 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 16:25:46" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 162546 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 16:25:46 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x01, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {10, (cob_u8_ptr)"abcde12345", &a_3}; +static const cob_field c_2 = {10, (cob_u8_ptr)"54321edcba", &a_3}; + + +/* ASCII to EBCDIC table */ +static const unsigned char cob_ascii_ebcdic[256] = { + 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, + 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, + 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, + 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, + 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, + 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, + 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, + 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, + 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, + 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, + 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, + 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, + 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, + 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, + 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, + 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, + 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, + 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, + 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, + 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, + 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, + 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, + 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, + 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, + 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, + 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, + 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, + 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, + 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, + 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, + 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, + 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 16:25:46 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[10] __attribute__((aligned)); /* Z */ + static cob_u8_t b_7[10] __attribute__((aligned)); /* G */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {10, b_7, &a_2}; /* G */ + static cob_field f_9 = {1, b_7, &a_1}; /* X */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 15 : Entry prog : prog.cob */ + l_2:; + + /* Line: 15 : MOVE : prog.cob */ + memcpy (b_7, b_6, 10); + + /* Line: 17 : SORT : prog.cob */ + cob_table_sort_init (1, cob_ascii_ebcdic); + cob_table_sort_init_key (&f_9, 0, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_7 + 0, &a_2), 10); + + /* Line: 18 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_1) != 0)) + { + + /* Line: 19 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 20 : MOVE : prog.cob */ + memcpy (b_7, b_6, 10); + + /* Line: 22 : SORT : prog.cob */ + cob_table_sort_init (1, cob_ascii_ebcdic); + cob_table_sort_init_key (&f_9, 1, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_7 + 0, &a_2), 10); + + /* Line: 23 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_2) != 0)) + { + + /* Line: 24 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 25 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = NULL; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "d4b2e1a3c5", 10); + memset (b_7, 32, 10); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_DATA([prog2.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 13:58:56 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 13:58:56" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 135856 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 13:58:56 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x01, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {10, (cob_u8_ptr)"abcde12345", &a_3}; +static const cob_field c_2 = {10, (cob_u8_ptr)"54321edcba", &a_3}; + + +/* ASCII to EBCDIC table */ +static const unsigned char cob_ascii_ebcdic[256] = { + 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, + 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, + 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, + 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, + 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, + 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, + 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, + 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, + 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, + 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, + 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, + 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, + 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, + 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, + 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, + 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, + 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, + 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, + 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, + 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, + 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, + 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, + 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, + 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, + 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, + 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, + 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, + 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, + 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, + 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, + 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, + 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog2 (); +static int prog2_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog2 ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog2' */ + +/* ENTRY 'prog2' */ + +static int +prog2 () +{ + return prog2_ (0); +} + +static int +prog2_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 13:58:56 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'prog2' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[10] __attribute__((aligned)); /* Z */ + static cob_u8_t b_7[10] __attribute__((aligned)); /* G */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {10, b_7, &a_2}; /* G */ + static cob_field f_9 = {1, b_7, &a_1}; /* X */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 16 : Entry prog2 : prog.cob */ + l_2:; + + /* Line: 16 : MOVE : prog.cob */ + memcpy (b_7, b_6, 10); + + /* Line: 17 : SORT : prog.cob */ + cob_table_sort_init (1, 0); + cob_table_sort_init_key (&f_9, 0, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_7 + 0, &a_2), 10); + + /* Line: 18 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_1) != 0)) + { + + /* Line: 19 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 20 : MOVE : prog.cob */ + memcpy (b_7, b_6, 10); + + /* Line: 21 : SORT : prog.cob */ + cob_table_sort_init (1, 0); + cob_table_sort_init_key (&f_9, 1, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_7 + 0, &a_2), 10); + + /* Line: 22 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_2) != 0)) + { + + /* Line: 23 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 24 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog2"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog2; + module->module_cancel.funcptr = (void *(*)())prog2_; + module->collating_sequence = cob_ascii_ebcdic; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "d4b2e1a3c5", 10); + memset (b_7, 32, 10); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog2' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE prog.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) +AT_CHECK([$COMPILE prog2.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([COLLATING SEQUENCE alphanum comparison]) +AT_KEYWORDS([runmisc EBCDIC ASCII]) + +AT_DATA([ascii.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:37:21 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 17:37:21" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 173721 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:37:21 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x1000, NULL}; +static const cob_field_attr a_2 = {0x21, 0, 0, 0x0000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {1, (cob_u8_ptr)"1", &a_1}; +static const cob_field c_2 = {1, (cob_u8_ptr)"a", &a_1}; +static const cob_field c_3 = {5, (cob_u8_ptr)"ERROR", &a_1}; + + +/* NATIVE table */ +static const unsigned char cob_native[256] = { + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 17:37:21 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + + /* End of data storage */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 11 : Entry prog : prog.cob */ + l_2:; + + /* Line: 11 : IF : prog.cob */ + if (((int)cob_cmp ((cob_field *)&c_1, (cob_field *)&c_2) >= 0)) + { + + /* Line: 15 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_3); + } + + /* Line: 17 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = cob_native; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + + +AT_DATA([ebcdic.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:34:27 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 17:34:27" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 173427 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:34:27 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x1000, NULL}; +static const cob_field_attr a_2 = {0x21, 0, 0, 0x0000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {1, (cob_u8_ptr)"a", &a_1}; +static const cob_field c_2 = {1, (cob_u8_ptr)"1", &a_1}; +static const cob_field c_3 = {5, (cob_u8_ptr)"ERROR", &a_1}; + + +/* ASCII to EBCDIC table */ +static const unsigned char cob_ascii_ebcdic[256] = { + 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, + 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, + 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, + 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, + 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, + 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, + 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, + 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, + 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, + 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, + 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, + 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, + 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, + 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, + 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, + 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, + 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, + 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, + 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, + 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, + 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, + 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, + 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, + 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, + 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, + 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, + 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, + 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, + 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, + 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, + 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, + 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 17:34:27 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + + /* End of data storage */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 13 : Entry prog : prog.cob */ + l_2:; + + /* Line: 13 : IF : prog.cob */ + if (((int)cob_cmp ((cob_field *)&c_1, (cob_field *)&c_2) >= 0)) + { + + /* Line: 15 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_3); + } + + /* Line: 17 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = cob_ascii_ebcdic; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE -o ascii ascii.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./ascii], [0], [], []) + +AT_CHECK([$COMPILE -o ebcdic ebcdic.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./ebcdic], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([SORT: table with default COLLATING SEQUENCE]) +AT_KEYWORDS([runmisc SORT EBCDIC ASCII]) + +AT_DATA([ascii.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:47:39 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 17:47:39" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 174739 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:47:39 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x01, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {10, (cob_u8_ptr)"12345abcde", &a_3}; + + +/* NATIVE table */ +static const unsigned char cob_native[256] = { + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 17:47:39 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[10] __attribute__((aligned)); /* Z */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {10, b_6, &a_2}; /* G */ + static cob_field f_9 = {1, b_6, &a_1}; /* X */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 16 : Entry prog : prog.cob */ + l_2:; + + /* Line: 16 : SORT : prog.cob */ + cob_table_sort_init (1, 0); + cob_table_sort_init_key (&f_9, 0, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_6 + 0, &a_2), 10); + + /* Line: 18 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_1) != 0)) + { + + /* Line: 24 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 26 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = cob_native; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "d4b2e1a3c5", 10); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_DATA([ebcdic.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:48:46 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 17:48:46" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 174846 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:48:46 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x01, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {10, (cob_u8_ptr)"abcde12345", &a_3}; + + +/* ASCII to EBCDIC table */ +static const unsigned char cob_ascii_ebcdic[256] = { + 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, + 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, + 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, + 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, + 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, + 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, + 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, + 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, + 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, + 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, + 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, + 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, + 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, + 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, + 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, + 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, + 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, + 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, + 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, + 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, + 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, + 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, + 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, + 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, + 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, + 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, + 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, + 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, + 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, + 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, + 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, + 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 17:48:46 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[10] __attribute__((aligned)); /* Z */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {10, b_6, &a_2}; /* G */ + static cob_field f_9 = {1, b_6, &a_1}; /* X */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 16 : Entry prog : prog.cob */ + l_2:; + + /* Line: 16 : SORT : prog.cob */ + cob_table_sort_init (1, 0); + cob_table_sort_init_key (&f_9, 0, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_6 + 0, &a_2), 10); + + /* Line: 20 : IF : prog.cob */ + if (((int)cob_cmp (&f_7, (cob_field *)&c_1) != 0)) + { + + /* Line: 24 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 26 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = cob_ascii_ebcdic; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "d4b2e1a3c5", 10); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_DATA([native.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:49:26 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 17:49:26" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 174926 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 17:49:26 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x01, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + + +/* Constants */ +static const cob_field c_1 = {10, (cob_u8_ptr)"12345abcde", &a_3}; +static const cob_field c_2 = {10, (cob_u8_ptr)"abcde12345", &a_3}; + + +/* NATIVE table */ +static const unsigned char cob_native[256] = { + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, + 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, + 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, + 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, + 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, + 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, + 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, + 232, 233, 234, 235, 236, 237, 238, 239, + 240, 241, 242, 243, 244, 245, 246, 247, + 248, 249, 250, 251, 252, 253, 254, 255 +}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int prog (); +static int prog_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (prog ()); +} + +/* Functions */ + +/* PROGRAM-ID 'prog' */ + +/* ENTRY 'prog' */ + +static int +prog () +{ + return prog_ (0); +} + +static int +prog_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 17:49:26 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto -fno-constant-folding prog.cob */ + + /* Program local variables for 'prog' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Local cob_field items */ + cob_field f0; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[10] __attribute__((aligned)); /* Z */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_7 = {10, b_6, &a_2}; /* G */ + static cob_field f_9 = {1, b_6, &a_1}; /* X */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 16 : Entry prog : prog.cob */ + l_2:; + + /* Line: 16 : SORT : prog.cob */ + cob_table_sort_init (1, 0); + cob_table_sort_init_key (&f_9, 0, 0); + cob_table_sort (COB_SET_FLD(f0, 1, b_6 + 0, &a_2), 10); + + /* Line: 22 : IF : prog.cob */ + if ((!((int)cob_cmp (&f_7, (cob_field *)&c_1) == 0) || + ((int)cob_cmp (&f_7, (cob_field *)&c_2) == 0))) + { + + /* Line: 24 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &f_7); + } + + /* Line: 26 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "prog"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())prog; + module->module_cancel.funcptr = (void *(*)())prog_; + module->collating_sequence = cob_native; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "d4b2e1a3c5", 10); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'prog' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE -o ascii ascii.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./ascii], [0], [], []) +AT_CHECK([$COMPILE -o ebcdic ebcdic.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./ebcdic], [0], [], []) +AT_CHECK([$COMPILE -o native native.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./native], [0], [], []) + +AT_CLEANUP + + +AT_SETUP([INSPECT/STRING/UNSTRING statements]) +AT_KEYWORDS([backcomp INSPECT STRING UNSTRING]) + +AT_DATA([prog.c], [[ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 16:22:10 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + +#include +#include +#include +#include +#include +#define COB_KEYWORD_INLINE __inline +#include + +#define COB_SOURCE_FILE "prog.cob" +#define COB_PACKAGE_VERSION "2.2" +#define COB_PATCH_LEVEL 0 +#define COB_MODULE_FORMATTED_DATE "juil. 23 2024 16:22:10" +#define COB_MODULE_DATE 20240723 +#define COB_MODULE_TIME 162210 + +/* Global variables */ +/* Generated by cobc 2.2.0 */ +/* Generated from prog.cob */ +/* Generated at juil. 23 2024 16:22:10 */ +/* GnuCOBOL build date Apr 10 2024 16:39:16 */ +/* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ +/* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + +/* Module path */ +static const char *cob_module_path = NULL; + +/* Number of call parameters */ +static int cob_call_params = 0; + +/* Attributes */ + +static const cob_field_attr a_1 = {0x21, 0, 0, 0x0000, NULL}; +static const cob_field_attr a_2 = {0x10, 2, 0, 0x0000, NULL}; +static const cob_field_attr a_3 = {0x21, 0, 0, 0x1000, NULL}; + +static const cob_field_attr cob_all_attr = {0x22, 0, 0, 0, NULL}; + + +/* Constants */ +static const cob_field c_1 = {1, (cob_u8_ptr)"u", &a_3}; +static const cob_field c_2 = {1, (cob_u8_ptr)"2", &a_3}; +static const cob_field c_3 = {1, (cob_u8_ptr)"S", &a_3}; +static const cob_field c_4 = {1, (cob_u8_ptr)"3", &a_3}; +static const cob_field c_5 = {1, (cob_u8_ptr)"4", &a_3}; +static const cob_field c_6 = {1, (cob_u8_ptr)"5", &a_3}; +static const cob_field c_7 = {1, (cob_u8_ptr)"6", &a_3}; +static const cob_field c_8 = {1, (cob_u8_ptr)"s", &a_3}; +static const cob_field c_9 = {1, (cob_u8_ptr)"7", &a_3}; +static const cob_field c_10 = {1, (cob_u8_ptr)"U", &a_3}; +static const cob_field c_11 = {1, (cob_u8_ptr)"8", &a_3}; +static const cob_field c_12 = {1, (cob_u8_ptr)"a", &a_3}; +static const cob_field c_13 = {1, (cob_u8_ptr)"9", &a_3}; +static const cob_field c_14 = {2, (cob_u8_ptr)"aa", &a_3}; +static const cob_field c_15 = {2, (cob_u8_ptr)"AA", &a_3}; +static const cob_field c_16 = {2, (cob_u8_ptr)"10", &a_3}; +static const cob_field c_17 = {2, (cob_u8_ptr)"11", &a_3}; +static const cob_field c_18 = {2, (cob_u8_ptr)"12", &a_3}; + +static cob_field cob_all_space = {1, (cob_u8_ptr)" ", &cob_all_attr}; + + /* Decimal constants */ + + +/* Function prototypes */ + +static int strings__stmt (); +static int strings__stmt_ (const int); + +/* Main function */ +int +main (int argc, char **argv) +{ + cob_init (argc, argv); + cob_stop_run (strings__stmt ()); +} + +/* Functions */ + +/* PROGRAM-ID 'strings-stmt' */ + +/* ENTRY 'strings__stmt' */ + +static int +strings__stmt () +{ + return strings__stmt_ (0); +} + +static int +strings__stmt_ (const int entry) +{ + /* Program local variables */ + /* Generated by cobc 2.2.0 */ + /* Generated from prog.cob */ + /* Generated at juil. 23 2024 16:22:10 */ + /* GnuCOBOL build date Apr 10 2024 16:39:16 */ + /* GnuCOBOL package date Sep 06 2017 18:45:29 UTC */ + /* Compile command /opt/gnucobol/gnucobol-2.2/bin/cobc -Cx -fno-computed-goto prog.cob */ + + /* Program local variables for 'strings-stmt' */ + + /* Module initialization indicator */ + static unsigned int initialized = 0; + + /* Module structure pointer */ + static cob_module *module = NULL; + + /* Global variable pointer */ + cob_global *cob_glob_ptr; + + + /* Call parameters */ + cob_field *cob_procedure_params[1]; + + /* Perform frame stack */ + struct cob_frame *frame_ptr; + struct cob_frame frame_stack[255]; + + + /* Data storage */ + static int b_2; /* RETURN-CODE */ + static cob_u8_t b_6[30] __attribute__((aligned)); /* ws-0 */ + static cob_u8_t b_7[10] __attribute__((aligned)); /* ws-1 */ + static cob_u8_t b_8[40] __attribute__((aligned)); /* ws-2 */ + static cob_u8_t b_9[28] __attribute__((aligned)); /* ws-words */ + static cob_u8_t b_13[2] __attribute__((aligned)); /* ws-count */ + + /* End of data storage */ + + + /* Fields */ + static cob_field f_6 = {30, b_6, &a_1}; /* ws-0 */ + static cob_field f_7 = {10, b_7, &a_1}; /* ws-1 */ + static cob_field f_8 = {40, b_8, &a_1}; /* ws-2 */ + static cob_field f_10 = {10, b_9, &a_1}; /* ws-words1 */ + static cob_field f_11 = {12, b_9 + 10, &a_1}; /* ws-words2 */ + static cob_field f_12 = {6, b_9 + 22, &a_1}; /* ws-words3 */ + static cob_field f_13 = {2, b_13, &a_2}; /* ws-count */ + + /* End of fields */ + + + + /* Start of function code */ + + /* CANCEL callback */ + if (unlikely(entry < 0)) { + if (entry == -20) + goto P_clear_decimal; + goto P_cancel; + } + + /* Check initialized, check module allocated, */ + /* set global pointer, */ + /* push module stack, save call parameter count */ + if (cob_module_global_enter (&module, &cob_glob_ptr, 0, entry, 0)) + return -1; + + /* Set address of module parameter list */ + module->cob_procedure_params = cob_procedure_params; + + /* Set frame stack pointer */ + frame_ptr = frame_stack; + frame_ptr->perform_through = 0; + + /* Initialize rest of program */ + if (unlikely(initialized == 0)) { + goto P_initialize; + } + P_ret_initialize: + + /* Increment module active */ + module->module_active++; + + /* Entry dispatch */ + goto l_2; + + /* PROCEDURE DIVISION */ + + /* Line: 16 : Entry strings-stmt : prog.cob */ + l_2:; + + /* Line: 16 : Paragraph main-section : prog.cob */ + + /* Line: 17 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_all (&f_13, (cob_field *)&c_1); + cob_inspect_finish (); + + /* Line: 18 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_13, 2, 2LL, 0) != 0)) + { + + /* Line: 18 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_2); + + /* Line: 19 : INITIALIZE : prog.cob */ + memset (b_13, 48, 2); + + /* Line: 21 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_leading (&f_13, (cob_field *)&c_3); + cob_inspect_finish (); + + /* Line: 22 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_13, 2, 2LL, 0) != 0)) + { + + /* Line: 22 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_4); + + /* Line: 23 : INITIALIZE : prog.cob */ + memset (b_13, 48, 2); + + /* Line: 25 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_before (&cob_all_space); + cob_inspect_characters (&f_13); + cob_inspect_finish (); + + /* Line: 27 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_13, 2, 10LL, 0) != 0)) + { + + /* Line: 27 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_5); + + /* Line: 28 : INITIALIZE : prog.cob */ + memset (b_13, 48, 2); + + /* Line: 30 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_before (&cob_all_space); + cob_inspect_all (&f_13, (cob_field *)&c_3); + cob_inspect_finish (); + + /* Line: 32 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_13, 2, 4LL, 0) != 0)) + { + + /* Line: 32 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_6); + + /* Line: 33 : INITIALIZE : prog.cob */ + memset (b_13, 48, 2); + + /* Line: 35 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_after (&cob_all_space); + cob_inspect_all (&f_13, (cob_field *)&c_3); + cob_inspect_finish (); + + /* Line: 37 : IF : prog.cob */ + if (((int)cob_cmp_numdisp (b_13, 2, 1LL, 0) != 0)) + { + + /* Line: 37 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_7); + + /* Line: 39 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 1); + cob_inspect_start (); + cob_inspect_leading ((cob_field *)&c_8, (cob_field *)&c_3); + cob_inspect_finish (); + + /* Line: 40 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"ssYNSSWuAK 06fLGvxwYRgr BjVuSk", 30) != 0)) + { + + /* Line: 41 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_9); + + /* Line: 43 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 1); + cob_inspect_start (); + cob_inspect_all ((cob_field *)&c_8, (cob_field *)&c_3); + cob_inspect_start (); + cob_inspect_all ((cob_field *)&c_10, (cob_field *)&c_1); + cob_inspect_finish (); + + /* Line: 45 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"ssYNssWUAK 06fLGvxwYRgr BjVUsk", 30) != 0)) + { + + /* Line: 46 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_11); + + /* Line: 48 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 1); + cob_inspect_start (); + cob_inspect_before (&cob_all_space); + cob_inspect_all ((cob_field *)&c_12, (cob_field *)&c_8); + cob_inspect_finish (); + + /* Line: 51 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"aaYNaaWUAK 06fLGvxwYRgr BjVUsk", 30) != 0)) + { + + /* Line: 52 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_13); + + /* Line: 54 : INSPECT : prog.cob */ + cob_inspect_init (&f_6, 0); + cob_inspect_start (); + cob_inspect_converting ((cob_field *)&c_14, (cob_field *)&c_15); + cob_inspect_finish (); + + /* Line: 55 : IF : prog.cob */ + if (((int)memcmp (b_6, (cob_u8_ptr)"AAYNAAWUAK 06fLGvxwYRgr BjVUsk", 30) != 0)) + { + + /* Line: 56 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_16); + + /* Line: 58 : STRING : prog.cob */ + cob_string_init (&f_8, NULL); + cob_string_delimited (NULL); + cob_string_append (&f_6); + cob_string_delimited (NULL); + cob_string_append (&f_7); + cob_string_finish (); + + /* Line: 61 : IF : prog.cob */ + if (((int)memcmp (b_8, (cob_u8_ptr)"AAYNAAWUAK 06fLGvxwYRgr BjVUskoNDT8a9awk", 40) != 0)) + { + + /* Line: 62 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_17); + + /* Line: 64 : UNSTRING : prog.cob */ + cob_unstring_init (&f_6, NULL, 1); + cob_unstring_delimited (&cob_all_space, 1); + cob_unstring_into (&f_10, 0, 0); + cob_unstring_into (&f_11, 0, 0); + cob_unstring_into (&f_12, 0, 0); + cob_unstring_finish (); + + /* Line: 68 : IF : prog.cob */ + if (((int)memcmp (b_9, (cob_u8_ptr)"AAYNAAWUAK06fLGvxwYRgrBjVUsk", 28) != 0)) + { + + /* Line: 69 : DISPLAY : prog.cob */ + cob_display (0, 1, 1, &c_18); + + /* Line: 71 : STOP RUN : prog.cob */ + cob_stop_run (b_2); + } + } + } + } + } + } + } + } + } + } + } + + /* Program exit */ + + /* Decrement module active count */ + if (module->module_active) { + module->module_active--; + } + + /* Pop module stack */ + cob_module_leave (module); + + /* Program return */ + return b_2; + + /* Frame stack jump table */ + P_switch: + cob_fatal_error (COB_FERROR_CODEGEN); + + + /* Program initialization */ + P_initialize: + + cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); + + cob_module_path = cob_glob_ptr->cob_main_argv0; + + /* Initialize module structure */ + module->module_name = "strings-stmt"; + module->module_formatted_date = COB_MODULE_FORMATTED_DATE; + module->module_source = COB_SOURCE_FILE; + module->module_entry.funcptr = (void *(*)())strings__stmt; + module->module_cancel.funcptr = (void *(*)())strings__stmt_; + module->collating_sequence = NULL; + module->crt_status = NULL; + module->cursor_pos = NULL; + module->module_ref_count = NULL; + module->module_path = &cob_module_path; + module->module_active = 0; + module->module_date = COB_MODULE_DATE; + module->module_time = COB_MODULE_TIME; + module->module_type = 0; + module->module_param_cnt = 0; + module->module_returning = 0; + module->ebcdic_sign = 0; + module->decimal_point = '.'; + module->currency_symbol = '$'; + module->numeric_separator = ','; + module->flag_filename_mapping = 1; + module->flag_binary_truncate = 1; + module->flag_pretty_display = 1; + module->flag_host_sign = 0; + module->flag_no_phys_canc = 1; + module->flag_main = 1; + module->flag_fold_call = 0; + module->flag_exit_program = 0; + + /* Initialize cancel callback */ + cob_set_cancel (module); + + /* Initialize WORKING-STORAGE */ + b_2 = 0; + memcpy (b_6, "SSYNSSWuAK 06fLGvxwYRgr BjVuSk", 30); + memcpy (b_7, "oNDT8a9awk", 10); + memset (b_8, 32, 40); + memset (b_9, 32, 28); + memset (b_13, 48, 2); + + initialized = 1; + goto P_ret_initialize; + + /* CANCEL callback handling */ + P_cancel: + + if (!initialized) { + return 0; + } + if (module->module_active) { + cob_fatal_error (COB_FERROR_CANCEL); + } + + initialized = 0; + + P_clear_decimal: + + return 0; + +} + +/* End PROGRAM-ID 'strings-stmt' */ + +/* End functions */ + + +]]) + +AT_CHECK([$COMPILE prog.c], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) + +AT_CLEANUP