implementing make_class instructoin
This commit is contained in:
parent
a9abaf5623
commit
03cb4c67fb
@ -594,6 +594,11 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
|
|||||||
break;
|
break;
|
||||||
/* -------------------------------------------------------- */
|
/* -------------------------------------------------------- */
|
||||||
|
|
||||||
|
case HCL_CODE_MAKE_CLASS:
|
||||||
|
LOG_INST_0 (hcl, "make_class");
|
||||||
|
break;
|
||||||
|
|
||||||
|
/* -------------------------------------------------------- */
|
||||||
case HCL_CODE_DUP_STACKTOP:
|
case HCL_CODE_DUP_STACKTOP:
|
||||||
LOG_INST_0 (hcl, "dup_stacktop");
|
LOG_INST_0 (hcl, "dup_stacktop");
|
||||||
break;
|
break;
|
||||||
|
24
lib/exec.c
24
lib/exec.c
@ -3727,6 +3727,30 @@ static int execute (hcl_t* hcl)
|
|||||||
|
|
||||||
/* -------------------------------------------------------- */
|
/* -------------------------------------------------------- */
|
||||||
|
|
||||||
|
case HCL_CODE_MAKE_CLASS:
|
||||||
|
{
|
||||||
|
hcl_oop_t t, sc, nivars, ncvars;
|
||||||
|
|
||||||
|
LOG_INST_0 (hcl, "make_class");
|
||||||
|
|
||||||
|
sc = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
|
||||||
|
nivars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
|
||||||
|
ncvars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
|
||||||
|
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(nivars));
|
||||||
|
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(ncvars));
|
||||||
|
t = hcl_makeclass(hcl, sc, HCL_OOP_TO_SMOOI(nivars), HCL_OOP_TO_SMOOI(ncvars));
|
||||||
|
|
||||||
|
if (HCL_UNLIKELY(!t))
|
||||||
|
{
|
||||||
|
supplement_errmsg (hcl, fetched_instruction_pointer);
|
||||||
|
goto oops;
|
||||||
|
}
|
||||||
|
|
||||||
|
HCL_STACK_PUSH (hcl, t); /* push the class created */
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
/* -------------------------------------------------------- */
|
||||||
|
|
||||||
case HCL_CODE_DUP_STACKTOP:
|
case HCL_CODE_DUP_STACKTOP:
|
||||||
{
|
{
|
||||||
hcl_oop_t t;
|
hcl_oop_t t;
|
||||||
|
@ -858,35 +858,30 @@ enum hcl_bcode_t
|
|||||||
/* UNUSED - 0xE5 - 0xE7 */
|
/* UNUSED - 0xE5 - 0xE7 */
|
||||||
|
|
||||||
HCL_CODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 ## */
|
HCL_CODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 ## */
|
||||||
|
|
||||||
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */
|
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */
|
||||||
HCL_CODE_MAKE_BYTEARRAY = 0xEA, /* 234 ## */
|
HCL_CODE_MAKE_BYTEARRAY = 0xEA, /* 234 ## */
|
||||||
HCL_CODE_MAKE_DIC = 0xEB, /* 235 ## */
|
HCL_CODE_MAKE_DIC = 0xEB, /* 235 ## */
|
||||||
|
|
||||||
HCL_CODE_POP_INTO_OBJVAR_X = 0xEC, /* 236 ## */
|
HCL_CODE_POP_INTO_OBJVAR_X = 0xEC, /* 236 ## */
|
||||||
|
|
||||||
HCL_CODE_POP_INTO_ARRAY = 0xED, /* 237 ## */
|
HCL_CODE_POP_INTO_ARRAY = 0xED, /* 237 ## */
|
||||||
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 ## */
|
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 ## */
|
||||||
HCL_CODE_POP_INTO_DIC = 0xEF, /* 239 */
|
HCL_CODE_POP_INTO_DIC = 0xEF, /* 239 */
|
||||||
|
|
||||||
HCL_CODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */
|
HCL_CODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */
|
||||||
|
|
||||||
HCL_CODE_MAKE_CONS = 0xF1, /* 241 */
|
HCL_CODE_MAKE_CONS = 0xF1, /* 241 */
|
||||||
HCL_CODE_POP_INTO_CONS = 0xF2, /* 242 */
|
HCL_CODE_POP_INTO_CONS = 0xF2, /* 242 */
|
||||||
HCL_CODE_POP_INTO_CONS_END = 0xF3, /* 243 */
|
HCL_CODE_POP_INTO_CONS_END = 0xF3, /* 243 */
|
||||||
|
|
||||||
HCL_CODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */
|
HCL_CODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */
|
||||||
|
|
||||||
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
|
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
|
||||||
/* -------------------------------------- */
|
/* -------------------------------------- */
|
||||||
|
|
||||||
/* UNUSED 0xF6 */
|
HCL_CODE_MAKE_CLASS = 0xF6, /* 246 ## ## */
|
||||||
|
HCL_CODE_DUP_STACKTOP = 0xF7, /* 247 */
|
||||||
HCL_CODE_DUP_STACKTOP = 0xF7,
|
HCL_CODE_POP_STACKTOP = 0xF8, /* 248 */
|
||||||
HCL_CODE_POP_STACKTOP = 0xF8,
|
HCL_CODE_RETURN_STACKTOP = 0xF9, /* 249 */
|
||||||
HCL_CODE_RETURN_STACKTOP = 0xF9, /* ^something */
|
HCL_CODE_RETURN_RECEIVER = 0xFA, /* 250 */
|
||||||
HCL_CODE_RETURN_RECEIVER = 0xFA, /* ^self */
|
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* 251, return the stack top from a block */
|
||||||
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* return the stack top from a block */
|
|
||||||
|
|
||||||
HCL_CODE_MAKE_FUNCTION = 0xFC, /* 252 */
|
HCL_CODE_MAKE_FUNCTION = 0xFC, /* 252 */
|
||||||
HCL_CODE_MAKE_BLOCK = 0xFD, /* 253 */
|
HCL_CODE_MAKE_BLOCK = 0xFD, /* 253 */
|
||||||
|
80
lib/hcl.h
80
lib/hcl.h
@ -815,6 +815,76 @@ struct hcl_process_scheduler_t
|
|||||||
} suspended;
|
} suspended;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
#define HCL_CLASS_NAMED_INSTVARS 7
|
||||||
|
typedef struct hcl_class_t hcl_class_t;
|
||||||
|
typedef struct hcl_class_t* hcl_oop_class_t;
|
||||||
|
struct hcl_class_t
|
||||||
|
{
|
||||||
|
HCL_OBJ_HEADER;
|
||||||
|
|
||||||
|
/* === the following five fields must be in sync with hcl_methowner_t === */
|
||||||
|
/* [0] - instance methods, MethodDictionary
|
||||||
|
* [1] - class methods, MethodDictionary */
|
||||||
|
hcl_oop_dic_t mthdic[2];
|
||||||
|
/* ===================================================================== */
|
||||||
|
|
||||||
|
hcl_oop_t superclass;
|
||||||
|
hcl_oop_t nivars; /* smooi. */
|
||||||
|
hcl_oop_t ncvars; /* smooi. */
|
||||||
|
|
||||||
|
hcl_oop_char_t ivarnames;
|
||||||
|
hcl_oop_char_t cvarnames;
|
||||||
|
|
||||||
|
/* indexed part afterwards */
|
||||||
|
hcl_oop_t cvar[1]; /* class variables. */
|
||||||
|
};
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
struct hcl_class_t
|
||||||
|
{
|
||||||
|
HCL_OBJ_HEADER;
|
||||||
|
|
||||||
|
/* === the following five fields must be in sync with hcl_methowner_t === */
|
||||||
|
hcl_oop_char_t name; /* Symbol */
|
||||||
|
|
||||||
|
/* [0] - instance methods, MethodDictionary
|
||||||
|
* [1] - class methods, MethodDictionary */
|
||||||
|
hcl_oop_dic_t mthdic[2];
|
||||||
|
|
||||||
|
hcl_oop_nsdic_t nsup; /* pointer to the upper namespace */
|
||||||
|
hcl_oop_nsdic_t nsdic; /* dictionary used for namespacing - may be nil when there are no subitems underneath */
|
||||||
|
/* ===================================================================== */
|
||||||
|
|
||||||
|
hcl_oop_t spec; /* SmallInteger. instance specification */
|
||||||
|
hcl_oop_t selfspec; /* SmallInteger. specification of the class object itself */
|
||||||
|
|
||||||
|
hcl_oop_t superclass; /* Another class */
|
||||||
|
hcl_oop_t subclasses; /* Array of subclasses */
|
||||||
|
|
||||||
|
hcl_oop_t modname; /* Symbol if importing a module. nil if not. */
|
||||||
|
|
||||||
|
/* == NEVER CHANGE THIS ORDER OF 3 ITEMS BELOW == */
|
||||||
|
hcl_oop_char_t ivars; /* String */
|
||||||
|
hcl_oop_char_t civars; /* String */
|
||||||
|
hcl_oop_char_t cvars; /* String */
|
||||||
|
/* == NEVER CHANGE THE ORDER OF 3 ITEMS ABOVE == */
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
hcl_oop_char_t pooldics; /* String - pool dictionaries imported */
|
||||||
|
|
||||||
|
hcl_oop_t trsize; /* trailer size for new instances */
|
||||||
|
hcl_oop_t trgc; /* trailer gc callback */
|
||||||
|
|
||||||
|
/* [0] - initial values for instance variables of new instances
|
||||||
|
* [1] - initial values for class instance variables */
|
||||||
|
hcl_oop_t initv[2];
|
||||||
|
#endif
|
||||||
|
/* indexed part afterwards */
|
||||||
|
hcl_oop_t cvar[1]; /* class instance variables and class variables. */
|
||||||
|
};
|
||||||
|
#endif
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* The HCL_BRANDOF() macro return the brand of an object including a numeric
|
* The HCL_BRANDOF() macro return the brand of an object including a numeric
|
||||||
* object encoded into a pointer.
|
* object encoded into a pointer.
|
||||||
@ -1696,7 +1766,8 @@ enum hcl_brand_t
|
|||||||
HCL_BRAND_PROCESS,
|
HCL_BRAND_PROCESS,
|
||||||
HCL_BRAND_PROCESS_SCHEDULER,
|
HCL_BRAND_PROCESS_SCHEDULER,
|
||||||
HCL_BRAND_SEMAPHORE,
|
HCL_BRAND_SEMAPHORE,
|
||||||
HCL_BRAND_SEMAPHORE_GROUP
|
HCL_BRAND_SEMAPHORE_GROUP,
|
||||||
|
HCL_BRAND_CLASS
|
||||||
};
|
};
|
||||||
typedef enum hcl_brand_t hcl_brand_t;
|
typedef enum hcl_brand_t hcl_brand_t;
|
||||||
|
|
||||||
@ -2357,6 +2428,13 @@ HCL_EXPORT hcl_oop_t hcl_makecontext (
|
|||||||
hcl_ooi_t ntmprs
|
hcl_ooi_t ntmprs
|
||||||
);
|
);
|
||||||
|
|
||||||
|
HCL_EXPORT hcl_oop_t hcl_makeclass (
|
||||||
|
hcl_t* hcl,
|
||||||
|
hcl_oop_t superclass,
|
||||||
|
hcl_ooi_t nivars,
|
||||||
|
hcl_ooi_t ncvars
|
||||||
|
);
|
||||||
|
|
||||||
HCL_EXPORT void hcl_freengcobj (
|
HCL_EXPORT void hcl_freengcobj (
|
||||||
hcl_t* hcl,
|
hcl_t* hcl,
|
||||||
hcl_oop_t obj
|
hcl_oop_t obj
|
||||||
|
33
lib/obj.c
33
lib/obj.c
@ -286,7 +286,7 @@ hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t
|
|||||||
#else
|
#else
|
||||||
# error UNSUPPORTED LIW BIT SIZE
|
# error UNSUPPORTED LIW BIT SIZE
|
||||||
#endif
|
#endif
|
||||||
if (!oop) return HCL_NULL;
|
if (HCL_UNLIKELY(!oop)) return HCL_NULL;
|
||||||
|
|
||||||
HCL_OBJ_SET_FLAGS_BRAND (oop, brand);
|
HCL_OBJ_SET_FLAGS_BRAND (oop, brand);
|
||||||
return oop;
|
return oop;
|
||||||
@ -300,7 +300,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr)
|
|||||||
hcl_pushvolat (hcl, &cdr);
|
hcl_pushvolat (hcl, &cdr);
|
||||||
|
|
||||||
cons = (hcl_oop_cons_t)hcl_allocoopobj(hcl, HCL_BRAND_CONS, 2);
|
cons = (hcl_oop_cons_t)hcl_allocoopobj(hcl, HCL_BRAND_CONS, 2);
|
||||||
if (cons)
|
if (HCL_LIKELY(cons))
|
||||||
{
|
{
|
||||||
cons->car = car;
|
cons->car = car;
|
||||||
cons->cdr = cdr;
|
cons->cdr = cdr;
|
||||||
@ -342,10 +342,10 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale)
|
|||||||
}
|
}
|
||||||
|
|
||||||
hcl_pushvolat (hcl, &value);
|
hcl_pushvolat (hcl, &value);
|
||||||
f = (hcl_oop_fpdec_t)hcl_allocoopobj (hcl, HCL_BRAND_FPDEC, HCL_FPDEC_NAMED_INSTVARS);
|
f = (hcl_oop_fpdec_t)hcl_allocoopobj(hcl, HCL_BRAND_FPDEC, HCL_FPDEC_NAMED_INSTVARS);
|
||||||
hcl_popvolat (hcl);
|
hcl_popvolat (hcl);
|
||||||
|
|
||||||
if (!f) return HCL_NULL;
|
if (HCL_UNLIKELY(!f)) return HCL_NULL;
|
||||||
|
|
||||||
f->value = value;
|
f->value = value;
|
||||||
f->scale = HCL_SMOOI_TO_OOP(scale);
|
f->scale = HCL_SMOOI_TO_OOP(scale);
|
||||||
@ -353,6 +353,23 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale)
|
|||||||
return (hcl_oop_t)f;
|
return (hcl_oop_t)f;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t superclass, hcl_ooi_t nivars, hcl_ooi_t ncvars)
|
||||||
|
{
|
||||||
|
hcl_oop_class_t c;
|
||||||
|
|
||||||
|
hcl_pushvolat (hcl, &superclass);
|
||||||
|
c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_BRAND_CLASS, HCL_CLASS_NAMED_INSTVARS);
|
||||||
|
hcl_popvolat (hcl);
|
||||||
|
if (HCL_UNLIKELY(!c)) return HCL_NULL;
|
||||||
|
|
||||||
|
c->superclass = superclass;
|
||||||
|
c->nivars = HCL_SMOOI_TO_OOP(nivars);
|
||||||
|
c->ncvars = HCL_SMOOI_TO_OOP(ncvars);
|
||||||
|
|
||||||
|
|
||||||
|
return (hcl_oop_t)c;
|
||||||
|
}
|
||||||
|
|
||||||
/* ------------------------------------------------------------------------ *
|
/* ------------------------------------------------------------------------ *
|
||||||
* NGC HANDLING
|
* NGC HANDLING
|
||||||
* ------------------------------------------------------------------------ */
|
* ------------------------------------------------------------------------ */
|
||||||
@ -376,8 +393,8 @@ hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
|
|||||||
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
|
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
|
||||||
/* TODO: improve this by using realloc */
|
/* TODO: improve this by using realloc */
|
||||||
|
|
||||||
tmp = hcl_makengcbytearray (hcl, HCL_NULL, newsize);
|
tmp = hcl_makengcbytearray(hcl, HCL_NULL, newsize);
|
||||||
if (tmp)
|
if (HCL_LIKELY(tmp))
|
||||||
{
|
{
|
||||||
if (obj)
|
if (obj)
|
||||||
{
|
{
|
||||||
@ -404,8 +421,8 @@ hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
|
|||||||
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
|
/* no hcl_pushvolat() is needed because 'obj' is a non-GC object. */
|
||||||
/* TODO: improve this by using realloc */
|
/* TODO: improve this by using realloc */
|
||||||
|
|
||||||
tmp = hcl_makengcarray (hcl, newsize);
|
tmp = hcl_makengcarray(hcl, newsize);
|
||||||
if (tmp)
|
if (HCL_LIKELY(tmp))
|
||||||
{
|
{
|
||||||
if (obj)
|
if (obj)
|
||||||
{
|
{
|
||||||
|
11
lib/print.c
11
lib/print.c
@ -92,7 +92,8 @@ enum
|
|||||||
WORD_PROCESS,
|
WORD_PROCESS,
|
||||||
WORD_PROCESS_SCHEDULER,
|
WORD_PROCESS_SCHEDULER,
|
||||||
WORD_SEMAPHORE,
|
WORD_SEMAPHORE,
|
||||||
WORD_SEMAPHORE_GROUP
|
WORD_SEMAPHORE_GROUP,
|
||||||
|
WORD_CLASS
|
||||||
};
|
};
|
||||||
|
|
||||||
static struct
|
static struct
|
||||||
@ -114,7 +115,8 @@ static struct
|
|||||||
{ 10, { '#','<','P','R','O','C','E','S','S','>' } },
|
{ 10, { '#','<','P','R','O','C','E','S','S','>' } },
|
||||||
{ 20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
|
{ 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','>' } },
|
{ 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','>' } }
|
{ 18, { '#','<','S','E','M','A','P','H','O','R','E','-','G','R','O','U','P','>' } },
|
||||||
|
{ 8, { '#','<','C','L','A','S','S','>' } }
|
||||||
};
|
};
|
||||||
|
|
||||||
static HCL_INLINE int print_single_char (hcl_fmtout_t* fmtout, hcl_ooch_t ch)
|
static HCL_INLINE int print_single_char (hcl_fmtout_t* fmtout, hcl_ooch_t ch)
|
||||||
@ -685,6 +687,11 @@ next:
|
|||||||
word_index = WORD_SEMAPHORE_GROUP;
|
word_index = WORD_SEMAPHORE_GROUP;
|
||||||
goto print_word;
|
goto print_word;
|
||||||
|
|
||||||
|
case HCL_BRAND_CLASS:
|
||||||
|
/* TODO: print the class name */
|
||||||
|
word_index = WORD_CLASS;
|
||||||
|
goto print_word;
|
||||||
|
|
||||||
default:
|
default:
|
||||||
HCL_DEBUG3 (hcl, "Internal error - unknown object type %d at %s:%d\n", (int)brand, __FILE__, __LINE__);
|
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);
|
HCL_ASSERT (hcl, "Unknown object type" == HCL_NULL);
|
||||||
|
Loading…
x
Reference in New Issue
Block a user