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

changed hcl_geterrnum() to HCL_ERRNUM().
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source 
reintroduced hcl_geterrnum() as a function
This commit is contained in:
hyung-hwan 2024-02-03 13:36:05 +09:00
parent d339338a40
commit 9aa1bde1a1
15 changed files with 125 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/main.c
View File

@ -362,7 +362,7 @@ static void print_synerr (hcl_t* hcl)
hcl_synerr_t synerr;
xtn_t* xtn;
xtn = (xtn_t*)hcl_getxtn (hcl);
xtn = (xtn_t*)hcl_getxtn(hcl);
hcl_getsynerr (hcl, &synerr);
hcl_logbfmt (hcl,HCL_LOG_STDERR, "ERROR: ");

14
lib/comp.c
View File

@ -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
View File

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

2
lib/exec.c
View File

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

2
lib/hcl-s.c
View File

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

2
lib/hcl-s2.c
View File

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

4
lib/hcl.c
View File

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

24
lib/hcl.h
View File

@ -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
);
@ -2443,7 +2451,7 @@ HCL_EXPORT hcl_synerrnum_t hcl_getsynerrnum (
HCL_EXPORT void hcl_setsynerrbfmt (
hcl_t* hcl,
hcl_synerrnum_t num,
const hcl_loc_t* loc,
const hcl_loc_t* loc,
const hcl_oocs_t* tgt,
const hcl_bch_t* msgfmt,
...
@ -2452,17 +2460,17 @@ HCL_EXPORT void hcl_setsynerrbfmt (
HCL_EXPORT void hcl_setsynerrufmt (
hcl_t* hcl,
hcl_synerrnum_t num,
const hcl_loc_t* loc,
const hcl_loc_t* loc,
const hcl_oocs_t* tgt,
const hcl_uch_t* msgfmt,
...
);
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE void hcl_setsynerr (hcl_t* hcl, hcl_synerrnum_t num, const hcl_loc_t* loc, const hcl_oocs_t* tgt)
{
hcl_setsynerrbfmt (hcl, num, loc, tgt, HCL_NULL);
}
static HCL_INLINE void hcl_setsynerr (hcl_t* hcl, hcl_synerrnum_t num, const hcl_loc_t* loc, const hcl_oocs_t* tgt)
{
hcl_setsynerrbfmt (hcl, num, loc, tgt, HCL_NULL);
}
#else
# define hcl_setsynerr(hcl,num,loc,tgt) hcl_setsynerrbfmt(hcl,num,loc,tgt,HCL_NULL)
#endif

2
lib/heap.c
View File

@ -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
View File

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

2
lib/std.c
View File

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

2
pas/Makefile.am
View File

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

2
pas/Makefile.in
View File

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

94
pas/hcl.pas
View File

@ -8,17 +8,11 @@ unit HCL;
interface
type
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,18 +64,19 @@ 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
var
h: pointer;
errnum: integer;
errmsg: array[0..255] of AnsiChar;
@ -89,11 +101,30 @@ 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 *)
bmsg := hcl_geterrbmsg(self.handle);
exit(string(bmsg))
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);
@ -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
@ -132,12 +164,16 @@ begin
hcl_detachccio(self.handle);
raise Exception.Create('failed to begin feeding - ' + errmsg)
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);
hcl_detachudio(self.handle);
if n <= -1 then
begin
raise Exception.Create('failed to execute - ' + self.FetchErrorMsg())
if hcl_execute(self.handle) = nil then begin
errmsg := self.FetchErrorMsg();
hcl_detachudio(self.handle);
raise Exception.Create('failed to execute - ' + errmsg)
end;
hcl_detachudio(self.handle);
end;
end. (* unit *)

57
pas/main.pas
View File

@ -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
@ -65,11 +16,11 @@ begin
//x.AttachUDIO();
x.Compile(pwidechar('(printf "hello 동키콩\n")'));
x.Compile('(printf "hello 동키콩월드\n")');
x.Compile('(a := 20)');
x.Compile('(printf "%d\n" a)');
x.Compile('(printf "hello 동키콩월드\n") ');
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);