summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2017-04-21 06:56:23 -0700
committerKaz Kylheku <kaz@kylheku.com>2017-04-21 06:56:23 -0700
commit4e647f4d27827d2918e519cb3f52583d2bbb2a59 (patch)
tree4de914375260f4ccfdecef3ce64ec1de3adef575
parent0ba765092f20424828a520d6ccda1c313dab08f0 (diff)
downloadtxr-4e647f4d27827d2918e519cb3f52583d2bbb2a59.tar.gz
txr-4e647f4d27827d2918e519cb3f52583d2bbb2a59.tar.bz2
txr-4e647f4d27827d2918e519cb3f52583d2bbb2a59.zip
Continuing implementation of buffers.
* Makefile (OBJS): New objects itypes.o and buf.o. * buf.c, buf.h: New files. * itypes.c, itypes.h: New files. * lib.c (obj_print_impl): Handle BUF via buf_print and buf_pprint. (init): Call itypes_init and buf_init. * parser.h (end_of_buflit): Declared. * parser.l (BUFLIT): New exclusive state. (grammar): New rules for recognizing start of buffer literal and its interior. (end_of_buflit): New function. * parser.y (HASH_B_QUOTE): New token. (buflit, buflit_items, buflit_item): New nonterminals and corresponding grammar rules. (i_expr, n_expr): These symbols now generate a buflit; a buffer literal is a kind of expression. (yybadtoken): Handle HASH_B_QUOTE case.
-rw-r--r--Makefile2
-rw-r--r--buf.c544
-rw-r--r--buf.h97
-rw-r--r--itypes.c232
-rw-r--r--itypes.h114
-rw-r--r--lib.c10
-rw-r--r--parser.h1
-rw-r--r--parser.l37
-rw-r--r--parser.y38
9 files changed, 1071 insertions, 4 deletions
diff --git a/Makefile b/Makefile
index b1b2db11..25f26944 100644
--- a/Makefile
+++ b/Makefile
@@ -49,7 +49,7 @@ EXTRA_OBJS-y :=
OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o
OBJS += arith.o hash.o utf8.o filter.o eval.o parser.o rand.o combi.o sysif.o
-OBJS += args.o lisplib.o cadr.o struct.o jmp.o protsym.o
+OBJS += args.o lisplib.o cadr.o struct.o itypes.o buf.o jmp.o protsym.o
OBJS-$(debug_support) += debug.o
OBJS-$(have_syslog) += syslog.o
OBJS-$(have_glob) += glob.o
diff --git a/buf.c b/buf.c
new file mode 100644
index 00000000..feba34b7
--- /dev/null
+++ b/buf.c
@@ -0,0 +1,544 @@
+/* Copyright 2017
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ * list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <stddef.h>
+#include <wchar.h>
+#include <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <stdio.h>
+#include <dirent.h>
+#include "config.h"
+#include "lib.h"
+#include "gc.h"
+#include "itypes.h"
+#include "signal.h"
+#include "unwind.h"
+#include "eval.h"
+#include "stream.h"
+#include "arith.h"
+#include "buf.h"
+
+static cnum buf_check_len(val len, val self)
+{
+ cnum l = c_num(len);
+ if (l < 0)
+ uw_throwf(error_s, lit("~a: negative length ~s specified"),
+ self, len, nao);
+ return l;
+}
+
+static cnum buf_check_alloc_size(val alloc_size, cnum len, val self)
+{
+ cnum ah = c_num(alloc_size);
+ if (ah < len)
+ uw_throwf(error_s, lit("~a: alloc size size ~s lower than length"),
+ self, alloc_size, nao);
+ return ah;
+}
+
+static cnum buf_check_index(val index, val self)
+{
+ cnum ix = c_num(index);
+ if (ix < 0)
+ uw_throwf(error_s, lit("~a: negative byte index ~s specified"),
+ self, index, nao);
+ return ix;
+}
+
+val make_buf(val len, val init_val, val alloc_size)
+{
+ val self = lit("make-buf");
+ cnum l = buf_check_len(len, self);
+ val alloc = if3(null_or_missing_p(alloc_size), len, alloc_size);
+ cnum size = buf_check_alloc_size(alloc, l, self);
+ cnum iv = c_u8(default_arg(init_val, zero), self);
+ mem_t *data = if3(iv == 0,
+ chk_calloc(size, 1),
+ chk_malloc(size));
+ val obj = make_obj();
+
+ obj->b.type = BUF;
+ obj->b.data = data;
+ obj->b.len = len;
+ obj->b.size = num(size);
+
+ if (iv != 0)
+ memset(data, (unsigned char) iv, c_num(len));
+
+ return obj;
+}
+
+val make_borrowed_buf(val len, mem_t *data)
+{
+ val obj = make_obj();
+
+ obj->b.type = BUF;
+ obj->b.data = data;
+ obj->b.len = len;
+ obj->b.size = nil;
+
+ return obj;
+}
+
+static struct buf *buf_handle(val buf, val ctx)
+{
+ if (type(buf) == BUF)
+ return coerce(struct buf *, buf);
+ uw_throwf(error_s, lit("~a: ~s isn't a buffer"),
+ ctx, buf, nao);
+}
+
+static void buf_grow(struct buf *b, val init_val, val self)
+{
+ cnum len = c_num(b->len);
+ cnum oldsize = c_num(b->size), size = oldsize;
+ cnum iv = c_u8(default_arg(init_val, zero), self);
+
+ while (size < len) {
+ cnum delta = size / 4;
+ if (INT_PTR_MAX - delta >= size)
+ size += size / 4;
+ else
+ size = len;
+ }
+
+ if (size > oldsize) {
+ b->data = chk_realloc(b->data, size);
+ b->size = num(size);
+ memset(b->data + oldsize, (unsigned char) iv, size - oldsize);
+ }
+}
+
+static void buf_shrink(struct buf *b)
+{
+ cnum oldsize = c_num(b->size);
+ cnum len = c_num(b->len);
+
+ if (len != oldsize) {
+ b->data = chk_realloc(b->data, len);
+ b->size = b->len;
+ }
+}
+
+val buf_trim(val buf)
+{
+ val self = lit("buf-trim");
+ struct buf *b = buf_handle(buf, self);
+ val oldsize = b->size;
+ if (!oldsize)
+ uw_throwf(error_s, lit("~a: ~s is a fixed buffer"),
+ self, buf, nao);
+ buf_shrink(b);
+ return oldsize;
+}
+
+static val buf_do_set_len(val buf, struct buf *b, val len,
+ val init_val, val self)
+{
+ val oldlen = b->len;
+ if (!b->size)
+ uw_throwf(error_s, lit("~a: ~s is a fixed buffer"),
+ self, buf, nao);
+ (void) buf_check_len(len, self);
+ b->len = len;
+ buf_grow(b, init_val, self);
+ return oldlen;
+}
+
+val buf_set_length(val buf, val len, val init_val)
+{
+ val self = lit("buf-set-len");
+ struct buf *b = buf_handle(buf, self);
+ return buf_do_set_len(buf, b, len, init_val, self);
+}
+
+val length_buf(val buf)
+{
+ val self = lit("buf-set-len");
+ struct buf *b = buf_handle(buf, self);
+ return b->len;
+}
+
+static void buf_put_bytes(val buf, val pos, mem_t *ptr, cnum size, val self)
+{
+ struct buf *b = buf_handle(buf, self);
+ cnum p = buf_check_index(pos, self);
+ if (p >= c_num(b->len))
+ buf_do_set_len(buf, b, plus(pos, num_fast(size)), nil, self);
+ memcpy(b->data + p, ptr, size);
+}
+
+#if HAVE_I8
+val buf_put_i8(val buf, val pos, val num)
+{
+ val self = lit("buf-put-i8");
+ struct buf *b = buf_handle(buf, self);
+ cnum p = buf_check_index(pos, self);
+ i8_t v = c_i8(num, self);
+ if (p >= c_num(b->len))
+ buf_do_set_len(buf, b, succ(pos), nil, self);
+ b->data[p] = v;
+ return num;
+}
+
+val buf_put_u8(val buf, val pos, val num)
+{
+ val self = lit("buf-put-u8");
+ struct buf *b = buf_handle(buf, self);
+ cnum p = buf_check_index(pos, self);
+ cnum v = c_u8(num, self);
+ if (p >= c_num(b->len))
+ buf_do_set_len(buf, b, succ(pos), nil, self);
+ b->data[p] = v;
+ return num;
+}
+#endif
+
+#if HAVE_I16
+val buf_put_i16(val buf, val pos, val num)
+{
+ val self = lit("buf-put-i16");
+ i16_t n = c_i16(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_u16(val buf, val pos, val num)
+{
+ val self = lit("buf-put-u16");
+ u16_t n = c_u16(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+#endif
+
+#if HAVE_I32
+val buf_put_i32(val buf, val pos, val num)
+{
+ val self = lit("buf-put-i32");
+ i32_t n = c_i32(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_u32(val buf, val pos, val num)
+{
+ val self = lit("buf-put-u32");
+ u32_t n = c_u32(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+#endif
+
+#if HAVE_I64
+val buf_put_i64(val buf, val pos, val num)
+{
+ val self = lit("buf-put-i64");
+ i64_t n = c_i64(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_u64(val buf, val pos, val num)
+{
+ val self = lit("buf-put-u64");
+ u64_t n = c_u64(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+#endif
+
+val buf_put_char(val buf, val pos, val num)
+{
+ val self = lit("buf-put-char");
+ struct buf *b = buf_handle(buf, self);
+ cnum p = buf_check_index(pos, self);
+ char v = c_char(num, self);
+ if (p >= c_num(b->len))
+ buf_do_set_len(buf, b, succ(pos), nil, self);
+ b->data[p] = v;
+ return num;
+}
+
+val buf_put_uchar(val buf, val pos, val num)
+{
+ val self = lit("buf-put-uchar");
+ struct buf *b = buf_handle(buf, self);
+ cnum p = buf_check_index(pos, self);
+ unsigned char v = c_char(num, self);
+ if (p >= c_num(b->len))
+ buf_do_set_len(buf, b, succ(pos), nil, self);
+ b->data[p] = v;
+ return num;
+}
+
+val buf_put_short(val buf, val pos, val num)
+{
+ val self = lit("buf-put-short");
+ short n = c_short(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_ushort(val buf, val pos, val num)
+{
+ val self = lit("buf-put-ushort");
+ unsigned short n = c_short(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_int(val buf, val pos, val num)
+{
+ val self = lit("buf-put-int");
+ int n = c_int(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_uint(val buf, val pos, val num)
+{
+ val self = lit("buf-put-uint");
+ unsigned n = c_uint(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_long(val buf, val pos, val num)
+{
+ val self = lit("buf-put-long");
+ long n = c_long(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_ulong(val buf, val pos, val num)
+{
+ val self = lit("buf-put-ulong");
+ unsigned long n = c_ulong(num, self);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+val buf_put_double(val buf, val pos, val num)
+{
+ val self = lit("buf-put-double");
+ double n = c_flo(num);
+ buf_put_bytes(buf, pos, coerce(mem_t *, &n), sizeof n, self);
+ return num;
+}
+
+#if HAVE_I8
+val buf_get_i8(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_u8(val buf, val pos)
+{
+ return nil;
+}
+#endif
+
+#if HAVE_I16
+val buf_get_i16(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_u16(val buf, val pos)
+{
+ return nil;
+}
+#endif
+
+#if HAVE_I32
+val buf_get_i32(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_u32(val buf, val pos)
+{
+ return nil;
+}
+#endif
+
+#if HAVE_I64
+val buf_get_i64(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_u64(val buf, val pos)
+{
+ return nil;
+}
+#endif
+
+val buf_get_char(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_uchar(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_short(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_ushort(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_int(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_uint(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_long(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_ulong(val buf, val pos)
+{
+ return nil;
+}
+val buf_get_double(val buf, val pos)
+{
+ return nil;
+}
+
+val buf_print(val buf, val stream_in)
+{
+ 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;
+ mem_t *data = b->data;
+ val save_mode = test_set_indent_mode(stream, num_fast(indent_off),
+ num_fast(indent_data));
+ val save_indent;
+
+ put_string(lit("#b'"), stream);
+
+ save_indent = inc_indent(stream, zero);
+
+ while (len-- > 0) {
+ format(stream, lit("~,02x"), num_fast(*data++), nao);
+ if ((++count & 7) == 0 && len)
+ width_check(stream, chr(' '));
+ }
+
+ set_indent(stream, save_indent);
+ set_indent_mode(stream, save_mode);
+
+ return put_char(chr('\''), stream);
+}
+
+val buf_pprint(val buf, val stream_in)
+{
+ val stream = default_arg(stream_in, std_output);
+ struct buf *b = buf_handle(buf, lit("buf-print"));
+ cnum len = c_num(b->len);
+ mem_t *data = b->data;
+
+ while (len-- > 0)
+ put_byte(num_fast(*data++), stream);
+
+ return t;
+}
+
+void buf_init(void)
+{
+ reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
+ reg_fun(intern(lit("buf-trim"), user_package), func_n1(buf_trim));
+ reg_fun(intern(lit("buf-set-length"), user_package), func_n3o(buf_set_length, 2));
+ reg_fun(intern(lit("length-buf"), user_package), func_n1(length_buf));
+
+#if HAVE_I8
+ reg_fun(intern(lit("buf-put-i8"), user_package), func_n3(buf_put_i8));
+ reg_fun(intern(lit("buf-put-u8"), user_package), func_n3(buf_put_u8));
+#endif
+
+#if HAVE_I16
+ reg_fun(intern(lit("buf-put-i16"), user_package), func_n3(buf_put_i16));
+ reg_fun(intern(lit("buf-put-u16"), user_package), func_n3(buf_put_u16));
+#endif
+
+#if HAVE_I32
+ reg_fun(intern(lit("buf-put-i32"), user_package), func_n3(buf_put_i32));
+ reg_fun(intern(lit("buf-put-u32"), user_package), func_n3(buf_put_u32));
+#endif
+
+#if HAVE_I64
+ reg_fun(intern(lit("buf-put-i64"), user_package), func_n3(buf_put_i64));
+ reg_fun(intern(lit("buf-put-u64"), user_package), func_n3(buf_put_u64));
+#endif
+
+ reg_fun(intern(lit("buf-put-char"), user_package), func_n3(buf_put_char));
+ reg_fun(intern(lit("buf-put-uchar"), user_package), func_n3(buf_put_uchar));
+ reg_fun(intern(lit("buf-put-short"), user_package), func_n3(buf_put_short));
+ reg_fun(intern(lit("buf-put-ushort"), user_package), func_n3(buf_put_ushort));
+ reg_fun(intern(lit("buf-put-int"), user_package), func_n3(buf_put_int));
+ reg_fun(intern(lit("buf-put-uint"), user_package), func_n3(buf_put_uint));
+ reg_fun(intern(lit("buf-put-long"), user_package), func_n3(buf_put_long));
+ reg_fun(intern(lit("buf-put-ulong"), user_package), func_n3(buf_put_ulong));
+ reg_fun(intern(lit("buf-put-double"), user_package), func_n3(buf_put_double));
+
+#if HAVE_I8
+ reg_fun(intern(lit("buf-get-i8"), user_package), func_n2(buf_get_i8));
+ reg_fun(intern(lit("buf-get-u8"), user_package), func_n2(buf_get_u8));
+#endif
+
+#if HAVE_I16
+ reg_fun(intern(lit("buf-get-i16"), user_package), func_n2(buf_get_i16));
+ reg_fun(intern(lit("buf-get-u16"), user_package), func_n2(buf_get_u16));
+#endif
+
+#if HAVE_I32
+ reg_fun(intern(lit("buf-get-i32"), user_package), func_n2(buf_get_i32));
+ reg_fun(intern(lit("buf-get-u32"), user_package), func_n2(buf_get_u32));
+#endif
+
+#if HAVE_I64
+ reg_fun(intern(lit("buf-get-i64"), user_package), func_n2(buf_get_i64));
+ reg_fun(intern(lit("buf-get-u64"), user_package), func_n2(buf_get_u64));
+#endif
+
+ reg_fun(intern(lit("buf-get-char"), user_package), func_n2(buf_get_char));
+ reg_fun(intern(lit("buf-get-uchar"), user_package), func_n2(buf_get_uchar));
+ reg_fun(intern(lit("buf-get-short"), user_package), func_n2(buf_get_short));
+ reg_fun(intern(lit("buf-get-ushort"), user_package), func_n2(buf_get_ushort));
+ reg_fun(intern(lit("buf-get-int"), user_package), func_n2(buf_get_int));
+ reg_fun(intern(lit("buf-get-uint"), user_package), func_n2(buf_get_uint));
+ reg_fun(intern(lit("buf-get-long"), user_package), func_n2(buf_get_long));
+ reg_fun(intern(lit("buf-get-ulong"), user_package), func_n2(buf_get_ulong));
+ reg_fun(intern(lit("buf-get-double"), user_package), func_n2(buf_get_double));
+ reg_fun(intern(lit("buf-get-cptr"), user_package), func_n2(buf_get_cptr));
+}
diff --git a/buf.h b/buf.h
new file mode 100644
index 00000000..604568dd
--- /dev/null
+++ b/buf.h
@@ -0,0 +1,97 @@
+/* Copyright 2017
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ * list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+val make_buf(val len, val init_val, val alloc_size);
+val make_borrowed_buf(val len, mem_t *data);
+val buf_trim(val buf);
+val buf_set_length(val obj, val len, val init_val);
+val length_buf(val buf);
+
+#if HAVE_I8
+val buf_put_i8(val buf, val pos, val num);
+val buf_put_u8(val buf, val pos, val num);
+#endif
+
+#if HAVE_I16
+val buf_put_i16(val buf, val pos, val num);
+val buf_put_u16(val buf, val pos, val num);
+#endif
+
+#if HAVE_I32
+val buf_put_i32(val buf, val pos, val num);
+val buf_put_u32(val buf, val pos, val num);
+#endif
+
+#if HAVE_I64
+val buf_put_i64(val buf, val pos, val num);
+val buf_put_u64(val buf, val pos, val num);
+#endif
+
+val buf_put_char(val buf, val pos, val num);
+val buf_put_uchar(val buf, val pos, val num);
+val buf_put_short(val buf, val pos, val num);
+val buf_put_ushort(val buf, val pos, val num);
+val buf_put_int(val buf, val pos, val num);
+val buf_put_uint(val buf, val pos, val num);
+val buf_put_long(val buf, val pos, val num);
+val buf_put_ulong(val buf, val pos, val num);
+val buf_put_double(val buf, val pos, val num);
+
+#if HAVE_I8
+val buf_get_i8(val buf, val pos);
+val buf_get_u8(val buf, val pos);
+#endif
+
+#if HAVE_I16
+val buf_get_i16(val buf, val pos);
+val buf_get_u16(val buf, val pos);
+#endif
+
+#if HAVE_I32
+val buf_get_i32(val buf, val pos);
+val buf_get_u32(val buf, val pos);
+#endif
+
+#if HAVE_I64
+val buf_get_i64(val buf, val pos);
+val buf_get_u64(val buf, val pos);
+#endif
+
+val buf_get_char(val buf, val pos);
+val buf_get_uchar(val buf, val pos);
+val buf_get_short(val buf, val pos);
+val buf_get_ushort(val buf, val pos);
+val buf_get_int(val buf, val pos);
+val buf_get_uint(val buf, val pos);
+val buf_get_long(val buf, val pos);
+val buf_get_ulong(val buf, val pos);
+val buf_get_double(val buf, val pos);
+
+val buf_print(val buf, val stream);
+val buf_pprint(val buf, val stream);
+
+void buf_init(void);
diff --git a/itypes.c b/itypes.c
new file mode 100644
index 00000000..2d4c962f
--- /dev/null
+++ b/itypes.c
@@ -0,0 +1,232 @@
+/* Copyright 2017
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ * list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <stddef.h>
+#include <wchar.h>
+#include <signal.h>
+#include "config.h"
+#include "lib.h"
+#include "signal.h"
+#include "unwind.h"
+#include "arith.h"
+#include "itypes.h"
+
+int itypes_little_endian;
+
+#if HAVE_I8
+i8_t c_i8(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < -128 || v > 127)
+ uw_throwf(error_s, lit("~a: value ~s out of signed 8 bit range"),
+ self, n, nao);
+ return v;
+}
+
+u8_t c_u8(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < 0 || v > 255)
+ uw_throwf(error_s, lit("~a: value ~s out of signed 8 bit range"),
+ self, n, nao);
+ return v;
+}
+#endif
+
+#if HAVE_I16
+i16_t c_i16(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < -0x8000 || v > 0x7FFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
+ self, n, nao);
+ return v;
+}
+
+u16_t c_u16(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < 0 || v > 0xFFFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
+ self, n, nao);
+ return v;
+}
+#endif
+
+#if HAVE_I32
+i32_t c_i32(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < (cnum) -0x80000000 || v > (cnum) 0x7FFFFFFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 32 bit range"),
+ self, n, nao);
+ return v;
+}
+
+u32_t c_u32(val n, val self)
+{
+ uint_ptr_t v = c_uint_ptr_num(n);
+ if (v < 0 || v > 0xFFFFFFFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 32 bit range"),
+ self, n, nao);
+ return v;
+}
+#endif
+
+#if HAVE_I64
+#if SIZEOF_PTR == 8
+i64_t c_i64(val n, val self)
+{
+ cnum v = c_num(num);
+ if (v < (cnum) -0x8000000000000000 || v > (cnum) 0x7FFFFFFFFFFFFFFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 64 bit range"),
+ self, n, nao);
+ return v;
+}
+
+u64_t c_u64(val n, val self)
+{
+ uint_ptr_t v = c_uint_ptr_num(n);
+ if (v < (cnum) -0x8000000000000000 || v > (cnum) 0x7FFFFFFFFFFFFFFF)
+ uw_throwf(error_s, lit("~a: value ~s is out of signed 64 bit range"),
+ self, n, nao);
+ return v;
+}
+#else
+i64_t c_i64(val n, val self)
+{
+ val low32 = logtrunc(n, num_fast(32));
+ val high32 = ash(n, num_fast(-32));
+ return ((i64_t) c_i32(high32, self)) << 32 | c_u32(low32, self);
+}
+
+u64_t c_u64(val n, val self)
+{
+ val low32 = logtrunc(n, num_fast(32));
+ val high32 = ash(n, num_fast(-32));
+ return ((u64_t) c_u32(high32, self)) << 32 | c_u32(low32, self);
+}
+#endif
+#endif
+
+char c_char(val n, val self)
+{
+#if CHAR_MAX == UCHAR_MAX
+ return c_u8(n, self);
+#else
+ return c_i8(n, self);
+#endif
+}
+
+signed char c_schar(val n, val self)
+{
+ return c_i8(n, self);
+}
+
+unsigned char c_uchar(val n, val self)
+{
+ return c_u8(n, self);
+}
+
+short c_short(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < SHRT_MIN || v > SHRT_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of short int range"),
+ self, n, nao);
+ return v;
+}
+
+unsigned short c_ushort(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < 0 || v > USHRT_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of unsigned short range"),
+ self, n, nao);
+ return v;
+}
+
+int c_int(val n, val self)
+{
+ cnum v = c_num(n);
+ if (v < INT_MIN || v > INT_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of int range"),
+ self, n, nao);
+ return v;
+}
+
+unsigned int c_uint(val n, val self)
+{
+ uint_ptr_t v = c_uint_ptr_num(n);
+ if (v < 0 || v > UINT_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of int range"),
+ self, n, nao);
+ return v;
+}
+
+long c_long(val n, val self)
+{
+#if SIZEOF_LONG <= SIZEOF_PTR
+ cnum v = c_num(n);
+ if (v < LONG_MIN || v > LONG_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of long int range"),
+ self, n, nao);
+ return v;
+#elif SIZEOF_LONG == SIZEOF_PTR && HAVE_I64
+ return c_i64(n, self);
+#else
+#error portme
+#endif
+}
+
+unsigned long c_ulong(val n, val self)
+{
+#if SIZEOF_LONG <= SIZEOF_PTR
+ uint_ptr_t v = c_unum(n);
+ if (v < 0 || v > ULONG_MAX)
+ uw_throwf(error_s, lit("~a: value ~s is out of unsigned long range"),
+ self, n, nao);
+ return v;
+#elif SIZEOF_LONG == SIZEOF_PTR && HAVE_I64
+ return c_u64(n, self);
+#else
+#error portme
+#endif
+}
+
+extern int itypes_little_endian;
+void itypes_init(void);
+
+void itypes_init()
+{
+ union u {
+ volatile unsigned ui;
+ volatile unsigned char uc[sizeof (unsigned)];
+ } u = { 0xff };
+
+ itypes_little_endian = (u.uc[0] = 0xff);
+}
diff --git a/itypes.h b/itypes.h
new file mode 100644
index 00000000..afdd9b80
--- /dev/null
+++ b/itypes.h
@@ -0,0 +1,114 @@
+/* Copyright 2017
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice, this
+ * list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#if CHAR_BIT == 8
+#define HAVE_I8 1
+typedef unsigned char u8_t;
+typedef signed char i8_t;
+#endif
+
+#if CHAR_BIT == 16
+#define HAVE_I16 1
+typedef unsigned char u16_t;
+typedef signed char i16_t;
+#elif (SIZEOF_SHORT * CHAR_BIT) == 16
+#define HAVE_I16 1
+typedef unsigned short u16_t;
+typedef short i16_t;
+#elif (SIZEOF_INT * CHAR_BIT) == 16
+#define HAVE_I16 1
+typedef unsigned u16_t;
+typedef int i16_t;
+#endif
+
+#if CHAR_BIT == 32
+#define HAVE_I32 1
+typedef unsigned char u32_t;
+typedef signed char i32_t;
+#elif (SIZEOF_SHORT * CHAR_BIT) == 32
+#define HAVE_I32 1
+typedef unsigned short u32_t;
+typedef short i32_t;
+#elif (SIZEOF_INT * CHAR_BIT) == 32
+#define HAVE_I32 1
+typedef unsigned u32_t;
+typedef int i32_t;
+#elif (SIZEOF_LONG * CHAR_BIT) == 32
+#define HAVE_I32 1
+typedef unsigned long u32_t;
+typedef long i32_t;
+#endif
+
+#if (SIZEOF_INT * CHAR_BIT) == 64
+#define HAVE_I64 1
+typedef unsigned u64_t;
+typedef int i64_t;
+#elif (SIZEOF_LONG * CHAR_BIT) == 64
+#define HAVE_I64 1
+typedef unsigned long u64_t;
+typedef long i64_t;
+#elif HAVE_ULONGLONG_T && (SIZEOF_LONGLONG_T * CHAR_BIT) == 64
+#define HAVE_I64 1
+typedef ulonglong_t u64_t;
+typedef longlong_t i64_t;
+#endif
+
+#if HAVE_I8
+i8_t c_i8(val, val self);
+u8_t c_u8(val, val self);
+#endif
+
+#if HAVE_I16
+i16_t c_i16(val, val self);
+u16_t c_u16(val, val self);
+#endif
+
+#if HAVE_I32
+i32_t c_i32(val, val self);
+u32_t c_u32(val, val self);
+#endif
+
+#if HAVE_I64
+i64_t c_i64(val, val self);
+u64_t c_u64(val, val self);
+#endif
+
+char c_char(val, val self);
+signed char c_schar(val, val self);
+unsigned char c_uchar(val, val self);
+
+short c_short(val, val self);
+unsigned short c_ushort(val, val self);
+
+int c_int(val, val self);
+unsigned int c_uint(val, val self);
+
+long c_long(val, val self);
+unsigned long c_ulong(val, val self);
+
+extern int itypes_little_endian;
+void itypes_init(void);
diff --git a/lib.c b/lib.c
index 99e59351..9a594e10 100644
--- a/lib.c
+++ b/lib.c
@@ -67,6 +67,8 @@
#include "termios.h"
#include "cadr.h"
#include "struct.h"
+#include "itypes.h"
+#include "buf.h"
#include "txr.h"
#define max(a, b) ((a) > (b) ? (a) : (b))
@@ -10258,6 +10260,12 @@ dot:
format(out, if3(pretty, lit("#R(~a ~a)"), lit("#R(~s ~s)")),
from(obj), to(obj), nao);
break;
+ case BUF:
+ if (pretty)
+ buf_pprint(obj, out);
+ else
+ buf_print(obj, out);
+ break;
default:
format(out, lit("#<garbage: ~p>"), obj, nao);
break;
@@ -10912,6 +10920,8 @@ void init(mem_t *(*oom)(mem_t *, size_t), val *stack_bottom)
eval_init();
hash_init();
struct_init();
+ itypes_init();
+ buf_init();
sysif_init();
arith_init();
rand_init();
diff --git a/parser.h b/parser.h
index b31cc254..41969c3f 100644
--- a/parser.h
+++ b/parser.h
@@ -78,6 +78,7 @@ void yyerrorf(scanner_t *scanner, val s, ...);
void yybadtoken(parser_t *, int tok, val context);
void end_of_regex(scanner_t *scanner);
void end_of_char(scanner_t *scanner);
+void end_of_buflit(scanner_t *scanner);
#ifdef SPACE
int yylex(YYSTYPE *yylval_param, yyscan_t yyscanner);
#endif
diff --git a/parser.l b/parser.l
index 7d6c0284..fef31835 100644
--- a/parser.l
+++ b/parser.l
@@ -239,7 +239,8 @@ UANY {ASC}|{U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
UANYN {ASCN}|{U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
-%x SPECIAL BRACED NESTED REGEX SREGEX STRLIT CHRLIT QSILIT QSPECIAL WLIT QWLIT
+%x SPECIAL BRACED NESTED REGEX SREGEX STRLIT CHRLIT
+%x QSILIT QSPECIAL WLIT QWLIT BUFLIT
%%
@@ -621,6 +622,11 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
return HASH_BACKSLASH;
}
+<SPECIAL,QSPECIAL,NESTED,BRACED>#b' {
+ yy_push_state(BUFLIT, yyscanner);
+ return HASH_B_QUOTE;
+}
+
<SPECIAL,QSPECIAL,NESTED,BRACED>#[/] {
yy_push_state(REGEX, yyscanner);
return HASH_SLASH;
@@ -1011,6 +1017,27 @@ UONLY {U2}{U}|{U3}{U}{U}|{U4}{U}{U}{U}
return LITCHAR;
}
+<BUFLIT>{HEX} {
+ yylval->chr = strtol(yytext, 0, 16);
+ return LITCHAR;
+}
+
+<BUFLIT>' {
+ return '\'';
+}
+
+<BUFLIT>{WS} {
+}
+
+<BUFLIT>{NL} {
+ yyextra->lineno++;
+}
+
+<BUFLIT>. {
+ yyerrorf(yyg, lit("bad character in buffer literal: \\~a"),
+ chr(yytext[0]), nao);
+}
+
<STRLIT,CHRLIT,QSILIT,WLIT,QWLIT>. {
yyerrprepf(yyg, lit("non-UTF-8 byte in literal: '\\x~02x'"),
num(convert(unsigned char, yytext[0])), nao);
@@ -1084,6 +1111,14 @@ void end_of_char(scanner_t *yyg)
yy_pop_state(yyg);
}
+void end_of_buflit(scanner_t *yyg)
+{
+ if (YYSTATE != BUFLIT)
+ internal_error("end_of_buflit called in wrong scanner state");
+
+ yy_pop_state(yyg);
+}
+
val source_loc(val form)
{
return gethash(form_to_ln_hash, form);
diff --git a/parser.y b/parser.y
index df054f95..0884e4aa 100644
--- a/parser.y
+++ b/parser.y
@@ -55,6 +55,8 @@
#include "cadr.h"
#include "debug.h"
#include "txr.h"
+#include "itypes.h"
+#include "buf.h"
#include "parser.h"
static val sym_helper(parser_t *parser, wchar_t *lexeme, val meta_allowed);
@@ -118,6 +120,7 @@ INLINE val expand_form_ver(val form, int ver)
%token <lineno> MOD MODLAST DEFINE TRY CATCH FINALLY IF
%token <lineno> ERRTOK /* deliberately not used in grammar */
%token <lineno> HASH_BACKSLASH HASH_SLASH DOTDOT HASH_H HASH_S HASH_R HASH_SEMI
+%token <lineno> HASH_B_QUOTE
%token <lineno> WORDS WSPLICE QWORDS QWSPLICE
%token <lineno> SECRET_ESCAPE_R SECRET_ESCAPE_E SECRET_ESCAPE_I
@@ -145,7 +148,7 @@ INLINE val expand_form_ver(val form, int ver)
%type <val> regex lisp_regex regexpr regbranch
%type <val> regterm regtoken regclass regclassterm regrange
%type <val> strlit chrlit quasilit quasi_items quasi_item litchars wordslit
-%type <val> wordsqlit not_a_clause
+%type <val> wordsqlit buflit buflit_items buflit_item not_a_clause
%type <chr> regchar
%type <val> byacc_fool
%type <lineno> '(' '[' '@'
@@ -154,7 +157,7 @@ INLINE val expand_form_ver(val form, int ver)
%right SYMTOK '{' '}'
%right ALL SOME NONE MAYBE CASES CHOOSE AND OR END COLLECT UNTIL COLL
%right OUTPUT REPEAT REP FIRST LAST EMPTY DEFINE IF ELIF ELSE
-%right SPACE TEXT NUMBER METANUM HASH_N_EQUALS HASH_N_HASH
+%right SPACE TEXT NUMBER METANUM HASH_N_EQUALS HASH_N_HASH HASH_B_QUOTE
%nonassoc '[' ']' '(' ')'
%left '-' ',' '\'' '^' SPLICE '@'
%left '|' '/'
@@ -961,6 +964,7 @@ i_expr : SYMTOK { $$ = symhlpr($1, t); }
| quasilit { $$ = $1; }
| WORDS wordslit { $$ = rl($2, num($1)); }
| QWORDS wordsqlit { $$ = rl(cons(quasilist_s, $2), num($1)); }
+ | buflit { $$ = $1; }
| '\'' i_dot_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2),
num(parser->lineno)); }
| '^' i_dot_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2),
@@ -993,6 +997,7 @@ n_expr : SYMTOK { $$ = symhlpr($1, t); }
| quasilit { $$ = $1; }
| WORDS wordslit { $$ = rl($2, num($1)); }
| QWORDS wordsqlit { $$ = rl(cons(quasilist_s, $2), num($1)); }
+ | buflit { $$ = $1; }
| '\'' n_dot_expr { $$ = rl(rlcp(list(quote_s, $2, nao), $2),
num(parser->lineno)); }
| '^' n_dot_expr { $$ = rl(rlcp(list(sys_qquote_s, $2, nao), $2),
@@ -1210,6 +1215,34 @@ wordsqlit : '`' { $$ = nil; }
$$ = rlcp(cons(qword, $3), $1); }
;
+buflit : HASH_B_QUOTE '\'' { $$ = make_buf(zero, nil, nil); }
+ | HASH_B_QUOTE buflit_items '\'' { val len = length($2);
+ val bytes = nreverse($2);
+ val buf = make_buf(len, nil, nil);
+ cnum i;
+ end_of_buflit(scnr);
+
+ for (i = 0; i < c_num(len); i++)
+ { buf_put_u8(buf, num(i),
+ pop(&bytes)); }
+ $$ = buf; }
+ | HASH_B_QUOTE error { yyerr("unterminated buffer literal");
+ end_of_buflit(scnr);
+ yyerrok; }
+ ;
+
+buflit_items : buflit_items buflit_item { $$ = cons($2, $1); }
+ | buflit_item { $$ = cons($1, nil); }
+ ;
+
+buflit_item : LITCHAR LITCHAR { $$ = num($1 << 4 | $2); }
+ | LITCHAR error { $$ = zero;
+ yyerr("unpaired digit in buffer literal");
+ yyerrok; }
+ ;
+
+
+
not_a_clause : ALL { $$ = mkexp(all_s, nil, num(parser->lineno)); }
| SOME { $$ = mkexp(some_s, nil, num(parser->lineno)); }
| NONE { $$ = mkexp(none_s, nil, num(parser->lineno)); }
@@ -1770,6 +1803,7 @@ void yybadtoken(parser_t *parser, int tok, val context)
case HASH_SEMI: problem = lit("#;"); break;
case HASH_N_EQUALS: problem = lit("#<n>="); break;
case HASH_N_HASH: problem = lit("#<n>#"); break;
+ case HASH_B_QUOTE: problem = lit("#b'"); break;
case WORDS: problem = lit("#\""); break;
case WSPLICE: problem = lit("#*\""); break;
case QWORDS: problem = lit("#`"); break;