diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2020-06-29 21:21:06 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2020-06-29 21:21:06 -0700 |
commit | 9557a79765457c2cd1a7214f0d8d51d2ea62ed70 (patch) | |
tree | f01f0ef6ffe860d2ccabb053d937b24e058ebc04 | |
parent | 7006ede97348c57aff89d6af7d19bb6411d9b3f6 (diff) | |
download | txr-9557a79765457c2cd1a7214f0d8d51d2ea62ed70.tar.gz txr-9557a79765457c2cd1a7214f0d8d51d2ea62ed70.tar.bz2 txr-9557a79765457c2cd1a7214f0d8d51d2ea62ed70.zip |
c_num: now takes self argument.
The c_num and c_unum functions now take a self argument for
identifying the calling function. This requires changes in a
large number of places.
In a few places, additional functions acquire a self
argument. The ffi module has the most extensive example of
this.
Some functions mention their name in a larger string, or have
scattered literals giving their name; with the introduction of
the self local variable, these are replaced by references to
self.
In the following changelog, the notation TS stands for "take
self argument", meaning that the functions acquires a new "val
self" argument. The notation DS means "define self": the functions
in question defines a self variable, which they pass down.
The notation PS means that the functions pass down an existing
self variable to functions that now require it.
* args.h (args_count): TS.
* arith.c (c_unum, c_num): TS.
(toint, exptv): DS.
* buf.c (buf_check_len, buf_check_alloc_size, buf_check_index,
buf_do_set_len, replace_buf, buf_put_buf, buf_put_i8,
buf_put_u8, buf_put_char, buf_put_uchar, buf_get_bytes,
buf_get_i8, buf_get_u8, buf_get_cptr,
buf_strm_get_byte_callback, buf_strm_unget_byte, buf_swap32,
str_buf, buf_int, buf_uint, int_buf, uint_buf): PS.
(make_duplicate_buf, buf_shrink, sub_buf, buf_print,
buf_pprint): DS.
* chskum.c (sha256_stream_impl, sha256_buf, crc32_buf,
md5_stream_impl, md5_buf): TS.
(chksum_ensure_buf, sha256_stream, sha256, sha256_hash,
md5_stream, md5, md5_hash): PS.
(crc32_stream): DS.
* combi.c (perm_while_fun, perm_gen_fun_common,
perm_str_gen_fun, rperm_gen_fun, comb_vec_gen_fun,
comb_str_gen_fun, rcomb_vec_gen_fun, rcomb_str_gen_fun): DS.
* diff.c (dbg_clear, dbg_set, dbg_restore): DS.
* eval.c (do_eval, gather_free_refs, maprodv, maprendv,
maprodo, do_args_apf, do_args_ipf): DS.
(op_dwim, me_op, map_common): PS.
(prod_common): TS.
* ffi.c (struct txr_ffi_type): release member TS.
(make_ffi_type_pointer): PS and release argument TS.
(ffi_varray_dynsize, ffi_array_in, ffi_array_put_common,
ffi_array_get_common, ffi_varray_in, ffi_varray_null_term): PS.
(ffi_simple_release, ffi_ptr_in_release, ffi_struct_release,
ffi_wchar_array_get, ffi_array_release_common,
ffi_array_release, ffi_varray_release): TS.
(ffi_float_put, double_put, ffi_be_i16_put, ffi_be_u16_put,
ffi_le_i16_put, ffi_le_u16_put, ffi_be_i32_put, ffi_be_u32_put,
ffi_le_i32_put, ffi_sbit_put, ffi_ubit_put, ffi_buf_d_put,
make_ffi_type_array, make_ffi_type_enum, ffi_type_compile,
make_ffi_type_desc, ffi_make_call_desc, ffi_call_wrap,
ffi_closure_dispatch_save, ffi_put_into, ffi_in, ffi_get,
ffi_put, carray_set_length, carray_blank, carray_buf,
carray_buf_sync, carray_cptr, carray_refset, carray_sub,
carray_replace, carray_uint, carray_int): PS.
(carray_vec, carray_list): DS.
* filter.c (url_encode, url_decode, base64_stream_enc_impl): DS.
* ftw.c (ftw_callback, ftw_wrap): DS.
* gc.c (mark_obj, gc_set_delta): DS.
* glob.c (glob_wrap): DS.
* hash.c (equal_hash, eql_hash, eq_hash, do_make_hash,
hash_equal, set_hash_traversal_limit, gen_hash_seed): DS.
* itypes.c (c_i8, c_u8, c_i16, c_u16, c_i32, c_u32, c_i64,
c_u64, c_short, c_ushort, c_int, c_uint, c_long, c_ulong): PS.
* lib.c (seq_iter_rewind): TS and becomes internal.
(seq_iter_init_with_info, seq_setpos, replace_str, less,
replace_vec, diff, isec, obj_print_impl): PS.
(nthcdr, equal, mkstring, mkustring, upcase_str, downcase_str,
search_str, sub_str, cat_str, scat2, scat3, fmt_join,
split_str_keep, split_str_set, trim_str, int_str, chr_int,
chr_str, chr_str_set, vector, vecref, vecref_l, list_vec,
copy_vec, sub_vec, cat_vec, lazy_str_put, lazy_str_gt,
length_str_ge, length_str_lt, length_str_le, cptr_size_hint,
cptr_int, out_lazy_str, out_quasi_str, time_string_local_time,
time_string_utc, time_fields_local_time, time_fields_utc,
time_struct_local, time_struct_utc, make_time, time_meth,
time_parse_meth): DS.
(init_str, cat_str_init, cat_str_measure, cat_str_append,
vscat, time_fields_to_tm, time_struct_to_tm, make_time_impl): TS.
* lib.h (seq_iter_rewind): Declaration removed.
(c_num, c_unum, init_str): Declarations updated.
* match.c (LOG_MISMATCH, LOG_MATCH): PS.
(h_skip, h_coll, do_output_line, do_output, v_skip, v_fuzz,
v_collect): DS.
* parser.c (parser, circ_backpatch, report_security_problem,
hist_save, repl, lino_fileno, lino_getch, lineno_getl,
lineno_gets, lineno_open): DS.
(parser_set_lineno, lisp_parse_impl): PS.
* parser.l (YY_INPUT): PS.
* rand.c (make_random_state): PS.
* regex.c (print_rec): DS.
(search_regex): PS.
* signal.c (kill_wrap, raise_wrap, get_sig_handler,
getitimer_wrap, setitimer_wrap): DS.
* socket.c (addrinfo_in, sockaddr_pack, fd_timeout,
to_connect, open_sockfd, sock_mark_connected,
sock_timeout): TS.
(getaddrinfo_wrap, dgram_set_sock_peer, sock_bind,
sock_connect, sock_listen, sock_accept, sock_shutdown,
sock_send_timeout, sock_recv_timeout, socketpair_wrap): DS.
* stream.c (generic_fill_buf, errno_to_string, stdio_truncate,
string_out_put_string, open_fileno, open_command, base_name,
dir-name): DS.
(unget_byte, put_buf, fill_buf, fill_buf_adjust,
get_line_as_buf, formatv, put_byte, test_set_indent_mode,
test_neq_set_indent_mode, set_indent_mode, set_indent,
inc_indent, set_max_length, set_max_depth, open_subprocess, run ): PS.
(fds_subst, fds_swizzle): TS.
* struct.c (make_struct_type, super, umethod_args_fun): PS.
(method_args_fun): DS.
* strudel.c (strudel_put_buf, strudel_fill_buf): DS.
* sysif.c (errno_wrap, exit_wrap, usleep_wrap, mkdir_wrap,
ensure_dir, makedev_wrap, minor_wrap, major_wrap, mknod_wrap,
mkfifo_wrap, wait_wrap, wifexited, wexitstatus, wifsignaled,
wtermsig, wcoredump, wifstopped, wstopsig, wifcontinued,
dup_wrap, close_wrap, exit_star_wrap, umask_wrap, setuid_wrap,
seteuid_wrap, setgid_wrap, setegid_wrap,
simulate_setuid_setgid, getpwuid_wrap, fnmatch_wrap,
dlopen_wrap): DS.
(chmod_wrap, do_chown, flock_pack, do_utimes, poll_wrap,
setgroups_wrap, setresuid_wrap, setresgid_wrap, getgrgid_wrap): PS.
(c_time): TS.
* sysif.h (c_time): Declaration updated.
* syslog.c (openlog_wrap, syslog_wrap): DS.
* termios.c (termios_pack): TS.
(tcgetattr_wrap, tcsetattr_wrap, tcsendbreak_wrap,
tcdrain_wrap, tcflush_wrap, tcflow_rap, encode_speeds,
decode_speeds): DS.
* txr.c (compato, array_dim, gc_delta): DS.
* unwind.c (uw_find_frames_by_mask): DS.
* vm.c (vm_make_desc): PS.
(vm_make_closure, vm_swtch): DS.
-rw-r--r-- | args.h | 4 | ||||
-rw-r--r-- | arith.c | 23 | ||||
-rw-r--r-- | buf.c | 85 | ||||
-rw-r--r-- | chksum.c | 57 | ||||
-rw-r--r-- | combi.c | 30 | ||||
-rw-r--r-- | debug.c | 9 | ||||
-rw-r--r-- | eval.c | 28 | ||||
-rw-r--r-- | ffi.c | 158 | ||||
-rw-r--r-- | filter.c | 23 | ||||
-rw-r--r-- | ftw.c | 9 | ||||
-rw-r--r-- | gc.c | 6 | ||||
-rw-r--r-- | glob.c | 3 | ||||
-rw-r--r-- | hash.c | 46 | ||||
-rw-r--r-- | itypes.c | 28 | ||||
-rw-r--r-- | lib.c | 345 | ||||
-rw-r--r-- | lib.h | 7 | ||||
-rw-r--r-- | match.c | 55 | ||||
-rw-r--r-- | parser.c | 36 | ||||
-rw-r--r-- | parser.l | 5 | ||||
-rw-r--r-- | rand.c | 14 | ||||
-rw-r--r-- | regex.c | 8 | ||||
-rw-r--r-- | signal.c | 27 | ||||
-rw-r--r-- | socket.c | 131 | ||||
-rw-r--r-- | stream.c | 129 | ||||
-rw-r--r-- | struct.c | 14 | ||||
-rw-r--r-- | strudel.c | 6 | ||||
-rw-r--r-- | sysif.c | 158 | ||||
-rw-r--r-- | sysif.h | 2 | ||||
-rw-r--r-- | syslog.c | 11 | ||||
-rw-r--r-- | termios.c | 80 | ||||
-rw-r--r-- | txr.c | 6 | ||||
-rw-r--r-- | unwind.c | 3 | ||||
-rw-r--r-- | vm.c | 8 |
33 files changed, 881 insertions, 673 deletions
@@ -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); @@ -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); @@ -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) @@ -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"), @@ -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; @@ -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; } @@ -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); @@ -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); @@ -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); @@ -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)); @@ -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; } @@ -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; @@ -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) @@ -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); @@ -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; { @@ -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); @@ -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; @@ -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); @@ -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 \ @@ -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) { @@ -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)); @@ -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)), @@ -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); } @@ -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); } } @@ -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)); @@ -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) @@ -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) { @@ -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; @@ -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; @@ -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)))); @@ -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; } @@ -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; @@ -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]; |