rusefi
/
bldc
mirror of https://github.com/rusefi/bldc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge commit '3c051b179a1e6dda1d3f7c1ae9b412206ab6e64f'

This commit is contained in:
Benjamin Vedder 2024-02-23 07:08:24 +01:00
parent 1e8e494c61 3c051b179a
commit 5ac558816d
30 changed files with 688 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lispBM/lispBM/doc/lbmref.md
View File

@ -61,7 +61,51 @@ apa?
kurt_russel_is_great
```
## Numbers and Numerical Types
LBM supports signed and unsigned integer types as well as float and double.
The numerical types in LBM are
1. byte - unsigned 8bit value.
2. i - signed 28bit value (56bits on 64bit platforms).
3. u - unsigned 28bit value (56bits on 64bit platforms).
4. i32 - signed 32bit value.
5. u32 - unsigned 32bit value.
6. i64 - signed 64bit value.
7. u64 - unsigned 64bit value.
8. f32 - (float) a 32bit floating point value.
9. f64 - (double) a 64bit floating point value.
The byte and the char value have identical representation and type, thus char is an unsigned 8 bit type in LBM.
An integer literal is interpreted to be of type 'i', a 28/56bit signed integer value.
A literal with decimal point is interpreted to be a type 'f32' or float value.
To specify literals of the othertype the value is to be postfixed with a qualifier string.
The qualifiers available in LBM are: 'b', 'i', 'u', 'i32', 'u32', 'i64', 'u64', 'f32' and 'f63'.
The 'i' and 'f32' qualifiers are never strictly needed but can be added if one so wishes.
So for example:
1. '1b' - Specifies a byte typed value of 1
2. '1.0f64' - Specifies a 64bit float with value 1.0.
**Note** that it is an absolute requirement to include a decimal when writing a floating point literal in LBM.
We are trying to make type conversions to not feel too unfamilar to people
who are familiar with the C programming language. On a 32bit platform
LBM numerical types are ordered according to: 'byte < i < u < i32 < u32 < i64 < u64 < float < double'.
Operations such as '(+ a b)', figures out the largest type according to the ordering above and converts the
all values to this largest type.
Example:
1. '(+ 1u 3i32)' - Promotes the 1u value type i32 and performs the addition, resulting in 4i32.
2. '(+ 1 3.14)' - Here the value 1 is of type 'i' which is smaller than 'f32', the result 4.14f32.
A potential source of confusion is that 'f32' is a larger type than 'i64' and 'u64'. this means
that if you, for example, add 1.0 to an 'i64' value you will get an 'f32' back. If you instead wanted
the float to be converted into a double before the addition, this has to be done manually.
Example:
1. '(+ (to-double 1.0) 5i64)' - Manually convert a value to double.
## Arithmetic

8
lispBM/lispBM/include/heap.h
View File

@ -346,7 +346,7 @@ lbm_uint lbm_dec_custom(lbm_value val);
* \param val Value to decode
* \return The value encoded in val casted to a char. Returns 0 if val does not encode a number.
*/
char lbm_dec_as_char(lbm_value a);
uint8_t lbm_dec_as_char(lbm_value a);
/** Decode a numerical value as if it is unsigned
*
* \param val Value to decode
@ -705,7 +705,7 @@ extern lbm_value lbm_enc_u64(uint64_t x);
*/
extern lbm_value lbm_enc_double(double x);
static inline lbm_value lbm_enc_char(char x) {
static inline lbm_value lbm_enc_char(uint8_t x) {
return ((lbm_uint)x << LBM_VAL_SHIFT) | LBM_TYPE_CHAR;
}
@ -717,8 +717,8 @@ static inline lbm_uint lbm_dec_u(lbm_value x) {
return x >> LBM_VAL_SHIFT;
}
static inline char lbm_dec_char(lbm_value x) {
return (char)(x >> LBM_VAL_SHIFT);
static inline uint8_t lbm_dec_char(lbm_value x) {
return (uint8_t)(x >> LBM_VAL_SHIFT);
}
static inline lbm_uint lbm_dec_sym(lbm_value x) {

22
lispBM/lispBM/include/lbm_defines.h
View File

@ -44,8 +44,8 @@
#define LBM_TYPE_CONS 0x10000000u
#define LBM_TYPE_CONS_CONST 0x14000000u
#define LBM_NON_CONS_POINTER_TYPE_FIRST 0x20000000u
#define LBM_TYPE_U32 0x28000000u
#define LBM_TYPE_I32 0x38000000u
#define LBM_TYPE_I32 0x28000000u
#define LBM_TYPE_U32 0x38000000u
#define LBM_TYPE_I64 0x48000000u
#define LBM_TYPE_U64 0x58000000u
#define LBM_TYPE_FLOAT 0x68000000u
@ -73,8 +73,8 @@
#define LBM_TYPE_SYMBOL 0x00000000u // 00 0 0
#define LBM_TYPE_CHAR 0x00000004u // 01 0 0
#define LBM_TYPE_BYTE 0x00000004u
#define LBM_TYPE_U 0x00000008u // 10 0 0
#define LBM_TYPE_I 0x0000000Cu // 11 0 0
#define LBM_TYPE_I 0x00000008u // 10 0 0
#define LBM_TYPE_U 0x0000000Cu // 11 0 0
#define LBM_LOW_RESERVED_BITS 0x0000000Fu // 11 1 1
#else /* 64 bit Version */
@ -97,8 +97,8 @@
#define LBM_TYPE_CONS (lbm_uint)0x1000000000000000
#define LBM_TYPE_CONS_CONST (lbm_uint)0x1400000000000000
#define LBM_NON_CONS_POINTER_TYPE_FIRST (lbm_uint)0x2000000000000000
#define LBM_TYPE_U64 (lbm_uint)0x2800000000000000
#define LBM_TYPE_I64 (lbm_uint)0x3800000000000000
#define LBM_TYPE_I64 (lbm_uint)0x2800000000000000
#define LBM_TYPE_U64 (lbm_uint)0x3800000000000000
#define LBM_TYPE_DOUBLE (lbm_uint)0x4800000000000000
#define LBM_TYPE_ARRAY (lbm_uint)0x5000000000000000
#define LBM_TYPE_CHANNEL (lbm_uint)0x7000000000000000
@ -124,13 +124,13 @@
#define LBM_TYPE_SYMBOL (lbm_uint)0x0 // 00 00 00 0 0
#define LBM_TYPE_CHAR (lbm_uint)0x4 // 00 00 01 0 0
#define LBM_TYPE_BYTE (lbm_uint)0x4
#define LBM_TYPE_U (lbm_uint)0x8 // 00 00 10 0 0
#define LBM_TYPE_I (lbm_uint)0xC // 00 00 11 0 0
#define LBM_TYPE_U32 (lbm_uint)0x14 // 00 01 01 0 0
#define LBM_TYPE_I32 (lbm_uint)0x18 // 00 01 10 0 0
#define LBM_TYPE_I32 (lbm_uint)0x8 // 00 00 10 0 0
#define LBM_TYPE_U32 (lbm_uint)0xC // 00 00 11 0 0
#define LBM_TYPE_I (lbm_uint)0x14 // 00 01 01 0 0
#define LBM_TYPE_U (lbm_uint)0x18 // 00 01 10 0 0
#define LBM_TYPE_FLOAT (lbm_uint)0x1C // 00 01 11 0 0
#define LBM_LOW_RESERVED_BITS (lbm_uint)0xFF // 11 11 11 1 1
#endif
/* ------------------------------------------------------------
Built in symbols

8
lispBM/lispBM/include/lbm_flat_value.h
View File

@ -32,8 +32,8 @@ typedef struct {
#define S_SYM_VALUE 0x2 // 1 value
#define S_SYM_STRING 0x3
#define S_BYTE_VALUE 0x4
#define S_I_VALUE 0x5
#define S_U_VALUE 0x6
#define S_I28_VALUE 0x5
#define S_U28_VALUE 0x6
#define S_I32_VALUE 0x7
#define S_U32_VALUE 0x8
#define S_FLOAT_VALUE 0x9
@ -41,6 +41,8 @@ typedef struct {
#define S_U64_VALUE 0xB
#define S_DOUBLE_VALUE 0xC
#define S_LBM_ARRAY 0xD
#define S_I56_VALUE 0xE
#define S_U56_VALUE 0xF
// Maximum number of recursive calls
#define FLATTEN_VALUE_MAXIMUM_DEPTH 2000
@ -75,7 +77,7 @@ bool f_u64(lbm_flat_value_t *v, uint64_t w);
bool f_lbm_array(lbm_flat_value_t *v, uint32_t num_bytes, uint8_t *data);
lbm_value flatten_value(lbm_value v);
int flatten_value_c(lbm_flat_value_t *fv, lbm_value v);
int flatten_value_size(lbm_value v, int depth, int n_cons, int max_cons);
int flatten_value_size(lbm_value v, int depth);
void lbm_set_max_flatten_depth(int depth);
/** Unflatten a flat value stored in an lbm_memory array onto the heap

2
lispBM/lispBM/repl/Makefile
View File

@ -27,7 +27,7 @@ all64: CCFLAGS += -DLBM64
all64: repl
install: repl
install: all
mkdir -p ~/.local/bin
cp repl ~/.local/bin/lbm

4
lispBM/lispBM/repl/repl.c
View File

@ -119,7 +119,7 @@ void done_callback(eval_context_t *ctx) {
// TODO: report failure in some way.
if (res_output_file && store_result_cid == ctx->id) {
store_result_cid = -1;
int32_t fv_size = flatten_value_size(ctx->r, 0, 0, (int)lbm_heap_size());
int32_t fv_size = flatten_value_size(ctx->r, 0);
if (fv_size > 0) {
lbm_flat_value_t fv;
fv.buf = malloc((uint32_t)fv_size);
@ -654,7 +654,7 @@ void shutdown_procedure(void) {
lbm_value val_field = lbm_cdr(lbm_car(curr));
char *name = (char*)lbm_get_name_by_symbol(lbm_dec_sym(name_field));
if (!name) goto shutdown_procedure_1;
int32_t fv_size = flatten_value_size(val_field, 0, 0, (int)lbm_heap_size());
int32_t fv_size = flatten_value_size(val_field, 0);
if (fv_size > 0) {
lbm_flat_value_t fv;
fv.buf = malloc((uint32_t)fv_size);

4
lispBM/lispBM/src/eval_cps.c
View File

@ -3580,7 +3580,7 @@ static void cont_read_next_token(eval_context_t *ctx) {
lbm_channel_drop(chan, (unsigned int)n);
switch(int_result.type) {
case TOKTYPEBYTE:
res = lbm_enc_char((char)(int_result.negative ? -int_result.value : int_result.value));
res = lbm_enc_char((uint8_t)(int_result.negative ? -int_result.value : int_result.value));
break;
case TOKTYPEI:
res = lbm_enc_i((lbm_int)(int_result.negative ? -int_result.value : int_result.value));
@ -3675,7 +3675,7 @@ static void cont_read_next_token(eval_context_t *ctx) {
if(n > 0) {
lbm_channel_drop(chan,(unsigned int) n);
lbm_stack_drop(&ctx->K, 2);
ctx->r = lbm_enc_char(c_val);
ctx->r = lbm_enc_char((uint8_t)c_val);
ctx->app_cont = true;
return;
}else if (n < 0) goto retry_token;

13
lispBM/lispBM/src/extensions/runtime_extensions.c
View File

@ -153,7 +153,17 @@ lbm_value ext_set_gc_stack_size(lbm_value *args, lbm_uint argn) {
}
return ENC_SYM_TERROR;
}
lbm_value ext_is_64bit(lbm_value *args, lbm_uint argn) {
(void) args;
(void) argn;
#ifndef LBM64
return ENC_SYM_NIL;
#else
return ENC_SYM_TRUE;
#endif
}
bool lbm_runtime_extensions_init(bool minimal) {
if (!minimal) {
@ -183,6 +193,7 @@ bool lbm_runtime_extensions_init(bool minimal) {
res = res && lbm_add_extension("env-get", ext_env_get);
res = res && lbm_add_extension("env-set", ext_env_set);
res = res && lbm_add_extension("set-gc-stack-size", ext_set_gc_stack_size);
res = res && lbm_add_extension("is-64bit", ext_is_64bit);
}
return res;
}

139
lispBM/lispBM/src/fundamental.c
View File

@ -27,6 +27,68 @@
#include <stdio.h>
#include <math.h>
/* Type promotion ranks
32bit LBM:
byte < i < u < i32 < u32 < i64 < u64 < float < double
64bit LBM:
byte < i32 < u32 < i < u < i64 < u64 < float < double
*/
// PROMOTE_SWAP is for commutative operations
// PROMOTE is for non-commutative operations
#ifndef LBM64
#define PROMOTE_SWAP(t, a, b) \
if (lbm_type_of_functional(a) < lbm_type_of_functional(b)) { \
lbm_value tmp = a; \
a = b; \
b = tmp; \
} \
t = lbm_type_of_functional(a);
#else
#define PROMOTE_SWAP(t, a, b) \
if (lbm_type_of_functional(b) == LBM_TYPE_FLOAT && (lbm_type_of_functional(a) < LBM_TYPE_DOUBLE)) { \
lbm_value tmp = a; \
a = b; \
b = tmp; \
} if (lbm_type_of_functional(a) == LBM_TYPE_FLOAT && (lbm_type_of_functional(b) < LBM_TYPE_DOUBLE)) { \
/* DO NOTHING */ \
} else if (lbm_type_of_functional(a) < lbm_type_of_functional(b)) { \
lbm_value tmp = a; \
a = b; \
b = tmp; \
} \
t = lbm_type_of_functional(a);
#endif
#ifndef LBM64
#define PROMOTE(t, a, b) \
if (lbm_type_of_functional(a) < lbm_type_of_functional(b)) { \
t = lbm_type_of_functional(b); \
} else { \
t = lbm_type_of_functional(a); \
}
#else
#define PROMOTE(t, a, b) \
if (lbm_type_of_functional(b) == LBM_TYPE_FLOAT) { \
if (lbm_type_of_functional(a) < LBM_TYPE_DOUBLE) { \
t = LBM_TYPE_FLOAT; \
} else { \
t = lbm_type_of_functional(a); \
} \
} else if (lbm_type_of_functional(a) < lbm_type_of_functional(b)) { \
t = lbm_type_of_functional(b); \
} else { \
t = lbm_type_of_functional(a); \
}
#endif
// TODO: Check for correctnes
#define IS_NUMBER(X) \
( (((X) & 1) && ((X) & LBM_NUMBER_MASK)) || \
@ -35,7 +97,6 @@
// (x & LBM_NUMBER_MASK)
// (x & 0xC))
// Todo: It may be possible perform some of these operations
// on encoded values followed by a "correction" of the result values
// type bits.
@ -51,17 +112,18 @@ static lbm_uint add2(lbm_uint a, lbm_uint b) {
return retval;
}
lbm_uint t = (lbm_type_of_functional(a) < lbm_type_of_functional(b)) ? lbm_type_of_functional(b) : lbm_type_of_functional(a);
lbm_type t;
PROMOTE_SWAP(t, a, b);
switch (t) {
case LBM_TYPE_BYTE: retval = lbm_enc_char(lbm_dec_as_char(a) + lbm_dec_as_char(b)); break;
case LBM_TYPE_I: retval = lbm_enc_i(lbm_dec_as_i32(a) + lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = lbm_enc_u(lbm_dec_as_u32(a) + lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(lbm_dec_as_u32(a) + lbm_dec_as_u32(b)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(lbm_dec_as_i32(a) + lbm_dec_as_i32(b)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(lbm_dec_as_float(a) + lbm_dec_as_float(b)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(lbm_dec_as_u64(a) + lbm_dec_as_u64(b)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(lbm_dec_as_i64(a) + lbm_dec_as_i64(b)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(lbm_dec_as_double(a) + lbm_dec_as_double(b)); break;
case LBM_TYPE_BYTE: retval = lbm_enc_char((uint8_t)(lbm_dec_char(a) + lbm_dec_char(b))); break;
case LBM_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) + lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) + lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(lbm_dec_u32(a) + lbm_dec_as_u32(b)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(lbm_dec_i32(a) + lbm_dec_as_i32(b)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(lbm_dec_float(a) + lbm_dec_as_float(b)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(lbm_dec_u64(a) + lbm_dec_as_u64(b)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(lbm_dec_i64(a) + lbm_dec_as_i64(b)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(lbm_dec_double(a) + lbm_dec_as_double(b)); break;
}
return retval;
}
@ -74,17 +136,19 @@ static lbm_uint mul2(lbm_uint a, lbm_uint b) {
lbm_set_error_suspect(IS_NUMBER(a) ? b : a);
return retval;
}
lbm_uint t = (lbm_type_of_functional(a) < lbm_type_of_functional(b)) ? lbm_type_of_functional(b) : lbm_type_of_functional(a);
lbm_type t;
PROMOTE_SWAP(t, a, b);
switch (t) {
case LBM_TYPE_I: retval = lbm_enc_i(lbm_dec_as_i32(a) * lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = lbm_enc_u(lbm_dec_as_u32(a) * lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(lbm_dec_as_u32(a) * lbm_dec_as_u32(b)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(lbm_dec_as_i32(a) * lbm_dec_as_i32(b)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(lbm_dec_as_float(a) * lbm_dec_as_float(b)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(lbm_dec_as_u64(a) * lbm_dec_as_u64(b)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(lbm_dec_as_i64(a) * lbm_dec_as_i64(b)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(lbm_dec_as_double(a) * lbm_dec_as_double(b)); break;
case LBM_TYPE_CHAR: retval = lbm_enc_char((uint8_t)(lbm_dec_char(a) * lbm_dec_char(b))); break;
case LBM_TYPE_I: retval = lbm_enc_i(lbm_dec_i(a) * lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = lbm_enc_u(lbm_dec_u(a) * lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(lbm_dec_u32(a) * lbm_dec_as_u32(b)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(lbm_dec_i32(a) * lbm_dec_as_i32(b)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(lbm_dec_float(a) * lbm_dec_as_float(b)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(lbm_dec_u64(a) * lbm_dec_as_u64(b)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(lbm_dec_i64(a) * lbm_dec_as_i64(b)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(lbm_dec_double(a) * lbm_dec_as_double(b)); break;
}
return retval;
}
@ -100,6 +164,7 @@ static lbm_uint div2(lbm_uint a, lbm_uint b) {
lbm_uint t = (lbm_type_of_functional(a) < lbm_type_of_functional(b)) ? lbm_type_of_functional(b) : lbm_type_of_functional(a);
switch (t) {
case LBM_TYPE_CHAR: if (lbm_dec_char(b) == 0) {return ENC_SYM_DIVZERO;} retval = lbm_enc_char((uint8_t)(lbm_dec_char(a) * lbm_dec_char(b))); break;
case LBM_TYPE_I: if (lbm_dec_i(b) == 0) {return ENC_SYM_DIVZERO;} retval = lbm_enc_i(lbm_dec_as_i32(a) / lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: if (lbm_dec_as_u32(b) == 0) {return ENC_SYM_DIVZERO;} retval = lbm_enc_u(lbm_dec_as_u32(a) / lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: if (lbm_dec_as_u32(b) == 0) {return ENC_SYM_DIVZERO;} retval = lbm_enc_u32(lbm_dec_as_u32(a) / lbm_dec_as_u32(b)); break;
@ -144,17 +209,16 @@ static lbm_uint negate(lbm_uint a) {
return retval;
}
if (lbm_type_of_functional(a) > LBM_TYPE_CHAR) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_I: retval = lbm_enc_i(- lbm_dec_i(a)); break;
case LBM_TYPE_U: retval = lbm_enc_u(- lbm_dec_u(a)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(- lbm_dec_u32(a)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(- lbm_dec_i32(a)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(- lbm_dec_float(a)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(- lbm_dec_u64(a)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(- lbm_dec_i64(a)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(- lbm_dec_double(a)); break;
}
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_BYTE: retval = lbm_enc_char((uint8_t)(256 - (int)(lbm_dec_char(a)))); break;
case LBM_TYPE_I: retval = lbm_enc_i(- lbm_dec_i(a)); break;
case LBM_TYPE_U: retval = lbm_enc_u(- lbm_dec_u(a)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(- lbm_dec_u32(a)); break;
case LBM_TYPE_I32: retval = lbm_enc_i32(- lbm_dec_i32(a)); break;
case LBM_TYPE_FLOAT: retval = lbm_enc_float(- lbm_dec_float(a)); break;
case LBM_TYPE_U64: retval = lbm_enc_u64(- lbm_dec_u64(a)); break;
case LBM_TYPE_I64: retval = lbm_enc_i64(- lbm_dec_i64(a)); break;
case LBM_TYPE_DOUBLE: retval = lbm_enc_double(- lbm_dec_double(a)); break;
}
return retval;
}
@ -168,8 +232,10 @@ static lbm_uint sub2(lbm_uint a, lbm_uint b) {
return retval;
}
lbm_uint t = (lbm_type_of_functional(a) < lbm_type_of_functional(b)) ? lbm_type_of_functional(b) : lbm_type_of_functional(a);
lbm_uint t;
PROMOTE(t, a, b);
switch (t) {
case LBM_TYPE_BYTE: retval = lbm_enc_char((uint8_t)(lbm_dec_char(a) - lbm_dec_char(b))); break;
case LBM_TYPE_I: retval = lbm_enc_i(lbm_dec_as_i32(a) - lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = lbm_enc_u(lbm_dec_as_u32(a) - lbm_dec_as_u32(b)); break;
case LBM_TYPE_U32: retval = lbm_enc_u32(lbm_dec_as_u32(a) - lbm_dec_as_u32(b)); break;
@ -244,7 +310,8 @@ static int compare(lbm_uint a, lbm_uint b) {
return ENC_SYM_TERROR;
}
lbm_uint t = (lbm_type_of_functional(a) < lbm_type_of_functional(b)) ? lbm_type_of_functional(b) : lbm_type_of_functional(a);
lbm_uint t;
PROMOTE(t, a, b);
switch (t) {
case LBM_TYPE_I: retval = CMP(lbm_dec_as_i32(a), lbm_dec_as_i32(b)); break;
case LBM_TYPE_U: retval = CMP(lbm_dec_as_u32(a), lbm_dec_as_u32(b)); break;
@ -343,7 +410,7 @@ static lbm_value fundamental_sub(lbm_value *args, lbm_uint nargs, eval_context_t
switch (nargs) {
case 0:
res = lbm_enc_u(0);
res = lbm_enc_char(0);
break;
case 1:
@ -369,7 +436,7 @@ static lbm_value fundamental_sub(lbm_value *args, lbm_uint nargs, eval_context_t
static lbm_value fundamental_mul(lbm_value *args, lbm_uint nargs, eval_context_t *ctx) {
(void) ctx;
lbm_uint prod = lbm_enc_u(1);
lbm_uint prod = lbm_enc_char(1);
for (lbm_uint i = 0; i < nargs; i ++) {
prod = mul2(prod, args[i]);
if (lbm_type_of(prod) == LBM_TYPE_SYMBOL) {

75
lispBM/lispBM/src/heap.c
View File

@ -264,26 +264,26 @@ lbm_uint lbm_dec_custom(lbm_value val) {
return res;
}
char lbm_dec_as_char(lbm_value a) {
uint8_t lbm_dec_as_char(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR:
return (char) lbm_dec_char(a);
return (uint8_t) lbm_dec_char(a);
case LBM_TYPE_I:
return (char) lbm_dec_i(a);
return (uint8_t) lbm_dec_i(a);
case LBM_TYPE_U:
return (char) lbm_dec_u(a);
return (uint8_t) lbm_dec_u(a);
case LBM_TYPE_I32:
return (char) lbm_dec_i32(a);
return (uint8_t) lbm_dec_i32(a);
case LBM_TYPE_U32:
return (char) lbm_dec_u32(a);
return (uint8_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT:
return (char)lbm_dec_float(a);
return (uint8_t)lbm_dec_float(a);
case LBM_TYPE_I64:
return (char) lbm_dec_i64(a);
return (uint8_t) lbm_dec_i64(a);
case LBM_TYPE_U64:
return (char) lbm_dec_u64(a);
return (uint8_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE:
return (char) lbm_dec_double(a);
return (uint8_t) lbm_dec_double(a);
}
return 0;
}
@ -311,29 +311,6 @@ uint32_t lbm_dec_as_u32(lbm_value a) {
return 0;
}
uint64_t lbm_dec_as_u64(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR:
return (uint64_t) lbm_dec_char(a);
case LBM_TYPE_I:
return (uint64_t) lbm_dec_i(a);
case LBM_TYPE_U:
return lbm_dec_u(a);
case LBM_TYPE_I32: /* fall through */
case LBM_TYPE_U32:
return (uint64_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT:
return (uint64_t)lbm_dec_float(a);
case LBM_TYPE_I64:
case LBM_TYPE_U64:
return (uint64_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE:
return (uint64_t) lbm_dec_double(a);
}
return 0;
}
int32_t lbm_dec_as_i32(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR:
@ -343,8 +320,9 @@ int32_t lbm_dec_as_i32(lbm_value a) {
case LBM_TYPE_U:
return (int32_t) lbm_dec_u(a);
case LBM_TYPE_I32:
case LBM_TYPE_U32:
return (int32_t) lbm_dec_i32(a);
case LBM_TYPE_U32:
return (int32_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT:
return (int32_t) lbm_dec_float(a);
case LBM_TYPE_I64:
@ -367,19 +345,44 @@ int64_t lbm_dec_as_i64(lbm_value a) {
case LBM_TYPE_U:
return (int64_t) lbm_dec_u(a);
case LBM_TYPE_I32:
case LBM_TYPE_U32:
return (int64_t) lbm_dec_i32(a);
case LBM_TYPE_U32:
return (int64_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT:
return (int64_t) lbm_dec_float(a);
case LBM_TYPE_I64:
case LBM_TYPE_U64:
return (int64_t) lbm_dec_i64(a);
case LBM_TYPE_U64:
return (int64_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE:
return (int64_t) lbm_dec_double(a);
}
return 0;
}
uint64_t lbm_dec_as_u64(lbm_value a) {
switch (lbm_type_of_functional(a)) {
case LBM_TYPE_CHAR:
return (uint64_t) lbm_dec_char(a);
case LBM_TYPE_I:
return (uint64_t) lbm_dec_i(a);
case LBM_TYPE_U:
return lbm_dec_u(a);
case LBM_TYPE_I32:
return (uint64_t) lbm_dec_i32(a);
case LBM_TYPE_U32:
return (uint64_t) lbm_dec_u32(a);
case LBM_TYPE_FLOAT:
return (uint64_t)lbm_dec_float(a);
case LBM_TYPE_I64:
return (uint64_t) lbm_dec_i64(a);
case LBM_TYPE_U64:
return (uint64_t) lbm_dec_u64(a);
case LBM_TYPE_DOUBLE:
return (uint64_t) lbm_dec_double(a);
}
return 0;
}
float lbm_dec_as_float(lbm_value a) {

63
lispBM/lispBM/src/lbm_flat_value.c
View File

@ -139,10 +139,11 @@ int f_sym_string_bytes(lbm_value sym) {
bool f_i(lbm_flat_value_t *v, lbm_int i) {
bool res = true;
res = res && write_byte(v,S_I_VALUE);
#ifndef LBM64
res = res && write_byte(v,S_I28_VALUE);
res = res && write_word(v,(uint32_t)i);
#else
res = res && write_byte(v,S_I56_VALUE);
res = res && write_dword(v, (uint64_t)i);
#endif
return res;
@ -150,10 +151,11 @@ bool f_i(lbm_flat_value_t *v, lbm_int i) {
bool f_u(lbm_flat_value_t *v, lbm_uint u) {
bool res = true;
res = res && write_byte(v,S_U_VALUE);
#ifndef LBM64
res = res && write_byte(v,S_U28_VALUE);
res = res && write_word(v,(uint32_t)u);
#else
res = res && write_byte(v,S_U56_VALUE);
res = res && write_dword(v,(uint64_t)u);
#endif
return res;
@ -236,21 +238,18 @@ void flatten_error(jmp_buf jb, int val) {
longjmp(jb, val);
}
int flatten_value_size_internal(jmp_buf jb, lbm_value v, int depth, int n_cons, int max_cons) {
int flatten_value_size_internal(jmp_buf jb, lbm_value v, int depth) {
if (depth > flatten_maximum_depth) {
flatten_error(jb, FLATTEN_VALUE_ERROR_MAXIMUM_DEPTH);
}
if (n_cons > max_cons) {
flatten_error(jb, FLATTEN_VALUE_ERROR_CIRCULAR);
}
switch (lbm_type_of(v)) {
case LBM_TYPE_CONS: /* fall through */
case LBM_TYPE_CONS_CONST: {
int s2 = 0;
int s1 = flatten_value_size_internal(jb,lbm_car(v), depth + 1, n_cons+1, max_cons);
int s1 = flatten_value_size_internal(jb,lbm_car(v), depth + 1);
if (s1 > 0) {
s2 = flatten_value_size_internal(jb,lbm_cdr(v), depth + 1, n_cons+1, max_cons);
s2 = flatten_value_size_internal(jb,lbm_cdr(v), depth + 1);
if (s2 > 0) {
return (1 + s1 + s2);
}
@ -290,13 +289,13 @@ int flatten_value_size_internal(jmp_buf jb, lbm_value v, int depth, int n_cons,
}
}
int flatten_value_size(lbm_value v, int depth, int n_cons, int max_cons) {
int flatten_value_size(lbm_value v, int depth) {
jmp_buf jb;
int r = setjmp(jb);
if (r != 0) {
return r;
}
return flatten_value_size_internal(jb, v, depth, n_cons, max_cons);
return flatten_value_size_internal(jb, v, depth);
}
int flatten_value_c(lbm_flat_value_t *fv, lbm_value v) {
@ -414,7 +413,7 @@ lbm_value flatten_value(lbm_value v) {
}
lbm_array_header_t *array = NULL;
int required_mem = flatten_value_size(v, 0, 0, (int)lbm_heap_size());
int required_mem = flatten_value_size(v, 0);
if (required_mem > 0) {
array = (lbm_array_header_t *)lbm_malloc(sizeof(lbm_array_header_t));
if (array == NULL) {
@ -530,39 +529,59 @@ static int lbm_unflatten_value_internal(lbm_flat_value_t *v, lbm_value *res) {
uint8_t tmp;
bool b = extract_byte(v, &tmp);
if (b) {
*res = lbm_enc_char((char)tmp);
*res = lbm_enc_char((uint8_t)tmp);
return UNFLATTEN_OK;
}
return UNFLATTEN_MALFORMED;
}
case S_I_VALUE: {
case S_I28_VALUE: {
lbm_uint tmp;
bool b;
#ifndef LBM64
b = extract_word(v, &tmp);
#else
b = extract_dword(v, &tmp);
#endif
if (b) {
*res = lbm_enc_i((int32_t)tmp);
return UNFLATTEN_OK;
}
return UNFLATTEN_MALFORMED;
}
case S_U_VALUE: {
case S_U28_VALUE: {
lbm_uint tmp;
bool b;
#ifndef LBM64
b = extract_word(v, &tmp);
#else
b = extract_dword(v, &tmp);
#endif
if (b) {
*res = lbm_enc_u((uint32_t)tmp);
return UNFLATTEN_OK;
}
return UNFLATTEN_MALFORMED;
}
case S_I56_VALUE: {
uint64_t tmp;
bool b;
b = extract_dword(v, &tmp);
if (b) {
#ifndef LBM64
*res = lbm_enc_i64((int64_t)tmp);
#else
*res = lbm_enc_i(tmp);
#endif
return UNFLATTEN_OK;
}
return UNFLATTEN_MALFORMED;
}
case S_U56_VALUE: {
uint64_t tmp;
bool b;
b = extract_dword(v, &tmp);
if (b) {
#ifndef LBM64
*res = lbm_enc_u64(tmp);
#else
*res = lbm_enc_u(tmp);
#endif
return UNFLATTEN_OK;
}
return UNFLATTEN_MALFORMED;
}
case S_FLOAT_VALUE: {
lbm_uint tmp;
bool b;

4
lispBM/lispBM/tests/test_enc_dec.c
View File

@ -31,13 +31,13 @@ int main(int argc, char **argv) {
res &= (lbm_dec_char(lbm_enc_char(0)) == 0);
printf("DEC/ENC %d: %s \n", n++, res ? "ok" : "NOK!");
res &= (lbm_dec_char(lbm_enc_char(-1)) == -1);
res &= (lbm_dec_char(lbm_enc_char(-1)) == 255);
printf("DEC/ENC %d: %s \n", n++, res ? "ok" : "NOK!");
res &= (lbm_dec_char(lbm_enc_char(1)) == 1);
printf("DEC/ENC %d: %s \n", n++, res ? "ok" : "NOK!");
res &= (lbm_dec_char(lbm_enc_char(127)) == 127);
printf("DEC/ENC %d: %s \n", n++, res ? "ok" : "NOK!");
res &= (lbm_dec_char(lbm_enc_char(-128)) == -128);
res &= (lbm_dec_char(lbm_enc_char(255)) == 255);
printf("DEC/ENC %d: %s \n", n++, res ? "ok" : "NOK!");
res &= (lbm_dec_sym(lbm_enc_sym(0)) == 0);

16
lispBM/lispBM/tests/test_type_promote_add_1.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of byte type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (+ 1b 1b)) type-char))
(define a2 (eq (type-of (+ 1b 1)) type-i))
(define a3 (eq (type-of (+ 1b 1u)) type-u))
(define a4 (eq (type-of (+ 1b 1i32)) type-i32))
(define a5 (eq (type-of (+ 1b 1u32)) type-u32))
(define a6 (eq (type-of (+ 1b 1i64)) type-i64))
(define a7 (eq (type-of (+ 1b 1u64)) type-u64))
(define a8 (eq (type-of (+ 1b 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1b 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_add_2.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of i type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (+ 1 1b)) type-i))
(define a2 (eq (type-of (+ 1 1)) type-i))
(define a3 (eq (type-of (+ 1 1u)) type-u))
(define a4 (eq (type-of (+ 1 1i32)) type-i))
(define a5 (eq (type-of (+ 1 1u32)) type-i))
(define a6 (eq (type-of (+ 1 1i64)) type-i64))
(define a7 (eq (type-of (+ 1 1u64)) type-u64))
(define a8 (eq (type-of (+ 1 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (+ 1 1b)) type-i))
(define a2 (eq (type-of (+ 1 1)) type-i))
(define a3 (eq (type-of (+ 1 1u)) type-u))
(define a4 (eq (type-of (+ 1 1i32)) type-i32))
(define a5 (eq (type-of (+ 1 1u32)) type-u32))
(define a6 (eq (type-of (+ 1 1i64)) type-i64))
(define a7 (eq (type-of (+ 1 1u64)) type-u64))
(define a8 (eq (type-of (+ 1 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

30
lispBM/lispBM/tests/test_type_promote_add_3.lisp Normal file
View File

@ -0,0 +1,30 @@
;; Promotion of u type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (+ 1u 1b)) type-u))
(define a2 (eq (type-of (+ 1u 1)) type-u))
(define a3 (eq (type-of (+ 1u 1u)) type-u))
(define a4 (eq (type-of (+ 1u 1i32)) type-u))
(define a5 (eq (type-of (+ 1u 1u32)) type-u))
(define a6 (eq (type-of (+ 1u 1i64)) type-i64))
(define a7 (eq (type-of (+ 1u 1u64)) type-u64))
(define a8 (eq (type-of (+ 1u 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1u 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (+ 1u 1b)) type-u))
(define a2 (eq (type-of (+ 1u 1)) type-u))
(define a3 (eq (type-of (+ 1u 1u)) type-u))
(define a4 (eq (type-of (+ 1u 1i32)) type-i32))
(define a5 (eq (type-of (+ 1u 1u32)) type-u32))
(define a6 (eq (type-of (+ 1u 1i64)) type-i64))
(define a7 (eq (type-of (+ 1u 1u64)) type-u64))
(define a8 (eq (type-of (+ 1u 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1u 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_add_4.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of i32 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (+ 1i32 1b)) type-i32))
(define a2 (eq (type-of (+ 1i32 1)) type-i))
(define a3 (eq (type-of (+ 1i32 1u)) type-u))
(define a4 (eq (type-of (+ 1i32 1i32)) type-i32))
(define a5 (eq (type-of (+ 1i32 1u32)) type-u32))
(define a6 (eq (type-of (+ 1i32 1i64)) type-i64))
(define a7 (eq (type-of (+ 1i32 1u64)) type-u64))
(define a8 (eq (type-of (+ 1i32 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1i32 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (+ 1i32 1b)) type-i32))
(define a2 (eq (type-of (+ 1i32 1)) type-i32))
(define a3 (eq (type-of (+ 1i32 1u)) type-i32))
(define a4 (eq (type-of (+ 1i32 1i32)) type-i32))
(define a5 (eq (type-of (+ 1i32 1u32)) type-u32))
(define a6 (eq (type-of (+ 1i32 1i64)) type-i64))
(define a7 (eq (type-of (+ 1i32 1u64)) type-u64))
(define a8 (eq (type-of (+ 1i32 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1i32 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_add_5.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of u32 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (+ 1u32 1b)) type-u32))
(define a2 (eq (type-of (+ 1u32 1)) type-i))
(define a3 (eq (type-of (+ 1u32 1u)) type-u))
(define a4 (eq (type-of (+ 1u32 1i32)) type-u32))
(define a5 (eq (type-of (+ 1u32 1u32)) type-u32))
(define a6 (eq (type-of (+ 1u32 1i64)) type-i64))
(define a7 (eq (type-of (+ 1u32 1u64)) type-u64))
(define a8 (eq (type-of (+ 1u32 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1u32 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (+ 1u32 1b)) type-u32))
(define a2 (eq (type-of (+ 1u32 1)) type-u32))
(define a3 (eq (type-of (+ 1u32 1u)) type-u32))
(define a4 (eq (type-of (+ 1u32 1i32)) type-u32))
(define a5 (eq (type-of (+ 1u32 1u32)) type-u32))
(define a6 (eq (type-of (+ 1u32 1i64)) type-i64))
(define a7 (eq (type-of (+ 1u32 1u64)) type-u64))
(define a8 (eq (type-of (+ 1u32 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1u32 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

30
lispBM/lispBM/tests/test_type_promote_add_6.lisp Normal file
View File

@ -0,0 +1,30 @@
;; Promotion of i64 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (+ 1i64 1b)) type-i64))
(define a2 (eq (type-of (+ 1i64 1)) type-i64))
(define a3 (eq (type-of (+ 1i64 1u)) type-i64))
(define a4 (eq (type-of (+ 1i64 1i32)) type-i64))
(define a5 (eq (type-of (+ 1i64 1u32)) type-i64))
(define a6 (eq (type-of (+ 1i64 1i64)) type-i64))
(define a7 (eq (type-of (+ 1i64 1u64)) type-u64))
(define a8 (eq (type-of (+ 1i64 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1i64 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (+ 1i64 1b)) type-i64))
(define a2 (eq (type-of (+ 1i64 1)) type-i64))
(define a3 (eq (type-of (+ 1i64 1u)) type-i64))
(define a4 (eq (type-of (+ 1i64 1i32)) type-i64))
(define a5 (eq (type-of (+ 1i64 1u32)) type-i64))
(define a6 (eq (type-of (+ 1i64 1i64)) type-i64))
(define a7 (eq (type-of (+ 1i64 1u64)) type-u64))
(define a8 (eq (type-of (+ 1i64 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1i64 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_add_7.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of u64 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (+ 1u64 1b)) type-u64))
(define a2 (eq (type-of (+ 1u64 1)) type-u64))
(define a3 (eq (type-of (+ 1u64 1u)) type-u64))
(define a4 (eq (type-of (+ 1u64 1i32)) type-u64))
(define a5 (eq (type-of (+ 1u64 1u32)) type-u64))
(define a6 (eq (type-of (+ 1u64 1i64)) type-u64))
(define a7 (eq (type-of (+ 1u64 1u64)) type-u64))
(define a8 (eq (type-of (+ 1u64 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1u64 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_add_8.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of f32 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (+ 1.0f32 1b)) type-float))
(define a2 (eq (type-of (+ 1.0f32 1)) type-float))
(define a3 (eq (type-of (+ 1.0f32 1u)) type-float))
(define a4 (eq (type-of (+ 1.0f32 1i32)) type-float))
(define a5 (eq (type-of (+ 1.0f32 1u32)) type-float))
(define a6 (eq (type-of (+ 1.0f32 1i64)) type-float))
(define a7 (eq (type-of (+ 1.0f32 1u64)) type-float))
(define a8 (eq (type-of (+ 1.0f32 1.0f32)) type-float))
(define a9 (eq (type-of (+ 1.0f32 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_add_9.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of f64 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (+ 1.0f64 1b)) type-double))
(define a2 (eq (type-of (+ 1.0f64 1)) type-double))
(define a3 (eq (type-of (+ 1.0f64 1u)) type-double))
(define a4 (eq (type-of (+ 1.0f64 1i32)) type-double))
(define a5 (eq (type-of (+ 1.0f64 1u32)) type-double))
(define a6 (eq (type-of (+ 1.0f64 1i64)) type-double))
(define a7 (eq (type-of (+ 1.0f64 1u64)) type-double))
(define a8 (eq (type-of (+ 1.0f64 1.0f32)) type-double))
(define a9 (eq (type-of (+ 1.0f64 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_mul_1.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of byte type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (* 1b 1b)) type-char))
(define a2 (eq (type-of (* 1b 1)) type-i))
(define a3 (eq (type-of (* 1b 1u)) type-u))
(define a4 (eq (type-of (* 1b 1i32)) type-i32))
(define a5 (eq (type-of (* 1b 1u32)) type-u32))
(define a6 (eq (type-of (* 1b 1i64)) type-i64))
(define a7 (eq (type-of (* 1b 1u64)) type-u64))
(define a8 (eq (type-of (* 1b 1.0f32)) type-float))
(define a9 (eq (type-of (* 1b 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_mul_2.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of i type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (* 1 1b)) type-i))
(define a2 (eq (type-of (* 1 1)) type-i))
(define a3 (eq (type-of (* 1 1u)) type-u))
(define a4 (eq (type-of (* 1 1i32)) type-i))
(define a5 (eq (type-of (* 1 1u32)) type-i))
(define a6 (eq (type-of (* 1 1i64)) type-i64))
(define a7 (eq (type-of (* 1 1u64)) type-u64))
(define a8 (eq (type-of (* 1 1.0f32)) type-float))
(define a9 (eq (type-of (* 1 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (* 1 1b)) type-i))
(define a2 (eq (type-of (* 1 1)) type-i))
(define a3 (eq (type-of (* 1 1u)) type-u))
(define a4 (eq (type-of (* 1 1i32)) type-i32))
(define a5 (eq (type-of (* 1 1u32)) type-u32))
(define a6 (eq (type-of (* 1 1i64)) type-i64))
(define a7 (eq (type-of (* 1 1u64)) type-u64))
(define a8 (eq (type-of (* 1 1.0f32)) type-float))
(define a9 (eq (type-of (* 1 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

30
lispBM/lispBM/tests/test_type_promote_mul_3.lisp Normal file
View File

@ -0,0 +1,30 @@
;; Promotion of u type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (* 1u 1b)) type-u))
(define a2 (eq (type-of (* 1u 1)) type-u))
(define a3 (eq (type-of (* 1u 1u)) type-u))
(define a4 (eq (type-of (* 1u 1i32)) type-u))
(define a5 (eq (type-of (* 1u 1u32)) type-u))
(define a6 (eq (type-of (* 1u 1i64)) type-i64))
(define a7 (eq (type-of (* 1u 1u64)) type-u64))
(define a8 (eq (type-of (* 1u 1.0f32)) type-float))
(define a9 (eq (type-of (* 1u 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (* 1u 1b)) type-u))
(define a2 (eq (type-of (* 1u 1)) type-u))
(define a3 (eq (type-of (* 1u 1u)) type-u))
(define a4 (eq (type-of (* 1u 1i32)) type-i32))
(define a5 (eq (type-of (* 1u 1u32)) type-u32))
(define a6 (eq (type-of (* 1u 1i64)) type-i64))
(define a7 (eq (type-of (* 1u 1u64)) type-u64))
(define a8 (eq (type-of (* 1u 1.0f32)) type-float))
(define a9 (eq (type-of (* 1u 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_mul_4.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of i32 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (* 1i32 1b)) type-i32))
(define a2 (eq (type-of (* 1i32 1)) type-i))
(define a3 (eq (type-of (* 1i32 1u)) type-u))
(define a4 (eq (type-of (* 1i32 1i32)) type-i32))
(define a5 (eq (type-of (* 1i32 1u32)) type-u32))
(define a6 (eq (type-of (* 1i32 1i64)) type-i64))
(define a7 (eq (type-of (* 1i32 1u64)) type-u64))
(define a8 (eq (type-of (* 1i32 1.0f32)) type-float))
(define a9 (eq (type-of (* 1i32 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (* 1i32 1b)) type-i32))
(define a2 (eq (type-of (* 1i32 1)) type-i32))
(define a3 (eq (type-of (* 1i32 1u)) type-i32))
(define a4 (eq (type-of (* 1i32 1i32)) type-i32))
(define a5 (eq (type-of (* 1i32 1u32)) type-u32))
(define a6 (eq (type-of (* 1i32 1i64)) type-i64))
(define a7 (eq (type-of (* 1i32 1u64)) type-u64))
(define a8 (eq (type-of (* 1i32 1.0f32)) type-float))
(define a9 (eq (type-of (* 1i32 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

29
lispBM/lispBM/tests/test_type_promote_mul_5.lisp Normal file
View File

@ -0,0 +1,29 @@
;; Promotion of u32 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (* 1u32 1b)) type-u32))
(define a2 (eq (type-of (* 1u32 1)) type-i))
(define a3 (eq (type-of (* 1u32 1u)) type-u))
(define a4 (eq (type-of (* 1u32 1i32)) type-u32))
(define a5 (eq (type-of (* 1u32 1u32)) type-u32))
(define a6 (eq (type-of (* 1u32 1i64)) type-i64))
(define a7 (eq (type-of (* 1u32 1u64)) type-u64))
(define a8 (eq (type-of (* 1u32 1.0f32)) type-float))
(define a9 (eq (type-of (* 1u32 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (* 1u32 1b)) type-u32))
(define a2 (eq (type-of (* 1u32 1)) type-u32))
(define a3 (eq (type-of (* 1u32 1u)) type-u32))
(define a4 (eq (type-of (* 1u32 1i32)) type-u32))
(define a5 (eq (type-of (* 1u32 1u32)) type-u32))
(define a6 (eq (type-of (* 1u32 1i64)) type-i64))
(define a7 (eq (type-of (* 1u32 1u64)) type-u64))
(define a8 (eq (type-of (* 1u32 1.0f32)) type-float))
(define a9 (eq (type-of (* 1u32 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

30
lispBM/lispBM/tests/test_type_promote_mul_6.lisp Normal file
View File

@ -0,0 +1,30 @@
;; Promotion of i64 type
(defun apply (f x) (eval (cons f x)))
(if (is-64bit) {
(define a1 (eq (type-of (* 1i64 1b)) type-i64))
(define a2 (eq (type-of (* 1i64 1)) type-i64))
(define a3 (eq (type-of (* 1i64 1u)) type-i64))
(define a4 (eq (type-of (* 1i64 1i32)) type-i64))
(define a5 (eq (type-of (* 1i64 1u32)) type-i64))
(define a6 (eq (type-of (* 1i64 1i64)) type-i64))
(define a7 (eq (type-of (* 1i64 1u64)) type-u64))
(define a8 (eq (type-of (* 1i64 1.0f32)) type-float))
(define a9 (eq (type-of (* 1i64 1.0f64)) type-Double))
}
{
(define a1 (eq (type-of (* 1i64 1b)) type-i64))
(define a2 (eq (type-of (* 1i64 1)) type-i64))
(define a3 (eq (type-of (* 1i64 1u)) type-i64))
(define a4 (eq (type-of (* 1i64 1i32)) type-i64))
(define a5 (eq (type-of (* 1i64 1u32)) type-i64))
(define a6 (eq (type-of (* 1i64 1i64)) type-i64))
(define a7 (eq (type-of (* 1i64 1u64)) type-u64))
(define a8 (eq (type-of (* 1i64 1.0f32)) type-float))
(define a9 (eq (type-of (* 1i64 1.0f64)) type-Double))
})
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_mul_7.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of u64 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (* 1u64 1b)) type-u64))
(define a2 (eq (type-of (* 1u64 1)) type-u64))
(define a3 (eq (type-of (* 1u64 1u)) type-u64))
(define a4 (eq (type-of (* 1u64 1i32)) type-u64))
(define a5 (eq (type-of (* 1u64 1u32)) type-u64))
(define a6 (eq (type-of (* 1u64 1i64)) type-u64))
(define a7 (eq (type-of (* 1u64 1u64)) type-u64))
(define a8 (eq (type-of (* 1u64 1.0f32)) type-float))
(define a9 (eq (type-of (* 1u64 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_mul_8.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of f32 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (* 1.0f32 1b)) type-float))
(define a2 (eq (type-of (* 1.0f32 1)) type-float))
(define a3 (eq (type-of (* 1.0f32 1u)) type-float))
(define a4 (eq (type-of (* 1.0f32 1i32)) type-float))
(define a5 (eq (type-of (* 1.0f32 1u32)) type-float))
(define a6 (eq (type-of (* 1.0f32 1i64)) type-float))
(define a7 (eq (type-of (* 1.0f32 1u64)) type-float))
(define a8 (eq (type-of (* 1.0f32 1.0f32)) type-float))
(define a9 (eq (type-of (* 1.0f32 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))

16
lispBM/lispBM/tests/test_type_promote_mul_9.lisp Normal file
View File

@ -0,0 +1,16 @@
;; Promotion of f64 type
(defun apply (f x) (eval (cons f x)))
(define a1 (eq (type-of (* 1.0f64 1b)) type-double))
(define a2 (eq (type-of (* 1.0f64 1)) type-double))
(define a3 (eq (type-of (* 1.0f64 1u)) type-double))
(define a4 (eq (type-of (* 1.0f64 1i32)) type-double))
(define a5 (eq (type-of (* 1.0f64 1u32)) type-double))
(define a6 (eq (type-of (* 1.0f64 1i64)) type-double))
(define a7 (eq (type-of (* 1.0f64 1u64)) type-double))
(define a8 (eq (type-of (* 1.0f64 1.0f32)) type-double))
(define a9 (eq (type-of (* 1.0f64 1.0f64)) type-Double))
(check (apply and (list a1 a2 a3 a4 a5 a6 a7 a8 a9)))