diff --git a/Makefile.in b/Makefile.in index 3576143..87e5308 100644 --- a/Makefile.in +++ b/Makefile.in @@ -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/config.sub $(top_srcdir)/ac/install-sh \ $(top_srcdir)/ac/ltmain.sh $(top_srcdir)/ac/missing ac/ar-lib \ - ac/compile ac/config.guess ac/config.sub ac/install-sh \ - ac/ltmain.sh ac/missing + ac/compile ac/config.guess ac/config.sub ac/depcomp \ + ac/install-sh ac/ltmain.sh ac/missing DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) top_distdir = $(distdir) diff --git a/configure b/configure index 79f9112..527cff4 100755 --- a/configure +++ b/configure @@ -649,6 +649,10 @@ HCL_SIZEOF_INT HCL_SIZEOF_LONG HCL_SIZEOF_LONG_LONG 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_TRUE BUILD_MODE @@ -798,6 +802,8 @@ with_sysroot enable_libtool_lock enable_debug enable_cxx +enable_dynamic_module +enable_static_module ' ac_precious_vars='build_alias host_alias @@ -1445,6 +1451,9 @@ Optional Features: --enable-debug build the library in the debug mode (default. no) --enable-cxx build the library for C++ if a C++ compiler is 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: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] @@ -19337,6 +19346,57 @@ else 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_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. Usually this means the macro was only invoked conditionally." "$LINENO" 5 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}" ac_write_fail=0 diff --git a/configure.ac b/configure.ac index ca89551..cd1e9c4 100644 --- a/configure.ac +++ b/configure.ac @@ -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" ) + +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_LONG_LONG, $ac_cv_sizeof_long_long) AC_SUBST(HCL_SIZEOF_LONG, $ac_cv_sizeof_long) diff --git a/lib/err.c b/lib/err.c index df7b6aa..b8dec40 100644 --- a/lib/err.c +++ b/lib/err.c @@ -117,6 +117,7 @@ static char* synerrstr[] = "invalid callable", "unbalanced key/value pair", + "unbalanced parenthesis/brace/bracket", "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) { - 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; } 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; } diff --git a/lib/exec.c b/lib/exec.c index 36244e5..90197ce 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1060,9 +1060,6 @@ static int execute (hcl_t* hcl) hcl_oob_t bcode; hcl_oow_t b1, b2; 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) hcl_uintmax_t inst_counter = 0; @@ -1543,10 +1540,10 @@ static int execute (hcl_t* hcl) switch (HCL_OBJ_GET_FLAGS_BRAND(rcv)) { case HCL_BRAND_CONTEXT: - if (activate_context(hcl, b1) <= -1) return -1; + if (activate_context(hcl, b1) <= -1) goto oops; break; case HCL_BRAND_PRIM: - if (call_primitive(hcl, b1) <= -1) return -1; + if (call_primitive(hcl, b1) <= -1) goto oops; break; default: goto cannot_call; @@ -1557,7 +1554,7 @@ static int execute (hcl_t* hcl) cannot_call: /* run time error */ hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv); - return -1; + goto oops; } break; } @@ -1801,7 +1798,7 @@ static int execute (hcl_t* hcl) /* create an empty array */ t = hcl_makearray (hcl, b1); - if (!t) return -1; + if (!t) goto oops; HCL_STACK_PUSH (hcl, t); /* push the array created */ break; @@ -1828,7 +1825,7 @@ static int execute (hcl_t* hcl) /* create an empty array */ 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 */ 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) { hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1); - return -1; + goto oops; } HCL_STACK_POP (hcl); t2 = HCL_STACK_GETTOP(hcl); /* array */ @@ -1862,7 +1859,7 @@ static int execute (hcl_t* hcl) FETCH_PARAM_CODE_TO (hcl, b1); LOG_INST_1 (hcl, "make_dic %zu", b1); t = (hcl_oop_t)hcl_makedic (hcl, b1 + 10); - if (!t) return -1; + if (!t) goto oops; HCL_STACK_PUSH (hcl, t); break; } @@ -1877,7 +1874,7 @@ static int execute (hcl_t* hcl) t2 = HCL_STACK_GETTOP(hcl); /* key */ HCL_STACK_POP (hcl); 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; } @@ -1916,31 +1913,6 @@ static int execute (hcl_t* hcl) handle_return: 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->processor->active->initial_context) == hcl->_block_context); @@ -1953,8 +1925,6 @@ static int execute (hcl_t* hcl) } else { - unwind_protect = 0; - /* set the instruction pointer to an invalid value. * this is stored into the current method context * before context switching and marks a dead context */ @@ -1977,23 +1947,6 @@ static int execute (hcl_t* hcl) ctx = hcl->active_context; 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; 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_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? */ - return -1; + hcl_seterrbfmt (hcl, HCL_EINTERN, "unable to return from dead context"); /* TODO: can i make this error catchable at the hcl level? */ + goto oops; non_local_return_ok: /*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); SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender); -#if 0 -XXXXX - if (unwind_protect) + /* 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) { - static hcl_ooch_t fbm[] = { - 'u', 'n', 'w', 'i', 'n', 'd', 'T', 'o', ':', - 'r', 'e', 't', 'u', 'r', 'n', ':' - }; - - 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); + /* 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->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); + 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 - * however, the check here is done after context switching and the - * processified block check has been done against the context before switching */ + /* NOTE: this condition is true for the processified block context also. + * hcl->active_context->origin == hcl->processor->active->initial_context->origin + * however, the check here is done after context switching and the + * 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, hcl->sp == 0); + /* the stack contains the final return value so the stack pointer must be 0. */ + HCL_ASSERT (hcl, hcl->sp == 0); - if (hcl->option.trait & HCL_AWAIT_PROCS) - terminate_process (hcl, hcl->processor->active); - else - goto done; + if (hcl->option.trait & HCL_AWAIT_PROCS) + terminate_process (hcl, hcl->processor->active); + else + goto done; - /* TODO: store the return value to the VM register. - * the caller to hcl_execute() can fetch it to return it to the system */ - } + /* TODO: store the return value to the VM register. + * the caller to hcl_execute() can fetch it to return it to the system */ } -#if 0 } -#endif - break; case HCL_CODE_RETURN_FROM_BLOCK: @@ -2135,7 +2066,7 @@ XXXXX * this base block context is created with no temporaries * for this reason */ 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 * 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK @@ -2192,7 +2123,7 @@ XXXXX * this base block context is created with no * stack for this reason. */ 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 * not to get affected by potential GC */ @@ -2264,6 +2195,11 @@ done: oops: /* 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; } diff --git a/lib/hcl-cfg.h.in b/lib/hcl-cfg.h.in index f458770..e7d7a8d 100644 --- a/lib/hcl-cfg.h.in +++ b/lib/hcl-cfg.h.in @@ -216,6 +216,12 @@ /* __va_copy is available */ #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 */ #undef HCL_ENDIAN_BIG diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 9033bf6..c8db969 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -261,6 +261,7 @@ struct hcl_iotok_t HCL_IOTOK_FALSE, HCL_IOTOK_IDENT, + HCL_IOTOK_IDENT_DOTTED, HCL_IOTOK_DOT, HCL_IOTOK_LPAREN, HCL_IOTOK_RPAREN, diff --git a/lib/hcl.c b/lib/hcl.c index cd960ed..a278cab 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -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) 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; #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) 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; #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) { 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; } @@ -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); 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_seterrnum (hcl, HCL_ENOENT); /* TODO: be more descriptive about the error */ hcl->vmprim.dl_close (hcl, md.handle); 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) { 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); 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; 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_seterrnum (hcl, HCL_ENOENT); /* TODO: proper/better error code and handling */ hcl_rbt_delete (&hcl->modtab, name, namelen); hcl->vmprim.dl_close (hcl, mdp->handle); 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; 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); if (pair) { diff --git a/lib/hcl.h b/lib/hcl.h index 8be9b2b..130c88f 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -151,6 +151,7 @@ enum hcl_synerrnum_t HCL_SYNERR_CALLABLE, /* invalid callable */ HCL_SYNERR_UNBALKV, /* unbalanced key/value pair */ + HCL_SYNERR_UNBALPBB, /* unbalanced parenthesis/brace/bracket */ HCL_SYNERR_EMPTYXLIST /* empty x-list */ }; typedef enum hcl_synerrnum_t hcl_synerrnum_t; diff --git a/lib/main.c b/lib/main.c index 940789a..86c30c6 100644 --- a/lib/main.c +++ b/lib/main.c @@ -504,7 +504,8 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags) if (!handle) { 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), '-'); 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, '.')) { 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 { 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); } } @@ -558,7 +567,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags) /* TODO: support various platforms */ /* TODO: implemenent this */ 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; #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] = '_'; symname = &bufptr[1]; /* try the name as it is */ + sym = sys_dl_getsym(handle, symname); 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_ */ 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 /* TODO: IMPLEMENT THIS */ 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; #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); } - if (xtn->logfd_istty) { if (mask & HCL_LOG_FATAL) write_all (logfd, "\x1B[1;31m", 7); diff --git a/lib/prim.c b/lib/prim.c index 914d1aa..8d9b010 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -202,6 +202,65 @@ static hcl_pfrc_t prim_not (hcl_t* hcl, hcl_ooi_t nargs) 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) @@ -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) { - hcl_ooi_t x = 0; + hcl_ooi_t x; hcl_oow_t i; 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; - arg = HCL_STACK_GETARG(hcl, nargs, i); if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; 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) +{ + 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_oow_t i; 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); - 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_ooi_t v; - arg = HCL_STACK_GETARG(hcl, nargs, i); - if (oop_to_ooi(hcl, arg, &v) <= -1) return HCL_PF_FAILURE; - x -= v; + hcl_seterrnum (hcl, HCL_EDIVBY0); + return HCL_PF_FAILURE; } + x %= v; } 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' } }, { 1, 1, prim_not, 3, { 'n','o','t' } }, -/* { 2, 2, prim_and, 3, { 'a','n','d' } }, - { 2, 2, prim_or, 2, { 'o','r' } }, */ - + { 2, HCL_TYPE_MAX(hcl_oow_t), prim_and, 3, { 'a','n','d' } }, + { 2, HCL_TYPE_MAX(hcl_oow_t), prim_or, 2, { 'o','r' } }, { 2, 2, prim_eqv, 4, { 'e','q','v','?' } }, { 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_min, 3, { 'm','i','n' } }, - */ - - { 0, HCL_TYPE_MAX(hcl_oow_t), prim_plus, 1, { '+' } }, - { 0, HCL_TYPE_MAX(hcl_oow_t), prim_minus, 1, { '-' } }, - + { 1, HCL_TYPE_MAX(hcl_oow_t), prim_plus, 1, { '+' } }, + { 1, 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' } }, }; diff --git a/lib/read.c b/lib/read.c index 5053ec1..480ff92 100644 --- a/lib/read.c +++ b/lib/read.c @@ -222,7 +222,7 @@ static HCL_INLINE int is_alnumchar (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); 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); break; } } + break; } @@ -1740,6 +1773,12 @@ static int read_object (hcl_t* hcl) int oldflagv; int concode; + if (level <= 0) + { + hcl_setsynerr (hcl, HCL_SYNERR_UNBALPBB, TOKEN_LOC(hcl), HCL_NULL); + return -1; + } + concode = LIST_FLAG_GET_CONCODE(flagv); if (req[concode].closer != TOKEN_TYPE(hcl)) @@ -1780,8 +1819,6 @@ static int read_object (hcl_t* hcl) break; } - - #if 0 case HCL_IOTOK_BAPAREN: 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: obj = hcl_makesymbol (hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); 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; @@ -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]); } - } static void fini_compiler (hcl_t* hcl)