summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--args.h4
-rw-r--r--arith.c23
-rw-r--r--buf.c85
-rw-r--r--chksum.c57
-rw-r--r--combi.c30
-rw-r--r--debug.c9
-rw-r--r--eval.c28
-rw-r--r--ffi.c158
-rw-r--r--filter.c23
-rw-r--r--ftw.c9
-rw-r--r--gc.c6
-rw-r--r--glob.c3
-rw-r--r--hash.c46
-rw-r--r--itypes.c28
-rw-r--r--lib.c345
-rw-r--r--lib.h7
-rw-r--r--match.c55
-rw-r--r--parser.c36
-rw-r--r--parser.l5
-rw-r--r--rand.c14
-rw-r--r--regex.c8
-rw-r--r--signal.c27
-rw-r--r--socket.c131
-rw-r--r--stream.c129
-rw-r--r--struct.c14
-rw-r--r--strudel.c6
-rw-r--r--sysif.c158
-rw-r--r--sysif.h2
-rw-r--r--syslog.c11
-rw-r--r--termios.c80
-rw-r--r--txr.c6
-rw-r--r--unwind.c3
-rw-r--r--vm.c8
33 files changed, 881 insertions, 673 deletions
diff --git a/args.h b/args.h
index 54c00bf2..43af4733 100644
--- a/args.h
+++ b/args.h
@@ -185,9 +185,9 @@ INLINE val args_get_nozap(struct args *args, cnum *arg_index, val *list)
return pop(list);
}
-INLINE cnum args_count(struct args *args)
+INLINE cnum args_count(struct args *args, val self)
{
- return args->fill + c_num(length_list(args->list));
+ return args->fill + c_num(length_list(args->list), self);
}
val args_get_checked(val name, struct args *args, cnum *arg_index);
diff --git a/arith.c b/arith.c
index aad37344..1e212f43 100644
--- a/arith.c
+++ b/arith.c
@@ -198,7 +198,7 @@ val normalize(val bignum)
}
}
-ucnum c_unum(val num)
+ucnum c_unum(val num, val self)
{
switch (type(num)) {
case CHR: case NUM:
@@ -216,10 +216,10 @@ ucnum c_unum(val num)
}
/* fallthrough */
range:
- uw_throwf(error_s, lit("~s is out of allowed range [0, ~a]"),
- num, unum(UINT_PTR_MAX), nao);
+ uw_throwf(error_s, lit("~a: ~s is out of allowed range [0, ~a]"),
+ self, num, unum(UINT_PTR_MAX), nao);
default:
- type_mismatch(lit("~s is not an integer"), num, nao);
+ uw_throwf(type_error_s, lit("~a: ~s is not an integer"), self, num, nao);
}
}
@@ -3782,6 +3782,8 @@ val tofloat(val obj)
val toint(val obj, val base)
{
+ val self = lit("toint");
+
switch (tag(obj)) {
case TAG_NUM:
return obj;
@@ -3796,7 +3798,7 @@ val toint(val obj, val base)
if (iswalpha(ch)) {
cnum n = 10 + towupper(ch) - 'A';
- cnum b = c_num(default_arg(base, num_fast(10)));
+ cnum b = c_num(default_arg(base, num_fast(10)), self);
if (n < b)
return num(n);
@@ -4041,7 +4043,7 @@ val num(cnum n)
return (n >= NUM_MIN && n <= NUM_MAX) ? num_fast(n) : bignum(n);
}
-cnum c_num(val n)
+cnum c_num(val n, val self)
{
switch (type(n)) {
case CHR: case NUM:
@@ -4052,10 +4054,10 @@ cnum c_num(val n)
mp_get_intptr(mp(n), &out);
return out;
}
- uw_throwf(error_s, lit("~s is out of allowed range [~s, ~s]"),
- n, num(INT_PTR_MIN), num(INT_PTR_MAX), nao);
+ uw_throwf(error_s, lit("~a: ~s is out of allowed range [~s, ~s]"),
+ self, n, num(INT_PTR_MIN), num(INT_PTR_MAX), nao);
default:
- type_mismatch(lit("~s is not an integer"), n, nao);
+ uw_throwf(type_error_s, lit("~a: ~s is not an integer"), self, n, nao);
}
}
@@ -4446,7 +4448,8 @@ static val rexpt(val right, val left)
val exptv(struct args *nlist)
{
- cnum nargs = args_count(nlist);
+ val self = lit("exptv");
+ cnum nargs = args_count(nlist, self);
args_decl(rnlist, max(ARGS_MIN, nargs));
args_copy_reverse(rnlist, nlist, nargs);
return nary_op(expt_s, rexpt, unary_num, rnlist, one);
diff --git a/buf.c b/buf.c
index 3cd050ef..9a9d8ff6 100644
--- a/buf.c
+++ b/buf.c
@@ -47,7 +47,7 @@
static cnum buf_check_len(val len, val self)
{
- cnum l = c_num(len);
+ cnum l = c_num(len, self);
if (l < 0)
uw_throwf(error_s, lit("~a: negative length ~s specified"),
self, len, nao);
@@ -56,7 +56,7 @@ static cnum buf_check_len(val len, val self)
static cnum buf_check_alloc_size(val alloc_size, cnum len, val self)
{
- cnum ah = c_num(alloc_size);
+ cnum ah = c_num(alloc_size, self);
if (ah < len)
uw_throwf(error_s, lit("~a: alloc size size ~s lower than length"),
self, alloc_size, nao);
@@ -65,9 +65,9 @@ static cnum buf_check_alloc_size(val alloc_size, cnum len, val self)
static cnum buf_check_index(struct buf *b, val index, val self)
{
- cnum ix = c_num(index);
+ cnum ix = c_num(index, self);
if (ix < 0)
- ix = c_num(plus(b->len, index));
+ ix = c_num(plus(b->len, index), self);
if (ix < 0)
uw_throwf(error_s, lit("~a: negative byte index ~s specified"),
self, index, nao);
@@ -119,10 +119,11 @@ val make_borrowed_buf(val len, mem_t *data)
val make_duplicate_buf(val len, mem_t *data)
{
+ val self = lit("make-duplicate-buf");
val obj = make_obj();
obj->b.type = BUF;
- obj->b.data = chk_copy_obj(data, c_num(len));
+ obj->b.data = chk_copy_obj(data, c_num(len, self));
obj->b.len = len;
obj->b.size = len;
@@ -154,13 +155,14 @@ val copy_buf(val buf)
static void buf_shrink(struct buf *b)
{
+ val self = lit("buf-trim");
val len = b->len;
if (len == zero)
len = succ(len); /* avoid reallocing to zero length; i.e. freeing */
if (len != b->size) {
- b->data = chk_realloc(b->data, c_unum(len));
+ b->data = chk_realloc(b->data, c_unum(len, self));
b->size = b->len;
}
}
@@ -181,8 +183,8 @@ static val buf_do_set_len(val buf, struct buf *b, val newlen,
val init_val, val self)
{
val oldlen = b->len;
- cnum olen = c_num(oldlen), len = c_num(newlen);
- cnum oldsize = c_num(b->size), size = oldsize;
+ cnum olen = c_num(oldlen, self), len = c_num(newlen, self);
+ cnum oldsize = c_num(b->size, self), size = oldsize;
cnum iv = c_u8(default_arg(init_val, zero), self);
if (!b->size)
@@ -242,6 +244,7 @@ mem_t *buf_get(val buf, val self)
val sub_buf(val buf, val from, val to)
{
+ val self = lit("sub-buf");
struct buf *b = buf_handle(buf, lit("sub"));
val len = b->len;
@@ -268,7 +271,7 @@ val sub_buf(val buf, val from, val to)
} else if (from == 0 && to == len) {
return buf;
} else {
- return make_duplicate_buf(minus(to, from), b->data + c_num(from));
+ return make_duplicate_buf(minus(to, from), b->data + c_num(from, self));
}
}
@@ -319,10 +322,10 @@ val replace_buf(val buf, val items, val from, val to)
if (gt(len_rep, len_it)) {
val len_diff = minus(len_rep, len_it);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
- memmove(buf->b.data + t - c_num(len_diff),
+ memmove(buf->b.data + t - c_num(len_diff, self),
buf->b.data + t,
l - t);
@@ -330,12 +333,12 @@ val replace_buf(val buf, val items, val from, val to)
to = plus(from, len_it);
} else if (lt(len_rep, len_it)) {
val len_diff = minus(len_it, len_rep);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
buf_set_length(buf, plus(len, len_diff), zero);
- memmove(buf->b.data + t + c_num(len_diff),
+ memmove(buf->b.data + t + c_num(len_diff, self),
buf->b.data + t,
l - t);
to = plus(from, len_it);
@@ -344,12 +347,12 @@ val replace_buf(val buf, val items, val from, val to)
if (zerop(len_it))
return buf;
if (bufp(items)) {
- memmove(buf->b.data + c_num(from), items->b.data, c_num(len_it));
+ memmove(buf->b.data + c_num(from, self), items->b.data, c_num(len_it, self));
} else {
seq_iter_t item_iter;
seq_iter_init(self, &item_iter, items);
- cnum f = c_num(from);
- cnum t = c_num(to);
+ cnum f = c_num(from, self);
+ cnum t = c_num(to, self);
for (; f != t; f++) {
val item = seq_geti(&item_iter);
@@ -392,7 +395,7 @@ val buf_put_buf(val dbuf, val sbuf, val pos)
{
val self = lit("buf-put-buf");
struct buf *sb = buf_handle(sbuf, self);
- buf_move_bytes(dbuf, pos, sb->data, c_num(sb->len), self);
+ buf_move_bytes(dbuf, pos, sb->data, c_num(sb->len, self), self);
return sbuf;
}
@@ -413,7 +416,7 @@ val buf_put_i8(val buf, val pos, val num)
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
i8_t v = c_i8(num, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
buf_do_set_len(buf, b, succ(pos), nil, self);
b->data[p] = v;
return num;
@@ -425,7 +428,7 @@ val buf_put_u8(val buf, val pos, val num)
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
cnum v = c_u8(num, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
buf_do_set_len(buf, b, succ(pos), nil, self);
b->data[p] = v;
return num;
@@ -492,7 +495,7 @@ val buf_put_char(val buf, val pos, val num)
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
char v = c_char(num, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
buf_do_set_len(buf, b, succ(pos), nil, self);
b->data[p] = v;
return num;
@@ -504,7 +507,7 @@ val buf_put_uchar(val buf, val pos, val num)
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
unsigned char v = c_uchar(num, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
buf_do_set_len(buf, b, succ(pos), nil, self);
b->data[p] = v;
return num;
@@ -593,7 +596,7 @@ void buf_get_bytes(val buf, val pos, mem_t *ptr, cnum size, val self)
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
cnum e = p + size;
- cnum l = c_num(b->len);
+ cnum l = c_num(b->len, self);
if (e > l || e < 0)
uw_throwf(error_s, lit("~a: attempted read past buffer end"), self, nao);
@@ -607,7 +610,7 @@ val buf_get_i8(val buf, val pos)
val self = lit("buf-get-i8");
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
uw_throwf(error_s, lit("~a: attempted read past buffer end"), self, nao);
return num_fast(convert(i8_t, b->data[p]));
}
@@ -617,7 +620,7 @@ val buf_get_u8(val buf, val pos)
val self = lit("buf-get-u8");
struct buf *b = buf_handle(buf, self);
cnum p = buf_check_index(b, pos, self);
- if (p >= c_num(b->len))
+ if (p >= c_num(b->len, self))
uw_throwf(error_s, lit("~a: attempted read past buffer end"), self, nao);
return num_fast(convert(u8_t, b->data[p]));
}
@@ -787,9 +790,10 @@ val buf_get_cptr(val buf, val pos)
val buf_print(val buf, val stream_in)
{
+ val self = lit("buf-print");
val stream = default_arg(stream_in, std_output);
- struct buf *b = buf_handle(buf, lit("buf-print"));
- cnum len = c_num(b->len), count = 0;
+ struct buf *b = buf_handle(buf, self);
+ cnum len = c_num(b->len, self), count = 0;
mem_t *data = b->data;
val save_mode = test_neq_set_indent_mode(stream, num_fast(indent_foff),
num_fast(indent_data));
@@ -818,9 +822,10 @@ val buf_print(val buf, val stream_in)
val buf_pprint(val buf, val stream_in)
{
+ val self = lit("buf-pprint");
val stream = default_arg(stream_in, std_output);
- struct buf *b = buf_handle(buf, lit("buf-print"));
- cnum len = c_num(b->len);
+ struct buf *b = buf_handle(buf, self);
+ cnum len = c_num(b->len, self);
mem_t *data = b->data;
while (len-- > 0)
@@ -889,7 +894,7 @@ static int buf_strm_get_byte_callback(mem_t *ctx)
struct buf *b = buf_handle(s->buf, self);
cnum p = buf_check_index(b, s->pos, self);
s->pos = num(p + 1);
- return (p >= c_num(b->len)) ? EOF : b->data[p];
+ return (p >= c_num(b->len, self)) ? EOF : b->data[p];
}
static val buf_strm_get_char(val stream)
@@ -933,7 +938,7 @@ static val buf_strm_unget_byte(val stream, int byte)
val self = lit("unget-byte");
struct buf_strm *s = coerce(struct buf_strm *, stream->co.handle);
struct buf *b = buf_handle(s->buf, self);
- cnum p = c_num(s->pos);
+ cnum p = c_num(s->pos, self);
if (p <= 0) {
uw_throwf(file_error_s,
@@ -1090,7 +1095,7 @@ void buf_swap32(val buf)
{
val self = lit("buf-swap32");
struct buf *b = buf_handle(buf, self);
- mem_t *data = b->data, *end = data + c_num(b->len);
+ mem_t *data = b->data, *end = data + c_num(b->len, self);
for (; data + 3 < end; data += 4) {
u32_t sw32 = *coerce(u32_t *, data);
@@ -1113,7 +1118,7 @@ static val str_buf(val buf, val null_term)
val self = lit("str-buf");
struct buf *b = buf_handle(buf, self);
val nt = default_null_arg(null_term);
- size_t blen = c_unum(b->len);
+ size_t blen = c_unum(b->len, self);
size_t len = (nt && blen > 0 && !b->data[blen-1]) ? blen - 1 : blen;
wchar_t *str = utf8_dup_from_buf(coerce(const char *, b->data), len);
return string_own(str);
@@ -1125,7 +1130,7 @@ static val buf_int(val num)
switch (type(num)) {
case NUM: case CHR:
- num = bignum(c_num(num));
+ num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
{
@@ -1134,10 +1139,10 @@ static val buf_int(val num)
val bytes = ash(plus(bits, num_fast(7)), num_fast(-3));
val bitsround = ash(bytes, num_fast(3));
val un = logtrunc(num, bitsround);
- val ube = if3(bignump(un), un, bignum(c_num(un)));
+ val ube = if3(bignump(un), un, bignum(c_num(un, self)));
mp_int *m = mp(ube);
size_t numsize = mp_unsigned_bin_size(m);
- size_t bufsize = c_unum(bytes);
+ size_t bufsize = c_unum(bytes, self);
mem_t *data = chk_malloc(bufsize);
data[0] = 0;
mp_to_unsigned_bin(m, data + (bufsize - numsize));
@@ -1155,7 +1160,7 @@ static val buf_uint(val num)
switch (type(num)) {
case NUM: case CHR:
- num = bignum(c_num(num));
+ num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
{
@@ -1179,7 +1184,7 @@ static val int_buf(val buf)
{
val self = lit("int-buf");
struct buf *b = buf_handle(buf, self);
- ucnum size = c_unum(b->size);
+ ucnum size = c_unum(b->size, self);
ucnum bits = size * 8;
val ubn = make_bignum();
mp_err mpe = mp_read_unsigned_bin(mp(ubn), b->data, size);
@@ -1192,7 +1197,7 @@ static val uint_buf(val buf)
{
val self = lit("int-buf");
struct buf *b = buf_handle(buf, self);
- ucnum size = c_unum(b->size);
+ ucnum size = c_unum(b->size, self);
val ubn = make_bignum();
mp_err mpe = mp_read_unsigned_bin(mp(ubn), b->data, size);
if (mpe != MP_OKAY)
diff --git a/chksum.c b/chksum.c
index 1942c0b4..d4f3c4d2 100644
--- a/chksum.c
+++ b/chksum.c
@@ -47,7 +47,8 @@
static val sha256_ctx_s, md5_ctx_s;
-static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash)
+static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash,
+ val self)
{
SHA256_t s256;
val buf = iobuf_get();
@@ -57,7 +58,7 @@ static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash)
if (null_or_missing_p(nbytes)) {
for (;;) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (!rd)
break;
@@ -67,7 +68,7 @@ static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash)
} else {
while (ge(nbytes, bfsz)) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (zerop(read))
break;
@@ -80,7 +81,7 @@ static void sha256_stream_impl(val stream, val nbytes, unsigned char *hash)
{
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (rd)
SHA256_update(&s256, buf->b.data, rd);
}
@@ -95,7 +96,7 @@ static val chksum_ensure_buf(val self, val buf_in,
val hash_name)
{
if (null_or_missing_p(buf_in)) {
- *phash = chk_malloc(c_unum(len));
+ *phash = chk_malloc(c_unum(len, self));
return make_borrowed_buf(len, *phash);
} else {
*phash = buf_get(buf_in, self);
@@ -112,7 +113,7 @@ val sha256_stream(val stream, val nbytes, val buf_in)
unsigned char *hash;
val buf = chksum_ensure_buf(self, buf_in, num_fast(SHA256_DIGEST_LENGTH),
&hash, lit("SHA-256"));
- sha256_stream_impl(stream, nbytes, hash);
+ sha256_stream_impl(stream, nbytes, hash, self);
return buf;
}
@@ -128,11 +129,11 @@ static void sha256_szmax_upd(SHA256_t *ps256, mem_t *data, ucnum len)
SHA256_update(ps256, data, len);
}
-static void sha256_buf(val buf, unsigned char *hash)
+static void sha256_buf(val buf, unsigned char *hash, val self)
{
SHA256_t s256;
SHA256_init(&s256);
- sha256_szmax_upd(&s256, buf->b.data, c_unum(buf->b.len));
+ sha256_szmax_upd(&s256, buf->b.data, c_unum(buf->b.len, self));
SHA256_final(&s256, hash);
}
@@ -160,7 +161,7 @@ val sha256(val obj, val buf_in)
sha256_str(obj, hash);
return buf;
case BUF:
- sha256_buf(obj, hash);
+ sha256_buf(obj, hash, self);
return buf;
default:
uw_throwf(error_s, lit("~a: cannot hash ~s, only buffer and strings"),
@@ -204,14 +205,14 @@ val sha256_hash(val ctx, val obj)
}
break;
case BUF:
- sha256_szmax_upd(ps256, obj->b.data, c_unum(obj->b.len));
+ sha256_szmax_upd(ps256, obj->b.data, c_unum(obj->b.len, self));
break;
case CHR:
utf8_encode(c_chr(obj), sha256_utf8_byte_callback, coerce(mem_t *, ps256));
break;
case NUM:
{
- cnum n = c_num(obj);
+ cnum n = c_num(obj, self);
unsigned char uc = n;
if (n < 0 || n > 255)
uw_throwf(error_s, lit("~a: byte value ~s out of range"),
@@ -242,6 +243,7 @@ val sha256_end(val ctx, val buf_in)
val crc32_stream(val stream, val nbytes)
{
+ val self = lit("crc32-stream");
u32_t crc = 0;
val buf = iobuf_get();
val bfsz = length_buf(buf);
@@ -249,7 +251,7 @@ val crc32_stream(val stream, val nbytes)
if (null_or_missing_p(nbytes)) {
for (;;) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (!rd)
break;
@@ -259,7 +261,7 @@ val crc32_stream(val stream, val nbytes)
} else {
while (ge(nbytes, bfsz)) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (zerop(read))
break;
@@ -272,7 +274,7 @@ val crc32_stream(val stream, val nbytes)
{
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (rd)
crc = crc32_cont(buf->b.data, rd, crc);
}
@@ -282,9 +284,9 @@ val crc32_stream(val stream, val nbytes)
return unum(crc);
}
-static val crc32_buf(val buf)
+static val crc32_buf(val buf, val self)
{
- ucnum len = c_unum(buf->b.len);
+ ucnum len = c_unum(buf->b.len, self);
mem_t *data = buf->b.data;
const size_t szmax = convert(size_t, -1) / 4 + 1;
u32_t crc = 0;
@@ -318,14 +320,15 @@ val crc32(val obj)
case LIT:
return crc32_str(obj);
case BUF:
- return crc32_buf(obj);
+ return crc32_buf(obj, self);
default:
uw_throwf(error_s, lit("~a: cannot hash ~s, only buffer and strings"),
self, obj, nao);
}
}
-static void md5_stream_impl(val stream, val nbytes, unsigned char *hash)
+static void md5_stream_impl(val stream, val nbytes, unsigned char *hash,
+ val self)
{
MD5_t md5;
val buf = iobuf_get();
@@ -335,7 +338,7 @@ static void md5_stream_impl(val stream, val nbytes, unsigned char *hash)
if (null_or_missing_p(nbytes)) {
for (;;) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (!rd)
break;
@@ -345,7 +348,7 @@ static void md5_stream_impl(val stream, val nbytes, unsigned char *hash)
} else {
while (ge(nbytes, bfsz)) {
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (zerop(read))
break;
@@ -358,7 +361,7 @@ static void md5_stream_impl(val stream, val nbytes, unsigned char *hash)
{
val read = fill_buf(buf, zero, stream);
- cnum rd = c_num(read);
+ cnum rd = c_num(read, self);
if (rd)
MD5_update(&md5, buf->b.data, rd);
}
@@ -374,7 +377,7 @@ val md5_stream(val stream, val nbytes, val buf_in)
unsigned char *hash;
val buf = chksum_ensure_buf(self, buf_in, num_fast(MD5_DIGEST_LENGTH),
&hash, lit("MD5"));
- md5_stream_impl(stream, nbytes, hash);
+ md5_stream_impl(stream, nbytes, hash, self);
return buf;
}
@@ -390,11 +393,11 @@ static void md5_szmax_upd(MD5_t *pmd5, mem_t *data, ucnum len)
MD5_update(pmd5, data, len);
}
-static void md5_buf(val buf, unsigned char *hash)
+static void md5_buf(val buf, unsigned char *hash, val self)
{
MD5_t md5;
MD5_init(&md5);
- md5_szmax_upd(&md5, buf->b.data, c_unum(buf->b.len));
+ md5_szmax_upd(&md5, buf->b.data, c_unum(buf->b.len, self));
MD5_final(&md5, hash);
}
@@ -422,7 +425,7 @@ val md5(val obj, val buf_in)
md5_str(obj, hash);
return buf;
case BUF:
- md5_buf(obj, hash);
+ md5_buf(obj, hash, self);
return buf;
default:
uw_throwf(error_s, lit("~a: cannot hash ~s, only buffer and strings"),
@@ -466,14 +469,14 @@ val md5_hash(val ctx, val obj)
}
break;
case BUF:
- md5_szmax_upd(pmd5, obj->b.data, c_unum(obj->b.len));
+ md5_szmax_upd(pmd5, obj->b.data, c_unum(obj->b.len, self));
break;
case CHR:
utf8_encode(c_chr(obj), md5_utf8_byte_callback, coerce(mem_t *, pmd5));
break;
case NUM:
{
- cnum n = c_num(obj);
+ cnum n = c_num(obj, self);
unsigned char uc = n;
if (n < 0 || n > 255)
uw_throwf(error_s, lit("~a: byte value ~s out of range"),
diff --git a/combi.c b/combi.c
index 3795fc76..60655d3d 100644
--- a/combi.c
+++ b/combi.c
@@ -38,14 +38,15 @@
static val perm_while_fun(val state)
{
+ val self = lit("perm");
val p = vecref(state, zero);
- cnum k = c_num(vecref(state, one));
+ cnum k = c_num(vecref(state, one), self);
val c = vecref(state, two);
- cnum n = c_num(length(p));
+ cnum n = c_num(length(p), self);
cnum i, j;
for (i = k - 1, j = n - k + 1; i >= 0; i--, j++) {
- cnum ci = c_num(c->v.vec[i]) + 1;
+ cnum ci = c_num(c->v.vec[i], self) + 1;
if (ci >= j) {
if (i == 0)
@@ -78,16 +79,17 @@ static cnum perm_index(cnum n, val b)
static void perm_gen_fun_common(val state, val out,
void (*fill)(val out, cnum i, val v))
{
+ val self = lit("perm");
val p = vecref(state, zero);
val kk = vecref(state, one);
val c = vecref(state, two);
val nn = length(p);
val b = vector(nn, nil);
- cnum k = c_num(kk);
+ cnum k = c_num(kk, self);
cnum i;
for (i = 0; i < k; i++) {
- cnum ci = c_num(c->v.vec[i]);
+ cnum ci = c_num(c->v.vec[i], self);
cnum j = perm_index(ci, b);
fill(out, i, p->v.vec[j]);
b->v.vec[j] = t;
@@ -184,10 +186,11 @@ static void perm_str_gen_fill(val out, cnum i, val v)
static val perm_str_gen_fun(val state)
{
+ val self = lit("perm");
val kk = vecref(state, one);
val out = mkustring(kk);
perm_gen_fun_common(state, out, perm_str_gen_fill);
- out->st.str[c_num(kk)] = 0;
+ out->st.str[c_num(kk, self)] = 0;
return out;
}
@@ -243,10 +246,11 @@ static val rperm_while_fun(val env)
static val rperm_gen_fun(val env)
{
+ val self = lit("rperm");
cons_bind (list, vec, env);
list_collect_decl(out, ptail);
cnum i;
- cnum len = c_num(length_vec(vec));
+ cnum len = c_num(length_vec(vec), self);
for (i = 0; i < len; i++)
ptail = list_collect(ptail, car(vec->v.vec[i]));
@@ -392,8 +396,9 @@ static val comb_list(val list, val k)
static val comb_vec_gen_fun(val state)
{
+ val self = lit("comb");
val nn = length_list(state);
- cnum i, n = c_num(nn);
+ cnum i, n = c_num(nn, self);
val iter, out = vector(nn, nil);
for (iter = state, i = n - 1; i >= 0; iter = cdr(iter), i--)
@@ -412,8 +417,9 @@ static val comb_vec(val vec, val k)
static val comb_str_gen_fun(val state)
{
+ val self = lit("comb");
val nn = length_list(state);
- cnum i, n = c_num(nn);
+ cnum i, n = c_num(nn, self);
val iter, out = mkustring(nn);
out->st.str[n] = 0;
@@ -549,8 +555,9 @@ static val rcomb_list(val list, val k)
static val rcomb_vec_gen_fun(val state)
{
+ val self = lit("rcomb");
val nn = length_list(state);
- cnum i, n = c_num(nn);
+ cnum i, n = c_num(nn, self);
val iter, out = vector(nn, nil);
for (iter = state, i = n - 1; i >= 0; iter = cdr(iter), i--)
@@ -569,8 +576,9 @@ static val rcomb_vec(val vec, val k)
static val rcomb_str_gen_fun(val state)
{
+ val self = lit("rcomb");
val nn = length_list(state);
- cnum i, n = c_num(nn);
+ cnum i, n = c_num(nn, self);
val iter, out = mkustring(nn);
out->st.str[n] = 0;
diff --git a/debug.c b/debug.c
index 16ad6f28..92b8640a 100644
--- a/debug.c
+++ b/debug.c
@@ -41,17 +41,20 @@ static val sys_print_backtrace_s;
static val dbg_clear(val mask)
{
- return unum(debug_clear(c_unum(mask)));
+ val self = lit("dbg-clear");
+ return unum(debug_clear(c_unum(mask, self)));
}
static val dbg_set(val mask)
{
- return unum(debug_set(c_unum(mask)));
+ val self = lit("dbg-set");
+ return unum(debug_set(c_unum(mask, self)));
}
static val dbg_restore(val state)
{
- debug_restore(c_unum(state));
+ val self = lit("dbg-restore");
+ debug_restore(c_unum(state, self));
return nil;
}
diff --git a/eval.c b/eval.c
index 1d1b6cf0..f0a1c90d 100644
--- a/eval.c
+++ b/eval.c
@@ -1529,6 +1529,7 @@ val eval_intrinsic_noerr(val form, val env, val *error_p)
static val do_eval(val form, val env, val ctx,
val (*lookup)(val env, val sym))
{
+ val self = lit("eval");
uw_frame_t *ev = 0;
val ret = nil;
@@ -1570,7 +1571,7 @@ static val do_eval(val form, val env, val ctx,
abort();
} else {
val arglist = rest(form);
- cnum alen = if3(consp(arglist), c_num(length(arglist)), 0);
+ cnum alen = if3(consp(arglist), c_num(length(arglist), self), 0);
cnum argc = max(alen, ARGS_MIN);
val lfe_save = last_form_evaled;
args_decl(args, argc);
@@ -2642,7 +2643,7 @@ static val op_dwim(val form, val env)
{
val argexps = rest(form);
val objexpr = pop(&argexps);
- cnum alen = if3(consp(argexps), c_num(length(argexps)), 0);
+ cnum alen = if3(consp(argexps), c_num(length(argexps), car(form)), 0);
cnum argc = max(alen, ARGS_MIN);
args_decl(args, argc);
@@ -3889,7 +3890,7 @@ static val me_op(val form, val menv)
gethash(op_table, car(body_trans)));
uw_pop_frame(&uw_handler);
- if (c_num(max) > 1024)
+ if (c_num(max, sym) > 1024)
eval_error(form, lit("~a: @~a calls for function with too many arguments"),
sym, max, nao);
@@ -5008,11 +5009,12 @@ static val no_warn_expand(val form, val menv)
static val gather_free_refs(val info_cons, val exc, struct args *args)
{
+ val self = lit("expand-with-free-refs");
(void) exc;
args_normalize_least(args, 2);
- if (args_count(args) == 2) {
+ if (args_count(args, self) == 2) {
val tag = args_at(args, 1);
cons_bind (kind, sym, tag);
@@ -5285,7 +5287,7 @@ static val map_common(val self, val fun, struct args *lists,
} else if (!args_two_more(lists, 0)) {
return map_fn(fun, args_atz(lists, 0));
} else {
- cnum i, idx, argc = args_count(lists);
+ cnum i, idx, argc = args_count(lists, self);
seq_iter_t *iter_array = coerce(seq_iter_t *,
alloca(argc * sizeof *iter_array));
args_decl(args_fun, max(argc, ARGS_MIN));
@@ -5407,7 +5409,7 @@ static val lazy_mappendv(val fun, struct args *lists)
return lazy_appendl(lazy_mapcarv(fun, lists));
}
-static val prod_common(val fun, struct args *lists,
+static val prod_common(val self, val fun, struct args *lists,
loc (*collect_fn)(loc ptail, val obj),
val (*mapv_fn)(val fun, struct args *lists))
{
@@ -5416,7 +5418,7 @@ static val prod_common(val fun, struct args *lists,
} else if (!args_two_more(lists, 0)) {
return mapv_fn(fun, lists);
} else {
- cnum argc = args_count(lists), i;
+ cnum argc = args_count(lists, self), i;
list_collect_decl (out, ptail);
args_decl(args_reset, max(argc, ARGS_MIN));
args_decl(args_work, max(argc, ARGS_MIN));
@@ -5455,12 +5457,12 @@ static val prod_common(val fun, struct args *lists,
val maprodv(val fun, struct args *lists)
{
- return prod_common(fun, lists, list_collect, mapcarv);
+ return prod_common(lit("maprodv"), fun, lists, list_collect, mapcarv);
}
val maprendv(val fun, struct args *lists)
{
- return prod_common(fun, lists, list_collect_append, mappendv);
+ return prod_common(lit("maprendv"), fun, lists, list_collect_append, mappendv);
}
static loc collect_nothing(loc ptail, val obj)
@@ -5471,7 +5473,7 @@ static loc collect_nothing(loc ptail, val obj)
static val maprodo(val fun, struct args *lists)
{
- return prod_common(fun, lists, collect_nothing, mappendv);
+ return prod_common(lit("maprodo"), fun, lists, collect_nothing, mappendv);
}
static val symbol_value(val sym)
@@ -6089,9 +6091,10 @@ static val do_apf(val fun, struct args *args)
static val do_args_apf(val dargs, struct args *args)
{
+ val self = lit("apf");
val fun = dargs->a.car;
struct args *da = dargs->a.args;
- cnum da_nargs = da->fill + c_num(length(da->list));
+ cnum da_nargs = da->fill + c_num(length(da->list), self);
args_decl(args_call, max(args->fill + da_nargs, ARGS_MIN));
args_copy(args_call, da);
args_normalize_exact(args_call, da_nargs);
@@ -6115,9 +6118,10 @@ static val do_ipf(val fun, struct args *args)
static val do_args_ipf(val dargs, struct args *args)
{
+ val self = lit("ipf");
val fun = dargs->a.car;
struct args *da = dargs->a.args;
- cnum da_nargs = da->fill + c_num(length(da->list));
+ cnum da_nargs = da->fill + c_num(length(da->list), self);
args_decl(args_call, max(args->fill + da_nargs, ARGS_MIN));
args_copy(args_call, da);
args_normalize_exact(args_call, da_nargs);
diff --git a/ffi.c b/ffi.c
index 59684b32..282aca78 100644
--- a/ffi.c
+++ b/ffi.c
@@ -203,7 +203,7 @@ struct txr_ffi_type {
val (*get)(struct txr_ffi_type *, mem_t *src, val self);
val (*in)(struct txr_ffi_type *, int copy, mem_t *src, val obj, val self);
void (*out)(struct txr_ffi_type *, int copy, val obj, mem_t *dest, val self);
- void (*release)(struct txr_ffi_type *, val obj, mem_t *dst);
+ void (*release)(struct txr_ffi_type *, val obj, mem_t *dst, val self);
cnum (*dynsize)(struct txr_ffi_type *, val obj, val self);
mem_t *(*alloc)(struct txr_ffi_type *, val obj, val self);
void (*free)(void *);
@@ -430,7 +430,7 @@ static cnum ffi_varray_dynsize(struct txr_ffi_type *tft, val obj, val self)
case conv_none:
default:
{
- cnum len = c_num(length(obj)) + tft->null_term;
+ cnum len = c_num(length(obj), self) + tft->null_term;
val eltype = tft->eltype;
struct txr_ffi_type *etft = ffi_type_struct(eltype);
if (etft->incomplete)
@@ -482,10 +482,12 @@ static val ffi_void_get(struct txr_ffi_type *tft, mem_t *src, val self)
return nil;
}
-static void ffi_simple_release(struct txr_ffi_type *tft, val obj, mem_t *dst)
+static void ffi_simple_release(struct txr_ffi_type *tft, val obj,
+ mem_t *dst, val self)
{
(void) tft;
(void) obj;
+ (void) self;
mem_t **loc = coerce(mem_t **, dst);
free(*loc);
*loc = 0;
@@ -820,7 +822,7 @@ static void ffi_float_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
switch (type(n)) {
case NUM:
case CHR:
- v = c_num(n);
+ v = c_num(n, self);
break;
case BGNUM:
n = int_flo(n);
@@ -859,7 +861,7 @@ static void ffi_double_put(struct txr_ffi_type *tft, val n, mem_t *dst,
switch (type(n)) {
case NUM:
case CHR:
- v = c_num(n);
+ v = c_num(n, self);
break;
case BGNUM:
n = int_flo(n);
@@ -904,7 +906,7 @@ static val ffi_val_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_be_i16_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -929,7 +931,7 @@ static val ffi_be_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_be_u16_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -952,7 +954,7 @@ static val ffi_be_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_le_i16_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -977,7 +979,7 @@ static val ffi_le_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_le_u16_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -1000,7 +1002,7 @@ static val ffi_le_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_be_i32_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -1028,7 +1030,7 @@ static val ffi_be_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_be_u32_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- ucnum v = c_unum(n);
+ ucnum v = c_unum(n, self);
(void) tft;
@@ -1054,7 +1056,7 @@ static val ffi_be_u32_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_le_i32_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
(void) tft;
@@ -1082,7 +1084,7 @@ static val ffi_le_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
static void ffi_le_u32_put(struct txr_ffi_type *tft, val n,
mem_t *dst, val self)
{
- ucnum v = c_unum(n);
+ ucnum v = c_unum(n, self);
(void) tft;
@@ -1400,7 +1402,7 @@ static void ffi_sbit_put(struct txr_ffi_type *tft, val n,
unsigned mask = tft->mask;
unsigned sbmask = mask ^ (mask >> 1);
int shift = tft->shift;
- cnum cn = c_num(n);
+ cnum cn = c_num(n, self);
int in = cn;
unsigned uput = (convert(unsigned, in) << shift) & mask;
@@ -1452,7 +1454,7 @@ static void ffi_ubit_put(struct txr_ffi_type *tft, val n,
{
unsigned mask = tft->mask;
int shift = tft->shift;
- ucnum cn = c_unum(n);
+ ucnum cn = c_unum(n, self);
unsigned un = cn;
unsigned uput = (un << shift) & mask;
@@ -2111,7 +2113,7 @@ static void ffi_buf_d_put(struct txr_ffi_type *tft, val buf, mem_t *dst,
*coerce(const mem_t **, dst) = 0;
} else {
mem_t *b = buf_get(buf, self);
- *coerce(const mem_t **, dst) = chk_copy_obj(b, c_num(length(buf)));
+ *coerce(const mem_t **, dst) = chk_copy_obj(b, c_num(length(buf), self));
}
}
@@ -2291,13 +2293,14 @@ static val ffi_ptr_out_s_in(struct txr_ffi_type *tft, int copy,
return obj;
}
-static void ffi_ptr_in_release(struct txr_ffi_type *tft, val obj, mem_t *dst)
+static void ffi_ptr_in_release(struct txr_ffi_type *tft, val obj,
+ mem_t *dst, val self)
{
struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
mem_t **loc = coerce(mem_t **, dst);
if (tgtft->release != 0 && *loc != 0)
- tgtft->release(tgtft, obj, *loc);
+ tgtft->release(tgtft, obj, *loc, self);
free(*loc);
*loc = 0;
}
@@ -2422,7 +2425,8 @@ static val ffi_struct_get(struct txr_ffi_type *tft, mem_t *src, val self)
return strct;
}
-static void ffi_struct_release(struct txr_ffi_type *tft, val strct, mem_t *dst)
+static void ffi_struct_release(struct txr_ffi_type *tft, val strct,
+ mem_t *dst, val self)
{
cnum i, nmemb = tft->nelem;
struct smemb *memb = tft->memb;
@@ -2437,7 +2441,7 @@ static void ffi_struct_release(struct txr_ffi_type *tft, val strct, mem_t *dst)
if (slsym) {
if (mtft->release != 0) {
val slval = slot(strct, slsym);
- mtft->release(mtft, slval, dst + offs);
+ mtft->release(mtft, slval, dst + offs, self);
}
}
}
@@ -2499,7 +2503,7 @@ static val ffi_zchar_array_get(struct txr_ffi_type *tft, mem_t *src,
static val ffi_wchar_array_get(struct txr_ffi_type *tft, mem_t *src,
- cnum nelem)
+ cnum nelem, val self)
{
if (nelem == 0) {
return null_string;
@@ -2510,7 +2514,7 @@ static val ffi_wchar_array_get(struct txr_ffi_type *tft, mem_t *src,
return string(wchptr);
} else {
val ustr = mkustring(num_fast(nelem));
- return init_str(ustr, wchptr);
+ return init_str(ustr, wchptr, self);
}
}
}
@@ -2607,7 +2611,7 @@ static val ffi_array_in(struct txr_ffi_type *tft, int copy, mem_t *src,
}
case conv_wchar:
{
- val str = ffi_wchar_array_get(tft, src, tft->nelem);
+ val str = ffi_wchar_array_get(tft, src, tft->nelem, self);
return if3(vec, replace(vec, str, zero, t), str);
}
case conv_bchar:
@@ -2649,7 +2653,7 @@ static void ffi_array_put_common(struct txr_ffi_type *tft, val vec, mem_t *dst,
case SEQ_VECLIKE:
{
val v = si.obj;
- cnum lim = min(nelem - nt, c_num(length(si.obj)));
+ cnum lim = min(nelem - nt, c_num(length(si.obj), self));
for (; i < lim; i++) {
val elval = ref(v, num_fast(i));
@@ -2752,7 +2756,7 @@ static val ffi_array_get_common(struct txr_ffi_type *tft, mem_t *src, val self,
case conv_zchar:
return ffi_zchar_array_get(tft, src, nelem);
case conv_wchar:
- return ffi_wchar_array_get(tft, src, nelem);
+ return ffi_wchar_array_get(tft, src, nelem, self);
case conv_bchar:
return ffi_bchar_array_get(tft, src, nelem);
case conv_none:
@@ -2784,7 +2788,7 @@ static val ffi_array_get(struct txr_ffi_type *tft, mem_t *src, val self)
}
static void ffi_array_release_common(struct txr_ffi_type *tft, val vec,
- mem_t *dst, cnum nelem)
+ mem_t *dst, cnum nelem, val self)
{
val eltype = tft->eltype;
ucnum offs = 0;
@@ -2802,15 +2806,16 @@ static void ffi_array_release_common(struct txr_ffi_type *tft, val vec,
for (i = 0; i < znelem; i++) {
if (etft->release != 0) {
val elval = ref(vec, num_fast(i));
- etft->release(etft, elval, dst + offs);
+ etft->release(etft, elval, dst + offs, self);
}
offs += elsize;
}
}
-static void ffi_array_release(struct txr_ffi_type *tft, val vec, mem_t *dst)
+static void ffi_array_release(struct txr_ffi_type *tft, val vec,
+ mem_t *dst, val self)
{
- ffi_array_release_common(tft, vec, dst, tft->nelem);
+ ffi_array_release_common(tft, vec, dst, tft->nelem, self);
}
static void ffi_varray_put(struct txr_ffi_type *tft, val vec, mem_t *dst,
@@ -2860,7 +2865,7 @@ static val ffi_varray_in(struct txr_ffi_type *tft, int copy, mem_t *src,
}
case conv_wchar:
{
- val str = ffi_wchar_array_get(tft, src, nelem);
+ val str = ffi_wchar_array_get(tft, src, nelem, self);
return if3(vec, replace(vec, str, zero, t), str);
}
case conv_bchar:
@@ -2888,7 +2893,7 @@ static val ffi_varray_null_term_in(struct txr_ffi_type *tft, int copy, mem_t *sr
struct txr_ffi_type *etft = ffi_type_struct(eltype);
cnum elsize = etft->size;
cnum offs, i;
- cnum nelem_orig = c_num(length(vec_in));
+ cnum nelem_orig = c_num(length(vec_in), self);
for (i = 0, offs = 0; ; i++) {
mem_t *el = src + offs, *p;
@@ -2949,10 +2954,11 @@ static val ffi_varray_null_term_get(struct txr_ffi_type *tft, mem_t *src,
}
}
-static void ffi_varray_release(struct txr_ffi_type *tft, val vec, mem_t *dst)
+static void ffi_varray_release(struct txr_ffi_type *tft, val vec,
+ mem_t *dst, val self)
{
- cnum nelem = c_num(length(vec)) + tft->null_term;
- ffi_array_release_common(tft, vec, dst, nelem);
+ cnum nelem = c_num(length(vec), self) + tft->null_term;
+ ffi_array_release_common(tft, vec, dst, nelem, self);
}
static val ffi_carray_get(struct txr_ffi_type *tft, mem_t *src, val self)
@@ -3120,7 +3126,7 @@ static val make_ffi_type_pointer(val syntax, val lisp_type,
void (*out)(struct txr_ffi_type *, int copy,
val obj, mem_t *dst, val self),
void (*release)(struct txr_ffi_type *,
- val obj, mem_t *dst),
+ val obj, mem_t *dst, val self),
val tgtype)
{
val self = lit("ffi-type-compile");
@@ -3216,7 +3222,7 @@ static val make_ffi_type_struct(val syntax, val lisp_type,
coerce(ffi_type *, chk_calloc(1, sizeof *ft)));
int flexp = 0;
val slot_exprs = cddr(syntax);
- cnum nmemb = c_num(length(slot_exprs)), i;
+ cnum nmemb = c_num(length(slot_exprs), self), i;
struct smemb *memb = coerce(struct smemb *,
chk_calloc(nmemb, sizeof *memb));
val obj = if3(use_existing,
@@ -3387,7 +3393,7 @@ static val make_ffi_type_union(val syntax, val use_existing, val self)
coerce(ffi_type *, chk_calloc(1, sizeof *ft)));
int flexp = 0;
val slot_exprs = cddr(syntax);
- cnum nmemb = c_num(length(slot_exprs)), i;
+ cnum nmemb = c_num(length(slot_exprs), self), i;
struct smemb *memb = coerce(struct smemb *,
chk_calloc(nmemb, sizeof *memb));
val obj = if3(use_existing,
@@ -3511,7 +3517,7 @@ static val make_ffi_type_array(val syntax, val lisp_type,
struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
chk_calloc(1, sizeof *tft));
ffi_type *ft = coerce(ffi_type *, chk_calloc(1, sizeof *ft));
- cnum nelem = c_num(dim);
+ cnum nelem = c_num(dim, self);
val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops);
struct txr_ffi_type *etft = ffi_type_struct(eltype);
@@ -3636,7 +3642,7 @@ static val make_ffi_type_enum(val syntax, val enums,
self, syntax, n, nao);
}
- cur = c_num(n);
+ cur = c_num(n, self);
if (cur > INT_MAX)
uw_throwf(error_s, lit("~a: ~s member ~s value ~s too large"),
self, syntax, n, nao);
@@ -3870,7 +3876,7 @@ val ffi_type_compile(val syntax)
} else if (sym == buf_s || sym == buf_d_s) {
val size = ffi_eval_expr(cadr(syntax), nil, nil);
val xsyntax = list(sym, size, nao);
- cnum nelem = c_num(size);
+ cnum nelem = c_num(size, self);
val type = make_ffi_type_builtin(xsyntax, buf_s, FFI_KIND_PTR,
sizeof (mem_t *),
alignof (mem_t *),
@@ -3920,7 +3926,7 @@ val ffi_type_compile(val syntax)
0, 0, 0, eltype);
} else if (sym == sbit_s || sym == ubit_s) {
val nbits = ffi_eval_expr(cadr(syntax), nil, nil);
- cnum nb = c_num(nbits);
+ cnum nb = c_num(nbits, self);
val xsyntax = list(sym, nbits, nao);
val type = make_ffi_type_builtin(xsyntax, integer_s,
FFI_KIND_NUM,
@@ -3939,14 +3945,14 @@ val ffi_type_compile(val syntax)
uw_throwf(error_s, lit("~a: invalid bitfield size ~s; "
"must be 0 to ~s"),
self, nbits, num_fast(bits_int), nao);
- tft->nelem = c_num(nbits);
+ tft->nelem = c_num(nbits, self);
tft->bitfield = 1;
return type;
} else if (sym == bit_s && !consp(cddr(syntax))) {
goto toofew;
} else if (sym == bit_s) {
val nbits = ffi_eval_expr(cadr(syntax), nil, nil);
- cnum nb = c_num(nbits);
+ cnum nb = c_num(nbits, self);
val type_syntax = caddr(syntax);
val xsyntax = list(sym, nbits, type_syntax, nao);
val type = ffi_type_compile(type_syntax);
@@ -4007,7 +4013,7 @@ val ffi_type_compile(val syntax)
goto toofew;
} else if (sym == align_s) {
val align = ffi_eval_expr(cadr(syntax), nil, nil);
- ucnum al = c_num(align);
+ ucnum al = c_num(align, self);
if (cdddr(syntax))
goto excess;
if (al <= 0) {
@@ -4676,8 +4682,8 @@ static struct cobj_ops ffi_call_desc_ops =
val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
{
val self = lit("ffi-make-call-desc");
- cnum nf = c_num(default_arg(nfixed, zero));
- cnum nt = c_num(ntotal), i;
+ cnum nf = c_num(default_arg(nfixed, zero), self);
+ cnum nt = c_num(ntotal, self), i;
struct txr_ffi_call_desc *tfcd = coerce(struct txr_ffi_call_desc *,
chk_calloc(1, sizeof *tfcd));
ffi_type **args = coerce(ffi_type **, chk_xalloc(nt, sizeof *args, self));
@@ -4778,7 +4784,7 @@ val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args)
for (i = 0; i < nreached; i++) {
struct txr_ffi_type *mtft = type[i];
if (mtft->release != 0)
- mtft->release(mtft, args->arg[i], convert(mem_t *, values[i]));
+ mtft->release(mtft, args->arg[i], convert(mem_t *, values[i]), self);
}
}
}
@@ -4911,7 +4917,7 @@ static void ffi_closure_dispatch_safe(ffi_cif *cif, void *cret,
s_exit_point = uw_curr_exit_point;
if (s_exit_point) {
if (rtft->release != 0 && retval != nao)
- rtft->release(rtft, retval, convert(mem_t *, cret));
+ rtft->release(rtft, retval, convert(mem_t *, cret), self);
if (!tfcl->abort_retval)
memset(cret, 0, rsize);
else
@@ -5066,8 +5072,8 @@ val ffi_put_into(val dstbuf, val obj, val type, val offset_in)
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
mem_t *dst = buf_get(dstbuf, self);
val offset = default_arg(offset_in, zero);
- cnum offsn = c_num(offset);
- cnum room = c_num(minus(length_buf(dstbuf), offset));
+ cnum offsn = c_num(offset, self);
+ cnum room = c_num(minus(length_buf(dstbuf), offset), self);
cnum size = tft->dynsize(tft, obj, self);
if (offsn < 0)
uw_throwf(error_s, lit("~a: negative offset ~s specified"),
@@ -5095,8 +5101,8 @@ val ffi_in(val srcbuf, val obj, val type, val copy_p, val offset_in)
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
mem_t *src = buf_get(srcbuf, self);
val offset = default_arg(offset_in, zero);
- cnum offsn = c_num(offset);
- cnum room = c_num(minus(length_buf(srcbuf), offset));
+ cnum offsn = c_num(offset, self);
+ cnum room = c_num(minus(length_buf(srcbuf), offset), self);
cnum size = tft->dynsize(tft, obj, self);
if (offsn < 0)
uw_throwf(error_s, lit("~a: negative offset ~s specified"),
@@ -5117,8 +5123,8 @@ val ffi_get(val srcbuf, val type, val offset_in)
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
mem_t *src = buf_get(srcbuf, self);
val offset = default_arg(offset_in, zero);
- cnum offsn = c_num(offset);
- cnum room = c_num(minus(length_buf(srcbuf), offset));
+ cnum offsn = c_num(offset, self);
+ cnum room = c_num(minus(length_buf(srcbuf), offset), self);
if (offsn < 0)
uw_throwf(error_s, lit("~a: negative offset ~s specified"),
self, offset, nao);
@@ -5134,8 +5140,8 @@ val ffi_out(val dstbuf, val obj, val type, val copy_p, val offset_in)
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
mem_t *dst = buf_get(dstbuf, self);
val offset = default_arg(offset_in, zero);
- cnum offsn = c_num(offset);
- cnum room = c_num(minus(length_buf(dstbuf), offset));
+ cnum offsn = c_num(offset, self);
+ cnum room = c_num(minus(length_buf(dstbuf), offset), self);
cnum size = tft->dynsize(tft, obj, self);
if (offsn < 0)
uw_throwf(error_s, lit("~a: negative offset ~s specified"),
@@ -5238,7 +5244,7 @@ val carray_set_length(val carray, val nelem)
{
val self = lit("carray-set-length");
struct carray *scry = carray_struct_checked(self, carray);
- cnum nel = c_num(nelem);
+ cnum nel = c_num(nelem, self);
if (carray->co.ops == &carray_owned_ops)
uw_throwf(error_s,
@@ -5347,9 +5353,10 @@ mem_t *carray_ptr(val carray, val type, val self)
val carray_vec(val vec, val type, val null_term_p)
{
+ val self = lit("carray-vec");
val len = length(vec);
val nt_p = default_null_arg(null_term_p);
- cnum i, l = c_num(if3(nt_p, succ(len), len));
+ cnum i, l = c_num(if3(nt_p, succ(len), len), self);
val carray = carray_blank(len, type);
for (i = 0; i < l; i++) {
@@ -5363,12 +5370,13 @@ val carray_vec(val vec, val type, val null_term_p)
val carray_list(val list, val type, val null_term_p)
{
+ val self = lit("carray-vec");
val nt_p = default_null_arg(null_term_p);
val len = if3(nt_p, succ(length(list)), length(list));
val carray = carray_blank(len, type);
cnum i;
- (void) c_num(len);
+ (void) c_num(len, self);
for (i = 0; !endp(list); list = cdr(list), i++) {
val el = car(list);
@@ -5381,7 +5389,7 @@ val carray_list(val list, val type, val null_term_p)
val carray_blank(val nelem, val type)
{
val self = lit("carray-blank");
- cnum nel = c_num(nelem);
+ cnum nel = c_num(nelem, self);
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
if (nel < 0) {
@@ -5409,8 +5417,8 @@ val carray_buf(val buf, val type, val offs_in)
val self = lit("carray-buf");
mem_t *data = buf_get(buf, self);
val offs = default_arg_strict(offs_in, zero);
- cnum offsn = c_num(offs);
- cnum blen = c_num(minus(length_buf(buf), offs));
+ cnum offsn = c_num(offs, self);
+ cnum blen = c_num(minus(length_buf(buf), offs), self);
struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
cnum nelem = if3(tft->size, blen / tft->size, 0);
if (offsn < 0)
@@ -5431,7 +5439,7 @@ val carray_buf_sync(val carray)
struct carray *scry = carray_struct_checked(self, carray);
val buf = scry->ref;
mem_t *data = buf_get(buf, self);
- cnum blen = c_num(minus(length_buf(buf), num(scry->offs)));
+ cnum blen = c_num(minus(length_buf(buf), num(scry->offs)), self);
struct txr_ffi_type *tft = ffi_type_struct(scry->eltype);
if (blen < 0)
uw_throwf(error_s,
@@ -5458,7 +5466,7 @@ val carray_cptr(val cptr, val type, val len)
{
val self = lit("carray-cptr");
mem_t *data = cptr_get(cptr);
- cnum nelem = c_num(default_arg(len, negone));
+ cnum nelem = c_num(default_arg(len, negone), self);
(void) ffi_type_struct_checked(self, type);
return make_carray(type, data, nelem, nil, 0);
}
@@ -5515,7 +5523,7 @@ val carray_ref(val carray, val idx)
{
val self = lit("carray-ref");
struct carray *scry = carray_struct_checked(self, carray);
- cnum ix = c_num(idx);
+ cnum ix = c_num(idx, self);
if (ix < 0 && scry->nelem >= 0)
ix += scry->nelem;
@@ -5536,7 +5544,7 @@ val carray_refset(val carray, val idx, val newval)
{
val self = lit("carray-refset");
struct carray *scry = carray_struct_checked(self, carray);
- cnum ix = c_num(idx);
+ cnum ix = c_num(idx, self);
if (ix < 0 && scry->nelem >= 0)
ix += scry->nelem;
@@ -5583,8 +5591,8 @@ val carray_sub(val carray, val from, val to)
}
{
- cnum fn = c_num(from);
- cnum tn = c_num(to);
+ cnum fn = c_num(from, self);
+ cnum tn = c_num(to, self);
cnum elsize = scry->eltft->size;
if (fn < 0)
@@ -5655,12 +5663,12 @@ val carray_replace(val carray, val values, val from, val to)
{
val vlen = length(values);
- cnum fn = c_num(from);
- cnum tn = c_num(to);
+ cnum fn = c_num(from, self);
+ cnum tn = c_num(to, self);
struct txr_ffi_type *eltft = scry->eltft;
cnum elsize = eltft->size;
cnum size = (ucnum) ln * (ucnum) elsize;
- cnum vn = c_num(vlen);
+ cnum vn = c_num(vlen, self);
cnum sn;
mem_t *ptr;
seq_iter_t item_iter;
@@ -5823,7 +5831,7 @@ val carray_uint(val num, val eltype_in)
switch (type(num)) {
case NUM: case CHR:
- num = bignum(c_num(num));
+ num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
if (minusp(num))
@@ -5858,7 +5866,7 @@ val carray_int(val num, val eltype_in)
switch (type(num)) {
case NUM: case CHR:
- num = bignum(c_num(num));
+ num = bignum(c_num(num, self));
/* fallthrough */
case BGNUM:
{
@@ -5867,10 +5875,10 @@ val carray_int(val num, val eltype_in)
val bytes = ash(plus(bits, num_fast(7)), num_fast(-3));
val bitsround = ash(bytes, num_fast(3));
val un = logtrunc(num, bitsround);
- val ube = if3(bignump(un), un, bignum(c_num(un)));
+ val ube = if3(bignump(un), un, bignum(c_num(un, self)));
mp_int *m = mp(ube);
ucnum size = mp_unsigned_bin_size(m);
- ucnum nelem = (c_unum(bytes) + tft->size - 1) / tft->size;
+ ucnum nelem = (c_unum(bytes, self) + tft->size - 1) / tft->size;
mem_t *data = chk_xalloc(nelem, tft->size, self);
ucnum delta = nelem * tft->size - size;
val ca = make_carray(eltype, data, nelem, nil, 0);
diff --git a/filter.c b/filter.c
index 37e7bb8b..d3e9169e 100644
--- a/filter.c
+++ b/filter.c
@@ -676,12 +676,13 @@ static int is_url_reserved(int ch)
val url_encode(val str, val space_plus)
{
+ val self = lit("url-encode");
val in_byte = make_string_byte_input_stream(str);
val out = make_string_output_stream();
val ch;
while ((ch = get_byte(in_byte)) != nil) {
- int c = c_num(ch);
+ int c = c_num(ch, self);
if (space_plus && c == ' ')
put_char(chr('+'), out);
@@ -696,6 +697,7 @@ val url_encode(val str, val space_plus)
val url_decode(val str, val space_plus)
{
+ val self = lit("url-encode");
val in = make_string_input_stream(str);
val out = make_string_output_stream();
@@ -707,7 +709,7 @@ val url_decode(val str, val space_plus)
val ch3 = get_char(in);
if (ch2 && ch3 && chr_isxdigit(ch2) && chr_isxdigit(ch3)) {
- int byte = digit_value(c_num(ch2)) << 4 | digit_value(c_num(ch3));
+ int byte = digit_value(c_num(ch2, self)) << 4 | digit_value(c_num(ch3, self));
put_byte(num_fast(byte), out);
} else {
put_char(ch, out);
@@ -744,12 +746,13 @@ INLINE void col_check(cnum *pcol, cnum wcol, val out)
static val base64_stream_enc_impl(val out, val in, val nbytes, val wrap_cols,
const char *b64)
{
+ val self = lit("base64-stream-enc");
int ulim = nilp(default_null_arg(nbytes));
cnum col = 0;
- cnum nb = if3(ulim, 0, c_num(nbytes));
+ cnum nb = if3(ulim, 0, c_num(nbytes, self));
cnum count = 0;
val ret = zero;
- cnum wcol = c_num(default_arg(wrap_cols, zero));
+ cnum wcol = c_num(default_arg(wrap_cols, zero), self);
for (; ulim || nb > 0; ulim ? --nb : 0) {
val bv0 = get_byte(in);
@@ -757,9 +760,9 @@ static val base64_stream_enc_impl(val out, val in, val nbytes, val wrap_cols,
val bv2 = if2(bv1 && (ulim || --nb > 0), get_byte(in));
if (bv2) {
- cnum b0 = c_num(bv0);
- cnum b1 = c_num(bv1);
- cnum b2 = c_num(bv2);
+ cnum b0 = c_num(bv0, self);
+ cnum b1 = c_num(bv1, self);
+ cnum b2 = c_num(bv2, self);
cnum word = (b0 << 16) | (b1 << 8) | b2;
put_char(chr(b64[(word >> 18) ]), out); col_check(&col, wcol, out);
put_char(chr(b64[(word >> 12) & 0x3F]), out); col_check(&col, wcol, out);
@@ -767,8 +770,8 @@ static val base64_stream_enc_impl(val out, val in, val nbytes, val wrap_cols,
put_char(chr(b64[(word ) & 0x3F]), out); col_check(&col, wcol, out);
count += 3;
} else if (bv1) {
- cnum b0 = c_num(bv0);
- cnum b1 = c_num(bv1);
+ cnum b0 = c_num(bv0, self);
+ cnum b1 = c_num(bv1, self);
cnum word = (b0 << 16) | (b1 << 8);
put_char(chr(b64[(word >> 18) ]), out); col_check(&col, wcol, out);
put_char(chr(b64[(word >> 12) & 0x3F]), out); col_check(&col, wcol, out);
@@ -777,7 +780,7 @@ static val base64_stream_enc_impl(val out, val in, val nbytes, val wrap_cols,
count += 2;
break;
} else if (bv0) {
- cnum b0 = c_num(bv0);
+ cnum b0 = c_num(bv0, self);
cnum word = (b0 << 16);
put_char(chr(b64[(word >> 18) ]), out); col_check(&col, wcol, out);
put_char(chr(b64[(word >> 12) & 0x3F]), out); col_check(&col, wcol, out);
diff --git a/ftw.c b/ftw.c
index 99178961..4e911f2f 100644
--- a/ftw.c
+++ b/ftw.c
@@ -52,6 +52,7 @@ static uw_frame_t *s_exit_point;
static int ftw_callback(const char *c_path, const struct stat *c_sb,
int c_type, struct FTW *fb)
{
+ val self = lit("ftw");
int c_result = 1;
uw_frame_t cont_guard;
@@ -72,7 +73,7 @@ static int ftw_callback(const char *c_path, const struct stat *c_sb,
args_decl(args, max(ARGS_MIN, 5));
args_add5(args, path, type, sb, level, base);
result = generic_funcall(s_callback, args);
- c_result = if3(integerp(result), c_num(result), 0);
+ c_result = if3(integerp(result), c_num(result, self), 0);
}
uw_unwind {
@@ -89,6 +90,8 @@ static int ftw_callback(const char *c_path, const struct stat *c_sb,
val ftw_wrap(val dirpath, val fn, val flags_in, val nopenfd_in)
{
+ val self = lit("ftw");
+
if (s_callback) {
uw_throwf(error_s, lit("ftw: cannot be re-entered from "
"ftw callback"), nao);
@@ -105,8 +108,8 @@ val ftw_wrap(val dirpath, val fn, val flags_in, val nopenfd_in)
}
return ret;
} else {
- int nopenfd = c_num(default_arg(nopenfd_in, num_fast(20)));
- int flags = c_num(default_arg(flags_in, zero));
+ int nopenfd = c_num(default_arg(nopenfd_in, num_fast(20)), self);
+ int flags = c_num(default_arg(flags_in, zero), self);
char *dirpath_u8 = utf8_dup_to(c_str(dirpath));
int res = (s_callback = fn,
nftw(dirpath_u8, ftw_callback, nopenfd, flags));
diff --git a/gc.c b/gc.c
index 4f9e6f60..bec066e8 100644
--- a/gc.c
+++ b/gc.c
@@ -325,6 +325,7 @@ void cobj_destroy_free_op(val obj)
static void mark_obj(val obj)
{
+ val self = lit("gc");
type_t t;
tail_call:
@@ -397,7 +398,7 @@ tail_call:
{
val alloc_size = obj->v.vec[vec_alloc];
val len = obj->v.vec[vec_length];
- cnum i, fp = c_num(len);
+ cnum i, fp = c_num(len, self);
mark_obj(alloc_size);
mark_obj(len);
@@ -960,7 +961,8 @@ val gc_push(val obj, loc plist)
static val gc_set_delta(val delta)
{
- opt_gc_delta = c_num(delta);
+ val self = lit("gc");
+ opt_gc_delta = c_num(delta, self);
return nil;
}
diff --git a/glob.c b/glob.c
index f8fb8895..a4b8a4e5 100644
--- a/glob.c
+++ b/glob.c
@@ -66,7 +66,8 @@ static int errfunc_thunk(const char *errpath, int errcode)
val glob_wrap(val pattern, val flags, val errfun)
{
- cnum c_flags = c_num(default_arg(flags, zero));
+ val self = lit("glob");
+ cnum c_flags = c_num(default_arg(flags, zero), self);
char *pat_u8 = utf8_dup_to(c_str(pattern));
glob_t gl;
diff --git a/hash.c b/hash.c
index 3c76e68a..90727284 100644
--- a/hash.c
+++ b/hash.c
@@ -200,6 +200,8 @@ static ucnum hash_double(double n)
ucnum equal_hash(val obj, int *count, ucnum seed)
{
+ val self = lit("hash-equal");
+
if ((*count)-- <= 0)
return 0;
@@ -216,7 +218,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
case CHR:
return c_chr(obj);
case NUM:
- return c_num(obj);
+ return c_num(obj, self);
case SYM:
case PKG:
case ENV:
@@ -235,7 +237,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
{
val length = obj->v.vec[vec_length];
ucnum h = equal_hash(obj->v.vec[vec_length], count, seed);
- cnum i, len = c_num(length);
+ cnum i, len = c_num(length, self);
ucnum lseed;
for (i = 0, lseed = seed; i < len; i++, lseed += seed) {
@@ -269,7 +271,7 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
return equal_hash(obj->rn.from, count, seed)
+ equal_hash(obj->rn.to, count, seed + (RNG << 8));
case BUF:
- return hash_buf(obj->b.data, c_unum(obj->b.len), seed, count);
+ return hash_buf(obj->b.data, c_unum(obj->b.len, self), seed, count);
case TNOD:
return equal_hash(obj->tn.left, count, (seed + TNOD))
+ equal_hash(obj->tn.right, count, seed + (TNOD << 8))
@@ -281,6 +283,8 @@ ucnum equal_hash(val obj, int *count, ucnum seed)
static ucnum eql_hash(val obj, int *count)
{
+ val self = lit("hash-eql");
+
if ((*count)-- <= 0)
return 0;
@@ -306,7 +310,7 @@ static ucnum eql_hash(val obj, int *count)
case TAG_CHR:
return c_chr(obj);
case TAG_NUM:
- return c_num(obj);
+ return c_num(obj, self);
case TAG_LIT:
switch (CHAR_BIT * sizeof (mem_t *)) {
case 32:
@@ -321,6 +325,8 @@ static ucnum eql_hash(val obj, int *count)
static ucnum eq_hash(val obj)
{
+ val self = lit("hash");
+
switch (tag(obj)) {
case TAG_PTR:
switch (CHAR_BIT * sizeof (mem_t *)) {
@@ -332,7 +338,7 @@ static ucnum eq_hash(val obj)
case TAG_CHR:
return c_chr(obj);
case TAG_NUM:
- return c_num(obj);
+ return c_num(obj, self);
case TAG_LIT:
switch (CHAR_BIT * sizeof (mem_t *)) {
case 32:
@@ -761,6 +767,8 @@ static_def(struct hash_ops hash_equal_ops = hash_ops_init(equal_hash, equal,
static val do_make_hash(val weak_keys, val weak_vals,
hash_type_t type, val seed)
{
+ val self = lit("make-hash");
+
if (weak_keys && type == hash_type_equal) {
uw_throwf(error_s,
lit("make-hash: bad combination :weak-keys with :equal-based"),
@@ -774,9 +782,9 @@ static val do_make_hash(val weak_keys, val weak_vals,
h->seed = convert(u32_t, c_unum(default_arg(seed,
if3(hash_seed_s,
- hash_seed, zero))));
+ hash_seed, zero)), self));
h->flags = convert(hash_flags_t, flags);
- h->modulus = c_num(mod);
+ h->modulus = c_num(mod, self);
h->count = 0;
h->table = table;
h->userdata = nil;
@@ -826,7 +834,7 @@ val make_similar_hash(val existing)
val table = vector(mod, nil);
val hash = cobj(coerce(mem_t *, h), hash_s, &hash_ops);
- h->modulus = c_num(mod);
+ h->modulus = c_num(mod, self);
h->count = 0;
h->table = table;
h->userdata = ex->userdata;
@@ -977,7 +985,7 @@ val clearhash(val hash)
val mod = num_fast(256);
val table = vector(mod, nil);
cnum oldcount = h->count;
- h->modulus = c_num(mod);
+ h->modulus = c_num(mod, self);
h->count = 0;
h->table = table;
setcheck(hash, table);
@@ -1171,8 +1179,10 @@ val hash_eql(val obj)
val hash_equal(val obj, val seed)
{
+ val self = lit("hash-equal");
int lim = hash_traversal_limit;
- return num_fast(equal_hash(obj, &lim, if3(missingp(seed), 0, c_unum(seed))));
+ return num_fast(equal_hash(obj, &lim,
+ if3(missingp(seed), 0, c_unum(seed, self))));
}
/*
@@ -1831,22 +1841,24 @@ val hash_invert(val hash, val joinfun, val unitfun, struct args *hashv_args)
static val set_hash_traversal_limit(val lim)
{
+ val self = lit("set-hash-traversal-limit");
val old = num(hash_traversal_limit);
- hash_traversal_limit = c_num(lim);
+ hash_traversal_limit = c_num(lim, self);
return old;
}
static val gen_hash_seed(void)
{
- val time = time_sec_usec();
- ucnum sec = convert(ucnum, c_time(car(time)));
- ucnum usec = c_unum(cdr(time));
+ val self = lit("gen-hash-seed");
+ val time = time_sec_usec();
+ ucnum sec = convert(ucnum, c_time(car(time), self));
+ ucnum usec = c_unum(cdr(time), self);
#if HAVE_UNISTD_H
- ucnum pid = convert(ucnum, getpid());
+ ucnum pid = convert(ucnum, getpid());
#else
- ucnum pid = 0;
+ ucnum pid = 0;
#endif
- return unum(sec ^ (usec << 12) ^ pid);
+ return unum(sec ^ (usec << 12) ^ pid);
}
void hash_init(void)
diff --git a/itypes.c b/itypes.c
index 51cbb7cd..be0833c4 100644
--- a/itypes.c
+++ b/itypes.c
@@ -38,7 +38,7 @@
#if HAVE_I8
i8_t c_i8(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < -128 || v > 127)
uw_throwf(error_s, lit("~a: value ~s out of signed 8 bit range"),
self, n, nao);
@@ -47,7 +47,7 @@ i8_t c_i8(val n, val self)
u8_t c_u8(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < 0 || v > 255)
uw_throwf(error_s, lit("~a: value ~s out of unsigned 8 bit range"),
self, n, nao);
@@ -58,7 +58,7 @@ u8_t c_u8(val n, val self)
#if HAVE_I16
i16_t c_i16(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < -0x8000 || v > 0x7FFF)
uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
self, n, nao);
@@ -67,7 +67,7 @@ i16_t c_i16(val n, val self)
u16_t c_u16(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < 0 || v > 0xFFFF)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned 16 bit range"),
self, n, nao);
@@ -78,7 +78,7 @@ u16_t c_u16(val n, val self)
#if HAVE_I32
i32_t c_i32(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < (-convert(cnum, 0x7FFFFFFF) - 1) || v > 0x7FFFFFFF)
uw_throwf(error_s, lit("~a: value ~s is out of signed 32 bit range"),
self, n, nao);
@@ -87,7 +87,7 @@ i32_t c_i32(val n, val self)
u32_t c_u32(val n, val self)
{
- uint_ptr_t v = c_unum(n);
+ uint_ptr_t v = c_unum(n, self);
if (v > 0xFFFFFFFF)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned 32 bit range"),
self, n, nao);
@@ -100,7 +100,7 @@ u32_t c_u32(val n, val self)
#if CHAR_BIT * SIZEOF_PTR >= 64
i64_t c_i64(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < (- (cnum) 0x7FFFFFFFFFFFFFFF - 1) || v > (cnum) 0x7FFFFFFFFFFFFFFF)
uw_throwf(error_s, lit("~a: value ~s is out of signed 64 bit range"),
self, n, nao);
@@ -109,7 +109,7 @@ i64_t c_i64(val n, val self)
u64_t c_u64(val n, val self)
{
- ucnum v = c_unum(n);
+ ucnum v = c_unum(n, self);
if (v > (ucnum) 0xFFFFFFFFFFFFFFFF)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned 64 bit range"),
self, n, nao);
@@ -198,7 +198,7 @@ unsigned char c_uchar(val n, val self)
short c_short(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < SHRT_MIN || v > SHRT_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of short int range"),
self, n, nao);
@@ -207,7 +207,7 @@ short c_short(val n, val self)
unsigned short c_ushort(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < 0 || v > USHRT_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned short range"),
self, n, nao);
@@ -216,7 +216,7 @@ unsigned short c_ushort(val n, val self)
int c_int(val n, val self)
{
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < INT_MIN || v > INT_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of int range"),
self, n, nao);
@@ -225,7 +225,7 @@ int c_int(val n, val self)
unsigned int c_uint(val n, val self)
{
- uint_ptr_t v = c_unum(n);
+ uint_ptr_t v = c_unum(n, self);
if (v > UINT_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned int range"),
self, n, nao);
@@ -235,7 +235,7 @@ unsigned int c_uint(val n, val self)
long c_long(val n, val self)
{
#if SIZEOF_LONG <= SIZEOF_PTR
- cnum v = c_num(n);
+ cnum v = c_num(n, self);
if (v < LONG_MIN || v > LONG_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of long int range"),
self, n, nao);
@@ -250,7 +250,7 @@ long c_long(val n, val self)
unsigned long c_ulong(val n, val self)
{
#if SIZEOF_LONG <= SIZEOF_PTR
- uint_ptr_t v = c_unum(n);
+ uint_ptr_t v = c_unum(n, self);
if (v > ULONG_MAX)
uw_throwf(error_s, lit("~a: value ~s is out of unsigned long range"),
self, n, nao);
diff --git a/lib.c b/lib.c
index 040294b5..766fa817 100644
--- a/lib.c
+++ b/lib.c
@@ -543,7 +543,7 @@ val seq_geti(seq_iter_t *it)
return v;
}
-void seq_iter_rewind(seq_iter_t *it)
+static void seq_iter_rewind(seq_iter_t *it, val self)
{
switch (it->inf.kind) {
case SEQ_NIL:
@@ -566,7 +566,7 @@ void seq_iter_rewind(seq_iter_t *it)
switch (type(rf)) {
case NUM:
- it->ui.cn = c_num(rf);
+ it->ui.cn = c_num(rf, self);
break;
case CHR:
it->ui.cn = c_chr(rf);
@@ -616,7 +616,7 @@ static void seq_iter_init_with_info(val self, seq_iter_t *it,
break;
case SEQ_VECLIKE:
it->ui.index = 0;
- it->ul.len = c_num(length(it->inf.obj));
+ it->ul.len = c_num(length(it->inf.obj), self);
it->get = seq_iter_get_vec;
it->peek = seq_iter_peek_vec;
break;
@@ -640,8 +640,8 @@ static void seq_iter_init_with_info(val self, seq_iter_t *it,
if (lt(rf, rt)) switch (type(rf)) {
case NUM:
- it->ui.cn = c_num(rf);
- it->ul.cbound = c_num(rt);
+ it->ui.cn = c_num(rf, self);
+ it->ul.cbound = c_num(rt, self);
it->get = seq_iter_get_range_cnum;
it->peek = seq_iter_peek_range_cnum;
break;
@@ -661,8 +661,8 @@ static void seq_iter_init_with_info(val self, seq_iter_t *it,
unsup_obj(self, it->inf.obj);
} else if (gt(rf, rt)) switch (type(rf)) {
case NUM:
- it->ui.cn = c_num(rf);
- it->ul.cbound = c_num(rt);
+ it->ui.cn = c_num(rf, self);
+ it->ul.cbound = c_num(rt, self);
it->get = seq_iter_get_rev_range_cnum;
it->peek = seq_iter_peek_rev_range_cnum;
break;
@@ -738,7 +738,7 @@ void seq_setpos(val self, seq_iter_t *it, val pos)
it->ui.iter = pos;
break;
case SEQ_VECLIKE:
- it->ui.index = c_num(pos);
+ it->ui.index = c_num(pos, self);
break;
default:
unsup_obj(self, it->inf.obj);
@@ -1301,10 +1301,11 @@ val last(val seq, val n)
val nthcdr(val pos, val list)
{
- cnum n = c_num(pos);
+ val self = lit("nthcdr");
+ cnum n = c_num(pos, self);
if (n < 0)
- uw_throwf(error_s, lit("nthcdr: negative index ~s given"), pos, nao);
+ uw_throwf(error_s, lit("~a: negative index ~s given"), self, pos, nao);
gc_hint(list);
@@ -3167,7 +3168,7 @@ val partition_star(val seq, val indices)
}
}
-cnum c_num(val num);
+cnum c_num(val num, val self);
val eql(val left, val right)
{
@@ -3198,6 +3199,8 @@ val eql(val left, val right)
val equal(val left, val right)
{
+ val self = lit("equal");
+
if (left == right)
return t;
@@ -3299,7 +3302,7 @@ val equal(val left, val right)
cnum i, length;
if (!equal(left->v.vec[vec_length], right->v.vec[vec_length]))
return nil;
- length = c_num(left->v.vec[vec_length]);
+ length = c_num(left->v.vec[vec_length], self);
for (i = 0; i < length; i++) {
if (!equal(left->v.vec[i], right->v.vec[i]))
return nil;
@@ -3344,8 +3347,8 @@ val equal(val left, val right)
break;
case BUF:
if (type(right) == BUF) {
- cnum ll = c_num(left->b.len);
- cnum rl = c_num(right->b.len);
+ cnum ll = c_num(left->b.len, self);
+ cnum rl = c_num(right->b.len, self);
if (ll == rl && memcmp(left->b.data, right->b.data, ll) == 0)
return t;
}
@@ -4009,10 +4012,11 @@ val string_8bit_size(const unsigned char *str, size_t sz)
val mkstring(val len, val ch_in)
{
+ val self = lit("mkstring");
size_t l = if3(minusp(len),
- (uw_throwf(error_s, lit("mkstring: negative size ~s specified"),
- len, nao), 0),
- c_num(len));
+ (uw_throwf(error_s, lit("~a: negative size ~s specified"),
+ self, len, nao), 0),
+ c_num(len, self));
wchar_t *str = chk_wmalloc(l + 1);
val s = string_own(str);
val ch = default_arg_strict(ch_in, chr(' '));
@@ -4025,10 +4029,11 @@ val mkstring(val len, val ch_in)
val mkustring(val len)
{
+ val self = lit("mkustring");
cnum l = if3(minusp(len),
- (uw_throwf(error_s, lit("mkustring: negative size ~s specified"),
+ (uw_throwf(error_s, lit("~a: negative size ~s specified"),
len, nao), 0),
- c_num(len));
+ c_num(len, self));
wchar_t *str = chk_wmalloc(l + 1);
val s = string_own(str);
str[l] = 0;
@@ -4037,9 +4042,9 @@ val mkustring(val len)
return s;
}
-val init_str(val str, const wchar_t *data)
+val init_str(val str, const wchar_t *data, val self)
{
- wmemcpy(str->st.str, data, c_num(str->st.len));
+ wmemcpy(str->st.str, data, c_num(str->st.len, self));
return str;
}
@@ -4054,8 +4059,9 @@ val copy_str(val str)
val upcase_str(val str)
{
+ val self = lit("upcase-str");
val len = length_str(str);
- wchar_t *dst = chk_wmalloc(c_unum(len) + 1);
+ wchar_t *dst = chk_wmalloc(c_unum(len, self) + 1);
const wchar_t *src = c_str(str);
val out = string_own(dst);
@@ -4067,8 +4073,9 @@ val upcase_str(val str)
val downcase_str(val str)
{
+ val self = lit("downcase-str");
val len = length_str(str);
- wchar_t *dst = chk_wmalloc(c_unum(len) + 1);
+ wchar_t *dst = chk_wmalloc(c_unum(len, self) + 1);
const wchar_t *src = c_str(str);
val out = string_own(dst);
@@ -4192,6 +4199,7 @@ const wchar_t *c_str(val obj)
val search_str(val haystack, val needle, val start_num, val from_end)
{
+ val self = lit("search-str");
from_end = default_null_arg(from_end);
start_num = default_arg(start_num, zero);
@@ -4199,7 +4207,7 @@ val search_str(val haystack, val needle, val start_num, val from_end)
return nil;
} else {
val h_is_lazy = lazy_stringp(haystack);
- cnum start = c_num(start_num);
+ cnum start = c_num(start_num, self);
cnum good = -1, pos = -1;
const wchar_t *n = c_str(needle), *h;
@@ -4219,7 +4227,7 @@ val search_str(val haystack, val needle, val start_num, val from_end)
pos = -1;
} while (pos != -1 && (good = pos) != -1 && from_end && h[start++]);
} else {
- size_t ln = c_num(length_str(needle));
+ size_t ln = c_num(length_str(needle), self);
if (start < 0) {
lazy_str_force(haystack);
@@ -4378,6 +4386,7 @@ static val lazy_sub_str(val lstr, val from, val to)
val sub_str(val str_in, val from, val to)
{
+ val self = lit("sub-str");
val len = nil;
if (lazy_stringp(str_in))
@@ -4408,10 +4417,10 @@ val sub_str(val str_in, val from, val to)
} else if (from == zero && eql(to, len)) {
return str_in;
} else {
- size_t nchar = c_num(to) - c_num(from) + 1;
+ size_t nchar = c_num(to, self) - c_num(from, self) + 1;
wchar_t *sub = chk_wmalloc(nchar);
const wchar_t *str = c_str(str_in);
- wcsncpy(sub, str + c_num(from), nchar);
+ wcsncpy(sub, str + c_num(from, self), nchar);
sub[nchar-1] = 0;
return string_own(sub);
}
@@ -4471,20 +4480,20 @@ val replace_str(val str_in, val items, val from, val to)
if (gt(len_rep, len_it)) {
val len_diff = minus(len_rep, len_it);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
- wmemmove(str_in->st.str + t - c_num(len_diff),
+ wmemmove(str_in->st.str + t - c_num(len_diff, self),
str_in->st.str + t, (l - t) + 1);
set(mkloc(str_in->st.len, str_in), minus(len, len_diff));
to = plus(from, len_it);
} else if (lt(len_rep, len_it)) {
val len_diff = minus(len_it, len_rep);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
string_extend(str_in, len_diff);
- wmemmove(str_in->st.str + t + c_num(len_diff),
+ wmemmove(str_in->st.str + t + c_num(len_diff, self),
str_in->st.str + t, (l - t) + 1);
to = plus(from, len_it);
}
@@ -4492,12 +4501,12 @@ val replace_str(val str_in, val items, val from, val to)
if (zerop(len_it))
return str_in;
if (stringp(items)) {
- wmemmove(str_in->st.str + c_num(from), c_str(items), c_num(len_it));
+ wmemmove(str_in->st.str + c_num(from, self), c_str(items), c_num(len_it, self));
} else {
seq_iter_t item_iter;
seq_iter_init(self, &item_iter, items);
- cnum f = c_num(from);
- cnum t = c_num(to);
+ cnum f = c_num(from, self);
+ cnum t = c_num(to, self);
for (; f != t; f++)
str_in->st.str[f] = c_chr(seq_geti(&item_iter));
@@ -4514,7 +4523,7 @@ struct cat_str {
wchar_t *str, *ptr;
};
-static void cat_str_init(struct cat_str *cs, val sep, wchar_t *onech)
+static void cat_str_init(struct cat_str *cs, val sep, wchar_t *onech, val self)
{
cs->sep = sep;
cs->total = 1;
@@ -4527,17 +4536,17 @@ static void cat_str_init(struct cat_str *cs, val sep, wchar_t *onech)
cs->len_sep = 1;
cs->sep = auto_str(coerce(const wchli_t *, wref(onech)));
} else {
- cs->len_sep = c_num(length_str(cs->sep));
+ cs->len_sep = c_num(length_str(cs->sep), self);
}
}
-static void cat_str_measure(struct cat_str *cs, val item, int more_p)
+static void cat_str_measure(struct cat_str *cs, val item, int more_p, val self)
{
if (!item)
return;
if (stringp(item)) {
- size_t ntotal = cs->total + c_num(length_str(item));
+ size_t ntotal = cs->total + c_num(length_str(item), self);
if (cs->len_sep && more_p)
ntotal += cs->len_sep;
@@ -4573,12 +4582,12 @@ static void cat_str_alloc(struct cat_str *cs)
cs->ptr = cs->str = chk_wmalloc(cs->total);
}
-static void cat_str_append(struct cat_str *cs, val item, int more_p)
+static void cat_str_append(struct cat_str *cs, val item, int more_p, val self)
{
if (!item)
return;
if (stringp(item)) {
- cnum len = c_num(length_str(item));
+ cnum len = c_num(length_str(item), self);
wmemcpy(cs->ptr, c_str(item), len);
cs->ptr += len;
} else {
@@ -4599,35 +4608,36 @@ static val cat_str_get(struct cat_str *cs)
val cat_str(val list, val sep)
{
+ val self = lit("cat-str");
val iter;
struct cat_str cs;
wchar_t onech[] = wini(" ");
- cat_str_init(&cs, sep, onech);
+ cat_str_init(&cs, sep, onech, self);
for (iter = list; iter != nil; iter = cdr(iter))
- cat_str_measure(&cs, car(iter), cdr(iter) != nil);
+ cat_str_measure(&cs, car(iter), cdr(iter) != nil, self);
cat_str_alloc(&cs);
for (iter = list; iter != nil; iter = cdr(iter))
- cat_str_append(&cs, car(iter), cdr(iter) != nil);
+ cat_str_append(&cs, car(iter), cdr(iter) != nil, self);
return cat_str_get(&cs);
}
-static val vscat(val sep, va_list vl1, va_list vl2)
+static val vscat(val sep, va_list vl1, va_list vl2, val self)
{
val item, next;
struct cat_str cs;
wchar_t onech[] = wini(" ");
- cat_str_init(&cs, sep, onech);
+ cat_str_init(&cs, sep, onech, self);
for (item = va_arg(vl1, val); item != nao; item = next)
{
next = va_arg(vl1, val);
- cat_str_measure(&cs, item, next != nao);
+ cat_str_measure(&cs, item, next != nao, self);
}
cat_str_alloc(&cs);
@@ -4635,7 +4645,7 @@ static val vscat(val sep, va_list vl1, va_list vl2)
for (item = va_arg(vl2, val); item != nao; item = next)
{
next = va_arg(vl2, val);
- cat_str_append(&cs, item, next != nao);
+ cat_str_append(&cs, item, next != nao, self);
}
return cat_str_get(&cs);
@@ -4643,11 +4653,12 @@ static val vscat(val sep, va_list vl1, va_list vl2)
val scat(val sep, ...)
{
+ val self = lit("scat");
va_list vl1, vl2;
val ret;
va_start (vl1, sep);
va_start (vl2, sep);
- ret = vscat(sep, vl1, vl2);
+ ret = vscat(sep, vl1, vl2, self);
va_end (vl1);
va_end (vl2);
return ret;
@@ -4655,53 +4666,56 @@ val scat(val sep, ...)
val scat2(val s1, val s2)
{
+ val self = lit("scat2");
struct cat_str cs;
- cat_str_init(&cs, nil, NULL);
+ cat_str_init(&cs, nil, NULL, self);
- cat_str_measure(&cs, s1, 1);
- cat_str_measure(&cs, s2, 0);
+ cat_str_measure(&cs, s1, 1, self);
+ cat_str_measure(&cs, s2, 0, self);
cat_str_alloc(&cs);
- cat_str_append(&cs, s1, 1);
- cat_str_append(&cs, s2, 0);
+ cat_str_append(&cs, s1, 1, self);
+ cat_str_append(&cs, s2, 0, self);
return cat_str_get(&cs);
}
val scat3(val s1, val sep, val s2)
{
+ val self = lit("scat3");
struct cat_str cs;
wchar_t onech[] = wini(" ");
- cat_str_init(&cs, sep, onech);
+ cat_str_init(&cs, sep, onech, self);
- cat_str_measure(&cs, s1, 1);
- cat_str_measure(&cs, s2, 0);
+ cat_str_measure(&cs, s1, 1, self);
+ cat_str_measure(&cs, s2, 0, self);
cat_str_alloc(&cs);
- cat_str_append(&cs, s1, 1);
- cat_str_append(&cs, s2, 0);
+ cat_str_append(&cs, s1, 1, self);
+ cat_str_append(&cs, s2, 0, self);
return cat_str_get(&cs);
}
val fmt_join(struct args *args)
{
+ val self = lit("sys:fmt-join");
cnum index;
val iter;
int more;
struct cat_str cs;
- cat_str_init(&cs, nil, 0);
+ cat_str_init(&cs, nil, 0, self);
for (index = 0, iter = args->list, more = args_more_nozap(args, index, iter);
more;)
{
val item = args_get_nozap(args, &index, &iter);
- cat_str_measure(&cs, item, more = args_more_nozap(args, index, iter));
+ cat_str_measure(&cs, item, more = args_more_nozap(args, index, iter), self);
}
cat_str_alloc(&cs);
@@ -4710,7 +4724,7 @@ val fmt_join(struct args *args)
more;)
{
val item = args_get_nozap(args, &index, &iter);
- cat_str_append(&cs, item, more = args_more_nozap(args, index, iter));
+ cat_str_append(&cs, item, more = args_more_nozap(args, index, iter), self);
}
return cat_str_get(&cs);
@@ -4718,6 +4732,7 @@ val fmt_join(struct args *args)
val split_str_keep(val str, val sep, val keep_sep)
{
+ val self = lit("split-str");
keep_sep = default_null_arg(keep_sep);
if (regexp(sep)) {
@@ -4753,7 +4768,7 @@ val split_str_keep(val str, val sep, val keep_sep)
len_sep = 1;
sep = auto_str(coerce(const wchli_t *, wref(onech)));
} else {
- len_sep = c_num(length_str(sep));
+ len_sep = c_num(length_str(sep), self);
}
if (len_sep == 0) {
@@ -4767,7 +4782,7 @@ val split_str_keep(val str, val sep, val keep_sep)
for (; *cstr; cstr++) {
val piece = mkustring(one);
- init_str(piece, cstr);
+ init_str(piece, cstr, self);
iter = list_collect(iter, piece);
if (keep_sep && *(cstr+1))
iter = list_collect(iter, null_string);
@@ -4790,7 +4805,7 @@ val split_str_keep(val str, val sep, val keep_sep)
const wchar_t *psep = wcsstr(cstr, csep);
size_t span = (psep != 0) ? (size_t) (psep - cstr) : wcslen(cstr);
val piece = mkustring(num(span));
- init_str(piece, cstr);
+ init_str(piece, cstr, self);
iter = list_collect(iter, piece);
cstr += span;
if (psep != 0) {
@@ -4824,6 +4839,7 @@ val split_str(val str, val sep)
val split_str_set(val str, val set)
{
+ val self = lit("split-str-set");
const wchar_t *cstr = c_str(str);
const wchar_t *cset = c_str(set);
list_collect_decl (out, iter);
@@ -4831,7 +4847,7 @@ val split_str_set(val str, val set)
for (;;) {
size_t span = wcscspn(cstr, cset);
val piece = mkustring(num(span));
- init_str(piece, cstr);
+ init_str(piece, cstr, self);
iter = list_collect(iter, piece);
cstr += span;
if (*cstr) {
@@ -4972,8 +4988,9 @@ val list_str(val str)
val trim_str(val str)
{
+ val self = lit("trim-str");
const wchar_t *start = c_str(str);
- const wchar_t *end = start + c_num(length_str(str));
+ const wchar_t *end = start + c_num(length_str(str), self);
if (opt_compat && opt_compat <= 148) {
while (start[0] && iswspace(start[0]))
@@ -5071,10 +5088,11 @@ val str_ge(val astr, val bstr)
val int_str(val str, val base)
{
+ val self = lit("int-str");
const wchar_t *wcs = c_str(str);
wchar_t *ptr;
long value;
- cnum b = c_num(default_arg(base, num_fast(10)));
+ cnum b = c_num(default_arg(base, num_fast(10)), self);
int zerox = 0, octzero = 0, minus = 0, flip = 0;
switch (wcs[0]) {
@@ -5355,8 +5373,8 @@ tail:
}
case BUF:
{
- cnum ll = c_num(left->b.len);
- cnum rl = c_num(right->b.len);
+ cnum ll = c_num(left->b.len, self);
+ cnum rl = c_num(right->b.len, self);
cnum len = min(ll, rl);
int cmp = memcmp(left->b.data, right->b.data, len);
@@ -5565,7 +5583,8 @@ val int_chr(val ch)
val chr_int(val num)
{
- cnum n = c_num(num);
+ val self = lit("chr-int");
+ cnum n = c_num(num, self);
if (n < 0 || n > 0x10FFFF)
uw_throwf(numeric_error_s,
lit("chr-num: ~s is out of character range"), num, nao);
@@ -5574,11 +5593,12 @@ val chr_int(val num)
val chr_str(val str, val ind)
{
- cnum index = c_num(ind);
+ val self = lit("chr-str");
+ cnum index = c_num(ind, self);
if (index < 0) {
ind = plus(length_str(str), ind);
- index = c_num(ind);
+ index = c_num(ind, self);
}
if (index < 0 || !length_str_gt(str, ind))
@@ -5595,7 +5615,8 @@ val chr_str(val str, val ind)
val chr_str_set(val str, val ind, val chr)
{
- cnum index = c_num(ind);
+ val self = lit("chr-str-set");
+ cnum index = c_num(ind, self);
if (is_lit(str)) {
uw_throwf(error_s, lit("chr-str-set: cannot modify literal string ~s"),
@@ -5604,7 +5625,7 @@ val chr_str_set(val str, val ind, val chr)
if (index < 0) {
ind = plus(length_str(str), ind);
- index = c_num(ind);
+ index = c_num(ind, self);
}
if (index < 0 || !length_str_gt(str, ind))
@@ -7858,8 +7879,9 @@ val dupl(val fun)
val vector(val length, val initval)
{
+ val self = lit("vector");
unsigned i;
- ucnum len = c_unum(length);
+ ucnum len = c_unum(length, self);
ucnum alloc_plus = len + 2;
ucnum size = if3(alloc_plus > len, alloc_plus, (ucnum) -1);
val *v = coerce(val *, chk_xalloc(size, sizeof *v, lit("vector")));
@@ -7889,9 +7911,9 @@ val vec_set_length(val vec, val length)
type_check(self, vec, VEC);
{
- cnum new_length = c_num(length);
- cnum old_length = c_num(vec->v.vec[vec_length]);
- cnum old_alloc = c_num(vec->v.vec[vec_alloc]);
+ cnum new_length = c_num(length, self);
+ cnum old_length = c_num(vec->v.vec[vec_length], self);
+ cnum old_alloc = c_num(vec->v.vec[vec_alloc], self);
if (new_length < 0)
uw_throwf(error_s, lit("~a: negative length ~s specified"),
@@ -7935,25 +7957,27 @@ val vec_set_length(val vec, val length)
val vecref(val vec, val ind)
{
- cnum index = c_num(ind);
- cnum len = c_num(length_vec(vec));
+ val self = lit("vecref");
+ cnum index = c_num(ind, self);
+ cnum len = c_num(length_vec(vec), self);
if (index < 0)
index = len + index;
if (index < 0 || index >= len)
- uw_throwf(error_s, lit("vecref: ~s is out of range for vector ~s"),
- ind, vec, nao);
+ uw_throwf(error_s, lit("~a: ~s is out of range for vector ~s"),
+ self, ind, vec, nao);
return vec->v.vec[index];
}
loc vecref_l(val vec, val ind)
{
- cnum index = c_num(ind);
- cnum len = c_num(length_vec(vec));
+ val self = lit("vecref");
+ cnum index = c_num(ind, self);
+ cnum len = c_num(length_vec(vec), self);
if (index < 0)
index = len + index;
if (index < 0 || index >= len)
- uw_throwf(error_s, lit("vecref: ~s is out of range for vector ~s"),
- ind, vec, nao);
+ uw_throwf(error_s, lit("~a: ~s is out of range for vector ~s"),
+ self, ind, vec, nao);
return mkloc(vec->v.vec[index], vec);
}
@@ -8022,12 +8046,13 @@ val vec_list(val list)
val list_vec(val vec)
{
+ val self = lit("list-vec");
list_collect_decl (list, ptail);
int i, len;
- type_check(lit("list-vec"), vec, VEC);
+ type_check(self, vec, VEC);
- len = c_num(vec->v.vec[vec_length]);
+ len = c_num(vec->v.vec[vec_length], self);
for (i = 0; i < len; i++)
ptail = list_collect(ptail, vec->v.vec[i]);
@@ -8037,9 +8062,10 @@ val list_vec(val vec)
val copy_vec(val vec_in)
{
+ val self = lit("copy-vec");
val length = length_vec(vec_in);
- ucnum alloc_plus = c_unum(length) + 2;
- val *v = coerce(val *, chk_xalloc(alloc_plus, sizeof *v, lit("copy-vec")));
+ ucnum alloc_plus = c_unum(length, self) + 2;
+ val *v = coerce(val *, chk_xalloc(alloc_plus, sizeof *v, self));
val vec = make_obj();
vec->v.type = VEC;
#if HAVE_VALGRIND
@@ -8055,6 +8081,7 @@ val copy_vec(val vec_in)
val sub_vec(val vec_in, val from, val to)
{
+ val self = lit("sub-vec");
val len = length_vec(vec_in);
if (null_or_missing_p(from))
@@ -8080,9 +8107,9 @@ val sub_vec(val vec_in, val from, val to)
} else if (from == zero && eql(to, len)) {
return vec_in;
} else {
- cnum cfrom = c_num(from);
- size_t nelem = c_num(to) - cfrom;
- val *v = coerce(val *, chk_xalloc((nelem + 2), sizeof *v, lit("sub-vec")));
+ cnum cfrom = c_num(from, self);
+ size_t nelem = c_num(to, self) - cfrom;
+ val *v = coerce(val *, chk_xalloc((nelem + 2), sizeof *v, self));
val vec = make_obj();
vec->v.type = VEC;
#if HAVE_VALGRIND
@@ -8143,10 +8170,10 @@ val replace_vec(val vec_in, val items, val from, val to)
if (gt(len_rep, len_it)) {
val len_diff = minus(len_rep, len_it);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
- memmove(vec_in->v.vec + t - c_num(len_diff),
+ memmove(vec_in->v.vec + t - c_num(len_diff, self),
vec_in->v.vec + t,
(l - t) * sizeof vec_in->v.vec);
@@ -8154,12 +8181,12 @@ val replace_vec(val vec_in, val items, val from, val to)
to = plus(from, len_it);
} else if (lt(len_rep, len_it)) {
val len_diff = minus(len_it, len_rep);
- cnum t = c_num(to);
- cnum l = c_num(len);
+ cnum t = c_num(to, self);
+ cnum l = c_num(len, self);
vec_set_length(vec_in, plus(len, len_diff));
- memmove(vec_in->v.vec + t + c_num(len_diff),
+ memmove(vec_in->v.vec + t + c_num(len_diff, self),
vec_in->v.vec + t,
(l - t) * sizeof vec_in->v.vec);
to = plus(from, len_it);
@@ -8168,15 +8195,15 @@ val replace_vec(val vec_in, val items, val from, val to)
if (zerop(len_it))
return vec_in;
if (vectorp(items)) {
- memmove(vec_in->v.vec + c_num(from), items->v.vec,
- sizeof *vec_in->v.vec * c_num(len_it));
+ memmove(vec_in->v.vec + c_num(from, self), items->v.vec,
+ sizeof *vec_in->v.vec * c_num(len_it, self));
mut(vec_in);
} else {
seq_iter_t item_iter;
seq_iter_init(self, &item_iter, items);
int mut_needed = 0;
- cnum f = c_num(from);
- cnum t = c_num(to);
+ cnum f = c_num(from, self);
+ cnum t = c_num(to, self);
for (; f != t; f++) {
val item = seq_geti(&item_iter);
@@ -8218,6 +8245,7 @@ val replace_obj(val obj, val items, val from, val to)
val cat_vec(val list)
{
+ val self = lit("cat-vec");
ucnum total = 0;
val iter;
val vec, *v;
@@ -8225,7 +8253,7 @@ val cat_vec(val list)
list = nullify(list);
for (iter = list; iter != nil; iter = cdr(iter)) {
- ucnum newtot = total + c_unum(length_vec(car(iter)));
+ ucnum newtot = total + c_unum(length_vec(car(iter)), self);
if (newtot < total)
goto toobig;
total = newtot;
@@ -8234,7 +8262,7 @@ val cat_vec(val list)
if (total + 2 < total)
goto toobig;
- v = coerce(val *, chk_xalloc(total + 2, sizeof *v, lit("cat-vec")));
+ v = coerce(val *, chk_xalloc(total + 2, sizeof *v, self));
vec = make_obj();
vec->v.type = VEC;
@@ -8247,14 +8275,14 @@ val cat_vec(val list)
for (iter = list; iter != nil; iter = cdr(iter)) {
val item = car(iter);
- cnum len = c_num(item->v.vec[vec_length]);
+ cnum len = c_num(item->v.vec[vec_length], self);
memcpy(v, item->v.vec, len * sizeof *v);
v += len;
}
return vec;
toobig:
- uw_throwf(error_s, lit("cat-vec: resulting vector too large"), nao);
+ uw_throwf(error_s, lit("~a: resulting vector too large"), self, nao);
}
static val simple_lazy_stream_func(val stream, val lcons)
@@ -8381,6 +8409,7 @@ val lazy_str_force(val lstr)
val lazy_str_put(val lstr, val stream, struct strm_base *s)
{
+ val self = lit("lazy-str-put");
val lim = lstr->ls.props->limit;
val term = lstr->ls.props->term;
val iter;
@@ -8402,7 +8431,7 @@ val lazy_str_put(val lstr, val stream, struct strm_base *s)
}
if (--max_len == 0)
goto max_reached;
- max_chr -= c_num(length_str(str));
+ max_chr -= c_num(length_str(str), self);
}
if (lim)
lim = pred(lim);
@@ -8451,11 +8480,12 @@ val lazy_str_force_upto(val lstr, val index)
val length_str_gt(val str, val len)
{
+ val self = lit("length-str-gt");
switch (type(str)) {
case LIT:
{
const wchar_t *cstr = c_str(str);
- size_t clen = c_num(len);
+ size_t clen = c_num(len, self);
const wchar_t *nult = wmemchr(cstr, 0, clen + 1);
return nult == 0 ? t : nil;
}
@@ -8465,17 +8495,18 @@ val length_str_gt(val str, val len)
lazy_str_force_upto(str, len);
return gt(length_str(str->ls.prefix), len);
default:
- type_mismatch(lit("length-str-gt: ~s is not a string"), str, nao);
+ type_mismatch(lit("~a: ~s is not a string"), self, str, nao);
}
}
val length_str_ge(val str, val len)
{
+ val self = lit("length-str-ge");
switch (type(str)) {
case LIT:
{
const wchar_t *cstr = c_str(str);
- size_t clen = c_num(len);
+ size_t clen = c_num(len, self);
const wchar_t *nult = wmemchr(cstr, 0, clen);
return nult == 0 ? t : nil;
}
@@ -8485,17 +8516,18 @@ val length_str_ge(val str, val len)
lazy_str_force_upto(str, len);
return ge(length_str(str->ls.prefix), len);
default:
- type_mismatch(lit("length-str-ge: ~s is not a string"), str, nao);
+ type_mismatch(lit("~a: ~s is not a string"), self, str, nao);
}
}
val length_str_lt(val str, val len)
{
+ val self = lit("length-str-lt");
switch (type(str)) {
case LIT:
{
const wchar_t *cstr = c_str(str);
- size_t clen = c_num(len);
+ size_t clen = c_num(len, self);
const wchar_t *nult = wmemchr(cstr, 0, clen);
return nult != 0 ? t : nil;
}
@@ -8505,17 +8537,18 @@ val length_str_lt(val str, val len)
lazy_str_force_upto(str, len);
return lt(length_str(str->ls.prefix), len);
default:
- type_mismatch(lit("length-str-lt: ~s is not a string"), str, nao);
+ type_mismatch(lit("~a: ~s is not a string"), self, str, nao);
}
}
val length_str_le(val str, val len)
{
+ val self = lit("length-str-le");
switch (type(str)) {
case LIT:
{
const wchar_t *cstr = c_str(str);
- size_t clen = c_num(len);
+ size_t clen = c_num(len, self);
const wchar_t *nult = wmemchr(cstr, 0, clen + 1);
return nult != 0 ? t : nil;
}
@@ -8525,7 +8558,7 @@ val length_str_le(val str, val len)
lazy_str_force_upto(str, len);
return le(length_str(str->ls.prefix), len);
default:
- type_mismatch(lit("length-str-lt: ~s is not a string"), str, nao);
+ type_mismatch(lit("~a: ~s is not a string"), self, str, nao);
}
}
@@ -8646,15 +8679,17 @@ val cptr_type(val cptr)
val cptr_size_hint(val cptr, val size)
{
+ val self = lit("cptr-size-hint");
(void) cptr;
- malloc_bytes += c_unum(size);
+ malloc_bytes += c_unum(size, self);
return nil;
}
val cptr_int(val n, val type_sym_in)
{
+ val self = lit("cptr-int");
val type_sym = default_null_arg(type_sym_in);
- return cptr_typed(coerce(mem_t *, c_num(n)), type_sym, 0);
+ return cptr_typed(coerce(mem_t *, c_num(n, self)), type_sym, 0);
}
val cptr_obj(val obj, val type_sym_in)
@@ -10723,7 +10758,7 @@ val diff(val seq1, val seq2, val testfun, val keyfun)
val el2;
int found = 0;
- seq_iter_rewind(&si2);
+ seq_iter_rewind(&si2, self);
while (seq_get(&si2, &el2)) {
val el2_key = funcall1(keyfun, el2);
@@ -10829,7 +10864,7 @@ val isec(val seq1, val seq2, val testfun, val keyfun)
val el1_key = funcall1(keyfun, el1);
val el2;
- seq_iter_rewind(&si2);
+ seq_iter_rewind(&si2, self);
while (seq_get(&si2, &el2)) {
val el2_key = funcall1(keyfun, el2);
@@ -11877,6 +11912,7 @@ static void out_str_readable(const wchar_t *ptr, val out, int *semi_flag)
static void out_lazy_str(val lstr, val out, struct strm_base *strm)
{
+ val self = lit("print");
int semi_flag = 0;
val lim = lstr->ls.props->limit;
val term = lstr->ls.props->term;
@@ -11904,7 +11940,7 @@ static void out_lazy_str(val lstr, val out, struct strm_base *strm)
}
if (--max_len == 0)
goto max_reached;
- max_chr -= c_num(length_str(str));
+ max_chr -= c_num(length_str(str), self);
}
out_str_readable(c_str(str), out, &semi_flag);
out_str_readable(wcterm, out, &semi_flag);
@@ -11952,6 +11988,7 @@ static void out_quasi_str_sym(val name, val mods, val rem_args,
static void out_quasi_str(val args, val out, struct strm_ctx *ctx)
{
+ val self = lit("print");
val iter, next;
cnum max_len = ctx->strm->max_length, max_count = max_len;
@@ -11970,7 +12007,7 @@ static void out_quasi_str(val args, val out, struct strm_ctx *ctx)
} else {
out_str_readable(c_str(elem), out, &semi_flag);
if (max_len) {
- max_len -= c_num(length(elem));
+ max_len -= c_num(length(elem), self);
if (max_len == 0) {
goto max_reached;
}
@@ -12395,7 +12432,7 @@ dot:
break;
case VEC:
{
- cnum i, length = c_num(obj->v.vec[vec_length]);
+ cnum i, length = c_num(obj->v.vec[vec_length], self);
cnum max_length = ctx->strm->max_length;
val save_mode = test_set_indent_mode(out, num_fast(indent_off),
num_fast(indent_data));
@@ -12504,7 +12541,7 @@ tail:
case VEC:
{
cnum i;
- cnum l = c_num(length_vec(obj));
+ cnum l = c_num(length_vec(obj), self);
for (i = 0; i < l; i++) {
val in = num(i);
@@ -12745,7 +12782,8 @@ static val string_time(struct tm *(*break_time_fn)(const time_t *, struct tm *),
val time_string_local(val time, val format)
{
- time_t secs = c_time(time);
+ val self = lit("time-string-local");
+ time_t secs = c_time(time, self);
const wchar_t *wcfmt = c_str(format);
char *u8fmt = utf8_dup_to(wcfmt);
val timestr = string_time(localtime_r, u8fmt, secs);
@@ -12755,7 +12793,8 @@ val time_string_local(val time, val format)
val time_string_utc(val time, val format)
{
- time_t secs = c_time(time);
+ val self = lit("time-string-utc");
+ time_t secs = c_time(time, self);
const wchar_t *wcfmt = c_str(format);
char *u8fmt = utf8_dup_to(wcfmt);
val timestr = string_time(gmtime_r, u8fmt, secs);
@@ -12804,8 +12843,9 @@ static val broken_time_struct(struct tm *tms)
val time_fields_local(val time)
{
+ val self = lit("time-fields-local");
struct tm tms;
- time_t secs = c_time(time);
+ time_t secs = c_time(time, self);
if (localtime_r(&secs, &tms) == 0)
return nil;
@@ -12815,8 +12855,9 @@ val time_fields_local(val time)
val time_fields_utc(val time)
{
+ val self = lit("time-fields-utc");
struct tm tms;
- time_t secs = c_time(time);
+ time_t secs = c_time(time, self);
if (gmtime_r(&secs, &tms) == 0)
return nil;
@@ -12826,8 +12867,9 @@ val time_fields_utc(val time)
val time_struct_local(val time)
{
+ val self = lit("time-struct-local");
struct tm tms;
- time_t secs = c_time(time);
+ time_t secs = c_time(time, self);
if (localtime_r(&secs, &tms) == 0)
return nil;
@@ -12837,8 +12879,9 @@ val time_struct_local(val time)
val time_struct_utc(val time)
{
+ val self = lit("time-struct-utc");
struct tm tms;
- time_t secs = c_time(time);
+ time_t secs = c_time(time, self);
if (gmtime_r(&secs, &tms) == 0)
return nil;
@@ -12848,15 +12891,16 @@ val time_struct_utc(val time)
static void time_fields_to_tm(struct tm *ptm,
val year, val month, val day,
- val hour, val min, val sec, val dst)
+ val hour, val min, val sec, val dst,
+ val self)
{
uses_or2;
- ptm->tm_year = c_num(or2(year, zero)) - 1900;
- ptm->tm_mon = c_num(or2(month, zero)) - 1;
- ptm->tm_mday = c_num(or2(day, zero));
- ptm->tm_hour = c_num(or2(hour, zero));
- ptm->tm_min = c_num(or2(min, zero));
- ptm->tm_sec = c_num(or2(sec, zero));
+ ptm->tm_year = c_num(or2(year, zero), self) - 1900;
+ ptm->tm_mon = c_num(or2(month, zero), self) - 1;
+ ptm->tm_mday = c_num(or2(day, zero), self);
+ ptm->tm_hour = c_num(or2(hour, zero), self);
+ ptm->tm_min = c_num(or2(min, zero), self);
+ ptm->tm_sec = c_num(or2(sec, zero), self);
if (!dst)
ptm->tm_isdst = 0;
@@ -12873,7 +12917,8 @@ static void time_fields_to_tm(struct tm *ptm,
#endif
}
-static void time_struct_to_tm(struct tm *ptm, val time_struct, val strict)
+static void time_struct_to_tm(struct tm *ptm, val time_struct, val strict,
+ val self)
{
val year = slot(time_struct, year_s);
val month = slot(time_struct, month_s);
@@ -12892,19 +12937,19 @@ static void time_struct_to_tm(struct tm *ptm, val time_struct, val strict)
sec = (sec ? sec : zero);
}
- time_fields_to_tm(ptm, year, month, day, hour, min, sec, dst);
+ time_fields_to_tm(ptm, year, month, day, hour, min, sec, dst, self);
}
static val make_time_impl(time_t (*pmktime)(struct tm *),
val year, val month, val day,
val hour, val minute, val second,
- val isdst)
+ val isdst, val self)
{
struct tm local = all_zero_init;
time_t time;
time_fields_to_tm(&local, year, month, day,
- hour, minute, second, isdst);
+ hour, minute, second, isdst, self);
time = pmktime(&local);
return time == -1 ? nil : num_time(time);
@@ -12914,7 +12959,9 @@ val make_time(val year, val month, val day,
val hour, val minute, val second,
val isdst)
{
- return make_time_impl(mktime, year, month, day, hour, minute, second, isdst);
+ val self = lit("make-time");
+ return make_time_impl(mktime, year, month, day, hour, minute, second,
+ isdst, self);
}
#if HAVE_STRPTIME
@@ -12998,13 +13045,15 @@ val make_time_utc(val year, val month, val day,
val hour, val minute, val second,
val isdst)
{
+ val self = lit("make-time-utc");
#if HAVE_TIMEGM
time_t (*pmktime)(struct tm *) = timegm;
#else
time_t (*pmktime)(struct tm *) = timegm_hack;
#endif
- return make_time_impl(pmktime, year, month, day, hour, minute, second, isdst);
+ return make_time_impl(pmktime, year, month, day, hour, minute, second,
+ isdst, self);
}
static val time_meth(val utc_p, val time_struct)
@@ -13023,8 +13072,9 @@ static val time_meth(val utc_p, val time_struct)
static val time_string_meth(val time_struct, val format)
{
+ val self = lit("(meth time-string)");
struct tm tms = all_zero_init;
- time_struct_to_tm(&tms, time_struct, t);
+ time_struct_to_tm(&tms, time_struct, t, self);
char buffer[512] = "";
char *fmt = utf8_dup_to(c_str(format));
@@ -13040,8 +13090,9 @@ static val time_string_meth(val time_struct, val format)
static val time_parse_meth(val time_struct, val format, val string)
{
+ val self = lit("(meth time-parse)");
struct tm tms = all_zero_init;
- time_struct_to_tm(&tms, time_struct, nil);
+ time_struct_to_tm(&tms, time_struct, nil, self);
val ret = nil;
{
diff --git a/lib.h b/lib.h
index 3e97d45d..84de4c4b 100644
--- a/lib.h
+++ b/lib.h
@@ -553,7 +553,6 @@ val subtypep(val sub, val sup);
val typep(val obj, val type);
seq_info_t seq_info(val cobj);
void seq_iter_init(val self, seq_iter_t *it, val obj);
-void seq_iter_rewind(seq_iter_t *it);
INLINE int seq_get(seq_iter_t *it, val *pval) { return it->get(it, pval); }
INLINE int seq_peek(seq_iter_t *it, val *pval) { return it->peek(it, pval); }
val seq_geti(seq_iter_t *it);
@@ -730,8 +729,8 @@ val improper_plist_to_alist(val list, val boolean_keys);
val num(cnum val);
val unum(ucnum u);
val flo(double val);
-cnum c_num(val num);
-ucnum c_unum(val num);
+cnum c_num(val num, val self);
+ucnum c_unum(val num, val self);
cnum c_fixnum(val num, val self);
double c_flo(val self, val num);
val fixnump(val num);
@@ -849,7 +848,7 @@ val string_8bit(const unsigned char *str);
val string_8bit_size(const unsigned char *str, size_t sz);
val mkstring(val len, val ch);
val mkustring(val len); /* must initialize immediately with init_str! */
-val init_str(val str, const wchar_t *);
+val init_str(val str, const wchar_t *, val self);
val copy_str(val str);
val upcase_str(val str);
val downcase_str(val str);
diff --git a/match.c b/match.c
index 710a56ef..fee391bc 100644
--- a/match.c
+++ b/match.c
@@ -516,14 +516,14 @@ typedef val (*h_match_func)(match_line_ctx *c);
debuglf(elem, lit(KIND " mismatch, position ~a (~a:~d)"), \
plus(c->pos, c->base), c->file, c->data_lineno, nao); \
debuglf(elem, lit(" ~a"), c->dataline, nao); \
- if (c_num(c->pos) < 77) \
+ if (c_num(c->pos, lit("txr")) < 77) \
debuglf(elem, lit(" ~*a^"), c->pos, lit(""), nao)
#define LOG_MATCH(KIND, EXTENT) \
debuglf(elem, lit(KIND " matched, position ~a-~a (~a:~d)"), \
plus(c->pos, c->base), EXTENT, c->file, c->data_lineno, nao); \
debuglf(elem, lit(" ~a"), c->dataline, nao); \
- if (c_num(EXTENT) < 77) \
+ if (c_num(EXTENT, lit("txr")) < 77) \
debuglf(elem, lit(" ~*a~<*a^"), c->pos, lit(""), \
minus(EXTENT, c->pos), lit("^"), nao)
@@ -821,11 +821,12 @@ static val h_var(match_line_ctx *c)
static val h_skip(match_line_ctx *c)
{
+ val self = lit("skip");
val elem = first(c->specline);
val max = tleval_144(elem, second(elem), c->bindings);
val min = tleval_144(elem, third(elem), c->bindings);
- cnum cmax = integerp(max) ? c_num(max) : 0;
- cnum cmin = integerp(min) ? c_num(min) : 0;
+ cnum cmax = integerp(max) ? c_num(max, self) : 0;
+ cnum cmin = integerp(min) ? c_num(min, self) : 0;
val greedy = eq(max, greedy_k);
val last_good_result = nil, last_good_pos = nil;
@@ -951,6 +952,7 @@ static val h_accept_fail(match_line_ctx *c)
static val h_coll(match_line_ctx *c)
{
+ val self = lit("coll");
val elem = first(c->specline);
val op_sym = first(elem);
val coll_specline = second(elem);
@@ -980,12 +982,12 @@ static val h_coll(match_line_ctx *c)
val have_vars, have_lists;
val vars = getplist_f(args, vars_k, mkcloc(have_vars));
val lists = getplist_f(args, lists_k, mkcloc(have_lists));
- cnum cmax = if3(gap, c_num(gap), if3(max, c_num(max), 0));
- cnum cmin = if3(gap, c_num(gap), if3(min, c_num(min), 0));
+ cnum cmax = if3(gap, c_num(gap, self), if3(max, c_num(max, self), 0));
+ cnum cmin = if3(gap, c_num(gap, self), if3(min, c_num(min, self), 0));
cnum mincounter = cmin, maxcounter = 0;
- cnum ctimax = if3(times, c_num(times), if3(maxtimes, c_num(maxtimes), 0));
- cnum ctimin = if3(times, c_num(times), if3(mintimes, c_num(mintimes), 0));
- cnum cchars = if3(chars, c_num(chars), 0);
+ cnum ctimax = if3(times, c_num(times, self), if3(maxtimes, c_num(maxtimes, self), 0));
+ cnum ctimin = if3(times, c_num(times, self), if3(mintimes, c_num(mintimes, self), 0));
+ cnum cchars = if3(chars, c_num(chars, self), 0);
cnum timescounter = 0, charscounter = 0;
int compat_222 = opt_compat && opt_compat <= 222;
val iter;
@@ -1977,6 +1979,8 @@ static val extract_bindings(val bindings, val output_spec, val vars)
static void do_output_line(val bindings, val specline, val filter, val out)
{
+ val self = lit("output");
+
if (specline == t)
return;
@@ -2034,7 +2038,7 @@ static void do_output_line(val bindings, val specline, val filter, val out)
val counter_bind = if2(counter, cons(counter_var, nil));
cnum i;
- for (i = 0; i < c_num(max_depth); i++) {
+ for (i = 0; i < c_num(max_depth, self); i++) {
val bind_a = nappend2(mapcar(func_n1(bind_car), bind_cp), bindings);
val bind_d = mapcar(func_n1(bind_cdr), bind_cp);
@@ -2046,7 +2050,7 @@ static void do_output_line(val bindings, val specline, val filter, val out)
if (i == 0 && first_clauses) {
do_output_line(bind_a, first_clauses, filter, out);
- } else if (i == c_num(max_depth) - 1 &&
+ } else if (i == c_num(max_depth, self) - 1 &&
(last_clauses || modlast_clauses)) {
if (modlast_clauses) {
val iter;
@@ -2128,6 +2132,8 @@ static void do_output_line(val bindings, val specline, val filter, val out)
static void do_output(val bindings, val specs, val filter, val out)
{
+ val self = lit("output");
+
if (specs == t)
return;
@@ -2173,7 +2179,7 @@ static void do_output(val bindings, val specs, val filter, val out)
val counter_bind = if2(counter, cons(counter_var, nil));
cnum i;
- for (i = 0; i < c_num(max_depth); i++) {
+ for (i = 0; i < c_num(max_depth, self); i++) {
val bind_a = nappend2(mapcar(func_n1(bind_car), bind_cp), bindings);
val bind_d = mapcar(func_n1(bind_cdr), bind_cp);
@@ -2185,7 +2191,7 @@ static void do_output(val bindings, val specs, val filter, val out)
if (i == 0 && first_clauses) {
do_output(bind_a, first_clauses, filter, out);
- } else if (i == c_num(max_depth) - 1 &&
+ } else if (i == c_num(max_depth, self) - 1 &&
(last_clauses || modlast_clauses))
{
if (modlast_clauses) {
@@ -2341,6 +2347,7 @@ typedef val (*v_match_func)(match_files_ctx *cout);
static val v_skip(match_files_ctx *c)
{
+ val self = lit("skip");
spec_bind (specline, first_spec, c->spec);
if (rest(specline))
@@ -2356,8 +2363,8 @@ static val v_skip(match_files_ctx *c)
val args = rest(first_spec);
val max = tleval_144(skipspec, first(args), c->bindings);
val min = tleval_144(skipspec, second(args), c->bindings);
- cnum cmax = integerp(max) ? c_num(max) : 0;
- cnum cmin = integerp(min) ? c_num(min) : 0;
+ cnum cmax = integerp(max) ? c_num(max, self) : 0;
+ cnum cmin = integerp(min) ? c_num(min, self) : 0;
val greedy = eq(max, greedy_k);
volatile val last_good_result = nil;
volatile val last_good_line = zero;
@@ -2430,6 +2437,7 @@ static val v_skip(match_files_ctx *c)
static val v_fuzz(match_files_ctx *c)
{
+ val self = lit("fuzz");
spec_bind (specline, first_spec, c->spec);
if (rest(specline))
@@ -2445,8 +2453,8 @@ static val v_fuzz(match_files_ctx *c)
val args = rest(first_spec);
val m = tleval_144(fuzz_spec, first(args), c->bindings);
val n = tleval_144(fuzz_spec, second(args), c->bindings);
- cnum cm = if3(m, c_num(m), 0);
- cnum cn = if3(n, c_num(n), 0);
+ cnum cm = if3(m, c_num(m, self), 0);
+ cnum cn = if3(n, c_num(n, self), 0);
{
cnum reps, good;
@@ -3328,6 +3336,7 @@ out:
static val v_collect(match_files_ctx *c)
{
+ val self = lit("collect");
spec_bind (specline, first_spec, c->spec);
val op_sym = first(first_spec);
val coll_spec = second(first_spec);
@@ -3357,14 +3366,14 @@ static val v_collect(match_files_ctx *c)
val have_vars, have_lists;
volatile val vars = getplist_f(args, vars_k, mkcloc(have_vars));
val lists = getplist_f(args, lists_k, mkcloc(have_lists));
- cnum cmax = if3(gap, c_num(gap), if3(max, c_num(max), 0));
- cnum cmin = if3(gap, c_num(gap), if3(min, c_num(min), 0));
+ cnum cmax = if3(gap, c_num(gap, self), if3(max, c_num(max, self), 0));
+ cnum cmin = if3(gap, c_num(gap, self), if3(min, c_num(min, self), 0));
cnum mincounter = cmin, maxcounter = 0;
- cnum ctimax = if3(times, c_num(times), if3(maxtimes, c_num(maxtimes), 0));
- cnum ctimin = if3(times, c_num(times), if3(mintimes, c_num(mintimes), 0));
+ cnum ctimax = if3(times, c_num(times, self), if3(maxtimes, c_num(maxtimes, self), 0));
+ cnum ctimin = if3(times, c_num(times, self), if3(mintimes, c_num(mintimes, self), 0));
volatile cnum timescounter = 0, linescounter = 0;
- cnum ctimes = if3(times, c_num(times), 0);
- cnum clines = if3(lines, c_num(lines), 0);
+ cnum ctimes = if3(times, c_num(times, self), 0);
+ cnum clines = if3(lines, c_num(lines, self), 0);
int compat_222 = opt_compat && opt_compat <= 222;
val iter;
uw_mark_frame;
diff --git a/parser.c b/parser.c
index c1984a07..08174154 100644
--- a/parser.c
+++ b/parser.c
@@ -161,12 +161,13 @@ void parser_reset(parser_t *p)
val parser(val stream, val name, val lineno)
{
+ val self = lit("parser");
parser_t *p = coerce(parser_t *, chk_malloc(sizeof *p));
val parser;
parser_common_init(p);
parser = cobj(coerce(mem_t *, p), parser_s, &parser_ops);
p->parser = parser;
- p->lineno = c_num(default_arg(lineno, one));
+ p->lineno = c_num(default_arg(lineno, one), self);
p->name = name;
p->stream = stream;
@@ -199,7 +200,7 @@ val parser_set_lineno(val self, val stream, val lineno)
{
val parser = ensure_parser(stream, nil);
parser_t *pi = parser_get_impl(self, parser);
- pi->lineno = c_num(lineno);
+ pi->lineno = c_num(lineno, self);
return stream;
}
@@ -264,6 +265,7 @@ static val patch_ref(parser_t *p, val obj)
static void circ_backpatch(parser_t *p, struct circ_stack *up, val obj)
{
+ val self = lit("parser");
struct circ_stack cs = { up, obj };
if (!parser_callgraph_circ_check(up, obj))
@@ -297,7 +299,7 @@ tail:
case VEC:
{
cnum i;
- cnum l = c_num(length_vec(obj));
+ cnum l = c_num(length_vec(obj), self);
for (i = 0; i < l; i++) {
val v = obj->v.vec[i];
@@ -647,7 +649,7 @@ static val lisp_parse_impl(val self, val interactive, val rlcp_p, val source_in,
class_check (self, error_stream, stream_s);
if (lineno && !missingp(lineno))
- pi->lineno = c_num(lineno);
+ pi->lineno = c_num(lineno, self);
env_vbind(dyn_env, stderr_s, error_stream);
@@ -834,6 +836,7 @@ val txr_parse(val source_in, val error_stream,
static void report_security_problem(val name)
{
+ val self = lit("listener");
static int umask_warned;
format(std_output,
@@ -843,7 +846,7 @@ static void report_security_problem(val name)
if (!umask_warned++)
{
val um = umask_wrap(colon_k);
- if ((c_num(um) & 022) != 022) {
+ if ((c_num(um, self) & 022) != 022) {
format(std_output,
lit("** possible reason: your umask has an insecure value: ~,03o\n"),
um, nao);
@@ -1405,12 +1408,13 @@ static void hist_save(lino_t *ls, val in_stream, val out_stream,
val histfile, const wchar_t *histfile_w,
val hist_len_var)
{
+ val self = lit("listener");
if (histfile_w && lino_have_new_lines(ls)) {
val histfile_tmp = scat2(histfile, lit(".tmp"));
const wchar_t *histfile_tmp_w = c_str(histfile_tmp);
lino_t *ltmp = lino_make(coerce(mem_t *, in_stream),
coerce(mem_t *, out_stream));
- lino_hist_set_max_len(ltmp, c_num(cdr(hist_len_var)));
+ lino_hist_set_max_len(ltmp, c_num(cdr(hist_len_var), self));
lino_hist_load(ltmp, histfile_w);
lino_hist_save(ltmp, histfile_tmp_w, 0);
if (lino_hist_save(ls, histfile_tmp_w, 1) == 0)
@@ -1424,6 +1428,7 @@ static void hist_save(lino_t *ls, val in_stream, val out_stream,
val repl(val bindings, val in_stream, val out_stream, val env)
{
+ val self = lit("listener");
lino_t *ls = if3(repl_level++,
lino_ctx,
lino_ctx = lino_make(coerce(mem_t *, in_stream),
@@ -1472,7 +1477,7 @@ val repl(val bindings, val in_stream, val out_stream, val env)
if (rcfile)
load_rcfile(rcfile);
- lino_hist_set_max_len(ls, c_num(cdr(hist_len_var)));
+ lino_hist_set_max_len(ls, c_num(cdr(hist_len_var), self));
if (histfile_w) {
if (lino_hist_load(ls, histfile_w) == 0 &&
@@ -1492,7 +1497,7 @@ val repl(val bindings, val in_stream, val out_stream, val env)
val var_sym = intern(var_name, user_package);
uw_frame_t uw_handler;
- lino_hist_set_max_len(ls, c_num(cdr(hist_len_var)));
+ lino_hist_set_max_len(ls, c_num(cdr(hist_len_var), self));
lino_set_multiline(ls, cdr(multi_line_var) != nil);
lino_set_selinclusive(ls, cdr(sel_inclusive_var) != nil);
reg_varl(counter_sym, counter);
@@ -1650,8 +1655,9 @@ static val circref(val n)
static int lino_fileno(mem_t *stream_in)
{
+ val self = lit("listener");
val stream = coerce(val, stream_in);
- return c_num(stream_fd(stream));
+ return c_num(stream_fd(stream), self);
}
static int lino_puts(mem_t *stream_in, const wchar_t *str_in)
@@ -1678,6 +1684,7 @@ static int lino_puts_file(mem_t *stream_in, const wchar_t *str_in)
static wint_t lino_getch(mem_t *stream_in)
{
+ val self = lit("listener");
wint_t ret = WEOF;
val stream, ch;
@@ -1687,7 +1694,7 @@ static wint_t lino_getch(mem_t *stream_in)
stream = coerce(val, stream_in);
ch = get_char(stream);
- ret = if3(ch, (wint_t) c_num(ch), WEOF);
+ ret = if3(ch, (wint_t) c_num(ch, self), WEOF);
uw_catch (sy, va) {
(void) sy;
@@ -1703,6 +1710,7 @@ static wint_t lino_getch(mem_t *stream_in)
static wchar_t *lino_getl(mem_t *stream_in, wchar_t *buf, size_t nchar)
{
+ val self = lit("listener");
wchar_t *ptr = buf;
val stream = coerce(val, stream_in);
@@ -1713,7 +1721,7 @@ static wchar_t *lino_getl(mem_t *stream_in, wchar_t *buf, size_t nchar)
val ch = get_char(stream);
if (!ch)
break;
- if ((*ptr++ = c_num(ch)) == '\n')
+ if ((*ptr++ = c_num(ch, self)) == '\n')
break;
}
@@ -1723,6 +1731,7 @@ static wchar_t *lino_getl(mem_t *stream_in, wchar_t *buf, size_t nchar)
static wchar_t *lino_gets(mem_t *stream_in, wchar_t *buf, size_t nchar)
{
+ val self = lit("listener");
wchar_t *ptr = buf;
val stream = coerce(val, stream_in);
@@ -1733,7 +1742,7 @@ static wchar_t *lino_gets(mem_t *stream_in, wchar_t *buf, size_t nchar)
val ch = get_char(stream);
if (!ch)
break;
- *ptr++ = c_num(ch);
+ *ptr++ = c_num(ch, self);
}
*ptr++ = 0;
@@ -1753,6 +1762,7 @@ static const wchli_t *lino_mode_str[] = {
static mem_t *lino_open(const wchar_t *name_in, lino_file_mode_t mode_in)
{
+ val self = lit("listener");
val name = string(name_in);
val mode = static_str(lino_mode_str[mode_in]);
val ret = 0;
@@ -1760,7 +1770,7 @@ static mem_t *lino_open(const wchar_t *name_in, lino_file_mode_t mode_in)
ret = open_file(name, mode);
#if HAVE_CHMOD
if (mode_in == lino_overwrite || mode_in == lino_append)
- (void) fchmod(c_num(stream_fd(ret)), S_IRUSR | S_IWUSR);
+ (void) fchmod(c_num(stream_fd(ret), self), S_IRUSR | S_IWUSR);
#endif
ignerr_end;
return coerce(mem_t *, ret);
diff --git a/parser.l b/parser.l
index c49f6e10..93b83fc5 100644
--- a/parser.l
+++ b/parser.l
@@ -48,9 +48,10 @@
#define YY_INPUT(buf, result, max_size) \
do { \
- val n = get_bytes(lit("parser"), yyextra->stream, \
+ val self = lit("parser"); \
+ val n = get_bytes(self, yyextra->stream, \
coerce(mem_t *, buf), max_size); \
- result = c_num(n); \
+ result = c_num(n, self); \
} while (0)
#define YY_DECL \
diff --git a/rand.c b/rand.c
index 77d6c18f..ba8c5ad9 100644
--- a/rand.c
+++ b/rand.c
@@ -131,7 +131,7 @@ val make_random_state(val seed, val warmup)
dig++, bit = 0;
}
} else if (fixnump(seed)) {
- cnum s = c_num(seed) & NUM_MAX;
+ cnum s = c_num(seed, self) & NUM_MAX;
r->state[0] = s & 0xFFFFFFFFul;
i = 1;
@@ -144,8 +144,8 @@ val make_random_state(val seed, val warmup)
#endif
} else if (nilp(seed)) {
val time = time_sec_usec();
- r->state[0] = convert(rand32_t, c_num(car(time)));
- r->state[1] = convert(rand32_t, c_num(cdr(time)));
+ r->state[0] = convert(rand32_t, c_num(car(time), self));
+ r->state[1] = convert(rand32_t, c_num(cdr(time), self));
#if HAVE_UNISTD_H
r->state[2] = convert(rand32_t, getpid());
i = 3;
@@ -163,9 +163,9 @@ val make_random_state(val seed, val warmup)
seed, nao);
for (i = 0; i < 16; i++)
- r->state[i] = c_unum(seed->v.vec[i]);
+ r->state[i] = c_unum(seed->v.vec[i], self);
- r->cur = c_num(seed->v.vec[i]);
+ r->cur = c_num(seed->v.vec[i], self);
return rs;
} else {
uw_throwf(error_s, lit("make-random-state: seed ~s is not a number"),
@@ -182,7 +182,7 @@ val make_random_state(val seed, val warmup)
{
uses_or2;
- cnum wu = c_num(or2(warmup, random_warmup));
+ cnum wu = c_num(or2(warmup, random_warmup), self);
for (i = 0; i < wu; i++)
(void) rand32(r);
@@ -298,7 +298,7 @@ val random(val state, val modulus)
return normalize(out);
} else if (fixnump(modulus)) {
- cnum m = c_num(modulus);
+ cnum m = c_num(modulus, self);
if (m == 1) {
return zero;
} else if (m > 1) {
diff --git a/regex.c b/regex.c
index 936269c6..acb2c7a8 100644
--- a/regex.c
+++ b/regex.c
@@ -2296,6 +2296,8 @@ static void paren_print_rec(val exp, val stream, int *semi_flag)
static void print_rec(val exp, val stream, int *semi_flag)
{
+ val self = lit("regex-print");
+
if (exp == space_k) {
puts_clear_flag(lit("\\s"), stream, semi_flag);
} else if (exp == digit_k) {
@@ -2325,7 +2327,7 @@ static void print_rec(val exp, val stream, int *semi_flag)
}
} else if (stringp(exp)) {
cnum i;
- cnum l = c_num(length(exp));
+ cnum l = c_num(length(exp), self);
for (i = 0; i < l; i++)
print_rec(chr_str(exp, num(i)), stream, semi_flag);
} else if (consp(exp)) {
@@ -2590,7 +2592,7 @@ val search_regex(val haystack, val needle_regex, val start,
if (from_end) {
cnum i;
- cnum s = c_num(start);
+ cnum s = c_num(start, self);
const wchar_t *h = c_str(haystack);
slen = (slen ? slen : length_str(haystack));
@@ -2598,7 +2600,7 @@ val search_regex(val haystack, val needle_regex, val start,
if (regex_run(needle_regex, L"") >= 0)
return cons(slen, zero);
- for (i = c_num(slen) - 1; i >= s; i--) {
+ for (i = c_num(slen, self) - 1; i >= s; i--) {
cnum span = regex_run(needle_regex, h + i);
if (span >= 0)
return cons(num(i), num(span));
diff --git a/signal.c b/signal.c
index cddd46fe..c238514e 100644
--- a/signal.c
+++ b/signal.c
@@ -118,7 +118,8 @@ static void sig_handler(int sig)
static val kill_wrap(val pid, val sig)
{
- cnum p = c_num(pid), s = c_num(default_arg(sig, num_fast(SIGTERM)));
+ val self = lit("kill");
+ cnum p = c_num(pid, self), s = c_num(default_arg(sig, num_fast(SIGTERM)), self);
int res = kill(p, s);
if (opt_compat && opt_compat <= 114)
return num(res);
@@ -127,7 +128,8 @@ static val kill_wrap(val pid, val sig)
static val raise_wrap(val sig)
{
- int res = raise(c_num(sig));
+ val self = lit("raise");
+ int res = raise(c_num(sig, self));
return tnil(res == 0);
}
@@ -260,7 +262,7 @@ val set_sig_handler(val signo, val lambda)
{
static struct sigaction blank;
val self = lit("set-sig-handler");
- cnum sig = c_num(signo);
+ cnum sig = c_num(signo, self);
val old;
small_sigset_t block, saved;
@@ -309,10 +311,11 @@ val set_sig_handler(val signo, val lambda)
val get_sig_handler(val signo)
{
- cnum sig = c_num(signo);
+ val self = lit("get-sig-handler");
+ cnum sig = c_num(signo, self);
if (sig < 0 || sig >= MAX_SIG)
- uw_throwf(error_s, lit("get-sig-handler: signal ~s out of range"), sig, nao);
+ uw_throwf(error_s, lit("~a: signal ~s out of range"), self, sig, nao);
return sig_lambda[sig];
}
@@ -389,9 +392,10 @@ static val tv_to_usec(val sec, val usec)
val getitimer_wrap(val which)
{
+ val self = lit("getitimer");
struct itimerval itv;
- if (getitimer(c_num(which), &itv) < 0)
+ if (getitimer(c_num(which, self), &itv) < 0)
return nil;
return list(tv_to_usec(num_time(itv.it_interval.tv_sec), num(itv.it_interval.tv_usec)),
@@ -401,15 +405,16 @@ val getitimer_wrap(val which)
val setitimer_wrap(val which, val interval, val currval)
{
+ val self = lit("setitimer");
struct itimerval itn, itv;
const val meg = num_fast(1000000);
- itn.it_interval.tv_sec = c_time(trunc(interval, meg));
- itn.it_interval.tv_usec = c_num(mod(interval, meg));
- itn.it_value.tv_sec = c_time(trunc(currval, meg));
- itn.it_value.tv_usec = c_num(mod(currval, meg));
+ itn.it_interval.tv_sec = c_time(trunc(interval, meg), self);
+ itn.it_interval.tv_usec = c_num(mod(interval, meg), self);
+ itn.it_value.tv_sec = c_time(trunc(currval, meg), self);
+ itn.it_value.tv_usec = c_num(mod(currval, meg), self);
- if (setitimer(c_num(which), &itn, &itv) < 0)
+ if (setitimer(c_num(which, self), &itn, &itv) < 0)
return nil;
return list(tv_to_usec(num_time(itv.it_interval.tv_sec), num(itv.it_interval.tv_usec)),
diff --git a/socket.c b/socket.c
index f0c252bf..38cbd7f0 100644
--- a/socket.c
+++ b/socket.c
@@ -163,16 +163,17 @@ static val sockaddr_unpack(int family, struct sockaddr_storage *src)
#if HAVE_GETADDRINFO
-static void addrinfo_in(struct addrinfo *dest, val src)
+static void addrinfo_in(struct addrinfo *dest, val src, val self)
{
- dest->ai_flags = c_num(default_arg(slot(src, flags_s), zero));
- dest->ai_family = c_num(default_arg(slot(src, family_s), zero));
- dest->ai_socktype = c_num(default_arg(slot(src, socktype_s), zero));
- dest->ai_protocol = c_num(default_arg(slot(src, protocol_s), zero));
+ dest->ai_flags = c_num(default_arg(slot(src, flags_s), zero), self);
+ dest->ai_family = c_num(default_arg(slot(src, family_s), zero), self);
+ dest->ai_socktype = c_num(default_arg(slot(src, socktype_s), zero), self);
+ dest->ai_protocol = c_num(default_arg(slot(src, protocol_s), zero), self);
}
static val getaddrinfo_wrap(val node_in, val service_in, val hints_in)
{
+ val self = lit("getaddrinfo");
val node = default_arg(node_in, nil);
val service = default_arg(service_in, nil);
val hints = default_arg(hints_in, nil);
@@ -188,7 +189,7 @@ static val getaddrinfo_wrap(val node_in, val service_in, val hints_in)
if (hints) {
memset(&hints_ai, 0, sizeof hints_ai);
- addrinfo_in(&hints_ai, hints);
+ addrinfo_in(&hints_ai, hints, self);
}
res = getaddrinfo(node_u8, service_u8, phints, &alist);
@@ -209,7 +210,7 @@ static val getaddrinfo_wrap(val node_in, val service_in, val hints_in)
if (node_num_p)
ipv4_addr_from_num(&sa->sin_addr, node);
if (svc_num_p)
- sa->sin_port = htons(c_num(service));
+ sa->sin_port = htons(c_num(service, self));
ptail = list_collect(ptail, sockaddr_in_unpack(sa));
}
break;
@@ -219,7 +220,7 @@ static val getaddrinfo_wrap(val node_in, val service_in, val hints_in)
if (node_num_p)
ipv6_addr_from_num(&sa->sin6_addr, node);
if (svc_num_p)
- sa->sin6_port = ntohs(c_num(service));
+ sa->sin6_port = ntohs(c_num(service, self));
ptail = list_collect(ptail, sockaddr_in6_unpack(sa));
}
break;
@@ -243,7 +244,8 @@ static void addr_mismatch(val addr, val family)
}
static void sockaddr_pack(val sockaddr, val family,
- struct sockaddr_storage *buf, socklen_t *len)
+ struct sockaddr_storage *buf, socklen_t *len,
+ val self)
{
val addr_type = typeof(sockaddr);
@@ -256,7 +258,7 @@ static void sockaddr_pack(val sockaddr, val family,
memset(sa, 0, sizeof *sa);
sa->sin_family = AF_INET;
ipv4_addr_from_num(&sa->sin_addr, addr);
- sa->sin_port = ntohs(c_num(port));
+ sa->sin_port = ntohs(c_num(port, self));
*len = sizeof *sa;
} else if (addr_type == sockaddr_in6_s) {
val addr = slot(sockaddr, addr_s);
@@ -271,7 +273,7 @@ static void sockaddr_pack(val sockaddr, val family,
ipv6_addr_from_num(&sa->sin6_addr, addr);
ipv6_flow_info_from_num(sa, flow);
ipv6_scope_id_from_num(sa, scope);
- sa->sin6_port = ntohs(c_num(port));
+ sa->sin6_port = ntohs(c_num(port, self));
*len = sizeof *sa;
} else if (addr_type == sockaddr_un_s) {
val path = slot(sockaddr, path_s);
@@ -642,8 +644,9 @@ static val dgram_get_sock_peer(val stream)
static val dgram_set_sock_peer(val stream, val peer)
{
+ val self = lit("set-sock-peer");
struct dgram_stream *d = coerce(struct dgram_stream *, stream->co.handle);
- sockaddr_pack(peer, d->family, &d->peer_addr, &d->pa_len);
+ sockaddr_pack(peer, d->family, &d->peer_addr, &d->pa_len, self);
return set(mkloc(d->peer, stream), peer);
}
@@ -677,10 +680,11 @@ static_def(struct strm_ops dgram_strm_ops =
static val sock_bind(val sock, val sockaddr)
{
+ val self = lit("sock-bind");
val sfd = stream_fd(sock);
if (sfd) {
- int fd = c_num(sfd);
+ int fd = c_num(sfd, self);
val family = sock_family(sock);
struct sockaddr_storage sa;
socklen_t salen;
@@ -688,7 +692,7 @@ static val sock_bind(val sock, val sockaddr)
(void) setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &reuse, sizeof(reuse));
- sockaddr_pack(sockaddr, family, &sa, &salen);
+ sockaddr_pack(sockaddr, family, &sa, &salen, self);
if (bind(fd, coerce(struct sockaddr *, &sa), salen) != 0)
uw_throwf(socket_error_s, lit("sock-bind failed: ~d/~s"),
@@ -703,9 +707,9 @@ static val sock_bind(val sock, val sockaddr)
#if HAVE_POLL
-static int fd_timeout(int fd, val timeout, int write)
+static int fd_timeout(int fd, val timeout, int write, val self)
{
- cnum ms = c_num(timeout) / 1000;
+ cnum ms = c_num(timeout, self) / 1000;
int pollms = (ms > INT_MAX) ? INT_MAX : ms;
struct pollfd pfd;
int res;
@@ -728,9 +732,9 @@ static int fd_timeout(int fd, val timeout, int write)
#elif HAVE_SELECT
-static int fd_timeout(int fd, val timeout, int write)
+static int fd_timeout(int fd, val timeout, int write, val self)
{
- cnum us = c_num(timeout);
+ cnum us = c_num(timeout, self);
struct timeval tv;
fd_set fds;
@@ -756,7 +760,7 @@ static int fd_timeout(int fd, val timeout, int write)
#endif
static int to_connect(int fd, struct sockaddr *addr, socklen_t len,
- val sock, val sockaddr, val timeout)
+ val sock, val sockaddr, val timeout, val self)
{
int res;
@@ -780,7 +784,7 @@ static int to_connect(int fd, struct sockaddr *addr, socklen_t len,
break;
}
- res = fd_timeout(fd, timeout, 1);
+ res = fd_timeout(fd, timeout, 1, self);
switch (res) {
case -1:
@@ -805,19 +809,19 @@ static int to_connect(int fd, struct sockaddr *addr, socklen_t len,
return res;
}
-static val open_sockfd(val fd, val family, val type, val mode_str)
+static val open_sockfd(val fd, val family, val type, val mode_str, val self)
{
struct stdio_mode m, m_rpb = stdio_mode_init_rpb;
if (type == num_fast(SOCK_DGRAM)) {
- return make_dgram_sock_stream(c_num(fd), family, nil, 0, 0, 0, 0,
+ return make_dgram_sock_stream(c_num(fd, self), family, nil, 0, 0, 0, 0,
parse_mode(mode_str, m_rpb), 0);
} else {
- FILE *f = (errno = 0, w_fdopen(c_num(fd), c_str(normalize_mode(&m, mode_str, m_rpb))));
+ FILE *f = (errno = 0, w_fdopen(c_num(fd, self), c_str(normalize_mode(&m, mode_str, m_rpb))));
if (!f) {
int eno = errno;
- close(c_num(fd));
+ close(c_num(fd, self));
uw_throwf(errno_to_file_error(eno), lit("error creating stream for socket ~a: ~d/~s"),
fd, num(eno), errno_to_str(eno), nao);
}
@@ -829,6 +833,7 @@ static val open_sockfd(val fd, val family, val type, val mode_str)
static val sock_connect(val sock, val sockaddr, val timeout)
{
+ val self = lit("sock-connect");
val sfd = stream_fd(sock);
if (sfd) {
@@ -836,12 +841,12 @@ static val sock_connect(val sock, val sockaddr, val timeout)
struct sockaddr_storage sa;
socklen_t salen;
- sockaddr_pack(sockaddr, family, &sa, &salen);
+ sockaddr_pack(sockaddr, family, &sa, &salen, self);
- if (to_connect(c_num(sfd), coerce(struct sockaddr *, &sa), salen,
- sock, sockaddr, default_null_arg(timeout)) != 0)
- uw_throwf(socket_error_s, lit("sock-connect ~s to addr ~s: ~d/~s"),
- sock, sockaddr, num(errno), errno_to_str(errno), nao);
+ if (to_connect(c_num(sfd, self), coerce(struct sockaddr *, &sa), salen,
+ sock, sockaddr, default_null_arg(timeout), self) != 0)
+ uw_throwf(socket_error_s, lit("~a: ~s to addr ~s: ~d/~s"),
+ self, sock, sockaddr, num(errno), errno_to_str(errno), nao);
sock_set_peer(sock, sockaddr);
@@ -853,10 +858,10 @@ static val sock_connect(val sock, val sockaddr, val timeout)
return sock;
}
- uw_throwf(socket_error_s, lit("sock-connect: cannot connect ~s"), sock, nao);
+ uw_throwf(socket_error_s, lit("~a: cannot connect ~s"), self, sock, nao);
}
-static val sock_mark_connected(val sock)
+static val sock_mark_connected(val sock, val self)
{
val sfd = stream_fd(sock);
@@ -865,9 +870,9 @@ static val sock_mark_connected(val sock)
struct sockaddr_storage sa = all_zero_init;
socklen_t salen = sizeof sa;
- (void) getpeername(c_num(sfd), coerce(struct sockaddr *, &sa), &salen);
+ (void) getpeername(c_num(sfd, self), coerce(struct sockaddr *, &sa), &salen);
- sock_set_peer(sock, sockaddr_unpack(c_num(family), &sa));
+ sock_set_peer(sock, sockaddr_unpack(c_num(family, self), &sa));
if (sock_type(sock) == num_fast(SOCK_DGRAM)) {
struct dgram_stream *d = coerce(struct dgram_stream *, sock->co.handle);
@@ -882,11 +887,12 @@ static val sock_mark_connected(val sock)
static val sock_listen(val sock, val backlog)
{
+ val self = lit("sock-listen");
val sfd = stream_fd(sock);
if (!sfd)
- uw_throwf(socket_error_s, lit("sock-listen: cannot listen on ~s"),
- sock, nao);
+ uw_throwf(socket_error_s, lit("~a: cannot listen on ~s"),
+ self, sock, nao);
if (sock_type(sock) == num_fast(SOCK_DGRAM)) {
if (sock_peer(sock)) {
@@ -894,20 +900,21 @@ static val sock_listen(val sock, val backlog)
goto failed;
}
} else {
- if (listen(c_num(sfd), c_num(default_arg(backlog, num_fast(16)))))
+ if (listen(c_num(sfd, self), c_num(default_arg(backlog, num_fast(16)), self)))
goto failed;
}
return t;
failed:
- uw_throwf(socket_error_s, lit("sock-listen failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(socket_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
}
static val sock_accept(val sock, val mode_str, val timeout_in)
{
+ val self = lit("sock-accept");
val sfd = stream_fd(sock);
- int fd = sfd ? c_num(sfd) : -1;
+ int fd = sfd ? c_num(sfd, self) : -1;
val family = sock_family(sock);
val type = sock_type(sock);
struct sockaddr_storage sa;
@@ -920,13 +927,13 @@ static val sock_accept(val sock, val mode_str, val timeout_in)
#if HAVE_POLL || HAVE_SELECT
if (timeout) {
- int res = fd_timeout(fd, timeout, 0);
+ int res = fd_timeout(fd, timeout, 0, self);
switch (res) {
case -1:
goto badfd;
case 0:
- uw_throwf(timeout_error_s, lit("sock-accept ~s: timeout"), sock, nao);
+ uw_throwf(timeout_error_s, lit("~a: ~s: timeout"), self, sock, nao);
default:
break;
}
@@ -966,7 +973,7 @@ static val sock_accept(val sock, val mode_str, val timeout_in)
if (nbytes == -1)
goto failed;
- if (nilp(peer = sockaddr_unpack(c_num(family), &sa))) {
+ if (nilp(peer = sockaddr_unpack(c_num(family, self), &sa))) {
free(dgram);
uw_throwf(socket_error_s, lit("sock-accept: ~s isn't a supported socket family"),
family, nao);
@@ -1000,12 +1007,13 @@ static val sock_accept(val sock, val mode_str, val timeout_in)
if (afd < 0)
goto failed;
- if (nilp(peer = sockaddr_unpack(c_num(family), &sa)))
+ if (nilp(peer = sockaddr_unpack(c_num(family, self), &sa)))
uw_throwf(socket_error_s, lit("accept: ~s isn't a supported socket family"),
family, nao);
{
- val stream = open_sockfd(num(afd), family, num_fast(SOCK_STREAM), mode_str);
+ val stream = open_sockfd(num(afd), family, num_fast(SOCK_STREAM),
+ mode_str, self);
sock_set_peer(stream, peer);
return stream;
}
@@ -1020,22 +1028,23 @@ badfd:
static val sock_shutdown(val sock, val how)
{
+ val self = lit("sock-shutdown");
val sfd = stream_fd(sock);
flush_stream(sock);
- if (shutdown(c_num(sfd), c_num(default_arg(how, num_fast(SHUT_WR)))))
- uw_throwf(socket_error_s, lit("shutdown failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ if (shutdown(c_num(sfd, self), c_num(default_arg(how, num_fast(SHUT_WR)), self)))
+ uw_throwf(socket_error_s, lit("~a failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return t;
}
#if defined SO_SNDTIMEO && defined SO_RCVTIMEO
-static val sock_timeout(val sock, val usec, val name, int which)
+static val sock_timeout(val sock, val usec, val name, int which, val self)
{
- cnum fd = c_num(stream_fd(sock));
- cnum u = c_num(usec);
+ cnum fd = c_num(stream_fd(sock), self);
+ cnum u = c_num(usec, self);
struct timeval tv;
tv.tv_sec = u / 1000000;
@@ -1051,25 +1060,29 @@ static val sock_timeout(val sock, val usec, val name, int which)
static val sock_send_timeout(val sock, val usec)
{
- return sock_timeout(sock, usec, lit("sock-send-timeout"), SO_SNDTIMEO);
+ val self = lit("sock-send-timeout");
+ return sock_timeout(sock, usec, self, SO_SNDTIMEO, self);
}
static val sock_recv_timeout(val sock, val usec)
{
- return sock_timeout(sock, usec, lit("sock-recv-timeout"), SO_RCVTIMEO);
+ val self = lit("sock-recv-timeout");
+ return sock_timeout(sock, usec, self, SO_RCVTIMEO, self);
}
#endif
static val open_socket(val family, val type, val mode_str)
{
- int fd = socket(c_num(family), c_num(type), 0);
- return open_sockfd(num(fd), family, type, mode_str);
+ val self = lit("open-socket");
+ int fd = socket(c_num(family, self), c_num(type, self), 0);
+ return open_sockfd(num(fd), family, type, mode_str, self);
}
static val socketpair_wrap(val family, val type, val mode_str)
{
+ val self = lit("open-socket-pair");
int sv[2] = { -1, -1 };
- int res = socketpair(c_num(family), c_num(type), 0, sv);
+ int res = socketpair(c_num(family, self), c_num(type, self), 0, sv);
val out = nil;
uw_simple_catch_begin;
@@ -1079,11 +1092,11 @@ static val socketpair_wrap(val family, val type, val mode_str)
num(errno), errno_to_str(errno), nao);
{
- val s0 = open_sockfd(num(sv[0]), family, type, mode_str);
- val s1 = open_sockfd(num(sv[1]), family, type, mode_str);
+ val s0 = open_sockfd(num(sv[0]), family, type, mode_str, self);
+ val s1 = open_sockfd(num(sv[1]), family, type, mode_str, self);
- sock_mark_connected(s0);
- sock_mark_connected(s1);
+ sock_mark_connected(s0, self);
+ sock_mark_connected(s1, self);
out = list(s0, s1, nao);
}
diff --git a/stream.c b/stream.c
index 9a0ef731..d9bd7992 100644
--- a/stream.c
+++ b/stream.c
@@ -359,6 +359,7 @@ static ucnum generic_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos)
static ucnum generic_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos)
{
+ val self = lit("fill-buf");
struct strm_ops *ops = coerce(struct strm_ops *, stream->co.ops);
ucnum i;
@@ -366,7 +367,7 @@ static ucnum generic_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos)
val byte = ops->get_byte(stream);
if (!byte)
break;
- *ptr++ = c_num(byte);
+ *ptr++ = c_num(byte, self);
}
if (i > len)
@@ -525,8 +526,9 @@ static void stdio_stream_mark(val stream)
val errno_to_string(val err)
{
+ val self = lit("get-error-str");
if (is_num(err))
- return errno_to_str(c_num(err));
+ return errno_to_str(c_num(err, self));
else if (!err)
return lit("no error");
else if (err == t)
@@ -939,8 +941,9 @@ static val stdio_close(val stream, val throw_on_error)
#if HAVE_FTRUNCATE || HAVE_CHSIZE
static val stdio_truncate(val stream, val len)
{
+ val self = lit("truncate-stream");
struct stdio_handle *h = coerce(struct stdio_handle *, stream->co.handle);
- cnum l = c_num(len);
+ cnum l = c_num(len, self);
#if HAVE_FTRUNCATE
typedef off_t trunc_off_t;
int (*truncfun)(int, off_t) = ftruncate;
@@ -2221,6 +2224,7 @@ static val string_out_byte_flush(struct string_out *so, val stream)
static val string_out_put_string(val stream, val str)
{
+ val self = lit("put-string");
struct string_out *so = coerce(struct string_out *, stream->co.handle);
if (so->buf == 0)
@@ -2231,7 +2235,7 @@ static val string_out_put_string(val stream, val str)
{
const wchar_t *s = c_str(str);
- size_t len = c_num(length_str(str));
+ size_t len = c_num(length_str(str), self);
size_t old_size = so->size;
size_t required_size = len + so->fill + 1;
@@ -2252,7 +2256,7 @@ static val string_out_put_string(val stream, val str)
so->fill += len;
return t;
oflow:
- uw_throw(error_s, lit("string output stream overflow"));
+ uw_throwf(error_s, lit("~a: string output stream overflow"), self, nao);
}
}
@@ -2985,7 +2989,7 @@ val unget_char(val ch, val stream_in)
val unget_byte(val byte, val stream_in)
{
val self = lit("unget-byte");
- cnum b = c_num(byte);
+ cnum b = c_num(byte, self);
val stream = default_arg(stream_in, std_input);
struct strm_ops *ops = coerce(struct strm_ops *,
cobj_ops(self, stream, stream_s));
@@ -3001,8 +3005,8 @@ val put_buf(val buf, val pos_in, val stream_in)
{
val self = lit("put-buf");
val stream = default_arg(stream_in, std_output);
- ucnum pos = c_unum(default_arg(pos_in, zero));
- ucnum len = c_unum(length_buf(buf));
+ ucnum pos = c_unum(default_arg(pos_in, zero), self);
+ ucnum len = c_unum(length_buf(buf), self);
mem_t *ptr = buf_get(buf, self);
struct strm_ops *ops = coerce(struct strm_ops *,
cobj_ops(self, stream, stream_s));
@@ -3014,8 +3018,8 @@ val fill_buf(val buf, val pos_in, val stream_in)
{
val self = lit("fill-buf");
val stream = default_arg(stream_in, std_input);
- ucnum pos = c_unum(default_arg(pos_in, zero));
- ucnum len = c_unum(length_buf(buf));
+ ucnum pos = c_unum(default_arg(pos_in, zero), self);
+ ucnum len = c_unum(length_buf(buf), self);
mem_t *ptr = buf_get(buf, self);
struct strm_ops *ops = coerce(struct strm_ops *,
cobj_ops(self, stream, stream_s));
@@ -3026,9 +3030,9 @@ val fill_buf_adjust(val buf, val pos_in, val stream_in)
{
val self = lit("fill-buf-adjust");
val stream = default_arg(stream_in, std_input);
- ucnum pos = c_unum(default_arg(pos_in, zero));
+ ucnum pos = c_unum(default_arg(pos_in, zero), self);
val alloc_size = buf_alloc_size(buf);
- ucnum len = c_unum(alloc_size);
+ ucnum len = c_unum(alloc_size, self);
mem_t *ptr = buf_get(buf, self);
val readpos;
struct strm_ops *ops = coerce(struct strm_ops *,
@@ -3053,7 +3057,7 @@ val get_line_as_buf(val stream_in)
val b = ops->get_byte(stream);
if (b == nil || b == num('\n'))
break;
- bytes[count++] = c_num(b);
+ bytes[count++] = c_num(b, self);
if (count == sizeof bytes) {
buf_put_bytes(buf, length_buf(buf), bytes, count, self);
@@ -3249,7 +3253,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
or2(stream_in, make_string_output_stream()));
val save_indent = get_indent(stream);
val save_mode = nil;
- val name = lit("format");
+ val self = lit("format");
uw_simple_catch_begin;
@@ -3358,7 +3362,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
digits = (digits * 10) + (ch - '0');
if (digits > 999999)
uw_throwf(assert_s, lit("~a: ridiculous precision or field"),
- name, nao);
+ self, nao);
continue;
default:
do_digits:
@@ -3391,15 +3395,15 @@ val formatv(val stream_in, val fmtstr, struct args *al)
}
break;
case vf_star:
- obj = args_get_checked(name, al, &arg_ix);
- digits = c_num(obj);
+ obj = args_get_checked(self, al, &arg_ix);
+ digits = c_num(obj, self);
goto do_digits;
break;
case vf_spec:
state = vf_init;
switch (ch) {
case 'x': case 'X':
- obj = args_get_checked(name, al, &arg_ix);
+ obj = args_get_checked(self, al, &arg_ix);
typ = type(obj);
hex:
if (typ == BGNUM) {
@@ -3409,7 +3413,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
mp_toradix_case(mp(obj), coerce(unsigned char *, pnum), 16, ch == 'x');
} else {
const char *fmt = ch == 'x' ? num_fmt->hex : num_fmt->HEX;
- value = c_num(obj);
+ value = c_num(obj, self);
if (value < 0) {
num_buf[0] = '-';
sprintf(num_buf + 1, fmt, -value);
@@ -3419,7 +3423,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
}
goto output_num;
case 'o': case 'b':
- obj = args_get_checked(name, al, &arg_ix);
+ obj = args_get_checked(self, al, &arg_ix);
typ = type(obj);
oct:
if (typ == BGNUM) {
@@ -3429,10 +3433,10 @@ val formatv(val stream_in, val fmtstr, struct args *al)
pnum = coerce(char *, chk_malloc(nchars + 1));
mp_toradix(mp(obj), coerce(unsigned char *, pnum), rad);
} else if (ch == 'o') {
- cnum value = c_num(obj);
+ cnum value = c_num(obj, self);
sprintf(num_buf, num_fmt->oct, value);
} else {
- cnum val = c_num(obj);
+ cnum val = c_num(obj, self);
int s = (val < 0);
int i = sizeof num_buf;
@@ -3454,7 +3458,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
}
goto output_num;
case 'f': case 'e':
- obj = args_get_checked(name, al, &arg_ix);
+ obj = args_get_checked(self, al, &arg_ix);
{
double n;
@@ -3467,7 +3471,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
n = c_flo(obj, lit("format"));
break;
case NUM:
- n = convert(double, c_num(obj));
+ n = convert(double, c_num(obj, self));
break;
default:
uw_throwf(error_s, lit("format: ~~~a conversion requires "
@@ -3477,7 +3481,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
if (!precision_p) {
if (!dfl_digits)
- dfl_digits = c_num(cdr(lookup_var(nil, print_flo_digits_s)));
+ dfl_digits = c_num(cdr(lookup_var(nil, print_flo_digits_s)), self);
precision = dfl_digits;
}
@@ -3523,16 +3527,16 @@ val formatv(val stream_in, val fmtstr, struct args *al)
goto output_num;
}
case 'd':
- obj = args_get_checked(name, al, &arg_ix);
+ obj = args_get_checked(self, al, &arg_ix);
typ = type(obj);
goto dec;
case 'a': case 's':
- obj = args_get_checked(name, al, &arg_ix);
+ obj = args_get_checked(self, al, &arg_ix);
typ = type(obj);
if (typ == NUM || typ == BGNUM) {
if (!print_base)
- print_base = c_num(cdr(lookup_var(nil, print_base_s)));
+ print_base = c_num(cdr(lookup_var(nil, print_base_s)), self);
switch (print_base) {
case 0:
case 2:
@@ -3553,7 +3557,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
dec:
switch (typ) {
case NUM:
- value = c_num(obj);
+ value = c_num(obj, self);
sprintf(num_buf, num_fmt->dec, value);
goto output_num;
case BGNUM:
@@ -3568,7 +3572,8 @@ val formatv(val stream_in, val fmtstr, struct args *al)
if (!precision_p) {
if (!dfl_precision)
dfl_precision = c_num(cdr(lookup_var(nil,
- print_flo_precision_s)));
+ print_flo_precision_s)),
+ self);
precision = dfl_precision;
}
@@ -3622,7 +3627,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
continue;
case 'p':
{
- val ptr = args_get_checked(name, al, &arg_ix);
+ val ptr = args_get_checked(self, al, &arg_ix);
value = coerce(cnum, ptr);
sprintf(num_buf, num_fmt->hex, value);
}
@@ -3656,7 +3661,7 @@ val formatv(val stream_in, val fmtstr, struct args *al)
}
if (args_more(al, arg_ix))
- uw_throwf(assert_s, lit("~a: excess arguments"), name, nao);
+ uw_throwf(assert_s, lit("~a: excess arguments"), self, nao);
}
@@ -3814,7 +3819,7 @@ val put_byte(val byte, val stream_in)
val stream = default_arg(stream_in, std_output);
struct strm_ops *ops = coerce(struct strm_ops *,
cobj_ops(self, stream, stream_s));
- cnum b = c_num(byte);
+ cnum b = c_num(byte, self);
if (b < 0 || b > 255)
uw_throwf(file_error_s, lit("~a: stream ~s: byte value ~a out of range"),
@@ -3900,7 +3905,7 @@ val test_set_indent_mode(val stream, val compare, val mode)
cobj_handle(self, stream, stream_s));
val oldval = num_fast(s->indent_mode);
if (oldval == compare)
- s->indent_mode = convert(enum indent_mode, c_num(mode));
+ s->indent_mode = convert(enum indent_mode, c_num(mode, self));
return oldval;
}
@@ -3911,7 +3916,7 @@ val test_neq_set_indent_mode(val stream, val compare, val mode)
cobj_handle(self, stream, stream_s));
val oldval = num_fast(s->indent_mode);
if (oldval != compare)
- s->indent_mode = convert(enum indent_mode, c_num(mode));
+ s->indent_mode = convert(enum indent_mode, c_num(mode, self));
return oldval;
}
@@ -3921,7 +3926,7 @@ val set_indent_mode(val stream, val mode)
struct strm_base *s = coerce(struct strm_base *,
cobj_handle(self, stream, stream_s));
val oldval = num_fast(s->indent_mode);
- s->indent_mode = convert(enum indent_mode, c_num(mode));
+ s->indent_mode = convert(enum indent_mode, c_num(mode, self));
return oldval;
}
@@ -3939,7 +3944,7 @@ val set_indent(val stream, val indent)
struct strm_base *s = coerce(struct strm_base *,
cobj_handle(self, stream, stream_s));
val oldval = num(s->indent_chars);
- s->indent_chars = c_num(indent);
+ s->indent_chars = c_num(indent, self);
if (s->indent_chars < 0)
s->indent_chars = 0;
return oldval;
@@ -3952,7 +3957,7 @@ val inc_indent(val stream, val delta)
cobj_handle(self, stream, stream_s));
val oldval = num(s->indent_chars);
val col = num(s->column);
- s->indent_chars = c_num(plus(delta, col));
+ s->indent_chars = c_num(plus(delta, col), self);
if (s->indent_chars < 0)
s->indent_chars = 0;
return oldval;
@@ -3996,7 +4001,7 @@ val set_max_length(val stream, val length)
struct strm_base *s = coerce(struct strm_base *,
cobj_handle(self, stream, stream_s));
cnum old_max = s->max_length;
- s->max_length = c_num(length);
+ s->max_length = c_num(length, self);
return num(old_max);
}
@@ -4006,7 +4011,7 @@ val set_max_depth(val stream, val depth)
struct strm_base *s = coerce(struct strm_base *,
cobj_handle(self, stream, stream_s));
cnum old_max = s->max_depth;
- s->max_depth = c_num(depth);
+ s->max_depth = c_num(depth, self);
return num(old_max);
}
@@ -4087,12 +4092,13 @@ val open_file(val path, val mode_str)
val open_fileno(val fd, val mode_str)
{
+ val self = lit("open-fileno");
struct stdio_mode m, m_r = stdio_mode_init_r;
- FILE *f = (errno = 0, w_fdopen(c_num(fd), c_str(normalize_mode(&m, mode_str, m_r))));
+ FILE *f = (errno = 0, w_fdopen(c_num(fd, self), c_str(normalize_mode(&m, mode_str, m_r))));
if (!f) {
int eno = errno;
- close(c_num(fd));
+ close(c_num(fd, self));
uw_throwf(errno_to_file_error(eno), lit("error opening descriptor ~a: ~d/~s"),
fd, num(eno), errno_to_str(eno), nao);
}
@@ -4139,9 +4145,9 @@ static void fds_init(struct save_fds *fds)
fds->in = fds->out = fds->err = -1;
}
-static int fds_subst(val stream, int fd_std)
+static int fds_subst(val stream, int fd_std, val self)
{
- int fd_orig = c_num(stream_fd(stream));
+ int fd_orig = c_num(stream_fd(stream), self);
if (fd_orig == fd_std)
return -1;
@@ -4159,16 +4165,16 @@ static int fds_subst(val stream, int fd_std)
}
}
-static void fds_swizzle(struct save_fds *fds, int flags)
+static void fds_swizzle(struct save_fds *fds, int flags, val self)
{
if ((flags & FDS_IN) != 0)
- fds->in = fds_subst(std_input, STDIN_FILENO);
+ fds->in = fds_subst(std_input, STDIN_FILENO, self);
if ((flags & FDS_OUT) != 0)
- fds->out = fds_subst(std_output, STDOUT_FILENO);
+ fds->out = fds_subst(std_output, STDOUT_FILENO, self);
if ((flags & FDS_ERR) != 0)
- fds->err = fds_subst(std_error, STDERR_FILENO);
+ fds->err = fds_subst(std_error, STDERR_FILENO, self);
}
static void fds_restore(struct save_fds *fds)
@@ -4192,6 +4198,7 @@ static void fds_restore(struct save_fds *fds)
val open_command(val path, val mode_str)
{
+ val self = lit("open-command");
struct stdio_mode m, m_r = stdio_mode_init_r;
val mode = normalize_mode_no_bin(&m, mode_str, m_r);
int input = m.read != 0;
@@ -4202,14 +4209,14 @@ val open_command(val path, val mode_str)
uw_simple_catch_begin;
- fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR);
+ fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR, self);
f = w_popen(c_str(path), c_str(mode));
if (!f) {
int eno = errno;
- uw_throwf(errno_to_file_error(eno), lit("error opening pipe ~s: ~d/~s"),
- path, num(eno), errno_to_str(eno), nao);
+ uw_throwf(errno_to_file_error(eno), lit("~a: error opening pipe ~s: ~d/~s"),
+ self, path, num(eno), errno_to_str(eno), nao);
}
uw_unwind {
@@ -4238,7 +4245,7 @@ static val open_subprocess(val name, val mode_str, val args, val fun)
args = default_null_arg(args);
fun = default_null_arg(fun);
- nargs = c_num(length(args)) + 1;
+ nargs = c_num(length(args), self) + 1;
if (!name && !fun)
uw_throwf(error_s, lit("~a: program name and/or function required"), self, nao);
@@ -4247,7 +4254,7 @@ static val open_subprocess(val name, val mode_str, val args, val fun)
uw_simple_catch_begin;
- fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR);
+ fds_swizzle(&sfds, (input ? FDS_IN : FDS_OUT) | FDS_ERR, self);
if (nargs < 0 || nargs == INT_MAX)
uw_throwf(error_s, lit("~a: argument list overflow"), self, nao);
@@ -4512,7 +4519,7 @@ static val run(val command, val args)
struct save_fds sfds;
args = default_null_arg(args);
- nargs = c_num(length(args)) + 1;
+ nargs = c_num(length(args), self) + 1;
fds_init(&sfds);
@@ -4566,7 +4573,7 @@ static val run(val name, val args)
val ret = nil;
args = default_null_arg(args);
- nargs = c_num(length(args)) + 1;
+ nargs = c_num(length(args), self) + 1;
if (nargs < 0 || nargs == INT_MAX)
uw_throwf(error_s, lit("~a: argument list overflow"), self, nao);
@@ -4583,7 +4590,7 @@ static val run(val name, val args)
uw_simple_catch_begin;
- fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR);
+ fds_swizzle(&sfds, FDS_IN | FDS_OUT | FDS_ERR, self);
pid = fork();
@@ -4756,8 +4763,9 @@ static void detect_path_separators(void)
val base_name(val path, val suff)
{
+ val self = lit("base-name");
const wchar_t *wpath = c_str(path);
- const wchar_t *end = wpath + c_num(length_str(path));
+ const wchar_t *end = wpath + c_num(length_str(path), self);
const wchar_t *rsep;
const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars));
@@ -4778,7 +4786,7 @@ val base_name(val path, val suff)
{
val base = mkustring(num_fast(end - rsep));
- init_str(base, rsep);
+ init_str(base, rsep, self);
return if3(!null_or_missing_p(suff) && ends_with(suff, base, nil, nil) &&
neql(length(suff), length(base)),
sub(base, zero, neg(length(suff))),
@@ -4788,8 +4796,9 @@ val base_name(val path, val suff)
val dir_name(val path)
{
+ val self = lit("dir-name");
const wchar_t *wpath = c_str(path);
- const wchar_t *rsep = wpath + c_num(length_str(path));
+ const wchar_t *rsep = wpath + c_num(length_str(path), self);
const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars));
if (rsep == wpath)
@@ -4817,7 +4826,7 @@ val dir_name(val path)
{
val base = mkustring(num_fast(rsep - wpath - 1));
- return init_str(base, wpath);
+ return init_str(base, wpath, self);
}
}
diff --git a/struct.c b/struct.c
index 95b72b9f..2da353d6 100644
--- a/struct.c
+++ b/struct.c
@@ -388,13 +388,14 @@ val make_struct_type(val name, val supers,
} else {
struct struct_type *st = coerce(struct struct_type *,
chk_malloc(sizeof *st));
- cnum nsupers = c_num(length(supers));
+ cnum nsupers = c_num(length(supers), self);
struct struct_type **sus = get_struct_handles(nsupers, supers, self);
val id = num_fast(coerce(ucnum, st) / (uptopow2(sizeof *st) / 2));
val super_slots = get_super_slots(nsupers, sus);
val all_slots = uniq(append2(super_slots, append2(static_slots, slots)));
cnum stsl_upb = c_num(plus(length(static_slots),
- num(count_super_stslots(nsupers, sus, self))));
+ num(count_super_stslots(nsupers, sus, self))),
+ self);
val stype = cobj(coerce(mem_t *, st), struct_type_s, &struct_type_ops);
val iter;
cnum sl, stsl, i;
@@ -402,7 +403,7 @@ val make_struct_type(val name, val supers,
st->self = stype;
st->name = name;
- st->id = c_num(id);
+ st->id = c_num(id, self);
st->nslots = st->nstslots = 0;
st->slots = all_slots;
st->nsupers = nsupers;
@@ -544,7 +545,7 @@ val struct_set_postinitfun(val type, val fun)
val super(val type, val idx)
{
val self = lit("super");
- cnum ix = c_num(default_arg(idx, zero));
+ cnum ix = c_num(default_arg(idx, zero), self);
if (ix < 0)
uw_throwf(error_s,
@@ -1535,10 +1536,11 @@ static val method_fun(val env, varg args)
static val method_args_fun(val dargs, varg args)
{
+ val self = lit("method");
struct args *da = dargs->a.args;
val fun = dargs->a.car;
val strct = dargs->a.cdr;
- cnum da_nargs = da->fill + c_num(length(da->list));
+ cnum da_nargs = da->fill + c_num(length(da->list), self);
args_decl(args_call, max(args->fill + 1 + da_nargs, ARGS_MIN));
args_add(args_call, strct);
args_cat(args_call, da);
@@ -1621,7 +1623,7 @@ static val umethod_args_fun(val dargs, struct args *args)
uw_throwf(error_s, lit("~a: object argument required to call ~s"),
self, env, nao);
} else {
- cnum da_nargs = da->fill + c_num(length(da->list));
+ cnum da_nargs = da->fill + c_num(length(da->list), self);
cnum index = 0;
val strct = args_get(args, &index);
args_decl(args_call, max(args->fill + da_nargs, ARGS_MIN));
diff --git a/strudel.c b/strudel.c
index 4c19f581..d362c335 100644
--- a/strudel.c
+++ b/strudel.c
@@ -120,22 +120,24 @@ static val strudel_unget_byte(val stream, int byte)
static ucnum strudel_put_buf(val stream, mem_t *ptr, ucnum len, ucnum pos)
{
+ val self = lit("put-buf");
struct strudel_base *sb = coerce(struct strudel_base *, stream->co.handle);
obj_t buf_obj;
val buf = init_borrowed_buf(&buf_obj, unum(len), ptr);
val obj = sb->obj;
val meth = slot(obj, put_buf_s);
- return c_unum(funcall3(meth, obj, buf, num(pos)));
+ return c_unum(funcall3(meth, obj, buf, num(pos)), self);
}
static ucnum strudel_fill_buf(val stream, mem_t *ptr, ucnum len, ucnum pos)
{
+ val self = lit("fill-buf");
struct strudel_base *sb = coerce(struct strudel_base *, stream->co.handle);
obj_t buf_obj;
val buf = init_borrowed_buf(&buf_obj, unum(len), ptr);
val obj = sb->obj;
val meth = slot(obj, fill_buf_s);
- return c_unum(funcall3(meth, obj, buf, num(pos)));
+ return c_unum(funcall3(meth, obj, buf, num(pos)), self);
}
static val strudel_close(val stream, val throw_on_error)
diff --git a/sysif.c b/sysif.c
index 7d383162..21bf00b4 100644
--- a/sysif.c
+++ b/sysif.c
@@ -135,9 +135,10 @@ static val at_exit_list;
static val errno_wrap(val newval)
{
+ val self = lit("errno");
val oldval = num(errno);
if (default_null_arg(newval))
- errno = c_num(newval);
+ errno = c_num(newval, self);
return oldval;
}
@@ -185,6 +186,7 @@ static val daemon_wrap(val nochdir, val noclose)
static val exit_wrap(val status)
{
+ val self = lit("exit");
int stat;
if missingp(status)
@@ -194,7 +196,7 @@ static val exit_wrap(val status)
else if (status == t)
stat = EXIT_SUCCESS;
else
- stat = c_num(status);
+ stat = c_num(status, self);
exit(stat);
/* notreached */
@@ -229,8 +231,9 @@ static val abort_wrap(void)
val usleep_wrap(val usec)
{
+ val self = lit("usleep");
val retval;
- cnum u = c_num(usec);
+ cnum u = c_num(usec, self);
sig_save_enable;
@@ -307,7 +310,8 @@ val errno_to_file_error(int err)
#if HAVE_MKDIR
static val mkdir_wrap(val path, val mode)
{
- cnum cmode = c_num(default_arg(mode, num_fast(0777)));
+ val self = lit("mkdir");
+ cnum cmode = c_num(default_arg(mode, num_fast(0777)), self);
char *u8path = utf8_dup_to(c_str(path));
int err = mkdir(u8path, cmode);
free(u8path);
@@ -423,6 +427,7 @@ static val mkdir_nothrow_exists(val path, val mode)
static val ensure_dir(val path, val mode)
{
+ val self = lit("ensure-dir");
#if HAVE_WINDOWS_H
val sep = lit("\\");
val sep_set = lit("\\/");
@@ -445,7 +450,7 @@ static val ensure_dir(val path, val mode)
}
if (integerp(ret)) {
- int eno = c_num(ret);
+ int eno = c_num(ret, self);
uw_throwf(errno_to_file_error(eno),
lit("ensure-dir: ~a: ~d/~s"), path, ret,
errno_to_str(eno), nao);
@@ -517,17 +522,20 @@ static val rmdir_wrap(val path)
static val makedev_wrap(val major, val minor)
{
- return num(makedev(c_num(major), c_num(minor)));
+ val self = lit("makedev");
+ return num(makedev(c_num(major, self), c_num(minor, self)));
}
static val minor_wrap(val dev)
{
- return num(minor(c_num(dev)));
+ val self = lit("minor");
+ return num(minor(c_num(dev, self)));
}
static val major_wrap(val dev)
{
- return num(major(c_num(dev)));
+ val self = lit("major");
+ return num(major(c_num(dev, self)));
}
#endif
@@ -536,8 +544,9 @@ static val major_wrap(val dev)
static val mknod_wrap(val path, val mode, val dev)
{
- cnum cmode = c_num(mode);
- cnum cdev = c_num(default_arg(dev, zero));
+ val self = lit("mknod");
+ cnum cmode = c_num(mode, self);
+ cnum cdev = c_num(default_arg(dev, zero), self);
char *u8path = utf8_dup_to(c_str(path));
int err = mknod(u8path, cmode, cdev);
free(u8path);
@@ -564,7 +573,8 @@ static val mknod_wrap(val path, val mode, val dev)
static val mkfifo_wrap(val path, val mode)
{
- cnum cmode = c_num(mode);
+ val self = lit("mkfifo");
+ cnum cmode = c_num(mode, self);
char *u8path = utf8_dup_to(c_str(path));
int err = mkfifo(u8path, cmode);
free(u8path);
@@ -599,7 +609,7 @@ static val chmod_wrap(val target, val mode)
int fd = if3(u8path, -1, get_fd(target, self));
if (integerp(mode)) {
- cmode = c_num(mode);
+ cmode = c_num(mode, self);
} else if (stringp(mode)) {
#if HAVE_SYS_STAT
struct stat st;
@@ -766,8 +776,8 @@ inval:
static val do_chown(val target, val uid, val gid, val link_p, val self)
{
- cnum cuid = c_num(uid);
- cnum cgid = c_num(gid);
+ cnum cuid = c_num(uid, self);
+ cnum cgid = c_num(gid, self);
int err;
if (stringp(target)) {
@@ -879,8 +889,8 @@ static void flock_pack(val self, val in, struct flock *out)
{
out->l_type = c_short(slot(in, type_s), self);
out->l_whence = c_short(slot(in, whence_s), self);
- out->l_start = c_num(slot(in, start_s));
- out->l_len = c_num(slot(in, len_s));
+ out->l_start = c_num(slot(in, start_s), self);
+ out->l_len = c_num(slot(in, len_s), self);
}
static void flock_unpack(val out, struct flock *in)
@@ -952,69 +962,79 @@ static val fork_wrap(void)
static val wait_wrap(val pid, val flags)
{
- cnum p = c_num(default_arg(pid, negone));
- cnum f = c_num(default_arg(flags, zero));
+ val self = lit("wait");
+ cnum p = c_num(default_arg(pid, negone), self);
+ cnum f = c_num(default_arg(flags, zero), self);
int status = 0, result = waitpid(p, &status, f);
return if2(result >= 0, cons(num(result), num(status)));
}
static val wifexited(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wifexited");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return tnil(WIFEXITED(s));
}
static val wexitstatus(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wexitstatus");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return num(WEXITSTATUS(s));
}
static val wifsignaled(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wifsignaled");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return tnil(WIFSIGNALED(s));
}
static val wtermsig(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wtermsig");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return num(WTERMSIG(s));
}
#ifdef WCOREDUMP
static val wcoredump(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wcoredump");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return tnil(WCOREDUMP(s));
}
#endif
static val wifstopped(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wifstopped");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return tnil(WIFSTOPPED(s));
}
static val wstopsig(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wstopsig");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return num(WSTOPSIG(s));
}
#ifdef WIFCONTINUED
static val wifcontinued(val status)
{
- int s = c_num(if3(consp(status), cdr(status), status));
+ val self = lit("wifcontinued");
+ int s = c_num(if3(consp(status), cdr(status), status), self);
return tnil(WIFCONTINUED(s));
}
#endif
static val dup_wrap(val old, val neu)
{
+ val self = lit("dupfd");
if (missingp(neu))
- return num(dup(c_num(old)));
- return num(dup2(c_num(old), c_num(neu)));
+ return num(dup(c_num(old, self)));
+ return num(dup2(c_num(old, self), c_num(neu, self)));
}
static val close_wrap(val fd, val throw_on_error)
@@ -1037,7 +1057,7 @@ val exec_wrap(val file, val args_opt)
{
val self = lit("execvp");
val args = default_null_arg(args_opt);
- int nargs = c_num(length(args)) + 1;
+ int nargs = c_num(length(args), self) + 1;
char **argv = if3(nargs < 0 || nargs == INT_MAX,
(uw_throwf(process_error_s, lit("~a: argument list overflow"),
self, nao), convert(char **, 0)),
@@ -1059,6 +1079,7 @@ val exec_wrap(val file, val args_opt)
static val exit_star_wrap(val status)
{
+ val self = lit("exit*");
int stat;
if (status == nil)
@@ -1066,7 +1087,7 @@ static val exit_star_wrap(val status)
else if (status == t)
stat = EXIT_SUCCESS;
else
- stat = c_num(status);
+ stat = c_num(status, self);
_exit(stat);
/* notreached */
@@ -1075,9 +1096,9 @@ static val exit_star_wrap(val status)
#endif
-time_t c_time(val time)
+time_t c_time(val time, val self)
{
- return if3(convert(time_t, -1) > 0, (time_t) c_unum(time), (time_t) c_num(time));
+ return if3(convert(time_t, -1) > 0, (time_t) c_unum(time, self), (time_t) c_num(time, self));
}
val num_time(time_t time)
@@ -1197,18 +1218,18 @@ static val do_utimes(val target, val atime, val atimens,
#if HAVE_FUTIMENS
int flags = if3(symlink_nofollow, AT_SYMLINK_NOFOLLOW, 0);
struct timespec times[2];
- times[0].tv_sec = c_time(atime);
+ times[0].tv_sec = c_time(atime, self);
times[0].tv_nsec = timens(atimens, self);
- times[1].tv_sec = c_time(mtime);
+ times[1].tv_sec = c_time(mtime, self);
times[1].tv_nsec = timens(mtimens, self);
res = utimensat(AT_FDCWD, u8path, times, flags);
#else
errno = -EINVAL;
if (integerp(atimens) || integerp(mtimens)) {
struct timeval times[2];
- times[0].tv_sec = c_time(atime);
+ times[0].tv_sec = c_time(atime, self);
times[0].tv_usec = c_long(trunc(atimens, num_fast(1000)), self);
- times[1].tv_sec = c_time(mtime);
+ times[1].tv_sec = c_time(mtime, self);
times[1].tv_usec = c_long(trunc(mtimens, num_fast(1000)), self);
if (symlink_nofollow) {
#if HAVE_LUTIMES
@@ -1231,9 +1252,9 @@ static val do_utimes(val target, val atime, val atimens,
#if HAVE_FUTIMENS
struct timespec times[2];
int fd = get_fd(target, self);
- times[0].tv_sec = c_time(atime);
+ times[0].tv_sec = c_time(atime, self);
times[0].tv_nsec = timens(atimens, self);
- times[1].tv_sec = c_time(mtime);
+ times[1].tv_sec = c_time(mtime, self);
times[1].tv_nsec = timens(mtimens, self);
res = futimens(fd, times);
#elif HAVE_FUTIMES
@@ -1241,9 +1262,9 @@ static val do_utimes(val target, val atime, val atimens,
int fd = get_fd(target, self);
errno = -EINVAL;
if (integerp(atimens) || integerp(mtimens)) {
- times[0].tv_sec = c_time(atime);
+ times[0].tv_sec = c_time(atime, self);
times[0].tv_usec = c_long(trunc(atimens, num_fast(1000)), self);
- times[1].tv_sec = c_time(mtime);
+ times[1].tv_sec = c_time(mtime, self);
times[1].tv_usec = c_long(trunc(mtimens, num_fast(1000)), self);
res = futimes(fd, times);
}
@@ -1282,12 +1303,14 @@ static val wrap_lutimes(val target, val atime, val atimens,
val umask_wrap(val mask)
{
+ val self = lit("umask");
+
if (missingp(mask)) {
mode_t m = umask(0777);
(void) umask(m);
return num(m);
}
- return num(umask(c_num(mask)));
+ return num(umask(c_num(mask, self)));
}
#endif
@@ -1344,7 +1367,8 @@ static val unsetenv_wrap(val name)
static val poll_wrap(val poll_list, val timeout_in)
{
- nfds_t i, len = c_num(length(poll_list));
+ val self = lit("poll");
+ nfds_t i, len = c_num(length(poll_list), self);
val iter;
struct pollfd *pfd = coerce(struct pollfd *, alloca(len * sizeof *pfd));
val timeout = default_arg(timeout_in, negone);
@@ -1353,11 +1377,11 @@ static val poll_wrap(val poll_list, val timeout_in)
for (i = 0, iter = poll_list; iter; iter = cdr(iter), i++) {
cons_bind (obj, events, car(iter));
- pfd[i].events = c_num(events);
+ pfd[i].events = c_num(events, self);
switch (type(obj)) {
case NUM:
- pfd[i].fd = c_num(obj);
+ pfd[i].fd = c_num(obj, self);
break;
case COBJ:
if (subtypep(obj->co.cls, stream_s)) {
@@ -1368,7 +1392,7 @@ static val poll_wrap(val poll_list, val timeout_in)
lit("poll: stream ~s doesn't have a file descriptor"),
obj, nao);
}
- pfd[i].fd = c_num(fdval);
+ pfd[i].fd = c_num(fdval, self);
break;
}
/* fallthrough */
@@ -1383,7 +1407,7 @@ static val poll_wrap(val poll_list, val timeout_in)
sig_save_enable;
- res = poll(pfd, len, c_num(timeout));
+ res = poll(pfd, len, c_num(timeout, self));
sig_restore_enable;
@@ -1463,7 +1487,8 @@ static val getgroups_wrap(void)
static val setuid_wrap(val nval)
{
- if (setuid(c_num(nval)) == -1)
+ val self = lit("setuid");
+ if (setuid(c_num(nval, self)) == -1)
uw_throwf(system_error_s, lit("setuid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1471,7 +1496,8 @@ static val setuid_wrap(val nval)
static val seteuid_wrap(val nval)
{
- if (seteuid(c_num(nval)) == -1)
+ val self = lit("seteuid");
+ if (seteuid(c_num(nval, self)) == -1)
uw_throwf(system_error_s, lit("seteuid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1479,7 +1505,8 @@ static val seteuid_wrap(val nval)
static val setgid_wrap(val nval)
{
- if (setgid(c_num(nval)) == -1)
+ val self = lit("setgid");
+ if (setgid(c_num(nval, self)) == -1)
uw_throwf(system_error_s, lit("setgid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1487,7 +1514,8 @@ static val setgid_wrap(val nval)
static val setegid_wrap(val nval)
{
- if (setegid(c_num(nval)) == -1)
+ val self = lit("setegid");
+ if (setegid(c_num(nval, self)) == -1)
uw_throwf(system_error_s, lit("setegid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1581,6 +1609,8 @@ void drop_privilege(void)
void simulate_setuid_setgid(val open_script)
{
+ val self = lit("txr");
+
if (repress_called != RC_MAGIC || (is_setuid && seteuid(orig_euid) != 0))
abort();
@@ -1592,7 +1622,7 @@ void simulate_setuid_setgid(val open_script)
if (fdv) {
struct stat stb;
- cnum fd = c_num(fdv);
+ cnum fd = c_num(fdv, self);
if (fstat(fd, &stb) != 0)
goto drop;
@@ -1620,7 +1650,7 @@ drop:
static val setgroups_wrap(val list)
{
val self = lit("setgroups");
- ucnum len = c_num(length(list));
+ ucnum len = c_num(length(list), self);
if (convert(ucnum, convert(size_t, len)) != len) {
uw_throwf(system_error_s, lit("~a: list too long"), self, nao);
@@ -1629,7 +1659,7 @@ static val setgroups_wrap(val list)
int i = 0, res;
for (; list; i++, list = cdr(list)) {
- cnum gid = c_num(car(list));
+ cnum gid = c_num(car(list), self);
arr[i] = gid;
}
@@ -1669,7 +1699,8 @@ static val getresgid_wrap(void)
static val setresuid_wrap(val r, val e, val s)
{
- if (setresuid(c_num(r), c_num(e), c_num(s)) != 0)
+ val self = lit("setresuid");
+ if (setresuid(c_num(r, self), c_num(e, self), c_num(s, self)) != 0)
uw_throwf(system_error_s, lit("setresuid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1677,7 +1708,8 @@ static val setresuid_wrap(val r, val e, val s)
static val setresgid_wrap(val r, val e, val s)
{
- if (setresuid(c_num(r), c_num(e), c_num(s)) != 0)
+ val self = lit("setresgid");
+ if (setresuid(c_num(r, self), c_num(e, self), c_num(s, self)) != 0)
uw_throwf(system_error_s, lit("setresuid failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return t;
@@ -1733,9 +1765,10 @@ static val getpwent_wrap(void)
static val getpwuid_wrap(val uid)
{
+ val self = lit("getpwuid");
char buf[1024];
struct passwd pw, *p;
- int res = getpwuid_r(c_num(uid), &pw, buf, sizeof buf, &p);
+ int res = getpwuid_r(c_num(uid, self), &pw, buf, sizeof buf, &p);
return (res == 0 && p != 0) ? make_pwstruct(&pw) : nil;
}
@@ -1761,7 +1794,7 @@ static val getpwent_wrap(void)
static val getpwuid_wrap(val uid)
{
- struct passwd *p = getpwuid(c_num(uid));
+ struct passwd *p = getpwuid(c_num(uid, self));
return (p != 0) ? make_pwstruct(p) : nil;
}
@@ -1826,9 +1859,10 @@ static val getgrent_wrap(void)
static val getgrgid_wrap(val uid)
{
+ val self = lit("getgrgid");
char buf[1024];
struct group gr, *g;
- int res = getgrgid_r(c_num(uid), &gr, buf, sizeof buf, &g);
+ int res = getgrgid_r(c_num(uid, self), &gr, buf, sizeof buf, &g);
return (res == 0 && g != 0) ? make_grstruct(&gr) : nil;
}
@@ -1848,7 +1882,7 @@ static val getgrnam_wrap(val wname)
static val getgrgid_wrap(val uid)
{
- struct group *g = getgrgid(c_num(uid));
+ struct group *g = getgrgid(c_num(uid, self));
return (g != 0) ? make_grstruct(g) : nil;
}
@@ -1997,9 +2031,10 @@ int stdio_fseek(FILE *f, val off, int whence)
#if HAVE_FNMATCH
static val fnmatch_wrap(val pattern, val string, val flags)
{
+ val self = lit("fnmatch");
const wchar_t *pattern_ws = c_str(pattern);
const wchar_t *string_ws = c_str(string);
- cnum c_flags = c_num(default_arg(flags, zero));
+ cnum c_flags = c_num(default_arg(flags, zero), self);
char *pattern_u8 = utf8_dup_to(pattern_ws);
char *string_u8 = utf8_dup_to(string_ws);
int res = fnmatch(pattern_u8, string_u8, c_flags);
@@ -2057,10 +2092,11 @@ static struct cobj_ops cptr_dl_ops = cobj_ops_init(cobj_equal_handle_op,
static val dlopen_wrap(val name, val flags)
{
+ val self = lit("dlopen");
const wchar_t *name_ws = if3(null_or_missing_p(name),
0, c_str(name));
char *name_u8 = if3(name_ws != 0, utf8_dup_to(name_ws), 0);
- cnum f = if3(missingp(flags), RTLD_LAZY, c_num(flags));
+ cnum f = if3(missingp(flags), RTLD_LAZY, c_num(flags, self));
mem_t *ptr = coerce(mem_t *, (dlerror(), dlopen(name_u8, f)));
free(name_u8);
if (ptr == 0) {
diff --git a/sysif.h b/sysif.h
index 98ba91be..f61ad6f4 100644
--- a/sysif.h
+++ b/sysif.h
@@ -44,7 +44,7 @@ val usleep_wrap(val usec);
#if HAVE_FORK_STUFF
val exec_wrap(val file, val args_opt);
#endif
-time_t c_time(val time);
+time_t c_time(val time, val self);
val num_time(time_t time);
#if HAVE_SYS_STAT
struct stat;
diff --git a/syslog.c b/syslog.c
index 4f087566..ebb6cdc9 100644
--- a/syslog.c
+++ b/syslog.c
@@ -89,9 +89,10 @@ void syslog_init(void)
val openlog_wrap(val wident, val optmask, val facility)
{
+ val self = lit("openlog");
static char *ident;
- cnum coptmask = c_num(default_arg(optmask, zero));
- cnum cfacility = c_num(default_arg(facility, num_fast(LOG_USER)));
+ cnum coptmask = c_num(default_arg(optmask, zero), self);
+ cnum cfacility = c_num(default_arg(facility, num_fast(LOG_USER)), self);
char *old_ident = ident;
ident = utf8_dup_to(c_str(wident));
@@ -105,13 +106,15 @@ val openlog_wrap(val wident, val optmask, val facility)
val setlogmask_wrap(val mask)
{
- return num(setlogmask(c_num(mask)));
+ val self = lit("setlogmask");
+ return num(setlogmask(c_num(mask, self)));
}
val syslog_wrapv(val prio, val fmt, struct args *args)
{
+ val self = lit("syslog");
val text = formatv(nil, fmt, args);
- cnum cprio = c_num(prio);
+ cnum cprio = c_num(prio, self);
char *u8text = utf8_dup_to(c_str(text));
syslog(cprio, "%s", u8text);
return nil;
diff --git a/termios.c b/termios.c
index ea73365c..cce146c2 100644
--- a/termios.c
+++ b/termios.c
@@ -207,22 +207,22 @@ static val termios_unpack(struct termios *in)
return out;
}
-static void termios_pack(struct termios *out, val in)
+static void termios_pack(struct termios *out, val in, val self)
{
int i, cc_sz = convert(int, sizeof out->c_cc / sizeof out->c_cc[0]);
val cc = slot(in, cc_s);
- out->c_iflag = c_num(slot(in, iflag_s));
- out->c_oflag = c_num(slot(in, oflag_s));
- out->c_cflag = c_num(slot(in, cflag_s));
- out->c_lflag = c_num(slot(in, lflag_s));
+ out->c_iflag = c_num(slot(in, iflag_s), self);
+ out->c_oflag = c_num(slot(in, oflag_s), self);
+ out->c_cflag = c_num(slot(in, cflag_s), self);
+ out->c_lflag = c_num(slot(in, lflag_s), self);
- cfsetispeed(out, termios_baud_to_speed(c_num(slot(in, ispeed_s))));
- cfsetospeed(out, termios_baud_to_speed(c_num(slot(in, ospeed_s))));
+ cfsetispeed(out, termios_baud_to_speed(c_num(slot(in, ispeed_s), self)));
+ cfsetospeed(out, termios_baud_to_speed(c_num(slot(in, ospeed_s), self)));
for (i = 0; i < cc_sz; i++) {
val ch = vecref(cc, num_fast(i));
- cnum c = c_num(ch);
+ cnum c = c_num(ch, self);
out->c_cc[i] = c;
@@ -249,39 +249,41 @@ static val get_fd(val stream)
static val tcgetattr_wrap(val stream)
{
+ val self = lit("tcgetattr");
struct termios tio;
int res;
val fd = get_fd(stream);
- res = tcgetattr(c_num(fd), &tio);
+ res = tcgetattr(c_num(fd, self), &tio);
if (res < 0)
- uw_throwf(system_error_s, lit("tcgetattr failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return termios_unpack(&tio);
}
static val tcsetattr_wrap(val termios, val actions, val stream)
{
+ val self = lit("tcsetattr");
struct termios tio;
int res;
val fd = get_fd(stream);
actions = default_arg(actions, num(TCSADRAIN));
- res = tcgetattr(c_num(fd), &tio);
+ res = tcgetattr(c_num(fd, self), &tio);
if (res < 0)
- uw_throwf(system_error_s, lit("tcgetattr failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed to retrieve settings: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
- termios_pack(&tio, termios);
+ termios_pack(&tio, termios, self);
- res = tcsetattr(c_num(fd), c_num(actions), &tio);
+ res = tcsetattr(c_num(fd, self), c_num(actions, self), &tio);
if (res < 0)
- uw_throwf(system_error_s, lit("tcsetattr failed: ~d/~s"),
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
num(errno), errno_to_str(errno), nao);
return termios;
@@ -289,61 +291,66 @@ static val tcsetattr_wrap(val termios, val actions, val stream)
static val tcsendbreak_wrap(val duration, val stream)
{
+ val self = lit("tcsendbreak");
val fd = get_fd(stream);
- int res = tcsendbreak(c_num(fd), if3(missingp(duration),
- 500, c_num(duration)));
+ int res = tcsendbreak(c_num(fd, self), if3(missingp(duration),
+ 500, c_num(duration, self)));
if (res < 0)
- uw_throwf(system_error_s, lit("tcsendbreak failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return t;
}
static val tcdrain_wrap(val stream)
{
+ val self = lit("tcdrain");
val fd = get_fd(stream);
- int res = tcdrain(c_num(fd));
+ int res = tcdrain(c_num(fd, self));
if (res < 0)
- uw_throwf(system_error_s, lit("tcdrain failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return t;
}
static val tcflush_wrap(val queue, val stream)
{
+ val self = lit("tcflush");
val fd = get_fd(stream);
- int res = tcflush(c_num(fd), c_num(queue));
+ int res = tcflush(c_num(fd, self), c_num(queue, self));
if (res < 0)
- uw_throwf(system_error_s, lit("tcflush failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return t;
}
static val tcflow_wrap(val action, val stream)
{
+ val self = lit("tcflush");
val fd = get_fd(stream);
- int res = tcflow(c_num(fd), c_num(action));
+ int res = tcflow(c_num(fd, self), c_num(action, self));
if (res < 0)
- uw_throwf(system_error_s, lit("tcflow failed: ~d/~s"),
- num(errno), errno_to_str(errno), nao);
+ uw_throwf(system_error_s, lit("~a: failed: ~d/~s"),
+ self, num(errno), errno_to_str(errno), nao);
return t;
}
static val encode_speeds(val termios)
{
+ val self = lit("encode-speeds");
struct termios tio = all_zero_init;
- tio.c_iflag = c_num(slot(termios, iflag_s));
- tio.c_cflag = c_num(slot(termios, cflag_s));
- cfsetispeed(&tio, termios_baud_to_speed(c_num(slot(termios, ispeed_s))));
- cfsetospeed(&tio, termios_baud_to_speed(c_num(slot(termios, ospeed_s))));
+ tio.c_iflag = c_num(slot(termios, iflag_s), self);
+ tio.c_cflag = c_num(slot(termios, cflag_s), self);
+ cfsetispeed(&tio, termios_baud_to_speed(c_num(slot(termios, ispeed_s), self)));
+ cfsetospeed(&tio, termios_baud_to_speed(c_num(slot(termios, ospeed_s), self)));
slotset(termios, iflag_s, num(tio.c_iflag));
slotset(termios, cflag_s, num(tio.c_cflag));
@@ -352,10 +359,11 @@ static val encode_speeds(val termios)
static val decode_speeds(val termios)
{
+ val self = lit("decode-speeds");
struct termios tio = all_zero_init;
- tio.c_cflag = c_num(slot(termios, cflag_s));
- tio.c_iflag = c_num(slot(termios, iflag_s));
+ tio.c_cflag = c_num(slot(termios, cflag_s), self);
+ tio.c_iflag = c_num(slot(termios, iflag_s), self);
slotset(termios, ispeed_s, num(termios_speed_to_baud(cfgetispeed(&tio))));
slotset(termios, ospeed_s, num(termios_speed_to_baud(cfgetospeed(&tio))));
diff --git a/txr.c b/txr.c
index a5dacc3d..760b7814 100644
--- a/txr.c
+++ b/txr.c
@@ -418,7 +418,7 @@ static int do_fixnum_opt(int (*opt_func)(val), val opt, val arg)
static int compat(val optval)
{
- int compat = c_num(optval);
+ int compat = c_num(optval, lit("txr"));
int min = compat_fixup(compat);
if (min) {
@@ -436,14 +436,14 @@ static int compat(val optval)
static int array_dim(val optval)
{
- opt_arraydims = c_num(optval);
+ opt_arraydims = c_num(optval, lit("txr"));
opt_print_bindings = 1;
return 1;
}
static int gc_delta(val optval)
{
- opt_gc_delta = c_num(mul(optval, num_fast(1048576)));
+ opt_gc_delta = c_num(mul(optval, num_fast(1048576)), lit("gc"));
return 1;
}
diff --git a/unwind.c b/unwind.c
index ac0f2d9f..252fe117 100644
--- a/unwind.c
+++ b/unwind.c
@@ -393,7 +393,8 @@ val uw_find_frames(val extype, val frtype)
val uw_find_frames_by_mask(val mask_in)
{
- ucnum mask = c_unum(mask_in);
+ val self = lit("find-frames-by-mask");
+ ucnum mask = c_unum(mask_in, self);
list_collect_decl (out, ptail);
uw_frame_t *fr;
diff --git a/vm.c b/vm.c
index 890ddf02..8955e910 100644
--- a/vm.c
+++ b/vm.c
@@ -128,7 +128,7 @@ val vm_make_desc(val nlevels, val nregs, val bytecode,
{
mem_t *code = buf_get(bytecode, self);
val dvl = length_vec(datavec);
- cnum stsz = c_num(length_vec(symvec));
+ cnum stsz = c_num(length_vec(symvec), self);
loc data_loc = if3(dvl != zero, vecref_l(datavec, zero), nulloc);
struct vm_desc *vd = coerce(struct vm_desc *, chk_malloc(sizeof *vd));
struct vm_desc *vtail = vmd_list.prev, *vnull = vtail->lnk.next;
@@ -234,6 +234,7 @@ static struct vm_closure *vm_closure_struct(val self, val obj)
static val vm_make_closure(struct vm *vm, int frsz)
{
+ val self = lit("vm");
size_t dspl_sz = vm->nlvl * sizeof (struct vm_env);
struct vm_closure *vc = coerce(struct vm_closure *,
chk_malloc(offsetof (struct vm_closure, dspl)
@@ -266,7 +267,7 @@ static val vm_make_closure(struct vm *vm, int frsz)
case NUM:
{
val heap_vec = vector(vec, nil);
- size_t size = sizeof *cdi->mem * c_num(vec);
+ size_t size = sizeof *cdi->mem * c_num(vec, self);
cdi->vec = heap_vec;
cdi->mem = heap_vec->v.vec;
memcpy(cdi->mem, mem, size);
@@ -750,8 +751,9 @@ NOINLINE static void vm_ifql(struct vm *vm, vm_word_t insn)
NOINLINE static void vm_swtch(struct vm *vm, vm_word_t insn)
{
+ val self = lit("vm");
unsigned tblsz = vm_insn_extra(insn);
- ucnum idx = c_unum(vm_get(vm->dspl, vm_insn_operand(insn)));
+ ucnum idx = c_unum(vm_get(vm->dspl, vm_insn_operand(insn)), self);
if (idx < tblsz) {
vm_word_t tgt = vm->code[vm->ip + idx / 2];
generated by cgit v1.2.3 (git 2.25.1) at 2025-03-10 03:02:04 +0000