lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Get rid of the float_t and double_t nonsense 

Necessitates a big refactoring of the magic macros that make the types.
This commit is contained in:
Lassi Kortela 2019-10-14 02:27:33 +03:00
parent 29fada554c
commit a174bba817
3 changed files with 69 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
c/cvalues.h
View File

@ -245,31 +245,42 @@ void cv_pin(struct cvalue *cv)
autorelease(cv); autorelease(cv);
} }
#define num_init(ctype, cnvt, tag) \ #define NUM_INIT_SUFFIX(ctype, cnvt, tag, suffix) \
static int cvalue_##ctype##_init(struct fltype *type, value_t arg, \ static int cvalue_##ctype##_init(struct fltype *type, value_t arg, \
void *dest) \ void *dest) \
{ \ { \
ctype##_t n = 0; \ ctype##suffix n = 0; \
(void)type; \ (void)type; \
if (isfixnum(arg)) { \ if (isfixnum(arg)) { \
n = numval(arg); \ n = numval(arg); \
} else if (iscprim(arg)) { \ } else if (iscprim(arg)) { \
struct cprim *cp = (struct cprim *)ptr(arg); \ struct cprim *cp = (struct cprim *)ptr(arg); \
void *p = cp_data(cp); \ void *p = cp_data(cp); \
n = (ctype##_t)conv_to_##cnvt(p, cp_numtype(cp)); \ n = (ctype##suffix)conv_to_##cnvt(p, cp_numtype(cp)); \
} else { \ } else { \
return 1; \ return 1; \
} \ } \
*((ctype##_t *)dest) = n; \ *((ctype##suffix *)dest) = n; \
return 0; \ return 0; \
} }
num_init(int8, int32, T_INT8) num_init(uint8, uint32, T_UINT8)
num_init(int16, int32, T_INT16) num_init(uint16, uint32, T_UINT16)
num_init(int32, int32, T_INT32) num_init(uint32, uint32, T_UINT32)
num_init(int64, int64, T_INT64) num_init(uint64, uint64, T_UINT64)
num_init(float, double, T_FLOAT) num_init(double, double, T_DOUBLE)
#define num_ctor_init(typenam, ctype, tag) \ #define NUM_INIT(ctype, cnvt, tag) NUM_INIT_SUFFIX(ctype, cnvt, tag, )
#define NUM_INIT_T(ctype, cnvt, tag) NUM_INIT_SUFFIX(ctype, cnvt, tag, _t)
NUM_INIT_T(int8, int32, T_INT8);
NUM_INIT_T(int16, int32, T_INT16);
NUM_INIT_T(int32, int32, T_INT32);
NUM_INIT_T(int64, int64, T_INT64);
NUM_INIT_T(uint8, uint32, T_UINT8);
NUM_INIT_T(uint16, uint32, T_UINT16);
NUM_INIT_T(uint32, uint32, T_UINT32);
NUM_INIT_T(uint64, uint64, T_UINT64);
NUM_INIT(float, double, T_FLOAT);
NUM_INIT(double, double, T_DOUBLE);
#define NUM_CTOR_INIT_SUFFIX(typenam, ctype, tag, suffix) \
value_t cvalue_##typenam(value_t *args, uint32_t nargs) \ value_t cvalue_##typenam(value_t *args, uint32_t nargs) \
{ \ { \
value_t cp; \ value_t cp; \
@ -277,35 +288,52 @@ num_init(float, double, T_FLOAT) num_init(double, double, T_DOUBLE)
PUSH(fixnum(0)); \ PUSH(fixnum(0)); \
args = &Stack[SP - 1]; \ args = &Stack[SP - 1]; \
} \ } \
cp = cprim(typenam##type, sizeof(ctype##_t)); \ cp = cprim(typenam##type, sizeof(ctype##suffix)); \
if (cvalue_##ctype##_init(typenam##type, args[0], \ if (cvalue_##ctype##_init(typenam##type, args[0], \
cp_data((struct cprim *)ptr(cp)))) \ cp_data((struct cprim *)ptr(cp)))) \
type_error(#typenam, "number", args[0]); \ type_error(#typenam, "number", args[0]); \
return cp; \ return cp; \
} }
#define num_ctor_ctor(typenam, ctype, tag) \ #define NUM_CTOR_CTOR_SUFFIX(typenam, ctype, tag, suffix) \
value_t mk_##typenam(ctype##_t n) \ value_t mk_##typenam(ctype##suffix n) \
{ \ { \
value_t cp = cprim(typenam##type, sizeof(ctype##_t)); \ value_t cp = cprim(typenam##type, sizeof(ctype##suffix)); \
*(ctype##_t *)cp_data((struct cprim *)ptr(cp)) = n; \ *(ctype##suffix *)cp_data((struct cprim *)ptr(cp)) = n; \
return cp; \ return cp; \
} }
#define num_ctor(typenam, ctype, tag) \ #define NUM_CTOR(typenam, ctype, tag) \
num_ctor_init(typenam, ctype, tag) num_ctor_ctor(typenam, ctype, tag) NUM_CTOR_INIT_SUFFIX(typenam, ctype, tag, ) \
NUM_CTOR_CTOR_SUFFIX(typenam, ctype, tag, )
#define NUM_CTOR_T(typenam, ctype, tag) \
NUM_CTOR_INIT_SUFFIX(typenam, ctype, tag, _t) \
NUM_CTOR_CTOR_SUFFIX(typenam, ctype, tag, _t)
NUM_CTOR_T(int8, int8, T_INT8);
NUM_CTOR_T(int16, int16, T_INT16);
NUM_CTOR_T(int32, int32, T_INT32);
NUM_CTOR_T(int64, int64, T_INT64);
NUM_CTOR_T(uint8, uint8, T_UINT8);
NUM_CTOR_T(uint16, uint16, T_UINT16);
NUM_CTOR_T(uint32, uint32, T_UINT32);
NUM_CTOR_T(uint64, uint64, T_UINT64);
NUM_CTOR_T(byte, uint8, T_UINT8);
NUM_CTOR_T(wchar, int32, T_INT32);
num_ctor(int8, int8, T_INT8) num_ctor(uint8, uint8, T_UINT8)
num_ctor(int16, int16, T_INT16) num_ctor(uint16, uint16, T_UINT16)
num_ctor(int32, int32, T_INT32) num_ctor(uint32, uint32, T_UINT32)
num_ctor(int64, int64, T_INT64) num_ctor(uint64, uint64, T_UINT64)
num_ctor(byte, uint8, T_UINT8) num_ctor(wchar, int32, T_INT32)
#ifdef BITS64 #ifdef BITS64
num_ctor(long, int64, T_INT64) num_ctor(ulong, uint64, T_UINT64) NUM_CTOR_T(long, int64, T_INT64);
NUM_CTOR_T(ulong, uint64, T_UINT64);
#else #else
num_ctor(long, int32, T_INT32) num_ctor(ulong, uint32, T_UINT32) NUM_CTOR_T(long, int32, T_INT32);
NUM_CTOR_T(ulong, uint32, T_UINT32);
#endif #endif
num_ctor(float, float, T_FLOAT) num_ctor(double, double, T_DOUBLE)
NUM_CTOR(float, float, T_FLOAT);
NUM_CTOR(double, double, T_DOUBLE);
value_t size_wrap(size_t sz) value_t size_wrap(size_t sz)
{ {
@ -1052,7 +1080,7 @@ static void cvalues_init(void)
setc(emptystringsym, cvalue_static_cstring("")); setc(emptystringsym, cvalue_static_cstring(""));
} }
#define RETURN_NUM_AS(var, type) return (mk_##type((type##_t)var)) #define RETURN_INT_AS(var, type) return (mk_##type((type##_t)var))
value_t return_from_uint64(uint64_t Uaccum) value_t return_from_uint64(uint64_t Uaccum)
{ {
@ -1060,13 +1088,13 @@ value_t return_from_uint64(uint64_t Uaccum)
return fixnum((fixnum_t)Uaccum); return fixnum((fixnum_t)Uaccum);
} }
if (Uaccum > (uint64_t)S64_MAX) { if (Uaccum > (uint64_t)S64_MAX) {
RETURN_NUM_AS(Uaccum, uint64); RETURN_INT_AS(Uaccum, uint64);
} else if (Uaccum > (uint64_t)UINT_MAX) { } else if (Uaccum > (uint64_t)UINT_MAX) {
RETURN_NUM_AS(Uaccum, int64); RETURN_INT_AS(Uaccum, int64);
} else if (Uaccum > (uint64_t)INT_MAX) { } else if (Uaccum > (uint64_t)INT_MAX) {
RETURN_NUM_AS(Uaccum, uint32); RETURN_INT_AS(Uaccum, uint32);
} }
RETURN_NUM_AS(Uaccum, int32); RETURN_INT_AS(Uaccum, int32);
} }
value_t return_from_int64(int64_t Saccum) value_t return_from_int64(int64_t Saccum)
@ -1075,11 +1103,11 @@ value_t return_from_int64(int64_t Saccum)
return fixnum((fixnum_t)Saccum); return fixnum((fixnum_t)Saccum);
} }
if (Saccum > (int64_t)UINT_MAX || Saccum < (int64_t)INT_MIN) { if (Saccum > (int64_t)UINT_MAX || Saccum < (int64_t)INT_MIN) {
RETURN_NUM_AS(Saccum, int64); RETURN_INT_AS(Saccum, int64);
} else if (Saccum > (int64_t)INT_MAX) { } else if (Saccum > (int64_t)INT_MAX) {
RETURN_NUM_AS(Saccum, uint32); RETURN_INT_AS(Saccum, uint32);
} }
RETURN_NUM_AS(Saccum, int32); RETURN_INT_AS(Saccum, int32);
} }
static value_t fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn) static value_t fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn)
@ -1158,9 +1186,9 @@ static value_t fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn)
if (fits_fixnum(Saccum)) { if (fits_fixnum(Saccum)) {
return fixnum((fixnum_t)Saccum); return fixnum((fixnum_t)Saccum);
} }
RETURN_NUM_AS(Saccum, int32); RETURN_INT_AS(Saccum, int32);
} }
RETURN_NUM_AS(Saccum, int64); RETURN_INT_AS(Saccum, int64);
} }
Uaccum -= negpart; Uaccum -= negpart;
} else { } else {
@ -1293,9 +1321,9 @@ static value_t fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
if (fits_fixnum(Saccum)) { if (fits_fixnum(Saccum)) {
return fixnum((fixnum_t)Saccum); return fixnum((fixnum_t)Saccum);
} }
RETURN_NUM_AS(Saccum, int32); RETURN_INT_AS(Saccum, int32);
} }
RETURN_NUM_AS(Saccum, int64); RETURN_INT_AS(Saccum, int64);
} else { } else {
Uaccum *= (uint64_t)Saccum; Uaccum *= (uint64_t)Saccum;
} }

4
c/scheme.h
View File

@ -928,8 +928,8 @@ struct fltype *get_array_type(value_t eltype);
struct fltype *define_opaque_type(value_t sym, size_t sz, struct fltype *define_opaque_type(value_t sym, size_t sz,
struct cvtable *vtab, cvinitfunc_t init); struct cvtable *vtab, cvinitfunc_t init);
value_t mk_double(double_t n); value_t mk_double(double n);
value_t mk_float(float_t n); value_t mk_float(float n);
value_t mk_uint32(uint32_t n); value_t mk_uint32(uint32_t n);
value_t mk_uint64(uint64_t n); value_t mk_uint64(uint64_t n);
value_t mk_wchar(int32_t n); value_t mk_wchar(int32_t n);

3
c/scheme_compiler_watcomc.h
View File

@ -5,9 +5,6 @@
#define __ORDER_LITTLE_ENDIAN__ 1234 #define __ORDER_LITTLE_ENDIAN__ 1234
#define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__ #define __BYTE_ORDER__ __ORDER_LITTLE_ENDIAN__
typedef float float_t;
typedef double double_t;
#pragma aux DivideByZeroError aborts; #pragma aux DivideByZeroError aborts;
extern void DivideByZeroError(void); extern void DivideByZeroError(void);