libgcobol/constants.cc

/*
 * Copyright (c) 2021-2026 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.
 */

#include <fcntl.h>
#include <unistd.h>

#include <cctype>
#include <cerrno>
#include <cmath>
#include <cfenv>
#include <cstdio>
#include <cstdlib>
#include <cstring>
#include <ctime>

#include <algorithm>
#include <unordered_map>
#include <vector>

#include "ec.h"
#include "io.h"
#include "common-defs.h"
#include "gcobolio.h"
#include "cobol-endian.h"

#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wwrite-strings"
#pragma GCC diagnostic ignored "-Wmissing-field-initializers"

// There are global variables that need to be initialized at the point where
// the very first PROGRAM-ID is executed.  This flag is used to make sure that
// initialization happens just once.
int __gg__globals_are_initialized = 0;


#if COBOL_BIG_ENDIAN
#define endian big_endian_e
#else
#define endian none_e
#endif

unsigned char __gg__data_spaces[1] = {' '};
struct cblc_field_t __ggsr__spaces = {
  .data           = __gg__data_spaces ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 0 ,
  .name           = "SPACES" ,
  .picture        = "" ,
  .initial        = (char *)space_value_e ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = quoted_e | constant_e | register_e | space_value_e,
  .type           = FldAlphanumeric ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_low_values[1] = {'\0'};
struct cblc_field_t __ggsr__low_values = {
  .data           = __gg__data_low_values,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 0 ,
  .name           = "LOW_VALUES" ,
  .picture        = "" ,
  .initial        = (char *)low_value_e ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = quoted_e | constant_e | register_e | low_value_e ,
  .type           = FldAlphanumeric ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_zeros[1] = {'0'};
struct cblc_field_t __ggsr__zeros = {
  .data           = __gg__data_zeros ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 0 ,
  .name           = "ZEROS" ,
  .picture        = "" ,
  .initial        = (char *)zero_value_e ,
  .parent         = NULL ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = quoted_e | constant_e | register_e | zero_value_e ,
  .type           = FldAlphanumeric ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_high_values[1] = {0xFF};
struct cblc_field_t __ggsr__high_values = {
  .data           = __gg__data_high_values ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 0 ,
  .name           = "HIGH_VALUES" ,
  .picture        = "" ,
  .initial        = (char *)high_value_e ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = quoted_e | constant_e | register_e | high_value_e ,
  .type           = FldAlphanumeric ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_quotes[1] = {0xFF};
struct cblc_field_t __ggsr__quotes = {
  .data           = __gg__data_quotes ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 0 ,
  .name           = "QUOTES" ,
  .picture        = "" ,
  .initial        = (char *)quote_value_e ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = quoted_e | constant_e | register_e | quote_value_e ,
  .type           = FldAlphanumeric ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_nulls[8] = {0,0,0,0,0,0,0,0};
struct cblc_field_t __ggsr__nulls = {
  .data           = __gg__data_nulls ,
  .capacity       = 8 ,
  .allocated      = 8 ,
  .offset         = 0 ,
  .name           = "NULLS" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = constant_e | register_e | null_value_e ,
  .type           = FldPointer ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data__file_status[2] = {0,0};
struct cblc_field_t __ggsr___file_status = {
  .data           = __gg__data__file_status ,
  .capacity       = 2 ,
  .allocated      = 2 ,
  .offset         = 0 ,
  .name           = "_FILE_STATUS" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e ,
  .type           = FldNumericDisplay ,
  .level          = 0 ,
  .digits         = 2 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };


unsigned char __gg__data_upsi_0[2] = {0,0};
struct cblc_field_t __ggsr__upsi_0 = {
  .data           = __gg__data_upsi_0 ,
  .capacity       = 2 ,
  .allocated      = 2 ,
  .offset         = 0 ,
  .name           = "UPSI-0" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | endian,
  .type           = FldNumericBin5 ,
  .level          = 0 ,
  .digits         = 4 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg___data_dev_stdin[] = "/dev/stdin";
struct cblc_field_t __ggsr___dev_stdin = {
  .data           = __gg___data_dev_stdin ,
  .capacity       = sizeof(__gg___data_dev_stdin)-1 ,
  .allocated       = sizeof(__gg___data_dev_stdin)-1 ,
  .offset         = 0 ,
  .name           = "_dev_stdin" ,
  .picture        = "" ,
  .initial        = "/dev/stdin" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = constant_e | quoted_e | register_e ,
  .type           = FldLiteralA ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

 unsigned char __gg___data_dev_stdout[] = "/dev/stdout";
struct cblc_field_t __ggsr___dev_stdout = {
  .data           = __gg___data_dev_stdout ,
  .capacity       = sizeof(__gg___data_dev_stdout)-1 ,
  .allocated      = sizeof(__gg___data_dev_stdout)-1 ,
  .offset         = 0 ,
  .name           = "_dev_stdout" ,
  .picture        = "" ,
  .initial        = "/dev/stdout" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = constant_e | quoted_e | register_e ,
  .type           = FldLiteralA ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg___data_dev_stderr[] = "/dev/stderr";
struct cblc_field_t __ggsr___dev_stderr = {
  .data           = __gg___data_dev_stderr ,
  .capacity       = sizeof(__gg___data_dev_stderr)-1 ,
  .allocated      = sizeof(__gg___data_dev_stderr)-1 ,
  .offset         = 0 ,
  .name           = "_dev_stderr" ,
  .picture        = "" ,
  .initial        = "/dev/stderr" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = constant_e | quoted_e | register_e ,
  .type           = FldLiteralA ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg___data_dev_null[] = "/dev/null";
struct cblc_field_t __ggsr___dev_null = {
  .data           = __gg___data_dev_null ,
  .capacity       = sizeof(__gg___data_dev_null)-1 ,
  .allocated      = sizeof(__gg___data_dev_null)-1 ,
  .offset         = 0 ,
  .name           = "_dev_null" ,
  .picture        = "" ,
  .initial        = "/dev/null" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = constant_e | quoted_e | register_e ,
  .type           = FldLiteralA ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data_argi[] = {0,0,0,0};
struct cblc_field_t __ggsr__argi = {
  .data           = __gg__data_argi ,
  .capacity       = 4 ,
  .allocated      = 4 ,
  .offset         = 0 ,
  .name           = "_ARGI" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = global_e | endian,
  .type           = FldNumericBin5 ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char __gg__data__literally_zero[] = {0,0,0,0};
struct cblc_field_t __ggsr___literally_zero = {
  .data           = __gg__data__literally_zero ,
  .capacity       = 4 ,
  .allocated      = 4 ,
  .offset         = 0 ,
  .name           = "_literally_zero" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | endian,
  .type           = FldNumericBin5 ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

#if COBOL_BIG_ENDIAN
unsigned char __gg__data__literally_one[] = {0,0,0,1};
#else
unsigned char __gg__data__literally_one[] = {1,0,0,0};
#endif
struct cblc_field_t __ggsr__literally_one = {
  .data           = __gg__data__literally_one ,
  .capacity       = 4 ,
  .allocated      = 4 ,
  .offset         = 0 ,
  .name           = "_literally_one" ,
  .picture        = "" ,
  .initial        = "" ,
  .parent         = NULL,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | endian,
  .type           = FldNumericBin5 ,
  .level          = 0 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

/* The following defines storage for the global DEBUG-ITEM:

     01 DEBUG-ITEM.
        02 DEBUG-LINE PIC X(6).
        02 FILLER PIC X VALUE SPACE.
        02 DEBUG-NAME PIC X(30).
        02 FILLER PIC X VALUE SPACE.
        02 DEBUG-SUB-1 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
        02 FILLER PIC X VALUE SPACE.
        02 DEBUG-SUB-2 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
        02 FILLER PIC X VALUE SPACE.
        02 DEBUG-SUB-3 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
        02 FILLER PIC X VALUE SPACE.
        02 DEBUG-CONTENTS PIC X(76).
*/

unsigned char __gg__data_debug_item[132] =
                                 "                                      "
                                 "+0000 +0000 +0000 "
                                 "                                      "
                                 "                                     ";
struct cblc_field_t __ggsr__debug_item = {
  .data           = __gg__data_debug_item ,
  .capacity       = 132 ,
  .allocated      = 132 ,
  .offset         = 0 ,
  .name           = "DEBUG-ITEM" ,
  .picture        = "" ,
  .initial        =              "                                      "
                                 "+0000 +0000 +0000 "
                                 "                                      "
                                 "                                     " ,
  .parent         = NULL ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = external_e | register_e ,
  .type           = FldGroup ,
  .level          = 01 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_line = __gg__data_debug_item;
struct cblc_field_t __ggsr__debug_line = {
  .data           = __gg__data_debug_line ,
  .capacity       = 6 ,
  .allocated      = 6 ,
  .offset         = 0 ,
  .name           = "DEBUG-LINE" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = external_e | register_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };


unsigned char *__gg__data_debug_filler_1 = &__gg__data_debug_item[6];
struct cblc_field_t __ggsr__debug_filler_1 = {
  .data           = __gg__data_debug_item ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 6 ,
  .name           = "FILLER" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = external_e | register_e | filler_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_name = &__gg__data_debug_item[7];
struct cblc_field_t __ggsr__debug_name = {
  .data           = __gg__data_debug_name ,
  .capacity       = 30 ,
  .allocated      = 30 ,
  .offset         = 7 ,
  .name           = "DEBUG-NAME" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = external_e | register_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_filler_2 = &__gg__data_debug_item[37];
struct cblc_field_t __ggsr__debug_filler_2 = {
  .data           = __gg__data_debug_filler_2 ,
  .capacity       = 1 ,
  .allocated      = 1 ,
  .offset         = 37 ,
  .name           = "FILLER" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = external_e | register_e | filler_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_sub_1 = &__gg__data_debug_item[38];
struct cblc_field_t __ggsr__debug_sub_1 = {
  .data           = __gg__data_debug_sub_1 ,
  .capacity       = 5 ,
  .allocated      = 5 ,
  .offset         = 38 ,
  .name           = "DEBUG-SUB-1" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = signable_e | external_e | register_e | leading_e | separate_e ,
  .type           = FldNumericDisplay ,
  .level          = 05 ,
  .digits         = 4 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_filler_3 = &__gg__data_debug_item[43];
struct cblc_field_t __ggsr__debug_filler_3 = {
  .data           = __gg__data_debug_filler_3 ,
  .capacity       =  1,
  .allocated      =  1,
  .offset         =  43,
  .name           = "FILLER" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | filler_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_sub_2 = &__gg__data_debug_item[44];
struct cblc_field_t __ggsr__debug_sub_2 = {
  .data           = __gg__data_debug_sub_2 ,
  .capacity       = 5 ,
  .allocated      = 5 ,
  .offset         = 44 ,
  .name           = "DEBUG-SUB-2" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = signable_e | register_e | leading_e | separate_e ,
  .type           = FldNumericDisplay ,
  .level          = 05 ,
  .digits         = 4 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_filler_4 = &__gg__data_debug_item[49];
struct cblc_field_t __ggsr__debug_filler_4 = {
  .data           = __gg__data_debug_filler_4 ,
  .capacity       =  1,
  .allocated      =  1,
  .offset         =  49,
  .name           = "FILLER" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | filler_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_sub_3 = &__gg__data_debug_item[50];
struct cblc_field_t __ggsr__debug_sub_3 = {
  .data           = __gg__data_debug_sub_3 ,
  .capacity       = 5 ,
  .allocated      = 5 ,
  .offset         = 50 ,
  .name           = "DEBUG-SUB-3" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = signable_e | register_e | leading_e | separate_e ,
  .type           = FldNumericDisplay ,
  .level          = 05 ,
  .digits         = 4 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_filler_5 = &__gg__data_debug_item[55];
struct cblc_field_t __ggsr__debug_filler_5 = {
  .data           = __gg__data_debug_filler_5 ,
  .capacity       =  1,
  .allocated      =  1,
  .offset         =  55,
  .name           = "FILLER" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e | filler_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

unsigned char *__gg__data_debug_contents = &__gg__data_debug_item[56];
struct cblc_field_t __ggsr__debug_contents = {
  .data           = __gg__data_debug_contents ,
  .capacity       = 76 ,
  .allocated      = 76 ,
  .offset         = 56 ,
  .name           = "DEBUG-CONTENTS" ,
  .picture        = "" ,
  .initial        = NULL ,
  .parent         = &__ggsr__debug_item ,
  .occurs_lower   = 0 ,
  .occurs_upper   = 0 ,
  .attr           = register_e ,
  .type           = FldAlphanumeric ,
  .level          = 05 ,
  .digits         = 0 ,
  .rdigits        = 0 ,
  .encoding       = iconv_CP1252_e ,
  .alphabet       = 0 ,
  };

#pragma GCC diagnostic pop