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

trying to revive this project

Browse Source
This commit is contained in:
hyung-hwan
2018-02-05 10:43:25 +00:00
parent a84cd9da09
commit 293222d5c5
47 changed files with 16035 additions and 6174 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
lib/Makefile.am
View File

@ -34,12 +34,15 @@ libhcl_la_SOURCES = \
debug.c \
decode.c \
dic.c \
err.c \
exec.c \
gc.c \
hcl.c \
heap.c \
logfmt.c \
obj.c \
opt-imp.h \
opt.c \
prim.c \
print.c \
rbt.c \

56
lib/Makefile.in
View File

@ -1,7 +1,7 @@
# Makefile.in generated by automake 1.14.1 from Makefile.am.
# Makefile.in generated by automake 1.15 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# Copyright (C) 1994-2014 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
@ -17,7 +17,17 @@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__is_gnu_make = { \
if test -z '$(MAKELEVEL)'; then \
false; \
elif test -n '$(MAKE_HOST)'; then \
true; \
elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \
true; \
else \
false; \
fi; \
}
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
@ -80,9 +90,6 @@ build_triplet = @build@
host_triplet = @host@
bin_PROGRAMS = hcl$(EXEEXT)
subdir = lib
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(srcdir)/hcl-cfg.h.in $(top_srcdir)/ac/depcomp \
$(pkginclude_HEADERS)
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_cxx_namespace.m4 \
$(top_srcdir)/m4/ax_numval.m4 $(top_srcdir)/m4/libtool.m4 \
@ -91,6 +98,8 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/ax_cxx_namespace.m4 \
$(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
DIST_COMMON = $(srcdir)/Makefile.am $(pkginclude_HEADERS) \
$(am__DIST_COMMON)
mkinstalldirs = $(install_sh) -d
CONFIG_HEADER = hcl-cfg.h
CONFIG_CLEAN_FILES =
@ -130,11 +139,11 @@ am__DEPENDENCIES_2 = $(am__DEPENDENCIES_1)
libhcl_la_DEPENDENCIES = $(am__DEPENDENCIES_2)
am_libhcl_la_OBJECTS = libhcl_la-bigint.lo libhcl_la-comp.lo \
libhcl_la-debug.lo libhcl_la-decode.lo libhcl_la-dic.lo \
libhcl_la-exec.lo libhcl_la-gc.lo libhcl_la-hcl.lo \
libhcl_la-heap.lo libhcl_la-logfmt.lo libhcl_la-obj.lo \
libhcl_la-prim.lo libhcl_la-print.lo libhcl_la-rbt.lo \
libhcl_la-read.lo libhcl_la-sym.lo libhcl_la-utf8.lo \
libhcl_la-utl.lo
libhcl_la-err.lo libhcl_la-exec.lo libhcl_la-gc.lo \
libhcl_la-hcl.lo libhcl_la-heap.lo libhcl_la-logfmt.lo \
libhcl_la-obj.lo libhcl_la-opt.lo libhcl_la-prim.lo \
libhcl_la-print.lo libhcl_la-rbt.lo libhcl_la-read.lo \
libhcl_la-sym.lo libhcl_la-utf8.lo libhcl_la-utl.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@)
@ -212,6 +221,8 @@ am__define_uniq_tagged_files = \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/hcl-cfg.h.in \
$(top_srcdir)/ac/depcomp
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
pkgincludedir = $(includedir)
pkglibdir = $(libdir)
@ -276,6 +287,7 @@ LIBTOOL_DEPS = @LIBTOOL_DEPS@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
@ -387,12 +399,15 @@ libhcl_la_SOURCES = \
debug.c \
decode.c \
dic.c \
err.c \
exec.c \
gc.c \
hcl.c \
heap.c \
logfmt.c \
obj.c \
opt-imp.h \
opt.c \
prim.c \
print.c \
rbt.c \
@ -425,7 +440,6 @@ $(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign lib/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign lib/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
@ -562,12 +576,14 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-debug.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-decode.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-dic.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-err.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-exec.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-gc.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-hcl.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-heap.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-logfmt.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-obj.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-opt.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-prim.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-print.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libhcl_la-rbt.Plo@am__quote@
@ -635,6 +651,13 @@ libhcl_la-dic.lo: dic.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-dic.lo `test -f 'dic.c' || echo '$(srcdir)/'`dic.c
libhcl_la-err.lo: err.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-err.lo -MD -MP -MF $(DEPDIR)/libhcl_la-err.Tpo -c -o libhcl_la-err.lo `test -f 'err.c' || echo '$(srcdir)/'`err.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-err.Tpo $(DEPDIR)/libhcl_la-err.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='err.c' object='libhcl_la-err.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-err.lo `test -f 'err.c' || echo '$(srcdir)/'`err.c
libhcl_la-exec.lo: exec.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-exec.lo -MD -MP -MF $(DEPDIR)/libhcl_la-exec.Tpo -c -o libhcl_la-exec.lo `test -f 'exec.c' || echo '$(srcdir)/'`exec.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-exec.Tpo $(DEPDIR)/libhcl_la-exec.Plo
@ -677,6 +700,13 @@ libhcl_la-obj.lo: obj.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-obj.lo `test -f 'obj.c' || echo '$(srcdir)/'`obj.c
libhcl_la-opt.lo: opt.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-opt.lo -MD -MP -MF $(DEPDIR)/libhcl_la-opt.Tpo -c -o libhcl_la-opt.lo `test -f 'opt.c' || echo '$(srcdir)/'`opt.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-opt.Tpo $(DEPDIR)/libhcl_la-opt.Plo
@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='opt.c' object='libhcl_la-opt.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-opt.lo `test -f 'opt.c' || echo '$(srcdir)/'`opt.c
libhcl_la-prim.lo: prim.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-prim.lo -MD -MP -MF $(DEPDIR)/libhcl_la-prim.Tpo -c -o libhcl_la-prim.lo `test -f 'prim.c' || echo '$(srcdir)/'`prim.c
@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libhcl_la-prim.Tpo $(DEPDIR)/libhcl_la-prim.Plo
@ -980,6 +1010,8 @@ uninstall-am: uninstall-binPROGRAMS uninstall-pkgincludeHEADERS \
uninstall-binPROGRAMS uninstall-hook \
uninstall-pkgincludeHEADERS uninstall-pkglibLTLIBRARIES
.PRECIOUS: Makefile
install-data-hook:
@echo "#ifndef _HCL_CFG_H_" > "$(DESTDIR)$(pkgincludedir)/hcl-cfg.h"

4472
lib/bigint.c
View File

File diff suppressed because it is too large Load Diff

194
lib/comp.c
View File

@ -80,14 +80,14 @@ static int add_temporary_variable (hcl_t* hcl, hcl_oop_t name, hcl_oow_t dup_che
{
hcl_oow_t i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, name));
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, name));
for (i = dup_check_start; i < hcl->c->tv.size; i++)
{
HCL_ASSERT (HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{
hcl->errnum = HCL_EEXIST;
hcl_seterrnum (hcl, HCL_EEXIST);
return -1;
}
}
@ -113,11 +113,11 @@ static int find_temporary_variable_backward (hcl_t* hcl, hcl_oop_t name, hcl_oow
{
hcl_oow_t i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, name));
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, name));
for (i = hcl->c->tv.size; i > 0; )
{
--i;
HCL_ASSERT (HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
HCL_ASSERT (hcl, HCL_IS_SYMBOL (hcl, hcl->c->tv.ptr[i]));
if (hcl->c->tv.ptr[i] == name)
{
*index = i;
@ -125,13 +125,13 @@ static int find_temporary_variable_backward (hcl_t* hcl, hcl_oop_t name, hcl_oow
}
}
hcl->errnum = HCL_ENOENT;
hcl_seterrnum (hcl, HCL_ENOENT);
return -1;
}
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count)
{
HCL_ASSERT (hcl->c->blk.depth >= 0);
HCL_ASSERT (hcl, hcl->c->blk.depth >= 0);
if (hcl->c->blk.depth >= hcl->c->blk.tmprcnt_capa)
{
@ -154,7 +154,7 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
static HCL_INLINE void patch_instruction (hcl_t* hcl, hcl_oow_t index, hcl_oob_t bc)
{
HCL_ASSERT (index < hcl->code.bc.len);
HCL_ASSERT (hcl, index < hcl->code.bc.len);
hcl->code.bc.arr->slot[index] = bc;
}
@ -169,7 +169,7 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc)
* at the max when incremented */
if (hcl->code.bc.len == HCL_SMOOI_MAX - 1)
{
hcl->errnum = HCL_EBCFULL; /* byte code full/too big */
hcl_seterrnum (hcl, HCL_EBCFULL); /* byte code full/too big */
return -1;
}
@ -267,7 +267,7 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
goto write_long;
}
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
write_short:
@ -277,7 +277,7 @@ write_short:
write_long:
if (param_1 > MAX_CODE_PARAM)
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
#if (HCL_BCODE_LONG_PARAM_SIZE == 2)
@ -293,7 +293,7 @@ write_long:
write_long2:
if (param_1 > MAX_CODE_PARAM2)
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
#if (HCL_BCODE_LONG_PARAM_SIZE == 2)
@ -343,7 +343,7 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
goto write_long;
}
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
write_short:
@ -354,7 +354,7 @@ write_short:
write_long:
if (param_1 > MAX_CODE_PARAM || param_2 > MAX_CODE_PARAM)
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
#if (HCL_BCODE_LONG_PARAM_SIZE == 2)
@ -374,7 +374,7 @@ write_long:
write_long2:
if (param_1 > MAX_CODE_PARAM || param_2 > MAX_CODE_PARAM)
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
#if (HCL_BCODE_LONG_PARAM_SIZE == 2)
@ -454,9 +454,9 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
/* switch to JUMP2 instruction to allow a bigger jump offset.
* up to twice MAX_CODE_JUMP only */
HCL_ASSERT (jump_offset <= MAX_CODE_JUMP * 2);
HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2);
HCL_ASSERT (hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_X ||
HCL_ASSERT (hcl, hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_X ||
hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_BACKWARD_X ||
hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE ||
hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE);
@ -479,11 +479,11 @@ static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, h
{
hcl_cframe_t* tmp;
HCL_ASSERT (index >= 0);
HCL_ASSERT (hcl, index >= 0);
hcl->c->cfs.top++;
HCL_ASSERT (hcl->c->cfs.top >= 0);
HCL_ASSERT (index <= hcl->c->cfs.top);
HCL_ASSERT (hcl, hcl->c->cfs.top >= 0);
HCL_ASSERT (hcl, index <= hcl->c->cfs.top);
if ((hcl_oow_t)hcl->c->cfs.top >= hcl->c->cfs.capa)
{
@ -517,7 +517,7 @@ static int insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_oop_t ope
{
if (hcl->c->cfs.top == HCL_TYPE_MAX(hcl_ooi_t))
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_EFRMFLOOD);
return -1;
}
@ -528,7 +528,7 @@ static int push_cframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
{
if (hcl->c->cfs.top == HCL_TYPE_MAX(hcl_ooi_t))
{
hcl->errnum = HCL_ETOOBIG;
hcl_seterrnum (hcl, HCL_EFRMFLOOD);
return -1;
}
@ -537,7 +537,7 @@ static int push_cframe (hcl_t* hcl, int opcode, hcl_oop_t operand)
static HCL_INLINE void pop_cframe (hcl_t* hcl)
{
HCL_ASSERT (hcl->c->cfs.top >= 0);
HCL_ASSERT (hcl, hcl->c->cfs.top >= 0);
hcl->c->cfs.top--;
}
@ -639,8 +639,8 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src)
hcl_oop_t obj;
hcl_ooi_t i;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_break);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_break);
obj = HCL_CONS_CDR(src);
if (!HCL_IS_NIL(hcl,obj))
@ -677,7 +677,7 @@ static int compile_break (hcl_t* hcl, hcl_oop_t src)
if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL) <= -1) return -1;
/* TODO: study if supporting expression after break is good like return. (break (+ 10 20)) */
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP) <= -1) return -1;
@ -698,8 +698,8 @@ static int compile_if (hcl_t* hcl, hcl_oop_t src)
hcl_oop_t obj, cond;
hcl_cframe_t* cf;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_if);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_if);
/* (if (< 20 30)
* (do this)
@ -749,8 +749,8 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
hcl_ooi_t jump_inst_pos;
hcl_oow_t saved_tv_count, tv_dup_start;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_lambda);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_lambda);
saved_tv_count = hcl->c->tv.size;
obj = HCL_CONS_CDR(src);
@ -831,7 +831,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
while (1);
}
HCL_ASSERT (nargs == hcl->c->tv.size - saved_tv_count);
HCL_ASSERT (hcl, nargs == hcl->c->tv.size - saved_tv_count);
if (nargs > MAX_CODE_NBLKARGS) /*TODO: change this limit to max call argument count */
{
/* while an integer object is pused to indicate the number of
@ -886,7 +886,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
}
/* ntmprs: number of temporary variables including arguments */
HCL_ASSERT (ntmprs == hcl->c->tv.size - saved_tv_count);
HCL_ASSERT (hcl, ntmprs == hcl->c->tv.size - saved_tv_count);
if (ntmprs > MAX_CODE_NBLKTMPRS)
{
HCL_DEBUG1 (hcl, "Syntax error - too many variables - %O\n", args);
@ -909,7 +909,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src)
* count of temporaries in the home context */
if (emit_double_param_instruction (hcl, HCL_CODE_MAKE_BLOCK, nargs, hcl->c->tv.size/*ntmprs*/) <= -1) return -1;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */
jump_inst_pos = hcl->code.bc.len;
/* specifying MAX_CODE_JUMP causes emit_single_param_instruction() to
* produce the long jump instruction (BCODE_JUMP_FORWARD_X) */
@ -925,8 +925,8 @@ static int compile_return (hcl_t* hcl, hcl_oop_t src)
{
hcl_oop_t obj, val;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_return);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_return);
obj = HCL_CONS_CDR(src);
@ -967,8 +967,8 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
hcl_oop_t obj, var, val;
hcl_oow_t index;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_set);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_set);
obj = HCL_CONS_CDR(src);
@ -1036,7 +1036,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
else
{
/* the check in compile_lambda() must ensure this condition */
HCL_ASSERT (index <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, index <= HCL_SMOOI_MAX);
PUSH_SUBCFRAME (hcl, COP_EMIT_SET, HCL_SMOOI_TO_OOP(index));
cf = GET_SUBCFRAME (hcl);
@ -1053,9 +1053,9 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
hcl_oow_t cond_pos;
hcl_cframe_t* cf;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_until || HCL_CONS_CAR(src) == hcl->_while);
HCL_ASSERT (next_cop == COP_POST_UNTIL_COND || next_cop == COP_POST_WHILE_COND);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_until || HCL_CONS_CAR(src) == hcl->_while);
HCL_ASSERT (hcl, next_cop == COP_POST_UNTIL_COND || next_cop == COP_POST_WHILE_COND);
obj = HCL_CONS_CDR(src);
@ -1073,7 +1073,7 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
cond_pos = hcl->code.bc.len; /* position where the bytecode for the conditional is emitted */
cond = HCL_CONS_CAR(obj);
@ -1095,7 +1095,7 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
hcl_oop_t car;
int syncode;
HCL_ASSERT (HCL_IS_CONS(hcl, obj));
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, obj));
car = HCL_CONS_CAR(obj);
if (HCL_IS_SYMBOL(hcl,car) && (syncode = HCL_OBJ_GET_FLAGS_SYNCODE(car)))
@ -1157,7 +1157,7 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
default:
HCL_DEBUG3 (hcl, "Internal error - unknown syncode %d at %s:%d\n", syncode, __FILE__, __LINE__);
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
}
}
@ -1174,7 +1174,7 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
* many operations can be performed without taking GC into account */
oldtop = GET_TOP_CFRAME_INDEX(hcl);
HCL_ASSERT (oldtop >= 0);
HCL_ASSERT (hcl, oldtop >= 0);
SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, HCL_SMOOI_TO_OOP(0));
@ -1205,7 +1205,7 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
nargs = hcl_countcons (hcl, cdr);
if (nargs > MAX_CODE_PARAM)
{
hcl->errnum = HCL_ETOOBIG; /* TODO: change the error code to a better one */
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
}
@ -1214,7 +1214,7 @@ HCL_DEBUG0 (hcl, "DEFUN NOT IMPLEMENTED...\n");
/* patch the argument count in the operand field of the COP_EMIT_CALL frame */
cf = GET_CFRAME(hcl, oldtop);
HCL_ASSERT (cf->opcode == COP_EMIT_CALL);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL);
cf->operand = HCL_SMOOI_TO_OOP(nargs);
}
@ -1230,7 +1230,7 @@ static int emit_indexed_variable_access (hcl_t* hcl, hcl_oow_t index, hcl_oob_t
/* if a temporary variable is accessed inside a block,
* use a special instruction to indicate it */
HCL_ASSERT (index < hcl->c->blk.tmprcnt[hcl->c->blk.depth]);
HCL_ASSERT (hcl, index < hcl->c->blk.tmprcnt[hcl->c->blk.depth]);
for (i = hcl->c->blk.depth; i > 0; i--) /* excluded the top level -- TODO: change this code depending on global variable handling */
{
if (index >= hcl->c->blk.tmprcnt[i - 1])
@ -1259,7 +1259,7 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_oop_t obj)
{
hcl_oow_t index;
HCL_ASSERT (HCL_BRANDOF(hcl,obj) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,obj) == HCL_BRAND_SYMBOL);
if (HCL_OBJ_GET_FLAGS_SYNCODE(obj))
{
@ -1298,7 +1298,7 @@ static int compile_object (hcl_t* hcl)
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_COMPILE_OBJECT);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT);
if (HCL_OOP_IS_NUMERIC(cf->operand)) goto literal;
@ -1350,7 +1350,7 @@ static int compile_object_list (hcl_t* hcl)
int cop;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_COMPILE_OBJECT_LIST ||
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT_LIST ||
cf->opcode == COP_COMPILE_IF_OBJECT_LIST ||
cf->opcode == COP_COMPILE_ARGUMENT_LIST ||
cf->opcode == COP_COMPILE_IF_OBJECT_LIST_TAIL ||
@ -1388,7 +1388,7 @@ static int compile_object_list (hcl_t* hcl)
coperand = cdr;
}
HCL_ASSERT (!HCL_IS_NIL(hcl, coperand));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl, coperand));
}
if (!HCL_IS_CONS(hcl, coperand))
@ -1458,7 +1458,7 @@ static HCL_INLINE int patch_nearest_post_if_body (hcl_t* hcl)
hcl_cframe_t* cf;
cf = find_cframe_from_top (hcl, COP_POST_IF_BODY);
HCL_ASSERT (cf != HCL_NULL);
HCL_ASSERT (hcl, cf != HCL_NULL);
/* jump instruction position of the JUMP_FORWARD_IF_FALSE after the conditional of the previous if or elif*/
jip = HCL_OOP_TO_SMOOI(cf->operand);
@ -1469,7 +1469,7 @@ static HCL_INLINE int patch_nearest_post_if_body (hcl_t* hcl)
if (emit_byte_instruction (hcl, HCL_CODE_PUSH_NIL) <= -1) return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
/* emit jump_forward before the beginning of the else block.
@ -1493,12 +1493,12 @@ static HCL_INLINE int patch_nearest_post_if_body (hcl_t* hcl)
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
/* this is the actual beginning */
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
/* modify the POST_IF_BODY frame */
HCL_ASSERT (cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
cf->operand = HCL_SMOOI_TO_OOP(jump_inst_pos);
cf->u.post_if.body_pos = body_pos;
@ -1511,11 +1511,11 @@ static HCL_INLINE int subcompile_elif (hcl_t* hcl)
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_SUBCOMPILE_ELIF);
HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_ELIF);
src = cf->operand;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_elif);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_elif);
obj = HCL_CONS_CDR(src);
@ -1550,11 +1550,11 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl)
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_SUBCOMPILE_ELSE);
HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_ELSE);
src = cf->operand;
HCL_ASSERT (HCL_IS_CONS(hcl, src));
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_else);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_else);
obj = HCL_CONS_CDR(src);
@ -1579,9 +1579,9 @@ static HCL_INLINE int post_if_cond (hcl_t* hcl)
hcl_ooi_t body_pos;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_IF_COND);
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_COND);
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP) <= -1) return -1;
@ -1589,7 +1589,7 @@ static HCL_INLINE int post_if_cond (hcl_t* hcl)
/* to drop the result of the conditional when it is true */
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_IF_OBJECT_LIST, cf->operand); /* 1 */
@ -1606,8 +1606,8 @@ static HCL_INLINE int post_if_body (hcl_t* hcl)
hcl_oow_t jump_offset;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
jip = HCL_OOP_TO_SMOOI(cf->operand);
@ -1641,10 +1641,10 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl)
int jump_inst, next_cop;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND);
HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND);
cond_pos = cf->u.post_while.cond_pos;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
if (cf->opcode == COP_POST_UNTIL_COND)
@ -1661,7 +1661,7 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl)
if (emit_single_param_instruction (hcl, jump_inst, MAX_CODE_JUMP) <= -1) return -1;
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, cf->operand); /* 1 */
@ -1679,10 +1679,10 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
hcl_ooi_t jump_offset;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_UNTIL_BODY || cf->opcode == COP_POST_WHILE_BODY);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_BODY || cf->opcode == COP_POST_WHILE_BODY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl->code.bc.len >= cf->u.post_while.cond_pos);
HCL_ASSERT (hcl, hcl->code.bc.len >= cf->u.post_while.cond_pos);
if (hcl->code.bc.len > cf->u.post_while.body_pos)
{
/* some code exist after POP_STACKTOP after JUMP_FORWARD_IF_TRUE/FALSE.
@ -1697,7 +1697,7 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
}
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_offset = hcl->code.bc.len - cf->u.post_while.cond_pos + 1;
if (jump_offset > 3) jump_offset += HCL_BCODE_LONG_PARAM_SIZE;
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_BACKWARD_0, jump_offset) <= -1) return -1;
@ -1725,8 +1725,8 @@ static int update_break (hcl_t* hcl)
hcl_ooi_t jip, jump_offset;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_UPDATE_BREAK);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_UPDATE_BREAK);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
jip = HCL_OOP_TO_SMOOI(cf->operand);
@ -1736,7 +1736,7 @@ static int update_break (hcl_t* hcl)
/* no explicit about jump_offset. because break can only place inside
* a loop, the same check in post_while_body() must assert
* this break jump_offset to be small enough */
HCL_ASSERT (jump_offset <= MAX_CODE_JUMP * 2);
HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2);
patch_long_jump (hcl, jip, jump_offset);
POP_CFRAME (hcl);
@ -1751,8 +1751,8 @@ static HCL_INLINE int emit_call (hcl_t* hcl)
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_EMIT_CALL);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_CALL_0, HCL_OOP_TO_SMOOI(cf->operand));
@ -1767,8 +1767,8 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
hcl_oow_t jip;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_EMIT_LAMBDA);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_LAMBDA);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
jip = HCL_OOP_TO_SMOOI(cf->operand);
@ -1807,8 +1807,8 @@ static HCL_INLINE int emit_pop_stacktop (hcl_t* hcl)
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_EMIT_POP_STACKTOP);
HCL_ASSERT (HCL_IS_NIL(hcl, cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_STACKTOP);
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand));
n = emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP);
@ -1822,8 +1822,8 @@ static HCL_INLINE int emit_return (hcl_t* hcl)
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_EMIT_RETURN);
HCL_ASSERT (HCL_IS_NIL(hcl, cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_RETURN);
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand));
n = emit_byte_instruction (hcl, HCL_CODE_RETURN_FROM_BLOCK);
@ -1836,7 +1836,7 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_EMIT_SET);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SET);
if (cf->u.set.var_type == VAR_NAMED)
@ -1844,7 +1844,7 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
hcl_oow_t index;
hcl_oop_t cons;
HCL_ASSERT (HCL_IS_SYMBOL(hcl, cf->operand));
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, cf->operand));
cons = (hcl_oop_t)hcl_getatsysdic (hcl, cf->operand);
if (!cons)
@ -1859,8 +1859,8 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
else
{
hcl_oow_t index;
HCL_ASSERT (cf->u.set.var_type == VAR_INDEXED);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->u.set.var_type == VAR_INDEXED);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
index = (hcl_oow_t)HCL_OOP_TO_SMOOI(cf->operand);
if (emit_indexed_variable_access (hcl, index, HCL_CODE_STORE_INTO_CTXTEMPVAR_0, HCL_CODE_STORE_INTO_TEMPVAR_0) <= -1) return -1;
@ -1877,13 +1877,13 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
{
hcl_oow_t saved_bc_len, saved_lit_len;
HCL_ASSERT (GET_TOP_CFRAME_INDEX(hcl) < 0);
HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0);
saved_bc_len = hcl->code.bc.len;
saved_lit_len = hcl->code.lit.len;
HCL_ASSERT (hcl->c->tv.size == 0);
HCL_ASSERT (hcl->c->blk.depth == -1);
HCL_ASSERT (hcl, hcl->c->tv.size == 0);
HCL_ASSERT (hcl, hcl->c->blk.depth == -1);
/* TODO: in case i implement all global variables as block arguments at the top level... */
hcl->c->blk.depth++;
@ -1964,7 +1964,7 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
default:
HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode);
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
goto oops;
}
}
@ -1973,9 +1973,9 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
/* TODO: for interactive use, this value must be accessible by the executor... how to do it? */
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) goto oops;
HCL_ASSERT (GET_TOP_CFRAME_INDEX(hcl) < 0);
HCL_ASSERT (hcl->c->tv.size == 0);
HCL_ASSERT (hcl->c->blk.depth == 0);
HCL_ASSERT (hcl, GET_TOP_CFRAME_INDEX(hcl) < 0);
HCL_ASSERT (hcl, hcl->c->tv.size == 0);
HCL_ASSERT (hcl, hcl->c->blk.depth == 0);
hcl->c->blk.depth--;
return 0;

12
lib/decode.c
View File

@ -56,9 +56,9 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end)
/* the instruction at the offset 'end' is not decoded.
* decoding offset range is from start to end - 1. */
HCL_ASSERT (start >= 0 && end >= 0);
HCL_ASSERT (hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */
HCL_ASSERT (end <= hcl->code.bc.len); /* not harmful though this fails */
HCL_ASSERT (hcl, start >= 0 && end >= 0);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */
HCL_ASSERT (hcl, end <= hcl->code.bc.len); /* not harmful though this fails */
ip = start;
cdptr = ((hcl_oop_byte_t)hcl->code.bc.arr)->slot;
@ -513,8 +513,8 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end)
LOG_INST_2 (hcl, "make_block %zu %zu", b1, b2);
HCL_ASSERT (b1 >= 0);
HCL_ASSERT (b2 >= b1);
HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
break;
case BCODE_SEND_BLOCK_COPY:
@ -528,7 +528,7 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end)
default:
LOG_INST_1 (hcl, "UNKNOWN BYTE CODE ENCOUNTERED %x", (int)bcode);
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
break;
}
}

54
lib/dic.c
View File

@ -54,7 +54,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
if (inc_max > 0) inc = inc_max;
else
{
hcl->errnum = HCL_EOOMEM;
hcl_seterrnum (hcl, HCL_EOOMEM);
return HCL_NULL;
}
}
@ -71,12 +71,12 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
ass = (hcl_oop_cons_t)oldbuc->slot[--oldsz];
if ((hcl_oop_t)ass != hcl->_nil)
{
HCL_ASSERT (HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
key = (hcl_oop_char_t)ass->car;
HCL_ASSERT (HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
index = hcl_hashchars(key->slot, HCL_OBJ_GET_SIZE(key)) % newsz;
index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % newsz;
while (newbuc->slot[index] != hcl->_nil) index = (index + 1) % newsz;
newbuc->slot[index] = (hcl_oop_t)ass;
}
@ -94,22 +94,22 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha
/* the system dictionary is not a generic dictionary.
* it accepts only a symbol as a key. */
HCL_ASSERT (HCL_IS_SYMBOL(hcl,key));
HCL_ASSERT (HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (HCL_IS_ARRAY(hcl,dic->bucket));
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (hcl, HCL_IS_ARRAY(hcl,dic->bucket));
index = hcl_hashchars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket);
index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket);
/* find */
while (dic->bucket->slot[index] != hcl->_nil)
{
ass = (hcl_oop_cons_t)dic->bucket->slot[index];
HCL_ASSERT (HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
HCL_ASSERT (HCL_BRANDOF(hcl,ass->car) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,ass->car) == HCL_BRAND_SYMBOL);
if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(ass->car) &&
hcl_equalchars (key->slot, ((hcl_oop_char_t)ass->car)->slot, HCL_OBJ_GET_SIZE(key)))
hcl_equaloochars (key->slot, ((hcl_oop_char_t)ass->car)->slot, HCL_OBJ_GET_SIZE(key)))
{
/* the value of HCL_NULL indicates no insertion or update. */
if (value) ass->cdr = value; /* update */
@ -123,18 +123,18 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha
{
/* when value is HCL_NULL, perform no insertion.
* the value of HCL_NULL indicates no insertion or update. */
hcl->errnum = HCL_ENOENT;
hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL;
}
/* the key is not found. insert it. */
HCL_ASSERT (HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally));
tally = HCL_OOP_TO_SMOOI(dic->tally);
if (tally >= HCL_SMOOI_MAX)
{
/* this built-in dictionary is not allowed to hold more than
* HCL_SMOOI_MAX items for efficiency sake */
hcl->errnum = HCL_EDFULL;
hcl_seterrnum (hcl, HCL_EDFULL);
return HCL_NULL;
}
@ -164,7 +164,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha
dic->bucket = bucket;
/* recalculate the index for the expanded bucket */
index = hcl_hashchars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket);
index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket);
while (dic->bucket->slot[index] != hcl->_nil)
index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket);
@ -177,7 +177,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_cha
/* the current tally must be less than the maximum value. otherwise,
* it overflows after increment below */
HCL_ASSERT (tally < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, tally < HCL_SMOOI_MAX);
dic->tally = HCL_SMOOI_TO_OOP(tally + 1);
dic->bucket->slot[index] = (hcl_oop_t)ass;
@ -197,20 +197,20 @@ static hcl_oop_cons_t lookup (hcl_t* hcl, hcl_oop_set_t dic, const hcl_oocs_t* n
hcl_oow_t index;
hcl_oop_cons_t ass;
HCL_ASSERT (HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (HCL_BRANDOF(hcl,dic->bucket) == HCL_BRAND_ARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,dic->bucket) == HCL_BRAND_ARRAY);
index = hcl_hashchars(name->ptr, name->len) % HCL_OBJ_GET_SIZE(dic->bucket);
index = hcl_hashoochars(name->ptr, name->len) % HCL_OBJ_GET_SIZE(dic->bucket);
while (dic->bucket->slot[index] != hcl->_nil)
{
ass = (hcl_oop_cons_t)dic->bucket->slot[index];
HCL_ASSERT (HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
HCL_ASSERT (HCL_BRANDOF(hcl,ass->car) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,ass) == HCL_BRAND_CONS);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,ass->car) == HCL_BRAND_SYMBOL);
if (name->len == HCL_OBJ_GET_SIZE(ass->car) &&
hcl_equalchars(name->ptr, ((hcl_oop_char_t)ass->car)->slot, name->len))
hcl_equaloochars(name->ptr, ((hcl_oop_char_t)ass->car)->slot, name->len))
{
return ass;
}
@ -219,19 +219,19 @@ static hcl_oop_cons_t lookup (hcl_t* hcl, hcl_oop_set_t dic, const hcl_oocs_t* n
}
/* when value is HCL_NULL, perform no insertion */
hcl->errnum = HCL_ENOENT;
hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL;
}
hcl_oop_cons_t hcl_putatsysdic (hcl_t* hcl, hcl_oop_t key, hcl_oop_t value)
{
HCL_ASSERT (HCL_IS_SYMBOL(hcl,key));
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, value);
}
hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key)
{
HCL_ASSERT (HCL_IS_SYMBOL(hcl,key));
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, HCL_NULL);
}
@ -242,13 +242,13 @@ hcl_oop_cons_t hcl_lookupsysdic (hcl_t* hcl, const hcl_oocs_t* name)
hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_t key, hcl_oop_t value)
{
HCL_ASSERT (HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, value);
}
hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_set_t dic, hcl_oop_t key)
{
HCL_ASSERT (HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,key) == HCL_BRAND_SYMBOL);
return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, HCL_NULL);
}

406
lib/err.c Normal file
View File

@ -0,0 +1,406 @@
/*
* $Id$
*
Copyright (c) 2014-2017 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"
/* BEGIN: GENERATED WITH generr.hcl */
static hcl_ooch_t errstr_0[] = {'n','o',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_1[] = {'g','e','n','e','r','i','c',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_2[] = {'n','o','t',' ','i','m','p','l','e','m','e','n','t','e','d','\0'};
static hcl_ooch_t errstr_3[] = {'s','u','b','s','y','s','t','e','m',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_4[] = {'i','n','t','e','r','n','a','l',' ','e','r','r','o','r',' ','t','h','a','t',' ','s','h','o','u','l','d',' ','n','e','v','e','r',' ','h','a','v','e',' ','h','a','p','p','e','n','e','d','\0'};
static hcl_ooch_t errstr_5[] = {'i','n','s','u','f','f','i','c','i','e','n','t',' ','s','y','s','t','e','m',' ','m','e','m','o','r','y','\0'};
static hcl_ooch_t errstr_6[] = {'i','n','s','u','f','f','i','c','i','e','n','t',' ','o','b','j','e','c','t',' ','m','e','m','o','r','y','\0'};
static hcl_ooch_t errstr_7[] = {'i','n','v','a','l','i','d',' ','c','l','a','s','s','/','t','y','p','e','\0'};
static hcl_ooch_t errstr_8[] = {'i','n','v','a','l','i','d',' ','p','a','r','a','m','e','t','e','r',' ','o','r',' ','a','r','g','u','m','e','n','t','\0'};
static hcl_ooch_t errstr_9[] = {'d','a','t','a',' ','n','o','t',' ','f','o','u','n','d','\0'};
static hcl_ooch_t errstr_10[] = {'e','x','i','s','t','i','n','g','/','d','u','p','l','i','c','a','t','e',' ','d','a','t','a','\0'};
static hcl_ooch_t errstr_11[] = {'b','u','s','y','\0'};
static hcl_ooch_t errstr_12[] = {'a','c','c','e','s','s',' ','d','e','n','i','e','d','\0'};
static hcl_ooch_t errstr_13[] = {'o','p','e','r','a','t','i','o','n',' ','n','o','t',' ','p','e','r','m','i','t','t','e','d','\0'};
static hcl_ooch_t errstr_14[] = {'n','o','t',' ','a',' ','d','i','r','e','c','t','o','r','y','\0'};
static hcl_ooch_t errstr_15[] = {'i','n','t','e','r','r','u','p','t','e','d','\0'};
static hcl_ooch_t errstr_16[] = {'p','i','p','e',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_17[] = {'r','e','s','o','u','r','c','e',' ','t','e','m','p','o','r','a','r','i','l','y',' ','u','n','a','v','a','i','l','a','b','l','e','\0'};
static hcl_ooch_t errstr_18[] = {'b','a','d',' ','s','y','s','t','e','m',' ','h','a','n','d','l','e','\0'};
static hcl_ooch_t errstr_19[] = {'t','o','o',' ','m','a','n','y',' ','f','r','a','m','e','s','\0'};
static hcl_ooch_t errstr_20[] = {'m','e','s','s','a','g','e',' ','r','e','c','e','i','v','e','r',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_21[] = {'m','e','s','s','a','g','e',' ','s','e','n','d','i','n','g',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_22[] = {'w','r','o','n','g',' ','n','u','m','b','e','r',' ','o','f',' ','a','r','g','u','m','e','n','t','s','\0'};
static hcl_ooch_t errstr_23[] = {'r','a','n','g','e',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_24[] = {'b','y','t','e','-','c','o','d','e',' ','f','u','l','l','\0'};
static hcl_ooch_t errstr_25[] = {'d','i','c','t','i','o','n','a','r','y',' ','f','u','l','l','\0'};
static hcl_ooch_t errstr_26[] = {'n','o',' ','m','o','r','e',' ','i','n','t','u','t','\0'};
static hcl_ooch_t errstr_27[] = {'t','o','o',' ','m','a','n','y',' ','p','a','r','a','m','e','t','e','r','s','\0'};
static hcl_ooch_t errstr_28[] = {'*','*','*',' ','u','n','d','e','f','i','n','e','d',' ','e','r','r','o','r',' ','*','*','*','\0'};
static hcl_ooch_t errstr_29[] = {'d','i','v','i','d','e',' ','b','y',' ','z','e','r','o','\0'};
static hcl_ooch_t errstr_30[] = {'I','/','O',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_31[] = {'e','n','c','o','d','i','n','g',' ','c','o','n','v','e','r','s','i','o','n',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_32[] = {'b','u','f','f','e','r',' ','f','u','l','l','\0'};
static hcl_ooch_t* errstr[] =
{
errstr_0, errstr_1, errstr_2, errstr_3, errstr_4, errstr_5, errstr_6, errstr_7,
errstr_8, errstr_9, errstr_10, errstr_11, errstr_12, errstr_13, errstr_14, errstr_15,
errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23,
errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31,
errstr_32
};
#if defined(HCL_INCLUDE_COMPILER)
static hcl_ooch_t synerrstr_0[] = {'n','o',' ','e','r','r','o','r','\0'};
static hcl_ooch_t synerrstr_1[] = {'i','l','l','e','g','a','l',' ','c','h','a','r','a','c','t','e','r','\0'};
static hcl_ooch_t synerrstr_2[] = {'c','o','m','m','e','n','t',' ','n','o','t',' ','c','l','o','s','e','d','\0'};
static hcl_ooch_t synerrstr_3[] = {'s','t','r','i','n','g',' ','n','o','t',' ','c','l','o','s','e','d','\0'};
static hcl_ooch_t synerrstr_4[] = {'n','o',' ','c','h','a','r','a','c','t','e','r',' ','a','f','t','e','r',' ','$','\0'};
static hcl_ooch_t synerrstr_5[] = {'n','o',' ','v','a','l','i','d',' ','c','h','a','r','a','c','t','e','r',' ','a','f','t','e','r',' ','#','\0'};
static hcl_ooch_t synerrstr_6[] = {'w','r','o','n','g',' ','c','h','a','r','a','c','t','e','r',' ','l','i','t','e','r','a','l','\0'};
static hcl_ooch_t synerrstr_7[] = {'c','o','l','o','n',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_8[] = {'s','t','r','i','n','g',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_9[] = {'i','n','v','a','l','i','d',' ','r','a','d','i','x','\0'};
static hcl_ooch_t synerrstr_10[] = {'i','n','v','a','l','i','d',' ','n','u','m','e','r','i','c',' ','l','i','t','e','r','a','l','\0'};
static hcl_ooch_t synerrstr_11[] = {'b','y','t','e',' ','t','o','o',' ','s','m','a','l','l',' ','o','r',' ','t','o','o',' ','l','a','r','g','e','\0'};
static hcl_ooch_t synerrstr_12[] = {'w','r','o','n','g',' ','e','r','r','o','r',' ','l','i','t','e','r','a','l','\0'};
static hcl_ooch_t synerrstr_13[] = {'{',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_14[] = {'}',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_15[] = {'(',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_16[] = {')',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_17[] = {']',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_18[] = {'.',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_19[] = {',',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_20[] = {'|',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_21[] = {'>',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_22[] = {':','=',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_23[] = {'i','d','e','n','t','i','f','i','e','r',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_24[] = {'i','n','t','e','g','e','r',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_25[] = {'p','r','i','m','i','t','i','v','e',':',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_26[] = {'w','r','o','n','g',' ','d','i','r','e','c','t','i','v','e','\0'};
static hcl_ooch_t synerrstr_27[] = {'u','n','d','e','f','i','n','e','d',' ','c','l','a','s','s','\0'};
static hcl_ooch_t synerrstr_28[] = {'d','u','p','l','i','c','a','t','e',' ','c','l','a','s','s','\0'};
static hcl_ooch_t synerrstr_29[] = {'c','o','n','t','r','a','d','i','c','t','o','r','y',' ','c','l','a','s','s',' ','d','e','f','i','n','i','t','i','o','n','\0'};
static hcl_ooch_t synerrstr_30[] = {'w','r','o','n','g',' ','c','l','a','s','s',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_31[] = {'i','n','v','a','l','i','d',' ','n','o','n','-','p','o','i','n','t','e','r',' ','i','n','s','t','a','n','c','e',' ','s','i','z','e','\0'};
static hcl_ooch_t synerrstr_32[] = {'p','r','o','h','i','b','i','t','e','d',' ','i','n','h','e','r','i','t','a','n','c','e','\0'};
static hcl_ooch_t synerrstr_33[] = {'v','a','r','i','a','b','l','e',' ','d','e','c','l','a','r','a','t','i','o','n',' ','n','o','t',' ','a','l','l','o','w','e','d','\0'};
static hcl_ooch_t synerrstr_34[] = {'m','o','d','i','f','i','e','r',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_35[] = {'w','r','o','n','g',' ','m','o','d','i','f','i','e','r','\0'};
static hcl_ooch_t synerrstr_36[] = {'d','i','s','a','l','l','o','w','e','d',' ','m','o','d','i','f','i','e','r','\0'};
static hcl_ooch_t synerrstr_37[] = {'d','u','p','l','i','c','a','t','e',' ','m','o','d','i','f','i','e','r','\0'};
static hcl_ooch_t synerrstr_38[] = {'m','e','t','h','o','d',' ','n','a','m','e',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_39[] = {'d','u','p','l','i','c','a','t','e',' ','m','e','t','h','o','d',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_40[] = {'i','n','v','a','l','i','d',' ','v','a','r','i','a','d','i','c',' ','m','e','t','h','o','d',' ','d','e','f','i','n','i','t','i','o','n','\0'};
static hcl_ooch_t synerrstr_41[] = {'v','a','r','i','a','b','l','e',' ','n','a','m','e',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_42[] = {'d','u','p','l','i','c','a','t','e',' ','a','r','g','u','m','e','n','t',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_43[] = {'d','u','p','l','i','c','a','t','e',' ','t','e','m','p','o','r','a','r','y',' ','v','a','r','i','a','b','l','e',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_44[] = {'d','u','p','l','i','c','a','t','e',' ','v','a','r','i','a','b','l','e',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_45[] = {'d','u','p','l','i','c','a','t','e',' ','b','l','o','c','k',' ','a','r','g','u','m','e','n','t',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_46[] = {'u','n','d','e','c','l','a','r','e','d',' ','v','a','r','i','a','b','l','e','\0'};
static hcl_ooch_t synerrstr_47[] = {'u','n','u','s','a','b','l','e',' ','v','a','r','i','a','b','l','e',' ','i','n',' ','c','o','m','p','i','l','e','d',' ','c','o','d','e','\0'};
static hcl_ooch_t synerrstr_48[] = {'i','n','a','c','c','e','s','s','i','b','l','e',' ','v','a','r','i','a','b','l','e','\0'};
static hcl_ooch_t synerrstr_49[] = {'a','m','b','i','g','u','o','u','s',' ','v','a','r','i','a','b','l','e','\0'};
static hcl_ooch_t synerrstr_50[] = {'t','o','o',' ','m','a','n','y',' ','i','n','s','t','a','n','c','e','/','c','l','a','s','s',' ','v','a','r','i','a','b','l','e','s','\0'};
static hcl_ooch_t synerrstr_51[] = {'i','n','a','c','c','e','s','s','i','b','l','e',' ','s','e','l','f','\0'};
static hcl_ooch_t synerrstr_52[] = {'w','r','o','n','g',' ','e','x','p','r','e','s','s','i','o','n',' ','p','r','i','m','a','r','y','\0'};
static hcl_ooch_t synerrstr_53[] = {'t','o','o',' ','m','a','n','y',' ','t','e','m','p','o','r','a','r','i','e','s','\0'};
static hcl_ooch_t synerrstr_54[] = {'t','o','o',' ','m','a','n','y',' ','a','r','g','u','m','e','n','t','s','\0'};
static hcl_ooch_t synerrstr_55[] = {'t','o','o',' ','m','a','n','y',' ','b','l','o','c','k',' ','t','e','m','p','o','r','a','r','i','e','s','\0'};
static hcl_ooch_t synerrstr_56[] = {'t','o','o',' ','m','a','n','y',' ','b','l','o','c','k',' ','a','r','g','u','m','e','n','t','s','\0'};
static hcl_ooch_t synerrstr_57[] = {'t','o','o',' ','l','a','r','g','e',' ','b','l','o','c','k','\0'};
static hcl_ooch_t synerrstr_58[] = {'t','o','o',' ','l','a','r','g','e',' ','a','r','r','a','y',' ','e','x','p','r','e','s','s','i','o','n','\0'};
static hcl_ooch_t synerrstr_59[] = {'w','r','o','n','g',' ','p','r','i','m','i','t','i','v','e',' ','f','u','n','c','t','i','o','n',' ','n','u','m','b','e','r','\0'};
static hcl_ooch_t synerrstr_60[] = {'w','r','o','n','g',' ','p','r','i','m','i','t','i','v','e',' ','f','u','n','c','t','i','o','n',' ','i','d','e','n','t','i','f','i','e','r','\0'};
static hcl_ooch_t synerrstr_61[] = {'w','r','o','n','g',' ','p','r','i','m','i','t','i','v','e',' ','f','u','n','c','t','i','o','n',' ','a','r','g','u','m','e','n','t',' ','d','e','f','i','n','i','t','i','o','n','\0'};
static hcl_ooch_t synerrstr_62[] = {'w','r','o','n','g',' ','m','o','d','u','l','e',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_63[] = {'f','a','i','l','e','d',' ','t','o',' ','i','m','p','o','r','t',' ','m','o','d','u','l','e','\0'};
static hcl_ooch_t synerrstr_64[] = {'#','i','n','c','l','u','d','e',' ','e','r','r','o','r','\0'};
static hcl_ooch_t synerrstr_65[] = {'w','r','o','n','g',' ','p','r','a','g','m','a',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_66[] = {'w','r','o','n','g',' ','n','a','m','e','s','p','a','c','e',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_67[] = {'w','r','o','n','g',' ','p','o','o','l',' ','d','i','c','t','i','o','n','a','r','y',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_68[] = {'d','u','p','l','i','c','a','t','e',' ','p','o','o','l',' ','d','i','c','t','i','o','n','a','r','y',' ','n','a','m','e','\0'};
static hcl_ooch_t synerrstr_69[] = {'l','i','t','e','r','a','l',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t synerrstr_70[] = {'b','r','e','a','k',' ','o','r',' ','c','o','n','t','i','n','u','e',' ','n','o','t',' ','w','i','t','h','i','n',' ','a',' ','l','o','o','p','\0'};
static hcl_ooch_t synerrstr_71[] = {'b','r','e','a','k',' ','o','r',' ','c','o','n','t','i','n','u','e',' ','w','i','t','h','i','n',' ','a',' ','b','l','o','c','k','\0'};
static hcl_ooch_t synerrstr_72[] = {'w','h','i','l','e',' ','e','x','p','e','c','t','e','d','\0'};
static hcl_ooch_t* synerrstr[] =
{
synerrstr_0, synerrstr_1, synerrstr_2, synerrstr_3, synerrstr_4, synerrstr_5, synerrstr_6, synerrstr_7,
synerrstr_8, synerrstr_9, synerrstr_10, synerrstr_11, synerrstr_12, synerrstr_13, synerrstr_14, synerrstr_15,
synerrstr_16, synerrstr_17, synerrstr_18, synerrstr_19, synerrstr_20, synerrstr_21, synerrstr_22, synerrstr_23,
synerrstr_24, synerrstr_25, synerrstr_26, synerrstr_27, synerrstr_28, synerrstr_29, synerrstr_30, synerrstr_31,
synerrstr_32, synerrstr_33, synerrstr_34, synerrstr_35, synerrstr_36, synerrstr_37, synerrstr_38, synerrstr_39,
synerrstr_40, synerrstr_41, synerrstr_42, synerrstr_43, synerrstr_44, synerrstr_45, synerrstr_46, synerrstr_47,
synerrstr_48, synerrstr_49, synerrstr_50, synerrstr_51, synerrstr_52, synerrstr_53, synerrstr_54, synerrstr_55,
synerrstr_56, synerrstr_57, synerrstr_58, synerrstr_59, synerrstr_60, synerrstr_61, synerrstr_62, synerrstr_63,
synerrstr_64, synerrstr_65, synerrstr_66, synerrstr_67, synerrstr_68, synerrstr_69, synerrstr_70, synerrstr_71,
synerrstr_72
};
#endif
/* END: GENERATED WITH generr.hcl */
/* --------------------------------------------------------------------------
* ERROR NUMBER TO STRING CONVERSION
* -------------------------------------------------------------------------- */
const hcl_ooch_t* hcl_errnum_to_errstr (hcl_errnum_t errnum)
{
static hcl_ooch_t e_unknown[] = {'u','n','k','n','o','w','n',' ','e','r','r','o','r','\0'};
return (errnum >= 0 && errnum < HCL_COUNTOF(errstr))? errstr[errnum]: e_unknown;
}
#if defined(HCL_INCLUDE_COMPILER)
const hcl_ooch_t* hcl_synerrnum_to_errstr (hcl_synerrnum_t errnum)
{
static hcl_ooch_t e_unknown[] = {'u','n','k','n','o','w','n',' ','e','r','r','o','r','\0'};
return (errnum >= 0 && errnum < HCL_COUNTOF(synerrstr))? synerrstr[errnum]: e_unknown;
}
#endif
/* --------------------------------------------------------------------------
* SYSTEM DEPENDENT FUNCTIONS
* -------------------------------------------------------------------------- */
#if defined(HAVE_EXECINFO_H)
# include <execinfo.h>
# include <stdlib.h>
#endif
#if defined(_WIN32)
# include <windows.h>
#elif defined(__OS2__)
# define INCL_DOSPROCESS
# define INCL_DOSFILEMGR
# define INCL_DOSERRORS
# include <os2.h>
#elif defined(__DOS__)
# include <dos.h>
# if defined(_INTELC32_)
# define DOS_EXIT 0x4C
# else
# include <dosfunc.h>
# endif
# include <errno.h>
#elif defined(vms) || defined(__vms)
# define __NEW_STARLET 1
# include <starlet.h> /* (SYS$...) */
# include <ssdef.h> /* (SS$...) */
# include <lib$routines.h> /* (lib$...) */
#elif defined(macintosh)
# include <MacErrors.h>
# include <Process.h>
# include <Dialogs.h>
# include <TextUtils.h>
#else
# include <sys/types.h>
# include <unistd.h>
# include <signal.h>
# include <errno.h>
#endif
hcl_errnum_t hcl_syserr_to_errnum (int e)
{
#if defined(__OS2__)
/* APIRET e */
switch (e)
{
case ERROR_NOT_ENOUGH_MEMORY: return HCL_ESYSMEM;
case ERROR_INVALID_PARAMETER:
case ERROR_INVALID_HANDLE:
case ERROR_INVALID_NAME: return HCL_EINVAL;
case ERROR_ACCESS_DENIED:
case ERROR_SHARING_VIOLATION: return HCL_EACCES;
case ERROR_FILE_NOT_FOUND:
case ERROR_PATH_NOT_FOUND: return HCL_ENOENT;
case ERROR_ALREADY_EXISTS: return HCL_EEXIST;
/*TODO: add more mappings */
default: return HCL_ESYSERR;
}
#elif defined(macintosh)
switch (e)
{
case notEnoughMemoryErr: return HCL_ESYSMEM;
case paramErr: return HCL_EINVAL;
case qErr: /* queue element not found during deletion */
case fnfErr: /* file not found */
case dirNFErr: /* direcotry not found */
case resNotFound: /* resource not found */
case resFNotFound: /* resource file not found */
case nbpNotFound: /* name not found on remove */
return HCL_ENOENT;
/*TODO: add more mappings */
default: return HCL_ESYSERR;
}
#else
switch (e)
{
case ENOMEM: return HCL_ESYSMEM;
case EINVAL: return HCL_EINVAL;
#if defined(EBUSY)
case EBUSY: return HCL_EBUSY;
#endif
case EACCES: return HCL_EACCES;
#if defined(EPERM)
case EPERM: return HCL_EPERM;
#endif
#if defined(ENOTDIR)
case ENOTDIR: return HCL_ENOTDIR;
#endif
case ENOENT: return HCL_ENOENT;
#if defined(EEXIST)
case EEXIST: return HCL_EEXIST;
#endif
#if defined(EINTR)
case EINTR: return HCL_EINTR;
#endif
#if defined(EPIPE)
case EPIPE: return HCL_EPIPE;
#endif
#if defined(EAGAIN) && defined(EWOULDBLOCK) && (EAGAIN != EWOULDBLOCK)
case EAGAIN:
case EWOULDBLOCK: return HCL_EAGAIN;
#elif defined(EAGAIN)
case EAGAIN: return HCL_EAGAIN;
#elif defined(EWOULDBLOCK)
case EWOULDBLOCK: return HCL_EAGAIN;
#endif
#if defined(EBADF)
case EBADF: return HCL_EBADHND;
#endif
#if defined(EIO)
case EIO: return HCL_EIOERR;
#endif
default: return HCL_ESYSERR;
}
#endif
}
/* --------------------------------------------------------------------------
* ERROR NUMBER/MESSAGE HANDLING
* -------------------------------------------------------------------------- */
const hcl_ooch_t* hcl_geterrstr (hcl_t* hcl)
{
return hcl_errnum_to_errstr (hcl->errnum);
}
const hcl_ooch_t* hcl_geterrmsg (hcl_t* hcl)
{
if (hcl->errmsg.len <= 0) return hcl_errnum_to_errstr (hcl->errnum);
return hcl->errmsg.buf;
}
const hcl_ooch_t* hcl_backuperrmsg (hcl_t* hcl)
{
hcl_copyoocstr (hcl->errmsg.tmpbuf.ooch, HCL_COUNTOF(hcl->errmsg.tmpbuf.ooch), hcl->errmsg.buf);
return hcl->errmsg.tmpbuf.ooch;
}
void hcl_seterrwithsyserr (hcl_t* hcl, int syserr)
{
if (hcl->vmprim.syserrstrb)
{
hcl->vmprim.syserrstrb (hcl, syserr, hcl->errmsg.tmpbuf.bch, HCL_COUNTOF(hcl->errmsg.tmpbuf.bch));
hcl_seterrbfmt (hcl, hcl_syserr_to_errnum(syserr), "%hs", hcl->errmsg.tmpbuf.bch);
}
else
{
HCL_ASSERT (hcl, hcl->vmprim.syserrstru != HCL_NULL);
hcl->vmprim.syserrstru (hcl, syserr, hcl->errmsg.tmpbuf.uch, HCL_COUNTOF(hcl->errmsg.tmpbuf.uch));
hcl_seterrbfmt (hcl, hcl_syserr_to_errnum(syserr), "%ls", hcl->errmsg.tmpbuf.uch);
}
}
/* --------------------------------------------------------------------------
* ASSERTION FAILURE HANDLERsemaphore heap full
* -------------------------------------------------------------------------- */
void hcl_assertfailed (hcl_t* hcl, const hcl_bch_t* expr, const hcl_bch_t* file, hcl_oow_t line)
{
#if defined(HAVE_BACKTRACE)
void* btarray[128];
hcl_oow_t btsize;
char** btsyms;
#endif
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_FATAL, "ASSERTION FAILURE: %s at %s:%zu\n", expr, file, line);
#if defined(HAVE_BACKTRACE)
btsize = backtrace (btarray, HCL_COUNTOF(btarray));
btsyms = backtrace_symbols (btarray, btsize);
if (btsyms)
{
hcl_oow_t i;
hcl_logbfmt (hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, "[BACKTRACE]\n");
for (i = 0; i < btsize; i++)
{
hcl_logbfmt(hcl, HCL_LOG_UNTYPED | HCL_LOG_DEBUG, " %s\n", btsyms[i]);
}
free (btsyms);
}
#endif
#if defined(_WIN32)
ExitProcess (249);
#elif defined(__OS2__)
DosExit (EXIT_PROCESS, 249);
#elif defined(__DOS__)
{
union REGS regs;
regs.h.ah = DOS_EXIT;
regs.h.al = 249;
intdos (&regs, &regs);
}
#elif defined(vms) || defined(__vms)
lib$stop (SS$_ABORT); /* use SS$_OPCCUS instead? */
/* this won't be reached since lib$stop() terminates the process */
sys$exit (SS$_ABORT); /* this condition code can be shown with
* 'show symbol $status' from the command-line. */
#elif defined(macintosh)
ExitToShell ();
#else
kill (getpid(), SIGABRT);
_exit (1);
#endif
}

189
lib/exec.c
View File

@ -269,7 +269,7 @@ static void vm_cleanup (hcl_t* hcl)
static HCL_INLINE hcl_oop_t make_context (hcl_t* hcl, hcl_ooi_t ntmprs)
{
HCL_ASSERT (ntmprs >= 0);
HCL_ASSERT (hcl, ntmprs >= 0);
return hcl_allocoopobj (hcl, HCL_BRAND_CONTEXT, HCL_CONTEXT_NAMED_INSTVARS + (hcl_oow_t)ntmprs);
}
@ -292,7 +292,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
proc->current_context = c;
proc->sp = HCL_SMOOI_TO_OOP(-1);
HCL_ASSERT ((hcl_oop_t)c->sender == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)c->sender == hcl->_nil);
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - made process %O of size %zu\n", proc, HCL_OBJ_GET_SIZE(proc));
@ -310,7 +310,7 @@ static HCL_INLINE void sleep_active_process (hcl_t* hcl, int state)
/* store the current active context to the current process.
* it is the suspended context of the process to be suspended */
HCL_ASSERT (hcl->processor->active != hcl->nil_process);
HCL_ASSERT (hcl, hcl->processor->active != hcl->nil_process);
hcl->processor->active->current_context = hcl->active_context;
hcl->processor->active->state = HCL_SMOOI_TO_OOP(state);
}
@ -334,10 +334,10 @@ static HCL_INLINE void wake_new_process (hcl_t* hcl, hcl_oop_process_t proc)
static void switch_to_process (hcl_t* hcl, hcl_oop_process_t proc, int new_state_for_old_active)
{
/* the new process must not be the currently active process */
HCL_ASSERT (hcl->processor->active != proc);
HCL_ASSERT (hcl, hcl->processor->active != proc);
/* the new process must be in the runnable state */
HCL_ASSERT (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) ||
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_WAITING));
sleep_active_process (hcl, new_state_for_old_active);
@ -350,7 +350,7 @@ static HCL_INLINE hcl_oop_process_t find_next_runnable_process (hcl_t* hcl)
{
hcl_oop_process_t npr;
HCL_ASSERT (hcl->processor->active->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING));
HCL_ASSERT (hcl, hcl->processor->active->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING));
npr = hcl->processor->active->next;
if ((hcl_oop_t)npr == hcl->_nil) npr = hcl->processor->runnable_head;
return npr;
@ -370,20 +370,20 @@ static HCL_INLINE int chain_into_processor (hcl_t* hcl, hcl_oop_process_t proc)
* link it to the processor's process list. */
hcl_ooi_t tally;
HCL_ASSERT ((hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT ((hcl_oop_t)proc->next == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->next == hcl->_nil);
HCL_ASSERT (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED));
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED));
tally = HCL_OOP_TO_SMOOI(hcl->processor->tally);
HCL_ASSERT (tally >= 0);
HCL_ASSERT (hcl, tally >= 0);
if (tally >= HCL_SMOOI_MAX)
{
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_FATAL, "Processor - too many process\n");
#endif
hcl->errnum = HCL_EPFULL;
hcl_seterrnum (hcl, HCL_EPFULL);
return -1;
}
@ -411,11 +411,11 @@ static HCL_INLINE void unchain_from_processor (hcl_t* hcl, hcl_oop_process_t pro
/* the processor's process chain must be composed of running/runnable
* processes only */
HCL_ASSERT (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING) ||
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNING) ||
proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
tally = HCL_OOP_TO_SMOOI(hcl->processor->tally);
HCL_ASSERT (tally > 0);
HCL_ASSERT (hcl, tally > 0);
if ((hcl_oop_t)proc->prev != hcl->_nil) proc->prev->next = proc->next;
else hcl->processor->runnable_head = proc->next;
@ -435,13 +435,13 @@ static HCL_INLINE void chain_into_semaphore (hcl_t* hcl, hcl_oop_process_t proc,
{
/* append a process to the process list of a semaphore*/
HCL_ASSERT ((hcl_oop_t)proc->sem == hcl->_nil);
HCL_ASSERT ((hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT ((hcl_oop_t)proc->next == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->sem == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->next == hcl->_nil);
if ((hcl_oop_t)sem->waiting_head == hcl->_nil)
{
HCL_ASSERT ((hcl_oop_t)sem->waiting_tail == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)sem->waiting_tail == hcl->_nil);
sem->waiting_head = proc;
}
else
@ -458,7 +458,7 @@ static HCL_INLINE void unchain_from_semaphore (hcl_t* hcl, hcl_oop_process_t pro
{
hcl_oop_semaphore_t sem;
HCL_ASSERT ((hcl_oop_t)proc->sem != hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->sem != hcl->_nil);
sem = proc->sem;
if ((hcl_oop_t)proc->prev != hcl->_nil) proc->prev->next = proc->next;
@ -495,12 +495,12 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
/* a runnable or running process must not be chanined to the
* process list of a semaphore */
HCL_ASSERT ((hcl_oop_t)proc->sem == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->sem == hcl->_nil);
if (nrp == proc)
{
/* no runnable process after termination */
HCL_ASSERT (hcl->processor->active == hcl->nil_process);
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "No runnable process after process termination\n");
}
else
@ -541,8 +541,8 @@ static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED))
{
/* SUSPENED ---> RUNNING */
HCL_ASSERT ((hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT ((hcl_oop_t)proc->next == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->prev == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)proc->next == hcl->_nil);
#if defined(HCL_DEBUG_VM_PROCESSOR)
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "Processor - process %O SUSPENDED->RUNNING\n", proc);
@ -560,7 +560,7 @@ static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
{
/* RUNNABLE ---> RUNNING */
/* TODO: should i allow this? */
HCL_ASSERT (hcl->processor->active != proc);
HCL_ASSERT (hcl, hcl->processor->active != proc);
switch_to_process (hcl, proc, PROC_STATE_RUNNABLE);
}
#endif
@ -592,7 +592,7 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
/* the last running/runnable process has been unchained
* from the processor and set to SUSPENDED. the active
* process must be the nil process */
HCL_ASSERT (hcl->processor->active == hcl->nil_process);
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
}
else
{
@ -603,7 +603,7 @@ static void suspend_process (hcl_t* hcl, hcl_oop_process_t proc)
* untouched unless the unchained process is the last
* running/runnable process. so calling switch_to_process()
* which expects the active process to be valid is safe */
HCL_ASSERT (hcl->processor->active != hcl->nil_process);
HCL_ASSERT (hcl, hcl->processor->active != hcl->nil_process);
switch_to_process (hcl, nrp, PROC_STATE_SUSPENDED);
}
}
@ -622,7 +622,7 @@ static void yield_process (hcl_t* hcl, hcl_oop_process_t proc)
hcl_oop_process_t nrp;
HCL_ASSERT (proc == hcl->processor->active);
HCL_ASSERT (hcl, proc == hcl->processor->active);
nrp = find_next_runnable_process (hcl);
/* if there are more than 1 runnable processes, the next
@ -639,9 +639,10 @@ static void yield_process (hcl_t* hcl, hcl_oop_process_t proc)
static int async_signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem)
{
#if 0
if (hcl->sem_list_count >= SEM_LIST_MAX)
{
hcl->errnum = HCL_ESLFULL;
hcl_seterrnum (hcl, HCL_ESLFULL);
return -1;
}
@ -660,6 +661,7 @@ static int async_signal_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem)
hcl->sem_list[hcl->sem_list_count] = sem;
hcl->sem_list_count++;
#endif
return 0;
}
@ -715,9 +717,9 @@ static void await_semaphore (hcl_t* hcl, hcl_oop_semaphore_t sem)
/* link the suspended process to the semaphore's process list */
chain_into_semaphore (hcl, proc, sem);
HCL_ASSERT (sem->waiting_tail == proc);
HCL_ASSERT (hcl, sem->waiting_tail == proc);
HCL_ASSERT (hcl->processor->active != proc);
HCL_ASSERT (hcl, hcl->processor->active != proc);
}
}
@ -797,9 +799,10 @@ static int add_to_sem_heap (hcl_t* hcl, hcl_oop_semaphore_t sem)
{
hcl_ooi_t index;
#if 0
if (hcl->sem_heap_count >= SEM_HEAP_MAX)
{
hcl->errnum = HCL_ESHFULL;
hcl_seterrnum (hcl, HCL_ESHFULL);
return -1;
}
@ -818,7 +821,7 @@ static int add_to_sem_heap (hcl_t* hcl, hcl_oop_semaphore_t sem)
hcl->sem_heap_capa = new_capa;
}
HCL_ASSERT (hcl->sem_heap_count <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, hcl->sem_heap_count <= HCL_SMOOI_MAX);
index = hcl->sem_heap_count;
hcl->sem_heap[index] = sem;
@ -826,6 +829,7 @@ static int add_to_sem_heap (hcl_t* hcl, hcl_oop_semaphore_t sem)
hcl->sem_heap_count++;
sift_up_sem_heap (hcl, index);
#endif
return 0;
}
@ -889,27 +893,27 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
*/
/* the receiver must be a block context */
HCL_ASSERT (HCL_IS_CONTEXT (hcl, rcv_blkctx));
HCL_ASSERT (hcl, HCL_IS_CONTEXT (hcl, rcv_blkctx));
if (rcv_blkctx->receiver_or_source != hcl->_nil)
{
/* the 'source' field is not nil.
* this block context has already been activated once.
* you can't send 'value' again to reactivate it.
* For example, [thisContext value] value. */
HCL_ASSERT (HCL_OBJ_GET_SIZE(rcv_blkctx) > HCL_CONTEXT_NAMED_INSTVARS);
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv_blkctx) > HCL_CONTEXT_NAMED_INSTVARS);
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
"Error - re-valuing of a block context - %O\n", rcv_blkctx);
hcl->errnum = HCL_ERECALL;
hcl_seterrnum (hcl, HCL_ERECALL);
return -1;
}
HCL_ASSERT (HCL_OBJ_GET_SIZE(rcv_blkctx) == HCL_CONTEXT_NAMED_INSTVARS);
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv_blkctx) == HCL_CONTEXT_NAMED_INSTVARS);
if (HCL_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs) != nargs)
{
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
"Error - wrong number of arguments to a block context %O - expecting %zd, got %zd\n",
rcv_blkctx, HCL_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs), nargs);
hcl->errnum = HCL_ECALLARG;
hcl_seterrnum (hcl, HCL_ECALLARG);
return -1;
}
@ -918,7 +922,7 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
* simple calculation is needed to find the number of local temporaries */
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blkctx->ntmprs) -
HCL_OOP_TO_SMOOI(((hcl_oop_context_t)rcv_blkctx->home)->ntmprs);
HCL_ASSERT (local_ntmprs >= nargs);
HCL_ASSERT (hcl, local_ntmprs >= nargs);
/* create a new block context to clone rcv_blkctx */
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blkctx);
@ -950,7 +954,7 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
HCL_ASSERT (blkctx->home != hcl->_nil);
HCL_ASSERT (hcl, blkctx->home != hcl->_nil);
blkctx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
blkctx->sender = hcl->active_context;
@ -964,7 +968,7 @@ static HCL_INLINE int activate_context (hcl_t* hcl, hcl_ooi_t nargs)
hcl_oop_context_t rcv, blkctx;
rcv = (hcl_oop_context_t)HCL_STACK_GETRCV(hcl, nargs);
HCL_ASSERT (HCL_IS_CONTEXT (hcl, rcv));
HCL_ASSERT (hcl, HCL_IS_CONTEXT (hcl, rcv));
x = __activate_context (hcl, rcv, nargs, &blkctx);
if (x <= -1) return -1;
@ -979,7 +983,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
hcl_oop_word_t rcv;
rcv = (hcl_oop_word_t)HCL_STACK_GETRCV(hcl, nargs);
HCL_ASSERT (HCL_IS_PRIM (hcl, rcv));
HCL_ASSERT (hcl, HCL_IS_PRIM (hcl, rcv));
if (nargs < rcv->slot[1] && nargs > rcv->slot[2])
{
@ -987,7 +991,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
"Error - wrong number of arguments to a primitive - expecting %zd-%zd, got %zd\n",
rcv->slot[1], rcv->slot[2], nargs);
hcl->errnum = HCL_ECALLARG;
hcl_seterrnum (hcl, HCL_ECALLARG);
return -1;
}
@ -1000,8 +1004,8 @@ static hcl_oop_process_t start_initial_process (hcl_t* hcl, hcl_oop_context_t ct
hcl_oop_process_t proc;
/* there must be no active process when this function is called */
HCL_ASSERT (hcl->processor->tally == HCL_SMOOI_TO_OOP(0));
HCL_ASSERT (hcl->processor->active == hcl->nil_process);
HCL_ASSERT (hcl, hcl->processor->tally == HCL_SMOOI_TO_OOP(0));
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
proc = make_process (hcl, ctx);
if (!proc) return HCL_NULL;
@ -1011,8 +1015,8 @@ static hcl_oop_process_t start_initial_process (hcl_t* hcl, hcl_oop_context_t ct
hcl->processor->active = proc;
/* do something that resume_process() would do with less overhead */
HCL_ASSERT ((hcl_oop_t)proc->current_context != hcl->_nil);
HCL_ASSERT (proc->current_context == proc->initial_context);
HCL_ASSERT (hcl, (hcl_oop_t)proc->current_context != hcl->_nil);
HCL_ASSERT (hcl, proc->current_context == proc->initial_context);
SWITCH_ACTIVE_CONTEXT (hcl, proc->current_context);
return proc;
@ -1049,13 +1053,13 @@ static int start_initial_process_and_context (hcl_t* hcl)
* especially, the fact that the sender field is nil is used by
* the main execution loop for breaking out of the loop */
HCL_ASSERT (hcl->active_context == HCL_NULL);
HCL_ASSERT (hcl, hcl->active_context == HCL_NULL);
/* hcl_gc() uses hcl->processor when hcl->active_context
* is not NULL. at this poinst, hcl->processor should point to
* an instance of ProcessScheduler. */
HCL_ASSERT ((hcl_oop_t)hcl->processor != hcl->_nil);
HCL_ASSERT (hcl->processor->tally == HCL_SMOOI_TO_OOP(0));
HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor != hcl->_nil);
HCL_ASSERT (hcl, hcl->processor->tally == HCL_SMOOI_TO_OOP(0));
/* start_initial_process() calls the SWITCH_ACTIVE_CONTEXT() macro.
* the macro assumes a non-null value in hcl->active_context.
@ -1092,7 +1096,7 @@ static int execute (hcl_t* hcl)
hcl_ooi_t fetched_instruction_pointer;
#endif
HCL_ASSERT (hcl->active_context != HCL_NULL);
HCL_ASSERT (hcl, hcl->active_context != HCL_NULL);
vm_startup (hcl);
hcl->proc_switched = 0;
@ -1106,8 +1110,8 @@ static int execute (hcl_t* hcl)
do
{
HCL_ASSERT (HCL_OOP_IS_SMOOI(hcl->sem_heap[0]->heap_ftime_sec));
HCL_ASSERT (HCL_OOP_IS_SMOOI(hcl->sem_heap[0]->heap_ftime_nsec));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(hcl->sem_heap[0]->heap_ftime_sec));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(hcl->sem_heap[0]->heap_ftime_nsec));
HCL_INITNTIME (&ft,
HCL_OOP_TO_SMOOI(hcl->sem_heap[0]->heap_ftime_sec),
@ -1136,8 +1140,8 @@ static int execute (hcl_t* hcl)
* it uses wake_new_process() instead of
* switch_to_process() as there is no running
* process at this moment */
HCL_ASSERT (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (proc == hcl->processor->runnable_head);
HCL_ASSERT (hcl, proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE));
HCL_ASSERT (hcl, proc == hcl->processor->runnable_head);
wake_new_process (hcl, proc);
hcl->proc_switched = 1;
@ -1160,7 +1164,7 @@ static int execute (hcl_t* hcl)
if (hcl->processor->active == hcl->nil_process)
{
/* no more waiting semaphore and no more process */
HCL_ASSERT (hcl->processor->tally = HCL_SMOOI_TO_OOP(0));
HCL_ASSERT (hcl, hcl->processor->tally = HCL_SMOOI_TO_OOP(0));
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_DEBUG, "No more runnable process\n");
#if 0
@ -1230,7 +1234,7 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x7; /* low 3 bits */
push_instvar:
LOG_INST_1 (hcl, "push_instvar %zu", b1);
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_source) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_source) == HCL_OBJ_TYPE_OOP);
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1]);
break;
@ -1250,7 +1254,7 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x7; /* low 3 bits */
store_instvar:
LOG_INST_1 (hcl, "store_into_instvar %zu", b1);
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1] = HCL_STACK_GETTOP(hcl);
break;
@ -1269,7 +1273,7 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x7; /* low 3 bits */
pop_into_instvar:
LOG_INST_1 (hcl, "pop_into_instvar %zu", b1);
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1] = HCL_STACK_GETTOP(hcl);
HCL_STACK_POP (hcl);
break;
@ -1321,7 +1325,7 @@ static int execute (hcl_t* hcl)
* in the relevant method context */
ctx = hcl->active_context->origin;
bx = b1;
HCL_ASSERT (HCL_IS_CONTEXT(hcl, ctx));
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, ctx));
#else
/* otherwise, the index may point to a temporaries
* declared inside a block */
@ -1445,7 +1449,7 @@ static int execute (hcl_t* hcl)
b1 = bcode & 0x3; /* low 2 bits */
handle_object:
ass = (hcl_oop_cons_t)hcl->code.lit.arr->slot[b1];
HCL_ASSERT (HCL_IS_CONS(hcl, ass));
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass));
if ((bcode >> 3) & 1)
{
@ -1575,8 +1579,7 @@ static int execute (hcl_t* hcl)
{
cannot_call:
/* run time error */
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - cannot call %O\n", rcv);
hcl->errnum = HCL_ECALL;
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv);
return -1;
}
break;
@ -1612,7 +1615,7 @@ static int execute (hcl_t* hcl)
handle_ctxtempvar:
ctx = hcl->active_context;
HCL_ASSERT ((hcl_oop_t)ctx != hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)ctx != hcl->_nil);
for (i = 0; i < b1; i++)
{
ctx = (hcl_oop_context_t)ctx->home;
@ -1674,8 +1677,8 @@ static int execute (hcl_t* hcl)
handle_objvar:
t = (hcl_oop_oop_t)hcl->code.lit.arr->slot[b2];
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(t) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (b1 < HCL_OBJ_GET_SIZE(t));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(t) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, b1 < HCL_OBJ_GET_SIZE(t));
if ((bcode >> 3) & 1)
{
@ -1816,7 +1819,7 @@ static int execute (hcl_t* hcl)
{
hcl_oop_t t;
LOG_INST_0 (hcl, "dup_stacktop");
HCL_ASSERT (!HCL_STACK_ISEMPTY(hcl));
HCL_ASSERT (hcl, !HCL_STACK_ISEMPTY(hcl));
t = HCL_STACK_GETTOP(hcl);
HCL_STACK_PUSH (hcl, t);
break;
@ -1824,7 +1827,7 @@ static int execute (hcl_t* hcl)
case HCL_CODE_POP_STACKTOP:
LOG_INST_0 (hcl, "pop_stacktop");
HCL_ASSERT (!HCL_STACK_ISEMPTY(hcl));
HCL_ASSERT (hcl, !HCL_STACK_ISEMPTY(hcl));
HCL_STACK_POP (hcl);
break;
@ -1867,8 +1870,8 @@ static int execute (hcl_t* hcl)
*/
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->processor->active->initial_context) == hcl->_block_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->processor->active->initial_context) == hcl->_block_context);
*/
/* decrement the instruction pointer back to the return instruction.
* even if the context is reentered, it will just return.
@ -1887,7 +1890,7 @@ static int execute (hcl_t* hcl)
{
/* returning from a method */
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
*/
hcl->ip = -1;
}
@ -1897,7 +1900,7 @@ static int execute (hcl_t* hcl)
/* method return from within a block(including a non-local return) */
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context);
*/
ctx = hcl->active_context;
while ((hcl_oop_t)ctx != hcl->_nil)
@ -1925,12 +1928,12 @@ static int execute (hcl_t* hcl)
/* cannot return from a method that has returned already */
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
*/
HCL_ASSERT (hcl->active_context->origin->ip == HCL_SMOOI_TO_OOP(-1));
HCL_ASSERT (hcl, hcl->active_context->origin->ip == HCL_SMOOI_TO_OOP(-1));
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - cannot return from dead context\n");
hcl->errnum = HCL_EINTERN; /* TODO: can i make this error catchable at the hcl level? */
hcl_seterrnum (hcl, HCL_EINTERN); /* TODO: can i make this error catchable at the hcl level? */
return -1;
non_local_return_ok:
@ -1939,7 +1942,7 @@ static int execute (hcl_t* hcl)
}
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
*/
/* restore the stack pointer */
hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp);
@ -1970,14 +1973,14 @@ XXXXX
{
/* the new active context is the fake initial context.
* this context can't get executed further. */
HCL_ASSERT ((hcl_oop_t)hcl->active_context->sender == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
/*
// HCL_ASSERT (HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
*/
HCL_ASSERT (hcl->active_context->receiver_or_source == hcl->_nil);
HCL_ASSERT (hcl->active_context == hcl->processor->active->initial_context);
HCL_ASSERT (hcl->active_context->origin == hcl->processor->active->initial_context->origin);
HCL_ASSERT (hcl->active_context->origin == hcl->active_context);
HCL_ASSERT (hcl, hcl->active_context->receiver_or_source == hcl->_nil);
HCL_ASSERT (hcl, hcl->active_context == hcl->processor->active->initial_context);
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->processor->active->initial_context->origin);
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context);
/* NOTE: this condition is true for the processified block context also.
* hcl->active_context->origin == hcl->processor->active->initial_context->origin
@ -1985,7 +1988,7 @@ XXXXX
* processified block check has been done against the context before switching */
/* the stack contains the final return value so the stack pointer must be 0. */
HCL_ASSERT (hcl->sp == 0);
HCL_ASSERT (hcl, hcl->sp == 0);
if (hcl->option.trait & HCL_AWAIT_PROCS)
terminate_process (hcl, hcl->processor->active);
@ -2015,7 +2018,7 @@ XXXXX
* over a block using the newProcess method. let's terminate
* the process. */
HCL_ASSERT ((hcl_oop_t)hcl->active_context->sender == hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
terminate_process (hcl, hcl->processor->active);
}
else
@ -2051,8 +2054,8 @@ XXXXX
LOG_INST_2 (hcl, "make_block %zu %zu", b1, b2);
HCL_ASSERT (b1 >= 0);
HCL_ASSERT (b2 >= b1);
HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
/* the block context object created here is used as a base
* object for block context activation. activate_context()
@ -2097,18 +2100,18 @@ XXXXX
LOG_INST_0 (hcl, "send_block_copy");
/* it emulates thisContext blockCopy: nargs ofTmprCount: ntmprs */
HCL_ASSERT (hcl->sp >= 2);
HCL_ASSERT (hcl, hcl->sp >= 2);
HCL_ASSERT (HCL_CLASSOF(hcl, HCL_STACK_GETTOP(hcl)) == hcl->_small_integer);
HCL_ASSERT (hcl, HCL_CLASSOF(hcl, HCL_STACK_GETTOP(hcl)) == hcl->_small_integer);
ntmprs = HCL_OOP_TO_SMOOI(HCL_STACK_GETTOP(hcl));
HCL_STACK_POP (hcl);
HCL_ASSERT (HCL_CLASSOF(hcl, HCL_STACK_GETTOP(hcl)) == hcl->_small_integer);
HCL_ASSERT (hcl, HCL_CLASSOF(hcl, HCL_STACK_GETTOP(hcl)) == hcl->_small_integer);
nargs = HCL_OOP_TO_SMOOI(HCL_STACK_GETTOP(hcl));
HCL_STACK_POP (hcl);
HCL_ASSERT (nargs >= 0);
HCL_ASSERT (ntmprs >= nargs);
HCL_ASSERT (hcl, nargs >= 0);
HCL_ASSERT (hcl, ntmprs >= nargs);
/* the block context object created here is used
* as a base object for block context activation.
@ -2122,7 +2125,7 @@ XXXXX
/* get the receiver to the block copy message after block context instantiation
* not to get affected by potential GC */
rctx = (hcl_oop_context_t)HCL_STACK_GETTOP(hcl);
HCL_ASSERT (rctx == hcl->active_context);
HCL_ASSERT (hcl, rctx == hcl->active_context);
/* [NOTE]
* blkctx->sender is left to nil. it is set to the
@ -2175,7 +2178,7 @@ XXXXX
default:
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_FATAL, "Fatal error - unknown byte code 0x%zx\n", bcode);
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
goto oops;
}
}
@ -2196,8 +2199,8 @@ int hcl_execute (hcl_t* hcl)
{
int n;
HCL_ASSERT (hcl->initial_context == HCL_NULL);
HCL_ASSERT (hcl->active_context == HCL_NULL);
HCL_ASSERT (hcl, hcl->initial_context == HCL_NULL);
HCL_ASSERT (hcl, hcl->active_context == HCL_NULL);
if (start_initial_process_and_context (hcl) <= -1) return -1;
hcl->initial_context = hcl->processor->active->initial_context;

42
lib/gc.c
View File

@ -63,9 +63,9 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
/* the symbol table doesn't allow more data items than HCL_SMOOI_MAX.
* so hcl->symtab->tally must always be a small integer */
HCL_ASSERT (HCL_OOP_IS_SMOOI(hcl->symtab->tally));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(hcl->symtab->tally));
tally = HCL_OOP_TO_SMOOI(hcl->symtab->tally);
HCL_ASSERT (tally >= 0); /* it must not be less than 0 */
HCL_ASSERT (hcl, tally >= 0); /* it must not be less than 0 */
if (tally <= 0) return;
/* NOTE: in theory, the bucket size can be greater than HCL_SMOOI_MAX
@ -80,7 +80,7 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
continue;
}
HCL_ASSERT (hcl->symtab->bucket->slot[index] != _nil);
HCL_ASSERT (hcl, hcl->symtab->bucket->slot[index] != _nil);
for (i = 0, x = index, y = index; i < bucket_size; i++)
{
@ -93,9 +93,9 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
* at the current hash index */
symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[y];
HCL_ASSERT (HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
z = hcl_hashchars(symbol->slot, HCL_OBJ_GET_SIZE(symbol)) % bucket_size;
z = hcl_hashoochars(symbol->slot, HCL_OBJ_GET_SIZE(symbol)) % bucket_size;
/* move an element if necessary */
if ((y > x && (z <= x || z > y)) ||
@ -110,8 +110,8 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
tally--;
}
HCL_ASSERT (tally >= 0);
HCL_ASSERT (tally <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, tally >= 0);
HCL_ASSERT (hcl, tally <= HCL_SMOOI_MAX);
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally);
}
@ -137,9 +137,9 @@ static HCL_INLINE hcl_oow_t get_payload_bytes (hcl_t* hcl, hcl_oop_t oop)
* | Z | <-- if TRAILER is set, it is the number of bytes in the trailer
* | | | | |
*/
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t));
HCL_ASSERT (HCL_OBJ_GET_FLAGS_EXTRA(oop) == 0); /* no 'extra' for an OOP object */
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_EXTRA(oop) == 0); /* no 'extra' for an OOP object */
nbytes = HCL_OBJ_BYTESOF(oop) + HCL_SIZEOF(hcl_oow_t) + \
(hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)];
@ -191,7 +191,7 @@ hcl_oop_t hcl_moveoop (hcl_t* hcl, hcl_oop_t oop)
* assuming the new heap is as large as the old heap,
* and garbage collection doesn't allocate more objects
* than in the old heap, it must not fail. */
HCL_ASSERT (tmp != HCL_NULL);
HCL_ASSERT (hcl, tmp != HCL_NULL);
/* copy the payload to the new object */
HCL_MEMCPY (tmp, oop, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
@ -224,9 +224,9 @@ static hcl_uint8_t* scan_new_heap (hcl_t* hcl, hcl_uint8_t* ptr)
{
hcl_oow_t nbytes;
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t));
HCL_ASSERT (HCL_OBJ_GET_FLAGS_EXTRA(oop) == 0); /* no 'extra' for an OOP object */
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t));
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_EXTRA(oop) == 0); /* no 'extra' for an OOP object */
nbytes = HCL_OBJ_BYTESOF(oop) + HCL_SIZEOF(hcl_oow_t) + \
(hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)];
@ -253,7 +253,7 @@ static hcl_uint8_t* scan_new_heap (hcl_t* hcl, hcl_uint8_t* ptr)
* are garbages. */
size = HCL_PROCESS_NAMED_INSTVARS +
HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1;
HCL_ASSERT (size <= HCL_OBJ_GET_SIZE(oop));
HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop));
}
else
{
@ -291,8 +291,8 @@ void hcl_gc (hcl_t* hcl)
if (hcl->active_context)
{
HCL_ASSERT ((hcl_oop_t)hcl->processor != hcl->_nil);
HCL_ASSERT ((hcl_oop_t)hcl->processor->active != hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor != hcl->_nil);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->processor->active != hcl->_nil);
/* store the stack pointer to the active process */
hcl->processor->active->sp = HCL_SMOOI_TO_OOP(hcl->sp);
@ -422,19 +422,19 @@ void hcl_pushtmp (hcl_t* hcl, hcl_oop_t* oop_ptr)
{
/* if you have too many temporaries pushed, something must be wrong.
* change your code not to exceede the stack limit */
HCL_ASSERT (hcl->tmp_count < HCL_COUNTOF(hcl->tmp_stack));
HCL_ASSERT (hcl, hcl->tmp_count < HCL_COUNTOF(hcl->tmp_stack));
hcl->tmp_stack[hcl->tmp_count++] = oop_ptr;
}
void hcl_poptmp (hcl_t* hcl)
{
HCL_ASSERT (hcl->tmp_count > 0);
HCL_ASSERT (hcl, hcl->tmp_count > 0);
hcl->tmp_count--;
}
void hcl_poptmps (hcl_t* hcl, hcl_oow_t count)
{
HCL_ASSERT (hcl->tmp_count >= count);
HCL_ASSERT (hcl, hcl->tmp_count >= count);
hcl->tmp_count -= count;
}
@ -471,6 +471,7 @@ int hcl_ignite (hcl_t* hcl)
hcl->_nil = hcl_makenil (hcl);
if (!hcl->_nil) return -1;
}
if (!hcl->_true)
{
hcl->_true = hcl_maketrue (hcl);
@ -482,6 +483,7 @@ int hcl_ignite (hcl_t* hcl)
if (!hcl->_false) return -1;
}
if (!hcl->symtab)
{
hcl->symtab = (hcl_oop_set_t)hcl_makeset (hcl, hcl->option.dfl_symtab_size);

3
lib/hcl-cfg.h.in
View File

@ -297,8 +297,7 @@
/* sizeof(__uint128_t) */
#undef HCL_SIZEOF___UINT128_T
/* Define to the sub-directory in which libtool stores uninstalled libraries.
*/
/* Define to the sub-directory where libtool stores uninstalled libraries. */
#undef LT_OBJDIR
/* The size of `MB_LEN_MAX', as computed by valueof. */

128
lib/hcl-cmn.h
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2016 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -37,7 +37,7 @@
# include "hcl-msw.h"
#elif defined(__OS2__)
# include "hcl-os2.h"
#elif defined(__MSDOS__)
#elif defined(__DOS__)
# include "hcl-dos.h"
#elif defined(macintosh)
# include "hcl-mac.h" /* class mac os */
@ -57,7 +57,6 @@
# endif
#endif
/* =========================================================================
* PRIMITIVE TYPE DEFINTIONS
* ========================================================================= */
@ -119,8 +118,8 @@
#elif defined(HCL_SIZEOF_LONG) && (HCL_SIZEOF_LONG == 4)
# define HCL_HAVE_UINT32_T
# define HCL_HAVE_INT32_T
typedef unsigned long hcl_uint32_t;
typedef signed long hcl_int32_t;
typedef unsigned long int hcl_uint32_t;
typedef signed long int hcl_int32_t;
#elif defined(HCL_SIZEOF___INT32) && (HCL_SIZEOF___INT32 == 4)
# define HCL_HAVE_UINT32_T
# define HCL_HAVE_INT32_T
@ -131,7 +130,7 @@
# define HCL_HAVE_INT32_T
typedef unsigned __int32_t hcl_uint32_t;
typedef signed __int32_t hcl_int32_t;
#elif defined(__MSDOS__)
#elif defined(__DOS__)
# define HCL_HAVE_UINT32_T
# define HCL_HAVE_INT32_T
typedef unsigned long int hcl_uint32_t;
@ -152,13 +151,13 @@
#elif defined(HCL_SIZEOF_LONG) && (HCL_SIZEOF_LONG == 8)
# define HCL_HAVE_UINT64_T
# define HCL_HAVE_INT64_T
typedef unsigned long hcl_uint64_t;
typedef signed long hcl_int64_t;
typedef unsigned long int hcl_uint64_t;
typedef signed long int hcl_int64_t;
#elif defined(HCL_SIZEOF_LONG_LONG) && (HCL_SIZEOF_LONG_LONG == 8)
# define HCL_HAVE_UINT64_T
# define HCL_HAVE_INT64_T
typedef unsigned long long hcl_uint64_t;
typedef signed long long hcl_int64_t;
typedef unsigned long long int hcl_uint64_t;
typedef signed long long int hcl_int64_t;
#elif defined(HCL_SIZEOF___INT64) && (HCL_SIZEOF___INT64 == 8)
# define HCL_HAVE_UINT64_T
# define HCL_HAVE_INT64_T
@ -182,13 +181,13 @@
#elif defined(HCL_SIZEOF_LONG) && (HCL_SIZEOF_LONG == 16)
# define HCL_HAVE_UINT128_T
# define HCL_HAVE_INT128_T
typedef unsigned long hcl_uint128_t;
typedef signed long hcl_int128_t;
typedef unsigned long int hcl_uint128_t;
typedef signed long int hcl_int128_t;
#elif defined(HCL_SIZEOF_LONG_LONG) && (HCL_SIZEOF_LONG_LONG == 16)
# define HCL_HAVE_UINT128_T
# define HCL_HAVE_INT128_T
typedef unsigned long long hcl_uint128_t;
typedef signed long long hcl_int128_t;
typedef unsigned long long int hcl_uint128_t;
typedef signed long long int hcl_int128_t;
#elif defined(HCL_SIZEOF___INT128) && (HCL_SIZEOF___INT128 == 16)
# define HCL_HAVE_UINT128_T
# define HCL_HAVE_INT128_T
@ -275,11 +274,22 @@
* BASIC HCL TYPES
* =========================================================================*/
typedef char hcl_bch_t;
typedef int hcl_bci_t;
typedef char hcl_bch_t;
typedef int hcl_bci_t;
typedef unsigned char hcl_bchu_t; /* unsigned version of hcl_bch_t for inner working */
#define HCL_SIZEOF_BCH_T HCL_SIZEOF_CHAR
#define HCL_SIZEOF_BCI_T HCL_SIZEOF_INT
typedef hcl_uint16_t hcl_uch_t; /* TODO ... wchar_t??? */
#if defined(__GNUC__) && defined(__CHAR16_TYPE__)
/* TODO ... wchar_t???, char16_t? char32_t? */
typedef __CHAR16_TYPE__ hcl_uch_t;
#else
typedef hcl_uint16_t hcl_uch_t;
#endif
typedef hcl_int32_t hcl_uci_t;
typedef hcl_uint16_t hcl_uchu_t; /* same as hcl_uch_t as it is already unsigned */
#define HCL_SIZEOF_UCH_T 2
#define HCL_SIZEOF_UCI_T 4
typedef hcl_uint8_t hcl_oob_t;
@ -308,11 +318,18 @@ struct hcl_bcs_t
};
typedef struct hcl_bcs_t hcl_bcs_t;
typedef hcl_uch_t hcl_ooch_t;
typedef hcl_uci_t hcl_ooci_t;
typedef hcl_ucs_t hcl_oocs_t;
#define HCL_OOCH_IS_UCH
#if 0
typedef hcl_bch_t hcl_ooch_t;
typedef hcl_bci_t hcl_ooci_t;
typedef hcl_bcs_t hcl_oocs_t;
# define HCL_OOCH_IS_BCH
#else
typedef hcl_uch_t hcl_ooch_t;
typedef hcl_uci_t hcl_ooci_t;
typedef hcl_ucs_t hcl_oocs_t;
# define HCL_OOCH_IS_UCH
#endif
/* =========================================================================
@ -397,11 +414,12 @@ struct hcl_ntime_t
/* =========================================================================
* PRIMITIVE MACROS
* ========================================================================= */
#define HCL_UCI_EOF ((hcl_ooci_t)-1)
#define HCL_UCI_NL ((hcl_ooci_t)'\n')
#define HCL_UCI_EOF ((hcl_uci_t)-1)
#define HCL_BCI_EOF ((hcl_bci_t)-1)
#define HCL_OOCI_EOF ((hcl_ooci_t)-1)
#define HCL_SIZEOF(x) (sizeof(x))
#define HCL_COUNTOF(x) (sizeof(x) / sizeof(x[0]))
#define HCL_COUNTOF(x) (sizeof(x) / sizeof((x)[0]))
/**
* The HCL_OFFSETOF() macro returns the offset of a field from the beginning
@ -450,6 +468,7 @@ struct hcl_ntime_t
#define HCL_ORBITS(type,value,offset,length,bits) \
(value = (((type)(value)) | (((bits) & HCL_LBMASK(type,length)) << (offset))))
/**
* The HCL_BITS_MAX() macros calculates the maximum value that the 'nbits'
* bits of an unsigned integer of the given 'type' can hold.
@ -548,6 +567,11 @@ struct hcl_cmgr_t
hcl_cmgr_uctobc_t uctobc;
};
/* =========================================================================
* FORWARD DECLARATION FOR MAIN HCL STRUCTURE
* =========================================================================*/
typedef struct hcl_t hcl_t;
/* =========================================================================
* MACROS THAT CHANGES THE BEHAVIORS OF THE C COMPILER/LINKER
* =========================================================================*/
@ -556,11 +580,11 @@ struct hcl_cmgr_t
# define HCL_IMPORT
# define HCL_EXPORT
# define HCL_PRIVATE
#elif defined(_WIN32) || (defined(__WATCOMC__) && !defined(__WINDOWS_386__))
#elif defined(_WIN32) || (defined(__WATCOMC__) && (__WATCOMC__ >= 1000) && !defined(__WINDOWS_386__))
# define HCL_IMPORT __declspec(dllimport)
# define HCL_EXPORT __declspec(dllexport)
# define HCL_PRIVATE
#elif defined(__GNUC__) && (__GNUC__>=4)
#elif defined(__GNUC__) && ((__GNUC__>= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 3))
# define HCL_IMPORT __attribute__((visibility("default")))
# define HCL_EXPORT __attribute__((visibility("default")))
# define HCL_PRIVATE __attribute__((visibility("hidden")))
@ -585,9 +609,6 @@ struct hcl_cmgr_t
# undef HCL_HAVE_INLINE
#endif
/**
* The HCL_TYPE_IS_SIGNED() macro determines if a type is signed.
* \code
@ -619,6 +640,15 @@ struct hcl_cmgr_t
#define HCL_TYPE_MIN(type) \
((HCL_TYPE_IS_SIGNED(type)? HCL_TYPE_SIGNED_MIN(type): HCL_TYPE_UNSIGNED_MIN(type)))
/* round up a positive integer x to the nearst multiple of y */
#define HCL_ALIGN(x,y) ((((x) + (y) - 1) / (y)) * (y))
/* round up a positive integer x to the nearst multiple of y where
* y must be a multiple of a power of 2*/
#define HCL_ALIGN_POW2(x,y) ((((x) + (y) - 1)) & ~((y) - 1))
#define HCL_IS_UNALIGNED_POW2(x,y) ((x) & ((y) - 1))
#define HCL_IS_ALIGNED_POW2(x,y) (!HCL_IS_UNALIGNED_POW2(x,y))
/* =========================================================================
* COMPILER FEATURE TEST MACROS
@ -643,6 +673,12 @@ struct hcl_cmgr_t
#if __has_builtin(__builtin_ctz)
#define HCL_HAVE_BUILTIN_CTZ
#endif
#if __has_builtin(__builtin_ctzl)
#define HCL_HAVE_BUILTIN_CTZL
#endif
#if __has_builtin(__builtin_ctzll)
#define HCL_HAVE_BUILTIN_CTZLL
#endif
#if __has_builtin(__builtin_uadd_overflow)
#define HCL_HAVE_BUILTIN_UADD_OVERFLOW
@ -685,8 +721,36 @@ struct hcl_cmgr_t
#if __has_builtin(__builtin_expect)
#define HCL_HAVE_BUILTIN_EXPECT
#endif
#if __has_builtin(__sync_lock_test_and_set)
#define HCL_HAVE_SYNC_LOCK_TEST_AND_SET
#endif
#if __has_builtin(__sync_lock_release)
#define HCL_HAVE_SYNC_LOCK_RELEASE
#endif
#if __has_builtin(__sync_synchronize)
#define HCL_HAVE_SYNC_SYNCHRONIZE
#endif
#if __has_builtin(__sync_bool_compare_and_swap)
#define HCL_HAVE_SYNC_BOOL_COMPARE_AND_SWAP
#endif
#if __has_builtin(__sync_val_compare_and_swap)
#define HCL_HAVE_SYNC_VAL_COMPARE_AND_SWAP
#endif
#elif defined(__GNUC__) && defined(__GNUC_MINOR__)
#if (__GNUC__ >= 4)
#define HCL_HAVE_SYNC_LOCK_TEST_AND_SET
#define HCL_HAVE_SYNC_LOCK_RELEASE
#define HCL_HAVE_SYNC_SYNCHRONIZE
#define HCL_HAVE_SYNC_BOOL_COMPARE_AND_SWAP
#define HCL_HAVE_SYNC_VAL_COMPARE_AND_SWAP
#endif
#if (__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4)
#define HCL_HAVE_BUILTIN_CTZ
#define HCL_HAVE_BUILTIN_EXPECT
@ -710,13 +774,13 @@ struct hcl_cmgr_t
#endif
#if defined(HCL_HAVE_BUILTIN_EXPECT)
# define HCL_LIKELY(x) (__builtin_expect(!!x,1))
# define HCL_UNLIKELY(x) (__builtin_expect(!!x,0))
# define HCL_LIKELY(x) (__builtin_expect(!!(x),1))
# define HCL_UNLIKELY(x) (__builtin_expect(!!(x),0))
#else
# define HCL_LIKELY(x) (x)
# define HCL_UNLIKELY(x) (x)
#endif
#endif

141
lib/hcl-opt.h Normal file
View File

@ -0,0 +1,141 @@
/*
* $Id$
*
Copyright (c) 2014-2017 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.
*/
#ifndef _HCL_OPT_H_
#define _HCL_OPT_H_
#include "hcl-cmn.h"
/** \file
* This file defines functions and data structures to process
* command-line arguments.
*/
typedef struct hcl_uopt_t hcl_uopt_t;
typedef struct hcl_uopt_lng_t hcl_uopt_lng_t;
struct hcl_uopt_lng_t
{
const hcl_uch_t* str;
hcl_uci_t val;
};
struct hcl_uopt_t
{
/* input */
const hcl_uch_t* str; /* option string */
hcl_uopt_lng_t* lng; /* long options */
/* output */
hcl_uci_t opt; /* character checked for validity */
hcl_uch_t* arg; /* argument associated with an option */
/* output */
const hcl_uch_t* lngopt;
/* input + output */
int ind; /* index into parent argv vector */
/* input + output - internal*/
hcl_uch_t* cur;
};
typedef struct hcl_bopt_t hcl_bopt_t;
typedef struct hcl_bopt_lng_t hcl_bopt_lng_t;
struct hcl_bopt_lng_t
{
const hcl_bch_t* str;
hcl_bci_t val;
};
struct hcl_bopt_t
{
/* input */
const hcl_bch_t* str; /* option string */
hcl_bopt_lng_t* lng; /* long options */
/* output */
hcl_bci_t opt; /* character checked for validity */
hcl_bch_t* arg; /* argument associated with an option */
/* output */
const hcl_bch_t* lngopt;
/* input + output */
int ind; /* index into parent argv vector */
/* input + output - internal*/
hcl_bch_t* cur;
};
#if defined(__cplusplus)
extern "C" {
#endif
/**
* The hcl_getopt() function processes the \a argc command-line arguments
* pointed to by \a argv as configured in \a opt. It can process two
* different option styles: a single character starting with '-', and a
* long name starting with '--'.
*
* A character in \a opt.str is treated as a single character option. Should
* it require a parameter, specify ':' after it.
*
* Two special returning option characters indicate special error conditions.
* - \b ? indicates a bad option stored in the \a opt->opt field.
* - \b : indicates a bad parameter for an option stored in the \a opt->opt field.
*
* @return an option character on success, HCL_CHAR_EOF on no more options.
*/
HCL_EXPORT hcl_uci_t hcl_getuopt (
int argc, /* argument count */
hcl_uch_t* const* argv, /* argument array */
hcl_uopt_t* opt /* option configuration */
);
HCL_EXPORT hcl_bci_t hcl_getbopt (
int argc, /* argument count */
hcl_bch_t* const* argv, /* argument array */
hcl_bopt_t* opt /* option configuration */
);
#if defined(HCL_OOCH_IS_UCH)
# define hcl_opt_t hcl_uopt_t
# define hcl_opt_lng_t hcl_uopt_lng_t
# define hcl_getopt(argc,argv,opt) hcl_getuopt(argc,argv,opt)
#else
# define hcl_opt_t hcl_bopt_t
# define hcl_opt_lng_t hcl_bopt_lng_t
# define hcl_getopt(argc,argv,opt) hcl_getbopt(argc,argv,opt)
#endif
#if defined(__cplusplus)
}
#endif
#endif

10
lib/hcl-prv.h
View File

@ -29,6 +29,7 @@
#include "hcl.h"
#include "hcl-utl.h"
#include <stdarg.h>
/* you can define this to either 1 or 2 */
#define HCL_BCODE_LONG_PARAM_SIZE 2
@ -44,6 +45,12 @@
* PUSH_CONTEXT, PUSH_INTLIT, PUSH_INTLIT, SEND_BLOCK_COPY */
#define HCL_USE_MAKE_BLOCK
/* define this to enable karatsuba multiplication in bigint */
#define HCL_ENABLE_KARATSUBA
#define HCL_KARATSUBA_CUTOFF 32
#define HCL_KARATSUBA_CUTOFF_DEBUG 3
/* define this to allow an pointer(OOP) object to have trailing bytes
* this is used to embed bytes codes into the back of a compile method
* object instead of putting in in a separate byte array. */
@ -51,7 +58,6 @@
/* this is for gc debugging */
/*#define HCL_DEBUG_PROCESSOR*/
#define HCL_DEBUG_GC
#define HCL_DEBUG_VM_EXEC
/* allow the caller to drive process switching by calling
@ -105,8 +111,6 @@
# define HCL_MEMCMP(dst,src,size) memcmp(dst,src,size)
#endif
#define HCL_ASSERT(x) assert(x)
#define HCL_ALIGN(x,y) ((((x) + (y) - 1) / (y)) * (y))

158
lib/hcl-rbt.h
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2015 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -29,14 +29,14 @@
#include "hcl-cmn.h"
/**@file
/** \file
* This file provides a red-black tree encapsulated in the #hcl_rbt_t type that
* implements a self-balancing binary search tree.Its interface is very close
* to #hcl_htb_t.
*
* This sample code adds a series of keys and values and print them
* in descending key order.
* @code
* \code
* #include <hcl/cmn/rbt.h>
* #include <hcl/cmn/mem.h>
* #include <hcl/cmn/sio.h>
@ -67,7 +67,7 @@
* hcl_rbt_close (s1);
* return 0;
* }
* @endcode
* \endcode
*/
typedef struct hcl_rbt_t hcl_rbt_t;
@ -99,9 +99,9 @@ typedef enum hcl_rbt_id_t hcl_rbt_id_t;
* The hcl_rbt_copier_t type defines a pair contruction callback.
*/
typedef void* (*hcl_rbt_copier_t) (
hcl_rbt_t* rbt /* red-black tree */,
void* dptr /* pointer to a key or a value */,
hcl_oow_t dlen /* length of a key or a value */
hcl_rbt_t* rbt /**< red-black tree */,
void* dptr /**< pointer to a key or a value */,
hcl_oow_t dlen /**< length of a key or a value */
);
/**
@ -136,7 +136,7 @@ typedef int (*hcl_rbt_comper_t) (
*/
typedef void (*hcl_rbt_keeper_t) (
hcl_rbt_t* rbt, /**< red-black tree */
void* vptr, /**< value pointer */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
);
@ -152,8 +152,8 @@ typedef hcl_rbt_walk_t (*hcl_rbt_walker_t) (
/**
* The hcl_rbt_cbserter_t type defines a callback function for hcl_rbt_cbsert().
* The hcl_rbt_cbserter() function calls it to allocate a new pair for the
* key pointed to by @a kptr of the length @a klen and the callback context
* @a ctx. The second parameter @a pair is passed the pointer to the existing
* key pointed to by \a kptr of the length \a klen and the callback context
* \a ctx. The second parameter \a pair is passed the pointer to the existing
* pair for the key or #HCL_NULL in case of no existing key. The callback
* must return a pointer to a new or a reallocated pair. When reallocating the
* existing pair, this callback must destroy the existing pair and return the
@ -162,9 +162,9 @@ typedef hcl_rbt_walk_t (*hcl_rbt_walker_t) (
typedef hcl_rbt_pair_t* (*hcl_rbt_cbserter_t) (
hcl_rbt_t* rbt, /**< red-black tree */
hcl_rbt_pair_t* pair, /**< pair pointer */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* ctx /**< callback context */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* ctx /**< callback context */
);
/**
@ -177,7 +177,7 @@ struct hcl_rbt_pair_t
{
struct
{
void* ptr;
void* ptr;
hcl_oow_t len;
} key;
@ -234,11 +234,11 @@ typedef enum hcl_rbt_style_kind_t hcl_rbt_style_kind_t;
*/
struct hcl_rbt_t
{
hcl_mmgr_t* mmgr;
hcl_t* hcl;
const hcl_rbt_style_t* style;
hcl_oob_t scale[2]; /**< length scale */
hcl_oob_t scale[2]; /**< length scale */
hcl_rbt_pair_t xnil; /**< internal nil node */
hcl_oow_t size; /**< number of pairs */
hcl_oow_t size; /**< number of pairs */
hcl_rbt_pair_t* root; /**< root pair */
};
@ -290,13 +290,13 @@ HCL_EXPORT const hcl_rbt_style_t* hcl_getrbtstyle (
/**
* The hcl_rbt_open() function creates a red-black tree.
* @return hcl_rbt_t pointer on success, HCL_NULL on failure.
* \return hcl_rbt_t pointer on success, HCL_NULL on failure.
*/
HCL_EXPORT hcl_rbt_t* hcl_rbt_open (
hcl_mmgr_t* mmgr, /**< memory manager */
hcl_oow_t xtnsize, /**< extension size in bytes */
int kscale, /**< key scale */
int vscale /**< value scale */
hcl_t* hcl,
hcl_oow_t xtnsize, /**< extension size in bytes */
int kscale, /**< key scale */
int vscale /**< value scale */
);
/**
@ -311,9 +311,9 @@ HCL_EXPORT void hcl_rbt_close (
*/
HCL_EXPORT int hcl_rbt_init (
hcl_rbt_t* rbt, /**< red-black tree */
hcl_mmgr_t* mmgr, /**< memory manager */
int kscale, /**< key scale */
int vscale /**< value scale */
hcl_t* hcl,
int kscale, /**< key scale */
int vscale /**< value scale */
);
/**
@ -323,10 +323,6 @@ HCL_EXPORT void hcl_rbt_fini (
hcl_rbt_t* rbt /**< red-black tree */
);
HCL_EXPORT hcl_mmgr_t* hcl_rbt_getmmgr (
hcl_rbt_t* rbt
);
HCL_EXPORT void* hcl_rbt_getxtn (
hcl_rbt_t* rbt
);
@ -361,13 +357,13 @@ HCL_EXPORT hcl_oow_t hcl_rbt_getsize (
* The hcl_rbt_search() function searches red-black tree to find a pair with a
* matching key. It returns the pointer to the pair found. If it fails
* to find one, it returns HCL_NULL.
* @return pointer to the pair with a maching key,
* \return pointer to the pair with a maching key,
* or HCL_NULL if no match is found.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_search (
const hcl_rbt_t* rbt, /**< red-black tree */
const void* kptr, /**< key pointer */
hcl_oow_t klen /**< the size of the key */
const void* kptr, /**< key pointer */
hcl_oow_t klen /**< the size of the key */
);
/**
@ -375,56 +371,56 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_search (
* matching key. If one is found, it updates the pair. Otherwise, it inserts
* a new pair with the key and the value given. It returns the pointer to the
* pair updated or inserted.
* @return a pointer to the updated or inserted pair on success,
* \return a pointer to the updated or inserted pair on success,
* HCL_NULL on failure.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_upsert (
hcl_rbt_t* rbt, /**< red-black tree */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
);
/**
* The hcl_rbt_ensert() function inserts a new pair with the key and the value
* given. If there exists a pair with the key given, the function returns
* the pair containing the key.
* @return pointer to a pair on success, HCL_NULL on failure.
* \return pointer to a pair on success, HCL_NULL on failure.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_ensert (
hcl_rbt_t* rbt, /**< red-black tree */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
);
/**
* The hcl_rbt_insert() function inserts a new pair with the key and the value
* given. If there exists a pair with the key given, the function returns
* HCL_NULL without channging the value.
* @return pointer to the pair created on success, HCL_NULL on failure.
* \return pointer to the pair created on success, HCL_NULL on failure.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_insert (
hcl_rbt_t* rbt, /**< red-black tree */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
);
/**
* The hcl_rbt_update() function updates the value of an existing pair
* with a matching key.
* @return pointer to the pair on success, HCL_NULL on no matching pair
* \return pointer to the pair on success, HCL_NULL on no matching pair
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
hcl_rbt_t* rbt, /**< red-black tree */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
hcl_oow_t klen, /**< key length */
void* vptr, /**< value pointer */
hcl_oow_t vlen /**< value length */
hcl_oow_t vlen /**< value length */
);
/**
@ -435,7 +431,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* a new pair if the key is not found and appends the new value to the
* existing value delimited by a comma if the key is found.
*
* @code
* \code
* hcl_rbt_walk_t print_map_pair (hcl_rbt_t* map, hcl_rbt_pair_t* pair, void* ctx)
* {
* hcl_printf (HCL_T("%.*s[%d] => %.*s[%d]\n"),
@ -460,7 +456,7 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* // in this sample, i will append the new value to the old value
* // separated by a comma
* hcl_rbt_pair_t* new_pair;
* hcl_char_t comma = HCL_T(',');
* hcl_ooch_t comma = HCL_T(',');
* hcl_oob_t* vptr;
*
* // allocate a new pair, but without filling the actual value.
@ -471,11 +467,11 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
*
* // fill in the value space
* vptr = new_pair->vptr;
* hcl_memcpy (vptr, pair->vptr, pair->vlen*HCL_SIZEOF(hcl_char_t));
* vptr += pair->vlen*HCL_SIZEOF(hcl_char_t);
* hcl_memcpy (vptr, &comma, HCL_SIZEOF(hcl_char_t));
* vptr += HCL_SIZEOF(hcl_char_t);
* hcl_memcpy (vptr, v->ptr, v->len*HCL_SIZEOF(hcl_char_t));
* hcl_memcpy (vptr, pair->vptr, pair->vlen*HCL_SIZEOF(hcl_ooch_t));
* vptr += pair->vlen*HCL_SIZEOF(hcl_ooch_t);
* hcl_memcpy (vptr, &comma, HCL_SIZEOF(hcl_ooch_t));
* vptr += HCL_SIZEOF(hcl_ooch_t);
* hcl_memcpy (vptr, v->ptr, v->len*HCL_SIZEOF(hcl_ooch_t));
*
* // this callback requires the old pair to be destroyed
* hcl_rbt_freepair (rbt, pair);
@ -489,12 +485,12 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* {
* hcl_rbt_t* s1;
* int i;
* hcl_char_t* keys[] = { HCL_T("one"), HCL_T("two"), HCL_T("three") };
* hcl_char_t* vals[] = { HCL_T("1"), HCL_T("2"), HCL_T("3"), HCL_T("4"), HCL_T("5") };
* hcl_ooch_t* keys[] = { HCL_T("one"), HCL_T("two"), HCL_T("three") };
* hcl_ooch_t* vals[] = { HCL_T("1"), HCL_T("2"), HCL_T("3"), HCL_T("4"), HCL_T("5") };
*
* s1 = hcl_rbt_open (
* HCL_MMGR_GETDFL(), 0,
* HCL_SIZEOF(hcl_char_t), HCL_SIZEOF(hcl_char_t)
* HCL_SIZEOF(hcl_ooch_t), HCL_SIZEOF(hcl_ooch_t)
* ); // note error check is skipped
* hcl_rbt_setstyle (s1, &style1);
*
@ -512,24 +508,24 @@ HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_update (
* hcl_rbt_close (s1);
* return 0;
* }
* @endcode
* \endcode
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_cbsert (
hcl_rbt_t* rbt, /**< red-black tree */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
void* kptr, /**< key pointer */
hcl_oow_t klen, /**< key length */
hcl_rbt_cbserter_t cbserter, /**< callback function */
void* ctx /**< callback context */
void* ctx /**< callback context */
);
/**
* The hcl_rbt_delete() function deletes a pair with a matching key
* @return 0 on success, -1 on failure
* \return 0 on success, -1 on failure
*/
HCL_EXPORT int hcl_rbt_delete (
hcl_rbt_t* rbt, /**< red-black tree */
const void* kptr, /**< key pointer */
hcl_oow_t klen /**< key size */
hcl_rbt_t* rbt, /**< red-black tree */
const void* kptr, /**< key pointer */
hcl_oow_t klen /**< key size */
);
/**
@ -546,7 +542,7 @@ HCL_EXPORT void hcl_rbt_clear (
HCL_EXPORT void hcl_rbt_walk (
hcl_rbt_t* rbt, /**< red-black tree */
hcl_rbt_walker_t walker, /**< callback function for each pair */
void* ctx /**< pointer to user-specific data */
void* ctx /**< pointer to user-specific data */
);
/**
@ -556,32 +552,32 @@ HCL_EXPORT void hcl_rbt_walk (
HCL_EXPORT void hcl_rbt_rwalk (
hcl_rbt_t* rbt, /**< red-black tree */
hcl_rbt_walker_t walker, /**< callback function for each pair */
void* ctx /**< pointer to user-specific data */
void* ctx /**< pointer to user-specific data */
);
/**
* The hcl_rbt_allocpair() function allocates a pair for a key and a value
* given. But it does not chain the pair allocated into the red-black tree @a rbt.
* given. But it does not chain the pair allocated into the red-black tree \a rbt.
* Use this function at your own risk.
*
* Take note of he following special behavior when the copier is
* #HCL_RBT_COPIER_INLINE.
* - If @a kptr is #HCL_NULL, the key space of the size @a klen is reserved but
* - If \a kptr is #HCL_NULL, the key space of the size \a klen is reserved but
* not propagated with any data.
* - If @a vptr is #HCL_NULL, the value space of the size @a vlen is reserved
* - If \a vptr is #HCL_NULL, the value space of the size \a vlen is reserved
* but not propagated with any data.
*/
HCL_EXPORT hcl_rbt_pair_t* hcl_rbt_allocpair (
hcl_rbt_t* rbt,
hcl_rbt_t* rbt,
void* kptr,
hcl_oow_t klen,
hcl_oow_t klen,
void* vptr,
hcl_oow_t vlen
hcl_oow_t vlen
);
/**
* The hcl_rbt_freepair() function destroys a pair. But it does not detach
* the pair destroyed from the red-black tree @a rbt. Use this function at your
* the pair destroyed from the red-black tree \a rbt. Use this function at your
* own risk.
*/
HCL_EXPORT void hcl_rbt_freepair (
@ -594,10 +590,10 @@ HCL_EXPORT void hcl_rbt_freepair (
*/
HCL_EXPORT int hcl_rbt_dflcomp (
const hcl_rbt_t* rbt,
const void* kptr1,
hcl_oow_t klen1,
const void* kptr2,
hcl_oow_t klen2
const void* kptr1,
hcl_oow_t klen1,
const void* kptr2,
hcl_oow_t klen2
);
#if defined(__cplusplus)

455
lib/hcl-utl.h
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2015 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -29,124 +29,469 @@
#include "hcl-cmn.h"
/* -----------------------------------------------------------------------
* DOUBLY LINKED LIST MACROS
* ----------------------------------------------------------------------- */
#define HCL_APPEND_TO_LIST(list, node) do { \
(node)->next = HCL_NULL; \
(node)->prev = (list)->last; \
if ((list)->first) (list)->last->next = (node); \
else (list)->first = (node); \
(list)->last = (node); \
} while(0)
#define HCL_PREPPEND_TO_LIST(list, node) do { \
(node)->prev = HCL_NULL; \
(node)->next = (list)->first; \
if ((list)->last) (list)->first->prev = (node); \
else (list)->last = (node); \
(list)->first = (node); \
} while(0)
#define HCL_DELETE_FROM_LIST(list, node) do { \
if ((node)->prev) (node)->prev->next = (node)->next; \
else (list)->first = (node)->next; \
if ((node)->next) (node)->next->prev = (node)->prev; \
else (list)->last = (node)->prev; \
} while(0)
#define HCL_APPEND_TO_OOP_LIST(hcl, list, node_type, node, _link) do { \
(node)->_link.next = (node_type)(hcl)->_nil; \
(node)->_link.prev = (list)->last; \
if ((hcl_oop_t)(list)->last != (hcl)->_nil) (list)->last->_link.next = (node); \
else (list)->first = (node); \
(list)->last = (node); \
} while(0)
#define HCL_PREPPEND_TO_OOP_LIST(hcl, list, node_type, node, _link) do { \
(node)->_link.prev = (node_type)(hcl)->_nil; \
(node)->_link.next = (list)->first; \
if ((hcl_oop_t)(list)->first != (hcl)->_nil) (list)->first->_link.prev = (node); \
else (list)->last = (node); \
(list)->first = (node); \
} while(0)
#define HCL_DELETE_FROM_OOP_LIST(hcl, list, node, _link) do { \
if ((hcl_oop_t)(node)->_link.prev != (hcl)->_nil) (node)->_link.prev->_link.next = (node)->_link.next; \
else (list)->first = (node)->_link.next; \
if ((hcl_oop_t)(node)->_link.next != (hcl)->_nil) (node)->_link.next->_link.prev = (node)->_link.prev; \
else (list)->last = (node)->_link.prev; \
} while(0)
/*
#define HCL_CLEANUP_FROM_OOP_LIST(hcl, list, node, _link) do { \
HCL_DELETE_FROM_OOP_LIST (hcl, list, node, _link); \
(node)->_link.prev = (node_type)(hcl)->_nil; \
(node)->_link.next = (node_type)(hcl)->_nil; \
} while(0);
*/
#define HCL_CONST_SWAP16(x) \
((qse_uint16_t)((((qse_uint16_t)(x) & (qse_uint16_t)0x00ffU) << 8) | \
(((qse_uint16_t)(x) & (qse_uint16_t)0xff00U) >> 8) ))
#define HCL_CONST_SWAP32(x) \
((qse_uint32_t)((((qse_uint32_t)(x) & (qse_uint32_t)0x000000ffUL) << 24) | \
(((qse_uint32_t)(x) & (qse_uint32_t)0x0000ff00UL) << 8) | \
(((qse_uint32_t)(x) & (qse_uint32_t)0x00ff0000UL) >> 8) | \
(((qse_uint32_t)(x) & (qse_uint32_t)0xff000000UL) >> 24) ))
#if defined(HCL_ENDIAN_LITTLE)
# define HCL_CONST_NTOH16(x) HCL_CONST_SWAP16(x)
# define HCL_CONST_HTON16(x) HCL_CONST_SWAP16(x)
# define HCL_CONST_NTOH32(x) HCL_CONST_SWAP32(x)
# define HCL_CONST_HTON32(x) HCL_CONST_SWAP32(x)
#elif defined(HCL_ENDIAN_BIG)
# define HCL_CONST_NTOH16(x) (x)
# define HCL_CONST_HTON16(x) (x)
# define HCL_CONST_NTOH32(x) (x)
# define HCL_CONST_HTON32(x) (x)
#else
# error UNKNOWN ENDIAN
#endif
#if defined(__cplusplus)
extern "C" {
#endif
#if defined(HCL_OOCH_IS_UCH)
# define hcl_hashchars(ptr,len) hcl_hashuchars(ptr,len)
# define hcl_compoocbcstr(str1,str2) hcl_compucbcstr(str1,str2)
# define hcl_compoocstr(str1,str2) hcl_compucstr(str1,str2)
# define hcl_copyoochars(dst,src,len) hcl_copyuchars(dst,src,len)
# define hcl_copybchtooochars(dst,src,len) hcl_copybchtouchars(dst,src,len)
# define hcl_copyoocstr(dst,len,src) hcl_copyucstr(dst,len,src)
# define hcl_findoochar(ptr,len,c) hcl_finduchar(ptr,len,c)
# define hcl_countoocstr(str) hcl_countucstr(str)
#else
# define hcl_hashchars(ptr,len) hcl_hashbchars(ptr,len)
# define hcl_compoocbcstr(str1,str2) hcl_compbcstr(str1,str2)
# define hcl_compoocstr(str1,str2) hcl_compbcstr(str1,str2)
# define hcl_copyoochars(dst,src,len) hcl_copybchars(dst,src,len)
# define hcl_copybchtooochars(dst,src,len) hcl_copybchars(dst,src,len)
# define hcl_copyoocstr(dst,len,src) hcl_copybcstr(dst,len,src)
# define hcl_findoochar(ptr,len,c) hcl_findbchar(ptr,len,c)
# define hcl_countoocstr(str) hcl_countbcstr(str)
#endif
/* ========================================================================= */
/* hcl-utl.c */
/* ========================================================================= */
hcl_oow_t hcl_hashbytes (
HCL_EXPORT hcl_oow_t hcl_hashbytes (
const hcl_oob_t* ptr,
hcl_oow_t len
);
hcl_oow_t hcl_hashuchars (
const hcl_uch_t* ptr,
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE hcl_oow_t hcl_hashbchars (const hcl_bch_t* ptr, hcl_oow_t len)
{
return hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_bch_t));
}
static HCL_INLINE hcl_oow_t hcl_hashuchars (const hcl_uch_t* ptr, hcl_oow_t len)
{
return hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_uch_t));
}
static HCL_INLINE hcl_oow_t hcl_hashwords (const hcl_oow_t* ptr, hcl_oow_t len)
{
return hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oow_t));
}
static HCL_INLINE hcl_oow_t hcl_hashhalfwords (const hcl_oohw_t* ptr, hcl_oow_t len)
{
return hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oohw_t));
}
#else
# define hcl_hashbchars(ptr,len) hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_bch_t))
# define hcl_hashuchars(ptr,len) hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_uch_t))
# define hcl_hashwords(ptr,len) hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oow_t))
# define hcl_hashhalfwords(ptr,len) hcl_hashbytes((const hcl_oob_t*)ptr, len * HCL_SIZEOF(hcl_oohw_t))
#endif
#if defined(HCL_OOCH_IS_UCH)
# define hcl_hashoochars(ptr,len) hcl_hashuchars(ptr,len)
#else
# define hcl_hashoochars(ptr,len) hcl_hashbchars(ptr,len)
#endif
/**
* The hcl_equaluchars() function determines equality of two strings
* of the same length \a len.
*/
HCL_EXPORT int hcl_equaluchars (
const hcl_uch_t* str1,
const hcl_uch_t* str2,
hcl_oow_t len
);
#define hcl_hashbchars(ptr,len) hcl_hashbytes(ptr,len)
int hcl_equalchars (
const hcl_uch_t* str1,
const hcl_uch_t* str2,
HCL_EXPORT int hcl_equalbchars (
const hcl_bch_t* str1,
const hcl_bch_t* str2,
hcl_oow_t len
);
int hcl_compucstr (
HCL_EXPORT int hcl_compuchars (
const hcl_uch_t* str1,
hcl_oow_t len1,
const hcl_uch_t* str2,
hcl_oow_t len2
);
HCL_EXPORT int hcl_compbchars (
const hcl_bch_t* str1,
hcl_oow_t len1,
const hcl_bch_t* str2,
hcl_oow_t len2
);
HCL_EXPORT int hcl_compucstr (
const hcl_uch_t* str1,
const hcl_uch_t* str2
);
int hcl_compbcstr (
HCL_EXPORT int hcl_compbcstr (
const hcl_bch_t* str1,
const hcl_bch_t* str2
);
int hcl_compucbcstr (
HCL_EXPORT int hcl_compucbcstr (
const hcl_uch_t* str1,
const hcl_bch_t* str2
);
int hcl_compucxbcstr (
HCL_EXPORT int hcl_compucharsucstr (
const hcl_uch_t* str1,
hcl_oow_t len,
hcl_oow_t len,
const hcl_uch_t* str2
);
HCL_EXPORT int hcl_compucharsbcstr (
const hcl_uch_t* str1,
hcl_oow_t len,
const hcl_bch_t* str2
);
void hcl_copyuchars (
HCL_EXPORT int hcl_compbcharsbcstr (
const hcl_bch_t* str1,
hcl_oow_t len,
const hcl_bch_t* str2
);
HCL_EXPORT int hcl_compbcharsucstr (
const hcl_bch_t* str1,
hcl_oow_t len,
const hcl_uch_t* str2
);
HCL_EXPORT void hcl_copyuchars (
hcl_uch_t* dst,
const hcl_uch_t* src,
hcl_oow_t len
hcl_oow_t len
);
void hcl_copybchars (
HCL_EXPORT void hcl_copybchars (
hcl_bch_t* dst,
const hcl_bch_t* src,
hcl_oow_t len
hcl_oow_t len
);
void hcl_copybchtouchars (
HCL_EXPORT void hcl_copybtouchars (
hcl_uch_t* dst,
const hcl_bch_t* src,
hcl_oow_t len
hcl_oow_t len
);
hcl_oow_t hcl_copyucstr (
HCL_EXPORT hcl_oow_t hcl_copyucstr (
hcl_uch_t* dst,
hcl_oow_t len,
hcl_oow_t len,
const hcl_uch_t* src
);
hcl_oow_t hcl_copybcstr (
HCL_EXPORT hcl_oow_t hcl_copybcstr (
hcl_bch_t* dst,
hcl_oow_t len,
hcl_oow_t len,
const hcl_bch_t* src
);
hcl_uch_t* hcl_finduchar (
HCL_EXPORT hcl_uch_t* hcl_finduchar (
const hcl_uch_t* ptr,
hcl_oow_t len,
hcl_oow_t len,
hcl_uch_t c
);
hcl_bch_t* hcl_findbchar (
HCL_EXPORT hcl_bch_t* hcl_findbchar (
const hcl_bch_t* ptr,
hcl_oow_t len,
hcl_oow_t len,
hcl_bch_t c
);
hcl_oow_t hcl_countucstr (
HCL_EXPORT hcl_uch_t* hcl_rfinduchar (
const hcl_uch_t* ptr,
hcl_oow_t len,
hcl_uch_t c
);
HCL_EXPORT hcl_bch_t* hcl_rfindbchar (
const hcl_bch_t* ptr,
hcl_oow_t len,
hcl_bch_t c
);
HCL_EXPORT hcl_uch_t* hcl_finducharinucstr (
const hcl_uch_t* ptr,
hcl_uch_t c
);
HCL_EXPORT hcl_bch_t* hcl_findbcharinbcstr (
const hcl_bch_t* ptr,
hcl_bch_t c
);
HCL_EXPORT hcl_oow_t hcl_countucstr (
const hcl_uch_t* str
);
hcl_oow_t hcl_countbcstr (
HCL_EXPORT hcl_oow_t hcl_countbcstr (
const hcl_bch_t* str
);
#if defined(HCL_OOCH_IS_UCH)
# define hcl_equaloochars(str1,str2,len) hcl_equaluchars(str1,str2,len)
# define hcl_compoochars(str1,len1,str2,len2) hcl_compuchars(str1,len1,str2,len2)
# define hcl_compoocbcstr(str1,str2) hcl_compucbcstr(str1,str2)
# define hcl_compoocharsbcstr(str1,len1,str2) hcl_compucharsbcstr(str1,len1,str2)
# define hcl_compoocharsucstr(str1,len1,str2) hcl_compucharsucstr(str1,len1,str2)
# define hcl_compoocharsoocstr(str1,len1,str2) hcl_compucharsucstr(str1,len1,str2)
# define hcl_compoocstr(str1,str2) hcl_compucstr(str1,str2)
# define hcl_copyoochars(dst,src,len) hcl_copyuchars(dst,src,len)
# define hcl_copybctooochars(dst,src,len) hcl_copybtouchars(dst,src,len)
# define hcl_copyoocstr(dst,len,src) hcl_copyucstr(dst,len,src)
# define hcl_findoochar(ptr,len,c) hcl_finduchar(ptr,len,c)
# define hcl_rfindoochar(ptr,len,c) hcl_rfinduchar(ptr,len,c)
# define hcl_findoocharinoocstr(ptr,c) hcl_finducharinucstr(ptr,c)
# define hcl_countoocstr(str) hcl_countucstr(str)
#else
# define hcl_equaloochars(str1,str2,len) hcl_equalbchars(str1,str2,len)
# define hcl_compoochars(str1,len1,str2,len2) hcl_compbchars(str1,len1,str2,len2)
# define hcl_compoocbcstr(str1,str2) hcl_compbcstr(str1,str2)
# define hcl_compoocharsbcstr(str1,len1,str2) hcl_compbcharsbcstr(str1,len1,str2)
# define hcl_compoocharsucstr(str1,len1,str2) hcl_compbcharsucstr(str1,len1,str2)
# define hcl_compoocharsoocstr(str1,len1,str2) hcl_compbcharsbcstr(str1,len1,str2)
# define hcl_compoocstr(str1,str2) hcl_compbcstr(str1,str2)
# define hcl_copyoochars(dst,src,len) hcl_copybchars(dst,src,len)
# define hcl_copybctooochars(dst,src,len) hcl_copybchars(dst,src,len)
# define hcl_copyoocstr(dst,len,src) hcl_copybcstr(dst,len,src)
# define hcl_findoochar(ptr,len,c) hcl_findbchar(ptr,len,c)
# define hcl_rfindoochar(ptr,len,c) hcl_rfindbchar(ptr,len,c)
# define hcl_findoocharinoocstr(ptr,c) hcl_findbcharinbcstr(ptr,c)
# define hcl_countoocstr(str) hcl_countbcstr(str)
#endif
HCL_EXPORT int hcl_copyoocstrtosbuf (
hcl_t* hcl,
const hcl_ooch_t* str,
int id
);
HCL_EXPORT int hcl_concatoocstrtosbuf (
hcl_t* hcl,
const hcl_ooch_t* str,
int id
);
HCL_EXPORT hcl_cmgr_t* hcl_getutf8cmgr (
void
);
/**
* The hcl_convutoutf8chars() function converts a unicode character string \a ucs
* to a UTF8 string and writes it into the buffer pointed to by \a bcs, but
* not more than \a bcslen bytes including the terminating null.
*
* Upon return, \a bcslen is modified to the actual number of bytes written to
* \a bcs excluding the terminating null; \a ucslen is modified to the number of
* wide characters converted.
*
* You may pass #HCL_NULL for \a bcs to dry-run conversion or to get the
* required buffer size for conversion. -2 is never returned in this case.
*
* \return
* - 0 on full conversion,
* - -1 on no or partial conversion for an illegal character encountered,
* - -2 on no or partial conversion for a small buffer.
*
* \code
* const hcl_uch_t ucs[] = { 'H', 'e', 'l', 'l', 'o' };
* hcl_bch_t bcs[10];
* hcl_oow_t ucslen = 5;
* hcl_oow_t bcslen = HCL_COUNTOF(bcs);
* n = hcl_convutoutf8chars (ucs, &ucslen, bcs, &bcslen);
* if (n <= -1)
* {
* // conversion error
* }
* \endcode
*/
HCL_EXPORT int hcl_convutoutf8chars (
const hcl_uch_t* ucs,
hcl_oow_t* ucslen,
hcl_bch_t* bcs,
hcl_oow_t* bcslen
);
/**
* The hcl_convutf8touchars() function converts a UTF8 string to a uncide string.
*
* It never returns -2 if \a ucs is #HCL_NULL.
*
* \code
* const hcl_bch_t* bcs = "test string";
* hcl_uch_t ucs[100];
* hcl_oow_t ucslen = HCL_COUNTOF(buf), n;
* hcl_oow_t bcslen = 11;
* int n;
* n = hcl_convutf8touchars (bcs, &bcslen, ucs, &ucslen);
* if (n <= -1) { invalid/incomplenete sequence or buffer to small }
* \endcode
*
* The resulting \a ucslen can still be greater than 0 even if the return
* value is negative. The value indiates the number of characters converted
* before the error has occurred.
*
* \return 0 on success.
* -1 if \a bcs contains an illegal character.
* -2 if the wide-character string buffer is too small.
* -3 if \a bcs is not a complete sequence.
*/
HCL_EXPORT int hcl_convutf8touchars (
const hcl_bch_t* bcs,
hcl_oow_t* bcslen,
hcl_uch_t* ucs,
hcl_oow_t* ucslen
);
HCL_EXPORT int hcl_convutoutf8cstr (
const hcl_uch_t* ucs,
hcl_oow_t* ucslen,
hcl_bch_t* bcs,
hcl_oow_t* bcslen
);
HCL_EXPORT int hcl_convutf8toucstr (
const hcl_bch_t* bcs,
hcl_oow_t* bcslen,
hcl_uch_t* ucs,
hcl_oow_t* ucslen
);
HCL_EXPORT hcl_oow_t hcl_uctoutf8 (
hcl_uch_t uc,
hcl_bch_t* utf8,
hcl_oow_t size
);
HCL_EXPORT hcl_oow_t hcl_utf8touc (
const hcl_bch_t* utf8,
hcl_oow_t size,
hcl_uch_t* uc
);
HCL_EXPORT int hcl_ucwidth (
hcl_uch_t uc
);
/* ------------------------------------------------------------------------- */
#if defined(HCL_HAVE_UINT16_T)
HCL_EXPORT hcl_uint16_t hcl_ntoh16 (
hcl_uint16_t x
);
HCL_EXPORT hcl_uint16_t hcl_hton16 (
hcl_uint16_t x
);
#endif
#if defined(HCL_HAVE_UINT32_T)
HCL_EXPORT hcl_uint32_t hcl_ntoh32 (
hcl_uint32_t x
);
HCL_EXPORT hcl_uint32_t hcl_hton32 (
hcl_uint32_t x
);
#endif
#if defined(HCL_HAVE_UINT64_T)
HCL_EXPORT hcl_uint64_t hcl_ntoh64 (
hcl_uint64_t x
);
HCL_EXPORT hcl_uint64_t hcl_hton64 (
hcl_uint64_t x
);
#endif
#if defined(HCL_HAVE_UINT128_T)
HCL_EXPORT hcl_uint128_t hcl_ntoh128 (
hcl_uint128_t x
);
HCL_EXPORT hcl_uint128_t hcl_hton128 (
hcl_uint128_t x
);
#endif
#if defined(__cplusplus)
}
#endif

110
lib/hcl.c
View File

@ -32,7 +32,7 @@ hcl_t* hcl_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_oow_t heapsize, const
hcl_t* hcl;
/* if this assertion fails, correct the type definition in hcl.h */
HCL_ASSERT (HCL_SIZEOF(hcl_oow_t) == HCL_SIZEOF(hcl_oop_t));
HCL_ASSERT (hcl, HCL_SIZEOF(hcl_oow_t) == HCL_SIZEOF(hcl_oop_t));
hcl = HCL_MMGR_ALLOC (mmgr, HCL_SIZEOF(*hcl) + xtnsize);
if (hcl)
@ -87,13 +87,24 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
{
HCL_MEMSET (hcl, 0, HCL_SIZEOF(*hcl));
hcl->mmgr = mmgr;
hcl->cmgr = hcl_getutf8cmgr();
hcl->vmprim = *vmprim;
hcl->option.log_mask = ~0u;
hcl->option.log_maxcapa = HCL_DFL_LOG_MAXCAPA;
hcl->option.dfl_symtab_size = HCL_DFL_SYMTAB_SIZE;
hcl->option.dfl_sysdic_size = HCL_DFL_SYSDIC_SIZE;
hcl->option.dfl_procstk_size = HCL_DFL_PROCSTK_SIZE;
hcl->log.capa = HCL_ALIGN_POW2(1, HCL_LOG_CAPA_ALIGN); /* TODO: is this a good initial size? */
/* alloate the log buffer in advance though it may get reallocated
* in put_oocs and put_ooch in logfmt.c. this is to let the logging
* routine still function despite some side-effects when
* reallocation fails */
/* +1 required for consistency with put_oocs and put_ooch in logfmt.c */
hcl->log.ptr = hcl_allocmem (hcl, (hcl->log.capa + 1) * HCL_SIZEOF(*hcl->log.ptr));
if (!hcl->log.ptr) goto oops;
/*hcl->permheap = hcl_makeheap (hcl, what is the best size???);
if (!hcl->curheap) goto oops; */
hcl->curheap = hcl_makeheap (hcl, heapsz);
@ -101,7 +112,7 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
hcl->newheap = hcl_makeheap (hcl, heapsz);
if (!hcl->newheap) goto oops;
if (hcl_rbt_init (&hcl->pmtable, mmgr, HCL_SIZEOF(hcl_ooch_t), 1) <= -1) goto oops;
if (hcl_rbt_init (&hcl->pmtable, hcl, HCL_SIZEOF(hcl_ooch_t), 1) <= -1) goto oops;
hcl_rbt_setstyle (&hcl->pmtable, hcl_getrbtstyle(HCL_RBT_STYLE_INLINE_COPIERS));
fill_bigint_tables (hcl);
@ -111,6 +122,8 @@ oops:
if (hcl->newheap) hcl_killheap (hcl, hcl->newheap);
if (hcl->curheap) hcl_killheap (hcl, hcl->curheap);
if (hcl->permheap) hcl_killheap (hcl, hcl->permheap);
if (hcl->log.ptr) hcl_freemem (hcl, hcl->log.ptr);
hcl->log.capa = 0;
return -1;
}
@ -121,7 +134,7 @@ static hcl_rbt_walk_t unload_primitive_module (hcl_rbt_t* rbt, hcl_rbt_pair_t* p
md = HCL_RBT_VPTR(pair);
if (md->mod.unload) md->mod.unload (hcl, &md->mod);
if (md->handle) hcl->vmprim.mod_close (hcl, md->handle);
if (md->handle) hcl->vmprim.dl_close (hcl, md->handle);
return HCL_RBT_WALK_FORWARD;
}
@ -130,6 +143,34 @@ void hcl_fini (hcl_t* hcl)
{
hcl_cb_t* cb;
hcl_rbt_walk (&hcl->pmtable, unload_primitive_module, hcl);
hcl_rbt_fini (&hcl->pmtable);
if (hcl->log.len > 0)
{
/* flush pending log messages just in case. */
HCL_ASSERT (hcl, hcl->log.ptr != HCL_NULL);
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
}
for (cb = hcl->cblist; cb; cb = cb->next)
{
if (cb->fini) cb->fini (hcl);
}
if (hcl->log.len > 0)
{
/* flush pending log message that could be generated by the fini
* callbacks. however, the actual logging might not be produced at
* this point because one of the callbacks could arrange to stop
* logging */
HCL_ASSERT (hcl, hcl->log.ptr != HCL_NULL);
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
}
/* deregister all callbacks */
while (hcl->cblist) hcl_deregcb (hcl, hcl->cblist);
if (hcl->sem_list)
{
hcl_freemem (hcl, hcl->sem_list);
@ -144,13 +185,6 @@ void hcl_fini (hcl_t* hcl)
hcl->sem_heap_count = 0;
}
for (cb = hcl->cblist; cb; cb = cb->next)
{
if (cb->fini) cb->fini (hcl);
}
hcl_rbt_walk (&hcl->pmtable, unload_primitive_module, hcl);
hcl_rbt_fini (&hcl->pmtable);
if (hcl->code.bc.arr)
{
@ -178,53 +212,33 @@ void hcl_fini (hcl_t* hcl)
hcl_killheap (hcl, hcl->curheap);
hcl_killheap (hcl, hcl->permheap);
/* deregister all callbacks */
while (hcl->cblist) hcl_deregcb (hcl, hcl->cblist);
if (hcl->log.ptr)
{
/* make sure to flush your log message */
/* TODO: flush unwritten message */
hcl_freemem (hcl, hcl->log.ptr);
hcl->log.capa = 0;
hcl->log.len = 0;
}
}
hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl)
{
return hcl->mmgr;
}
void* hcl_getxtn (hcl_t* hcl)
{
return (void*)(hcl + 1);
}
hcl_errnum_t hcl_geterrnum (hcl_t* hcl)
{
return hcl->errnum;
}
void hcl_seterrnum (hcl_t* hcl, hcl_errnum_t errnum)
{
hcl->errnum = errnum;
}
int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
{
switch (id)
{
case HCL_TRAIT:
hcl->option.trait = *(const int*)value;
hcl->option.trait = *(const unsigned int*)value;
#if !defined(NDEBUG)
hcl->option.karatsuba_cutoff = ((hcl->option.trait & HCL_DEBUG_BIGINT)? HCL_KARATSUBA_CUTOFF_DEBUG: HCL_KARATSUBA_CUTOFF);
#endif
return 0;
case HCL_LOG_MASK:
hcl->option.log_mask = *(const unsigned int*)value;
return 0;
case HCL_LOG_MAXCAPA:
hcl->option.log_maxcapa = *(hcl_oow_t*)value;
return 0;
case HCL_SYMTAB_SIZE:
{
hcl_oow_t w;
@ -260,7 +274,7 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
}
einval:
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
@ -269,13 +283,17 @@ int hcl_getoption (hcl_t* hcl, hcl_option_t id, void* value)
switch (id)
{
case HCL_TRAIT:
*(int*)value = hcl->option.trait;
*(unsigned int*)value = hcl->option.trait;
return 0;
case HCL_LOG_MASK:
*(unsigned int*)value = hcl->option.log_mask;
return 0;
case HCL_LOG_MAXCAPA:
*(hcl_oow_t*)value = hcl->option.log_maxcapa;
return 0;
case HCL_SYMTAB_SIZE:
*(hcl_oow_t*)value = hcl->option.dfl_symtab_size;
return 0;
@ -289,7 +307,7 @@ int hcl_getoption (hcl_t* hcl, hcl_option_t id, void* value)
return 0;
};
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
@ -330,7 +348,7 @@ void* hcl_allocmem (hcl_t* hcl, hcl_oow_t size)
void* ptr;
ptr = HCL_MMGR_ALLOC (hcl->mmgr, size);
if (!ptr) hcl->errnum = HCL_ESYSMEM;
if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
return ptr;
}
@ -339,7 +357,7 @@ void* hcl_callocmem (hcl_t* hcl, hcl_oow_t size)
void* ptr;
ptr = HCL_MMGR_ALLOC (hcl->mmgr, size);
if (!ptr) hcl->errnum = HCL_ESYSMEM;
if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
else HCL_MEMSET (ptr, 0, size);
return ptr;
}
@ -347,7 +365,7 @@ void* hcl_callocmem (hcl_t* hcl, hcl_oow_t size)
void* hcl_reallocmem (hcl_t* hcl, void* ptr, hcl_oow_t size)
{
ptr = HCL_MMGR_REALLOC (hcl->mmgr, ptr, size);
if (!ptr) hcl->errnum = HCL_ESYSMEM;
if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
return ptr;
}
@ -359,13 +377,13 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
void hcl_getsynerr (hcl_t* hcl, hcl_synerr_t* synerr)
{
HCL_ASSERT (hcl->c != HCL_NULL);
HCL_ASSERT (hcl, hcl->c != HCL_NULL);
if (synerr) *synerr = hcl->c->synerr;
}
void hcl_setsynerr (hcl_t* hcl, hcl_synerrnum_t num, const hcl_ioloc_t* loc, const hcl_oocs_t* tgt)
{
hcl->errnum = HCL_ESYNERR;
hcl_seterrnum (hcl, HCL_ESYNERR);
hcl->c->synerr.num = num;
/* The SCO compiler complains of this ternary operation saying:

415
lib/hcl.h
View File

@ -41,12 +41,43 @@
enum hcl_errnum_t
{
HCL_ENOERR, /**< no error */
HCL_EOTHER, /**< other error */
HCL_EGENERIC, /**< generic error */
HCL_ENOIMPL, /**< not implemented */
HCL_ESYSERR, /**< subsystem error */
HCL_EINTERN, /**< internal error */
HCL_ESYSMEM, /**< insufficient system memory */
HCL_EOOMEM, /**< insufficient object memory */
HCL_ETYPE, /**< invalid class/type */
HCL_EINVAL, /**< invalid parameter or data */
HCL_ENOENT, /**< data not found */
HCL_EEXIST, /**< existing/duplicate data */
HCL_EBUSY,
HCL_EACCES,
HCL_EPERM,
HCL_ENOTDIR,
HCL_EINTR,
HCL_EPIPE,
HCL_EAGAIN,
HCL_EBADHND,
HCL_EFRMFLOOD, /**< too many frames */
HCL_EMSGRCV, /**< mesasge receiver error */
HCL_EMSGSND, /**< message sending error. even doesNotUnderstand: is not found */
HCL_ENUMARGS, /**< wrong number of arguments */
HCL_ERANGE, /**< range error. overflow and underflow */
HCL_EBCFULL, /**< byte-code full */
HCL_EDFULL, /**< dictionary full */
HCL_EPFULL, /**< processor full */
HCL_EFINIS, /**< unexpected end of data/input/stream/etc */
HCL_EXXXXX2, /**< **** not used ***** */
HCL_EDIVBY0, /**< divide by zero */
HCL_EIOERR, /**< I/O error */
HCL_EECERR, /**< encoding conversion error */
HCL_EBUFFULL, /**< buffer full */
#if 0
HCL_EINVAL, /**< invalid parameter or data */
HCL_ETOOBIG, /**< data too large */
HCL_EPERM, /**< operation not permitted */
@ -62,6 +93,8 @@ enum hcl_errnum_t
HCL_EIOERR, /**< I/O error */
HCL_EECERR, /**< encoding conversion error */
HCL_EFINIS, /**< end of data/input/stream/etc */
#endif
HCL_ESYNERR, /**< syntax error */
HCL_ECALL, /**< runtime error - cannot call */
HCL_ERECALL, /**< runtime error - cannot call again */
@ -121,14 +154,19 @@ enum hcl_option_t
{
HCL_TRAIT,
HCL_LOG_MASK,
HCL_LOG_MAXCAPA,
HCL_SYMTAB_SIZE, /* default system table size */
HCL_SYSDIC_SIZE, /* default system dictionary size */
HCL_PROCSTK_SIZE /* default process stack size */
};
typedef enum hcl_option_t hcl_option_t;
/* [NOTE] ensure that it is a power of 2 */
#define HCL_LOG_CAPA_ALIGN 512
enum hcl_option_dflval_t
{
HCL_DFL_LOG_MAXCAPA = HCL_LOG_CAPA_ALIGN * 16,
HCL_DFL_SYMTAB_SIZE = 5000,
HCL_DFL_SYSDIC_SIZE = 5000,
HCL_DFL_PROCSTK_SIZE = 5000
@ -137,12 +175,17 @@ typedef enum hcl_option_dflval_t hcl_option_dflval_t;
enum hcl_trait_t
{
#if !defined(NDEBUG)
HCL_DEBUG_GC = (1 << 0),
HCL_DEBUG_BIGINT = (1 << 1),
#endif
/* perform no garbage collection when the heap is full.
* you still can use hcl_gc() explicitly. */
HCL_NOGC = (1 << 0),
HCL_NOGC = (1 << 8),
/* wait for running process when exiting from the main method */
HCL_AWAIT_PROCS = (1 << 1)
HCL_AWAIT_PROCS = (1 << 9)
};
typedef enum hcl_trait_t hcl_trait_t;
@ -172,13 +215,15 @@ typedef struct hcl_obj_word_t* hcl_oop_word_t;
/* ========================================================================= */
/* BIGINT TYPES AND MACROS */
/* ========================================================================= */
#if HCL_SIZEOF_UINTMAX_T > HCL_SIZEOF_OOW_T
#if (HCL_SIZEOF_UINTMAX_T > HCL_SIZEOF_OOW_T)
# define HCL_USE_FULL_WORD
#endif
#if defined(HCL_USE_FULL_WORD)
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
@ -189,7 +234,9 @@ typedef struct hcl_obj_word_t* hcl_oop_word_t;
#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
@ -634,17 +681,22 @@ typedef struct hcl_t hcl_t;
* ========================================================================= */
#define HCL_MOD_NAME_LEN_MAX 120
typedef void* (*hcl_mod_open_t) (hcl_t* hcl, const hcl_uch_t* name);
typedef void (*hcl_mod_close_t) (hcl_t* hcl, void* handle);
typedef void* (*hcl_mod_getsym_t) (hcl_t* hcl, void* handle, const hcl_uch_t* name);
typedef void* (*hcl_vmprim_dlopen_t) (hcl_t* hcl, const hcl_uch_t* name);
typedef void (*hcl_vmprim_dlclose_t) (hcl_t* hcl, void* handle);
typedef void* (*hcl_vmprim_dlsym_t) (hcl_t* hcl, void* handle, const hcl_uch_t* name);
typedef void (*hcl_log_write_t) (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* msg, hcl_oow_t len);
typedef void (*hcl_syserrstrb_t) (hcl_t* hcl, int syserr, hcl_bch_t* buf, hcl_oow_t len);
typedef void (*hcl_syserrstru_t) (hcl_t* hcl, int syserr, hcl_uch_t* buf, hcl_oow_t len);
struct hcl_vmprim_t
{
hcl_mod_open_t mod_open;
hcl_mod_close_t mod_close;
hcl_mod_getsym_t mod_getsym;
hcl_log_write_t log_write;
hcl_vmprim_dlopen_t dl_open;
hcl_vmprim_dlclose_t dl_close;
hcl_vmprim_dlsym_t dl_getsym;
hcl_log_write_t log_write;
hcl_syserrstrb_t syserrstrb;
hcl_syserrstru_t syserrstru;
};
typedef struct hcl_vmprim_t hcl_vmprim_t;
@ -789,6 +841,15 @@ struct hcl_prim_mod_data_t
};
typedef struct hcl_prim_mod_data_t hcl_prim_mod_data_t;
struct hcl_sbuf_t
{
hcl_ooch_t* ptr;
hcl_oow_t len;
hcl_oow_t capa;
};
typedef struct hcl_sbuf_t hcl_sbuf_t;
/* =========================================================================
* HCL VM
* ========================================================================= */
@ -807,15 +868,34 @@ typedef struct hcl_compiler_t hcl_compiler_t;
struct hcl_t
{
hcl_mmgr_t* mmgr;
hcl_cmgr_t* cmgr;
hcl_errnum_t errnum;
struct
{
union
{
hcl_ooch_t ooch[2048];
hcl_bch_t bch[2048];
hcl_uch_t uch[2048];
} tmpbuf;
hcl_ooch_t buf[2048];
hcl_oow_t len;
} errmsg;
struct
{
int trait;
unsigned int log_mask;
hcl_oow_t log_maxcapa;
hcl_oow_t dfl_symtab_size;
hcl_oow_t dfl_sysdic_size;
hcl_oow_t dfl_procstk_size;
#if !defined(NDEBUG)
/* set automatically when trait is set */
int karatsuba_cutoff;
#endif
} option;
hcl_vmprim_t vmprim;
@ -829,6 +909,7 @@ struct hcl_t
hcl_oow_t len;
hcl_oow_t capa;
int last_mask;
int default_type_mask;
} log;
/* ========================= */
@ -899,6 +980,8 @@ struct hcl_t
} bigint[37];
/* == END BIGINT CONVERSION == */
hcl_sbuf_t sbuf[64];
struct
{
struct
@ -959,26 +1042,198 @@ struct hcl_t
#define HCL_STACK_SETRETTORCV(hcl,nargs) (HCL_STACK_POPS(hcl, nargs))
/* =========================================================================
* STRING ENCODING CONVERSION
* ========================================================================= */
#if defined(HCL_OOCH_IS_UCH)
# define hcl_convootobchars(hcl,oocs,oocslen,bcs,bcslen) hcl_convutobchars(hcl,oocs,oocslen,bcs,bcslen)
# define hcl_convbtooochars(hcl,bcs,bcslen,oocs,oocslen) hcl_convbtouchars(hcl,bcs,bcslen,oocs,oocslen)
# define hcl_convootobcstr(hcl,oocs,oocslen,bcs,bcslen) hcl_convutobcstr(hcl,oocs,oocslen,bcs,bcslen)
# define hcl_convbtooocstr(hcl,bcs,bcslen,oocs,oocslen) hcl_convbtoucstr(hcl,bcs,bcslen,oocs,oocslen)
#else
# define hcl_convootouchars(hcl,oocs,oocslen,bcs,bcslen) hcl_convbtouchars(hcl,oocs,oocslen,bcs,bcslen)
# define hcl_convutooochars(hcl,bcs,bcslen,oocs,oocslen) hcl_convutobchars(hcl,bcs,bcslen,oocs,oocslen)
# define hcl_convootoucstr(hcl,oocs,oocslen,bcs,bcslen) hcl_convbtoucstr(hcl,oocs,oocslen,bcs,bcslen)
# define hcl_convutooocstr(hcl,bcs,bcslen,oocs,oocslen) hcl_convutobcstr(hcl,bcs,bcslen,oocs,oocslen)
#endif
HCL_EXPORT int hcl_convbtouchars (
hcl_t* hcl,
const hcl_bch_t* bcs,
hcl_oow_t* bcslen,
hcl_uch_t* ucs,
hcl_oow_t* ucslen
);
HCL_EXPORT int hcl_convutobchars (
hcl_t* hcl,
const hcl_uch_t* ucs,
hcl_oow_t* ucslen,
hcl_bch_t* bcs,
hcl_oow_t* bcslen
);
/**
* The hcl_convbtoucstr() function converts a null-terminated byte string
* to a wide string.
*/
HCL_EXPORT int hcl_convbtoucstr (
hcl_t* hcl,
const hcl_bch_t* bcs,
hcl_oow_t* bcslen,
hcl_uch_t* ucs,
hcl_oow_t* ucslen
);
/**
* The hcl_convutobcstr() function converts a null-terminated wide string
* to a byte string.
*/
int hcl_convutobcstr (
hcl_t* hcl,
const hcl_uch_t* ucs,
hcl_oow_t* ucslen,
hcl_bch_t* bcs,
hcl_oow_t* bcslen
);
#if defined(HCL_OOCH_IS_UCH)
# define hcl_dupootobcharswithheadroom(hcl,hrb,oocs,oocslen,bcslen) hcl_duputobcharswithheadroom(hcl,hrb,oocs,oocslen,bcslen)
# define hcl_dupbtooocharswithheadroom(hcl,hrb,bcs,bcslen,oocslen) hcl_dupbtoucharswithheadroom(hcl,hrb,bcs,bcslen,oocslen)
# define hcl_dupootobchars(hcl,oocs,oocslen,bcslen) hcl_duputobchars(hcl,oocs,oocslen,bcslen)
# define hcl_dupbtooochars(hcl,bcs,bcslen,oocslen) hcl_dupbtouchars(hcl,bcs,bcslen,oocslen)
# define hcl_dupootobcstrwithheadroom(hcl,hrb,oocs,bcslen) hcl_duputobcstrwithheadroom(hcl,hrb,oocs,bcslen)
# define hcl_dupbtooocstrwithheadroom(hcl,hrb,bcs,oocslen) hcl_dupbtoucstrwithheadroom(hcl,hrb,bcs,oocslen)
# define hcl_dupootobcstr(hcl,oocs,bcslen) hcl_duputobcstr(hcl,oocs,bcslen)
# define hcl_dupbtooocstr(hcl,bcs,oocslen) hcl_dupbtoucstr(hcl,bcs,oocslen)
#else
# define hcl_dupootoucharswithheadroom(hcl,hrb,oocs,oocslen,ucslen) hcl_dupbtoucharswithheadroom(hcl,hrb,oocs,oocslen,ucslen)
# define hcl_duputooocharswithheadroom(hcl,hrb,ucs,ucslen,oocslen) hcl_duputobcharswithheadroom(hcl,hrb,ucs,ucslen,oocslen)
# define hcl_dupootouchars(hcl,oocs,oocslen,ucslen) hcl_dupbtouchars(hcl,oocs,oocslen,ucslen)
# define hcl_duputooochars(hcl,ucs,ucslen,oocslen) hcl_duputobchars(hcl,ucs,ucslen,oocslen)
# define hcl_dupootoucstrwithheadroom(hcl,hrb,oocs,ucslen) hcl_dupbtoucstrwithheadroom(hcl,hrb,oocs,ucslen)
# define hcl_duputooocstrwithheadroom(hcl,hrb,ucs,oocslen) hcl_duputobcstrwithheadroom(hcl,hrb,ucs,oocslen)
# define hcl_dupootoucstr(hcl,oocs,ucslen) hcl_dupbtoucstr(hcl,oocs,ucslen)
# define hcl_duputooocstr(hcl,ucs,oocslen) hcl_duputobcstr(hcl,ucs,oocslen)
#endif
HCL_EXPORT hcl_uch_t* hcl_dupbtoucharswithheadroom (
hcl_t* hcl,
hcl_oow_t headroom_bytes,
const hcl_bch_t* bcs,
hcl_oow_t bcslen,
hcl_oow_t* ucslen
);
HCL_EXPORT hcl_bch_t* hcl_duputobcharswithheadroom (
hcl_t* hcl,
hcl_oow_t headroom_bytes,
const hcl_uch_t* ucs,
hcl_oow_t ucslen,
hcl_oow_t* bcslen
);
HCL_EXPORT hcl_uch_t* hcl_dupbtouchars (
hcl_t* hcl,
const hcl_bch_t* bcs,
hcl_oow_t bcslen,
hcl_oow_t* ucslen
);
HCL_EXPORT hcl_bch_t* hcl_duputobchars (
hcl_t* hcl,
const hcl_uch_t* ucs,
hcl_oow_t ucslen,
hcl_oow_t* bcslen
);
HCL_EXPORT hcl_uch_t* hcl_dupbtoucstrwithheadroom (
hcl_t* hcl,
hcl_oow_t headroom_bytes,
const hcl_bch_t* bcs,
hcl_oow_t* ucslen
);
HCL_EXPORT hcl_bch_t* hcl_duputobcstrwithheadroom (
hcl_t* hcl,
hcl_oow_t headroom_bytes,
const hcl_uch_t* ucs,
hcl_oow_t* bcslen
);
HCL_EXPORT hcl_uch_t* hcl_dupbtoucstr (
hcl_t* hcl,
const hcl_bch_t* bcs,
hcl_oow_t* ucslen /* optional: length of returned string */
);
HCL_EXPORT hcl_bch_t* hcl_duputobcstr (
hcl_t* hcl,
const hcl_uch_t* ucs,
hcl_oow_t* bcslen /* optional: length of returned string */
);
#if defined(HCL_OOCH_IS_UCH)
# define hcl_dupoochars(hcl,oocs,oocslen) hcl_dupuchars(hcl,oocs,oocslen)
#else
# define hcl_dupoochars(hcl,oocs,oocslen) hcl_dupbchars(hcl,oocs,oocslen)
#endif
HCL_EXPORT hcl_uch_t* hcl_dupuchars (
hcl_t* hcl,
const hcl_uch_t* ucs,
hcl_oow_t ucslen
);
HCL_EXPORT hcl_bch_t* hcl_dupbchars (
hcl_t* hcl,
const hcl_bch_t* bcs,
hcl_oow_t bcslen
);
/* =========================================================================
* HCL VM LOGGING
* ========================================================================= */
enum hcl_log_mask_t
{
HCL_LOG_DEBUG = (1 << 0),
HCL_LOG_INFO = (1 << 1),
HCL_LOG_WARN = (1 << 2),
HCL_LOG_ERROR = (1 << 3),
HCL_LOG_FATAL = (1 << 4),
HCL_LOG_DEBUG = (1 << 0),
HCL_LOG_INFO = (1 << 1),
HCL_LOG_WARN = (1 << 2),
HCL_LOG_ERROR = (1 << 3),
HCL_LOG_FATAL = (1 << 4),
HCL_LOG_UNTYPED = (1 << 6), /* only to be used by HCL_DEBUGx() and HCL_INFOx() */
HCL_LOG_COMPILER = (1 << 7),
HCL_LOG_VM = (1 << 8),
HCL_LOG_MNEMONIC = (1 << 9), /* bytecode mnemonic */
HCL_LOG_GC = (1 << 10),
HCL_LOG_IC = (1 << 11), /* instruction cycle, fetch-decode-execute */
HCL_LOG_PRIMITIVE = (1 << 12),
HCL_LOG_APP = (1 << 13), /* hcl applications, set by hcl logging primitive */
HCL_LOG_ALL_LEVELS = (HCL_LOG_DEBUG | HCL_LOG_INFO | HCL_LOG_WARN | HCL_LOG_ERROR | HCL_LOG_FATAL),
HCL_LOG_ALL_TYPES = (HCL_LOG_UNTYPED | HCL_LOG_COMPILER | HCL_LOG_VM | HCL_LOG_MNEMONIC | HCL_LOG_GC | HCL_LOG_IC | HCL_LOG_PRIMITIVE | HCL_LOG_APP),
HCL_LOG_STDOUT = (1 << 14), /* write log messages to stdout without timestamp. HCL_LOG_STDOUT wins over HCL_LOG_STDERR. */
HCL_LOG_STDERR = (1 << 15) /* write log messages to stderr without timestamp. */
HCL_LOG_MNEMONIC = (1 << 8), /* bytecode mnemonic */
HCL_LOG_GC = (1 << 9),
HCL_LOG_IC = (1 << 10), /* instruction cycle, fetch-decode-execute */
HCL_LOG_APP = (1 << 11) /* hcl applications, set by hcl logging primitive */
};
typedef enum hcl_log_mask_t hcl_log_mask_t;
#define HCL_LOG_ENABLED(hcl,mask) ((hcl)->option.log_mask & (mask))
/* all bits must be set to get enabled */
#define HCL_LOG_ENABLED(hcl,mask) (((hcl)->option.log_mask & (mask)) == (mask))
#define HCL_LOG0(hcl,mask,fmt) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt); } while(0)
#define HCL_LOG1(hcl,mask,fmt,a1) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt, a1); } while(0)
@ -986,20 +1241,47 @@ typedef enum hcl_log_mask_t hcl_log_mask_t;
#define HCL_LOG3(hcl,mask,fmt,a1,a2,a3) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt, a1, a2, a3); } while(0)
#define HCL_LOG4(hcl,mask,fmt,a1,a2,a3,a4) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt, a1, a2, a3, a4); } while(0)
#define HCL_LOG5(hcl,mask,fmt,a1,a2,a3,a4,a5) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt, a1, a2, a3, a4, a5); } while(0)
#define HCL_LOG6(hcl,mask,fmt,a1,a2,a3,a4,a5,a6) do { if (HCL_LOG_ENABLED(hcl,mask)) hcl_logbfmt(hcl, mask, fmt, a1, a2, a3, a4, a5, a6); } while(0)
#define HCL_DEBUG0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_DEBUG, fmt)
#define HCL_DEBUG1(hcl,fmt,a1) HCL_LOG1(hcl, HCL_LOG_DEBUG, fmt, a1)
#define HCL_DEBUG2(hcl,fmt,a1,a2) HCL_LOG2(hcl, HCL_LOG_DEBUG, fmt, a1, a2)
#define HCL_DEBUG3(hcl,fmt,a1,a2,a3) HCL_LOG3(hcl, HCL_LOG_DEBUG, fmt, a1, a2, a3)
#define HCL_DEBUG4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_DEBUG, fmt, a1, a2, a3, a4)
#define HCL_DEBUG5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_DEBUG, fmt, a1, a2, a3, a4, a5)
#if defined(NDEBUG)
/* [NOTE]
* get rid of debugging message totally regardless of
* the log mask in the release build.
*/
# define HCL_DEBUG0(hcl,fmt)
# define HCL_DEBUG1(hcl,fmt,a1)
# define HCL_DEBUG2(hcl,fmt,a1,a2)
# define HCL_DEBUG3(hcl,fmt,a1,a2,a3)
# define HCL_DEBUG4(hcl,fmt,a1,a2,a3,a4)
# define HCL_DEBUG5(hcl,fmt,a1,a2,a3,a4,a5)
# define HCL_DEBUG6(hcl,fmt,a1,a2,a3,a4,a5,a6)
#else
# define HCL_DEBUG0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt)
# define HCL_DEBUG1(hcl,fmt,a1) HCL_LOG1(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1)
# define HCL_DEBUG2(hcl,fmt,a1,a2) HCL_LOG2(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2)
# define HCL_DEBUG3(hcl,fmt,a1,a2,a3) HCL_LOG3(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3)
# define HCL_DEBUG4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4)
# define HCL_DEBUG5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5)
# define HCL_DEBUG6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG6(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6)
#endif
#define HCL_INFO0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_INFO, fmt)
#define HCL_INFO1(hcl,fmt,a1) HCL_LOG1(hcl, HCL_LOG_INFO, fmt, a1)
#define HCL_INFO2(hcl,fmt,a1,a2) HCL_LOG2(hcl, HCL_LOG_INFO, fmt, a1, a2)
#define HCL_INFO3(hcl,fmt,a1,a2,a3) HCL_LOG3(hcl, HCL_LOG_INFO, fmt, a1, a2, a3)
#define HCL_INFO4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_INFO, fmt, a1, a2, a3, a4)
#define HCL_INFO5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_INFO, fmt, a1, a2, a3, a4, a5
#define HCL_INFO0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt)
#define HCL_INFO1(hcl,fmt,a1) HCL_LOG1(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1)
#define HCL_INFO2(hcl,fmt,a1,a2) HCL_LOG2(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2)
#define HCL_INFO3(hcl,fmt,a1,a2,a3) HCL_LOG3(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3)
#define HCL_INFO4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4)
#define HCL_INFO5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5)
#define HCL_INFO6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG6(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6)
/* =========================================================================
* HCL ASSERTION
* ========================================================================= */
#if defined(NDEBUG)
# define HCL_ASSERT(hcl,expr) ((void)0)
#else
# define HCL_ASSERT(hcl,expr) ((void)((expr) || (hcl_assertfailed (hcl, #expr, __FILE__, __LINE__), 0)))
#endif
/* =========================================================================
* HCL COMMON OBJECTS
@ -1098,24 +1380,57 @@ HCL_EXPORT void hcl_fini (
);
HCL_EXPORT hcl_mmgr_t* hcl_getmmgr (
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl) { return hcl->mmgr; }
static HCL_INLINE void* hcl_getxtn (hcl_t* hcl) { return (void*)(hcl + 1); }
/*static HCL_INLINE hcl_cmgr_t* hcl_getcmgr (hcl_t* hcl) { return hcl->cmgr; }
static HCL_INLINE void hcl_setcmgr (hcl_t* hcl, hcl_cmgr_t* cmgr) { hcl->cmgr = cmgr; }*/
static HCL_INLINE hcl_errnum_t hcl_geterrnum (hcl_t* hcl) { return hcl->errnum; }
static HCL_INLINE void hcl_seterrnum (hcl_t* hcl, hcl_errnum_t errnum) { hcl->errnum = errnum; hcl->errmsg.len = 0; }
#else
# define hcl_getmmgr(hcl) ((hcl)->mmgr)
# define hcl_getxtn(hcl) ((void*)((hcl) + 1))
# define hcl_getcmgr(hcl) ((hcl)->cmgr)
# define hcl_setcmgr(hcl,mgr) ((hcl)->cmgr = (mgr))
# define hcl_geterrnum(hcl) ((hcl)->errnum)
# define hcl_seterrnum(hcl,num) ((hcl)->errmsg.len = 0, (hcl)->errnum = (num))
#endif
HCL_EXPORT void hcl_seterrbfmt (
hcl_t* hcl,
hcl_errnum_t errnum,
const hcl_bch_t* fmt,
...
);
HCL_EXPORT void hcl_seterrufmt (
hcl_t* hcl,
hcl_errnum_t errnum,
const hcl_uch_t* fmt,
...
);
HCL_EXPORT void hcl_seterrwithsyserr (
hcl_t* hcl,
int syserr
);
HCL_EXPORT const hcl_ooch_t* hcl_geterrstr (
hcl_t* hcl
);
HCL_EXPORT void* hcl_getxtn (
HCL_EXPORT const hcl_ooch_t* hcl_geterrmsg (
hcl_t* hcl
);
HCL_EXPORT hcl_errnum_t hcl_geterrnum (
HCL_EXPORT const hcl_ooch_t* hcl_backuperrmsg (
hcl_t* hcl
);
HCL_EXPORT void hcl_seterrnum (
hcl_t* hcl,
hcl_errnum_t errnum
);
/**
* The hcl_getoption() function gets the value of an option
* specified by \a id into the buffer pointed to by \a value.
@ -1123,8 +1438,8 @@ HCL_EXPORT void hcl_seterrnum (
* \return 0 on success, -1 on failure
*/
HCL_EXPORT int hcl_getoption (
hcl_t* hcl,
hcl_option_t id,
hcl_t* hcl,
hcl_option_t id,
void* value
);
@ -1135,8 +1450,8 @@ HCL_EXPORT int hcl_getoption (
* \return 0 on success, -1 on failure
*/
HCL_EXPORT int hcl_setoption (
hcl_t* hcl,
hcl_option_t id,
hcl_t* hcl,
hcl_option_t id,
const void* value
);
@ -1416,6 +1731,14 @@ HCL_EXPORT hcl_oop_t hcl_makeprim (
hcl_oow_t maxargs
);
HCL_EXPORT void hcl_assertfailed (
hcl_t* hcl,
const hcl_bch_t* expr,
const hcl_bch_t* file,
hcl_oow_t line
);
#if defined(__cplusplus)
}
#endif

10
lib/heap.c
View File

@ -33,7 +33,7 @@ hcl_heap_t* hcl_makeheap (hcl_t* hcl, hcl_oow_t size)
heap = (hcl_heap_t*)HCL_MMGR_ALLOC(hcl->mmgr, HCL_SIZEOF(*heap) + size);
if (!heap)
{
hcl->errnum = HCL_ESYSMEM;
hcl_seterrnum (hcl, HCL_ESYSMEM);
return HCL_NULL;
}
@ -44,9 +44,9 @@ hcl_heap_t* hcl_makeheap (hcl_t* hcl, hcl_oow_t size)
heap->ptr = (hcl_uint8_t*)HCL_ALIGN(((hcl_uintptr_t)heap->base), HCL_SIZEOF(hcl_oop_t));
heap->limit = heap->base + size;
HCL_ASSERT (heap->ptr >= heap->base);
HCL_ASSERT (heap->limit >= heap->base );
HCL_ASSERT (heap->limit - heap->base == size);
HCL_ASSERT (hcl, heap->ptr >= heap->base);
HCL_ASSERT (hcl, heap->limit >= heap->base );
HCL_ASSERT (hcl, heap->limit - heap->base == size);
/* if size is too small, heap->ptr may go past heap->limit even at
* this moment depending on the alignment of heap->base. subsequent
@ -68,7 +68,7 @@ void* hcl_allocheapmem (hcl_t* hcl, hcl_heap_t* heap, hcl_oow_t size)
/* check the heap size limit */
if (heap->ptr >= heap->limit || heap->limit - heap->ptr < size)
{
hcl->errnum = HCL_EOOMEM;
hcl_seterrnum (hcl, HCL_EOOMEM);
return HCL_NULL;
}

594
lib/logfmt.c
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2016 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -27,7 +27,6 @@
#include "hcl-prv.h"
/*#include <stdio.h>*/ /* for snrintf(). used for floating-point number formatting */
#include <stdarg.h>
#if defined(_MSC_VER) || defined(__BORLANDC__) || (defined(__WATCOMC__) && (__WATCOMC__ < 1200))
# define snprintf _snprintf
@ -126,12 +125,12 @@ static const hcl_bch_t hex2ascii_upper[] =
'N','O','P','Q','R','S','T','U','V','W','X','H','Z'
};
static hcl_ooch_t ooch_nullstr[] = { '(','n','u','l','l', ')','\0' };
static hcl_uch_t uch_nullstr[] = { '(','n','u','l','l', ')','\0' };
static hcl_bch_t bch_nullstr[] = { '(','n','u','l','l', ')','\0' };
typedef int (*hcl_fmtout_putch_t) (
hcl_t* hcl,
hcl_oow_t mask,
hcl_oow_t mask,
hcl_ooch_t c,
hcl_oow_t len
);
@ -160,7 +159,7 @@ struct hcl_fmtout_t
* The buffer pointed to by `nbuf' must have length >= MAXNBUF.
*/
static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t *lenp)
static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t* lenp)
{
hcl_bch_t* p;
@ -172,7 +171,7 @@ static hcl_bch_t* sprintn_lower (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, h
return p; /* returns the end */
}
static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t *lenp)
static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t* lenp)
{
hcl_bch_t* p;
@ -187,6 +186,103 @@ static hcl_bch_t* sprintn_upper (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, h
/* ------------------------------------------------------------------------- */
static int put_ooch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
{
/* this is not equivalent to put_oocs(hcl,mask,&ch, 1);
* this function is to emit a single character multiple times */
hcl_oow_t rem;
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
{
/* the mask has changed. commit the buffered text */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
redo:
rem = 0;
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa, max;
hcl_ooch_t* tmp;
max = HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len;
if (len > max)
{
/* data too big. */
rem += len - max;
len = max;
}
newcapa = HCL_ALIGN_POW2(hcl->log.len + len, HCL_LOG_CAPA_ALIGN); /* TODO: adjust this capacity */
if (newcapa > hcl->option.log_maxcapa)
{
/* [NOTE]
* it doesn't adjust newcapa to hcl->option.log_maxcapa.
* nor does it cut the input to fit it into the adjusted capacity.
* if maxcapa set is not aligned to HCL_LOG_CAPA_ALIGN,
* the largest buffer capacity may be suboptimal */
goto make_do;
}
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp)
{
make_do:
if (hcl->log.len > 0)
{
/* can't expand the buffer. just flush the existing contents */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
if (len > hcl->log.capa)
{
rem += len - hcl->log.capa;
len = hcl->log.capa;
}
}
else
{
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
}
while (len > 0)
{
hcl->log.ptr[hcl->log.len++] = ch;
len--;
}
hcl->log.last_mask = mask;
if (rem > 0)
{
len = rem;
goto redo;
}
return 1; /* success */
}
static int put_oocs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
hcl_oow_t rem;
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
@ -204,96 +300,81 @@ static int put_ooch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
}
redo:
rem = 0;
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa;
hcl_oow_t newcapa, max;
hcl_ooch_t* tmp;
if (len > HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len)
max = HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len;
if (len > max)
{
/* data too big */
hcl->errnum = HCL_ETOOBIG;
return -1;
/* data too big. */
rem += len - max;
len = max;
}
newcapa = HCL_ALIGN_POW2(hcl->log.len + len, 512); /* TODO: adjust this capacity */
if (newcapa > hcl->option.log_maxcapa)
{
/* [NOTE]
* it doesn't adjust newcapa to hcl->option.log_maxcapa.
* nor does it cut the input to fit it into the adjusted capacity.
* if maxcapa set is not aligned to HCL_LOG_CAPA_ALIGN,
* the largest buffer capacity may be suboptimal */
goto make_do;
}
newcapa = HCL_ALIGN(hcl->log.len + len, 512); /* TODO: adjust this capacity */
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp)
{
make_do:
if (hcl->log.len > 0)
{
/* can't expand the buffer. just flush the existing contents */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
goto redo;
}
return -1;
if (len > hcl->log.capa)
{
rem += len - hcl->log.capa;
len = hcl->log.capa;
}
}
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
while (len > 0)
{
hcl->log.ptr[hcl->log.len++] = ch;
len--;
}
hcl->log.last_mask = mask;
return 1; /* success */
}
static int put_oocs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
if (len <= 0) return 1;
if (hcl->log.len > 0 && hcl->log.last_mask != mask)
{
/* the mask has changed. commit the buffered text */
/* TODO: HANDLE LINE ENDING CONVENTION BETTER... */
if (hcl->log.ptr[hcl->log.len - 1] != '\n')
else
{
/* no line ending - append a line terminator */
hcl->log.ptr[hcl->log.len++] = '\n';
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
hcl->vmprim.log_write (hcl, hcl->log.last_mask, hcl->log.ptr, hcl->log.len);
hcl->log.len = 0;
}
if (len > hcl->log.capa - hcl->log.len)
{
hcl_oow_t newcapa;
hcl_ooch_t* tmp;
if (len > HCL_TYPE_MAX(hcl_oow_t) - hcl->log.len)
{
/* data too big */
hcl->errnum = HCL_ETOOBIG;
return -1;
}
newcapa = HCL_ALIGN(hcl->log.len + len, 512); /* TODO: adjust this capacity */
/* +1 to handle line ending injection more easily */
tmp = hcl_reallocmem (hcl, hcl->log.ptr, (newcapa + 1) * HCL_SIZEOF(*tmp));
if (!tmp) return -1;
hcl->log.ptr = tmp;
hcl->log.capa = newcapa;
}
HCL_MEMCPY (&hcl->log.ptr[hcl->log.len], ptr, len * HCL_SIZEOF(*ptr));
hcl->log.len += len;
hcl->log.last_mask = mask;
if (rem > 0)
{
ptr += len;
len = rem;
goto redo;
}
return 1; /* success */
}
/* ------------------------------------------------------------------------- */
typedef hcl_ooi_t (*outbfmt_t) (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...);
static hcl_ooi_t log_object (hcl_t* hcl, hcl_iocmd_t cmd, void* arg)
{
hcl_iooutarg_t* outarg = (hcl_iooutarg_t*)arg;
@ -308,21 +389,239 @@ static int print_object (hcl_t* hcl, hcl_oow_t mask, hcl_oop_t obj)
return hcl_printobj (hcl, obj, log_object, &outarg);
}
#if 0
static void print_object (hcl_t* hcl, hcl_oow_t mask, hcl_oop_t oop, outbfmt_t outbfmt)
{
if (oop == hcl->_nil)
{
outbfmt (hcl, mask, "nil");
}
else if (oop == hcl->_true)
{
outbfmt (hcl, mask, "true");
}
else if (oop == hcl->_false)
{
outbfmt (hcl, mask, "false");
}
else if (HCL_OOP_IS_SMOOI(oop))
{
outbfmt (hcl, mask, "%zd", HCL_OOP_TO_SMOOI(oop));
}
else if (HCL_OOP_IS_SMPTR(oop))
{
outbfmt (hcl, mask, "%p", HCL_OOP_TO_SMPTR(oop));
}
else if (HCL_OOP_IS_CHAR(oop))
{
outbfmt (hcl, mask, "$%.1C", HCL_OOP_TO_CHAR(oop));
}
else if (HCL_OOP_IS_ERROR(oop))
{
outbfmt (hcl, mask, "error(%zd)", HCL_OOP_TO_ERROR(oop));
}
else
{
hcl_oop_class_t c;
hcl_oow_t i;
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(oop));
c = (hcl_oop_class_t)HCL_OBJ_GET_CLASS(oop); /*HCL_CLASSOF(hcl, oop);*/
if (c == hcl->_large_negative_integer)
{
hcl_oow_t i;
outbfmt (hcl, mask, "-16r");
for (i = HCL_OBJ_GET_SIZE(oop); i > 0;)
{
outbfmt (hcl, mask, "%0*lX", (int)(HCL_SIZEOF(hcl_liw_t) * 2), (unsigned long)((hcl_oop_liword_t)oop)->slot[--i]);
}
}
else if (c == hcl->_large_positive_integer)
{
hcl_oow_t i;
outbfmt (hcl, mask, "16r");
for (i = HCL_OBJ_GET_SIZE(oop); i > 0;)
{
outbfmt (hcl, mask, "%0*lX", (int)(HCL_SIZEOF(hcl_liw_t) * 2), (unsigned long)((hcl_oop_liword_t)oop)->slot[--i]);
}
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_CHAR)
{
if (c == hcl->_symbol)
{
outbfmt (hcl, mask, "#%.*js", HCL_OBJ_GET_SIZE(oop), ((hcl_oop_char_t)oop)->slot);
}
else /*if ((hcl_oop_t)c == hcl->_string)*/
{
hcl_ooch_t ch;
int escape = 0;
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
ch = ((hcl_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
escape = 1;
break;
}
}
if (escape)
{
hcl_ooch_t escaped;
outbfmt (hcl, mask, "S'");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
ch = ((hcl_oop_char_t)oop)->slot[i];
if (ch < ' ')
{
switch (ch)
{
case '\0':
escaped = '0';
break;
case '\n':
escaped = 'n';
break;
case '\r':
escaped = 'r';
break;
case '\t':
escaped = 't';
break;
case '\f':
escaped = 'f';
break;
case '\b':
escaped = 'b';
break;
case '\v':
escaped = 'v';
break;
case '\a':
escaped = 'a';
break;
default:
escaped = ch;
break;
}
if (escaped == ch)
outbfmt (hcl, mask, "\\x%X", ch);
else
outbfmt (hcl, mask, "\\%jc", escaped);
}
else
{
outbfmt (hcl, mask, "%jc", ch);
}
}
outbfmt (hcl, mask, "'");
}
else
{
outbfmt (hcl, mask, "'%.*js'", HCL_OBJ_GET_SIZE(oop), ((hcl_oop_char_t)oop)->slot);
}
}
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_BYTE)
{
outbfmt (hcl, mask, "#[");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %d", ((hcl_oop_byte_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]");
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_HALFWORD)
{
outbfmt (hcl, mask, "#[["); /* TODO: fix this symbol/notation */
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %zX", (hcl_oow_t)((hcl_oop_halfword_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]]");
}
else if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_WORD)
{
outbfmt (hcl, mask, "#[[["); /* TODO: fix this symbol/notation */
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " %zX", ((hcl_oop_word_t)oop)->slot[i]);
}
outbfmt (hcl, mask, "]]]");
}
else if (c == hcl->_array)
{
outbfmt (hcl, mask, "#(");
for (i = 0; i < HCL_OBJ_GET_SIZE(oop); i++)
{
outbfmt (hcl, mask, " ");
print_object (hcl, mask, ((hcl_oop_oop_t)oop)->slot[i], outbfmt);
}
outbfmt (hcl, mask, ")");
}
else if (c == hcl->_class)
{
/* print the class name */
outbfmt (hcl, mask, "%.*js", HCL_OBJ_GET_SIZE(((hcl_oop_class_t)oop)->name), ((hcl_oop_class_t)oop)->name->slot);
}
else if (c == hcl->_association)
{
outbfmt (hcl, mask, "%O -> %O", ((hcl_oop_association_t)oop)->key, ((hcl_oop_association_t)oop)->value);
}
else
{
outbfmt (hcl, mask, "<<%.*js>>", HCL_OBJ_GET_SIZE(c->name), ((hcl_oop_char_t)c->name)->slot);
}
}
}
#endif
/* ------------------------------------------------------------------------- */
#undef FMTCHAR_IS_BCH
#undef FMTCHAR_IS_UCH
#undef FMTCHAR_IS_OOCH
#undef fmtchar_t
#undef logfmtv
#define fmtchar_t hcl_bch_t
#define logfmtv __logbfmtv
#define FMTCHAR_IS_BCH
#define logfmtv hcl_logbfmtv
#if defined(HCL_OOCH_IS_BCH)
# define FMTCHAR_IS_OOCH
#endif
#include "logfmtv.h"
#undef FMTCHAR_IS_BCH
#undef FMTCHAR_IS_UCH
#undef FMTCHAR_IS_OOCH
#undef fmtchar_t
#undef logfmtv
#define fmtchar_t hcl_ooch_t
#define logfmtv hcl_logoofmtv
#define FMTCHAR_IS_OOCH
#include "logfmtv.h"
#define fmtchar_t hcl_uch_t
#define logfmtv __logufmtv
#define FMTCHAR_IS_UCH
#if defined(HCL_OOCH_IS_UCH)
# define FMTCHAR_IS_OOCH
#endif
#include "logfmtv.h"
static int _logbfmtv (hcl_t* hcl, const hcl_bch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logbfmtv (hcl, fmt, data, ap, hcl_logbfmt);
}
static int _logufmtv (hcl_t* hcl, const hcl_uch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logufmtv (hcl, fmt, data, ap, hcl_logbfmt);
}
hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
{
@ -330,12 +629,23 @@ hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
va_list ap;
hcl_fmtout_t fo;
if (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES)
{
/* if a type is given, it's not untyped any more.
* mask off the UNTYPED bit */
mask &= ~HCL_LOG_UNTYPED;
/* if the default_type_mask has the UNTYPED bit on,
* it'll get turned back on */
mask |= (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES);
}
fo.mask = mask;
fo.putch = put_ooch;
fo.putcs = put_oocs;
va_start (ap, fmt);
x = hcl_logbfmtv (hcl, fmt, &fo, ap);
x = _logbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n')
@ -346,18 +656,24 @@ hcl_ooi_t hcl_logbfmt (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
return (x <= -1)? -1: fo.count;
}
hcl_ooi_t hcl_logoofmt (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* fmt, ...)
hcl_ooi_t hcl_logufmt (hcl_t* hcl, hcl_oow_t mask, const hcl_uch_t* fmt, ...)
{
int x;
va_list ap;
hcl_fmtout_t fo;
if (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES)
{
mask &= ~HCL_LOG_UNTYPED;
mask |= (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES);
}
fo.mask = mask;
fo.putch = put_ooch;
fo.putcs = put_oocs;
va_start (ap, fmt);
x = hcl_logoofmtv (hcl, fmt, &fo, ap);
x = _logufmtv (hcl, fmt, &fo, ap);
va_end (ap);
if (hcl->log.len > 0 && hcl->log.ptr[hcl->log.len - 1] == '\n')
@ -368,3 +684,135 @@ hcl_ooi_t hcl_logoofmt (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* fmt, ...)
return (x <= -1)? -1: fo.count;
}
/* --------------------------------------------------------------------------
* ERROR MESSAGE FORMATTING
* -------------------------------------------------------------------------- */
static int put_errch (hcl_t* hcl, hcl_oow_t mask, hcl_ooch_t ch, hcl_oow_t len)
{
hcl_oow_t max;
max = HCL_COUNTOF(hcl->errmsg.buf) - hcl->errmsg.len - 1;
if (len > max) len = max;
if (len <= 0) return 1;
while (len > 0)
{
hcl->errmsg.buf[hcl->errmsg.len++] = ch;
len--;
}
hcl->errmsg.buf[hcl->errmsg.len] = '\0';
return 1; /* success */
}
static int put_errcs (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* ptr, hcl_oow_t len)
{
hcl_oow_t max;
max = HCL_COUNTOF(hcl->errmsg.buf) - hcl->errmsg.len - 1;
if (len > max) len = max;
if (len <= 0) return 1;
HCL_MEMCPY (&hcl->errmsg.buf[hcl->errmsg.len], ptr, len * HCL_SIZEOF(*ptr));
hcl->errmsg.len += len;
hcl->errmsg.buf[hcl->errmsg.len] = '\0';
return 1; /* success */
}
static hcl_ooi_t __errbfmtv (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...);
static int _errbfmtv (hcl_t* hcl, const hcl_bch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logbfmtv (hcl, fmt, data, ap, __errbfmtv);
}
static int _errufmtv (hcl_t* hcl, const hcl_uch_t* fmt, hcl_fmtout_t* data, va_list ap)
{
return __logufmtv (hcl, fmt, data, ap, __errbfmtv);
}
static hcl_ooi_t __errbfmtv (hcl_t* hcl, hcl_oow_t mask, const hcl_bch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
return fo.count;
}
void hcl_seterrbfmt (hcl_t* hcl, hcl_errnum_t errnum, const hcl_bch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errbfmtv (hcl, fmt, &fo, ap);
va_end (ap);
}
void hcl_seterrufmt (hcl_t* hcl, hcl_errnum_t errnum, const hcl_uch_t* fmt, ...)
{
va_list ap;
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
va_start (ap, fmt);
_errufmtv (hcl, fmt, &fo, ap);
va_end (ap);
}
void hcl_seterrbfmtv (hcl_t* hcl, hcl_errnum_t errnum, const hcl_bch_t* fmt, va_list ap)
{
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
_errbfmtv (hcl, fmt, &fo, ap);
}
void hcl_seterrufmtv (hcl_t* hcl, hcl_errnum_t errnum, const hcl_uch_t* fmt, va_list ap)
{
hcl_fmtout_t fo;
hcl->errnum = errnum;
hcl->errmsg.len = 0;
fo.mask = 0; /* not used */
fo.putch = put_errch;
fo.putcs = put_errcs;
_errufmtv (hcl, fmt, &fo, ap);
}

166
lib/logfmtv.h
View File

@ -1,7 +1,7 @@
/*
/*/*
* $Id$
*
Copyright (c) 2014-2016 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -85,7 +85,7 @@
data->count += len; \
} while (0)
int logfmtv (hcl_t* hcl, const fmtchar_t* fmt, hcl_fmtout_t* data, va_list ap)
static int logfmtv (hcl_t* hcl, const fmtchar_t* fmt, hcl_fmtout_t* data, va_list ap, outbfmt_t outbfmt)
{
const fmtchar_t* percent;
#if defined(FMTCHAR_IS_OOCH)
@ -100,10 +100,26 @@ int logfmtv (hcl_t* hcl, const fmtchar_t* fmt, hcl_fmtout_t* data, va_list ap)
hcl_uintmax_t num = 0;
int stop = 0;
#if 0
hcl_bchbuf_t* fltfmt;
hcl_oochbuf_t* fltout;
#endif
hcl_bch_t* (*sprintn) (hcl_bch_t* nbuf, hcl_uintmax_t num, int base, hcl_ooi_t* lenp);
data->count = 0;
#if 0
fltfmt = &hcl->d->fltfmt;
fltout = &hcl->d->fltout;
fltfmt->ptr = fltfmt->buf;
fltfmt->capa = HCL_COUNTOF(fltfmt->buf) - 1;
fltout->ptr = fltout->buf;
fltout->capa = HCL_COUNTOF(fltout->buf) - 1;
#endif
while (1)
{
#if defined(FMTCHAR_IS_OOCH)
@ -225,6 +241,7 @@ reswitch:
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
if (flagc & FLAGC_LENMOD) goto invalid_format;
for (n = 0;; ++fmt)
{
n = n * 10 + ch - '0';
@ -303,7 +320,7 @@ reswitch:
goto reswitch;
/* end of length modifiers */
case 'n':
case 'n': /* number of characters printed so far */
if (lm_flag & LF_J) /* j */
*(va_arg(ap, hcl_intmax_t*)) = data->count;
else if (lm_flag & LF_Z) /* z */
@ -318,11 +335,8 @@ reswitch:
*(va_arg(ap, short int*)) = data->count;
else if (lm_flag & LF_C) /* hh */
*(va_arg(ap, char*)) = data->count;
else if (flagc & FLAGC_LENMOD)
{
hcl->errnum = HCL_EINVAL;
goto oops;
}
else if (flagc & FLAGC_LENMOD)
goto invalid_format;
else
*(va_arg(ap, int*)) = data->count;
break;
@ -347,6 +361,9 @@ reswitch:
case 'x':
base = 16;
goto handle_nosign;
case 'b':
base = 2;
goto handle_nosign;
/* end of unsigned integer conversions */
case 'p': /* pointer */
@ -363,7 +380,9 @@ reswitch:
/* zeropad must not take effect for 'c' */
if (flagc & FLAGC_ZEROPAD) padc = ' ';
if (lm_flag & LF_L) goto uppercase_c;
#if defined(HCL_OOCH_IS_UCH)
if (lm_flag & LF_J) goto uppercase_c;
#endif
lowercase_c:
bch = HCL_SIZEOF(hcl_bch_t) < HCL_SIZEOF(int)? va_arg(ap, int): va_arg(ap, hcl_bch_t);
@ -378,13 +397,16 @@ reswitch:
case 'C':
{
hcl_ooch_t ooch;
hcl_uch_t ooch;
/* zeropad must not take effect for 'C' */
if (flagc & FLAGC_ZEROPAD) padc = ' ';
if (lm_flag & LF_H) goto lowercase_c;
#if defined(HCL_OOCH_IS_BCH)
if (lm_flag & LF_J) goto lowercase_c;
#endif
uppercase_c:
ooch = HCL_SIZEOF(hcl_ooch_t) < HCL_SIZEOF(int)? va_arg(ap, int): va_arg(ap, hcl_ooch_t);
ooch = HCL_SIZEOF(hcl_uch_t) < HCL_SIZEOF(int)? va_arg(ap, int): va_arg(ap, hcl_uch_t);
/* precision 0 doesn't kill the letter */
width--;
@ -402,20 +424,19 @@ reswitch:
/* zeropad must not take effect for 'S' */
if (flagc & FLAGC_ZEROPAD) padc = ' ';
if (lm_flag & LF_L) goto uppercase_s;
#if defined(HCL_OOCH_IS_UCH)
if (lm_flag & LF_J) goto uppercase_s;
#endif
lowercase_s:
bsp = va_arg (ap, hcl_bch_t*);
if (bsp == HCL_NULL) bsp = bch_nullstr;
#if defined(HCL_OOCH_IS_UCH)
/* get the length */
for (bslen = 0; bsp[bslen]; bslen++);
if (hcl_utf8toucs (bsp, &bslen, HCL_NULL, &slen) <= -1)
{
/* conversion error */
hcl->errnum = HCL_EECERR;
goto oops;
}
if (hcl_convbtooochars (hcl, bsp, &bslen, HCL_NULL, &slen) <= -1) goto oops;
/* slen holds the length after conversion */
n = slen;
@ -429,13 +450,13 @@ reswitch:
hcl_oow_t conv_len, src_len, tot_len = 0;
while (n > 0)
{
HCL_ASSERT (bslen > tot_len);
HCL_ASSERT (hcl, bslen > tot_len);
src_len = bslen - tot_len;
conv_len = HCL_COUNTOF(conv_buf);
/* this must not fail since the dry-run above was successful */
hcl_utf8toucs (&bsp[tot_len], &src_len, conv_buf, &conv_len);
hcl_convbtooochars (hcl, &bsp[tot_len], &src_len, conv_buf, &conv_len);
tot_len += src_len;
if (conv_len > n) conv_len = n;
@ -446,39 +467,94 @@ reswitch:
}
if ((flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
break;
}
case 'S':
{
const hcl_ooch_t* sp;
/* zeropad must not take effect for 's' */
if (flagc & FLAGC_ZEROPAD) padc = ' ';
if (lm_flag & LF_H) goto lowercase_s;
uppercase_s:
sp = va_arg (ap, hcl_ooch_t*);
if (sp == HCL_NULL) sp = ooch_nullstr;
#else
if (flagc & FLAGC_DOT)
{
for (n = 0; n < precision && sp[n]; n++);
for (n = 0; n < precision && bsp[n]; n++);
}
else
{
for (n = 0; sp[n]; n++);
for (n = 0; bsp[n]; n++);
}
width -= n;
if (!(flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
PUT_OOCS (sp, n);
PUT_OOCS (bsp, n);
if ((flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
#endif
break;
}
case 'S':
{
const hcl_uch_t* usp;
hcl_oow_t uslen, slen;
/* zeropad must not take effect for 's' */
if (flagc & FLAGC_ZEROPAD) padc = ' ';
if (lm_flag & LF_H) goto lowercase_s;
#if defined(HCL_OOCH_IS_UCH)
if (lm_flag & LF_J) goto lowercase_s;
#endif
uppercase_s:
usp = va_arg (ap, hcl_uch_t*);
if (usp == HCL_NULL) usp = uch_nullstr;
#if defined(HCL_OOCH_IS_BCH)
/* get the length */
for (uslen = 0; usp[uslen]; uslen++);
if (hcl_convutooochars (hcl, usp, &uslen, HCL_NULL, &slen) <= -1) goto oops;
/* slen holds the length after conversion */
n = slen;
if ((flagc & FLAGC_DOT) && precision < slen) n = precision;
width -= n;
if (!(flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
{
hcl_ooch_t conv_buf[32];
hcl_oow_t conv_len, src_len, tot_len = 0;
while (n > 0)
{
HCL_ASSERT (hcl, uslen > tot_len);
src_len = uslen - tot_len;
conv_len = HCL_COUNTOF(conv_buf);
/* this must not fail since the dry-run above was successful */
hcl_convutooochars (hcl, &usp[tot_len], &src_len, conv_buf, &conv_len);
tot_len += src_len;
if (conv_len > n) conv_len = n;
PUT_OOCS (conv_buf, conv_len);
n -= conv_len;
}
}
if ((flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
#else
if (flagc & FLAGC_DOT)
{
for (n = 0; n < precision && usp[n]; n++);
}
else
{
for (n = 0; usp[n]; n++);
}
width -= n;
if (!(flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
PUT_OOCS (usp, n);
if ((flagc & FLAGC_LEFTADJ) && width > 0) PUT_OOCH (padc, width);
#endif
break;
}
case 'O': /* object - ignore precision, width, adjustment */
if (print_object (hcl, data->mask, va_arg (ap, hcl_oop_t)) <= -1) goto oops;
//print_object (hcl, data->mask, va_arg(ap, hcl_oop_t), outbfmt);
break;
#if 0
@ -549,8 +625,7 @@ reswitch:
#endif
else if (flagc & FLAGC_LENMOD)
{
hcl->errnum = HCL_EINVAL;
goto oops;
goto invalid_format;
}
else
{
@ -560,7 +635,7 @@ reswitch:
fmtlen = fmt - percent;
if (fmtlen > fltfmt->capa)
{
if (fltfmt->ptr == fltfmt->sbuf)
if (fltfmt->ptr == fltfmt->buf)
{
fltfmt->ptr = HCL_MMGR_ALLOC (HCL_MMGR_GETDFL(), HCL_SIZEOF(*fltfmt->ptr) * (fmtlen + 1));
if (fltfmt->ptr == HCL_NULL) goto oops;
@ -620,7 +695,7 @@ reswitch:
newcapa = precision + width + 32;
if (fltout->capa < newcapa)
{
HCL_ASSERT (fltout->ptr == fltout->sbuf);
HCL_ASSERT (hcl, fltout->ptr == fltout->buf);
fltout->ptr = HCL_MMGR_ALLOC (HCL_MMGR_GETDFL(), HCL_SIZEOF(char_t) * (newcapa + 1));
if (fltout->ptr == HCL_NULL) goto oops;
@ -706,7 +781,7 @@ handle_nosign:
* This is just a work-around for it */
int i;
for (i = 0, num = 0; i < HCL_SIZEOF(hcl_uintmax_t) / HCL_SIZEOF(hcl_oow_t); i++)
{
{
#if defined(HCL_ENDIAN_BIG)
num = num << (8 * HCL_SIZEOF(hcl_oow_t)) | (va_arg (ap, hcl_oow_t));
#else
@ -819,6 +894,11 @@ number:
if ((flagc & FLAGC_SHARP) && num != 0)
{
if (base == 2)
{
PUT_OOCH ('0', 1);
PUT_OOCH ('b', 1);
}
if (base == 8)
{
PUT_OOCH ('0', 1);

574
lib/main.c
View File

@ -25,11 +25,14 @@
*/
#include "hcl-prv.h"
#include "hcl-opt.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <limits.h>
#include <errno.h>
#include <locale.h>
#if defined(_WIN32)
@ -52,6 +55,7 @@
#else
# include <errno.h>
# include <unistd.h>
# include <fcntl.h>
# include <ltdl.h>
# define USE_LTDL
@ -73,7 +77,9 @@ struct bb_t
char buf[1024];
hcl_oow_t pos;
hcl_oow_t len;
FILE* fp;
hcl_bch_t* fn;
};
typedef struct xtn_t xtn_t;
@ -81,6 +87,10 @@ struct xtn_t
{
const char* read_path; /* main source file */
const char* print_path;
int logfd;
int logmask;
int logfd_istty;
};
/* ========================================================================= */
@ -110,84 +120,109 @@ static hcl_mmgr_t sys_mmgr =
/* ========================================================================= */
#if defined(_WIN32) || defined(__OS2__) || defined(__DOS__)
# define IS_PATH_SEP(c) ((c) == '/' || (c) == '\\')
#else
# define IS_PATH_SEP(c) ((c) == '/')
#endif
static const hcl_bch_t* get_base_name (const hcl_bch_t* path)
{
const hcl_bch_t* p, * last = HCL_NULL;
for (p = path; *p != '\0'; p++)
{
if (IS_PATH_SEP(*p)) last = p;
}
return (last == HCL_NULL)? path: (last + 1);
}
static HCL_INLINE hcl_ooi_t open_input (hcl_t* hcl, hcl_ioinarg_t* arg)
{
xtn_t* xtn = hcl_getxtn(hcl);
bb_t* bb;
FILE* infp = HCL_NULL, * outfp = HCL_NULL;
bb_t* bb = HCL_NULL;
/* TOOD: support predefined include directory as well */
if (arg->includer)
{
/* includee */
hcl_bch_t bcs[1024]; /* TODO: right buffer size */
hcl_oow_t bcslen = HCL_COUNTOF(bcs);
hcl_oow_t ucslen = ~(hcl_oow_t)0;
hcl_oow_t ucslen, bcslen, parlen;
const hcl_bch_t* fn, * fb;
if (hcl_ucstoutf8 (arg->name, &ucslen, bcs, &bcslen) <= -1)
{
hcl_seterrnum (hcl, HCL_EECERR);
return -1;
}
#if defined(HCL_OOCH_IS_UCH)
if (hcl_convootobcstr (hcl, arg->name, &ucslen, HCL_NULL, &bcslen) <= -1) goto oops;
#else
bcslen = hcl_countbcstr (arg->name);
#endif
/* TODO: make bcs relative to the includer */
#if defined(__MSDOS__) || defined(_WIN32) || defined(__OS2__)
infp = fopen (bcs, "rb");
#else
infp = fopen (bcs, "r");
#endif
fn = ((bb_t*)arg->includer->handle)->fn;
if (!infp)
{
hcl_seterrnum (hcl, HCL_EIOERR);
return -1;
}
fb = get_base_name (fn);
parlen = fb - fn;
bb = hcl_callocmem (hcl, HCL_SIZEOF(*bb) + (HCL_SIZEOF(hcl_bch_t) * (parlen + bcslen + 1)));
if (!bb) goto oops;
bb->fn = (hcl_bch_t*)(bb + 1);
hcl_copybchars (bb->fn, fn, parlen);
#if defined(HCL_OOCH_IS_UCH)
hcl_convootobcstr (hcl, arg->name, &ucslen, &bb->fn[parlen], &bcslen);
#else
hcl_copybcstr (&bb->fn[parlen], bcslen + 1, arg->name);
#endif
}
else
{
/* main stream */
#if defined(__MSDOS__) || defined(_WIN32) || defined(__OS2__)
infp = fopen (xtn->read_path, "rb");
if (xtn->print_path) outfp = fopen (xtn->print_path, "wb");
else outfp = stdout;
hcl_oow_t pathlen;
pathlen = hcl_countbcstr (xtn->read_path);
bb = hcl_callocmem (hcl, HCL_SIZEOF(*bb) + (HCL_SIZEOF(hcl_bch_t) * (pathlen + 1)));
if (!bb) goto oops;
bb->fn = (hcl_bch_t*)(bb + 1);
hcl_copybcstr (bb->fn, pathlen + 1, xtn->read_path);
}
#if defined(__DOS__) || defined(_WIN32) || defined(__OS2__)
bb->fp = fopen (bb->fn, "rb");
#else
infp = fopen (xtn->read_path, "r");
if (xtn->print_path) outfp = fopen (xtn->print_path, "w");
else outfp = stdout;
bb->fp = fopen (bb->fn, "r");
#endif
if (!infp || !outfp)
{
if (infp) fclose (infp);
if (outfp && outfp != stdout) fclose (outfp);
hcl_seterrnum (hcl, HCL_EIOERR);
return -1;
}
}
bb = hcl_callocmem (hcl, HCL_SIZEOF(*bb));
if (!bb)
if (!bb->fp)
{
if (infp) fclose (infp);
if (outfp && outfp != stdout) fclose (outfp);
return -1;
hcl_seterrnum (hcl, HCL_EIOERR);
goto oops;
}
bb->fp = infp;
arg->handle = bb;
return 0;
oops:
if (bb)
{
if (bb->fp) fclose (bb->fp);
hcl_freemem (hcl, bb);
}
return -1;
}
static HCL_INLINE hcl_ooi_t close_input (hcl_t* hcl, hcl_ioinarg_t* arg)
{
xtn_t* xtn = hcl_getxtn(hcl);
/*xtn_t* xtn = hcl_getxtn(hcl);*/
bb_t* bb;
bb = (bb_t*)arg->handle;
HCL_ASSERT (bb != HCL_NULL && bb->fp != HCL_NULL);
HCL_ASSERT (hcl, bb != HCL_NULL && bb->fp != HCL_NULL);
if (bb->fp) fclose (bb->fp);
fclose (bb->fp);
hcl_freemem (hcl, bb);
arg->handle = HCL_NULL;
arg->handle = HCL_NULL;
return 0;
}
@ -199,9 +234,8 @@ static HCL_INLINE hcl_ooi_t read_input (hcl_t* hcl, hcl_ioinarg_t* arg)
hcl_oow_t bcslen, ucslen, remlen;
int x;
bb = (bb_t*)arg->handle;
HCL_ASSERT (bb != HCL_NULL && bb->fp != HCL_NULL);
HCL_ASSERT (hcl, bb != HCL_NULL && bb->fp != HCL_NULL);
do
{
x = fgetc (bb->fp);
@ -219,14 +253,18 @@ static HCL_INLINE hcl_ooi_t read_input (hcl_t* hcl, hcl_ioinarg_t* arg)
}
while (bb->len < HCL_COUNTOF(bb->buf) && x != '\r' && x != '\n');
#if defined(HCL_OOCH_IS_UCH)
bcslen = bb->len;
ucslen = HCL_COUNTOF(arg->buf);
x = hcl_utf8toucs (bb->buf, &bcslen, arg->buf, &ucslen);
if (x <= -1 && ucslen <= 0)
{
hcl_seterrnum (hcl, HCL_EECERR);
return -1;
}
x = hcl_convbtooochars (hcl, bb->buf, &bcslen, arg->buf, &ucslen);
if (x <= -1 && ucslen <= 0) return -1;
/* if ucslen is greater than 0, i see that some characters have been
* converted properly */
#else
bcslen = (bb->len < HCL_COUNTOF(arg->buf))? bb->len: HCL_COUNTOF(arg->buf);
ucslen = bcslen;
hcl_copybchars (arg->buf, bb->buf, bcslen);
#endif
remlen = bb->len - bcslen;
if (remlen > 0) memmove (bb->buf, &bb->buf[bcslen], remlen);
@ -249,7 +287,7 @@ static hcl_ooi_t read_handler (hcl_t* hcl, hcl_iocmd_t cmd, void* arg)
return read_input (hcl, (hcl_ioinarg_t*)arg);
default:
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
}
}
@ -282,7 +320,7 @@ static HCL_INLINE hcl_ooi_t close_output (hcl_t* hcl, hcl_iooutarg_t* arg)
FILE* fp;
fp = (FILE*)arg->handle;
HCL_ASSERT (fp != HCL_NULL);
HCL_ASSERT (hcl, fp != HCL_NULL);
fclose (fp);
arg->handle = HCL_NULL;
@ -301,14 +339,18 @@ static HCL_INLINE hcl_ooi_t write_output (hcl_t* hcl, hcl_iooutarg_t* arg)
do
{
#if defined(HCL_OOCH_IS_UCH)
bcslen = HCL_COUNTOF(bcsbuf);
ucslen = arg->len - donelen;
x = hcl_ucstoutf8 (&arg->ptr[donelen], &ucslen, bcsbuf, &bcslen);
if (x <= -1 && ucslen <= 0)
{
hcl_seterrnum (hcl, HCL_EECERR);
return -1;
}
x = hcl_convootobchars (hcl, &arg->ptr[donelen], &ucslen, bcsbuf, &bcslen);
if (x <= -1 && ucslen <= 0) return -1;
#else
bcslen = HCL_COUNTOF(bcsbuf);
ucslen = arg->len - donelen;
if (ucslen > bcslen) ucslen = bcslen;
else if (ucslen < bcslen) bcslen = ucslen;
hcl_copybchars (&arg->buf[donelen], bcsbuf, bcslen);
#endif
if (fwrite (bcsbuf, HCL_SIZEOF(bcsbuf[0]), bcslen, (FILE*)arg->handle) < bcslen)
{
@ -337,7 +379,7 @@ static hcl_ooi_t print_handler (hcl_t* hcl, hcl_iocmd_t cmd, void* arg)
return write_output (hcl, (hcl_iooutarg_t*)arg);
default:
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
}
}
@ -378,51 +420,85 @@ static void log_write (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* msg, hcl_oo
#if defined(_WIN32)
# error NOT IMPLEMENTED
#elif defined(macintosh)
# error NOT IMPLEMENTED
#else
hcl_bch_t buf[256];
hcl_oow_t ucslen, bcslen, msgidx;
int n;
char ts[64];
size_t tslen;
struct tm tm, *tmp;
time_t now;
xtn_t* xtn = hcl_getxtn(hcl);
int logfd;
if (mask & HCL_LOG_GC) return; /* don't show gc logs */
if (mask & HCL_LOG_STDERR)
{
/* the messages that go to STDERR don't get masked out */
logfd = 2;
}
else
{
if (!(xtn->logmask & mask & ~HCL_LOG_ALL_LEVELS)) return; /* check log types */
if (!(xtn->logmask & mask & ~HCL_LOG_ALL_TYPES)) return; /* check log levels */
if (mask & HCL_LOG_STDOUT) logfd = 1;
else
{
logfd = xtn->logfd;
if (logfd <= -1) return;
}
}
/* TODO: beautify the log message.
* do classification based on mask. */
if (!(mask & (HCL_LOG_STDOUT | HCL_LOG_STDERR)))
{
time_t now;
char ts[32];
size_t tslen;
struct tm tm, *tmp;
now = time(NULL);
#if defined(__MSDOS__)
tmp = localtime (&now);
#else
tmp = localtime_r (&now, &tm);
#endif
tslen = strftime (ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %z ", tmp);
if (tslen == 0)
{
strcpy (ts, "0000-00-00 00:00:00 +0000");
tslen = 25;
}
if (write_all (1, ts, tslen) <= -1)
{
char ttt[20];
#if defined(__MSDOS__) && defined(_INTELC32_)
sprintf (ttt, "ERR: %d\n", errno);
#else
snprintf (ttt, sizeof(ttt), "ERR: %d\n", errno);
#endif
write (1, ttt, strlen(ttt));
now = time(NULL);
#if defined(__DOS__)
tmp = localtime (&now);
tslen = strftime (ts, sizeof(ts), "%Y-%m-%d %H:%M:%S ", tmp); /* no timezone info */
if (tslen == 0)
{
strcpy (ts, "0000-00-00 00:00:00");
tslen = 19;
}
#else
tmp = localtime_r (&now, &tm);
#if defined(HAVE_STRFTIME_SMALL_Z)
tslen = strftime (ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %z ", tmp);
#else
tslen = strftime (ts, sizeof(ts), "%Y-%m-%d %H:%M:%S %Z ", tmp);
#endif
if (tslen == 0)
{
strcpy (ts, "0000-00-00 00:00:00 +0000");
tslen = 25;
}
#endif
write_all (logfd, ts, tslen);
}
if (xtn->logfd_istty)
{
if (mask & HCL_LOG_FATAL) write_all (logfd, "\x1B[1;31m", 7);
else if (mask & HCL_LOG_ERROR) write_all (logfd, "\x1B[1;32m", 7);
else if (mask & HCL_LOG_WARN) write_all (logfd, "\x1B[1;33m", 7);
}
#if defined(HCL_OOCH_IS_UCH)
msgidx = 0;
while (len > 0)
{
ucslen = len;
bcslen = HCL_COUNTOF(buf);
n = hcl_ucstoutf8 (&msg[msgidx], &ucslen, buf, &bcslen);
n = hcl_convootobchars (hcl, &msg[msgidx], &ucslen, buf, &bcslen);
if (n == 0 || n == -2)
{
/* n = 0:
@ -431,10 +507,10 @@ if (mask & HCL_LOG_GC) return; /* don't show gc logs */
* buffer not sufficient. not all got converted yet.
* write what have been converted this round. */
HCL_ASSERT (ucslen > 0); /* if this fails, the buffer size must be increased */
HCL_ASSERT (hcl, ucslen > 0); /* if this fails, the buffer size must be increased */
/* attempt to write all converted characters */
if (write_all (1, buf, bcslen) <= -1) break;
if (write_all (logfd, buf, bcslen) <= -1) break;
if (n == 0) break;
else
@ -449,9 +525,154 @@ if (mask & HCL_LOG_GC) return; /* don't show gc logs */
break;
}
}
#else
write_all (logfd, msg, len);
#endif
if (xtn->logfd_istty)
{
if (mask & (HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN)) write_all (logfd, "\x1B[0m", 4);
}
#endif
}
static void syserrstrb (hcl_t* hcl, int syserr, hcl_bch_t* buf, hcl_oow_t len)
{
#if defined(HAVE_STRERROR_R)
strerror_r (syserr, buf, len);
#else
/* this is not thread safe */
hcl_copybcstr (buf, len, strerror(syserr));
#endif
}
static void fini_hcl (hcl_t* hcl)
{
xtn_t* xtn = hcl_getxtn(hcl);
if (xtn->logfd >= 0)
{
close (xtn->logfd);
xtn->logfd = -1;
xtn->logfd_istty = 0;
}
}
static int handle_logopt (hcl_t* hcl, const hcl_bch_t* str)
{
xtn_t* xtn = hcl_getxtn (hcl);
hcl_bch_t* xstr = (hcl_bch_t*)str;
hcl_bch_t* cm, * flt;
cm = hcl_findbcharinbcstr (xstr, ',');
if (cm)
{
/* i duplicate this string for open() below as open() doesn't
* accept a length-bounded string */
xstr = hcl_dupbchars (hcl, str, hcl_countbcstr(str));
if (!xstr)
{
fprintf (stderr, "ERROR: out of memory in duplicating %s\n", str);
return -1;
}
cm = hcl_findbcharinbcstr(xstr, ',');
*cm = '\0';
do
{
flt = cm + 1;
cm = hcl_findbcharinbcstr(flt, ',');
if (cm) *cm = '\0';
if (hcl_compbcstr(flt, "app") == 0) xtn->logmask |= HCL_LOG_APP;
else if (hcl_compbcstr(flt, "compiler") == 0) xtn->logmask |= HCL_LOG_COMPILER;
else if (hcl_compbcstr(flt, "vm") == 0) xtn->logmask |= HCL_LOG_VM;
else if (hcl_compbcstr(flt, "mnemonic") == 0) xtn->logmask |= HCL_LOG_MNEMONIC;
else if (hcl_compbcstr(flt, "gc") == 0) xtn->logmask |= HCL_LOG_GC;
else if (hcl_compbcstr(flt, "ic") == 0) xtn->logmask |= HCL_LOG_IC;
else if (hcl_compbcstr(flt, "primitive") == 0) xtn->logmask |= HCL_LOG_PRIMITIVE;
else if (hcl_compbcstr(flt, "fatal") == 0) xtn->logmask |= HCL_LOG_FATAL;
else if (hcl_compbcstr(flt, "error") == 0) xtn->logmask |= HCL_LOG_ERROR;
else if (hcl_compbcstr(flt, "warn") == 0) xtn->logmask |= HCL_LOG_WARN;
else if (hcl_compbcstr(flt, "info") == 0) xtn->logmask |= HCL_LOG_INFO;
else if (hcl_compbcstr(flt, "debug") == 0) xtn->logmask |= HCL_LOG_DEBUG;
else if (hcl_compbcstr(flt, "fatal+") == 0) xtn->logmask |= HCL_LOG_FATAL;
else if (hcl_compbcstr(flt, "error+") == 0) xtn->logmask |= HCL_LOG_FATAL | HCL_LOG_ERROR;
else if (hcl_compbcstr(flt, "warn+") == 0) xtn->logmask |= HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN;
else if (hcl_compbcstr(flt, "info+") == 0) xtn->logmask |= HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN | HCL_LOG_INFO;
else if (hcl_compbcstr(flt, "debug+") == 0) xtn->logmask |= HCL_LOG_FATAL | HCL_LOG_ERROR | HCL_LOG_WARN | HCL_LOG_INFO | HCL_LOG_DEBUG;
else
{
fprintf (stderr, "ERROR: unknown log option value - %s\n", flt);
if (str != xstr) hcl_freemem (hcl, xstr);
return -1;
}
}
while (cm);
if (!(xtn->logmask & HCL_LOG_ALL_TYPES)) xtn->logmask |= HCL_LOG_ALL_TYPES; /* no types specified. force to all types */
if (!(xtn->logmask & HCL_LOG_ALL_LEVELS)) xtn->logmask |= HCL_LOG_ALL_LEVELS; /* no levels specified. force to all levels */
}
else
{
xtn->logmask = HCL_LOG_ALL_LEVELS | HCL_LOG_ALL_TYPES;
}
xtn->logfd = open (xstr, O_CREAT | O_WRONLY | O_APPEND , 0644);
if (xtn->logfd == -1)
{
fprintf (stderr, "ERROR: cannot open a log file %s\n", xstr);
if (str != xstr) hcl_freemem (hcl, xstr);
return -1;
}
#if defined(HAVE_ISATTY)
xtn->logfd_istty = isatty(xtn->logfd);
#endif
if (str != xstr) hcl_freemem (hcl, xstr);
return 0;
}
#if !defined(NDEBUG)
static int handle_dbgopt (hcl_t* hcl, const hcl_bch_t* str)
{
xtn_t* xtn = hcl_getxtn (hcl);
const hcl_bch_t* cm, * flt;
hcl_oow_t len;
unsigned int trait, dbgopt = 0;
cm = str - 1;
do
{
flt = cm + 1;
cm = hcl_findbcharinbcstr(flt, ',');
len = cm? (cm - flt): hcl_countbcstr(flt);
if (hcl_compbcharsbcstr (flt, len, "gc") == 0) dbgopt |= HCL_DEBUG_GC;
else if (hcl_compbcharsbcstr (flt, len, "bigint") == 0) dbgopt |= HCL_DEBUG_BIGINT;
else
{
fprintf (stderr, "ERROR: unknown debug option value - %.*s\n", (int)len, flt);
return -1;
}
}
while (cm);
hcl_getoption (hcl, HCL_TRAIT, &trait);
trait |= dbgopt;
hcl_setoption (hcl, HCL_TRAIT, &trait);
return 0;
}
#endif
/* ========================================================================= */
static hcl_t* g_hcl = HCL_NULL;
@ -619,65 +840,125 @@ static char* syntax_error_msg[] =
static void print_synerr (hcl_t* hcl)
{
hcl_synerr_t synerr;
hcl_bch_t bcs[1024]; /* TODO: right buffer size */
hcl_oow_t bcslen, ucslen;
xtn_t* xtn;
xtn = hcl_getxtn (hcl);
hcl_getsynerr (hcl, &synerr);
printf ("ERROR: ");
hcl_logbfmt (hcl,HCL_LOG_STDERR, "ERROR: ");
if (synerr.loc.file)
{
bcslen = HCL_COUNTOF(bcs);
ucslen = ~(hcl_oow_t)0;
if (hcl_ucstoutf8 (synerr.loc.file, &ucslen, bcs, &bcslen) >= 0)
{
printf ("%.*s ", (int)bcslen, bcs);
}
hcl_logbfmt (hcl, HCL_LOG_STDERR, "%js", synerr.loc.file);
}
else
{
printf ("%s ", xtn->read_path);
hcl_logbfmt (hcl, HCL_LOG_STDERR, "%s", xtn->read_path);
}
printf ("syntax error at line %lu column %lu - %s",
hcl_logbfmt (hcl, HCL_LOG_STDERR, "syntax error at line %lu column %lu - %hs",
(unsigned long int)synerr.loc.line, (unsigned long int)synerr.loc.colm,
syntax_error_msg[synerr.num]);
if (synerr.tgt.len > 0)
{
bcslen = HCL_COUNTOF(bcs);
ucslen = synerr.tgt.len;
if (hcl_ucstoutf8 (synerr.tgt.ptr, &ucslen, bcs, &bcslen) >= 0)
{
printf (" [%.*s]", (int)bcslen, bcs);
}
hcl_logbfmt (hcl, HCL_LOG_STDERR, " - %.*js", synerr.tgt.len, synerr.tgt.ptr);
}
printf ("\n");
hcl_logbfmt (hcl, HCL_LOG_STDERR, "\n");
}
hcl_ooch_t str_hcl[] = { 'S', 't', 'i', 'x' };
hcl_ooch_t str_my_object[] = { 'M', 'y', 'O', 'b','j','e','c','t' };
hcl_ooch_t str_main[] = { 'm', 'a', 'i', 'n' };
#define MIN_MEMSIZE 2048000ul
int main (int argc, char* argv[])
{
hcl_t* hcl;
xtn_t* xtn;
hcl_vmprim_t vmprim;
hcl_cb_t hclcb;
hcl_bci_t c;
static hcl_bopt_lng_t lopt[] =
{
{ ":log", 'l' },
{ ":memsize", 'm' },
#if !defined(NDEBUG)
{ ":debug", '\0' }, /* NOTE: there is no short option for --debug */
#endif
{ HCL_NULL, '\0' }
};
static hcl_bopt_t opt =
{
"l:m:",
lopt
};
const char* logopt = HCL_NULL;
hcl_oow_t memsize = MIN_MEMSIZE;
#if !defined(NDEBUG)
const char* dbgopt = HCL_NULL;
#endif
setlocale (LC_ALL, "");
#if !defined(macintosh)
if (argc < 2)
{
print_usage:
fprintf (stderr, "Usage: %s filename ...\n", argv[0]);
return -1;
}
while ((c = hcl_getbopt (argc, argv, &opt)) != HCL_BCI_EOF)
{
switch (c)
{
case 'l':
logopt = opt.arg;
break;
case 'm':
memsize = strtoul(opt.arg, HCL_NULL, 0);
if (memsize <= MIN_MEMSIZE) memsize = MIN_MEMSIZE;
break;
case '\0':
#if !defined(NDEBUG)
if (hcl_compbcstr(opt.lngopt, "debug") == 0)
{
dbgopt = opt.arg;
break;
}
#endif
goto print_usage;
case ':':
if (opt.lngopt)
fprintf (stderr, "bad argument for '%s'\n", opt.lngopt);
else
fprintf (stderr, "bad argument for '%c'\n", opt.opt);
return -1;
default:
goto print_usage;
}
}
if (opt.ind >= argc) goto print_usage;
#endif
memset (&vmprim, 0, HCL_SIZEOF(vmprim));
vmprim.log_write = log_write;
vmprim.syserrstrb = syserrstrb;
hcl = hcl_open (&sys_mmgr, HCL_SIZEOF(xtn_t), 2048000lu, &vmprim, HCL_NULL);
if (!hcl)
@ -704,8 +985,46 @@ int main (int argc, char* argv[])
/*trait |= HCL_NOGC;*/
trait |= HCL_AWAIT_PROCS;
hcl_setoption (hcl, HCL_TRAIT, &trait);
/* disable GC logs */
trait = ~HCL_LOG_GC;
hcl_setoption (hcl, HCL_LOG_MASK, &trait);
}
xtn = hcl_getxtn (hcl);
xtn->logfd = -1;
xtn->logfd_istty = 0;
memset (&hclcb, 0, HCL_SIZEOF(hclcb));
hclcb.fini = fini_hcl;
hcl_regcb (hcl, &hclcb);
if (logopt)
{
if (handle_logopt (hcl, logopt) <= -1)
{
hcl_close (hcl);
return -1;
}
}
else
{
/* default logging mask when no logging option is set */
xtn->logmask = HCL_LOG_ALL_TYPES | HCL_LOG_ERROR | HCL_LOG_FATAL;
}
#if !defined(NDEBUG)
if (dbgopt)
{
if (handle_dbgopt (hcl, dbgopt) <= -1)
{
hcl_close (hcl);
return -1;
}
}
#endif
if (hcl_ignite(hcl) <= -1)
{
printf ("cannot ignite hcl - %d\n", hcl_geterrnum(hcl));
@ -720,15 +1039,8 @@ int main (int argc, char* argv[])
return -1;
}
xtn = hcl_getxtn (hcl);
#if defined(macintosh)
i = 20;
xtn->read_path = "test.st";
#endif
xtn->read_path = argv[1];
if (argc >= 2) xtn->print_path = argv[2];
xtn->read_path = argv[opt.ind++];
if (opt.ind < argc) xtn->print_path = argv[opt.ind++];
if (hcl_attachio (hcl, read_handler, print_handler) <= -1)
{
@ -741,7 +1053,7 @@ int main (int argc, char* argv[])
{
hcl_oop_t obj;
obj = hcl_read (hcl);
obj = hcl_read(hcl);
if (!obj)
{
if (hcl->errnum == HCL_EFINIS)
@ -762,14 +1074,14 @@ int main (int argc, char* argv[])
}
if (hcl_print (hcl, obj) <= -1)
if (hcl_print(hcl, obj) <= -1)
{
printf ("ERROR: cannot print object - %d\n", hcl_geterrnum(hcl));
}
else
{
hcl_print (hcl, HCL_CHAR_TO_OOP('\n'));
if (hcl_compile (hcl, obj) <= -1)
if (hcl_compile(hcl, obj) <= -1)
{
if (hcl->errnum == HCL_ESYNERR)
{
@ -789,22 +1101,26 @@ hcl_decode (hcl, 0, hcl->code.bc.len);
HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n");
g_hcl = hcl;
setup_tick ();
if (hcl_execute (hcl) <= -1)
if (hcl_execute(hcl) <= -1)
{
printf ("ERROR: cannot execute - %d\n", hcl_geterrnum(hcl));
hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot execute - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
}
cancel_tick();
g_hcl = HCL_NULL;
{
HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n");
HCL_LOG2 (hcl, HCL_LOG_MNEMONIC, "BYTECODES hcl->code.bc.len = > %lu hcl->code.lit.len => %lu\n",
(unsigned long int)hcl->code.bc.len, (unsigned long int)hcl->code.lit.len);
hcl_decode (hcl, 0, hcl->code.bc.len);
hcl_dumpsymtab (hcl);
/*hcl_dumpsymtab (hcl);*/
}
hcl_close (hcl);
#if defined(_WIN32) && defined(_DEBUG)

52
lib/obj.c
View File

@ -26,20 +26,26 @@
#include "hcl-prv.h"
void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size)
{
hcl_uint8_t* ptr;
#if defined(HCL_DEBUG_GC)
if (!(hcl->option.trait & HCL_NOGC)) hcl_gc (hcl);
#if !defined(NDEBUG)
if ((hcl->option.trait & HCL_DEBUG_GC) && !(hcl->option.trait & HCL_NOGC)) hcl_gc (hcl);
#endif
ptr = hcl_allocheapmem (hcl, hcl->curheap, size);
if (!ptr && !(hcl->option.trait & HCL_NOGC))
if (!ptr && hcl->errnum == HCL_EOOMEM && !(hcl->option.trait & HCL_NOGC))
{
hcl_gc (hcl);
HCL_LOG4 (hcl, HCL_LOG_INFO,
"GC completed - current heap ptr %p limit %p size %zd free %zd\n",
hcl->curheap->ptr, hcl->curheap->limit,
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->base),
(hcl_oow_t)(hcl->curheap->limit - hcl->curheap->ptr)
);
ptr = hcl_allocheapmem (hcl, hcl->curheap, size);
/* TODO: grow heap if ptr is still null. */
}
@ -182,10 +188,10 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vlen,
hcl_oow_t named_instvar;
hcl_obj_type_t indexed_type;
HCL_ASSERT (HCL_OOP_IS_POINTER(_class));
HCL_ASSERT (HCL_CLASSOF(hcl, _class) == hcl->_class);
HCL_ASSERT (hcl, HCL_OOP_IS_POINTER(_class));
HCL_ASSERT (hcl, HCL_CLASSOF(hcl, _class) == hcl->_class);
HCL_ASSERT (HCL_OOP_IS_SMOOI(((hcl_oop_class_t)_class)->spec));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(((hcl_oop_class_t)_class)->spec));
spec = HCL_OOP_TO_SMOOI(((hcl_oop_class_t)_class)->spec);
named_instvar = HCL_CLASS_SPEC_NAMED_INSTVAR(spec); /* size of the named_instvar part */
@ -202,7 +208,7 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vlen,
return -1;
}
HCL_ASSERT (named_instvar + vlen <= HCL_OBJ_SIZE_MAX);
HCL_ASSERT (hcl, named_instvar + vlen <= HCL_OBJ_SIZE_MAX);
}
else
{
@ -219,7 +225,7 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vlen,
vlen = 0; /* vlen is not used */
if (named_instvar > HCL_MAX_NAMED_INSTVARS) return -1;
HCL_ASSERT (named_instvar <= HCL_OBJ_SIZE_MAX);
HCL_ASSERT (hcl, named_instvar <= HCL_OBJ_SIZE_MAX);
}
*type = indexed_type;
@ -235,11 +241,11 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_t _class, const void* vptr, hcl_o
hcl_oow_t alloclen;
hcl_oow_t tmp_count = 0;
HCL_ASSERT (hcl->_nil != HCL_NULL);
HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
if (decode_spec (hcl, _class, vlen, &type, &alloclen) <= -1)
{
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return HCL_NULL;
}
@ -252,7 +258,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_t _class, const void* vptr, hcl_o
* the variable part(indexed instance variables) are allowed. */
oop = hcl_allocoopobj (hcl, alloclen);
HCL_ASSERT (vptr == HCL_NULL);
HCL_ASSERT (hcl, vptr == HCL_NULL);
/*
This function is not GC-safe. so i don't want to initialize
the payload of a pointer object. The caller can call this
@ -287,7 +293,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_t _class, const void* vptr, hcl_o
break;
default:
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
oop = HCL_NULL;
break;
}
@ -297,7 +303,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_t _class, const void* vptr, hcl_o
return oop;
#endif
hcl->errnum = HCL_ENOIMPL;
hcl_seterrnum (hcl, HCL_ENOIMPL);
return HCL_NULL;
}
@ -311,11 +317,11 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vl
hcl_oow_t alloclen;
hcl_oow_t tmp_count = 0;
HCL_ASSERT (hcl->_nil != HCL_NULL);
HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
if (decode_spec (hcl, _class, vlen, &type, &alloclen) <= -1)
{
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return HCL_NULL;
}
@ -329,7 +335,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vl
break;
default:
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
oop = HCL_NULL;
break;
}
@ -339,7 +345,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_t _class, hcl_oow_t vl
return oop;
#endif
hcl->errnum = HCL_ENOIMPL;
hcl_seterrnum (hcl, HCL_ENOIMPL);
return HCL_NULL;
}
#endif
@ -447,7 +453,7 @@ hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
{
hcl_oop_t tmp;
HCL_ASSERT (!obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
HCL_ASSERT (hcl, !obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
/* no hcl_pushtmp() is needed because 'obj' is a non-GC object. */
/* TODO: improve this by using realloc */
@ -475,7 +481,7 @@ hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
{
hcl_oop_t tmp;
HCL_ASSERT (!obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
HCL_ASSERT (hcl, !obj || (HCL_OOP_IS_POINTER(obj) && HCL_OBJ_GET_FLAGS_NGC(obj)));
/* no hcl_pushtmp() is needed because 'obj' is a non-GC object. */
/* TODO: improve this by using realloc */
@ -503,7 +509,7 @@ hcl_oow_t hcl_countcons (hcl_t* hcl, hcl_oop_t cons)
/* this function ignores the last cdr */
hcl_oow_t count = 1;
HCL_ASSERT (HCL_BRANDOF(hcl, cons));
HCL_ASSERT (hcl, HCL_BRANDOF(hcl, cons));
do
{
cons = HCL_CONS_CDR(cons);
@ -517,7 +523,7 @@ hcl_oow_t hcl_countcons (hcl_t* hcl, hcl_oop_t cons)
hcl_oop_t hcl_getlastconscdr (hcl_t* hcl, hcl_oop_t cons)
{
HCL_ASSERT (HCL_BRANDOF(hcl, cons));
HCL_ASSERT (hcl, HCL_BRANDOF(hcl, cons));
do
{
cons = HCL_CONS_CDR(cons);
@ -535,7 +541,7 @@ hcl_oop_t hcl_reversecons (hcl_t* hcl, hcl_oop_t cons)
/* Note: The non-nil cdr in the last cons cell gets lost.
* e.g.) Reversing (1 2 3 . 4) results in (3 2 1) */
HCL_ASSERT (HCL_BRANDOF(hcl, cons));
HCL_ASSERT (hcl, HCL_BRANDOF(hcl, cons));
prev = hcl->_nil;
ptr = cons;

215
lib/opt-impl.h Normal file
View File

@ -0,0 +1,215 @@
/*
* $Id$
*
Copyright (c) 2014-2017 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.
*/
/* this file is supposed to be included by opt.c multiple times */
#include "hcl-opt.h"
#include "hcl-utl.h"
/*
* hcl_getopt is based on BSD getopt.
* --------------------------------------------------------------------------
*
* Copyright (c) 1987-2002 The Regents of the University of California.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*
* A. Redistributions of source code must retain the above copyright notice,
* this list of conditions and the following disclaimer.
* B. 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.
* C. Neither the names of the copyright holders nor the names of its
* contributors may be used to endorse or promote products derived from this
* software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE
* LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
* --------------------------------------------------------------------------
*/
xci_t xgetopt (int argc, xch_t* const* argv, xopt_t* opt)
{
xch_t* oli; /* option letter list index */
int dbldash = 0;
opt->arg = HCL_NULL;
opt->lngopt = HCL_NULL;
if (opt->cur == HCL_NULL)
{
opt->cur = XEMSG;
opt->ind = 1;
}
if (*opt->cur == '\0')
{
/* update scanning pointer */
if (opt->ind >= argc || *(opt->cur = argv[opt->ind]) != '-')
{
/* All arguments have been processed or the current
* argument doesn't start with a dash */
opt->cur = XEMSG;
return XCI_EOF;
}
opt->cur++;
#if 0
if (*opt->cur == '\0')
{
/* - */
opt->ind++;
opt->cur = XEMSG;
return XCI_EOF;
}
#endif
if (*opt->cur == '-')
{
if (*++opt->cur == '\0')
{
/* -- */
opt->ind++;
opt->cur = XEMSG;
return XCI_EOF;
}
else
{
dbldash = 1;
}
}
}
if (dbldash && opt->lng != HCL_NULL)
{
const xopt_lng_t* o;
xch_t* end = opt->cur;
while (*end != '\0' && *end != '=') end++;
for (o = opt->lng; o->str; o++)
{
const xch_t* str = o->str;
if (*str == ':') str++;
if (xcompcharscstr(opt->cur, end - opt->cur, str) != 0) continue;
/* match */
opt->cur = XEMSG;
opt->lngopt = o->str;
/* for a long matching option, remove the leading colon */
if (opt->lngopt[0] == ':') opt->lngopt++;
if (*end == '=') opt->arg = end + 1;
if (*o->str != ':')
{
/* should not have an option argument */
if (opt->arg != HCL_NULL) return BADARG;
}
else if (opt->arg == HCL_NULL)
{
/* check if it has a remaining argument
* available */
if (argc <= ++opt->ind) return BADARG;
/* If so, the next available argument is
* taken to be an option argument */
opt->arg = argv[opt->ind];
}
opt->ind++;
return o->val;
}
/*if (*end == HCL_T('=')) *end = HCL_T('\0');*/
opt->lngopt = opt->cur;
return BADCH;
}
if ((opt->opt = *opt->cur++) == ':' ||
(oli = xfindcharincstr(opt->str, opt->opt)) == HCL_NULL)
{
/*
* if the user didn't specify '-' as an option,
* assume it means EOF.
*/
if (opt->opt == (int)'-') return XCI_EOF;
if (*opt->cur == '\0') ++opt->ind;
return BADCH;
}
if (*++oli != ':')
{
/* don't need argument */
if (*opt->cur == '\0') opt->ind++;
}
else
{
/* need an argument */
if (*opt->cur != '\0')
{
/* no white space */
opt->arg = opt->cur;
}
else if (argc <= ++opt->ind)
{
/* no arg */
opt->cur = XEMSG;
/*if (*opt->str == ':')*/ return BADARG;
/*return BADCH;*/
}
else
{
/* white space */
opt->arg = argv[opt->ind];
}
opt->cur = XEMSG;
opt->ind++;
}
return opt->opt; /* dump back option letter */
}

82
lib/opt.c Normal file
View File

@ -0,0 +1,82 @@
/*
* $Id$
*
Copyright (c) 2014-2017 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-opt.h"
#include "hcl-utl.h"
#define BADCH '?'
#define BADARG ':'
static hcl_uch_t EMSG_UCH[] = { '\0' };
static hcl_bch_t EMSG_BCH[] = { '\0' };
/* ------------------------------------------------------------ */
#undef XEMSG
#undef xch_t
#undef xci_t
#undef xopt_t
#undef xopt_lng_t
#undef xgetopt
#undef xcompcharscstr
#undef xfindcharincstr
#undef XCI_EOF
#define XEMSG EMSG_UCH
#define xch_t hcl_uch_t
#define xci_t hcl_uci_t
#define xopt_t hcl_uopt_t
#define xopt_lng_t hcl_uopt_lng_t
#define xgetopt hcl_getuopt
#define xcompcharscstr hcl_compucharsucstr
#define xfindcharincstr hcl_finducharinucstr
#define XCI_EOF HCL_BCI_EOF
#include "opt-impl.h"
/* ------------------------------------------------------------ */
#undef XEMSG
#undef xch_t
#undef xci_t
#undef xopt_t
#undef xopt_lng_t
#undef xgetopt
#undef xcompcharscstr
#undef xfindcharincstr
#undef XCI_EOF
#define XEMSG EMSG_BCH
#define xch_t hcl_bch_t
#define xci_t hcl_bci_t
#define xopt_t hcl_bopt_t
#define xopt_lng_t hcl_bopt_lng_t
#define xgetopt hcl_getbopt
#define xcompcharscstr hcl_compbcharsbcstr
#define xfindcharincstr hcl_findbcharinbcstr
#define XCI_EOF HCL_UCI_EOF
#include "opt-impl.h"
/* ------------------------------------------------------------ */

6
lib/prim.c
View File

@ -63,7 +63,7 @@ static void log_char_object (hcl_t* hcl, hcl_oow_t mask, hcl_oop_char_t msg)
hcl_oow_t rem;
const hcl_ooch_t* ptr;
HCL_ASSERT (HCL_OBJ_GET_FLAGS_TYPE(msg) == HCL_OBJ_TYPE_CHAR);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(msg) == HCL_OBJ_TYPE_CHAR);
rem = HCL_OBJ_GET_SIZE(msg);
ptr = msg->slot;
@ -74,7 +74,7 @@ start_over:
if (*ptr == '\0')
{
n = hcl_logbfmt (hcl, mask, "%C", *ptr);
HCL_ASSERT (n == 1);
HCL_ASSERT (hcl, n == 1);
rem -= n;
ptr += n;
goto start_over;
@ -88,7 +88,7 @@ start_over:
* actually, this check is not needed because of '\0' skipping
* at the beginning of the loop */
n = hcl_logbfmt (hcl, mask, "%C", *ptr);
HCL_ASSERT (n == 1);
HCL_ASSERT (hcl, n == 1);
}
rem -= n;
ptr += n;

24
lib/print.c
View File

@ -42,7 +42,7 @@ do { \
(pr)->outarg->len = l; \
if ((pr)->printer((pr)->hcl, HCL_IO_WRITE, (pr)->outarg) <= -1) \
{ \
(pr)->hcl->errnum = HCL_EIOERR; \
hcl_seterrnum ((pr)->hcl, HCL_EIOERR); \
return -1; \
} \
} while(0)
@ -89,7 +89,7 @@ static HCL_INLINE int push (hcl_t* hcl, print_stack_t* info)
static HCL_INLINE void pop (hcl_t* hcl, print_stack_t* info)
{
HCL_ASSERT (hcl->p.s.size > 0);
HCL_ASSERT (hcl, hcl->p.s.size > 0);
hcl->p.s.size--;
*info = ((print_stack_t*)hcl->p.s.ptr)[hcl->p.s.size];
}
@ -259,7 +259,7 @@ next:
break;
case HCL_BRAND_INTEGER:
HCL_ASSERT (HCL_OBJ_GET_SIZE(obj) == 1);
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(obj) == 1);
if (print_ooi (pr, ((hcl_oop_word_t)obj)->slot[0]) <= -1) return -1;
break;
@ -321,7 +321,7 @@ next:
goto next;
resume_cons:
HCL_ASSERT (ps.type == PRINT_STACK_CONS);
HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS);
cur = ps.obj; /* Get back the CDR pushed */
if (HCL_IS_NIL(hcl,cur))
{
@ -395,7 +395,7 @@ next:
}
else
{
HCL_ASSERT (ps.type == PRINT_STACK_ARRAY);
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
ps.obj = obj;
}
@ -411,7 +411,7 @@ next:
goto next;
resume_array:
HCL_ASSERT (ps.type == PRINT_STACK_ARRAY);
HCL_ASSERT (hcl, ps.type == PRINT_STACK_ARRAY);
arridx = ps.idx;
obj = ps.obj;
}
@ -483,8 +483,8 @@ next:
default:
HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
HCL_ASSERT ("Unknown object type" == HCL_NULL);
hcl->errnum = HCL_EINTERN;
HCL_ASSERT (hcl, "Unknown object type" == HCL_NULL);
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
}
@ -507,7 +507,7 @@ done:
default:
HCL_DEBUG3 (hcl, "Internal error - unknown print stack type %d at %s:%d\n", (int)ps.type, __FILE__, __LINE__);
hcl->errnum = HCL_EINTERN;
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
}
}
@ -521,10 +521,10 @@ HCL_INLINE int hcl_printobj (hcl_t* hcl, hcl_oop_t obj, hcl_ioimpl_t printer, hc
int n;
printer_t pr;
HCL_ASSERT (hcl->c->printer != HCL_NULL);
HCL_ASSERT (hcl, hcl->c->printer != HCL_NULL);
/* the printer stack must be empty. buggy if not. */
HCL_ASSERT (hcl->p.s.size == 0);
HCL_ASSERT (hcl, hcl->p.s.size == 0);
hcl->p.e = obj; /* remember the head of the object to print */
pr.hcl = hcl;
@ -538,7 +538,7 @@ HCL_INLINE int hcl_printobj (hcl_t* hcl, hcl_oop_t obj, hcl_ioimpl_t printer, hc
if (n <= -1) hcl->p.s.size = 0;
/* the printer stack must get empty when done. buggy if not */
HCL_ASSERT (hcl->p.s.size == 0);
HCL_ASSERT (hcl, hcl->p.s.size == 0);
return n;
}

105
lib/rbt.c
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2015 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -58,68 +58,68 @@
HCL_INLINE hcl_rbt_pair_t* hcl_rbt_allocpair (
hcl_rbt_t* rbt, void* kptr, hcl_oow_t klen, void* vptr, hcl_oow_t vlen)
{
hcl_rbt_pair_t* n;
hcl_rbt_pair_t* pair;
copier_t kcop = rbt->style->copier[HCL_RBT_KEY];
copier_t vcop = rbt->style->copier[HCL_RBT_VAL];
hcl_oow_t as = HCL_SIZEOF(hcl_rbt_pair_t);
if (kcop == HCL_RBT_COPIER_INLINE) as += KTOB(rbt,klen);
if (kcop == HCL_RBT_COPIER_INLINE) as += HCL_ALIGN_POW2(KTOB(rbt,klen), HCL_SIZEOF_VOID_P);
if (vcop == HCL_RBT_COPIER_INLINE) as += VTOB(rbt,vlen);
n = (hcl_rbt_pair_t*) HCL_MMGR_ALLOC (rbt->mmgr, as);
if (n == HCL_NULL) return HCL_NULL;
pair = (hcl_rbt_pair_t*) HCL_MMGR_ALLOC (rbt->hcl->mmgr, as);
if (pair == HCL_NULL) return HCL_NULL;
n->color = HCL_RBT_RED;
n->parent = HCL_NULL;
n->child[LEFT] = &rbt->xnil;
n->child[RIGHT] = &rbt->xnil;
pair->color = HCL_RBT_RED;
pair->parent = HCL_NULL;
pair->child[LEFT] = &rbt->xnil;
pair->child[RIGHT] = &rbt->xnil;
KLEN(n) = klen;
KLEN(pair) = klen;
if (kcop == HCL_RBT_COPIER_SIMPLE)
{
KPTR(n) = kptr;
KPTR(pair) = kptr;
}
else if (kcop == HCL_RBT_COPIER_INLINE)
{
KPTR(n) = n + 1;
if (kptr) HCL_MEMCPY (KPTR(n), kptr, KTOB(rbt,klen));
KPTR(pair) = pair + 1;
if (kptr) HCL_MEMCPY (KPTR(pair), kptr, KTOB(rbt,klen));
}
else
{
KPTR(n) = kcop (rbt, kptr, klen);
if (KPTR(n) == HCL_NULL)
KPTR(pair) = kcop (rbt, kptr, klen);
if (KPTR(pair) == HCL_NULL)
{
HCL_MMGR_FREE (rbt->mmgr, n);
HCL_MMGR_FREE (rbt->hcl->mmgr, pair);
return HCL_NULL;
}
}
VLEN(n) = vlen;
VLEN(pair) = vlen;
if (vcop == HCL_RBT_COPIER_SIMPLE)
{
VPTR(n) = vptr;
VPTR(pair) = vptr;
}
else if (vcop == HCL_RBT_COPIER_INLINE)
{
VPTR(n) = n + 1;
VPTR(pair) = pair + 1;
if (kcop == HCL_RBT_COPIER_INLINE)
VPTR(n) = (hcl_oob_t*)VPTR(n) + KTOB(rbt,klen);
if (vptr) HCL_MEMCPY (VPTR(n), vptr, VTOB(rbt,vlen));
VPTR(pair) = (hcl_oob_t*)VPTR(pair) + HCL_ALIGN_POW2(KTOB(rbt,klen), HCL_SIZEOF_VOID_P);
if (vptr) HCL_MEMCPY (VPTR(pair), vptr, VTOB(rbt,vlen));
}
else
{
VPTR(n) = vcop (rbt, vptr, vlen);
if (VPTR(n) != HCL_NULL)
VPTR(pair) = vcop (rbt, vptr, vlen);
if (VPTR(pair) != HCL_NULL)
{
if (rbt->style->freeer[HCL_RBT_KEY] != HCL_NULL)
rbt->style->freeer[HCL_RBT_KEY] (rbt, KPTR(n), KLEN(n));
HCL_MMGR_FREE (rbt->mmgr, n);
rbt->style->freeer[HCL_RBT_KEY] (rbt, KPTR(pair), KLEN(pair));
HCL_MMGR_FREE (rbt->hcl->mmgr, pair);
return HCL_NULL;
}
}
return n;
return pair;
}
HCL_INLINE void hcl_rbt_freepair (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair)
@ -128,7 +128,7 @@ HCL_INLINE void hcl_rbt_freepair (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair)
rbt->style->freeer[HCL_RBT_KEY] (rbt, KPTR(pair), KLEN(pair));
if (rbt->style->freeer[HCL_RBT_VAL] != HCL_NULL)
rbt->style->freeer[HCL_RBT_VAL] (rbt, VPTR(pair), VLEN(pair));
HCL_MMGR_FREE (rbt->mmgr, pair);
HCL_MMGR_FREE (rbt->hcl->mmgr, pair);
}
static hcl_rbt_style_t style[] =
@ -191,16 +191,16 @@ const hcl_rbt_style_t* hcl_getrbtstyle (hcl_rbt_style_kind_t kind)
return &style[kind];
}
hcl_rbt_t* hcl_rbt_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, int kscale, int vscale)
hcl_rbt_t* hcl_rbt_open (hcl_t* hcl, hcl_oow_t xtnsize, int kscale, int vscale)
{
hcl_rbt_t* rbt;
rbt = (hcl_rbt_t*) HCL_MMGR_ALLOC (mmgr, HCL_SIZEOF(hcl_rbt_t) + xtnsize);
rbt = (hcl_rbt_t*) HCL_MMGR_ALLOC (hcl->mmgr, HCL_SIZEOF(hcl_rbt_t) + xtnsize);
if (rbt == HCL_NULL) return HCL_NULL;
if (hcl_rbt_init (rbt, mmgr, kscale, vscale) <= -1)
if (hcl_rbt_init (rbt, hcl, kscale, vscale) <= -1)
{
HCL_MMGR_FREE (mmgr, rbt);
HCL_MMGR_FREE (hcl->mmgr, rbt);
return HCL_NULL;
}
@ -211,14 +211,14 @@ hcl_rbt_t* hcl_rbt_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, int kscale, int vs
void hcl_rbt_close (hcl_rbt_t* rbt)
{
hcl_rbt_fini (rbt);
HCL_MMGR_FREE (rbt->mmgr, rbt);
HCL_MMGR_FREE (rbt->hcl->mmgr, rbt);
}
int hcl_rbt_init (hcl_rbt_t* rbt, hcl_mmgr_t* mmgr, int kscale, int vscale)
int hcl_rbt_init (hcl_rbt_t* rbt, hcl_t* hcl, int kscale, int vscale)
{
/* do not zero out the extension */
HCL_MEMSET (rbt, 0, HCL_SIZEOF(*rbt));
rbt->mmgr = mmgr;
rbt->hcl = hcl;
rbt->scale[HCL_RBT_KEY] = (kscale < 1)? 1: kscale;
rbt->scale[HCL_RBT_VAL] = (vscale < 1)? 1: vscale;
@ -243,11 +243,6 @@ void hcl_rbt_fini (hcl_rbt_t* rbt)
hcl_rbt_clear (rbt);
}
hcl_mmgr_t* hcl_rbt_getmmgr (hcl_rbt_t* rbt)
{
return rbt->mmgr;
}
void* hcl_rbt_getxtn (hcl_rbt_t* rbt)
{
return (void*)(rbt + 1);
@ -260,7 +255,7 @@ const hcl_rbt_style_t* hcl_rbt_getstyle (const hcl_rbt_t* rbt)
void hcl_rbt_setstyle (hcl_rbt_t* rbt, const hcl_rbt_style_t* style)
{
HCL_ASSERT (style != HCL_NULL);
HCL_ASSERT (rbt->hcl, style != HCL_NULL);
rbt->style = style;
}
@ -324,7 +319,7 @@ static void rotate (hcl_rbt_t* rbt, hcl_rbt_pair_t* pivot, int leftwise)
hcl_rbt_pair_t* parent, * z, * c;
int cid1, cid2;
HCL_ASSERT (pivot != HCL_NULL);
HCL_ASSERT (rbt->hcl, pivot != HCL_NULL);
if (leftwise)
{
@ -352,13 +347,13 @@ static void rotate (hcl_rbt_t* rbt, hcl_rbt_pair_t* pivot, int leftwise)
}
else
{
HCL_ASSERT (parent->right == pivot);
HCL_ASSERT (rbt->hcl, parent->right == pivot);
parent->right = z;
}
}
else
{
HCL_ASSERT (rbt->root == pivot);
HCL_ASSERT (rbt->hcl, rbt->root == pivot);
rbt->root = z;
}
@ -379,7 +374,7 @@ static void adjust (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair)
x_par = pair->parent;
if (x_par->color == HCL_RBT_BLACK) break;
HCL_ASSERT (x_par->parent != HCL_NULL);
HCL_ASSERT (rbt->hcl, x_par->parent != HCL_NULL);
if (x_par == x_par->parent->child[LEFT])
{
@ -469,7 +464,7 @@ static hcl_rbt_pair_t* change_pair_val (
}
else
{
HCL_ASSERT (pair->parent->right == pair);
HCL_ASSERT (rbt->hcl, pair->parent->right == pair);
pair->parent->right = p;
}
}
@ -542,7 +537,7 @@ static hcl_rbt_pair_t* insert (
if (x_par == HCL_NULL)
{
/* the tree contains no pair */
HCL_ASSERT (rbt->root == &rbt->xnil);
HCL_ASSERT (rbt->hcl, rbt->root == &rbt->xnil);
rbt->root = x_new;
}
else
@ -551,12 +546,12 @@ static hcl_rbt_pair_t* insert (
int n = rbt->style->comper (rbt, kptr, klen, KPTR(x_par), KLEN(x_par));
if (n > 0)
{
HCL_ASSERT (x_par->right == &rbt->xnil);
HCL_ASSERT (rbt->hcl, x_par->right == &rbt->xnil);
x_par->right = x_new;
}
else
{
HCL_ASSERT (x_par->left == &rbt->xnil);
HCL_ASSERT (rbt->hcl, x_par->left == &rbt->xnil);
x_par->left = x_new;
}
@ -639,7 +634,7 @@ hcl_rbt_pair_t* hcl_rbt_cbsert (
}
else
{
HCL_ASSERT (tmp.parent->right == x_cur);
HCL_ASSERT (rbt->hcl, tmp.parent->right == x_cur);
tmp.parent->right = x_new;
}
}
@ -664,7 +659,7 @@ hcl_rbt_pair_t* hcl_rbt_cbsert (
if (x_par == HCL_NULL)
{
/* the tree contains no pair */
HCL_ASSERT (rbt->root == &rbt->xnil);
HCL_ASSERT (rbt->hcl, rbt->root == &rbt->xnil);
rbt->root = x_new;
}
else
@ -673,12 +668,12 @@ hcl_rbt_pair_t* hcl_rbt_cbsert (
int n = rbt->style->comper (rbt, kptr, klen, KPTR(x_par), KLEN(x_par));
if (n > 0)
{
HCL_ASSERT (x_par->right == &rbt->xnil);
HCL_ASSERT (rbt->hcl, x_par->right == &rbt->xnil);
x_par->right = x_new;
}
else
{
HCL_ASSERT (x_par->left == &rbt->xnil);
HCL_ASSERT (rbt->hcl, x_par->left == &rbt->xnil);
x_par->left = x_new;
}
@ -738,7 +733,7 @@ static void adjust_for_delete (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, hcl_rbt_pai
}
else
{
HCL_ASSERT (pair == par->right);
HCL_ASSERT (rbt->hcl, pair == par->right);
tmp = par->left;
if (tmp->color == HCL_RBT_RED)
{
@ -783,7 +778,7 @@ static void delete_pair (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair)
{
hcl_rbt_pair_t* x, * y, * par;
HCL_ASSERT (pair && !IS_NIL(rbt,pair));
HCL_ASSERT (rbt->hcl, pair && !IS_NIL(rbt,pair));
if (IS_NIL(rbt,pair->left) || IS_NIL(rbt,pair->right))
{
@ -961,7 +956,7 @@ static HCL_INLINE void walk (hcl_rbt_t* rbt, walker_t walker, void* ctx, int l,
else
{
/* both the left child and the right child have been traversed */
HCL_ASSERT (prev == x_cur->child[r]);
HCL_ASSERT (rbt->hcl, prev == x_cur->child[r]);
/* just move up to the parent */
prev = x_cur;
x_cur = x_cur->parent;

84
lib/read.c
View File

@ -109,7 +109,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n
ptr = str->ptr,
end = str->ptr + str->len;
HCL_ASSERT (ptr < end);
HCL_ASSERT (hcl, ptr < end);
if (*ptr == '+' || *ptr == '-')
{
@ -119,11 +119,11 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n
if (radixed)
{
HCL_ASSERT (ptr < end);
HCL_ASSERT (hcl, ptr < end);
if (*ptr != '#')
{
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
ptr++; /* skip '#' */
@ -133,14 +133,14 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n
else if (*ptr == 'b') base = 2;
else
{
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
ptr++;
}
else base = 10;
HCL_ASSERT (ptr < end);
HCL_ASSERT (hcl, ptr < end);
value = old_value = 0;
while (ptr < end && (v = CHAR_TO_NUM(*ptr, base)) < base)
@ -149,7 +149,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n
if (value < old_value)
{
/* overflow must have occurred */
hcl->errnum = HCL_ERANGE;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
old_value = value;
@ -159,13 +159,13 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n
if (ptr < end)
{
/* trailing garbage? */
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
if (value > HCL_TYPE_MAX(hcl_ooi_t) + (negsign? 1: 0)) /* assume 2's complement */
{
hcl->errnum = HCL_ERANGE;
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
@ -306,7 +306,7 @@ static HCL_INLINE int add_token_str (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_
static HCL_INLINE int does_token_name_match (hcl_t* hcl, voca_id_t id)
{
return hcl->c->tok.name.len == vocas[id].len &&
hcl_equalchars(hcl->c->tok.name.ptr, vocas[id].str, vocas[id].len);
hcl_equaloochars(hcl->c->tok.name.ptr, vocas[id].str, vocas[id].len);
}
static HCL_INLINE int add_token_char (hcl_t* hcl, hcl_ooch_t c)
@ -321,7 +321,7 @@ static HCL_INLINE int add_token_char (hcl_t* hcl, hcl_ooch_t c)
static HCL_INLINE void unget_char (hcl_t* hcl, const hcl_iolxc_t* c)
{
/* Make sure that the unget buffer is large enough */
HCL_ASSERT (hcl->c->nungots < HCL_COUNTOF(hcl->c->ungot));
HCL_ASSERT (hcl, hcl->c->nungots < HCL_COUNTOF(hcl->c->ungot));
hcl->c->ungot[hcl->c->nungots++] = *c;
}
@ -656,7 +656,7 @@ static int get_sharp_token (hcl_t* hcl)
hcl_ooci_t c;
int radix;
HCL_ASSERT (hcl->c->lxc.c == '#');
HCL_ASSERT (hcl, hcl->c->lxc.c == '#');
GET_CHAR_TO (hcl, c);
@ -799,7 +799,7 @@ HCL_DEBUG2 (hcl, "INVALID CHARACTER LITERAL [%.*S]\n", (hcl_ooi_t)hcl->c->tok.na
}
else
{
HCL_ASSERT (TOKEN_NAME_LEN(hcl) == 3);
HCL_ASSERT (hcl, TOKEN_NAME_LEN(hcl) == 3);
c = TOKEN_NAME_CHAR(hcl,2);
}
@ -1033,7 +1033,7 @@ retry:
break;
}
HCL_DEBUG2 (hcl, "TOKEN: [%.*S]\n", (hcl_ooi_t)TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl));
HCL_DEBUG2 (hcl, "TOKEN: [%.*js]\n", (hcl_ooi_t)TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl));
return 0;
}
@ -1042,7 +1042,7 @@ static void clear_io_names (hcl_t* hcl)
{
hcl_iolink_t* cur;
HCL_ASSERT (hcl->c != HCL_NULL);
HCL_ASSERT (hcl, hcl->c != HCL_NULL);
while (hcl->c->io_names)
{
@ -1149,7 +1149,7 @@ static int end_include (hcl_t* hcl)
cur = hcl->c->curinp;
hcl->c->curinp = hcl->c->curinp->includer;
HCL_ASSERT (cur->name != HCL_NULL);
HCL_ASSERT (hcl, cur->name != HCL_NULL);
hcl_freemem (hcl, cur);
/* hcl->parse.depth.incl--; */
@ -1179,7 +1179,7 @@ static HCL_INLINE hcl_oop_t push (hcl_t* hcl, hcl_oop_t obj)
static HCL_INLINE void pop (hcl_t* hcl)
{
/* the stack is empty. called pop() more than push()? */
HCL_ASSERT (!HCL_IS_NIL(hcl,hcl->c->r.s));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
hcl->c->r.s = HCL_CONS_CDR(hcl->c->r.s);
}
@ -1223,7 +1223,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
int fv;
/* the stack must not be empty - cannot leave a list without entering it */
HCL_ASSERT (!HCL_IS_NIL(hcl,hcl->c->r.s));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
/*head = HCL_CONS_CAR(HCL_CONS_CDR(hcl->c->r.s));*/
@ -1247,7 +1247,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
count = 0;
while (ptr != hcl->_nil)
{
HCL_ASSERT (HCL_OBJ_GET_FLAGS_BRAND(ptr) == HCL_BRAND_CONS);
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_BRAND(ptr) == HCL_BRAND_CONS);
ptr = HCL_CONS_CDR(ptr);
count++;
}
@ -1280,7 +1280,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv)
{
/* restore the flag for the outer returning level */
hcl_oop_t flag = HCL_CONS_CDR(HCL_CONS_CDR(hcl->c->r.s));
HCL_ASSERT (HCL_OOP_IS_SMOOI(HCL_CONS_CAR(flag)));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(HCL_CONS_CAR(flag)));
*flagv = HCL_OOP_TO_SMOOI(HCL_CONS_CAR(flag));
}
@ -1293,7 +1293,7 @@ static HCL_INLINE int dot_list (hcl_t* hcl)
hcl_oop_t cons;
int flagv;
HCL_ASSERT (!HCL_IS_NIL(hcl,hcl->c->r.s));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
/* mark the state that a dot has appeared in the list */
cons = HCL_CONS_CDR(HCL_CONS_CDR(hcl->c->r.s));
@ -1313,19 +1313,19 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
/* the stack top is the pair pointing to the list tail */
tail = hcl->c->r.s;
HCL_ASSERT (!HCL_IS_NIL(hcl,tail));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,tail));
/* the pair pointing to the list head is below the tail cell
* connected via cdr. */
head = HCL_CONS_CDR(tail);
HCL_ASSERT (!HCL_IS_NIL(hcl,head));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,head));
/* the pair pointing to the flag is below the head cell
* connected via cdr */
flag = HCL_CONS_CDR(head);
/* retrieve the numeric flag value */
HCL_ASSERT(HCL_OOP_IS_SMOOI(HCL_CONS_CAR(flag)));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(HCL_CONS_CAR(flag)));
flagv = (int)HCL_OOP_TO_SMOOI(HCL_CONS_CAR(flag));
if (flagv & CLOSED)
@ -1337,7 +1337,7 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
else if (flagv & DOTTED)
{
/* the list must not be empty to have reached the dotted state */
HCL_ASSERT (!HCL_IS_NIL(hcl,HCL_CONS_CAR(tail)));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,HCL_CONS_CAR(tail)));
/* chain the object via 'cdr' of the tail cell */
HCL_CONS_CDR(HCL_CONS_CAR(tail)) = obj;
@ -1362,7 +1362,7 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
/* the list head is not set yet. it is the first
* element added to the list. let both head and tail
* point to the new cons cell */
HCL_ASSERT (HCL_IS_NIL (hcl, HCL_CONS_CAR(tail)));
HCL_ASSERT (hcl, HCL_IS_NIL (hcl, HCL_CONS_CAR(tail)));
HCL_CONS_CAR(head) = cons;
HCL_CONS_CAR(tail) = cons;
}
@ -1381,7 +1381,7 @@ static hcl_oop_t chain_to_list (hcl_t* hcl, hcl_oop_t obj)
static HCL_INLINE int is_list_empty (hcl_t* hcl)
{
/* the stack must not be empty */
HCL_ASSERT (!HCL_IS_NIL(hcl,hcl->c->r.s));
HCL_ASSERT (hcl, !HCL_IS_NIL(hcl,hcl->c->r.s));
/* if the tail pointer is pointing to nil, the list is empty */
return HCL_IS_NIL(hcl,HCL_CONS_CAR(hcl->c->r.s));
@ -1412,9 +1412,9 @@ static int get_byte_array_literal (hcl_t* hcl, hcl_oop_t* xlit)
hcl_ooi_t tmp;
hcl_oop_t ba;
HCL_ASSERT (hcl->c->r.balit.size == 0);
HCL_ASSERT (hcl, hcl->c->r.balit.size == 0);
HCL_ASSERT (TOKEN_TYPE(hcl) == HCL_IOTOK_BAPAREN);
HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_BAPAREN);
GET_TOKEN(hcl); /* skip #[ */
while (TOKEN_TYPE(hcl) == HCL_IOTOK_NUMLIT || TOKEN_TYPE(hcl) == HCL_IOTOK_RADNUMLIT)
@ -1425,7 +1425,7 @@ static int get_byte_array_literal (hcl_t* hcl, hcl_oop_t* xlit)
{
/* the token reader reads a valid token. no other errors
* than the range error must not occur */
HCL_ASSERT (hcl->errnum == HCL_ERANGE);
HCL_ASSERT (hcl, hcl->errnum == HCL_ERANGE);
/* if the token is out of the SMOOI range, it's too big or
* to small to be a byte */
@ -1487,9 +1487,9 @@ static int get_symbol_array_literal (hcl_t* hcl, hcl_oop_t* xlit)
hcl_oop_t sa, sym;
hcl_oow_t i;
HCL_ASSERT (hcl->c->r.salit.size == 0);
HCL_ASSERT (hcl, hcl->c->r.salit.size == 0);
HCL_ASSERT (TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR);
HCL_ASSERT (hcl, TOKEN_TYPE(hcl) == HCL_IOTOK_VBAR);
GET_TOKEN(hcl); /* skip #[ */
while (TOKEN_TYPE(hcl) == HCL_IOTOK_IDENT)
@ -1540,8 +1540,8 @@ static int read_object (hcl_t* hcl)
switch (TOKEN_TYPE(hcl))
{
default:
HCL_ASSERT (!"should never happen - invalid token type");
hcl->errnum = HCL_EINTERN;
HCL_ASSERT (hcl, !"should never happen - invalid token type");
hcl_seterrnum (hcl, HCL_EINTERN);
return -1;
case HCL_IOTOK_EOF:
@ -1715,7 +1715,7 @@ static int read_object (hcl_t* hcl)
{
int oldflagv;
HCL_ASSERT (level > 0);
HCL_ASSERT (hcl, level > 0);
/* if so, append the element read into the quote list */
if (chain_to_list (hcl, obj) == HCL_NULL) return -1;
@ -1741,8 +1741,8 @@ static int read_object (hcl_t* hcl)
}
/* upon exit, we must be at the top level */
HCL_ASSERT (level == 0);
HCL_ASSERT (array_level == 0);
HCL_ASSERT (hcl, level == 0);
HCL_ASSERT (hcl, array_level == 0);
hcl->c->r.e = obj;
return 0;
@ -1750,10 +1750,10 @@ static int read_object (hcl_t* hcl)
static HCL_INLINE int __read (hcl_t* hcl)
{
if (get_token (hcl) <= -1) return -1;
if (get_token(hcl) <= -1) return -1;
if (TOKEN_TYPE(hcl) == HCL_IOTOK_EOF)
{
hcl->errnum = HCL_EFINIS;
hcl_seterrnum (hcl, HCL_EFINIS);
return -1;
}
return read_object (hcl);
@ -1761,7 +1761,7 @@ static HCL_INLINE int __read (hcl_t* hcl)
hcl_oop_t hcl_read (hcl_t* hcl)
{
HCL_ASSERT (hcl->c && hcl->c->reader);
HCL_ASSERT (hcl, hcl->c && hcl->c->reader);
if (__read(hcl) <= -1) return HCL_NULL;
return hcl->c->r.e;
}
@ -1858,7 +1858,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer)
if (!reader || !printer)
{
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return -1;
}
@ -1890,7 +1890,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer)
}
else if (hcl->c->reader || hcl->c->printer)
{
hcl->errnum = HCL_EPERM; /* TODO: change this error code */
hcl_seterrnum (hcl, HCL_EPERM); /* TODO: change this error code */
return -1;
}
@ -1960,7 +1960,7 @@ void hcl_detachio (hcl_t* hcl)
hcl->c->reader (hcl, HCL_IO_CLOSE, hcl->c->curinp);
prev = hcl->c->curinp->includer;
HCL_ASSERT (hcl->c->curinp->name != HCL_NULL);
HCL_ASSERT (hcl, hcl->c->curinp->name != HCL_NULL);
HCL_MMGR_FREE (hcl->mmgr, hcl->c->curinp);
hcl->c->curinp = prev;
}

30
lib/sym.c
View File

@ -53,7 +53,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
if (inc_max > 0) inc = inc_max;
else
{
hcl->errnum = HCL_EOOMEM;
hcl_seterrnum (hcl, HCL_EOOMEM);
return HCL_NULL;
}
}
@ -70,10 +70,10 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
symbol = (hcl_oop_char_t)oldbuc->slot[--oldsz];
if ((hcl_oop_t)symbol != hcl->_nil)
{
HCL_ASSERT (HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
/*HCL_ASSERT (sym->size > 0);*/
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
/*HCL_ASSERT (hcl, sym->size > 0);*/
index = hcl_hashchars(symbol->slot, HCL_OBJ_GET_SIZE(symbol)) % newsz;
index = hcl_hashoochars(symbol->slot, HCL_OBJ_GET_SIZE(symbol)) % newsz;
while (newbuc->slot[index] != hcl->_nil) index = (index + 1) % newsz;
newbuc->slot[index] = (hcl_oop_t)symbol;
}
@ -88,25 +88,25 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
hcl_oow_t index;
hcl_oop_char_t symbol;
HCL_ASSERT (len > 0);
HCL_ASSERT (hcl, len > 0);
if (len <= 0)
{
/* i don't allow an empty symbol name */
hcl->errnum = HCL_EINVAL;
hcl_seterrnum (hcl, HCL_EINVAL);
return HCL_NULL;
}
HCL_ASSERT (HCL_BRANDOF(hcl,hcl->symtab->bucket) == HCL_BRAND_ARRAY);
index = hcl_hashchars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,hcl->symtab->bucket) == HCL_BRAND_ARRAY);
index = hcl_hashoochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
/* find a matching symbol in the open-addressed symbol table */
while (hcl->symtab->bucket->slot[index] != hcl->_nil)
{
symbol = (hcl_oop_char_t)hcl->symtab->bucket->slot[index];
HCL_ASSERT (HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
HCL_ASSERT (hcl, HCL_BRANDOF(hcl,symbol) == HCL_BRAND_SYMBOL);
if (len == HCL_OBJ_GET_SIZE(symbol) &&
hcl_equalchars (ptr, symbol->slot, len))
hcl_equaloochars (ptr, symbol->slot, len))
{
return (hcl_oop_t)symbol;
}
@ -116,18 +116,18 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
if (!create)
{
hcl->errnum = HCL_ENOENT;
hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL;
}
/* make a new symbol and insert it */
HCL_ASSERT (HCL_OOP_IS_SMOOI(hcl->symtab->tally));
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(hcl->symtab->tally));
tally = HCL_OOP_TO_SMOOI(hcl->symtab->tally);
if (tally >= HCL_SMOOI_MAX)
{
/* this built-in table is not allowed to hold more than
* HCL_SMOOI_MAX items for efficiency sake */
hcl->errnum = HCL_EDFULL;
hcl_seterrnum (hcl, HCL_EDFULL);
return HCL_NULL;
}
@ -153,7 +153,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
hcl->symtab->bucket = bucket;
/* recalculate the index for the expanded bucket */
index = hcl_hashchars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
index = hcl_hashoochars(ptr, len) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
while (hcl->symtab->bucket->slot[index] != hcl->_nil)
index = (index + 1) % HCL_OBJ_GET_SIZE(hcl->symtab->bucket);
@ -163,7 +163,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow
symbol = (hcl_oop_char_t)hcl_alloccharobj (hcl, HCL_BRAND_SYMBOL, ptr, len);
if (symbol)
{
HCL_ASSERT (tally < HCL_SMOOI_MAX);
HCL_ASSERT (hcl, tally < HCL_SMOOI_MAX);
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally + 1);
hcl->symtab->bucket->slot[index] = (hcl_oop_t)symbol;
}

493
lib/utf8.c
View File

@ -1,7 +1,7 @@
/*
* $Id$
*
Copyright (c) 2014-2015 Chung, Hyung-Hwan. All rights reserved.
Copyright (c) 2014-2017 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
@ -26,8 +26,6 @@
#include "hcl-prv.h"
#define HCL_BCLEN_MAX 6
/*
* from RFC 2279 UTF-8, a transformation format of ISO 10646
*
@ -47,7 +45,7 @@ struct __utf8_t
hcl_uint8_t fbyte; /* mask to the first utf8 byte */
hcl_uint8_t mask;
hcl_uint8_t fmask;
int length; /* number of bytes */
int length; /* number of bytes */
};
typedef struct __utf8_t __utf8_t;
@ -66,8 +64,8 @@ static HCL_INLINE __utf8_t* get_utf8_slot (hcl_uch_t uc)
{
__utf8_t* cur, * end;
HCL_ASSERT (HCL_SIZEOF(hcl_bch_t) == 1);
HCL_ASSERT (HCL_SIZEOF(hcl_uch_t) >= 2);
/*HCL_ASSERT (hcl, HCL_SIZEOF(hcl_bch_t) == 1);
HCL_ASSERT (hcl, HCL_SIZEOF(hcl_uch_t) >= 2);*/
end = utf8_table + HCL_COUNTOF(utf8_table);
cur = utf8_table;
@ -112,10 +110,10 @@ hcl_oow_t hcl_utf8touc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc)
{
__utf8_t* cur, * end;
HCL_ASSERT (utf8 != HCL_NULL);
HCL_ASSERT (size > 0);
HCL_ASSERT (HCL_SIZEOF(hcl_bch_t) == 1);
HCL_ASSERT (HCL_SIZEOF(hcl_uch_t) >= 2);
/*HCL_ASSERT (hcl, utf8 != HCL_NULL);
HCL_ASSERT (hcl, size > 0);
HCL_ASSERT (hcl, HCL_SIZEOF(hcl_bch_t) == 1);
HCL_ASSERT (hcl, HCL_SIZEOF(hcl_uch_t) >= 2);*/
end = utf8_table + HCL_COUNTOF(utf8_table);
cur = utf8_table;
@ -179,342 +177,147 @@ hcl_oow_t hcl_utf8touc (const hcl_bch_t* utf8, hcl_oow_t size, hcl_uch_t* uc)
return 0; /* error - invalid sequence */
}
/* ----------------------------------------------------------------------- */
static HCL_INLINE int bcsn_to_ucsn_with_cmgr (
const hcl_bch_t* bcs, hcl_oow_t* bcslen,
hcl_uch_t* ucs, hcl_oow_t* ucslen, hcl_cmgr_t* cmgr, int all)
{
const hcl_bch_t* p;
int ret = 0;
hcl_oow_t mlen;
if (ucs)
{
/* destination buffer is specified.
* copy the conversion result to the buffer */
hcl_uch_t* q, * qend;
p = bcs;
q = ucs;
qend = ucs + *ucslen;
mlen = *bcslen;
while (mlen > 0)
{
hcl_oow_t n;
if (q >= qend)
{
/* buffer too small */
ret = -2;
break;
}
n = cmgr->bctouc (p, mlen, q);
if (n == 0)
{
/* invalid sequence */
if (all)
{
n = 1;
*q = '?';
}
else
{
ret = -1;
break;
}
}
if (n > mlen)
{
/* incomplete sequence */
if (all)
{
n = 1;
*q = '?';
}
else
{
ret = -3;
break;
}
}
q++;
p += n;
mlen -= n;
}
*ucslen = q - ucs;
*bcslen = p - bcs;
}
else
{
/* no destination buffer is specified. perform conversion
* but don't copy the result. the caller can call this function
* without a buffer to find the required buffer size, allocate
* a buffer with the size and call this function again with
* the buffer. */
hcl_uch_t w;
hcl_oow_t wlen = 0;
p = bcs;
mlen = *bcslen;
while (mlen > 0)
{
hcl_oow_t n;
n = cmgr->bctouc (p, mlen, &w);
if (n == 0)
{
/* invalid sequence */
if (all) n = 1;
else
{
ret = -1;
break;
}
}
if (n > mlen)
{
/* incomplete sequence */
if (all) n = 1;
else
{
ret = -3;
break;
}
}
p += n;
mlen -= n;
wlen += 1;
}
*ucslen = wlen;
*bcslen = p - bcs;
}
return ret;
}
static HCL_INLINE int bcs_to_ucs_with_cmgr (
const hcl_bch_t* bcs, hcl_oow_t* bcslen,
hcl_uch_t* ucs, hcl_oow_t* ucslen, hcl_cmgr_t* cmgr, int all)
{
const hcl_bch_t* bp;
hcl_oow_t mlen, wlen;
int n;
for (bp = bcs; *bp != '\0'; bp++) /* nothing */ ;
mlen = bp - bcs; wlen = *ucslen;
n = bcsn_to_ucsn_with_cmgr (bcs, &mlen, ucs, &wlen, cmgr, all);
if (ucs)
{
/* null-terminate the target buffer if it has room for it. */
if (wlen < *ucslen) ucs[wlen] = '\0';
else n = -2; /* buffer too small */
}
*bcslen = mlen; *ucslen = wlen;
return n;
}
static HCL_INLINE int ucsn_to_bcsn_with_cmgr (
const hcl_uch_t* ucs, hcl_oow_t* ucslen,
hcl_bch_t* bcs, hcl_oow_t* bcslen, hcl_cmgr_t* cmgr)
{
const hcl_uch_t* p = ucs;
const hcl_uch_t* end = ucs + *ucslen;
int ret = 0;
if (bcs)
{
hcl_oow_t rem = *bcslen;
while (p < end)
{
hcl_oow_t n;
if (rem <= 0)
{
ret = -2; /* buffer too small */
break;
}
n = cmgr->uctobc (*p, bcs, rem);
if (n == 0)
{
ret = -1;
break; /* illegal character */
}
if (n > rem)
{
ret = -2; /* buffer too small */
break;
}
bcs += n; rem -= n; p++;
}
*bcslen -= rem;
}
else
{
hcl_bch_t bcsbuf[HCL_BCLEN_MAX];
hcl_oow_t mlen = 0;
while (p < end)
{
hcl_oow_t n;
n = cmgr->uctobc (*p, bcsbuf, HCL_COUNTOF(bcsbuf));
if (n == 0)
{
ret = -1;
break; /* illegal character */
}
/* it assumes that bcsbuf is large enough to hold a character */
HCL_ASSERT (n <= HCL_COUNTOF(bcsbuf));
p++; mlen += n;
}
/* this length excludes the terminating null character.
* this function doesn't even null-terminate the result. */
*bcslen = mlen;
}
*ucslen = p - ucs;
return ret;
}
static int ucs_to_bcs_with_cmgr (
const hcl_uch_t* ucs, hcl_oow_t* ucslen,
hcl_bch_t* bcs, hcl_oow_t* bcslen, hcl_cmgr_t* cmgr)
{
const hcl_uch_t* p = ucs;
int ret = 0;
if (bcs)
{
hcl_oow_t rem = *bcslen;
while (*p != '\0')
{
hcl_oow_t n;
if (rem <= 0)
{
ret = -2;
break;
}
n = cmgr->uctobc (*p, bcs, rem);
if (n == 0)
{
ret = -1;
break; /* illegal character */
}
if (n > rem)
{
ret = -2;
break; /* buffer too small */
}
bcs += n; rem -= n; p++;
}
/* update bcslen to the length of the bcs string converted excluding
* terminating null */
*bcslen -= rem;
/* null-terminate the multibyte sequence if it has sufficient space */
if (rem > 0) *bcs = '\0';
else
{
/* if ret is -2 and cs[cslen] == '\0',
* this means that the bcs buffer was lacking one
* slot for the terminating null */
ret = -2; /* buffer too small */
}
}
else
{
hcl_bch_t bcsbuf[HCL_BCLEN_MAX];
hcl_oow_t mlen = 0;
while (*p != '\0')
{
hcl_oow_t n;
n = cmgr->uctobc (*p, bcsbuf, HCL_COUNTOF(bcsbuf));
if (n == 0)
{
ret = -1;
break; /* illegal character */
}
/* it assumes that bcs is large enough to hold a character */
HCL_ASSERT (n <= HCL_COUNTOF(bcs));
p++; mlen += n;
}
/* this length holds the number of resulting multi-byte characters
* excluding the terminating null character */
*bcslen = mlen;
}
*ucslen = p - ucs; /* the number of wide characters handled. */
return ret;
}
static hcl_cmgr_t utf8_cmgr =
{
hcl_utf8touc,
hcl_uctoutf8
};
int hcl_utf8toucs (const hcl_bch_t* bcs, hcl_oow_t* bcslen, hcl_uch_t* ucs, hcl_oow_t* ucslen)
{
if (*bcslen == ~(hcl_oow_t)0)
{
/* the source is null-terminated. */
return bcs_to_ucs_with_cmgr (bcs, bcslen, ucs, ucslen, &utf8_cmgr, 0);
}
else
{
/* the source is length bound */
return bcsn_to_ucsn_with_cmgr (bcs, bcslen, ucs, ucslen, &utf8_cmgr, 0);
}
}
int hcl_ucstoutf8 (const hcl_uch_t* ucs, hcl_oow_t *ucslen, hcl_bch_t* bcs, hcl_oow_t* bcslen)
{
if (*ucslen == ~(hcl_oow_t)0)
{
/* null-terminated */
return ucs_to_bcs_with_cmgr (ucs, ucslen, bcs, bcslen, &utf8_cmgr);
}
else
{
/* length bound */
return ucsn_to_bcsn_with_cmgr (ucs, ucslen, bcs, bcslen, &utf8_cmgr);
}
}
/*
hcl_oow_t hcl_ucslen (const hcl_uch_t* ucs)
* See http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c
*/
struct interval
{
const hcl_uch_t* ptr = ucs;
while (*ptr) ptr = HCL_INCPTR(const hcl_uch_t, ptr, 1);
return HCL_SUBPTR(const hcl_uch_t, ptr, ucs);
int first;
int last;
};
/* auxiliary function for binary search in interval table */
static int bisearch(hcl_uch_t ucs, const struct interval *table, int max)
{
int min = 0;
int mid;
if (ucs < table[0].first || ucs > table[max].last) return 0;
while (max >= min)
{
mid = (min + max) / 2;
if (ucs > table[mid].last) min = mid + 1;
else if (ucs < table[mid].first) max = mid - 1;
else return 1;
}
return 0;
}
/* The following two functions define the column width of an ISO 10646
* character as follows:
*
* - The null character (U+0000) has a column width of 0.
*
* - Other C0/C1 control characters and DEL will lead to a return
* value of -1.
*
* - Non-spacing and enclosing combining characters (general
* category code Mn or Me in the Unicode database) have a
* column width of 0.
*
* - SOFT HYPHEN (U+00AD) has a column width of 1.
*
* - Other format characters (general category code Cf in the Unicode
* database) and ZERO WIDTH SPACE (U+200B) have a column width of 0.
*
* - Hangul Jamo medial vowels and final consonants (U+1160-U+11FF)
* have a column width of 0.
*
* - Spacing characters in the East Asian Wide (W) or East Asian
* Full-width (F) category as defined in Unicode Technical
* Report #11 have a column width of 2.
*
* - All remaining characters (including all printable
* ISO 8859-1 and WGL4 characters, Unicode control characters,
* etc.) have a column width of 1.
*
* This implementation assumes that wchar_t characters are encoded
* in ISO 10646.
*/
int hcl_ucwidth (hcl_uch_t uc)
{
/* sorted list of non-overlapping intervals of non-spacing characters */
/* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */
static const struct interval combining[] = {
{ 0x0300, 0x036F }, { 0x0483, 0x0486 }, { 0x0488, 0x0489 },
{ 0x0591, 0x05BD }, { 0x05BF, 0x05BF }, { 0x05C1, 0x05C2 },
{ 0x05C4, 0x05C5 }, { 0x05C7, 0x05C7 }, { 0x0600, 0x0603 },
{ 0x0610, 0x0615 }, { 0x064B, 0x065E }, { 0x0670, 0x0670 },
{ 0x06D6, 0x06E4 }, { 0x06E7, 0x06E8 }, { 0x06EA, 0x06ED },
{ 0x070F, 0x070F }, { 0x0711, 0x0711 }, { 0x0730, 0x074A },
{ 0x07A6, 0x07B0 }, { 0x07EB, 0x07F3 }, { 0x0901, 0x0902 },
{ 0x093C, 0x093C }, { 0x0941, 0x0948 }, { 0x094D, 0x094D },
{ 0x0951, 0x0954 }, { 0x0962, 0x0963 }, { 0x0981, 0x0981 },
{ 0x09BC, 0x09BC }, { 0x09C1, 0x09C4 }, { 0x09CD, 0x09CD },
{ 0x09E2, 0x09E3 }, { 0x0A01, 0x0A02 }, { 0x0A3C, 0x0A3C },
{ 0x0A41, 0x0A42 }, { 0x0A47, 0x0A48 }, { 0x0A4B, 0x0A4D },
{ 0x0A70, 0x0A71 }, { 0x0A81, 0x0A82 }, { 0x0ABC, 0x0ABC },
{ 0x0AC1, 0x0AC5 }, { 0x0AC7, 0x0AC8 }, { 0x0ACD, 0x0ACD },
{ 0x0AE2, 0x0AE3 }, { 0x0B01, 0x0B01 }, { 0x0B3C, 0x0B3C },
{ 0x0B3F, 0x0B3F }, { 0x0B41, 0x0B43 }, { 0x0B4D, 0x0B4D },
{ 0x0B56, 0x0B56 }, { 0x0B82, 0x0B82 }, { 0x0BC0, 0x0BC0 },
{ 0x0BCD, 0x0BCD }, { 0x0C3E, 0x0C40 }, { 0x0C46, 0x0C48 },
{ 0x0C4A, 0x0C4D }, { 0x0C55, 0x0C56 }, { 0x0CBC, 0x0CBC },
{ 0x0CBF, 0x0CBF }, { 0x0CC6, 0x0CC6 }, { 0x0CCC, 0x0CCD },
{ 0x0CE2, 0x0CE3 }, { 0x0D41, 0x0D43 }, { 0x0D4D, 0x0D4D },
{ 0x0DCA, 0x0DCA }, { 0x0DD2, 0x0DD4 }, { 0x0DD6, 0x0DD6 },
{ 0x0E31, 0x0E31 }, { 0x0E34, 0x0E3A }, { 0x0E47, 0x0E4E },
{ 0x0EB1, 0x0EB1 }, { 0x0EB4, 0x0EB9 }, { 0x0EBB, 0x0EBC },
{ 0x0EC8, 0x0ECD }, { 0x0F18, 0x0F19 }, { 0x0F35, 0x0F35 },
{ 0x0F37, 0x0F37 }, { 0x0F39, 0x0F39 }, { 0x0F71, 0x0F7E },
{ 0x0F80, 0x0F84 }, { 0x0F86, 0x0F87 }, { 0x0F90, 0x0F97 },
{ 0x0F99, 0x0FBC }, { 0x0FC6, 0x0FC6 }, { 0x102D, 0x1030 },
{ 0x1032, 0x1032 }, { 0x1036, 0x1037 }, { 0x1039, 0x1039 },
{ 0x1058, 0x1059 }, { 0x1160, 0x11FF }, { 0x135F, 0x135F },
{ 0x1712, 0x1714 }, { 0x1732, 0x1734 }, { 0x1752, 0x1753 },
{ 0x1772, 0x1773 }, { 0x17B4, 0x17B5 }, { 0x17B7, 0x17BD },
{ 0x17C6, 0x17C6 }, { 0x17C9, 0x17D3 }, { 0x17DD, 0x17DD },
{ 0x180B, 0x180D }, { 0x18A9, 0x18A9 }, { 0x1920, 0x1922 },
{ 0x1927, 0x1928 }, { 0x1932, 0x1932 }, { 0x1939, 0x193B },
{ 0x1A17, 0x1A18 }, { 0x1B00, 0x1B03 }, { 0x1B34, 0x1B34 },
{ 0x1B36, 0x1B3A }, { 0x1B3C, 0x1B3C }, { 0x1B42, 0x1B42 },
{ 0x1B6B, 0x1B73 }, { 0x1DC0, 0x1DCA }, { 0x1DFE, 0x1DFF },
{ 0x200B, 0x200F }, { 0x202A, 0x202E }, { 0x2060, 0x2063 },
{ 0x206A, 0x206F }, { 0x20D0, 0x20EF }, { 0x302A, 0x302F },
{ 0x3099, 0x309A }, { 0xA806, 0xA806 }, { 0xA80B, 0xA80B },
{ 0xA825, 0xA826 }, { 0xFB1E, 0xFB1E }, { 0xFE00, 0xFE0F },
{ 0xFE20, 0xFE23 }, { 0xFEFF, 0xFEFF }, { 0xFFF9, 0xFFFB },
{ 0x10A01, 0x10A03 }, { 0x10A05, 0x10A06 }, { 0x10A0C, 0x10A0F },
{ 0x10A38, 0x10A3A }, { 0x10A3F, 0x10A3F }, { 0x1D167, 0x1D169 },
{ 0x1D173, 0x1D182 }, { 0x1D185, 0x1D18B }, { 0x1D1AA, 0x1D1AD },
{ 0x1D242, 0x1D244 }, { 0xE0001, 0xE0001 }, { 0xE0020, 0xE007F },
{ 0xE0100, 0xE01EF }
};
/* test for 8-bit control characters */
if (uc == 0) return 0;
if (uc < 32 || (uc >= 0x7f && uc < 0xa0)) return -1;
/* binary search in table of non-spacing characters */
if (bisearch(uc, combining, sizeof(combining) / sizeof(struct interval) - 1)) return 0;
/* if we arrive here, uc is not a combining or C0/C1 control character */
if (uc >= 0x1100)
{
if (uc <= 0x115f || /* Hangul Jamo init. consonants */
uc == 0x2329 || uc == 0x232a ||
(uc >= 0x2e80 && uc <= 0xa4cf && uc != 0x303f) || /* CJK ... Yi */
(uc >= 0xac00 && uc <= 0xd7a3) || /* Hangul Syllables */
(uc >= 0xf900 && uc <= 0xfaff) || /* CJK Compatibility Ideographs */
(uc >= 0xfe10 && uc <= 0xfe19) || /* Vertical forms */
(uc >= 0xfe30 && uc <= 0xfe6f) || /* CJK Compatibility Forms */
(uc >= 0xff00 && uc <= 0xff60) || /* Fullwidth Forms */
(uc >= 0xffe0 && uc <= 0xffe6) ||
(uc >= 0x20000 && uc <= 0x2fffd) ||
(uc >= 0x30000 && uc <= 0x3fffd))
{
return 2;
}
}
return 1;
}
*/

964
lib/utl.c
View File

File diff suppressed because it is too large Load Diff