renamed prim to pf.

added module manipulation functions
This commit is contained in:
hyung-hwan 2018-02-09 04:24:50 +00:00
parent 91e1177bdb
commit 0546665e95
6 changed files with 448 additions and 39 deletions

View File

@ -971,7 +971,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
return -1;
}
return ((hcl_prim_impl_t)rcv->slot[0]) (hcl, nargs);
return ((hcl_pfimpl_t)rcv->slot[0]) (hcl, nargs);
}
/* ------------------------------------------------------------------------- */

View File

@ -1131,6 +1131,38 @@ HCL_EXPORT int hcl_compile (
hcl_oop_t expr
);
/* ========================================================================= */
/* hcl.c */
/* ========================================================================= */
hcl_mod_data_t* hcl_openmod (
hcl_t* hcl,
const hcl_ooch_t* name,
hcl_oow_t namelen,
int hints /* 0 or bitwise-ORed of hcl_mod_hint_t enumerators */
);
void hcl_closemod (
hcl_t* hcl,
hcl_mod_data_t* mdp
);
int hcl_importmod (
hcl_t* hcl,
const hcl_ooch_t* name,
hcl_oow_t len
);
/*
* The hcl_querymod() function finds a primitive function in modules
* with a full primitive identifier.
*/
hcl_pfbase_t* hcl_querymod (
hcl_t* hcl,
const hcl_ooch_t* pfid,
hcl_oow_t pfidlen
);
/* ========================================================================= */
/* prim.c */
/* ========================================================================= */

349
lib/hcl.c
View File

@ -112,8 +112,8 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
hcl->newheap = hcl_makeheap (hcl, heapsz);
if (!hcl->newheap) goto oops;
if (hcl_rbt_init (&hcl->pmtable, hcl, HCL_SIZEOF(hcl_ooch_t), 1) <= -1) goto oops;
hcl_rbt_setstyle (&hcl->pmtable, hcl_getrbtstyle(HCL_RBT_STYLE_INLINE_COPIERS));
if (hcl_rbt_init (&hcl->modtab, hcl, HCL_SIZEOF(hcl_ooch_t), 1) <= -1) goto oops;
hcl_rbt_setstyle (&hcl->modtab, hcl_getrbtstyle(HCL_RBT_STYLE_INLINE_COPIERS));
fill_bigint_tables (hcl);
@ -130,14 +130,16 @@ oops:
return -1;
}
static hcl_rbt_walk_t unload_primitive_module (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, void* ctx)
static hcl_rbt_walk_t unload_module (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, void* ctx)
{
hcl_t* hcl = (hcl_t*)ctx;
hcl_prim_mod_data_t* md;
hcl_mod_data_t* mdp;
md = HCL_RBT_VPTR(pair);
if (md->mod.unload) md->mod.unload (hcl, &md->mod);
if (md->handle) hcl->vmprim.dl_close (hcl, md->handle);
mdp = HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, mdp != HCL_NULL);
mdp->pair = HCL_NULL; /* to prevent hcl_closemod() from calling hcl_rbt_delete() */
hcl_closemod (hcl, mdp);
return HCL_RBT_WALK_FORWARD;
}
@ -146,8 +148,8 @@ void hcl_fini (hcl_t* hcl)
{
hcl_cb_t* cb;
hcl_rbt_walk (&hcl->pmtable, unload_primitive_module, hcl);
hcl_rbt_fini (&hcl->pmtable);
hcl_rbt_walk (&hcl->modtab, unload_module, hcl);
hcl_rbt_fini (&hcl->modtab);
if (hcl->log.len > 0)
{
@ -384,3 +386,332 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
HCL_MMGR_FREE (hcl->mmgr, ptr);
}
/* -------------------------------------------------------------------------- */
#define MOD_PREFIX "hcl_mod_"
#define MOD_PREFIX_LEN 8
#if defined(HCL_ENABLE_STATIC_MODULE)
#if defined(HCL_ENABLE_MOD_CON)
# include "../mod/_con.h"
#endif
#if defined(HCL_ENABLE_MOD_FFI)
# include "../mod/_ffi.h"
#endif
#if defined(HCL_ENABLE_MOD_SCK)
# include "../mod/_sck.h"
#endif
#include "../mod/_stdio.h"
#if defined(HCL_ENABLE_MOD_X11)
# include "../mod/_x11.h"
#endif
static struct
{
hcl_bch_t* modname;
int (*modload) (hcl_t* hcl, hcl_mod_t* mod);
}
static_modtab[] =
{
#if defined(HCL_ENABLE_MOD_CON)
{ "con", hcl_mod_con },
#endif
#if defined(HCL_ENABLE_MOD_FFI)
{ "ffi", hcl_mod_ffi },
#endif
#if defined(HCL_ENABLE_MOD_SCK)
{ "sck", hcl_mod_sck },
{ "sck.addr", hcl_mod_sck_addr },
#endif
{ "stdio", hcl_mod_stdio },
#if defined(HCL_ENABLE_MOD_X11)
{ "x11", hcl_mod_x11 },
/*{ "x11.win", hcl_mod_x11_win },*/
#endif
};
#endif
hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namelen, int hints)
{
hcl_rbt_pair_t* pair;
hcl_mod_data_t* mdp;
hcl_mod_data_t md;
hcl_mod_load_t load = HCL_NULL;
#if defined(HCL_ENABLE_STATIC_MODULE)
int n;
#endif
/* maximum module name length is HCL_MOD_NAME_LEN_MAX.
* MOD_PREFIX_LEN for MOD_PREFIX
* 1 for _ at the end when hcl_mod_xxx_ is attempted.
* 1 for the terminating '\0'.
*/
hcl_ooch_t buf[MOD_PREFIX_LEN + HCL_MOD_NAME_LEN_MAX + 1 + 1];
/* copy instead of encoding conversion. MOD_PREFIX must not
* include a character that requires encoding conversion.
* note the terminating null isn't needed in buf here. */
hcl_copybctooochars (buf, MOD_PREFIX, MOD_PREFIX_LEN);
if (namelen > HCL_COUNTOF(buf) - (MOD_PREFIX_LEN + 1 + 1))
{
/* module name too long */
hcl_seterrnum (hcl, HCL_EINVAL); /* TODO: change the error number to something more specific */
return HCL_NULL;
}
hcl_copyoochars (&buf[MOD_PREFIX_LEN], name, namelen);
buf[MOD_PREFIX_LEN + namelen] = '\0';
#if defined(HCL_ENABLE_STATIC_MODULE)
/* attempt to find a statically linked module */
/* TODO: binary search ... */
for (n = 0; n < HCL_COUNTOF(static_modtab); n++)
{
if (hcl_compoocharsbcstr (name, namelen, static_modtab[n].modname) == 0)
{
load = static_modtab[n].modload;
break;
}
}
if (load)
{
/* found the module in the staic module table */
HCL_MEMSET (&md, 0, HCL_SIZEOF(md));
hcl_copyoochars ((hcl_ooch_t*)md.mod.name, name, namelen);
/* Note md.handle is HCL_NULL for a static module */
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = hcl_rbt_insert (&hcl->modtab, (hcl_ooch_t*)name, namelen, &md, HCL_SIZEOF(md));
if (pair == HCL_NULL)
{
hcl_seterrnum (hcl, HCL_ESYSMEM);
return HCL_NULL;
}
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints;
if (load (hcl, &mdp->mod) <= -1)
{
hcl_rbt_delete (&hcl->modtab, (hcl_ooch_t*)name, namelen);
return HCL_NULL;
}
mdp->pair = pair;
HCL_DEBUG1 (hcl, "Opened a static module [%js]\n", mdp->mod.name);
return mdp;
}
else
{
#if !defined(HCL_ENABLE_DYNAMIC_MODULE)
HCL_DEBUG2 (hcl, "Cannot find a static module [%.*js]\n", namelen, name);
hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL;
#endif
}
#endif
#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? */
return HCL_NULL;
#endif
/* attempt to find a dynamic external module */
HCL_MEMSET (&md, 0, HCL_SIZEOF(md));
hcl_copyoochars ((hcl_ooch_t*)md.mod.name, name, namelen);
if (hcl->vmprim.dl_open && hcl->vmprim.dl_getsym && hcl->vmprim.dl_close)
{
md.handle = hcl->vmprim.dl_open (hcl, &buf[MOD_PREFIX_LEN], HCL_VMPRIM_OPENDL_PFMOD);
}
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 */
return HCL_NULL;
}
/* attempt to get hcl_mod_xxx where xxx is the module name*/
load = hcl->vmprim.dl_getsym (hcl, md.handle, buf);
if (!load)
{
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;
}
/* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */
pair = hcl_rbt_insert (&hcl->modtab, (void*)name, namelen, &md, HCL_SIZEOF(md));
if (pair == HCL_NULL)
{
HCL_DEBUG2 (hcl, "Cannot register a module [%.*js]\n", namelen, name);
hcl_seterrnum (hcl, HCL_ESYSMEM);
hcl->vmprim.dl_close (hcl, md.handle);
return HCL_NULL;
}
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints;
if (load (hcl, &mdp->mod) <= -1)
{
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;
}
mdp->pair = pair;
HCL_DEBUG2 (hcl, "Opened a module [%js] - %p\n", mdp->mod.name, mdp->handle);
/* the module loader must ensure to set a proper query handler */
HCL_ASSERT (hcl, mdp->mod.query != HCL_NULL);
return mdp;
}
void hcl_closemod (hcl_t* hcl, hcl_mod_data_t* mdp)
{
if (mdp->mod.unload) mdp->mod.unload (hcl, &mdp->mod);
if (mdp->handle)
{
hcl->vmprim.dl_close (hcl, mdp->handle);
HCL_DEBUG2 (hcl, "Closed a module [%js] - %p\n", mdp->mod.name, mdp->handle);
mdp->handle = HCL_NULL;
}
else
{
HCL_DEBUG1 (hcl, "Closed a static module [%js]\n", mdp->mod.name);
}
if (mdp->pair)
{
/*mdp->pair = HCL_NULL;*/ /* this reset isn't needed as the area will get freed by hcl_rbt_delete()) */
hcl_rbt_delete (&hcl->modtab, mdp->mod.name, hcl_countoocstr(mdp->mod.name));
}
}
int hcl_importmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t len)
{
hcl_rbt_pair_t* pair;
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)
{
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, mdp != HCL_NULL);
HCL_DEBUG1 (hcl, "Cannot import module [%js] - already active\n", mdp->mod.name);
hcl_seterrnum (hcl, HCL_EPERM);
goto done2;
}
mdp = hcl_openmod (hcl, name, len, HCL_MOD_LOAD_FOR_IMPORT);
if (!mdp) goto done2;
if (!mdp->mod.import)
{
HCL_DEBUG1 (hcl, "Cannot import module [%js] - importing not supported by the module\n", mdp->mod.name);
hcl_seterrnum (hcl, HCL_ENOIMPL);
goto done;
}
if (mdp->mod.import (hcl, &mdp->mod) <= -1)
{
HCL_DEBUG1 (hcl, "Cannot import module [%js] - module's import() returned failure\n", mdp->mod.name);
goto done;
}
r = 0; /* everything successful */
done:
/* close the module opened above.
* [NOTE] if the import callback calls the hcl_querymod(), the returned
* function pointers will get all invalidated here. so never do
* anything like that */
hcl_closemod (hcl, mdp);
done2:
return r;
}
hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidlen)
{
/* primitive function identifier
* _funcname
* modname_funcname
*/
hcl_rbt_pair_t* pair;
hcl_mod_data_t* mdp;
const hcl_ooch_t* sep;
hcl_oow_t mod_name_len;
hcl_pfbase_t* pfbase;
sep = hcl_rfindoochar (pfid, pfidlen, '.');
if (!sep)
{
/* i'm writing a conservative code here. the compiler should
* guarantee that a period is included in an primitive function identifer.
* what if the compiler is broken? imagine a buggy compiler rewritten
* in hcl itself? */
HCL_DEBUG2 (hcl, "Internal error - no period in a primitive function identifier [%.*js] - buggy compiler?\n", pfidlen, pfid);
hcl_seterrbfmt (hcl, HCL_EINTERN, "no period in a primitive function identifier [%.*js]", pfidlen, pfid);
return HCL_NULL;
}
mod_name_len = sep - pfid;
/* the first segment through the segment before the last compose a
* module id. the last segment is the primitive function name.
* for instance, in con.window.open, con.window is a module id and
* open is the primitive function name. */
pair = hcl_rbt_search (&hcl->modtab, pfid, mod_name_len);
if (pair)
{
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, mdp != HCL_NULL);
}
else
{
/* open a module using the part before the last period */
mdp = hcl_openmod (hcl, pfid, mod_name_len, 0);
if (!mdp) return HCL_NULL;
}
if ((pfbase = mdp->mod.query (hcl, &mdp->mod, sep + 1, pfidlen - mod_name_len - 1)) == HCL_NULL)
{
/* the primitive function is not found. but keep the module open even if it's opened above */
HCL_DEBUG3 (hcl, "Cannot find a primitive function [%.*js] in a module [%js]\n", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name);
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to find a primitive function [%.*js] in a module [%js]", pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name);
return HCL_NULL;
}
HCL_DEBUG4 (hcl, "Found a primitive function [%.*js] in a module [%js] - %p\n",
pfidlen - mod_name_len - 1, sep + 1, mdp->mod.name, pfbase);
return pfbase;
}

View File

@ -696,9 +696,9 @@ enum hcl_vmprim_opendl_flag_t
};
typedef enum hcl_vmprim_opendl_flag_t hcl_vmprim_opendl_flag_t;
typedef void* (*hcl_vmprim_dlopen_t) (hcl_t* hcl, const hcl_uch_t* name);
typedef void* (*hcl_vmprim_dlopen_t) (hcl_t* hcl, const hcl_ooch_t* name, int flags);
typedef void (*hcl_vmprim_dlclose_t) (hcl_t* hcl, void* handle);
typedef void* (*hcl_vmprim_dlsym_t) (hcl_t* hcl, void* handle, const hcl_uch_t* name);
typedef void* (*hcl_vmprim_dlgetsym_t) (hcl_t* hcl, void* handle, const hcl_ooch_t* name);
typedef void (*hcl_log_write_t) (hcl_t* hcl, hcl_oow_t mask, const hcl_ooch_t* msg, hcl_oow_t len);
typedef void (*hcl_syserrstrb_t) (hcl_t* hcl, int syserr, hcl_bch_t* buf, hcl_oow_t len);
@ -715,7 +715,7 @@ struct hcl_vmprim_t
{
hcl_vmprim_dlopen_t dl_open;
hcl_vmprim_dlclose_t dl_close;
hcl_vmprim_dlsym_t dl_getsym;
hcl_vmprim_dlgetsym_t dl_getsym;
hcl_log_write_t log_write;
hcl_syserrstrb_t syserrstrb;
@ -834,7 +834,7 @@ struct hcl_cb_t
/* =========================================================================
* PRIMITIVE MODULE MANIPULATION
* PRIMITIVE FUNCTIONS
* ========================================================================= */
enum hcl_pfrc_t
{
@ -843,39 +843,85 @@ enum hcl_pfrc_t
};
typedef enum hcl_pfrc_t hcl_pfrc_t;
typedef hcl_pfrc_t (*hcl_prim_impl_t) (hcl_t* hcl, hcl_ooi_t nargs);
typedef hcl_pfrc_t (*hcl_pfimpl_t) (hcl_t* hcl, hcl_ooi_t nargs);
typedef struct hcl_prim_mod_t hcl_prim_mod_t;
typedef int (*hcl_prim_mod_load_t) (
hcl_t* hcl,
hcl_prim_mod_t* mod
typedef struct hcl_pfbase_t hcl_pfbase_t;
struct hcl_pfbase_t
{
hcl_pfimpl_t handler;
hcl_oow_t minargs;
hcl_oow_t maxargs;
};
typedef struct hcl_pfinfo_t hcl_pfinfo_t;
struct hcl_pfinfo_t
{
hcl_ooch_t mthname[32];
int variadic;
hcl_pfbase_t base;
};
/* =========================================================================
* PRIMITIVE MODULE MANIPULATION
* ========================================================================= */
#define HCL_MOD_NAME_LEN_MAX 120
typedef struct hcl_mod_t hcl_mod_t;
enum hcl_mod_hint_t
{
HCL_MOD_LOAD_FOR_IMPORT = (1 << 0)
};
typedef enum hcl_mod_hint_t hcl_mod_hint_t;
typedef int (*hcl_mod_load_t) (
hcl_t* hcl,
hcl_mod_t* mod
);
typedef hcl_prim_impl_t (*hcl_prim_mod_query_t) (
typedef int (*hcl_mod_import_t) (
hcl_t* hcl,
hcl_prim_mod_t* mod,
const hcl_uch_t* name
hcl_mod_t* mod
);
typedef void (*hcl_prim_mod_unload_t) (
hcl_t* hcl,
hcl_prim_mod_t* mod
typedef hcl_pfbase_t* (*hcl_mod_query_t) (
hcl_t* hcl,
hcl_mod_t* mod,
const hcl_ooch_t* name,
hcl_oow_t namelen
);
struct hcl_prim_mod_t
typedef void (*hcl_mod_unload_t) (
hcl_t* hcl,
hcl_mod_t* mod
);
typedef void (*hcl_mod_gc_t) (
hcl_t* hcl,
hcl_mod_t* mod
);
struct hcl_mod_t
{
hcl_prim_mod_unload_t unload;
hcl_prim_mod_query_t query;
void* ctx;
/* input */
const hcl_ooch_t name[HCL_MOD_NAME_LEN_MAX + 1];
/*const*/ int hints; /* bitwised-ORed of hcl_mod_hint_t enumerators */
/* user-defined data */
hcl_mod_import_t import;
hcl_mod_query_t query;
hcl_mod_unload_t unload;
hcl_mod_gc_t gc;
void* ctx;
};
struct hcl_prim_mod_data_t
struct hcl_mod_data_t
{
void* handle;
hcl_prim_mod_t mod;
void* handle;
hcl_rbt_pair_t* pair; /* internal backreference to hcl->modtab */
hcl_mod_t mod;
};
typedef struct hcl_prim_mod_data_t hcl_prim_mod_data_t;
typedef struct hcl_mod_data_t hcl_mod_data_t;
struct hcl_sbuf_t
@ -937,7 +983,7 @@ struct hcl_t
hcl_vmprim_t vmprim;
hcl_cb_t* cblist;
hcl_rbt_t pmtable; /* primitive module table */
hcl_rbt_t modtab; /* primitive module table */
struct
{
@ -1815,7 +1861,7 @@ HCL_EXPORT hcl_oop_t hcl_reversecons (
HCL_EXPORT hcl_oop_t hcl_makeprim (
hcl_t* hcl,
hcl_prim_impl_t primimpl,
hcl_pfimpl_t primimpl,
hcl_oow_t minargs,
hcl_oow_t maxargs
);

View File

@ -54,7 +54,7 @@
# include <Timer.h>
#else
# if defined(MOO_ENABLE_LIBLTDL)
# if defined(HCL_ENABLE_LIBLTDL)
# include <ltdl.h>
# define USE_LTDL
# define sys_dl_error() lt_dlerror()

View File

@ -30,7 +30,7 @@ struct prim_t
{
hcl_oow_t minargs;
hcl_oow_t maxargs;
hcl_prim_impl_t impl;
hcl_pfimpl_t impl;
hcl_oow_t namelen;
hcl_ooch_t name[10];
@ -40,7 +40,7 @@ typedef struct prim_t prim_t;
/* ------------------------------------------------------------------------- */
hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_prim_impl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs)
hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs)
{
hcl_oop_word_t obj;