added HCL_EUNDEFVAR

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

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

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))
+	if (HCL_UNLIKELY(!ex)) return -1;
-	{
-		supplement_errmsg (hcl, ip);
-		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;
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
-					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;
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
-					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;
+					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
-					break;
+					goto oops_with_errmsg_supplement;
 				}
 				((hcl_oop_byte_t)t2)->slot[b1] = bv;
 				break;

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

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

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

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;

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)

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.

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)