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

added HCL_EUNDEFVAR

Browse Source
This commit is contained in:
hyung-hwan 2022-05-05 04:03:56 +00:00
parent c8905fc88e
commit ff089929a9
10 changed files with 114 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lib/comp.c
View File

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

3
lib/err.c
View File

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

24
lib/exec.c
View File

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

7
lib/gc.c
View File

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

14
lib/hcl.h
View File

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

4
lib/obj.c
View File

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

6
lib/print.c
View File

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

1
t/Makefile.am
View File

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

1
t/Makefile.in
View File

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

65
t/var-01.hcl Normal file
View File

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