>From f89a50238de62b73d9fc44ee7226461650ab119d Tue 18 Feb 2025 04:19:13 PM EST
From: "James K. Lowden" <[email protected]>
Date: Tue 18 Feb 2025 04:19:13 PM EST
Subject: [PATCH] COBOL 11/14 84K lhd: libgcobol header files
libgcobol/ChangeLog
* /charmaps.h: New file.
* /common-defs.h: New file.
* /ec.h: New file.
* /exceptl.h: New file.
* /gcobolio.h: New file.
* /gfileio.h: New file.
* /gmath.h: New file.
* /io.h: New file.
* /libgcobol.h: New file.
* /valconv.h: New file.
---
libgcobol/charmaps.h |
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/common-defs.h |
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/ec.h |
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/exceptl.h |
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/gcobolio.h |
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/gfileio.h | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/gmath.h | ++++++++++++++++++++++++++++++++++++++-
libgcobol/io.h |
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/libgcobol.h |
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
libgcobol/valconv.h |
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
10 files changed, 2017 insertions(+), 10 deletions(-)
diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h
new file mode 100644
index 00000000000..64270c6f08c
--- /dev/null
+++ b/libgcobol/charmaps.h
@@ -0,0 +1,369 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef CHARMAPS_H
+#define CHARMAPS_H
+
+#include <unistd.h>
+
+/* There are four distinct codeset domains in the COBOL compiler.
+ *
+ * First is the codeset of the console. Established by looking at what
+ * setlocale() reports, this can be either UTF-8 or some ASCII based code
+ * page. (We assume CP1252). Data coming from the console or the system,
+ * ACCEPT statements; redirected console input, getenv() and other system
+ * calls are in the "console" domain.
+ *
+ * Second is the internal single-byte-coded codeset of the data, in memory,
+ * being manipulated by the generated code of the cobol executable. The
actual
+ * codeset of "internal" is either EBCDIC (in the form of Code Page 1140 or
+ * ASCII (Code Page 1252)
+ *
+ * Third is the C++ source code of the GCOBOL compiler; this comment is
+ * in that environment. We neither know, nor care, if this code is encoded in
+ * in UTF-8 (as is probable, in these enlighted days of 2022) or something
like
+ * Code Page1252. We are going to regard it as "ascii" under the
+ * assumption that there is no reason for any character in the compiler's
+ * source code to have a code point outside of the plain vanilla 0x20 through
+ * 0x7F range.
+ *
+ * Fourth is the "raw" COBOL source code that is the input to the GCOBOL
+ * compiler. This domain can be either UTF-8 or something like CodePage1252.
+ * Which encoding is relevant; The literal string MOVE "<euro>1234" is seven
+ * bytes long in UTF-8, and five bytes long in CP1252. We start with an
+ * assumption that it is UTF-8 and switch to CP1252 upon encountering a byte
+ * sequence with values above 0x80 that can't be UTF-8. We have provision for
+ * forcing it to be one or the other. Codepoints in that domain are
referenced
+ * as "raw". Codepoint in the "raw" domain don't last long; they are be
+ * converted to either "ascii" or "internal" early on, as necessary.
+ */
+
+
+/* Notes on character codesets:
+
+ This library is implemented to handle "native" codesets of either ASCII (in
+ the form of a single-byte-coded codeset like code page 1252) or EBCDIC (in
+ the form of a single-byte-coded codeset like code page 1140).
+
+ This C/C++ source code, however, is assumed to be an ASCII-based codeset,
+ so that a character constant like a space is assumed to encode as 0x20.
+
+ Furthermore, we assume that the codeset of the COBOL source code being
+ compiled is also ASCII-based, even if it is actually UTF-8. Said another
+ way, characters encoded between zero and 127 are regarded as ASCII.
+
+ This means that we are not going to try to compile EBCDIC COBOL source
code;
+ any such will have to be externally converted to ASCII before feeding it
+ through this compiler on an ASCII based Linux system.
+
+ This situation is rife for confusion here in the source code for the
+ library.
+
+ To help reduce that confusion, we are going to eschew character constants
+ in the C/C++ source code. Instead, we use symbolic versions. In general,
+ "source_space" means 0x20, while "internal_space" will be either 0x20
+ when using the ASCII-based native codeset, or it will be 0x40 when using
+ the EBCDIC-based native codeset.
+
+ Maintaining one's sanity while learning and working with this C/C++ code
+ will require a firm grip on context. You'll have to keep track of whether
+ the character is being used to analyze the ASCII-based COBOL source, or
+ whether the character in question is part of the native COBOL cobol data
+ that is being analyzed or generated.
+
+ For example, when a PICTURE string has in it a source_nine, the generated
+ result in the variable is based on character_zero.
+
+ Stay alert! */
+
+
+extern bool __gg__ebcdic_codeset_in_use;
+#define internal_is_ebcdic (__gg__ebcdic_codeset_in_use)
+
+extern unsigned short const *__gg__internal_codeset_map;
+
+#define NULLCH ('\0')
+#define DEGENERATE_HIGH_VALUE 0xFF
+#define DEGENERATE_LOW_VALUE 0x00
+
+#define ascii_A ((uint8_t)('A'))
+#define ascii_B ((uint8_t)('B'))
+#define ascii_C ((uint8_t)('C'))
+#define ascii_D ((uint8_t)('D'))
+#define ascii_E ((uint8_t)('E'))
+#define ascii_F ((uint8_t)('F'))
+#define ascii_G ((uint8_t)('G'))
+#define ascii_H ((uint8_t)('H'))
+#define ascii_I ((uint8_t)('I'))
+#define ascii_J ((uint8_t)('J'))
+#define ascii_K ((uint8_t)('K'))
+#define ascii_L ((uint8_t)('L'))
+#define ascii_M ((uint8_t)('M'))
+#define ascii_N ((uint8_t)('N'))
+#define ascii_O ((uint8_t)('O'))
+#define ascii_P ((uint8_t)('P'))
+#define ascii_Q ((uint8_t)('Q'))
+#define ascii_R ((uint8_t)('R'))
+#define ascii_S ((uint8_t)('S'))
+#define ascii_T ((uint8_t)('T'))
+#define ascii_U ((uint8_t)('U'))
+#define ascii_V ((uint8_t)('V'))
+#define ascii_W ((uint8_t)('W'))
+#define ascii_X ((uint8_t)('X'))
+#define ascii_Y ((uint8_t)('Y'))
+#define ascii_Z ((uint8_t)('Z'))
+#define ascii_a ((uint8_t)('a'))
+#define ascii_b ((uint8_t)('b'))
+#define ascii_c ((uint8_t)('c'))
+#define ascii_d ((uint8_t)('d'))
+#define ascii_e ((uint8_t)('e'))
+#define ascii_f ((uint8_t)('f'))
+#define ascii_g ((uint8_t)('g'))
+#define ascii_h ((uint8_t)('h'))
+#define ascii_i ((uint8_t)('i'))
+#define ascii_j ((uint8_t)('j'))
+#define ascii_k ((uint8_t)('k'))
+#define ascii_l ((uint8_t)('l'))
+#define ascii_m ((uint8_t)('m'))
+#define ascii_n ((uint8_t)('n'))
+#define ascii_o ((uint8_t)('o'))
+#define ascii_p ((uint8_t)('p'))
+#define ascii_q ((uint8_t)('q'))
+#define ascii_r ((uint8_t)('r'))
+#define ascii_s ((uint8_t)('s'))
+#define ascii_t ((uint8_t)('t'))
+#define ascii_u ((uint8_t)('u'))
+#define ascii_v ((uint8_t)('v'))
+#define ascii_w ((uint8_t)('w'))
+#define ascii_x ((uint8_t)('x'))
+#define ascii_y ((uint8_t)('y'))
+#define ascii_z ((uint8_t)('z'))
+#define ascii_space ((uint8_t)(' '))
+#define ascii_zero ((uint8_t)('0'))
+#define ascii_0 ((uint8_t)('0'))
+#define ascii_1 ((uint8_t)('1'))
+#define ascii_2 ((uint8_t)('2'))
+#define ascii_3 ((uint8_t)('3'))
+#define ascii_4 ((uint8_t)('4'))
+#define ascii_5 ((uint8_t)('5'))
+#define ascii_6 ((uint8_t)('6'))
+#define ascii_7 ((uint8_t)('7'))
+#define ascii_8 ((uint8_t)('8'))
+#define ascii_9 ((uint8_t)('9'))
+#define ascii_nine ((uint8_t)('9'))
+#define ascii_period ((uint8_t)('.'))
+#define ascii_colon ((uint8_t)(':'))
+#define ascii_comma ((uint8_t)(','))
+#define ascii_dquote ((uint8_t)('"'))
+#define ascii_oparen ((uint8_t)('('))
+#define ascii_caret ((uint8_t)('^'))
+#define ascii_slash ((uint8_t)('/'))
+#define ascii_plus ((uint8_t)('+'))
+#define ascii_minus ((uint8_t)('-'))
+#define ascii_hyphen ((uint8_t)('-'))
+#define ascii_underscore ((uint8_t)('_'))
+#define ascii_asterisk ((uint8_t)('*'))
+#define ascii_query ((uint8_t)('?'))
+#define ascii_cr ((uint8_t)('\r'))
+#define ascii_ff ((uint8_t)('\f'))
+#define ascii_newline ((uint8_t)('\n'))
+#define ascii_return ((uint8_t)('\r'))
+
+#define internal_space ((uint8_t)__gg__internal_codeset_map[ascii_space])
+#define internal_zero ((uint8_t)__gg__internal_codeset_map[ascii_zero])
+#define internal_period ((uint8_t)__gg__internal_codeset_map[ascii_period])
+#define internal_comma ((uint8_t)__gg__internal_codeset_map[ascii_comma])
+#define internal_dquote ((uint8_t)__gg__internal_codeset_map[ascii_dquote])
+#define internal_asterisk
((uint8_t)__gg__internal_codeset_map[ascii_asterisk])
+#define internal_plus ((uint8_t)__gg__internal_codeset_map[ascii_plus])
+#define internal_minus ((uint8_t)__gg__internal_codeset_map[ascii_minus])
+#define internal_cr ((uint8_t)__gg__internal_codeset_map[ascii_cr])
+#define internal_ff ((uint8_t)__gg__internal_codeset_map[ascii_ff])
+#define internal_newline ((uint8_t)__gg__internal_codeset_map[ascii_newline])
+#define internal_return ((uint8_t)__gg__internal_codeset_map[ascii_return])
+#define internal_0 ((uint8_t)__gg__internal_codeset_map[ascii_0])
+#define internal_1 ((uint8_t)__gg__internal_codeset_map[ascii_1])
+#define internal_2 ((uint8_t)__gg__internal_codeset_map[ascii_2])
+#define internal_3 ((uint8_t)__gg__internal_codeset_map[ascii_3])
+#define internal_4 ((uint8_t)__gg__internal_codeset_map[ascii_4])
+#define internal_5 ((uint8_t)__gg__internal_codeset_map[ascii_5])
+#define internal_6 ((uint8_t)__gg__internal_codeset_map[ascii_6])
+#define internal_7 ((uint8_t)__gg__internal_codeset_map[ascii_7])
+#define internal_8 ((uint8_t)__gg__internal_codeset_map[ascii_8])
+#define internal_9 ((uint8_t)__gg__internal_codeset_map[ascii_9])
+#define internal_colon ((uint8_t)__gg__internal_codeset_map[ascii_colon])
+#define internal_query ((uint8_t)__gg__internal_codeset_map[ascii_query])
+#define internal_A ((uint8_t)__gg__internal_codeset_map[ascii_A])
+#define internal_B ((uint8_t)__gg__internal_codeset_map[ascii_B])
+#define internal_C ((uint8_t)__gg__internal_codeset_map[ascii_C])
+#define internal_D ((uint8_t)__gg__internal_codeset_map[ascii_D])
+#define internal_E ((uint8_t)__gg__internal_codeset_map[ascii_E])
+#define internal_F ((uint8_t)__gg__internal_codeset_map[ascii_F])
+#define internal_G ((uint8_t)__gg__internal_codeset_map[ascii_G])
+#define internal_H ((uint8_t)__gg__internal_codeset_map[ascii_H])
+#define internal_I ((uint8_t)__gg__internal_codeset_map[ascii_I])
+#define internal_J ((uint8_t)__gg__internal_codeset_map[ascii_J])
+#define internal_K ((uint8_t)__gg__internal_codeset_map[ascii_K])
+#define internal_L ((uint8_t)__gg__internal_codeset_map[ascii_L])
+#define internal_M ((uint8_t)__gg__internal_codeset_map[ascii_M])
+#define internal_N ((uint8_t)__gg__internal_codeset_map[ascii_N])
+#define internal_O ((uint8_t)__gg__internal_codeset_map[ascii_O])
+#define internal_P ((uint8_t)__gg__internal_codeset_map[ascii_P])
+#define internal_Q ((uint8_t)__gg__internal_codeset_map[ascii_Q])
+#define internal_R ((uint8_t)__gg__internal_codeset_map[ascii_R])
+#define internal_S ((uint8_t)__gg__internal_codeset_map[ascii_S])
+#define internal_T ((uint8_t)__gg__internal_codeset_map[ascii_T])
+#define internal_U ((uint8_t)__gg__internal_codeset_map[ascii_U])
+#define internal_V ((uint8_t)__gg__internal_codeset_map[ascii_V])
+#define internal_W ((uint8_t)__gg__internal_codeset_map[ascii_W])
+#define internal_X ((uint8_t)__gg__internal_codeset_map[ascii_X])
+#define internal_Y ((uint8_t)__gg__internal_codeset_map[ascii_Y])
+#define internal_Z ((uint8_t)__gg__internal_codeset_map[ascii_Z])
+#define internal_a ((uint8_t)__gg__internal_codeset_map[ascii_a])
+#define internal_b ((uint8_t)__gg__internal_codeset_map[ascii_b])
+#define internal_c ((uint8_t)__gg__internal_codeset_map[ascii_c])
+#define internal_d ((uint8_t)__gg__internal_codeset_map[ascii_d])
+#define internal_e ((uint8_t)__gg__internal_codeset_map[ascii_e])
+#define internal_f ((uint8_t)__gg__internal_codeset_map[ascii_f])
+#define internal_g ((uint8_t)__gg__internal_codeset_map[ascii_g])
+#define internal_h ((uint8_t)__gg__internal_codeset_map[ascii_h])
+#define internal_i ((uint8_t)__gg__internal_codeset_map[ascii_i])
+#define internal_j ((uint8_t)__gg__internal_codeset_map[ascii_j])
+#define internal_k ((uint8_t)__gg__internal_codeset_map[ascii_k])
+#define internal_l ((uint8_t)__gg__internal_codeset_map[ascii_l])
+#define internal_m ((uint8_t)__gg__internal_codeset_map[ascii_m])
+#define internal_n ((uint8_t)__gg__internal_codeset_map[ascii_n])
+#define internal_o ((uint8_t)__gg__internal_codeset_map[ascii_o])
+#define internal_p ((uint8_t)__gg__internal_codeset_map[ascii_p])
+#define internal_q ((uint8_t)__gg__internal_codeset_map[ascii_q])
+#define internal_r ((uint8_t)__gg__internal_codeset_map[ascii_r])
+#define internal_s ((uint8_t)__gg__internal_codeset_map[ascii_s])
+#define internal_t ((uint8_t)__gg__internal_codeset_map[ascii_t])
+#define internal_u ((uint8_t)__gg__internal_codeset_map[ascii_u])
+#define internal_v ((uint8_t)__gg__internal_codeset_map[ascii_v])
+#define internal_w ((uint8_t)__gg__internal_codeset_map[ascii_w])
+#define internal_x ((uint8_t)__gg__internal_codeset_map[ascii_x])
+#define internal_y ((uint8_t)__gg__internal_codeset_map[ascii_y])
+#define internal_z ((uint8_t)__gg__internal_codeset_map[ascii_z])
+
+
+enum text_device_t
+ {
+ td_default_e,
+ td_sourcecode_e,
+ td_console_e,
+ };
+
+enum text_codeset_t
+ {
+ cs_default_e,
+ cs_utf8_e,
+ cs_cp1252_e,
+ cs_cp1140_e
+ };
+
+
+extern unsigned char __gg__data_space[1] ;
+extern unsigned char __gg__data_low_values[1] ;
+extern unsigned char __gg__data_zeros[1] ;
+extern unsigned char __gg__data_high_values[1] ;
+extern unsigned char __gg__data_quotes[1] ;
+extern unsigned char __gg__data_upsi_0[2] ;
+extern unsigned char __gg__data_return_code[2] ;
+
+// These are the various hardcoded tables used for conversions.
+extern const unsigned short __gg__one_to_one_values[256];
+extern const unsigned short __gg__cp1252_to_cp1140_values[256];
+extern const unsigned short __gg__cp1140_to_cp1252_values[256];
+
+// These are the two standard collations.
+extern const unsigned short __gg__cp1252_to_ebcdic_collation[256];
+extern const unsigned short __gg__ebcdic_to_cp1252_collation[256];
+
+// As described above, we have a number of operations we need to accomplish.
But
+// the actual routines are dependent on whether EBCDIC or ASCII is in use. We
+// implement that by having a function pointer for each function; those
pointers
+// are established when the __gg__ebcdic_codeset_in_use variable is
established.
+
+// These routines convert a single ASCII character to either ASCII or EBCDIC
+
+extern "C"
+char __gg__ascii_to_ascii_chr(char ch);
+extern "C"
+char __gg__ascii_to_ebcdic_chr(char ch);
+extern "C"
+char (*__gg__ascii_to_internal_chr)(char);
+#define ascii_to_internal(a) ((*__gg__ascii_to_internal_chr)(a))
+
+extern "C"
+void __gg__ascii_to_ascii(char *str, size_t length);
+extern "C"
+void __gg__ascii_to_ebcdic(char *str, size_t length);
+extern "C"
+void (*__gg__ascii_to_internal_str)(char *str, size_t length);
+#define ascii_to_internal_str(a, b) ((*__gg__ascii_to_internal_str)((a), (b)))
+
+extern "C"
+char *__gg__raw_to_ascii(char **dest, size_t *dest_size, const char *str,
size_t length);
+extern "C"
+char *__gg__raw_to_ebcdic(char **dest, size_t *dest_size, const char *in,
size_t length);
+extern "C"
+char *(*__gg__raw_to_internal)(char **dest, size_t *dest_length, const char
*in, size_t length);
+#define raw_to_internal(a, b, c, d) ((*__gg__raw_to_internal)((a), (b), (c),
(d)))
+
+extern "C"
+char *__gg__ascii_to_console(char **dest, size_t *dest_size, char const *
const str, const size_t length);
+extern "C"
+char *__gg__ebcdic_to_console(char **dest, size_t *dest_size, char const *
const str, const size_t length);
+extern "C"
+char *(*__gg__internal_to_console_cm)(char **dest, size_t *dest_size, const
char *in, size_t length);
+#define internal_to_console(a, b, c, d) ((*__gg__internal_to_console_cm)((a),
(b), (c), (d)))
+
+extern "C"
+void __gg__console_to_ascii(char * const str, size_t length);
+extern "C"
+void __gg__console_to_ebcdic(char * const str, size_t length);
+extern "C"
+void (*__gg__console_to_internal_cm)(char * const str, size_t length);
+#define console_to_internal(a, b) ((*__gg__console_to_internal_cm)((a), (b)))
+
+extern "C"
+void __gg__ebcdic_to_ascii(char *str, const size_t length);
+extern "C"
+void (*__gg__internal_to_ascii)(char *str, size_t length);
+#define internal_to_ascii(a, b) ((*__gg__internal_to_ascii)((a), (b)))
+
+extern "C" void __gg__set_internal_codeset(int use_ebcdic);
+
+extern "C"
+void __gg__text_conversion_override(text_device_t device,
+ text_codeset_t codeset);
+
+#endif
\ No newline at end of file
diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
new file mode 100644
index 00000000000..ebb4e8bd806
--- /dev/null
+++ b/libgcobol/common-defs.h
@@ -0,0 +1,496 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef COMMON_DEFS_H_
+#define COMMON_DEFS_H_
+
+#include <stdint.h>
+#include <list>
+
+#define COUNT_OF(X) (sizeof(X) / sizeof(X[0]))
+
+// This constant establishes the maximum number of digits in a fixed point
+// number. We are using 37 digits as a maximum because a full-size 37-digit
+// number (10**37) takes 123 bits, and a full-size 38-digit number (10**38)
+// takes 127 bits. By using a maximum of 37, that gives us an additional digit
+// of headroom in order to accomplish rounding.
+
+// You should keep in mind that the _Float128 binary floating point numbers
that
+// we use can reliably reproduce numbers of 33 decimal digits when going to
+// binary and back.
+
+#define MAX_FIXED_POINT_DIGITS (37)
+
+// COBOL tables can have up to seven subscripts
+#define MAXIMUM_TABLE_DIMENSIONS 7
+
+// This bit gets turned on in the first or last byte (depending on the
leading_e attribute
+// phrase) of a NumericDisplay to indicate that the value is negative.
+
+// When running the EBCDIC character set, the meaning of this bit is flipped,
+// because an EBCDIC zero is 0xF0, while ASCII is 0x30
+#define NUMERIC_DISPLAY_SIGN_BIT 0x40
+
+#define LEVEL01 (1)
+#define LEVEL49 (49)
+#define LEVEL77 (77)
+
+// In the __gg__move_literala() call, we piggyback this bit onto the
+// cbl_round_t parameter, just to cut down on the number of parameters passed
+#define REFER_ALL_BIT 0x80
+
+
+/*
+ * User-defined names in IBM COBOL can have at most 30 characters.
+ * For DBCS, the maximum is 14.
+ *
+ * Per ISO/IEC 1989:2023(E), 8.3.2 COBOL words,
+ * "A COBOL word is a character-string of not more than 63 characters"
+ */
+typedef char cbl_name_t[64];
+
+// Note that the field_type enum is duplicated in the source code for the
+// COBOL-aware GDB, and so any changes here (or there) have to be reflected
+// there (or here)
+
+// Note further that if this list changes, then the valid_move() matrix has to
+// change as will. Currently that matrix is in util.cc.
+
+enum cbl_field_type_t {
+ FldInvalid, // uninitialized
+ FldGroup,
+ FldAlphanumeric, // For X(n).
+ FldNumericBinary, // For 999v9 comp big-endian, 1 to 16 bytes
+ FldFloat, // 4-, 8-, and 16-byte floating point. See ieeedec_e
and big_endian_e flags
+ FldPacked, // For 999v9 comp-3 internal decimal, packed
decimal representation;
+ FldNumericBin5, // For 999v9 comp-5 little-endian, 1 to 16 bytes.
(Native binary)
+ FldNumericDisplay, // For 999v9 one decimal character per byte
+ FldNumericEdited, // For 999.9 PIC BPVZ90/,.+-CRDB*cs; must
have one of B/Z0,.*+-CRDBcs
+ FldAlphaEdited, // PIC AX9B0/; must have at least
one A or X, and at least one B0/
+ FldLiteralA, // Alphanumeric literal
+ FldLiteralN, // Numeric literal
+ FldClass,
+ FldConditional, // Target for parser_relop()
+ FldForward,
+ FldIndex,
+ FldSwitch,
+ FldDisplay,
+ FldPointer,
+ FldBlob,
+};
+
+
+/* BINARY, COMP, COMPUTATIONAL, COMP-4, COMPUTATIONAL-4 are the same:
+ * Storage, by default, is big-endian.
+ * PIC 9(1 to 4) is 2 bytes
+ * PIC 9(5 to 9) is 4 bytes
+ * PIC 9(10 to 18) is 8 bytes
+ * PIC 9(19-37) is 16 bytes
+ * COMP-1, COMPUTATIONAL-1
+ * 4-byte floating point (single)
+ * COMP-2, COMPUTATIONAL-2
+ * 8-byte floating point (double)
+ * PACKED-DECIMAL, COMP-3, COMPUTATIONAL-3
+ * Packed decimal. Final nybble is 0xF for unsigned numbers. For signable
+ * values, it is 0xD for negative, and 0xC for
non-negative
+ * COMP-5, COMPUTATIONAL-5
+ * Native binary. The maximum number of digits is implied by
+ * the 2, 4, or 8 bytes of data storage. By "native", little-endian
+ * is implied on Intel processors.
+ */
+
+/*
+ * Enumerated bit mask of variable attributes.
+ * A field as either left- or right-justified.
+ * A field is padded (in the unjustified direction) either with 0 or SPC.
+ * (But maybe the fill character should just be an explicit character.)
+ */
+enum cbl_field_attr_t : size_t {
+ none_e = 0x0000000000,
+ figconst_1_e = 0x0000000001, // This needs to be 1 - don't change the
position
+ figconst_2_e = 0x0000000002, // This needs to be 2
+ figconst_4_e = 0x0000000004, // This needs to be 4
+ rjust_e = 0x0000000008, // justify right
+ ljust_e = 0x0000000010, // justify left
+ zeros_e = 0x0000000020, // zero fill
+ signable_e = 0x0000000040,
+ constant_e = 0x0000000080, // pre-assigned constant
+ function_e = 0x0000000100,
+ quoted_e = 0x0000000200,
+ filler_e = 0x0000000400,
+ _spare_e = 0x0000000800, //
+ intermediate_e = 0x0000001000, // Compiler-defined temporary variable
+ embiggened_e = 0x0000002000, // redefined numeric made 64-bit by USAGE
POINTER
+ all_alpha_e = 0x0000004000, // FldAlphanumeric, but all A's
+ all_x_e = 0x0000008000, // picture is all X's
+ all_ax_e = 0x000000a000, // picture is all A's or all X's
+ prog_ptr_e = 0x0000010000, // FUNCTION-POINTER or PROGRAM-POINTER
+ scaled_e = 0x0000020000,
+ refmod_e = 0x0000040000, // Runtime; indicates a refmod is active
+ based_e = 0x0000080000, // pointer capacity, for ADDRESS OF or
ALLOCATE
+ any_length_e = 0x0000100000, // inferred length of linkage in nested
program
+ global_e = 0x0000200000, // field has global scope
+ external_e = 0x0000400000, // field has external scope
+ blank_zero_e = 0x0000800000, // BLANK WHEN ZERO
+ // data division uses 2 low bits of high byte
+ linkage_e = 0x0001000000, // field is in linkage section
+ local_e = 0x0002000000, // field is in local section
+ leading_e = 0x0004000000, // leading sign (signable_e alone means
trailing)
+ separate_e = 0x0008000000, // separate sign
+ envar_e = 0x0010000000, // names an environment variable
+ dnu_1_e = 0x0020000000, // unused: this attribute bit is available
+ bool_encoded_e = 0x0040000000, // data.initial is a boolean string
+ hex_encoded_e = 0x0080000000, // data.initial is a hex-encoded string
+ depends_on_e = 0x0100000000, // A group hierachy contains a DEPENDING_ON
+ initialized_e = 0x0200000000, // Don't call parser_initialize from
parser_symbol_add
+ has_value_e = 0x0400000000, // Flag to hierarchical descendents to
ignore .initial
+ ieeedec_e = 0x0800000000, // Indicates a FldFloat is IEEE 754
decimal, rather than binary
+ big_endian_e = 0x1000000000, // Indicates a value is big-endian
+ same_as_e = 0x2000000000, // Field produced by SAME AS (cannot take
new members)
+ record_key_e = 0x4000000000,
+ typedef_e = 0x8000000000, // IS TYPEDEF
+ strongdef_e = typedef_e + intermediate_e, // STRONG TYPEDEF (not
temporary)
+};
+enum cbl_figconst_t
+ {
+ normal_value_e = 0, // This one must be zero
+ low_value_e = 1, // The order is important, because
+ null_value_e = 2,
+ zero_value_e = 3, // at times we compare, for example, low_value_e to
+ space_value_e = 4,
+ quote_value_e = 5, //
+ high_value_e = 6, // high_value_e to determine that low is less than high
+ };
+#define FIGCONST_MASK (figconst_1_e|figconst_2_e|figconst_4_e)
+#define DATASECT_MASK (linkage_e | local_e)
+
+enum cbl_file_org_t {
+ file_disorganized_e,
+ file_sequential_e,
+ file_line_sequential_e,
+ file_indexed_e,
+ file_relative_e,
+};
+
+enum cbl_file_access_t {
+ file_inaccessible_e,
+ file_access_seq_e,
+ file_access_rnd_e,
+ file_access_dyn_e,
+};
+
+enum cbl_file_mode_t {
+ file_mode_none_e,
+ file_mode_input_e = 'r',
+ file_mode_output_e = 'w',
+ file_mode_extend_e = 'a',
+ file_mode_io_e = '+',
+};
+
+enum cbl_round_t {
+ away_from_zero_e,
+ nearest_toward_zero_e,
+ toward_greater_e,
+ toward_lesser_e,
+ nearest_away_from_zero_e,
+ nearest_even_e,
+ prohibited_e,
+ truncation_e,
+};
+
+#define RELOP_START 0
+enum relop_t {
+ lt_op = RELOP_START,
+ le_op,
+ eq_op,
+ ne_op,
+ ge_op,
+ gt_op,
+};
+
+#define LOGOP_START 100
+enum logop_t {
+ not_op = LOGOP_START,
+ and_op,
+ or_op,
+ xor_op,
+ xnor_op,
+ true_op,
+ false_op,
+};
+
+#define SETOP_START 200
+enum setop_t {
+ is_op = SETOP_START,
+};
+
+enum bitop_t {
+ bit_set_op, // set bit on
+ bit_clear_op, // set bit off
+ bit_on_op, // true if bit is on
+ bit_off_op, // true if bit is off
+ bit_and_op,
+ bit_or_op,
+ bit_xor_op,
+};
+
+enum file_close_how_t {
+ file_close_no_how_e = 0x00,
+ file_close_removal_e = 0x01,
+ file_close_no_rewind_e = 0x02,
+ file_close_with_lock_e = 0x04,
+ file_close_reel_unit_e = 0x08,
+};
+
+enum cbl_compute_error_code_t {
+ compute_error_none = 0x0000,
+ compute_error_truncate = 0x0001,
+ compute_error_divide_by_zero = 0x0002,
+ compute_error_exp_zero_by_zero = 0x0004,
+ compute_error_exp_zero_by_minus = 0x0008,
+ compute_error_exp_minus_by_frac = 0x0010,
+ compute_error_overflow = 0x0020,
+ compute_error_underflow = 0x0040,
+};
+
+enum cbl_arith_format_t {
+ not_expected_e,
+ no_giving_e, giving_e,
+ corresponding_e };
+
+enum cbl_encoding_t {
+ ASCII_e, // STANDARD-1 (in caps to avoid conflict with ascii_e in
libgcobol.cc)
+ iso646_e, // STANDARD-2
+ EBCDIC_e, // NATIVE or EBCDIC
+ custom_encoding_e,
+};
+
+enum cbl_truncation_mode {
+ trunc_std_e,
+ trunc_opt_e,
+ trunc_bin_e,
+};
+
+enum cbl_inspect_bound_t {
+ bound_characters_e,
+ bound_all_e,
+ bound_first_e,
+ bound_leading_e,
+ bound_trailing_e,
+};
+
+// a SPECIAL-NAME
+enum special_name_t {
+ SYSIN_e, SYSIPT_e, SYSOUT_e,
+ SYSLIST_e, SYSLST_e,
+ SYSPUNCH_e, SYSPCH_e,
+ CONSOLE_e,
+ C01_e, C02_e, C03_e, C04_e, C05_e, C06_e,
+ C07_e, C08_e, C09_e, C10_e, C11_e, C12_e,
+ CSP_e,
+ S01_e, S02_e, S03_e, S04_e, S05_e,
+ AFP_5A_e,
+ STDIN_e, STDOUT_e, STDERR_e, SYSERR_e,
+ ARG_NUM_e, ARG_VALUE_e, ENV_NAME_e, ENV_VALUE_e,
+};
+
+enum classify_t {
+ ClassInvalidType,
+ ClassNumericType,
+ ClassAlphabeticType,
+ ClassLowerType,
+ ClassUpperType,
+ ClassDbcsType,
+ ClassKanjiType,
+};
+
+static inline const char *
+classify_str( enum classify_t classify ) {
+ switch(classify) {
+ case ClassInvalidType: return "ClassInvalidType";
+ case ClassNumericType: return "ClassNumericType";
+ case ClassAlphabeticType: return "ClassAlphabeticType";
+ case ClassLowerType: return "ClassLowerType";
+ case ClassUpperType: return "ClassUpperType";
+ case ClassDbcsType: return "ClassDbcsType";
+ case ClassKanjiType: return "ClassKanjiType";
+ };
+ return "(unknown classification)";
+}
+
+static inline const char *
+cbl_file_mode_str( cbl_file_mode_t mode ) {
+ switch(mode) {
+ case file_mode_none_e: return "file_mode_none_e";
+ case file_mode_input_e: return "file_mode_input_e: 'r'";
+ case file_mode_output_e: return "file_mode_output_e: 'w'";
+ case file_mode_io_e: return "file_mode_io_e: '+'";
+ case file_mode_extend_e: return "file_mode_extend_e: 'a'";
+ }
+ return "???";
+};
+
+enum module_type_t {
+ module_activating_e,
+ module_current_e,
+ module_nested_e,
+ module_stack_e,
+ module_toplevel_e,
+};
+
+
+static inline bool
+ec_cmp( ec_type_t raised, ec_type_t mask )
+{
+ if( raised == mask ) return true;
+
+ // Do not match on only the low byte.
+ if( 0 < (~EC_ALL_E & static_cast<uint32_t>(mask)) ) return false;
+
+ return 0 != ( static_cast<uint32_t>(raised)
+ &
+ static_cast<uint32_t>(mask) );
+}
+
+struct cbl_enabled_exception_t {
+ bool enabled, location;
+ ec_type_t ec;
+ size_t file;
+
+ cbl_enabled_exception_t()
+ : enabled(false)
+ , location(false)
+ , ec(ec_none_e)
+ , file(0)
+ {}
+
+ cbl_enabled_exception_t( bool enabled, bool location,
+ ec_type_t ec, size_t file = 0 )
+ : enabled(enabled)
+ , location(location)
+ , ec(ec)
+ , file(file)
+ {}
+
+ // sort by ec and file, not enablement
+ bool operator<( const cbl_enabled_exception_t& that ) const {
+ if( ec == that.ec ) return file < that.file;
+ return ec < that.ec;
+ }
+ // match on ec and file, not enablement
+ bool operator==( const cbl_enabled_exception_t& that ) const {
+ return ec == that.ec && file == that.file;
+ }
+};
+
+
+class cbl_enabled_exceptions_array_t;
+
+class cbl_enabled_exceptions_t : protected std::set<cbl_enabled_exception_t>
+{
+ friend cbl_enabled_exceptions_array_t;
+ void apply( const cbl_enabled_exception_t& elem ) {
+ auto inserted = insert( elem );
+ if( ! inserted.second ) {
+ erase(inserted.first);
+ insert(elem);
+ }
+ }
+
+ public:
+ bool turn_on_off( bool enabled, bool location, ec_type_t type,
+ std::set<size_t> files );
+
+ const cbl_enabled_exception_t * match( ec_type_t type, size_t file = 0 );
+
+ void dump() const;
+
+ void clear() { std::set<cbl_enabled_exception_t>::clear(); }
+
+ bool empty() const { return std::set<cbl_enabled_exception_t>::empty(); }
+ size_t size() const { return std::set<cbl_enabled_exception_t>::size(); }
+
+ cbl_enabled_exceptions_t& operator=( const cbl_enabled_exceptions_t& that ) {
+ std::set<cbl_enabled_exception_t>& self(*this);
+ self = that;
+ return *this;
+ }
+};
+
+extern cbl_enabled_exceptions_t enabled_exceptions;
+
+/*
+ * This class is passed to the runtime function evaluating the raised
exception.
+ * It is constructed in genapi.cc from the compile-time table.
+ */
+struct cbl_enabled_exceptions_array_t {
+ size_t nec;
+ cbl_enabled_exception_t *ecs;
+
+ cbl_enabled_exceptions_array_t( size_t nec, cbl_enabled_exception_t *ecs )
+ : nec(nec), ecs(ecs) {}
+
+ cbl_enabled_exceptions_array_t( const cbl_enabled_exceptions_t& input =
+ cbl_enabled_exceptions_t() )
+ : nec(input.size())
+ , ecs(NULL)
+ {
+ if( ! input.empty() ) {
+ ecs = new cbl_enabled_exception_t[nec];
+ std::copy(input.begin(), input.end(), ecs);
+ }
+ }
+
+ cbl_enabled_exceptions_array_t&
+ operator=( const cbl_enabled_exceptions_array_t& input);
+
+
+ bool match( ec_type_t ec, size_t file = 0 ) const;
+
+ size_t nbytes() const { return nec * sizeof(ecs[0]); }
+};
+
+template <typename T>
+T enabled_exception_match( T beg, T end, ec_type_t type, size_t file ) {
+ cbl_enabled_exception_t input( true, true, // don't matter
+ type, file );
+ auto output = std::find(beg, end, input);
+ if( output == end ) {
+ output = std::find_if( beg, end, // match any file
+ [ec = type]( const cbl_enabled_exception_t& elem ) {
+ return
+ elem.file == 0 &&
+ ec_cmp(ec, elem.ec); } );
+ }
+ return output;
+}
+
+
+
+#endif
diff --git a/libgcobol/ec.h b/libgcobol/ec.h
new file mode 100644
index 00000000000..1e3f7cfa7ea
--- /dev/null
+++ b/libgcobol/ec.h
@@ -0,0 +1,213 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef _CBL_EC_H_
+#define _CBL_EC_H_
+
+#include <set>
+#include <assert.h>
+
+#define EC_ALL_E 0xFFFFFF00
+
+enum ec_type_t {
+ ec_none_e = 0x00000000,
+ ec_all_e = EC_ALL_E, // 0xFFFFFF00
+
+ ec_argument_e = 0x00000100,
+ ec_argument_function_e,
+ ec_argument_imp_e,
+ ec_argument_imp_command_e,
+ ec_argument_imp_environment_e,
+
+ ec_bound_e = 0x00000200,
+ ec_bound_func_ret_value_e,
+ ec_bound_imp_e,
+ ec_bound_odo_e,
+ ec_bound_overflow_e,
+ ec_bound_ptr_e,
+ ec_bound_ref_mod_e,
+ ec_bound_set_e,
+ ec_bound_subscript_e,
+ ec_bound_table_limit_e,
+
+ ec_data_e = 0x00000400,
+ ec_data_conversion_e,
+ ec_data_imp_e,
+ ec_data_incompatible_e,
+ ec_data_not_finite_e,
+ ec_data_overflow_e,
+ ec_data_ptr_null_e,
+
+ ec_external_e = 0x00000800,
+ ec_external_data_mismatch_e,
+ ec_external_file_mismatch_e,
+ ec_external_format_conflict_e,
+
+ ec_flow_e = 0x00001000,
+ ec_flow_global_exit_e,
+ ec_flow_global_goback_e,
+ ec_flow_imp_e,
+ ec_flow_release_e,
+ ec_flow_report_e,
+ ec_flow_return_e,
+ ec_flow_search_e,
+ ec_flow_use_e,
+
+ ec_function_e = 0x00002000,
+ ec_function_not_found_e,
+ ec_function_ptr_invalid_e,
+ ec_function_ptr_null_e,
+
+ ec_io_e = 0x00004000,
+ ec_io_at_end_e,
+ ec_io_invalid_key_e,
+ ec_io_permanent_error_e,
+ ec_io_logic_error_e,
+ ec_io_record_operation_e,
+ ec_io_file_sharing_e,
+ ec_io_record_content_e,
+ ec_io_imp_e,
+ ec_io_eop_e,
+ ec_io_eop_overflow_e,
+ ec_io_linage_e,
+
+ ec_imp_e = 0x00008000,
+ ec_imp_suffix_e,
+
+ ec_locale_e = 0x00010000,
+ ec_locale_imp_e,
+ ec_locale_incompatible_e,
+ ec_locale_invalid_e,
+ ec_locale_invalid_ptr_e,
+ ec_locale_missing_e,
+ ec_locale_size_e,
+
+ ec_oo_e = 0x00020000,
+ ec_oo_arg_omitted_e,
+ ec_oo_conformance_e,
+ ec_oo_exception_e,
+ ec_oo_imp_e,
+ ec_oo_method_e,
+ ec_oo_null_e,
+ ec_oo_resource_e,
+ ec_oo_universal_e,
+
+ ec_order_e = 0x00040000,
+ ec_order_imp_e,
+ ec_order_not_supported_e,
+
+ ec_overflow_e = 0x00080000,
+ ec_overflow_imp_e,
+ ec_overflow_string_e,
+ ec_overflow_unstring_e,
+
+ ec_program_e = 0x00100000,
+ ec_program_arg_mismatch_e,
+ ec_program_arg_omitted_e,
+ ec_program_cancel_active_e,
+ ec_program_imp_e,
+ ec_program_not_found_e,
+ ec_program_ptr_null_e,
+ ec_program_recursive_call_e,
+ ec_program_resources_e,
+
+ ec_raising_e = 0x00200000,
+ ec_raising_imp_e,
+ ec_raising_not_specified_e,
+
+ ec_range_e = 0x00400000,
+ ec_range_imp_e,
+ ec_range_index_e,
+ ec_range_inspect_size_e,
+ ec_range_invalid_e,
+ ec_range_perform_varying_e,
+ ec_range_ptr_e,
+ ec_range_search_index_e,
+ ec_range_search_no_match_e,
+
+ ec_report_e = 0x00800000,
+ ec_report_active_e,
+ ec_report_column_overlap_e,
+ ec_report_file_mode_e,
+ ec_report_imp_e,
+ ec_report_inactive_e,
+ ec_report_line_overlap_e,
+ ec_report_not_terminated_e,
+ ec_report_page_limit_e,
+ ec_report_page_width_e,
+ ec_report_sum_size_e,
+ ec_report_varying_e,
+
+ ec_screen_e = 0x01000000,
+ ec_screen_field_overlap_e,
+ ec_screen_imp_e,
+ ec_screen_item_truncated_e,
+ ec_screen_line_number_e,
+ ec_screen_starting_column_e,
+
+ ec_size_e = 0x02000000,
+ ec_size_address_e,
+ ec_size_exponentiation_e,
+ ec_size_imp_e,
+ ec_size_overflow_e,
+ ec_size_truncation_e,
+ ec_size_underflow_e,
+ ec_size_zero_divide_e,
+
+ ec_sort_merge_e = 0x04000000,
+ ec_sort_merge_active_e,
+ ec_sort_merge_file_open_e,
+ ec_sort_merge_imp_e,
+ ec_sort_merge_release_e,
+ ec_sort_merge_return_e,
+ ec_sort_merge_sequence_e,
+
+ ec_storage_e = 0x08000000,
+ ec_storage_imp_e,
+ ec_storage_not_alloc_e,
+ ec_storage_not_avail_e,
+
+ ec_user_e = 0x10000000,
+ ec_user_suffix_e,
+
+ ec_validate_e = 0x20000000,
+ ec_validate_content_e,
+ ec_validate_format_e,
+ ec_validate_imp_e,
+ ec_validate_relation_e,
+ ec_validate_varying_e,
+
+ ec_continue_e = 0x30000000,
+ ec_continue_less_than_zero,
+};
+
+
+#endif
diff --git a/libgcobol/exceptl.h b/libgcobol/exceptl.h
new file mode 100644
index 00000000000..35809034f4f
--- /dev/null
+++ b/libgcobol/exceptl.h
@@ -0,0 +1,256 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef _CBL_EXCEPTC_H_
+#define _CBL_EXCEPTC_H_
+
+/* This file contains declarations needed by the libgcobol compilation. Some
+ of the information here is required by the gcc/cobol compilation, and so it
+ is safe to include in those files. */
+
+static const ec_type_t simon_says_important[] = {
+ ec_argument_function_e,
+ ec_bound_odo_e,
+ ec_bound_ref_mod_e,
+ ec_bound_subscript_e,
+ ec_data_incompatible_e,
+ ec_data_ptr_null_e,
+ ec_size_overflow_e,
+ ec_size_exponentiation_e,
+ ec_size_truncation_e,
+ ec_size_zero_divide_e,
+ ec_program_not_found_e,
+ ec_program_recursive_call_e,
+ ec_program_arg_mismatch_e,
+};
+
+enum ec_disposition_t {
+ ec_category_none_e,
+ ec_category_fatal_e,
+ ec_category_nonfatal_e,
+ ec_category_implementor_e,
+
+ // unimplemented equivalents
+ uc_category_none_e = 0x80 + ec_category_none_e,
+ uc_category_fatal_e = 0x80 + ec_category_fatal_e,
+ uc_category_nonfatal_e = 0x80 + ec_category_nonfatal_e,
+ uc_category_implementor_e = 0x80 + ec_category_implementor_e,
+};
+
+struct ec_descr_t {
+ ec_type_t type;
+ ec_disposition_t disposition;
+ const cbl_name_t name;
+ const char *description;
+
+ bool operator==( ec_type_t type ) const {
+ return this->type == type;
+ }
+};
+
+extern ec_type_t ec_type_of( const cbl_name_t name );
+
+extern ec_descr_t __gg__exception_table[];
+extern ec_descr_t *__gg__exception_table_end;
+
+/* Inventory of exceptions:
+ In except.hc::__gg__exception_table, unimplemented ECs have a uc_
disposition.
+
+ ec_function_argument_e ACOS
+ ANNUITY
+ ASIN
+ LOG
+ LOG10
+ PRESENT-VALUE
+ SQRT
+
+ ec_sort_merge_file_open_e FILE MERGE
+
+ ec_bound_subscript_e table subscript not an integer
+ table subscript less than 1
+ table subscript greater than occurs
+
+ ec_bound_ref_mod_e refmod start not an integer
+ refmod start less than 1
+ refmod start greater than variable size
+ refmod length not an integer
+ refmod length less than 1
+ refmod start+length exceeds variable size
+
+ ec_bound_odo_e DEPENDING not an integer
+ DEPENDING greater than occurs upper limit
+ DEPENDING less than occurs lower limit
+ subscript greater than DEPENDING for sending
item
+
+ ec_size_zero_divide_e For both fixed-point and floating-point
division
+
+ ec_size_truncation
+ ec_size_exponentiation
+
+ */
+
+// SymException
+struct cbl_exception_t {
+ size_t program, file;
+ ec_type_t type;
+ cbl_file_mode_t mode;
+};
+
+
+struct cbl_declarative_t {
+ enum { files_max = 16 };
+ size_t section; // implies program
+ bool global;
+ ec_type_t type;
+ uint32_t nfile, files[files_max];
+ cbl_file_mode_t mode;
+
+ cbl_declarative_t( cbl_file_mode_t mode = file_mode_none_e )
+ : section(0), global(false), type(ec_none_e)
+ , nfile(0)
+ , mode(mode)
+ {
+ std::fill(files, files + COUNT_OF(files), 0);
+ }
+ cbl_declarative_t( ec_type_t type )
+ : section(0), global(false), type(type)
+ , nfile(0)
+ , mode(file_mode_none_e)
+ {
+ std::fill(files, files + COUNT_OF(files), 0);
+ }
+
+ cbl_declarative_t( size_t section, ec_type_t type,
+ const std::list<size_t>& files,
+ cbl_file_mode_t mode, bool global = false )
+ : section(section), global(global), type(type)
+ , nfile(files.size())
+ , mode(mode)
+ {
+ assert( files.size() <= COUNT_OF(this->files) );
+ std::fill(this->files, this->files + COUNT_OF(this->files), 0);
+ if( nfile > 0 ) {
+ std::copy( files.begin(), files.end(), this->files );
+ }
+ }
+ cbl_declarative_t( const cbl_declarative_t& that )
+ : section(that.section), global(that.global), type(that.type)
+ , nfile(that.nfile)
+ , mode(that.mode)
+ {
+ std::fill(files, files + COUNT_OF(files), 0);
+ if( nfile > 0 ) {
+ std::copy( that.files, that.files + nfile, this->files );
+ }
+ }
+
+ /*
+ * Sort file names before file modes, and file modes before non-IO.
+ */
+ bool operator<( const cbl_declarative_t& that ) const {
+ // file name declaratives first, in section order
+ if( nfile != 0 ) {
+ if( that.nfile != 0 ) return section < that.section;
+ return true;
+ }
+ // file mode declaratives between file name declaratives and non-IO
+ if( mode != file_mode_none_e ) {
+ if( that.nfile != 0 ) return false;
+ if( that.mode == file_mode_none_e ) return true;
+ return section < that.section;
+ }
+ // all others by section, after names and modes
+ if( that.nfile != 0 ) return false;
+ if( that.mode != file_mode_none_e ) return false;
+ return section < that.section;
+ }
+
+ // TRUE if there are no files to match, or the provided file is in the list.
+ bool match_file( size_t file ) const {
+ static const auto pend = files + nfile;
+
+ return nfile == 0 || pend != std::find(files, files + nfile, file);
+ }
+
+ // USE Format 1 names a file mode, or at least one file, and not an EC.
+ bool is_format_1() const {
+ assert(type != ec_none_e || nfile > 0 || mode != file_mode_none_e);
+ return nfile > 0 || mode != file_mode_none_e;
+ }
+};
+
+
+/*
+ * ec_status_t represents the runtime exception condition status for
+ * any statement. Prior to execution, the generated code
+ * clears "type", and sets "source_file" and "lineno".
+ *
+ * If the statement includes some kind of ON ERROR
+ * clause, the generated code sets "handled" to the exception type
+ * handled by that clause, else it sets "handled" to ec_none_e.
+ *
+ * Post-execution, the generated code sets "type" to the appropriate
+ * exception, if any. The match-exception logic compares any raised
+ * exception to the set of declaratives, and returns a symbol-table
+ * index to the matching declarative, if any.
+ */
+class ec_status_t {
+ char msg[132];
+public:
+ ec_type_t type, handled;
+ cbl_name_t statement; // e.g., "ADD"
+ size_t lineno;
+ const char *source_file;
+
+ ec_status_t()
+ : type(ec_none_e)
+ , handled(ec_none_e)
+ , lineno(0)
+ , source_file(NULL)
+ {
+ msg[0] = statement[0] = '\0';
+ }
+
+ ec_status_t& update();
+ ec_status_t& enable( unsigned int mask );
+
+ const char * exception_location() {
+ snprintf(msg, sizeof(msg), "%s:%zu: '%s'", source_file, lineno, statement);
+ return msg;
+ }
+ ec_type_t unhandled() const {
+ return ec_type_t(static_cast<unsigned int>(type)
+ &
+ ~static_cast<unsigned int>(handled));
+ }
+};
+
+#endif
diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h
new file mode 100644
index 00000000000..061f24f309d
--- /dev/null
+++ b/libgcobol/gcobolio.h
@@ -0,0 +1,114 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef GCOBOLIO_H_
+#define GCOBOLIO_H_
+
+#include <stdio.h>
+#include <map>
+#include <unordered_map>
+#include <vector>
+
+typedef struct cblc_field_t
+ {
+ // This structure must match the code in structs.cc
+ unsigned char *data; // The runtime data. There is no null
terminator
+ size_t capacity; // The size of "data"
+ size_t allocated; // The number of bytes available for capacity
+ size_t offset; // Offset from our ancestor (see note below)
+ char *name; // The null-terminated name of this variable
+ char *picture; // The null-terminated picture string.
+ char *initial; // The null_terminated initial value
+ struct cblc_field_t *parent;// This field's immediate parent field
+ size_t occurs_lower; // non-zero for a table
+ size_t occurs_upper; // non-zero for a table
+ size_t attr; // See cbl_field_attr_t
+ signed char type; // A one-byte copy of cbl_field_type_t
+ signed char level; // This variable's level in the naming
heirarchy
+ signed char digits; // Digits specified in PIC string; e.g. 5 for
99v999
+ signed char rdigits; // Digits to the right of the decimal point. 3
for 99v999
+ int dummy; // GCC seems to want an even number of 32-bit
values
+ } cblc_field_t;
+
+/*
+ * Implementation details
+ */
+
+class supplemental_t;
+
+enum cblc_file_prior_op_t
+ {
+ file_op_none,
+ file_op_open,
+ file_op_start,
+ file_op_read,
+ file_op_write,
+ file_op_rewrite,
+ file_op_delete,
+ file_op_close,
+ };
+
+/* end implementation details */
+
+typedef struct cblc_file_t
+ {
+ // This structure must match the code in structs.cc
+ char *name; // This is the name of the
structure; might be the name of an environment variable
+ char *filename; // The name of the file to be opened
+ FILE *file_pointer; // The FILE *pointer
+ cblc_field_t *default_record; // The record_area
+ size_t record_area_min; // The size of the smallest 01
record in the FD
+ size_t record_area_max; // The size of the largest 01
record in the FD
+ cblc_field_t **keys; // For relative and indexed files.
The first is the primary key. Null-terminated.
+ int *key_numbers; // One per key -- each key has a
number. This table is key_number + 1
+ int *uniques; // One per key
+ cblc_field_t *password; //
+ cblc_field_t *status; // This must exist, and is the
cbl_field_t version of io_status
+ cblc_field_t *user_status; // This might exist, and is another
copy See 2014 standard, section 9.1.12
+ cblc_field_t *vsam_status; //
+ cblc_field_t *record_length; //
+ supplemental_t *supplemental; //
+ void *implementation; // reserved for any implementation
+ size_t reserve; // From I-O section RESERVE clause
+ long prior_read_location; // Location of immediately
preceding successful read
+ cbl_file_org_t org; // from ORGANIZATION clause
+ cbl_file_access_t access; // from ACCESS MODE clause
+ int mode_char; // 'r', 'w', '+', or 'a' from FILE
OPEN statement
+ int errnum; // most recent errno; can't reuse
"errno" as the name
+ file_status_t io_status; // See 2014 standard, section 9.1.12
+ int padding; // Actually a char
+ int delimiter; // ends a record; defaults to '\n'.
+ int flags; // cblc_file_flags_t
+ int recent_char; // This is the most recent char
sent to the file
+ int recent_key;
+ cblc_file_prior_op_t prior_op; // run-time type is INT
+ int dummy;
+ } cblc_file_t;
+
+#endif
diff --git a/libgcobol/gfileio.h b/libgcobol/gfileio.h
new file mode 100644
index 00000000000..e70d84fc91e
--- /dev/null
+++ b/libgcobol/gfileio.h
@@ -0,0 +1,57 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef GFILEIO_H_
+#define GFILEIO_H_
+
+extern "C"
+{
+void __gg__handle_error(const char *function, const char *msg);
+
+void __gg__file_open( cblc_file_t *file,
+ char *filename,
+ int mode_char,
+ int is_quoted);
+
+void __gg__file_reopen(cblc_file_t *file, int mode_char);
+
+void __gg__file_close( cblc_file_t *file, int how );
+
+void __gg__file_read( cblc_file_t *file,
+ int where);
+
+void __gg__file_write( cblc_file_t *file,
+ unsigned char *location,
+ size_t length,
+ int after,
+ int lines,
+ int is_random );
+}
+
+#endif
\ No newline at end of file
diff --git a/libgcobol/gmath.h b/libgcobol/gmath.h
new file mode 100644
index 00000000000..9aa8f635f4a
--- /dev/null
+++ b/libgcobol/gmath.h
@@ -0,0 +1,38 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef GMATH_H_
+#define GMATH_H_
+
+extern "C"
+{
+
+}
+
+#endif
\ No newline at end of file
diff --git a/libgcobol/io.h b/libgcobol/io.h
new file mode 100644
index 00000000000..0c89ad6d0c9
--- /dev/null
+++ b/libgcobol/io.h
@@ -0,0 +1,137 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+/*
+ * File status key values and meanings
+ * 0 Successful completion
+ * 0 No further information
+ * 2 Duplicate key READ
+ * 4 Short/long READ
+ * 5 OPEN optional file unavailable
+ * 7 Not a tape
+ * 1 At-end condition
+ * 0 Sequential READ EOF
+ * 4 Relative record too big
+ * 2 Invalid key condition
+ * 1 Sequence error
+ * 2 Duplicate key WRITE
+ * 3 Record not found
+ * 4 Sequential WRITE EOF
+ * 3 Permanent error
+ * 0 No further information
+ * 1 Filename inconsistent with operating system
+ * 4 Boundary violation
+ * 5 OPEN nonoptional file unavailable
+ * 7 OPEN EACCES
+ * 8 OPEN file previously closed with lock
+ * 9 OPEN wrong file type
+ * 4 Logic error condition
+ * 1 OPEN file already open
+ * 2 CLOSE file not open
+ * 3 REWRITE without prior READ
+ * 4 REWRITE/WRITE boundary violation
+ * 6 READ after failed READ
+ * 7 File not open for READ
+ * 8 File not open for WRITE
+ * 9 File not open for DELETE/REWRITE
+ * 9 Implementor-defined
+ * 0 VSAM/QSAM close on wrong thread
+ * 1 VSAM password failure
+ * 2 Logic error
+ * 3 Resource unavailable
+ * 5 Incomplete file information
+ * 6 VSAM no DD statement
+ * 7 VSAM File integrity verified
+ * 8 OPEN invalid environment variable contents
+ */
+
+#ifndef IO_H_
+#define IO_H_
+
+enum file_high_t {
+ FhSuccess = 0,
+ FhAtEnd = 1,
+ FhInvKey = 2,
+ FhOsError = 3,
+ FhLogicError = 4,
+ FhImplementor = 9,
+};
+
+enum file_status_t {
+ FsSuccess = FhSuccess,
+ FsDupRead = (FhSuccess * 10) + 2, // First digit is 0
+ FsRecordLength= (FhSuccess * 10) + 4,
+ FsUnavail = (FhSuccess * 10) + 5,
+ FsNotaTape = (FhSuccess * 10) + 7,
+
+ FsEofSeq = (FhAtEnd * 10) + 0, // First digit is 1
+ FsEofRel = (FhAtEnd * 10) + 4,
+
+ FsKeySeq = (FhInvKey * 10) + 1, // First digit is 2
+ FsDupWrite = (FhInvKey * 10) + 2,
+ FsNotFound = (FhInvKey * 10) + 3,
+ FsEofWrite = (FhInvKey * 10) + 4,
+
+ FsOsError = (FhOsError * 10) + 0, // First digit is 3
+ FsNameError = (FhOsError * 10) + 1,
+ FsBoundary = (FhOsError * 10) + 4,
+ FsNoFile = (FhOsError * 10) + 5,
+ FsNoAccess = (FhOsError * 10) + 7,
+ FsCloseLock = (FhOsError * 10) + 8,
+ FsWrongType = (FhOsError * 10) + 9,
+
+ FsLogicErr = (FhLogicError * 10) + 0, // First digit
is 4
+ FsIsOpen = (FhLogicError * 10) + 1,
+ FsCloseNotOpen= (FhLogicError * 10) + 2,
+ FsNoRead = (FhLogicError * 10) + 3,
+ FsBoundWrite = (FhLogicError * 10) + 4,
+ FsReadError = (FhLogicError * 10) + 6,
+ FsReadNotOpen = (FhLogicError * 10) + 7,
+ FsNoWrite = (FhLogicError * 10) + 8,
+ FsNoDelete = (FhLogicError * 10) + 9,
+
+ FsWrongThread = (FhImplementor * 10) + 0, // First digit
is 9
+ FsPassword = (FhImplementor * 10) + 1,
+ FsLogicOther = (FhImplementor * 10) + 2,
+ FsNoResource = (FhImplementor * 10) + 3,
+ FsIncomplete = (FhImplementor * 10) + 5,
+ FsNoDD = (FhImplementor * 10) + 6,
+ FsVsamOK = (FhImplementor * 10) + 7,
+ FsBadEnvVar = (FhImplementor * 10) + 8,
+
+ FsErrno = (1000000) // This means
"map errno to one of the above errors"
+};
+
+#define FhNotOkay FsEofSeq // Values less than 10 mean the data are valid
+
+extern "C" file_status_t __gg__file_status_word(enum file_status_t status,
+ int error_number);
+
+#endif
diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
new file mode 100644
index 00000000000..bd9446adf60
--- /dev/null
+++ b/libgcobol/libgcobol.h
@@ -0,0 +1,257 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef LIBGCOBOL_H_
+#define LIBGCOBOL_H_
+
+#include <stdio.h>
+
+#include <map>
+#include <unordered_map>
+#include <vector>
+
+#define MIN_FIELD_BLOCK_SIZE (16)
+
+// RUNTIME structures *must* match the ones created in structs.c and
initialized
+// and used in genapi.c. It's actually not all that important to emphasize
that
+// fact, since the compiled executable will crash and burn quickly if they
don't
+// match precisely.
+
+// Note that it must match the same structure in the GDB-COBOL debugger
+
+#define A_ZILLION (1000000) // Absurdly large number for
__gg__call_parameter_count
+
+// These bits are used for the "call flags" of arithmetic operations
+#define ON_SIZE_ERROR 0x01
+#define REMAINDER_PRESENT 0x02
+
+/* 'offset' is overloaded for FldAlphanumeric/temporary/intermediate variables
+ * For such variables, offset is a copy of the initial capacity. This is in
+ * support of the FUNCTION TRIM function, which both needs to be able to
+ * reduce the capacity of the target variable, and then to reset it back to
+ * the original value
+ */
+
+enum substitute_flags_t
+ {
+ substitute_anycase_e = 1,
+ substitute_first_e = 2, // first and last are mutually exclusive
+ substitute_last_e = 4,
+ };
+
+enum cblc_file_flags_t
+ {
+ file_flag_optional_e = 0x00001,
+ file_flag_existed_e = 0x00002,
+ file_name_quoted_e = 0x00004,
+ file_flag_initialized_e = 0x00008,
+ };
+
+// For indexed files, there can be one or more indexes, one per key.
+// Each index is one or more fields.
+
+struct file_hole_t
+ {
+ long location;
+ size_t size;
+ };
+
+struct file_index_t
+ {
+ std::multimap<std::vector<unsigned char>, long> key_to_position;
+ std::multimap<std::vector<unsigned char>, long>::iterator current_iterator;
+ std::multimap<std::vector<unsigned char>, long>::iterator ending_iterator;
+ };
+
+class supplemental_t
+ {
+ public:
+ std::vector<file_hole_t> holes;
+ std::vector<file_index_t> indexes;
+ std::vector<int> uniques;
+ };
+
+struct cblc_subscript_t
+ {
+ cblc_field_t *field; // That's what it usually is:
+ unsigned int type; // When type is FldLiteralN, field is a pointer to
__int128
+ };
+
+#define REFER_T_ALL_FLAGS_MASK 0x0FF // We allow for seven subscripts
+#define REFER_T_MOVE_ALL 0x100 // This is the move_all flag
+#define REFER_T_ADDRESS_OF 0x200 // This is the address_of flag
+
+struct cblc_declarative_t
+ {
+ int format;
+ int culprit; //declarative_culprit_t
+ int nfiles;
+ };
+
+/* According to the standard, the first digit of the file operation status
+ register is interpreted like this:
+
+ EC-I-O-AT-END '1'
+ EC-I-O-INVALID-KEY '2'
+ EC-I-O-PERMANENT-ERROR '3'
+ EC-I-O-LOGIC-ERROR '4'
+ EC-I-O-RECORD-OPERATION '5'
+ EC-I-O-FILE-SHARING '6'
+ EC-I-O-IMP '9'
+
+When the tens digit is '0', there are a number of conditions for
+successful completion. See section 9.1.12.1
+
+ 00 unqualified success
+ 02 duplicate key detected
+ 04 the data read were either too short or too long
+ 05 the operator couldn't find the tape
+ 07 somebody tried to rewind the card reader.
+
+For now, I am going to treat the io_status as an integer 00 through 99. I
+anticipate mostly returning
+ 00 for ordinary success,
+ 04 for a mismatched record size
+ 10 for an end-of-file
+
+*/
+
+// This global variable is constantly being updated with the yylineno. This is
+// useful for creating error messages, and for handling EXCEPTION_CONDITIONS
+extern int __gg__exception_code;
+extern int __gg__exception_line_number;
+extern int __gg__exception_file_status;
+extern const char *__gg__exception_file_name;
+extern const char *__gg__exception_statement;
+extern const char *__gg__exception_source_file;
+extern const char *__gg__exception_program_id;
+extern const char *__gg__exception_section;
+extern const char *__gg__exception_paragraph;
+
+extern "C" void __gg__set_exception_code( ec_type_t ec,
+ int from_raise_statement=0);
+
+extern int * __gg__fourplet_flags;
+
+extern cblc_field_t ** __gg__treeplet_1f;
+extern size_t * __gg__treeplet_1o;
+extern size_t * __gg__treeplet_1s;
+extern cblc_field_t ** __gg__treeplet_2f;
+extern size_t * __gg__treeplet_2o;
+extern size_t * __gg__treeplet_2s;
+extern cblc_field_t ** __gg__treeplet_3f;
+extern size_t * __gg__treeplet_3o;
+extern size_t * __gg__treeplet_3s;
+extern cblc_field_t ** __gg__treeplet_4f;
+extern size_t * __gg__treeplet_4o;
+extern size_t * __gg__treeplet_4s;
+
+#if 1
+ static inline
+ void exception_raise(ec_type_t ec_code) { __gg__set_exception_code(ec_code);
}
+#else
+# define
exception_raise(ec_code)do{__gg__set_exception_code(ec_code);}while(0);
+#endif
+
+extern "C" __int128 __gg__power_of_ten(int n);
+
+extern "C" __int128 __gg__dirty_to_binary_source( const char *dirty,
+ int length,
+ int *rdigits);
+extern "C" __int128 __gg__dirty_to_binary_internal( const char *dirty,
+ int length,
+ int *rdigits);
+extern "C" __int128 __gg__binary_value_from_field( int *rdigits,
+ cblc_field_t *var);
+extern "C" int __gg__compare_2( cblc_field_t *left_side,
+ unsigned char *left_location,
+ size_t left_length,
+ int left_attr,
+ bool left_all,
+ bool left_address_of,
+ cblc_field_t *right_side,
+ unsigned char *right_location,
+ size_t right_length,
+ int right_attr,
+ bool right_all,
+ bool right_address_of,
+ int second_time_through);
+extern "C" void __gg__int128_to_field(cblc_field_t *tgt,
+ __int128 value,
+ int source_rdigits,
+ enum cbl_round_t rounded,
+ int *compute_error);
+extern "C" void __gg__float128_to_field(cblc_field_t *tgt,
+ _Float128 value,
+ enum cbl_round_t rounded,
+ int *compute_error);
+extern "C" void __gg__int128_to_qualified_field(cblc_field_t *tgt,
+ size_t offset,
+ size_t length,
+ __int128 value,
+ int source_rdigits,
+ enum cbl_round_t rounded,
+ int *compute_error);
+extern "C" void __gg__float128_to_qualified_field(cblc_field_t *tgt,
+ size_t tgt_offset,
+ _Float128 value,
+ enum cbl_round_t rounded,
+ int *compute_error);
+
+extern "C" void __gg__double_to_target( cblc_field_t *tgt,
+ double tgt_value,
+ cbl_round_t rounded);
+extern "C" char __gg__get_decimal_separator();
+extern "C" char __gg__get_decimal_point();
+extern "C" char * __gg__get_default_currency_string();
+
+extern "C" void __gg__clock_gettime(clockid_t clk_id, struct timespec *tp);
+extern "C" _Float128 __gg__float128_from_location(cblc_field_t *var,
+ unsigned char *location);
+extern "C" void __gg__adjust_dest_size(cblc_field_t *dest, size_t ncount);
+#define MINIMUM_ALLOCATION_SIZE 16
+extern "C" void __gg__realloc_if_necessary( char **dest,
+ size_t *dest_size,
+ size_t new_size);
+extern "C" void __gg__set_exception_file(cblc_file_t *file);
+extern "C" void __gg__internal_to_console_in_place(char *loc, size_t length);
+extern "C" __int128 __gg__binary_value_from_qualified_field(int
*rdigits,
+ cblc_field_t *var,
+ size_t offset,
+ size_t size);
+extern "C" _Float128 __gg__float128_from_qualified_field(cblc_field_t *field,
+ size_t offset,
+ size_t size);
+extern "C" __int128 __gg__integer_from_qualified_field(cblc_field_t *var,
+ size_t var_offset,
+ size_t var_size);
+void __gg__abort(const char *msg);
+
+
+#endif
diff --git a/libgcobol/valconv.h b/libgcobol/valconv.h
new file mode 100644
index 00000000000..d907e6f70ee
--- /dev/null
+++ b/libgcobol/valconv.h
@@ -0,0 +1,80 @@
+/*
+ * Copyright (c) 2021-2025 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ * copyright notice, this list of conditions and the following disclaimer
+ * in the documentation and/or other materials provided with the
+ * distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ * contributors may be used to endorse or promote products derived from
+ * this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef __VALCONV_H
+#define __VALCONV_H
+
+extern int __gg__decimal_point ;
+extern int __gg__decimal_separator ;
+extern int __gg__quote_character ;
+extern int __gg__low_value_character ;
+extern int __gg__high_value_character ;
+extern char **__gg__currency_signs ;
+extern int __gg__default_currency_sign;
+extern char *__gg__ct_currency_signs[256]; // Compile-time currency signs
+
+
+// All "ordinals" are zero-based ordinals. The COBOL spec's ordinal values
+// for ordinary ASCII/EBCDIC ranger from 1 to 256, so we call them zero through
+// 255. We use unsigned ints so that when an custom alphabet is described, we
+// can make every unmentioned character have an ordinal greater than the final
+// ordinal of the custom list.
+struct alphabet_state
+ {
+ unsigned short collation[256];
+ unsigned char low_char;
+ unsigned char high_char;
+ };
+
+extern std::unordered_map<size_t, alphabet_state> __gg__alphabet_states;
+
+extern "C"
+ {
+ void __gg__realloc_if_necessary(char **dest, size_t *dest_size, size_t
new_size);
+ void __gg__alphabet_create(cbl_encoding_t encoding,
+ size_t alphabet_index,
+ unsigned char *alphabet,
+ int low_char,
+ int high_char );
+ bool __gg__string_to_numeric_edited(char * const dest,
+ char *source, // ASCII
+ int rdigits,
+ int is_negative,
+ const char *picture);
+ void __gg__string_to_alpha_edited(char *dest,
+ char *source,
+ int slength,
+ char *picture);
+ void __gg__currency_sign_init();
+ void __gg__currency_sign(int symbol, const char *sign);
+ void __gg__remove_trailing_zeroes(char *p);
+ }
+
+#endif
