diff --git a/README.md b/README.md index 7e7f772..072f6c0 100644 --- a/README.md +++ b/README.md @@ -36,20 +36,23 @@ do { | k | set k 20; printf "k=%d\n" k; }; ## Literals - integer -- character +- character `'c'` - small pointer - error -- string -- dictionary `#{ }` -- array `[ ]` -- byte array `#[ ]` -- list `#( )` +- string `"string"` +- byte-string `b"string"` +- symbol `#"symbol"` ## Basic Expressions +- dictionary `#{ }` +- array `#[ ]` +- byte array `#b[ ]` +- list `#( )` - function calls `( )` -- message sends `(: )` +- message sends `(rcv:msg arg1 ...)` - variable declaration `| |` -- class variable delcarations `:: | |` +- class variable delcarations `:: [ v1 [cv1 cv2 ...] v2 ... ] ` +- assignment `var := value` ## Builtin functions diff --git a/lib/bigint.c b/lib/bigint.c index d678fca..7a101be 100644 --- a/lib/bigint.c +++ b/lib/bigint.c @@ -4882,7 +4882,7 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) hcl->inttostr.xbuf.len = xlen; return hcl->_nil; } - return hcl_makestring(hcl, xbuf, xlen, 0); + return hcl_makestring(hcl, xbuf, xlen); } as = HCL_OBJ_GET_SIZE(num); @@ -4931,7 +4931,7 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int flagged_radix) return hcl->_nil; } - return hcl_makestring(hcl, xbuf, xlen, 0); + return hcl_makestring(hcl, xbuf, xlen); oops_einval: hcl_seterrnum (hcl, HCL_EINVAL); diff --git a/lib/comp.c b/lib/comp.c index e7f965d..27e2459 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -2695,7 +2695,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) /* set starting point past the added space (+1 to index, -1 to length) */ adj = (hcl->c->tv.s.ptr[vardcl.ivar_start] == ' '); - tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[vardcl.ivar_start + adj], vardcl.ivar_len - adj, 0); + tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[vardcl.ivar_start + adj], vardcl.ivar_len - adj); if (HCL_UNLIKELY(!tmp)) goto oops; if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) goto oops; } @@ -2713,7 +2713,7 @@ static HCL_INLINE int compile_class_p1 (hcl_t* hcl) } adj = (hcl->c->tv.s.ptr[vardcl.cvar_start] == ' '); - tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[vardcl.cvar_start + adj], vardcl.cvar_len - adj, 0); + tmp = hcl_makestring(hcl, &hcl->c->tv.s.ptr[vardcl.cvar_start + adj], vardcl.cvar_len - adj); if (HCL_UNLIKELY(!tmp)) goto oops; if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) goto oops; } @@ -4866,12 +4866,12 @@ redo: goto literal; case HCL_CNODE_STRLIT: - lit = hcl_makestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd), 0); + lit = hcl_makestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd)); if (HCL_UNLIKELY(!lit)) return -1; goto literal; case HCL_CNODE_BSTRLIT: - lit = hcl_makebytestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd), 0); + lit = hcl_makebytestring(hcl, HCL_CNODE_GET_TOKPTR(oprnd), HCL_CNODE_GET_TOKLEN(oprnd)); if (HCL_UNLIKELY(!lit)) return -1; goto literal; diff --git a/lib/dic.c b/lib/dic.c index 5bdcd54..b4f70bb 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -65,7 +65,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) } hcl_pushvolat (hcl, (hcl_oop_t*)&oldbuc); - newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0); + newbuc = (hcl_oop_oop_t)hcl_makearray(hcl, newsz); hcl_popvolat (hcl); if (!newbuc) return HCL_NULL; @@ -467,7 +467,7 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize) obj->tally = HCL_SMOOI_TO_OOP(0); hcl_pushvolat (hcl, (hcl_oop_t*)&obj); - bucket = (hcl_oop_oop_t)hcl_makearray(hcl, inisize, 0); + bucket = (hcl_oop_oop_t)hcl_makearray(hcl, inisize); hcl_popvolat (hcl); if (!bucket) obj = HCL_NULL; diff --git a/lib/exec.c b/lib/exec.c index 42c176b..0043414 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -2453,7 +2453,7 @@ static int do_throw_with_internal_errmsg (hcl_t* hcl, hcl_ooi_t ip) { hcl_oop_t ex; /* TODO: consider throwing an exception object instead of a string? */ - ex = hcl_makestring(hcl, hcl->errmsg.buf, hcl->errmsg.len, 0); /* TODO: include error location in the message? */ + ex = hcl_makestring(hcl, hcl->errmsg.buf, hcl->errmsg.len); /* TODO: include error location in the message? */ if (HCL_UNLIKELY(!ex)) return -1; if (do_throw(hcl, ex, ip) <= -1) return -1; return 0; @@ -4051,7 +4051,7 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc case HCL_CODE_CLASS_CIMSTORE: { hcl_oop_t _class; - hcl_oop_t mdic, cons, blk, car, cdr, name; + hcl_oop_t mdic, blk, name; int mtype; static hcl_bch_t* pfx[] = { "c", "i", "ci" }; @@ -4464,8 +4464,7 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc LOG_INST_1 (hcl, "make_array %zu", b1); /* create an empty array */ - /*t = hcl_makearray(hcl, b1, 0);*/ - t = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, b1); + t = hcl_makearray(hcl, b1); if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; HCL_STACK_PUSH (hcl, t); /* push the array created */ @@ -4499,8 +4498,7 @@ hcl_logbfmt (hcl, HCL_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d nc LOG_INST_1 (hcl, "make_bytearray %zu", b1); /* create an empty array */ - /*t = hcl_makebytearray(hcl, HCL_NULL, b1);*/ - t = hcl_instantiate(hcl, hcl->c_byte_array, HCL_NULL, b1); + t = hcl_makebytearray(hcl, HCL_NULL, b1); if (HCL_UNLIKELY(!t)) goto oops_with_errmsg_supplement; HCL_STACK_PUSH (hcl, t); /* push the byte array created */ diff --git a/lib/gc.c b/lib/gc.c index a62f1ad..baeb270 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -315,7 +315,7 @@ static kernel_class_info_t kernel_classes[__KCI_MAX__] = "Symbol", KCI_STRING, HCL_BRAND_SYMBOL, - HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, + HCL_CLASS_SELFSPEC_FLAG_FINAL | HCL_CLASS_SELFSPEC_FLAG_LIMITED, /* TODO: these flags not implemented yet */ 0, 0, HCL_CLASS_SPEC_FLAG_INDEXED | HCL_CLASS_SPEC_FLAG_IMMUTABLE, @@ -1416,18 +1416,16 @@ hcl_oop_t hcl_shallowcopy (hcl_t* hcl, hcl_oop_t oop) static hcl_oop_class_t alloc_kernel_class (hcl_t* hcl, int class_flags, hcl_oow_t num_classvars, hcl_oow_t spec, hcl_ooi_t nivars_super, int ibrand) { hcl_oop_class_t c; -#if 0 hcl_ooi_t cspec; -#endif c = (hcl_oop_class_t)hcl_allocoopobj(hcl, HCL_BRAND_CLASS, HCL_CLASS_NAMED_INSTVARS + num_classvars); if (HCL_UNLIKELY(!c)) return HCL_NULL; HCL_OBJ_SET_FLAGS_KERNEL (c, HCL_OBJ_FLAGS_KERNEL_IMMATURE); -#if 0 /* TODO extend the flags and uncomment this part */ cspec = kernel_classes[KCI_CLASS].class_spec_flags; if (HCL_CLASS_SPEC_IS_IMMUTABLE(cspec)) HCL_OBJ_SET_FLAGS_RDONLY (c, 1); /* just for completeness of code. will never be true as it's not defined in the kernel class info table */ +#if 0 /* TODO extend the flags and uncomment this part */ if (HCL_CLASS_SPEC_IS_UNCOPYABLE(cspec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (c, 1); /* class itself is uncopyable */ #endif diff --git a/lib/hcl.h b/lib/hcl.h index e269cd7..212c605 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -359,22 +359,22 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; * size calculation and the access to the payload fields become more complex. * Therefore, i've dropped the idea. * ========================================================================= */ -#define HCL_OBJ_FLAGS_TYPE_BITS (6) -#define HCL_OBJ_FLAGS_UNIT_BITS (5) -#define HCL_OBJ_FLAGS_EXTRA_BITS (1) -#define HCL_OBJ_FLAGS_KERNEL_BITS (2) -#define HCL_OBJ_FLAGS_MOVED_BITS (2) -#define HCL_OBJ_FLAGS_NGC_BITS (1) -#define HCL_OBJ_FLAGS_TRAILER_BITS (1) -#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) -#define HCL_OBJ_FLAGS_BRAND_BITS (6) -#define HCL_OBJ_FLAGS_FLEXI_BITS (1) +#define HCL_OBJ_FLAGS_TYPE_BITS (6) /* 6 */ +#define HCL_OBJ_FLAGS_UNIT_BITS (5) /* 11 */ +#define HCL_OBJ_FLAGS_EXTRA_BITS (1) /* 12 */ +#define HCL_OBJ_FLAGS_KERNEL_BITS (2) /* 14 */ +#define HCL_OBJ_FLAGS_MOVED_BITS (2) /* 16 */ +#define HCL_OBJ_FLAGS_NGC_BITS (1) /* 17 */ +#define HCL_OBJ_FLAGS_TRAILER_BITS (1) /* 18 */ +#define HCL_OBJ_FLAGS_SYNCODE_BITS (5) /* 23 */ +#define HCL_OBJ_FLAGS_BRAND_BITS (6) /* 29 */ +#define HCL_OBJ_FLAGS_FLEXI_BITS (1) /* 30 */ +#define HCL_OBJ_FLAGS_RDONLY_BITS (1) /* 31 */ /* #define HCL_OBJ_FLAGS_PERM_BITS 1 #define HCL_OBJ_FLAGS_MOVED_BITS 2 #define HCL_OBJ_FLAGS_PROC_BITS 2 -#define HCL_OBJ_FLAGS_RDONLY_BITS 1 #define HCL_OBJ_FLAGS_GCFIN_BITS 4 #define HCL_OBJ_FLAGS_TRAILER_BITS 1 #define HCL_OBJ_FLAGS_HASH_BITS 2 @@ -390,7 +390,8 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_FLAGS_TRAILER_SHIFT (HCL_OBJ_FLAGS_SYNCODE_BITS + HCL_OBJ_FLAGS_SYNCODE_SHIFT) #define HCL_OBJ_FLAGS_SYNCODE_SHIFT (HCL_OBJ_FLAGS_BRAND_BITS + HCL_OBJ_FLAGS_BRAND_SHIFT) #define HCL_OBJ_FLAGS_BRAND_SHIFT (HCL_OBJ_FLAGS_FLEXI_BITS + HCL_OBJ_FLAGS_FLEXI_SHIFT) -#define HCL_OBJ_FLAGS_FLEXI_SHIFT (0) +#define HCL_OBJ_FLAGS_FLEXI_SHIFT (HCL_OBJ_FLAGS_RDONLY_BITS + HCL_OBJ_FLAGS_RDONLY_SHIFT) +#define HCL_OBJ_FLAGS_RDONLY_SHIFT (0) #define HCL_OBJ_GET_FLAGS_TYPE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT, HCL_OBJ_FLAGS_TYPE_BITS) #define HCL_OBJ_GET_FLAGS_UNIT(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT, HCL_OBJ_FLAGS_UNIT_BITS) @@ -402,6 +403,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_GET_FLAGS_SYNCODE(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS) #define HCL_OBJ_GET_FLAGS_BRAND(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT, HCL_OBJ_FLAGS_BRAND_BITS) #define HCL_OBJ_GET_FLAGS_FLEXI(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS) +#define HCL_OBJ_GET_FLAGS_RDONLY(oop) HCL_GETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS) #define HCL_OBJ_SET_FLAGS_TYPE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_TYPE_SHIFT, HCL_OBJ_FLAGS_TYPE_BITS, v) #define HCL_OBJ_SET_FLAGS_UNIT(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_UNIT_SHIFT, HCL_OBJ_FLAGS_UNIT_BITS, v) @@ -413,6 +415,7 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; #define HCL_OBJ_SET_FLAGS_SYNCODE(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_SYNCODE_SHIFT, HCL_OBJ_FLAGS_SYNCODE_BITS, v) #define HCL_OBJ_SET_FLAGS_BRAND(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_BRAND_SHIFT, HCL_OBJ_FLAGS_BRAND_BITS, v) #define HCL_OBJ_SET_FLAGS_FLEXI(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_FLEXI_SHIFT, HCL_OBJ_FLAGS_FLEXI_BITS, v) +#define HCL_OBJ_SET_FLAGS_RDONLY(oop,v) HCL_SETBITS(hcl_oow_t, (oop)->_flags, HCL_OBJ_FLAGS_RDONLY_SHIFT, HCL_OBJ_FLAGS_RDONLY_BITS, v) #define HCL_OBJ_GET_SIZE(oop) ((oop)->_size) #define HCL_OBJ_GET_CLASS(oop) ((oop)->_class) @@ -2859,8 +2862,7 @@ HCL_EXPORT hcl_oop_t hcl_makecons ( HCL_EXPORT hcl_oop_t hcl_makearray ( hcl_t* hcl, - hcl_oow_t size, - int ngc + hcl_oow_t len ); HCL_EXPORT hcl_oop_t hcl_makebytearray ( @@ -2872,22 +2874,19 @@ HCL_EXPORT hcl_oop_t hcl_makebytearray ( HCL_EXPORT hcl_oop_t hcl_makebytestringwithbytes ( hcl_t* hcl, const hcl_oob_t* ptr, - hcl_oow_t len, - int ngc + hcl_oow_t len ); HCL_EXPORT hcl_oop_t hcl_makebytestring ( hcl_t* hcl, const hcl_ooch_t* ptr, - hcl_oow_t len, - int ngc + hcl_oow_t len ); HCL_EXPORT hcl_oop_t hcl_makestring ( hcl_t* hcl, const hcl_ooch_t* ptr, - hcl_oow_t len, - int ngc + hcl_oow_t len ); HCL_EXPORT hcl_oop_t hcl_makefpdec ( diff --git a/lib/obj.c b/lib/obj.c index cee6efb..df336af 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -136,7 +136,7 @@ static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t si hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, ngc, 0, 0); HCL_OBJ_SET_SIZE (hdr, size); - /*HCL_OBJ_SET_CLASS (hdr, hcl->_nil);*/ + HCL_OBJ_SET_CLASS (hdr, hcl->_nil); HCL_OBJ_SET_FLAGS_BRAND (hdr, brand); while (size > 0) hdr->slot[--size] = hcl->_nil; @@ -294,30 +294,32 @@ hcl_oop_t hcl_hatchnil (hcl_t* hcl) hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len) { - hcl_oop_t oop; + hcl_oop_t v; +/* TODO: use hcl_instantiate.. */ HCL_ASSERT (hcl, brand == HCL_BRAND_PBIGINT || brand == HCL_BRAND_NBIGINT); #if (HCL_LIW_BITS == HCL_OOW_BITS) - oop = hcl_allocwordobj(hcl, brand, ptr, len); + v = hcl_allocwordobj(hcl, brand, ptr, len); #elif (HCL_LIW_BITS == HCL_OOHW_BITS) - oop = hcl_allochalfwordobj(hcl, brand, ptr, len); + v = hcl_allochalfwordobj(hcl, brand, ptr, len); #else # error UNSUPPORTED LIW BIT SIZE #endif - if (HCL_UNLIKELY(oop)) + if (HCL_UNLIKELY(v)) { hcl_oop_class_t _class = (brand == HCL_BRAND_PBIGINT)? hcl->c_large_positive_integer: hcl->c_large_negative_integer; - HCL_OBJ_SET_FLAGS_BRAND (oop, brand); - HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class); + HCL_OBJ_SET_FLAGS_BRAND (v, brand); + HCL_OBJ_SET_CLASS (v, (hcl_oop_t)_class); } - return oop; + return v; } hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) { /* TODO: use hcl_instantiate() */ +#if 0 hcl_oop_cons_t cons; hcl_pushvolat (hcl, &car); @@ -334,28 +336,67 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) hcl_popvolats (hcl, 2); return (hcl_oop_t)cons; +#else + hcl_oop_cons_t v; + hcl_pushvolat (hcl, &car); + hcl_pushvolat (hcl, &cdr); + v = (hcl_oop_cons_t)hcl_instantiate(hcl, hcl->c_cons, HCL_NULL, 0); + hcl_popvolats (hcl, 2); + if (HCL_UNLIKELY(!v)) + { + const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl); + hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make cons - %js", orgmsg); + } + else + { + v->car = car; + v->cdr = cdr; + } + return (hcl_oop_t)v; +#endif } -hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc) +hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t len) { -/* TODO: use hcl_instantiate() */ +#if 0 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; +#else + hcl_oop_t v; + v = hcl_instantiate(hcl, hcl->c_array, HCL_NULL, 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); + } + return v; +#endif } -hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size) +hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { -/* TODO: use hcl_instantiate() */ +#if 0 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; +#else + hcl_oop_t v; + v = hcl_instantiate(hcl, hcl->c_byte_array, ptr, 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); + } + return v; +#endif } -hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len, int ngc) +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; @@ -378,10 +419,21 @@ hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow } 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); + } + return (hcl_oop_t)v; +#endif } -hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int ngc) +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. @@ -409,10 +461,33 @@ hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, } 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); + } + else + { + hcl_oow_t i; + hcl_oob_t b; + for (i = 0; i < len; i++) + { + b = ptr[i] & 0xFF; + HCL_OBJ_SET_BYTE_VAL(v, i, b); + } + } + + return (hcl_oop_t)v; +#endif } -hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int ngc) +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); @@ -426,6 +501,16 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int 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); + } + return v; +#endif } hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale) @@ -656,13 +741,11 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr, if (HCL_LIKELY(oop)) { - #if 0 hcl_ooi_t spec; - #endif HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class); - #if 0 /* TODO: revive this part */ spec = HCL_OOP_TO_SMOOI(_class->spec); if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1); + #if 0 /* TODO: revive this part */ if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1); #endif HCL_OBJ_SET_FLAGS_BRAND(oop, HCL_OOP_TO_SMOOI(_class->ibrand)); @@ -727,13 +810,11 @@ hcl_oop_t hcl_instantiatewithtrailer (hcl_t* hcl, hcl_oop_class_t _class, hcl_oo if (HCL_LIKELY(oop)) { - #if 0 hcl_ooi_t spec; - #endif HCL_OBJ_SET_CLASS (oop, (hcl_oop_t)_class); - #if 0 /* TODO: revive this part */ spec = HCL_OOP_TO_SMOOI(_class->spec); if (HCL_CLASS_SPEC_IS_IMMUTABLE(spec)) HCL_OBJ_SET_FLAGS_RDONLY (oop, 1); + #if 0 /* TODO: revive this part */ /* the object with trailer is to to uncopyable in hcl_allocoopobjwithtrailer() so no need to check/set it again here if (HCL_CLASS_SPEC_IS_UNCOPYABLE(spec)) HCL_OBJ_SET_FLAGS_UNCOPYABLE (oop, 1); */ diff --git a/lib/prim.c b/lib/prim.c index b8a99ca..f17cc3d 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -204,7 +204,7 @@ static hcl_pfrc_t pf_sprintf (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) else { hcl_oop_t str; - str = hcl_makestring(hcl, hcl->sprintf.xbuf.ptr, hcl->sprintf.xbuf.len, 0); + str = hcl_makestring(hcl, hcl->sprintf.xbuf.ptr, hcl->sprintf.xbuf.len); if (!str) return HCL_PF_FAILURE; HCL_STACK_SETRET (hcl, nargs, str); @@ -487,7 +487,7 @@ static hcl_pfrc_t pf_gets (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) } else { - v = hcl_makestring(hcl, ptr, len, 0); + v = hcl_makestring(hcl, ptr, len); if (ptr != buf) hcl_freemem(hcl, ptr); if (HCL_UNLIKELY(!v)) return HCL_PF_FAILURE; } diff --git a/lib/sym.c b/lib/sym.c index ef32510..38045de 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -59,7 +59,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) } hcl_pushvolat (hcl, (hcl_oop_t*)&oldbuc); - newbuc = (hcl_oop_oop_t)hcl_makearray(hcl, newsz, 0); + newbuc = (hcl_oop_oop_t)hcl_makearray(hcl, newsz); hcl_popvolat (hcl); if (!newbuc) return HCL_NULL; diff --git a/lib/xchg.c b/lib/xchg.c index 4af95b1..00b6249 100644 --- a/lib/xchg.c +++ b/lib/xchg.c @@ -368,7 +368,7 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void } nbytes = hcl_leoowtoh(w); - ns = hcl_makestring(hcl, HCL_NULL, nchars, 0); + ns = hcl_makestring(hcl, HCL_NULL, nchars); if (HCL_UNLIKELY(!ns)) goto oops; ucspos = 0; diff --git a/mod/core.c b/mod/core.c index 3706f65..e20af76 100644 --- a/mod/core.c +++ b/mod/core.c @@ -181,6 +181,12 @@ static hcl_pfrc_t __basic_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs, i return HCL_PF_FAILURE; } + if (HCL_OBJ_GET_FLAGS_RDONLY(obj)) + { + hcl_seterrbfmt (hcl, HCL_EINVAL, "receiver immutable - %O", obj); + return HCL_PF_FAILURE; + } + if (hcl_inttooow_noseterr(hcl, pos, &index) <= 0) { /* negative integer or not integer */ @@ -189,9 +195,10 @@ static hcl_pfrc_t __basic_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs, i } _class = (hcl_oop_class_t)HCL_CLASSOF(hcl, obj); - if (span_fixed) + if (span_fixed) /* include the fixed part in positioning */ { hcl_oow_t size; + size = HCL_OBJ_GET_SIZE(obj); if (index >= size) { diff --git a/t/Makefile.am b/t/Makefile.am index e3f6296..e2ab1c5 100644 --- a/t/Makefile.am +++ b/t/Makefile.am @@ -32,7 +32,7 @@ TESTS = $(check_PROGRAMS) $(check_SCRIPTS) $(check_ERRORS) TEST_EXTENSIONS = .hcl .err -HCLBIN = ../bin/hcl +HCLBIN = $(top_builddir)/bin/hcl HCL_LOG_COMPILER = $(SHELL) $(abs_srcdir)/run.sh $(HCLBIN) --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 AM_HCL_LOG_FLAGS = diff --git a/t/Makefile.in b/t/Makefile.in index 765eae4..d184e59 100644 --- a/t/Makefile.in +++ b/t/Makefile.in @@ -497,7 +497,7 @@ check_ERRORS = \ EXTRA_DIST = $(check_SCRIPTS) $(check_ERRORS) TEST_EXTENSIONS = .hcl .err -HCLBIN = ../bin/hcl +HCLBIN = $(top_builddir)/bin/hcl HCL_LOG_COMPILER = $(SHELL) $(abs_srcdir)/run.sh $(HCLBIN) --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0 AM_HCL_LOG_FLAGS = ERR_LOG_COMPILER = $(SHELL) $(abs_srcdir)/err.sh $(HCLBIN) --modlibdirs="@abs_top_builddir@/mod:@abs_top_builddir@/mod/.libs" --heapsize=0