added the flexi object bit

lib/dic.c

@@ -456,6 +456,7 @@ found:
 
 hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
 {
+/* TODO: use hcl_instantiate() */
 	hcl_oop_dic_t obj;
 
 	obj = (hcl_oop_dic_t)hcl_allocoopobj(hcl, HCL_BRAND_DIC, 2);

lib/exec.c

@@ -4453,7 +4453,8 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc
 				LOG_INST_1 (hcl, "make_array %zu", b1);
 
 				/* create an empty array */
-				t = hcl_makearray(hcl, b1, 0);
+				/*t = hcl_makearray(hcl, b1, 0);*/
+				t = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, b1);
 				if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement;
 
 				HCL_STACK_PUSH (hcl, t); /* push the array created */
@@ -4487,7 +4488,8 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc
 				LOG_INST_1 (hcl, "make_bytearray %zu", b1);
 
 				/* create an empty array */
-				t = hcl_makebytearray(hcl, HCL_NULL, b1);
+				/*t = hcl_makebytearray(hcl, HCL_NULL, b1);*/
+				t = hcl_instantiate(hcl, hcl->c_byte_array, HCL_NULL, b1);
 				if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement;
 
 				HCL_STACK_PUSH (hcl, t); /* push the byte array created */

lib/hcl.h

@@ -357,15 +357,16 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
  * size calculation and the access to the payload fields become more complex.
  * Therefore, i've dropped the idea.
  * ========================================================================= */
-#define HCL_OBJ_FLAGS_TYPE_BITS     6
+#define HCL_OBJ_FLAGS_TYPE_BITS      (6)
-#define HCL_OBJ_FLAGS_UNIT_BITS     5
+#define HCL_OBJ_FLAGS_UNIT_BITS      (5)
-#define HCL_OBJ_FLAGS_EXTRA_BITS    1
+#define HCL_OBJ_FLAGS_EXTRA_BITS     (1)
-#define HCL_OBJ_FLAGS_KERNEL_BITS   2
+#define HCL_OBJ_FLAGS_KERNEL_BITS    (2)
-#define HCL_OBJ_FLAGS_MOVED_BITS    2
+#define HCL_OBJ_FLAGS_MOVED_BITS     (2)
-#define HCL_OBJ_FLAGS_NGC_BITS      1
+#define HCL_OBJ_FLAGS_NGC_BITS       (1)
-#define HCL_OBJ_FLAGS_TRAILER_BITS  1
+#define HCL_OBJ_FLAGS_TRAILER_BITS   (1)
-#define HCL_OBJ_FLAGS_SYNCODE_BITS  5
+#define HCL_OBJ_FLAGS_SYNCODE_BITS   (5)
-#define HCL_OBJ_FLAGS_BRAND_BITS    6
+#define HCL_OBJ_FLAGS_BRAND_BITS     (6)
+#define HCL_OBJ_FLAGS_FLEXI_BITS     (1)
 
 /*
 #define HCL_OBJ_FLAGS_PERM_BITS       1
@@ -386,7 +387,8 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
 #define HCL_OBJ_FLAGS_NGC_SHIFT         (HCL_OBJ_FLAGS_TRAILER_BITS   + HCL_OBJ_FLAGS_TRAILER_SHIFT)
 #define HCL_OBJ_FLAGS_TRAILER_SHIFT     (HCL_OBJ_FLAGS_SYNCODE_BITS   + HCL_OBJ_FLAGS_SYNCODE_SHIFT)
 #define HCL_OBJ_FLAGS_SYNCODE_SHIFT     (HCL_OBJ_FLAGS_BRAND_BITS     + HCL_OBJ_FLAGS_BRAND_SHIFT)
-#define HCL_OBJ_FLAGS_BRAND_SHIFT   (0)
+#define HCL_OBJ_FLAGS_BRAND_SHIFT       (HCL_OBJ_FLAGS_FLEXI_BITS     + HCL_OBJ_FLAGS_FLEXI_SHIFT)
+#define HCL_OBJ_FLAGS_FLEXI_SHIFT       (0)
 
 #define HCL_OBJ_GET_FLAGS_TYPE(oop)        HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT,      HCL_OBJ_FLAGS_TYPE_BITS)
 #define HCL_OBJ_GET_FLAGS_UNIT(oop)        HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT,      HCL_OBJ_FLAGS_UNIT_BITS)
@@ -397,6 +399,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
 #define HCL_OBJ_GET_FLAGS_TRAILER(oop)     HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT,   HCL_OBJ_FLAGS_TRAILER_BITS)
 #define HCL_OBJ_GET_FLAGS_SYNCODE(oop)     HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT,   HCL_OBJ_FLAGS_SYNCODE_BITS)
 #define HCL_OBJ_GET_FLAGS_BRAND(oop)       HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT,     HCL_OBJ_FLAGS_BRAND_BITS)
+#define HCL_OBJ_GET_FLAGS_FLEXI(oop)       HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT,     HCL_OBJ_FLAGS_FLEXI_BITS)
 
 #define HCL_OBJ_SET_FLAGS_TYPE(oop,v)      HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT,      HCL_OBJ_FLAGS_TYPE_BITS,      v)
 #define HCL_OBJ_SET_FLAGS_UNIT(oop,v)      HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT,      HCL_OBJ_FLAGS_UNIT_BITS,      v)
@@ -407,6 +410,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
 #define HCL_OBJ_SET_FLAGS_TRAILER(oop,v)   HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TRAILER_SHIFT,   HCL_OBJ_FLAGS_TRAILER_BITS,   v)
 #define HCL_OBJ_SET_FLAGS_SYNCODE(oop,v)   HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT,   HCL_OBJ_FLAGS_SYNCODE_BITS,   v)
 #define HCL_OBJ_SET_FLAGS_BRAND(oop,v)     HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT,     HCL_OBJ_FLAGS_BRAND_BITS,     v)
+#define HCL_OBJ_SET_FLAGS_FLEXI(oop,v)     HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT,     HCL_OBJ_FLAGS_FLEXI_BITS, v)
 
 #define HCL_OBJ_GET_SIZE(oop) ((oop)->_size)
 #define HCL_OBJ_GET_CLASS(oop) ((oop)->_class)

lib/obj.c

@@ -513,7 +513,15 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t class_name, hcl_oop_t superclass,
 	return (hcl_oop_t)c;
 }
 
-static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t num_flexi_fields, hcl_obj_type_t* type, hcl_oow_t* outlen)
+struct decoded_spec_t
+{
+	hcl_obj_type_t type;
+	hcl_oow_t alloclen;
+	int flexi;
+};
+typedef struct decoded_spec_t decoded_spec_t;
+
+static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t num_flexi_fields, decoded_spec_t* dspec)
 {
 	hcl_oow_t spec;
 	hcl_oow_t num_fixed_fields;
@@ -560,32 +568,30 @@ static HCL_INLINE int decode_spec (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t
 	}
 
 	HCL_ASSERT (hcl, num_fixed_fields + num_flexi_fields <= HCL_OBJ_SIZE_MAX);
-	*type = indexed_type;
+	dspec->flexi = !!HCL_CLASS_SPEC_IS_INDEXED(spec);
-
+	dspec->type = indexed_type;
-	/* TODO: THIS PART IS WRONG.. nivars_super and nivars should be encoded to the spec.... */
+	dspec->alloclen = num_fixed_fields + num_flexi_fields + HCL_OOP_TO_SMOOI(_class->nivars_super);
-	*outlen = num_fixed_fields + num_flexi_fields + HCL_OOP_TO_SMOOI(_class->nivars_super) /*+ HCL_OOP_TO_SMOOI(_class->nivars)*/;
 	return 0;
 }
 
 hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, hcl_oow_t vlen)
 {
 	hcl_oop_t oop;
-	hcl_obj_type_t type;
+	decoded_spec_t dspec;
-	hcl_oow_t alloclen;
 	hcl_oow_t tmp_count = 0;
 
 	HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
 
-	if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL;
+	if (decode_spec(hcl, _class, vlen, &dspec) <= -1) return HCL_NULL;
 
 	hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++;
 
-	switch (type)
+	switch (dspec.type)
 	{
 		case HCL_OBJ_TYPE_OOP:
 			/* both the fixed part(named instance variables) and
 			 * the variable part(indexed instance variables) are allowed. */
-			oop = hcl_allocoopobj(hcl, HCL_BRAND_INSTANCE, alloclen);
+			oop = hcl_allocoopobj(hcl, HCL_BRAND_INSTANCE, dspec.alloclen);
 			if (HCL_LIKELY(oop))
 			{
 		#if 0
@@ -626,19 +632,19 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
 			break;
 
 		case HCL_OBJ_TYPE_CHAR:
-			oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, (const hcl_ooch_t*)vptr, alloclen);
+			oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, (const hcl_ooch_t*)vptr, dspec.alloclen);
 			break;
 
 		case HCL_OBJ_TYPE_BYTE:
-			oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oob_t*)vptr, alloclen);
+			oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oob_t*)vptr, dspec.alloclen);
 			break;
 
 		case HCL_OBJ_TYPE_HALFWORD:
-			oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oohw_t*)vptr, alloclen);
+			oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oohw_t*)vptr, dspec.alloclen);
 			break;
 
 		case HCL_OBJ_TYPE_WORD:
-			oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oow_t*)vptr, alloclen);
+			oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oow_t*)vptr, dspec.alloclen);
 			break;
 
 		/* TODO: more types... HCL_OBJ_TYPE_INT... HCL_OBJ_TYPE_FLOAT, HCL_OBJ_TYPE_UINT16, etc*/
@@ -660,6 +666,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
 		if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
 	#endif
 		HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
+		HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
 	}
 	hcl_popvolats (hcl, tmp_count);
 	return oop;
@@ -668,20 +675,19 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
 hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oow_t vlen, const hcl_oob_t* trptr, hcl_oow_t trlen)
 {
 	hcl_oop_t oop;
-	hcl_obj_type_t type;
+	decoded_spec_t dspec;
-	hcl_oow_t alloclen;
 	hcl_oow_t tmp_count = 0;
 
 	HCL_ASSERT (hcl, hcl->_nil != HCL_NULL);
 
-	if (decode_spec(hcl, _class, vlen, &type, &alloclen) <= -1) return HCL_NULL;
+	if (decode_spec(hcl, _class, vlen, &dspec) <= -1) return HCL_NULL;
 
 	hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++;
 
-	switch (type)
+	switch (dspec.type)
 	{
 		case HCL_OBJ_TYPE_OOP:
-			oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, alloclen, trptr, trlen);
+			oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, dspec.alloclen, trptr, trlen);
 			if (HCL_LIKELY(oop))
 			{
 				/* initialize named instance variables with default values */
@@ -719,7 +725,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo
 			break;
 	}
 
-	if (oop)
+	if (HCL_LIKELY(oop))
 	{
 	#if 0
 		hcl_ooi_t spec;
@@ -733,6 +739,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo
 		*/
 	#endif
 		HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand));
+		HCL_OBJ_SET_FLAGS_FLEXI(oop, dspec.flexi);
 	}
 	hcl_popvolats (hcl, tmp_count);
 	return oop;

mod/core.c

@@ -61,7 +61,182 @@ static hcl_pfrc_t pf_core_basic_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs
 	return HCL_PF_SUCCESS;
 }
 
-static hcl_pfrc_t pf_core_get_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+static hcl_pfrc_t pf_core_basic_at (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_t obj, val;
+	hcl_oop_t pos;
+	hcl_ooi_t index;
+
+	obj = HCL_STACK_GETARG(hcl, nargs, 0);
+	pos = HCL_STACK_GETARG(hcl, nargs, 1);
+
+	if (!HCL_OOP_IS_POINTER(obj) || !HCL_OBJ_GET_FLAGS_FLEXI(obj))
+	{
+	unindexable:
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not indexable - %O", obj);
+		return HCL_PF_FAILURE;
+	}
+
+	if (!HCL_OOP_IS_SMOOI(pos))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+	index = HCL_OOP_TO_SMOOI(pos);
+	if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj));
+		return HCL_PF_FAILURE;
+	}
+
+	switch (HCL_OBJ_GET_FLAGS_TYPE(obj))
+	{
+		case HCL_OBJ_TYPE_OOP:
+			val = HCL_OBJ_GET_OOP_VAL(obj, index);
+			break;
+
+		case HCL_OBJ_TYPE_CHAR:
+		{
+			hcl_ooch_t c;
+			c = HCL_OBJ_GET_CHAR_VAL(obj, index);
+			val = HCL_CHAR_TO_OOP(c);
+			break;
+		}
+
+		case HCL_OBJ_TYPE_BYTE:
+		{
+			hcl_ooi_t b;
+			b = HCL_OBJ_GET_BYTE_VAL(obj, index);
+			val = HCL_SMOOI_TO_OOP(b);
+			break;
+		}
+
+		case HCL_OBJ_TYPE_HALFWORD:
+			val = hcl_oowtoint(hcl, HCL_OBJ_GET_HALFWORD_VAL(obj, index));
+			if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE;
+			break;
+
+		case HCL_OBJ_TYPE_WORD:
+			val = hcl_oowtoint(hcl, HCL_OBJ_GET_WORD_VAL(obj, index));
+			if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE;
+			break;
+
+		default:
+			goto unindexable;
+			break;
+	}
+
+	HCL_STACK_SETRET (hcl, nargs, val);
+	return HCL_PF_SUCCESS;
+}
+
+static hcl_pfrc_t pf_core_basic_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_t obj, val;
+	hcl_oop_t pos;
+	hcl_ooi_t index;
+
+	obj = HCL_STACK_GETARG(hcl, nargs, 0);
+	pos = HCL_STACK_GETARG(hcl, nargs, 1);
+	val = HCL_STACK_GETARG(hcl, nargs, 2);
+
+	if (!HCL_OOP_IS_POINTER(obj) || !HCL_OBJ_GET_FLAGS_FLEXI(obj))
+	{
+	unindexable:
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver not indexable - %O", obj);
+		return HCL_PF_FAILURE;
+	}
+
+	if (!HCL_OOP_IS_SMOOI(pos))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+	index = HCL_OOP_TO_SMOOI(pos);
+	if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj));
+		return HCL_PF_FAILURE;
+	}
+
+	switch (HCL_OBJ_GET_FLAGS_TYPE(obj))
+	{
+		case HCL_OBJ_TYPE_OOP:
+			HCL_OBJ_SET_OOP_VAL(obj, index, val);
+			break;
+
+		case HCL_OBJ_TYPE_CHAR:
+		{
+			hcl_ooch_t c;
+			if (!HCL_OOP_IS_CHAR(val))
+			{
+				hcl_seterrbfmt (hcl, HCL_EINVAL, "value not character - %O", val);
+				return HCL_PF_FAILURE;
+			}
+			c = HCL_OOP_TO_CHAR(val);
+			HCL_OBJ_SET_CHAR_VAL(obj, index, c);
+			break;
+		}
+
+		case HCL_OBJ_TYPE_BYTE:
+		{
+			hcl_ooi_t b;
+			if (!HCL_OOP_IS_SMOOI(val))
+			{
+				hcl_seterrbfmt (hcl, HCL_EINVAL, "value not byte - %O", val);
+				return HCL_PF_FAILURE;
+			}
+			b = HCL_OOP_TO_SMOOI(val);
+			HCL_OBJ_SET_BYTE_VAL(obj, index, b);
+			break;
+		}
+
+		case HCL_OBJ_TYPE_HALFWORD:
+		{
+			hcl_oow_t w;
+			if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE;
+			HCL_OBJ_SET_HALFWORD_VAL(obj, index, w);
+			break;
+		}
+
+		case HCL_OBJ_TYPE_WORD:
+		{
+			hcl_oow_t w;
+			if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE;
+			HCL_OBJ_SET_WORD_VAL(obj, index, w);
+			break;
+		}
+
+		default:
+			goto unindexable;
+			break;
+	}
+
+	HCL_STACK_SETRET (hcl, nargs, val);
+	return HCL_PF_SUCCESS;
+}
+
+static hcl_pfrc_t pf_core_basic_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_oop_t src;
+	hcl_oop_t size;
+
+	src = (hcl_oop_oop_t)HCL_STACK_GETARG(hcl, nargs, 0);
+
+	if (!HCL_OOP_IS_POINTER(src))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "source not sizable - %O", src);
+		return HCL_PF_FAILURE;
+	}
+
+	size = hcl_oowtoint(hcl, HCL_OBJ_GET_SIZE(src));
+	if (!size) return HCL_PF_FAILURE;
+
+	HCL_STACK_SETRET (hcl, nargs, size);
+	return HCL_PF_SUCCESS;
+}
+
+static hcl_pfrc_t pf_core_class_name (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
 	hcl_oop_t obj;
 
@@ -125,26 +300,6 @@ static hcl_pfrc_t pf_core_inst_responds_to (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_
 	return HCL_PF_SUCCESS;
 }
 
-static hcl_pfrc_t pf_core_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
-{
-	hcl_oop_oop_t src;
-	hcl_oop_t size;
-
-	src = (hcl_oop_oop_t)HCL_STACK_GETARG(hcl, nargs, 0);
-
-	if (!HCL_OOP_IS_POINTER(src))
-	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "source not sizable - %O", src);
-		return HCL_PF_FAILURE;
-	}
-
-	size = hcl_oowtoint(hcl, HCL_OBJ_GET_SIZE(src));
-	if (!size) return HCL_PF_FAILURE;
-
-	HCL_STACK_SETRET (hcl, nargs, size);
-	return HCL_PF_SUCCESS;
-}
-
 static hcl_pfrc_t pf_core_slice (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
 	hcl_oop_t src, slice, a1, a2;
@@ -220,171 +375,16 @@ static hcl_pfrc_t pf_core_slice (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 	return HCL_PF_SUCCESS;
 }
 
-static hcl_pfrc_t pf_core_get (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
-{
-	hcl_oop_t obj, val;
-	hcl_oop_t pos;
-	hcl_ooi_t index;
-
-	obj = HCL_STACK_GETARG(hcl, nargs, 0);
-	pos = HCL_STACK_GETARG(hcl, nargs, 1);
-
-	if (!HCL_OOP_IS_POINTER(obj))
-	{
-	unindexable:
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "object not indexable - %O", obj);
-		return HCL_PF_FAILURE;
-	}
-
-	if (!HCL_OOP_IS_SMOOI(pos))
-	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos);
-		return HCL_PF_FAILURE;
-	}
-	index = HCL_OOP_TO_SMOOI(pos);
-	if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj))
-	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj));
-		return HCL_PF_FAILURE;
-	}
-
-	switch (HCL_OBJ_GET_FLAGS_TYPE(obj))
-	{
-		case HCL_OBJ_TYPE_OOP:
-			val = HCL_OBJ_GET_OOP_VAL(obj, index);
-			break;
-
-		case HCL_OBJ_TYPE_CHAR:
-		{
-			hcl_ooch_t c;
-			c = HCL_OBJ_GET_CHAR_VAL(obj, index);
-			val = HCL_CHAR_TO_OOP(c);
-			break;
-		}
-
-		case HCL_OBJ_TYPE_BYTE:
-		{
-			hcl_ooi_t b;
-			b = HCL_OBJ_GET_BYTE_VAL(obj, index);
-			val = HCL_SMOOI_TO_OOP(b);
-			break;
-		}
-
-		case HCL_OBJ_TYPE_HALFWORD:
-			val = hcl_oowtoint(hcl, HCL_OBJ_GET_HALFWORD_VAL(obj, index));
-			if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE;
-			break;
-
-		case HCL_OBJ_TYPE_WORD:
-			val = hcl_oowtoint(hcl, HCL_OBJ_GET_WORD_VAL(obj, index));
-			if (HCL_UNLIKELY(!val)) return HCL_PF_FAILURE;
-			break;
-
-		default:
-			goto unindexable;
-			break;
-	}
-
-	HCL_STACK_SETRET (hcl, nargs, val);
-	return HCL_PF_SUCCESS;
-}
-
-static hcl_pfrc_t pf_core_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
-{
-	hcl_oop_t obj, val;
-	hcl_oop_t pos;
-	hcl_ooi_t index;
-
-	obj = HCL_STACK_GETARG(hcl, nargs, 0);
-	pos = HCL_STACK_GETARG(hcl, nargs, 1);
-	val = HCL_STACK_GETARG(hcl, nargs, 2);
-
-	if (!HCL_OOP_IS_POINTER(obj))
-	{
-	unindexable:
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "object not indexable - %O", obj);
-		return HCL_PF_FAILURE;
-	}
-
-	if (!HCL_OOP_IS_SMOOI(pos))
-	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "position not numeric - %O", pos);
-		return HCL_PF_FAILURE;
-	}
-	index = HCL_OOP_TO_SMOOI(pos);
-	if (index < 0 || index >= HCL_OBJ_GET_SIZE(obj))
-	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hcl_ooi_t)HCL_OBJ_GET_SIZE(obj));
-		return HCL_PF_FAILURE;
-	}
-
-	switch (HCL_OBJ_GET_FLAGS_TYPE(obj))
-	{
-		case HCL_OBJ_TYPE_OOP:
-			HCL_OBJ_SET_OOP_VAL(obj, index, val);
-			break;
-
-		case HCL_OBJ_TYPE_CHAR:
-		{
-			hcl_ooch_t c;
-			if (!HCL_OOP_IS_CHAR(val))
-			{
-				hcl_seterrbfmt (hcl, HCL_EINVAL, "value not character - %O", val);
-				return HCL_PF_FAILURE;
-			}
-			c = HCL_OOP_TO_CHAR(val);
-			HCL_OBJ_SET_CHAR_VAL(obj, index, c);
-			break;
-		}
-
-		case HCL_OBJ_TYPE_BYTE:
-		{
-			hcl_ooi_t b;
-			if (!HCL_OOP_IS_SMOOI(val))
-			{
-				hcl_seterrbfmt (hcl, HCL_EINVAL, "value not byte - %O", val);
-				return HCL_PF_FAILURE;
-			}
-			b = HCL_OOP_TO_SMOOI(val);
-			HCL_OBJ_SET_BYTE_VAL(obj, index, b);
-			break;
-		}
-
-		case HCL_OBJ_TYPE_HALFWORD:
-		{
-			hcl_oow_t w;
-			if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE;
-			HCL_OBJ_SET_HALFWORD_VAL(obj, index, w);
-			break;
-		}
-
-		case HCL_OBJ_TYPE_WORD:
-		{
-			hcl_oow_t w;
-			if (hcl_inttooow(hcl, val, &w) <= -1) return HCL_PF_FAILURE;
-			HCL_OBJ_SET_WORD_VAL(obj, index, w);
-			break;
-		}
-
-		default:
-			goto unindexable;
-			break;
-	}
-
-	HCL_STACK_SETRET (hcl, nargs, val);
-	return HCL_PF_SUCCESS;
-}
 
 static hcl_pfinfo_t pfinfos[] =
 {
-	{ "basic_new",          { HCL_PFBASE_FUNC, pf_core_basic_new,         2,  2 } },
+	{ "basicAt",            { HCL_PFBASE_FUNC, pf_core_basic_at,              2,  2 } },
-	{ "class_name",         { HCL_PFBASE_FUNC, pf_core_get_class_name,    1,  1 } },
+	{ "basicAtPut",         { HCL_PFBASE_FUNC, pf_core_basic_at_put,          3,  3 } },
-	{ "class_responds_to",  { HCL_PFBASE_FUNC, pf_core_class_responds_to, 2,  2 } },
+	{ "basicNew",           { HCL_PFBASE_FUNC, pf_core_basic_new,             2,  2 } },
-	{ "get",                { HCL_PFBASE_FUNC, pf_core_get,               2,  2 } },
+	{ "basicSize",          { HCL_PFBASE_FUNC, pf_core_basic_size,            1,  1 } },
-	{ "inst_responds_to",   { HCL_PFBASE_FUNC, pf_core_inst_responds_to,  2,  2 } },
+	{ "className",          { HCL_PFBASE_FUNC, pf_core_class_name,            1,  1 } },
-	{ "length",             { HCL_PFBASE_FUNC, pf_core_size,              1,  1 } },
+	{ "classRespondsTo",    { HCL_PFBASE_FUNC, pf_core_class_responds_to,     2,  2 } },
-	{ "put",                { HCL_PFBASE_FUNC, pf_core_put,               3,  3 } },
+	{ "instRespondsTo",     { HCL_PFBASE_FUNC, pf_core_inst_responds_to,      2,  2 } },
-	{ "size",               { HCL_PFBASE_FUNC, pf_core_size,              1,  1 } },
 	{ "slice",              { HCL_PFBASE_FUNC, pf_core_slice,                 3,  3 } }
 };
 

src/kernel.hcl

@@ -1,22 +1,26 @@
 class Apex {
 	fun ::basicNew(size) {
-		return (core.basic_new self size)
+		return (core.basicNew self size)
 	}
 
 	fun ::respondsTo(mth) {
-		return (core.class_responds_to self mth)
+		return (core.classRespondsTo self mth)
 	}
 
 	fun respondsTo(mth) {
-		return (core.inst_responds_to self mth)
+		return (core.instRespondsTo self mth)
 	}
 
 	fun basicAt(pos) {
-		return (core.get self index)
+		return (core.basicAt self pos)
 	}
 
-	fun basicAtPut(index value) {
+	fun basicAtPut(pos value) {
-		return (core.put self index value)
+		return (core.basicAtPut self pos value)
+	}
+
+	fun basicSize() {
+		return (core.basicSize self)
 	}
 }
 
@@ -35,7 +39,7 @@ class Class :: Apex [
 	_cvarnames
 ] {
 	fun name() {
-		##return (core.class_name self)
+		##return (core.className self)
 		return _class
 	}
 
@@ -52,7 +56,7 @@ class Class :: Apex [
 
 class Collection :: Object {
 	fun length() {
-		return (core.length self)
+		return (core.basicSize self)
 	}
 }
 
@@ -62,23 +66,23 @@ class IndexedCollection :: Collection {
 	}
 
 	fun at(index) {
-		return (core.get self index)
+		return (core.basicAt self index)
 	}
 
 	fun atPut(index value) {
-		return (core.put self index value)
+		return (core.basicAtPut self index value)
 	}
 }
 
 class FixedSizedCollection :: IndexedCollection {
 	fun ::new(size) {
 		| obj iv |
-		obj := (core.basic_new self size)
+		obj := (core.basicNew self size)
 		if (self:respondsTo "initValue") { ## TODO: change "initValue" to a symbol once supported
 			i := 0
 			iv := (self:initValue)
 			while (i < size) {
-				core.put obj i iv
+				core.basicAtPut obj i iv
 				i := (i + 1)
 			}
 		}
@@ -147,3 +151,23 @@ printf "[%O]\n" (" ":respondsTo "length")
 ##printf "[%O]\n" (String:instanceVariableNames)
 
 ##printf "%O\n" #"abcdefg"
+
+
+printf "----------------------------------------\n"
+
+k := #[1 2 3]
+printf "%O\n" (k:basicAt 2)
+
+class X :: Object [ a b c ] {
+	fun :* new() {
+		self.a := 10
+		self.b := 20
+		self.c := 30
+	}
+}
+##k := (X:basicNew 0)
+k := (X:new)
+printf "%O\n" (k:basicAt 2)
+
+
+

t/class-5001.err

@@ -110,7 +110,7 @@ fun X:xxx() { ##ERROR: exception not handled - "not class"
 ## you can't place an item in the arrya at all.
 
 fun Array:*boom() {
-	core.put self 0 10 ##ERROR: exception not handled - "position(0) out of range - negative or greater than or equal to 0"
+	core.basicAtPut self 0 10 ##ERROR: exception not handled - "position(0) out of range - negative or greater than or equal to 0"
 	printf "%O" self
 	return self
 }