diff --git a/lib/fmt.c b/lib/fmt.c index 3a727cb..09f0059 100644 --- a/lib/fmt.c +++ b/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; diff --git a/lib/hcl.c b/lib/hcl.c index 9f564bc..badb969 100644 --- a/lib/hcl.c +++ b/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); } diff --git a/lib/hcl.h b/lib/hcl.h index 4b7b5dd..8e6fe94 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -2050,22 +2050,24 @@ HCL_EXPORT void hcl_reset ( hcl_t* hcl ); -#if defined(HCL_HAVE_INLINE) -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_XTN(hcl) ((void*)((hcl_uint8_t*)hcl + ((hcl_t*)hcl)->_instsize)) #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 ); diff --git a/lib/heap.c b/lib/heap.c index 442fbea..62d2a4d 100644 --- a/lib/heap.c +++ b/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); diff --git a/lib/rbt.c b/lib/rbt.c index cd3df6e..b94dee1 100644 --- a/lib/rbt.c +++ b/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; diff --git a/lib/read.c b/lib/read.c index 67c584b..6c395c1 100644 --- a/lib/read.c +++ b/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); diff --git a/lib/std.c b/lib/std.c index 4183e19..607ee97 100644 --- a/lib/std.c +++ b/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))) /* ----------------------------------------------------------------- diff --git a/pas/hcl.pas b/pas/hcl.pas index 87a8f4d..92b72a4 100644 --- a/pas/hcl.pas +++ b/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(0, @errnum); + h := hcl_openstd(System.SizeOf(Interp), @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*) - f := SysUtils.FileOpen(System.UTF8Encode(arg^.name), SysUtils.fmOpenRead); + self := handle_to_self(handle); + 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;