diff options
-rw-r--r-- | Makefile | 2 | ||||
-rw-r--r-- | buf.c | 544 | ||||
-rw-r--r-- | buf.h | 97 | ||||
-rw-r--r-- | itypes.c | 232 | ||||
-rw-r--r-- | itypes.h | 114 | ||||
-rw-r--r-- | lib.c | 10 | ||||
-rw-r--r-- | parser.h | 1 | ||||
-rw-r--r-- | parser.l | 37 | ||||
-rw-r--r-- | parser.y | 38 |
9 files changed, 1071 insertions, 4 deletions
@@ -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 @@ -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)); +} @@ -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); @@ -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(); @@ -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 @@ -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); @@ -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; |