updated code to correct the RDONLY bit behavior
All checks were successful
continuous-integration/drone/push Build is passing

This commit is contained in:
hyung-hwan 2024-09-08 15:52:32 +09:00
parent 4a6da0b386
commit b39bfaa181
14 changed files with 160 additions and 74 deletions

View File

@ -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

View File

@ -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);

View File

@ -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;

View File

@ -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;

View File

@ -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 */

View File

@ -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

View File

@ -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 (

123
lib/obj.c
View File

@ -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);
*/

View File

@ -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;
}

View File

@ -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;

View File

@ -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;

View File

@ -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)
{

View File

@ -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 =

View File

@ -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