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/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)

68
configure vendored
View File

@ -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

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" )
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)

3
lib/err.c
View File

@ -117,6 +117,7 @@ static char* synerrstr[] =
"invalid callable",
"unbalanced key/value pair",
"unbalanced parenthesis/brace/bracket",
"empty x-list"
};
@ -286,7 +287,7 @@ const hcl_ooch_t* hcl_geterrmsg (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;
}

98
lib/exec.c
View File

@ -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,24 +1973,6 @@ 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)
{
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);
@ -2071,10 +2006,6 @@ XXXXX
* 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;
}

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

@ -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

1
lib/hcl-prv.h
View File

@ -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,

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)
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)
{

1
lib/hcl.h
View File

@ -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;

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)
{
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);

163
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;
}
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;
@ -247,12 +307,10 @@ 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 = 0;
hcl_ooi_t x;
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++)
@ -262,6 +320,84 @@ static hcl_pfrc_t prim_minus (hcl_t* hcl, hcl_ooi_t nargs)
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;
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);
@ -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' } },
};

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)
{
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)