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

mapped a dotted identifer to a primitive function

Browse Source
This commit is contained in:
hyung-hwan 2018-02-12 10:50:44 +00:00
parent 45bb26d97f
commit 4ddffc101d
12 changed files with 400 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Makefile.in
View File

@ -163,8 +163,8 @@ am__DIST_COMMON = $(srcdir)/Makefile.in $(top_srcdir)/ac/ar-lib \
$(top_srcdir)/ac/compile $(top_srcdir)/ac/config.guess \ $(top_srcdir)/ac/compile $(top_srcdir)/ac/config.guess \
$(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \ $(top_srcdir)/ac/config.sub $(top_srcdir)/ac/install-sh \
$(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing ac/ar-lib \ $(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing ac/ar-lib \
ac/compile ac/config.guess ac/config.sub ac/install-sh \ ac/compile ac/config.guess ac/config.sub ac/depcomp \
ac/ltmain.sh ac/missing ac/install-sh ac/ltmain.sh ac/missing
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
distdir = $(PACKAGE)-$(VERSION) distdir = $(PACKAGE)-$(VERSION)
top_distdir = $(distdir) top_distdir = $(distdir)

68
configure vendored
View File

@ -649,6 +649,10 @@ HCL_SIZEOF_INT
HCL_SIZEOF_LONG HCL_SIZEOF_LONG
HCL_SIZEOF_LONG_LONG HCL_SIZEOF_LONG_LONG
HCL_SIZEOF_WCHAR_T HCL_SIZEOF_WCHAR_T
ENABLE_STATIC_MODULE_FALSE
ENABLE_STATIC_MODULE_TRUE
ENABLE_DYNAMIC_MODULE_FALSE
ENABLE_DYNAMIC_MODULE_TRUE
ENABLE_CXX_FALSE ENABLE_CXX_FALSE
ENABLE_CXX_TRUE ENABLE_CXX_TRUE
BUILD_MODE BUILD_MODE
@ -798,6 +802,8 @@ with_sysroot
enable_libtool_lock enable_libtool_lock
enable_debug enable_debug
enable_cxx enable_cxx
enable_dynamic_module
enable_static_module
' '
ac_precious_vars='build_alias ac_precious_vars='build_alias
host_alias host_alias
@ -1445,6 +1451,9 @@ Optional Features:
--enable-debug build the library in the debug mode (default. no) --enable-debug build the library in the debug mode (default. no)
--enable-cxx build the library for C++ if a C++ compiler is --enable-cxx build the library for C++ if a C++ compiler is
available (default. yes) available (default. yes)
--enable-dynamic-module enable dynamic module capability(default. yes)
--enable-static-module build modules statically into the main
library(default. no)
Optional Packages: Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
@ -19337,6 +19346,57 @@ else
fi fi
# Check whether --enable-dynamic-module was given.
if test "${enable_dynamic_module+set}" = set; then :
enableval=$enable_dynamic_module; enable_dynamic_module_is=$enableval
else
enable_dynamic_module_is=yes
fi
test "${enable_shared}" = "no" && enable_dynamic_module_is="no"
if test "${enable_dynamic_module_is}" = "yes"
then
$as_echo "#define HCL_ENABLE_DYNAMIC_MODULE /**/" >>confdefs.h
fi
if test "${enable_dynamic_module_is}" = "yes"; then
ENABLE_DYNAMIC_MODULE_TRUE=
ENABLE_DYNAMIC_MODULE_FALSE='#'
else
ENABLE_DYNAMIC_MODULE_TRUE='#'
ENABLE_DYNAMIC_MODULE_FALSE=
fi
# Check whether --enable-static-module was given.
if test "${enable_static_module+set}" = set; then :
enableval=$enable_static_module; enable_static_module_is=$enableval
else
enable_static_module_is=no
fi
test "${enable_shared}" = "no" -a "${enable_static}" = "yes" && enable_static_module_is="yes"
if test "${enable_static_module_is}" = "yes"
then
$as_echo "#define HCL_ENABLE_STATIC_MODULE /**/" >>confdefs.h
fi
if test "${enable_static_module_is}" = "yes"; then
ENABLE_STATIC_MODULE_TRUE=
ENABLE_STATIC_MODULE_FALSE='#'
else
ENABLE_STATIC_MODULE_TRUE='#'
ENABLE_STATIC_MODULE_FALSE=
fi
HCL_SIZEOF_WCHAR_T=$ac_cv_sizeof_wchar_t HCL_SIZEOF_WCHAR_T=$ac_cv_sizeof_wchar_t
HCL_SIZEOF_LONG_LONG=$ac_cv_sizeof_long_long HCL_SIZEOF_LONG_LONG=$ac_cv_sizeof_long_long
@ -19519,6 +19579,14 @@ if test -z "${ENABLE_CXX_TRUE}" && test -z "${ENABLE_CXX_FALSE}"; then
as_fn_error $? "conditional \"ENABLE_CXX\" was never defined. as_fn_error $? "conditional \"ENABLE_CXX\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5 Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi fi
if test -z "${ENABLE_DYNAMIC_MODULE_TRUE}" && test -z "${ENABLE_DYNAMIC_MODULE_FALSE}"; then
as_fn_error $? "conditional \"ENABLE_DYNAMIC_MODULE\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${ENABLE_STATIC_MODULE_TRUE}" && test -z "${ENABLE_STATIC_MODULE_FALSE}"; then
as_fn_error $? "conditional \"ENABLE_STATIC_MODULE\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
: "${CONFIG_STATUS=./config.status}" : "${CONFIG_STATUS=./config.status}"
ac_write_fail=0 ac_write_fail=0

29
configure.ac
View File

@ -416,6 +416,35 @@ test "${ax_cv_cxx_have_std_namespace}" = "yes" || enable_cxx_is="no"
AM_CONDITIONAL(ENABLE_CXX, test "${enable_cxx_is}" = "yes" ) AM_CONDITIONAL(ENABLE_CXX, test "${enable_cxx_is}" = "yes" )
dnl ===== enable-dynamic-module =====
AC_ARG_ENABLE([dynamic-module],
[AS_HELP_STRING([--enable-dynamic-module],[enable dynamic module capability(default. yes)])],
enable_dynamic_module_is=$enableval,
enable_dynamic_module_is=yes
)
test "${enable_shared}" = "no" && enable_dynamic_module_is="no"
if test "${enable_dynamic_module_is}" = "yes"
then
AC_DEFINE([HCL_ENABLE_DYNAMIC_MODULE],[],[enable dynamic module capability])
fi
AM_CONDITIONAL(ENABLE_DYNAMIC_MODULE, test "${enable_dynamic_module_is}" = "yes")
dnl ===== enable-static-module =====
AC_ARG_ENABLE([static-module],
[AS_HELP_STRING([--enable-static-module],[build modules statically into the main library(default. no)])],
enable_static_module_is=$enableval,
enable_static_module_is=no
)
test "${enable_shared}" = "no" -a "${enable_static}" = "yes" && enable_static_module_is="yes"
if test "${enable_static_module_is}" = "yes"
then
AC_DEFINE([HCL_ENABLE_STATIC_MODULE],[],[link modules statically into the main library])
fi
AM_CONDITIONAL(ENABLE_STATIC_MODULE, test "${enable_static_module_is}" = "yes")
AC_SUBST(HCL_SIZEOF_WCHAR_T, $ac_cv_sizeof_wchar_t) AC_SUBST(HCL_SIZEOF_WCHAR_T, $ac_cv_sizeof_wchar_t)
AC_SUBST(HCL_SIZEOF_LONG_LONG, $ac_cv_sizeof_long_long) AC_SUBST(HCL_SIZEOF_LONG_LONG, $ac_cv_sizeof_long_long)
AC_SUBST(HCL_SIZEOF_LONG, $ac_cv_sizeof_long) AC_SUBST(HCL_SIZEOF_LONG, $ac_cv_sizeof_long)

5
lib/err.c
View File

@ -117,6 +117,7 @@ static char* synerrstr[] =
"invalid callable", "invalid callable",
"unbalanced key/value pair", "unbalanced key/value pair",
"unbalanced parenthesis/brace/bracket",
"empty x-list" "empty x-list"
}; };
@ -280,13 +281,13 @@ const hcl_ooch_t* hcl_geterrstr (hcl_t* hcl)
const hcl_ooch_t* hcl_geterrmsg (hcl_t* hcl) const hcl_ooch_t* hcl_geterrmsg (hcl_t* hcl)
{ {
if (hcl->errmsg.len <= 0) return hcl_errnum_to_errstr (hcl->errnum); if (hcl->errmsg.len <= 0) return hcl_errnum_to_errstr(hcl->errnum);
return hcl->errmsg.buf; return hcl->errmsg.buf;
} }
const hcl_ooch_t* hcl_backuperrmsg (hcl_t* hcl) const hcl_ooch_t* hcl_backuperrmsg (hcl_t* hcl)
{ {
hcl_copyoocstr (hcl->errmsg.tmpbuf.ooch, HCL_COUNTOF(hcl->errmsg.tmpbuf.ooch), hcl->errmsg.buf); hcl_copyoocstr (hcl->errmsg.tmpbuf.ooch, HCL_COUNTOF(hcl->errmsg.tmpbuf.ooch), hcl_geterrmsg(hcl));
return hcl->errmsg.tmpbuf.ooch; return hcl->errmsg.tmpbuf.ooch;
} }

144
lib/exec.c
View File

@ -1060,9 +1060,6 @@ static int execute (hcl_t* hcl)
hcl_oob_t bcode; hcl_oob_t bcode;
hcl_oow_t b1, b2; hcl_oow_t b1, b2;
hcl_oop_t return_value; hcl_oop_t return_value;
int unwind_protect;
hcl_oop_context_t unwind_start;
hcl_oop_context_t unwind_stop;
#if defined(HCL_PROFILE_VM) #if defined(HCL_PROFILE_VM)
hcl_uintmax_t inst_counter = 0; hcl_uintmax_t inst_counter = 0;
@ -1543,10 +1540,10 @@ static int execute (hcl_t* hcl)
switch (HCL_OBJ_GET_FLAGS_BRAND(rcv)) switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))
{ {
case HCL_BRAND_CONTEXT: case HCL_BRAND_CONTEXT:
if (activate_context(hcl, b1) <= -1) return -1; if (activate_context(hcl, b1) <= -1) goto oops;
break; break;
case HCL_BRAND_PRIM: case HCL_BRAND_PRIM:
if (call_primitive(hcl, b1) <= -1) return -1; if (call_primitive(hcl, b1) <= -1) goto oops;
break; break;
default: default:
goto cannot_call; goto cannot_call;
@ -1557,7 +1554,7 @@ static int execute (hcl_t* hcl)
cannot_call: cannot_call:
/* run time error */ /* run time error */
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv); hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv);
return -1; goto oops;
} }
break; break;
} }
@ -1801,7 +1798,7 @@ static int execute (hcl_t* hcl)
/* create an empty array */ /* create an empty array */
t = hcl_makearray (hcl, b1); t = hcl_makearray (hcl, b1);
if (!t) return -1; if (!t) goto oops;
HCL_STACK_PUSH (hcl, t); /* push the array created */ HCL_STACK_PUSH (hcl, t); /* push the array created */
break; break;
@ -1828,7 +1825,7 @@ static int execute (hcl_t* hcl)
/* create an empty array */ /* create an empty array */
t = hcl_makebytearray (hcl, HCL_NULL, b1); t = hcl_makebytearray (hcl, HCL_NULL, b1);
if (!t) return -1; if (!t) goto oops;
HCL_STACK_PUSH (hcl, t); /* push the byte array created */ HCL_STACK_PUSH (hcl, t); /* push the byte array created */
break; break;
@ -1846,7 +1843,7 @@ static int execute (hcl_t* hcl)
if (!HCL_OOP_IS_SMOOI(t1) || (bv = HCL_OOP_TO_SMOOI(t1)) < 0 || bv > 255) if (!HCL_OOP_IS_SMOOI(t1) || (bv = HCL_OOP_TO_SMOOI(t1)) < 0 || bv > 255)
{ {
hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1); hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1);
return -1; goto oops;
} }
HCL_STACK_POP (hcl); HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* array */ t2 = HCL_STACK_GETTOP(hcl); /* array */
@ -1862,7 +1859,7 @@ static int execute (hcl_t* hcl)
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "make_dic %zu", b1); LOG_INST_1 (hcl, "make_dic %zu", b1);
t = (hcl_oop_t)hcl_makedic (hcl, b1 + 10); t = (hcl_oop_t)hcl_makedic (hcl, b1 + 10);
if (!t) return -1; if (!t) goto oops;
HCL_STACK_PUSH (hcl, t); HCL_STACK_PUSH (hcl, t);
break; break;
} }
@ -1877,7 +1874,7 @@ static int execute (hcl_t* hcl)
t2 = HCL_STACK_GETTOP(hcl); /* key */ t2 = HCL_STACK_GETTOP(hcl); /* key */
HCL_STACK_POP (hcl); HCL_STACK_POP (hcl);
t3 = HCL_STACK_GETTOP(hcl); /* dictionary */ t3 = HCL_STACK_GETTOP(hcl); /* dictionary */
if (!hcl_putatdic (hcl, (hcl_oop_dic_t)t3, t2, t1)) return -1; if (!hcl_putatdic (hcl, (hcl_oop_dic_t)t3, t2, t1)) goto oops;
break; break;
} }
@ -1916,31 +1913,6 @@ static int execute (hcl_t* hcl)
handle_return: handle_return:
if (hcl->active_context->origin == hcl->processor->active->initial_context->origin) if (hcl->active_context->origin == hcl->processor->active->initial_context->origin)
{ {
/* method return from a processified block
*
* #method(#class) main
* {
* [^100] newProcess resume.
* '1111' dump.
* '1111' dump.
* '1111' dump.
* ^300.
* }
*
* ^100 doesn't terminate a main process as the block
* has been processified. on the other hand, ^100
* in the following program causes main to exit.
*
* #method(#class) main
* {
* [^100] value.
* '1111' dump.
* '1111' dump.
* '1111' dump.
* ^300.
* }
*/
/* /*
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_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); // HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->processor->active->initial_context) == hcl->_block_context);
@ -1953,8 +1925,6 @@ static int execute (hcl_t* hcl)
} }
else else
{ {
unwind_protect = 0;
/* set the instruction pointer to an invalid value. /* set the instruction pointer to an invalid value.
* this is stored into the current method context * this is stored into the current method context
* before context switching and marks a dead context */ * before context switching and marks a dead context */
@ -1977,23 +1947,6 @@ static int execute (hcl_t* hcl)
ctx = hcl->active_context; ctx = hcl->active_context;
while ((hcl_oop_t)ctx != hcl->_nil) while ((hcl_oop_t)ctx != hcl->_nil)
{ {
#if 0
/* TODO: XXXXXXXXXXXXXX for STACK UNWINDING... */
if (HCL_CLASSOF(hcl, ctx) == hcl->_method_context)
{
hcl_ooi_t preamble;
preamble = HCL_OOP_TO_SMOOI(((hcl_oop_method_t)ctx->method_or_nargs)->preamble);
if (HCL_METHOD_GET_PREAMBLE_CODE(preamble) == HCL_METHOD_PREAMBLE_ENSURE)
{
if (!unwind_protect)
{
unwind_protect = 1;
unwind_start = ctx;
}
unwind_stop = ctx;
}
}
#endif
if (ctx == hcl->active_context->origin) goto non_local_return_ok; if (ctx == hcl->active_context->origin) goto non_local_return_ok;
ctx = ctx->sender; ctx = ctx->sender;
} }
@ -2005,8 +1958,8 @@ static int execute (hcl_t* hcl)
HCL_ASSERT (hcl, 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_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - cannot return from dead context\n");
hcl_seterrnum (hcl, HCL_EINTERN); /* TODO: can i make this error catchable at the hcl level? */ hcl_seterrbfmt (hcl, HCL_EINTERN, "unable to return from dead context"); /* TODO: can i make this error catchable at the hcl level? */
return -1; goto oops;
non_local_return_ok: non_local_return_ok:
/*HCL_DEBUG2 (hcl, "NON_LOCAL RETURN OK TO... %p %p\n", hcl->active_context->origin, hcl->active_context->origin->sender);*/ /*HCL_DEBUG2 (hcl, "NON_LOCAL RETURN OK TO... %p %p\n", hcl->active_context->origin, hcl->active_context->origin->sender);*/
@ -2020,61 +1973,39 @@ static int execute (hcl_t* hcl)
hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp); hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp);
SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender); SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender);
#if 0 /* push the return value to the stack of the new active context */
XXXXX HCL_STACK_PUSH (hcl, return_value);
if (unwind_protect)
if (hcl->active_context == hcl->initial_context)
{ {
static hcl_ooch_t fbm[] = { /* the new active context is the fake initial context.
'u', 'n', 'w', 'i', 'n', 'd', 'T', 'o', ':', * this context can't get executed further. */
'r', 'e', 't', 'u', 'r', 'n', ':' HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
};
HCL_STACK_PUSH (hcl, (hcl_oop_t)unwind_start);
HCL_STACK_PUSH (hcl, (hcl_oop_t)unwind_stop);
HCL_STACK_PUSH (hcl, (hcl_oop_t)return_value);
if (send_private_message (hcl, fbm, 16, 0, 2) <= -1) return -1;
}
else
{
#endif
/* push the return value to the stack of the new active context */
HCL_STACK_PUSH (hcl, return_value);
if (hcl->active_context == hcl->initial_context)
{
/* the new active context is the fake initial context.
* this context can't get executed further. */
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
/* /*
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context); // HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
*/ */
HCL_ASSERT (hcl, hcl->active_context->receiver_or_source == hcl->_nil); 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 == 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->processor->active->initial_context->origin);
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context); HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context);
/* NOTE: this condition is true for the processified block context also. /* NOTE: this condition is true for the processified block context also.
* hcl->active_context->origin == hcl->processor->active->initial_context->origin * hcl->active_context->origin == hcl->processor->active->initial_context->origin
* however, the check here is done after context switching and the * however, the check here is done after context switching and the
* processified block check has been done against the context before switching */ * 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. */ /* the stack contains the final return value so the stack pointer must be 0. */
HCL_ASSERT (hcl, hcl->sp == 0); HCL_ASSERT (hcl, hcl->sp == 0);
if (hcl->option.trait & HCL_AWAIT_PROCS) if (hcl->option.trait & HCL_AWAIT_PROCS)
terminate_process (hcl, hcl->processor->active); terminate_process (hcl, hcl->processor->active);
else else
goto done; goto done;
/* TODO: store the return value to the VM register. /* TODO: store the return value to the VM register.
* the caller to hcl_execute() can fetch it to return it to the system */ * the caller to hcl_execute() can fetch it to return it to the system */
}
} }
#if 0
} }
#endif
break; break;
case HCL_CODE_RETURN_FROM_BLOCK: case HCL_CODE_RETURN_FROM_BLOCK:
@ -2135,7 +2066,7 @@ XXXXX
* this base block context is created with no temporaries * this base block context is created with no temporaries
* for this reason */ * for this reason */
blkctx = (hcl_oop_context_t)make_context (hcl, 0); blkctx = (hcl_oop_context_t)make_context (hcl, 0);
if (!blkctx) return -1; if (!blkctx) goto oops;
/* the long forward jump instruction has the format of /* the long forward jump instruction has the format of
* 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK * 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK
@ -2192,7 +2123,7 @@ XXXXX
* this base block context is created with no * this base block context is created with no
* stack for this reason. */ * stack for this reason. */
blkctx = (hcl_oop_context_t)make_context (hcl, 0); blkctx = (hcl_oop_context_t)make_context (hcl, 0);
if (!blkctx) return -1; if (!blkctx) goto oops;
/* get the receiver to the block copy message after block context instantiation /* get the receiver to the block copy message after block context instantiation
* not to get affected by potential GC */ * not to get affected by potential GC */
@ -2264,6 +2195,11 @@ done:
oops: oops:
/* TODO: anything to do here? */ /* TODO: anything to do here? */
if (hcl->processor->active != hcl->nil_process)
{
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS ... = %zu\n", inst_counter);
terminate_process (hcl, hcl->processor->active);
}
return -1; return -1;
} }

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

@ -216,6 +216,12 @@
/* __va_copy is available */ /* __va_copy is available */
#undef HAVE___VA_COPY #undef HAVE___VA_COPY
/* enable dynamic module capability */
#undef HCL_ENABLE_DYNAMIC_MODULE
/* link modules statically into the main library */
#undef HCL_ENABLE_STATIC_MODULE
/* Big Endian */ /* Big Endian */
#undef HCL_ENDIAN_BIG #undef HCL_ENDIAN_BIG

1
lib/hcl-prv.h
View File

@ -261,6 +261,7 @@ struct hcl_iotok_t
HCL_IOTOK_FALSE, HCL_IOTOK_FALSE,
HCL_IOTOK_IDENT, HCL_IOTOK_IDENT,
HCL_IOTOK_IDENT_DOTTED,
HCL_IOTOK_DOT, HCL_IOTOK_DOT,
HCL_IOTOK_LPAREN, HCL_IOTOK_LPAREN,
HCL_IOTOK_RPAREN, HCL_IOTOK_RPAREN,

18
lib/hcl.c
View File

@ -515,7 +515,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
{ {
#if !defined(HCL_ENABLE_DYNAMIC_MODULE) #if !defined(HCL_ENABLE_DYNAMIC_MODULE)
HCL_DEBUG2 (hcl, "Cannot find a static module [%.*js]\n", namelen, name); HCL_DEBUG2 (hcl, "Cannot find a static module [%.*js]\n", namelen, name);
hcl_seterrnum (hcl, HCL_ENOENT); hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to find a static module [%.*js]", namelen, name);
return HCL_NULL; return HCL_NULL;
#endif #endif
} }
@ -523,7 +523,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
#if !defined(HCL_ENABLE_DYNAMIC_MODULE) #if !defined(HCL_ENABLE_DYNAMIC_MODULE)
HCL_DEBUG2 (hcl, "Cannot open module [%.*js] - module loading disabled\n", namelen, name); HCL_DEBUG2 (hcl, "Cannot open module [%.*js] - module loading disabled\n", namelen, name);
hcl_seterrnum (hcl, HCL_ENOIMPL); /* TODO: is it a good error number for disabled module loading? */ hcl_seterrbfmt (hcl, HCL_ENOIMPL, "unable to open module [%.*js] - module loading disabled", namelen, name);
return HCL_NULL; return HCL_NULL;
#endif #endif
@ -538,7 +538,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
if (md.handle == HCL_NULL) if (md.handle == HCL_NULL)
{ {
HCL_DEBUG2 (hcl, "Cannot open a module [%.*js]\n", namelen, name); HCL_DEBUG2 (hcl, "Cannot open a module [%.*js]\n", namelen, name);
hcl_seterrnum (hcl, HCL_ENOENT); /* TODO: be more descriptive about the error */ hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to open a module [%.*js]", namelen, name);
return HCL_NULL; return HCL_NULL;
} }
@ -546,8 +546,9 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
load = hcl->vmprim.dl_getsym (hcl, md.handle, buf); load = hcl->vmprim.dl_getsym (hcl, md.handle, buf);
if (!load) if (!load)
{ {
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js] - %js", buf, namelen, name, oldmsg);
HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name); HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name);
hcl_seterrnum (hcl, HCL_ENOENT); /* TODO: be more descriptive about the error */
hcl->vmprim.dl_close (hcl, md.handle); hcl->vmprim.dl_close (hcl, md.handle);
return HCL_NULL; return HCL_NULL;
} }
@ -558,7 +559,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
if (pair == HCL_NULL) if (pair == HCL_NULL)
{ {
HCL_DEBUG2 (hcl, "Cannot register a module [%.*js]\n", namelen, name); HCL_DEBUG2 (hcl, "Cannot register a module [%.*js]\n", namelen, name);
hcl_seterrnum (hcl, HCL_ESYSMEM); hcl_seterrbfmt (hcl, HCL_ESYSMEM, "unable to register a module [%.*js] for memory shortage", namelen, name);
hcl->vmprim.dl_close (hcl, md.handle); hcl->vmprim.dl_close (hcl, md.handle);
return HCL_NULL; return HCL_NULL;
} }
@ -568,8 +569,9 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
mdp->mod.hints = hints; mdp->mod.hints = hints;
if (load (hcl, &mdp->mod) <= -1) if (load (hcl, &mdp->mod) <= -1)
{ {
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg);
HCL_DEBUG3 (hcl, "Module function [%js] returned failure in [%.*js]\n", buf, namelen, name); HCL_DEBUG3 (hcl, "Module function [%js] returned failure in [%.*js]\n", buf, namelen, name);
hcl_seterrnum (hcl, HCL_ENOENT); /* TODO: proper/better error code and handling */
hcl_rbt_delete (&hcl->modtab, name, namelen); hcl_rbt_delete (&hcl->modtab, name, namelen);
hcl->vmprim.dl_close (hcl, mdp->handle); hcl->vmprim.dl_close (hcl, mdp->handle);
return HCL_NULL; return HCL_NULL;
@ -613,10 +615,6 @@ int hcl_importmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t len)
hcl_mod_data_t* mdp; hcl_mod_data_t* mdp;
int r = -1; int r = -1;
/* hcl_openmod(), hcl_closemod(), etc call a user-defined callback.
* i need to protect _class in case the user-defined callback allocates
* a OOP memory chunk and GC occurs. */
pair = hcl_rbt_search (&hcl->modtab, name, len); pair = hcl_rbt_search (&hcl->modtab, name, len);
if (pair) if (pair)
{ {

1
lib/hcl.h
View File

@ -151,6 +151,7 @@ enum hcl_synerrnum_t
HCL_SYNERR_CALLABLE, /* invalid callable */ HCL_SYNERR_CALLABLE, /* invalid callable */
HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */ HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */
HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */
HCL_SYNERR_EMPTYXLIST /* empty x-list */ HCL_SYNERR_EMPTYXLIST /* empty x-list */
}; };
typedef enum hcl_synerrnum_t hcl_synerrnum_t; typedef enum hcl_synerrnum_t hcl_synerrnum_t;

25
lib/main.c
View File

@ -504,7 +504,8 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
if (!handle) if (!handle)
{ {
hcl_bch_t* dash; hcl_bch_t* dash;
HCL_DEBUG3 (hcl, "Failed to open(ext) DL %hs[%js] - %s\n", &bufptr[len], name, sys_dl_error()); hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error());
HCL_DEBUG3 (hcl, "Failed to open(ext) DL %hs[%js] - %hs\n", &bufptr[len], name, sys_dl_error());
dash = hcl_rfindbchar(bufptr, hcl_countbcstr(bufptr), '-'); dash = hcl_rfindbchar(bufptr, hcl_countbcstr(bufptr), '-');
if (dash) if (dash)
{ {
@ -539,13 +540,21 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
if (hcl_findbchar (bufptr, bcslen, '.')) if (hcl_findbchar (bufptr, bcslen, '.'))
{ {
handle = sys_dl_open(bufptr); handle = sys_dl_open(bufptr);
if (!handle) HCL_DEBUG2 (hcl, "Failed to open DL %hs - %s\n", bufptr, sys_dl_error()); if (!handle)
{
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open DL %js - %hs", name, sys_dl_error());
HCL_DEBUG2 (hcl, "Failed to open DL %hs - %hs\n", bufptr, sys_dl_error());
}
else HCL_DEBUG2 (hcl, "Opened DL %hs handle %p\n", bufptr, handle); else HCL_DEBUG2 (hcl, "Opened DL %hs handle %p\n", bufptr, handle);
} }
else else
{ {
handle = sys_dl_openext(bufptr); handle = sys_dl_openext(bufptr);
if (!handle) HCL_DEBUG2 (hcl, "Failed to open(ext) DL %hs - %s\n", bufptr, sys_dl_error()); if (!handle)
{
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error());
HCL_DEBUG2 (hcl, "Failed to open(ext) DL %hs - %s\n", bufptr, sys_dl_error());
}
else HCL_DEBUG2 (hcl, "Opened(ext) DL %hs handle %p\n", bufptr, handle); else HCL_DEBUG2 (hcl, "Opened(ext) DL %hs handle %p\n", bufptr, handle);
} }
} }
@ -558,7 +567,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
/* TODO: support various platforms */ /* TODO: support various platforms */
/* TODO: implemenent this */ /* TODO: implemenent this */
HCL_DEBUG1 (hcl, "Dynamic loading not implemented - cannot open %js\n", name); HCL_DEBUG1 (hcl, "Dynamic loading not implemented - cannot open %js\n", name);
hcl_seterrnum (hcl, HCL_ENOIMPL); hcl_seterrnum (hcl, HCL_ENOIMPL, "dynamic loading not implemented - cannot open %js", name);
return HCL_NULL; return HCL_NULL;
#endif #endif
} }
@ -612,6 +621,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
for (i = 1; i <= bcslen; i++) if (bufptr[i] == '.') bufptr[i] = '_'; for (i = 1; i <= bcslen; i++) if (bufptr[i] == '.') bufptr[i] = '_';
symname = &bufptr[1]; /* try the name as it is */ symname = &bufptr[1]; /* try the name as it is */
sym = sys_dl_getsym(handle, symname); sym = sys_dl_getsym(handle, symname);
if (!sym) if (!sym)
{ {
@ -630,6 +640,10 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
{ {
symname = &bufptr[0]; /* try _name_ */ symname = &bufptr[0]; /* try _name_ */
sym = sys_dl_getsym(handle, symname); sym = sys_dl_getsym(handle, symname);
if (!sym)
{
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to get module symbol %hs", symname);
}
} }
} }
} }
@ -641,7 +655,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
#else #else
/* TODO: IMPLEMENT THIS */ /* TODO: IMPLEMENT THIS */
HCL_DEBUG2 (hcl, "Dynamic loading not implemented - Cannot load module symbol %js from handle %p\n", name, handle); HCL_DEBUG2 (hcl, "Dynamic loading not implemented - Cannot load module symbol %js from handle %p\n", name, handle);
hcl_seterrnum (hcl, HCL_ENOIMPL); hcl_seterrbfmt (hcl, HCL_ENOIMPL, "dynamic loading not implemented - Cannot load module symbol %js from handle %p", name, handle);
return HCL_NULL; return HCL_NULL;
#endif #endif
} }
@ -748,7 +762,6 @@ static void log_write (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* msg, hcl_oo
write_all (logfd, ts, tslen); write_all (logfd, ts, tslen);
} }
if (xtn->logfd_istty) if (xtn->logfd_istty)
{ {
if (mask & HCL_LOG_FATAL) write_all (logfd, "\x1B[1;31m", 7); if (mask & HCL_LOG_FATAL) write_all (logfd, "\x1B[1;31m", 7);

173
lib/prim.c
View File

@ -202,6 +202,65 @@ static hcl_pfrc_t prim_not (hcl_t* hcl, hcl_ooi_t nargs)
return HCL_PF_SUCCESS; return HCL_PF_SUCCESS;
} }
static hcl_pfrc_t prim_and (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_oop_t arg, rv;
hcl_oow_t i;
rv = hcl->_true;
for (i = 1; i < nargs; i++)
{
arg = HCL_STACK_GETARG(hcl, nargs, i);
if (arg == hcl->_true)
{
/* do nothing */
}
else if (arg == hcl->_false)
{
rv = hcl->_false;
break;
}
else
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "boolean parameter expected - %O", arg);
return HCL_PF_FAILURE;
}
}
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t prim_or (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_oop_t arg, rv;
hcl_oow_t i;
rv = hcl->_false;
for (i = 1; i < nargs; i++)
{
arg = HCL_STACK_GETARG(hcl, nargs, i);
if (arg == hcl->_true)
{
rv = hcl->_true;
break;
}
else if (arg == hcl->_false)
{
/* do nothing */
}
else
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "boolean parameter expected - %O", arg);
return HCL_PF_FAILURE;
}
}
HCL_STACK_SETRET (hcl, nargs, rv);
return HCL_PF_SUCCESS;
}
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
static hcl_pfrc_t oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov) static hcl_pfrc_t oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov)
@ -225,14 +284,15 @@ static hcl_pfrc_t oop_to_ooi (hcl_t* hcl, hcl_oop_t iv, hcl_ooi_t* ov)
static hcl_pfrc_t prim_plus (hcl_t* hcl, hcl_ooi_t nargs) static hcl_pfrc_t prim_plus (hcl_t* hcl, hcl_ooi_t nargs)
{ {
hcl_ooi_t x = 0; hcl_ooi_t x;
hcl_oow_t i; hcl_oow_t i;
hcl_oop_t arg, ret; hcl_oop_t arg, ret;
for (i = 0; i < nargs; i++) arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE;
for (i = 1; i < nargs; i++)
{ {
hcl_ooi_t v; hcl_ooi_t v;
arg = HCL_STACK_GETARG(hcl, nargs, i); arg = HCL_STACK_GETARG(hcl, nargs, i);
if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
x += v; x += v;
@ -246,22 +306,98 @@ static hcl_pfrc_t prim_plus (hcl_t* hcl, hcl_ooi_t nargs)
} }
static hcl_pfrc_t prim_minus (hcl_t* hcl, hcl_ooi_t nargs) static hcl_pfrc_t prim_minus (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_ooi_t x;
hcl_oow_t i;
hcl_oop_t arg, ret;
arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE;
for (i = 1; i < nargs; i++)
{
hcl_ooi_t v;
arg = HCL_STACK_GETARG(hcl, nargs, i);
if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
x -= v;
}
ret = hcl_makeinteger (hcl, x);
if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t prim_mul (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_ooi_t x;
hcl_oow_t i;
hcl_oop_t arg, ret;
arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE;
for (i = 1; i < nargs; i++)
{
hcl_ooi_t v;
arg = HCL_STACK_GETARG(hcl, nargs, i);
if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
x *= v;
}
ret = hcl_makeinteger (hcl, x);
if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t prim_div (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_ooi_t x;
hcl_oow_t i;
hcl_oop_t arg, ret;
arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE;
for (i = 1; i < nargs; i++)
{
hcl_ooi_t v;
arg = HCL_STACK_GETARG(hcl, nargs, i);
if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
if (v == 0)
{
hcl_seterrnum (hcl, HCL_EDIVBY0);
return HCL_PF_FAILURE;
}
x /= v;
}
ret = hcl_makeinteger (hcl, x);
if (!ret) return HCL_PF_FAILURE;
HCL_STACK_SETRET (hcl, nargs, ret);
return HCL_PF_SUCCESS;
}
static hcl_pfrc_t prim_mod (hcl_t* hcl, hcl_ooi_t nargs)
{ {
hcl_ooi_t x = 0; hcl_ooi_t x = 0;
hcl_oow_t i; hcl_oow_t i;
hcl_oop_t arg, ret; hcl_oop_t arg, ret;
if (nargs > 0) arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE;
for (i = 1; i < nargs; i++)
{ {
arg = HCL_STACK_GETARG(hcl, nargs, 0); hcl_ooi_t v;
if (oop_to_ooi(hcl, arg, &x) <= -1) return HCL_PF_FAILURE; arg = HCL_STACK_GETARG(hcl, nargs, i);
for (i = 1; i < nargs; i++) if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
if (v == 0)
{ {
hcl_ooi_t v; hcl_seterrnum (hcl, HCL_EDIVBY0);
arg = HCL_STACK_GETARG(hcl, nargs, i); return HCL_PF_FAILURE;
if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE;
x -= v;
} }
x %= v;
} }
ret = hcl_makeinteger (hcl, x); ret = hcl_makeinteger (hcl, x);
@ -303,9 +439,8 @@ static prim_t builtin_prims[] =
{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_log, 3, { 'l','o','g' } }, { 0, HCL_TYPE_MAX(hcl_oow_t), prim_log, 3, { 'l','o','g' } },
{ 1, 1, prim_not, 3, { 'n','o','t' } }, { 1, 1, prim_not, 3, { 'n','o','t' } },
/* { 2, 2, prim_and, 3, { 'a','n','d' } }, { 2, HCL_TYPE_MAX(hcl_oow_t), prim_and, 3, { 'a','n','d' } },
{ 2, 2, prim_or, 2, { 'o','r' } }, */ { 2, HCL_TYPE_MAX(hcl_oow_t), prim_or, 2, { 'o','r' } },
{ 2, 2, prim_eqv, 4, { 'e','q','v','?' } }, { 2, 2, prim_eqv, 4, { 'e','q','v','?' } },
{ 2, 2, prim_eql, 4, { 'e','q','l','?' } }, { 2, 2, prim_eql, 4, { 'e','q','l','?' } },
@ -320,13 +455,13 @@ static prim_t builtin_prims[] =
{ 2, 2, prim_max, 3, { 'm','a','x' } }, { 2, 2, prim_max, 3, { 'm','a','x' } },
{ 2, 2, prim_min, 3, { 'm','i','n' } }, { 2, 2, prim_min, 3, { 'm','i','n' } },
*/ */
{ 1, HCL_TYPE_MAX(hcl_oow_t), prim_plus, 1, { '+' } },
{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_plus, 1, { '+' } }, { 1, HCL_TYPE_MAX(hcl_oow_t), prim_minus, 1, { '-' } },
{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_minus, 1, { '-' } }, { 1, HCL_TYPE_MAX(hcl_oow_t), prim_mul, 1, { '*' } },
{ 1, HCL_TYPE_MAX(hcl_oow_t), prim_div, 1, { '/' } },
{ 2, HCL_TYPE_MAX(hcl_oow_t), prim_mod, 3, { 'm','o','d' } },
{ 0, HCL_TYPE_MAX(hcl_oow_t), prim_printf, 6, { 'p','r','i','n','t','f' } }, { 0, HCL_TYPE_MAX(hcl_oow_t), prim_printf, 6, { 'p','r','i','n','t','f' } },
}; };

74
lib/read.c
View File

@ -222,7 +222,7 @@ static HCL_INLINE int is_alnumchar (hcl_ooci_t c)
static HCL_INLINE int is_delimiter (hcl_ooci_t c) static HCL_INLINE int is_delimiter (hcl_ooci_t c)
{ {
return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' || c == '\"' || c == '\'' || c == '#' || c == ';' || c == '|' || is_spacechar(c) || c == HCL_UCI_EOF; return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' || c == '\"' || c == '\'' || c == '#' || c == ';' || c == '|' || c == '.' || is_spacechar(c) || c == HCL_UCI_EOF;
} }
@ -1075,13 +1075,46 @@ retry:
{ {
ADD_TOKEN_CHAR (hcl, c); ADD_TOKEN_CHAR (hcl, c);
GET_CHAR_TO (hcl, c); GET_CHAR_TO (hcl, c);
if (is_delimiter(c))
if (c == '.')
{
hcl_iolxc_t period;
period = hcl->c->lxc;
read_more_seg:
GET_CHAR_TO (hcl, c);
if (!is_delimiter(c))
{
SET_TOKEN_TYPE (hcl, HCL_IOTOK_IDENT_DOTTED);
ADD_TOKEN_CHAR (hcl, '.');
do
{
ADD_TOKEN_CHAR (hcl, c);
GET_CHAR_TO (hcl, c);
}
while (!is_delimiter(c));
if (c == '.') goto read_more_seg;
unget_char (hcl, &hcl->c->lxc);
break;
}
else
{
unget_char (hcl, &hcl->c->lxc);
unget_char (hcl, &period);
}
break;
}
else if (is_delimiter(c))
{ {
unget_char (hcl, &hcl->c->lxc); unget_char (hcl, &hcl->c->lxc);
break; break;
} }
} }
break; break;
} }
@ -1740,6 +1773,12 @@ static int read_object (hcl_t* hcl)
int oldflagv; int oldflagv;
int concode; int concode;
if (level <= 0)
{
hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL);
return -1;
}
concode = LIST_FLAG_GET_CONCODE(flagv); concode = LIST_FLAG_GET_CONCODE(flagv);
if (req[concode].closer != TOKEN_TYPE(hcl)) if (req[concode].closer != TOKEN_TYPE(hcl))
@ -1780,8 +1819,6 @@ static int read_object (hcl_t* hcl)
break; break;
} }
#if 0 #if 0
case HCL_IOTOK_BAPAREN: case HCL_IOTOK_BAPAREN:
if (get_byte_array_literal(hcl, &obj) <= -1) return -1; if (get_byte_array_literal(hcl, &obj) <= -1) return -1;
@ -1842,6 +1879,34 @@ static int read_object (hcl_t* hcl)
case HCL_IOTOK_IDENT: case HCL_IOTOK_IDENT:
obj = hcl_makesymbol (hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); obj = hcl_makesymbol (hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
break; break;
case HCL_IOTOK_IDENT_DOTTED:
obj = hcl_makesymbol (hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
if (obj)
{
hcl_pfbase_t* pfbase;
hcl_oop_t prim;
pfbase = hcl_querymod (hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl));
if (!pfbase)
{
/* TODO switch to syntax error */
return -1;
}
hcl_pushtmp (hcl, &obj);
prim = hcl_makeprim(hcl, pfbase->handler, pfbase->minargs, pfbase->maxargs);
if (!prim || !hcl_putatsysdic(hcl, obj, prim))
{
hcl_poptmp (hcl);
return -1;
}
hcl_poptmp (hcl);
}
break;
} }
if (!obj) return -1; if (!obj) return -1;
@ -1932,7 +1997,6 @@ static void gc_compiler (hcl_t* hcl)
{ {
hcl->c->r.salit.ptr[i] = hcl_moveoop (hcl, hcl->c->r.salit.ptr[i]); hcl->c->r.salit.ptr[i] = hcl_moveoop (hcl, hcl->c->r.salit.ptr[i]);
} }
} }
static void fini_compiler (hcl_t* hcl) static void fini_compiler (hcl_t* hcl)