procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

COBOL: libgcobol

Browse source 
libgcobol/
	* Makefile.am: New file.
	* Makefile.in: Autogenerate.
	* acinclude.m4: Likewise.
	* aclocal.m4: Likewise.
	* configure.ac: New file.
	* configure: Autogenerate.
	* configure.tgt: New file.
	* README: New file.
	* charmaps.cc: New file.
	* config.h.in: New file.
	* constants.cc: New file.
	* gfileio.cc: New file.
	* gmath.cc: New file.
	* io.cc: New file.
	* valconv.cc: New file.
	* 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.cc: New file.
	* intrinsic.cc: New file.
This commit is contained in:
James K. Lowden 2025-03-10 16:08:42 +01:00 • committed by Richard Biener
parent c6b277f1dc
commit a075418727
27 changed files with 52530 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

152
libgcobol/Makefile.am Normal file
View file

@ -0,0 +1,152 @@
# Copyright (C) 2025 Free Software Foundation, Inc.
# Contributed by the Symas Corporation, 2025
# This file is part of GCC.
# GCC is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
# GCC is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# Written de novo for libgcobol.
AUTOMAKE_OPTIONS = 1.8 foreign
ACLOCAL_AMFLAGS = -I .. -I ../config
toolexeclib_LTLIBRARIES = libgcobol.la
libgcobol.la: $(libgcobol_la_OBJECTS) \
$(libgcobol_la_DEPENDENCIES) \
$(EXTRA_libgcobol_la_DEPENDENCIES)
$(AM_V_GEN)$(libgcobol_la_LINK) \
-rpath $(libdir)/../lib64 \
$(libgcobol_la_OBJECTS) \
$(libgcobol_la_LIBADD) $(LIBS)
##
## 2.2.12 Automatic Dependency Tracking
## Automake generates code for automatic dependency tracking by default
##
libgcobol_la_SOURCES = \
charmaps.cc \
constants.cc \
gfileio.cc \
gmath.cc \
intrinsic.cc \
io.cc \
libgcobol.cc \
valconv.cc
#
# configure varables
#
# Automatic
AM_CFLAGS = @CFLAGS@
configure_input = @configure_input@
AM_CPPFLAGS = @CPPFLAGS@
AM_CXXFLAGS = @CXXFLAGS@
DEFS = @DEFS@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
ERLCFLAGS = @ERLCFLAGS@
FCFLAGS = @FCFLAGS@
FFLAGS = @FFLAGS@
AM_LDFLAGS = @LDFLAGS@
LIBS = @LIBS@
OBJCFLAGS = @OBJCFLAGS@
OBJCXXFLAGS = @OBJCXXFLAGS@
GOFLAGS = @GOFLAGS@
builddir = @builddir@
abs_builddir = @abs_builddir@
top_builddir = @top_builddir@
top_build_prefix = @top_build_prefix@
abs_top_builddir = @abs_top_builddir@
## srcdir see: overrides
abs_srcdir = @abs_srcdir@
top_srcdir = @top_srcdir@
abs_top_srcdir = @abs_top_srcdir@
# Installation
bindir = @bindir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
sysconfdir = @sysconfdir@
# Overrides and custom
CC = @CC@
CXX = @CXX@
AR = @AR@
AS = @AS@
RANLIB = @RANLIB@
LIBGCOBOL_VERSION = @LIBGCOBOL_VERSION@
VERSION_SUFFIX = @VERSION_SUFFIX@
LIBTOOL = @LIBTOOL@ $(LIBTOOLFLAGS)
libgcobol_la_LFLAGS = -lstdc++
libgcobol_la_LINK = $(LIBTOOL) --mode=link --tag=CXX $(CXX) \
-o libgcobol$(libsuffix).la \
-Wc,-shared-libgcc \
-version-info $(LIBGCOBOL_VERSION) \
-lstdc++ \
$(LTLDFLAGS)
# The 'all' rule must be the first one so that it is executed if
# nothing is specified on the command-line.
all: $(LIBGCOBOL_LA)
.PHONY: install install-html install-pdf install-info
###include $(top_srcdir)/../multilib.am
install: libgcobol$(libsuffix).la
$(LIBTOOL) --mode=install $(INSTALL) $^ $(DESTDIR)$(libdir)/../lib64
WARN_CFLAGS = -W -Wall -Wwrite-strings
# not defined: DEFS, MAX_ERRORS, LTLDFLAGS
ALL_CFLAGS = -I. -I$(srcdir) $(AM_CPPFLAGS) $(DEFS) \
$(XCFLAGS) $(AM_CXXFLAGS) $(WARN_CFLAGS) $(MAX_ERRORS) \
-DIN_GCC -DIN_TARGET_LIBS -fno-strict-aliasing
%.lo: %.c
$(LIBTOOL) --mode=compile $(CC) -c \
-o $@ $(ALL_CFLAGS) $(INCLUDES) $<
%.lo: %.cc
$(LIBTOOL) --mode=compile --tag=CXX $(CXX) -c \
-o $@ $(INCLUDES) $(ALL_CFLAGS) $<
doc: info dvi pdf html
# No install-html or install-pdf support
install-html install-pdf install-info:

976
libgcobol/Makefile.in Normal file
View file

@ -0,0 +1,976 @@
# Makefile.in generated by automake 1.15.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2017 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
# Copyright (C) 2025 Free Software Foundation, Inc.
# Contributed by the Symas Corporation, 2025
# This file is part of GCC.
# GCC is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
# GCC is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# Written de novo for libgcobol.
VPATH = @srcdir@
am__is_gnu_make = { \
if test -z '$(MAKELEVEL)'; then \
false; \
elif test -n '$(MAKE_HOST)'; then \
true; \
elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
true; \
else \
false; \
fi; \
}
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
target_triplet = @target@
subdir = .
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/../config/depstand.m4 \
$(top_srcdir)/../config/lead-dot.m4 \
$(top_srcdir)/../config/multi.m4 \
$(top_srcdir)/../config/override.m4 \
$(top_srcdir)/../config/toolexeclibdir.m4 \
$(top_srcdir)/../ltoptions.m4 $(top_srcdir)/../ltsugar.m4 \
$(top_srcdir)/../ltversion.m4 $(top_srcdir)/../lt~obsolete.m4 \
$(top_srcdir)/acinclude.m4 $(top_srcdir)/../config/acx.m4 \
$(top_srcdir)/../config/no-executables.m4 \
$(top_srcdir)/../config/enable.m4 \
$(top_srcdir)/../config/tls.m4 \
$(top_srcdir)/../config/bitfields.m4 \
$(top_srcdir)/../libtool.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \
$(am__configure_deps) $(am__DIST_COMMON)
am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno
mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
CONFIG_HEADER = config.h
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(toolexeclibdir)"
LTLIBRARIES = $(toolexeclib_LTLIBRARIES)
libgcobol_la_LIBADD =
am_libgcobol_la_OBJECTS = charmaps.lo constants.lo gfileio.lo gmath.lo \
intrinsic.lo io.lo libgcobol.lo valconv.lo
libgcobol_la_OBJECTS = $(am_libgcobol_la_OBJECTS)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
depcomp = $(SHELL) $(top_srcdir)/../depcomp
am__depfiles_maybe = depfiles
am__mv = mv -f
CXXCOMPILE = $(CXX) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \
$(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CXXFLAGS) $(CXXFLAGS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
LTCXXCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CXX) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CXXFLAGS) $(CXXFLAGS)
AM_V_CXX = $(am__v_CXX_@AM_V@)
am__v_CXX_ = $(am__v_CXX_@AM_DEFAULT_V@)
am__v_CXX_0 = @echo " CXX " $@;
am__v_CXX_1 =
CXXLD = $(CXX)
CXXLINK = $(LIBTOOL) $(AM_V_lt) --tag=CXX $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CXXLD) $(AM_CXXFLAGS) \
$(CXXFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_CXXLD = $(am__v_CXXLD_@AM_V@)
am__v_CXXLD_ = $(am__v_CXXLD_@AM_DEFAULT_V@)
am__v_CXXLD_0 = @echo " CXXLD " $@;
am__v_CXXLD_1 =
SOURCES = $(libgcobol_la_SOURCES)
DIST_SOURCES = $(libgcobol_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \
$(LISP)config.h.in
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
CSCOPE = cscope
AM_RECURSIVE_TARGETS = cscope
am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/config.h.in \
$(top_srcdir)/../compile $(top_srcdir)/../config.guess \
$(top_srcdir)/../config.sub $(top_srcdir)/../depcomp \
$(top_srcdir)/../install-sh $(top_srcdir)/../ltmain.sh \
$(top_srcdir)/../missing $(top_srcdir)/../mkinstalldirs \
ChangeLog README
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
distdir = $(PACKAGE)-$(VERSION)
top_distdir = $(distdir)
am__remove_distdir = \
if test -d "$(distdir)"; then \
find "$(distdir)" -type d ! -perm -200 -exec chmod u+w {} ';' \
&& rm -rf "$(distdir)" \
|| { sleep 5 && rm -rf "$(distdir)"; }; \
else :; fi
am__post_remove_distdir = $(am__remove_distdir)
DIST_ARCHIVES = $(distdir).tar.gz
GZIP_ENV = --best
DIST_TARGETS = dist-gzip
distuninstallcheck_listfiles = find . -type f -print
am__distuninstallcheck_listfiles = $(distuninstallcheck_listfiles) \
| sed 's|^\./|$(prefix)/|' | grep -v '$(infodir)/dir$$'
distcleancheck_listfiles = find . -type f -print
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
# Overrides and custom
CC = @CC@
CCAS = @CCAS@
CCASDEPMODE = @CCASDEPMODE@
CCASFLAGS = @CCASFLAGS@
CCDEPMODE = @CCDEPMODE@
CC_FOR_BUILD = @CC_FOR_BUILD@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CXX = @CXX@
CXXCPP = @CXXCPP@
CXXDEPMODE = @CXXDEPMODE@
CXXFLAGS = @CXXFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
FGREP = @FGREP@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBGCOBOL_VERSION = @LIBGCOBOL_VERSION@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@ $(LIBTOOLFLAGS)
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MKDIR_P = @MKDIR_P@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
SPEC_LIBGCOBOL_DEPS = @SPEC_LIBGCOBOL_DEPS@
STRIP = @STRIP@
VERSION = @VERSION@
VERSION_SUFFIX = @VERSION_SUFFIX@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_CC = @ac_ct_CC@
ac_ct_CXX = @ac_ct_CXX@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
# Installation
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_libsubdir = @build_libsubdir@
build_os = @build_os@
build_subdir = @build_subdir@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
enable_shared = @enable_shared@
enable_static = @enable_static@
exec_prefix = @exec_prefix@
extra_darwin_ldflags_libgcobol = @extra_darwin_ldflags_libgcobol@
get_gcc_base_ver = @get_gcc_base_ver@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_noncanonical = @host_noncanonical@
host_os = @host_os@
host_subdir = @host_subdir@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
multi_basedir = @multi_basedir@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
slibdir = @slibdir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target = @target@
target_alias = @target_alias@
target_cpu = @target_cpu@
target_noncanonical = @target_noncanonical@
target_os = @target_os@
target_subdir = @target_subdir@
target_vendor = @target_vendor@
toolexecdir = @toolexecdir@
toolexeclibdir = @toolexeclibdir@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
AUTOMAKE_OPTIONS = 1.8 foreign
ACLOCAL_AMFLAGS = -I .. -I ../config
toolexeclib_LTLIBRARIES = libgcobol.la
libgcobol_la_SOURCES = \
charmaps.cc \
constants.cc \
gfileio.cc \
gmath.cc \
intrinsic.cc \
io.cc \
libgcobol.cc \
valconv.cc
#
# configure varables
#
# Automatic
AM_CFLAGS = @CFLAGS@
configure_input = @configure_input@
AM_CPPFLAGS = @CPPFLAGS@
AM_CXXFLAGS = @CXXFLAGS@
ERLCFLAGS = @ERLCFLAGS@
FCFLAGS = @FCFLAGS@
FFLAGS = @FFLAGS@
AM_LDFLAGS = @LDFLAGS@
OBJCFLAGS = @OBJCFLAGS@
OBJCXXFLAGS = @OBJCXXFLAGS@
GOFLAGS = @GOFLAGS@
AS = @AS@
libgcobol_la_LFLAGS = -lstdc++
libgcobol_la_LINK = $(LIBTOOL) --mode=link --tag=CXX $(CXX) \
-o libgcobol$(libsuffix).la \
-Wc,-shared-libgcc \
-version-info $(LIBGCOBOL_VERSION) \
-lstdc++ \
$(LTLDFLAGS)
WARN_CFLAGS = -W -Wall -Wwrite-strings
# not defined: DEFS, MAX_ERRORS, LTLDFLAGS
ALL_CFLAGS = -I. -I$(srcdir) $(AM_CPPFLAGS) $(DEFS) \
$(XCFLAGS) $(AM_CXXFLAGS) $(WARN_CFLAGS) $(MAX_ERRORS) \
-DIN_GCC -DIN_TARGET_LIBS -fno-strict-aliasing
all: config.h
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
.SUFFIXES: .cc .lo .o .obj
am--refresh: Makefile
@:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \
$(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \
&& exit 0; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
echo ' $(SHELL) ./config.status'; \
$(SHELL) ./config.status;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
$(SHELL) ./config.status --recheck
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
$(am__cd) $(srcdir) && $(AUTOCONF)
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
$(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS)
$(am__aclocal_m4_deps):
config.h: stamp-h1
@test -f $@ || rm -f stamp-h1
@test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1
stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status
@rm -f stamp-h1
cd $(top_builddir) && $(SHELL) ./config.status config.h
$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
($(am__cd) $(top_srcdir) && $(AUTOHEADER))
rm -f stamp-h1
touch $@
distclean-hdr:
-rm -f config.h stamp-h1
install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES)
@$(NORMAL_INSTALL)
@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \
}
uninstall-toolexeclibLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \
done
clean-toolexeclibLTLIBRARIES:
-test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES)
@list='$(toolexeclib_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/charmaps.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/constants.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gfileio.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gmath.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/io.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libgcobol.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/valconv.Plo@am__quote@
.cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ $<
.cc.obj:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'`
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(CXXCOMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.cc.lo:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(LTCXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ $(AM_V_CXX)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCXX_FALSE@ DEPDIR=$(DEPDIR) $(CXXDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCXX_FALSE@ $(AM_V_CXX@am__nodep@)$(LTCXXCOMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
distclean-libtool:
-rm -f libtool config.lt
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscope: cscope.files
test ! -s cscope.files \
|| $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS)
clean-cscope:
-rm -f cscope.files
cscope.files: clean-cscope cscopelist
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
-rm -f cscope.out cscope.in.out cscope.po.out cscope.files
distdir: $(DISTFILES)
$(am__remove_distdir)
test -d "$(distdir)" || mkdir "$(distdir)"
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
-test -n "$(am__skip_mode_fix)" \
|| find "$(distdir)" -type d ! -perm -755 \
-exec chmod u+rwx,go+rx {} \; -o \
! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
! -type d ! -perm -400 -exec chmod a+r {} \; -o \
! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \
|| chmod -R a+r "$(distdir)"
dist-gzip: distdir
tardir=$(distdir) && $(am__tar) | eval GZIP= gzip $(GZIP_ENV) -c >$(distdir).tar.gz
$(am__post_remove_distdir)
dist-bzip2: distdir
tardir=$(distdir) && $(am__tar) | BZIP2=$${BZIP2--9} bzip2 -c >$(distdir).tar.bz2
$(am__post_remove_distdir)
dist-lzip: distdir
tardir=$(distdir) && $(am__tar) | lzip -c $${LZIP_OPT--9} >$(distdir).tar.lz
$(am__post_remove_distdir)
dist-xz: distdir
tardir=$(distdir) && $(am__tar) | XZ_OPT=$${XZ_OPT--e} xz -c >$(distdir).tar.xz
$(am__post_remove_distdir)
dist-tarZ: distdir
@echo WARNING: "Support for distribution archives compressed with" \
"legacy program 'compress' is deprecated." >&2
@echo WARNING: "It will be removed altogether in Automake 2.0" >&2
tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z
$(am__post_remove_distdir)
dist-shar: distdir
@echo WARNING: "Support for shar distribution archives is" \
"deprecated." >&2
@echo WARNING: "It will be removed altogether in Automake 2.0" >&2
shar $(distdir) | eval GZIP= gzip $(GZIP_ENV) -c >$(distdir).shar.gz
$(am__post_remove_distdir)
dist-zip: distdir
-rm -f $(distdir).zip
zip -rq $(distdir).zip $(distdir)
$(am__post_remove_distdir)
dist dist-all:
$(MAKE) $(AM_MAKEFLAGS) $(DIST_TARGETS) am__post_remove_distdir='@:'
$(am__post_remove_distdir)
# This target untars the dist file and tries a VPATH configuration. Then
# it guarantees that the distribution is self-contained by making another
# tarfile.
distcheck: dist
case '$(DIST_ARCHIVES)' in \
*.tar.gz*) \
eval GZIP= gzip $(GZIP_ENV) -dc $(distdir).tar.gz | $(am__untar) ;;\
*.tar.bz2*) \
bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\
*.tar.lz*) \
lzip -dc $(distdir).tar.lz | $(am__untar) ;;\
*.tar.xz*) \
xz -dc $(distdir).tar.xz | $(am__untar) ;;\
*.tar.Z*) \
uncompress -c $(distdir).tar.Z | $(am__untar) ;;\
*.shar.gz*) \
eval GZIP= gzip $(GZIP_ENV) -dc $(distdir).shar.gz | unshar ;;\
*.zip*) \
unzip $(distdir).zip ;;\
esac
chmod -R a-w $(distdir)
chmod u+w $(distdir)
mkdir $(distdir)/_build $(distdir)/_build/sub $(distdir)/_inst
chmod a-w $(distdir)
test -d $(distdir)/_build || exit 0; \
dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \
&& dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \
&& am__cwd=`pwd` \
&& $(am__cd) $(distdir)/_build/sub \
&& ../../configure \
$(AM_DISTCHECK_CONFIGURE_FLAGS) \
$(DISTCHECK_CONFIGURE_FLAGS) \
--srcdir=../.. --prefix="$$dc_install_base" \
&& $(MAKE) $(AM_MAKEFLAGS) \
&& $(MAKE) $(AM_MAKEFLAGS) dvi \
&& $(MAKE) $(AM_MAKEFLAGS) check \
&& $(MAKE) $(AM_MAKEFLAGS) install \
&& $(MAKE) $(AM_MAKEFLAGS) installcheck \
&& $(MAKE) $(AM_MAKEFLAGS) uninstall \
&& $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \
distuninstallcheck \
&& chmod -R a-w "$$dc_install_base" \
&& ({ \
(cd ../.. && umask 077 && mkdir "$$dc_destdir") \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \
distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \
} || { rm -rf "$$dc_destdir"; exit 1; }) \
&& rm -rf "$$dc_destdir" \
&& $(MAKE) $(AM_MAKEFLAGS) dist \
&& rm -rf $(DIST_ARCHIVES) \
&& $(MAKE) $(AM_MAKEFLAGS) distcleancheck \
&& cd "$$am__cwd" \
|| exit 1
$(am__post_remove_distdir)
@(echo "$(distdir) archives ready for distribution: "; \
list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \
sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x'
distuninstallcheck:
@test -n '$(distuninstallcheck_dir)' || { \
echo 'ERROR: trying to run $@ with an empty' \
'$$(distuninstallcheck_dir)' >&2; \
exit 1; \
}; \
$(am__cd) '$(distuninstallcheck_dir)' || { \
echo 'ERROR: cannot chdir into $(distuninstallcheck_dir)' >&2; \
exit 1; \
}; \
test `$(am__distuninstallcheck_listfiles) | wc -l` -eq 0 \
|| { echo "ERROR: files left after uninstall:" ; \
if test -n "$(DESTDIR)"; then \
echo " (check DESTDIR support)"; \
fi ; \
$(distuninstallcheck_listfiles) ; \
exit 1; } >&2
distcleancheck: distclean
@if test '$(srcdir)' = . ; then \
echo "ERROR: distcleancheck can only run from a VPATH build" ; \
exit 1 ; \
fi
@test `$(distcleancheck_listfiles) | wc -l` -eq 0 \
|| { echo "ERROR: files left in build directory after distclean:" ; \
$(distcleancheck_listfiles) ; \
exit 1; } >&2
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES) config.h
installdirs:
for dir in "$(DESTDIR)$(toolexeclibdir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-toolexeclibLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf ./$(DEPDIR)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-hdr distclean-libtool distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-toolexeclibLTLIBRARIES
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf $(top_srcdir)/autom4te.cache
-rm -rf ./$(DEPDIR)
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-toolexeclibLTLIBRARIES
.MAKE: all install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am am--refresh check check-am clean \
clean-cscope clean-generic clean-libtool \
clean-toolexeclibLTLIBRARIES cscope cscopelist-am ctags \
ctags-am dist dist-all dist-bzip2 dist-gzip dist-lzip \
dist-shar dist-tarZ dist-xz dist-zip distcheck distclean \
distclean-compile distclean-generic distclean-hdr \
distclean-libtool distclean-tags distcleancheck distdir \
distuninstallcheck dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip install-toolexeclibLTLIBRARIES installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am \
uninstall-toolexeclibLTLIBRARIES
.PRECIOUS: Makefile
libgcobol.la: $(libgcobol_la_OBJECTS) \
$(libgcobol_la_DEPENDENCIES) \
$(EXTRA_libgcobol_la_DEPENDENCIES)
$(AM_V_GEN)$(libgcobol_la_LINK) \
-rpath $(libdir)/../lib64 \
$(libgcobol_la_OBJECTS) \
$(libgcobol_la_LIBADD) $(LIBS)
# The 'all' rule must be the first one so that it is executed if
# nothing is specified on the command-line.
all: $(LIBGCOBOL_LA)
.PHONY: install install-html install-pdf install-info
###include $(top_srcdir)/../multilib.am
install: libgcobol$(libsuffix).la
$(LIBTOOL) --mode=install $(INSTALL) $^ $(DESTDIR)$(libdir)/../lib64
%.lo: %.c
$(LIBTOOL) --mode=compile $(CC) -c \
-o $@ $(ALL_CFLAGS) $(INCLUDES) $<
%.lo: %.cc
$(LIBTOOL) --mode=compile --tag=CXX $(CXX) -c \
-o $@ $(INCLUDES) $(ALL_CFLAGS) $<
doc: info dvi pdf html
# No install-html or install-pdf support
install-html install-pdf install-info:
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

12
libgcobol/README Normal file
View file

@ -0,0 +1,12 @@
The libgcobol is intended for use entirely and solely by executables created
from COBOL source code by the GCOBOL "COBOL for GCC" front end.
libgcobol.a can be staticly linked in, but it makes for very large binaries. We
tend to use that for debugging the GCOBOL compiler, and not much else
Many of the functions in the library are called by the executable code generated
by the GCOBOL compiler through GIMPLE tags, and thus prototypes -- which are
part of the C/C++ programming paradigm -- are not used. Both the calling
program and the called program use the extern "C" construction so that the
linker can find the functions, and they need to agree ahead of time about the
meaning of passed parameters.

26
libgcobol/acinclude.m4 Normal file
View file

@ -0,0 +1,26 @@
dnl Copyright (C) 2021-2025 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
dnl This program is distributed in the hope that it will be useful,
dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
dnl PARTICULAR PURPOSE.
m4_include(../config/acx.m4)
m4_include(../config/no-executables.m4)
m4_include(../config/enable.m4)
m4_include(../config/tls.m4)
m4_include(../config/bitfields.m4)
m4_include(../libtool.m4)
dnl The lines below arrange for aclocal not to bring an installed
dnl libtool.m4 into aclocal.m4, while still arranging for automake to
dnl add a definition of LIBTOOL to Makefile.in.
ifelse(yes,no,[
AC_DEFUN([AM_PROG_LIBTOOL],)
AC_DEFUN([AC_LIBTOOL_DLOPEN],)
AC_DEFUN([AC_LIBLTDL_CONVENIENCE],)
AC_SUBST(LIBTOOL)
])

1199
libgcobol/aclocal.m4 vendored Normal file
View file

File diff suppressed because it is too large Load diff

929
libgcobol/charmaps.cc Normal file
View file

@ -0,0 +1,929 @@
// This file is included in both the libgcobol and gcc/cobol compilations
/*
* 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.
*/
#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <unistd.h>
#include <algorithm>
#include <langinfo.h>
#include <unordered_map>
#include <locale.h>
#include <iconv.h>
#include "ec.h"
#include "common-defs.h"
#include "io.h"
#include "gcobolio.h"
#include "libgcobol.h"
#include "charmaps.h"
#include "valconv.h"
// First: single-byte-coded (SBC) character sets:
// 7-bit ASCII is a subset of the various ISO/IEC 8859 code pages.
// 8859 is a subset of code page 1252.
// CP1252 is informally, and improperly, known as the "ANSI" code set. In
// modern usage, when somebody says "8859-1", they almost invariably are
// referring to a CP1252 code set.
// EBCDIC is also an SBC character set. IBM's original "international EBCDIC"
// code set was Code Page 37, which did not have a Euro sign. Code Page 1140
// is the same as CP37, but with the Euro sign replacing the "universal
// currency symbol" at position 0x9F. The table below maps the 256 values of
// CodePage 1140 to the 256 values of CodePage 1252 in a way that allows for
// "round trip" conversion without any loss.
// See https://en.wikipedia.org/w/index.php?title=Code_page_37&oldid=1082467670,
// The modern world increasingly uses UTF-8, which is in conflict with ordinary
// COBOL's inherently single-byte nature. In UTF-8, the encoding for a Euro
// sign is three bytes (U+20AC encodes to E2 A2 AC). In single-byte CP1252, the
// Euro is encoded as 0x80.
// So, we are going to assume that internally, the generated COBOL executable
// operates in code page 1252 or [hopefully some day] code page 1140.
// We will convert output, as in DISPLAY <something> from the internal character
// set to the running machine's locale (for now, that locale will be assumed to
// be 1252/8859 if it isn't UTF-8).
// And we will take some pains to figure out if the source code file was done
// as UTF-8; if not, we will assume 1252/8859-1
// __gg__ebcdic_codeset_in_use is the ultimate determinator of whether the
// internal codeset is ASCII/CP1252 or EBCDIC/CP1140.
bool __gg__ebcdic_codeset_in_use = false ;
static text_codeset_t source_codeset = cs_cp1252_e;
static text_codeset_t console_codeset = cs_default_e;
#define UNICODE_REPLACEMENT 0xFFFD // This a white question mark in a black diamond
#define ASCII_REPLACEMENT 0x87 // In CP1252, 0x87 is a double-dagger
// This table is the default one-to-one mapping that's used, for example, when
// starting with ASCII and doing ASCII comparisons:
const unsigned short
__gg__one_to_one_values[256] =
{
0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0A,0x0B,0x0C,0x0D,0x0E,0x0F,
0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0x1A,0x1B,0x1C,0x1D,0x1E,0x1F,
0x20,0x21,0x22,0x23,0x24,0x25,0x26,0x27,0x28,0x29,0x2A,0x2B,0x2C,0x2D,0x2E,0x2F,
0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0x3A,0x3B,0x3C,0x3D,0x3E,0x3F,
0x40,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0x4A,0x4B,0x4C,0x4D,0x4E,0x4F,
0x50,0x51,0x52,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5A,0x5B,0x5C,0x5D,0x5E,0x5F,
0x60,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0x6A,0x6B,0x6C,0x6D,0x6E,0x6F,
0x70,0x71,0x72,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A,0x7B,0x7C,0x7D,0x7E,0x7F,
0x80,0x81,0x82,0x83,0x84,0x85,0x86,0x87,0x88,0x89,0x8A,0x8B,0x8C,0x8D,0x8E,0x8F,
0x90,0x91,0x92,0x93,0x94,0x95,0x96,0x97,0x98,0x99,0x9A,0x9B,0x9C,0x9D,0x9E,0x9F,
0xA0,0xA1,0xA2,0xA3,0xA4,0xA5,0xA6,0xA7,0xA8,0xA9,0xAA,0xAB,0xAC,0xAD,0xAE,0xAF,
0xB0,0xB1,0xB2,0xB3,0xB4,0xB5,0xB6,0xB7,0xB8,0xB9,0xBA,0xBB,0xBC,0xBD,0xBE,0xBF,
0xC0,0xC1,0xC2,0xC3,0xC4,0xC5,0xC6,0xC7,0xC8,0xC9,0xCA,0xCB,0xCC,0xCD,0xCE,0xCF,
0xD0,0xD1,0xD2,0xD3,0xD4,0xD5,0xD6,0xD7,0xD8,0xD9,0xDA,0xDB,0xDC,0xDD,0xDE,0xDF,
0xE0,0xE1,0xE2,0xE3,0xE4,0xE5,0xE6,0xE7,0xE8,0xE9,0xEA,0xEB,0xEC,0xED,0xEE,0xEF,
0xF0,0xF1,0xF2,0xF3,0xF4,0xF5,0xF6,0xF7,0xF8,0xF9,0xFA,0xFB,0xFC,0xFD,0xFE,0xFF
};
// This table can be used for converting EBCDIC values to CP1252.
// There is an unfortunate caveat, one that undoubtedly will have unintended
// consequences. But COBOL has has the concept of a HIGH-VALUE, a character
// that theoretically tests alphanumercially greater than all other characters.
// In the CP1252 code page, the default HIGH-VALUE (it can be changed by the
// ALPHABET clause is 0xFF, which is displayed as the character 'ÿ'). In the
// EBCDIC code page 1140, that character is an EO control code.
// So. In order that the default HIGH-VALUE once and always is 0xFF, these
// two tables have been modified slightly so that 0xFF always maps to 0xFF
// Programmers who use the ALPHABET clause to change the HIGH-VALUE are on their
// own.
const unsigned short
__gg__cp1140_to_cp1252_values[256] =
{
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x85, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0xA4, 0x81, 0x82, 0x83, 0x84, 0x0A, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xE2, 0xE4, 0xE0, 0xE1, 0xE3, 0xE5, 0xE7, 0xF1, 0xA2, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xE9, 0xEA, 0xEB, 0xE8, 0xED, 0xEE, 0xEF, 0xEC, 0xDF, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0xAC,
0x2D, 0x2F, 0xC2, 0xC4, 0xC0, 0xC1, 0xC3, 0xC5, 0xC7, 0xD1, 0xA6, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xF8, 0xC9, 0xCA, 0xCB, 0xC8, 0xCD, 0xCE, 0xCF, 0xCC, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xD8, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xAB, 0xBB, 0xF0, 0xFD, 0xFE, 0xB1,
0xB0, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xAA, 0xBA, 0xE6, 0xB8, 0xC6, 0x80,
0xB5, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xA1, 0xBF, 0xD0, 0xDD, 0xDE, 0xAE,
0x5E, 0xA3, 0xA5, 0xB7, 0xA9, 0xA7, 0xB6, 0xBC, 0xBD, 0xBE, 0x5B, 0x5D, 0xAF, 0xA8, 0xB4, 0xD7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xAD, 0xF4, 0xF6, 0xF2, 0xF3, 0xF5,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xB9, 0xFB, 0xFC, 0xF9, 0xFA, 0xFF,
0x5C, 0xF7, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xB2, 0xD4, 0xD6, 0xD2, 0xD3, 0xD5,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0xDB, 0xDC, 0xD9, 0xDA, /*0x9F*/ 0xFF,
};
// This table is the mirror image of cp1140_to_cp1252_values, except for the
// above-mentioned 0xFF
const unsigned short
__gg__cp1252_to_cp1140_values[256] =
{
0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,
0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,
0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,
0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,
0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xBA, 0xE0, 0xBB, 0xB0, 0x6D,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7, 0xA8, 0xA9, 0xC0, 0x4F, 0xD0, 0xA1, 0x07,
0x9F, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, 0x28, 0x29, 0x2A, 0x2B, 0x2C, 0x09, 0x0A, 0x1B,
0x30, 0x31, 0x1A, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3A, 0x3B, 0x04, 0x14, 0x3E, 0xFF,
0x41, 0xAA, 0x4A, 0xB1, 0x20, 0xB2, 0x6A, 0xB5, 0xBD, 0xB4, 0x9A, 0x8A, 0x5F, 0xCA, 0xAF, 0xBC,
0x90, 0x8F, 0xEA, 0xFA, 0xBE, 0xA0, 0xB6, 0xB3, 0x9D, 0xDA, 0x9B, 0x8B, 0xB7, 0xB8, 0xB9, 0xAB,
0x64, 0x65, 0x62, 0x66, 0x63, 0x67, 0x9E, 0x68, 0x74, 0x71, 0x72, 0x73, 0x78, 0x75, 0x76, 0x77,
0xAC, 0x69, 0xED, 0xEE, 0xEB, 0xEF, 0xEC, 0xBF, 0x80, 0xFD, 0xFE, 0xFB, 0xFC, 0xAD, 0xAE, 0x59,
0x44, 0x45, 0x42, 0x46, 0x43, 0x47, 0x9C, 0x48, 0x54, 0x51, 0x52, 0x53, 0x58, 0x55, 0x56, 0x57,
0x8C, 0x49, 0xCD, 0xCE, 0xCB, 0xCF, 0xCC, 0xE1, 0x70, 0xDD, 0xDE, 0xDB, 0xDC, 0x8D, 0x8E, /*0xDF*/ 0xFF,
};
// This is the EBCDIC collating sequence when the internal character set is CP1252. It's actually
// a copy of __gg__cp1252_to_cp1140_values, but modified so that 0xFF maps to 0xFF.
// Doing this meant swapping the CP1252 upper-Y-umlaut with lower-Y-umlaut.
const unsigned short
__gg__cp1252_to_ebcdic_collation[256] =
{
0x00, 0x01, 0x02, 0x03, 0x37, 0x2d, 0x2e, 0x2f, 0x16, 0x05, 0x25, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f,
0x10, 0x11, 0x12, 0x13, 0x3c, 0x3d, 0x32, 0x26, 0x18, 0x19, 0x3f, 0x27, 0x1c, 0x1d, 0x1e, 0x1f,
0x40, 0x5a, 0x7f, 0x7b, 0x5b, 0x6c, 0x50, 0x7d, 0x4d, 0x5d, 0x5c, 0x4e, 0x6b, 0x60, 0x4b, 0x61,
0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, 0xf9, 0x7a, 0x5e, 0x4c, 0x7e, 0x6e, 0x6f,
0x7c, 0xc1, 0xc2, 0xc3, 0xc4, 0xc5, 0xc6, 0xc7, 0xc8, 0xc9, 0xd1, 0xd2, 0xd3, 0xd4, 0xd5, 0xd6,
0xd7, 0xd8, 0xd9, 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7, 0xe8, 0xe9, 0xba, 0xe0, 0xbb, 0xb0, 0x6d,
0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,
0x97, 0x98, 0x99, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, 0xa8, 0xa9, 0xc0, 0x4f, 0xd0, 0xa1, 0x07,
0x9f, 0x21, 0x22, 0x23, 0x24, 0x15, 0x06, 0x17, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x09, 0x0a, 0x1b,
0x30, 0x31, 0x1a, 0x33, 0x34, 0x35, 0x36, 0x08, 0x38, 0x39, 0x3a, 0x3b, 0x04, 0x14, 0x3e, 0xdf,
0x41, 0xaa, 0x4a, 0xb1, 0x20, 0xb2, 0x6a, 0xb5, 0xbd, 0xb4, 0x9a, 0x8a, 0x5f, 0xca, 0xaf, 0xbc,
0x90, 0x8f, 0xea, 0xfa, 0xbe, 0xa0, 0xb6, 0xb3, 0x9d, 0xda, 0x9b, 0x8b, 0xb7, 0xb8, 0xb9, 0xab,
0x64, 0x65, 0x62, 0x66, 0x63, 0x67, 0x9e, 0x68, 0x74, 0x71, 0x72, 0x73, 0x78, 0x75, 0x76, 0x77,
0xac, 0x69, 0xed, 0xee, 0xeb, 0xef, 0xec, 0xbf, 0x80, 0xfd, 0xfe, 0xfb, 0xfc, 0xad, 0xae, 0x59,
0x44, 0x45, 0x42, 0x46, 0x43, 0x47, 0x9c, 0x48, 0x54, 0x51, 0x52, 0x53, 0x58, 0x55, 0x56, 0x57,
0x8c, 0x49, 0xcd, 0xce, 0xcb, 0xcf, 0xcc, 0xe1, 0x70, 0xdd, 0xde, 0xdb, 0xdc, 0x8d, 0x8e, 0xff,
};
// When using the EBCDIC internal character set, but if told to use the ASCII collating sequence,
// this table can be used. It's based on the __gg__cp1140_to_cp1252_values, but with the two
// characters at locations DF and FF swapped so that the HIGH-VALUE 0xFF maps to 0xFF.
const unsigned short
__gg__ebcdic_to_cp1252_collation[256] =
{
0x00, 0x01, 0x02, 0x03, 0x9C, 0x09, 0x86, 0x7F, 0x97, 0x8D, 0x8E, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,
0x10, 0x11, 0x12, 0x13, 0x9D, 0x85, 0x08, 0x87, 0x18, 0x19, 0x92, 0x8F, 0x1C, 0x1D, 0x1E, 0x1F,
0xA4, 0x81, 0x82, 0x83, 0x84, 0x0A, 0x17, 0x1B, 0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x05, 0x06, 0x07,
0x90, 0x91, 0x16, 0x93, 0x94, 0x95, 0x96, 0x04, 0x98, 0x99, 0x9A, 0x9B, 0x14, 0x15, 0x9E, 0x1A,
0x20, 0xA0, 0xE2, 0xE4, 0xE0, 0xE1, 0xE3, 0xE5, 0xE7, 0xF1, 0xA2, 0x2E, 0x3C, 0x28, 0x2B, 0x7C,
0x26, 0xE9, 0xEA, 0xEB, 0xE8, 0xED, 0xEE, 0xEF, 0xEC, 0xDF, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0xAC,
0x2D, 0x2F, 0xC2, 0xC4, 0xC0, 0xC1, 0xC3, 0xC5, 0xC7, 0xD1, 0xA6, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,
0xF8, 0xC9, 0xCA, 0xCB, 0xC8, 0xCD, 0xCE, 0xCF, 0xCC, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,
0xD8, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0xAB, 0xBB, 0xF0, 0xFD, 0xFE, 0xB1,
0xB0, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, 0x71, 0x72, 0xAA, 0xBA, 0xE6, 0xB8, 0xC6, 0x80,
0xB5, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0xA1, 0xBF, 0xD0, 0xDD, 0xDE, 0xAE,
0x5E, 0xA3, 0xA5, 0xB7, 0xA9, 0xA7, 0xB6, 0xBC, 0xBD, 0xBE, 0x5B, 0x5D, 0xAF, 0xA8, 0xB4, 0xD7,
0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0xAD, 0xF4, 0xF6, 0xF2, 0xF3, 0xF5,
0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, 0x51, 0x52, 0xB9, 0xFB, 0xFC, 0xF9, 0xFA, 0xDF,
0x5C, 0xF7, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0xB2, 0xD4, 0xD6, 0xD2, 0xD3, 0xD5,
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0xDB, 0xDC, 0xD9, 0xDA, 0xFF,
};
// This table is used for converting code page 1252 to the subset of UTF-8 that
// that contains CP1252
static const unsigned short
cp1252_to_utf8_values[256] =
{
0x0000, 0x0001, 0x0002, 0x0003, 0x0004, 0x0005, 0x0006, 0x0007, 0x0008, 0x0009, 0x000a, 0x000b, 0x000c, 0x000d, 0x000e, 0x000f, // 00
0x0010, 0x0011, 0x0012, 0x0013, 0x0014, 0x0015, 0x0016, 0x0017, 0x0018, 0x0019, 0x001a, 0x001b, 0x001c, 0x001d, 0x001e, 0x001f, // 10
0x0020, 0x0021, 0x0022, 0x0023, 0x0024, 0x0025, 0x0026, 0x0027, 0x0028, 0x0029, 0x002a, 0x002b, 0x002c, 0x002d, 0x002e, 0x002f, // 20
0x0030, 0x0031, 0x0032, 0x0033, 0x0034, 0x0035, 0x0036, 0x0037, 0x0038, 0x0039, 0x003a, 0x003b, 0x003c, 0x003d, 0x003e, 0x003f, // 30
0x0040, 0x0041, 0x0042, 0x0043, 0x0044, 0x0045, 0x0046, 0x0047, 0x0048, 0x0049, 0x004a, 0x004b, 0x004c, 0x004d, 0x004e, 0x004f, // 40
0x0050, 0x0051, 0x0052, 0x0053, 0x0054, 0x0055, 0x0056, 0x0057, 0x0058, 0x0059, 0x005a, 0x005b, 0x005c, 0x005d, 0x005e, 0x005f, // 50
0x0060, 0x0061, 0x0062, 0x0063, 0x0064, 0x0065, 0x0066, 0x0067, 0x0068, 0x0069, 0x006a, 0x006b, 0x006c, 0x006d, 0x006e, 0x006f, // 60
0x0070, 0x0071, 0x0072, 0x0073, 0x0074, 0x0075, 0x0076, 0x0077, 0x0078, 0x0079, 0x007a, 0x007b, 0x007c, 0x007d, 0x007e, 0x007f, // 70
0x20ac, 0x0081, 0x201a, 0x0192, 0x201e, 0x2026, 0x2020, 0x2021, 0x02c6, 0x2030, 0x0160, 0x2039, 0x0152, 0x008d, 0x017d, 0x008f, // 80
0x0090, 0x2018, 0x2019, 0x201c, 0x201d, 0x2022, 0x2013, 0x2014, 0x02dc, 0x2122, 0x0161, 0x203a, 0x0153, 0x009d, 0x017e, 0x0178, // 90
0x00a0, 0x00a1, 0x00a2, 0x00a3, 0x00a4, 0x00a5, 0x00a6, 0x00a7, 0x00a8, 0x00a9, 0x00aa, 0x00ab, 0x00ac, 0x00ad, 0x00ae, 0x00af, // A0
0x00b0, 0x00b1, 0x00b2, 0x00b3, 0x00b4, 0x00b5, 0x00b6, 0x00b7, 0x00b8, 0x00b9, 0x00ba, 0x00bb, 0x00bc, 0x00bd, 0x00be, 0x00bf, // B0
0x00c0, 0x00c1, 0x00c2, 0x00c3, 0x00c4, 0x00c5, 0x00c6, 0x00c7, 0x00c8, 0x00c9, 0x00ca, 0x00cb, 0x00cc, 0x00cd, 0x00ce, 0x00cf, // C0
0x00d0, 0x00d1, 0x00d2, 0x00d3, 0x00d4, 0x00d5, 0x00d6, 0x00d7, 0x00d8, 0x00d9, 0x00da, 0x00db, 0x00dc, 0x00dd, 0x00de, 0x00df, // D0
0x00e0, 0x00e1, 0x00e2, 0x00e3, 0x00e4, 0x00e5, 0x00e6, 0x00e7, 0x00e8, 0x00e9, 0x00ea, 0x00eb, 0x00ec, 0x00ed, 0x00ee, 0x00ef, // E0
0x00f0, 0x00f1, 0x00f2, 0x00f3, 0x00f4, 0x00f5, 0x00f6, 0x00f7, 0x00f8, 0x00f9, 0x00fa, 0x00fb, 0x00fc, 0x00fd, 0x00fe, 0x00ff, // F0
};
// This map table doe the reverse UTF-8 conversion back to cp1252
static const std::unordered_map<unsigned short, unsigned char>utf8_to_cp1252_values =
{
{0x0000, 0x00}, {0x0001, 0x01}, {0x0002, 0x02}, {0x0003, 0x03}, {0x0004, 0x04}, {0x0005, 0x05}, {0x0006, 0x06}, {0x0007, 0x07},
{0x0008, 0x08}, {0x0009, 0x09}, {0x000a, 0x0a}, {0x000b, 0x0b}, {0x000c, 0x0c}, {0x000d, 0x0d}, {0x000e, 0x0e}, {0x000f, 0x0f},
{0x0010, 0x10}, {0x0011, 0x11}, {0x0012, 0x12}, {0x0013, 0x13}, {0x0014, 0x14}, {0x0015, 0x15}, {0x0016, 0x16}, {0x0017, 0x17},
{0x0018, 0x18}, {0x0019, 0x19}, {0x001a, 0x1a}, {0x001b, 0x1b}, {0x001c, 0x1c}, {0x001d, 0x1d}, {0x001e, 0x1e}, {0x001f, 0x1f},
{0x0020, 0x20}, {0x0021, 0x21}, {0x0022, 0x22}, {0x0023, 0x23}, {0x0024, 0x24}, {0x0025, 0x25}, {0x0026, 0x26}, {0x0027, 0x27},
{0x0028, 0x28}, {0x0029, 0x29}, {0x002a, 0x2a}, {0x002b, 0x2b}, {0x002c, 0x2c}, {0x002d, 0x2d}, {0x002e, 0x2e}, {0x002f, 0x2f},
{0x0030, 0x30}, {0x0031, 0x31}, {0x0032, 0x32}, {0x0033, 0x33}, {0x0034, 0x34}, {0x0035, 0x35}, {0x0036, 0x36}, {0x0037, 0x37},
{0x0038, 0x38}, {0x0039, 0x39}, {0x003a, 0x3a}, {0x003b, 0x3b}, {0x003c, 0x3c}, {0x003d, 0x3d}, {0x003e, 0x3e}, {0x003f, 0x3f},
{0x0040, 0x40}, {0x0041, 0x41}, {0x0042, 0x42}, {0x0043, 0x43}, {0x0044, 0x44}, {0x0045, 0x45}, {0x0046, 0x46}, {0x0047, 0x47},
{0x0048, 0x48}, {0x0049, 0x49}, {0x004a, 0x4a}, {0x004b, 0x4b}, {0x004c, 0x4c}, {0x004d, 0x4d}, {0x004e, 0x4e}, {0x004f, 0x4f},
{0x0050, 0x50}, {0x0051, 0x51}, {0x0052, 0x52}, {0x0053, 0x53}, {0x0054, 0x54}, {0x0055, 0x55}, {0x0056, 0x56}, {0x0057, 0x57},
{0x0058, 0x58}, {0x0059, 0x59}, {0x005a, 0x5a}, {0x005b, 0x5b}, {0x005c, 0x5c}, {0x005d, 0x5d}, {0x005e, 0x5e}, {0x005f, 0x5f},
{0x0060, 0x60}, {0x0061, 0x61}, {0x0062, 0x62}, {0x0063, 0x63}, {0x0064, 0x64}, {0x0065, 0x65}, {0x0066, 0x66}, {0x0067, 0x67},
{0x0068, 0x68}, {0x0069, 0x69}, {0x006a, 0x6a}, {0x006b, 0x6b}, {0x006c, 0x6c}, {0x006d, 0x6d}, {0x006e, 0x6e}, {0x006f, 0x6f},
{0x0070, 0x70}, {0x0071, 0x71}, {0x0072, 0x72}, {0x0073, 0x73}, {0x0074, 0x74}, {0x0075, 0x75}, {0x0076, 0x76}, {0x0077, 0x77},
{0x0078, 0x78}, {0x0079, 0x79}, {0x007a, 0x7a}, {0x007b, 0x7b}, {0x007c, 0x7c}, {0x007d, 0x7d}, {0x007e, 0x7e}, {0x007f, 0x7f},
{0x20ac, 0x80}, {0x0081, 0x81}, {0x201a, 0x82}, {0x0192, 0x83}, {0x201e, 0x84}, {0x2026, 0x85}, {0x2020, 0x86}, {0x2021, 0x87},
{0x02c6, 0x88}, {0x2030, 0x89}, {0x0160, 0x8a}, {0x2039, 0x8b}, {0x0152, 0x8c}, {0x008d, 0x8d}, {0x017d, 0x8e}, {0x008f, 0x8f},
{0x0090, 0x90}, {0x2018, 0x91}, {0x2019, 0x92}, {0x201c, 0x93}, {0x201d, 0x94}, {0x2022, 0x95}, {0x2013, 0x96}, {0x2014, 0x97},
{0x02dc, 0x98}, {0x2122, 0x99}, {0x0161, 0x9a}, {0x203a, 0x9b}, {0x0153, 0x9c}, {0x009d, 0x9d}, {0x017e, 0x9e}, {0x0178, 0x9f},
{0x00a0, 0xa0}, {0x00a1, 0xa1}, {0x00a2, 0xa2}, {0x00a3, 0xa3}, {0x00a4, 0xa4}, {0x00a5, 0xa5}, {0x00a6, 0xa6}, {0x00a7, 0xa7},
{0x00a8, 0xa8}, {0x00a9, 0xa9}, {0x00aa, 0xaa}, {0x00ab, 0xab}, {0x00ac, 0xac}, {0x00ad, 0xad}, {0x00ae, 0xae}, {0x00af, 0xaf},
{0x00b0, 0xb0}, {0x00b1, 0xb1}, {0x00b2, 0xb2}, {0x00b3, 0xb3}, {0x00b4, 0xb4}, {0x00b5, 0xb5}, {0x00b6, 0xb6}, {0x00b7, 0xb7},
{0x00b8, 0xb8}, {0x00b9, 0xb9}, {0x00ba, 0xba}, {0x00bb, 0xbb}, {0x00bc, 0xbc}, {0x00bd, 0xbd}, {0x00be, 0xbe}, {0x00bf, 0xbf},
{0x00c0, 0xc0}, {0x00c1, 0xc1}, {0x00c2, 0xc2}, {0x00c3, 0xc3}, {0x00c4, 0xc4}, {0x00c5, 0xc5}, {0x00c6, 0xc6}, {0x00c7, 0xc7},
{0x00c8, 0xc8}, {0x00c9, 0xc9}, {0x00ca, 0xca}, {0x00cb, 0xcb}, {0x00cc, 0xcc}, {0x00cd, 0xcd}, {0x00ce, 0xce}, {0x00cf, 0xcf},
{0x00d0, 0xd0}, {0x00d1, 0xd1}, {0x00d2, 0xd2}, {0x00d3, 0xd3}, {0x00d4, 0xd4}, {0x00d5, 0xd5}, {0x00d6, 0xd6}, {0x00d7, 0xd7},
{0x00d8, 0xd8}, {0x00d9, 0xd9}, {0x00da, 0xda}, {0x00db, 0xdb}, {0x00dc, 0xdc}, {0x00dd, 0xdd}, {0x00de, 0xde}, {0x00df, 0xdf},
{0x00e0, 0xe0}, {0x00e1, 0xe1}, {0x00e2, 0xe2}, {0x00e3, 0xe3}, {0x00e4, 0xe4}, {0x00e5, 0xe5}, {0x00e6, 0xe6}, {0x00e7, 0xe7},
{0x00e8, 0xe8}, {0x00e9, 0xe9}, {0x00ea, 0xea}, {0x00eb, 0xeb}, {0x00ec, 0xec}, {0x00ed, 0xed}, {0x00ee, 0xee}, {0x00ef, 0xef},
{0x00f0, 0xf0}, {0x00f1, 0xf1}, {0x00f2, 0xf2}, {0x00f3, 0xf3}, {0x00f4, 0xf4}, {0x00f5, 0xf5}, {0x00f6, 0xf6}, {0x00f7, 0xf7},
{0x00f8, 0xf8}, {0x00f9, 0xf9}, {0x00fa, 0xfa}, {0x00fb, 0xfb}, {0x00fc, 0xfc}, {0x00fd, 0xfd}, {0x00fe, 0xfe}, {0x00ff, 0xff},
};
// This function extracts the next unicode code point from a stream of UTF-8
// data.
static bool
raw_is_SBC()
{
bool retval = false;
switch(source_codeset)
{
case cs_cp1252_e:
retval = true;
break;
default:
break;
}
return retval;
}
static size_t
extract_next_code_point(const unsigned char *utf8,
const size_t /*length_in_bytes*/,
size_t &position)
{
long retval = -1; // Means a badly formed code point
unsigned char ch = utf8[position++];
long under_construction = 0;
int countdown = 0;
if( (ch & 0x80) == 0x00 )
{
// We are in the ASCII subset of UTF-8, and we are done
retval = ch;
goto done;
}
else if( (ch & 0xE0) == 0xC0 )
{
// There is one byte to follow
countdown = 1;
under_construction = ch & 0x1F;
}
else if( (ch & 0xF0) == 0xE0 )
{
countdown = 2;
under_construction = ch & 0x0F;
}
else if( (ch & 0xF8) == 0xF0 )
{
countdown = 3;
under_construction = ch & 0x07;
}
else
{
// We have a poorly-constructed UTF-8 encoding
goto done;
}
while( countdown-- )
{
ch = utf8[position++];
// We are in a follow-up encoded byte:
if( (ch & 0xC0) == 0x80 )
{
// The top two bits are 10, so build in the bottom six bits
under_construction <<= 6;
under_construction |= (ch & 0x3F);
}
else
{
// This is a poorly-formed encoding
goto done;
}
}
retval = under_construction;
done:
return retval;
}
void flipper(void)
{
for(int i=0; i<256; i++)
{
fprintf(stderr, "{0x%4.4x, 0x%2.2x}, ", cp1252_to_utf8_values[i], i);
if( (i % 8) == 7 )
{
fprintf(stderr, "\n");
}
}
}
extern "C"
char __gg__ascii_to_ascii_chr(char ch)
{
return ch;
}
extern "C"
char __gg__ascii_to_ebcdic_chr(char ch)
{
return (char)__gg__cp1252_to_cp1140_values[(ch&0xFF)];
}
extern "C"
char *
__gg__raw_to_ascii(char **dest, size_t *dest_size, const char *in, size_t length)
{
// We are anticipating `length` characters, some of which might be multi-
// character UTF-8 codepoints. We are sending back a nul-terminated string
// of SBC ASCII values.
__gg__realloc_if_necessary(dest, dest_size, length+1);
// This is the byte position of the output
size_t index = 0;
// This is the byte position of the input
size_t position = 0;
while( index < length )
{
// In the case of "display "âêîôû", when the source code is encoded in
// UTF-8, the field->data.capacity is showing up as 10, because that
// UTF-8 string is ten bytes long, and the parser is not counting
// characters. The data.initial field is indeed nul-terminated, so when we
// hit a nul, we bug out:
if( in[position] == '\0' )
{
// We have hit the end. We want to space-fill to the right:
while( index < length )
{
(*dest)[index++] = internal_space;
}
break;
}
// Special handling for PIC X VALUE HIGH-VALUE. If we just hand default
// 0xFF values to the rest of the routine, the utf-8 detection will give
// us a result that confuses the remainder of the processing.
if( (in[position]&0xFF) == 0xFF )
{
(*dest)[index++] = in[position++];
continue;
}
if( raw_is_SBC() )
{
(*dest)[index++] = in[position++];
continue;
}
size_t code_point;
// Pull the next code_point from the UTF-8 stream
long unicode_point = extract_next_code_point((const unsigned char *)in,
length,
position );
// Check for that unicode code point in the subset of characters we
// know about:
std::unordered_map<unsigned short, unsigned char>::const_iterator it =
utf8_to_cp1252_values.find(unicode_point);
if( it == utf8_to_cp1252_values.end() )
{
// That unicode character isn't in our list
code_point = ASCII_REPLACEMENT;
}
else
{
code_point = it->second;
}
(*dest)[index++] = (char)code_point;
}
(*dest)[index++] = '\0';
return *dest;
}
extern "C"
char *
__gg__raw_to_ebcdic(char **dest, size_t *dest_size, const char *in, size_t length)
{
// A UTF-8 string is at least as long as the single-byte-coded resulting
// string:
__gg__realloc_if_necessary(dest, dest_size, length+1);
size_t index = 0;
size_t position = 0;
size_t code_point;
while( index < length )
{
// See comments in __gg__raw_to_ascii
if( in[position] == '\0' )
{
// We have hit the end. We want to space-fill to the right:
while( index < length )
{
(*dest)[index++] = internal_space;
}
break;
}
if( raw_is_SBC() )
{
code_point = in[position++];
long ebcdic_code_point = __gg__cp1252_to_cp1140_values[code_point&0xFF];
(*dest)[index++] = ebcdic_code_point;
continue;
}
if( (in[position]&0xff) == 0xff )
{
// HIGH-VALUE is a special case
(*dest)[index++] = in[position++];
continue;
}
// Pull the next code_point from the UTF-8 stream
long unicode_point = extract_next_code_point( (const unsigned char *)in,
length,
position );
// Check for that unicode code point in the subset of characters we
// know about:
std::unordered_map<unsigned short, unsigned char>::const_iterator it =
utf8_to_cp1252_values.find(unicode_point);
if( it == utf8_to_cp1252_values.end() )
{
// That unicode character isn't in our list
code_point = ASCII_REPLACEMENT;
}
else
{
code_point = it->second;
}
// TODO: This could be sped up by creating a utf8_to_cp1140_values map.
// But sufficient unto the day are the evils thereof
long ebcdic_code_point = __gg__cp1252_to_cp1140_values[code_point&0xFF];
(*dest)[index++] = ebcdic_code_point;
}
(*dest)[index++] = '\0';
return *dest;
}
static
char *
convert_cp1252_to_utf8(char **dest, size_t *dest_size, const char *in, size_t length)
{
// Worst case is all unicode characters.
__gg__realloc_if_necessary(dest, dest_size, 4 * length + 1);
size_t index = 0;
for(size_t i=0; i<length; i++)
{
unsigned char ch = *in++;
size_t unicode_point = cp1252_to_utf8_values[ch];
if( unicode_point < 0x0080 )
{
// Single-byte
(*dest)[index++] = (char)unicode_point;
}
else if(unicode_point < 0x0800)
{
// Two-byte:
(*dest)[index++] = 0xC0 + (unicode_point>>6);
(*dest)[index++] = 0x80 + ((unicode_point>>0) & 0x3F);
}
else if(unicode_point < 0x10000)
{
// Three-byte:
(*dest)[index++] = 0xE0 + (unicode_point>>12);
(*dest)[index++] = 0x80 + ((unicode_point>>6) & 0x3F);
(*dest)[index++] = 0x80 + ((unicode_point>>0) & 0x3F);
}
else
{
// Four-byte:
(*dest)[index++] = 0xF0 + (unicode_point>>18);
(*dest)[index++] = 0x80 + ((unicode_point>>12) & 0x3F);
(*dest)[index++] = 0x80 + ((unicode_point>>6) & 0x3F);
(*dest)[index++] = 0x80 + ((unicode_point>>0) & 0x3F);
}
}
(*dest)[index++] = '\0';
return *dest;
}
// This is the address of the 256-character map for internal characters
// It'll be set to one-to-one for ASCII, and to cp1252-to-cp1140_values for
// EBCDIC.
unsigned short const *__gg__internal_codeset_map;
// Here is the list of function pointers establish which ones of the paired
// possibilities of conversion routines are actually in use.
char (*__gg__ascii_to_internal_chr)(char);
void (*__gg__ascii_to_internal_str)(char *str, size_t length);
char *(*__gg__raw_to_internal)(char **dest, size_t *dest_size, const char *in, const size_t length);
char *(*__gg__internal_to_console_cm)(char **dest, size_t *dest_size, const char *in, size_t length);
void (*__gg__console_to_internal_cm)(char * const str, size_t length);
void (*__gg__internal_to_ascii)(char *str, size_t length);
extern "C"
void __gg__set_internal_codeset(int use_ebcdic)
{
__gg__ebcdic_codeset_in_use = !!use_ebcdic;
}
extern "C"
void __gg__text_conversion_override(text_device_t device,
text_codeset_t codeset)
{
// Establish the default sourcecode and console codesets, and
// establish the codeset conversion routines:
if( internal_is_ebcdic )
{
// fprintf(stderr, "Setting up EBCDIC\n");
__gg__internal_codeset_map = __gg__cp1252_to_cp1140_values;
__gg__ascii_to_internal_chr = &__gg__ascii_to_ebcdic_chr;
__gg__ascii_to_internal_str = &__gg__ascii_to_ebcdic;
__gg__raw_to_internal = &__gg__raw_to_ebcdic;
__gg__internal_to_console_cm = &__gg__ebcdic_to_console;
__gg__console_to_internal_cm = &__gg__console_to_ebcdic;
__gg__internal_to_ascii = &__gg__ebcdic_to_ascii;
}
else
{
// fprintf(stderr, "Setting up ASCII\n");
__gg__internal_codeset_map = __gg__one_to_one_values;
__gg__ascii_to_internal_chr = &__gg__ascii_to_ascii_chr;
__gg__ascii_to_internal_str = &__gg__ascii_to_ascii;
__gg__raw_to_internal = &__gg__raw_to_ascii;
__gg__internal_to_console_cm = &__gg__ascii_to_console;
__gg__console_to_internal_cm = &__gg__console_to_ascii;
__gg__internal_to_ascii = &__gg__ascii_to_ascii;
}
switch(device)
{
case td_default_e:
{
// We are setting our codesets to the defaults
// First, sort out the console:
// It is my understanding that the environment variable LANG is
// supposed to be set by the terminal to indicate the terminal's
// current character set. Let's use that as the winner, even if
// that's not quite the way locale(3) works.
const char *envLANG = getenv("LANG");
if( !envLANG )
{
// This is odd. No "LANG"?
envLANG = setlocale(LC_CTYPE, NULL);
}
if( !envLANG )
{
// This is even more odd. Pick something as a backup to the backup
envLANG = "UTF-8";
}
if( envLANG )
{
if( strcasestr(envLANG, "UTF-8") )
{
console_codeset = cs_utf8_e;
}
else
{
// If it isn't UTF-8, then figure on it being CP1252 as a
// convenient way of specifying an SBC codeset.
console_codeset = cs_cp1252_e;
}
}
break;
}
case td_sourcecode_e:
// Explicitly set the source code codeset:
source_codeset = codeset;
break;
case td_console_e:
// Explicitly set the console codeset:
console_codeset = codeset;
break;
}
}
extern "C"
void
__gg__ascii_to_ascii(char *, size_t )
{
return;
}
extern "C"
void
__gg__ascii_to_ebcdic(char *str, size_t length)
{
for(size_t i=0; i<length; i++)
{
str[i] = __gg__cp1252_to_cp1140_values[str[i]&0xFF];
}
}
extern "C"
void
__gg__ebcdic_to_ascii(char * const str, size_t length)
{
for(size_t i=0; i<length; i++)
{
str[i] = __gg__cp1140_to_cp1252_values[str[i]&0xFF];
}
}
extern "C"
char *__gg__ascii_to_console( char **dest,
size_t *dest_size,
char const * const str,
const size_t length)
{
if( console_codeset == cs_utf8_e )
{
__gg__realloc_if_necessary(dest, dest_size, length);
convert_cp1252_to_utf8(dest, dest_size, str, length);
}
else
{
__gg__realloc_if_necessary(dest, dest_size, length+1);
memcpy(*dest, str, length);
(*dest)[length] = '\0';
}
return *dest;
}
extern "C"
char *__gg__ebcdic_to_console(char **dest,
size_t *dest_size,
char const * const str,
const size_t length)
{
static size_t ebcdic_size = MINIMUM_ALLOCATION_SIZE;
static char *ebcdic = (char *)malloc(ebcdic_size);
__gg__realloc_if_necessary(&ebcdic, &ebcdic_size, length);
memcpy(ebcdic, str, length);
__gg__ebcdic_to_ascii(ebcdic, length);
if( console_codeset == cs_utf8_e )
{
convert_cp1252_to_utf8(dest, dest_size, ebcdic, length);
}
else
{
__gg__realloc_if_necessary(dest, dest_size, length+1);
strcpy(*dest, ebcdic);
}
return *dest;
}
extern "C"
void __gg__console_to_ascii(char * const str, size_t length)
{
// In-place conversion of ASCII data that might be UTF-8 to CP1252
if( console_codeset == cs_cp1252_e )
{
// It's already what we want it to be
return;
}
char *dest = str;
size_t position = 0;
while( position < length )
{
size_t code_point;
// Pull the next code_point from the UTF-8 stream
long unicode_point
= extract_next_code_point( (const unsigned char *)str,
length,
position );
if( unicode_point == -1 )
{
// The UTF-8 stream was poorly formed.
code_point = ASCII_REPLACEMENT;
}
else
{
// Check for that unicode code point in the subset of characters we
// know about:
std::unordered_map<unsigned short, unsigned char>::const_iterator it
= utf8_to_cp1252_values.find(unicode_point);
if( it == utf8_to_cp1252_values.end() )
{
// That unicode character isn't in our list
code_point = ASCII_REPLACEMENT;
}
else
{
code_point = it->second;
}
}
*dest++ = (char)code_point;
}
*dest++ = '\0';
}
extern "C"
void
__gg__console_to_ebcdic(char * const str, size_t length)
{
char *dest = str;
size_t position = 0;
while( position < length )
{
size_t code_point;
// Pull the next code_point from the UTF-8 stream
long unicode_point
= extract_next_code_point( (const unsigned char *)str,
length,
position );
if( unicode_point == -1 )
{
// The UTF-8 stream was poorly formed.
code_point = ASCII_REPLACEMENT;
}
else
{
// Check for that unicode code point in the subset of characters we
// know about:
std::unordered_map<unsigned short, unsigned char>::const_iterator it
= utf8_to_cp1252_values.find(unicode_point);
if( it == utf8_to_cp1252_values.end() )
{
// That unicode character isn't in our list
code_point = ASCII_REPLACEMENT;
}
else
{
code_point = it->second;
}
}
*dest++ = __gg__cp1252_to_cp1140_values[code_point&0xFF] ;
}
*dest++ = '\0';
}
extern "C"
size_t
_to_ctype(char * const location, size_t length)
{
// Converts from our internal codeset to the system LC_TYPE codeset
const char *fromcode;
const char *tocode;
if( __gg__ebcdic_codeset_in_use )
{
fromcode = "CP1140";
}
else
{
fromcode = "CP1252";
}
const char *ctype = setlocale(LC_CTYPE, "");
if( strcasestr(ctype, "UTF") )
{
tocode = "UTF-8";
}
else
{
tocode = "CP1252";
}
iconv_t cd = iconv_open(tocode, fromcode);
assert( cd != (iconv_t)-1 );
static char *dest = NULL;
static size_t dest_size = 0;
// create a buffer long enough that iconv() won't fail:
__gg__realloc_if_necessary(&dest, &dest_size, 4*length+1);
// Set up for the iconv() call:
char *inbuf = location;
size_t inbytesleft = length;
char *outbuf = dest;
size_t outbytesleft = 2*length+1;
memset(dest, ' ', 2*length+1);
iconv(cd, &inbuf, &inbytesleft, &outbuf, &outbytesleft);
memcpy(location, dest, length);
return 0;
}
extern "C"
size_t
_from_ctype(char * const location, size_t length)
{
// Converts from our internal codeset to the system LC_TYPE codeset
const char *fromcode;
const char *tocode;
if( __gg__ebcdic_codeset_in_use )
{
tocode = "CP1140";
}
else
{
tocode = "CP1252";
}
const char *ctype = setlocale(LC_CTYPE, "");
if( strcasestr(ctype, "UTF") )
{
fromcode = "UTF-8";
}
else
{
fromcode = "CP1252";
}
iconv_t cd = iconv_open(tocode, fromcode);
assert( cd != (iconv_t)-1 );
static char *dest = NULL;
static size_t dest_size = 0;
// create a buffer long enough that iconv() won't fail:
__gg__realloc_if_necessary(&dest, &dest_size, length+1);
// Set up for the iconv() call:
char *inbuf = location;
size_t inbytesleft = length;
char *outbuf = dest;
size_t outbytesleft = length+1;
memset(dest, internal_space, length+1);
///size_t iret =
iconv(cd, &inbuf, &inbytesleft, &outbuf, &outbytesleft);
memcpy(location, dest, length);
return 0;
}

370
libgcobol/charmaps.h Normal file
View file

@ -0,0 +1,370 @@
/*
* 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_dollar_sign ((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

504
libgcobol/common-defs.h Normal file
View file

@ -0,0 +1,504 @@
/*
* 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)
};
// The separate_e value does double-duty for FldPacked/COMP-6, which is not
// the same as FldPacked COMP-3. A COMP-3 can have signable_e, meaning that the
// final nybble is 0x0D for negative, and 0x0C for non-negative. When a COMP-3
// has no sign, then the final nybble is 0x0F. The packed_no_sign_e bit means
// that there is no sign nybble.
#define packed_no_sign_e separate_e
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

100
libgcobol/config.h.in Normal file
View file

@ -0,0 +1,100 @@
/* config.h.in. Generated from configure.ac by autoheader. */
/* Define to 1 if the target assembler supports thread-local storage. */
#undef HAVE_CC_TLS
/* Define to 1 if you have the <dlfcn.h> header file. */
#undef HAVE_DLFCN_H
/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H
/* Define to 1 if you have the <malloc.h> header file. */
#undef HAVE_MALLOC_H
/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H
/* Define to 1 if you have the <stdint.h> header file. */
#undef HAVE_STDINT_H
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H
/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H
/* Define to 1 if you have the <sys/stat.h> header file. */
#undef HAVE_SYS_STAT_H
/* Define to 1 if you have the <sys/types.h> header file. */
#undef HAVE_SYS_TYPES_H
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
/* Define to the sub-directory in which libtool stores uninstalled libraries.
*/
#undef LT_OBJDIR
/* Name of package */
#undef PACKAGE
/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT
/* Define to the full name of this package. */
#undef PACKAGE_NAME
/* Define to the full name and version of this package. */
#undef PACKAGE_STRING
/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME
/* Define to the home page for this package. */
#undef PACKAGE_URL
/* Define to the version of this package. */
#undef PACKAGE_VERSION
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS
/* Enable extensions on AIX 3, Interix. */
#ifndef _ALL_SOURCE
# undef _ALL_SOURCE
#endif
/* Enable GNU extensions on systems that have them. */
#ifndef _GNU_SOURCE
# undef _GNU_SOURCE
#endif
/* Enable threading extensions on Solaris. */
#ifndef _POSIX_PTHREAD_SEMANTICS
# undef _POSIX_PTHREAD_SEMANTICS
#endif
/* Enable extensions on HP NonStop. */
#ifndef _TANDEM_SOURCE
# undef _TANDEM_SOURCE
#endif
/* Enable general extensions on Solaris. */
#ifndef __EXTENSIONS__
# undef __EXTENSIONS__
#endif
/* Version number of package */
#undef VERSION
/* Define to 1 if on MINIX. */
#undef _MINIX
/* Define to 2 if the system does not provide POSIX.1 features except with
this defined. */
#undef _POSIX_1_SOURCE
/* Define to 1 if you need to in order for `stat' and other things to work. */
#undef _POSIX_SOURCE

19627
libgcobol/configure vendored Executable file
View file

File diff suppressed because it is too large Load diff

268
libgcobol/configure.ac Normal file
View file

@ -0,0 +1,268 @@
# Configure script for libgcobol.
# Adapted by James K. Lowden from configure script for libalg68.
# This file is part of GCC.
# GCC is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
# GCC is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# Configure looks for the existence of this file to auto-config each language.
# We define several parameters used by configure:
# Process this file with autoreconf to produce a configure script.
AC_INIT(package-unused, version-unused,,libgcobol)
AC_CONFIG_SRCDIR(Makefile.am)
AC_CONFIG_HEADER(config.h)
AM_ENABLE_MULTILIB(, ..)
# This works around the fact that libtool configuration may change LD
# for this particular configuration, but some shells, instead of
# keeping the changes in LD private, export them just because LD is
# exported.
ORIGINAL_LD_FOR_MULTILIBS=$LD
####. ${srcdir}/configure.tgt
GCC_NO_EXECUTABLES
AC_USE_SYSTEM_EXTENSIONS
# Do not delete or change the following two lines. For why, see
# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html
AC_CANONICAL_SYSTEM
target_alias=${target_alias-$host_alias}
AC_SUBST(target_alias)
AM_INIT_AUTOMAKE # ([1.15.1 no-define foreign no-dist -Wall -Wno-portability])
AH_TEMPLATE(PACKAGE, [Name of package])
AH_TEMPLATE(VERSION, [Version number of package])
AC_ARG_WITH(cross-host,
[ --with-cross-host=HOST Configuring with a cross compiler])
# Checks for header files.
AC_CHECK_HEADERS(malloc.h)
AC_CANONICAL_HOST
ACX_NONCANONICAL_HOST
ACX_NONCANONICAL_TARGET
GCC_TOPLEV_SUBDIRS
# -----------------
# __int128 support
# -----------------
AC_CACHE_CHECK([whether __int128 is supported], [libgcobol_cv_have_int128],
[GCC_TRY_COMPILE_OR_LINK([
__int128 foo (__int128 )
{
__int128 aaa;
return (__int128) aaa;
}
__int128 bar (__int128 )
{
__int128 aaa;
return (__int128) aaa;
}
],[
foo (1);
bar (1);
],[
libgcobol_cv_have_int128=yes
],[
libgcobol_cv_have_int128=no
])])
# The following conditional is useful when this creates a Makefile.am file that
# is subsequently processed into a Makefile.in file. At the present time,
# however the libgcobol build uses a hardcoded Makefile.in file.
AM_CONDITIONAL(BUILD_LIBGCOBOL, [test "x$libgcobol_cv_have_int128" = xyes])
GCC_WITH_TOOLEXECLIBDIR
AC_MSG_CHECKING([for --enable-version-specific-runtime-libs])
AC_ARG_ENABLE(version-specific-runtime-libs,
[ --enable-version-specific-runtime-libs Specify that runtime libraries should be installed in a compiler-specific directory ],
[case "$enableval" in
yes) version_specific_libs=yes ;;
no) version_specific_libs=no ;;
*) AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);;
esac],
[version_specific_libs=no])
AC_MSG_RESULT($version_specific_libs)
AC_ARG_WITH(slibdir,
[ --with-slibdir=DIR shared libraries in DIR [LIBDIR]],
slibdir="$with_slibdir",
if test "${version_specific_libs}" = yes; then
slibdir='$(libsubdir)'
elif test -n "$with_cross_host" && test x"$with_cross_host" != x"no"; then
slibdir='$(exec_prefix)/$(host_noncanonical)/lib'
else
slibdir='$(libdir)'
fi)
AC_SUBST(slibdir)
# Command-line options.
# Very limited version of AC_MAINTAINER_MODE.
AC_ARG_ENABLE([maintainer-mode],
[AC_HELP_STRING([--enable-maintainer-mode],
[enable make rules and dependencies not useful (and
sometimes confusing) to the casual installer])],
[case ${enable_maintainer_mode} in
yes) MAINT='' ;;
no) MAINT='#' ;;
*) AC_MSG_ERROR([--enable-maintainer-mode must be yes or no]) ;;
esac
maintainer_mode=${enableval}],
[MAINT='#'])
AC_SUBST([MAINT])dnl
toolexecdir=no
toolexeclibdir=no
# Calculate toolexeclibdir
# Also toolexecdir, though it's only used in toolexeclibdir
case ${version_specific_libs} in
yes)
# Need the gcc compiler version to know where to install libraries
# and header files if --enable-version-specific-runtime-libs option
# is selected.
toolexecdir='$(libdir)/gcc/$(target_noncanonical)'
toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)'
;;
no)
if test -n "$with_cross_host" &&
test x"$with_cross_host" != x"no"; then
# Install a library built with a cross compiler in tooldir, not libdir.
toolexecdir='$(exec_prefix)/$(target_noncanonical)'
toolexeclibdir='$(toolexecdir)/lib'
else
toolexecdir='$(libdir)/gcc-lib/$(target_noncanonical)'
toolexeclibdir='$(libdir)'
fi
multi_os_directory=`$CC -print-multi-os-directory`
case $multi_os_directory in
.) ;; # Avoid trailing /.
*) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;;
esac
;;
esac
AC_SUBST(toolexecdir)
AC_SUBST(toolexeclibdir)
AH_TEMPLATE(PACKAGE, [Name of package])
AH_TEMPLATE(VERSION, [Version number of package])
AM_MAINTAINER_MODE
# Check the compiler.
# The same as in boehm-gc and libstdc++. Have to borrow it from there.
# We must force CC to /not/ be precious variables; otherwise
# the wrong, non-multilib-adjusted value will be used in multilibs.
# As a side effect, we have to subst CFLAGS ourselves.
m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS])
m4_define([_AC_ARG_VAR_PRECIOUS],[])
AC_PROG_CC
AC_PROG_CXX
AM_PROG_AS
m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS])
AC_SUBST(CFLAGS)
# In order to override CFLAGS_FOR_TARGET, all of our special flags go
# in XCFLAGS. But we need them in CFLAGS during configury. So put them
# in both places for now and restore CFLAGS at the end of config.
save_CFLAGS="$CFLAGS"
# Find other programs we need.
AC_CHECK_TOOL(AR, ar)
AC_CHECK_TOOL(NM, nm)
AC_CHECK_TOOL(RANLIB, ranlib, ranlib-not-found-in-path-error)
AC_PROG_MAKE_SET
AC_PROG_INSTALL
AM_PROG_LIBTOOL
LT_INIT
AC_LIBTOOL_DLOPEN
AM_CONDITIONAL([ENABLE_DARWIN_AT_RPATH], [test x$enable_darwin_at_rpath = xyes])
AC_SUBST(enable_shared)
AC_SUBST(enable_static)
if test "${multilib}" = "yes"; then
multilib_arg="--enable-multilib"
else
multilib_arg=
fi
AC_LANG_C
# Check the compiler.
# The same as in boehm-gc and libstdc++. Have to borrow it from there.
# We must force CC to /not/ be precious variables; otherwise
# the wrong, non-multilib-adjusted value will be used in multilibs.
# As a side effect, we have to subst CFLAGS ourselves.
m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS])
m4_define([_AC_ARG_VAR_PRECIOUS],[])
AC_PROG_CC
m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS])
AC_SUBST(CFLAGS)
CC_FOR_BUILD=${CC_FOR_BUILD:-gcc}
AC_SUBST(CC_FOR_BUILD)
AC_SEARCH_LIBS([malloc], [c])
AC_SEARCH_LIBS([cosf], [m])
AC_SEARCH_LIBS([clock_gettime], [rt])
# Add dependencies for libgcobol.spec file
SPEC_LIBGCOBOL_DEPS="$LIBS"
AC_SUBST(SPEC_LIBGCOBOL_DEPS)
# libgcobol soname version
LIBGCOBOL_VERSION=1:0:0
AC_SUBST(LIBGCOBOL_VERSION)
## added
VERSION_SUFFIX=$(echo $LIBGCOBOL_VERSION | tr ':' '.' )
AC_SUBST(VERSION_SUFFIX)
## end added
# Determine what GCC version number to use in filesystem paths.
GCC_BASE_VER
extra_darwin_ldflags_libgcobol=
case $host in
*-*-darwin*)
extra_darwin_ldflags_libgcobol=-Wl,-U,___cobol_main ;;
*) ;;
esac
AC_SUBST(extra_darwin_ldflags_libgcobol)
AC_CONFIG_SRCDIR([Makefile.am])
AC_CONFIG_FILES([Makefile])
####AC_CONFIG_FILES(libgcobol.spec)
AC_MSG_NOTICE([libgcobol has been configured.])
AC_OUTPUT

41
libgcobol/configure.tgt Normal file
View file

@ -0,0 +1,41 @@
# -*- shell-script -*-
# Copyright (C) 2025 Free Software Foundation, Inc.
#
# GCC is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# GCC is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GCC; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
# This is the target specific configuration file. This is invoked by the
# autoconf generated configure script. Putting it in a separate shell file
# lets us skip running autoconf when modifying target specific information.
# Enable the libgcobol build only on systems where it is known to work.
# More targets shall be added after testing.
# For testing, you can override this with --enable-libgcobol. (See configure.ac)
LIBGCOBOL_SUPPORTED=no
case "${target}" in
aarch64*-*-linux*)
LIBGCOBOL_SUPPORTED=yes
;;
powerpc64le-*-linux*)
LIBGCOBOL_SUPPORTED=yes
;;
x86_64-*-linux*x32)
LIBGCOBOL_SUPPORTED=no
;;
x86_64-*-linux*)
LIBGCOBOL_SUPPORTED=yes
;;
esac

423
libgcobol/constants.cc Normal file
View file

@ -0,0 +1,423 @@
/*
* 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.
*/
#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <math.h>
#include <fenv.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <unistd.h>
#include <algorithm>
#include <unordered_map>
#include "ec.h"
#include "io.h"
#include "common-defs.h"
#include "gcobolio.h"
#include "libgcobol.h"
#include "gfileio.h"
#include "charmaps.h"
#include <sys/mman.h>
#include <sys/stat.h>
#include <sys/types.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;
// We have a number of integer constants. We need two macros, one for 1-digit
// names and a second for 2-digit names in order to match our mangling
// convention for variable names that start with a numeric:
// 4 becomes _1_4
// _ indicates this is a mangled name
// 1 means it is one character long
// _ terminates the 1
// 4 is the one-character name
#define INTEGER_CONSTANT1(a) \
unsigned char __gg__data_##a[1] = {(a)}; \
struct cblc_field_t __gg___1_##a = { \
.data = __gg__data_##a , \
.capacity = 1 , \
.allocated = 1 , \
.offset = 0 , \
.name = #a , \
.picture = "" , \
.initial = #a , \
.parent = NULL, \
.occurs_lower = 0 , \
.occurs_upper = 0 , \
.attr = 0x80 , \
.type = FldLiteralN , \
.level = 0 , \
.digits = 0 , \
.rdigits = 0 , \
.dummy = 0 , \
};
#define INTEGER_CONSTANT2(a) \
unsigned char __gg__data_##a[1] = {(a)}; \
struct cblc_field_t __gg___2_##a = { \
.data = __gg__data_##a , \
.capacity = 1 , \
.allocate = 1 , \
.offset = 0 , \
.name = #a , \
.picture = "" , \
.initial = #a , \
.parent = NULL, \
.occurs_lower = 0 , \
.occurs_upper = 0 , \
.attr = 0x80 , \
.type = FldLiteralN , \
.level = 0 , \
.digits = 0 , \
.rdigits = 0 , \
.dummy = 0 , \
};
unsigned char __gg__data_space[1] = {' '};
struct cblc_field_t __gg__space = {
.data = __gg__data_space ,
.capacity = sizeof(__gg__data_space) ,
.allocated = sizeof(__gg__data_space) ,
.offset = 0 ,
.name = "SPACE" ,
.picture = "" ,
.initial = (char *)space_value_e ,
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
.attr = 0x284 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
struct cblc_field_t __gg__spaces = {
.data = __gg__data_space ,
.capacity = sizeof(__gg__data_space) ,
.allocated = sizeof(__gg__data_space) ,
.offset = 0 ,
.name = "SPACES" ,
.picture = "" ,
.initial = (char *)space_value_e ,
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
.attr = 0x284 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_low_values[1] = {'\0'};
struct cblc_field_t __gg__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 = 0x281 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_zeros[1] = {'0'};
struct cblc_field_t __gg__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 = 0x83 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_high_values[1] = {0xFF};
struct cblc_field_t __gg__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 = 0x286 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_quotes[1] = {0xFF};
struct cblc_field_t __gg__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 = 0x285 ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_nulls[8] = {0,0,0,0,0,0,0,0};
struct cblc_field_t __gg__nulls = {
.data = __gg__data_nulls ,
.capacity = 8 ,
.allocated = 8 ,
.offset = 0 ,
.name = "NULLS" ,
.picture = "" ,
.initial = "" ,
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
.attr = 0x280 ,
.type = FldPointer ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data__file_status[2] = {0,0};
struct cblc_field_t __gg___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 = 0x0 ,
.type = FldNumericDisplay ,
.level = 0 ,
.digits = 2 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_linage_counter[2] = {0,0};
struct cblc_field_t __gg___14_linage_counter6 = {
.data = __gg__data_linage_counter ,
.capacity = 2 ,
.allocated = 2 ,
.offset = 0 ,
.name = "LINAGE-COUNTER" ,
.picture = "" ,
.initial = "" ,
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
.attr = 0x0 ,
.type = FldNumericBin5 ,
.level = 0 ,
.digits = 4 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_upsi_0[2] = {0,0};
struct cblc_field_t __gg___6_upsi_04 = {
.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 = 0x0 ,
.type = FldNumericBin5 ,
.level = 0 ,
.digits = 4 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg__data_return_code[2] = {0,0};
struct cblc_field_t __gg___11_return_code6 = {
.data = __gg__data_return_code ,
.capacity = 2 ,
.allocated = 2 ,
.offset = 0 ,
.name = "RETURN-CODE" ,
.picture = "" ,
.initial = "" ,
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
.attr = 0x0 ,
.type = FldNumericBin5 ,
.level = 0 ,
.digits = 4 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg___data_dev_stdin[] = "/dev/stdin";
struct cblc_field_t __gg___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 = 0x0 ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg___data_dev_stdout[] = "/dev/stdout";
struct cblc_field_t __gg___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 = 0x0 ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg___data_dev_stderr[] = "/dev/stderr";
struct cblc_field_t __gg___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 = 0x0 ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
unsigned char __gg___data_dev_null[] = "/dev/null";
struct cblc_field_t __gg___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 = 0x0 ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
.rdigits = 0 ,
.dummy = 0 ,
};
#pragma GCC diagnostic pop

213
libgcobol/ec.h Normal file
View file

@ -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

256
libgcobol/exceptl.h Normal file
View file

@ -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

114
libgcobol/gcobolio.h Normal file
View file

@ -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

4660
libgcobol/gfileio.cc Normal file
View file

File diff suppressed because it is too large Load diff

57
libgcobol/gfileio.h Normal file
View file

@ -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

2174
libgcobol/gmath.cc Normal file
View file

File diff suppressed because it is too large Load diff

38
libgcobol/gmath.h Normal file
View file

@ -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

5452
libgcobol/intrinsic.cc Normal file
View file

File diff suppressed because it is too large Load diff

95
libgcobol/io.cc Normal file
View file

@ -0,0 +1,95 @@
/*
* 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.
*/
#include "io.h"
#include "stdio.h"
#include "stdlib.h"
#include <errno.h>
#include <stdbool.h>
#include <stdint.h>
/*
* The Cobol runtime support is responsible to set the file status
* word appropriately to the application's expectations. This function
* sets the defined file status register for the file to value of the
* status parameter, except for FhErrno. For FhErrno, it sets the
* file status register to a value derived from the current value of
* errno. If the errno value is not accounted for, the high bit is
* set to 1, and the rest to errno.
*/
extern "C"
file_status_t
__gg__file_status_word( enum file_status_t status,
int error_number) {
file_status_t file_status_register;
if( status != FsErrno ) {
return status;
}
switch( error_number ) {
case 0: file_status_register = FsSuccess; break;
case EACCES: file_status_register = FsNoAccess; break;
case EDQUOT: file_status_register = FsBoundary; break;
case EEXIST: file_status_register = FsNoAccess; break;
case EFAULT: file_status_register = FsNoFile; break;
case EFBIG: file_status_register = FsBoundary; break;
case EINTR: file_status_register = FsOsError; break;
case EINVAL: file_status_register = FsWrongType; break;
case EISDIR: file_status_register = FsWrongType; break;
case ELOOP: file_status_register = FsOsError; break;
case EMFILE: file_status_register = FsOsError; break;
case ENAMETOOLONG:
file_status_register = FsWrongType; break;
case ENFILE: file_status_register = FsOsError; break;
case ENODEV: file_status_register = FsNoFile; break;
case ENOENT: file_status_register = FsNoFile; break;
case ENOMEM: file_status_register = FsOsError; break;
case ENOSPC: file_status_register = FsBoundary; break;
case ENOTDIR: file_status_register = FsNoFile; break;
case ENXIO: file_status_register = FsNoFile; break;
case EOPNOTSUPP:
file_status_register = FsOsError; break;
case EOVERFLOW: file_status_register = FsBoundary; break;
case EPERM: file_status_register = FsNoAccess; break;
case EROFS: file_status_register = FsNoAccess; break;
case ETXTBSY: file_status_register= FsWrongType; break;
case EWOULDBLOCK:
file_status_register = FsOsError; break;
default:
perror("What is this? ");
fprintf(stderr, "__gg__file_status_word got an error_number "
"%d, which it doesn't know how to handle\n", error_number);
abort();
break;
}
return file_status_register;
}

137
libgcobol/io.h Normal file
View file

@ -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

12649
libgcobol/libgcobol.cc Normal file
View file

File diff suppressed because it is too large Load diff

257
libgcobol/libgcobol.h Normal file
View file

@ -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

1721
libgcobol/valconv.cc Normal file
View file

File diff suppressed because it is too large Load diff

80
libgcobol/valconv.h Normal file
View file

@ -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