hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

converted some macros to functions - hcl_getxtn(), hcl_getcmgr(), hcl_setcmgr, hcl_getmmgr()
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source 
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
This commit is contained in:
hyung-hwan 2024-02-20 15:40:39 +09:00
parent d1deecb5d7
commit ee152519a8
8 changed files with 98 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lib/fmt.c
View File

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

29
lib/hcl.c
View File

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

26
lib/hcl.h
View File

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

4
lib/heap.c
View File

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

2
lib/rbt.c
View File

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

25
lib/read.c
View File

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

2
lib/std.c
View File

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

43
pas/hcl.pas
View File

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