hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implementing make_class instructoin

Browse Source
This commit is contained in:
hyung-hwan 2021-05-21 09:59:35 +00:00
parent a9abaf5623
commit 03cb4c67fb
6 changed files with 148 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/decode.c
View File

@ -594,6 +594,11 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
break;
/* -------------------------------------------------------- */
case HCL_CODE_MAKE_CLASS:
LOG_INST_0 (hcl, "make_class");
break;
/* -------------------------------------------------------- */
case HCL_CODE_DUP_STACKTOP:
LOG_INST_0 (hcl, "dup_stacktop");
break;

24
lib/exec.c
View File

@ -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:
{
hcl_oop_t t;

17
lib/hcl-prv.h
View File

@ -858,35 +858,30 @@ enum hcl_bcode_t
/* UNUSED - 0xE5 - 0xE7 */
HCL_CODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 ## */
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */
HCL_CODE_MAKE_BYTEARRAY = 0xEA, /* 234 ## */
HCL_CODE_MAKE_DIC = 0xEB, /* 235 ## */
HCL_CODE_POP_INTO_OBJVAR_X = 0xEC, /* 236 ## */
HCL_CODE_POP_INTO_ARRAY = 0xED, /* 237 ## */
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 ## */
HCL_CODE_POP_INTO_DIC = 0xEF, /* 239 */
HCL_CODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */
HCL_CODE_MAKE_CONS = 0xF1, /* 241 */
HCL_CODE_POP_INTO_CONS = 0xF2, /* 242 */
HCL_CODE_POP_INTO_CONS_END = 0xF3, /* 243 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
/* -------------------------------------- */
/* UNUSED 0xF6 */
HCL_CODE_DUP_STACKTOP = 0xF7,
HCL_CODE_POP_STACKTOP = 0xF8,
HCL_CODE_RETURN_STACKTOP = 0xF9, /* ^something */
HCL_CODE_RETURN_RECEIVER = 0xFA, /* ^self */
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* return the stack top from a block */
HCL_CODE_MAKE_CLASS = 0xF6, /* 246 ## ## */
HCL_CODE_DUP_STACKTOP = 0xF7, /* 247 */
HCL_CODE_POP_STACKTOP = 0xF8, /* 248 */
HCL_CODE_RETURN_STACKTOP = 0xF9, /* 249 */
HCL_CODE_RETURN_RECEIVER = 0xFA, /* 250 */
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* 251, return the stack top from a block */
HCL_CODE_MAKE_FUNCTION = 0xFC, /* 252 */
HCL_CODE_MAKE_BLOCK = 0xFD, /* 253 */

80
lib/hcl.h
View File

@ -815,6 +815,76 @@ struct hcl_process_scheduler_t
} 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
* object encoded into a pointer.
@ -1696,7 +1766,8 @@ enum hcl_brand_t
HCL_BRAND_PROCESS,
HCL_BRAND_PROCESS_SCHEDULER,
HCL_BRAND_SEMAPHORE,
HCL_BRAND_SEMAPHORE_GROUP
HCL_BRAND_SEMAPHORE_GROUP,
HCL_BRAND_CLASS
};
typedef enum hcl_brand_t hcl_brand_t;
@ -2357,6 +2428,13 @@ HCL_EXPORT hcl_oop_t hcl_makecontext (
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_t* hcl,
hcl_oop_t obj

33
lib/obj.c
View File

@ -286,7 +286,7 @@ hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t
#else
# error UNSUPPORTED LIW BIT SIZE
#endif
if (!oop) return HCL_NULL;
if (HCL_UNLIKELY(!oop)) return HCL_NULL;
HCL_OBJ_SET_FLAGS_BRAND (oop, brand);
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);
cons = (hcl_oop_cons_t)hcl_allocoopobj(hcl, HCL_BRAND_CONS, 2);
if (cons)
if (HCL_LIKELY(cons))
{
cons->car = car;
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);
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);
if (!f) return HCL_NULL;
if (HCL_UNLIKELY(!f)) return HCL_NULL;
f->value = value;
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;
}
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
* ------------------------------------------------------------------------ */
@ -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. */
/* TODO: improve this by using realloc */
tmp = hcl_makengcbytearray (hcl, HCL_NULL, newsize);
if (tmp)
tmp = hcl_makengcbytearray(hcl, HCL_NULL, newsize);
if (HCL_LIKELY(tmp))
{
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. */
/* TODO: improve this by using realloc */
tmp = hcl_makengcarray (hcl, newsize);
if (tmp)
tmp = hcl_makengcarray(hcl, newsize);
if (HCL_LIKELY(tmp))
{
if (obj)
{

11
lib/print.c
View File

@ -92,7 +92,8 @@ enum
WORD_PROCESS,
WORD_PROCESS_SCHEDULER,
WORD_SEMAPHORE,
WORD_SEMAPHORE_GROUP
WORD_SEMAPHORE_GROUP,
WORD_CLASS
};
static struct
@ -114,7 +115,8 @@ static struct
{ 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','>' } },
{ 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)
@ -685,6 +687,11 @@ next:
word_index = WORD_SEMAPHORE_GROUP;
goto print_word;
case HCL_BRAND_CLASS:
/* TODO: print the class name */
word_index = WORD_CLASS;
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);