diff --git a/lib/dic.c b/lib/dic.c index baf5323..088f8a8 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -482,7 +482,8 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize) if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make dictionary - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_dictionary->name, orgmsg); } else { diff --git a/lib/exec.c b/lib/exec.c index 9206ac7..a09b68b 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -379,7 +379,7 @@ static HCL_INLINE hcl_oop_context_t make_context (hcl_t* hcl, hcl_ooi_t ntmprs) * for this, there must be a way to specify the type of the member variables... * it's error-prone to initialize the numeric value to nil where 0 is necessary */ - if (HCL_LIKELY(ctx)) ctx->ivaroff = HCL_SMOOI_TO_OOP(0); + if (HCL_LIKELY(ctx)) ctx->ivaroff = HCL_SMOOI_TO_OOP(0); return ctx; } @@ -558,13 +558,13 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c) else if (clstksize < 32) clstksize = 32; hcl_pushvolat (hcl, (hcl_oop_t*)&c); - /*proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize + clstksize);*/ proc = (hcl_oop_process_t)hcl_instantiate(hcl, hcl->c_process, HCL_NULL, stksize + exstksize + clstksize); hcl_popvolat (hcl); if (HCL_UNLIKELY(!proc)) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, hcl->errnum, "unable to make process - %js", oldmsg); + hcl_seterrbfmt (hcl, hcl->errnum, + "unable to instantiate %O - %js", hcl->c_process->name, oldmsg); return HCL_NULL; } @@ -5233,7 +5233,8 @@ hcl_pfrc_t hcl_pf_semaphore_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) if (HCL_UNLIKELY(!sem)) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, hcl->errnum, "unable to make semaphore - %js", oldmsg); + hcl_seterrbfmt (hcl, hcl->errnum, + "unable to instantiate %O - %js", hcl->c_semaphore->name, oldmsg); return HCL_PF_FAILURE; } @@ -5526,7 +5527,8 @@ hcl_pfrc_t hcl_pf_semaphore_group_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nar if (HCL_UNLIKELY(!sg)) { const hcl_ooch_t* oldmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, hcl->errnum, "unable to make semaphore group - %js", oldmsg); + hcl_seterrbfmt (hcl, hcl->errnum, + "unable to instantiate %O - %js", hcl->c_semaphore_group->name, oldmsg); return HCL_PF_FAILURE; } diff --git a/lib/gc.c b/lib/gc.c index eb7fbed..618dd9b 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -1422,7 +1422,7 @@ static hcl_oop_class_t alloc_kernel_class (hcl_t* hcl, int class_flags, hcl_oow_ hcl_oop_class_t c; hcl_ooi_t cspec; - c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_BRAND_CLASS, HCL_CLASS_NAMED_INSTVARS + num_classvars); + c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_CLASS_NAMED_INSTVARS + num_classvars); if (HCL_UNLIKELY(!c)) return HCL_NULL; HCL_OBJ_SET_FLAGS_KERNEL (c, HCL_OBJ_FLAGS_KERNEL_IMMATURE); @@ -1837,7 +1837,8 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (HCL_UNLIKELY(!hcl->nil_process)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make nil process - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O to be nil process - %js", hcl->c_process->name, orgmsg); goto oops; } @@ -1859,7 +1860,8 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize) if (HCL_UNLIKELY(!hcl->processor)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make process scheduler - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js",hcl->c_process_scheduler->name, orgmsg); goto oops; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index cccb711..9c10e6c 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -776,19 +776,6 @@ struct hcl_flx_hbc_t hcl_ooch_t start_c; }; -typedef struct hcl_flx_hn_t hcl_flx_hn_t; /* hash-marked number - radixed number */ -struct hcl_flx_hn_t -{ - /* input data */ - hcl_tok_type_t tok_type; - hcl_synerrnum_t synerr_code; - int radix; - - /* state data */ - hcl_oow_t digit_count; - hcl_oow_t invalid_digit_count; -}; - typedef struct hcl_flx_pi_t hcl_flx_pi_t; struct hcl_flx_pi_t { @@ -868,7 +855,6 @@ enum hcl_flx_state_t HCL_FLX_HMARKED_BC, /* #b - intermediate state before #b[, #c[, or #b-radixed binary number */ HCL_FLX_HMARKED_BINOP, /* #++ - binary operator symbol */ HCL_FLX_HMARKED_CHAR, /* hash-marked character that begins with #\ */ - HCL_FLX_HMARKED_NUMBER, /* hash-marked number - radixed number like #xABCD */ HCL_FLX_HMARKED_IDENT, /* literal symbol */ HCL_FLX_PLAIN_IDENT, /* plain identifier */ HCL_FLX_BINOP, /* binary operator */ @@ -962,7 +948,6 @@ struct hcl_compiler_t hcl_flx_hc_t hc; /* hash-marked character */ hcl_flx_hi_t hi; /* hash-marked identifier - literal symbol */ hcl_flx_hbc_t hbc; /* #b #c ... */ - hcl_flx_hn_t hn; /* hash-marked number - radixed number */ hcl_flx_pi_t pi; /* plain identifier */ hcl_flx_binop_t binop; /* binary operator */ hcl_flx_pn_t pn; /* plain number */ @@ -1516,13 +1501,11 @@ void* hcl_allocbytes ( */ hcl_oop_t hcl_allocoopobj ( hcl_t* hcl, - int brand, hcl_oow_t size ); hcl_oop_t hcl_allocoopobjwithtrailer ( hcl_t* hcl, - int brand, hcl_oow_t size, const hcl_oob_t* tptr, hcl_oow_t tlen @@ -1530,28 +1513,24 @@ hcl_oop_t hcl_allocoopobjwithtrailer ( hcl_oop_t hcl_alloccharobj ( hcl_t* hcl, - int brand, const hcl_ooch_t* ptr, hcl_oow_t len ); hcl_oop_t hcl_allocbyteobj ( hcl_t* hcl, - int brand, const hcl_oob_t* ptr, hcl_oow_t len ); hcl_oop_t hcl_allochalfwordobj ( hcl_t* hcl, - int brand, const hcl_oohw_t* ptr, hcl_oow_t len ); hcl_oop_t hcl_allocwordobj ( hcl_t* hcl, - int brand, const hcl_oow_t* ptr, hcl_oow_t len ); diff --git a/lib/obj.c b/lib/obj.c index c2a8544..5b6c0b8 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -109,7 +109,7 @@ void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size) } -static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t size, int ngc) +static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, hcl_oow_t size, int ngc) { hcl_oop_oop_t hdr; hcl_oow_t nbytes, nbytes_aligned; @@ -144,12 +144,12 @@ static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t si } -hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size) +hcl_oop_t hcl_allocoopobj (hcl_t* hcl, hcl_oow_t size) { - return alloc_oop_array(hcl, brand, size, 0); + return alloc_oop_array(hcl, size, 0); } -hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, int brand, hcl_oow_t size, const hcl_oob_t* bptr, hcl_oow_t blen) +hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_t* bptr, hcl_oow_t blen) { hcl_oop_oop_t hdr; hcl_oow_t nbytes, nbytes_aligned; @@ -177,7 +177,7 @@ hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, int brand, hcl_oow_t size, con return (hcl_oop_t)hdr; } -static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const void* ptr, hcl_oow_t len, hcl_obj_type_t type, hcl_oow_t unit, int extra, int ngc) +static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, const void* ptr, hcl_oow_t len, hcl_obj_type_t type, hcl_oow_t unit, int extra, int ngc) { /* allocate a variable object */ @@ -221,24 +221,24 @@ static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const vo return hdr; } -hcl_oop_t hcl_alloccharobj (hcl_t* hcl, int brand, const hcl_ooch_t* ptr, hcl_oow_t len) +hcl_oop_t hcl_alloccharobj (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) { - return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, 0); + return alloc_numeric_array(hcl, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, 0); } -hcl_oop_t hcl_allocbyteobj (hcl_t* hcl, int brand, const hcl_oob_t* ptr, hcl_oow_t len) +hcl_oop_t hcl_allocbyteobj (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { - return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 0); + return alloc_numeric_array(hcl, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 0); } -hcl_oop_t hcl_allochalfwordobj (hcl_t* hcl, int brand, const hcl_oohw_t* ptr, hcl_oow_t len) +hcl_oop_t hcl_allochalfwordobj (hcl_t* hcl, const hcl_oohw_t* ptr, hcl_oow_t len) { - return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_HALFWORD, HCL_SIZEOF(hcl_oohw_t), 0, 0); + return alloc_numeric_array(hcl, ptr, len, HCL_OBJ_TYPE_HALFWORD, HCL_SIZEOF(hcl_oohw_t), 0, 0); } -hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow_t len) +hcl_oop_t hcl_allocwordobj (hcl_t* hcl, const hcl_oow_t* ptr, hcl_oow_t len) { - return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0); + return alloc_numeric_array(hcl, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0); } /* ------------------------------------------------------------------------ * @@ -251,7 +251,7 @@ hcl_oop_t hcl_hatchundef (hcl_t* hcl) * this function doesn't set the class field */ hcl_oop_t v; - v = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0); + v = hcl_allocoopobj(hcl, 0); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); @@ -270,7 +270,7 @@ hcl_oop_t hcl_hatchnil (hcl_t* hcl) * this function doesn't set the class field */ hcl_oop_t v; - v = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0); + v = hcl_allocoopobj(hcl, 0); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); @@ -312,7 +312,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make cons - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to instantiate %O - %js", hcl->c_cons->name, orgmsg); } else { @@ -336,7 +336,8 @@ hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t len) if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make array - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_array->name, orgmsg); } return v; #endif @@ -349,7 +350,8 @@ hcl_oop_t hcl_makechararray (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make char-array - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_character_array->name, orgmsg); } return v; } @@ -367,7 +369,8 @@ hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make byte-array - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_byte_array->name, orgmsg); } return v; #endif @@ -375,79 +378,32 @@ hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { -#if 0 - hcl_oop_byte_t b; - hcl_oow_t i; - hcl_oob_t v; - - b = (hcl_oop_byte_t)alloc_numeric_array(hcl, HCL_BRAND_BYTE_STRING, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 1, ngc); - if (HCL_UNLIKELY(!b)) - { - const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make bytestring - %js", orgmsg); - } - else - { - for (i = 0; i < len; i++) - { - v = ptr[i]; - HCL_OBJ_SET_BYTE_VAL(b, i, v); - } - - HCL_OBJ_SET_CLASS (b, (hcl_oop_t)hcl->c_byte_string); - } - - return (hcl_oop_t)b; -#else hcl_oop_byte_t v; v = (hcl_oop_byte_t)hcl_instantiate(hcl, hcl->c_byte_string, ptr, len); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make byte-string with bytes - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O with bytes - %js", hcl->c_byte_string->name, orgmsg); } return (hcl_oop_t)v; -#endif } hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) { -#if 0 /* a byte string is a byte array with an extra null at the back. * the input to this function, however, is the pointer to hcl_ooch_t data * because this function is mainly used to convert a token to a byte string. * the token in the compiler is stored as a hcl_ooch_t string. */ - hcl_oop_byte_t b; - hcl_oow_t i; - hcl_oob_t v; - - b = (hcl_oop_byte_t)alloc_numeric_array(hcl, HCL_BRAND_BYTE_STRING, HCL_NULL, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 1, ngc); - if (HCL_UNLIKELY(!b)) - { - const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make bytestring - %js", orgmsg); - } - else - { - for (i = 0; i < len; i++) - { - v = ptr[i] & 0xFF; - HCL_OBJ_SET_BYTE_VAL(b, i, v); - } - - HCL_OBJ_SET_CLASS (b, (hcl_oop_t)hcl->c_byte_string); - } - - return (hcl_oop_t)b; -#else hcl_oop_byte_t v; v = (hcl_oop_byte_t)hcl_instantiate(hcl, hcl->c_byte_string, HCL_NULL, len); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make bytestring - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_byte_string->name, orgmsg); } else { @@ -461,35 +417,19 @@ hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) } return (hcl_oop_t)v; -#endif } hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len) { -#if 0 - hcl_oop_char_t c; - /*c = hcl_alloccharobj(hcl, HCL_BRAND_STRING, ptr, len);*/ - c = (hcl_oop_char_t)alloc_numeric_array(hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc); - if (HCL_UNLIKELY(!c)) - { - 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; -#else hcl_oop_t v; v = hcl_instantiate(hcl, hcl->c_string, ptr, len); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make string - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_string->name, orgmsg); } return v; -#endif } hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) @@ -507,14 +447,15 @@ 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_instantiate(hcl, hcl->c_fixed_point_decimal, HCL_NULL, 0); hcl_popvolat (hcl); if (HCL_UNLIKELY(!f)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make fpdec - %js", orgmsg); + hcl_seterrbfmt ( + hcl, HCL_ERRNUM(hcl), "unable to instantiate %O - %js", + hcl->c_fixed_point_decimal->name, orgmsg); } else { @@ -528,8 +469,6 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t class_name, hcl_oop_t superclass, hcl_ooi_t nivars, hcl_ooi_t ncvars, hcl_oop_t ivars_str, hcl_oop_t cvars_str) { hcl_oop_class_t c; - hcl_oow_t spec, selfspec; - hcl_ooi_t nivars_super; hcl_pushvolat (hcl, &class_name); hcl_pushvolat (hcl, &superclass); @@ -540,35 +479,40 @@ hcl_oop_t hcl_makeclass (hcl_t* hcl, hcl_oop_t class_name, hcl_oop_t superclass, if (HCL_UNLIKELY(!c)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make class %O - %js", class_name, orgmsg); - return HCL_NULL; - } - - /* TODO: other flags... indexable? byte? word?*/ - spec = HCL_CLASS_SPEC_MAKE(nivars, 0, 0); /* TODO: how to include nivars_super ? */ - selfspec = HCL_CLASS_SELFSPEC_MAKE(ncvars, 0, 0); - - if (!HCL_IS_NIL(hcl, superclass)) - { - hcl_ooi_t superspec; - superspec = HCL_OOP_TO_SMOOI(((hcl_oop_class_t)superclass)->spec); - nivars_super = HCL_OOP_TO_SMOOI(((hcl_oop_class_t)superclass)->nivars_super) + HCL_CLASS_SPEC_NAMED_INSTVARS(superspec); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate class %O - %js", class_name, orgmsg); } else { - nivars_super = 0; + hcl_oow_t spec, selfspec; + hcl_ooi_t nivars_super; + + /* TODO: other flags... indexable? byte? word?*/ + spec = HCL_CLASS_SPEC_MAKE(nivars, 0, 0); /* TODO: how to include nivars_super ? */ + selfspec = HCL_CLASS_SELFSPEC_MAKE(ncvars, 0, 0); + + if (!HCL_IS_NIL(hcl, superclass)) + { + hcl_ooi_t superspec; + superspec = HCL_OOP_TO_SMOOI(((hcl_oop_class_t)superclass)->spec); + nivars_super = HCL_OOP_TO_SMOOI(((hcl_oop_class_t)superclass)->nivars_super) + HCL_CLASS_SPEC_NAMED_INSTVARS(superspec); + } + else + { + nivars_super = 0; + } + + c->spec = HCL_SMOOI_TO_OOP(spec); + c->selfspec = HCL_SMOOI_TO_OOP(selfspec); + c->name = class_name; + c->superclass = superclass; + c->nivars_super = HCL_SMOOI_TO_OOP(nivars_super); + c->ibrand = HCL_SMOOI_TO_OOP(HCL_BRAND_INSTANCE); /* TODO: really need ibrand??? */ + + /* TODO: remember ivars_str and vars_str? */ + /* duplicate ivars_str and cvars_str and set it to c->ivarnames and c->cvarnames???? */ } - c->spec = HCL_SMOOI_TO_OOP(spec); - c->selfspec = HCL_SMOOI_TO_OOP(selfspec); - c->name = class_name; - c->superclass = superclass; - c->nivars_super = HCL_SMOOI_TO_OOP(nivars_super); - c->ibrand = HCL_SMOOI_TO_OOP(HCL_BRAND_INSTANCE); /* TODO: really need ibrand??? */ - - /* TODO: remember ivars_str and vars_str? */ - /* duplicate ivars_str and cvars_str and set it to c->ivarnames and c->cvarnames???? */ - return (hcl_oop_t)c; } @@ -656,7 +600,7 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, 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, dspec.alloclen); + oop = hcl_allocoopobj(hcl, dspec.alloclen); if (HCL_LIKELY(oop)) { #if 0 @@ -697,19 +641,19 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, break; case HCL_OBJ_TYPE_CHAR: - oop = hcl_alloccharobj(hcl, HCL_BRAND_INSTANCE, (const hcl_ooch_t*)vptr, dspec.alloclen); + oop = hcl_alloccharobj(hcl, (const hcl_ooch_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_BYTE: - oop = hcl_allocbyteobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oob_t*)vptr, dspec.alloclen); + oop = hcl_allocbyteobj(hcl, (const hcl_oob_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_HALFWORD: - oop = hcl_allochalfwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oohw_t*)vptr, dspec.alloclen); + oop = hcl_allochalfwordobj(hcl, (const hcl_oohw_t*)vptr, dspec.alloclen); break; case HCL_OBJ_TYPE_WORD: - oop = hcl_allocwordobj(hcl, HCL_BRAND_INSTANCE, (const hcl_oow_t*)vptr, dspec.alloclen); + oop = hcl_allocwordobj(hcl, (const hcl_oow_t*)vptr, dspec.alloclen); break; /* TODO: more types... HCL_OBJ_TYPE_INT... HCL_OBJ_TYPE_FLOAT, HCL_OBJ_TYPE_UINT16, etc*/ @@ -749,7 +693,7 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo switch (dspec.type) { case HCL_OBJ_TYPE_OOP: - oop = hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_INSTANCE, dspec.alloclen, trptr, trlen); + oop = hcl_allocoopobjwithtrailer(hcl, dspec.alloclen, trptr, trlen); if (HCL_LIKELY(oop)) { /* initialize named instance variables with default values */ @@ -815,7 +759,7 @@ void hcl_freengcobj (hcl_t* hcl, hcl_oop_t obj) hcl_oop_t hcl_makengcbytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { - return alloc_numeric_array(hcl, HCL_BRAND_BYTE_ARRAY, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 1); + return alloc_numeric_array(hcl, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 1); } hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize) @@ -843,7 +787,7 @@ hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize) hcl_oop_t hcl_makengcarray (hcl_t* hcl, hcl_oow_t len) { - return alloc_numeric_array(hcl, HCL_BRAND_ARRAY, HCL_NULL, len, HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 1); + return alloc_numeric_array(hcl, HCL_NULL, len, HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 1); } hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize) diff --git a/lib/prim.c b/lib/prim.c index 3bb44ef..9c15e7a 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -39,27 +39,14 @@ typedef struct pf_t pf_t; hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hcl_oow_t maxargs, hcl_mod_t* mod) { -#if 0 - hcl_oop_prim_t obj; /* in principle, hcl_oop_word_t with HCL_PRIM_NAMED_INSTVARS elements */ - - obj = (hcl_oop_prim_t)hcl_allocwordobj(hcl, HCL_BRAND_PRIM, HCL_NULL, HCL_PRIM_NAMED_INSTVARS); - if (HCL_LIKELY(obj)) - { - obj->impl = (hcl_oow_t)primimpl; - obj->min_nargs = minargs; - obj->max_nargs = maxargs; - obj->mod = (hcl_oow_t)mod; - } - - return (hcl_oop_t)obj; -#else hcl_oop_prim_t v; /* in principle, hcl_oop_word_t with HCL_PRIM_NUM_WORDS elements */ v = (hcl_oop_prim_t)hcl_instantiate(hcl, hcl->c_primitive, HCL_NULL, 0); if (HCL_UNLIKELY(!v)) { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make primitive - %js", orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O - %js", hcl->c_primitive->name, orgmsg); } else { @@ -70,7 +57,6 @@ hcl_oop_t hcl_makeprim (hcl_t* hcl, hcl_pfimpl_t primimpl, hcl_oow_t minargs, hc } return (hcl_oop_t)v; -#endif } /* ------------------------------------------------------------------------- */ @@ -1350,17 +1336,35 @@ int hcl_addbuiltinprims (hcl_t* hcl) for (i = 0; i < HCL_COUNTOF(builtin_prims); i++) { prim = hcl_makeprim(hcl, builtin_prims[i].impl, builtin_prims[i].minargs, builtin_prims[i].maxargs, HCL_NULL); - if (HCL_UNLIKELY(!prim)) return -1; + if (HCL_UNLIKELY(!prim)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make primitive '%.*js' - %js", + builtin_prims[i].namelen, builtin_prims[i].name, orgmsg); + return -1; + } hcl_pushvolat (hcl, &prim); name = hcl_makesymbol(hcl, builtin_prims[i].name, builtin_prims[i].namelen); hcl_popvolat (hcl); - if (HCL_UNLIKELY(!name)) return -1; + if (HCL_UNLIKELY(!name)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make primitive name '%.*js' - %js", + builtin_prims[i].namelen, builtin_prims[i].name, orgmsg); + return -1; + } hcl_pushvolat (hcl, &name); cons = hcl_putatsysdic(hcl, name, prim); hcl_popvolat (hcl); - if (HCL_UNLIKELY(!cons)) return -1; + if (HCL_UNLIKELY(!cons)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to add primitive '%.*js' to system dictionary - %js", + builtin_prims[i].namelen, builtin_prims[i].name, orgmsg); + return -1; + } /* turn on the kernel bit in the symbol associated with a primitive * function. 'set' prevents this symbol from being used as a variable diff --git a/lib/read.c b/lib/read.c index ca4b6b8..a834355 100644 --- a/lib/read.c +++ b/lib/read.c @@ -2197,14 +2197,6 @@ static HCL_INLINE void init_flx_hbc (hcl_flx_hbc_t* hbc, hcl_ooch_t start_c) hbc->start_c = start_c; } -static HCL_INLINE void init_flx_hn (hcl_flx_hn_t* hn, hcl_tok_type_t tok_type, hcl_synerrnum_t synerr_code, int radix) -{ - HCL_MEMSET (hn, 0, HCL_SIZEOF(*hn)); - hn->tok_type = tok_type; - hn->synerr_code = synerr_code; - hn->radix = radix; -} - static HCL_INLINE void init_flx_qt (hcl_flx_qt_t* qt, hcl_tok_type_t tok_type, hcl_synerrnum_t synerr_code, hcl_ooch_t end_char, hcl_ooch_t esc_char, hcl_oow_t min_len, hcl_oow_t max_len, int is_byte) { HCL_MEMSET (qt, 0, HCL_SIZEOF(*qt)); @@ -2573,18 +2565,6 @@ static int flx_hmarked_token (hcl_t* hcl, hcl_ooci_t c) FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_FLX_HMARKED_BC); break; - #if 0 - case 'e': /* #eXXX - error literal */ - init_flx_hn (FLX_HN(hcl), HCL_TOK_ERRLIT, HCL_SYNERR_ERRLIT, 10); - goto radixed_number; - - case 'p': /* #pXXX - small pointer */ - init_flx_hn (FLX_HN(hcl), HCL_TOK_SMPTRLIT, HCL_SYNERR_SMPTRLIT, 16); - radixed_number: - FEED_CONTINUE_WITH_CHAR (hcl, c, HCL_FLX_HMARKED_NUMBER); - goto consumed; - #endif - /* --------------------------- */ case '\\': init_flx_hc (FLX_HC(hcl)); @@ -2729,21 +2709,13 @@ static int flx_hmarked_bc (hcl_t* hcl, hcl_ooci_t c) if (c == '[') { /* #b[ - byte array starter */ - /* TODO: more types.. #w[ .. #u32[ ... etc */ + /* TODO: more types.. #c[ #w[ .. #u32[ ... etc */ + /* char-array word-array 32bit-int-array etc */ hcl_tok_type_t tt; tt = (hb->start_c == 'b' || hb->start_c == 'B')? HCL_TOK_BAPAREN: HCL_TOK_CAPAREN; FEED_WRAP_UP_WITH_CHAR (hcl, c, tt); goto consumed; } -#if 0 - else if (hb->start_c == 'b' || hb->start_c == 'B') - { - /* TODO: this part needs to be removed once 0x, 0b, 0o and etc are implemented */ - init_flx_hn (FLX_HN(hcl), HCL_TOK_RADNUMLIT, HCL_SYNERR_NUMLIT, 2); - FEED_CONTINUE (hcl, HCL_FLX_HMARKED_NUMBER); - goto not_consumed; - } -#endif else { hcl_ooch_t start_c = hb->start_c; @@ -2787,64 +2759,6 @@ not_consumed: return 0; } -static int flx_hmarked_number (hcl_t* hcl, hcl_ooci_t c) -{ - hcl_flx_hn_t* rn = FLX_HN(hcl); - - if (HCL_CHAR_TO_NUM(c, rn->radix) >= rn->radix) - { - if (is_delim_char(c)) - { - if (rn->digit_count == 0) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_NUMLIT, TOKEN_LOC(hcl), HCL_NULL, - "no valid digit after radix specifier '%.*js'", TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl)); - return -1; - } - else if (rn->invalid_digit_count > 0) - { - /* invalid as a radixed number, but this could be a hash-marked directive */ - hcl_tok_type_t tok_type; - - if (get_directive_token_type(hcl, &tok_type) <= -1) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_NUMLIT, TOKEN_LOC(hcl), HCL_NULL, - "neither valid radixed number nor valid directive '%.*js'", TOKEN_NAME_LEN(hcl), TOKEN_NAME_PTR(hcl)); - return -1; - } - else - { - FEED_WRAP_UP (hcl, tok_type); - goto not_consumed; - } - } - - FEED_WRAP_UP (hcl, rn->tok_type); - goto not_consumed; - } - else - { - ADD_TOKEN_CHAR(hcl, c); - rn->digit_count++; - rn->invalid_digit_count++; - goto consumed; - } - } - else - { - HCL_ASSERT (hcl, !is_delim_char(c)); - ADD_TOKEN_CHAR(hcl, c); - rn->digit_count++; - goto consumed; - } - -consumed: - return 1; - -not_consumed: - return 0; -} - static int flx_hmarked_ident (hcl_t* hcl, hcl_ooci_t c) { hcl_flx_hi_t* hi = FLX_HI(hcl); @@ -3446,7 +3360,6 @@ static int feed_char (hcl_t* hcl, hcl_ooci_t c) case HCL_FLX_HMARKED_BC: return flx_hmarked_bc(hcl, c); case HCL_FLX_HMARKED_BINOP: return flx_hmarked_binop(hcl, c); case HCL_FLX_HMARKED_CHAR: return flx_hmarked_char(hcl, c); - case HCL_FLX_HMARKED_NUMBER: return flx_hmarked_number(hcl, c); case HCL_FLX_HMARKED_IDENT: return flx_hmarked_ident(hcl, c); case HCL_FLX_PLAIN_IDENT: return flx_plain_ident(hcl, c); diff --git a/lib/sym.c b/lib/sym.c index 38045de..7a38a7d 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -169,7 +169,8 @@ static hcl_oop_t find_or_make_symbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow else { const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); - hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make symbol - %.*js - %js", len, ptr, orgmsg); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), + "unable to instantiate %O with %.*js - %js", hcl->c_symbol->name, len, ptr, orgmsg); } return (hcl_oop_t)sym; }