From 9aa1bde1a1027945fa88955a24652119b493ce4e Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Sat, 3 Feb 2024 13:36:05 +0900 Subject: [PATCH] changed hcl_geterrnum() to HCL_ERRNUM(). reintroduced hcl_geterrnum() as a function --- bin/main.c | 2 +- lib/comp.c | 14 ++++---- lib/err.c | 11 ++++++ lib/exec.c | 2 +- lib/hcl-s.c | 2 +- lib/hcl-s2.c | 2 +- lib/hcl.c | 4 +-- lib/hcl.h | 24 ++++++++----- lib/heap.c | 2 +- lib/read.c | 18 +++++----- lib/std.c | 2 +- pas/Makefile.am | 2 +- pas/Makefile.in | 2 +- pas/hcl.pas | 94 +++++++++++++++++++++++++++++++++++-------------- pas/main.pas | 57 +++--------------------------- 15 files changed, 125 insertions(+), 113 deletions(-) diff --git a/bin/main.c b/bin/main.c index 79b05cc..352c8f7 100644 --- a/bin/main.c +++ b/bin/main.c @@ -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: "); diff --git a/lib/comp.c b/lib/comp.c index 875348f..0d6b972 100644 --- a/lib/comp.c +++ b/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; } diff --git a/lib/err.c b/lib/err.c index 34c2500..bd6f256 100644 --- a/lib/err.c +++ b/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; diff --git a/lib/exec.c b/lib/exec.c index 14575bd..856c5e0 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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); diff --git a/lib/hcl-s.c b/lib/hcl-s.c index 1f0c6fa..eca7320 100644 --- a/lib/hcl-s.c +++ b/lib/hcl-s.c @@ -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)); } diff --git a/lib/hcl-s2.c b/lib/hcl-s2.c index 5e301df..75e1204 100644 --- a/lib/hcl-s2.c +++ b/lib/hcl-s2.c @@ -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)); } diff --git a/lib/hcl.c b/lib/hcl.c index 0bed1b3..9f564bc 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -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); diff --git a/lib/hcl.h b/lib/hcl.h index 26b2cad..eb2b5cf 100644 --- a/lib/hcl.h +++ b/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 ); @@ -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 diff --git a/lib/heap.c b/lib/heap.c index 879147f..442fbea 100644 --- a/lib/heap.c +++ b/lib/heap.c @@ -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; } diff --git a/lib/read.c b/lib/read.c index 6430ba9..b7e6375 100644 --- a/lib/read.c +++ b/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; } diff --git a/lib/std.c b/lib/std.c index b710b1a..c11e4ed 100644 --- a/lib/std.c +++ b/lib/std.c @@ -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; } diff --git a/pas/Makefile.am b/pas/Makefile.am index d95e27d..24cb7b0 100644 --- a/pas/Makefile.am +++ b/pas/Makefile.am @@ -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 diff --git a/pas/Makefile.in b/pas/Makefile.in index 5708d1b..3bc1afe 100644 --- a/pas/Makefile.in +++ b/pas/Makefile.in @@ -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 diff --git a/pas/hcl.pas b/pas/hcl.pas index 48d3887..bda8ab6 100644 --- a/pas/hcl.pas +++ b/pas/hcl.pas @@ -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 *) diff --git a/pas/main.pas b/pas/main.pas index 2839e4a..42950f2 100644 --- a/pas/main.pas +++ b/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 @@ -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);