added HCL_MOD_LIBDIRS

2024-01-05 15:01:59 +09:00 · 2024-01-05 15:01:59 +09:00 · 9bc90c4d60
commit 9bc90c4d60
parent 15a8f142f1
10 changed files with 286 additions and 110 deletions
--- a/bin/main.c
+++ b/bin/main.c
@ -599,6 +599,7 @@ int main (int argc, char* argv[])
 		{ ":heapsize",    '\0' },
 		{ ":log",         'l'  },
 		{ ":info",        '\0' },
+		{ ":modlibdirs",  '\0' },

 		{ HCL_NULL,       '\0' }
 	};
@ -613,6 +614,7 @@ int main (int argc, char* argv[])
 	int verbose = 0;
 	int show_info = 0;
 	int experimental = 0;
+	const char* modlibdirs = HCL_NULL;

 #if defined(HCL_BUILD_DEBUG)
 	const char* dbgopt = HCL_NULL;
@ -662,6 +664,11 @@ int main (int argc, char* argv[])
 					show_info = 1;
 					break;
 				}
+				else if (hcl_comp_bcstr(opt.lngopt, "modlibdirs") == 0)
+				{
+					modlibdirs = opt.arg;
+					break;
+				}

 				goto print_usage;

@ -711,6 +718,33 @@ int main (int argc, char* argv[])
 		hcl_setoption (hcl, HCL_LOG_MASK, &trait);*/
 	}

+	if (modlibdirs)
+	{
+	#if defined(HCL_OOCH_IS_UCH)
+		hcl_ooch_t* tmp;
+		tmp = hcl_dupbtoucstr(hcl, modlibdirs, HCL_NULL);
+		if (HCL_UNLIKELY(!tmp))
+		{
+			hcl_logbfmt (hcl, HCL_LOG_STDERR,"ERROR: cannot duplicate modlibdirs - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
+			goto oops;
+		}
+
+		if (hcl_setoption(hcl, HCL_MOD_LIBDIRS, tmp) <= -1)
+		{
+			hcl_logbfmt (hcl, HCL_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
+			hcl_freemem (hcl, tmp);
+			goto oops;
+		}
+		hcl_freemem (hcl, tmp);
+	#else
+		if (hcl_setoption(hcl, HCL_MOD_LIBDIRS, modlibdirs) <= -1)
+		{
+			hcl_logbfmt (hcl, HCL_LOG_STDERR,"ERROR: cannot set modlibdirs - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl));
+			goto oops;
+		}
+	#endif
+	}
+
 	xtn = (xtn_t*)hcl_getxtn(hcl);

 	memset (&hclcb, 0, HCL_SIZEOF(hclcb));
--- a/lang.txt
+++ b/lang.txt
@ -9,6 +9,11 @@
 	for dyna-clases, the super prefix is now allowed for varibles. it's allowed for method calls only.
 	double-check symbol and dsymbol resolution in set, set-r, defun, defclass to decide how to make it more logical and reasonable

+
+	assignment syntax
+		(k := 20) -> (set k 20)
+		k := 20  -> (set  k 20)
+
 	implement module -> ::, ., or what notation?
 	implement namespace -> ::, ., or what notation?
 	review the . notation used for C-module loading... may have to change it
--- a/lib/hcl-prv.h
+++ b/lib/hcl-prv.h
@ -182,6 +182,7 @@ enum hcl_tok_type_t
 	HCL_TOK_DBLCOLONS, /* :: */
 	HCL_TOK_TRPCOLONS, /* ::: */
 	HCL_TOK_DCSTAR,    /* ::* */
+	HCL_TOK_COLONEQ,   /* := */
 	HCL_TOK_SEMICOLON, /* ; */
 	HCL_TOK_COMMA,     /* , */
 	HCL_TOK_LPAREN,    /* ( */
--- a/lib/hcl-utl.h
+++ b/lib/hcl-utl.h
@ -377,13 +377,16 @@ typedef enum hcl_cmgr_id_t hcl_cmgr_id_t;
 * PATH-RELATED MACROS
 * ========================================================================= */
 #if defined(_WIN32) || defined(__OS2__) || defined(__DOS__)
-#	define HCL_IS_PATH_SEP(c) ((c) == '/' || (c) == '\\')
 #	define HCL_DFL_PATH_SEP ('\\')
+#	define HCL_ALT_PATH_SEP ('/')
+#	define HCL_IS_PATH_SEP(c) ((c) == HCL_DFL_PATH_SEP || (c) == HCL_ALT_PATH_SEP)
 #else
-#	define HCL_IS_PATH_SEP(c) ((c) == '/')
 #	define HCL_DFL_PATH_SEP ('/')
+#	define HCL_ALT_PATH_SEP ('/')
+#	define HCL_IS_PATH_SEP(c) ((c) == HCL_DFL_PATH_SEP)
 #endif

+
 /* TODO: handle path with a drive letter or in the UNC notation */
 #define HCL_IS_PATH_ABSOLUTE(x) HCL_IS_PATH_SEP(x[0])

--- a/lib/hcl.c
+++ b/lib/hcl.c
@ -188,6 +188,7 @@ static hcl_rbt_walk_t unload_module (hcl_rbt_t* rbt, hcl_rbt_pair_t* pair, void*
 void hcl_fini (hcl_t* hcl)
 {
 	hcl_cb_t* cb;
+	hcl_oow_t i;

 	hcl_rbt_walk (&hcl->modtab, unload_module, hcl);
 	hcl_rbt_fini (&hcl->modtab);
@ -217,7 +218,6 @@ void hcl_fini (hcl_t* hcl)
 	/* deregister all callbacks */
 	while (hcl->cblist) hcl_deregcb (hcl, hcl->cblist);

-
 	/* detach the user data io handlers just in case */
 	hcl_detachudio (hcl);

@ -311,6 +311,11 @@ void hcl_fini (hcl_t* hcl)
 		hcl->option.log_target_b = HCL_NULL;
 	}

+	for (i = 0; i < HCL_COUNTOF(hcl->option.mod); i++)
+	{
+		if (hcl->option.mod[i].ptr) hcl_freemem (hcl, hcl->option.mod[i].ptr);
+	}
+
 	if (hcl->inttostr.xbuf.ptr)
 	{
 		hcl_freemem (hcl, hcl->inttostr.xbuf.ptr);
@ -363,6 +368,22 @@ void hcl_reset (hcl_t* hcl)
 	hcl_gc (hcl, 1);
 }

+static int dup_str_opt (hcl_t* hcl, const void* value, hcl_oocs_t* tmp)
+{
+	if (value)
+	{
+		tmp->ptr = hcl_dupoocstr(hcl, value, &tmp->len);
+		if (HCL_UNLIKELY(!tmp->ptr)) return -1;
+	}
+	else
+	{
+		tmp->ptr = HCL_NULL;
+		tmp->len = 0;
+	}
+
+	return 0;
+}
+
 int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
 {
 	hcl_cb_t* cb;
@ -500,11 +521,26 @@ int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)
 			break;
 		}

+		case HCL_MOD_LIBDIRS:
+		case HCL_MOD_PREFIX:
+		case HCL_MOD_POSTFIX:
+		{
+			hcl_oocs_t tmp;
+			int idx;
+
+			if (dup_str_opt(hcl, value, &tmp) <= -1) return -1;
+
+			idx = id - HCL_MOD_LIBDIRS;
+			if (hcl->option.mod[idx].ptr) hcl_freemem (hcl, hcl->option.mod[idx].ptr);
+
+			hcl->option.mod[idx] = tmp;
+			return 0;
+		}
+
 		case HCL_MOD_INCTX:
 			hcl->option.mod_inctx = *(void**)value;
 			break;

-
 		default:
 			goto einval;
 	}
@ -567,6 +603,12 @@ int hcl_getoption (hcl_t* hcl, hcl_option_t id, void* value)
 			*(hcl_oow_t*)value = hcl->option.dfl_procstk_size;
 			return 0;

+		case HCL_MOD_LIBDIRS:
+		case HCL_MOD_PREFIX:
+		case HCL_MOD_POSTFIX:
+			*(const hcl_ooch_t**)value = hcl->option.mod[id - HCL_MOD_LIBDIRS].ptr;
+			return 0;
+
 		case HCL_MOD_INCTX:
 			*(void**)value = hcl->option.mod_inctx;
 			return 0;
--- a/lib/hcl.h
+++ b/lib/hcl.h
@ -194,6 +194,11 @@ enum hcl_option_t
 	HCL_SYMTAB_SIZE,  /* default system table size */
 	HCL_SYSDIC_SIZE,  /* default system dictionary size */
 	HCL_PROCSTK_SIZE, /* default process stack size */
+
+        HCL_MOD_LIBDIRS,
+        HCL_MOD_PREFIX,
+        HCL_MOD_POSTFIX,
+
 	HCL_MOD_INCTX
 };
 typedef enum hcl_option_t hcl_option_t;
@ -1542,6 +1547,8 @@ struct hcl_t
 		hcl_oow_t dfl_procstk_size;
 		void* mod_inctx;

+		hcl_oocs_t mod[3];
+
 	#if defined(HCL_BUILD_DEBUG)
 		/* set automatically when trait is set */
 		hcl_oow_t karatsuba_cutoff;
--- a/lib/read.c
+++ b/lib/read.c
@ -1454,6 +1454,7 @@ static delim_token_t delim_token_tab[] =
 	{ "...",      3, HCL_TOK_ELLIPSIS }, /* for variable arguments */

 	{ ":",        1, HCL_TOK_COLON }, /* key-value separator in dictionary */
+	{ ":=",       2, HCL_TOK_COLONEQ },
 	{ "::",       2, HCL_TOK_DBLCOLONS },
 	{ "::*",      3, HCL_TOK_DCSTAR },   /* class instantiation method */
 	{ ":::",      3, HCL_TOK_TRPCOLONS  }, /* superclass, class variables, class methods */
--- a/lib/std.c
+++ b/lib/std.c
@ -2457,40 +2457,45 @@ static void dl_cleanup (hcl_t* hcl)
 #endif
 }

-static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
+static void* dlopen_pfmod (hcl_t* hcl, const hcl_ooch_t* name, const hcl_ooch_t* dirptr, const hcl_oow_t dirlen, hcl_bch_t* bufptr, hcl_oow_t bufcapa)
 {
-#if defined(USE_LTDL) || defined(USE_DLFCN) || defined(USE_MACH_O_DYLD)
-	hcl_bch_t stabuf[128], * bufptr;
-	hcl_oow_t ucslen, bcslen, bufcapa;
 	void* handle;
-
-	#if defined(HCL_OOCH_IS_UCH)
-	if (hcl_convootobcstr(hcl, name, &ucslen, HCL_NULL, &bufcapa) <= -1) return HCL_NULL;
-	/* +1 for terminating null. but it's not needed because HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX)
-	 * and HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTIFX) include the terminating nulls. Never mind about
-	 * the extra 2 characters. */
-	#else
-	bufcapa = hcl_count_bcstr(name);
-	#endif
-	bufcapa += HCL_COUNTOF(HCL_DEFAULT_PFMODDIR) + HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX) + HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTFIX) + 1;
-
-	if (bufcapa <= HCL_COUNTOF(stabuf)) bufptr = stabuf;
-	else
-	{
-		bufptr = (hcl_bch_t*)hcl_allocmem(hcl, bufcapa * HCL_SIZEOF(*bufptr));
-		if (!bufptr) return HCL_NULL;
-	}
-
-	if (flags & HCL_VMPRIM_DLOPEN_PFMOD)
-	{
 	hcl_oow_t len, i, xlen, dlen;
+	hcl_oow_t ucslen, bcslen;

 	/* opening a primitive function module - mostly libhcl-xxxx.
 	 * if PFMODPREFIX is absolute, never use PFMODDIR */
-		dlen = HCL_IS_PATH_ABSOLUTE(HCL_DEFAULT_PFMODPREFIX)?
-			0: hcl_copy_bcstr(bufptr, bufcapa, HCL_DEFAULT_PFMODDIR);
-		len = hcl_copy_bcstr(bufptr, bufcapa, HCL_DEFAULT_PFMODPREFIX);
+	if (HCL_IS_PATH_ABSOLUTE(HCL_DEFAULT_PFMODPREFIX))
+	{
+		dlen = 0;
+		len = hcl_copy_bcstr(&bufptr[dlen], bufcapa - dlen, HCL_DEFAULT_PFMODPREFIX);
+	}
+	else if (dirptr)
+	{
+		xlen = dirlen;
+		dlen = bufcapa;
+		if (hcl_convootobchars(hcl, dirptr, &xlen, bufptr, &dlen) <= -1) return HCL_NULL;
+
+		if (dlen > 0 && bufptr[dlen - 1] != HCL_DFL_PATH_SEP)
+		{
+		#if defined(__DOS__) || defined(_WIN32) || defined(__OS2__)
+			if (hcl_find_bchar(bufptr, dlen, HCL_ALT_PATH_SEP) &&
+			    !hcl_find_bchar(bufptr, dlen, HCL_DFL_PATH_SEP))
+				bufptr[dlen++] = HCL_ALT_PATH_SEP;
+			else
+				bufptr[dlen++] = HCL_DFL_PATH_SEP;
+		#endif
+			bufptr[dlen++] = HCL_DFL_PATH_SEP;
+		}
+		len = hcl_copy_bcstr(&bufptr[dlen], bufcapa - dlen, HCL_DEFAULT_PFMODPREFIX);
 		len += dlen;
+	}
+	else
+	{
+		dlen = hcl_copy_bcstr(bufptr, bufcapa, HCL_DEFAULT_PFMODDIR);
+		len = hcl_copy_bcstr(&bufptr[dlen], bufcapa - dlen, HCL_DEFAULT_PFMODPREFIX);
+		len += dlen;
+	}

 	bcslen = bufcapa - len;
 #if defined(HCL_OOCH_IS_UCH)
@ -2512,6 +2517,7 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
 	hcl_copy_bcstr (&bufptr[xlen], bufcapa - xlen, HCL_DEFAULT_PFMODPOSTFIX);

 	/* both prefix and postfix attached. for instance, libhcl-xxx */
+	HCL_DEBUG3 (hcl, "Opening(ext) PFMOD %hs[%js] - %hs\n", &bufptr[dlen], name, bufptr);
 	handle = sys_dl_openext(bufptr);
 	if (!handle)
 	{
@ -2556,10 +2562,15 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
 	pfmod_open_ok:
 		HCL_DEBUG3 (hcl, "Opened(ext) PFMOD %hs[%js] handle %p\n", &bufptr[dlen], name, handle);
 	}
+
+	return handle;
 }
-	else
+
+static void* dlopen_raw (hcl_t* hcl, const hcl_ooch_t* name, hcl_bch_t* bufptr, hcl_oow_t bufcapa)
 {
-		/* opening a raw shared object without a prefix and/or a postfix */
+	void* handle;
+	hcl_oow_t ucslen, bcslen;
+
 #if defined(HCL_OOCH_IS_UCH)
 	bcslen = bufcapa;
 	hcl_convootobcstr(hcl, name, &ucslen, bufptr, &bcslen);
@ -2591,6 +2602,78 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
 		}
 		else HCL_DEBUG2 (hcl, "Opened(ext) DL %hs handle %p\n", bufptr, handle);
 	}
+
+	return handle;
+}
+
+static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
+{
+#if defined(USE_LTDL) || defined(USE_DLFCN) || defined(USE_MACH_O_DYLD)
+	hcl_bch_t stabuf[128], * bufptr;
+	hcl_oow_t ucslen, bcslen, bufcapa;
+	void* handle = HCL_NULL;
+
+	#if defined(HCL_OOCH_IS_UCH)
+	if (hcl_convootobcstr(hcl, name, &ucslen, HCL_NULL, &bufcapa) <= -1) return HCL_NULL;
+
+	if (hcl->option.mod[0].len > 0)
+	{
+		/* multiple directories separated by a colon can be specified for HCL_MOD_LIBDIRS
+		 * however, use the total length to secure space just for simplicity */
+		ucslen = hcl->option.mod[0].len;
+		if (hcl_convootobchars(hcl, hcl->option.mod[0].ptr, &ucslen, HCL_NULL, &bcslen) <= -1) return HCL_NULL;
+		bufcapa += bcslen;
+	}
+	#else
+	bufcapa = hcl_count_bcstr(name);
+	bufcapa += (hcl->option.mod[0].len > 0)? hcl->option.mod[0].len: HCL_COUNTOF(HCL_DEFAULT_PFMODDIR);
+	#endif
+
+	/* HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX) and HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTIFX)
+	 * include the terminating nulls. Never mind about the extra 2 characters. */
+	bufcapa += HCL_COUNTOF(HCL_DEFAULT_PFMODPREFIX) + HCL_COUNTOF(HCL_DEFAULT_PFMODPOSTFIX) + 1;
+
+	if (bufcapa <= HCL_COUNTOF(stabuf)) bufptr = stabuf;
+	else
+	{
+		bufptr = (hcl_bch_t*)hcl_allocmem(hcl, bufcapa * HCL_SIZEOF(*bufptr));
+		if (!bufptr) return HCL_NULL;
+	}
+
+	if (flags & HCL_VMPRIM_DLOPEN_PFMOD)
+	{
+		if (hcl->option.mod[0].len > 0)
+		{
+			const hcl_ooch_t* ptr, * end, * seg;
+
+			ptr = hcl->option.mod[0].ptr;
+			end = hcl->option.mod[0].ptr + hcl->option.mod[0].len;
+			seg = ptr;
+
+			while (ptr <= end)
+			{
+				if (ptr == end || *ptr == ':')
+				{
+					if (ptr - seg > 0)
+					{
+						handle = dlopen_pfmod(hcl, name, seg, ptr - seg, bufptr, bufcapa);
+						if (handle) break;
+					}
+
+					if (ptr == end) break;
+					seg = ptr + 1;
+				}
+				ptr++;
+			}
+
+		}
+
+		if (!handle) handle = dlopen_pfmod(hcl, name, HCL_NULL, 0, bufptr, bufcapa);
+	}
+	else
+	{
+		/* opening a raw shared object without a prefix and/or a postfix */
+		handle = dlopen_raw(hcl, name, bufptr, bufcapa);
 	}

 	if (bufptr != stabuf) hcl_freemem (hcl, bufptr);
--- a/t/Makefile.am
+++ b/t/Makefile.am
@ -27,8 +27,8 @@ TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS)

 TEST_EXTENSIONS = .hcl .err

-HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl -x
+HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
 AM_HCL_LOG_FLAGS =

-ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl -x
+ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
 AM_ERR_LOG_FLAGS =
--- a/t/Makefile.in
+++ b/t/Makefile.in
@ -491,9 +491,9 @@ check_ERRORS = \

 EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS)
 TEST_EXTENSIONS = .hcl .err
-HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl -x
+HCL_LOG_COMPILER = sh $(abs_srcdir)/run.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
 AM_HCL_LOG_FLAGS = 
-ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl -x
+ERR_LOG_COMPILER = sh $(abs_srcdir)/err.sh ../bin/hcl --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 -x
 AM_ERR_LOG_FLAGS = 
 all: all-am