diff --git a/lib/exec.c b/lib/exec.c index 019a5e4..07ab440 100644 --- a/lib/exec.c +++ b/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)) diff --git a/lib/hcl.h b/lib/hcl.h index 1d609ca..8ada514 100644 --- a/lib/hcl.h +++ b/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; diff --git a/lib/obj.c b/lib/obj.c index 96250c6..7ee2c63 100644 --- a/lib/obj.c +++ b/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 * ------------------------------------------------------------------------ */ diff --git a/lib/print.c b/lib/print.c index dd0537a..543e297 100644 --- a/lib/print.c +++ b/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);