hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

writing functions for bytecode and literal frame exchange with other vms
Some checks failed
continuous-integration/drone/push Build is failing
Details

Browse Source
This commit is contained in:
hyung-hwan 2023-12-23 12:43:26 +09:00
parent 5f91536a38
commit 58d913e3da
11 changed files with 775 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
bin/main.c
View File

@ -428,13 +428,12 @@ static hcl_oop_t execute_in_interactive_mode (hcl_t* hcl)
return retv;
}
static hcl_oop_t execute_in_batch_mode (hcl_t* hcl, int verbose)
static hcl_oop_t execute_in_batch_mode(hcl_t* hcl, int verbose)
{
hcl_oop_t retv;
hcl_decode (hcl, 0, hcl_getbclen(hcl));
HCL_LOG3 (hcl, HCL_LOG_MNEMONIC, "BYTECODES bclen=%zu lflen=%zu ngtmprs=%zu\n", hcl_getbclen(hcl), hcl_getlflen(hcl), hcl_getngtmprs(hcl));
hcl_decode(hcl, 0, hcl_getbclen(hcl));
HCL_LOG3(hcl, HCL_LOG_MNEMONIC, "BYTECODES bclen=%zu lflen=%zu ngtmprs=%zu\n", hcl_getbclen(hcl), hcl_getlflen(hcl), hcl_getngtmprs(hcl));
g_hcl = hcl;
/*setup_tick ();*/

8
lib/Makefile.am
View File

@ -52,17 +52,14 @@ pkginclude_HEADERS = \
hcl-cmn.h \
hcl-fmt.h \
hcl-opt.h \
hcl-pac1.h \
hcl-rbt.h \
hcl-upac.h \
hcl-utl.h \
hcl-xma.h
pkglib_LTLIBRARIES = libhcl.la
libhcl_la_SOURCES = \
hcl.h \
hcl-cmn.h \
hcl-opt.h \
hcl-rbt.h \
hcl-utl.h \
hcl-prv.h \
bigint.c \
chr.c \
@ -94,6 +91,7 @@ libhcl_la_SOURCES = \
utf16.c \
utf8.c \
utl.c \
xchg.c \
xma.c
libhcl_la_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
libhcl_la_LDFLAGS = $(LDFLAGS_LIB_COMMON)

29
lib/Makefile.in
View File

@ -159,7 +159,7 @@ am_libhcl_la_OBJECTS = libhcl_la-bigint.lo libhcl_la-chr.lo \
libhcl_la-prim.lo libhcl_la-print.lo libhcl_la-rbt.lo \
libhcl_la-read.lo libhcl_la-std.lo libhcl_la-sym.lo \
libhcl_la-utf16.lo libhcl_la-utf8.lo libhcl_la-utl.lo \
libhcl_la-xma.lo
libhcl_la-xchg.lo libhcl_la-xma.lo
libhcl_la_OBJECTS = $(am_libhcl_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
@ -210,8 +210,8 @@ am__depfiles_remade = ./$(DEPDIR)/libhcl_la-bigint.Plo \
./$(DEPDIR)/libhcl_la-rbt.Plo ./$(DEPDIR)/libhcl_la-read.Plo \
./$(DEPDIR)/libhcl_la-std.Plo ./$(DEPDIR)/libhcl_la-sym.Plo \
./$(DEPDIR)/libhcl_la-utf16.Plo ./$(DEPDIR)/libhcl_la-utf8.Plo \
./$(DEPDIR)/libhcl_la-utl.Plo ./$(DEPDIR)/libhcl_la-xma.Plo \
./$(DEPDIR)/libhclx_la-hcl-c.Plo \
./$(DEPDIR)/libhcl_la-utl.Plo ./$(DEPDIR)/libhcl_la-xchg.Plo \
./$(DEPDIR)/libhcl_la-xma.Plo ./$(DEPDIR)/libhclx_la-hcl-c.Plo \
./$(DEPDIR)/libhclx_la-hcl-s.Plo \
./$(DEPDIR)/libhclx_la-hcl-s2.Plo \
./$(DEPDIR)/libhclx_la-json.Plo ./$(DEPDIR)/libhclx_la-tmr.Plo \
@ -243,8 +243,8 @@ am__can_run_installinfo = \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__pkginclude_HEADERS_DIST = hcl.h hcl-chr.h hcl-cmn.h hcl-fmt.h \
hcl-opt.h hcl-rbt.h hcl-utl.h hcl-xma.h hcl-c.h hcl-s.h \
hcl-tmr.h hcl-xutl.h hcl-json.h
hcl-opt.h hcl-pac1.h hcl-rbt.h hcl-upac.h hcl-utl.h hcl-xma.h \
hcl-c.h hcl-s.h hcl-tmr.h hcl-xutl.h hcl-json.h
HEADERS = $(pkginclude_HEADERS)
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) \
hcl-cfg.h.in
@ -433,14 +433,10 @@ LIBADD_LIB_COMMON = $(LIBM) $(am__append_1) $(am__append_2) \
@WIN32_TRUE@ -DHCL_DEFAULT_PFMODPOSTFIX=\"-1.dll\" \
@WIN32_TRUE@ $(am__append_4) $(am__append_5)
pkginclude_HEADERS = hcl.h hcl-chr.h hcl-cmn.h hcl-fmt.h hcl-opt.h \
hcl-rbt.h hcl-utl.h hcl-xma.h $(am__append_8)
hcl-pac1.h hcl-rbt.h hcl-upac.h hcl-utl.h hcl-xma.h \
$(am__append_8)
pkglib_LTLIBRARIES = libhcl.la $(am__append_7)
libhcl_la_SOURCES = \
hcl.h \
hcl-cmn.h \
hcl-opt.h \
hcl-rbt.h \
hcl-utl.h \
hcl-prv.h \
bigint.c \
chr.c \
@ -472,6 +468,7 @@ libhcl_la_SOURCES = \
utf16.c \
utf8.c \
utl.c \
xchg.c \
xma.c
libhcl_la_CPPFLAGS = $(CPPFLAGS_LIB_COMMON)
@ -610,6 +607,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-utf16.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-utf8.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-utl.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-xchg.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-xma.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhclx_la-hcl-c.Plo@am__quote@ # am--include-marker
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhclx_la-hcl-s.Plo@am__quote@ # am--include-marker
@ -830,6 +828,13 @@ libhcl_la-utl.lo: utl.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhcl_la-utl.lo `test -f 'utl.c' || echo '$(srcdir)/'`utl.c
libhcl_la-xchg.lo: xchg.c
@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhcl_la-xchg.lo -MD -MP -MF $(DEPDIR)/libhcl_la-xchg.Tpo -c -o libhcl_la-xchg.lo `test -f 'xchg.c' || echo '$(srcdir)/'`xchg.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-xchg.Tpo $(DEPDIR)/libhcl_la-xchg.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='xchg.c' object='libhcl_la-xchg.lo' libtool=yes @AMDEPBACKSLASH@
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libhcl_la-xchg.lo `test -f 'xchg.c' || echo '$(srcdir)/'`xchg.c
libhcl_la-xma.lo: xma.c
@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libhcl_la_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libhcl_la-xma.lo -MD -MP -MF $(DEPDIR)/libhcl_la-xma.Tpo -c -o libhcl_la-xma.lo `test -f 'xma.c' || echo '$(srcdir)/'`xma.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-xma.Tpo $(DEPDIR)/libhcl_la-xma.Plo
@ -1059,6 +1064,7 @@ distclean: distclean-am
-rm -f ./$(DEPDIR)/libhcl_la-utf16.Plo
-rm -f ./$(DEPDIR)/libhcl_la-utf8.Plo
-rm -f ./$(DEPDIR)/libhcl_la-utl.Plo
-rm -f ./$(DEPDIR)/libhcl_la-xchg.Plo
-rm -f ./$(DEPDIR)/libhcl_la-xma.Plo
-rm -f ./$(DEPDIR)/libhclx_la-hcl-c.Plo
-rm -f ./$(DEPDIR)/libhclx_la-hcl-s.Plo
@ -1138,6 +1144,7 @@ maintainer-clean: maintainer-clean-am
-rm -f ./$(DEPDIR)/libhcl_la-utf16.Plo
-rm -f ./$(DEPDIR)/libhcl_la-utf8.Plo
-rm -f ./$(DEPDIR)/libhcl_la-utl.Plo
-rm -f ./$(DEPDIR)/libhcl_la-xchg.Plo
-rm -f ./$(DEPDIR)/libhcl_la-xma.Plo
-rm -f ./$(DEPDIR)/libhclx_la-hcl-c.Plo
-rm -f ./$(DEPDIR)/libhclx_la-hcl-s.Plo

27
lib/hcl-cmn.h
View File

@ -472,6 +472,33 @@ typedef struct hcl_bcs_t hcl_bcs_t;
typedef unsigned int hcl_bitmask_t;
/* =========================================================================
* BIGINT TYPES AND MACROS
* ========================================================================= */
#if defined(HCL_ENABLE_FULL_LIW) && (HCL_SIZEOF_UINTMAX_T > HCL_SIZEOF_OOW_T)
# define HCL_USE_OOW_FOR_LIW
#endif
#if defined(HCL_USE_OOW_FOR_LIW)
typedef hcl_oow_t hcl_liw_t; /* large integer word */
typedef hcl_ooi_t hcl_lii_t;
typedef hcl_uintmax_t hcl_lidw_t; /* large integer double word */
typedef hcl_intmax_t hcl_lidi_t;
# define HCL_SIZEOF_LIW_T HCL_SIZEOF_OOW_T
# define HCL_SIZEOF_LIDW_T HCL_SIZEOF_UINTMAX_T
# define HCL_LIW_BITS HCL_OOW_BITS
# define HCL_LIDW_BITS (HCL_SIZEOF_UINTMAX_T * HCL_BITS_PER_BYTE)
#else
typedef hcl_oohw_t hcl_liw_t;
typedef hcl_oohi_t hcl_lii_t;
typedef hcl_oow_t hcl_lidw_t;
typedef hcl_ooi_t hcl_lidi_t;
# define HCL_SIZEOF_LIW_T HCL_SIZEOF_OOHW_T
# define HCL_SIZEOF_LIDW_T HCL_SIZEOF_OOW_T
# define HCL_LIW_BITS HCL_OOHW_BITS
# define HCL_LIDW_BITS HCL_OOW_BITS
#endif
/* =========================================================================
* BASIC OOP ENCODING
* ========================================================================= */

37
lib/hcl-pac1.h Normal file
View File

@ -0,0 +1,37 @@
/*
Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#if defined(__GNUC__) && (__GNUC__ >= 4)
# pragma pack(push,1)
#elif defined(__GNUC__)
# pragma pack(1)
#elif defined(__HP_aCC) || defined(__HP_cc)
# pragma PACK 1
#elif defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0500))
# pragma pack(push,1)
#elif defined(__DECC)
# pragma pack(push,1)
#else
# pragma pack(1)
#endif

37
lib/hcl-upac.h Normal file
View File

@ -0,0 +1,37 @@
/*
Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#if defined(__GNUC__) && (__GNUC__ >= 4)
# pragma pack(pop)
#elif defined(__GNUC__)
# pragma pack()
#elif defined(__HP_aCC) || defined(__HP_cc)
# pragma PACK
#elif defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0500))
# pragma pack(pop)
#elif defined(__DECC)
# pragma pack(pop)
#else
# pragma pack()
#endif

196
lib/hcl-utl.h
View File

@ -213,18 +213,80 @@
#endif
#if defined(HCL_HAVE_SIZEOF_UINT16_T) && (HCL_SIZEOF_OF_UINT16_T == HCL_SIZEOF_OOW_T)
#if defined(HCL_HAVE_UINT16_T) && (HCL_SIZEOF_UINT16_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_NTOHOOW(x) HCL_CONST_NTOH16(x)
# define HCL_CONST_HTONOOW(x) HCL_CONST_HTON16(x)
#elif defined(HCL_HAVE_SIZEOF_UINT32_T) && (HCL_SIZEOF_OF_UINT32_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_HTOBEOOW(x) HCL_CONST_HTOBE16(x)
# define HCL_CONST_HTOLEOOW(x) HCL_CONST_HTOLE16(x)
# define HCL_CONST_BEOOWTOH(x) HCL_CONST_BE16TOH(x)
# define HCL_CONST_LEOOWTOH(x) HCL_CONST_LE16TOH(x)
#elif defined(HCL_HAVE_UINT32_T) && (HCL_SIZEOF_UINT32_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_NTOHOOW(x) HCL_CONST_NTOH32(x)
# define HCL_CONST_HTONOOW(x) HCL_CONST_HTON32(x)
#elif defined(HCL_HAVE_SIZEOF_UINT64_T) && (HCL_SIZEOF_OF_UINT64_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_HTOBEOOW(x) HCL_CONST_HTOBE32(x)
# define HCL_CONST_HTOLEOOW(x) HCL_CONST_HTOLE32(x)
# define HCL_CONST_BEOOWTOH(x) HCL_CONST_BE32TOH(x)
# define HCL_CONST_LEOOWTOH(x) HCL_CONST_LE32TOH(x)
#elif defined(HCL_HAVE_UINT64_T) && (HCL_SIZEOF_UINT64_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_NTOHOOW(x) HCL_CONST_NTOH64(x)
# define HCL_CONST_HTONOOW(x) HCL_CONST_HTON64(x)
#elif defined(HCL_HAVE_SIZEOF_UINT128_T) && (HCL_SIZEOF_OF_UINT128_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_HTOBEOOW(x) HCL_CONST_HTOBE64(x)
# define HCL_CONST_HTOLEOOW(x) HCL_CONST_HTOLE64(x)
# define HCL_CONST_BEOOWTOH(x) HCL_CONST_BE64TOH(x)
# define HCL_CONST_LEOOWTOH(x) HCL_CONST_LE64TOH(x)
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_UINT128_T == HCL_SIZEOF_OOW_T)
# define HCL_CONST_NTOHOOW(x) HCL_CONST_NTOH128(x)
# define HCL_CONST_HTONOOW(x) HCL_CONST_HTON128(x)
# define HCL_CONST_HTOBEOOW(x) HCL_CONST_HTOBE128(x)
# define HCL_CONST_HTOLEOOW(x) HCL_CONST_HTOLE128(x)
# define HCL_CONST_BEOOWTOH(x) HCL_CONST_BE128TOH(x)
# define HCL_CONST_LEOOWTOH(x) HCL_CONST_LE128TOH(x)
#endif
#if defined(HCL_HAVE_UINT16_T) && (HCL_SIZEOF_UINT16_T == HCL_SIZEOF_OOHW_T)
# define HCL_CONST_NTOHOOHW(x) HCL_CONST_NTOH16(x)
# define HCL_CONST_HTONOOHW(x) HCL_CONST_HTON16(x)
# define HCL_CONST_HTOBEOOHW(x) HCL_CONST_HTOBE16(x)
# define HCL_CONST_HTOLEOOHW(x) HCL_CONST_HTOLE16(x)
# define HCL_CONST_BEOOHWTOH(x) HCL_CONST_BE16TOH(x)
# define HCL_CONST_LEOOHWTOH(x) HCL_CONST_LE16TOH(x)
#elif defined(HCL_HAVE_UINT32_T) && (HCL_SIZEOF_UINT32_T == HCL_SIZEOF_OOHW_T)
# define HCL_CONST_NTOHOOHW(x) HCL_CONST_NTOH32(x)
# define HCL_CONST_HTONOOHW(x) HCL_CONST_HTON32(x)
# define HCL_CONST_HTOBEOOHW(x) HCL_CONST_HTOBE32(x)
# define HCL_CONST_HTOLEOOHW(x) HCL_CONST_HTOLE32(x)
# define HCL_CONST_BEOOHWTOH(x) HCL_CONST_BE32TOH(x)
# define HCL_CONST_LEOOHWTOH(x) HCL_CONST_LE32TOH(x)
#elif defined(HCL_HAVE_UINT64_T) && (HCL_SIZEOF_UINT64_T == HCL_SIZEOF_OOHW_T)
# define HCL_CONST_NTOHOOHW(x) HCL_CONST_NTOH64(x)
# define HCL_CONST_HTONOOHW(x) HCL_CONST_HTON64(x)
# define HCL_CONST_HTOBEOOHW(x) HCL_CONST_HTOBE64(x)
# define HCL_CONST_HTOLEOOHW(x) HCL_CONST_HTOLE64(x)
# define HCL_CONST_BEOOHWTOH(x) HCL_CONST_BE64TOH(x)
# define HCL_CONST_LEOOHWTOH(x) HCL_CONST_LE64TOH(x)
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_UINT128_T == HCL_SIZEOF_OOHW_T)
# define HCL_CONST_NTOHOOHW(x) HCL_CONST_NTOH128(x)
# define HCL_CONST_HTONOOHW(x) HCL_CONST_HTON128(x)
# define HCL_CONST_HTOBEOOHW(x) HCL_CONST_HTOBE128(x)
# define HCL_CONST_HTOLEOOHW(x) HCL_CONST_HTOLE128(x)
# define HCL_CONST_BEOOHWTOH(x) HCL_CONST_BE128TOH(x)
# define HCL_CONST_LEOOHWTOH(x) HCL_CONST_LE128TOH(x)
#endif
#if defined(HCL_USE_OOW_FOR_LIW)
# define HCL_CONST_NTOHLIW(x) HCL_CONST_NTOHOOW(x)
# define HCL_CONST_HTONLIW(x) HCL_CONST_HTONOOW(x)
# define HCL_CONST_HTOBELIW(x) HCL_CONST_HTOBEOOW(x)
# define HCL_CONST_HTOLELIW(x) HCL_CONST_HTOLEOOW(x)
# define HCL_CONST_BELIWTOH(x) HCL_CONST_BEOOWTOH(x)
# define HCL_CONST_LELIWTOH(x) HCL_CONST_LEOOWTOH(x)
#else
# define HCL_CONST_NTOHLIW(x) HCL_CONST_NTOHOOHW(x)
# define HCL_CONST_HTONLIW(x) HCL_CONST_HTONOOHW(x)
# define HCL_CONST_HTOBELIW(x) HCL_CONST_HTOBEOOHW(x)
# define HCL_CONST_HTOLELIW(x) HCL_CONST_HTOLEOOHW(x)
# define HCL_CONST_BELIWTOH(x) HCL_CONST_BEOOHWTOH(x)
# define HCL_CONST_LELIWTOH(x) HCL_CONST_LEOOHWTOH(x)
#endif
/* =========================================================================
@ -336,40 +398,47 @@ HCL_EXPORT hcl_oow_t hcl_hash_bytes_ (
);
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE hcl_oow_t hcl_hash_bytes (const hcl_oob_t* ptr, hcl_oow_t len)
{
hcl_oow_t hv;
HCL_HASH_BYTES (hv, ptr, len);
/* constrain the hash value to be representable in a small integer
* for convenience sake */
return hv % ((hcl_oow_t)HCL_SMOOI_MAX + 1);
}
static HCL_INLINE hcl_oow_t hcl_hash_bytes (const hcl_oob_t* ptr, hcl_oow_t len)
{
hcl_oow_t hv;
HCL_HASH_BYTES (hv, ptr, len);
/* constrain the hash value to be representable in a small integer
* for convenience sake */
return hv % ((hcl_oow_t)HCL_SMOOI_MAX + 1);
}
static HCL_INLINE hcl_oow_t hcl_hash_bchars (const hcl_bch_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_bch_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_bchars (const hcl_bch_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_bch_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_uchars (const hcl_uch_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_uch_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_uchars (const hcl_uch_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_uch_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_words (const hcl_oow_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oow_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_words (const hcl_oow_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oow_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_halfwords (const hcl_oohw_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oohw_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_liwords(const hcl_liw_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_liw_t));
}
static HCL_INLINE hcl_oow_t hcl_hash_halfwords (const hcl_oohw_t* ptr, hcl_oow_t len)
{
return hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oohw_t));
}
#else
# define hcl_hash_bytes(ptr,len) hcl_hash_bytes_(ptr, len)
# define hcl_hash_bchars(ptr,len) hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_bch_t))
# define hcl_hash_uchars(ptr,len) hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_uch_t))
# define hcl_hash_words(ptr,len) hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oow_t))
# define hcl_hash_halfwords(ptr,len) hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oohw_t))
# define hcl_hash_liwords(ptr,len) hcl_hash_bytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_liw_t))
#endif
#if defined(HCL_OOCH_IS_UCH)
@ -1116,18 +1185,81 @@ static HCL_INLINE hcl_uint128_t hcl_bswap128 (hcl_uint128_t x)
# error UNKNOWN ENDIAN
#endif
#if defined(HCL_HAVE_SIZEOF_UINT16_T) && (HCL_SIZEOF_OF_UINT16_T == HCL_SIZEOF_OOW_T)
#if defined(HCL_HAVE_UINT16_T) && (HCL_SIZEOF_UINT16_T == HCL_SIZEOF_OOW_T)
# define hcl_ntohoow(x) hcl_ntoh16(x)
# define hcl_htonoow(x) hcl_hton16(x)
#elif defined(HCL_HAVE_SIZEOF_UINT32_T) && (HCL_SIZEOF_OF_UINT32_T == HCL_SIZEOF_OOW_T)
# define hcl_htobeoow(x) hcl_htobe116(x)
# define hcl_beoowtoh(x) hcl_be16toh(x)
# define hcl_htoleoow(x) hcl_htole16(x)
# define hcl_leoowtoh(x) hcl_le16toh(x)
#elif defined(HCL_HAVE_UINT32_T) && (HCL_SIZEOF_UINT32_T == HCL_SIZEOF_OOW_T)
# define hcl_ntohoow(x) hcl_ntoh32(x)
# define hcl_htonoow(x) hcl_hton32(x)
#elif defined(HCL_HAVE_SIZEOF_UINT64_T) && (HCL_SIZEOF_OF_UINT64_T == HCL_SIZEOF_OOW_T)
# define hcl_htobeoow(x) hcl_htobe32(x)
# define hcl_beoowtoh(x) hcl_be32toh(x)
# define hcl_htoleoow(x) hcl_htole32(x)
# define hcl_leoowtoh(x) hcl_le32toh(x)
#elif defined(HCL_HAVE_UINT64_T) && (HCL_SIZEOF_UINT64_T == HCL_SIZEOF_OOW_T)
# define hcl_ntohoow(x) hcl_ntoh64(x)
# define hcl_htonoow(x) hcl_hton64(x)
#elif defined(HCL_HAVE_SIZEOF_UINT128_T) && (HCL_SIZEOF_OF_UINT128_T == HCL_SIZEOF_OOW_T)
# define hcl_htobeoow(x) hcl_htobe64(x)
# define hcl_beoowtoh(x) hcl_be64toh(x)
# define hcl_htoleoow(x) hcl_htole64(x)
# define hcl_leoowtoh(x) hcl_le64toh(x)
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_UINT128_T == HCL_SIZEOF_OOW_T)
# define hcl_ntohoow(x) hcl_ntoh128(x)
# define hcl_htonoow(x) hcl_hton128(x)
# define hcl_htobeoow(x) hcl_htobe128(x)
# define hcl_beoowtoh(x) hcl_be128toh(x)
# define hcl_htoleoow(x) hcl_htole128(x)
# define hcl_leoowtoh(x) hcl_le128toh(x)
#endif
#if defined(HCL_HAVE_UINT16_T) && (HCL_SIZEOF_UINT16_T == HCL_SIZEOF_OOHW_T)
# define hcl_ntohoohw(x) hcl_ntoh16(x)
# define hcl_htonoohw(x) hcl_hton16(x)
# define hcl_htobeoohw(x) hcl_htobe116(x)
# define hcl_beoohwtoh(x) hcl_be16toh(x)
# define hcl_htoleoohw(x) hcl_htole16(x)
# define hcl_leoohwtoh(x) hcl_le16toh(x)
#elif defined(HCL_HAVE_UINT32_T) && (HCL_SIZEOF_UINT32_T == HCL_SIZEOF_OOHW_T)
# define hcl_ntohoohw(x) hcl_ntoh32(x)
# define hcl_htonoohw(x) hcl_hton32(x)
# define hcl_htobeoohw(x) hcl_htobe32(x)
# define hcl_beoohwtoh(x) hcl_be32toh(x)
# define hcl_htoleoohw(x) hcl_htole32(x)
# define hcl_leoohwtoh(x) hcl_le32toh(x)
#elif defined(HCL_HAVE_UINT64_T) && (HCL_SIZEOF_UINT64_T == HCL_SIZEOF_OOHW_T)
# define hcl_ntohoohw(x) hcl_ntoh64(x)
# define hcl_htonoohw(x) hcl_hton64(x)
# define hcl_htobeoohw(x) hcl_htobe64(x)
# define hcl_beoohwtoh(x) hcl_be64toh(x)
# define hcl_htoleoohw(x) hcl_htole64(x)
# define hcl_leoohwtoh(x) hcl_le64toh(x)
#elif defined(HCL_HAVE_UINT128_T) && (HCL_SIZEOF_UINT128_T == HCL_SIZEOF_OOHW_T)
# define hcl_ntohoohw(x) hcl_ntoh128(x)
# define hcl_htonoohw(x) hcl_hton128(x)
# define hcl_htobeoohw(x) hcl_htobe128(x)
# define hcl_beoohwtoh(x) hcl_be128toh(x)
# define hcl_htoleoohw(x) hcl_htole128(x)
# define hcl_leoohwtoh(x) hcl_le128toh(x)
#endif
#if defined(HCL_USE_OOW_FOR_LIW)
# define hcl_ntohliw(x) hcl_ntohoow(x)
# define hcl_htonliw(x) hcl_htonoow(x)
# define hcl_htobeliw(x) hcl_htobeoow(x)
# define hcl_beliwtoh(x) hcl_beoowtoh(x)
# define hcl_htoleliw(x) hcl_htoleoow(x)
# define hcl_leliwtoh(x) hcl_leoowtoh(x)
#else
# define hcl_ntohliw(x) hcl_ntohoohw(x)
# define hcl_htonliw(x) hcl_htonoohw(x)
# define hcl_htobeliw(x) hcl_htobeoohw(x)
# define hcl_beliwtoh(x) hcl_beoohwtoh(x)
# define hcl_htoleliw(x) hcl_htoleoohw(x)
# define hcl_leliwtoh(x) hcl_leoohwtoh(x)
#endif
/* =========================================================================

27
lib/hcl.h
View File

@ -251,39 +251,12 @@ typedef struct hcl_obj_word_t* hcl_oop_word_t;
#define HCL_OOP_BITS (HCL_SIZEOF_OOP_T * HCL_BITS_PER_BYTE)
/* =========================================================================
* BIGINT TYPES AND MACROS
* ========================================================================= */
#if defined(HCL_ENABLE_FULL_LIW) && (HCL_SIZEOF_UINTMAX_T > HCL_SIZEOF_OOW_T)
# define HCL_USE_OOW_FOR_LIW
#endif
#if defined(HCL_USE_OOW_FOR_LIW)
typedef hcl_oow_t hcl_liw_t; /* large integer word */
typedef hcl_ooi_t hcl_lii_t;
typedef hcl_uintmax_t hcl_lidw_t; /* large integer double word */
typedef hcl_intmax_t hcl_lidi_t;
# define HCL_SIZEOF_LIW_T HCL_SIZEOF_OOW_T
# define HCL_SIZEOF_LIDW_T HCL_SIZEOF_UINTMAX_T
# define HCL_LIW_BITS HCL_OOW_BITS
# define HCL_LIDW_BITS (HCL_SIZEOF_UINTMAX_T * HCL_BITS_PER_BYTE)
typedef hcl_oop_word_t hcl_oop_liword_t;
# define HCL_OBJ_TYPE_LIWORD HCL_OBJ_TYPE_WORD
#else
typedef hcl_oohw_t hcl_liw_t;
typedef hcl_oohi_t hcl_lii_t;
typedef hcl_oow_t hcl_lidw_t;
typedef hcl_ooi_t hcl_lidi_t;
# define HCL_SIZEOF_LIW_T HCL_SIZEOF_OOHW_T
# define HCL_SIZEOF_LIDW_T HCL_SIZEOF_OOW_T
# define HCL_LIW_BITS HCL_OOHW_BITS
# define HCL_LIDW_BITS HCL_OOW_BITS
typedef hcl_oop_halfword_t hcl_oop_liword_t;
# define HCL_OBJ_TYPE_LIWORD HCL_OBJ_TYPE_HALFWORD
#endif
/* =========================================================================

1
lib/poll-msw.c
View File

@ -33,6 +33,7 @@
#include <time.h>
#include <errno.h>
#include <limits.h>
#include <io.h>
#if defined(__BORLANDC__)
# include <malloc.h>

2
lib/std.c
View File

@ -116,7 +116,7 @@
# include <malloc.h>
# define malloc(x) halloc(x, 1)
# define free(x) hfree(x)
# else
# elif defined(__WATCOMC__)
# include <dosfunc.h>
# endif

484
lib/xchg.c Normal file
View File

@ -0,0 +1,484 @@
/*
Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hcl-prv.h"
/* compiler's literal representation */
#include <hcl-pac1.h>
struct hcl_clit_hdr_t
{
hcl_uint8_t ver;
hcl_uint8_t oow_size;
};
typedef struct hcl_clit_hdr_t hcl_clit_hdr_t;
#include <hcl-upac.h>
enum hcl_clit_type_t
{
HCL_CLIT_STRING = 0x00,
HCL_CLIT_SYMBOL, /* contained in a cons cell */
HCL_CLIT_PBIGINT,
HCL_CLIT_NBIGINT,
HCL_CLIT_FPDEC_1, /* smooi + smooi */
HCL_CLIT_FPDEC_2, /* pbigint + smooi */
HCL_CLIT_FPDEC_3, /* nbigint + smooi */
HCL_CLIT_PRIM,
HCL_CLIT_END =0xFF /* end marker. not a real literal type */
};
typedef enum hcl_clit_type_t hcl_clit_type_t;
#define HCL_CLIT_HEADER \
hcl_oow_t _type: 3; \
hcl_oow_t _size: (HCL_OOW_BITS - 3)
#define HCL_CLIT_SIZE_MAX ((((hcl_oow_t)1) << 3) >> 3)
/* TODO: should clit be chained? these fields in the header?
hcl_clit_t* _prev;
hcl_clit_t* _next
*/
struct hcl_clit_t
{
HCL_CLIT_HEADER;
};
typedef struct hcl_clit_t hcl_clit_t;
/*
struct hcl_clit_string_t
{
HCL_CLIT_HEADER;
};
typedef struct hcl_clit_string_t hcl_clit_string_t;
struct hcl_clit_symbol_t
{
HCL_CLIT_HEADER;
};
typedef struct hcl_clit_symbol_t hcl_clit_symbol_t;
*/
struct hcl_clit_fpdec_t
{
HCL_CLIT_HEADER;
#if 0
hcl_oop_t value; /* smooi or bigint */
hcl_oop_t scale; /* smooi, positiv
#else
/* TODO: how to represent value?? */
hcl_ooi_t scale;
#endif
};
typedef struct hcl_clit_fpdec_t hcl_clit_fpdec_t;
struct hcl_clit_prim_t
{
HCL_CLIT_HEADER;
};
typedef struct hcl_clit_prim_t hcl_clit_prim_t;
static hcl_clit_t* alloc_clit (hcl_t* hcl, hcl_clit_type_t type, const void* data, hcl_oow_t size)
{
hcl_clit_t* clit;
if (size > HCL_CLIT_SIZE_MAX)
{
hcl_seterrnum (hcl, HCL_EINVAL); /* TODO: more specific error messagae... */
return HCL_NULL;
}
clit = (hcl_clit_t*)hcl_allocmem(hcl, HCL_SIZEOF(*clit) + size);
if (HCL_UNLIKELY(!clit)) return HCL_NULL;
clit->_type = type;
clit->_size = size;
if (size > 0 && data) HCL_MEMCPY (clit + 1, data, size);
/* if size is greater than 0 and data is HCL_NULL, the allocated space is left uninitialized */
return clit;
}
hcl_clit_t* hcl_makestringclit (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len)
{
return alloc_clit(hcl, HCL_CLIT_STRING, ptr, len * HCL_SIZEOF(*ptr));
}
hcl_clit_t* hcl_makesymbolclit (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len)
{
return alloc_clit(hcl, HCL_CLIT_SYMBOL, ptr, len * HCL_SIZEOF(*ptr));
}
hcl_clit_t* hcl_makefpdecclit (hcl_t* hcl)
{
hcl_clit_fpdec_t* fpdec;
fpdec = (hcl_clit_fpdec_t*)alloc_clit(hcl, HCL_CLIT_FPDEC_1, HCL_NULL, HCL_SIZEOF(*fpdec) - HCL_SIZEOF(hcl_clit_t));
if (HCL_UNLIKELY(!fpdec)) return HCL_NULL;
//fpdec-> = argss;
return (hcl_clit_t*)fpdec;
}
hcl_clit_t* hcl_makeprimclit (hcl_t* hcl)
{
hcl_clit_prim_t* prim;
prim = (hcl_clit_prim_t*)alloc_clit(hcl, HCL_CLIT_PRIM, HCL_NULL, HCL_SIZEOF(*prim) - HCL_SIZEOF(hcl_clit_t));
if (HCL_UNLIKELY(!prim)) return HCL_NULL;
//prim-> = argss;
return (hcl_clit_t*)prim;
}
void hcl_freeclit (hcl_t* hcl, hcl_clit_t* clit)
{
hcl_freemem(hcl, clit);
}
#if 0
static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const void* ptr, hcl_oow_t len, hcl_obj_type_t type, hcl_oow_t unit, int extra, int ngc)
{
/* allocate a variable object */
hcl_oop_t hdr;
hcl_oow_t xbytes, nbytes, nbytes_aligned;
xbytes = len * unit;
/* 'extra' indicates an extra unit to append at the end.
* it's useful to store a string with a terminating null */
nbytes = extra? xbytes + unit: xbytes;
nbytes_aligned = HCL_ALIGN(nbytes, HCL_SIZEOF(hcl_oop_t));
/* TODO: check overflow in size calculation*/
/* making the number of bytes to allocate a multiple of
* HCL_SIZEOF(hcl_oop_t) will guarantee the starting address
* of the allocated space to be an even number.
* see HCL_OOP_IS_NUMERIC() and HCL_OOP_IS_POINTER() */
if (HCL_UNLIKELY(ngc))
hdr = (hcl_oop_t)hcl_callocmem(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
else
hdr = (hcl_oop_t)hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
if (HCL_UNLIKELY(!hdr)) return HCL_NULL;
hdr->_flags = HCL_OBJ_MAKE_FLAGS(type, unit, extra, 0, 0, ngc, 0, 0);
hdr->_size = len;
HCL_OBJ_SET_SIZE (hdr, len);
/*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/
HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);
if (ptr)
{
/* copy data */
HCL_MEMCPY (hdr + 1, ptr, xbytes);
HCL_MEMSET ((hcl_uint8_t*)(hdr + 1) + xbytes, 0, nbytes_aligned - xbytes);
}
else
{
/* initialize with zeros when the string pointer is not given */
HCL_MEMSET ((hdr + 1), 0, nbytes_aligned);
}
return hdr;
}
hcl_oop_t hcl_alloccharobj (hcl_t* hcl, int brand, const hcl_ooch_t* ptr, hcl_oow_t len)
{
return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, 0);
}
hcl_oop_t hcl_allocbyteobj (hcl_t* hcl, int brand, const hcl_oob_t* ptr, hcl_oow_t len)
{
return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 0);
}
hcl_oop_t hcl_allochalfwordobj (hcl_t* hcl, int brand, const hcl_oohw_t* ptr, hcl_oow_t len)
{
return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_HALFWORD, HCL_SIZEOF(hcl_oohw_t), 0, 0);
}
hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow_t len)
{
return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0);
}
#endif
#if 0
static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
{
hcl_oow_t capa, i, lfbase = 0;
hcl_oop_t tmp;
lfbase = (hcl->option.trait & HCL_TRAIT_INTERACTIVE)? hcl->c->fnblk.info[hcl->c->fnblk.depth].lfbase: 0;
/* TODO: speed up the following duplicate check loop */
for (i = lfbase; i < hcl->code.lit.len; i++)
{
tmp = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i];
if (tmp == obj)
{
/* this removes redundancy of symbols, characters, and integers. */
*index = i - lfbase;
return 0;
}
else if (HCL_IS_STRING(hcl, obj) && HCL_IS_STRING(hcl, tmp) && hcl_equalobjs(hcl, obj, tmp))
{
/* a string object requires equality check. however, the string created to the literal frame
* must be made immutable. non-immutable string literals are source of various problems */
*index = i - lfbase;
return 0;
}
}
capa = HCL_OBJ_GET_SIZE(hcl->code.lit.arr);
if (hcl->code.lit.len >= capa)
{
hcl_oop_t tmp;
hcl_oow_t newcapa;
newcapa = HCL_ALIGN(capa + 1, HCL_LIT_BUFFER_ALIGN);
tmp = hcl_remakengcarray(hcl, (hcl_oop_t)hcl->code.lit.arr, newcapa);
if (HCL_UNLIKELY(!tmp)) return -1;
hcl->code.lit.arr = (hcl_oop_oop_t)tmp;
}
*index = hcl->code.lit.len - lfbase;
((hcl_oop_oop_t)hcl->code.lit.arr)->slot[hcl->code.lit.len++] = obj;
/* TODO: RDONLY? */
/*if (HCL_IS_OOP_POINTER(obj)) HCL_OBJ_SET_FLAGS_RDONLY(obj, 1); */
return 0;
}
#endif
struct hcl_clit_frame_t
{
int x;
};
typedef struct hcl_clit_frame_t hcl_clit_frame_t;
/*
* B(1) | LEN(8) | DATA |
* DATA is B-specific.
*/
typedef int (*hcl_clit_reader_t) (
hcl_t* hcl,
void* buf,
hcl_oow_t* len,
void* ctx
);
typedef int (*hcl_clit_writer_t) (
hcl_t* hcl,
const void* ptr,
hcl_oow_t len,
void* ctx
);
int hcl_writeclits (hcl_t* hcl, hcl_clit_writer_t wrtr, void* ctx)
{
hcl_oow_t i, lfbase = 0;
hcl_oop_t tmp;
int brand;
hcl_oow_t tsize;
hcl_uint8_t b;
hcl_oow_t w;
hcl_clit_hdr_t h;
lfbase = (hcl->option.trait & HCL_TRAIT_INTERACTIVE)? hcl->c->fnblk.info[hcl->c->fnblk.depth].lfbase: 0;
/* start with a header */
h.ver = 1;
h.oow_size = (hcl_uint8_t)HCL_SIZEOF(hcl_oow_t); /* the size must not exceed 256 */
if (wrtr(hcl, &h, HCL_SIZEOF(h), ctx) <= -1) goto oops;
/* write actual literals */
for (i = lfbase; i < hcl->code.lit.len; i++)
{
tmp = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i];
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp);
switch (brand)
{
case HCL_BRAND_PBIGINT:
case HCL_BRAND_NBIGINT:
{
hcl_oow_t nbytes;
hcl_oow_t j;
hcl_liw_t liw;
/* write the brand */
b = (brand == HCL_BRAND_PBIGINT ? HCL_CLIT_PBIGINT : HCL_CLIT_NBIGINT);
if (wrtr(hcl, &b, 1, ctx) <= -1) goto oops;
/* write the number of bytes in the little-endian */
nbytes = tsize * HCL_SIZEOF(hcl_liw_t);
w = hcl_htoleoow(nbytes);
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
for (j = 0; j < tsize; j++)
{
liw = HCL_OBJ_GET_LIWORD_VAL(tmp, j);
liw = hcl_htoleliw(liw);
if (wrtr(hcl, &liw, HCL_SIZEOF(liw), ctx) <= -1) goto oops;
}
break;
}
case HCL_BRAND_CONS:
{
/* write 1-byte brand */
b = (hcl_uint8_t)HCL_CLIT_SYMBOL;
if (wrtr(hcl, &b, 1, ctx) <= -1) goto oops;
/* get the symbol at CAR and make it as if it is the current object processed.*/
tmp = HCL_CONS_CAR(tmp);
brand = HCL_OBJ_GET_FLAGS_BRAND(tmp);
tsize = HCL_OBJ_GET_SIZE(tmp);
HCL_ASSERT(hcl, brand == HCL_BRAND_SYMBOL);
goto string_body;
}
case HCL_BRAND_FPDEC:
{
hcl_oop_fpdec_t f;
f = (hcl_oop_fpdec_t)tmp;
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(f->scale));
HCL_ASSERT(hcl, HCL_OOP_IS_SMOOI(f->value) || HCL_OOP_IS_POINTER(f->value));
/* write 1-byte brand */
if (HCL_OOP_IS_SMOOI(f->value)) b = HCL_CLIT_FPDEC_1;
else if (HCL_IS_PBIGINT(hcl, f->value)) b = HCL_CLIT_FPDEC_2;
else
{
HCL_ASSERT(hcl, HCL_IS_NBIGINT(hcl, f->value));
b = HCL_CLIT_FPDEC_2;
}
if (wrtr(hcl, &b, 1, ctx) <= -1) goto oops;
/* cast the scale part from hcl_ooi_t to hcl_oow_t */
w = hcl_htoleoow((hcl_oow_t)f->scale);
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
/* TODO: write the value part */
break;
}
case HCL_BRAND_STRING:
{
#if defined(HCL_OOCH_IS_UCH)
hcl_uch_t* ucsptr;
hcl_oow_t ucspos, ucslen;
hcl_bch_t bcsbuf[128];
hcl_oow_t bcslen;
int n;
/* write 1-byte brand */
b = (hcl_uint8_t)HCL_CLIT_STRING;
if (wrtr(hcl, &b, 1, ctx) <= -1) goto oops;
string_body:
ucsptr = HCL_OBJ_GET_CHAR_SLOT(tmp);
ucslen = tsize;
if (hcl_convutobchars(hcl, ucsptr, &ucslen, HCL_NULL, &bcslen) <= -1) goto oops;
/* write the number of bytes in the little-endian */
w = hcl_htoleoow(bcslen);
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
/* write string in bytess and write to the callback.*/
ucspos = 0;
while (ucspos < tsize)
{
bcslen = HCL_COUNTOF(bcsbuf);
ucslen = tsize - ucspos;
n = hcl_convutobchars(hcl, &ucsptr[ucspos], &ucslen, bcsbuf, &bcslen);
if (n <= -1 && bcslen == 0) goto oops;
if (wrtr(hcl, bcsbuf, bcslen, ctx) <= -1) goto oops;
ucspos += ucslen;
}
#else
w = hcl_htoleoow(tsize);
if (wrtr(hcl, &w, HCL_SIZEOF(w), ctx) <= -1) goto oops;
if (wrtr(hcl, HCL_OBJ_GET_CHAR_SLOT(tmp), tsize, ctx) <= -1) goto oops;
#endif
break;
}
case HCL_BRAND_PRIM:
break;
}
}
b = HCL_CLIT_END;
if (wrtr(hcl, &b, 1, ctx) <= -1) goto oops;
return 0;
oops:
return -1;
}
int hcl_restoreclits(hcl_t* hcl, hcl_clit_reader_t rdr, void* ctx)
{
int n;
hcl_uint8_t buf[128];
hcl_oow_t len, i;
while (1)
{
len = HCL_COUNTOF(buf);
n = rdr(hcl, buf, &len, ctx);
if (n <= -1) goto oops;
if (n == 0) break;
for (i = 0; i < len; i++)
{
switch (buf[i])
{
case HCL_BRAND_PBIGINT:
case HCL_BRAND_NBIGINT:
break;
case HCL_BRAND_STRING:
break;
}
}
}
/* TODO: have i SEEN HCL_CLIT_END??? otherwise, incomplete... */
return 0;
oops:
return -1;
}