diff --git a/lib/exec.c b/lib/exec.c index d502ddd..edf6328 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -2272,7 +2272,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in } else { - HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv)); + /*HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));*/ HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class)); class_ = (hcl_oop_class_t)rcv->_class; mth_blk = find_imethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner); @@ -4127,8 +4127,9 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid message", op, rcv); /* TODO: change to HCL_ESEND?? */ goto cannot_send; } - else if (HCL_IS_CLASS(hcl, rcv) || HCL_IS_INSTANCE(hcl, rcv)) + else if (HCL_IS_CLASS(hcl, rcv) || HCL_IS_INSTANCE(hcl, rcv) || HCL_IS_CLASS(hcl, rcv->_class)) /* TOIDO: revisit this condition */ { + send_message: if (send_message(hcl, rcv, op, ((bcode >> 2) & 1) /* to_super */, b1 /* nargs */, b2 /* nrvars */) <= -1) { const hcl_ooch_t* msg = hcl_backuperrmsg(hcl); @@ -4139,7 +4140,12 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1) /* TODO: support non-symbol op? */ else { + #if 0 hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid receiver", op, rcv); /* TODO: change to HCL_ESEND?? */ + #else + goto send_message; + #endif + cannot_send: if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break; goto oops_with_errmsg_supplement; diff --git a/lib/gc.c b/lib/gc.c index aba570c..ebe0578 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -1265,7 +1265,7 @@ static int ignite_2 (hcl_t* hcl) } #if 0 - /* Prevent the object instations in the permspace. + /* Prevent the object instantions in the permspace. * * 1. The symbol table is big and it may resize after ignition. * the resizing operation will migrate the obejct out of the @@ -1399,7 +1399,7 @@ static int ignite_3 (hcl_t* hcl) for (i = 0; i < HCL_COUNTOF(kernel_classes); i++) { - sym = hcl_makesymbol(hcl, kernel_classes[i].name, hcl_count_oocstr(kernel_classes[i].name)); + sym = hcl_makesymbolwithbcstr(hcl, kernel_classes[i].name); if (HCL_UNLIKELY(!sym)) return -1; cls = *(hcl_oop_class_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset); @@ -1462,13 +1462,13 @@ static int make_kernel_objs (hcl_t* hcl) #endif if (HCL_LIKELY(!hcl->_undef)) { /* TODO: create it as nogc */ - hcl->_undef = hcl_makeundef(hcl); + hcl->_undef = hcl_hatchundef(hcl); if (HCL_UNLIKELY(!hcl->_undef)) goto oops; } if (HCL_LIKELY(!hcl->_nil)) { /* TODO: create it as nogc? */ - hcl->_nil = hcl_makenil(hcl); + hcl->_nil = hcl_hatchnil(hcl); if (HCL_UNLIKELY(!hcl->_nil)) goto oops; } @@ -1482,6 +1482,8 @@ static int make_kernel_objs (hcl_t* hcl) if (ignite_3(hcl) <= -1) goto oops; +/* TODO: scan the heap. and fix the class of objects using brand if the class is NULL */ + #if 0 hcl->igniting = 0; #endif @@ -1506,16 +1508,8 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (make_kernel_objs(hcl) <= -1) return -1; - if (!hcl->_true) - { - hcl->_true = hcl_maketrue(hcl); - if (HCL_UNLIKELY(!hcl->_true)) goto oops; - } - if (!hcl->_false) - { - hcl->_false = hcl_makefalse(hcl); - if (HCL_UNLIKELY(!hcl->_false)) goto oops; - } + HCL_ASSERT (hcl, hcl->_true != HCL_NULL); + HCL_ASSERT (hcl, hcl->_false != HCL_NULL); if (!hcl->symtab) { diff --git a/lib/hcl.h b/lib/hcl.h index fe6811b..b36956a 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -2772,23 +2772,14 @@ HCL_EXPORT hcl_oow_t hcl_fmttobcstr ( /* ========================================================================= * OBJECT MANAGEMENT * ========================================================================= */ -HCL_EXPORT hcl_oop_t hcl_makeundef ( +HCL_EXPORT hcl_oop_t hcl_hatchundef ( hcl_t* hcl ); -HCL_EXPORT hcl_oop_t hcl_makenil ( +HCL_EXPORT hcl_oop_t hcl_hatchnil ( hcl_t* hcl ); -HCL_EXPORT hcl_oop_t hcl_maketrue ( - hcl_t* hcl -); - -HCL_EXPORT hcl_oop_t hcl_makefalse ( - hcl_t* hcl -); - - HCL_EXPORT hcl_oop_t hcl_makecons ( hcl_t* hcl, hcl_oop_t car, diff --git a/lib/obj.c b/lib/obj.c index 31d5da3..0b91a0e 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -254,8 +254,11 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow * COMMON OBJECTS * ------------------------------------------------------------------------ */ -hcl_oop_t hcl_makeundef (hcl_t* hcl) +hcl_oop_t hcl_hatchundef (hcl_t* hcl) { + /* create the undef object for bootstrapping. + * this function doesn't set the class field */ + hcl_oop_t o; o = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0); if (HCL_LIKELY(o)) @@ -270,8 +273,11 @@ hcl_oop_t hcl_makeundef (hcl_t* hcl) return o; } -hcl_oop_t hcl_makenil (hcl_t* hcl) +hcl_oop_t hcl_hatchnil (hcl_t* hcl) { + /* create the nil object for bootstrapping. + * this function doesn't set the class field */ + hcl_oop_t o; o = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0); if (HCL_LIKELY(o)) @@ -286,16 +292,6 @@ hcl_oop_t hcl_makenil (hcl_t* hcl) return o; } -hcl_oop_t hcl_maketrue (hcl_t* hcl) -{ - return hcl_allocoopobj(hcl, HCL_BRAND_TRUE, 0); -} - -hcl_oop_t hcl_makefalse (hcl_t* hcl) -{ - return hcl_allocoopobj(hcl, HCL_BRAND_FALSE, 0); -} - hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len) { hcl_oop_t oop; @@ -327,6 +323,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) { cons->car = car; cons->cdr = cdr; + HCL_OBJ_SET_CLASS (cons, (hcl_oop_t)hcl->c_cons); } hcl_popvolats (hcl, 2); @@ -336,12 +333,18 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc) { - return hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size); + hcl_oop_t v; + v = hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size); + if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_array); + return v; } hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size) { - return hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size); + hcl_oop_t v; + v = hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size); + if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_byte_array); + return v; } hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len, int ngc) @@ -373,6 +376,8 @@ hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, v = ptr[i] & 0xFF; HCL_OBJ_SET_BYTE_VAL(b, i, v); } + + HCL_OBJ_SET_CLASS (b, (hcl_oop_t)hcl->c_byte_array); } return (hcl_oop_t)b; @@ -388,6 +393,10 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make string - %js", orgmsg); } + else + { + HCL_OBJ_SET_CLASS (c, (hcl_oop_t)hcl->c_string); + } return (hcl_oop_t)c; } @@ -413,11 +422,13 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make fpdec - %js", orgmsg); - return HCL_NULL; } - - f->value = value; - f->scale = HCL_SMOOI_TO_OOP(scale); + else + { + f->value = value; + f->scale = HCL_SMOOI_TO_OOP(scale); + HCL_OBJ_SET_CLASS (f, (hcl_oop_t)hcl->c_fixed_point_decimal); + } return (hcl_oop_t)f; } diff --git a/lib/sym.c b/lib/sym.c index 0766065..6dccb6e 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -104,7 +104,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, sym)); if (len == HCL_OBJ_GET_SIZE(sym) && - hcl_equal_oochars (ptr, sym->slot, len)) + hcl_equal_oochars(ptr, sym->slot, len)) { return (hcl_oop_t)sym; } @@ -159,7 +159,7 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow /* create a new symbol since it isn't found in the symbol table */ /*sym = (hcl_oop_char_t)hcl_alloccharobj(hcl, HCL_BRAND_SYMBOL, ptr, len);*/ - sym = (hcl_oop_char_t)hcl_instantiate(hcl, hcl->c_symbol, ptr, len); + sym = (hcl_oop_char_t)hcl_instantiate(hcl, hcl->c_symbol, ptr, len); if (HCL_LIKELY(sym)) { HCL_ASSERT (hcl, tally < HCL_SMOOI_MAX); @@ -183,3 +183,20 @@ hcl_oop_t hcl_findsymbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) { return find_or_make_symbol(hcl, ptr, len, 0); } + +hcl_oop_t hcl_makesymbolwithbcstr (hcl_t* hcl, const hcl_ooch_t* ptr) +{ +#if defined(HCL_OOCH_IS_UCH) + hcl_uch_t* ucsptr; + hcl_oow_t ucslen; + hcl_oop_t v; +/* TODO: no duplication? */ + ucsptr = hcl_dupbtoucstr(hcl, ptr, &ucslen); + if (HCL_UNLIKELY(!ucsptr)) return HCL_NULL; + v = hcl_makesymbol(hcl, ucsptr, ucslen); + hcl_freemem (hcl, ucsptr); + return v; +#else + return hcl_makesymbol(hcl, ptr, hcl_count_bcstr(ptr)); +#endif +}