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

wip - ongoing full OO support effort
All checks were successful
continuous-integration/drone/push Build is passing
Details

Browse Source
This commit is contained in:
hyung-hwan 2024-03-03 22:17:14 +09:00
parent ec73905fc4
commit 7a15fbc3d1
4 changed files with 564 additions and 427 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lib/exec.c
View File

@ -3887,7 +3887,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
case HCL_CODE_CLASS_IMSTORE:
{
hcl_oop_t class_;
hcl_oop_t mdic, cons, blk;
hcl_oop_t mdic, cons, blk, car, cdr, name;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_2 (hcl, "class_%hsmstore %zu", (bcode == HCL_CODE_CLASS_CMSTORE? "c": (bcode == HCL_CODE_CLASS_CIMSTORE? "ci": "i")), b1);
@ -3912,11 +3912,17 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
blk = HCL_STACK_GETTOP(hcl);
hcl_pushvolat (hcl, (hcl_oop_t*)&mdic);
cons = hcl_makecons(hcl, (bcode == HCL_CODE_CLASS_IMSTORE? hcl->_nil: blk), (bcode == HCL_CODE_CLASS_CMSTORE? hcl->_nil: blk));
/* let car point to the instance method,
* let cdr point to the class method */
car = (bcode == HCL_CODE_CLASS_IMSTORE? hcl->_nil: blk);
cdr = (bcode == HCL_CODE_CLASS_CMSTORE? hcl->_nil: blk);
cons = hcl_makecons(hcl, car, cdr);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!cons)) goto oops_with_errmsg_supplement;
if (!hcl_putatdic(hcl, (hcl_oop_dic_t)mdic, hcl->active_function->literal_frame[b1], cons)) goto oops_with_errmsg_supplement;
/* put the code at method dictionary */
name = hcl->active_function->literal_frame[b1]; /* method name */
if (!hcl_putatdic(hcl, (hcl_oop_dic_t)mdic, name, cons)) goto oops_with_errmsg_supplement;
break;
}
/* -------------------------------------------------------- */

851
lib/gc.c
View File

@ -66,6 +66,435 @@ static struct
/* ========================================================================= */
static struct
{
const char* name;
hcl_oow_t c_offset; /* class offset */
hcl_oow_t sc_offset; /* superclass offset */
hcl_oow_t nivars;
hcl_oow_t ncvars;
} kctab[] = {
{ "Apex",
HCL_OFFSETOF(hcl_t, c_apex),
HCL_TYPE_MAX(hcl_oow_t),
0, 0 },
{ "Object",
HCL_OFFSETOF(hcl_t, c_object),
HCL_OFFSETOF(hcl_t, c_apex),
0, 0 },
{ "UndefinedObject",
HCL_OFFSETOF(hcl_t, c_undefobj),
HCL_OFFSETOF(hcl_t, c_apex),
0, 0 },
{ "Class",
HCL_OFFSETOF(hcl_t, c_class),
HCL_OFFSETOF(hcl_t, c_object),
HCL_CLASS_NAMED_INSTVARS, 0 },
{ "String",
HCL_OFFSETOF(hcl_t, c_string),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
{ "Symbol",
HCL_OFFSETOF(hcl_t, c_symbol),
HCL_OFFSETOF(hcl_t, c_string),
0, 0 },
#if 0
{ "Boolean",
HCL_OFFSETOF(hcl_t, c_boolean),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
{ "True",
HCL_OFFSETOF(hcl_t, c_true),
HCL_OFFSETOF(hcl_t, c_boolean),
0, 0 },
{ "False",
HCL_OFFSETOF(hcl_t, c_false),
HCL_OFFSETOF(hcl_t, c_boolean),
0, 0 },
#endif
{ "System",
HCL_OFFSETOF(hcl_t, c_system),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
};
/* ========================================================================= */
/*
* Apex......................
* ^ ^ ^ : .......
* | | | v v :
* | | +------------------- Class .....
* | | ^ ^
* | +-------- NilObject ......: :
* | ^........ nil :
* Object ...........................:
* ^
* |
*
* The class hierarchy is roughly as follows:
*
* Apex
* Class
* NilObject
* Object
* Collection
* IndexedCollection
* FixedSizedCollection
* Array
* ByteArray
* String
* Symbol
* Set
* Dictionary
* SystemDictionary
* SymbolSet
* Magnitude
* Association
* Character
* Number
* Integer
* SmallInteger
* LargeInteger
* LargePositiveInteger
* LargeNegativeInteger
*
* Apex has no instance variables.
*
*/
struct kernel_class_info_t
{
const hcl_bch_t* name;
int class_flags;
int class_num_classvars;
int class_spec_named_instvars;
int class_spec_flags;
int class_spec_indexed_type;
hcl_oow_t offset;
};
typedef struct kernel_class_info_t kernel_class_info_t;
static kernel_class_info_t kernel_classes[] =
{
/* --------------------------------------------------------------
* Apex - proto-object with 1 class variable.
* UndefinedObject - class for the nil object.
* Object - top of all ordinary objects.
* String
* Symbol
* Array
* ByteArray
* SymbolSet
* Character
* SmallIntger
* -------------------------------------------------------------- */
{ "Apex",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_apex) },
{ "UndefinedObject",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_undefobj) },
#define KCI_CLASS 2 /* index to the Class entry in this table */
{ "Class",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CLASS_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_class) },
#if 0
{ "Interface",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_INTERFACE_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, _interface) },
#endif
{ "Object",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_object) },
{ "String",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_string) },
{ "Symbol",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_symbol) },
{ "Array",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_array) },
{ "ByteArray",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_BYTE,
HCL_OFFSETOF(hcl_t, c_byte_array) },
{ "SymbolTable",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_symtab) },
{ "Dictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_dictionary) },
{ "Cons",
0,
0,
HCL_CONS_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_cons) },
#if 0
{ "Namespace",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_NSDIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_namespace) },
{ "PoolDictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_pool_dictionary) },
#endif
{ "MethodDictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_dictionary) },
#if 0
{ "CompiledMethod",
0,
0,
HCL_METHOD_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method) },
{ "MethodSignature",
0,
0,
HCL_METHSIG_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_methsig) },
#endif
{ "CompiledBlock",
0,
0,
HCL_BLOCK_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block) },
{ "MethodContext",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context) },
{ "BlockContext",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block_context) },
{ "Process",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process) },
{ "Semaphore",
0,
0,
HCL_SEMAPHORE_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore) },
{ "SemaphoreGroup",
0,
0,
HCL_SEMAPHORE_GROUP_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore_group) },
{ "ProcessScheduler",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_SCHEDULER_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process_scheduler) },
{ "Error",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_error) },
{ "True",
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_true) },
{ "False",
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_false) },
/* TOOD: what is a proper spec for Character and SmallInteger?
* If the fixed part is 0, its instance must be an object of 0 payload fields.
* Does this make sense? */
{ "Character",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_character) },
{ "SmallInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_integer) },
{ "LargePositiveInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_positive_integer) },
{ "LargeNegativeInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_negative_integer) },
{ "FixedPointDecimal",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_FPDEC_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_fixed_point_decimal) },
{ "SmallPointer",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_pointer) },
{ "LargePointer",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
1, /* #word(1) */
HCL_CLASS_SPEC_FLAG_IMMUTABLE | HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_WORD,
HCL_OFFSETOF(hcl_t, c_large_pointer) },
{ "System",
0,
5, /* asyncsg, gcfin_sem, gcfin_should_exit, ossig_pid, shr */
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_system) }
};
/* ========================================================================= */
static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
{
hcl_oop_char_t symbol;
@ -770,428 +1199,6 @@ hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop)
/* ========================================================================= */
static struct
{
const char* name;
hcl_oow_t c_offset; /* class offset */
hcl_oow_t sc_offset; /* superclass offset */
hcl_oow_t nivars;
hcl_oow_t ncvars;
} kctab[] = {
{ "Apex",
HCL_OFFSETOF(hcl_t, c_apex),
HCL_TYPE_MAX(hcl_oow_t),
0, 0 },
{ "Object",
HCL_OFFSETOF(hcl_t, c_object),
HCL_OFFSETOF(hcl_t, c_apex),
0, 0 },
{ "UndefinedObject",
HCL_OFFSETOF(hcl_t, c_undefobj),
HCL_OFFSETOF(hcl_t, c_apex),
0, 0 },
{ "Class",
HCL_OFFSETOF(hcl_t, c_class),
HCL_OFFSETOF(hcl_t, c_object),
HCL_CLASS_NAMED_INSTVARS, 0 },
{ "String",
HCL_OFFSETOF(hcl_t, c_string),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
{ "Symbol",
HCL_OFFSETOF(hcl_t, c_symbol),
HCL_OFFSETOF(hcl_t, c_string),
0, 0 },
{ "Boolean",
HCL_OFFSETOF(hcl_t, c_boolean),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
{ "True",
HCL_OFFSETOF(hcl_t, c_true),
HCL_OFFSETOF(hcl_t, c_boolean),
0, 0 },
{ "False",
HCL_OFFSETOF(hcl_t, c_false),
HCL_OFFSETOF(hcl_t, c_boolean),
0, 0 },
{ "System",
HCL_OFFSETOF(hcl_t, c_system),
HCL_OFFSETOF(hcl_t, c_object),
0, 0 },
};
/*
* Apex......................
* ^ ^ ^ : .......
* | | | v v :
* | | +------------------- Class .....
* | | ^ ^
* | +-------- NilObject ......: :
* | ^........ nil :
* Object ...........................:
* ^
* |
*
* The class hierarchy is roughly as follows:
*
* Apex
* Class
* NilObject
* Object
* Collection
* IndexedCollection
* FixedSizedCollection
* Array
* ByteArray
* String
* Symbol
* Set
* Dictionary
* SystemDictionary
* SymbolSet
* Magnitude
* Association
* Character
* Number
* Integer
* SmallInteger
* LargeInteger
* LargePositiveInteger
* LargeNegativeInteger
*
* Apex has no instance variables.
*
*/
struct kernel_class_info_t
{
const hcl_bch_t* name;
int class_flags;
int class_num_classvars;
int class_spec_named_instvars;
int class_spec_flags;
int class_spec_indexed_type;
hcl_oow_t offset;
};
typedef struct kernel_class_info_t kernel_class_info_t;
static kernel_class_info_t kernel_classes[] =
{
/* --------------------------------------------------------------
* Apex - proto-object with 1 class variable.
* UndefinedObject - class for the nil object.
* Object - top of all ordinary objects.
* String
* Symbol
* Array
* ByteArray
* SymbolSet
* Character
* SmallIntger
* -------------------------------------------------------------- */
{ "Apex",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_apex) },
{ "UndefinedObject",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_undefobj) },
#define KCI_CLASS 2 /* index to the Class entry in this table */
{ "Class",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CLASS_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_class) },
#if 0
{ "Interface",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_INTERFACE_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, _interface) },
#endif
{ "Object",
0,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_object) },
{ "String",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_string) },
{ "Symbol",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_CHAR,
HCL_OFFSETOF(hcl_t, c_symbol) },
{ "Array",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_array) },
{ "ByteArray",
0,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_BYTE,
HCL_OFFSETOF(hcl_t, c_byte_array) },
{ "SymbolTable",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_symbol_table) },
{ "Dictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_dictionary) },
{ "Association",
0,
0,
HCL_ASSOCIATION_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_association) },
#if 0
{ "Namespace",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_NSDIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_namespace) },
{ "PoolDictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_pool_dictionary) },
#endif
{ "MethodDictionary",
0,
0,
HCL_DIC_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_dictionary) },
{ "CompiledMethod",
0,
0,
HCL_METHOD_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method) },
{ "MethodSignature",
0,
0,
HCL_METHSIG_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_methsig) },
{ "CompiledBlock",
0,
0,
HCL_BLOCK_NAMED_INSTVARS,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block) },
{ "MethodContext",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_method_context) },
{ "BlockContext"
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_CONTEXT_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_block_context) },
{ "Process",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process) },
{ "Semaphore",
0,
0,
HCL_SEMAPHORE_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore) },
{ "SemaphoreGroup",
0,
0,
HCL_SEMAPHORE_GROUP_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_semaphore_group) },
{ "ProcessScheduler",
HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_PROCESS_SCHEDULER_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_UNCOPYABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_process_scheduler) },
{ "Error",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_error) },
{ "True",
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_true) },
{ "False",
HCL_CLASS_SELFSPEC_FLAG_LIMITED | HCL_CLASS_SELFSPEC_FLAG_FINAL,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_false) },
/* TOOD: what is a proper spec for Character and SmallInteger?
* If the fixed part is 0, its instance must be an object of 0 payload fields.
* Does this make sense? */
{ "Character",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_character) },
{ "SmallInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_integer) },
{ "LargePositiveInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_positive_integer) },
{ "LargeNegativeInteger",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_LIWORD,
HCL_OFFSETOF(hcl_t, c_large_negative_integer) },
{ "FixedPointDecimal",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
HCL_FPDEC_NAMED_INSTVARS,
HCL_CLASS_SPEC_FLAG_IMMUTABLE,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_fixed_point_decimal) },
{ "SmallPointer",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_small_pointer) },
{ "LargePointer",
HCL_CLASS_SELFSPEC_FLAG_LIMITED,
0,
1, /* #word(1) */
HCL_CLASS_SPEC_FLAG_IMMUTABLE | HCL_CLASS_SPEC_FLAG_INDEXED,
HCL_OBJ_TYPE_WORD,
HCL_OFFSETOF(hcl_t, c_large_pointer) },
{ "System",
0,
5, /* asyncsg, gcfin_sem, gcfin_should_exit, ossig_pid, shr */
0,
0,
HCL_OBJ_TYPE_OOP,
HCL_OFFSETOF(hcl_t, c_system) }
};
#if 0
static hcl_oow_t move_finalizable_objects (hcl_t* hcl);

122
lib/hcl-prv.h
View File

@ -150,6 +150,128 @@
# define HCL_OBJ_SIZE_BITS_MAX (HCL_OBJ_SIZE_MAX * HCL_BITS_PER_BYTE)
#endif
/* ========================================================================= */
/* CLASS SPEC ENCODING */
/* ========================================================================= */
/*
* The spec field of a class object encodes the number of the fixed part
* and the type of the indexed part. The fixed part is the number of
* named instance variables. If the spec of a class is indexed, the object
* of the class can be instantiated with the size of the indexed part.
*
* For example, on a platform where sizeof(hcl_oow_t) is 4,
* the layout of the spec field of a class as an OOP value looks like this:
*
* 31 12 11 10 9 8 7 6 5 4 3 2 1 0
* |number of named instance variables|indexed-type|flags |oop-tag|
*
* the number of named instance variables is stored in high 21 bits.
* the indexed type takes up bit 5 to bit 10 (assuming HCL_OBJ_TYPE_BITS is 6.
* HCL_OBJ_TYPE_XXX enumerators are used to represent actual values).
* and the indexability is stored in the flag bits which span from bit 2 to 4.
*
* The maximum number of named(fixed) instance variables for a class is:
* 2 ^ ((BITS-IN-OOW - HCL_OOP_TAG_BITS_LO) - HCL_OBJ_TYPE_BITS - 1 - 2) - 1
*
* HCL_OOP_TAG_BITS_LO are decremented from the number of bits in OOW because
* the spec field is always encoded as a small integer.
*
* The number of named instance variables can be greater than 0 if the
* class spec is not indexed or if it's a pointer indexed class
* (indexed_type == HCL_OBJ_TYPE_OOP)
*
* indexed_type is one of the #hcl_obj_type_t enumerators.
*/
#define HCL_CLASS_SPEC_FLAG_BITS (3)
/*
* The HCL_CLASS_SPEC_MAKE() macro creates a class spec value.
* _class->spec = HCL_SMOOI_TO_OOP(HCL_CLASS_SPEC_MAKE(0, 1, HCL_OBJ_TYPE_CHAR));
*/
#define HCL_CLASS_SPEC_MAKE(named_instvar,flags,indexed_type) ( \
(((hcl_oow_t)(named_instvar)) << (HCL_OBJ_FLAGS_TYPE_BITS + HCL_CLASS_SPEC_FLAG_BITS)) | \
(((hcl_oow_t)(indexed_type)) << (HCL_CLASS_SPEC_FLAG_BITS)) | (((hcl_oow_t)flags) & HCL_LBMASK(hcl_oow_t,HCL_CLASS_SPEC_FLAG_BITS)))
/* what is the number of named instance variables?
* HCL_CLASS_SPEC_NAMED_INSTVARS(HCL_OOP_TO_SMOOI(_class->spec))
* ensure to update Class<<specNumInstVars if you change this macro. */
#define HCL_CLASS_SPEC_NAMED_INSTVARS(spec) \
(((hcl_oow_t)(spec)) >> (HCL_OBJ_FLAGS_TYPE_BITS + HCL_CLASS_SPEC_FLAG_BITS))
/* is it a user-indexable class?
* all objects can be indexed with basicAt:.
* this indicates if an object can be instantiated with a dynamic size
* (new: size) and and can be indexed with at:.
*/
#define HCL_CLASS_SPEC_FLAGS(spec) (((hcl_oow_t)(spec)) & HCL_LBMASK(hcl_oow_t,HCL_CLASS_SPEC_FLAG_BITS))
/* if so, what is the indexing type? character? pointer? etc? */
#define HCL_CLASS_SPEC_INDEXED_TYPE(spec) \
((((hcl_oow_t)(spec)) >> HCL_CLASS_SPEC_FLAG_BITS) & HCL_LBMASK(hcl_oow_t, HCL_OBJ_FLAGS_TYPE_BITS))
#define HCL_CLASS_SPEC_FLAG_INDEXED (1 << 0)
#define HCL_CLASS_SPEC_FLAG_IMMUTABLE (1 << 1)
#define HCL_CLASS_SPEC_FLAG_UNCOPYABLE (1 << 2)
#define HCL_CLASS_SPEC_IS_INDEXED(spec) (HCL_CLASS_SPEC_FLAGS(spec) & HCL_CLASS_SPEC_FLAG_INDEXED)
#define HCL_CLASS_SPEC_IS_IMMUTABLE(spec) (HCL_CLASS_SPEC_FLAGS(spec) & HCL_CLASS_SPEC_FLAG_IMMUTABLE)
#define HCL_CLASS_SPEC_IS_UNCOPYABLE(spec) (HCL_CLASS_SPEC_FLAGS(spec) & HCL_CLASS_SPEC_FLAG_UNCOPYABLE)
/* What is the maximum number of named instance variables?
* This limit is set this way because the number must be encoded into
* the spec field of the class with limited number of bits assigned to
* the number of named instance variables.
*/
#define HCL_MAX_NAMED_INSTVARS \
HCL_BITS_MAX(hcl_oow_t, HCL_SMOOI_ABS_BITS - (HCL_OBJ_FLAGS_TYPE_BITS + HCL_CLASS_SPEC_FLAG_BITS))
/* Given the number of named instance variables, what is the maximum number
* of indexed instance variables? The number of indexed instance variables
* is not stored in the spec field of the class. It only affects the actual
* size of an object(obj->_size) selectively combined with the number of
* named instance variables. So it's the maximum value of obj->_size minus
* the number of named instance variables.
*/
#define HCL_MAX_INDEXED_INSTVARS(named_instvar) (HCL_OBJ_SIZE_MAX - named_instvar)
/*
* self-specification of a class
* | classinstvars | classvars | flags |
*
* When converted to a small integer
* | sign-bit | classinstvars | classvars | flags | tag |
*/
#define HCL_CLASS_SELFSPEC_FLAG_BITS (3)
#define HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS ((HCL_SMOOI_ABS_BITS - HCL_CLASS_SELFSPEC_FLAG_BITS) / 2)
#define HCL_CLASS_SELFSPEC_CLASSVAR_BITS (HCL_SMOOI_ABS_BITS - (HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS + HCL_CLASS_SELFSPEC_FLAG_BITS))
#define HCL_CLASS_SELFSPEC_MAKE(class_var,classinst_var,flag) \
((((hcl_oow_t)class_var) << (HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS + HCL_CLASS_SELFSPEC_FLAG_BITS)) | \
(((hcl_oow_t)classinst_var) << (HCL_CLASS_SELFSPEC_FLAG_BITS)) | \
(((hcl_oow_t)flag) << (0)))
#define HCL_CLASS_SELFSPEC_CLASSVARS(spec) \
(((hcl_oow_t)spec) >> (HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS + HCL_CLASS_SELFSPEC_FLAG_BITS))
#define HCL_CLASS_SELFSPEC_CLASSINSTVARS(spec) \
((((hcl_oow_t)spec) >> HCL_CLASS_SELFSPEC_FLAG_BITS) & HCL_LBMASK(hcl_oow_t, HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS))
#define HCL_CLASS_SELFSPEC_FLAGS(spec) \
(((hcl_oow_t)spec) & HCL_LBMASK(hcl_oow_t, HCL_CLASS_SELFSPEC_FLAG_BITS))
#define HCL_CLASS_SELFSPEC_FLAG_FINAL (1 << 0)
#define HCL_CLASS_SELFSPEC_FLAG_LIMITED (1 << 1)
#define HCL_MAX_CLASSVARS HCL_BITS_MAX(hcl_oow_t, HCL_CLASS_SELFSPEC_CLASSVAR_BITS)
#define HCL_MAX_CLASSINSTVARS HCL_BITS_MAX(hcl_oow_t, HCL_CLASS_SELFSPEC_CLASSINSTVAR_BITS)
/* ========================================================================= */
/* END OF CLASS SPEC ENCODING */
/* ========================================================================= */
#if defined(HCL_INCLUDE_COMPILER)

6
lib/hcl.h
View File

@ -1649,17 +1649,19 @@ struct hcl_t
hcl_oop_class_t c_symbol; /* Symbol */
hcl_oop_class_t c_array; /* Array */
hcl_oop_class_t c_byte_array; /* ByteArray */
hcl_oop_class_t c_symbol_table; /* SymbolTable */
hcl_oop_class_t c_symtab; /* SymbolTable */
hcl_oop_class_t c_dictionary;
hcl_oop_class_t c_association; /* Association */
hcl_oop_class_t c_cons; /* Cons */
#if 0
hcl_oop_class_t c_namespace; /* Namespace */
hcl_oop_class_t c_pool_dictionary; /* PoolDictionary */
#endif
hcl_oop_class_t c_method_dictionary; /* MethodDictionary */
#if 0
hcl_oop_class_t c_method; /* CompiledMethod */
hcl_oop_class_t c_methsig; /* MethodSignature */
#endif
hcl_oop_class_t c_block; /* CompiledBlock */
hcl_oop_class_t c_method_context; /* MethodContext */