From ff089929a927a32b06df8d1923435586993c126d Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 5 May 2022 04:03:56 +0000 Subject: [PATCH] added HCL_EUNDEFVAR --- lib/comp.c | 4 ++-- lib/err.c | 3 ++- lib/exec.c | 24 ++++++++++--------- lib/gc.c | 7 ++++++ lib/hcl.h | 14 ++++++++++- lib/obj.c | 4 ++++ lib/print.c | 6 +++++ t/Makefile.am | 1 + t/Makefile.in | 1 + t/var-01.hcl | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 114 insertions(+), 15 deletions(-) create mode 100644 t/var-01.hcl diff --git a/lib/comp.c b/lib/comp.c index 34c15d7..8c52564 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -3220,7 +3220,7 @@ static HCL_INLINE int compile_catch (hcl_t* hcl) static HCL_INLINE int post_try (hcl_t* hcl) { -/* TODO: */ +/* TODO: anything else? */ pop_cblk (hcl); POP_CFRAME (hcl); return 0; @@ -3810,7 +3810,7 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_cnode_t* obj) cons = (hcl_oop_t)hcl_getatsysdic(hcl, sym); if (!cons) { - cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_nil); + cons = (hcl_oop_t)hcl_putatsysdic(hcl, sym, hcl->_undef); if (HCL_UNLIKELY(!cons)) return -1; } diff --git a/lib/err.c b/lib/err.c index 14c3dfb..206da98 100644 --- a/lib/err.c +++ b/lib/err.c @@ -80,6 +80,7 @@ static hcl_ooch_t errstr_38[] = {'e','x','c','e','p','a','i','o','n',' ','n','o' static hcl_ooch_t errstr_39[] = {'s','t','a','c','k',' ','u','n','d','e','r','f','l','o','w','\0'}; static hcl_ooch_t errstr_40[] = {'s','t','a','c','k',' ','o','v','e','r','f','l','o','w','\0'}; +static hcl_ooch_t errstr_41[] = {'u','n','d','e','f','i','n','e','d',' ','v','a','r','i','a','b','l','e',' ','a','c','c','e','s','s','\0'}; static hcl_ooch_t* errstr[] = { @@ -88,7 +89,7 @@ static hcl_ooch_t* errstr[] = errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23, errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31, errstr_32, errstr_33, errstr_34, errstr_35, errstr_36, errstr_37, errstr_38, errstr_39, - errstr_40 + errstr_40, errstr_41 }; diff --git a/lib/exec.c b/lib/exec.c index de9bbcd..97850e1 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -2384,11 +2384,7 @@ static int do_throw_with_internal_errmsg (hcl_t* hcl, hcl_ooi_t ip) hcl_oop_t ex; /* TODO: consider throwing an exception object instead of a string? */ ex = hcl_makestring(hcl, hcl->errmsg.buf, hcl->errmsg.len, 0); /* TODO: include error location in the message? */ - if (HCL_UNLIKELY(!ex)) - { - supplement_errmsg (hcl, ip); - return -1; - } + if (HCL_UNLIKELY(!ex)) return -1; if (do_throw(hcl, ex, ip) <= -1) return -1; return 0; } @@ -3542,6 +3538,12 @@ static int execute (hcl_t* hcl) { /* push */ LOG_INST_1 (hcl, "push_object @%zu", b1); + if (HCL_IS_UNDEF(hcl, ass->cdr)) + { + hcl_seterrbfmt (hcl, HCL_EUNDEFVAR, "%.*js accessed without initization", HCL_OBJ_GET_SIZE(ass->car), HCL_OBJ_GET_CHAR_SLOT(ass->car)); + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; + } HCL_STACK_PUSH (hcl, ass->cdr); } break; @@ -4312,8 +4314,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2))) { hcl_seterrbfmt (hcl, HCL_ECALL, "array index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2)); - if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops; - break; + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; } ((hcl_oop_oop_t)t2)->slot[b1] = t1; @@ -4347,8 +4349,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) if (!HCL_OOP_IS_SMOOI(t1) || (bv = HCL_OOP_TO_SMOOI(t1)) < 0 || bv > 255) { hcl_seterrbfmt (hcl, HCL_ERANGE, "not a byte or out of byte range - %O", t1); - if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops; - break; + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; } HCL_STACK_POP (hcl); t2 = HCL_STACK_GETTOP(hcl); /* byte array */ @@ -4356,8 +4358,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2))) { hcl_seterrbfmt (hcl, HCL_ECALL, "bytearray index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2)); - if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) <= -1) goto oops; - break; + if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; + goto oops_with_errmsg_supplement; } ((hcl_oop_byte_t)t2)->slot[b1] = bv; break; diff --git a/lib/gc.c b/lib/gc.c index 43559d5..28e5917 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -583,6 +583,7 @@ void hcl_gc (hcl_t* hcl) old_nil = hcl->_nil; /* move _nil and the root object table */ + hcl->_undef = hcl_moveoop(hcl, hcl->_undef); hcl->_nil = hcl_moveoop(hcl, hcl->_nil); hcl->_true = hcl_moveoop(hcl, hcl->_true); hcl->_false = hcl_moveoop(hcl, hcl->_false); @@ -766,6 +767,12 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (HCL_UNLIKELY(!hcl->heap)) return -1; } + if (!hcl->_undef) + { + hcl->_undef = hcl_makeundef(hcl); + if (HCL_UNLIKELY(!hcl->_undef)) return -1; + } + if (!hcl->_nil) { hcl->_nil = hcl_makenil(hcl); diff --git a/lib/hcl.h b/lib/hcl.h index 977a64c..1f48a76 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -92,7 +92,8 @@ enum hcl_errnum_t HCL_ESEMFLOOD, /**< runtime error - too many semaphores */ HCL_EEXCEPT, /**< runtime error - exception not handled */ HCL_ESTKOVRFLW, /**< runtime error - stack overflow */ - HCL_ESTKUNDFLW /**< runtime error - stack overflow */ + HCL_ESTKUNDFLW, /**< runtime error - stack overflow */ + HCL_EUNDEFVAR, /**< runtime error - undefined variable access */ }; typedef enum hcl_errnum_t hcl_errnum_t; @@ -1527,6 +1528,7 @@ struct hcl_t hcl_heap_t* heap; /* ========================= */ + hcl_oop_t _undef; /* special internal value for uninitialized global variables */ hcl_oop_t _nil; /* pointer to the nil object */ hcl_oop_t _true; hcl_oop_t _false; @@ -1803,6 +1805,7 @@ enum hcl_brand_t HCL_BRAND_ERROR, HCL_BRAND_CHARACTER, + HCL_BRAND_UNDEF, HCL_BRAND_NIL, HCL_BRAND_TRUE, HCL_BRAND_FALSE, @@ -1829,6 +1832,10 @@ enum hcl_brand_t HCL_BRAND_SEMAPHORE_GROUP, HCL_BRAND_CLASS, HCL_BRAND_INSTANCE + + + /* [NOTE] each enumerator must not exceed the maximum value that can be + * represented with HCL_OBJ_FLAGS_BRAND_BITS bits */ }; typedef enum hcl_brand_t hcl_brand_t; @@ -1874,6 +1881,7 @@ enum hcl_concode_t }; typedef enum hcl_concode_t hcl_concode_t; +#define HCL_IS_UNDEF(hcl,v) (v == (hcl)->_undef) #define HCL_IS_NIL(hcl,v) (v == (hcl)->_nil) #define HCL_IS_TRUE(hcl,v) (v == (hcl)->_true) #define HCL_IS_FALSE(hcl,v) (v == (hcl)->_false) @@ -2441,6 +2449,10 @@ HCL_EXPORT hcl_oow_t hcl_fmttobcstr ( /* ========================================================================= * OBJECT MANAGEMENT * ========================================================================= */ +HCL_EXPORT hcl_oop_t hcl_makeundef ( + hcl_t* hcl +); + HCL_EXPORT hcl_oop_t hcl_makenil ( hcl_t* hcl ); diff --git a/lib/obj.c b/lib/obj.c index e81455e..11bdc4e 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -257,6 +257,10 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow * COMMON OBJECTS * ------------------------------------------------------------------------ */ +hcl_oop_t hcl_makeundef (hcl_t* hcl) +{ + return hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0); +} hcl_oop_t hcl_makenil (hcl_t* hcl) { diff --git a/lib/print.c b/lib/print.c index cef900f..f336a47 100644 --- a/lib/print.c +++ b/lib/print.c @@ -79,6 +79,7 @@ static HCL_INLINE void pop (hcl_t* hcl, print_stack_t* info) enum { + WORD_UNDEF, WORD_NIL, WORD_TRUE, WORD_FALSE, @@ -103,6 +104,7 @@ static struct hcl_ooch_t ptr[20]; } word[] = { + { 8, { '#', '<', 'U', 'N', 'D', 'D', 'F', '>' } }, { 4, { 'n', 'u', 'l', 'l' } }, { 4, { 't', 'r', 'u', 'e' } }, { 5, { 'f', 'a', 'l', 's', 'e' } }, @@ -265,6 +267,10 @@ next: goto done; } + case HCL_BRAND_UNDEF: + word_index = WORD_UNDEF; + goto print_word; + case HCL_BRAND_NIL: word_index = WORD_NIL; goto print_word; diff --git a/t/Makefile.am b/t/Makefile.am index 0bd0b8e..dab2318 100644 --- a/t/Makefile.am +++ b/t/Makefile.am @@ -5,6 +5,7 @@ check_SCRIPTS = \ insta-02.hcl \ ret-01.hcl \ retvar-01.hcl + var-01.hcl ##noinst_SCRIPTS = $(check_SCRIPTS) EXTRA_DIST = $(check_SCRIPTS) diff --git a/t/Makefile.in b/t/Makefile.in index ee8b6ab..97de598 100644 --- a/t/Makefile.in +++ b/t/Makefile.in @@ -838,6 +838,7 @@ uninstall-am: .PRECIOUS: Makefile + var-01.hcl # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/t/var-01.hcl b/t/var-01.hcl new file mode 100644 index 0000000..ed88543 --- /dev/null +++ b/t/var-01.hcl @@ -0,0 +1,65 @@ +(defun x (a b ::: r) + + | x y | + + (set x a) + (set y b) + + (if (> a b) + (do + | a b | + (set a (mod x y)) + (set b (+ x y)) + (set r (* a b)) + ) + else + (do + + | a b | + (set a (* x y)) + (set b (- x y)) + (set r (* a b)) + ) + ) + + (if (/= x a) (printf "ERROR: x is not equal to a\n")) + (if (/= y b) (printf "ERROR: y is not equal to b\n")) +) + +(set t (x 10 20)) +(if (/= t -2000) (printf "ERROR: t is not equal to -2000\n") + else (printf "OK: %d\n" t)) +(set t (x 30 20)) +(if (/= t 500) (printf "ERROR: t is not equal to 500\n") + else (printf "OK: %d\n" t)) + + +(defun x () + + (do + | x y | + + (set x 99) + (try + + (do + | x | + (set x 88) + (if (/= x 88) (printf "ERROR: x is not 88\n") + else (printf "OK: %d\n" x)) + (throw 1000) + ) + catch (x) + (if (/= x 1000) (printf "ERROR: x is not 1000\n") + else (printf "OK: %d\n" x)) + (set y x) + ) + + (if (/= x 99) (printf "ERROR: x is not 99\n") + else (printf "OK: %d\n" x)) + (if (/= y 1000) (print "ERROR: y is not 1000\n") + else (printf "OK: %d\n" y)) + ) +) + +(x)