converted some macros to functions - hcl_getxtn(), hcl_getcmgr(), hcl_setcmgr, hcl_getmmgr()

introduced the same macros unsing upper-case naming convention - HCL_XTN(), HCL_MMGR, HCL_CMGR()
enhanced the pascal wrapper to load an included file based on the parent path

lib/fmt.c

@@ -1713,7 +1713,7 @@ hcl_ooi_t hcl_logbfmtv (hcl_t* hcl, hcl_bitmask_t mask, const hcl_bch_t* fmt, va
 	fo.fmt_str = fmt;
 	fo.ctx = hcl;
 	fo.mask = mask;
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.putbchars = log_bcs;
 	fo.putuchars = log_ucs;
 	fo.putobj = hcl_fmt_object_;
@@ -1781,7 +1781,7 @@ hcl_ooi_t hcl_logufmtv (hcl_t* hcl, hcl_bitmask_t mask, const hcl_uch_t* fmt, va
 	fo.fmt_str = fmt;
 	fo.ctx = hcl;
 	fo.mask = mask;
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.putbchars = log_bcs;
 	fo.putuchars = log_ucs;
 	fo.putobj = hcl_fmt_object_;
@@ -1958,7 +1958,7 @@ hcl_ooi_t hcl_prbfmtv (hcl_t* hcl, const hcl_bch_t* fmt, va_list ap)
 	fo.fmt_str = fmt;
 	fo.ctx = hcl;
 	fo.mask = 0;
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.putbchars = print_bcs;
 	fo.putuchars = print_ucs;
 	fo.putobj = hcl_fmt_object_;
@@ -1991,7 +1991,7 @@ hcl_ooi_t hcl_prufmtv (hcl_t* hcl, const hcl_uch_t* fmt, va_list ap)
 	fo.fmt_str = fmt;
 	fo.ctx = hcl;
 	fo.mask = 0;
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.putbchars = print_bcs;
 	fo.putuchars = print_ucs;
 	fo.putobj = hcl_fmt_object_;
@@ -2859,7 +2859,7 @@ int hcl_prfmtcallstack (hcl_t* hcl, hcl_ooi_t nargs)
 	HCL_MEMSET (&fo, 0, HCL_SIZEOF(fo));
 
 	fo.mask = 0;
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.ctx = hcl;
 	fo.putbchars = print_bcs;
 	fo.putuchars = print_ucs;
@@ -2888,7 +2888,7 @@ int hcl_logfmtcallstack (hcl_t* hcl, hcl_ooi_t nargs)
 		fo.mask |= (hcl->log.default_type_mask & HCL_LOG_ALL_TYPES);
 	}
 
-	fo.mmgr = hcl_getmmgr(hcl);
+	fo.mmgr = HCL_MMGR(hcl);
 	fo.ctx = hcl;
 	fo.putbchars = log_bcs;
 	fo.putuchars = log_ucs;

lib/hcl.c

@@ -51,7 +51,26 @@ hcl_t* hcl_open (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, const hcl_vmprim_t* vmprim
 void hcl_close (hcl_t* hcl)
 {
 	hcl_fini (hcl);
-	HCL_MMGR_FREE (hcl_getmmgr(hcl), hcl);
+	HCL_MMGR_FREE (HCL_MMGR(hcl), hcl);
+}
+
+void* hcl_getxtn (hcl_t* hcl)
+{
+	return (void*)((hcl_uint8_t*)hcl + hcl->_instsize);
+}
+
+hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl)
+{
+	return hcl->_mmgr;
+}
+
+hcl_cmgr_t* hcl_getcmgr (hcl_t* hcl)
+{
+	return hcl->_cmgr;
+}
+void hcl_setcmgr (hcl_t* hcl, hcl_cmgr_t* cmgr)
+{
+	hcl->_cmgr = cmgr;
 }
 
 static void fill_bigint_tables (hcl_t* hcl)
@@ -665,7 +684,7 @@ void* hcl_allocmem (hcl_t* hcl, hcl_oow_t size)
 {
 	void* ptr;
 
-	ptr = HCL_MMGR_ALLOC (hcl_getmmgr(hcl), size);
+	ptr = HCL_MMGR_ALLOC(HCL_MMGR(hcl), size);
 	if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
 	return ptr;
 }
@@ -674,7 +693,7 @@ void* hcl_callocmem (hcl_t* hcl, hcl_oow_t size)
 {
 	void* ptr;
 
-	ptr = HCL_MMGR_ALLOC (hcl_getmmgr(hcl), size);
+	ptr = HCL_MMGR_ALLOC(HCL_MMGR(hcl), size);
 	if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
 	else HCL_MEMSET (ptr, 0, size);
 	return ptr;
@@ -682,14 +701,14 @@ void* hcl_callocmem (hcl_t* hcl, hcl_oow_t size)
 
 void* hcl_reallocmem (hcl_t* hcl, void* ptr, hcl_oow_t size)
 {
-	ptr = HCL_MMGR_REALLOC (hcl_getmmgr(hcl), ptr, size);
+	ptr = HCL_MMGR_REALLOC(HCL_MMGR(hcl), ptr, size);
 	if (!ptr) hcl_seterrnum (hcl, HCL_ESYSMEM);
 	return ptr;
 }
 
 void hcl_freemem (hcl_t* hcl, void* ptr)
 {
-	HCL_MMGR_FREE (hcl_getmmgr(hcl), ptr);
+	HCL_MMGR_FREE (HCL_MMGR(hcl), ptr);
 }
 
 

lib/hcl.h

@@ -2050,22 +2050,24 @@ HCL_EXPORT void hcl_reset (
 	hcl_t*   hcl
 );
 
-#if defined(HCL_HAVE_INLINE)
+#define HCL_XTN(hcl) ((void*)((hcl_uint8_t*)hcl + ((hcl_t*)hcl)->_instsize))
-static HCL_INLINE void* hcl_getxtn (hcl_t* hcl) { return (void*)((hcl_uint8_t*)hcl + hcl->_instsize); }
-static HCL_INLINE hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl) { return hcl->_mmgr; }
-static HCL_INLINE hcl_cmgr_t* hcl_getcmgr (hcl_t* hcl) { return hcl->_cmgr; }
-static HCL_INLINE void hcl_setcmgr (hcl_t* hcl, hcl_cmgr_t* cmgr) { hcl->_cmgr = cmgr; }
-#else
-#define hcl_getxtn(hcl) ((void*)((hcl_uint8_t*)hcl + ((hcl_t*)hcl)->_instsize))
-#define hcl_getmmgr(hcl) (((hcl_t*)(hcl))->_mmgr)
-#define hcl_getcmgr(hcl) (((hcl_t*)(hcl))->_cmgr)
-#define hcl_setcmgr(hcl,cmgr) (((hcl_t*)(hcl))->_cmgr = (cmgr))
-#endif
-
 #define HCL_MMGR(hcl) (((hcl_t*)(hcl))->_mmgr)
 #define HCL_CMGR(hcl) (((hcl_t*)(hcl))->_cmgr)
 #define HCL_ERRNUM(hcl) (((hcl_t*)(hcl))->errnum)
 
+void* hcl_getxtn (
+	hcl_t* hcl
+);
+
+HCL_EXPORT hcl_cmgr_t* hcl_getcmgr (
+	hcl_t* hcl
+);
+
+HCL_EXPORT void hcl_setcmgr (
+	hcl_t*      hcl,
+	hcl_cmgr_t* cmgr
+);
+
 HCL_EXPORT hcl_errnum_t hcl_geterrnum (
 	hcl_t* hcl
 );

lib/heap.c

@@ -80,12 +80,12 @@ hcl_heap_t* hcl_makeheap (hcl_t* hcl, hcl_oow_t size)
 	{
 		/* use the existing memory allocator */
 		HCL_ASSERT (hcl, alloc_size == 0);
-		heap->xmmgr = *hcl_getmmgr(hcl);
+		heap->xmmgr = *HCL_MMGR(hcl);
 	}
 	else
 	{
 		/* create a new memory allocator over the allocated heap */
-		heap->xma = hcl_xma_open(hcl_getmmgr(hcl), 0, heap->base, heap->size);
+		heap->xma = hcl_xma_open(HCL_MMGR(hcl), 0, heap->base, heap->size);
 		if (HCL_UNLIKELY(!heap->xma))
 		{
 			hcl->vmprim.free_heap (hcl, heap);

lib/rbt.c

@@ -65,7 +65,7 @@ HCL_INLINE hcl_rbt_pair_t* hcl_rbt_allocpair (
 	if (kcop == HCL_RBT_COPIER_INLINE) as += HCL_ALIGN_POW2(KTOB(rbt,klen), HCL_SIZEOF_VOID_P);
 	if (vcop == HCL_RBT_COPIER_INLINE) as += VTOB(rbt,vlen);
 
-	pair = (hcl_rbt_pair_t*)HCL_MMGR_ALLOC(hcl_getmmgr(rbt->hcl), as);
+	pair = (hcl_rbt_pair_t*)HCL_MMGR_ALLOC(HCL_MMGR(rbt->hcl), as);
 	if (pair == HCL_NULL) return HCL_NULL;
 
 	pair->color = HCL_RBT_RED;

lib/read.c

@@ -24,7 +24,7 @@
 
 #include "hcl-prv.h"
 
-/*#define HCL_LANG_ENABLE_WIDE_DELIM*/
+#define HCL_LANG_ENABLE_WIDE_DELIM
 
 #define BUFFER_ALIGN 128
 #define BALIT_BUFFER_ALIGN 128
@@ -208,7 +208,6 @@ static HCL_INLINE int is_alphachar (hcl_ooci_t c)
 	return (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z');
 }
 
-
 static HCL_INLINE int is_alnumchar (hcl_ooci_t c)
 {
 /* TODO: support full unicode */
@@ -221,9 +220,9 @@ static HCL_INLINE int is_delimchar (hcl_ooci_t c)
 	return c == '(' || c == ')' || c == '[' || c == ']' || c == '{' || c == '}' ||
 	       c == '|' || c == ',' || c == '.' || c == ':' || c == ';' ||
 	       /* the first characters of tokens in delim_token_tab up to this point */
-
 #if defined(HCL_OOCH_IS_UCH) && defined(HCL_LANG_ENABLE_WIDE_DELIM)
-	       c == L'“' || c == L'”' ||
+	       c == L'\u201C' || c == L'\u201D' ||  /* “ ” */
+	       c == L'\u2018' || c == L'\u2019' ||  /* ‘ ’ */
 #endif
 	       c == '#' || c == '\"' || c == '\'' || c == '\\' || is_spacechar(c) || c == HCL_OOCI_EOF;
 }
@@ -2011,18 +2010,22 @@ static int flx_start (hcl_t* hcl, hcl_ooci_t c)
 			FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
 			goto consumed;
 
-#if defined(HCL_OOCH_IS_UCH) && defined(HCL_LANG_ENABLE_WIDE_DELIM)
-		case L'“':
-			init_flx_qt (FLX_QT(hcl), HCL_TOK_STRLIT, HCL_SYNERR_STRLIT, L'”', '\\', 0, HCL_TYPE_MAX(hcl_oow_t), 0);
-			FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
-			goto consumed;
-#endif
-
 		case '\'':
 			init_flx_qt (FLX_QT(hcl), HCL_TOK_CHARLIT, HCL_SYNERR_CHARLIT, c, '\\', 1, 1, 0);
 			FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
 			goto consumed;
 
+#if defined(HCL_OOCH_IS_UCH) && defined(HCL_LANG_ENABLE_WIDE_DELIM)
+		case L'\u201C': /* “ ” */
+			init_flx_qt (FLX_QT(hcl), HCL_TOK_STRLIT, HCL_SYNERR_STRLIT, L'\u201D', '\\', 0, HCL_TYPE_MAX(hcl_oow_t), 0);
+			FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
+			goto consumed;
+		case L'\u2018': /* ‘ ’ */
+			init_flx_qt (FLX_QT(hcl), HCL_TOK_CHARLIT, HCL_SYNERR_CHARLIT, L'\u2019', '\\', 1, 1, 0);
+			FEED_CONTINUE (hcl, HCL_FLX_QUOTED_TOKEN); /* discard the quote itself. move on the the QUOTED_TOKEN state */
+			goto consumed;
+#endif
+
 		case '+':
 		case '-':
 			init_flx_st (FLX_ST(hcl), c);

lib/std.c

@@ -410,7 +410,7 @@ struct xtn_t
 	} ev;
 };
 
-#define GET_XTN(hcl) ((xtn_t*)((hcl_uint8_t*)hcl_getxtn(hcl) - HCL_SIZEOF(xtn_t)))
+#define GET_XTN(hcl) ((xtn_t*)((hcl_uint8_t*)HCL_XTN(hcl) - HCL_SIZEOF(xtn_t)))
 
 
 /* -----------------------------------------------------------------

pas/hcl.pas

@@ -60,6 +60,7 @@ type
 	Interp = class
 	protected
 		handle: pointer;
+		basedir: string;
 
 	public
 		constructor Create(x: integer);
@@ -77,6 +78,12 @@ type
 		function FetchErrorMsg(): string;
 	end;
 
+	InterpExt = record
+		self: Interp;
+	end;
+
+	InterpExtPtr = ^InterpExt;
+
 	IO = class
 	public
 		procedure Open(); virtual; abstract;
@@ -106,6 +113,7 @@ function hcl_errnum_is_synerr(errnum: integer): boolean; cdecl; external;
 
 function hcl_openstd(xtnsize: System.SizeUint; errnum: pointer): pointer; cdecl; external;
 procedure hcl_close(handle: pointer); cdecl; external;
+function hcl_getxtn(handle: pointer): InterpExtPtr; cdecl; external;
 
 function hcl_setoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external;
 function hcl_getoption(handle: pointer; option: Option; value: pointer): integer; cdecl; external;
@@ -147,21 +155,26 @@ var
 	errnum: integer;
 	errmsg: array[0..255] of AnsiChar;
 	tb: BitMask;
+	ext: InterpExtPtr;
 begin
-
+	h := hcl_openstd(System.SizeOf(Interp), @errnum);
-	h := hcl_openstd(0, @errnum);
 	if h = nil then begin
 		hcl_errnum_to_errbcstr(errnum, @errmsg, length(errmsg));
 		raise Exception.Create(errmsg);
 	end;
 
+
 	tb := BitMask(TraitBit.LANG_ENABLE_EOF) or BitMask(TraitBit.LANG_ENABLE_BLOCK);
 	if hcl_setoption(h, Option.TRAIT, @tb) <= -1 then begin
 		hcl_errnum_to_errbcstr(errnum, @errmsg, length(errmsg));
 		hcl_close(h);
 		raise Exception.Create(errmsg);
 	end;
+
 	self.handle := h;
+
+	ext := hcl_getxtn(h);
+	ext^.self := self;
 end;
 
 destructor Interp.Destroy;
@@ -206,35 +219,48 @@ procedure Interp.Ignite(heapsize: System.SizeUint);
 begin
 	if hcl_ignite(self.handle, heapsize) <= -1 then
 	begin
-		(* TODO: proper error message *)
 		raise Exception.Create('failed to ignite - ' + self.FetchErrorMsg())
 	end;
 end;
 
 procedure Interp.AddBuiltinPrims();
 begin
-	(* TODO: proper error message *)
 	if hcl_addbuiltinprims(self.handle) <= -1 then
 	begin
 		raise Exception.Create('failed to add builtin primitives - ' + self.FetchErrorMsg())
 	end;
 end;
 
+function handle_to_self(handle: pointer): Interp;
+var
+	ext: InterpExtPtr;
+begin
+	ext := hcl_getxtn(handle);
+	exit(ext^.self);
+end;
+
 function cci_handler(handle: pointer; cmd: IoCmd; arg: CciArgPtr): integer; cdecl;
 var
 	f: System.THandle;
 	len: System.LongInt;
 	err: System.Integer;
+	name: System.RawByteString;
+	self: Interp;
 begin
 	(* check if the main stream is requested.
 	 * it doesn't have to be handled because the main stream must be handled via feeding *)
 
-	if arg^.includer = nil then exit(0);
+	if arg^.includer = nil then exit(0); (* main stream - ignore it *)
 
 	case cmd of
 		IO_OPEN: begin
-		(* TODO: remember the parent path and load from the parent directory if necessary*)
+			self := handle_to_self(handle);
-			f := SysUtils.FileOpen(System.UTF8Encode(arg^.name), SysUtils.fmOpenRead);
+			if arg^.includer <> nil then
+				name := SysUtils.ConcatPaths([self.basedir, UTF8Encode(arg^.name)])
+			else
+				name := System.UTF8Encode(arg^.name);
+
+			f := SysUtils.FileOpen(name, SysUtils.fmOpenRead);
 			if f = System.THandle(-1) then begin
 				err := SysUtils.GetLastOSError();
 				hcl_seterrbmsg(handle, hcl_syserrstrb(handle, 0, err, nil, 0), pansichar(SysUtils.SysErrorMessage(err)));
@@ -306,6 +332,7 @@ begin
 	end;
 	attached := true;
 
+	self.basedir := SysUtils.ExtractFilePath(filename);
 	if hcl_beginfeed(self.handle, nil) <= -1 then begin
 		errmsg := 'failed to begin feeding - ' + self.FetchErrorMsg();
 		goto oops;
@@ -335,12 +362,14 @@ begin
 	feed_ongoing := false;
 
 	hcl_detachccio(self.handle);
+	self.basedir := '';
 	SysUtils.FileClose(f);
 	exit();
 
 oops:
 	if feed_ongoing then hcl_endfeed(self.handle);
 	if attached then hcl_detachccio(self.handle);
+	self.basedir := '';
 	if f >= -1 then SysUtils.FileClose(f);
 	raise Exception.Create(errmsg);
 end;