version 0.73.0

This commit is contained in:
2023-07-14 12:15:30 -03:00
parent 110d8a0419
commit 945dd1a809
1466 changed files with 374820 additions and 0 deletions
+148
View File
@@ -0,0 +1,148 @@
# Generated automatically from Makefile.in by configure.
#
# Makefile.in for the Tiny COBOL compiler runtime library
#
prefix=/usr/local
exec_prefix=${prefix}
#
# Debug flags are set in htconfig.h
# -DPICTURE_TESTING -DDEBUG_RTS
#
CCX=gcc
ASM=as
INCLUDES=-I/usr/include -I/usr/local/include -I../lib -I..
#CCXFLAGS=${INCLUDES} -g -Wall
#CCXFLAGS1=${INCLUDES} -g -Wall
CCXFLAGS=${INCLUDES} -Wall
CCXFLAGS1=${INCLUDES} -Wall
ACXFLAGS=-D -as
WRES=windres
WRESFLAGS=-O coff
RANLIB=ranlib
AR=ar
#lib_dir=${prefix}/lib
lib_dir=C:/TinyCOBOL
#INSTRC=${prefix}/share/htcobol
INSTRC=${lib_dir}
RCFILE=htrtconf
#INSTALL=/usr/bin/install -c
INSTALL=install.exe
#INSTALL_DATA=${INSTALL} -m 644
INSTALL_DATA=${INSTALL}
MV = mv -f
RM = rm -f
LNK = ln -sf
MKDIR = mkdir -p
MAKEDEPEND=@MAKEDEPEND@
#
#LIBS=-L/usr/local/lib -lm -ldb -lpdcurses
LIBS=-L/usr/local/lib -L/c/mingw/lib -lm -ldb -lpdcurses
#
# Default install directory is set in htconfig.h
#
lib_version=0.73.0
lib_name1=htcobol
STATIC_LIB1=lib${lib_name1}.a
SHARED_LIB1=${lib_name1}.dll
SHARED_LIB1A=${lib_name1}.dll.a
#SHARED_LIB1=lib${lib_name2}.dll
SRC1 = mcmath.c cobmove.c general.c fileio.c flckclient.c \
pictures.c basicio.c strings.c screenio.c \
cobmove_9_.c cobmove_b_.c cobmove_c_.c cobmove_e_.c \
cobmove_f_.c cobmove_x_.c rterrors.c scr_curses.c intrinsic.c \
dyncall.c config.c
# dycall.c config.c
# dyncall.c ltdl.c config.c
# dyncall.c
SRC2 = htcobolrt.rc
OBJS1 = $(SRC1:.c=.o)
OBJS2 = $(SRC2:.rc=.o)
OBJD1 = $(SRC1:.c=.lo)
OBJD2 = $(SRC2:.rc=.lo)
#
# Rules for compiling .c .s sources
#
.SUFFIX: .c .o .lo
.c.o:
$(CCX) $(CCXFLAGS) -c $<
%.lo: %.c
$(CCX) $(CCXFLAGS1) -c $< -o $@
#
# Notes on building and using the shared htcobol library.
# - The linker will try to use the shared libraries by default.
# If not available it will try to use the static libraries.
# - When linking with a shared htcobol library, all other libraries must be
# named, whether they are used in the cobol program or not.
# (i.e. -lncurses -ldb)
# - To run a cobol program built with a shared htcobol library, and the
# htcobol library is not installed in one of the standard locations, use
# the $LD_LIBRARY_PATH environmental variable to add this path.
# (i.e. export LD_LIBRARY_PATH=this path:$LD_LIBRARY_PATH )
# - For testing purposes, it is recommended that only a static htcobol library
# be used, since gdb will not work properly with shared libraries.
#
all: static-libs
devel: static-libs shared-libs
static-libs: ${STATIC_LIB1}
shared-libs: ${SHARED_LIB1}
# Rules for building the DLL resources
#
htcobolrt.o: htcobolrt.rc
$(WRES) $(WRESFLAGS) $< $@
# Rules for building the static library
#
${STATIC_LIB1}: ${OBJS1}
${AR} cr ${STATIC_LIB1} ${OBJS1}
${RANLIB} ${STATIC_LIB1}
# Rules for building the shared library
#
${SHARED_LIB1}: ${OBJS1} $(OBJS2)
${CCX} -shared -Wl,--out-implib,${lib_name1}.dll.a,--output-def,${lib_name1}.def -o ${SHARED_LIB1} $(OBJS1) $(OBJS2) ${LIBS}
clean:
@${RM} ${OBJS} ${STATIC_LIB1} \
${SHARED_LIB1} ${SHARED_LIB1}.a \
core *.bak *.o *.lo
install: install-dir install-static install-shared install-rts-config
install-rts-config:
# $(MKDIR) $(INSTRC)
${INSTALL_DATA} $(RCFILE) $(INSTRC)/$(RCFILE)
install-static: ${STATIC_LIB1}
# ${INSTALL_DATA} ${STATIC_LIB1} ${lib_dir}/${STATIC_LIB1}
install-shared: ${SHARED_LIB1}
${INSTALL_DATA} ${SHARED_LIB1} ${lib_dir}/${SHARED_LIB1}
# ${INSTALL_DATA} ${SHARED_LIB1A} ${lib_dir}/${SHARED_LIB1A}
install-dir:
$(MKDIR) $(INSTRC)
+149
View File
@@ -0,0 +1,149 @@
#
# Makefile.in for the Tiny COBOL compiler runtime library
#
prefix=@prefix@
exec_prefix=@exec_prefix@
#
# Debug flags are set in htconfig.h
# -DPICTURE_TESTING -DDEBUG_RTS
#
CCX=@CC@
ASM=@AS@
INCLUDES=@INCLUDES@ -I/usr/include/mysql
CCXFLAGS=${INCLUDES} @CCXFLAGS@ -Wall -ggdb
CCXFLAGS1=${INCLUDES} @CCXFLAGS@ -Wall -fPIC -ggdb
ACXFLAGS=@ACXFLAGS@
RANLIB=@RANLIB@
AR=@AR@
INSTRC=@cobdir_default@
RCFILE=@rtoptfile_default@
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
MV = mv -f
RM = rm -f
MKDIR = mkdir -p
LNK = ln -sf
GREP = grep -v
MAKEDEPEND=@MAKEDEPEND@
LIBS=-ldl @htg_ld_args_m@ @htg_ld_args_db@ -lncurses -L/usr/lib/mysql -L/usr/lib
#
# Default install directory is set in htconfig.h
#
lib_dir=@exec_prefix@/lib
lib_version=@tcob_version@
lib_name1=htcobol
#lib_name2=htcobol2
STATIC_LIB1=lib${lib_name1}.a
#STATIC_LIB2=lib${lib_name2}.a
SHARED_LIB1=lib${lib_name1}.so.${lib_version}
#SHARED_LIB2=lib${lib_name2}.so.${lib_version}
SRC1 = mcmath.c general.c fileio.c \
pictures.c basicio.c strings.c screenio.c \
cobmove.c cobmove_f_.c cobmove_x_.c cobmove_e_.c \
cobmove_9_.c cobmove_b_.c cobmove_c_.c \
rterrors.c scr_curses.c intrinsic.c \
dyncall.c flckclient.c config.c screen.c
#SRC2 = dyncall.c
#SRC2 = dyncall_ltdl.c ltdl.c
OBJS1 = $(SRC1:.c=.o)
#OBJS2 = $(SRC2:.c=.o)
OBJD1 = $(SRC1:.c=.lo)
#OBJD2 = $(SRC2:.c=.lo)
#
# Rules for compiling .c .s sources
#
.SUFFIX: .c .o .lo
.c.o:
$(CCX) $(CCXFLAGS) -c $<
%.lo: %.c
$(CCX) $(CCXFLAGS1) -c $< -o $@
#
# Notes on building and using the shared htcobol library.
# - The linker will try to use the shared libraries by default.
# If not available it will try to use the static libraries.
# - When linking with a shared htcobol library, all other libraries must be
# named, whether they are used in the cobol program or not.
# (i.e. -lncurses -ldb)
# - To run a cobol program built with a shared htcobol library, and the
# htcobol library is not installed in one of the standard locations, use
# the $LD_LIBRARY_PATH environmental variable to add this path.
# (i.e. export LD_LIBRARY_PATH=this path:$LD_LIBRARY_PATH )
# - For testing purposes, it is recommended that only a static htcobol library
# be used, since gdb will not work properly with shared libraries.
#
all: static-libs shared-libs
#all: shared-libs
#all: static-libs
devel: static-libs
static-libs: ${STATIC_LIB1} # ${STATIC_LIB2}
shared-libs: ${SHARED_LIB1} # ${SHARED_LIB2}
# Rules for building the static library
#
${STATIC_LIB1}: ${OBJS1}
${AR} cr ${STATIC_LIB1} ${OBJS1}
${RANLIB} ${STATIC_LIB1}
${STATIC_LIB2}: ${OBJS2}
${AR} cr ${STATIC_LIB2} ${OBJS2}
${RANLIB} ${STATIC_LIB2}
# Rules for building the shared library
#
${SHARED_LIB1}: ${OBJD1}
${CCX} -shared -Wl,-soname,lib${lib_name1}.so.0 -o ${SHARED_LIB1} $(OBJD1) ${LIBS}
${LNK} $(SHARED_LIB1) lib$(lib_name1).so.0
${LNK} $(SHARED_LIB1) lib$(lib_name1).so
${SHARED_LIB2}: ${OBJD2}
${CCX} -shared -Wl,-soname,lib${lib_name2}.so.0 -o ${SHARED_LIB2} $(OBJD2) ${LIBS}
${LNK} $(SHARED_LIB2) lib$(lib_name2).so.0
${LNK} $(SHARED_LIB2) lib$(lib_name2).so
clean:
@${RM} ${OBJS} ${OBJD} ${STATIC_LIB1} ${STATIC_LIB2} \
lib$(lib_name1).so* lib$(lib_name2).so* \
core *.bak *.txt *.o *.lo
install: install-static install-shared
install-rts-config:
$(MKDIR) $(INSTRC)
${INSTALL_DATA} $(RCFILE) $(INSTRC)/$(RCFILE)
#install-static: ${STATIC_LIB1} # ${STATIC_LIB2}
install-static: ${STATIC_LIB1} install-rts-config
${INSTALL_DATA} ${STATIC_LIB1} ${lib_dir}/${STATIC_LIB1}
# ${INSTALL_DATA} ${STATIC_LIB2} ${lib_dir}/${STATIC_LIB2}
#install-shared: ${SHARED_LIB1} # ${SHARED_LIB2}
install-shared: ${SHARED_LIB1} install-rts-config
${INSTALL_DATA} ${SHARED_LIB1} ${lib_dir}/${SHARED_LIB1}
# ${INSTALL_DATA} ${SHARED_LIB2} ${lib_dir}/${SHARED_LIB2}
${LNK} ${lib_dir}/$(SHARED_LIB1) ${lib_dir}/lib$(lib_name1).so
# ${LNK} ${lib_dir}/$(SHARED_LIB2) ${lib_dir}/lib$(lib_name2).so
${LNK} ${lib_dir}/$(SHARED_LIB1) ${lib_dir}/lib$(lib_name1).so.0
# ${LNK} ${lib_dir}/$(SHARED_LIB2) ${lib_dir}/lib$(lib_name2).so.0
+148
View File
@@ -0,0 +1,148 @@
# Generated automatically from Makefile.in by configure.
#
# Makefile.in for the Tiny COBOL compiler runtime library
#
prefix=/usr/local
exec_prefix=${prefix}
#
# Debug flags are set in htconfig.h
# -DPICTURE_TESTING -DDEBUG_RTS
#
CCX=gcc
ASM=as
INCLUDES=-I/usr/include -I/usr/local/include -I../lib -I..
#CCXFLAGS=${INCLUDES} -g -Wall
#CCXFLAGS1=${INCLUDES} -g -Wall
CCXFLAGS=${INCLUDES} -Wall
CCXFLAGS1=${INCLUDES} -Wall
ACXFLAGS=-D -as
WRES=windres
WRESFLAGS=-O coff
RANLIB=ranlib
AR=ar
#lib_dir=${prefix}/lib
lib_dir=@install_dir@
#INSTRC=${prefix}/share/htcobol
INSTRC=${lib_dir}
RCFILE=htrtconf
#INSTALL=/usr/bin/install -c
INSTALL=install.exe
#INSTALL_DATA=${INSTALL} -m 644
INSTALL_DATA=${INSTALL}
MV = mv -f
RM = rm -f
LNK = ln -sf
MKDIR = mkdir -p
MAKEDEPEND=@MAKEDEPEND@
#
#LIBS=-L/usr/local/lib -lm -ldb -lpdcurses
LIBS=-L/usr/local/lib -L/c/mingw/lib -lm -ldb -lcurses
#
# Default install directory is set in htconfig.h
#
lib_version=@tcob_version@
lib_name1=htcobol
STATIC_LIB1=lib${lib_name1}.a
SHARED_LIB1=${lib_name1}.dll
SHARED_LIB1A=${lib_name1}.dll.a
#SHARED_LIB1=lib${lib_name2}.dll
SRC1 = mcmath.c cobmove.c general.c fileio.c flckclient.c \
pictures.c basicio.c strings.c screenio.c \
cobmove_9_.c cobmove_b_.c cobmove_c_.c cobmove_e_.c \
cobmove_f_.c cobmove_x_.c rterrors.c scr_curses.c intrinsic.c \
dyncall.c config.c
# dycall.c config.c
# dyncall.c ltdl.c config.c
# dyncall.c
SRC2 = htcobolrt.rc
OBJS1 = $(SRC1:.c=.o)
OBJS2 = $(SRC2:.rc=.o)
OBJD1 = $(SRC1:.c=.lo)
OBJD2 = $(SRC2:.rc=.lo)
#
# Rules for compiling .c .s sources
#
.SUFFIX: .c .o .lo
.c.o:
$(CCX) $(CCXFLAGS) -c $<
%.lo: %.c
$(CCX) $(CCXFLAGS1) -c $< -o $@
#
# Notes on building and using the shared htcobol library.
# - The linker will try to use the shared libraries by default.
# If not available it will try to use the static libraries.
# - When linking with a shared htcobol library, all other libraries must be
# named, whether they are used in the cobol program or not.
# (i.e. -lncurses -ldb)
# - To run a cobol program built with a shared htcobol library, and the
# htcobol library is not installed in one of the standard locations, use
# the $LD_LIBRARY_PATH environmental variable to add this path.
# (i.e. export LD_LIBRARY_PATH=this path:$LD_LIBRARY_PATH )
# - For testing purposes, it is recommended that only a static htcobol library
# be used, since gdb will not work properly with shared libraries.
#
all: static-libs
devel: static-libs shared-libs
static-libs: ${STATIC_LIB1}
shared-libs: ${SHARED_LIB1}
# Rules for building the DLL resources
#
htcobolrt.o: htcobolrt.rc
$(WRES) $(WRESFLAGS) $< $@
# Rules for building the static library
#
${STATIC_LIB1}: ${OBJS1}
${AR} cr ${STATIC_LIB1} ${OBJS1}
${RANLIB} ${STATIC_LIB1}
# Rules for building the shared library
#
${SHARED_LIB1}: ${OBJS1} $(OBJS2)
${CCX} -shared -Wl,--out-implib,${lib_name1}.dll.a,--output-def,${lib_name1}.def -o ${SHARED_LIB1} $(OBJS1) $(OBJS2) ${LIBS}
clean:
@${RM} ${OBJS} ${STATIC_LIB1} \
${SHARED_LIB1} ${SHARED_LIB1}.a \
core *.bak *.o *.lo
install: install-dir install-static install-shared install-rts-config
install-rts-config:
# $(MKDIR) $(INSTRC)
${INSTALL_DATA} $(RCFILE) $(INSTRC)/$(RCFILE)
install-static: ${STATIC_LIB1}
# ${INSTALL_DATA} ${STATIC_LIB1} ${lib_dir}/${STATIC_LIB1}
install-shared: ${SHARED_LIB1}
${INSTALL_DATA} ${SHARED_LIB1} ${lib_dir}/${SHARED_LIB1}
# ${INSTALL_DATA} ${SHARED_LIB1A} ${lib_dir}/${SHARED_LIB1A}
install-dir:
$(MKDIR) $(INSTRC)
+147
View File
@@ -0,0 +1,147 @@
#
# Makefile.in for the TinyCOBOL compiler runtime library (MinGW)
#
prefix=@prefix@
exec_prefix=${prefix}
MV=@MV@
RM=@RM@
MKDIR=@MKDIR@
#
# Debug flags are set in htconfig.h
# -DPICTURE_TESTING -DDEBUG_RTS
#
CCX=@CC@
ASM=@AS@
INCLUDES=@INCLUDES@
CCXFLAGS=${INCLUDES} -Wall
CCXFLAGS1=${INCLUDES} -Wall
ACXFLAGS=-D -as
MAKEDEPEND=@MAKEDEPEND@
WRES=@WINDRES@
WRESFLAGS=-O coff
RANLIB=@RANLIB@
AR=@AR@
INSTBIN=@cobbin_default@
INSTLIB=@coblib_default@
INSTRC=@cobdir_default@
RCFILE=@rtoptfile_default@
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
#
LIBS=@LIBS@ @htg_ld_args_db@ @htg_ld_args_curses@
#
lib_version=@tcob_version@
lib_name1=htcobol
STATIC_LIB1=lib${lib_name1}.a
DLL_LIB1=${lib_name1}.dll
DLL_IMLIB1=${lib_name1}.dll.a
DLL_DEF1=${lib_name1}.def
SRC1 = mcmath.c cobmove.c general.c fileio.c \
pictures.c basicio.c strings.c screenio.c \
cobmove_9_.c cobmove_b_.c cobmove_c_.c cobmove_e_.c \
cobmove_f_.c cobmove_x_.c rterrors.c scr_curses.c intrinsic.c \
dyncall.c config.c
# dyncall.c config.c fixnumeric.c imath.c
SRC2 = flckclient.c
SRC3 = htcobolrt.rc
OBJS1 = $(SRC1:.c=.o) @tc_use_lockserver_src_opt@
#OBJS1 = $(SRC1:.c=.o)
OBJS2 = $(SRC3:.rc=.o)
#
# Rules for compiling .c .s sources
#
.SUFFIX: .c .o
.c.o:
$(CCX) $(CCXFLAGS) -c $<
#
# Notes on building and using the htcobol DLL.
# - The linker will try to use the DLL by default.
# If not available it will try to use the static libraries.
# - When linking with the htcobol DLL, all other libraries (DLL's) must be
# named, whether or not they are used in the cobol program.
# (i.e. -lpdcurses -ldb)
# - To run a cobol program built with the htcobol DLL, and the
# htcobol DLL location must be included in the PATH or be located in the CWD.
# - For testing purposes, it is recommended that only a static htcobol library
# be used, since gdb will not work properly with DLL's.
#
#all: static-libs
all: static-libs @tc_shared_libs_opt@
#all: static-libs shared-libs
devel: static-libs shared-libs
static-libs: ${STATIC_LIB1}
shared-libs: ${DLL_LIB1}
# Rules for building the DLL resources
#
htcobolrt.o: htcobolrt.rc
$(WRES) $(WRESFLAGS) $< $@
# Rules for building the static library
#
${STATIC_LIB1}: ${OBJS1}
${AR} cr ${STATIC_LIB1} ${OBJS1}
${RANLIB} ${STATIC_LIB1}
# Rules for building the shared library (DLL)
#
${DLL_LIB1}: ${OBJS1} $(OBJS2)
${CCX} -shared -Wl,--out-implib,${DLL_IMLIB1},--output-def,${DLL_DEF1} -o ${DLL_LIB1} $(OBJS1) $(OBJS2) ${LIBS}
# ${CCX} -shared -Wl,--out-implib,${lib_name1}.dll.a,--output-def,${lib_name1}.def -o ${DLL_LIB1} $(OBJS1) $(OBJS2) ${LIBS}
clean:
@${RM} ${OBJS} ${STATIC_LIB1} ${DLL_LIB1} ${DLL_DEF1} ${DLL_IMLIB1} \
core *.bak *.o
install: install-rts-config install-static-libs @tc_shared_libs_install_opt@
#install: install-rts-config install-static-libs install-shared-libs
install-rts-config: install-dir
# $(MKDIR) $(INSTRC)
${INSTALL_DATA} $(RCFILE) $(INSTRC)\$(RCFILE)
install-static-libs: ${STATIC_LIB1}
${INSTALL_DATA} ${STATIC_LIB1} ${INSTLIB}\${STATIC_LIB1}
install-shared-libs: ${DLL_LIB1}
${INSTALL_DATA} ${DLL_LIB1} ${INSTBIN}\${DLL_LIB1}
${INSTALL_DATA} ${DLL_IMLIB1} ${INSTLIB}\${DLL_IMLIB1}
install-dir:
$(MKDIR) $(INSTRC)
uninstall: uninstall-rts-config uninstall-static-libs uninstall-shared-libs
uninstall-rts-config:
$(RM) $(INSTRC)\$(RCFILE)
uninstall-static-libs:
$(RM) ${INSTLIB}\${STATIC_LIB1}
uninstall-shared-libs:
$(RM) ${INSTBIN}\${DLL_LIB1}
$(RM) ${INSTLIB}\${DLL_IMLIB1}
+149
View File
@@ -0,0 +1,149 @@
# Generated automatically from Makefile.in by configure.
#
# Makefile.in for the Tiny COBOL compiler runtime library
#
prefix=/usr/local
exec_prefix=${prefix}
#
# Debug flags are set in htconfig.h
# -DPICTURE_TESTING -DDEBUG_RTS
#
CCX=gcc
ASM=as
INCLUDES=-I/usr/include -I/usr/local/include -I../lib -I../
CCXFLAGS=${INCLUDES} -Wall
CCXFLAGS1=${INCLUDES} -Wall -fPIC
ACXFLAGS=-as
RANLIB=ranlib
AR=ar
INSTRC=${prefix}/share/htcobol
RCFILE=htrtconf
INSTALL=/usr/bin/install -c
INSTALL_DATA=${INSTALL} -m 644
MV = mv -f
RM = rm -f
MKDIR = mkdir -p
LNK = ln -sf
GREP = grep -v
MAKEDEPEND=@MAKEDEPEND@
LIBS=-ldl -lm -ldb -lncurses
#
# Default install directory is set in htconfig.h
#
lib_dir=${prefix}/lib
lib_version=0.62.11
lib_name1=htcobol
#lib_name2=htcobol2
STATIC_LIB1=lib${lib_name1}.a
#STATIC_LIB2=lib${lib_name2}.a
SHARED_LIB1=lib${lib_name1}.so.${lib_version}
#SHARED_LIB2=lib${lib_name2}.so.${lib_version}
SRC1 = mcmath.c general.c fileio.c \
pictures.c basicio.c strings.c screenio.c \
cobmove.c cobmove_f_.c cobmove_x_.c cobmove_e_.c \
cobmove_9_.c cobmove_b_.c cobmove_c_.c \
rterrors.c scr_curses.c intrinsic.c \
dyncall.c flckclient.c config.c
#SRC2 = dyncall.c
#SRC2 = dyncall_ltdl.c ltdl.c
OBJS1 = $(SRC1:.c=.o)
#OBJS2 = $(SRC2:.c=.o)
OBJD1 = $(SRC1:.c=.lo)
#OBJD2 = $(SRC2:.c=.lo)
#
# Rules for compiling .c .s sources
#
.SUFFIX: .c .o .lo
.c.o:
$(CCX) $(CCXFLAGS) -c $<
%.lo: %.c
$(CCX) $(CCXFLAGS1) -c $< -o $@
#
# Notes on building and using the shared htcobol library.
# - The linker will try to use the shared libraries by default.
# If not available it will try to use the static libraries.
# - When linking with a shared htcobol library, all other libraries must be
# named, whether they are used in the cobol program or not.
# (i.e. -lncurses -ldb)
# - To run a cobol program built with a shared htcobol library, and the
# htcobol library is not installed in one of the standard locations, use
# the $LD_LIBRARY_PATH environmental variable to add this path.
# (i.e. export LD_LIBRARY_PATH=this path:$LD_LIBRARY_PATH )
# - For testing purposes, it is recommended that only a static htcobol library
# be used, since gdb will not work properly with shared libraries.
#
#all: static-libs shared-libs
#all: shared-libs
all: static-libs
devel: static-libs
static-libs: ${STATIC_LIB1} # ${STATIC_LIB2}
shared-libs: ${SHARED_LIB1} # ${SHARED_LIB2}
# Rules for building the static library
#
${STATIC_LIB1}: ${OBJS1}
${AR} cr ${STATIC_LIB1} ${OBJS1}
${RANLIB} ${STATIC_LIB1}
${STATIC_LIB2}: ${OBJS2}
${AR} cr ${STATIC_LIB2} ${OBJS2}
${RANLIB} ${STATIC_LIB2}
# Rules for building the shared library
#
${SHARED_LIB1}: ${OBJD1}
${CCX} -shared -Wl,-soname,lib${lib_name1}.so.0 -o ${SHARED_LIB1} $(OBJD1) ${LIBS}
${LNK} $(SHARED_LIB1) lib$(lib_name1).so.0
${LNK} $(SHARED_LIB1) lib$(lib_name1).so
${SHARED_LIB2}: ${OBJD2}
${CCX} -shared -Wl,-soname,lib${lib_name2}.so.0 -o ${SHARED_LIB2} $(OBJD2) ${LIBS}
${LNK} $(SHARED_LIB2) lib$(lib_name2).so.0
${LNK} $(SHARED_LIB2) lib$(lib_name2).so
clean:
@${RM} ${OBJS} ${OBJD} ${STATIC_LIB1} ${STATIC_LIB2} \
lib$(lib_name1).so* lib$(lib_name2).so* \
core *.bak *.txt *.o *.lo
install: install-static
install-rts-config:
$(MKDIR) $(INSTRC)
${INSTALL_DATA} $(RCFILE) $(INSTRC)/$(RCFILE)
#install-static: ${STATIC_LIB1} # ${STATIC_LIB2}
install-static: ${STATIC_LIB1} install-rts-config
${INSTALL_DATA} ${STATIC_LIB1} ${lib_dir}/${STATIC_LIB1}
# ${INSTALL_DATA} ${STATIC_LIB2} ${lib_dir}/${STATIC_LIB2}
#install-shared: ${SHARED_LIB1} # ${SHARED_LIB2}
install-shared: ${SHARED_LIB1} install-rts-config
${INSTALL_DATA} ${SHARED_LIB1} ${lib_dir}/${SHARED_LIB1}
# ${INSTALL_DATA} ${SHARED_LIB2} ${lib_dir}/${SHARED_LIB2}
${LNK} ${lib_dir}/$(SHARED_LIB1) ${lib_dir}/lib$(lib_name1).so
# ${LNK} ${lib_dir}/$(SHARED_LIB2) ${lib_dir}/lib$(lib_name2).so
${LNK} ${lib_dir}/$(SHARED_LIB1) ${lib_dir}/lib$(lib_name1).so.0
# ${LNK} ${lib_dir}/$(SHARED_LIB2) ${lib_dir}/lib$(lib_name2).so.0
+546
View File
@@ -0,0 +1,546 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
//
// Cobol Compiler Run Time Library -- Accept/Display basic I/O functions
//
//
//#define DEBUG_BASIC_RTS 1
//#define HTCOB_LD_PATH "TCOB_LD_LIBRARY_PATH"
#include "htcoblib.h"
#include "rterrors.h"
#include "mwindows.h"
#ifndef __MINGW32__
#include <termios.h>
#endif
#ifdef WANT_DYNAMIC_LIBS
#include <glob.h>
#endif
#ifndef __MINGW32__
/* Needed for gettimeofday */
#include <sys/time.h>
#else
/* Needed for GetSystemTime */
#include <windows.h>
#endif
#ifdef USE_MF_COMPATABILITY
#define TCOB_COMMANDLINE_MFCOMP 1
#endif
extern int bDecimalComma;
//static struct fld_desc _generic_4binary = { 4,DTYPE_BININT,0,0,0,0,0,0,0,0,"S\19\x09" };
int tcob_var_argc = 0;
char **tcob_var_argv = NULL;
#ifdef WANT_READLINE
#ifdef WANT_ALL_DYNAMIC_LIBS
static char *readline_stub(char *s);
static char *(* _readline)(char *s) = readline_stub;
static void add_history_stub(char *s)
{
}
static void (* _add_history)(char *) = add_history_stub;
/*-------------------------------------------------------------------------*\
| |
| readline_stub |
| |
\*-------------------------------------------------------------------------*/
static char * readline_stub(char *s)
{
char *libname = "libreadline.so";
void *handle = dlopen(libname, RTLD_LAZY);
if (!handle)
{
tcob_rt_warning("readline_stub", TCERR_RESOLVE_STUB, libname, dlerror());
// fprintf(stderr,"*ERROR* loading %s: %s\n",libname,dlerror());
return NULL;
}
_readline = dlsym(handle, "readline");
_add_history = dlsym(handle, "add_history");
return _readline(s);
}
#else
#define _readline readline
#define _add_history add_history
#endif
#endif
/*-------------------------------------------------------------------------*\
| |
| tcob_newline |
| |
\*-------------------------------------------------------------------------*/
void tcob_newline(int dupon)
{
putc('\n', ((dupon == 1) ? stdout : stderr));
}
/*-------------------------------------------------------------------------*\
| |
| tcob_display |
| |
\*-------------------------------------------------------------------------*/
void tcob_display(struct fld_desc *f, char *s, int dupon)
{
char *buffer;
struct fld_desc ftmp;
unsigned int picLen;
int moved = 0;
unsigned int i, len;
if ((f->type == DTYPE_DISPLAY)
|| (f->type == DTYPE_PACKED)
|| (f->type == DTYPE_BININT)
|| (f->type == DTYPE_FLOAT))
{
char cDecimalChar = (bDecimalComma) ? ',' : '.';
len = tcob_picCompLength(f) + tc_abs((char) f->pscale);
#ifdef DEBUG_BASIC_RTS
fprintf(stderr, "debug display 1a: f->type=%c, f->len=%d, len=%d, f->decimals=%d\n",
f->type, f->len, len, f->decimals);
if (f->type != DTYPE_GROUP)
{
char c;
fprintf(stderr, "debug display 1b: pic=");
for (i = 0; (c = tcob_picElemVal(f->pic, i)); i++)
{
fprintf(stderr, "%c(%d)", c, tcob_picElemLen(f->pic, i));
}
fprintf(stderr, "\n");
}
#endif
memmove(&ftmp, f, sizeof (ftmp));
ftmp.type = DTYPE_EDITED;
picLen = tcob_picReqLen(4);
ftmp.pic = (char *) malloc(picLen);
tcob_picCreate(ftmp.pic, picLen, NULL);
if (tcob_picElemVal(f->pic, 0) == 'S')
tcob_picAppend(ftmp.pic, picLen, '-', 1, NULL);
if (ftmp.decimals <= 0)
{
tcob_picAppend(ftmp.pic, picLen, '9', len, NULL);
}
else
{
if (tcob_picElemVal(f->pic, 0) == 'P' || /* unsigned scaled */
tcob_picElemVal(f->pic, 1) == 'P')
{ /* signed scaled */
tcob_picAppend(ftmp.pic, picLen,
cDecimalChar, 1,
'9', ftmp.decimals, NULL);
}
else
{
tcob_picAppend(ftmp.pic, picLen,
'9', len - ftmp.decimals,
cDecimalChar, 1,
'9', ftmp.decimals, NULL);
}
}
if (ftmp.decimals > 0) /* account for the decimal point */
len++;
if (tcob_picElemVal(f->pic, 0) == 'S') /* account for the sign */
len++;
buffer = malloc(len);
ftmp.len = len;
tcob_move(f, s, &ftmp, buffer);
moved++;
#ifdef DEBUG_BASIC_RTS
fprintf(stderr, "debug display 2a: type=%c, len=%d, decimals=%d;\n",
ftmp.type, ftmp.len, ftmp.decimals);
if (ftmp.type != DTYPE_GROUP)
{
char c;
fprintf(stderr, "debug display 2b: pic=");
for (i = 0; (c = tcob_picElemVal(ftmp.pic, i)); i++)
fprintf(stderr, "%c(%d)", c, tcob_picElemLen(ftmp.pic, i));
fprintf(stderr, "\n");
}
#endif
free(ftmp.pic);
}
else
{
len = f->len;
buffer = s;
}
if (dupon == 1)
{
for (i = 0; i < len; i++)
putc(buffer[i], stdout);
}
else
{
for (i = 0; i < len; i++)
putc(buffer[i], stderr);
}
if (moved)
free(buffer);
}
/*-------------------------------------------------------------------------*\
| |
| tcob_display_erase |
| |
\*-------------------------------------------------------------------------*/
void tcob_display_erase(int dupon)
{
putc('\f', ((dupon == 1) ? stdout : stderr));
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_chron |
| Accepts a variable using the current local time/date. |
| |
\*-------------------------------------------------------------------------*/
/* DATE-TIME */
#define DATE 0
#define TIME 1
#define DAY 2
#define DAY_OF_WEEK 3
int tcob_accept_chron(struct fld_desc *f, char *buffer,
int date_fmt, int is_yyyy)
{
time_t tnow;
struct tm *timep;
unsigned int ctime;
unsigned int year;
unsigned int digits;
unsigned int hsec; /* hundredths of a second */
time(&tnow);
timep = localtime(&tnow);
year = (is_yyyy) ? (timep->tm_year) + 1900 : (timep->tm_year) % 100;
/* Determine hundredths of a second */
if (date_fmt == TIME)
{
#ifndef __MINGW32__
struct timeval tv;
gettimeofday(&tv, NULL);
hsec = tv.tv_usec / 10000;
#else
SYSTEMTIME st;
GetSystemTime(&st);
hsec = st.wMilliseconds / 10;
#endif
}
switch (date_fmt)
{
case TIME:
/* Accepts the current time in the form 'HHMMSScc'.
* HH is the hour (0-23), MM is the minute, SS is the second,
* cc is hundredths of a second.
*/
ctime = timep->tm_hour * 1000000 +
timep->tm_min * 10000 +
timep->tm_sec * 100 +
hsec;
digits = 8;
break;
case DATE:
/* Accepts the current date in the form 'YYMMDD'/'YYYYMMDD'.
* YY is the year, MM is the month (January=1), DD is the day.
*/
ctime = year * 10000 +
((timep->tm_mon) + 1) * 100 +
timep->tm_mday;
digits = (is_yyyy) ? 8 : 6;
break;
case DAY:
/* Accepts the current day of the year in the form 'YYDDD'/'YYYYDDD'.
* YY is the year, DDD is the day of the year.
*/
ctime = year * 1000 +
((timep->tm_yday) + 1);
digits = (is_yyyy) ? 7 : 5;
break;
case DAY_OF_WEEK:
/* Accepts the current day of the week into a single character.
* The reason for the calculation is that C's representation of
* Sunday is 0, while in COBOL it is 7. The rest of the week is
* the same in both languages (Monday=1 ... Saturday=6).
*/
ctime = (((timep->tm_wday) + 6) % 7) + 1;
digits = 1;
break;
default:
return 1;
}
// {
struct fld_desc tmpfld;
int piclen;
char edited[9]; /* length is max value of 'digits' plus one */
memset(&tmpfld, 0, sizeof (tmpfld));
tmpfld.len = digits;
tmpfld.type = DTYPE_DISPLAY;
piclen = tcob_picReqLen(1);
tmpfld.pic = tcob_picCreate(malloc(piclen), piclen, '9', digits);
sprintf(edited, "%0*d", digits, ctime);
tcob_move(&tmpfld, (char *) & edited, f, buffer);
free(tmpfld.pic);
// }
return 0;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_std |
| |
\*-------------------------------------------------------------------------*/
int tcob_accept_std(char *buffer, struct fld_desc *f, int flags)
{
#ifndef __MINGW32__
struct termios attr;
#endif
int r;
static char *szBuf = NULL;
unsigned int picLen;
struct fld_desc f1 = {0, DTYPE_ALPHANUMERIC, 0, 0, 0, 0, 0, 0, 0, 0, NULL};
#ifndef __MINGW32__
if ((flags & SCR_NOECHO) != 0)
{
// Get terminal attributes
if (tcgetattr(STDIN_FILENO, &attr) != 0)
return (-1);
// Turn off echo flag
attr.c_lflag &= ~(ECHO);
// Set terminal attributes
// Discard any typed but un-read characters
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &attr) != 0)
return (-1);
}
#endif
#ifdef WANT_READLINE
if (isatty(fileno(stdin)))
{
szBuf = _readline("");
}
else
{
fgets(szBuf, RLBUF_SIZE, stdin);
szBuf[strlen(szBuf) - 1] = 0;
}
#else
/* we alloc the line buffer only at the first time */
if (!szBuf)
szBuf = malloc(RLBUF_SIZE);
fgets(szBuf, RLBUF_SIZE, stdin);
szBuf[strlen(szBuf) - 1] = 0;
#endif
r = strlen(szBuf) ? 0 : -1; /* it's not really "on escape", but... */
f1.len = strlen(szBuf);
picLen = tcob_picReqLen(1);
f1.pic = (char *) malloc(picLen);
tcob_picCreate(f1.pic, picLen, 'X', f1.len, NULL);
#ifdef WANT_READLINE
if (f1.len)
_add_history(szBuf);
#endif
tcob_move(&f1, szBuf, f, buffer);
free(f1.pic);
#ifdef WANT_READLINE
/* free the buffer only if it came from a readline call */
if (isatty(fileno(stdin)))
free(szBuf);
#endif
#ifndef __MINGW32__
if ((flags & SCR_NOECHO) != 0)
{
// Turn on echo flag
attr.c_lflag |= ECHO;
// Set terminal attributes
if (tcsetattr(STDIN_FILENO, TCSANOW, &attr) != 0)
return (-1);
}
#endif
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_cmd_line |
| Accepts the set of command-line variables as a single string. |
| Return value - 0: Success |
| 1: Insufficient space in buffer |
| |
\*-------------------------------------------------------------------------*/
//int tcob_accept_cmd_line( int ac, char **av, struct fld_desc *f, char *buffer ) {
int tcob_accept_cmd_line(struct fld_desc *f, char *buffer)
{
int i, r = 0;
unsigned int len, totlen;
// test only
// fprintf(stderr, "debug: accept_cmd_line : f.type=%c, f.len=%d\n", f->type, f->len);
// Padd variable with blanks
memset(buffer, ' ', f->len);
// Process input parms
totlen = 0;
/* Command line index */
// test only
// fprintf(stderr, "debug: accept_cmd_line 1: tcob_var_argc=%d\n", ac);
#ifdef TCOB_COMMANDLINE_MFCOMP
for (i = 1; i < tcob_var_argc; i++)
{
#else
for (i = 0; i < tcob_var_argc; i++)
{
#endif
// test only
// fprintf(stderr, "debug: accept_cmd_line 2: av[%d]=%s;\n", i, tcob_var_argv[i]);
len = strlen(tcob_var_argv[i]);
// test only
// fprintf(stderr, "debug: accept_cmd_line 3: len=%d; j=%d;\n", len, j);
if (f->len >= totlen + len)
{
memmove(&buffer[totlen], tcob_var_argv[i], len);
totlen += (len + 1);
if ((i + 1 != tcob_var_argc) && (f->len < totlen))
{
i = tcob_var_argc;
r = 1;
}
}
else
{
// test only
// fprintf(stderr, "debug: accept_cmd_line 4: len=%d; j=%d;\n", len, j);
i = tcob_var_argc;
r = 1;
}
}
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_env_var |
| Accepts an environment variable. |
| Return value - 0: Success |
| 1: Environment variable was not found |
| 2: Insufficient space in buffer |
| |
\*-------------------------------------------------------------------------*/
int tcob_accept_env_var(struct fld_desc *f, char *buffer, char *ptevname)
{
int r = 0;
unsigned int len;
char *pt1;
// test only
// fprintf(stderr, "debug: accept_env_var 0: f.type=%c, f.len=%d, ptevname=%s;\n",
// f->type, f->len, ptevname);
// Padd variable with blanks
memset(buffer, ' ', f->len);
// Get environment variable, if it exists
if ((pt1 = getenv(ptevname)) == NULL)
r = 1;
else
{
len = strlen(pt1);
// test only
// fprintf(stderr, "debug: accept_env_var 1: f.len=%d, evlen=%d;\n",
// f->len, len);
if (f->len < len)
{
len = f->len;
r = 2;
}
memmove(buffer, pt1, len);
}
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_init |
| Initialize the command line variables. |
| Return value - 0: Success |
| |
\*-------------------------------------------------------------------------*/
int tcob_init(int ac, char **av)
{
int r = 0;
tcob_var_argc = ac;
tcob_var_argv = av;
return r;
}
/* end of basicio.c */
BIN
View File
Binary file not shown.
+407
View File
@@ -0,0 +1,407 @@
/*
* Copyright (C) 1999 - 2003, Rildo Pragana, Jim Noeth,
* Andrew Cameron, David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
/*
*
* COBOL Compiler Run Time Library -- Move Module
*
*/
#include "htcoblib.h"
/* #define DEBUG_RTS 0 */
/* #define DEBUG_MOVE_RTS 1 */
#define COBMV_9_ 0
#define COBMV_B_ 6
#define COBMV_C_ 12
#define COBMV_E_ 30
#define COBMV_F_ 18
#define COBMV_X_ 24
#define COBMV__9 0
#define COBMV__B 1
#define COBMV__C 2
#define COBMV__E 3
#define COBMV__F 4
#define COBMV__X 5
#define COBMV_MAX 255
#ifdef DEBUG_MOVE_RTS
char *StrMovRtn[] = {
"tcob_move_9_9", "tcob_move_9_b", "tcob_move_9_c",
"tcob_move_9_e", "tcob_move_9_f", "tcob_move_9_x",
"tcob_move_b_9", "tcob_move_b_b", "tcob_move_b_c",
"tcob_move_b_e", "tcob_move_b_f", "tcob_move_b_x",
"tcob_move_c_9", "tcob_move_c_b", "tcob_move_c_c",
"tcob_move_c_e", "tcob_move_c_f", "tcob_move_c_x",
"tcob_move_f_9", "tcob_move_f_b", "tcob_move_f_c",
"tcob_move_f_e", "tcob_move_f_f", "tcob_move_f_x",
"tcob_move_x_9", "tcob_move_x_b", "tcob_move_x_c",
"tcob_move_x_e", "tcob_move_x_f", "tcob_move_x_x",
"tcob_move_e_9", "tcob_move_e_b", "tcob_move_e_c",
"tcob_move_e_e", "tcob_move_e_f", "tcob_move_e_x"
};
#endif
/*--------------------------------------------------------------------------*\
| |
| void tcob_move( struct fld_desc *FieldDescSrc, |
| char *caSrcBuffer, |
| struct fld_desc *FieldDescDest, |
| char *caDestBuffer) |
| |
| Copy the contents of the field described by FieldDescSrc (data is |
| pointed to by caSrcBuffer) to the field described by FieldDescDest |
| (data will be stored in memory pointed to by caDescBuffer). |
| |
| This routine will appropriately convert data (or format it) as it |
| potentially moves from one data type to another. Truncation and |
| padding will also be done in this routine if field sizes differ. |
| Data types that this routine will handle are: |
| |
| Type Source Type Destination Type Defined As |
| '9' Numeric Display Numeric Display DTYPE_DISPLAY |
| 'D' Accept Display Accept Display DTYPE_ACCEP_DISPLAY |
| 'C' Numeric Packed Decimal Numeric Packed Decimal DTYPE_PACKED |
| 'A' Alpha Alpha DTYPE_ALPHA |
| 'X' AlphaNumeric AlphaNumeric DTYPE_ALPHANUMERIC |
| 'E' AlphaNumeric Numeric Edited DTYPE_EDITED |
| 'G' AlphaNumeric AlphaNumeric DTYPE_GROUP |
| 'B' Numeric Bin Int Numeric Bin Int DTYPE_BININT |
| 'U' Floating Point Floating Point DTYPE_FLOAT |
| |
| The main entry point is tcob_move, which looks at the data types of |
| the source and destinations, then calls a specific routine to handle |
| those specific data types. The routines are listed below, their name |
| is composed of tcob_move_?_?, where the first question mark is the |
| source data type, and the second question mark is the destination |
| data type. Certain data types are grouped together, such as ALPHA, |
| ALPHANUMERIC, GROUP and EDITED (when it is the source). This reduces |
| the number of routines needed to handle the various data types (the |
| list below is without the prefix tcob_move, i.e. _x_x means: |
| tcob_move_x_x). |
| |
| _x_x _9_x _b_x _f_x _c_x |
| _x_9 _9_9 _b_9 _f_9 _c_9 |
| _x_c _9_c _b_b _f_b _c_b |
| _x_e _9_b _b_c _f_c _c_c |
| _x_f _9_e _b_e _f_e _c_e |
| _x_b _9_f _b_f _f_f _c_f |
| |
\*-------------------------------------------------------------------------*/
void tcob_move( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 ) {
int i;
extern void (*pMovRtn[])(struct fld_desc *, char *,
struct fld_desc *, char *);
switch(pfldDesc1->type) {
case DTYPE_DISPLAY:
i = COBMV_9_;
break;
case DTYPE_ALPHA:
i = COBMV_X_;
break;
case DTYPE_BININT:
i = COBMV_B_;
break;
case DTYPE_PACKED:
i = COBMV_C_;
break;
case DTYPE_ACCEPT_DISPLAY:
i = COBMV_X_;
break;
case DTYPE_EDITED:
// i = COBMV_X_;
i = COBMV_E_;
break;
case DTYPE_GROUP:
i = COBMV_X_;
break;
case DTYPE_FLOAT:
i = COBMV_F_;
break;
case DTYPE_ALPHANUMERIC:
case DTYPE_ALPHANUMERICL:
i = COBMV_X_;
break;
default:
runtime_error(RTERR_INVALID_PIC, pfldDesc1, (void *)caData1);
return;
}
switch(pfldDesc2->type) {
case DTYPE_DISPLAY:
i += COBMV__9;
break;
case DTYPE_ALPHA:
i += COBMV__X;
break;
case DTYPE_BININT:
i += COBMV__B;
break;
case DTYPE_PACKED:
i += COBMV__C;
break;
case DTYPE_ACCEPT_DISPLAY:
i += COBMV__X;
break;
case DTYPE_EDITED:
i += COBMV__E;
break;
case DTYPE_GROUP:
i += COBMV__X;
break;
case DTYPE_FLOAT:
i += COBMV__F;
break;
case DTYPE_ALPHANUMERIC:
case DTYPE_ALPHANUMERICL:
i += COBMV__X;
break;
default:
runtime_error(RTERR_INVALID_PIC, pfldDesc2, (void *)caData2);
return;
}
/* Override for non-elementary moves */
if ((pfldDesc1->type == DTYPE_GROUP)
|| (pfldDesc2->type == DTYPE_GROUP)) {
i = COBMV_X_ + COBMV__X;
}
#ifdef DEBUG_MOVE_RTS
// fprintf(stderr, "Debug: tcob_move type = %d\n", i);
fprintf(stderr, "Debug: tcob_move type = %d, %s\n", i, StrMovRtn[i]);
#endif
pMovRtn[i](pfldDesc1, caData1, pfldDesc2, caData2);
}
/*------------------------------------------------------------------------*\
| |
| runtime_error |
| |
\*------------------------------------------------------------------------*/
void runtime_error(int iErrorNum, struct fld_desc *pField, void *pData) {
unsigned int i, j;
extern int _iRtErrorNbr[];
extern char *_szRtErrorDesc[];
for(i = 0; _iRtErrorNbr[i] != -1; ++i)
if(iErrorNum == _iRtErrorNbr[i])
break;
fprintf(stderr, "\n\nRun Time Error - ");
if(_iRtErrorNbr[i] != -1)
fprintf(stderr, "%s\n", _szRtErrorDesc[i]);
else
fprintf(stderr, "Unknown Error\n");
if(pField) {
fprintf(stderr, "Field Description: ");
fprintf(stderr, "len = %ld, type = %c, dec/pscale = %d/%d, all = %d, just_r = %d, signs = %d/%d\n",
pField->len, pField->type, (char)pField->decimals,
(char)pField->pscale, pField->all, pField->just_r,
pField->separate_sign, pField->leading_sign);
}
if(!pData) {
fprintf(stderr, "No data pointer provided\n");
return;
}
fprintf(stderr, "Data Dump, Address = %08lX", (unsigned long)pData);
for(j=0; j<tcob_fldLength(pField); j+=24) {
fprintf(stderr, "\n%04d: ", (unsigned)j);
for(i = 0; i < 24; ++i) {
if((i + j) == tcob_fldLength(pField))
break;
fprintf(stderr, "%02X ", ((unsigned char *)pData)[j+i]);
}
fprintf(stderr, "\n ");
for(i = 0; i < 24; ++i) {
if((i + j) == pField->len)
if((i + j) == tcob_fldLength(pField))
break;
if((((unsigned char *)pData)[i] >= ' ')
&& (((unsigned char *)pData)[i] < 0x7f))
fprintf(stderr, " %c ", ((unsigned char *)pData)[j+i]);
else
fprintf(stderr, " ");
}
}
fprintf(stderr, "\n\n");
}
int _iRtErrorNbr[] = {
RTERR_INVALID_DATA,
RTERR_INVALID_PIC,
-1
};
char *_szRtErrorDesc[] = {
"Invalid Data Content",
"Invalid Picture Structure",
(char *)0
};
/*------------------------------------------------------------------------*\
| |
| _DUMP_ |
| |
\*------------------------------------------------------------------------*/
void _DUMP_(unsigned char *caData, char *szCount, char *caOut) {
unsigned int i, k;
unsigned char c;
k = 0;
for(i = 0; i < 4; ++i) {
if(szCount[i] == '\0')
break;
k = (k * 10) + (szCount[i] - '0');
}
for(i = 0; i < k; ++i) {
c = (caData[i] >> 4) + '0';
if (c > '9') c += 7;
caOut[i * 2] = c;
c = (caData[i] & 0xf) + '0';
if (c > '9') c += 7;
caOut[(i * 2) + 1] = c;
}
}
/*------------------------------------------------------------------------*\
| |
| _FLDDUMP_ |
| |
\*------------------------------------------------------------------------*/
void _FLDDUMP_(struct fld_desc *pField, char *pData, char *szDesc) {
unsigned int i, j;
if(szDesc)
fprintf(stderr, "\n_FLDDUMP_\n%s: ", szDesc);
if(pField) {
fprintf(stderr, "len=%ld, type=%c, dec/pscale=%d/%d, ",
pField->len, pField->type, (char)pField->decimals, (char)pField->pscale);
fprintf(stderr, "all=%d, jr/bz=%d/%d, signs (l/s)= %d/%d\n",
pField->all, pField->just_r, pField->blank, pField->leading_sign, pField->separate_sign);
}
if (pField->type != DTYPE_GROUP && pField->type != DTYPE_ALPHANUMERICL) {
fprintf(stderr, "picture:");
for(i=0; tcob_picElemVal(pField->pic,i); i++) {
fprintf(stderr, "%c(%d)", tcob_picElemVal(pField->pic,i),
tcob_picElemLen(pField->pic,i));
}
fprintf(stderr, "\n");
}
if(!pData) {
fprintf(stderr, "No data pointer provided\n");
return;
}
fprintf(stderr, "Data Dump, Address = %08lX", (unsigned long)pData);
for(j=0; j<tcob_fldLength(pField); j+=24) {
fprintf(stderr, "\n%04d: ", (unsigned)j);
for(i = 0; i < 24; ++i) {
if((i + j) == tcob_fldLength(pField))
break;
fprintf(stderr, "%02X ", ((unsigned char *)pData)[j+i]);
}
fprintf(stderr, "\n ");
for(i = 0; i < 24; ++i) {
if((i + j) == tcob_fldLength(pField))
break;
if((((unsigned char *)pData)[i] >= ' ')
&& (((unsigned char *)pData)[i] < 0x7f))
fprintf(stderr, " %c ", ((unsigned char *)pData)[j+i]);
else
fprintf(stderr, " ");
}
}
fprintf(stderr, "\n\n");
}
/*------------------------------------------------------------------------*\
| |
| initIntValues |
| Initialize the values in the _iIntValues_ array. |
| |
\*------------------------------------------------------------------------*/
void initIntValues () {
unsigned int i;
extern long long _iIntValues_[MAX_INTEGERS];
_iIntValues_[MAX_INTEGERS - 1] = (long long)1;
for(i = MAX_INTEGERS -1; i > 0; --i)
_iIntValues_[i - 1] = _iIntValues_[i] * (long long)10;
}
/*------------------------------------------------------------------------*\
| |
| Static Storage Definitions |
| |
\*------------------------------------------------------------------------*/
int bDecimalComma = 0;
char cCurrencySymbol = '$';
long long _iIntValues_[MAX_INTEGERS] = {
(long long)-1, (long long)-1, (long long)-1,
(long long)-1, (long long)-1, (long long)-1,
(long long)-1, (long long)-1, (long long)-1,
(long long)-1, (long long)-1, (long long)-1,
(long long)-1, (long long)-1, (long long)-1,
(long long)-1, (long long)-1, (long long)-1
};
void (*pMovRtn[])(struct fld_desc *, char *,
struct fld_desc *, char *) = {
tcob_move_9_9, tcob_move_9_b, tcob_move_9_c,
tcob_move_9_e, tcob_move_9_f, tcob_move_9_x,
tcob_move_b_9, tcob_move_b_b, tcob_move_b_c,
tcob_move_b_e, tcob_move_b_f, tcob_move_b_x,
tcob_move_c_9, tcob_move_c_b, tcob_move_c_c,
tcob_move_c_e, tcob_move_c_f, tcob_move_c_x,
tcob_move_f_9, tcob_move_f_b, tcob_move_f_c,
tcob_move_f_e, tcob_move_f_f, tcob_move_f_x,
tcob_move_x_9, tcob_move_x_b, tcob_move_x_c,
tcob_move_x_e, tcob_move_x_f, tcob_move_x_x,
tcob_move_e_9, tcob_move_e_b, tcob_move_e_c,
tcob_move_e_e, tcob_move_e_f, tcob_move_e_x
};
#ifdef DEBUG_MOVE_RTS
int _iMoveLevel_ = 0;
#endif
BIN
View File
Binary file not shown.
+556
View File
@@ -0,0 +1,556 @@
/*
* Copyright (C) 2003 Jeff Smith
* Copyright (C) 2001, 2000, 1999 Rildo Pragana, Jim Noeth,
* Andrew Cameron, David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
#include "htcoblib.h"
/* To turn RTS MOVE debugging on, change 'if 0' to 'if 1'.
* Note that RTS MOVE debugging must also be turned on in cobmove.c .
* Or do both with the configuration option --enable-debug-rts-move .
*/
#if 0
#define DEBUG_MOVE_RTS 1
#endif
/*--------------------------------------------------------------------------*\
| |
| Move routines where the source field is DTYPE_DISPLAY |
| |
\*--------------------------------------------------------------------------*/
void tcob_move_9_9(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
int bIsNegative;
int iSrcDecimals, iSrcPscale;
int iDstDecimals, iDstPscale;
unsigned char *caSrcData;
unsigned char *caDstData;
struct fld_desc fSrcWork;
struct fld_desc fDstWork;
unsigned int bSrcSigned;
unsigned int bDstSigned;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_9 (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(fSrcWork));
memcpy(&fDstWork, pfldDesc2, sizeof(fDstWork));
caSrcData = (unsigned char *)caData1;
caDstData = (unsigned char *)caData2;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
iDstDecimals = (char)fDstWork.decimals; /* do not remove (char) */
iSrcPscale = (char)fSrcWork.pscale; /* do not remove (char) */
iDstPscale = (char)fDstWork.pscale; /* do not remove (char) */
bSrcSigned = (tcob_picElemVal(fSrcWork.pic,0) == 'S') ? 1 : 0;
bDstSigned = (tcob_picElemVal(fDstWork.pic,0) == 'S') ? 1 : 0;
/* Determine source's sign and temporarily remove */
if(bSrcSigned) {
if(fSrcWork.separate_sign) {
char cSign;
if(fSrcWork.leading_sign) {
cSign = caSrcData[0];
++caSrcData; /* point past the sign */
} else
cSign = caSrcData[fSrcWork.len - 1];
fSrcWork.len --; /* subtract length of sign */
bIsNegative = (cSign == '-') ? 1 : 0;
} else /* Sign is non-separate */
bIsNegative = tcob_extract_sign(&fSrcWork, (char *)caSrcData);
} else /* Variable is unsigned */
bIsNegative = 0;
if(bDstSigned && fDstWork.separate_sign) {
if(fDstWork.leading_sign)
++caDstData; /* point past the sign area */
fDstWork.len --; /* subtract length for sign */
}
if(fSrcWork.all && (fSrcWork.len == 1)) {
/* Numeric ALL literal must have a length of 1 */
memset(caDstData, *caSrcData, fDstWork.len);
} else {
int off_src, off_dst, len;
unsigned int off1, off2;
off_src = ((iSrcDecimals)?iSrcDecimals:iSrcPscale) - fSrcWork.len;
off_dst = ((iDstDecimals)?iDstDecimals:iDstPscale) - fDstWork.len;
if (off_src < off_dst) {
off1 = 0;
off2 = off_dst - off_src;
len = (int)fSrcWork.len - off2;
if (len > (int)fDstWork.len)
len = fDstWork.len;
} else {
off1 = off_src - off_dst;
off2 = 0;
len = (int)fDstWork.len - off1;
if (len > (int)fSrcWork.len)
len = fSrcWork.len;
}
memset(caDstData, '0', fDstWork.len);
if (len > 0)
memcpy(caDstData+off1, caSrcData+off2, len);
}
/* Restore signs */
if(bSrcSigned && (!fSrcWork.separate_sign))
tcob_put_sign(&fSrcWork, (char *)caSrcData, bIsNegative);
if(bDstSigned) {
if(fDstWork.separate_sign) {
int iLoc = (fDstWork.leading_sign) ? 0 : fDstWork.len;
caData2[iLoc] = (bIsNegative) ? '-' : '+';
} else
tcob_put_sign(&fDstWork, (char *)caDstData, bIsNegative);
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_9_b(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int bIsNegative;
unsigned int bIsZero;
int iSrcLen;
unsigned int iDstLen;
char *caSrcData;
unsigned int bSrcSigned;
unsigned int bDstSigned;
long long iLongField;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_b (%d)\n", _iMoveLevel_++);
}
#endif
caSrcData = caData1;
bSrcSigned = (tcob_picElemVal(pfldDesc1->pic,0) == 'S') ? 1 : 0;
bDstSigned = (tcob_picElemVal(pfldDesc2->pic,0) == 'S') ? 1 : 0;
iSrcLen = pfldDesc1->len;
iDstLen = tcob_picCompLength(pfldDesc2);
/* Determine source's sign and temporarily remove */
if(bSrcSigned) {
if(pfldDesc1->separate_sign) {
char cSign;
if(pfldDesc1->leading_sign) {
cSign = caSrcData[0];
++caSrcData; /* point past the sign */
} else
cSign = caSrcData[pfldDesc1->len - 1];
iSrcLen --;
bIsNegative = (cSign == '-') ? 1 : 0;
} else /* Sign is non-separate */
bIsNegative = tcob_extract_sign(pfldDesc1, caSrcData);
} else /* Variable is unsigned */
bIsNegative = 0;
bIsZero = ((pfldDesc1->len == 1) && (*caSrcData == '0')) ? 1 : 0;
iLongField = 0;
if (!bIsZero) {
int i;
int off, scale, len;
char caWork[MAX_DIGITS];
extern long long _iIntValues_[MAX_INTEGERS];
/* do not remove (char) on these four assignments */
int iSrcDecimals = (char)pfldDesc1->decimals;
int iDstDecimals = (char)pfldDesc2->decimals;
int iSrcPscale = (char)pfldDesc1->pscale;
int iDstPscale = (char)pfldDesc2->pscale;
if(pfldDesc1->all && (iSrcLen == 1)) {
/* Numeric ALL literal must have a length of 1 */
memset(caWork, *caSrcData, MAX_DIGITS);
iSrcLen = MAX_DIGITS;
iSrcDecimals = 0;
iSrcPscale = 0;
caSrcData = (char *)caWork;
}
scale = ((iDstDecimals)?iDstDecimals:iDstPscale) -
((iSrcDecimals)?iSrcDecimals:iSrcPscale);
off = scale - iDstLen + iSrcLen;
if (off > 0) {
len = iSrcLen - off;
if (len > (int)iDstLen)
len = iDstLen;
} else {
len = iDstLen + off;
if (len > (int)iSrcLen)
len = iSrcLen;
off = 0;
}
if(_iIntValues_[0] == (long long)-1) /* first time called */
initIntValues();
for(i=0; i<len; i++) {
iLongField += (_iIntValues_[MAX_INTEGERS-(len-i)-scale]
* (long long)(caSrcData[off+i] - '0'));
#ifdef DEBUG_MOVE_RTS
fprintf(stderr, "Debug: tcob_move_9_b 4: iLongField=%lld\n",
iLongField);
#endif
}
/* Set destination's sign */
if(bDstSigned && bIsNegative)
iLongField *= (long long)-1;
}
/* Restore source's sign */
if(bSrcSigned && (!pfldDesc1->separate_sign))
tcob_put_sign(pfldDesc1, caSrcData, bIsNegative);
switch(pfldDesc2->len) {
case 1:
*(char *)caData2 = iLongField;
break;
case 2:
*(short int *)caData2 = iLongField;
break;
case 4:
*(int *)caData2 = iLongField;
break;
case 8:
*(long long *)caData2 = iLongField;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_9_c(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
int j, k;
int bIsNegative;
int iSrcDecimals, iSrcPscale;
int iDstDecimals, iDstPscale;
unsigned int bSrcSigned;
char caWork[MAX_INTEGERS + MAX_DECIMALS];
unsigned char *caSrcData;
unsigned char *caDstData;
unsigned char iDigit;
struct fld_desc fSrcWork;
struct fld_desc fDstWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_c (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
memcpy(&fDstWork, pfldDesc2, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
caDstData = (unsigned char *)caData2;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
iDstDecimals = (char)fDstWork.decimals; /* do not remove (char) */
iSrcPscale = (char)fSrcWork.pscale; /* do not remove (char) */
iDstPscale = (char)fDstWork.pscale; /* do not remove (char) */
bSrcSigned = (tcob_picElemVal(fSrcWork.pic,0) == 'S') ? 1 : 0;
if(bSrcSigned) {
if(fSrcWork.separate_sign) {
char cSign;
if(fSrcWork.leading_sign) {
cSign = caSrcData[0];
++caSrcData; /* point past the sign */
} else
cSign = caSrcData[fSrcWork.len - 1];
fSrcWork.len --; /* subtract length of sign */
bIsNegative = (cSign == '-') ? 1 : 0;
} else /* Sign is non-separate */
bIsNegative = tcob_extract_sign(&fSrcWork, (char *)caSrcData);
} else /* Variable is unsigned */
bIsNegative = 0;
if(fSrcWork.all && (fSrcWork.len == 1)) { /* this is a 'move all' */
memset(caWork, *caSrcData, sizeof(caWork));
} else {
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(iSrcPscale < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len + (iSrcPscale * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - fSrcWork.decimals);
memmove(&caWork[j], caSrcData, fSrcWork.len);
if(bSrcSigned && (!fSrcWork.separate_sign))
tcob_put_sign(&fSrcWork, (char *)caSrcData, (char)bIsNegative);
}
if(iDstPscale < 0) /* integer scaling */
j = MAX_DIGITS - fDstWork.len - (iDstPscale * -1);
else if(iDstDecimals > (int)fDstWork.len) /* fractional scaling */
j = MAX_DIGITS + iDstDecimals - fDstWork.len;
else
j = MAX_DIGITS - (fDstWork.len - fDstWork.decimals);
memset (caDstData, 0, (fDstWork.len/2)+1);
k = ((fDstWork.len & 1) == 0) ? 1 : 0;
for(i = 0; i < fDstWork.len; ++i) {
iDigit = caWork[j + i] - '0';
caDstData[k / 2] |= ((k & 1) ? (iDigit) : (iDigit << 4));
++k;
}
if(tcob_picElemVal(fDstWork.pic,0) == 'S')
iDigit = (bIsNegative) ? 0x0D : 0x0C;
else
iDigit = 0x0F;
caDstData[fDstWork.len / 2] |= iDigit;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_9_e(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_e (%d)\n", _iMoveLevel_++);
}
#endif
tcob_move_edited(pfldDesc1, caData1, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_9_f(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
int i, j, k;
int bIsNegative;
int iSrcDecimals, iSrcPscale;
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned char *caSrcData;
struct fld_desc fSrcWork;
double dWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_f (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
iSrcPscale = (char)fSrcWork.pscale; /* do not remove (char) */
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') { /* Variable is signed */
if(fSrcWork.separate_sign) {
char cSign;
if(fSrcWork.leading_sign) {
cSign = caSrcData[0];
++caSrcData; /* point past the sign */
} else
cSign = caSrcData[fSrcWork.len - 1];
fSrcWork.len --; /* subtract length of sign */
bIsNegative = (cSign == '-') ? 1 : 0;
} else /* Sign is non-separate */
bIsNegative = tcob_extract_sign(&fSrcWork, (char *)caSrcData);
} else /* Variable is unsigned */
bIsNegative = 0;
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < (MAX_DIGITS * 2)) {
caWork[i++] = caSrcData[j++];
if(j == k)
j = 0;
}
} else {
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(iSrcPscale < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len - (iSrcPscale * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - fSrcWork.decimals);
memmove(&caWork[j], caSrcData, fSrcWork.len);
if((tcob_picElemVal(fSrcWork.pic,0) == 'S') && (!fSrcWork.separate_sign))
tcob_put_sign(&fSrcWork, (char *)caSrcData, bIsNegative);
}
/* re-form to create a null-terminated string with a decimal point */
memmove(caWork + MAX_INTEGERS + 1, caWork + MAX_INTEGERS, MAX_DECIMALS);
caWork[MAX_INTEGERS] = '.';
caWork[MAX_INTEGERS + MAX_DECIMALS + 1] = '\0';
dWork = atof(caWork);
if(bIsNegative)
dWork *= (double)-1.0;
if(pfldDesc2->len == 4)
*(float *)caData2 = (float)dWork;
else
*(double *)caData2 = dWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_9_x(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
unsigned int bIsNegative;
unsigned int bSrcSigned;
unsigned int iSrcLen;
int iSrcPscale;
char *caSrcData;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_9_x (%d)\n", _iMoveLevel_++);
}
#endif
caSrcData = caData1;
iSrcLen = pfldDesc1->len;
iSrcPscale = -(char)pfldDesc1->pscale;
bSrcSigned = (tcob_picElemVal(pfldDesc1->pic,0) == 'S') ? 1 : 0;
/* Remove sign, as in numeric to alphanumeric transfers, it is not
* transferred to the destination */
if(bSrcSigned) {
if(pfldDesc1->separate_sign) {
iSrcLen --;
if (pfldDesc1->leading_sign)
caSrcData ++;
} else
bIsNegative = tcob_extract_sign(pfldDesc1, caSrcData);
}
if(pfldDesc1->all) { /* this is a 'move all' */
if(iSrcLen == 1) {
memset(caData2, *caSrcData, pfldDesc2->len);
} else {
unsigned int rem = pfldDesc2->len % iSrcLen;
for(i = 0; i < pfldDesc2->len - rem; i += iSrcLen)
memcpy(caData2+i, caSrcData, iSrcLen);
memcpy(caData2+i, caSrcData, rem);
}
} else {
/* start is the offset into the destination where the source
* value is placed, and off1-1 is where it ends. off1 is where
* the pscale zeros begin, and off2-1 is where they end.
* srcoff is the number of initial digits not transferred from
* the source. */
int start, end1, end2, srcoff;
srcoff = 0;
if(pfldDesc2->just_r) {
start = pfldDesc2->len-(iSrcPscale+iSrcLen);
end1 = pfldDesc2->len-iSrcPscale;
end2 = pfldDesc2->len;
if (start < 0) {
srcoff = -start;
start = 0;
}
if (end1 < 0)
end1 = 0;
} else {
start = 0;
end1 = iSrcLen;
end2 = iSrcLen+iSrcPscale;
if (end1 > pfldDesc2->len)
end1 = pfldDesc2->len;
if (end2 > pfldDesc2->len)
end2 = pfldDesc2->len;
}
memset(caData2, ' ', pfldDesc2->len);
memcpy(caData2+start, caSrcData+srcoff, end1-start);
memset(caData2+end1, '0', end2-end1);
}
/* Restore sign to the source */
if (bSrcSigned && (!pfldDesc1->separate_sign))
tcob_put_sign(pfldDesc1, caSrcData, bIsNegative);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_9_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
BIN
View File
Binary file not shown.
+478
View File
@@ -0,0 +1,478 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
#include "htcoblib.h"
//#define DEBUG_MOVE_RTS 1
/*--------------------------------------------------------------------------*\
| |
| Move routines where the source field is DTYPE_BINARY |
| |
\*--------------------------------------------------------------------------*/
void tcob_move_b_9(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
int i;
int bIsNegative;
char caWork[MAX_INTEGERS];
unsigned int picLen;
char *pData=NULL;
struct fld_desc fldWork;
long long iLongField=0;
long long iLongWork;
extern long long _iIntValues_[MAX_INTEGERS];
char caWork1[MAX_INTEGERS+1];
unsigned int iLen;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
caWork1[MAX_INTEGERS] = '\0';
fprintf(stderr, "Debug: Enter tcob_move_b_9 (%d)\n", _iMoveLevel_++);
}
#endif
if(_iIntValues_[0] == (long long)-1) /* first time called */
initIntValues();
fldWork.type = DTYPE_DISPLAY;
fldWork.decimals = pfldDesc1->decimals;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
if (tcob_picElemVal(pfldDesc1->pic,0) == 'S') {
switch(pfldDesc1->len) {
case 1:
iLongField = *(char *)caData1;
iLen = 3;
break;
case 2:
iLongField = *(short int *)caData1;
iLen = 5;
break;
case 4:
iLongField = *(int *)caData1;
iLen = 10;
break;
case 8:
iLongField = *(long long *)caData1;
iLen = 18;
break;
}
}
else {
switch(pfldDesc1->len) {
case 1:
iLongField = *(unsigned char *)caData1;
iLen = 3;
break;
case 2:
iLongField = *(unsigned short int *)caData1;
iLen = 5;
break;
case 4:
iLongField = *(unsigned int *)caData1;
iLen = 10;
break;
case 8:
iLongField = *(unsigned long long *)caData1;
iLen = 18;
break;
}
}
fldWork.len = iLen;
picLen = tcob_picReqLen(2);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'S', 1, '9', iLen, NULL);
pData = &caWork[MAX_INTEGERS - iLen];
if(iLongField < 0) {
bIsNegative = 1;
iLongField = iLongField * (long long)-1;
} else
bIsNegative = 0;
for(i = 0; i < MAX_INTEGERS; ++i) {
iLongWork = iLongField / _iIntValues_[i];
caWork[i] = (unsigned char)iLongWork + '0';
iLongField = iLongField - (_iIntValues_[i] * iLongWork);
caWork1[i] = '=';
}
tcob_put_sign(&fldWork, pData, bIsNegative);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_9 call (%d)\n", _iMoveLevel_);
strncpy(caWork1, caWork, MAX_INTEGERS);
fprintf(stderr, "Debug tcob_move_b_9: caWork1=%s, len=%d, bIsNegative=%d;\n",
caWork1, strlen(caWork1), bIsNegative);
_FLDDUMP_(&fldWork, pData, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_9(&fldWork, pData, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: after tcob_move_9_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, pData, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
void tcob_move_b_b(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
long long iLongField=0;
int iSrcDecimals, iSrcPscale;
int iDstDecimals, iDstPscale;
int scale;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_b_b (%d)\n", _iMoveLevel_++);
}
#endif
if (tcob_picElemVal(pfldDesc1->pic,0) == 'S') {
switch(pfldDesc1->len) {
case 1:
iLongField = *(char *)caData1;
break;
case 2:
iLongField = *(short int *)caData1;
break;
case 4:
iLongField = *(int *)caData1;
break;
case 8:
iLongField = *(long long *)caData1;
break;
}
}
else {
switch(pfldDesc1->len) {
case 1:
iLongField = *(unsigned char *)caData1;
break;
case 2:
iLongField = *(unsigned short int *)caData1;
break;
case 4:
iLongField = *(unsigned int *)caData1;
break;
case 8:
iLongField = *(unsigned long long *)caData1;
break;
}
}
if ((tcob_picElemVal(pfldDesc2->pic,0) != 'S') && (iLongField < 0)) {
iLongField = - iLongField;
}
/* Scaling */
iSrcDecimals = (char)pfldDesc1->decimals;
iDstDecimals = (char)pfldDesc2->decimals;
iSrcPscale = (char)pfldDesc1->pscale;
iDstPscale = (char)pfldDesc2->pscale;
scale = (iDstDecimals?iDstDecimals:iDstPscale) -
(iSrcDecimals?iSrcDecimals:iSrcPscale);
if (scale > 0) {
for (i=0; i<scale; i++)
iLongField *= 10;
} else if (scale < 0) {
for (i=0; i<-scale; i++)
iLongField /= 10;
}
switch(pfldDesc2->len) {
case 1:
*(char *)caData2 = iLongField;
break;
case 2:
*(short int *)caData2 = iLongField;
break;
case 4:
*(int *)caData2 = iLongField;
break;
case 8:
*(long long *)caData2 = iLongField;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_b_c(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
int i;
int bIsNegative;
char caWork[MAX_INTEGERS];
unsigned int picLen;
char *pData=NULL;
struct fld_desc fldWork;
long long iLongField=0;
long long iLongWork;
extern long long _iIntValues_[MAX_INTEGERS];
unsigned int iLen;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_b_c (%d)\n", _iMoveLevel_++);
}
#endif
if(_iIntValues_[0] == (long long)-1) /* first time called */
initIntValues();
fldWork.type = DTYPE_DISPLAY;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 1:
iLongField = *(char *)caData1;
iLen = 3;
break;
case 2:
iLongField = *(short int *)caData1;
iLen = 5;
break;
case 4:
iLongField = *(int *)caData1;
iLen = 10;
break;
case 8:
iLongField = *(long long *)caData1;
iLen = 18;
break;
}
fldWork.len = iLen;
picLen = tcob_picReqLen(2);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'S', 1, '9', iLen, NULL);
pData = &caWork[MAX_INTEGERS - iLen];
if(iLongField < 0) {
bIsNegative = 1;
iLongField = iLongField * (long long)-1;
} else
bIsNegative = 0;
for(i = 0; i < MAX_INTEGERS; ++i) {
iLongWork = iLongField / _iIntValues_[i];
caWork[i] = (unsigned char)iLongWork + '0';
iLongField = iLongField - (_iIntValues_[i] * iLongWork);
}
tcob_put_sign(&fldWork, pData, bIsNegative);
tcob_move_9_c(&fldWork, pData, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
void tcob_move_b_e(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_b_e (%d)\n", _iMoveLevel_++);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_edited(pfldDesc1, caData1, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_b_f(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
long long iLongField=0;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_b_f (%d)\n", _iMoveLevel_++);
}
#endif
switch(pfldDesc1->len) {
case 1:
iLongField = *(char *)caData1;
break;
case 2:
iLongField = *(short int *)caData1;
break;
case 4:
iLongField = *(int *)caData1;
break;
case 8:
iLongField = *(long long *)caData1;
break;
}
switch(pfldDesc2->len) {
case 4:
*(float *)caData2 = (float)iLongField;
break;
case 8:
*(double *)caData2 = (double)iLongField;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_b_x(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
int i;
int bIsNegative;
char caWork[MAX_INTEGERS];
unsigned int picLen;
char *pData=NULL;
struct fld_desc fldWork;
long long iLongField=0;
long long iLongWork;
extern long long _iIntValues_[MAX_INTEGERS];
unsigned int iLen;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_b_x (%d)\n", _iMoveLevel_++);
}
#endif
if(_iIntValues_[0] == (long long)-1) /* first time called */
initIntValues();
fldWork.type = DTYPE_DISPLAY;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 1:
iLongField = *(char *)caData1;
iLen = 3;
break;
case 2:
iLongField = *(short int *)caData1;
iLen = 5;
break;
case 4:
iLongField = *(int *)caData1;
iLen = 10;
break;
case 8:
iLongField = *(long long *)caData1;
iLen = 18;
break;
}
fldWork.len = (pfldDesc2->len > iLen ? iLen: pfldDesc2->len);
picLen = tcob_picReqLen(2);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'S', 1, '9', iLen, NULL);
pData = &caWork[MAX_INTEGERS - iLen];
if(iLongField < 0) {
bIsNegative = 1;
iLongField = iLongField * (long long)-1;
} else
bIsNegative = 0;
for(i = 0; i < MAX_INTEGERS; ++i) {
iLongWork = iLongField / _iIntValues_[i];
caWork[i] = (unsigned char)iLongWork + '0';
iLongField = iLongField - (_iIntValues_[i] * iLongWork);
}
tcob_put_sign(&fldWork, pData, bIsNegative);
tcob_move_9_x(&fldWork, pData, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_b_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
BIN
View File
Binary file not shown.
+610
View File
@@ -0,0 +1,610 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
#include "htcoblib.h"
/* #define DEBUG_RTS 0 */
/* #define DEBUG_MOVE_RTS 1 */
/*--------------------------------------------------------------------------*\
| |
| Move routines where the source field is DTYPE_PACKED |
| |
\*--------------------------------------------------------------------------*/
void tcob_move_c_9(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
int j, k;
unsigned int bIsNegative;
int iSrcDecimals;
int iDstDecimals;
int iSrcOffset;
unsigned char iDigit;
char caWork[MAX_INTEGERS + MAX_DECIMALS];
unsigned char *caSrcData;
unsigned char *caDstData;
struct fld_desc fSrcWork;
struct fld_desc fDstWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_9 (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
memcpy(&fDstWork, pfldDesc2, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
caDstData = (unsigned char *)caData2;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
iDstDecimals = (char)fDstWork.decimals; /* do not remove (char) */
/* Proper COMP-3's with even length have a leading half-byte */
iSrcOffset = ((fSrcWork.len & 1) == 0) ? 1 : 0;
/* Determine if source value is negative */
bIsNegative = 0;
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') {
iDigit = caSrcData[fSrcWork.len/2] & 0x0F;
if((iDigit == 0x0D) || (iDigit == 0x0B))
bIsNegative = 1;
}
if(fDstWork.separate_sign) {
if(fDstWork.leading_sign)
++caDstData; /* point past the sign area */
fDstWork.len --; /* subtract length of the sign */
}
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < fDstWork.len) {
iDigit = caSrcData[(j + iSrcOffset) / 2];
if((j + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
++j;
caDstData[i++] = iDigit + '0';
if(j == k)
j = 0;
}
if(tcob_picElemVal(fDstWork.pic,0) == 'S') {
if(fDstWork.separate_sign) {
int iLoc = (fDstWork.leading_sign) ? 0 : fDstWork.len;
caData2[iLoc] = (bIsNegative) ? '-' : '+';
} else
tcob_put_sign(&fDstWork, (char *)caDstData, bIsNegative);
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
} /* END OF MOVE ALL CODE */
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(iSrcDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len - (iSrcDecimals * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - fSrcWork.decimals);
for(i = 0; i < fSrcWork.len; ++i) {
iDigit = caSrcData[(i + iSrcOffset) / 2];
if((i + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
caWork[j + i] = iDigit + '0';
}
if(iDstDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fDstWork.len - (iDstDecimals * -1);
else if(iDstDecimals > (int)fDstWork.len) /* fractional scaling */
j = MAX_DIGITS + iDstDecimals - fDstWork.len;
else
j = MAX_DIGITS - (fDstWork.len - iDstDecimals);
memmove(caDstData, &caWork[j], fDstWork.len);
if(tcob_picElemVal(fDstWork.pic,0) == 'S') {
if(fDstWork.separate_sign) {
int iLoc = (fDstWork.leading_sign) ? 0 : fDstWork.len;
caData2[iLoc] = bIsNegative ? '-' : '+';
} else
tcob_put_sign(&fDstWork, (char *)caDstData, bIsNegative);
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_c_b(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
int j, k;
unsigned int bIsNegative;
int iSrcDecimals;
int iSrcOffset;
unsigned int iDestLen;
char caWork[MAX_INTEGERS + MAX_DECIMALS + 1];
unsigned char *caSrcData;
unsigned char iDigit;
struct fld_desc fSrcWork;
long long iLongField;
extern long long _iIntValues_[MAX_INTEGERS];
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_b (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
iSrcDecimals = (char)fSrcWork.decimals;
if(iSrcDecimals >= (int)fSrcWork.len) { /* all fraction */
switch(pfldDesc2->len) {
case 1:
*(char *)caData2 = 0;
break;
case 2:
*(short int *)caData2 = 0;
break;
case 4:
*(int *)caData2 = 0;
break;
case 8:
*(long long *)caData2 = 0;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
if(_iIntValues_[0] == (long long)-1) /* first time called */
initIntValues();
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
/* Proper COMP-3's with even length have a leading half-byte */
iSrcOffset = ((fSrcWork.len & 1) == 0) ? 1 : 0;
/* Determine if source value is negative */
bIsNegative = 0;
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') {
iDigit = caSrcData[fSrcWork.len/2] & 0x0F;
if((iDigit == 0x0D) || (iDigit == 0x0B))
bIsNegative = 1;
}
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < MAX_INTEGERS) {
iDigit = caSrcData[(j + iSrcOffset) / 2];
if((j + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
++j;
caWork[i++] = iDigit + '0';
if(j == k)
j = 0;
}
fSrcWork.len = MAX_INTEGERS;
} /* END OF MOVE ALL CODE */
else {
if(iSrcDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len - (iSrcDecimals * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - iSrcDecimals);
for(i = 0; i < fSrcWork.len; ++i) {
iDigit = caSrcData[(i + iSrcOffset) / 2];
if((i + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
caWork[j + i] = iDigit + '0';
}
}
iDestLen = 0;
for(i=0; tcob_picElemVal(pfldDesc2->pic,i); i++) {
if(tcob_picElemVal(pfldDesc2->pic,i) == '9')
iDestLen += tcob_picElemLen(pfldDesc2->pic,i);
}
iLongField = 0;
k = 0;
if(iSrcDecimals > 0)
fSrcWork.len -= iSrcDecimals;
else
k = iSrcDecimals * -1;
j = MAX_INTEGERS - 1;
if(fSrcWork.len < iDestLen)
iDestLen = fSrcWork.len;
for(i = 0; i < iDestLen; ++i) {
iLongField += (_iIntValues_[j] * (long long)(caWork[j - k] - '0'));
--j;
}
if(bIsNegative)
iLongField *= (long long)-1;
switch(pfldDesc2->len) {
case 1:
*(char *)caData2 = iLongField;
break;
case 2:
*(short int *)caData2 = iLongField;;
break;
case 4:
*(int *)caData2 = iLongField;
break;
case 8:
*(long long *)caData2 = iLongField;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_c_c(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
int j, k;
unsigned int bIsNegative;
int iSrcDecimals;
int iDstDecimals;
int iSrcOffset;
char caWork[MAX_INTEGERS + MAX_DECIMALS];
unsigned char *caSrcData;
unsigned char *caDstData;
unsigned char iDigit;
struct fld_desc fSrcWork;
struct fld_desc fDstWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_c (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
memcpy(&fDstWork, pfldDesc2, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
caDstData = (unsigned char *)caData2;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
iDstDecimals = (char)fDstWork.decimals; /* do not remove (char) */
/* Proper COMP-3's with even length have a leading half-byte */
iSrcOffset = ((fSrcWork.len & 1) == 0) ? 1 : 0;
/* Determine if source value is negative */
bIsNegative = 0;
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') {
iDigit = caSrcData[fSrcWork.len/2] & 0x0F;
if((iDigit == 0x0D) || (iDigit == 0x0B))
bIsNegative = 1;
}
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < (MAX_DIGITS * 2)) {
caWork[i++] = caSrcData[j++];
if(j == k)
j = 0;
}
} else {
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(iSrcDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len - (iSrcDecimals * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - iSrcDecimals);
for(i = 0; i < fSrcWork.len; ++i) {
iDigit = caSrcData[(i + iSrcOffset) / 2];
if((i + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
caWork[j + i] = iDigit + '0';
}
}
if(iDstDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fDstWork.len - (iDstDecimals * -1);
else if(iDstDecimals > (int)fDstWork.len) /* fractional scaling */
j = MAX_DIGITS + iDstDecimals - fDstWork.len;
else
j = MAX_DIGITS - (fDstWork.len - iDstDecimals);
memset (caDstData, 0, (fDstWork.len/2)+1);
k = ((fDstWork.len & 1) == 0) ? 1 : 0;
for(i = 0; i < fDstWork.len; ++i) {
iDigit = caWork[j + i] - '0';
caDstData[k / 2] |= ((k & 1) ? (iDigit) : (iDigit << 4));
++k;
}
if(tcob_picElemVal(fDstWork.pic,0) == 'S')
iDigit = bIsNegative ? 0x0D : 0x0C;
else
iDigit = 0x0F;
caDstData[fDstWork.len / 2] |= iDigit;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_c_e(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_e (%d)\n", _iMoveLevel_++);
}
#endif
tcob_move_edited(pfldDesc1, caData1, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_c_f(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
int j, k;
unsigned int bIsNegative;
int iSrcDecimals;
int iSrcOffset;
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned char *caSrcData;
unsigned char iDigit;
struct fld_desc fSrcWork;
double dWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_f (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
/* Proper COMP-3's with even length have a leading half-byte */
iSrcOffset = ((fSrcWork.len & 1) == 0) ? 1 : 0;
/* Determine if source value is negative */
bIsNegative = 0;
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') {
iDigit = caSrcData[fSrcWork.len/2] & 0x0F;
if((iDigit == 0x0D) || (iDigit == 0x0B))
bIsNegative = 1;
}
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < (MAX_DIGITS * 2)) {
iDigit = caSrcData[(j + iSrcOffset) / 2];
if((j + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
++j;
caWork[i++] = iDigit + '0';
if(j == k)
j = 0;
}
} else {
memset(caWork, '0', sizeof(caWork)); /* move src to 9(18)V9(18) */
if(iSrcDecimals < 0) /* integer scaling */
j = MAX_DIGITS - fSrcWork.len - (iSrcDecimals * -1);
else if(iSrcDecimals > (int)fSrcWork.len) /* fractional scaling */
j = MAX_DIGITS + iSrcDecimals - fSrcWork.len;
else
j = MAX_DIGITS - (fSrcWork.len - fSrcWork.decimals);
for(i = 0; i < fSrcWork.len; ++i) {
iDigit = caSrcData[(i + iSrcOffset) / 2];
if((i + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
caWork[j + i] = iDigit + '0';
}
}
/* re-form to create a null-terminated string with a decimal point */
memmove(caWork + MAX_INTEGERS + 1, caWork + MAX_INTEGERS, MAX_DECIMALS);
caWork[MAX_INTEGERS] = '.';
caWork[MAX_INTEGERS + MAX_DECIMALS + 1] = '\0';
dWork = atof(caWork);
if(bIsNegative)
dWork *= (double)-1.0;
if(pfldDesc2->len == 4)
*(float *)caData2 = (float)dWork;
else
*(double *)caData2 = dWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_c_x(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i, j, k;
unsigned int bIsNegative;
int iSrcDecimals;
int iSrcOffset;
int iDstOffset;
unsigned char iDigit;
unsigned char *caSrcData;
struct fld_desc fSrcWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_c_x (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fSrcWork, pfldDesc1, sizeof(struct fld_desc));
caSrcData = (unsigned char *)caData1;
iSrcDecimals = (char)fSrcWork.decimals; /* do not remove (char) */
/* Proper COMP-3's with even length have a leading half-byte */
iSrcOffset = ((fSrcWork.len & 1) == 0) ? 1 : 0;
/* Determine if source value is negative */
bIsNegative = 0;
if(tcob_picElemVal(fSrcWork.pic,0) == 'S') {
iDigit = caSrcData[fSrcWork.len/2] & 0x0F;
if((iDigit == 0x0D) || (iDigit == 0x0B))
bIsNegative = 1;
}
if(fSrcWork.all) { /* this is a 'move all' */
i = 0;
j = 0;
k = fSrcWork.len;
while(i < pfldDesc2->len) {
iDigit = caSrcData[(j + iSrcOffset) / 2];
if((j + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
++j;
caData2[i++] = iDigit + '0';
if(j == k)
j = 0;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
/* END OF MOVE ALL CODE */
memset(caData2, ' ', pfldDesc2->len);
if(fSrcWork.len > pfldDesc2->len) {
k = pfldDesc2->len;
iDstOffset = 0;
} else {
if(pfldDesc2->just_r)
iDstOffset = pfldDesc2->len - fSrcWork.len;
else
iDstOffset = 0;
k = fSrcWork.len;
}
for(i = 0; i < k; ++i) {
iDigit = caSrcData[(i + iSrcOffset) / 2];
if((i + iSrcOffset) & 1)
iDigit = iDigit & 0x0F;
else
iDigit = iDigit >> 4;
caData2[i + iDstOffset] = iDigit + '0';
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_c_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
BIN
View File
Binary file not shown.
+908
View File
@@ -0,0 +1,908 @@
/*
* Copyright (C) 1999 - 2003, Rildo Pragana, Jim Noeth,
* David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
/*
*
* COBOL Compiler Run Time Library -- Move Module
*
*/
#include "htcoblib.h"
/* #define DEBUG_RTS 0 */
/* #define DEBUG_MOVE_RTS 1 */
/*------------------------------------------------------------------------*\
| |
| tcob_move_edited |
| |
\*------------------------------------------------------------------------*/
enum suppress_state {SUPPRESS_NOT_YET,
SUPPRESS_YES,
SUPPRESS_DONE};
void tcob_move_edited( struct fld_desc *pSrcFld, char *pSrcData,
struct fld_desc *pDstFld, char *pDstData ) {
unsigned int i, k;
unsigned int iSrcPtr;
int iDstPtr;
int iDecimalPos;
enum suppress_state iSuppress;
unsigned int bIsNegative;
unsigned int bInFraction;
unsigned int bIsAlphaEdited;
unsigned int bBlanking;
extern int bDecimalComma;
char *caWorkData;
char *pPic;
unsigned int picLen;
char cChar;
char cFloatChar;
char cFillChar;
char cInsertion;
char cDecimalPoint;
char cComma;
extern char cCurrencySymbol;
struct fld_desc FldWrk;
memset(&FldWrk, 0, sizeof(struct fld_desc)); /* All values to 0 */
picLen = tcob_picReqLen(1);
FldWrk.pic = (char *)malloc(picLen);
tcob_picCreate (FldWrk.pic, picLen, 'S', 1, NULL);
FldWrk.just_r = pDstFld->just_r;
pPic = pDstFld->pic;
bIsNegative = 0;
bInFraction = 0;
bIsAlphaEdited = 0; /* Assume Numeric-Edited */
bBlanking = 1;
cInsertion = '\0';
if(bDecimalComma) {
cComma = '.';
cDecimalPoint = ',';
} else {
cComma = ',';
cDecimalPoint = '.';
}
for(i=0; (cChar=tcob_picElemVal(pPic,i)); i++) {
k = tcob_picElemLen(pPic,i);
if((cChar == 'X')
|| (cChar == '9')
|| (cChar == 'A')) {
if(cChar != '9')
bIsAlphaEdited = 1;
bBlanking = 0;
FldWrk.len += k;
if(bInFraction)
FldWrk.decimals += k;
} else if((cChar == 'Z')
|| (cChar == '*')) {
cInsertion = cChar;
FldWrk.len += k;
if(bInFraction)
FldWrk.decimals += k;
} else if((cChar == '+')
|| (cChar == '-')
|| (cChar == cCurrencySymbol)) {
if(cInsertion) {
if(cInsertion == cChar) {
FldWrk.len += k;
if(bInFraction)
FldWrk.decimals += k;
}
} else if(k > 1) {
cInsertion = cChar;
FldWrk.len += (k - 1);
if(bInFraction)
FldWrk.decimals += (k - 1);
} else {
unsigned int ii;
unsigned char c;
for(ii=i+1; (c=tcob_picElemVal(pPic, ii)); ii++) {
if (c == cChar) {
cInsertion = cChar;
break;
} else if((c != cDecimalPoint)
&& (c != cComma)
&& (c != '0')
&& (c != '/')
&& (c != 'B')){
break;
}
}
}
} else if((cChar == cDecimalPoint)
|| (cChar == 'V')) {
bInFraction = 1;
}
}
if(FldWrk.len == 0) {
free(FldWrk.pic);
return;
}
caWorkData = (char *)malloc(FldWrk.len);
if(!caWorkData) {
free(FldWrk.pic);
return;
}
FldWrk.type = (bIsAlphaEdited) ? DTYPE_ALPHANUMERIC : DTYPE_DISPLAY;
tcob_move(pSrcFld, pSrcData, &FldWrk, caWorkData);
if(!bIsAlphaEdited)
bIsNegative = tcob_extract_sign(&FldWrk, caWorkData);
if(bBlanking) { /* Zero suppression with replacement insertion */
for(i = 0; i < FldWrk.len; ++i)
if(caWorkData[i] != '0')
break;
if(i == FldWrk.len) { /* it is zero, so blank it out */
if (cInsertion == '*') {
unsigned int j, dp = 0;
memset(pDstData, '*', pDstFld->len);
/* reset the decimal point */
for(j=0; (cChar=tcob_picElemVal(pPic, j)); j++) {
if (cChar==cDecimalPoint) {
pDstData[dp] = cChar;
break;
}
dp += tcob_picElemLen(pPic, j);
if (dp >= pDstFld->len)
break;
}
} else {
memset(pDstData, ' ', pDstFld->len);
}
free(FldWrk.pic);
return;
}
}
free(FldWrk.pic);
iSuppress = SUPPRESS_NOT_YET;
bInFraction = 0;
cFloatChar = '\0';
cFillChar = ' ';
iSrcPtr = 0;
iDstPtr = 0;
iDecimalPos = 0;
/* pPic now becomes an expanded version of the PIC string */
pPic = tcob_picExpand(pDstFld);
if(!pPic) {
free(caWorkData);
return;
}
for(i=0; (cChar=pPic[i]); i++, iDstPtr++) {
if((cChar == 'X')
|| (cChar == '9')
|| (cChar == 'A')) {
if((iSuppress == SUPPRESS_YES) /* floating insertion so far */
&& (cFloatChar)) {
pDstData[iDstPtr - 1] = cFloatChar;
}
pDstData[iDstPtr] = caWorkData[iSrcPtr];
iSuppress = SUPPRESS_DONE;
iSrcPtr++;
} else if((cChar == 'Z')
|| (cChar == '*')) {
if (iSuppress == SUPPRESS_DONE) {
pDstData[iDstPtr] = caWorkData[iSrcPtr];
} else if (caWorkData[iSrcPtr] != '0') {
pDstData[iDstPtr] = caWorkData[iSrcPtr];
iSuppress = SUPPRESS_DONE;
} else {
if (cChar == '*')
cFillChar = '*';
pDstData[iDstPtr] = cFillChar;
iSuppress = SUPPRESS_YES;
}
iSrcPtr++;
} else if((cChar == cCurrencySymbol)
|| (cChar == '+')
|| (cChar == '-')) {
char c;
if (cChar == '+') c = (bIsNegative) ? '-' : cChar;
else if(cChar == '-') c = (bIsNegative) ? cChar : ' ';
else c = cChar;
if((!cInsertion)
||(cInsertion == 'Z')
||(cInsertion == '*')) {
pDstData[iDstPtr] = c;
} else { /* floating insertion */
if (iSuppress == SUPPRESS_YES) {
if (caWorkData[iSrcPtr] != '0') {
pDstData[iDstPtr-1] = c;
iSuppress = SUPPRESS_DONE;
} else {
pDstData[iDstPtr] = ' ';
iSrcPtr++;
}
}
if (cChar != cInsertion) {
pDstData[iDstPtr] = c;
} else if (iSuppress == SUPPRESS_DONE) {
pDstData[iDstPtr] = caWorkData[iSrcPtr];
iSrcPtr++;
} else if (iSuppress == SUPPRESS_NOT_YET) {
pDstData[iDstPtr] = ' ';
cFloatChar = c;
iSuppress = SUPPRESS_YES;
}
}
} else if((cChar == cComma) /* simple insertion */
|| (cChar == '0')
|| (cChar == '/')
|| (cChar == 'B')) {
pDstData[iDstPtr] = (iSuppress == SUPPRESS_YES)
? cFillChar
: ((cChar == 'B') ? ' ' : cChar);
} else if(cChar == cDecimalPoint) { /* special insertion */
pDstData[iDstPtr] = cChar;
if ((iSuppress == SUPPRESS_YES) && (cFloatChar))
pDstData[iDstPtr-1] = cFloatChar;
iSuppress = SUPPRESS_DONE;
} else if(cChar == 'V') {
iDstPtr--; /* iDstPtr not incremented */
iDecimalPos = iDstPtr+1;
} else if((cChar == 'C')
&& (pPic[i + 1] == 'R')) {
if(bIsNegative) {
pDstData[iDstPtr] = 'C';
pDstData[iDstPtr+1] = 'R';
} else {
pDstData[iDstPtr] = ' ';
pDstData[iDstPtr+1] = ' ';
}
i++;
iDstPtr++;
} else if((cChar == 'D')
&& (pPic[i + 1] == 'B')) {
if(bIsNegative) {
pDstData[iDstPtr] = 'D';
pDstData[iDstPtr+1] = 'B';
} else {
pDstData[iDstPtr] = ' ';
pDstData[iDstPtr+1] = ' ';
}
i++;
iDstPtr++;
} else {
pDstData[iDstPtr] = cChar;
iSuppress = SUPPRESS_DONE;
}
}
if((iDecimalPos)
&& (iSuppress == SUPPRESS_DONE)) {
for(i=iDecimalPos; i < pDstFld->len; i++) {
if((pDstData[i] >= '0')
&& (pDstData[i] <= '9'))
break;
pDstData[i] = '0';
}
}
free(pPic);
free(caWorkData);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_9 |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_9( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 ) {
unsigned int i;
unsigned int bInDecPortion;
unsigned int bLeadingWhite;
unsigned int bTrailingWhite;
unsigned int iDigitCount;
unsigned int iDecCount;
extern int bDecimalComma;
char *caWork;
unsigned int picLen;
char cDecimalPoint;
char cChar;
char cSign;
struct fld_desc fldWork;
iDigitCount = 0;
iDecCount = 0;
bInDecPortion = 0;
bLeadingWhite = 0;
bTrailingWhite = 0;
cSign = 0;
cDecimalPoint = (bDecimalComma) ? ',' : '.';
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_9 (%d)\n", _iMoveLevel_++);
}
#endif
caWork = (char *)malloc(pfldDesc1->len);
/* de-edit */
/* Check for CR or DB at end to indicate a minus sign */
i = pfldDesc1->len - 2;
if (i >= 0) {
if (((caData1[i] == 'C') && (caData1[i+1] == 'R')) ||
((caData1[i] == 'D') && (caData1[i+1] == 'B'))) {
cSign = 2;
}
}
for(i = 0; i < pfldDesc1->len; ++i) {
cChar = caData1[i];
switch(cChar) {
case '+':
case '-':
if(cSign) {
runtime_error(RTERR_INVALID_DATA, pfldDesc1,
(void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
cSign = (cChar == '+') ? 1 : 2;
break;
case '.':
case ',':
if(cChar == cDecimalPoint) {
bInDecPortion = 1;
}
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
caWork[iDigitCount++] = cChar;
if(bInDecPortion)
iDecCount++;
break;
}
}
memset (&fldWork, 0, sizeof(fldWork));
fldWork.len = iDigitCount;
fldWork.decimals = iDecCount;
fldWork.type = DTYPE_DISPLAY;
picLen = tcob_picReqLen(4);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate(fldWork.pic, picLen, NULL);
if(cSign)
tcob_picAppend(fldWork.pic, picLen, 'S', 1, NULL);
if(iDigitCount > iDecCount)
tcob_picAppend(fldWork.pic, picLen,
'9', iDigitCount - iDecCount, NULL);
if(iDecCount)
tcob_picAppend(fldWork.pic, picLen, 'V', 1, '9', iDecCount, NULL);
if(cSign == 1)
tcob_put_sign(&fldWork, caWork, 0);
if(cSign == 2)
tcob_put_sign(&fldWork, caWork, 1);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, caWork, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_9(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_b |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_b( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int picLen, iLen;
char *caWork;
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_b (%d)\n", _iMoveLevel_++);
}
#endif
memset (&fldWork, 0, sizeof(fldWork));
fldWork.decimals = pfldDesc2->decimals;
fldWork.type = DTYPE_DISPLAY;
fldWork.pscale = pfldDesc2->pscale;
fldWork.all = pfldDesc2->all;
fldWork.just_r = pfldDesc2->just_r;
fldWork.separate_sign = pfldDesc2->separate_sign;
fldWork.leading_sign = pfldDesc2->leading_sign ;
fldWork.len = tcob_picCompLength(pfldDesc2);
picLen = (2 * pfldDesc2->len ) + 1;
fldWork.pic = (char *)malloc(picLen);
memcpy(fldWork.pic, pfldDesc2->pic, picLen);
iLen = tcob_picCompLength(pfldDesc2);
caWork = (char *)malloc(iLen);
memset (caWork, 0, iLen);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_e_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(&fldWork, caWork, "Dest");
}
#endif
tcob_move_e_9(pfldDesc1, caData1, &fldWork, caWork);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_b call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, caWork, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_b(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_f |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_f( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int picLen, iLen;
char *caWork;
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_f (%d)\n", _iMoveLevel_++);
}
#endif
memset (&fldWork, 0, sizeof(fldWork));
fldWork.decimals = pfldDesc2->decimals;
fldWork.type = DTYPE_DISPLAY;
fldWork.pscale = pfldDesc2->pscale;
fldWork.all = pfldDesc2->all;
fldWork.just_r = pfldDesc2->just_r;
fldWork.separate_sign = pfldDesc2->separate_sign;
fldWork.leading_sign = pfldDesc2->leading_sign ;
fldWork.len = tcob_picCompLength(pfldDesc2);
picLen = (2 * pfldDesc2->len ) + 1;
fldWork.pic = (char *)malloc(picLen);
memcpy(fldWork.pic, pfldDesc2->pic, picLen);
iLen = tcob_picCompLength(pfldDesc2);
caWork = (char *)malloc(iLen);
memset (caWork, 0, iLen);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_e_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(&fldWork, caWork, "Dest");
}
#endif
tcob_move_e_9(pfldDesc1, caData1, &fldWork, caWork);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_f call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, caWork, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_f(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_c |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_c( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int picLen, iLen;
char *caWork;
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_c (%d)\n", _iMoveLevel_++);
}
#endif
memset (&fldWork, 0, sizeof(fldWork));
fldWork.decimals = pfldDesc2->decimals;
fldWork.type = DTYPE_DISPLAY;
fldWork.pscale = pfldDesc2->pscale;
fldWork.all = pfldDesc2->all;
fldWork.just_r = pfldDesc2->just_r;
fldWork.separate_sign = pfldDesc2->separate_sign;
fldWork.leading_sign = pfldDesc2->leading_sign ;
fldWork.len = tcob_picCompLength(pfldDesc2);
picLen = (2 * pfldDesc2->len ) + 1;
fldWork.pic = (char *)malloc(picLen);
memcpy(fldWork.pic, pfldDesc2->pic, picLen);
iLen = tcob_picCompLength(pfldDesc2);
caWork = (char *)malloc(iLen);
memset (caWork, 0, iLen);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_e_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(&fldWork, caWork, "Dest");
}
#endif
tcob_move_e_9(pfldDesc1, caData1, &fldWork, caWork);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_c call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, caWork, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_c(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_e |
| |
\*------------------------------------------------------------------------*/
/* Walter */
void tcob_move_e_e( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int picLen, iLen;
char *caWork;
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_e (%d)\n", _iMoveLevel_++);
}
#endif
memset (&fldWork, 0, sizeof(fldWork));
fldWork.decimals = pfldDesc1->decimals;
fldWork.type = DTYPE_DISPLAY;
fldWork.pscale = pfldDesc1->pscale;
fldWork.all = pfldDesc1->all;
fldWork.just_r = pfldDesc1->just_r;
fldWork.separate_sign = pfldDesc1->separate_sign;
fldWork.leading_sign = pfldDesc1->leading_sign ;
fldWork.len = tcob_picEditedCompLength(pfldDesc1);
picLen = tcob_picReqLen(4);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate(fldWork.pic, picLen, NULL);
tcob_picAppend(fldWork.pic, picLen, 'S', 1, NULL);
tcob_picAppend(fldWork.pic, picLen, '9', pfldDesc1->len, NULL);
if(pfldDesc1->decimals)
tcob_picAppend(fldWork.pic, picLen, 'V', 1, '9', pfldDesc1->decimals, NULL);
iLen = tcob_picCompLength(&fldWork) + 1;
caWork = (char *)malloc(iLen);
memset (caWork, 0, iLen);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_e_9 call (%d)\n", _iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(&fldWork, caWork, "Dest");
}
#endif
tcob_move_e_9(pfldDesc1, caData1, &fldWork, caWork);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_9_e call (%d)\n", _iMoveLevel_);
_FLDDUMP_(&fldWork, caWork, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
tcob_move_9_e(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_e |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_eX( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int i, j;
char *caWork, cChar, eChar;
int value; // walter
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_e (%d)\n", _iMoveLevel_++);
}
#endif
caWork = tcob_picExpand(pfldDesc2);
value = 0; /* no number before */
for(i=0, j=0; i < pfldDesc2->len; ++i) {
cChar = caWork[i];
if (pfldDesc1->len > j) {
eChar = caData1[j];
} else {
eChar = ' ';
}
switch(cChar) {
case '9':
if ((eChar > 47) && (eChar < 58)) {
caData2[i] = eChar;
}
else {
caData2[i] = cChar;
}
value = 1; /* number here */
j++;
break;
case 'B':
caData2[i] = ' ';
break;
case 'Z':
if (eChar == 48 && !value) {
caData2[i] = ' ';
}
else {
caData2[i] = eChar;
value = 1; /* number here */
}
j++;
break;
case 'X':
caData2[i] = eChar;
j++;
break;
default:
caData2[i] = cChar;
j++;
break;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
if (j == 0) {
fprintf(stderr, "Debug: Loop dump: tcob_move_e_e: caData1[j=%d]=%c, caData2[i=%d]=%c, caWork[i=%d]=%c, eChar=%c, cChar=%c, (%d)\n", (j), caData1[j], i, caData2[i], i, caWork[i], eChar, cChar, _iMoveLevel_);
}
else {
fprintf(stderr, "Debug: Loop dump: tcob_move_e_e: caData1[j=%d]=%c, caData2[i=%d]=%c, caWork[i=%d]=%c, eChar=%c, cChar=%c, (%d)\n", (j-1), caData1[j-1], i, caData2[i], i, caWork[i], eChar, cChar, _iMoveLevel_);
}
}
#endif
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_move_e_x |
| |
\*------------------------------------------------------------------------*/
void tcob_move_e_x( struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2 )
{
unsigned int picLen, iLen;
char *caWork;
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_e_x (%d)\n", _iMoveLevel_++);
}
#endif
memset (&fldWork, 0, sizeof(fldWork));
fldWork.decimals = pfldDesc1->decimals;
fldWork.type = DTYPE_ALPHANUMERIC;
fldWork.pscale = pfldDesc1->pscale;
fldWork.all = pfldDesc1->all;
fldWork.just_r = pfldDesc1->just_r;
fldWork.separate_sign = pfldDesc1->separate_sign;
fldWork.leading_sign = pfldDesc1->leading_sign ;
fldWork.len = pfldDesc1->len;
picLen = tcob_picReqLen(1);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'X', pfldDesc1->len, NULL);
iLen = pfldDesc1->len;
caWork = (char *)malloc(iLen);
memcpy (caWork, caData1, iLen);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: before tcob_move_x_x call (%d)\n", _iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(&fldWork, caWork, "Dest");
}
#endif
tcob_move_x_x(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_e_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
BIN
View File
Binary file not shown.
+342
View File
@@ -0,0 +1,342 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
#include "htcoblib.h"
extern int bDecimalComma;
//#define DEBUG_MOVE_RTS 1
/*--------------------------------------------------------------------------*\
| |
| Move routines where the source field is DTYPE_BINARY |
| |
\*--------------------------------------------------------------------------*/
void tcob_move_f_9(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned int picLen;
char caFormat[20];
struct fld_desc fldWork;
double dWork=0;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_9 (%d)\n", _iMoveLevel_++);
}
#endif
fldWork.type = DTYPE_ALPHANUMERIC;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 4:
dWork = (double)(*(float *)caData1);
break;
case 8:
dWork = *(double *)caData1;
break;
}
// The following statements are wrong: the first one because it doesn't
// allow more than 6 decimal places, the second because it rounds before
// formatting. We have to design our own sprintf in the spirit of what is
// done in dtofld.
sprintf(caFormat, "%%%df", MAX_DIGITS);
// sprintf(caFormat, "%%%d.%df", MAX_DIGITS, pfldDesc2->decimals+1);
sprintf(caWork, caFormat, dWork);
// If decimal point is comma, replace point by comma.
fldWork.len = strlen(caWork);
if (bDecimalComma){
unsigned int i;
for(i=0;i<fldWork.len;i++){
if (caWork[i] == '.')
caWork[i]=',';
}
}
picLen = tcob_picReqLen(1);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'X', fldWork.len, NULL);
tcob_move_x_9(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_f_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
fprintf(stderr, "dWork:%e, fmt:%s\n", dWork, caFormat);
}
#endif
free(fldWork.pic);
return;
}
void tcob_move_f_b(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned int picLen;
char caFormat[20];
struct fld_desc fldWork;
double dWork=0;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_b (%d)\n", _iMoveLevel_++);
}
#endif
fldWork.type = DTYPE_ALPHANUMERIC;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 4:
dWork = (double)(*(float *)caData1);
break;
case 8:
dWork = *(double *)caData1;
break;
}
sprintf(caFormat, "%%%df", MAX_DIGITS);
sprintf(caWork, caFormat, dWork);
fldWork.len = strlen(caWork);
picLen = tcob_picReqLen(1);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'X', fldWork.len, NULL);
tcob_move_x_b(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_f_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
void tcob_move_f_c(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned int picLen;
char caFormat[20];
struct fld_desc fldWork;
double dWork=0;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_c (%d)\n", _iMoveLevel_++);
}
#endif
fldWork.type = DTYPE_ALPHANUMERIC;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 4:
dWork = (double)(*(float *)caData1);
break;
case 8:
dWork = *(double *)caData1;
break;
}
sprintf(caFormat, "%%%df", MAX_DIGITS);
sprintf(caWork, caFormat, dWork);
fldWork.len = strlen(caWork);
picLen = tcob_picReqLen(1);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'X', fldWork.len, NULL);
tcob_move_x_c(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_f_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
void tcob_move_f_e(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_e (%d)\n", _iMoveLevel_++);
}
#endif
tcob_move_edited(pfldDesc1, caData1, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_f_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_f_f(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
double dWork=0;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_f (%d)\n", _iMoveLevel_++);
}
#endif
switch(pfldDesc1->len) {
case 4:
dWork = (double)(*(float *)caData1);
break;
case 8:
dWork = *(double *)caData1;
break;
}
switch(pfldDesc2->len) {
case 4:
*(float *)caData2 = (float)dWork;
break;
case 8:
*(double *)caData2 = dWork;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_f_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_f_x(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS + 2];
unsigned int picLen;
char caFormat[20];
struct fld_desc fldWork;
double dWork=0;
unsigned int i, j;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_f_x (%d)\n", _iMoveLevel_++);
}
#endif
fldWork.type = DTYPE_ALPHANUMERIC;
fldWork.decimals = 0;
fldWork.pscale = 0;
fldWork.all = pfldDesc1->all;
fldWork.just_r = 0;
fldWork.separate_sign = 0;
fldWork.leading_sign = 0;
switch(pfldDesc1->len) {
case 4:
dWork = (double)(*(float *)caData1);
break;
case 8:
dWork = *(double *)caData1;
break;
}
sprintf(caFormat, "%%%df", MAX_DIGITS);
sprintf(caWork, caFormat, dWork);
#ifdef DEBUG_MOVE_RTS
fprintf(stderr, "Debug tcob_move_f_x 0 : caWork=%s:\n", caWork);
#endif
// Remove sign and decimal point
fldWork.len = strlen(caWork);
for (i=0, j=0; i<fldWork.len; i++) {
if ((caWork[i] != '-') && (caWork[i] != '.') && (caWork[i] != ' ')){
caWork[j] = caWork[i];
#ifdef DEBUG_MOVE_RTS
fprintf(stderr, "Debug tcob_move_f_x 1 :caWork[i=%d]=%c: :caWork[j=%d]=%c:\n",
i, caWork[i], j, caWork[j]);
#endif
j++;
}
#ifdef DEBUG_MOVE_RTS
fprintf(stderr, "Debug tcob_move_f_x 2 :caWork[i=%d]=%c: :caWork[j=%d]=%c:\n",
i, caWork[i], j, caWork[j]);
#endif
}
caWork[j] = '\0';
fldWork.len = strlen(caWork);
picLen = tcob_picReqLen(1);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate (fldWork.pic, picLen, 'X', fldWork.len, NULL);
tcob_move_x_x(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug tcob_move_f_x 3 : caWork=%s:\n", caWork);
fprintf(stderr, "Debug: Leaving tcob_move_f_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
return;
}
BIN
View File
Binary file not shown.
+422
View File
@@ -0,0 +1,422 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
#include "htcoblib.h"
//#define DEBUG_MOVE_RTS 1
/*--------------------------------------------------------------------------*\
| |
| Move routines where the source field is DTYPE_ALPHANUMERIC |
| |
\*--------------------------------------------------------------------------*/
void tcob_move_x_9(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i;
unsigned int bInDecPortion;
unsigned int bLeadingWhite;
unsigned int bTrailingWhite;
unsigned int iDigitCount;
unsigned int iDecCount;
extern int bDecimalComma;
char *caWork;
char caAll[MAX_DIGITS + 1];
unsigned int picLen;
char cDecimalPoint;
char cChar;
char cSign;
struct fld_desc fldWork;
struct fld_desc SrcFld;
iDigitCount = 0;
iDecCount = 0;
bInDecPortion = 0;
bLeadingWhite = 1;
bTrailingWhite = 0;
cSign = 0;
cDecimalPoint = (bDecimalComma) ? ',' : '.';
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_9 (%d)\n", _iMoveLevel_++);
}
#endif
if(pfldDesc1->all) { /* move all */
memcpy(&SrcFld, pfldDesc2, sizeof(SrcFld));
if(caData1[0] == 0x00) {
memset(caAll, '0', SrcFld.len);
} else if(caData1[0] == (char)0xFF) {
memset(caAll, '9', SrcFld.len);
} else if((pfldDesc1->len == 1) && (caData1[0] == ' ')) {
/* This is a temporary hack due to the parser
* attempting to initialize numeric edited fields
* to SPACES. */
memset(caAll, '0', SrcFld.len);
} else {
unsigned int rem = SrcFld.len % pfldDesc1->len;
for(i = 0; i < (SrcFld.len - rem); i += pfldDesc1->len)
memcpy(caAll+i, caData1, pfldDesc1->len);
memcpy(caAll+i, caData1, rem);
}
if(tcob_picElemVal(SrcFld.pic,0) == 'S') {
SrcFld.separate_sign = 1;
SrcFld.leading_sign = 0;
caAll[SrcFld.len++] = '+';
}
pfldDesc1 = &SrcFld;
caData1 = caAll;
}
caWork = (char *)malloc(pfldDesc1->len);
for(i = 0; i < pfldDesc1->len; ++i) {
cChar = caData1[i];
switch(cChar) {
case '+':
case '-':
if(cSign) {
runtime_error(RTERR_INVALID_DATA, pfldDesc1,
(void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
cSign = (cChar == '+') ? 1 : 2;
bLeadingWhite = 0;
if(bTrailingWhite) {
runtime_error(RTERR_INVALID_DATA, pfldDesc1,
(void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
break;
case '.':
case ',':
bLeadingWhite = 0;
if(bTrailingWhite) {
runtime_error(RTERR_INVALID_DATA, pfldDesc1,
(void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
if(cChar == cDecimalPoint) {
bInDecPortion = 1;
}
break;
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
bLeadingWhite = 0;
if(bTrailingWhite) {
runtime_error(RTERR_INVALID_DATA, pfldDesc1,
(void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
caWork[iDigitCount++] = cChar;
if(bInDecPortion)
iDecCount++;
break;
case ' ':
case '\t':
if(!bLeadingWhite)
bTrailingWhite = 1;
break;
default:
runtime_error(RTERR_INVALID_DATA, pfldDesc1, (void *)caData1);
memset(caData2, '0', pfldDesc2->len);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(caWork);
return;
}
}
memset (&fldWork, 0, sizeof(fldWork));
fldWork.len = iDigitCount;
fldWork.decimals = iDecCount;
fldWork.type = DTYPE_DISPLAY;
picLen = tcob_picReqLen(4);
fldWork.pic = (char *)malloc(picLen);
tcob_picCreate(fldWork.pic, picLen, NULL);
if(cSign)
tcob_picAppend(fldWork.pic, picLen, 'S', 1, NULL);
if(iDigitCount > iDecCount)
tcob_picAppend(fldWork.pic, picLen,
'9', iDigitCount - iDecCount, NULL);
if(iDecCount)
tcob_picAppend(fldWork.pic, picLen, 'V', 1, '9', iDecCount, NULL);
if(cSign == 1)
tcob_put_sign(&fldWork, caWork, 0);
if(cSign == 2)
tcob_put_sign(&fldWork, caWork, 1);
tcob_move_9_9(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_9 (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
free(fldWork.pic);
free(caWork);
return;
}
void tcob_move_x_b(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS];
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_b (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fldWork, pfldDesc2, sizeof(struct fld_desc));
fldWork.type = DTYPE_DISPLAY;
fldWork.len = MAX_DIGITS;
tcob_move_x_9(pfldDesc1, caData1, &fldWork, caWork);
tcob_move_9_b(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_b (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_x_c(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS];
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_c (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fldWork, pfldDesc2, sizeof(struct fld_desc));
fldWork.type = DTYPE_DISPLAY;
tcob_move_x_9(pfldDesc1, caData1, &fldWork, caWork);
tcob_move_9_c(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_c (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_x_e(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_e (%d)\n", _iMoveLevel_++);
}
#endif
tcob_move_edited(pfldDesc1, caData1, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_e (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_x_f(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
char caWork[MAX_INTEGERS + MAX_DECIMALS];
struct fld_desc fldWork;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_f (%d)\n", _iMoveLevel_++);
}
#endif
memcpy(&fldWork, pfldDesc2, sizeof(struct fld_desc));
fldWork.type = DTYPE_DISPLAY;
fldWork.len = MAX_DIGITS;
tcob_move_x_9(pfldDesc1, caData1, &fldWork, caWork);
tcob_move_9_f(&fldWork, caWork, pfldDesc2, caData2);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_f (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
void tcob_move_x_x(struct fld_desc *pfldDesc1, char *caData1,
struct fld_desc *pfldDesc2, char *caData2) {
unsigned int i, j, k;
char *p;
int spaces;
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Enter tcob_move_x_x (%d)\n", _iMoveLevel_++);
}
#endif
if(pfldDesc1->all) { /* this is a 'move all' */
i = 0;
j = 0;
k = pfldDesc1->len;
while(i < pfldDesc2->len) {
caData2[i++] = caData1[j++];
if(j == k)
j = 0;
}
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
} /* END OF MOVE ALL CODE */
memset(caData2, ' ', pfldDesc2->len);
if(pfldDesc1->len > pfldDesc2->len) {
if(pfldDesc2->just_r)
k = pfldDesc1->len - pfldDesc2->len;
else
k = 0;
j = 0;
i = pfldDesc2->len;
}
else {
if(pfldDesc2->just_r)
j = pfldDesc2->len - pfldDesc1->len;
else
j = 0;
k = 0;
i = pfldDesc1->len;
}
if(!pfldDesc2->just_r){
j = 0;
} else {
spaces = 0;
p = caData1 + pfldDesc1->len - 1;
while((*p == ' ')&&(p >= caData1)){
spaces ++;
p--;
}
i = i - spaces;
j = j + spaces;
}
//memmove(&caData2 [j], &caData1 [k], i);
memmove(caData2 + j, caData1 + k, i);
#ifdef DEBUG_MOVE_RTS
{
extern int _iMoveLevel_;
fprintf(stderr, "Debug: Leaving tcob_move_x_x (%d)\n", --_iMoveLevel_);
_FLDDUMP_(pfldDesc1, caData1, "Source");
_FLDDUMP_(pfldDesc2, caData2, "Dest");
}
#endif
return;
}
BIN
View File
Binary file not shown.
+307
View File
@@ -0,0 +1,307 @@
/*
Copyright (C) 1999-2003 Rildo Pragana, Jim Noeth,
Andrew Cameron, David Essex.
Copyright (C) 1993, 1991 Rildo Pragana.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2.1,
or (at your option) any later version.
This library 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place,
Suite 330, Boston, MA 02111-1307 USA
*/
/*
Cobol Compiler Run Time Library
Managing the configuration file
*/
#include "config.h"
static int config_loaded = 0;
static int keys_loaded = 0;
static struct config_item *configuration=NULL;
/* install pair key / value */
static void install_keyvalue(char *key,char *value){
struct config_item *item;
struct config_item *last;
char *p;
p=key + strlen(value) -1 ;
while ((*p == ' ')||(*p == '\t')||(*p == '\n')) {
*p=0;
p--;
}
value+=strspn(value," \t");
p=value + strlen(value) -1 ;
while ((*p == ' ')||(*p == '\t')||(*p == '\n')) {
*p=0;
p--;
}
item=malloc(sizeof(struct config_item));
memset(item,0,sizeof(struct config_item));
item->key=strdup(key);
item->value=strdup(value);
item->intvalue=atoi(value);
if (configuration) {
last=configuration;
while (last->next) {last=last->next;}
last->next=item;
}
else configuration=item;
}
/* load configuration file */
static int load_config() {
FILE *file;
char config_line[CONFIG_MAXLINE];
char *p,*key,*value;
if (config_loaded)
return 0;
if ((p = getenv (TCOBRT_CONFIG_DIR)) != NULL) {
strcpy (config_line, p);
}
else {
strcpy (config_line, COBDIR_DEFAULT);
}
strcat (config_line, LT_DIRSEP_STR);
strcat (config_line, RTOPTFILE_DEFAULT);
if ((file=fopen(config_line, "r")) == NULL){
return -1;
}
fgets (config_line, CONFIG_MAXLINE, file);
while (!feof (file)) {
p=strchr(config_line,'#');
if (p) p[0]='\0'; /* Strip the comments from line */
key=strtok(config_line,"= \t");
if (key) {
value=strtok(NULL,"");
if (value) {
install_keyvalue(key,value);
}
}
fgets (config_line, CONFIG_MAXLINE, file); /* get next line */
}
fclose(file);
config_loaded = 1;
return 1;
}
static struct config_item *find_config_item(char *key){
struct config_item *item=configuration;
while(item){
if (strcmp(key,item->key)==0) return item;
item = item->next;
}
return NULL;
}
char *tcob_get_str_config(char *key){
struct config_item *item;
load_config();
item = find_config_item(key);
if (item)
return item->value;
return NULL;
}
int tcob_get_int_config(char *key){
struct config_item *item;
load_config();
item = find_config_item(key);
if (item)
return item->intvalue;
return 0;
}
/*
* Default values
*
*/
static struct KeyBinding keyBindings[] = {
/* Key Code , Action on edit , screen status */
{TCOBKEY_DECIMALPT, EDIT_DECIMALPT, TCOBKEY_DECIMALPT},
{TCOBKEY_DECIMALCOMMA, EDIT_NOP, TCOBKEY_DECIMALCOMMA},
{TCOBKEY_ESCAPE, EDIT_TERMINATE, TCOBKEY_ESCAPE}, /* Escape Key */
{TCOBKEY_RETURN, EDIT_TERMINATE, 13}, /* For RETURN, we finish the edit mode */
{KEY_ENTER, EDIT_TERMINATE, 13}, /* ENTER does the same as RETURN */
{KEY_LEFT, EDIT_LEFT, KEY_LEFT},
{KEY_RIGHT, EDIT_RIGHT, KEY_RIGHT},
{KEY_HOME, EDIT_FIRST, KEY_HOME},
{KEY_END, EDIT_LAST, KEY_END},
{KEY_UP, EDIT_UP_FIELD, KEY_UP},
{KEY_DOWN, EDIT_DOWN_FIELD, KEY_NEXT},
{TCOBKEY_TAB, EDIT_NEXT_FIELD, TCOBKEY_TAB}, /* Tab */
{KEY_BTAB, EDIT_PREV_FIELD, KEY_BTAB},
{CTRL('n'), EDIT_NEXT_FIELD, 14},
{CTRL('p'), EDIT_PREV_FIELD, 16},
{CTRL('f'), EDIT_FIRST_FIELD, 6},
{CTRL('l'), EDIT_LAST_FIELD, 12},
{KEY_DC, EDIT_DELETE, KEY_DC},
{KEY_IC, EDIT_INSERT, KEY_IC},
{KEY_BACKSPACE, EDIT_BACKSPACE, KEY_BACKSPACE},
{KEY_PPAGE, EDIT_TERMINATE, KEY_PPAGE},
{KEY_NPAGE, EDIT_TERMINATE, KEY_NPAGE},
{KEY_F(1), EDIT_TERMINATE, KEY_F(1)},
{KEY_F(2), EDIT_TERMINATE, KEY_F(2)},
{KEY_F(3), EDIT_TERMINATE, KEY_F(3)},
{KEY_F(4), EDIT_TERMINATE, KEY_F(4)},
{KEY_F(5), EDIT_TERMINATE, KEY_F(5)},
{KEY_F(6), EDIT_TERMINATE, KEY_F(6)},
{KEY_F(7), EDIT_TERMINATE, KEY_F(7)},
{KEY_F(8), EDIT_TERMINATE, KEY_F(8)},
{KEY_F(9), EDIT_TERMINATE, KEY_F(9)},
{KEY_F(10), EDIT_TERMINATE, KEY_F(10)},
{KEY_F(11), EDIT_TERMINATE, KEY_F(11)},
{KEY_F(12), EDIT_TERMINATE, KEY_F(12)},
{TCOBKEY_AUTOCLEANALL,EDIT_NOP,0},
{0, 0, 0}
};
static int get_key_code(char *key){
if (strcmp("KEY_ESC",key)==0) return TCOBKEY_ESCAPE;
if (strcmp("KEY_RETURN",key)==0) return TCOBKEY_RETURN;
if (strcmp("KEY_ENTER",key)==0) return KEY_ENTER;
if (strcmp("KEY_LEFT",key)==0) return KEY_LEFT;
if (strcmp("KEY_RIGHT",key)==0) return KEY_RIGHT;
if (strcmp("KEY_HOME",key)==0) return KEY_HOME;
if (strcmp("KEY_END",key)==0) return KEY_END;
if (strcmp("KEY_UP",key)==0) return KEY_UP;
if (strcmp("KEY_DOWN",key)==0) return KEY_DOWN;
if (strcmp("KEY_TAB",key)==0) return TCOBKEY_TAB;
if (strcmp("KEY_BTAB",key)==0) return KEY_BTAB;
if (strcmp("KEY_CTRL_A",key)==0) return CTRL('a');
if (strcmp("KEY_CTRL_B",key)==0) return CTRL('b');
if (strcmp("KEY_CTRL_C",key)==0) return CTRL('c');
if (strcmp("KEY_CTRL_D",key)==0) return CTRL('d');
if (strcmp("KEY_CTRL_E",key)==0) return CTRL('e');
if (strcmp("KEY_CTRL_F",key)==0) return CTRL('f');
if (strcmp("KEY_CTRL_G",key)==0) return CTRL('g');
if (strcmp("KEY_CTRL_H",key)==0) return CTRL('h');
if (strcmp("KEY_CTRL_I",key)==0) return CTRL('i');
if (strcmp("KEY_CTRL_J",key)==0) return CTRL('j');
if (strcmp("KEY_CTRL_K",key)==0) return CTRL('k');
if (strcmp("KEY_CTRL_L",key)==0) return CTRL('l');
if (strcmp("KEY_CTRL_M",key)==0) return CTRL('m');
if (strcmp("KEY_CTRL_N",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_O",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_P",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_Q",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_R",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_S",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_T",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_U",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_V",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_W",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_X",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_Y",key)==0) return CTRL('n');
if (strcmp("KEY_CTRL_Z",key)==0) return CTRL('n');
if (strcmp("KEY_DELETE",key)==0) return KEY_DC;
if (strcmp("KEY_INSERT",key)==0) return KEY_IC;
if (strcmp("KEY_BACKSPACE",key)==0) return KEY_BACKSPACE;
if (strcmp("KEY_NPAGE",key)==0) return KEY_NPAGE;
if (strcmp("KEY_PPAGE",key)==0) return KEY_PPAGE;
if (strcmp("KEY_F1",key)==0) return KEY_F(1);
if (strcmp("KEY_F2",key)==0) return KEY_F(2);
if (strcmp("KEY_F3",key)==0) return KEY_F(3);
if (strcmp("KEY_F4",key)==0) return KEY_F(4);
if (strcmp("KEY_F5",key)==0) return KEY_F(5);
if (strcmp("KEY_F6",key)==0) return KEY_F(6);
if (strcmp("KEY_F7",key)==0) return KEY_F(7);
if (strcmp("KEY_F8",key)==0) return KEY_F(8);
if (strcmp("KEY_F9",key)==0) return KEY_F(9);
if (strcmp("KEY_F10",key)==0) return KEY_F(10);
if (strcmp("KEY_F11",key)==0) return KEY_F(11);
if (strcmp("KEY_F12",key)==0) return KEY_F(12);
if (strcmp("KEY_AUTOCLEANALL",key)==0) return TCOBKEY_AUTOCLEANALL;
if (strcmp("KEY_DECIMALPT",key)==0) return TCOBKEY_DECIMALPT;
if (strcmp("KEY_DECIMALCOMMA",key)==0) return TCOBKEY_DECIMALCOMMA;
return -1;
}
int get_edit_code(char *code){
if (strcmp("EDIT_FIRST_FIELD",code)==0) return EDIT_FIRST_FIELD;
if (strcmp("EDIT_LAST_FIELD",code)==0) return EDIT_LAST_FIELD;
if (strcmp("EDIT_UP_FIELD",code)==0) return EDIT_UP_FIELD;
if (strcmp("EDIT_DOWN_FIELD",code)==0) return EDIT_DOWN_FIELD;
if (strcmp("EDIT_NEXT_FIELD",code)==0) return EDIT_NEXT_FIELD;
if (strcmp("EDIT_PREV_FIELD",code)==0) return EDIT_PREV_FIELD;
if (strcmp("EDIT_LEFT",code)==0) return EDIT_LEFT;
if (strcmp("EDIT_RIGHT",code)==0) return EDIT_RIGHT;
if (strcmp("EDIT_FIRST",code)==0) return EDIT_FIRST;
if (strcmp("EDIT_LAST",code)==0) return EDIT_LAST;
if (strcmp("EDIT_INSERT",code)==0) return EDIT_INSERT;
if (strcmp("EDIT_BACKSPACE",code)==0) return EDIT_BACKSPACE;
if (strcmp("EDIT_DELETE",code)==0) return EDIT_DELETE;
if (strcmp("EDIT_TERMINATE",code)==0) return EDIT_TERMINATE;
if (strcmp("EDIT_CLEAR",code)==0) return EDIT_CLEAR;
if (strcmp("EDIT_CLEAR_TOEND",code)==0) return EDIT_CLEAR_TOEND;
if (strcmp("EDIT_DECIMALPT",code)==0) return EDIT_DECIMALPT;
if (strcmp("EDIT_NOP",code)==0) return EDIT_NOP;
return -1;
}
static void install_keybinding(char *key,char *value){
int keycode;
char *edit_name,*terminate_name;
int i,edit_code,terminate_value;
keycode=get_key_code(key);
if (keycode < 0) return ; /* unknown key */
edit_name = strtok(value," \t");
terminate_name = strtok(NULL," \t");
if (edit_name == NULL) return; /* no action defined */
edit_code=get_edit_code(edit_name);
if (terminate_name) terminate_value=atoi(terminate_name);
else terminate_value = 0;
i=0;
while(keyBindings[i].keyCode){
if (keyBindings[i].keyCode==keycode){
keyBindings[i].action=edit_code;
keyBindings[i].screenStatus=terminate_value;
return;
}
i++;
}
return;
}
struct KeyBinding * tcob_get_keybindings(){
struct config_item *item;
load_config();
if (keys_loaded) return keyBindings;
item=configuration;
while(item){
if(strncmp(item->key,"KEY_",4)==0){
install_keybinding(item->key,item->value);
}
item=item->next;
}
keys_loaded=1;
return keyBindings;
}
+80
View File
@@ -0,0 +1,80 @@
/*
Copyright (C) 2002,2001, 2000, 1999, Rildo Pragana, Jim Noeth,
Andrew Cameron, David Essex.
Copyright (C) 1993, 1991 Rildo Pragana.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public License
as published by the Free Software Foundation; either version 2.1,
or (at your option) any later version.
This library 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 Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; see the file COPYING.LIB. If
not, write to the Free Software Foundation, Inc., 59 Temple Place,
Suite 330, Boston, MA 02111-1307 USA
*/
/*
Cobol Compiler Run Time Library
Managing the configuration file
*/
#ifndef _CONFIG_H
#define _CONFIG_H
#ifndef LT_DIRSEP_CHAR
#define LT_DIRSEP_CHAR '/'
#endif
#ifndef LT_DIRSEP_STR
#define LT_DIRSEP_STR "/"
#endif
#include "htcoblib.h"
#include "screenio.h"
#if defined(SunOS)
#include <curses.h>
#else
# if defined(__CYGWIN__)
# include <ncurses/ncurses.h>
# else
# if defined(__MINGW32__)
# include <curses.h>// # include <pdcurses.h>
# else
# include <curses.h>
# endif
# endif
#endif
#include "rterrors.h"
/* define a macro for CTRL modifier on keys */
#ifndef CTRL
#define CTRL(x) ((x) & 0x1f)
#endif
/* PDcurses 2.4 does not have the following defenetion */
#ifndef KEY_CODE_YES
#define KEY_CODE_YES 0x100 /* A wchar_t contains a key code */
#endif
//#define CONFIG_FILENAME "htrtconf"
#define CONFIG_MAXLINE 256
#define TCOBRT_CONFIG_DIR "TCOB_RTCONFIG_PATH"
struct config_item {
char *key;
char *value;
int intvalue;
struct config_item *next;
};
char *tcob_get_str_config(char *key);
int tcob_get_int_config(char *key);
struct KeyBinding * tcob_get_keybindings();
#endif /* _CONFIG_H */
BIN
View File
Binary file not shown.
+59
View File
@@ -0,0 +1,59 @@
/*
* Copyright (C) 2004 David Essex.
* Copyright (C) 2001, 2000, 1999 Rildo Pragana, Jim Noeth,
* Andrew Cameron, David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*
*
* This source is derived from a post on the MinGW list by Wu Yongwei.
*
* Emulates some of the POSIX functions found in "dlfcn.h"
*
*/
#ifndef _DLFCN_WIN32_H
#define _DLFCN_WIN32_H
#ifdef WIN32_LEAN_AND_MEAN
# include <windows.h>
#else
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# undef WIN32_LEAN_AND_MEAN
#endif
#include <errno.h>
#define dlopen(P,G) (void*)LoadLibrary(P)
#define dlsym(D,F) (void*)GetProcAddress((HMODULE)(D),(F))
#define dlclose(D) FreeLibrary((HMODULE)(D))
__inline const char* dlerror()
{
static char szMsgBuf[256];
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL,
GetLastError(),
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
szMsgBuf,
sizeof szMsgBuf,
NULL);
return szMsgBuf;
}
#endif /* _DLFCN_WIN32_H */
+706
View File
@@ -0,0 +1,706 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
//
// TinyCOBOL Run Time Library
// Dynamic CALL statement functions
//
#include "htcoblib.h"
#include "rterrors.h"
#ifndef PATH_MAX
#define PATH_MAX 1024
#endif
#define SUBR_HASHLEN 128
#define HTCOB_PATH_PWD_STR "."
/* max of 64 chars sub-routine names */
#define HTCOB_DYNLIBS_MAX_NAME 65
#ifdef __MINGW32__
#include "dlfcnwin32.h"
#else
#include <dlfcn.h>
#include <glob.h>
#endif // MINGW32
#ifdef __WINDOWS__
#define HTCOB_DYNLIBS_PATTERN "*.dll"
#define HTCOB_DYNLIBS_SUFIX ".dll"
#define HTCOB_PATH_SEP_CHAR ';'
#define HTCOB_PATH_DELIM_STR "\\"
#else
#define HTCOB_DYNLIBS_PATTERN "*.so"
#define HTCOB_DYNLIBS_SUFIX ".so"
#define HTCOB_PATH_SEP_CHAR ':'
#define HTCOB_PATH_DELIM_STR "/"
#endif
extern struct runelement_info *running_element; // walter 12-12-05 /* the current run element */
extern struct element_order *elementorder; // walter 12-12-05
/* store sub-routine names */
static char subrname[PATH_MAX];
static char subr_libname[PATH_MAX];
static struct resolve_handle
{
void *handle;
struct resolve_handle *next;
} *resolve_handles = NULL;
/*
this mini-symtable will register previously called subroutines
to speed up resolving their names to pointers
*/
static struct subr_desc
{
char name[255];
void *(*subr)();
struct subr_desc *next;
} subrtab[SUBR_HASHLEN];
#ifndef __MINGW32__
static char libs_pattern[] = HTCOB_DYNLIBS_PATTERN;
#endif
/*------------------------------------------------------------------------*\
| |
| subr_hash |
| |
\*------------------------------------------------------------------------*/
static int
subr_hash(char *s)
{
int val = 0, i;
for (i = 0; s[i] != '\0'; i++)
val += s[i];
return (val % SUBR_HASHLEN);
}
/*------------------------------------------------------------------------*\
| |
| savename |
| |
\*------------------------------------------------------------------------*/
static char *
savename(char *s)
{
char *ap;
if ((ap = (char *) tcob_malloc(strlen(s) + 1)) != NULL)
strcpy(ap, s);
return (ap);
}
/*------------------------------------------------------------------------*\
| |
| subr_lookup |
| |
\*------------------------------------------------------------------------*/
static int initialized = 0;
static struct subr_desc *
subr_lookup(char *s)
{
struct subr_desc *sd;
if (!initialized)
{
memset(&subrtab[0], 0x00, sizeof (subrtab));
initialized = 1;
return NULL;
}
for (sd = &subrtab[subr_hash(s)]; sd != NULL; sd = sd->next)
if (strcmp(s, sd->name) == 0)
return sd;
return NULL;
}
/*------------------------------------------------------------------------*\
| |
| subr_install |
| |
\*------------------------------------------------------------------------*/
static struct subr_desc *
subr_install(char *name, void *(*subr)())
{
int val;
struct subr_desc *sd = subr_lookup(name);
struct element_order *eo = NULL;
struct element_order *eop = NULL;
if (sd == NULL)
{
sd = tcob_malloc(sizeof (struct subr_desc));
if (sd == NULL)
return NULL;
strcpy(sd->name, name);
val = subr_hash(sd->name);
sd->next = &subrtab[val];
sd->subr = subr;
memcpy(&subrtab[val], sd, sizeof (struct subr_desc));
free(sd);
}
eo = elementorder;
eop = eo;
while (eo)
{ // find module name
if (!strcmp(name, eo->module_name))
break;
eop = eo;
eo = eo->next;
}
if (!eo)
{
eo = calloc(1, sizeof (struct element_order));
if (!elementorder) // first try
elementorder = eo;
else
eop->next = eo;
eo->module_name = savename(name);
eo->who_call = savename(running_element->name); //calloc(1, strlen(running_element->name)+1);
eo->next = NULL;
}
return sd;
}
/*------------------------------------------------------------------------*\
| |
| subr_uninstall |
| |
\*------------------------------------------------------------------------*/
static void
subr_uninstall(char *name)
{
struct subr_desc *sd = NULL;
struct subr_desc *ant = NULL;
int hash;
hash = subr_hash(name);
for (sd = &subrtab[hash]; sd; sd = sd->next)
{
if (strcmp(name, sd->name) == 0)
{
if (!ant)
memcpy(&subrtab[hash], sd->next, sizeof (struct subr_desc));
else
ant->next = sd->next;
memset(sd,0x00, sizeof (struct subr_desc));
return;
}
ant = sd;
}
}
/*------------------------------------------------------------------------*\
| |
| module_install |
| |
\*------------------------------------------------------------------------*/
static void
module_install(void *module)
{
struct resolve_handle *rh;
rh = tcob_malloc(sizeof (struct resolve_handle));
rh->handle = module;
rh->next = resolve_handles;
resolve_handles = rh;
}
/*------------------------------------------------------------------------*\
| |
| tcob_resolve_subr_error |
| |
\*------------------------------------------------------------------------*/
void
tcob_resolve_subr_error(void)
{
fprintf(stderr, "*** RT Error: dynamic library call \"%s\" not found!\n",subrname);
}
/*
*
* tcob_resolve_in_previous_libs
*
* Try to resolve a routine handler on previous opened libs
*
*
*/
static void *
tcob_resolve_in_previous_libs(char *subrname)
{
struct resolve_handle *rh;
void *(* _dynsubr)() = NULL;
for (rh = resolve_handles; rh != NULL; rh = rh->next)
{
_dynsubr = dlsym(rh->handle, subrname);
if (_dynsubr != NULL)
{
subr_install(subrname, _dynsubr);
return _dynsubr;
}
}
return NULL;
}
/*
*
* tcob_cancel_subr
*
* Cancel a dynamically loaded module and uninstall it.
*
*/
void
tcob_cancel_subr(char *name, char *running)
{
struct element_order *eo;
struct element_order *eop;
eo = elementorder;
eop = eo;
while (eo)
{
if (strcmp(name, eo->module_name) != 0)
break;
eop = eo;
eo = eo->next;
}
if (!eo)
return;
if (strcmp(running, eo->who_call) != 0) // you can't remove module that you did't call
return;
eop->next = NULL;
if (eo->next)
eop->next = eo->next;
if (eo == elementorder)
{
free(elementorder);
elementorder = eop->next;
}
else
free(eo);
subr_uninstall(name);
}
/*
* tcob_find_in_lib
*
* Try to find a library handler on a library name
*
*/
static void *
tcob_find_in_lib(char *rutname, char *libname)
{
void *(* _dynsubr)() = NULL;
void *module;
module = dlopen(libname, RTLD_LAZY);
if (module != NULL)
{
_dynsubr = dlsym(module, subrname);
if (_dynsubr != NULL)
{
subr_install(rutname, _dynsubr);
// save for speeding up next search
module_install(module);
// return the resolved handler
return _dynsubr;
}
dlclose(module);
}
return NULL;
}
/*
* tcob_resolve
*
* Try to resolve the routine name
* The paths specified by LD_LIBRARY_PATH and TCOB_LD_LIBRARY_PATH
*
*/
void *
tcob_resolve(char *subrname)
{
void *(* _dynsubr)() = NULL;
#ifndef __MINGW32__
glob_t g;
char **libname;
char *ldlib = NULL, *libs1 = NULL, *libstmp = NULL;
#else
char *libs1 = NULL, *libstmp = NULL;
#endif
char *libs = NULL;
struct subr_desc *sd; // walter 25-10-05
//char *libs1 = NULL, *libstmp=NULL;
// search in previously opened library handles
// check if we've not seen this before
if ((sd = subr_lookup(subrname)) != NULL)
{ // walter 25-10-05
return (sd->subr);
}
// search our currently linked libraries
// and the calling program
#ifndef __MINGW32__
_dynsubr = tcob_find_in_lib(subrname, NULL);
if (_dynsubr)
{
return _dynsubr;
}
// This may be equivalent but does not seam to work on Win32
// #else
// GetModuleFileName (NULL, subr_libname, sizeof (subr_libname));
// _dynsubr = tcob_find_in_lib(subrname, subr_libname);
// if (_dynsubr) {
// return _dynsubr;
// }
#endif
// search in previously opened library handles
_dynsubr = tcob_resolve_in_previous_libs(subrname);
if (_dynsubr)
{
return _dynsubr;
}
// First find a library named as the routine on all the library path
_dynsubr = tcob_find_in_lib(subrname, subrname);
if (_dynsubr)
{
return _dynsubr;
}
// The following search sequence is not really required on MinGW (Win32)
#ifndef __MINGW32__
// find rutname.so
strcpy(subr_libname, subrname);
strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
_dynsubr = tcob_find_in_lib(subrname, subr_libname);
if (_dynsubr)
{
return _dynsubr;
}
// find ./rutname.so
strcpy(subr_libname, ".");
strcat(subr_libname, HTCOB_PATH_DELIM_STR);
strcat(subr_libname, subrname);
strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
_dynsubr = tcob_find_in_lib(subrname, subr_libname);
if (_dynsubr)
{
return _dynsubr;
}
// find ./librutname.so
strcpy(subr_libname, ".");
strcat(subr_libname, HTCOB_PATH_DELIM_STR);
strcat(subr_libname, "lib");
strcat(subr_libname, subrname);
strcat(subr_libname, HTCOB_DYNLIBS_SUFIX);
_dynsubr = tcob_find_in_lib(subrname, subr_libname);
if (_dynsubr)
{
return _dynsubr;
}
#endif
// The following functionality is not implimented on MinGW (Win32)
#ifndef __MINGW32__
// Now find the modules on the current dir and on the TC library PATH
// setup our libraries names to search (in current directory)
g.gl_offs = 0;
glob(libs_pattern, 0, NULL, &g);
// add libraries found in HTCOB_LD_PATH
libs1 = getenv(HTCOB_LD_PATH);
if (libs1 != NULL)
{
libstmp = tcob_malloc(strlen(libs1) + 1);
strcpy(libstmp, libs1);
libs1 = libstmp;
}
// find all the libraryes on the HTCOB_LD_PATH
while ((libs = libs1) != NULL)
{
if ((libs1 = strchr(libs, HTCOB_PATH_SEP_CHAR)) != NULL)
{
*libs1++ = 0;
}
ldlib = tcob_malloc(strlen(libs) + strlen(libs_pattern) + 2);
strcpy(ldlib, libs);
strcat(ldlib, HTCOB_PATH_DELIM_STR);
strcat(ldlib, libs_pattern);
glob(ldlib, GLOB_APPEND, NULL, &g);
free(ldlib);
}
if (libstmp != NULL)
free(libstmp);
// loop until we find a function with the name given
libname = g.gl_pathv;
if (libname != NULL)
{
for (; *libname != NULL; libname++)
{
_dynsubr = tcob_find_in_lib(subrname, *libname);
if (_dynsubr != NULL)
{
return _dynsubr;
}
}
}
globfree(&g);
#else
HANDLE findFileHandle = NULL;
WIN32_FIND_DATA uFindFileData, *lpFindFileData;
lpFindFileData = &uFindFileData;
// Since the calling program is not a DLL
// This does not work on Win32
/*
//
// Search the calling program
//
fprintf(stderr, "dyncall debug 101 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
mNameLen = GetModuleFileName (NULL, subr_libname, sizeof (subr_libname));
if (mNameLen != 0) {
fprintf(stderr, "dyncall debug 103 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
mHandle = GetModuleHandle(subr_libname);
if (mHandle != NULL) {
fprintf(stderr, "dyncall debug 105 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
_dynsubr = dlsym(mHandle, subrname);
if (_dynsubr != NULL) {
fprintf(stderr, "dyncall debug 107 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
return _dynsubr;
}
}
}
*/
//
// Search loaded DLL's
//
// fprintf(stderr, "dyncall debug 111 : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
_dynsubr = tcob_resolve_in_previous_libs(subrname);
if (_dynsubr)
{
// fprintf(stderr, "Already loaded : subrname=%s, subr_libname=%s;\n", subrname, subr_libname);
return _dynsubr;
}
//
// Locate and search DLL's in the TCOB_LD_LIBRARY_PATH paths
//
libs1 = getenv(HTCOB_LD_PATH);
if (libs1 != NULL)
{
libstmp = tcob_malloc(strlen(libs1) + 1);
strcpy(libstmp, libs1);
libs = libstmp;
//
// Find all DLL's in the TCOB_LD_LIBRARY_PATH paths
//
// libs contains the search path
// libs1 will point to each directory to search
char * psc = tcob_malloc(2);
sprintf(psc, "%c", HTCOB_PATH_SEP_CHAR);
libs1 = strtok(libs, psc);
while (libs1 != NULL)
{
strcpy(subr_libname, libs1);
strcat(subr_libname, HTCOB_PATH_DELIM_STR);
strcat(subr_libname, HTCOB_DYNLIBS_PATTERN);
// printf("Searching on [%s]\n",subr_libname);
// get first dll from the current searched directory
findFileHandle = FindFirstFile(subr_libname, lpFindFileData);
if (findFileHandle != INVALID_HANDLE_VALUE)
{
strcpy(subr_libname, lpFindFileData->cFileName);
_dynsubr = tcob_find_in_lib(subrname, subr_libname);
if (_dynsubr)
{
return _dynsubr;
}
// get second to last dll from the current searched directory
while (FindNextFile(findFileHandle, lpFindFileData) == TRUE)
{
strcpy(subr_libname, lpFindFileData->cFileName);
_dynsubr = tcob_find_in_lib(subrname, subr_libname);
if (_dynsubr)
{
return _dynsubr;
}
}
}
// did not found yet... will search next directory on the search path
libs1 = strtok(NULL, psc);
}
free(libstmp);
}
#endif
return NULL;
}
/*------------------------------------------------------------------------*\
| |
| tcob_resolve_subr |
| |
\*------------------------------------------------------------------------*/
void *
tcob_resolve_subr(struct fld_desc *f, char *s, int stacklen)
{
char *p;
// get our subroutine name to call
strncpy(subrname, s, f->len);
subrname[f->len] = 0;
// remove trailing spaces
p = subrname;
while (*p)
{
if (*p == ' ')
*p = '\0';
if (*p == '-')
*p = '_';
p++;
}
// An non-zero stack length implies an WINAPI call convention
if (stacklen != 0)
{
sprintf(subr_libname, "%s@%d", subrname, stacklen - 1);
strcpy(subrname, subr_libname);
}
#ifndef __MINGW32__
if (strlen(subrname) > HTCOB_DYNLIBS_MAX_NAME)
{
fprintf(
stderr,
"*** RT Error: Maximun of length of %d characters in sub-routine name ('%s') execced.\n",
HTCOB_DYNLIBS_MAX_NAME, subrname);
return NULL;
}
#endif
// FIXME: check for invalid characters
// change - by _ on sub name
// p=subrname;
// while(*p){
// if (*p=='-') *p='_';
// p++;
// }
return tcob_resolve(subrname);
}
int
tcob_call_loadlib(struct fld_desc *f, char *s)
{
int r = 0;
char *p;
void *module;
strncpy(subrname, s, f->len);
subrname[f->len] = '\0';
// remove traling spaces and add NULL delimiter
p = subrname; // walter
while (*p)
{
if (*p == ' ')
*p = '\0';
p++;
}
// open the library
module = dlopen(subr_libname, RTLD_LAZY);
if (module != NULL)
{
// save handle to improve search sequence for next search
module_install(module);
r = 1;
}
return r;
}
/* end of dyncall.c */
BIN
View File
Binary file not shown.
+3044
View File
File diff suppressed because it is too large Load Diff
BIN
View File
Binary file not shown.
+1534
View File
File diff suppressed because it is too large Load Diff
+109
View File
@@ -0,0 +1,109 @@
/*
* Copyright (C) 2005 Walter Garrote
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
#include <htconfig.h>
#ifdef USE_MYSQL_GATEWAY
#include <mysqld_error.h>
#include <mysql.h>
MYSQL *sql_conn;
#endif
#ifdef USE_PGSQL_GATEWAY
#include <libpq-fe.h>
PGconn *sql_conn;
#endif
unsigned char sql_server;
char *sql_fdsql;
char *sql_host;
char *sql_user;
char *sql_passwd;
char *sql_db;
struct file_sql {
char *original_name;
char *table_name;
struct file_sql *next;
};
struct fields_sql {
struct altkey_desc *alt;
int level;
char *name;
char type;
int size;
int decimals;
int index;
int unique;
struct fields_sql *next;
};
struct keys_sql {
char *name;
int type; // 1-Primary, 2-Alternate unique, 3-Alternate duplicate
char *fields;
struct keys_sql *next;
};
struct fd_sql {
#ifdef USE_MYSQL_GATEWAY
MYSQL_RES *sql_result;
#endif
#ifdef USE_PGSQL_GATEWAY
PGresult *sql_result;
#endif
int row;
struct file_desc *file;
char *name;
struct fields_sql *fields;
struct keys_sql *keys;
struct fd_sql *next;
};
extern int bDecimalComma;
int tcob_read_tinysql(void);
int tcob_sql_int(char *campo);
char * tcob_sql_table_name(char *fd);
int tcob_sql_read_def(char *fd, struct file_desc *f);
int tcob_sql_read_fd(char *path, char *table, struct file_desc *f);
int tcob_sql_read_select(char *path, char *table);
void clean_read_line(char *linha, char *linhar, int ponto);
void tcob_move_value(char *variavel, char *value);
void create_mount_files(char *file_name, char *table_name);
struct fd_sql * search_table(struct file_desc *fd);
int put_value_query(struct fields_sql *fld, char *record, int p, char *query);
int create_sql_db(char *fd);
int insert_sql_db(struct file_desc *f, char *record);
int start_sql_db(struct file_desc *f, char *record, int cond, char *key_ptr);
int read_sql_db(struct file_desc *fd, char *record);
int readnext_sql_db(struct file_desc *fd, char *record);
int readprevious_sql_db(struct file_desc *fd, char *record);
int delete_sql_db(struct file_desc *fd, char *record);
int update_sql_db(struct file_desc *fd, char *record);
void put_value_record(struct fields_sql *fld, char *record, int p, char *row);
int connect_sql_db(void);
int query_sql_db(struct fd_sql *pfd, char *query, int store_result);
void free_sql_db(struct fd_sql *pfd);
int close_sql_table(struct file_desc *f);
int close_sql_db(void);
int read_offset_db(struct fd_sql *pfd, char *record);
+853
View File
@@ -0,0 +1,853 @@
/*
* Copyright (C) 2003 Andrew Cameron
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
#include "htcoblib.h"
#ifdef USE_LOCKSERVER
#include "flckclient.h"
struct fd_filename name_info[NO_OF_FILES];
char *temp_key;
/* This is the host that runs the Lockserver */
char *lockserverhost="localhost";
#ifdef __MINGW32__
char *realpath(const char *filename, char *pathbuf)
{
char buf[MAX_PATH];
char* finalpart;
DWORD len = GetFullPathName (filename, MAX_PATH, buf, &finalpart);
if (len == 0 || len > MAX_PATH-1) /* failure */
{
strcpy(pathbuf, filename);
return strdup (filename);
}
else
{
strcpy(pathbuf, buf);
return strdup (buf);
}
}
int write_socket(SOCKET s, const char *buf, int len)
{
int result;
result = send(s,buf,len,0);
return result;
}
int read_socket(SOCKET s, char *buf, int len)
{
int result;
result = recv(s,buf,len,0);
return result;
}
int init_socket()
{
wVersionRequested = MAKEWORD( 2, 2 );
err = WSAStartup( wVersionRequested, &wsaData );
if ( err != 0 )
{ /* Tell the user that we could not find a usable */
/* WinSock DLL. */
perror("Unable to find a Suitable Winsock DLL\n");
}
/* Confirm that the WinSock DLL supports 2.2.*/
/* Note that if the DLL supports versions greater */
/* than 2.2 in addition to 2.2, it will still return */
/* 2.2 in wVersion since that is the version we */
/* requested. */
if ( LOBYTE( wsaData.wVersion ) != 2 ||
HIBYTE( wsaData.wVersion ) != 2 ) {
/* Tell the user that we could not find a usable */
/* WinSock DLL. */
WSACleanup( );
perror("Unable to find a Suitable Winsock DLL\n");
} /* The WinSock DLL is acceptable. Proceed. */
return 0;
}
#endif
/*------------------------------------------------------------------------*\
| |
| set_lockserver_lock |
| |
\*------------------------------------------------------------------------*/
int set_lockserver_lock( char *filename, char *key)
{
/******************************************************************************/
/* This routine will connect to the Lockserver process and request a lock for */
/* A givein filename, key pair. The filename should be the full name of the */
/* of the file ie /home/andrew/names.db. The Key should be the PRIMARY key in */
/* the Datafile and not an Alternate Key. */
/* If the lock is granted it will retun 0 otherwise it will return 1 */
/******************************************************************************/
struct hostent *hp;
struct sockaddr_in sin;
char buf[TCOB_MAX_PATHLN];
#ifndef __MINGW32__
int s;
#else
SOCKET s;
#endif
int command;
int j;
pid_t mypid;
unsigned int mask;
#ifdef __MINGW32__
init_socket();
#endif
/* Translate host name into peer's IP address */
if ((hp = gethostbyname(lockserverhost)) == NULL) {
fprintf(stderr, "unknown host %s\n",lockserverhost);
exit(1);
}
/*
* Initialize the address data structure
*/
memset((void *)&sin, 0, sizeof(sin));
sin.sin_family = AF_INET;
memcpy((void *)&sin.sin_addr, hp->h_addr, hp->h_length);
sin.sin_port = htons(SERVER_PORT);
/*
* Create a socket
*/
if ((s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
perror("socket");
exit(1);
}
/*
* Create a connection between the socket and the server
*/
if (connect(s, (struct sockaddr *)&sin, sizeof(sin)) < 0) {
perror("connect: Check that Lockserver is running");
exit(1);
}
/* Get Connection Result
*/;
recv(s, buf, 1, 0);
if(buf[0] < 1) {
perror("Access Denied: Check that your IP is defined in the hosts file");
exit(1);
}
// Set Command to Request a Lock
command=0x2;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Length of Key
command=strlen(filename);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Key
#ifndef __MINGW32__
write(s, filename, command);
#else
write_socket(s, filename, command);
#endif
//Length of Index
command=strlen(key);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Index
#ifndef __MINGW32__
write(s, key, command);
#else
write_socket(s, key, command);
#endif
//Get My PID and use it as owner
mypid = getpid();
sprintf(buf,"%i",mypid);
//Length of Owner
command=strlen(buf);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Owner
#ifndef __MINGW32__
write(s, buf,command);
#else
write_socket(s, buf,command);
#endif
//TTL
command=65535;
mask=0xff00;
j=((command & mask) >> 8);
#ifndef __MINGW32__
write(s, &j, 1);
#else
write_socket(s, &j, 1);
#endif
mask=0xff;
j=command & mask;
#ifndef __MINGW32__
write(s, &j, 1);
#else
write_socket(s, &j, 1);
#endif
//TTW
command=1;
mask=0xff00;
j=((command & mask) >> 8);
#ifndef __MINGW32__
write(s, &j, 1);
#else
write_socket(s, &j, 1);
#endif
mask=0xff;
j=command & mask;
#ifndef __MINGW32__
write(s, &j, 1);
#else
write_socket(s, &j, 1);
#endif
//Pri
command=0x1;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//end
//Get 2 Byte Int Response.
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
command = command << 8;
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
#ifndef __MINGW32__
close(s);
#else
closesocket(s);
WSACleanup();
#endif
if(command == 1)
return(0);
else
return(1);
}
/*------------------------------------------------------------------------*\
| |
| get_lockserver_lock_owner |
| |
\*------------------------------------------------------------------------*/
int get_lockserver_lock_owner( char *filename, char *key)
{
/******************************************************************************/
/* This routine will connect to the Lockserver process and see if a record is */
/* locked for a given filename, ker pair. */
/* The filename should be the full name of the */
/* of the file ie /home/andrew/names.db. The Key should be the PRIMARY key in */
/* the Datafile and not an Alternate Key. */
/* If the record is locked it by another process it will retun 1 otherwise it */
/* will return 0 */
/******************************************************************************/
struct hostent *hp;
struct sockaddr_in sin;
char buf[TCOB_MAX_PATHLN];
#ifndef __MINGW32__
int s;
#else
SOCKET s;
#endif
int command;
int cmp;
int len;
pid_t mypid;
char *owner;
#ifdef __MINGW32__
init_socket();
#endif
/* Translate host name into peer's IP address */
if ((hp = gethostbyname(lockserverhost)) == NULL) {
fprintf(stderr, "unknown host %s\n",lockserverhost);
exit(1);
}
/*
* Initialize the address data structure
*/
memset((void *)&sin, 0, sizeof(sin));
sin.sin_family = AF_INET;
memcpy((void *)&sin.sin_addr, hp->h_addr, hp->h_length);
sin.sin_port = htons(SERVER_PORT);
/*
* Create a socket
*/
if ((s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
perror("socket");
exit(1);
}
/*
* Create a connection between the socket and the server
*/
if (connect(s, (struct sockaddr *)&sin, sizeof(sin)) < 0) {
perror("connect: Check that Lockserver is running");
exit(1);
}
/* Get Connection Result
*/;
recv(s, buf, 1,0);
if(buf[0] < 1) {
perror("Access Denied: Check that your IP is defined in the hosts file");
exit(1);
}
// Set Command to Find a Lock Ownerk
command=0x1;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Length of Key
command=strlen(filename);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Key
#ifndef __MINGW32__
write(s, filename, command);
#else
write_socket(s, filename, command);
#endif
//Length of Index
command=strlen(key);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Index
#ifndef __MINGW32__
write(s, key, command);
#else
write_socket(s, key, command);
#endif
//Get My PID
mypid = getpid();
sprintf(buf,"%i",mypid);
//Get Owner
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
owner = (char *) malloc (sizeof(char) * (command + 1));
#ifndef __MINGW32__
read(s, owner, command);
#else
read_socket(s, owner, command);
#endif
owner[command] = '\0';
#ifndef __MINGW32__
close(s);
#else
closesocket(s);
WSACleanup();
#endif
if(command > 0)
{
len = strlen(owner);
cmp=(strncmp(buf,owner,len));
if (cmp == 0)
{
free(owner);
return(0);
}
else
{
free(owner);
return(1);
}
}
else
{
free(owner);
return(0);
}
}
/*------------------------------------------------------------------------*\
| |
| lockserver_release_specific_lock |
| |
\*------------------------------------------------------------------------*/
int lockserver_release_specific_lock( char *filename, char *key)
{
/******************************************************************************/
/* This routine will connect to the Lockserver process and release a specific */
/* lock for a given filename, ker pair. If key is "*" it will release all */
/* records for that filename. */
/* The filename should be the full name of the */
/* of the file ie /home/andrew/names.db. The Key should be the PRIMARY key in */
/* the Datafile and not an Alternate Key. */
/* If successfull it will return 0 otherwise it will return 1 */
/******************************************************************************/
struct hostent *hp;
struct sockaddr_in sin;
char buf[TCOB_MAX_PATHLN];
#ifndef __MINGW32__
int s;
#else
SOCKET s;
#endif
int command;
pid_t mypid;
#ifdef __MINGW32__
init_socket();
#endif
/* Translate host name into peer's IP address */
if ((hp = gethostbyname(lockserverhost)) == NULL) {
fprintf(stderr, "unknown host %s\n",lockserverhost);
exit(1);
}
/*
* Initialize the address data structure
*/
memset((void *)&sin, 0, sizeof(sin));
sin.sin_family = AF_INET;
memcpy((void *)&sin.sin_addr, hp->h_addr, hp->h_length);
sin.sin_port = htons(SERVER_PORT);
/*
* Create a socket
*/
if ((s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
perror("socket");
exit(1);
}
/*
* Create a connection between the socket and the server
*/
if (connect(s, (struct sockaddr *)&sin, sizeof(sin)) < 0) {
perror("connect: Check that Lockserver is running");
exit(1);
}
/* Get Connection Result
*/;
recv(s, buf, 1, 0);
if(buf[0] < 1) {
perror("Access Denied: Check that your IP is defined in the hosts file");
exit(1);
}
// Set Command to Release a Specific lock
command=0x5;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Length of Key
command=strlen(filename);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Key
#ifndef __MINGW32__
write(s, filename, command);
#else
write_socket(s, filename, command);
#endif
//Length of Index
command=strlen(key);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Index
#ifndef __MINGW32__
write(s, key, command);
#else
write_socket(s, key, command);
#endif
//Get My PID and use it as owner
mypid = getpid();
sprintf(buf,"%i",mypid);
//Length of Owner
command=strlen(buf);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Owner
#ifndef __MINGW32__
write(s, buf,command);
#else
write_socket(s, buf,command);
#endif
//Get 2 Byte Int Response.
#ifndef __MINGE32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
command = command << 8;
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
#ifndef __MINGW32__
close(s);
#else
closesocket(s);
WSACleanup();
#endif
if(command > 0)
{
return(0);
}
else
{
return(1);
}
}
/*------------------------------------------------------------------------*\
| |
| lockserver_release_all_locks |
| |
\*------------------------------------------------------------------------*/
int lockserver_release_all_locks()
{
/******************************************************************************/
/* This routine will connect to the Lockserver process and release all */
/* lock for the running program. */
/* If the record is successfull it will return 0 otherwise it will return 1 */
/******************************************************************************/
struct hostent *hp;
struct sockaddr_in sin;
char buf[TCOB_MAX_PATHLN];
#ifndef __MINGW32__
int s;
#else
SOCKET s;
#endif
int command;
pid_t mypid;
#ifdef __MINGW32__
init_socket();
#endif
/* Translate host name into peer's IP address */
if ((hp = gethostbyname(lockserverhost)) == NULL) {
fprintf(stderr, "unknown host %s\n",lockserverhost);
exit(1);
}
/*
* Initialize the address data structure
*/
memset((void *)&sin, 0, sizeof(sin));
sin.sin_family = AF_INET;
memcpy((void *)&sin.sin_addr, hp->h_addr, hp->h_length);
sin.sin_port = htons(SERVER_PORT);
/*
* Create a socket
*/
if ((s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
perror("socket");
exit(1);
}
/*
* Create a connection between the socket and the server
*/
if (connect(s, (struct sockaddr *)&sin, sizeof(sin)) < 0) {
perror("connect: Check that Lockserver is running");
exit(1);
}
/* Get Connection Result
*/;
recv(s, buf, 1, 0);
if(buf[0] < 1) {
perror("Access Denied: Check that your IP is defined in the hosts file");
exit(1);
}
// Set Command to Release All locks
command=0x6;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Get My PID and use it as owner
mypid = getpid();
sprintf(buf,"%i",mypid);
//Length of Owner
command=strlen(buf);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Owner
#ifndef __MINGW32__
write(s, buf,command);
#else
write_socket(s, buf,command);
#endif
//Get 2 Byte Int Response.
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
command = command << 8;
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
#ifndef __MINGW32__
close(s);
#else
closesocket(s);
WSACleanup();
#endif
if(command > 0)
{
return(0);
}
else
{
return(1);
}
}
/*------------------------------------------------------------------------*\
| |
| show_lock |
| |
\*------------------------------------------------------------------------*/
int show_lock( char *filename, char *key, char *pidid, char *username)
{
/******************************************************************************/
/* This routine will connect to the Lockserver process and see if a record is */
/* locked for a given filename, ker pair. */
/* The filename should be the full name of the */
/* of the file ie /home/andrew/names.db. The Key should be the PRIMARY key in */
/* the Datafile and not an Alternate Key. */
/* This process will return the Process ID and the Username locking the record*/
/******************************************************************************/
struct hostent *hp;
struct sockaddr_in sin;
FILE *pt;
char buf[TCOB_MAX_PATHLN];
#ifndef __MINGW32__
int s;
#else
SOCKET s;
#endif
int command;
char *owner;
#ifdef __MINGW32__
init_socket();
#endif
/* Translate host name into peer's IP address */
if ((hp = gethostbyname(lockserverhost)) == NULL) {
fprintf(stderr, "unknown host %s\n",lockserverhost);
exit(1);
}
/*
* Initialize the address data structure
*/
memset((void *)&sin, 0, sizeof(sin));
sin.sin_family = AF_INET;
memcpy((void *)&sin.sin_addr, hp->h_addr, hp->h_length);
sin.sin_port = htons(SERVER_PORT);
/*
* Create a socket
*/
if ((s = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) {
perror("socket");
exit(1);
}
/*
* Create a connection between the socket and the server
*/
if (connect(s, (struct sockaddr *)&sin, sizeof(sin)) < 0) {
perror("connect: Check that Lockserver is running");
exit(1);
}
/* Get Connection Result
*/;
recv(s, buf, 1,0);
if(buf[0] < 1) {
perror("Access Denied: Check that your IP is defined in the hosts file");
exit(1);
}
// Set Command to Find a Lock Ownerk
command=0x1;
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Length of Key
realpath(filename,buf);
command=strlen(buf);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Key
#ifndef __MINGW32__
write(s, buf, command);
#else
write_socket(s, buf, command);
#endif
//Length of Index
command=strlen(key);
#ifndef __MINGW32__
write(s, &command, 1);
#else
write_socket(s, &command, 1);
#endif
//Index
#ifndef __MINGW32__
write(s, key, command);
#else
write_socket(s, key, command);
#endif
//Get Owner
#ifndef __MINGW32__
read(s, &command, 1);
#else
read_socket(s, &command, 1);
#endif
owner = (char *) malloc (sizeof(char) * (command + 1));
#ifndef __MINGW32__
read(s, owner, command);
#else
read_socket(s, owner, command);
#endif
owner[command] = '\0';
#ifndef __MINGW32__
close(s);
#else
closesocket(s);
WSACleanup();
#endif
strcpy(pidid,owner);
#ifdef __MINGW32__
strcpy(username,"Not-Implemented");
#else
sprintf(buf,"ps --no-header u %s | cut -f1 -d ' '",owner);
pt=popen(buf,"r");
fgets(buf,TCOB_MAX_PATHLN,pt);
strncpy(username,buf,strlen(buf)-1);
fclose(pt);
#endif
free(owner);
return(0);
}
void insert_filename( int fdb , char *filename )
{
int i;
for(i=0;i<=NO_OF_FILES;i++){
if(name_info[i].fd == 0)
{
name_info[i].fd=fdb;
realpath(filename,name_info[i].filesname);
break;
}
}
}
char *fd_filename( int fdb )
{
int i;
for(i=0;i<=NO_OF_FILES;i++){
if(name_info[i].fd == fdb)
{
return(name_info[i].filesname);
break;
}
}
return("");
}
void remove_filename( int fdb )
{
int i;
for(i=0;i<=NO_OF_FILES;i++){
if(name_info[i].fd == 0)
{
name_info[i].fd=0;
strcpy(name_info[i].filesname," ");
break;
}
}
}
#endif
+52
View File
@@ -0,0 +1,52 @@
/*
* Copyright (C) 2003 Andrew Cameron
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
#ifdef USE_LOCKSERVER
#ifndef __MINGW32__
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
#else
#include <winsock2.h>
#include <wininet.h>
#include <windows.h>
#include <process.h>
WORD wVersionRequested;
WSADATA wsaData;
int err;
#endif
#define SERVER_PORT 8675
struct fd_filename
{
int fd;
char filesname[TCOB_MAX_PATHLN];
};
int set_lockserver_lock( char *filename, char *key);
int get_lockserver_lock_owner( char *filename, char *key);
int lockserver_release_specific_lock( char *filename, char *key);
int lockserver_release_all_locks();
void insert_filename( int fdb , char *filename );
char *fd_filename( int fdb );
void remove_filename( int fdb );
#endif
BIN
View File
Binary file not shown.
+872
View File
@@ -0,0 +1,872 @@
/*
* Copyright (C) 2003, Rildo Pragana, Ferran Pegueroles, Bernard Giroud
* Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
* Andrew Cameron, David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
/*
*
* Cobol Compiler Run Time Library -- Genaral functions
*
*/
//#define DEBUG_RTS 1
#include "htcoblib.h"
#include "rterrors.h"
#include <stdarg.h>
#ifdef __MINGW32__
#include <process.h>
#endif
unsigned int srt_mem[128][2]; // [field][0] position, [1] size, [2] direction walter
//char *key_value=NULL;
//char *key1=NULL;
//char *key2=NULL; // value for qsort
char *screen_status = NULL; /* defined here to not force linking to curses */
char *screen_cursor = NULL; /* defined here to not force linking to curses */
char *last_screen_status = NULL; // walter
extern int bDecimalComma;
extern char cCurrencySymbol;
static struct runelement_list *loaded_elements = NULL; /* all the run elements loaded */
static struct runelement_list *process_stack = NULL; /* the process/routines stack */
struct runelement_info *running_element = NULL; /* the current run element */ // walter 12-12-05
/* walter 12-12-05 */
struct element_order *elementorder = NULL;
/* fim walter */
/* #define DEBUG_RTS 1 */
void
setDecimalComma()
{
bDecimalComma = 1;
}
/*------------------------------------------------------------------------*\
| |
| tcob_stop_run |
| |
\*------------------------------------------------------------------------*/
void
tcob_stop_run()
{
//static struct runelement_list *loaded_elements=NULL; /* all the run elements loaded */
//static struct runelement_list *process_stack=NULL; /* the process/routines stack */
//static struct runelement_info *running_element=NULL; /* the current run element */
#ifdef DEBUG_RTS
fprintf(stderr, "stop run on element '%s'\n", tcob_get_current_runelement()->name);
#endif
/*do_scrio_finish();*/ /* this is required, sometimes a routine opens curses and
the main program does not close curses */
if (loaded_elements != NULL)
{
tcob_cancel_all(); /* when stop run, we cancel all the routines */
tcob_unload_runelement(tcob_get_current_runelement()); /* close the current run element */
}
}
/*------------------------------------------------------------------------*\
| |
| tcob_fldLength |
| |
\*------------------------------------------------------------------------*/
unsigned int
tcob_fldLength(struct fld_desc *f)
{
unsigned int len;
if (f->type == DTYPE_BININT)
{
switch (f->len)
{
case 1: len = 3;
break;
case 2: len = 5;
break;
case 4: len = 10;
break;
default: len = 18;
break;
}
}
else if (f->type == DTYPE_FLOAT)
len = (f->len == 4) ? 14 : 30;
else
len = f->len;
return len;
}
/*------------------------------------------------------------------------*\
| |
| tcob_get_switch |
| |
\*------------------------------------------------------------------------*/
int
tcob_get_switch(struct fld_desc *f, short *sw, int swnum)
{
char sw_name[5];
char *res;
sprintf(sw_name, "SW%1d", swnum);
res = getenv(sw_name);
*sw = ((res != NULL) && (res[0] == '1')) ? 1 : 0;
#ifdef DEBUG_RTS
fprintf(stderr, "Getting switch SW%1d, val is %1d\n", swnum, *sw);
#endif
return 0;
}
/*------------------------------------------------------------------------*\
| |
| tcob_set_switch |
| |
\*------------------------------------------------------------------------*/
int
tcob_set_switch(struct fld_desc *f, short *sw, int swnum)
{
int res = 0;
#ifdef HAVE_PUTENV
#ifndef __MINGW32__
char *sw_set_cmd;
sw_set_cmd = malloc(7); /* size of SWnn=b */
sprintf(sw_set_cmd, "SW%1d=%1d", swnum, *sw);
res = putenv(sw_set_cmd);
free(sw_set_cmd);
#endif
#ifdef DEBUG_RTS
fprintf(stderr, "Setting switch SW%1d to %1d, res %d\n", swnum, *sw, res);
#endif
#endif
return res;
}
/*------------------------------------------------------------------------*\
| |
| tcob_chain |
| |
\*------------------------------------------------------------------------*/
void
tcob_chain(struct fld_desc *f, char *data, ...)
{
char *p;
unsigned int i;
#ifndef __MINGW32__
struct fld_desc *par_des;
char *par_dat;
int status = 0;
int files[2];
va_list ap;
if (pipe(files) < 0) /* create a pipe to pass data to chained program */
{
tcob_rt_error("tcob_chain", TCERR_GEN_NOPIPE, strerror(errno));
}
va_start(ap, data);
par_des = va_arg(ap, struct fld_desc *);
while (par_des)
{
par_dat = va_arg(ap, char *);
status = write(files[1], par_dat, par_des->len); /* write data to pipe */
if (status < 0)
{
tcob_rt_error("tcob_chain", TCERR_GEN_BADDATA, strerror(errno));
}
par_des = va_arg(ap, struct fld_desc *);
}
va_end(ap);
status = dup2(files[0], 100);
if (status < 0)
tcob_rt_error("tcob_chain", TCERR_GEN_BAD_PIPE, strerror(errno));
close(files[0]);
close(files[1]);
#endif /* __MINGW32__ */
for (i = f->len; (i > 0) && (data[i - 1] == ' '); i--)
; /* intentionally empty */
p = tcob_malloc(i + 1);
memcpy(p, data, i);
p[i] = '\0';
execlp(p, p, NULL);
/* If we reach this point, the exec has failed */
tcob_rt_error("tcob_chain", TCERR_GEN_NOEXEC, strerror(errno));
}
/*------------------------------------------------------------------------*\
| |
| tcob_chaining |
| |
\*------------------------------------------------------------------------*/
void
tcob_chaining(struct fld_desc *f, char *data, ...)
{
#ifndef __MINGW32__
char *p;
struct fld_desc *par_des;
char *par_dat;
struct fld_desc * des_list[20];
char *dat_list[20];
unsigned int i = 0, len = 0;
unsigned int num_pars = 0;
int status;
va_list ap;
if (f == NULL)
return;
des_list[num_pars] = f;
dat_list[num_pars] = data;
des_list[num_pars + 1] = NULL;
dat_list[num_pars + 1] = NULL;
len += f->len;
num_pars++;
va_start(ap, data);
par_des = va_arg(ap, struct fld_desc *);
while (par_des)
{
par_dat = va_arg(ap, char *);
des_list[num_pars] = par_des;
dat_list[num_pars] = par_dat;
des_list[num_pars + 1] = NULL;
dat_list[num_pars + 1] = NULL;
len += par_des->len;
num_pars++;
par_des = va_arg(ap, struct fld_desc *);
}
va_end(ap);
p = tcob_malloc(len);
for (i = 0; (status = read(100, p + i, 1) > 0) && (i < len); i++);
if (status < 0)
tcob_rt_error("tcob_chaining", TCERR_GEN_BAD_ARG, strerror(errno));
close(100);
if (i == 0)
{
return;
}
else if (i < len)
{
tcob_rt_error("tcob_chaining", TCERR_GEN_SIZE_ERR);
return;
}
for (i = 0; i < num_pars; i++)
{
memmove(dat_list[i], p, des_list[i]->len);
p += des_list[i]->len;
}
#endif /*__MINGW32__*/
}
/*------------------------------------------------------------------------*\
| |
| run element functions |
| |
| These functions control the data stored on the runtime for each |
| program or routine. |
| |
\*------------------------------------------------------------------------*/
static struct runelement_list*
find_in_runelement_list(struct runelement_list *list,
struct runelement_info *element)
{
if (list == NULL)
return NULL;
while (list)
{
if (list->element == element)
return list;
list = list->next;
}
return list;
}
static struct runelement_list*
add_to_runelement_list(struct runelement_list *list,
struct runelement_info *element)
{
struct runelement_list *new_item;
struct runelement_list *last_item;
new_item = (struct runelement_list *) tcob_malloc(sizeof (struct runelement_list));
new_item->element = element;
new_item->next = NULL;
if (list == NULL)
{ /* is the first item */
new_item->prev = NULL;
return new_item;
}
/* find the last item */
last_item = list;
while (last_item->next)
{
last_item = last_item->next;
}
last_item->next = new_item;
new_item->prev = last_item;
return list;
}
static struct runelement_list*
remove_from_runelement_list(struct runelement_list *list,
struct runelement_info *element)
{
struct runelement_list *remove_item = NULL;
struct runelement_list *prev_item = NULL;
struct runelement_list *next_item = NULL;
if (list == NULL)
return NULL;
if (element == NULL)
return list;
remove_item = list;
while (remove_item)
{
if (remove_item->element == element)
{
prev_item = remove_item->prev;
next_item = remove_item->next;
if (prev_item) prev_item->next = remove_item->next;
if (next_item) next_item->prev = remove_item->prev;
if (remove_item) free(remove_item);
if ((prev_item == NULL) && (next_item == NULL))
return NULL; /* empty list */
remove_item = next_item;
}
else
{
remove_item = remove_item->next;
}
}
return list;
}
#ifdef UNUSED
static void
free_runelement_list(struct runelement_list *list)
{
struct runelement_list *item = NULL;
struct runelement_list *item_prev = NULL;
if (list == NULL)
return;
item = list;
/* find the last one */
while (item->next) item = item->next;
while (item)
{
item_prev = item->prev;
free(item);
item = item_prev;
}
}
#endif
/*------------------------------------------------------------------------*\
| |
| tcob_get_current_runelement() |
| |
| Return info from the current run element, used by file open to store |
| information about open files. |
| |
\*------------------------------------------------------------------------*/
struct runelement_info*
tcob_get_current_runelement()
{
return running_element;
}
/*------------------------------------------------------------------------*\
| |
| tcob_enter_runelement |
| |
| Enter a run element, when a program is called, from anoter program or |
| by the shell, and when a program returns from a call statement. |
| |
\*------------------------------------------------------------------------*/
void
tcob_enter_runelement(char *prog_name, int prog_name_len,
int type, int *initvarsflg)
{
char *name = NULL;
struct runelement_list *actual = NULL;
struct runelement_info *new_element = NULL;
struct runelement_list *last_element = NULL;
/* prepare the name of the run element */
name = tcob_malloc(prog_name_len + 1);
strcpy(name, prog_name);
#ifdef DEBUG_RTS
fprintf(stderr, "Enter run element '%s', size %i ", name, prog_name_len);
#endif
/* find if we have entered this element before */
actual = loaded_elements;
while (actual != NULL)
{
last_element = actual;
if (strcmp(actual->element->name, name) == 0)
break;
actual = actual->next;
}
if ((actual == NULL) && (type == RUN_ELEMENT_RETURN))
{
tcob_rt_error("tcob_chain", TCERR_GEN_RUNELEMENT);
}
if (actual == NULL)
{ /* Is the first time is called */
#ifdef DEBUG_RTS
fprintf(stderr, "for first time\n");
#endif
*initvarsflg = 0;
new_element = (struct runelement_info *)
tcob_malloc(sizeof (struct runelement_info));
new_element->name = name;
new_element->screen_status = screen_status;
new_element->screen_cursor = screen_cursor;
new_element->decimal_comma = bDecimalComma;
new_element->currency_symbol = cCurrencySymbol;
/*new_element->handler = tcob_resolve_subr(); */
new_element->files = NULL;
loaded_elements = add_to_runelement_list(loaded_elements, new_element);
actual = find_in_runelement_list(loaded_elements, new_element);
if (actual == NULL)
{
tcob_rt_error("tcob_chain", TCERR_GEN_RUNELEMENT);
}
}
else
{
#ifdef DEBUG_RTS
fprintf(stderr, "reloading values\n");
#endif
/* restore saved values */
screen_status = actual->element->screen_status;
screen_cursor = actual->element->screen_cursor;
bDecimalComma = actual->element->decimal_comma;
cCurrencySymbol = actual->element->currency_symbol;
}
/* update the actual run element. */
running_element = actual->element;
if (type == RUN_ELEMENT_ENTER)
{
process_stack = add_to_runelement_list(process_stack, running_element);
#ifdef DEBUG_RTS
fprintf(stderr, "adding to process stack '%s'\n", running_element->name);
#endif
}
else
{
/* We shold POP from the process stack, but first we
* must be sure the previous call has made a push.
* If the previous call is not a call to a cobol program,
* it hasn't made a push.
*/
last_element = process_stack;
while (last_element->next) last_element = last_element->next;
if (last_element->prev && (last_element->prev->element == running_element))
{
/* remove the last one */
#ifdef DEBUG_RTS
fprintf(stderr, "removing from process stack '%s'\n",last_element->element->name);
#endif
last_element->prev->next = NULL;
if (last_element)
free(last_element);
}
else
{
if (running_element != last_element->element)
{
/* something stange, mix between cobol programs and non cobol programs */
#ifdef DEBUG_RTS
fprintf(stderr, "something strange\n");
#endif
}
else
{ /* last call not a cobol program: do nothing */
#ifdef DEBUG_RTS
fprintf(stderr, "last program is not a cobol program\n");
#endif
}
}
}
return;
}
/*------------------------------------------------------------------------*\
| |
| tcob_unload_runelement |
| |
\*------------------------------------------------------------------------*/
void
tcob_unload_runelement(struct runelement_info *element)
{
struct file_list *files = NULL;
struct file_list *tmp = NULL;
struct element_order *eo; // walter 12-12-05
// struct element_order *eon; // walter 12-12-05
if (!element)
return;
#ifdef DEBUG_RTS
fprintf(stderr, "unloading element '%s'\n", element->name);
#endif
/* here we should close all files for run element */
files = element->files;
while (files != NULL)
{
tcob_close_real(files->file, NULL);
tmp = files;
files = files->next;
if (tmp) free(tmp);
}
element->files = NULL;
/* remove reference from dynamic calls */
tcob_cancel_subr(element->name, running_element->name); // walter 12-12-2005
// walter 12-12-05
eo = elementorder;
while (eo)
{
tcob_cancel_subr(eo->module_name, eo->who_call);
eo = eo->next;
}
if (element)
free(element); // I dont understand that...why if(element) ???
}
/*------------------------------------------------------------------------*\
| |
| tcob_cancel/tcob_cancel_all |
| |
| We cancel the specified routine or we cancel all the routines except |
| the routines that are in the execution stack |
| |
\*------------------------------------------------------------------------*/
void
tcob_cancel(struct fld_desc *f, char *s)
{
struct runelement_list *element_to_cancel;
char *name;
unsigned int i;
// struct element_order *eo; // walter 12-12-05
// struct element_order *eop; // walter 12-12-05
if ((f == NULL) || (s == NULL))
{
return;
}
/* prepare the name of the run element, removing trailing spaces */
for (i = f->len; (i > 0) && (s[i - 1] == ' '); i--)
; /* intentionally empty */
name = tcob_malloc(i + 1);
memcpy(name, s, i);
name[i] = '\0';
// walter 12-12-05
// remove the modules called by the subroutine
/*
eo = elementorder;
eop = eo;
while(eo && strcmp(name, eo->module_name)!=0) {
eop = eo;
eo = eo->next;
}
if(!eo)
return;
if(strcmp(running_element->name, eo->who_call)!=0) // you can't remove module that you did't call
return;
eop->next = NULL;
if(eo->next)
eop->next = eo->next;
if(eo == elementorder) {
free(elementorder);
elementorder = eop->next;
} else
free(eo);
*/
// fim walter 12-12-05
#ifdef DEBUG_RTS
fprintf(stderr, "Trying to cancel '%s' ", name);
#endif
/* find if we have entered this element before */
element_to_cancel = loaded_elements;
while (element_to_cancel != NULL)
{
if (strcmp(element_to_cancel->element->name, name) == 0)
break;
element_to_cancel = element_to_cancel->next;
}
if (!element_to_cancel)
{
#ifdef DEBUG_RTS
fprintf(stderr, "not found, doing nothing");
#endif
return;
}
/* find if is on the process stack */
if (find_in_runelement_list(process_stack, element_to_cancel->element))
{
#ifdef DEBUG_RTS
fprintf(stderr, "in the process stack, doing nothing");
#endif
return;
}
#ifdef DEBUG_RTS
fprintf(stderr, "found cancelling\n");
#endif
tcob_unload_runelement(element_to_cancel->element);
loaded_elements = remove_from_runelement_list(loaded_elements, element_to_cancel->element);
}
void
tcob_cancel_all()
{
struct runelement_list *list;
#ifdef DEBUG_RTS
fprintf(stderr, "cancelling all\n");
#endif
list = loaded_elements;
while (list)
{
if (!find_in_runelement_list(process_stack, list->element))
{
tcob_unload_runelement(list->element);
}
list = list->next;
}
running_element = NULL;
loaded_elements = NULL;
}
/*
* tcob_add_file_list/tcob_remove_file_list
*
* Routines to keep a list of the files open for the current run element. This files are
* closed when tcob_stop_run or when the run element is cancelled
*
*/
void
tcob_add_file_list(struct file_desc *f)
{
struct runelement_info *current;
struct file_list *new_item;
struct file_list *last_item;
new_item = (struct file_list *) tcob_malloc(sizeof (struct file_list));
new_item->file = f;
new_item->next = NULL;
current = tcob_get_current_runelement();
#ifdef DEBUG_RTS
fprintf(stderr, "adding file to run element '%s'\n", current->name);
#endif
if (current->files == NULL)
{
current->files = new_item;
}
else
{
last_item = current->files;
while (last_item->next)
last_item = last_item->next;
last_item->next = new_item;
}
return;
}
void
tcob_remove_file_list(struct file_desc *f)
{
struct runelement_info *current = NULL;
struct file_list *prev_item = NULL;
struct file_list *remove_item = NULL;
current = tcob_get_current_runelement();
#ifdef DEBUG_RTS
fprintf(stderr, "removing file from run element '%s'\n", current->name);
#endif
if (current->files == NULL)
{
return;
}
remove_item = current->files;
/* if is the first in the list */
if (remove_item->file == f)
{
current->files = remove_item->next;
if (remove_item) free(remove_item);
return;
}
while (remove_item && remove_item->file != f)
{
prev_item = remove_item;
remove_item = remove_item->next;
}
if (prev_item && remove_item)
{
prev_item->next = remove_item->next;
if (remove_item) free(remove_item);
}
else
{
fprintf(stderr, "runtime error");
/* file not found */
}
return;
}
// use for compare keys
static int
compmi(const void *m1, const void *m2)
{
char *key_value, *key1, *key2;
int i, j;
key_value = calloc(1, sizeof (char) * 1024);
key1 = calloc(1, sizeof (char) * 1024);
key2 = calloc(1, sizeof (char) * 1024);
i = 0;
while (srt_mem[i][1])
{
if (srt_mem[i][1] > 1023)
srt_mem[i][1] = 1023;
// *value = 0;
*key_value = 0;
strncat(key_value, (m1 + srt_mem[i][0]), srt_mem[i][1]);
if (srt_mem[i][2] == 2) // descending key
for (j = 0; j < srt_mem[i][1]; j++)
key_value[j] = ~key_value[j];
strncat(key1, key_value, srt_mem[i][1]);
// *value = 0;
*key_value = 0;
strncat(key_value, (m2 + srt_mem[i][0]), srt_mem[i][1]);
if (srt_mem[i][2] == 2) // descending key
for (j = 0; j < srt_mem[i][1]; j++)
key_value[j] = ~key_value[j];
strncat(key2, key_value, srt_mem[i][1]);
i++;
}
i = strcmp(key1, key2);
free(key_value);
free(key1);
free(key2);
return i;
}
// sort table in memory
void
tcob_sort_mem(struct fld_desc *f, char *buffer, int len, int min, int max, char *dontimes, struct fld_desc *don, ...)
{
struct fld_desc *key;
char *value, *key_sort;
int direction, i;
va_list args;
// key_value = malloc(sizeof(char) * 1024); *key_value = 0;
// key1 = malloc(sizeof(char) * 1024); *key1 = 0;
// key2 = malloc(sizeof(char) * 1024); *key2 = 0;
key_sort = calloc(1, sizeof (char) * 4096);
if (don)
{ // depending on
max = 0;
i = 0;
while (i < don->len)
{
max = (max * 10) + (dontimes[i] - '0');
i++;
}
}
// mount the relative position and direction of the key_fields passed for sort
i = 0;
va_start(args, don);
key = va_arg(args, struct fld_desc *);
while (key)
{
direction = (int) va_arg(args, char *);
value = va_arg(args, char *);
srt_mem[i][0] = (value - buffer);
srt_mem[i][1] = key->len;
srt_mem[i][2] = direction;
key = va_arg(args, struct fld_desc *);
i++;
}
srt_mem[i][0] = 0;
srt_mem[i][1] = 0;
srt_mem[i][2] = 0;
va_end(args);
qsort(buffer, (size_t) max, (size_t) len, compmi); // f->len
/*
if(direction == 2) // descending key
for(j=0; j<key->len; j++)
value[j] = ~ value[j];
strncat(key_sort, value, key->len);
}
va_end(args); */
//qsort(f, (size_t) , f->len, compara);
// free(key_value); free(key1); free(key2);
return;
}
/* End of general.c */
BIN
View File
Binary file not shown.
+514
View File
@@ -0,0 +1,514 @@
/*
* Copyright (C) 1999 - 2003, Rildo Pragana,
* Andrew Cameron, David Essex, Jim Noeth.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
/*
*
* Header file for COBOL Compiler Run Time Library
*
*/
#ifndef HTCOBLIB_H
#define HTCOBLIB_H
/*
// walter
//#define DEBUG_COMPILER 1
// fim walter
*/
#include "htconfig.h"
#include "mwindows.h"
#ifndef __MINGW32__
#include <sys/param.h>
#endif
//#include <sys/stat.h>
#include <ctype.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>
//#include <math.h>
#include <stdlib.h>
#include <errno.h>
#include <limits.h>
//#include <fcntl.h>
#include <time.h>
#include <stdarg.h>
#include <sys/types.h>
#define tc_min(x,y) ((x)<(y) ? (x) : (y))
#define tc_abs(x) ((x)<0 ? -(x) : (x))
#define HTCOB_LD_PATH "TCOB_LD_LIBRARY_PATH"
/* Set library db headers and version 1.85 compatibility API for versions >= 2.xx */
#ifdef USE_DB
#include <db.h>
#endif
#ifdef USE_DB_1
#include <db1/db.h>
#endif
#ifdef USE_DB_23
#define DB_LIBRARY_COMPATIBILITY_API
#include <db_185.h>
#endif
#ifdef USE_DB_41
#define DB_LIBRARY_COMPATIBILITY_API
#include <db_185.h>
#endif
#ifdef USE_DB_2
#define DB_LIBRARY_COMPATIBILITY_API
#include <db2/db_185.h>
#endif
#ifdef USE_DB_3
#define DB_LIBRARY_COMPATIBILITY_API
#include <db3/db_185.h>
#endif
#ifdef USE_DB_4
#define DB_LIBRARY_COMPATIBILITY_API
#include <db4/db_185.h>
#endif
#ifdef WANT_READLINE
#include <readline/readline.h>
#endif
#ifdef WANT_DYNAMIC_LIBS
#include <dlfcn.h>
#endif
#define RTL_FILE_VERSION 4
#define KEY_RETURN 10
#define CHR_POSITIVE '+'
#define CHR_NEGATIVE '-'
#define CHR_BLANK ' '
#define CHR_ZERO '0'
#define DTYPE_DISPLAY '9'
#define DTYPE_ALPHA 'A'
#define DTYPE_BININT 'B'
#define DTYPE_PACKED 'C'
#define DTYPE_ACCEPT_DISPLAY 'D'
#define DTYPE_EDITED 'E'
#define DTYPE_GROUP 'G'
#define DTYPE_FLOAT 'U'
#define DTYPE_ALPHANUMERIC 'X'
#define DTYPE_ALPHANUMERICL 'x'
#define DTYPE_COUNT 7
#define MAX_DIGITS 18
#define MAX_INTEGERS 18
#define MAX_DECIMALS 18
#define RLBUF_SIZE 8192
#define ORG_INDEXED 1
#define ORG_SEQUENTIAL 2
#define ORG_RELATIVE 3
#define ORG_LINESEQUENTIAL 4
#ifdef SQL_GATEWAY
#define ORG_MYSQL 10
#define ORG_PGSQL 11
#endif
#define ACC_SEQUENTIAL 1
#define ACC_DYNAMIC 2
#define ACC_RANDOM 3
/*
The following are used by file open IO routine.
They indicate that the filename is EXTERNAL.
The stored filename string is then used as an environment
variable name. It is used to determined the actual filename.
If no environment variable is defined, then the filename
defaults to the stored name.
*/
#define ACCEV_ENVAR 5
#define ACCEV_SEQUENTIAL 6
#define ACCEV_DYNAMIC 7
#define ACCEV_RANDOM 8
#define FMOD_INPUT 1
#define FMOD_IO 2
#define FMOD_OUTPUT 3
#define FMOD_EXTEND 4
/* inspect options */
#define INSPECT_CHARACTERS 1
#define INSPECT_ALL 2
#define INSPECT_LEADING 3
#define INSPECT_FIRST 4
#define INSPECT_TRAILING 5
/* screen attributes */
#define SCR_BLANK_WHEN_ZERO 0x00000001
#define SCR_HIGHLIGHT 0x00000002
#define SCR_LOWLIGHT 0x00000004
#define SCR_UNDERLINE 0x00000008
#define SCR_REVERSE_VIDEO 0x00000010
#define SCR_BLINK 0x00000020
#define SCR_JUST_LEFT 0x00000040
#define SCR_JUST_RIGHT 0x00000080
#define SCR_AUTO 0x00000100
#define SCR_SECURE 0x00000200
#define SCR_REQUIRED 0x00000400
#define SCR_FULL 0x00000800
#define SCR_SIGN_LEADING 0x00001000
#define SCR_SIGN_SEPARATE 0x00002000
/* #define SCR_SIGN_PRESENT 0x00004000 */
#define SCR_BELL 0x00008000
#define SCR_BLANK_SCREEN 0x00010000
#define SCR_BLANK_LINE 0x00020000
#define SCR_DISPLAY 0x00040000 /* if set display, else accept */
#define SCR_NOECHO 0x00080000
#define SCR_UPDATE 0x00100000
#define SCR_ERASE_EOL 0x00200000
#define SCR_ERASE_EOS 0x00400000
#define SCR_NO_ADVANCING 0x00800000
#define SCR_UPPER 0x01000000
#define SCR_LOWER 0x02000000
#define SCR_IS_REFMOD 0x04000000 /* accept into a refmod field */
#define RTERR_INVALID_DATA 1
#define RTERR_INVALID_PIC 2
#define RTERR_NO_MEM 3
#define RTERR_DBG_TRACE 4
/* CONDITIONAL */
#define EQUAL 1
#define LESS 2
#define GREATER 4
#define GEQ 5
#define LEQ 3
#define NEQ 6
#define NO_OF_FILES 100
#define TCOB_MAX_PATHLN 255
/* walter 12-12-05 */
//struct who_call {
// char *name;
// struct who_call *next;
//};
struct element_order {
char *module_name;
// struct who_call *whocall;
char *who_call;
struct element_order *next;
};
/* fim walter */
/* 2 ways to enter a run element,
* entering a program directly or via a call (increasing the process stack
* or
* returning from a called program
*/
enum {
RUN_ELEMENT_ENTER,
RUN_ELEMENT_RETURN
};
#pragma pack(1)
struct fld_desc {
unsigned long int len;
char type;
unsigned char decimals;
char pscale;
unsigned int all:1;
unsigned int just_r:1;
unsigned int separate_sign:1;
unsigned int leading_sign:1;
unsigned int blank:1;
unsigned int reserved:3;
char *pic;
};
struct file_desc {
unsigned char vers_id;
struct fld_desc *fname_desc;
short signed reclen; /* length of record */
/* 1=INDEXED,2=SEQUENTIAL,3=RELATIVE, 4=LINESEQUENTIAL, 10=MYSQL, 11=PGSQL */
unsigned char organization;
/* 1=SEQUENTIAL,2=DYNAMIC,3=RANDOM */
unsigned char access_mode;
int open_mode;
char file_status[2]; /* internally saved file_status */
char file_status_ext[2]; /* reserve for a pointer to FS (libcob) */
DB *dbp; /* pointer for libdb operations */
char *start_record; /* record for start verb control (Andrew Cameron) */
unsigned int optional:1;
unsigned int file_missing:1;
unsigned int with_advancing:1;
unsigned int adv_before:1;
unsigned int init_done:1;
unsigned int eof_hit:1;
unsigned int read_done:1;
unsigned int reserved:1;
/******* from now on, only present for indexed files *********/
short unsigned rec_index; /* offset of index field in record */
struct fld_desc
*ixd_desc; /* offset (DGROUP) index field descriptor */
struct altkey_desc *key_in_use;
};
struct altkey_desc {
short int offset; /* offset of alternate key field in record */
struct fld_desc
*descriptor; /* descriptor for this field */
short int
duplicates; /* = 1 if duplicates allowed */
DB *alt_dbp; /* handle for the alternate key file */
};
struct scr_desc {
int attr;
int line;
int column;
short int foreground;
short int background;
void (*process_scr)();
};
/*
* Structure for keeping info for each run element
*/
struct runelement_info {
char *name; /* the name of the run element */
char *screen_status; /* pointer to the screen_status
field for this run element */
char *screen_cursor; /* pointer to the screen_cursor
field for this run element */
int decimal_comma; /* value of the decimal comma symbol
for this run element */
int currency_symbol; /* value of the currency symbol
for this run element */
void *handler; /* pointer for dynamic loaded routines
for calling cancel */
struct file_list *files; /* pointer to file open by run element. */
};
struct runelement_list {
struct runelement_info *element;
struct runelement_list *next;
struct runelement_list *prev;
};
struct file_list {
struct file_desc *file;
struct file_list *next;
};
#pragma pack()
/* cobmove.c */
void tcob_move(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2);
void _DUMP_(unsigned char *caData, char *szCount, char *caOut);
void _FLDDUMP_(struct fld_desc *f, char *c, char *szMsg);
void float2all(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2);
void initIntValues();
/* cobmove_9_.c */
void tcob_move_9_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_9_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_9_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_9_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_9_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_9_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* cobmove_b_.c */
void tcob_move_b_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_b_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_b_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_b_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_b_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_b_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* cobmove_c_.c */
void tcob_move_c_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_c_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_c_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_c_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_c_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_c_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* cobmove_f_.c */
void tcob_move_f_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_f_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_f_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_f_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_f_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_f_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* cobmove_x_.c */
void tcob_move_x_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_x_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_x_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_x_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_x_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_x_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* cobmove_e_.c */
void tcob_move_edited(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_9(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_b(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_c(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_e(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_f(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
void tcob_move_e_x(struct fld_desc *f1, char *s1,
struct fld_desc *f2, char *s2);
/* mcmath.c */
char tcob_sign_to_char(int digit );
int tcob_char_to_sign(char ch );
char tcob_extract_sign(struct fld_desc *f, char *s);
void tcob_put_sign(struct fld_desc *f, char *s, char sign);
int tcob_get_index(struct fld_desc *f, char *s);
void tcob_fldtod(struct fld_desc *f, char *s, double *fp);
void tcob_push_double(struct fld_desc *f, char *s, double d);
int tcob_assign_double(struct fld_desc *f, char *s1, int opts, double d1);
int tcob_dtofld(struct fld_desc *f, char *s1, int round, double d1);
void tcob_add_double(double *d2, double d1);
void tcob_subtract_double(double *d2, double d1);
void tcob_multiply_double(double *d2, double d1);
void tcob_divide_double(double *d2, double d1);
int tcob_add(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2, int round);
int tcob_subtract(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2, int round);
int tcob_multiply(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2, struct fld_desc *f3, char *s3, int round);
int tcob_divide(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2, struct fld_desc *f3, char *s3, int round);
int tcob_divide1(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2, struct fld_desc *f3, char *s3, struct fld_desc *f4, char *s4, int round);
int tcob_check_size_overflow(struct fld_desc *f, double d);
int tcob_check_condition(struct fld_desc *f1, char *s1, ...);
int tcob_compare(struct fld_desc *f1, char *s1, struct fld_desc *f2, char *s2);
/* general.c */
void tcob_stop_run(void);
unsigned int tcob_fldLength(struct fld_desc *f);
void tcob_add_file_list(struct file_desc *f);
void tcob_remove_file_list(struct file_desc *f);
void tcob_cancel_all();
struct runelement_info *tcob_get_current_runelement();
void tcob_unload_runelement(struct runelement_info *i);
/* pictures.c */
char* tcob_picExpand(struct fld_desc *f);
unsigned int tcob_picCompLength(struct fld_desc *f);
unsigned int tcob_picEditedCompLength(struct fld_desc *f);
unsigned int tcob_picEditedCompDecimals(struct fld_desc *f);
unsigned int tcob_picElemLen(char *p, unsigned int i);
char tcob_picElemVal(char *p, unsigned int i);
unsigned int tcob_picReqLen(unsigned int i);
char* tcob_picCreate(char *p, unsigned int len, ...);
char* tcob_picAppend(char *p, unsigned int len, ...);
int tcob_isFloatPic(char *p);
/* basicio.c */
void tcob_newline(int dupon);
void tcob_display(struct fld_desc *f,char *s, int dupon);
void tcob_display_erase(int dupon);
int tcob_accept_chron(struct fld_desc *f, char *buffer,
int date_fmt, int is_yyyy);
int tcob_accept_std(char *buffer, struct fld_desc *f, int echo);
int tcob_accept_cmd_line(struct fld_desc *f, char *buffer);
int tcob_accept_env_var(struct fld_desc *f, char *buffer, char *evname);
int tcob_init(int ac, char **av);
/* fileio.c */
int tcob_open(struct file_desc *f, char *record, char *fname, int mode);
int tcob_close(struct file_desc *f, char *record);
int tcob_close_real(struct file_desc *f, char *record);
int tcob_file_init(struct file_desc *f, char *record);
int tcob_read(struct file_desc *f, char *record, ...);
int tcob_read_into(struct file_desc *f, char *record, char *buf, ...);
int tcob_read_next(struct file_desc *f, char *record, ...);
int tcob_read_prev(struct file_desc *f, char *record, ...);
int tcob_read_next_into(struct file_desc *f, char *record, char *buf);
int tcob_read_prev_into(struct file_desc *f, char *record, char *buf);
int tcob_write(struct file_desc *f, char *record, ...);
int tcob_save_status(char *status, int rt);
/* screenio.c */
int tcob_accept_screen();
void tcob_display_screen();
void tcob_scr_process(int iAttr, int iLine, int line_sign,int iColumn,
int column_sign, int iFgColor, int iBgColor, int size,
struct fld_desc *fldScr, char *caScr, void *pInfo, ...);
void tcob_init_screen(void);
void tcob_do_scrio_finish();
/* dyncall.c */
/* void *tcob_resolve_subr(struct fld_desc*, char *); */
void *tcob_resolve_subr(struct fld_desc*, char *, int);
void tcob_resolve_subr_error(void);
void tcob_cancel_subr(char *, char *); // walter 12-12-2005 acrescentei um *
int tcob_call_loadlib(struct fld_desc*, char *);
void *tcob_resolve(char *);
/* Run Time Error Routines */
void runtime_error(int iErrorNbr, struct fld_desc *pFld, void *pData);
/* EOF htcoblib.h */
#endif /* HTCOBLIB_H */
+342
View File
@@ -0,0 +1,342 @@
EXPORTS
_DUMP_ @1
_FLDDUMP_ @2
__add_ovflpage @3
__addel @4
__big_delete @5
__big_insert @6
__big_keydata @7
__big_return @8
__big_split @9
__bt_close @10
__bt_cmp @11
__bt_defcmp @12
__bt_defpfx @13
__bt_delete @14
__bt_dleaf @15
__bt_fd @16
__bt_free @17
__bt_get @18
__bt_new @19
__bt_open @20
__bt_pgin @21
__bt_pgout @22
__bt_put @23
__bt_ret @24
__bt_search @25
__bt_seq @26
__bt_setcur @27
__bt_split @28
__bt_sync @29
__buf_free @30
__buf_init @31
__call_hash @32
__dbpanic @33
__default_hash @34 DATA
__delpair @35
__expand_table @36
__find_bigpair @37
__find_last_page @38
__free_ovflpage @39
__get_buf @40
__get_page @41
__hash_open @42
__ibitmap @43
__log2 @44
__ovfl_delete @45
__ovfl_get @46
__ovfl_put @47
__put_page @48
__rec_close @49
__rec_delete @50
__rec_dleaf @51
__rec_fd @52
__rec_fmap @53
__rec_fpipe @54
__rec_get @55
__rec_iput @56
__rec_open @57
__rec_put @58
__rec_ret @59
__rec_search @60
__rec_seq @61
__rec_sync @62
__rec_vmap @63
__rec_vpipe @64
__reclaim_buf @65
__split_page @66
_generic_4binary @67 DATA
_generic_8float @68 DATA
_get_output_format @69
_iIntValues_ @70 DATA
_iRtErrorNbr @71 DATA
_szRtErrorDesc @72 DATA
bDecimalComma @73 DATA
cCurrencySymbol @74 DATA
days_in_year @75
dbopen @76
dlerror @77
elementorder @78 DATA
filledNum @79
fixField @80
fldtoint @81
get_edit_code @82
get_next_input_field @83
get_prev_input_field @84
ignore_lock @85 DATA
initIntValues @86
integer_of_date @87
last_screen_status @88 DATA
map_file_name @89
mmdd @90
mpool_close @91
mpool_filter @92
mpool_get @93
mpool_new @94
mpool_open @95
mpool_put @96
mpool_sync @97
need_lock @98 DATA
pMovRtn @99 DATA
prepare_dest_field @100
prepare_input_field @101
running_element @102 DATA
runtime_error @103
scr_pos @104
screen_cursor @105 DATA
screen_status @106 DATA
setDecimalComma @107
srt_mem @108 DATA
tcob_accept_chron @109
tcob_accept_cmd_line @110
tcob_accept_curses @111
tcob_accept_env_var @112
tcob_accept_escapekey @113
tcob_accept_inkey @114
tcob_accept_screen @115
tcob_accept_std @116
tcob_add @117
tcob_add_double @118
tcob_add_file_list @119
tcob_adjust_length @120
tcob_assign_double @121
tcob_assign_int @122
tcob_autocleanall @123
tcob_call_loadlib @124
tcob_cancel @125
tcob_cancel_all @126
tcob_cancel_subr @127
tcob_chain @128
tcob_chaining @129
tcob_char_to_sign @130
tcob_check_alphabetic @131
tcob_check_condition @132
tcob_check_lower @133
tcob_check_numeric @134
tcob_check_size_overflow @135
tcob_check_upper @136
tcob_check_varying @137
tcob_classifyPic @138
tcob_close @139
tcob_close_real @140
tcob_cnv_ll2i @141
tcob_compare @142
tcob_compare_doubles @143
tcob_delete @144
tcob_display @145
tcob_display_curses @146
tcob_display_erase @147
tcob_display_screen @148
tcob_divide @149
tcob_divide1 @150
tcob_divide_double @151
tcob_do_scrio_finish @152
tcob_dtofld @153
tcob_enter_runelement @154
tcob_extract_sign @155
tcob_file_init @156
tcob_fldLength @157
tcob_fldtod @158
tcob_get_current_runelement @159
tcob_get_index @160
tcob_get_int_config @161
tcob_get_keybindings @162
tcob_get_str_config @163
tcob_get_switch @164
tcob_go_x @165
tcob_go_y @166
tcob_gox_expr @167
tcob_goxy @168
tcob_goxy_expr @169
tcob_goxy_variable @170
tcob_goy_expr @171
tcob_hasZ @172
tcob_ignorelock @173
tcob_init @174
tcob_init_screen @175
tcob_inspect_converting @176
tcob_inspect_replacing @177
tcob_inspect_tallying @178
tcob_intrinsic_abs @179
tcob_intrinsic_acos @180
tcob_intrinsic_annuity @181
tcob_intrinsic_asin @182
tcob_intrinsic_atan @183
tcob_intrinsic_cos @184
tcob_intrinsic_current_date @185
tcob_intrinsic_date_of_integer @186
tcob_intrinsic_date_to_yyyymmdd @187
tcob_intrinsic_day_of_integer @188
tcob_intrinsic_day_to_yyyyddd @189
tcob_intrinsic_factorial @190
tcob_intrinsic_integer @191
tcob_intrinsic_integer_of_date @192
tcob_intrinsic_integer_of_day @193
tcob_intrinsic_integer_part @194
tcob_intrinsic_log @195
tcob_intrinsic_log10 @196
tcob_intrinsic_lower_case @197
tcob_intrinsic_max @198
tcob_intrinsic_mean @199
tcob_intrinsic_median @200
tcob_intrinsic_midrange @201
tcob_intrinsic_min @202
tcob_intrinsic_mod @203
tcob_intrinsic_numval @204
tcob_intrinsic_numval_c @205
tcob_intrinsic_ord_max @206
tcob_intrinsic_ord_min @207
tcob_intrinsic_present_value @208
tcob_intrinsic_random @209
tcob_intrinsic_range @210
tcob_intrinsic_rem @211
tcob_intrinsic_reverse @212
tcob_intrinsic_sin @213
tcob_intrinsic_sqrt @214
tcob_intrinsic_standard_deviation @215
tcob_intrinsic_sum @216
tcob_intrinsic_tan @217
tcob_intrinsic_test_date_yyyymmdd @218
tcob_intrinsic_test_day_yyyyddd @219
tcob_intrinsic_upper_case @220
tcob_intrinsic_variance @221
tcob_intrinsic_year_to_yyyy @222
tcob_isAlpha @223
tcob_isNumEdit @224
tcob_isNumeric @225
tcob_isZNum @226
tcob_move @227
tcob_move_9_9 @228
tcob_move_9_b @229
tcob_move_9_c @230
tcob_move_9_e @231
tcob_move_9_f @232
tcob_move_9_x @233
tcob_move_b_9 @234
tcob_move_b_b @235
tcob_move_b_c @236
tcob_move_b_e @237
tcob_move_b_f @238
tcob_move_b_x @239
tcob_move_c_9 @240
tcob_move_c_b @241
tcob_move_c_c @242
tcob_move_c_e @243
tcob_move_c_f @244
tcob_move_c_x @245
tcob_move_e_9 @246
tcob_move_e_b @247
tcob_move_e_c @248
tcob_move_e_e @249
tcob_move_e_eX @250
tcob_move_e_f @251
tcob_move_e_x @252
tcob_move_edited @253
tcob_move_f_9 @254
tcob_move_f_b @255
tcob_move_f_c @256
tcob_move_f_e @257
tcob_move_f_f @258
tcob_move_f_x @259
tcob_move_x_9 @260
tcob_move_x_b @261
tcob_move_x_c @262
tcob_move_x_e @263
tcob_move_x_f @264
tcob_move_x_x @265
tcob_multiply @266
tcob_multiply_double @267
tcob_newline @268
tcob_open @269
tcob_picAppend @270
tcob_picChangeChar @271
tcob_picCharLen @272
tcob_picCompLength @273
tcob_picCreate @274
tcob_picDecimalPointPosition @275
tcob_picEditedCompDecimals @276
tcob_picEditedCompLength @277
tcob_picElemLen @278
tcob_picElemVal @279
tcob_picExpand @280
tcob_picReqLen @281
tcob_picSignPosition @282
tcob_picTotalLen @283
tcob_pow_double @284
tcob_push_double @285
tcob_put_integer @286
tcob_put_sign @287
tcob_read @288
tcob_read_next @289
tcob_read_prev @290
tcob_remove_file_list @291
tcob_resolve @292
tcob_resolve_subr @293
tcob_resolve_subr_error @294
tcob_rewrite @295
tcob_rt_abort @296
tcob_rt_debug @297
tcob_rt_error @298
tcob_rt_malloc @299
tcob_rt_warning @300
tcob_save_status @301
tcob_scr_accept @302
tcob_scr_accept_edited @303
tcob_scr_accept_field @304
tcob_scr_accept_number @305
tcob_scr_action_for_key @306
tcob_scr_display @307
tcob_scr_display_field @308
tcob_scr_display_for_input @309
tcob_scr_finish @310
tcob_scr_getx @311
tcob_scr_gety @312
tcob_scr_init @313
tcob_scr_kbdstatus @314
tcob_scr_process @315
tcob_scr_scrl @316
tcob_scr_setx @317
tcob_scr_sety @318
tcob_scr_setyx @319
tcob_set_switch @320
tcob_setlock @321
tcob_sign_to_char @322
tcob_sort_giving @323
tcob_sort_mem @324
tcob_sort_open @325
tcob_sort_release @326
tcob_sort_return @327
tcob_sort_using @328
tcob_start @329
tcob_stop_run @330
tcob_stringcmd @331
tcob_subtract @332
tcob_subtract_double @333
tcob_unload_runelement @334
tcob_unlock @335
tcob_unstring @336
tcob_var_argc @337 DATA
tcob_var_argv @338 DATA
tcob_write @339
tcob_write_adv @340
wacky_lseek_for_dos @341
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+71
View File
@@ -0,0 +1,71 @@
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <winver.h>
#define VER_FILEVERSION 0,73,0,0
#define VER_FILEVERSION_STR "0.73.0"
#define VER_BUILDDATE_STR "2012/02/08"
#define VER_LEGALCOPYRIGHT_STR "Copyright 1999-2004 by Rildo Pragana"
//#define VER_COMMENT_STR ""
#define VER_FILEDESCRIPTION_STR "TinyCOBOL run-time DLL"
#define VER_INTERNALNAME_STR "TinyCOBOL"
#define VER_ORIGINALFILENAME_STR "htcobol.dll"
#define VER_WWW_STR "http://tiny-cobol.sourceforge.net"
#define VER_COMPANYNAME_STR "The TinyCOBOL Project"
#define VER_LICENSE_STR "This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License;see www.gnu.org/copyleft/lesser.html."
#define VER_PRODUCTNAME_STR "TinyCOBOL"
#define VER_PRODUCTVERSION 0,73,0,0
#define VER_PRODUCTVERSION_STR "0.73.0"
#define VER_FILETYPE VFT_DLL
#ifndef VER_FILETYPE
#define VER_FILETYPE VFT_APP
#endif
#define VER_FILESUBTYPE VFT2_UNKNOWN
#define VER_FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
//#define VER_FILEFLAGS (VER_PRIVATEBUILD|VER_SPECIALBUILD|VER_PRERELEASE|VER_DEBUG|VER_PATCHED)
#define VER_FILEFLAGS 0
#define VER_FILEOS VOS__WINDOWS32
VS_VERSION_INFO VERSIONINFO
FILEVERSION VER_FILEVERSION
PRODUCTVERSION VER_PRODUCTVERSION
FILEFLAGSMASK VER_FILEFLAGSMASK
FILEFLAGS VER_FILEFLAGS
FILEOS VER_FILEOS
FILETYPE VER_FILETYPE
FILESUBTYPE VER_FILESUBTYPE
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4"
/* language ID = U.S. English, char set = Windows, Multilingual */
BEGIN
#ifdef VER_COMMENT_STR
VALUE "Comments", VER_COMMENT_STR
#endif
VALUE "CompanyName", VER_COMPANYNAME_STR
VALUE "License", VER_LICENSE_STR
VALUE "FileDescription", VER_FILEDESCRIPTION_STR
VALUE "FileVersion", VER_FILEVERSION_STR
VALUE "InternalName", VER_INTERNALNAME_STR
VALUE "LegalCopyright", VER_LEGALCOPYRIGHT_STR
VALUE "OriginalFilename", VER_ORIGINALFILENAME_STR
VALUE "ProductName", VER_PRODUCTNAME_STR
VALUE "ProductVersion", VER_PRODUCTVERSION_STR
VALUE "Build Date", VER_BUILDDATE_STR
VALUE "WWW", VER_WWW_STR
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x409, 1252
END
END
+71
View File
@@ -0,0 +1,71 @@
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <winver.h>
#define VER_FILEVERSION @TCOB_MAJOR_VERSION@,@TCOB_MINOR_VERSION@,@TCOB_PATCH_LEVEL@,0
#define VER_FILEVERSION_STR "@TCOB_VERSION@"
#define VER_BUILDDATE_STR "@TCOB_RELEASE_DATE@"
#define VER_LEGALCOPYRIGHT_STR "Copyright 1999-2004 by Rildo Pragana"
//#define VER_COMMENT_STR ""
#define VER_FILEDESCRIPTION_STR "TinyCOBOL run-time DLL"
#define VER_INTERNALNAME_STR "TinyCOBOL"
#define VER_ORIGINALFILENAME_STR "htcobol.dll"
#define VER_WWW_STR "http://tiny-cobol.sourceforge.net"
#define VER_COMPANYNAME_STR "The TinyCOBOL Project"
#define VER_LICENSE_STR "This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License;see www.gnu.org/copyleft/lesser.html."
#define VER_PRODUCTNAME_STR "TinyCOBOL"
#define VER_PRODUCTVERSION @TCOB_MAJOR_VERSION@,@TCOB_MINOR_VERSION@,@TCOB_PATCH_LEVEL@,0
#define VER_PRODUCTVERSION_STR "@TCOB_VERSION@"
#define VER_FILETYPE VFT_DLL
#ifndef VER_FILETYPE
#define VER_FILETYPE VFT_APP
#endif
#define VER_FILESUBTYPE VFT2_UNKNOWN
#define VER_FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
//#define VER_FILEFLAGS (VER_PRIVATEBUILD|VER_SPECIALBUILD|VER_PRERELEASE|VER_DEBUG|VER_PATCHED)
#define VER_FILEFLAGS 0
#define VER_FILEOS VOS__WINDOWS32
VS_VERSION_INFO VERSIONINFO
FILEVERSION VER_FILEVERSION
PRODUCTVERSION VER_PRODUCTVERSION
FILEFLAGSMASK VER_FILEFLAGSMASK
FILEFLAGS VER_FILEFLAGS
FILEOS VER_FILEOS
FILETYPE VER_FILETYPE
FILESUBTYPE VER_FILESUBTYPE
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4"
/* language ID = U.S. English, char set = Windows, Multilingual */
BEGIN
#ifdef VER_COMMENT_STR
VALUE "Comments", VER_COMMENT_STR
#endif
VALUE "CompanyName", VER_COMPANYNAME_STR
VALUE "License", VER_LICENSE_STR
VALUE "FileDescription", VER_FILEDESCRIPTION_STR
VALUE "FileVersion", VER_FILEVERSION_STR
VALUE "InternalName", VER_INTERNALNAME_STR
VALUE "LegalCopyright", VER_LEGALCOPYRIGHT_STR
VALUE "OriginalFilename", VER_ORIGINALFILENAME_STR
VALUE "ProductName", VER_PRODUCTNAME_STR
VALUE "ProductVersion", VER_PRODUCTVERSION_STR
VALUE "Build Date", VER_BUILDDATE_STR
VALUE "WWW", VER_WWW_STR
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x409, 1252
END
END
+96
View File
@@ -0,0 +1,96 @@
#
# TinyCOBOL run-time configuration file
#
#
# The KEY_XXXX field, define what the runtime does
# with the input of control keys.
#
# The input is define as :
#
# KEY_XXXX EDIT_action termination_value.
#
# Suported edit values :
#
# EDIT_TERMINATE Terminate the input. Move termination
# value to crt status.
#
# EDIT_LAST_FIELD Move cursor to the last field field.
# EDIT_FIRST_FIELD Move cursor to the last field field.
# EDIT_UP_FIELD Move cursor to previous field. If first field
# terminate edit.
# EDIT_DOWN_FIELD Move cursor to next field. If last field
# terminate edit.
# EDIT_PREV_FIELD Move cursor to previous field.At first field
# rotate to last field
# EDIT_NEXT_FIELD Move cursor to next field.At last field
# rotate to first field
#
# EDIT_LEFT Move cursor to left inside current field
# EDIT_RIGHT Move cursor to right inside current field
# EDIT_HOME Move cursor to the begining of current field
# EDIT_END Move cursor to end of current field
#
# EDIT_INSERT Insert a space in the current position
# EDIT_BACKSPACE Delete the character previous to the cursor
# EDIT_DELETE Delete the character on the cursor
#
# EDIT_CLEAR Clear the current field
# EDIT_CLEAR_TOEND Clear from cursor to the end of field
#
# EDIT_NOP Define no action for a key.
#
# Here is an example of a runtime config file. Appart from the keys defined
# here there is also possible to define from KEY_CTRL_A to KEY_CTRL_Z.
#
KEY_ESCAPE EDIT_TERMINATE 27
KEY_RETURN EDIT_TERMINATE 13
KEY_ENTER EDIT_TERMINATE 13
KEY_LEFT EDIT_LEFT
KEY_RIGHT EDIT_RIGHT
KEY_HOME EDIT_FIRST
KEY_END EDIT_LAST
KEY_UP EDIT_TERMINATE 0259
KEY_DOWN EDIT_TERMINATE 0367
#KEY_UP EDIT_CLEAR 0259
#KEY_DOWN EDIT_CLEAR 0367
#KEY_UP EDIT_CLEAR
#KEY_DOWN EDIT_CLEAR
#KEY_UP EDIT_UP_FIELD
#KEY_DOWN EDIT_DOWN_FIELD
KEY_TAB EDIT_NEXT_FIELD
KEY_BTAB EDIT_PREV_FIEL
KEY_CTRL_N EDIT_NEXT_FIELD 13
KEY_CTRL_P EDIT_PREV_FIELD 16
KEY_CTRL_F EDIT_FIRST_FIELD 6
KEY_CTRL_L EDIT_LAST_FIELD 12
KEY_CTRL_D EDIT_CLEAR 12
KEY_DELETE EDIT_DELETE
KEY_INSERT EDIT_INSERT
KEY_BACKSPACE EDIT_BACKSPACE
KEY_PPAGE EDIT_TERMINATE 0338
KEY_NPAGE EDIT_TERMINATE 0339
KEY_F1 EDIT_TERMINATE 0265
#KEY_F1 EDIT_TERMINATE 1
KEY_F2 EDIT_TERMINATE 0266
KEY_F3 EDIT_TERMINATE 0267
KEY_F4 EDIT_TERMINATE 0268
KEY_F5 EDIT_TERMINATE 0269
KEY_F6 EDIT_TERMINATE 0270
KEY_F7 EDIT_TERMINATE 0271
KEY_F8 EDIT_TERMINATE 0272
KEY_F9 EDIT_TERMINATE 0273
KEY_F10 EDIT_TERMINATE 0274
KEY_F11 EDIT_TERMINATE 0275
KEY_F12 EDIT_TERMINATE 0276
KEY_DECIMALCOMMA EDIT_DECIMALPT
KEY_AUTOCLEANALL EDIT_NOP 1
+1473
View File
File diff suppressed because it is too large Load Diff
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
Binary file not shown.
Binary file not shown.
+1385
View File
File diff suppressed because it is too large Load Diff
BIN
View File
Binary file not shown.
+544
View File
@@ -0,0 +1,544 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
/*---------------------------------------------------------------------------*\
| |
| COBOL Compiler Run Time Library -- Pictures |
| See each function's comments for more detail. |
| Independent of compressed PIC implementation: |
| tcob_picExpand() - Returns an expanded version of the PIC string |
| tcob_picCompLength() - Numeric character count |
| tcob_picEditedCompLength() - Numeric-edited character count |
| tcob_picEditedCompDecimals() - Decimal numeric-edited characters count |
| Dependent on compressed PIC implementation: |
| tcob_picElemVal() - Retrieve character value from a specified element |
| tcob_picElemLen() - Retrieve character count from a specified element |
| tcob_picReqLen() - Determine size to allocate for a new compressed PIC |
| tcob_picCreate() - Start a new compressed PIC string |
| tcob_picAppend() - Continue a compressed PIC string |
| |
\*---------------------------------------------------------------------------*/
#include "htcoblib.h"
#include "screenio.h"
extern int bDecimalComma;
/*------------------------------------------------------------------------*\
| |
| tcob_picExpand |
| expand a picture returning a malloc'ed string |
| from: "XAYBZC" (where X, Y, Z are picture characters and |
| A, B, C are binary counts for each character) |
| to: "XXXXYYYZZZZZ" |
| |
\*------------------------------------------------------------------------*/
char * tcob_picExpand( struct fld_desc *f ) {
char *result, c;
unsigned int i, t, tot;
for (i=0, tot=0; tcob_picElemVal(f->pic,i); i++)
tot += tcob_picElemLen(f->pic,i);
result = malloc(tot+1);
for (i=0, tot=0; (c=tcob_picElemVal(f->pic,i)); i++) {
t = tcob_picElemLen(f->pic,i);
memset (&result[tot], c, t);
tot += t;
}
result[tot] = '\0';
/*
#ifdef PICTURE_TESTING
printf("tcob_picexpand: %s\n", result);
free(result);
return NULL;
#else
return result;
#endif
*/
return result;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picCompLength |
| For numeric types, determine the total number of stored digits. |
| Includes 9's. |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picCompLength( struct fld_desc *f ) {
unsigned int len=0, i;
char c;
for (i=0; (c=tcob_picElemVal(f->pic,i)); i++) {
if (c == '9')
len += tcob_picElemLen(f->pic,i);
}
return len;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picEditedCompLength |
| For the numeric-edited type, determine the total number of digits |
| available. Includes 9's, Z's,*'s, and multiples of +, -, and the |
| currency sign. |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picEditedCompLength( struct fld_desc *f ) {
unsigned int len=0, i;
unsigned int bSeenPlus=0, bSeenMinus=0, bSeenCurrency=0;
char c;
extern char cCurrencySymbol;
for (i=0; (c=tcob_picElemVal(f->pic,i)); i++) {
unsigned int ilen = tcob_picElemLen(f->pic,i);
if (c == '9' || c == 'Z' || c == '*' ||
(bSeenPlus && (c == '+')) ||
(bSeenMinus && (c == '-')) ||
(bSeenCurrency && (c == cCurrencySymbol)) )
len += ilen;
if (!bSeenPlus && (c == '+')) {
bSeenPlus = 1;
len += ilen - 1;
} else if (!bSeenMinus && (c == '-')) {
bSeenMinus = 1;
len += ilen - 1;
} else if (!bSeenCurrency && (c == cCurrencySymbol)) {
bSeenCurrency = 1;
len += ilen - 1;
}
}
return len;
}
unsigned int tcob_picTotalLen( char *pic ) {
int len=0;
while (*pic) {
len += *(pic+1);
pic+=2;
}
return len;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picSignPosition |
| For the numeric- type, determine the position of the sign |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picSignPosition( struct fld_desc *f ) {
unsigned int len=0, i;
char c;
int d = DISPLAYFIELD(f->type);
for (i=0; (c=tcob_picElemVal(f->pic,i)); i++) {
unsigned int ilen = tcob_picElemLen(f->pic,i);
len += ilen;
if ((c == '+' || c == '-') || (c == 'S' && d && i == 0)) {
len -= ilen;
return len;
}
}
return -1;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picDecimalPointPosition |
| For the numeric- type, determine the position of the decimal point |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picDecimalPointPosition( struct fld_desc *f ) {
unsigned int len=0, i;
extern int bDecimalComma;
char c, cDecimal = (bDecimalComma) ? ',' : '.';
for (i=0; (c=tcob_picElemVal(f->pic,i)); i++) {
unsigned int ilen = tcob_picElemLen(f->pic,i);
len += ilen;
if (c == cDecimal) {
len -= ilen;
return len;
}
}
return -1;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picEditedCompDecimals |
| For the numeric-edited type, determine the total number of digits |
| available after the decimal point. Includes 9's, Z's,*'s, and |
| multiples of +, -, and the currency sign. |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picEditedCompDecimals( struct fld_desc *f ) {
unsigned int len=0, i;
int bSeenDecimal=0, bSeenPlus=0, bSeenMinus=0, bSeenCurrency=0;
extern int bDecimalComma;
extern char cCurrencySymbol;
char c, cDecimal = (bDecimalComma) ? ',' : '.';
for (i=0; (c=tcob_picElemVal(f->pic,i)); i++) {
unsigned int ilen = tcob_picElemLen(f->pic,i);
if (bSeenDecimal && // Must find the decimal point first
(c == '9' || c == 'Z' || c == '*' ||
(bSeenPlus && (c == '+')) ||
(bSeenMinus && (c == '-')) ||
(bSeenCurrency && (c == cCurrencySymbol)) ) )
len += ilen;
if (!bSeenDecimal && (c == cDecimal)) {
bSeenDecimal = 1;
} else if (!bSeenPlus && (c == '+')) {
bSeenPlus = 1;
if (bSeenDecimal)
len += ilen - 1;
} else if (!bSeenMinus && (c == '-')) {
bSeenMinus = 1;
if (bSeenDecimal)
len += ilen - 1;
} else if (!bSeenCurrency && (c == cCurrencySymbol)) {
bSeenCurrency = 1;
if (bSeenDecimal)
len += ilen - 1;
}
}
return len;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picElemLen & tcob_picElemVal |
| Determine the length or value of element i in array p. |
| Each element is composed of an 8-bit character and an 8-bit length. |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picElemLen(char *p, unsigned int i) {
return ( (unsigned int)(((unsigned short *)p)[i] >> 8) );
}
char tcob_picElemVal(char *p, unsigned int i) {
return ( ((unsigned short *)p)[i] & 0x0ff );
}
/*------------------------------------------------------------------------*\
| |
| tcob_picReqLen |
| Determine number of bytes to request for holding a compressed PIC |
| string of i elements. |
| |
\*------------------------------------------------------------------------*/
unsigned int tcob_picReqLen(unsigned int i) {
/* Currently using a 1-byte value and a 1-byte length for each
* element, plus a 1-byte NULL to indicate the end */
return ((i*2)+1);
}
/*------------------------------------------------------------------------*\
| |
| tcob_picCreate |
| Create a new PIC string and place in p. |
| |
\*------------------------------------------------------------------------*/
char *tcob_picCreate(char *p, unsigned int len, ...) {
char pc;
unsigned int i=0, ilen;
va_list args;
va_start(args, len);
while ((pc=va_arg(args,int))) {
for (ilen=va_arg(args, int); ilen>255; ilen-=255) {
if (i+1>=len)
break;
p[i] = pc;
p[i+1] = 255;
ilen -= 255;
i += 2;
}
if (i+1>=len)
break;
p[i] = pc;
p[i+1] = ilen;
i += 2;
}
if (i<len)
p[i] = '\0';
else if (i>1)
p[i-2] = '\0';
else if (len==1)
p[0] = '\0';
va_end(args);
return p;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picAppend |
| Continue the PIC string found in p. |
| |
\*------------------------------------------------------------------------*/
char *tcob_picAppend(char *p, unsigned int len, ...) {
char pc;
unsigned int i, ilen;
va_list args;
for (i=0; p[i]; i+=2) ;
va_start(args, len);
while ((pc=va_arg(args,int))) {
for (ilen=va_arg(args, int); ilen>255; ilen-=255) {
if (i+1>=len)
break;
p[i] = pc;
p[i+1] = 255;
ilen -= 255;
i += 2;
}
if (i+1>=len)
break;
p[i] = pc;
p[i+1] = ilen;
i += 2;
}
if (i<len)
p[i] = '\0';
else if (i>1)
p[i-2] = '\0';
else if (len==1)
p[0] = '\0';
va_end(args);
return p;
}
/*------------------------------------------------------------------------*\
| |
| tcob_picChangeChar |
| change the PIC string char in p. |
| |
\*------------------------------------------------------------------------*/
void tcob_picChangeChar(char *p, int i, char c) {
p[i*2]= c;
}
/*-----------------------------------------------------------
* Classify picture type
* receives a compressed pic pointer
* returns picture type
*/
char tcob_classifyPic( char *p ) {
int i;
char type=0;
for (i=0; p[i]; i+=2) {
switch (p[i]) {
case 'A':
if ((type != DTYPE_ALPHANUMERIC && type != DTYPE_EDITED)
|| !type)
type = DTYPE_ALPHA;
break;
case 'X':
if (type == DTYPE_DISPLAY || !type)
type = DTYPE_ALPHANUMERIC;
break;
case 'Z':
type=DTYPE_EDITED;
break;
case '9':
if (!type)
type=DTYPE_DISPLAY;
break;
case 'V':
case 'P':
case 'S':
break;
case '.':
case ',':
case '0':
case 'B':
case '/':
case '+':
case '-':
case '*':
case 'C':
case 'R':
case 'D':
type=DTYPE_EDITED;
break;
}
}
return type;
}
/*********************************************
tcob_isNumEdit
check if a picture stands for a numeric-edited item (true) or
alphanumeric-edited (false).
Standard: ISO/IEC 1989:2001 (pp.323-324)
---------------------------
13.16.38.3 General Rules
...
FORMAT 1
...
7) To define an item as alphanumeric-edited, character-string-1 shall
include:
- at least one symbol 'A' or 'X', and
- at least one of the symbols from the set 'B', '0', '/'.
**********************************************/
int tcob_isNumEdit(char *p) {
char cDecimalChar = '.';
int i,dsep=0;
int axfound=0;
int bzslfound=0;
if (bDecimalComma)
cDecimalChar = ',';
for (i=0; p[i]; i+=2) {
switch (p[i]) {
/* the standard says we must find one of those below, at least,
but for dates (pic 99/99/999) which is visibly not
numeric-edited, there is none 'A' or 'X'. So let's not
require this until someone explains me what to do here. */
case 'A':
case 'X':
axfound=1;
break;
/* don't count a 'B' after 'D' (DB) */
case 'D':
if (p[i+1]==1 && p[i+2]=='B' && p[i+3]==1) {
i+=2;
continue;
}
case '.':
case ',':
if (p[i] == cDecimalChar) {
if (dsep++) {
return 0;
}
/* make sure there are no repetitions here */
if (p[i+1] > 1) {
return 0;
}
}
continue;
case 'B':
case '0':
case '/':
bzslfound=1;
break;
}
}
if (bzslfound && axfound)
return 0;
else
return 1;
}
int tcob_isNumeric(char *p) {
int i;
for (i=0; p[i]; i+=2) {
switch (p[i]) {
case 'S': // walter 13-12-05
continue;
case '9':
continue;
case 'V':
continue;
default:
return 0;
}
}
return 1;
}
int tcob_isZNum(char *p) {
int i;
for (i=0; p[i]; i+=2) {
switch (p[i]) {
case '-':
case ',':
case '.':
case '9':
case 'Z':
continue;
default:
return 0;
}
}
return 1;
}
int tcob_isAlpha(char *p) {
int i;
for (i=0; p[i]; i+=2) {
switch (p[i]) {
case 'A':
case 'X':
return 1;
}
}
return 0;
}
/* check if the picture has any pic Z string */
int tcob_hasZ(char *p) {
int i;
for (i=0; p[i]; i+=2) {
switch (p[i]) {
case 'Z':
return 1;
}
}
return 0;
}
/*********************
how many significative characters (Z,X,A,9,*) there
are in the picture
**********************/
int tcob_picCharLen( unsigned char *pic ) {
int n=0;
while (*pic) {
if (strchr("9ZXA*",*pic)) {
n+=*(pic+1);
}
pic += 2;
}
return n;
}
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+227
View File
@@ -0,0 +1,227 @@
//
// Copyright (C) 2001, Ferran Pegueroles
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
//
// Cobol Compiler Run Time Library -- Runtime error functions
//
//
//#include "htcoblib.h"
#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#ifdef __MINGW32__
#include <windows.h>
#endif
#include "rterrors.h"
#include "htcoblib.h"
/*------------------------------------------------------------------------*\
| |
| table of messages |
| |
\*------------------------------------------------------------------------*/
static struct _msg
{
int msg_num;
char *msg_text;
} rt_messages[] = {
{ TCERR_RESOLVE_STUB, "cannot resolve lib '%s': %s\n"},
// Empty Message
{ TCERR_EMPTY, "%s"},
// Generic Messages
{ TCERR_NO_MEM, "cannot allocate memory\n"},
{ TCERR_NOT_IMPLEMENTED, "function not implemented\n"},
// Chain / chaining
{ TCERR_GEN_NOPIPE, "cannot open pipe to pass data in chain: %s\n"},
{ TCERR_GEN_BADDATA, "error passing data to program: %s\n"},
{ TCERR_GEN_NOEXEC, "cannot execute program on chain: %s\n"},
{ TCERR_GEN_BAD_ARG, "error getting parameters passed from caller: %s\n"},
{ TCERR_GEN_SIZE_ERR, "size error on parameters passed on chain\n"},
{ TCERR_GEN_BAD_PIPE, "error opening descriptor 100 for chaining: %s\n"},
{ TCERR_GEN_RUNELEMENT, "error entering runelement\n"},
// Dynamic calls
{ 301, "error opening '%s': %s\n"},
// Intrinsic functions
{ TCERR_INTRINSIC_BAD_ARG, "Bad arguments calling intrinsic function"},
{ -1, NULL}
};
/*
* Alloc memory and report the error if cannot allocate
*/
void *
tcob_rt_malloc(char *function, size_t size)
{
void *p;
p = calloc(1, size+1);
if (p)
return p;
tcob_rt_error(function, TCERR_NO_MEM);
tcob_rt_abort();
return NULL;
}
/*
* Exit the program with error closing all the files.
*
*/
void
tcob_rt_abort()
{
tcob_stop_run();
exit(1);
}
static void
tcob_rt_print_stack()
{
}
/*------------------------------------------------------------------------*\
| |
| _format_message |
| |
\*------------------------------------------------------------------------*/
static char *
_format_message(int msg_num, va_list ap)
{
unsigned int i, size = 100;
int n;
char *p, *fmt = NULL;
for (i = 0; rt_messages[i].msg_num != -1; i++)
{
if (rt_messages[i].msg_num == msg_num)
{
fmt = rt_messages[i].msg_text;
break;
}
}
if (fmt == NULL)
return "Undefined message";
if ((p = malloc(size)) == NULL)
return "Cannot allocate message";
while (1)
{
/* Try to print in the allocated space. */
#ifndef __MINGW32__
n = vsnprintf(p, size, fmt, ap);
#else
n = _vsnprintf(p, size, fmt, ap);
#endif
/* If that worked, return the string. */
if (n > -1 && n < (int) size)
return p;
/* Else try again with more space. */
if (n > -1) /* glibc 2.1 */
size = n + 1; /* precisely what is needed */
else /* glibc 2.0 */
size *= 2; /* twice the old size */
if ((p = realloc(p, size)) == NULL)
return NULL;
}
}
/*------------------------------------------------------------------------*\
| |
| tcob_rt_error |
| |
\*------------------------------------------------------------------------*/
void
tcob_rt_error(char *function, int msg_num, ...)
{
va_list ap;
char *p;
va_start(ap, msg_num);
p = _format_message(msg_num, ap);
va_end(ap);
fprintf(stderr, "TC Runtime Error: %s: %s", function, p);
tcob_rt_print_stack();
tcob_rt_abort();
}
/*------------------------------------------------------------------------*\
| |
| tcob_rt_warning |
| |
\*------------------------------------------------------------------------*/
void
tcob_rt_warning(char *function, int msg_num, ...)
{
va_list ap;
char *p;
va_start(ap, msg_num);
p = _format_message(msg_num, ap);
va_end(ap);
fprintf(stderr, "TC Runtime Warning: %s: %s", function, p);
tcob_rt_print_stack();
}
/*------------------------------------------------------------------------*\
| |
| tcob_rt_debug |
| |
\*------------------------------------------------------------------------*/
void
tcob_rt_debug(char * function, char *msg, ...)
{
#ifdef DEBUG_RTS
unsigned int size = 100;
int n;
char *p;
va_list ap;
if ((p = malloc(size)) == NULL)
return;
while (1)
{
/* Try to print in the allocated space. */
#ifndef __MINGW32__
n = vsnprintf(p, size, msg, ap);
#else
n = _vsnprintf(p, size, msg, ap);
#endif
/* If that worked, return the string. */
if (n > -1 && n < (int) size)
break;
/* Else try again with more space. */
if (n > -1) /* glibc 2.1 */
size = n + 1; /* precisely what is needed */
else /* glibc 2.0 */
size *= 2; /* twice the old size */
if ((p = realloc(p, size)) == NULL)
return;
}
fprintf(stderr, "TC Debug: %s: %s", function, p);
#endif /* DEBUG_RTS */
}
+48
View File
@@ -0,0 +1,48 @@
/*
* Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
* Andrew Cameron, David Essex.
* Copyright (C) 1993, 1991 Rildo Pragana.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
#ifndef RTERRORS_H
#define RTERRORS_H
enum {
TCERR_EMPTY,
TCERR_RESOLVE_STUB,
TCERR_NO_MEM,
TCERR_NOT_IMPLEMENTED,
TCERR_INTRINSIC_BAD_ARG,
TCERR_GEN_NOPIPE,
TCERR_GEN_BADDATA,
TCERR_GEN_NOEXEC,
TCERR_GEN_BAD_ARG,
TCERR_GEN_SIZE_ERR,
TCERR_GEN_BAD_PIPE,
TCERR_GEN_RUNELEMENT
};
void tcob_rt_abort();
void *tcob_rt_malloc(char *fucntion,size_t size);
void tcob_rt_error (char *function, int msg_num, ...);
void tcob_rt_warning (char *function, int msg_num, ...);
void tcob_rt_debug (char *function,char *msg,...);
#define tcob_malloc(x) tcob_rt_malloc(__FILE__,x)
#endif /* RTERRORS_H */
BIN
View File
Binary file not shown.
+1655
View File
File diff suppressed because it is too large Load Diff
BIN
View File
Binary file not shown.
+863
View File
@@ -0,0 +1,863 @@
/*
* Copyright (C) 2005 Walter Garrote
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 2.1,
* or (at your option) any later version.
*
* This library 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; see the file COPYING.LIB. If
* not, write to the Free Software Foundation, Inc., 59 Temple Place,
* Suite 330, Boston, MA 02111-1307 USA
*/
/* Screen routines */
#include <malloc.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include "screen.h"
extern char *last_screen_status;
void cbl_read_keyboard(char *str6);
char * cbl_avanca_posicao(char *dad, unsigned int qtd);
void cbl_windms_mudacor_posicao(short y, short x, int cor);
void tcob_init_screen(void);
int tcob_scr_kbdstatus(void);
// inicia par de cores
void cbl_windms_inicia_cor() {
int i;
if(initcor) // ja passamos por aqui;
return;
if(has_colors()) { // temos suporte a cores
start_color();
for(i = 0; i < COLOR_PAIRS; i++)
init_pair(i, i%COLORS, i/COLORS);
}
initcor++;
// na lib do tiny na parte de inicializacao de cores, não está definido os pares
// foi criada o par com fg e bg = 0
}
// retorna cor de fundo e de frente usando o codigo de cor
void cbl_windms_color_pair(short cor, short *fg, short *bg) {
// if(cor == 0) // cor padrao 7 (frente branca, fundo preto)
// cor = 7;
*fg = cor % 8; // cor de frente
*bg = cor / 8; // cor de fundo
}
// retorna o codigo de cor usando cor de frente e de fundo
short cbl_windms_monta_cor(short fg, short bg) {
return ((bg * 8) + fg);
}
attr_t encontra_atributo(char *dados) {
attr_t atr = A_NORMAL;
bool normal = true, standout = false, underline = false,
blink = false, reverse = false, dim = false,
protect = false, invisible = false, bold = false,
horiz = false, left = false, low = false,
right = false, top = false, vertical = false,
neg = false;
if(*dados == '/') {
neg = true;
*dados++;
} else
neg = false;
while(*dados != '}') {
*dados = tolower(*dados);
switch(*dados) {
case 'n': normal = ((neg) ? false : true); // normal
if(normal) {
blink = false; standout = false;
underline = false; reverse = false;
protect = false; invisible = false;
bold = false; dim = false;
horiz = false; left = false;
low = false; right = false;
top = false; vertical = false;
}
break;
case 'b': blink = ((neg) ? false : true); // blink
if(blink) normal = false;
break;
case 's': standout = ((neg) ? false : true); // standout
if(standout) normal = false;
break;
case 'u': underline= ((neg) ? false : true); // underline
if(underline) normal = false;
break;
case 'r': reverse = ((neg) ? false : true); // reverse
if(reverse) normal = false;
break;
case 'd': dim = ((neg) ? false : true); // dim
if(dim) normal = false;
break;
case 'p': protect = ((neg) ? false : true); // protect
if(protect) normal = false;
break;
case 'i': invisible= ((neg) ? false : true); // invisible
if(invisible) normal = false;
break;
case 'o': bold = ((neg) ? false : true); // bold
if(bold) normal = false;
break;
case 'h': horiz = ((neg) ? false : true); // horizontal
if(horiz) normal = false;
break;
case 'l': left = ((neg) ? false : true); // left
if(left) normal = false;
break;
case 'w': low = ((neg) ? false : true); // low
if(low) normal = false;
break;
case 'g': right = ((neg) ? false : true); // right
if(right) normal = false;
break;
case 't': top = ((neg) ? false : true); // top
if(top) normal = false;
break;
case 'v': vertical = ((neg) ? false : true); // vertical
if(vertical) normal = false;
break;
}
*dados++;
}
if(normal)
atr = A_NORMAL;
else {
atr = ((blink) ? A_BLINK : 0) |
((standout) ? A_STANDOUT : 0) |
((underline) ? A_UNDERLINE : 0) |
((reverse) ? A_REVERSE : 0) |
((dim) ? A_DIM : 0) |
((protect) ? A_PROTECT : 0) |
((invisible) ? A_INVIS : 0) |
((bold) ? A_BOLD : 0) |
((horiz) ? A_HORIZONTAL: 0) |
((left) ? A_LEFT : 0) |
((low) ? A_LOW : 0) |
((right) ? A_RIGHT : 0) |
((top) ? A_TOP : 0) |
((vertical) ? A_VERTICAL : 0) ;
}
return atr;
}
// escreve na janela
// para se pensar, podemos colocar um byte a mais como sendo o tipo do caracter (highlight, blink etc)
//2005-11-10 void cbl_windms_escreve(struct windpos *lk, unsigned int ponteiro, unsigned int salto, unsigned int ini, unsigned int ul) {
void cbl_windms_escreve(struct windmenu *lk, char *dados, unsigned int ponteiro, unsigned int salto, unsigned int ini, unsigned int ul) {
int y, x, cor, atr, tlaux;
short fg, bg;
char *dados1;
chtype caracter; //, xu;
unsigned char ls, ce, nl, tl;
bool disp;
ls = lk->ls;
ce = lk->ce;
nl = lk->nl;
tl = lk->tl;
atr = A_NORMAL;
switch(lk->fu) { // qual a funcao
case 1:
case 2: //2005-11-10 dados = salvawind[lk->id]->ponteiros; // posiciona na memoria alocada pelo subrotina
ls = salvawind[lk->id]->ls;
ce = salvawind[lk->id]->ce;
nl = salvawind[lk->id]->nl;
tl = salvawind[lk->id]->tl;
fg = 0; bg = 0; cor = 0;
break;
case 10: //2005-11-10 dados = &lk->dados[0]; // estamos recebendo a tela via cobol
cbl_windms_color_pair(lk->atr, &bg, &fg);
cor = COLOR_PAIR(cbl_windms_monta_cor(fg, bg)); // qual o par ?
break;
case 23:
case 13: //2005-11-10 dados = &lk->dados[0];
dados += ponteiro;
cbl_windms_color_pair(lk->atr, &bg, &fg);
cor = COLOR_PAIR(cbl_windms_monta_cor(fg, bg)); // qual o par ?
break;
}
tlaux = tl;
if(salto && salto < tl)
tlaux = salto;
dados1 = dados;
if(ini) // menu
dados = cbl_avanca_posicao(dados, ini);
attroff(A_BLINK); attroff(A_STANDOUT); attroff(A_UNDERLINE);
attroff(A_REVERSE); attroff(A_DIM); attroff(A_PROTECT);
attroff(A_INVIS); attroff(A_BOLD); attroff(A_HORIZONTAL);
attroff(A_LEFT); attroff(A_LOW); attroff(A_RIGHT);
attroff(A_TOP); attroff(A_VERTICAL);
standend(); color_set(0, NULL);
// attron(atr);
// color_set(cor, NULL);
// attrset(atr);
// move(ls, ce); refresh(); // apenas para garantir, caso haja um display antes
for(y = ls; y < (ls + nl); y++) { // escreve as linhas
x = ce;
while(x < (ce + tlaux)) { // escreve as colunas
disp = false;
switch(*dados) {
case '~': // mudanca de cor
*dados++; // proxima posicao
fg = (int) *(dados++) - 48; // cor de frente
bg = (int) *(dados++) - 48; // cor de fundo
cor = COLOR_PAIR(cbl_windms_monta_cor(fg, bg)); // par
// color_set(cor, NULL);
break;
case '^': // mudanca de atributo e caracter especial
*dados++;
switch(*dados) {
case '{': // mudanca de atributo
*dados++; // proxima posicao
// attroff(atr);
atr = encontra_atributo(dados);
while(*dados != '}')
*dados++;
*dados++;
// attron(atr);
break;
case '[': // alternate character
*dados++;
caracter = NCURSES_ACS(*dados++) | cor | atr;
disp = true;
break;
default: caracter = *dados | cor | atr;
disp = true;
break;
}
break;
default: caracter = *dados | cor | atr;
disp = true;
break;
}
if(disp) {
// xu = ' ' | 0 | A_NORMAL; attrset(0); color_set(0, NULL);
// mvaddch(y, x, xu);
// if(lk->fu == 2){ refresh();getch();}
mvaddch(y, x, caracter);
*dados++;
x++;
// if(lk->fu == 2){ refresh();getch();}
}
}
if(salto) // menu
dados = cbl_avanca_posicao(dados, (unsigned int) (salto - tlaux));
}
if(ul) { // limpar ate o final da janela menu
caracter = ' ' | cor | atr;
while(y<ul + ls) {
move(y, ce);
for(x = ce; x < (ce + tlaux); x++) // escreve as colunas
addch(caracter);
y++;
}
}
// attroff(atr);
refresh();
return;
}
// muda moldura da janela
//2005-11-10 void cbl_windms_moldura(struct windpos *lk) {
void cbl_windms_moldura(struct windmenu *lk) {
int i, cor, atr;
short fg, bg;
chtype c;
atr = A_NORMAL;
attroff(A_BLINK); attroff(A_STANDOUT); attroff(A_UNDERLINE);
attroff(A_REVERSE); attroff(A_DIM); attroff(A_PROTECT);
attroff(A_INVIS); attroff(A_BOLD); attroff(A_HORIZONTAL);
attroff(A_LEFT); attroff(A_LOW); attroff(A_RIGHT);
attroff(A_TOP); attroff(A_VERTICAL);
standend(); color_set(0, NULL);
// attron(atr);
cbl_windms_color_pair(lk->atr, &bg, &fg);
cor = COLOR_PAIR(cbl_windms_monta_cor(fg, bg)); // qual o par ?
c = ACS_ULCORNER | cor | atr;
mvaddch (lk->ls, lk->ce , c); // cnt esq superior
c = ACS_URCORNER | cor | atr;
mvaddch (lk->ls, lk->ce + lk->tl - 1, c); // cnt dir superior
c = ACS_LLCORNER | cor | atr;
mvaddch (lk->ls + lk->nl - 1, lk->ce , c); // cnt esq inferior
c = ACS_LRCORNER | cor | atr;
mvaddch (lk->ls + lk->nl - 1, lk->ce + lk->tl - 1, c); // cnt dir inferior
c = ACS_VLINE | cor | atr;
for(i = lk->ls + 1; i < lk->ls + lk->nl - 1; i++) {
mvaddch(i, lk->ce , c); // linha esquerda
mvaddch(i, lk->ce + lk->tl - 1, c); // linha direita
}
c = ACS_HLINE | cor | atr;
for(i = lk->ce + 1; i < lk->ce + lk->tl - 1; i++) {
mvaddch(lk->ls, i , c); // linha superior
mvaddch(lk->ls + lk->nl - 1, i , c); // linha inferior
}
refresh();
return;
}
// faz sombra na janela
//2005-11-10 void cbl_windms_sombra(struct windpos *lk) {
void cbl_windms_sombra(struct windmenu *lk) {
short i, ce, li;
int sombra;
ce = lk->ce + lk->tl;
li = lk->ls + lk->nl;
if(ce < 80) {
for(i = lk->ls + 1; (i < li + 1 && i < 25); i++) {
sombra = mvinch(i, ce) & A_COLOR;
if(sombra > 8)
cbl_windms_mudacor_posicao(i, ce, sombra / 8);
}
}
if(li < 25) {
for(i = lk->ce + 1; (i < ce && i < 80); i++) {
sombra = mvinch(li, i) & A_COLOR;
if(sombra > 8)
cbl_windms_mudacor_posicao(li, i, sombra / 8);
}
}
return;
}
// muda cor da posicao
void cbl_windms_mudacor_posicao(short y, short x, int cor) {
chtype pos;
short car;
attr_t atr;
pos = mvinch(y, x);
car = pos & A_CHARTEXT;
atr = ( pos & A_ATTRIBUTES ) / 65536;
pos = car | atr | cor;
addch(pos);
return;
}
// muda cor da janela
//2005-11-10 void cbl_windms_mudacor(struct windpos *lk) {
void cbl_windms_mudacor(struct windmenu *lk) {
int cor;
short fg, bg;
short x, y; // variaveis auxiliares
cbl_windms_color_pair(lk->atr, &bg, &fg);
cor = COLOR_PAIR(cbl_windms_monta_cor(fg, bg)); // qual o par ?
for(y = lk->ls; y < (lk->ls + lk->nl); y++) // escreve as linhas
for(x = lk->ce; x < (lk->ce + lk->tl); x++) // escreve as colunas
cbl_windms_mudacor_posicao(y, x, cor);
return;
}
// retorna tipo do atributo
void retorna_atributo(char *atrc, attr_t atr) {
*atrc = 'n'; // A_NORMAL
*atrc=(atr & A_STANDOUT ?'s':*atrc);
*atrc=(atr & A_UNDERLINE ?'u':*atrc);
*atrc=(atr & A_REVERSE ?'r':*atrc);
*atrc=(atr & A_BLINK ?'b':*atrc);
*atrc=(atr & A_DIM ?'d':*atrc);
*atrc=(atr & A_BOLD ?'o':*atrc);
*atrc=(atr & A_PROTECT ?'p':*atrc);
*atrc=(atr & A_INVIS ?'i':*atrc);
*atrc=(atr & A_HORIZONTAL?'h':*atrc);
*atrc=(atr & A_LEFT ?'l':*atrc);
*atrc=(atr & A_LOW ?'w':*atrc);
*atrc=(atr & A_RIGHT ?'g':*atrc);
*atrc=(atr & A_TOP ?'t':*atrc);
*atrc=(atr & A_VERTICAL ?'v':*atrc);
}
// guarda porcao da janela na memoria
//2005-11-10 int cbl_windms_guarda(struct windpos *lk) {
int cbl_windms_guarda(struct windmenu *lk) {
int y, x, tamanho;
chtype pos;
short cor, oldcor, car, fg, bg; // variaveis auxiliares
attr_t atr;
char *dados, *dados1;
char atrc, oldatrc;
if(ultima_janela == 99) // limite de janelas
return -1;
oldcor = -1;
oldatrc = '\0';
tamanho = 0;
// quantos bytes serao necessarios ?
for(y = lk->ls; y < lk->ls + lk->nl + 1; y++)
for(x = lk->ce; x < lk->ce + lk->tl + 1; x++) {
pos = mvinch(y, x);
cor = (pos & A_COLOR) / 256;
atr = (pos & A_ATTRIBUTES);
car = (pos & A_CHARTEXT);
if(cor != oldcor) { // mudou a cor
tamanho += 3;
oldcor = cor;
}
retorna_atributo(&atrc, atr); // pega codigo atributo
if(atrc != oldatrc) { // atributo diferente
tamanho += 4;
oldatrc = atrc;
}
if(atr & A_ALTCHARSET) // caracter especial
tamanho += 4;
else
tamanho++;
}
ultima_janela++; // janela a ser utilizada
salvawind[ultima_janela] = malloc(sizeof(struct salvawind));
salvawind[ultima_janela]->ls = lk->ls;
salvawind[ultima_janela]->ce = lk->ce;
salvawind[ultima_janela]->nl = lk->nl;
salvawind[ultima_janela]->tl = lk->tl;
salvawind[ultima_janela]->ponteiros = malloc(sizeof(char) * tamanho);
dados = salvawind[ultima_janela]->ponteiros;
dados1 = dados;
oldcor = -1;
oldatrc = '\0';
for(y = lk->ls; y < lk->ls + lk->nl; y++) { // guarda janela
for(x = lk->ce; x < lk->ce + lk->tl; x++) {
pos = mvinch(y, x);
cor = (pos & A_COLOR) / 256;
atr = (pos & A_ATTRIBUTES);
car = (pos & A_CHARTEXT);
if(cor != oldcor) { // mudou a cor
cbl_windms_color_pair(cor, &bg, &fg);
oldcor = cor;
*dados++ = '~';
*dados++ = (char) ( ( cor % 8 ) + 48 );
*dados++ = (char) ( ( cor / 8 ) + 48 );
}
retorna_atributo(&atrc, atr); // pega codigo atributo
if(atrc != oldatrc) { // atributo diferente
oldatrc = atrc;
*dados++ = '^'; *dados++ = '{';
*dados++ = atrc; *dados++ = '}';
}
if(atr & A_ALTCHARSET) { // caracter especial
*dados++ = '^'; *dados++ = '[';
*dados++ = car; *dados++ = ']';
}
else
*dados++ = car;
}
}
return ultima_janela;
}
// remove janela
//2005-11-10 int cbl_windms_remove(struct windpos *lk) {
int cbl_windms_remove(struct windmenu *lk) {
while(ultima_janela >= lk->id)
if(salvawind[ultima_janela]->ponteiros) {
if(lk->fu == 2) // restaura janela antes
//2005-11-10 cbl_windms_escreve(lk, 0, 0, 0, 0);
cbl_windms_escreve(lk, salvawind[ultima_janela]->ponteiros, 0, 0, 0, 0);
free(salvawind[ultima_janela]->ponteiros);
free(salvawind[ultima_janela]);
ultima_janela--;
}
return ultima_janela;
}
// avanca n casas considerando atributos e cores
char * cbl_avanca_posicao(char *dad, unsigned int qtd) {
while(qtd) {
switch(*dad) {
case '~': dad += 3;
break;
case '^': if(*(dad + 1) == '[')
dad += 6;
else {
qtd--;
dad++;
}
break;
default: qtd--;
dad++;
break;
}
}
return dad;
}
/* menu pop */
int cbl_windms_menu(struct windmenu *lk, char *dados) {
int refaz = 0;
char str6[6], *dad;
unsigned int tecla=0, ci, li, lj, pos;
char tmp[5];
cbl_windms_moldura(lk); /* display the box before */
/* ajust the size of the window and other parameters */
lk->ls++; lk->ce++;
lk->nl -= 2; lk->tl -= 2;
if(lk->lim == 0)
lk->lim = 1;
if(lk->lam == 0)
lk->lam = 1;
if(lk->lam > (lk->ls + lk->nl))
lk->lam = lk->ls;
if(lk->cam > (lk->ce + lk->tl))
lk->cam = lk->ce;
dad = cbl_avanca_posicao(dados, (lk->lim - 1) * lk->tlm); /* move pointer to the first characeter */
cbl_windms_escreve(lk, dados, (unsigned int) (dad - dados), lk->tlm, lk->cam, (unsigned int) lk->nl); /* write window */
ci = lk->cam; /* column in window */
li = lk->lim; /* first line in windows */
lj = lk->lam; /* atual line in window */
tecla = 0; /* return key */
noecho();
while(tecla != KEY_EXIT && tecla != KEY_ENTER && tecla != 13 && tecla != 27) {
move(lj + lk->ls - 1, lk->ce);
tecla = getch();
refaz = 0;
switch(tecla) {
case 13:
case KEY_ENTER: lk->ktm = tecla;
break;
case KEY_UP: if(lj > 1)
lj--;
else {
if(li > 1) {
li--;
refaz = 2;
}
}
break;
case KEY_DOWN: if(lj < lk->nl - 2)
lj++;
else {
if(lj + li <= lk->nlm) {
li++;
refaz = 2;
}
}
break;
case KEY_LEFT: if(ci > 0) {
ci--;
refaz = 1;
}
break;
case KEY_RIGHT: if((ci + lk->tl) < lk->tlm) {
ci++;
refaz = 1;
}
break;
case KEY_NPAGE: if(li < lk->nlm - lk->nl - 2)
li += lk->nl - 2;
else {
li = lk->nlm;
}
lj = 1;
refaz = 2;
break;
case KEY_PPAGE: if(li > lk->nl - 3)
li -= lk->nl - 3;
else {
li = 1;
}
lj = 1;
refaz = 2;
break;
case 'i':
case 'I': li = 1;
lj = 1;
refaz = 2;
break;
case 'f':
case 'F': li = lk->nlm;
lj = 1;
refaz = 2;
break;
case ' ': if(lk->fu == 23) {
dad = cbl_avanca_posicao(dados, (li + lj - 2) * (lk->tlm));
pos = (unsigned int) (dad - dados);
dados[pos] = (dados[pos] == ' ' ?'*':' ');
addch(dados[pos]); refresh();
}
break;
case 'm':
case 'M': if(lk->fu == 23) {
lk->ktm = 'M';
tecla = 27;
}
break;
case 'd':
case 'D': if(lk->fu == 23) {
lk->ktm = 'D';
tecla = 27;
}
break;
default: if(tecla == 27) {
ungetch(tecla);
cbl_read_keyboard(&str6[0]);
}
tecla = 0;
if(str6[0] == 27 && str6[1] == 0) {
tecla = 27;
lk->ktm = tecla;
}
break;
}
switch(refaz) {
case 1: lk->nl = ((lk->nlm - li) < lk->nl-2 ? (lk->nlm - li + 1):(lk->nl - 2));
cbl_windms_escreve(lk, dad, (unsigned int) (dad - dados), lk->tlm, ci, (unsigned int) lk->nl-2);
break;
case 2: dad = cbl_avanca_posicao(dados, (li - 1) * (lk->tlm));
lk->nl = ((lk->nlm - li) < lk->nl-2 ? (lk->nlm - li + 1):(lk->nl - 2));
cbl_windms_escreve(lk, dad, (unsigned int) (dad - dados), lk->tlm, ci, (unsigned int) lk->nl-2);
break;
}
}
echo();
tmp[4]='\0';
sprintf(tmp, "%04i", tecla);
memcpy(last_screen_status, tmp, 4);
lk->rtm = lj + li - 1;
lk->lim = li;
lk->lam = lj;
lk->cam = ci;
return 1;
}
/* Function to allocate dinamyc memory
receive: pointer = pointer to memory allocated
size = size of memory to allocate
flags = only for compatibility
return: 0 = ok, memory allocated
1 = error */
int cbl_alloc_mem(char **pointer, unsigned int *size, unsigned int *flagsmem ) {
*pointer=NULL;
if((*pointer = malloc(sizeof(char) * *(size))))
return 0;
return 1;
}
/* free the memory previous allocated
receive: pointer
return: none */
void cbl_free_mem(char **pointer) {
free(*pointer);
}
/* clear the window with character and attribute
receive: character = that will paint the screen
attribute = pair of attribute
return: none */
void cbl_clear_scr(int character, int cor) {
cbl_windms_inicia_cor();
if(has_colors())
character = character | COLOR_PAIR(cor);
bkgdset(character);
erase();
return;
}
/* return the position of cursor
receive: structure with line and column
return: position of cursor */
void cbl_get_csr_pos(struct screenposition *scr) {
getsyx(scr->line, scr->column);
scr->line++; // adjust the line
scr->column++; // adjust the column
return;
}
/* return the position of cursor
receive: structure with line and column
return: position of cursor */
void cbl_set_csr_pos(struct screenposition *scr) {
move(scr->line - 1, scr->column - 1);
return;
}
/* return the state of keyboard
receive: none
return: state of keyboard : 0 none, 1 has key
modified from scr_curses */
void cbl_get_kbd_status(char *state) {
int c;
nodelay(stdscr,TRUE);
c=getch();
nodelay(stdscr,FALSE);
if(c > 0) {
ungetch(c);
*state = 49;
} else
*state = 48;
return;
}
/* set the state of keypad */
void cbl_set_keypad(int state) {
keypad(stdscr, (state==1?TRUE:FALSE));
return;
}
/* return the size of screen
receive: none
return: depth and width */
void cbl_get_scr_size(short *depth, short *width) {
getmaxyx(stdscr, *depth, *width);
return;
}
/* return the character in keyboard buffer
receive: none
return: character */
void cbl_read_kbd_char(char *character) {
*character = (char) getch();
return;
}
/* return the keyboard string */
void cbl_read_keyboard(char *str6) {
int c, p;
char *s;
s = str6;
memset(s, 0, 6);
cbl_set_keypad(0);
c = getch();
*s++ = (char) c;
p = 0;
if(c == 27) {
while(tcob_scr_kbdstatus() && ++p < 6)
*s++ = (char) getch();
}
cbl_set_keypad(1);
}
// controle de janelas
// lk_info = ponteiro para cabecalho da janela (janela ou menu)
// lk_dados = dados da janela
int windms2(char *lk_info, char *lk_dados) {
struct windpos2 *lk2=NULL;
struct windmenu *lk=NULL;
if(last_screen_status == NULL) /* alloc memory for last_screen_status */
last_screen_status = malloc(sizeof(char) * 5);
tcob_init_screen(); /* check to see if ncurses was started */
cbl_windms_inicia_cor(); /* colors */
lk = malloc(sizeof(struct windmenu)); /* make a copy of parameters */
lk2 = (struct windpos2 *) lk_info;
if(*(lk_info + 1) == 13 || *(lk_info + 1) == 23) { /* menu */
lk->id = lk2->id; lk->fu = lk2->fu;
lk->ls = lk2->ls; lk->ce = lk2->ce;
lk->nl = lk2->nl; lk->tl = lk2->tl;
lk->atr = lk2->atr;
lk->nlm = (unsigned int) *(lk_info + 7);
lk->tlm = (unsigned int) *(lk_info + 11);
lk->ktm = (unsigned int) *(lk_info + 15);
lk->rtm = (unsigned int) *(lk_info + 19);
lk->lim = (unsigned int) *(lk_info + 23);
lk->lam = (unsigned int) *(lk_info + 27);
lk->cam = (unsigned int) *(lk_info + 31);
} else { /* other functions */
lk->id = lk2->id; lk->fu = lk2->fu;
lk->ls = lk2->ls; lk->ce = lk2->ce;
lk->nl = lk2->nl; lk->tl = lk2->tl;
lk->atr = lk2->atr; lk->nlm = 0;
lk->tlm = 0; lk->ktm = 0;
lk->rtm = 0; lk->lim = 0;
lk->lam = 0; lk->cam = 0;
}
/* verify the parameters */
if((lk->ls == 0 || lk->ce == 0)) { /* if line or column didn´t exists, use the cursor position */
int lin, col;
getsyx(lin, col);
if(lk->ls == 0) lk->ls = lin + 1;
if(lk->ce == 0) lk->ce = col + 1;
}
if(lk->ls > 25) lk->ls = 25;
if(lk->ce > 80) lk->ce = 80;
if(lk->nl > 25) lk->nl = 25;
if(lk->tl > 80) lk->tl = 80;
lk->ls--;
lk->ce--;
switch(lk->fu) { /* execute the function */
case 0: lk->id = cbl_windms_guarda(lk); /* store the window */
break;
case 2: /* restore the window and remove them */
case 3: lk->id = cbl_windms_remove(lk); /* just remove the window */
break;
case 1: /* restore the window without remove */
case 10: cbl_windms_escreve(lk, lk_dados, 0, 0, 0, 0); /* write the window */
break;
case 11:
case 14: cbl_windms_moldura(lk); /* display a box */
if(lk->fu == 14)
cbl_windms_sombra(lk); /* shadow the box */
break;
case 12: cbl_windms_mudacor(lk); /* change color of the window */
break;
case 13:
case 23: cbl_windms_menu(lk, lk_dados); /* menu */
break;
}
/* return the values acording to the funcions */
switch(lk->fu) {
case 0: /* free window */
case 2: *(lk_info) = lk->id; /* last window saved */
break;
case 13: /* menu */
case 23: *(lk_info+15) = lk->ktm; /* last keycode */
*(lk_info+19) = lk->rtm; /* line in array */
*(lk_info+23) = lk->lim; /* first line number in actual box */
*(lk_info+27) = lk->lam; /* line in the box */
*(lk_info+31) = lk->cam; /* column in the box */
break;
}
return 1;
}
+55
View File
@@ -0,0 +1,55 @@
#if defined(__MINGW32__)
# include <curses.h>
#else
# include <ncurses.h>
#endif
struct screenposition {
unsigned char line;
unsigned char column;
} *screenposition;
struct posicaotela {
unsigned char linha;
unsigned char coluna;
} *posicaotela;
//char *ponteiros[99];
struct windpos {
unsigned char id, fu, ls, ce, nl, tl, atr;
char dados[65535];
} *windpos;
struct salvawind {
unsigned char ls, ce, nl, tl;
char *ponteiros;
} *salvawind[99];
struct windpos2 {
unsigned char id, fu, ls, ce, nl, tl, atr;
} *windpos2;
// id = identificacao
// fu = funcao
// ls = linha superior
// ce = coluna esquerda
// nl = numero de linhas
// tl = tamanho de linhas
// atr = atributo inicial
// nlm = nr de linhas do menu
// tlm = tamanho de linhas do menu
// ktm = tecla de retorno do menu
// rtm = retorno de linha do menu
// lim = linha inicial na jenale no menu
// lam = linha na janela no menu
// cam = coluna na janela no menu
struct windmenu {
unsigned char id, fu, ls, ce, nl, tl, atr;
unsigned int nlm, tlm, ktm, rtm, lim, lam, cam;
} *windmenu;
int ultima_janela = -1;
bool initcor = 0;
+1331
View File
File diff suppressed because it is too large Load Diff
+154
View File
@@ -0,0 +1,154 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
#ifndef SCREENIO_H
#define SCREENIO_H
/* Cobol standard color nums */
#define TC_BLACK 0
#define TC_BLUE 1
#define TC_GREEN 2
#define TC_CYAN 3
#define TC_RED 4
#define TC_MAGENTA 5
#define TC_YELLOW 6
#define TC_WHITE 7
/* control keys */
#define TCOBKEY_DECIMALPT '.'
#define TCOBKEY_DECIMALCOMMA ','
#define TCOBKEY_TAB 9
#define TCOBKEY_FORWARD 12
#define TCOBKEY_HOMECLR 24
#define TCOBKEY_RETURN 13
#define TCOBKEY_ENTER 0527
#define TCOBKEY_ESCAPE 27
/* "pseudo-key" to indicate auto-clean must be enabled for all fields
We use KEY_MAX-1 to avoid conflicting with curses definitions */
#define TCOBKEY_AUTOCLEANALL 0776
/* Actions binded to keys pressed */
#define EDIT_FIRST_FIELD 1 /* Go to the first field */
#define EDIT_LAST_FIELD 2 /* Go to the last field */
#define EDIT_UP_FIELD 3 /* Go to the next field at last field
terminate edit mode */
#define EDIT_DOWN_FIELD 4 /* Go to the prev. field at first field
terminate edit mode */
#define EDIT_NEXT_FIELD 5 /* Go to the next field at last field
begin on the first field again */
#define EDIT_PREV_FIELD 6 /* Go to the prev. field at first
go to last filed */
#define EDIT_LEFT 7 /* move cursor left */
#define EDIT_RIGHT 8 /* move cursor right */
#define EDIT_FIRST 9 /* move cursor to the begining of field */
#define EDIT_LAST 10 /* move cursor to the end of field */
#define EDIT_INSERT 11 /* Insert a space */
#define EDIT_BACKSPACE 12 /* delete the char prev. to cursor */
#define EDIT_DELETE 13 /* delete the char on the cursor */
#define EDIT_TERMINATE 14 /* Terminate the edition, move value to SCREEN STATUS */
#define EDIT_CLEAR 15 /* Clear the current field */
#define EDIT_CLEAR_TOEND 16 /* Clear from the current position to the end of field */
#define EDIT_DECIMALPT 17 /* decimal point key */
#define EDIT_NOP 0 /* Do Nothing, the value is a normal char
or there isn no bindig for this code.
This is also the value of SCREEN STATUS
of SCREEN STATUS for auto fields, correct
input screen status = 0, (COBOL 2001 draft)*/
/* Struct to bind the key pressed and the action to do */
struct KeyBinding {
int keyCode; /* Key code returned by getch */
short action; /* Action to perform */
int screenStatus; /* Value to move to the SCREEN STATUS */
};
struct ScrFld {
struct ScrFld *pNext; /* pointer to next field in list */
int iAttributes; /* field attributs */
int charCount; /* number of characters typed */
int len; /* max char accepted in the field */
int decimals; /* number of digits in the decimal part of the field */
int decimalPointPosition; /* position of the decimal point in the field */
int signPosition; /* position of the sign in the field */
int iFldPos; /* horizontal position in field */
int iScrPos; /* horizontal position on screen */
short int iLine; /* Line number of start of field */
short int iCol; /* column number of start of field */
short int iFgColor; /* foreground color */
short int iBgColor; /* background color */
struct fld_desc *fldFrom; /* field description of source field */
char *caFrom; /* data area of source field */
struct fld_desc *fldTo; /* field description of dest. field */
char *caTo; /* data are of destination field */
struct fld_desc fldScr; /* field description of screen field */
char *caScr; /* data are of screen field */
struct fld_desc fldWk; /* work field desc for input fields */
char *caWk; /* work data area for input fields */
char caPicWk[200]; /* area for picture definition */
struct fld_desc fldScrCopy; /* keep a copy of fldScr */
char *caScrCopy; /* keep a copy of caScr */
};
//
// Usefull functions for use from the screen frontends
//
struct ScrFld *get_next_input_field(struct ScrFld *p);
struct ScrFld *get_prev_input_field(struct ScrFld *p);
void prepare_dest_field(struct ScrFld *pFld);
void prepare_input_field(struct ScrFld *pFld);
//
// functions that should be implemented by screen frontends
//
int tcob_scr_init();
void tcob_scr_finish();
int tcob_scr_accept(struct ScrFld *);
void tcob_scr_display(struct ScrFld *);
void tcob_scr_setyx(int y,int x);
void tcob_scr_sety(int y);
void tcob_scr_setx(int x);
int tcob_scr_gety();
int tcob_scr_getx();
int tcob_scr_kbdstatus();
int tcob_hasZ(char *p);
int tcob_isNumEdit(char *p);
#define DISPLAYFIELD(TYPE) ((TYPE) == DTYPE_DISPLAY)
#define EDITEDFIELD(TYPE) ((TYPE) == DTYPE_EDITED)
#define NUMERICFIELD(TYPE) (DISPLAYFIELD(TYPE) || EDITEDFIELD(TYPE))
#define HASDECIMALPOINT ((pFld->decimalPointPosition >= 0))
#define HASSIGN (pFld->signPosition >= 0)
#define DECIMALPOINT (HASDECIMALPOINT && pFld->decimalPointPosition == pFld->iScrPos)
#define CDECIMALPOINT ((bDecimalComma) ? ',' : '.')
#define CTHOUSANDSEPARATOR ((bDecimalComma) ? '.' : ',')
#endif /* SCREENIO_H */
BIN
View File
Binary file not shown.
+607
View File
@@ -0,0 +1,607 @@
//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana
//
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library 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 Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
//
//
// COBOL Compiler Run Time Library -- Strings Module
//
#include "htcoblib.h"
// #if defined(__MINGW32__)
// #include <windows.h>
// #endif
#if defined(SunOS)
va_list __builtin_va_alist;
#endif
static unsigned int offset_substr( char *s1, char *s2,
unsigned int n1, unsigned int n2 );
void tcob_put_integer( struct fld_desc *fdesc, char *sbuf, int value );
static struct comparand * alloc_comparand( int opt, struct comparand **list );
static void free_comparands( struct comparand *cmps );
extern struct fld_desc _generic_4binary;
/*
* auxiliary comparands list to walk several times through comparands
* in cob_inspect_replacing function.
*/
struct comparand {
struct comparand *next;
int opt;
struct fld_desc *ffor,*fby,*fcnt;
char *sfor,*sby,*scnt;
unsigned int before, after;
unsigned int cnt;
int state; /* -1 -> not yet (only if "after" found),
0 -> go, 1 -> stop */
};
#define COMP_STATE_WAIT -1
#define COMP_STATE_GO 0
#define COMP_STATE_STOP 1
/*------------------------------------------------------------------------*\
| |
| alloc_comparand |
| |
\*------------------------------------------------------------------------*/
static struct comparand * alloc_comparand( int opt, struct comparand **list ) {
struct comparand *anew, *tmp;
anew = (struct comparand *)malloc(sizeof(struct comparand));
memset(anew, 0, sizeof(*anew));
anew->opt = opt;
if ((tmp=*list)) {
for (; tmp->next; tmp=tmp->next) ;
tmp->next = anew;
} else
*list = anew;
return anew;
}
/*------------------------------------------------------------------------*\
| |
| free_comparands |
| |
\*------------------------------------------------------------------------*/
static void free_comparands( struct comparand *cmps ) {
struct comparand *tmp;
while (cmps) {
tmp = cmps;
cmps = cmps->next;
free(tmp);
}
}
/*------------------------------------------------------------------------*\
| |
| tcob_inspect_converting |
| |
\*------------------------------------------------------------------------*/
int tcob_inspect_converting( struct fld_desc *fvar, char *svar,
struct fld_desc *ffrom, char *sfrom,
struct fld_desc *fto, char *sto, ...) {
struct fld_desc *fbef, *faft;
char *sbef, *saft;
va_list args;
unsigned int len=fvar->len, blen=0, alen=0;
unsigned int idxBef, idxAft, i, j;
/* receive optional before/after variables */
va_start(args,sto);
if ((fbef = va_arg(args,struct fld_desc *))) {
sbef = va_arg(args,char *);
blen = fbef->len;
}
if ((faft = va_arg(args,struct fld_desc *))) {
saft = va_arg(args,char *);
alen = faft->len;
}
va_end(args);
/* the next two calls expect offset_substr to *
* return length 1 if string 2 not found. */
/* find BEFORE */
idxBef = offset_substr(svar, sbef, len, blen);
/* find AFTER */
idxAft = offset_substr(svar, saft, len, alen);
/* perform CONVERTING */
for (i=((faft)?(idxAft+alen):0); i<idxBef; i++) {
for (j=0; j<ffrom->len; j++) {
if (svar[i] == sfrom[j]) {
svar[i] = sto[j];
break;
}
}
}
return 0;
}
/*------------------------------------------------------------------------*\
| |
| tcob_inspect_tallying |
| |
\*------------------------------------------------------------------------*/
int tcob_inspect_tallying( struct fld_desc *fvar, char *svar, ... ) {
struct fld_desc *fcnt;
struct comparand *cmp, *comparands;
char *scnt=NULL;
int opt;
unsigned int len, rsize, offset;
va_list args;
va_start(args,svar);
comparands = NULL;
while ((fcnt = va_arg(args,struct fld_desc *))) {
scnt = va_arg(args,char *);
while ((opt = va_arg(args,int))) {
struct fld_desc *fbefore, *fafter;
char *sbefore, *safter;
cmp = alloc_comparand( opt,&comparands );
cmp->fcnt = fcnt; /* Associate the tally identifier */
cmp->scnt = scnt;
cmp->cnt = 0;
if (opt != INSPECT_CHARACTERS) {
if ((cmp->ffor = va_arg(args,struct fld_desc *))) {
cmp->sfor = va_arg(args,char *);
}
}
if ((fbefore = va_arg(args,struct fld_desc *))) {
sbefore = va_arg(args,char *);
cmp->before = offset_substr(svar, sbefore,
fvar->len, fbefore->len);
} else {
cmp->before = fvar->len;
}
if ((fafter = va_arg(args,struct fld_desc *))) {
safter = va_arg(args,char *);
cmp->after = offset_substr(svar, safter,
fvar->len, fafter->len) + fafter->len;
cmp->state = COMP_STATE_WAIT;
}
}
}
va_end(args);
len = fvar->len;
/* do the actual processing */
for (offset=0; offset<len; offset+=rsize) {
rsize = 1;
for (cmp=comparands; cmp; cmp=cmp->next) {
if (cmp->state == COMP_STATE_STOP)
continue;
if (cmp->state == COMP_STATE_WAIT) {
if (offset >= cmp->after)
cmp->state = COMP_STATE_GO;
else
continue;
}
if (cmp->opt == INSPECT_CHARACTERS) {
if (offset < cmp->before) {
cmp->cnt ++;
break;
} else {
cmp->state = COMP_STATE_STOP;
continue;
}
}
if (offset + cmp->ffor->len > cmp->before) {
cmp->state = COMP_STATE_STOP;
continue;
}
if (memcmp(svar+offset, cmp->sfor,
cmp->ffor->len) == 0) {
cmp->cnt ++;
rsize = cmp->ffor->len;
if (cmp->opt == INSPECT_FIRST)
cmp->state = COMP_STATE_STOP;
break;
}
if (cmp->opt == INSPECT_LEADING) {
cmp->state = COMP_STATE_STOP;
continue;
}
}
}
/* Add the counters to their associated identifiers */
for (cmp=comparands; cmp; cmp=cmp->next) {
if (cmp->cnt > 0) {
tcob_put_integer( cmp->fcnt, cmp->scnt,
tcob_get_index( cmp->fcnt, cmp->scnt ) + cmp->cnt );
}
}
free_comparands (comparands);
return 0;
}
/*------------------------------------------------------------------------*\
| |
| tcob_inspect_replacing |
| |
\*------------------------------------------------------------------------*/
int tcob_inspect_replacing( struct fld_desc *fvar, char *svar, ... ) {
struct comparand *cmp, *comparands;
int opt;
unsigned int exist_trailing=0, exist_leading=0;
unsigned int rsize, offset;
va_list args;
/* Set up comparand list */
va_start(args,svar);
comparands = NULL;
while ((opt = va_arg(args,int))) {
struct fld_desc *fbefore, *fafter;
char *sbefore, *safter;
cmp = alloc_comparand( opt,&comparands );
if (opt != INSPECT_CHARACTERS) {
if ((cmp->ffor = va_arg(args,struct fld_desc *))) {
cmp->sfor = va_arg(args,char *);
}
}
if ((cmp->fby = va_arg(args,struct fld_desc *))) {
cmp->sby = va_arg(args,char *);
}
if ((fbefore = va_arg(args,struct fld_desc *))) {
sbefore = va_arg(args,char *);
cmp->before = offset_substr(svar, sbefore,
fvar->len, fbefore->len);
} else {
cmp->before = fvar->len;
}
if ((fafter = va_arg(args,struct fld_desc *))) {
safter = va_arg(args,char *);
cmp->after = offset_substr(svar, safter,
fvar->len, fafter->len) + fafter->len;
cmp->state = COMP_STATE_WAIT;
}
if (cmp->opt == INSPECT_TRAILING){
exist_trailing = 1;
} else {
exist_leading = 1;
}
}
va_end(args);
/* Process forward from 0 to fvar->len */
if (exist_leading) {
for (offset=0; offset<fvar->len; offset+=rsize) {
rsize = 1;
for (cmp=comparands; cmp; cmp=cmp->next) {
/* We take care of later in the code */
if (cmp->opt == INSPECT_TRAILING)
continue;
/* The comparand is no longer being matched */
if (cmp->state == COMP_STATE_STOP)
continue;
/* See if we can use the comparand yet */
if (cmp->state == COMP_STATE_WAIT) {
if (offset >= cmp->after)
cmp->state = COMP_STATE_GO;
else
continue;
}
/* REPLACING CHARACTERS BY ... */
if (cmp->opt == INSPECT_CHARACTERS) {
if (offset < cmp->before) {
svar[offset] = *(cmp->sby);
break;
} else {
cmp->state = COMP_STATE_STOP;
continue;
}
}
/* See if we can no longer use the comparand */
if (offset + cmp->ffor->len > cmp->before) {
cmp->state = COMP_STATE_STOP;
continue;
}
/* See if we have a match */
if (memcmp(svar+offset, cmp->sfor,
cmp->ffor->len) == 0) {
memcpy(svar+offset, cmp->sby,
cmp->ffor->len);
rsize = cmp->ffor->len;
/* If REPLACING FIRST, do not match
* the comparand again */
if (cmp->opt == INSPECT_FIRST)
cmp->state = COMP_STATE_STOP;
break;
}
/* REPLACING LEADING cannot match after a
* non-match is encountered */
if (cmp->opt == INSPECT_LEADING) {
cmp->state = COMP_STATE_STOP;
continue;
}
} /* for comparands */
} /* for offset */
} /* of exist_leading */
/* Process backwards from fvar->len to 0
* no support for AFTER or BEFORE in this case */
if (exist_trailing) {
for (offset=fvar->len; ; offset-=rsize) {
rsize = 1;
for (cmp=comparands; cmp; cmp=cmp->next) {
if (cmp->opt != INSPECT_TRAILING)
continue;
if (cmp->state == COMP_STATE_GO) {
unsigned int len = cmp->ffor->len;
if ((offset >= len) && (memcmp(svar + offset - len,
cmp->sfor, len) == 0)) {
memcpy(svar + offset - len, cmp->sby, len);
rsize = len;
} else {
cmp->state = COMP_STATE_STOP;
}
}
} /* for comparands */
if (rsize >= offset)
break;
} /* for offset */
}
free_comparands (comparands);
return 0;
}
/*------------------------------------------------------------------------*\
| |
| tcob_unstring |
| |
\*------------------------------------------------------------------------*/
int tcob_unstring( struct fld_desc *fvar, char *svar, ... ) {
unsigned int picLen;
struct fld_desc fsrc = {0,DTYPE_ALPHANUMERIC,0,0,0,0,0,0,0,0,NULL};
struct fld_desc *fptr, *ftally;
char *sptr=NULL, *stally=NULL;
struct fld_desc **p;
struct fld_desc *fdest, *fdltr, *fcnt;
char *sdelim, *sdest, *sdltr=NULL, *scnt=NULL;
char *delimbuf;
int partlen, delimall, nfields;
unsigned int i, n, n1, len, delimlen;
va_list args;
/* receive POINTER and TALLYING arguments */
va_start(args,svar);
if ((fptr = va_arg(args,struct fld_desc *))) {
sptr = va_arg(args,char *);
}
if ((ftally = va_arg(args,struct fld_desc *))) {
stally = va_arg(args,char *);
}
/* setup indirect pointer to the start of delimiters array */
len = 16;
p = malloc (sizeof (struct fld_desc) * len);
p[0] = va_arg (args, struct fld_desc *);
for (i=0; p[i]; ) {
if (i + 3 >= len) {
len *= 2;
p = realloc (p, sizeof (struct fld_desc) * len);
}
p[i+1] = va_arg (args, struct fld_desc *);
p[i+2] = va_arg (args, struct fld_desc *);
if (p[i]->len != 0) /* Remove zero-length delimiters */
i+=3;
p[i] = va_arg (args, struct fld_desc *);
}
/* now execute the actual unstring command */
len = fvar->len;
if (fptr) { /* if there is a pointer, skip some length at svar */
int tempn = tcob_get_index(fptr,sptr)-1; /* get value of pointer */
if ((tempn >= (int)len) || (tempn < 0)) {
free (p);
va_end (args);
return 1;
}
n = (unsigned int)tempn;
} else
n = 0;
nfields = 0;
for (fdest = va_arg(args, struct fld_desc *); (fdest) && (n<len);
fdest = va_arg(args, struct fld_desc *)) {
sdest = va_arg(args, char *);
if ((fdltr = va_arg(args, struct fld_desc *)))
sdltr = va_arg(args, char *);
if ((fcnt = va_arg(args, struct fld_desc *)))
scnt = va_arg(args, char *);
/* find the nearest delimiter */
delimall = 0;
delimlen = 0;
delimbuf = NULL;
partlen = len-n;
if ((!p[0]) && (partlen>(int)(fdest->len)))
partlen = fdest->len;
for (i=0; (p[i]) && (partlen>0); i+=3) {
sdelim = (char *)(p[i+1]);
n1 = offset_substr(svar+n,sdelim,len-n,p[i]->len);
if ((int)n1 < partlen) {
partlen = n1;
delimlen = p[i]->len;
delimbuf = sdelim;
delimall = (int)(p[i+2]);
}
}
/* move sub-string INTO dest */
fsrc.len = partlen;
picLen = tcob_picReqLen(1);
fsrc.pic = (char *)malloc(picLen);
tcob_picCreate (fsrc.pic, picLen, 'X', fsrc.len, NULL);
tcob_move (&fsrc, svar+n, fdest, sdest);
free(fsrc.pic);
n += partlen; /* adjust for the partial string processed */
if (delimbuf) /* adjust for delimiter too */
n += delimlen;
/* set DELIMITER IN if storage requested */
if (fdltr) {
fsrc.len = delimlen;
picLen = tcob_picReqLen(1);
fsrc.pic = (char *)malloc(picLen);
tcob_picCreate (fsrc.pic, picLen, 'X', fsrc.len, NULL);
tcob_move(&fsrc, delimbuf, fdltr, sdltr);
free(fsrc.pic);
}
/* set COUNT IN if count requested */
if (fcnt)
tcob_put_integer(fcnt,scnt,partlen);
/* remove all copies of delimiter */
if (delimall) {
while ((n<len) && !offset_substr(svar+n,delimbuf,
len-n,delimlen))
n += delimlen;
}
nfields++;
}
va_end (args);
free (p);
if (ftally) {
tcob_put_integer( ftally, stally, nfields +
tcob_get_index( ftally, stally ) );
}
if (fptr)
tcob_put_integer( fptr, sptr, n+1 );
/* check if overflow found */
if (n<len) {
return 1;
}
return 0;
}
/*------------------------------------------------------------------------*\
| |
| tcob_stringcmd |
| Cobol STRING statement. |
| The variables, in order, are: |
| receiving var (INTO), |
| pointer (WITH POINTER clause) or NULL, |
| 1st sending var, 1st delimiter or NULL, |
| 2nd sending var, 2nd delimiter or NULL, ... |
| Each variable has its field descriptor (struct fld_desc) and its |
| buffer, except if it's non-existent. In such case, only a NULL is |
| passed as argument and must be skipped. (never 2 stack positions) |
| The last sending variable is a NULL. |
| |
| This function returns 1 in case of overflow found, or 0 if ok. |
| |
\*------------------------------------------------------------------------*/
int tcob_stringcmd( struct fld_desc *fdst, char *sdst,... ) {
struct fld_desc *fptr, *fsrc, *fdelim;
char *sptr, *ssrc, *sdelim=NULL;
unsigned int srclen, dstlen, n;
va_list args;
dstlen = fdst->len;
va_start(args,sdst);
fptr = va_arg(args,struct fld_desc *);
if (fptr) {
sptr = va_arg(args,char *);
n = tcob_get_index(fptr,sptr)-1; /* get index value */
} else
n = 0;
if (n >= dstlen) { /* Instant OVERFLOW */
va_end(args);
return 1;
}
for (fsrc = va_arg(args,struct fld_desc *); (fsrc) && (n<dstlen);
fsrc = va_arg(args,struct fld_desc *)) {
ssrc = va_arg(args,char *);
srclen = fsrc->len;
if ((fdelim = va_arg(args,struct fld_desc *))) { /* get delimiter's buffer */
sdelim = va_arg(args,char *);
srclen = offset_substr(ssrc,sdelim,srclen,fdelim->len);
}
memmove(sdst+n, ssrc, (n+srclen>dstlen)?dstlen-n:srclen);
n += srclen;
}
va_end(args);
if (fptr)
tcob_put_integer( fptr, sptr, tc_min(n,dstlen)+1 );
if ((n>dstlen) || (fsrc)) /* OVERFLOW */
return 1;
return 0;
}
/*------------------------------------------------------------------------*\
| |
| offset_substr |
| return number of characters before found s2 in s1 |
| Note that C string functions are not useful here, because |
| the strings are _not_ NULL-terminated. |
| I would like to see a better algorithm here, but this |
| "brute-force" method is easier to code now. |
| return n1 on string s2 not found |
| |
\*------------------------------------------------------------------------*/
static unsigned int offset_substr( char *s1, char *s2,
unsigned int n1, unsigned int n2 ) {
unsigned int i,j;
if ((n2>n1) || (n2==0))
return n1;
for (i=0;i<=n1-n2;i++) {
for (j=0;j<n2;j++) {
if (s1[i+j]!=s2[j]) break;
}
if (j==n2) break; /* found! */
}
if (i>n1-n2)
return n1;
return i;
}
/*------------------------------------------------------------------------*\
| |
| tcob_put_integer |
| |
\*------------------------------------------------------------------------*/
void tcob_put_integer( struct fld_desc *fdesc, char *sbuf, int value) {
tcob_move(&_generic_4binary,(char *)&value,fdesc,sbuf);
}
/* end of strings.c */
BIN
View File
Binary file not shown.