mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-02-04 11:19:10 +00:00
Code Issues 1 Releases Wiki Activity

Merge pull request #55 from jfcap/typed-array

Browse Source 
Binary Typed Array  for Janet
This commit is contained in:
Calvin Rose 2019-02-25 23:40:19 -05:00 committed by GitHub
commit 36f92db61e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
11 changed files with 960 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
examples/tarray.janet Normal file
View File

@ -0,0 +1,83 @@
# naive matrix implementation for testing typed array
(defmacro printf [& xs] ['print ['string/format (splice xs)]])
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
(defn matrix/row [mat i]
(def {:nrow nrow :ncol ncol :array array} mat)
(tarray/new :float64 ncol 1 (* i ncol) array))
(defn matrix/column [mat j]
(def {:nrow nrow :ncol ncol :array array} mat)
(tarray/new :float64 nrow ncol j array))
(defn matrix/set [mat i j value]
(def {:nrow nrow :ncol ncol :array array} mat)
(set (array (+ (* i ncol) j)) value))
(defn matrix/get [mat i j value]
(def {:nrow nrow :ncol ncol :array array} mat)
(array (+ (* i ncol) j)))
# other variants to test rows and cols views
(defn matrix/set* [mat i j value]
(set ((matrix/row mat i) j) value))
(defn matrix/set** [mat i j value]
(set ((matrix/column mat j) i) value))
(defn matrix/get* [mat i j value]
((matrix/row mat i) j))
(defn matrix/get** [mat i j value]
((matrix/column j) i))
(defn tarray/print [array]
(def size (tarray/length array))
(def buf @"")
(buffer/format buf "[%2i]" size)
(for i 0 size
(buffer/format buf " %+6.3f " (array i)))
(print buf))
(defn matrix/print [mat]
(def {:nrow nrow :ncol ncol :array tarray} mat)
(printf "matrix %iX%i %p" nrow ncol tarray)
(for i 0 nrow
(tarray/print (matrix/row mat i))))
(def nr 5)
(def nc 4)
(def A (matrix nr nc))
(loop (i :range (0 nr) j :range (0 nc))
(matrix/set A i j i))
(matrix/print A)
(loop (i :range (0 nr) j :range (0 nc))
(matrix/set* A i j i))
(matrix/print A)
(loop (i :range (0 nr) j :range (0 nc))
(matrix/set** A i j i))
(matrix/print A)
(printf "properties:\n%p" (tarray/properties (A :array)))
(for i 0 nr
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
(for i 0 nc
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))

4
src/core/corelib.c
View File

@ -787,6 +787,10 @@ JanetTable *janet_core_env(void) {
#ifdef JANET_ASSEMBLER
janet_lib_asm(env);
#endif
#ifdef JANET_TYPED_ARRAY
janet_lib_typed_array(env);
#endif
#ifdef JANET_BOOTSTRAP
/* Run bootstrap source */

2
src/core/io.c
View File

@ -56,6 +56,8 @@ JanetAbstractType cfun_io_filetype = {
cfun_io_gc,
NULL,
io_file_get,
NULL,
NULL,
NULL
};

107
src/core/marsh.c
View File

@ -266,6 +266,47 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
}
void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushint(st, value);
};
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushbyte(st, value);
};
void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, int32_t len) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushbytes(st, bytes, len);
}
void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
MarshalState *st = (MarshalState *)(ctx->m_state);
marshal_one(st, x, ctx->flags + 1);
}
#define MARK_SEEN() \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
void *abstract = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(abstract);
if (at->marshal) {
MARK_SEEN();
JanetMarshalContext context = {st, NULL, flags, NULL};
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_ckeywordv(at->name), flags + 1);
pushint(st, janet_abstract_size(abstract));
at->marshal(abstract, &context);
} else {
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
}
}
/* The main body of the marshaling function. Is the main
* entry point for the mutually recursive functions. */
static void marshal_one(MarshalState *st, Janet x, int flags) {
@ -291,8 +332,6 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
}
}
#define MARK_SEEN() \
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++))
/* Check reference and registry value */
{
@ -423,6 +462,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
MARK_SEEN();
return;
}
case JANET_ABSTRACT: {
marshal_one_abstract(st, x, flags);
return;
}
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
@ -476,6 +519,7 @@ typedef struct {
const uint8_t *end;
} UnmarshalState;
#define MARSH_EOS(st, data) do { \
if ((data) >= (st)->end) janet_panic("unexpected end of source");\
} while (0)
@ -856,6 +900,61 @@ static const uint8_t *unmarshal_one_fiber(
return data;
}
void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
*i = readint(st, &(ctx->data));
};
void janet_unmarshal_uint(JanetMarshalContext *ctx, uint32_t *i) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
*i = (uint32_t)readint(st, &(ctx->data));
};
void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
*i = (size_t)readint(st, &(ctx->data));
};
void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data);
*b = *(ctx->data++);
};
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, int32_t len) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data + len - 1);
memcpy(dest, ctx->data, len);
ctx->data += len;
}
void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
ctx->data = unmarshal_one(st, ctx->data, out, ctx->flags);
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);
const JanetAbstractType *at = janet_get_abstract_type(key);
if (at == NULL) return NULL;
if (at->unmarshal) {
void *p = janet_abstract(at, readint(st, &data));
JanetMarshalContext context = {NULL, st, flags, data};
at->unmarshal(p, &context);
*out = janet_wrap_abstract(p);
return data;
}
return NULL;
}
static const uint8_t *unmarshal_one(
UnmarshalState *st,
const uint8_t *data,
@ -965,6 +1064,10 @@ static const uint8_t *unmarshal_one(
}
return data;
}
case LB_ABSTRACT: {
data++;
return unmarshal_one_abstract(st, data, out, flags);
}
case LB_REFERENCE:
case LB_ARRAY:
case LB_TUPLE:

2
src/core/parse.c
View File

@ -630,6 +630,8 @@ static JanetAbstractType janet_parse_parsertype = {
parsergc,
parsermark,
parserget,
NULL,
NULL,
NULL
};

2
src/core/peg.c
View File

@ -984,6 +984,8 @@ static JanetAbstractType peg_type = {
NULL,
peg_mark,
NULL,
NULL,
NULL,
NULL
};

598
src/core/typedarray.c Normal file
View File

@ -0,0 +1,598 @@
/*
* Copyright (c) 2019 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
/* Compiler feature test macros for things */
#define _DEFAULT_SOURCE
#define _BSD_SOURCE
#ifndef JANET_AMALG
#include <janet.h>
#include "util.h"
#endif
typedef uint8_t ta_uint8_t;
typedef int8_t ta_int8_t;
typedef uint16_t ta_uint16_t;
typedef int16_t ta_int16_t;
typedef uint32_t ta_uint32_t;
typedef int32_t ta_int32_t;
typedef uint64_t ta_uint64_t;
typedef int64_t ta_int64_t;
typedef float ta_float32_t;
typedef double ta_float64_t;
static char *ta_type_names[] = {
"uint8",
"int8",
"uint16",
"int16",
"uint32",
"int32",
"uint64",
"int64",
"float32",
"float64",
"any",
};
static size_t ta_type_sizes[] = {
sizeof(ta_uint8_t),
sizeof(ta_int8_t),
sizeof(ta_uint16_t),
sizeof(ta_int16_t),
sizeof(ta_uint32_t),
sizeof(ta_int32_t),
sizeof(ta_uint64_t),
sizeof(ta_int64_t),
sizeof(ta_float32_t),
sizeof(ta_float64_t),
0,
};
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_float64 + 1)
#define TA_ATOM_MAXSIZE 8
#define TA_FLAG_BIG_ENDIAN 1
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
size_t nt = sizeof(ta_type_names) / sizeof(char *);
for (size_t i = 0; i < nt; i++) {
if (!janet_cstrcmp(name, ta_type_names[i]))
return i;
}
return 0;
}
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
buf->data = NULL;
if (size > 0) {
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
if (buf->data == NULL) {
JANET_OUT_OF_MEMORY;
}
}
buf->size = size;
#ifdef JANET_BIG_ENDIAN
buf->flags = TA_FLAG_BIG_ENDIAN;
#else
buf->flags = 0;
#endif
return buf;
}
static int ta_buffer_gc(void *p, size_t s) {
(void) s;
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
free(buf->data);
return 0;
}
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
janet_marshal_int(ctx, buf->size);
janet_marshal_int(ctx, buf->flags);
janet_marshal_bytes(ctx, buf->data, buf->size);
}
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
uint32_t size;
janet_unmarshal_uint(ctx, &size);
ta_buffer_init(buf, size); // warning if indianess <> platform ??
janet_unmarshal_uint(ctx, &(buf->flags));
janet_unmarshal_bytes(ctx, buf->data, buf->size);
}
static const JanetAbstractType ta_buffer_type = {
"ta/buffer",
ta_buffer_gc,
NULL,
NULL,
NULL,
ta_buffer_marshal,
ta_buffer_unmarshal,
};
static int ta_mark(void *p, size_t s) {
(void) s;
JanetTArrayView *view = (JanetTArrayView *)p;
janet_mark(janet_wrap_abstract(view->buffer));
return 0;
}
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayView *view = (JanetTArrayView *)p;
size_t offset = (view->buffer->data - (uint8_t *)(view->data));
janet_marshal_int(ctx, view->size);
janet_marshal_int(ctx, view->stride);
janet_marshal_int(ctx, view->type);
janet_marshal_int(ctx, offset);
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
}
static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayView *view = (JanetTArrayView *)p;
size_t offset;
Janet buffer;
janet_unmarshal_size(ctx, &(view->size));
janet_unmarshal_size(ctx, &(view->stride));
janet_unmarshal_uint(ctx, &(view->type));
janet_unmarshal_size(ctx, &offset);
janet_unmarshal_janet(ctx, &buffer);
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
size_t buf_need_size = offset + (janet_tarray_type_size(view->type)) * ((view->size - 1) * view->stride + 1);
if (view->buffer->size < buf_need_size)
janet_panic("bad typed array offset in marshalled data");
view->data = view->buffer->data + offset;
}
#define DEFINE_VIEW_TYPE(thetype) \
typedef struct { \
JanetTArrayBuffer * buffer; \
ta_##thetype##_t * data; \
size_t size; \
size_t stride; \
JanetTArrayType type; \
} TA_View_##thetype ;
#define DEFINE_VIEW_GETTER(type) \
static Janet ta_get_##type(void *p, Janet key) { \
Janet value; \
size_t index; \
if (!janet_checkint(key)) \
janet_panic("expected integer key"); \
index = (size_t)janet_unwrap_integer(key);\
TA_View_##type * array=(TA_View_##type *)p; \
if (index >= array->size) { \
value = janet_wrap_nil(); \
} else { \
value = janet_wrap_number(array->data[index*array->stride]); \
} \
return value; \
}
#define DEFINE_VIEW_SETTER(type) \
void ta_put_##type(void *p, Janet key,Janet value) { \
size_t index;\
if (!janet_checkint(key))\
janet_panic("expected integer key"); \
if (!janet_checktype(value,JANET_NUMBER)) \
janet_panic("expected number value"); \
index = (size_t)janet_unwrap_integer(key); \
TA_View_##type * array=(TA_View_##type *)p; \
if (index >= array->size) { \
janet_panic("typed array out of bounds"); \
} \
array->data[index*array->stride]=(ta_##type##_t)janet_unwrap_number(value); \
}
#define DEFINE_VIEW_INITIALIZER(thetype) \
static JanetTArrayView * ta_init_##thetype(JanetTArrayView * view,JanetTArrayBuffer * buf,size_t size,size_t offset,size_t stride) { \
if ((stride<1) || (size <1)) { \
janet_panic("stride and size should be > 0"); \
}; \
TA_View_##thetype * tview=(TA_View_##thetype *) view; \
size_t buf_size=offset+(sizeof(ta_##thetype##_t))*((size-1)*stride+1); \
if (buf==NULL) { \
buf=(JanetTArrayBuffer *)janet_abstract(&ta_buffer_type,sizeof(JanetTArrayBuffer)); \
ta_buffer_init(buf,buf_size); \
} \
if (buf->size<buf_size) { \
janet_panicf("bad buffer size : %i bytes allocated < %i required",buf->size,buf_size); \
} \
tview->buffer=buf; \
tview->stride=stride; \
tview->size=size; \
tview->data=(ta_##thetype##_t *)(buf->data+offset); \
tview->type=JANET_TARRAY_TYPE_##thetype; \
return view; \
};
#define BUILD_TYPE(type) \
DEFINE_VIEW_TYPE(type) \
DEFINE_VIEW_GETTER(type) \
DEFINE_VIEW_SETTER(type) \
DEFINE_VIEW_INITIALIZER(type)
BUILD_TYPE(uint8)
BUILD_TYPE(int8)
BUILD_TYPE(uint16)
BUILD_TYPE(int16)
BUILD_TYPE(uint32)
BUILD_TYPE(int32)
BUILD_TYPE(uint64)
BUILD_TYPE(int64)
BUILD_TYPE(float32)
BUILD_TYPE(float64)
#undef DEFINE_VIEW_TYPE
#undef DEFINE_VIEW_GETTER
#undef DEFINE_VIEW_SETTER
#undef DEFINE_VIEW_INITIALIZER
#define DEFINE_VIEW_ABSTRACT_TYPE(type) \
{ \
"ta/"#type, \
NULL, \
ta_mark, \
ta_get_##type, \
ta_put_##type, \
ta_view_marshal, \
ta_view_unmarshal \
}
static const JanetAbstractType ta_array_types[] = {
DEFINE_VIEW_ABSTRACT_TYPE(uint8),
DEFINE_VIEW_ABSTRACT_TYPE(int8),
DEFINE_VIEW_ABSTRACT_TYPE(uint16),
DEFINE_VIEW_ABSTRACT_TYPE(int16),
DEFINE_VIEW_ABSTRACT_TYPE(uint32),
DEFINE_VIEW_ABSTRACT_TYPE(int32),
DEFINE_VIEW_ABSTRACT_TYPE(uint64),
DEFINE_VIEW_ABSTRACT_TYPE(int64),
DEFINE_VIEW_ABSTRACT_TYPE(float32),
DEFINE_VIEW_ABSTRACT_TYPE(float64)
};
#undef DEFINE_VIEW_ABSTRACT_TYPE
static int is_ta_anytype(Janet x) {
if (janet_checktype(x, JANET_ABSTRACT)) {
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
for (size_t i = 0; i < TA_COUNT_TYPES; i++) {
if (at == ta_array_types + i) return 1;
}
}
return 0;
}
static int is_ta_type(Janet x, JanetTArrayType type) {
return (janet_checktype(x, JANET_ABSTRACT) && (type < TA_COUNT_TYPES) &&
(janet_abstract_type(janet_unwrap_abstract(x)) == &ta_array_types[type])) ? 1 : 0;
}
#define CASE_TYPE_INITIALIZE(type) case JANET_TARRAY_TYPE_##type : ta_init_##type(view,buffer,size,offset,stride); break
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buf, size);
return buf;
}
JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer) {
JanetTArrayView *view = janet_abstract(&ta_array_types[type], sizeof(JanetTArrayView));
switch (type) {
CASE_TYPE_INITIALIZE(uint8);
CASE_TYPE_INITIALIZE(int8);
CASE_TYPE_INITIALIZE(uint16);
CASE_TYPE_INITIALIZE(int16);
CASE_TYPE_INITIALIZE(uint32);
CASE_TYPE_INITIALIZE(int32);
CASE_TYPE_INITIALIZE(uint64);
CASE_TYPE_INITIALIZE(int64);
CASE_TYPE_INITIALIZE(float32);
CASE_TYPE_INITIALIZE(float64);
default :
janet_panic("bad typed array type");
}
return view;
}
#undef CASE_TYPE_INITIALIZE
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
return (JanetTArrayBuffer *)janet_getabstract(argv, n, &ta_buffer_type);
}
int janet_is_tarray_view(Janet x, JanetTArrayType type) {
return (type == JANET_TARRAY_TYPE_any) ? is_ta_anytype(x) : is_ta_type(x, type);
}
int janet_tarray_type_size(JanetTArrayType type) {
return (type < TA_COUNT_TYPES) ? ta_type_sizes[type] : 0 ;
}
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
if (janet_is_tarray_view(argv[n], type)) {
return (JanetTArrayView *)janet_unwrap_abstract(argv[n]);
} else {
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
n, (type <= JANET_TARRAY_TYPE_any) ? ta_type_names[type] : "?", argv[n]);
return NULL;
}
}
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 5);
size_t offset = 0;
size_t stride = 1;
JanetTArrayBuffer *buffer = NULL;
const uint8_t *keyw = janet_getkeyword(argv, 0);
JanetTArrayType type = get_ta_type_by_name(keyw);
size_t size = (size_t)janet_getinteger(argv, 1);
if (argc > 2)
stride = (size_t)janet_getinteger(argv, 2);
if (argc > 3)
offset = (size_t)janet_getinteger(argv, 3);
if (argc > 4) {
if (is_ta_anytype(argv[4])) {
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[4]);
offset = (view->buffer->data - (uint8_t *)(view->data)) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else {
buffer = (JanetTArrayBuffer *)janet_getabstract(argv, 4, &ta_buffer_type);
}
}
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
return janet_wrap_abstract(view);
}
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
if (is_ta_anytype(argv[0])) {
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
return janet_wrap_abstract(view->buffer);
}
size_t size = (size_t)janet_getinteger(argv, 0);
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
return janet_wrap_abstract(buf);
}
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
if (is_ta_anytype(argv[0])) {
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
return janet_wrap_number(view->size);
}
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
return janet_wrap_number(buf->size);
}
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
if (is_ta_anytype(argv[0])) {
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
JanetKV *props = janet_struct_begin(6);
janet_struct_put(props, janet_ckeywordv("size"), janet_wrap_number(view->size));
janet_struct_put(props, janet_ckeywordv("byte-offset"), janet_wrap_number((uint8_t *)(view->data) - view->buffer->data));
janet_struct_put(props, janet_ckeywordv("stride"), janet_wrap_number(view->stride));
janet_struct_put(props, janet_ckeywordv("type"), janet_ckeywordv(ta_type_names[view->type]));
janet_struct_put(props, janet_ckeywordv("type-size"), janet_wrap_number(ta_type_sizes[view->type]));
janet_struct_put(props, janet_ckeywordv("buffer"), janet_wrap_abstract(view->buffer));
return janet_wrap_struct(janet_struct_end(props));
} else {
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
JanetKV *props = janet_struct_begin(3);
janet_struct_put(props, janet_ckeywordv("size"), janet_wrap_number(buffer->size));
janet_struct_put(props, janet_ckeywordv("big-endian"), janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
return janet_wrap_struct(janet_struct_end(props));
}
}
/* TODO move it , it's not the good place for this function */
static Janet cfun_abstract_properties(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
const uint8_t *key = janet_getkeyword(argv, 0);
const JanetAbstractType *at = janet_get_abstract_type(janet_wrap_keyword(key));
if (at == NULL) {
return janet_wrap_nil();
}
JanetKV *props = janet_struct_begin(2);
janet_struct_put(props, janet_ckeywordv("name"), janet_ckeywordv(at->name));
janet_struct_put(props, janet_ckeywordv("marshal"), janet_wrap_boolean((at->marshal != NULL) && (at->unmarshal != NULL)));
return janet_wrap_struct(janet_struct_end(props));
}
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(argv[0]));
JanetRange range;
int32_t length = (int32_t)src->size;
if (argc == 1) {
range.start = 0;
range.end = length;
} else if (argc == 2) {
range.start = janet_gethalfrange(argv, 1, length, "start");
range.end = length;
} else {
range.start = janet_gethalfrange(argv, 1, length, "start");
range.end = janet_gethalfrange(argv, 2, length, "end");
if (range.end < range.start)
range.end = range.start;
}
JanetArray *array = janet_array(range.end - range.start);
if (array->data) {
for (int32_t i = range.start; i < range.end; i++) {
array->data[i - range.start] = at->get(src, janet_wrap_number(i));
}
}
array->count = range.end - range.start;
return janet_wrap_array(array);
}
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
size_t index_src = (size_t)janet_getinteger(argv, 1);
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
size_t index_dst = (size_t)janet_getinteger(argv, 3);
size_t count = (argc == 5) ? (size_t)janet_getinteger(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
size_t dst_atom_size = ta_type_sizes[dst->type];
size_t step_src = src->stride * src_atom_size;
size_t step_dst = dst->stride * dst_atom_size;
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
for (size_t i = 0; i < count; i++) {
memmove(pd, ps, src_atom_size);
pd += step_dst;
ps += step_src;
}
} else {
janet_panic("typed array copy out of bounds");
}
return janet_wrap_nil();
}
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
size_t index_src = (size_t)janet_getinteger(argv, 1);
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
size_t index_dst = (size_t)janet_getinteger(argv, 3);
size_t count = (argc == 5) ? (size_t)janet_getinteger(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
size_t dst_atom_size = ta_type_sizes[dst->type];
size_t step_src = src->stride * src_atom_size;
size_t step_dst = dst->stride * dst_atom_size;
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
uint8_t temp[TA_ATOM_MAXSIZE];
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
for (size_t i = 0; i < count; i++) {
memcpy(temp, ps, src_atom_size);
memcpy(ps, pd, src_atom_size);
memcpy(pd, temp, src_atom_size);
pd += step_dst;
ps += step_src;
}
} else {
janet_panic("typed array swap out of bounds");
}
return janet_wrap_nil();
}
static const JanetReg ta_cfuns[] = {
{
"tarray/new", cfun_typed_array_new,
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
"Create new typed array")
},
{
"tarray/buffer", cfun_typed_array_buffer,
JDOC("(tarray/buffer (array | size) )\n\n"
"return typed array buffer or create a new buffer ")
},
{
"tarray/length", cfun_typed_array_size,
JDOC("(tarray/length (array | buffer) )\n\n"
"return typed array or buffer size ")
},
{
"tarray/properties", cfun_typed_array_properties,
JDOC("(tarray/properties array )\n\n"
"return typed array properties as a struct")
},
{
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
"copy count elements of src array from index sindex \n"
"to dst array at position dindex \n"
"memory can overlap"
)
},
{
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
"swap count elements between src array from index sindex \n"
"and dst array at position dindex \n"
"memory can overlap"
)
},
{
"tarray/slice", cfun_typed_array_slice,
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
"Takes a slice of typed array from start to end. The range is half"
"open, [start, end). Indexes can also be negative, indicating indexing"
"from the end of the end of the typed array. By default, start is 0 and end is"
"the size of the typed array. Returns a new janet array.")
},
{
"abstract/properties", cfun_abstract_properties,
JDOC("(abstract/properties tag)\n\n"
"return abstract type properties as a struct")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_typed_array(JanetTable *env) {
janet_core_cfuns(env, NULL, ta_cfuns);
janet_register_abstract_type(&ta_buffer_type);
for (size_t i = 0; i < TA_COUNT_TYPES; i++) {
janet_register_abstract_type(ta_array_types + i);
}
}

32
src/core/util.c
View File

@ -284,6 +284,38 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
}
}
/* Abstract type introspection */
static const JanetAbstractType type_wrap = {"core/type_info", NULL, NULL, NULL, NULL, NULL, NULL};
typedef struct {
const JanetAbstractType *at;
} JanetAbstractTypeWrap;
void janet_register_abstract_type(const JanetAbstractType *at) {
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
abstract->at = at;
if (!(janet_checktype(janet_table_get(janet_vm_registry, janet_ckeywordv(at->name)), JANET_NIL))) {
janet_panic("Register abstract type fail, a type with same name exists");
}
janet_table_put(janet_vm_registry, janet_ckeywordv(at->name), janet_wrap_abstract(abstract));
}
const JanetAbstractType *janet_get_abstract_type(Janet key) {
Janet twrap = janet_table_get(janet_vm_registry, key);
if (janet_checktype(twrap, JANET_NIL)) {
return NULL;
}
if (!janet_checktype(twrap, JANET_ABSTRACT) || (janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
janet_panic("expected abstract type");
}
JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
return w->at;
}
#ifndef JANET_BOOTSTRAP
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
(void) p;

5
src/core/util.h
View File

@ -89,5 +89,10 @@ void janet_lib_debug(JanetTable *env);
#ifdef JANET_PEG
void janet_lib_peg(JanetTable *env);
#endif
#ifdef JANET_TYPED_ARRAY
void janet_lib_typed_array(JanetTable *env);
#endif
#endif

72
src/include/janet.h
View File

@ -128,6 +128,12 @@ extern "C" {
#define JANET_PEG
#endif
/* Enable or disable the typedarray module */
#ifndef JANET_NO_TYPED_ARRAY
#define JANET_TYPED_ARRAY
#endif
/* How to export symbols */
#ifndef JANET_API
#ifdef JANET_WINDOWS
@ -798,6 +804,13 @@ struct JanetParser {
int lookback;
};
typedef struct {
void *m_state; /* void* to not expose MarshalState ?*/
void *u_state;
int flags;
const uint8_t *data;
} JanetMarshalContext;
/* Defines an abstract type */
struct JanetAbstractType {
const char *name;
@ -805,6 +818,8 @@ struct JanetAbstractType {
int (*gcmark)(void *data, size_t len);
Janet(*get)(void *data, Janet key);
void (*put)(void *data, Janet key, Janet value);
void (*marshal)(void *p, JanetMarshalContext *ctx);
void (*unmarshal)(void *p, JanetMarshalContext *ctx);
};
struct JanetReg {
@ -1235,6 +1250,63 @@ JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
/* Marshal API */
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, int32_t len);
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
JANET_API void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i);
JANET_API void janet_unmarshal_uint(JanetMarshalContext *ctx, uint32_t *i);
JANET_API void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i);
JANET_API void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, int32_t len);
JANET_API void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
#ifdef JANET_TYPED_ARRAY
typedef enum {
JANET_TARRAY_TYPE_uint8,
JANET_TARRAY_TYPE_int8,
JANET_TARRAY_TYPE_uint16,
JANET_TARRAY_TYPE_int16,
JANET_TARRAY_TYPE_uint32,
JANET_TARRAY_TYPE_int32,
JANET_TARRAY_TYPE_uint64,
JANET_TARRAY_TYPE_int64,
JANET_TARRAY_TYPE_float32,
JANET_TARRAY_TYPE_float64,
JANET_TARRAY_TYPE_any,
} JanetTArrayType;
typedef struct {
uint8_t *data;
size_t size;
uint32_t flags;
} JanetTArrayBuffer;
typedef struct {
JanetTArrayBuffer *buffer;
void *data; /* pointer inside buffer->data */
size_t size;
size_t stride;
JanetTArrayType type;
} JanetTArrayView;
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
JANET_API int janet_tarray_type_size(JanetTArrayType type);
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
#endif
/***** END SECTION MAIN *****/
#ifdef __cplusplus

55
test/suite5.janet Normal file
View File

@ -0,0 +1,55 @@
# Copyright (c) 2019 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import test/helper :prefix "" :exit true)
(start-suite 5)
# some tests typed array
(assert-no-error
"create some typed array"
(do
(def a (tarray/new :float64 10))
(def b (tarray/new :float64 5 2 0 a))
(def c (tarray/new :uint32 20))
))
(assert-no-error
"create some typed array from buffer"
(do
(def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8))))
(def b (tarray/new :float64 10 2 64 buf))))
(def a (tarray/new :float64 10))
(def b (tarray/new :float64 5 2 0 a))
(assert-no-error
"fill tarray"
(for i 0 (tarray/length a)
(set (a i) i)))
(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer")
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
(end-suite)