some code for class instantiation

lib/exec.c

@@ -974,7 +974,7 @@ static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
 		/* don't switch to this process. just change the state to RUNNABLE.
 		 * process switching should be triggerd by the process scheduler. */
 		chain_into_processor (hcl, proc, PROC_STATE_RUNNABLE); 
-		/*HCL_STORE_OOP (hcl, &proc->current_context = proc->initial_context);*/
+		/*proc->current_context = proc->initial_context;*/
 	}
 #if 0
 	else if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_RUNNABLE))

lib/hcl.h

@@ -393,7 +393,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
 #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_GET_SIZE(oop) ((oop)->_size)
-/*#define HCL_OBJ_GET_CLASS(oop) ((oop)->_class)*/
+#define HCL_OBJ_GET_CLASS(oop) ((oop)->_class)
 
 #define HCL_OBJ_SET_SIZE(oop,v) ((oop)->_size = (v))
 #define HCL_OBJ_SET_CLASS(oop,c) ((oop)->_class = (c))
@@ -424,7 +424,8 @@ typedef enum hcl_obj_type_t hcl_obj_type_t;
 
 #define HCL_OBJ_HEADER \
 	hcl_oow_t _flags; \
-	hcl_oow_t _size
+	hcl_oow_t _size; \
+	hcl_oop_t _class
 
 struct hcl_obj_t
 {
@@ -482,7 +483,7 @@ struct hcl_obj_word_t
 #define HCL_OBJ_GET_WORD_VAL(oop,idx)     ((((hcl_oop_word_t)(oop))->slot)[idx])
 #define HCL_OBJ_GET_LIWORD_VAL(oop,idx)   ((((hcl_oop_liword_t)(oop))->slot)[idx])
 
-#define HCL_OBJ_SET_OOP_VAL(oop,idx,val)      ((((hcl_oop_oop_t)(oop))->slot)[idx] = (val)) /* [NOTE] HCL_STORE_OOP() */
+#define HCL_OBJ_SET_OOP_VAL(oop,idx,val)      ((((hcl_oop_oop_t)(oop))->slot)[idx] = (val))
 #define HCL_OBJ_SET_CHAR_VAL(oop,idx,val)     ((((hcl_oop_char_t)(oop))->slot)[idx] = (val))
 #define HCL_OBJ_SET_BYTE_VAL(oop,idx,val)     ((((hcl_oop_byte_t)(oop))->slot)[idx] = (val))
 #define HCL_OBJ_SET_HALFWORD_VAL(oop,idx,val) ((((hcl_oop_halfword_t)(oop))->slot)[idx] = (val))
@@ -981,6 +982,7 @@ typedef enum hcl_log_mask_t hcl_log_mask_t;
 #	define HCL_DEBUG4(hcl,fmt,a1,a2,a3,a4)
 #	define HCL_DEBUG5(hcl,fmt,a1,a2,a3,a4,a5)
 #	define HCL_DEBUG6(hcl,fmt,a1,a2,a3,a4,a5,a6)
+#	define HCL_DEBUG7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7)
 #else
 #	define HCL_DEBUG0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt)
 #	define HCL_DEBUG1(hcl,fmt,a1) HCL_LOG1(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1)
@@ -989,6 +991,7 @@ typedef enum hcl_log_mask_t hcl_log_mask_t;
 #	define HCL_DEBUG4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4)
 #	define HCL_DEBUG5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5)
 #	define HCL_DEBUG6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG6(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6)
+#	define HCL_DEBUG7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7) HCL_LOG6(hcl, HCL_LOG_DEBUG | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6, a7)
 #endif
 
 #define HCL_INFO0(hcl,fmt) HCL_LOG0(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt)
@@ -998,6 +1001,7 @@ typedef enum hcl_log_mask_t hcl_log_mask_t;
 #define HCL_INFO4(hcl,fmt,a1,a2,a3,a4) HCL_LOG4(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4)
 #define HCL_INFO5(hcl,fmt,a1,a2,a3,a4,a5) HCL_LOG5(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5)
 #define HCL_INFO6(hcl,fmt,a1,a2,a3,a4,a5,a6) HCL_LOG6(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6)
+#define HCL_INFO7(hcl,fmt,a1,a2,a3,a4,a5,a6,a7) HCL_LOG6(hcl, HCL_LOG_INFO | HCL_LOG_UNTYPED, fmt, a1, a2, a3, a4, a5, a6, a7)
 
 
 /* =========================================================================
@@ -1767,7 +1771,8 @@ enum hcl_brand_t
 	HCL_BRAND_PROCESS_SCHEDULER,
 	HCL_BRAND_SEMAPHORE,
 	HCL_BRAND_SEMAPHORE_GROUP,
-	HCL_BRAND_CLASS
+	HCL_BRAND_CLASS,
+	HCL_BRAND_INSTANCE
 };
 typedef enum hcl_brand_t hcl_brand_t;
 

lib/obj.c

@@ -370,6 +370,106 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl
 	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)
+{
+	/* TODO: */
+	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;
+	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;
+
+	hcl_pushvolat (hcl, (hcl_oop_t*)&_class); tmp_count++;
+
+	switch (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);
+			if (HCL_LIKELY(oop))
+			{
+		#if 0
+					/* initialize named instance variables with default values */
+					if (_class->initv[0] != hcl->_nil)
+					{
+						hcl_oow_t i = HCL_OBJ_GET_SIZE(_class->initv[0]);
+
+						/* [NOTE] i don't deep-copy initial values.
+						 *   if you change the contents of compound values like arrays,
+						 *   it affects subsequent instantiation of the class.
+						 *   it's important that the compiler should mark compound initial
+						 *   values read-only. */
+						while (i > 0)
+						{
+							--i;
+							HCL_OBJ_SET_OOP_VAL (oop, i, HCL_OBJ_GET_OOP_VAL(_class->initv[0], i));
+						}
+					}
+		#endif
+			}
+			HCL_ASSERT (hcl, vptr == HCL_NULL);
+			/*
+			This function is not GC-safe. so i don't want to initialize
+			the payload of a pointer object. The caller can call this
+			function and initialize payloads then.
+			if (oop && vptr && vlen > 0)
+			{
+					hcl_oop_oop_t hdr = (hcl_oop_oop_t)oop;
+					HCL_MEMCPY (&hdr->slot[named_instvar], vptr, vlen * HCL_SIZEOF(hcl_oop_t));
+			}
+
+			For the above code to work, it should protect the elements of
+			the vptr array with hcl_pushvolat(). So it might be better
+			to disallow a non-NULL vptr when indexed_type is OOP. See
+			the assertion above this comment block.
+			*/
+			break;
+
+		case HCL_OBJ_TYPE_CHAR:
+			oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
+			break;
+
+		case HCL_OBJ_TYPE_BYTE:
+			oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
+			break;
+
+		case HCL_OBJ_TYPE_HALFWORD:
+			oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
+			break;
+
+		case HCL_OBJ_TYPE_WORD:
+			oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, vptr, alloclen);
+			break;
+
+		default:
+			hcl_seterrnum (hcl, HCL_EINTERN);
+			oop = HCL_NULL;
+			break;
+	}
+		
+	if (HCL_LIKELY(oop))
+	{
+		hcl_ooi_t spec;
+		HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class);
+	#if 0
+		spec = HCL_OOP_TO_SMOOI(_class->spec);
+		if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1);
+		if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1);
+	#endif
+	}
+	hcl_popvolats (hcl, tmp_count);
+	return oop;
+}
+
 /* ------------------------------------------------------------------------ *
  * NGC HANDLING
  * ------------------------------------------------------------------------ */

lib/print.c

@@ -93,7 +93,8 @@ enum
 	WORD_PROCESS_SCHEDULER,
 	WORD_SEMAPHORE,
 	WORD_SEMAPHORE_GROUP,
-	WORD_CLASS
+	WORD_CLASS,
+	WORD_INSTANCE
 };
 
 static struct 
@@ -116,7 +117,9 @@ static struct
 	{  20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
 	{  12, { '#','<','S','E','M','A','P','H','O','R','E','>' } },
 	{  18, { '#','<','S','E','M','A','P','H','O','R','E','-','G','R','O','U','P','>' } },
-	{  8,  { '#','<','C','L','A','S','S','>' } }
+
+	{  8,  { '#','<','C','L','A','S','S','>' } },
+	{  11, { '#','<','I','N','S','T','A','N','C','E','>' } }
 };
 
 static HCL_INLINE int print_single_char (hcl_fmtout_t* fmtout, hcl_ooch_t ch)
@@ -692,6 +695,11 @@ next:
 			word_index = WORD_CLASS;
 			goto print_word;
 
+		case HCL_BRAND_INSTANCE:
+			/* TODO: print the class name also */
+			word_index = WORD_INSTANCE;
+			goto print_word;
+
 		default:
 			HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
 			HCL_ASSERT (hcl, "Unknown object type" == HCL_NULL);