changed hcl_geterrnum() to HCL_ERRNUM().
All checks were successful
continuous-integration/drone/push Build is passing
All checks were successful
continuous-integration/drone/push Build is passing
reintroduced hcl_geterrnum() as a function
This commit is contained in:
parent
d339338a40
commit
9aa1bde1a1
14
lib/comp.c
14
lib/comp.c
@ -112,7 +112,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to grow string buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to grow string buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -535,7 +535,7 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc, const hcl_loc_t* src
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to grow byte code buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to grow byte code buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -543,7 +543,7 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc, const hcl_loc_t* src
|
||||
if (HCL_UNLIKELY(!tmp2))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to grow debug info buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to grow debug info buffer - %js", orgmsg);
|
||||
hcl_freemem (hcl, tmp);
|
||||
return -1;
|
||||
}
|
||||
@ -969,7 +969,7 @@ static int push_cblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_cblk_type_t type)
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to resize control block info buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to resize control block info buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -1019,7 +1019,7 @@ static int push_clsblk (hcl_t* hcl, const hcl_loc_t* errloc, hcl_oow_t nivars, h
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to resize class block info buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to resize class block info buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -1123,7 +1123,7 @@ static int push_fnblk (hcl_t* hcl, const hcl_loc_t* errloc,
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to resize function block info buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to resize function block info buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -1239,7 +1239,7 @@ static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, h
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to grow compiler frame stack- %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to grow compiler frame stack- %js", orgmsg);
|
||||
hcl->c->cfs.top--;
|
||||
return -1;
|
||||
}
|
||||
|
11
lib/err.c
11
lib/err.c
@ -179,6 +179,12 @@ static hcl_uch_t e_unknown_u[] = {'u','n','k','n','o','w','n',' ','e','r','r','o
|
||||
# define e_unknown e_unknown_u
|
||||
#endif
|
||||
|
||||
|
||||
int hcl_errnum_is_synerr (hcl_errnum_t errnum)
|
||||
{
|
||||
return errnum == HCL_ESYNERR;
|
||||
}
|
||||
|
||||
const hcl_ooch_t* hcl_errnum_to_errstr (hcl_errnum_t errnum)
|
||||
{
|
||||
return (errnum >= 0 && errnum < HCL_COUNTOF(errstr))? errstr[errnum]: e_unknown;
|
||||
@ -268,6 +274,11 @@ const hcl_ooch_t* hcl_backuperrmsg (hcl_t* hcl)
|
||||
return hcl->errmsg.tmpbuf.ooch;
|
||||
}
|
||||
|
||||
hcl_errnum_t hcl_geterrnum (hcl_t* hcl)
|
||||
{
|
||||
return HCL_ERRNUM(hcl);
|
||||
}
|
||||
|
||||
void hcl_seterrnum (hcl_t* hcl, hcl_errnum_t errnum)
|
||||
{
|
||||
if (hcl->shuterr) return;
|
||||
|
@ -2367,7 +2367,7 @@ static void supplement_errmsg (hcl_t* hcl, hcl_ooi_t ip)
|
||||
{
|
||||
hcl_dbgi_t* dbgi;
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_errnum_t orgnum = hcl_geterrnum(hcl);
|
||||
hcl_errnum_t orgnum = HCL_ERRNUM(hcl);
|
||||
|
||||
HCL_ASSERT (hcl, HCL_IS_BYTEARRAY(hcl, hcl->active_function->dbgi));
|
||||
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
|
||||
|
@ -1292,7 +1292,7 @@ static void reformat_synerr (hcl_t* hcl)
|
||||
|
||||
static void send_proto_hcl_error (hcl_server_proto_t* proto)
|
||||
{
|
||||
if (hcl_geterrnum(proto->hcl) == HCL_ESYNERR) reformat_synerr (proto->hcl);
|
||||
if (HCL_ERRNUM(proto->hcl) == HCL_ESYNERR) reformat_synerr (proto->hcl);
|
||||
send_error_message (proto, hcl_geterrmsg(proto->hcl));
|
||||
}
|
||||
|
||||
|
@ -1367,7 +1367,7 @@ static void reformat_synerr (hcl_t* hcl)
|
||||
|
||||
static void send_proto_hcl_error (hcl_server_proto_t* proto)
|
||||
{
|
||||
if (hcl_geterrnum(proto->hcl) == HCL_ESYNERR) reformat_synerr (proto->hcl);
|
||||
if (HCL_ERRNUM(proto->hcl) == HCL_ESYNERR) reformat_synerr (proto->hcl);
|
||||
send_error_message (proto, hcl_geterrmsg(proto->hcl));
|
||||
}
|
||||
|
||||
|
@ -830,7 +830,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
|
||||
load = (hcl_mod_load_t)hcl->vmprim.dl_getsym(hcl, md.handle, buf);
|
||||
if (!load)
|
||||
{
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js]", buf, namelen, name);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to get module symbol [%js] in [%.*js]", buf, namelen, name);
|
||||
HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name);
|
||||
hcl->vmprim.dl_close (hcl, md.handle);
|
||||
return HCL_NULL;
|
||||
@ -851,7 +851,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
|
||||
if (load(hcl, &mdp->mod) <= -1)
|
||||
{
|
||||
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg);
|
||||
HCL_DEBUG3 (hcl, "Module function [%js] returned failure in [%.*js]\n", buf, namelen, name);
|
||||
hcl_rbt_delete (&hcl->modtab, name, namelen);
|
||||
hcl->vmprim.dl_close (hcl, mdp->handle);
|
||||
|
12
lib/hcl.h
12
lib/hcl.h
@ -2037,15 +2037,19 @@ static HCL_INLINE void* hcl_getxtn (hcl_t* hcl) { return (void*)((hcl_uint8_t*)h
|
||||
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; }
|
||||
static HCL_INLINE hcl_errnum_t hcl_geterrnum (hcl_t* hcl) { return hcl->errnum; }
|
||||
#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))
|
||||
# define hcl_geterrnum(hcl) (((hcl_t*)(hcl))->errnum)
|
||||
#endif
|
||||
|
||||
#define HCL_ERRNUM(hcl) (((hcl_t*)(hcl))->errnum)
|
||||
|
||||
HCL_EXPORT hcl_errnum_t hcl_geterrnum (
|
||||
hcl_t* hcl
|
||||
);
|
||||
|
||||
HCL_EXPORT void hcl_seterrnum (
|
||||
hcl_t* hcl,
|
||||
hcl_errnum_t errnum
|
||||
@ -2137,6 +2141,10 @@ HCL_EXPORT const hcl_ooch_t* hcl_backuperrmsg (
|
||||
hcl_t* hcl
|
||||
);
|
||||
|
||||
HCL_EXPORT int hcl_errnum_is_synerr (
|
||||
hcl_errnum_t errnum
|
||||
);
|
||||
|
||||
HCL_EXPORT const hcl_ooch_t* hcl_errnum_to_errstr (
|
||||
hcl_errnum_t errnum
|
||||
);
|
||||
|
@ -63,7 +63,7 @@ hcl_heap_t* hcl_makeheap (hcl_t* hcl, hcl_oow_t size)
|
||||
if (HCL_UNLIKELY(!heap))
|
||||
{
|
||||
const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to allocate a heap - %js", oldmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to allocate a heap - %js", oldmsg);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
|
18
lib/read.c
18
lib/read.c
@ -241,7 +241,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h
|
||||
if (HCL_UNLIKELY(!tmp))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to grow token buffer - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to grow token buffer - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -479,7 +479,7 @@ static const hcl_ooch_t* add_sr_name (hcl_t* hcl, const hcl_oocs_t* name)
|
||||
if (HCL_UNLIKELY(!link))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to source name [%.*js] - %js", name->len, name->ptr, orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to source name [%.*js] - %js", name->len, name->ptr, orgmsg);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
||||
@ -503,7 +503,7 @@ static HCL_INLINE int enter_list (hcl_t* hcl, const hcl_loc_t* loc, int flagv)
|
||||
if (HCL_UNLIKELY(!rstl))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to allocate reader stack node - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to allocate reader stack node - %js", orgmsg);
|
||||
return -1;
|
||||
}
|
||||
rstl->loc = *loc;
|
||||
@ -622,7 +622,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
|
||||
if (HCL_UNLIKELY(!sym))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to create symbol cnode for := - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to create symbol cnode for := - %js", orgmsg);
|
||||
if (head) hcl_freecnode (hcl, head);
|
||||
return HCL_NULL;
|
||||
}
|
||||
@ -633,7 +633,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
|
||||
if (HCL_UNLIKELY(!newhead))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to create cons cnode for := - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to create cons cnode for := - %js", orgmsg);
|
||||
hcl_freecnode (hcl, sym);
|
||||
if (head) hcl_freecnode (hcl, head);
|
||||
return HCL_NULL;
|
||||
@ -654,7 +654,7 @@ static HCL_INLINE hcl_cnode_t* leave_list (hcl_t* hcl, hcl_loc_t* list_loc, int*
|
||||
if (HCL_UNLIKELY(!head))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to create empty list - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to create empty list - %js", orgmsg);
|
||||
}
|
||||
}
|
||||
|
||||
@ -935,7 +935,7 @@ static int feed_begin_include (hcl_t* hcl)
|
||||
if (HCL_UNLIKELY(!arg))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to allocate source input structure - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to allocate source input structure - %js", orgmsg);
|
||||
goto oops;
|
||||
}
|
||||
|
||||
@ -2865,7 +2865,7 @@ int hcl_feed (hcl_t* hcl, const hcl_ooch_t* data, hcl_oow_t len)
|
||||
x = feed_char(hcl, HCL_OOCI_EOF);
|
||||
if (x <= -1)
|
||||
{
|
||||
if (hcl->c->feed.rd.level <= 0 && hcl_geterrnum(hcl) == HCL_ESYNERR && hcl_getsynerrnum(hcl) == HCL_SYNERR_EOF)
|
||||
if (hcl->c->feed.rd.level <= 0 && HCL_ERRNUM(hcl) == HCL_ESYNERR && hcl_getsynerrnum(hcl) == HCL_SYNERR_EOF)
|
||||
{
|
||||
/* convert this EOF error to success as the caller knows EOF in the feed mode.
|
||||
* the caller can safely stop feeding after gettting success from hcl_feed(hcl, HCL_NULL, 0);
|
||||
@ -3153,7 +3153,7 @@ static int init_compiler (hcl_t* hcl)
|
||||
if (HCL_UNLIKELY(!hcl->c))
|
||||
{
|
||||
const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
|
||||
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "failed to allocate compiler - %js", orgmsg);
|
||||
hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "failed to allocate compiler - %js", orgmsg);
|
||||
hcl_deregcb (hcl, cbp);
|
||||
return -1;
|
||||
}
|
||||
|
@ -3231,7 +3231,7 @@ hcl_t* hcl_openstdwithmmgr (hcl_mmgr_t* mmgr, hcl_oow_t xtnsize, hcl_errnum_t* e
|
||||
cb.vm_cleanup = cb_vm_cleanup;
|
||||
if (hcl_regcb(hcl, &cb) == HCL_NULL)
|
||||
{
|
||||
if (errnum) *errnum = hcl_geterrnum(hcl);
|
||||
if (errnum) *errnum = HCL_ERRNUM(hcl);
|
||||
hcl_close (hcl);
|
||||
return HCL_NULL;
|
||||
}
|
||||
|
@ -8,7 +8,7 @@ hcl_DEPENDENCIES = hcl.bin
|
||||
hcl_LINK = cp -pf hcl.bin $(builddir)/hcl$(EXEEXT) || echo
|
||||
|
||||
hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS)
|
||||
fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
|
||||
clean-local:
|
||||
rm -f *.ppu *.res hcl.bin
|
||||
|
@ -621,7 +621,7 @@ uninstall-am: uninstall-binPROGRAMS
|
||||
|
||||
|
||||
hcl.bin: $(hcl_SOURCES) ../lib/libhcl.la $(hcl_OBJECTS)
|
||||
fpc -o$(builddir)/$@ -FcUTF-8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
fpc -o$(builddir)/$@ -g -Mobjfpc -FcUTF8 -Fl../lib -Fl../lib/.libs -Fl/usr/lib/gcc/x86_64-linux-gnu/11 $(srcdir)/main.pas
|
||||
|
||||
clean-local:
|
||||
rm -f *.ppu *.res hcl.bin
|
||||
|
82
pas/hcl.pas
82
pas/hcl.pas
@ -10,15 +10,9 @@ interface
|
||||
|
||||
type
|
||||
Interp = class
|
||||
public
|
||||
protected
|
||||
handle: pointer;
|
||||
private
|
||||
handle1: integer;
|
||||
handle2: integer;
|
||||
handle3: integer;
|
||||
handle4: integer;
|
||||
handle5: integer;
|
||||
handle6: integer;
|
||||
|
||||
public
|
||||
constructor Create (x: integer);
|
||||
destructor Destroy; override;
|
||||
@ -34,12 +28,29 @@ type
|
||||
function FetchErrorMsg(): string;
|
||||
end;
|
||||
|
||||
InterpPtr = ^Interp;
|
||||
Location = record
|
||||
line: sizeint;
|
||||
colm: sizeint;
|
||||
filp: pwidechar;
|
||||
end;
|
||||
Synerr = record
|
||||
num: integer;
|
||||
loc: Location;
|
||||
tgt: record
|
||||
val: array[0..255] of widechar;
|
||||
len: sizeint;
|
||||
end;
|
||||
end;
|
||||
|
||||
SynerrPtr = ^Synerr;
|
||||
|
||||
(*----- external hcl function -----*)
|
||||
function hcl_errnum_to_errbcstr(errnum: integer; errbuf: pointer; errbufsz: sizeint): pointer; cdecl; external;
|
||||
function hcl_errnum_is_synerr(errnum: integer): boolean; cdecl; external;
|
||||
|
||||
function hcl_openstd(xtnsize: sizeint; errnum: pointer): pointer; cdecl; external;
|
||||
procedure hcl_close(handle: pointer); cdecl; external;
|
||||
function hcl_geterrnum(handle: pointer): integer; cdecl; external;
|
||||
function hcl_geterrbmsg(handle: pointer): pansichar; cdecl; external;
|
||||
function hcl_ignite(handle: pointer; heapsize: sizeint): integer; cdecl; external;
|
||||
function hcl_addbuiltinprims(handle: pointer): integer; cdecl; external;
|
||||
@ -53,15 +64,16 @@ procedure hcl_detachccio(handle: pointer); cdecl; external;
|
||||
function hcl_attachudiostdwithbcstr(handle: pointer; udi: pansichar; udo: pansichar): integer; cdecl; external;
|
||||
procedure hcl_detachudio(handle: pointer); cdecl; external;
|
||||
function hcl_compile(handle: pointer; cnode: pointer; flags: integer): integer; cdecl; external;
|
||||
function hcl_execute(handle: pointer): integer; cdecl; external;
|
||||
function hcl_execute(handle: pointer): pointer; cdecl; external;
|
||||
procedure hcl_abort(handle: pointer) cdecl; external;
|
||||
|
||||
procedure hcl_getsynerr(handle: pointer; synerr: SynerrPtr) cdecl; external;
|
||||
function hcl_count_ucstr(ptr: pwidechar): sizeint; cdecl; external;
|
||||
(*----- end external hcl function -----*)
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils;
|
||||
uses sysutils, math;
|
||||
|
||||
constructor Interp.Create (x: integer);
|
||||
var
|
||||
@ -89,12 +101,31 @@ end;
|
||||
|
||||
function Interp.FetchErrorMsg(): string;
|
||||
var
|
||||
bmsg: PAnsiChar;
|
||||
num: integer;
|
||||
bmsg: pansichar;
|
||||
serr: Synerr;
|
||||
filp: pwidechar;
|
||||
tgt: array[0..255] of widechar;
|
||||
begin
|
||||
(* TODO: if the errocode is syntax error. use the systax error message and locations info *)
|
||||
num := hcl_geterrnum(self.handle);
|
||||
if hcl_errnum_is_synerr(num) then begin
|
||||
hcl_getsynerr(self.handle, @serr);
|
||||
bmsg := hcl_geterrbmsg(self.handle);
|
||||
filp := pwidechar(widestring(''));
|
||||
if serr.loc.filp <> nil then filp := serr.loc.filp;
|
||||
if serr.tgt.len > 0 then begin
|
||||
sysutils.strlcopy(@tgt, serr.tgt.val, math.min(serr.tgt.len, length(tgt) - 1));
|
||||
exit(format('%s at %s[%u:%u] - %s', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm, string(tgt)]));
|
||||
end
|
||||
else begin
|
||||
exit(format('%s at %s[%u:%u]', [string(bmsg), string(filp), serr.loc.line, serr.loc.colm]));
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
bmsg := hcl_geterrbmsg(self.handle);
|
||||
exit(string(bmsg))
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure Interp.Ignite(heapsize: sizeint);
|
||||
begin
|
||||
@ -121,6 +152,7 @@ end;
|
||||
|
||||
procedure Interp.Compile(text: pansichar; len: sizeint);
|
||||
var
|
||||
errnum: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin
|
||||
@ -134,10 +166,14 @@ begin
|
||||
end;
|
||||
|
||||
if hcl_feedbchars(self.handle, text, len) <= -1 then begin
|
||||
errnum := hcl_geterrnum(self.handle);
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_endfeed(self.handle);
|
||||
hcl_detachccio(self.handle);
|
||||
raise Exception.Create('failed to feed text - ' + errmsg)
|
||||
if hcl_errnum_is_synerr(errnum) then
|
||||
raise Exception.Create(errmsg)
|
||||
else
|
||||
raise Exception.Create('failed to feed text - ' + errmsg);
|
||||
end;
|
||||
|
||||
if hcl_endfeed(self.handle) <= -1 then begin
|
||||
@ -156,6 +192,7 @@ end;
|
||||
|
||||
procedure Interp.Compile(text: pwidechar; len: sizeint);
|
||||
var
|
||||
errnum: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachcciostdwithbcstr(self.handle, nil) <= -1 then begin
|
||||
@ -169,10 +206,14 @@ begin
|
||||
end;
|
||||
|
||||
if hcl_feeduchars(self.handle, text, len) <= -1 then begin
|
||||
errnum := hcl_geterrnum(self.handle);
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_endfeed(self.handle);
|
||||
hcl_detachccio(self.handle);
|
||||
raise Exception.Create('failed to feed text - ' + errmsg)
|
||||
if hcl_errnum_is_synerr(errnum) then
|
||||
raise Exception.Create(errmsg)
|
||||
else
|
||||
raise Exception.Create('failed to feed text - ' + errmsg);
|
||||
end;
|
||||
|
||||
if hcl_endfeed(self.handle) <= -1 then begin
|
||||
@ -187,17 +228,18 @@ end;
|
||||
|
||||
procedure Interp.Execute();
|
||||
var
|
||||
n: integer;
|
||||
errmsg: string;
|
||||
begin
|
||||
if hcl_attachudiostdwithbcstr(self.handle, nil, nil) <= -1 then begin
|
||||
raise Exception.Create('failed to attach udio handlers - ' + self.FetchErrorMsg())
|
||||
end;
|
||||
n := hcl_execute(self.handle);
|
||||
if hcl_execute(self.handle) = nil then begin
|
||||
errmsg := self.FetchErrorMsg();
|
||||
hcl_detachudio(self.handle);
|
||||
if n <= -1 then
|
||||
begin
|
||||
raise Exception.Create('failed to execute - ' + self.FetchErrorMsg())
|
||||
raise Exception.Create('failed to execute - ' + errmsg)
|
||||
end;
|
||||
|
||||
hcl_detachudio(self.handle);
|
||||
end;
|
||||
|
||||
end. (* unit *)
|
||||
|
55
pas/main.pas
55
pas/main.pas
@ -4,55 +4,6 @@ program main;
|
||||
|
||||
uses HCL, sysutils;
|
||||
|
||||
(*
|
||||
function Make(): HCL.InterpPtr;
|
||||
var
|
||||
x: HCL.Interp;
|
||||
begin
|
||||
x := HCL.Interp.Create(20);
|
||||
Make := @x;
|
||||
end;
|
||||
|
||||
function Make2(): HCL.Interp;
|
||||
begin
|
||||
Make2 := HCL.Interp.Create(20);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
x: HCL.Interp;
|
||||
x2: ^HCL.Interp;
|
||||
begin
|
||||
Write ('sizeof X=>');
|
||||
Writeln (SizeOf(x));
|
||||
x := HCL.Interp.Make(20);
|
||||
Write ('instance sizeof X=>');
|
||||
Writeln (x.InstanceSize());
|
||||
// x.Open();
|
||||
// x.Close();
|
||||
x.Destroy();
|
||||
//x.Free();
|
||||
|
||||
Write ('sizeof X2=>');
|
||||
Writeln (SizeOf(x2));
|
||||
|
||||
// New(x2);
|
||||
// x2^.Open();
|
||||
// //x2^.Destroy();
|
||||
// //x2^.Free();
|
||||
// Dispose (x2);
|
||||
|
||||
x := Make2();
|
||||
//Writeln (x.handle);
|
||||
x.Destroy();
|
||||
x := nil;
|
||||
|
||||
// x2 := Make();
|
||||
// Writeln (x2^.handle);
|
||||
// x2^.Destroy();
|
||||
end.
|
||||
*)
|
||||
|
||||
var
|
||||
x: HCL.Interp = nil;
|
||||
begin
|
||||
@ -66,10 +17,10 @@ begin
|
||||
|
||||
x.Compile(pwidechar('(printf "hello 동키콩\n")'));
|
||||
x.Compile('(printf "hello 동키콩월드\n") ');
|
||||
x.Compile('(a := 20)');
|
||||
x.Compile('(printf "%d\n" a)');
|
||||
x.Compile('(동가리오 := 20)');
|
||||
x.Compile('(printf "%d %d\n" 동가리오 (* 동가리오 동가리오))');
|
||||
|
||||
x.Execute();
|
||||
x.Execute(); // check if exception...
|
||||
except
|
||||
on e: Exception do
|
||||
writeln ('exception:', e.Message);
|
||||
|
Loading…
Reference in New Issue
Block a user