From 58d913e3da53a931beeca2d89e11d88f7d969bf1 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sat, 23 Dec 2023 12:43:26 +0900 Subject: [PATCH] writing functions for bytecode and literal frame exchange with other vms --- bin/main.c | 7 +- lib/Makefile.am | 8 +- lib/Makefile.in | 29 +-- lib/hcl-cmn.h | 27 +++ lib/hcl-pac1.h | 37 ++++ lib/hcl-upac.h | 37 ++++ lib/hcl-utl.h | 196 ++++++++++++++++---- lib/hcl.h | 27 --- lib/poll-msw.c | 1 + lib/std.c | 2 +- lib/xchg.c | 484 ++++++++++++++++++++++++++++++++++++++++++++++++ 11 files changed, 775 insertions(+), 80 deletions(-) create mode 100644 lib/hcl-pac1.h create mode 100644 lib/hcl-upac.h create mode 100644 lib/xchg.c diff --git a/bin/main.c b/bin/main.c index 840647c..4da48fe 100644 --- a/bin/main.c +++ b/bin/main.c @@ -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 ();*/ diff --git a/lib/Makefile.am b/lib/Makefile.am index a591b7b..58d0213 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -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) diff --git a/lib/Makefile.in b/lib/Makefile.in index c0130a0..581c363 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -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 diff --git a/lib/hcl-cmn.h b/lib/hcl-cmn.h index 27808a5..df666f4 100644 --- a/lib/hcl-cmn.h +++ b/lib/hcl-cmn.h @@ -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 * ========================================================================= */ diff --git a/lib/hcl-pac1.h b/lib/hcl-pac1.h new file mode 100644 index 0000000..abf1463 --- /dev/null +++ b/lib/hcl-pac1.h @@ -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 diff --git a/lib/hcl-upac.h b/lib/hcl-upac.h new file mode 100644 index 0000000..b544ab3 --- /dev/null +++ b/lib/hcl-upac.h @@ -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 diff --git a/lib/hcl-utl.h b/lib/hcl-utl.h index 31684fc..11dfb20 100644 --- a/lib/hcl-utl.h +++ b/lib/hcl-utl.h @@ -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 /* ========================================================================= diff --git a/lib/hcl.h b/lib/hcl.h index 70428e8..aa62fba 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -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 /* ========================================================================= diff --git a/lib/poll-msw.c b/lib/poll-msw.c index 816813e..2ea4b5b 100644 --- a/lib/poll-msw.c +++ b/lib/poll-msw.c @@ -33,6 +33,7 @@ #include #include #include +#include #if defined(__BORLANDC__) # include diff --git a/lib/std.c b/lib/std.c index 636c03b..59d34b4 100644 --- a/lib/std.c +++ b/lib/std.c @@ -116,7 +116,7 @@ # include # define malloc(x) halloc(x, 1) # define free(x) hfree(x) -# else +# elif defined(__WATCOMC__) # include # endif diff --git a/lib/xchg.c b/lib/xchg.c new file mode 100644 index 0000000..63bfee0 --- /dev/null +++ b/lib/xchg.c @@ -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 +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 + +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; +} \ No newline at end of file