updated code to correct the RDONLY bit behavior
All checks were successful
continuous-integration/drone/push Build is passing
All checks were successful
continuous-integration/drone/push Build is passing
This commit is contained in:
parent
4a6da0b386
commit
b39bfaa181
19
README.md
19
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
|
||||
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
10
lib/exec.c
10
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 */
|
||||
|
6
lib/gc.c
6
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
|
||||
|
||||
|
39
lib/hcl.h
39
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 (
|
||||
|
123
lib/obj.c
123
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);
|
||||
}
|
||||
}
|
||||
|
||||
hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int ngc)
|
||||
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);
|
||||
@ -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);
|
||||
*/
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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;
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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)
|
||||
{
|
||||
|
@ -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 =
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user