mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-23 06:50:26 +00:00
Code Issues 1 Releases Wiki Activity

Renamed bigint -> inttypes / int

Browse Source 
A lot of refactoring larger integer types. Fix a number
of casting errors, but mostly rename things. Also try to
limit use of template-like macros as they bloat the binary
if not used in moderation. We were able to reduce the size of
typed array code as well by using a single view types.
This commit is contained in:
Calvin Rose 2019-03-18 21:12:38 -04:00
parent a07d76b264
commit bad040665f
10 changed files with 645 additions and 726 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

398
src/core/bigint.c
View File

@ -1,398 +0,0 @@
/*
* 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
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#ifndef JANET_AMALG
#include <janet.h>
#include "util.h"
#endif
#define MAX_INT_IN_DBL 9007199254740992UL /*2^53*/
typedef int64_t bi_int64;
typedef uint64_t bi_uint64;
static Janet int64_get(void *p, Janet key);
static Janet uint64_get(void *p, Janet key);
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
bi_int64 *box = (bi_int64 *)p;
janet_marshal_size(ctx, (size_t)(*box));
}
static void uint64_marshal(void *p, JanetMarshalContext *ctx) {
bi_uint64 *box = (bi_uint64 *)p;
janet_marshal_size(ctx, (size_t)(*box));
}
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
bi_int64 *box = (bi_int64 *)p;
janet_unmarshal_size(ctx, (size_t *)box);
}
static void uint64_unmarshal(void *p, JanetMarshalContext *ctx) {
bi_uint64 *box = (bi_uint64 *)p;
janet_unmarshal_size(ctx, (size_t *)box);
}
static const JanetAbstractType bi_int64_type = {
"core/int64",
NULL,
NULL,
int64_get,
NULL,
int64_marshal,
int64_unmarshal
};
static const JanetAbstractType bi_uint64_type = {
"core/uint64",
NULL,
NULL,
uint64_get,
NULL,
uint64_marshal,
uint64_unmarshal
};
static bi_int64 check_bi_int64(Janet x) {
switch (janet_type(x)) {
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (bi_int64)dbl;
break;
}
case JANET_STRING: {
bi_int64 value;
const uint8_t *str = janet_unwrap_string(x);
if (janet_scan_int64(str, janet_string_length(str), &value))
return value;
break;
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if ((janet_abstract_type(abst) == &bi_int64_type) || (janet_abstract_type(abst) == &bi_uint64_type))
return *(bi_int64 *)abst;
break;
}
}
janet_panic("bad int64 initializer");
return 0;
}
static bi_uint64 check_bi_uint64(Janet x) {
switch (janet_type(x)) {
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
return (bi_uint64)dbl;
break;
}
case JANET_STRING: {
bi_uint64 value;
const uint8_t *str = janet_unwrap_string(x);
if (janet_scan_uint64(str, janet_string_length(str), &value))
return value;
break;
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &bi_uint64_type)
return *(bi_uint64 *)abst;
break;
}
}
janet_panic("bad uint64 initializer");
return 0;
}
/* C API */
JanetBigintType janet_is_bigint(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_BIGINT_TYPE_none;
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
return (at == &bi_int64_type) ? JANET_BIGINT_TYPE_int64 : ((at == &bi_uint64_type) ? JANET_BIGINT_TYPE_uint64 : JANET_BIGINT_TYPE_none);
}
Janet janet_bigint_int64(int64_t x) {
bi_int64 *box = (bi_int64 *)janet_abstract(&bi_int64_type, sizeof(bi_int64));
*box = (bi_int64)x;
return janet_wrap_abstract(box);
}
Janet janet_bigint_uint64(uint64_t x) {
bi_uint64 *box = (bi_uint64 *)janet_abstract(&bi_uint64_type, sizeof(bi_uint64));
*box = (bi_uint64)x;
return janet_wrap_abstract(box);
}
int64_t janet_checkbigint_int64(Janet x) {
return (int64_t)check_bi_int64(x);
}
uint64_t janet_checkbigint_uint64(Janet x) {
return (uint64_t)check_bi_uint64(x);
}
static Janet cfun_bi_int64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return janet_bigint_int64(check_bi_int64(argv[0]));
}
static Janet cfun_bi_uint64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return janet_bigint_uint64(check_bi_uint64(argv[0]));
}
#define OPMETHOD(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_abstract(&bi_##type##_type, sizeof(bi_##type)); \
*box = check_bi_##type(argv[0]); \
for (int i=1;i<argc;i++) \
*box oper##= check_bi_##type(argv[i]); \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_getabstract(argv,0,&bi_##type##_type); \
for (int i=1;i<argc;i++) \
*box oper##= check_bi_##type(argv[i]); \
return janet_wrap_abstract(box); \
}
#define DIVMETHOD(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_abstract(&bi_##type##_type, sizeof(bi_##type)); \
*box = check_bi_##type(argv[0]); \
for (int i=1;i<argc;i++) { \
bi_##type value = check_bi_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= check_bi_##type(argv[i]); \
} \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_getabstract(argv,0,&bi_##type##_type); \
for (int i=1;i<argc;i++) { \
bi_##type value = check_bi_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= check_bi_##type(argv[i]); \
} \
return janet_wrap_abstract(box); \
}
#define DIVMETHOD_SIGNED(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_abstract(&bi_##type##_type, sizeof(bi_##type)); \
*box = check_bi_##type(argv[0]); \
for (int i=1;i<argc;i++) { \
bi_##type value = check_bi_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= check_bi_##type(argv[i]); \
} \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
bi_##type *box = (bi_##type *)janet_getabstract(argv,0,&bi_##type##_type); \
for (int i=1;i<argc;i++) { \
bi_##type value = check_bi_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= check_bi_##type(argv[i]); \
} \
return janet_wrap_abstract(box); \
}
#define COMPMETHOD(type,name,oper) \
static Janet cfun_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
bi_##type v1 = check_bi_##type(argv[0]); \
bi_##type v2 = check_bi_##type(argv[1]); \
return janet_wrap_boolean(v1 oper v2); \
}
OPMETHOD(int64, add, +)
OPMETHOD(int64, sub, -)
OPMETHOD(int64, mul, *)
DIVMETHOD_SIGNED(int64, div, /)
DIVMETHOD_SIGNED(int64, mod, %)
OPMETHOD(int64, and, &)
OPMETHOD(int64, or, |)
OPMETHOD(int64, xor, ^)
OPMETHOD(int64, lshift, <<)
OPMETHOD(int64, rshift, >>)
COMPMETHOD(int64, lt, <)
COMPMETHOD(int64, gt, >)
COMPMETHOD(int64, le, <=)
COMPMETHOD(int64, ge, >=)
COMPMETHOD(int64, eq, ==)
COMPMETHOD(int64, ne, !=)
OPMETHOD(uint64, add, +)
OPMETHOD(uint64, sub, -)
OPMETHOD(uint64, mul, *)
DIVMETHOD(uint64, div, /)
DIVMETHOD(uint64, mod, %)
OPMETHOD(uint64, and, &)
OPMETHOD(uint64, or, |)
OPMETHOD(uint64, xor, ^)
OPMETHOD(uint64, lshift, <<)
OPMETHOD(uint64, rshift, >>)
COMPMETHOD(uint64, lt, <)
COMPMETHOD(uint64, gt, >)
COMPMETHOD(uint64, le, <=)
COMPMETHOD(uint64, ge, >=)
COMPMETHOD(uint64, eq, ==)
COMPMETHOD(uint64, ne, !=)
#undef OPMETHOD
#undef DIVMETHOD
#undef DIVMETHOD_SIGNED
#undef COMPMETHOD
static JanetMethod int64_methods[] = {
{"+", cfun_int64_add},
{"-", cfun_int64_sub},
{"*", cfun_int64_mul},
{"/", cfun_int64_div},
{"%", cfun_int64_mod},
{"<", cfun_int64_lt},
{">", cfun_int64_gt},
{"<=", cfun_int64_le},
{">=", cfun_int64_ge},
{"==", cfun_int64_eq},
{"!=", cfun_int64_ne},
{"&", cfun_int64_and},
{"|", cfun_int64_or},
{"^", cfun_int64_xor},
{"<<", cfun_int64_lshift},
{">>", cfun_int64_rshift},
{"+!", cfun_int64_add_mut},
{"-!", cfun_int64_sub_mut},
{"*!", cfun_int64_mul_mut},
{"/!", cfun_int64_div_mut},
{"%!", cfun_int64_mod_mut},
{"&!", cfun_int64_and_mut},
{"|!", cfun_int64_or_mut},
{"^!", cfun_int64_xor_mut},
{"<<!", cfun_int64_lshift_mut},
{">>!", cfun_int64_rshift_mut},
{NULL, NULL}
};
static JanetMethod uint64_methods[] = {
{"+", cfun_uint64_add},
{"-", cfun_uint64_sub},
{"*", cfun_uint64_mul},
{"/", cfun_uint64_div},
{"%", cfun_uint64_mod},
{"<", cfun_uint64_lt},
{">", cfun_uint64_gt},
{"<=", cfun_uint64_le},
{">=", cfun_uint64_ge},
{"==", cfun_uint64_eq},
{"!=", cfun_uint64_ne},
{"&", cfun_uint64_and},
{"|", cfun_uint64_or},
{"^", cfun_uint64_xor},
{"<<", cfun_uint64_lshift},
{">>", cfun_uint64_rshift},
{"+!", cfun_uint64_add_mut},
{"-!", cfun_uint64_sub_mut},
{"*!", cfun_uint64_mul_mut},
{"/!", cfun_uint64_div_mut},
{"%!", cfun_uint64_mod_mut},
{"&!", cfun_uint64_and_mut},
{"|!", cfun_uint64_or_mut},
{"^!", cfun_uint64_xor_mut},
{"<<!", cfun_uint64_lshift_mut},
{">>!", cfun_uint64_rshift_mut},
{NULL, NULL}
};
static Janet int64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), int64_methods);
}
static Janet uint64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), uint64_methods);
}
static const JanetReg bi_cfuns[] = {
{
"bigint/int64", cfun_bi_int64_new,
JDOC("(bigint/int64 value )\n\n"
"Create new int64.")
},
{
"bigint/uint64", cfun_bi_uint64_new,
JDOC("(bigint/uint64 value )\n\n"
"Create new uint64.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_bigint(JanetTable *env) {
janet_core_cfuns(env, NULL, bi_cfuns);
janet_register_abstract_type(&bi_int64_type);
janet_register_abstract_type(&bi_uint64_type);
}

4
src/core/corelib.c
View File

@ -827,8 +827,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
#ifdef JANET_TYPED_ARRAY
janet_lib_typed_array(env);
#endif
#ifdef JANET_BIGINT
janet_lib_bigint(env);
#ifdef JANET_INT_TYPES
janet_lib_inttypes(env);
#endif

366
src/core/inttypes.c Normal file
View File

@ -0,0 +1,366 @@
/*
* 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.
*/
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#ifndef JANET_AMALG
#include <janet.h>
#include "util.h"
#endif
/* Conditional compilation */
#ifdef JANET_INT_TYPES
#define MAX_INT_IN_DBL 9007199254740992UL /* 2^53 */
static Janet it_s64_get(void *p, Janet key);
static Janet it_u64_get(void *p, Janet key);
static void int64_marshal(void *p, JanetMarshalContext *ctx) {
janet_marshal_int64(ctx, *((int64_t *)p));
}
static void int64_unmarshal(void *p, JanetMarshalContext *ctx) {
*((int64_t *)p) = janet_unmarshal_int64(ctx);
}
static const JanetAbstractType it_s64_type = {
"core/s64",
NULL,
NULL,
it_s64_get,
NULL,
int64_marshal,
int64_unmarshal
};
static const JanetAbstractType it_u64_type = {
"core/u64",
NULL,
NULL,
it_u64_get,
NULL,
int64_marshal,
int64_unmarshal
};
int64_t janet_unwrap_s64(Janet x) {
switch (janet_type(x)) {
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
if (fabs(dbl) <= MAX_INT_IN_DBL)
return (int64_t)dbl;
break;
}
case JANET_STRING: {
int64_t value;
const uint8_t *str = janet_unwrap_string(x);
if (janet_scan_int64(str, janet_string_length(str), &value))
return value;
break;
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
return *(int64_t *)abst;
break;
}
}
janet_panic("bad s64 initializer");
return 0;
}
uint64_t janet_unwrap_u64(Janet x) {
switch (janet_type(x)) {
case JANET_NUMBER : {
double dbl = janet_unwrap_number(x);
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
return (uint64_t)dbl;
break;
}
case JANET_STRING: {
uint64_t value;
const uint8_t *str = janet_unwrap_string(x);
if (janet_scan_uint64(str, janet_string_length(str), &value))
return value;
break;
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
return *(uint64_t *)abst;
break;
}
}
janet_panic("bad u64 initializer");
return 0;
}
JanetIntType janet_is_int(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
return (at == &it_s64_type) ? JANET_INT_S64 :
((at == &it_u64_type) ? JANET_INT_U64 :
JANET_INT_NONE);
}
Janet janet_wrap_s64(int64_t x) {
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
*box = (int64_t)x;
return janet_wrap_abstract(box);
}
Janet janet_wrap_u64(uint64_t x) {
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
*box = (uint64_t)x;
return janet_wrap_abstract(box);
}
static Janet cfun_it_s64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}
static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_getabstract(argv,0,&it_##type##_type); \
for (int i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
return janet_wrap_abstract(box); \
}
#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_getabstract(argv,0,&it_##type##_type); \
for (int i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
}
#define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
} \
\
static Janet cfun_it_##type##_##name##_mut(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_getabstract(argv,0,&it_##type##_type); \
for (int i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
if (value == 0) janet_panic("division by zero"); \
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
*box oper##= value; \
} \
return janet_wrap_abstract(box); \
}
#define COMPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T v1 = janet_unwrap_##type(argv[0]); \
T v2 = janet_unwrap_##type(argv[1]); \
return janet_wrap_boolean(v1 oper v2); \
}
OPMETHOD(int64_t, s64, add, +)
OPMETHOD(int64_t, s64, sub, -)
OPMETHOD(int64_t, s64, mul, *)
DIVMETHOD_SIGNED(int64_t, s64, div, /)
DIVMETHOD_SIGNED(int64_t, s64, mod, %)
OPMETHOD(int64_t, s64, and, &)
OPMETHOD(int64_t, s64, or, |)
OPMETHOD(int64_t, s64, xor, ^)
OPMETHOD(int64_t, s64, lshift, <<)
OPMETHOD(int64_t, s64, rshift, >>)
COMPMETHOD(int64_t, s64, lt, <)
COMPMETHOD(int64_t, s64, gt, >)
COMPMETHOD(int64_t, s64, le, <=)
COMPMETHOD(int64_t, s64, ge, >=)
COMPMETHOD(int64_t, s64, eq, ==)
COMPMETHOD(int64_t, s64, ne, !=)
OPMETHOD(uint64_t, u64, add, +)
OPMETHOD(uint64_t, u64, sub, -)
OPMETHOD(uint64_t, u64, mul, *)
DIVMETHOD(uint64_t, u64, div, /)
DIVMETHOD(uint64_t, u64, mod, %)
OPMETHOD(uint64_t, u64, and, &)
OPMETHOD(uint64_t, u64, or, |)
OPMETHOD(uint64_t, u64, xor, ^)
OPMETHOD(uint64_t, u64, lshift, <<)
OPMETHOD(uint64_t, u64, rshift, >>)
COMPMETHOD(uint64_t, u64, lt, <)
COMPMETHOD(uint64_t, u64, gt, >)
COMPMETHOD(uint64_t, u64, le, <=)
COMPMETHOD(uint64_t, u64, ge, >=)
COMPMETHOD(uint64_t, u64, eq, ==)
COMPMETHOD(uint64_t, u64, ne, !=)
#undef OPMETHOD
#undef DIVMETHOD
#undef DIVMETHOD_SIGNED
#undef COMPMETHOD
static JanetMethod it_s64_methods[] = {
{"+", cfun_it_s64_add},
{"-", cfun_it_s64_sub},
{"*", cfun_it_s64_mul},
{"/", cfun_it_s64_div},
{"%", cfun_it_s64_mod},
{"<", cfun_it_s64_lt},
{">", cfun_it_s64_gt},
{"<=", cfun_it_s64_le},
{">=", cfun_it_s64_ge},
{"==", cfun_it_s64_eq},
{"!=", cfun_it_s64_ne},
{"&", cfun_it_s64_and},
{"|", cfun_it_s64_or},
{"^", cfun_it_s64_xor},
{"<<", cfun_it_s64_lshift},
{">>", cfun_it_s64_rshift},
{"+!", cfun_it_s64_add_mut},
{"-!", cfun_it_s64_sub_mut},
{"*!", cfun_it_s64_mul_mut},
{"/!", cfun_it_s64_div_mut},
{"%!", cfun_it_s64_mod_mut},
{"&!", cfun_it_s64_and_mut},
{"|!", cfun_it_s64_or_mut},
{"^!", cfun_it_s64_xor_mut},
{"<<!", cfun_it_s64_lshift_mut},
{">>!", cfun_it_s64_rshift_mut},
{NULL, NULL}
};
static JanetMethod it_u64_methods[] = {
{"+", cfun_it_u64_add},
{"-", cfun_it_u64_sub},
{"*", cfun_it_u64_mul},
{"/", cfun_it_u64_div},
{"%", cfun_it_u64_mod},
{"<", cfun_it_u64_lt},
{">", cfun_it_u64_gt},
{"<=", cfun_it_u64_le},
{">=", cfun_it_u64_ge},
{"==", cfun_it_u64_eq},
{"!=", cfun_it_u64_ne},
{"&", cfun_it_u64_and},
{"|", cfun_it_u64_or},
{"^", cfun_it_u64_xor},
{"<<", cfun_it_u64_lshift},
{">>", cfun_it_u64_rshift},
{"+!", cfun_it_u64_add_mut},
{"-!", cfun_it_u64_sub_mut},
{"*!", cfun_it_u64_mul_mut},
{"/!", cfun_it_u64_div_mut},
{"%!", cfun_it_u64_mod_mut},
{"&!", cfun_it_u64_and_mut},
{"|!", cfun_it_u64_or_mut},
{"^!", cfun_it_u64_xor_mut},
{"<<!", cfun_it_u64_lshift_mut},
{">>!", cfun_it_u64_rshift_mut},
{NULL, NULL}
};
static Janet it_s64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), it_s64_methods);
}
static Janet it_u64_get(void *p, Janet key) {
(void) p;
if (!janet_checktype(key, JANET_KEYWORD))
janet_panicf("expected keyword, got %v", key);
return janet_getmethod(janet_unwrap_keyword(key), it_u64_methods);
}
static const JanetReg it_cfuns[] = {
{
"int/s64", cfun_it_s64_new,
JDOC("(int/s64 value)\n\n"
"Create a boxed signed 64 bit integer from a string value.")
},
{
"int/u64", cfun_it_u64_new,
JDOC("(int/u64 value)\n\n"
"Create a boxed unsigned 64 bit integer from a string value.")
},
{NULL, NULL, NULL}
};
/* Module entry point */
void janet_lib_inttypes(JanetTable *env) {
janet_core_cfuns(env, NULL, it_cfuns);
janet_register_abstract_type(&it_s64_type);
janet_register_abstract_type(&it_u64_type);
}
#endif

34
src/core/marsh.c
View File

@ -129,7 +129,7 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
}
/* Marshal a size_t onto the buffer */
static void pushsize(MarshalState *st, size_t x) {
static void push64(MarshalState *st, uint64_t x) {
if (x <= 0xF0) {
/* Single byte */
pushbyte(st, (uint8_t) x);
@ -286,9 +286,9 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
}
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value) {
MarshalState *st = (MarshalState *)(ctx->m_state);
pushsize(st, value);
push64(st, (uint64_t) value);
};
void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
@ -323,7 +323,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
JanetMarshalContext context = {st, NULL, flags, NULL};
pushbyte(st, LB_ABSTRACT);
marshal_one(st, janet_csymbolv(at->name), flags + 1);
pushsize(st, janet_abstract_size(abstract));
push64(st, (uint64_t) janet_abstract_size(abstract));
at->marshal(abstract, &context);
} else {
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
@ -579,8 +579,8 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
}
/* Helper to read a size_t (up to 8 bytes unsigned). */
static size_t readsize(UnmarshalState *st, const uint8_t **atdata) {
size_t ret;
static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
uint64_t ret;
const uint8_t *data = *atdata;
MARSH_EOS(st, data);
if (*data <= 0xF0) {
@ -591,7 +591,7 @@ static size_t readsize(UnmarshalState *st, const uint8_t **atdata) {
/* Multibyte, little endian */
int nbytes = *data - 0xF0;
ret = 0;
if (nbytes > 8) janet_panic("invalid size_t");
if (nbytes > 8) janet_panic("invalid 64 bit integer");
MARSH_EOS(st, data + nbytes);
for (int i = nbytes; i > 0; i--)
ret = (ret << 8) + data[i];
@ -949,20 +949,20 @@ static const uint8_t *unmarshal_one_fiber(
return data;
}
void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i) {
int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
*i = readint(st, &(ctx->data));
return readint(st, &(ctx->data));
};
void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i) {
int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
*i = readsize(st, &(ctx->data));
return read64(st, &(ctx->data));
};
void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b) {
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
MARSH_EOS(st, ctx->data);
*b = *(ctx->data++);
return *(ctx->data++);
};
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
@ -972,9 +972,11 @@ void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len)
ctx->data += len;
}
void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out) {
Janet janet_unmarshal_janet(JanetMarshalContext *ctx) {
Janet ret;
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
ctx->data = unmarshal_one(st, ctx->data, out, ctx->flags);
ctx->data = unmarshal_one(st, ctx->data, &ret, ctx->flags);
return ret;
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
@ -983,7 +985,7 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
const JanetAbstractType *at = janet_get_abstract_type(key);
if (at == NULL) return NULL;
if (at->unmarshal) {
void *p = janet_abstract(at, readsize(st, &data));
void *p = janet_abstract(at, (size_t) read64(st, &data));
JanetMarshalContext context = {NULL, st, flags, data};
at->unmarshal(p, &context);
*out = janet_wrap_abstract(p);

11
src/core/strtod.c
View File

@ -362,14 +362,13 @@ error:
return 1;
}
#ifdef JANET_BIGINT
#ifdef JANET_INT_TYPES
static int scan_bigint(
static int scan_int64(
const uint8_t *str,
int32_t len,
uint64_t *out,
int *neg
) {
int *neg) {
const uint8_t *end = str + len;
int seenadigit = 0;
int base = 10;
@ -433,7 +432,7 @@ static int scan_bigint(
int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
int neg;
uint64_t bi;
if (scan_bigint(str, len, &bi, &neg)) {
if (scan_int64(str, len, &bi, &neg)) {
if (neg && bi <= 0x8000000000000000UL) {
*out = -bi;
return 1;
@ -449,7 +448,7 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
int neg;
uint64_t bi;
if (scan_bigint(str, len, &bi, &neg)) {
if (scan_int64(str, len, &bi, &neg)) {
if (!neg) {
*out = bi;
return 1;

468
src/core/typedarray.c
View File

@ -29,19 +29,6 @@
#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 float ta_float32_t;
typedef double ta_float64_t;
#ifdef JANET_BIGINT
typedef uint64_t ta_uint64_t;
typedef int64_t ta_int64_t;
#endif
static char *ta_type_names[] = {
"uint8",
"int8",
@ -49,32 +36,28 @@ static char *ta_type_names[] = {
"int16",
"uint32",
"int32",
#ifdef JANET_BIGINT
"uint64",
"int64",
#endif
"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),
#ifdef JANET_BIGINT
sizeof(ta_uint64_t),
sizeof(ta_int64_t),
#endif
sizeof(ta_float32_t),
sizeof(ta_float64_t),
sizeof(uint8_t),
sizeof(int8_t),
sizeof(uint16_t),
sizeof(int16_t),
sizeof(uint32_t),
sizeof(int32_t),
sizeof(uint64_t),
sizeof(int64_t),
sizeof(float),
sizeof(double),
0
};
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_float64 + 1)
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
#define TA_ATOM_MAXSIZE 8
#define TA_FLAG_BIG_ENDIAN 1
@ -120,10 +103,9 @@ static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
size_t size;
janet_unmarshal_size(ctx, &size);
size_t size = janet_unmarshal_size(ctx);
ta_buffer_init(buf, size);
janet_unmarshal_int(ctx, &(buf->flags));
buf->flags = janet_unmarshal_int(ctx);
janet_unmarshal_bytes(ctx, buf->data, size);
}
@ -146,7 +128,7 @@ static int ta_mark(void *p, size_t s) {
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
JanetTArrayView *view = (JanetTArrayView *)p;
size_t offset = (view->buffer->data - (uint8_t *)(view->data));
size_t offset = (view->buffer->data - view->as.u8);
janet_marshal_size(ctx, view->size);
janet_marshal_size(ctx, view->stride);
janet_marshal_int(ctx, view->type);
@ -159,248 +141,194 @@ static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
size_t offset;
int32_t atype;
Janet buffer;
janet_unmarshal_size(ctx, &(view->size));
janet_unmarshal_size(ctx, &(view->stride));
janet_unmarshal_int(ctx, &atype);
view->size = janet_unmarshal_size(ctx);
view->stride = janet_unmarshal_size(ctx);
atype = janet_unmarshal_int(ctx);
if (atype < 0 || atype >= TA_COUNT_TYPES)
janet_panic("bad typed array type");
view->type = atype;
janet_unmarshal_size(ctx, &offset);
janet_unmarshal_janet(ctx, &buffer);
offset = janet_unmarshal_size(ctx);
buffer = janet_unmarshal_janet(ctx);
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
janet_panicf("expected typed array 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);
size_t buf_need_size = offset + (ta_type_sizes[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;
view->as.u8 = 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_checksize(key)) \
janet_panic("expected size as key"); \
index = (size_t)janet_unwrap_number(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_GETTER_BIGINT(type) \
static Janet ta_get_##type(void *p, Janet key) { \
Janet value; \
size_t index; \
if (!janet_checksize(key)) \
janet_panic("expected size as key"); \
index = (size_t)janet_unwrap_number(key);\
TA_View_##type *array=(TA_View_##type *)p; \
if (index >= array->size) { \
value = janet_wrap_nil(); \
} else { \
value = janet_bigint_##type(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_checksize(key))\
janet_panic("expected size as key"); \
if (!janet_checktype(value,JANET_NUMBER)) \
janet_panic("expected number value"); \
index = (size_t)janet_unwrap_number(key); \
TA_View_##type *array=(TA_View_##type *)p; \
if (index >= array->size) { \
janet_panic("index out of bounds"); \
} \
array->data[index*array->stride]=(ta_##type##_t)janet_unwrap_number(value); \
}
#define DEFINE_VIEW_SETTER_BIGINT(type) \
void ta_put_##type(void *p, Janet key,Janet value) { \
size_t index;\
if (!janet_checksize(key))\
janet_panic("expected size as key"); \
index = (size_t)janet_unwrap_number(key); \
TA_View_##type *array=(TA_View_##type *)p; \
if (index >= array->size) { \
janet_panic("index out of bounds"); \
} \
array->data[index*array->stride]=(ta_##type##_t)janet_checkbigint_##type(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)
#define BUILD_TYPE_BIGINT(type) \
DEFINE_VIEW_TYPE(type) \
DEFINE_VIEW_GETTER_BIGINT(type) \
DEFINE_VIEW_SETTER_BIGINT(type) \
DEFINE_VIEW_INITIALIZER(type)
BUILD_TYPE(uint8)
BUILD_TYPE(int8)
BUILD_TYPE(uint16)
BUILD_TYPE(int16)
BUILD_TYPE(uint32)
BUILD_TYPE(int32)
#ifdef JANET_BIGINT
BUILD_TYPE_BIGINT(uint64)
BUILD_TYPE_BIGINT(int64)
static Janet ta_getter(void *p, Janet key) {
Janet value;
size_t index, i;
JanetTArrayView *array = p;
if (!janet_checksize(key)) janet_panic("expected size as key");
index = (size_t) janet_unwrap_number(key);
i = index * array->stride;
if (index >= array->size) {
value = janet_wrap_nil();
} else {
switch (array->type) {
case JANET_TARRAY_TYPE_U8:
value = janet_wrap_number(array->as.u8[i]);
break;
case JANET_TARRAY_TYPE_S8:
value = janet_wrap_number(array->as.s8[i]);
break;
case JANET_TARRAY_TYPE_U16:
value = janet_wrap_number(array->as.u16[i]);
break;
case JANET_TARRAY_TYPE_S16:
value = janet_wrap_number(array->as.s16[i]);
break;
case JANET_TARRAY_TYPE_U32:
value = janet_wrap_number(array->as.u32[i]);
break;
case JANET_TARRAY_TYPE_S32:
value = janet_wrap_number(array->as.s32[i]);
break;
#ifdef JANET_INT_TYPES
case JANET_TARRAY_TYPE_U64:
value = janet_wrap_u64(array->as.u64[i]);
break;
case JANET_TARRAY_TYPE_S64:
value = janet_wrap_s64(array->as.s64[i]);
break;
#endif
BUILD_TYPE(float32)
BUILD_TYPE(float64)
#undef DEFINE_VIEW_TYPE
#undef DEFINE_VIEW_GETTER
#undef DEFINE_VIEW_SETTER
#undef DEFINE_VIEW_GETTER_BIGINT
#undef DEFINE_VIEW_SETTER_BIGINT
#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 \
case JANET_TARRAY_TYPE_F32:
value = janet_wrap_number(array->as.f32[i]);
break;
case JANET_TARRAY_TYPE_F64:
value = janet_wrap_number(array->as.f64[i]);
break;
default:
janet_panicf("cannot get from typed array of type %s",
ta_type_names[array->type]);
break;
}
}
return value;
}
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),
#ifdef JANET_BIGINT
DEFINE_VIEW_ABSTRACT_TYPE(uint64),
DEFINE_VIEW_ABSTRACT_TYPE(int64),
static void ta_setter(void *p, Janet key, Janet value) {
size_t index, i;
if (!janet_checksize(key)) janet_panic("expected size as key");
index = (size_t) janet_unwrap_number(key);
JanetTArrayView *array = p;
i = index * array->stride;
if (index >= array->size) {
janet_panic("index out of bounds");
}
if (!janet_checktype(value, JANET_NUMBER) &&
array->type != JANET_TARRAY_TYPE_U64 &&
array->type != JANET_TARRAY_TYPE_S64) {
janet_panic("expected number value");
}
switch (array->type) {
case JANET_TARRAY_TYPE_U8:
array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_S8:
array->as.s8[i] = (int8_t) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_U16:
array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_S16:
array->as.s16[i] = (int16_t) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_U32:
array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_S32:
array->as.s32[i] = (int32_t) janet_unwrap_number(value);
break;
#ifdef JANET_INT_TYPES
case JANET_TARRAY_TYPE_U64:
array->as.u64[i] = janet_unwrap_u64(value);
break;
case JANET_TARRAY_TYPE_S64:
array->as.s64[i] = janet_unwrap_s64(value);
break;
#endif
DEFINE_VIEW_ABSTRACT_TYPE(float32),
DEFINE_VIEW_ABSTRACT_TYPE(float64)
case JANET_TARRAY_TYPE_F32:
array->as.f32[i] = (float) janet_unwrap_number(value);
break;
case JANET_TARRAY_TYPE_F64:
array->as.f64[i] = janet_unwrap_number(value);
break;
default:
janet_panicf("cannot set typed array of type %s",
ta_type_names[array->type]);
break;
}
}
static const JanetAbstractType ta_view_type = {
"ta/view",
NULL,
ta_mark,
ta_getter,
ta_setter,
ta_view_marshal,
ta_view_unmarshal
};
#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]);
}
#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));
JanetTArrayBuffer *buf = 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);
#ifdef JANET_BIGINT
CASE_TYPE_INITIALIZE(uint64);
CASE_TYPE_INITIALIZE(int64);
#endif
CASE_TYPE_INITIALIZE(float32);
CASE_TYPE_INITIALIZE(float64);
default :
janet_panic("bad typed array type");
JanetTArrayView *janet_tarray_view(
JanetTArrayType type,
size_t size,
size_t stride,
size_t offset,
JanetTArrayBuffer *buffer) {
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
if (NULL == buffer) {
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buffer, buf_size);
}
if (buffer->size < buf_size) {
janet_panicf("bad buffer size, %i bytes allocated < %i required",
buffer->size,
buf_size);
}
view->buffer = buffer;
view->stride = stride;
view->size = size;
view->as.u8 = buffer->data + offset;
view->type = 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);
return 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);
}
size_t janet_tarray_type_size(JanetTArrayType type) {
return (type < TA_COUNT_TYPES) ? ta_type_sizes[type] : 0;
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &ta_view_type);
}
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 {
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
if (view->type != type) {
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;
n, ta_type_names[type], argv[n]);
}
return view;
}
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
@ -416,23 +344,35 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
if (argc > 3)
offset = janet_getsize(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];
if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
buffer = view->buffer;
} else {
buffer = (JanetTArrayBuffer *)janet_getabstract(argv, 4, &ta_buffer_type);
buffer = p;
}
}
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
return janet_wrap_abstract(view);
}
static JanetTArrayView *ta_is_view(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
return (JanetTArrayView *)abst;
}
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]);
JanetTArrayView *view;
if ((view = ta_is_view(argv[0]))) {
return janet_wrap_abstract(view->buffer);
}
size_t size = janet_getsize(argv, 0);
@ -442,8 +382,8 @@ static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
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]);
JanetTArrayView *view;
if ((view = ta_is_view(argv[0]))) {
return janet_wrap_number((double) view->size);
}
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
@ -452,10 +392,11 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
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]);
JanetTArrayView *view;
if ((view = ta_is_view(argv[0]))) {
JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
JanetKV *props = janet_struct_begin(6);
ptrdiff_t boffset = (uint8_t *)(view->data) - view->buffer->data;
ptrdiff_t boffset = view->as.u8 - view->buffer->data;
janet_struct_put(props, janet_ckeywordv("size"),
janet_wrap_number((double) view->size));
janet_struct_put(props, janet_ckeywordv("byte-offset"),
@ -482,8 +423,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
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]));
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetRange range;
int32_t length = (int32_t)src->size;
if (argc == 1) {
@ -501,7 +441,7 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
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->data[i - range.start] = ta_getter(src, janet_wrap_number(i));
}
}
array->count = range.end - range.start;
@ -510,17 +450,17 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
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);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(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);
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
size_t pos_dst = (dst->as.u8 - 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)) {
@ -537,17 +477,17 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
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);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(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);
size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
size_t pos_dst = (dst->as.u8 - 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) &&
@ -615,7 +555,5 @@ static const JanetReg ta_cfuns[] = {
void janet_lib_typed_array(JanetTable *env) {
janet_core_cfuns(env, NULL, ta_cfuns);
janet_register_abstract_type(&ta_buffer_type);
for (int i = 0; i < TA_COUNT_TYPES; i++) {
janet_register_abstract_type(ta_array_types + i);
}
janet_register_abstract_type(&ta_view_type);
}

4
src/core/util.h
View File

@ -92,8 +92,8 @@ void janet_lib_peg(JanetTable *env);
#ifdef JANET_TYPED_ARRAY
void janet_lib_typed_array(JanetTable *env);
#endif
#ifdef JANET_BIGINT
void janet_lib_bigint(JanetTable *env);
#ifdef JANET_INT_TYPES
void janet_lib_inttypes(JanetTable *env);
#endif

83
src/include/janet.h
View File

@ -133,12 +133,11 @@ extern "C" {
#define JANET_TYPED_ARRAY
#endif
/* Enable or disable the bigint module */
#ifndef JANET_NO_BIGINT
#define JANET_BIGINT
/* Enable or disable large int types (for now 64 bit, maybe 128 / 256 bit integer types) */
#ifndef JANET_NO_INT_TYPES
#define JANET_INT_TYPES
#endif
/* How to export symbols */
#ifndef JANET_API
#ifdef JANET_WINDOWS
@ -1032,6 +1031,8 @@ JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourc
/* Number scanning */
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
/* Debugging */
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
@ -1269,17 +1270,19 @@ JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
/* Marshal API */
#define janet_marshal_size(ctx, x) janet_marshal_int64((ctx), (int64_t) (x))
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_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, size_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_size(JanetMarshalContext *ctx, size_t *i);
JANET_API void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b);
#define janet_unmarshal_size(ctx) ((size_t) janet_unmarshal_int64((ctx)))
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
@ -1287,19 +1290,16 @@ 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,
#ifdef JANET_BIGINT
JANET_TARRAY_TYPE_uint64,
JANET_TARRAY_TYPE_int64,
#endif
JANET_TARRAY_TYPE_float32,
JANET_TARRAY_TYPE_float64,
JANET_TARRAY_TYPE_any,
JANET_TARRAY_TYPE_U8,
JANET_TARRAY_TYPE_S8,
JANET_TARRAY_TYPE_U16,
JANET_TARRAY_TYPE_S16,
JANET_TARRAY_TYPE_U32,
JANET_TARRAY_TYPE_S32,
JANET_TARRAY_TYPE_U64,
JANET_TARRAY_TYPE_S64,
JANET_TARRAY_TYPE_F32,
JANET_TARRAY_TYPE_F64
} JanetTArrayType;
typedef struct {
@ -1309,8 +1309,20 @@ typedef struct {
} JanetTArrayBuffer;
typedef struct {
union {
void *pointer;
uint8_t *u8;
int8_t *s8;
uint16_t *u16;
int16_t *s16;
uint32_t *u32;
int32_t *s32;
uint64_t *u64;
int64_t *s64;
float *f32;
double *f64;
} as;
JanetTArrayBuffer *buffer;
void *data; /* pointer inside buffer->data */
size_t size;
size_t stride;
JanetTArrayType type;
@ -1319,31 +1331,30 @@ typedef struct {
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 size_t 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);
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
#endif
#ifdef JANET_BIGINT
#ifdef JANET_INT_TYPES
typedef enum {
JANET_BIGINT_TYPE_none,
JANET_BIGINT_TYPE_int64,
JANET_BIGINT_TYPE_uint64,
} JanetBigintType;
JANET_INT_NONE,
JANET_INT_S64,
JANET_INT_U64
} JanetIntType;
JANET_API JanetBigintType janet_is_bigint(Janet x);
JANET_API Janet janet_bigint_int64(int64_t x);
JANET_API Janet janet_bigint_uint64(uint64_t x);
JANET_API int64_t janet_checkbigint_int64(Janet x);
JANET_API uint64_t janet_checkbigint_uint64(Janet x);
JANET_API JanetIntType janet_is_int(Janet x);
JANET_API Janet janet_wrap_s64(int64_t x);
JANET_API Janet janet_wrap_u64(uint64_t x);
JANET_API int64_t janet_unwrap_s64(Janet x);
JANET_API uint64_t janet_unwrap_u64(Janet x);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#endif
/***** END SECTION MAIN *****/
#ifdef __cplusplus

6
test/suite6.janet
View File

@ -23,8 +23,8 @@
# some tests for bigint
(def i64 bigint/int64)
(def u64 bigint/uint64)
(def i64 int/s64)
(def u64 int/u64)
(assert-no-error
"create some uint64 bigints"
@ -67,7 +67,7 @@
(assert-error
"trap INT64_MIN / -1"
(:/ (bigint/int64 "-0x8000_0000_0000_0000") -1))
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
# in place operators
(assert (let [a (u64 1e10)] (:+! a 1000000 "1000000" "0xffff") (:== a 10002065535)) "in place operators")

1
tools/amalg.janet
View File

@ -36,6 +36,7 @@
"src/core/fiber.c"
"src/core/gc.c"
"src/core/io.c"
"src/core/inttypes.c"
"src/core/marsh.c"
"src/core/math.c"
"src/core/os.c"