ref: c1ac6d795a28cd62ce5acf8fa75f2c381e59ef06
parent: 409a8dab1d8ef6cbd70b7c6b80c0ab8b7e9d2826
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Apr 10 17:36:19 EDT 2025
ptr → p32, p64; make ptr an alias to host's pointer This allows (de)serializing pointers between different CPUs. LSD requires this.
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -359,7 +359,7 @@
make-system-image #fn("n120021222354247576Dw54Dw64278788>2288685>22989>1{89504:" #(#fn(file):write :create :truncate (*linefeed* *directory-separator* *argv* that *exit-hooks*
*print-pretty* *print-width* *print-readably* *print-level*
- *print-length* *os-name* *interactive* *prompt* *os-version*)
+ *print-length* *os-name* *interactive* *prompt* *os-version* ptr)
*print-pretty* *print-readably* #fn("n0Aw04Fw1:" #(*print-pretty* *print-readably*)) #fn("n07021A>1722350245252752677842678845253f22985F5242:F7;52^1^142<F61:" #(filter #fn("n10Z;3u0420051S;3j0421051[S;JC0422051222105151dS;3I04230A52S;3=04242105151S:" #(#fn(const?)#fn(top-level-value) #fn(str) #fn(memq) #fn(io?))) sort #fn(environment) #.< nconc #fn(map) list
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -224,10 +224,10 @@
return sl_t;
if(iscvalue(v)){sl_numtype nt = cv_numtype(ptr(v));
- if(nt < T_FLOAT)
+ if(nt < T_FLT)
return sl_t;
void *data = cv_data(ptr(v));
- if(nt == T_FLOAT){+ if(nt == T_FLT){float f = *(float*)data;
if(f < 0)
f = -f;
@@ -234,7 +234,7 @@
if(f <= FLT_MAXINT && (float)(s32int)f == f)
return sl_t;
}else{- assert(nt == T_DOUBLE);
+ assert(nt == T_DBL);
double d = *(double*)data;
if(d < 0)
d = -d;
@@ -251,7 +251,7 @@
argcount(nargs, 1);
sl_v v = args[0];
return (isfixnum(v) || isubnum(v) ||
- (iscvalue(v) && cv_numtype(ptr(v)) < T_FLOAT)) ?
+ (iscvalue(v) && cv_numtype(ptr(v)) < T_FLT)) ?
sl_t : sl_nil;
}
@@ -289,9 +289,9 @@
sl_numtype nt = cv_numtype(cv);
double d;
if(valid_numtype(nt)){- if(nt == T_FLOAT)
+ if(nt == T_FLT)
d = (double)*(float*)data;
- else if(nt == T_DOUBLE)
+ else if(nt == T_DBL)
d = *(double*)data;
else
return v;
--- a/src/cvalues.c
+++ b/src/cvalues.c
@@ -225,6 +225,9 @@
*((ctype*)dest) = n; \
}
+typedef u32int u32ptr;
+typedef u64int u64ptr;
+
num_init(s8int, s32, T_S8)
num_init(u8int, u32, T_U8)
num_init(s16int, s32, T_S16)
@@ -233,9 +236,10 @@
num_init(u32int, u32, T_U32)
num_init(s64int, s64, T_S64)
num_init(u64int, u64, T_U64)
-num_init(uintptr, ptr, T_PTR)
-num_init(float, double, T_FLOAT)
-num_init(double, double, T_DOUBLE)
+num_init(u32ptr, p32, T_P32)
+num_init(u64ptr, p64, T_P64)
+num_init(float, double, T_FLT)
+num_init(double, double, T_DBL)
BUILTIN("rune", rune) {@@ -326,9 +330,10 @@
num_ctor_unboxed(u32, u32int, T_U32)
num_ctor_unboxed(s64, s64int, T_S64)
num_ctor_unboxed(u64, u64int, T_U64)
-num_ctor_unboxed(ptr, uintptr, T_PTR)
-num_ctor(float, float, T_FLOAT)
-num_ctor(double, double, T_DOUBLE)
+num_ctor_unboxed(p32, u32ptr, T_P32)
+num_ctor_unboxed(p64, u64ptr, T_P64)
+num_ctor(float, float, T_FLT)
+num_ctor(double, double, T_DBL)
num_ctor_init(utf8, u8int, T_U8)
static void
@@ -838,7 +843,8 @@
case T_U32: return mk_u32(((u32int*)data)[index]);
case T_S64: return mk_s64(((s64int*)data)[index]);
case T_U64: return mk_u64(((u64int*)data)[index]);
- case T_PTR: return mk_ptr(((uintptr*)data)[index]);
+ case T_P32: return mk_p32(((u32int*)data)[index]);
+ case T_P64: return mk_p64(((u64int*)data)[index]);
default: break;
}
}
@@ -912,7 +918,7 @@
sl_##name##type->init = cvalue_##ctype##_init; \
}while(0)
-#define RETURN_NUM_AS(var, type) return(mk_##type(var))
+#define RETURN_NUM_AS(var, type) return mk_##type(var)
sl_constfn
sl_v
@@ -962,7 +968,6 @@
{s64int i64;
u64int ui64;
- uintptr uiptr;
mpint *mp;
sl_numtype pt;
sl_fx pi;
@@ -970,8 +975,8 @@
if(num_to_ptr(n, &pi, &pt, &a)){ switch(pt){- case T_DOUBLE: return mk_double(-*(double*)a);
- case T_FLOAT: return mk_float(-*(float*)a);
+ case T_DBL: return mk_double(-*(double*)a);
+ case T_FLT: return mk_float(-*(float*)a);
case T_S8: return fixnum(-(sl_fx)*(s8int*)a);
case T_U8: return fixnum(-(sl_fx)*(u8int*)a);
case T_S16: return fixnum(-(sl_fx)*(s16int*)a);
@@ -998,17 +1003,11 @@
}
i64 = -(s64int)ui64;
goto i64neg;
- case T_PTR:
- uiptr = *(uintptr*)a;
- if(uiptr >= (u64int)INT64_MAX+1){- mp = uvtomp(uiptr, nil);
- mp->sign = -1;
- return mk_bignum(mp);
- }
- i64 = -(s64int)uiptr;
- goto i64neg;
- break;
- case T_BIGNUM:
+ case T_P32:
+ return mk_p32(-*(u32int*)a);
+ case T_P64:
+ return mk_p64(-*(u64int*)a);
+ case T_BIG:
mp = mpcopy(*(mpint**)a);
mp->sign = -mp->sign;
return mk_bignum(mp);
@@ -1073,7 +1072,7 @@
cthrow(type_error("num", b), a);return 2;
}
- if(eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
+ if(eq && eqnans && ((ta >= T_FLT) != (tb >= T_FLT)))
return 1;
if(cmp_eq(aptr, ta, bptr, tb, eqnans))
return 0;
@@ -1103,20 +1102,20 @@
if(!num_to_ptr(b, &bi, &tb, &bptr))
cthrow(type_error("num", b), a);// a pointer is not exactly a number
- if(ta == T_PTR)
+ if(ta == T_P32 || ta == T_P64)
cthrow(type_error("num", a), a);- if(tb == T_PTR)
+ if(tb == T_P32 || tb == T_P64)
cthrow(type_error("num", b), a);da = conv_to_double(a, aptr, ta);
db = conv_to_double(b, bptr, tb);
- if(db == 0 && tb < T_FLOAT) // exact 0
+ if(db == 0 && tb < T_FLT) // exact 0
cthrow(divide_by_0_error(), a);
da = da/db;
- if(ta < T_FLOAT && tb < T_FLOAT && (double)(s64int)da == da)
+ if(ta < T_FLT && tb < T_FLT && (double)(s64int)da == da)
return return_from_s64((s64int)da);
return mk_double(da);
}
@@ -1135,13 +1134,13 @@
if(!num_to_ptr(b, &bi, &tb, &bptr))
cthrow(type_error("num", b), a);// a pointer is not exactly a number
- if(ta == T_PTR)
+ if(ta == T_P32 || ta == T_P64)
cthrow(type_error("num", a), a);- if(tb == T_PTR)
+ if(tb == T_P32 || tb == T_P64)
cthrow(type_error("num", b), a);- if(ta == T_BIGNUM){- if(tb == T_BIGNUM){+ if(ta == T_BIG){+ if(tb == T_BIG){if(mpsignif(*(mpint**)bptr) == 0)
cthrow(divide_by_0_error(), a);
x = mpnew(0);
@@ -1194,9 +1193,9 @@
mpint *bmp = nil, *resmp = nil;
s64int b64;
- if(!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
+ if(!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLT)
cthrow(type_error("int", a), a);- if(!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
+ if(!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLT)
cthrow(type_error("int", b), a); if(ta < tb){@@ -1204,8 +1203,8 @@
ptmp = aptr; aptr = bptr; bptr = ptmp;
}
// now a's type is larger than or same as b's
- if(ta == T_BIGNUM){- if(tb == T_BIGNUM){+ if(ta == T_BIG){+ if(tb == T_BIG){bmp = *(mpint**)bptr;
resmp = mpnew(0);
}else{@@ -1226,10 +1225,11 @@
case T_U32: return mk_u32(*(u32int*)aptr & (u32int)b64);
case T_S64: return mk_s64(*(s64int*)aptr & (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr & (u64int)b64);
- case T_PTR: return mk_ptr(*(uintptr*)aptr & (uintptr)b64);
- case T_BIGNUM: mpand(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
- case T_FLOAT:
- case T_DOUBLE: break;
+ case T_P32: return mk_p32(*(u32int*)aptr & (u32int)b64);
+ case T_P64: return mk_p64(*(u64int*)aptr & (u64int)b64);
+ case T_BIG: mpand(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
+ case T_FLT:
+ case T_DBL: break;
}
break;
case 1:
@@ -1242,10 +1242,11 @@
case T_U32: return mk_u32(*(u32int*)aptr | (u32int)b64);
case T_S64: return mk_s64(*(s64int*)aptr | (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr | (u64int)b64);
- case T_PTR: return mk_ptr(*(uintptr*)aptr | (uintptr)b64);
- case T_BIGNUM: mpor(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
- case T_FLOAT:
- case T_DOUBLE: break;
+ case T_P32: return mk_p32(*(u32int*)aptr | (u32int)b64);
+ case T_P64: return mk_p64(*(u64int*)aptr | (u64int)b64);
+ case T_BIG: mpor(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
+ case T_FLT:
+ case T_DBL: break;
}
break;
case 2:
@@ -1258,10 +1259,11 @@
case T_U32: return mk_u32(*(u32int*)aptr ^ (u32int)b64);
case T_S64: return mk_s64(*(s64int*)aptr ^ (s64int)b64);
case T_U64: return mk_u64(*(u64int*)aptr ^ (u64int)b64);
- case T_PTR: return mk_ptr(*(uintptr*)aptr ^ (uintptr)b64);
- case T_BIGNUM: mpxor(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
- case T_FLOAT:
- case T_DOUBLE: break;
+ case T_P32: return mk_p32(*(u32int*)aptr ^ (u32int)b64);
+ case T_P64: return mk_p64(*(u64int*)aptr ^ (u64int)b64);
+ case T_BIG: mpxor(*(mpint**)aptr, bmp, resmp); return mk_bignum(resmp);
+ case T_FLT:
+ case T_DBL: break;
}
}
abort();
@@ -1334,8 +1336,9 @@
case T_U32: return mk_u32(~*(u32int*)aptr);
case T_S64: return mk_s64(~*(s64int*)aptr);
case T_U64: return mk_u64(~*(u64int*)aptr);
- case T_PTR: return mk_ptr(~*(uintptr*)aptr);
- case T_BIGNUM:; mpint *m = mpnew(0); mpnot(*(mpint**)aptr, m); return mk_bignum(m);
+ case T_P32: return mk_p32(~*(u32int*)aptr);
+ case T_P64: return mk_p64(~*(u64int*)aptr);
+ case T_BIG:; mpint *m = mpnew(0); mpnot(*(mpint**)aptr, m); return mk_bignum(m);
default: abort();
}
}
@@ -1386,14 +1389,17 @@
case T_U32: return mk_u32((*(u32int*)aptr) >> n);
case T_S64: return mk_s64((*(s64int*)aptr) >> n);
case T_U64: return mk_u64((*(u64int*)aptr) >> n);
- case T_PTR: return mk_ptr((*(uintptr*)aptr) >> n);
+ case T_P32: return mk_p32((*(u32int*)aptr) >> n);
+ case T_P64: return mk_p64((*(u64int*)aptr) >> n);
default: abort();
}
}else if(ta == T_U64)
return return_from_u64((*(u64int*)aptr)<<n);
- else if(ta == T_PTR)
- return return_from_u64((*(uintptr*)aptr)<<n);
- else if(ta < T_FLOAT)
+ else if(ta == T_P32)
+ return mk_p32((*(u32int*)aptr)<<n);
+ else if(ta == T_P64)
+ return mk_p64((*(u64int*)aptr)<<n);
+ else if(ta < T_FLT)
return return_from_s64(conv_to_s64(a, aptr, ta)<<n);
}
if(mp != nil){@@ -1431,9 +1437,10 @@
ctor_cv_intern(u32, T_U32, u32int);
ctor_cv_intern(s64, T_S64, s64int);
ctor_cv_intern(u64, T_U64, u64int);
- ctor_cv_intern(ptr, T_PTR, uintptr);
- ctor_cv_intern(float, T_FLOAT, float);
- ctor_cv_intern(double, T_DOUBLE, double);
+ ctor_cv_intern(p32, T_P32, u32int);
+ ctor_cv_intern(p64, T_P64, u64int);
+ ctor_cv_intern(float, T_FLT, float);
+ ctor_cv_intern(double, T_DBL, double);
ctor_cv_intern(utf8, T_U8, u8int);
ctor_cv_intern(arr, NONNUMERIC, int);
@@ -1446,12 +1453,16 @@
mk_primtype(u32, u32int);
mk_primtype(s64, s64int);
mk_primtype(u64, u64int);
- mk_primtype(ptr, uintptr);
+ mk_primtype(p32, u32ptr);
+ mk_primtype(p64, u64ptr);
mk_primtype(float, float);
mk_primtype(double, double);
mk_primtype(utf8, u8int);
- ctor_cv_intern(bignum, T_BIGNUM, mpint*);
+ sl_ptrsym = mk_csym("ptr");+ set(sl_ptrsym, sym_value(sizeof(uintptr) == 8 ? sl_p64sym : sl_p32sym));
+
+ ctor_cv_intern(bignum, T_BIG, mpint*);
sl_bignumtype = get_type(sl_bignumsym);
sl_bignumtype->init = cvalue_bignum_init;
sl_bignumtype->vtable = &bignum_vtable;
@@ -1464,7 +1475,8 @@
unboxedtypes[T_U32] = sl_u32type;
unboxedtypes[T_S64] = sl_s64type;
unboxedtypes[T_U64] = sl_u64type;
- unboxedtypes[T_PTR] = sl_ptrtype;
+ unboxedtypes[T_P32] = sl_p32type;
+ unboxedtypes[T_P64] = sl_p64type;
unboxedtypesyms[T_S8] = sl_s8sym;
unboxedtypesyms[T_U8] = sl_u8sym;
unboxedtypesyms[T_S16] = sl_s16sym;
@@ -1473,7 +1485,8 @@
unboxedtypesyms[T_U32] = sl_u32sym;
unboxedtypesyms[T_S64] = sl_s64sym;
unboxedtypesyms[T_U64] = sl_u64sym;
- unboxedtypesyms[T_PTR] = sl_ptrsym;
+ unboxedtypesyms[T_P32] = sl_p32sym;
+ unboxedtypesyms[T_P64] = sl_p64sym;
sl_strtype = get_type(mk_list2(sl_arrsym, sl_utf8sym));
sl_emptystr = cvalue_from_ref(sl_strtype, (char*)"", 0);
--- a/src/cvalues.h
+++ b/src/cvalues.h
@@ -1,11 +1,5 @@
#pragma once
-#if defined(BITS64)
-#define NWORDS(sz) (((sz)+7)>>3)
-#else
-#define NWORDS(sz) (((sz)+3)>>2)
-#endif
-
void add_finalizer(sl_cv *cv);
void sweep_finalizers(void);
void cv_autorelease(sl_cv *cv);
@@ -35,6 +29,8 @@
sl_v cbuiltin(const char *name, builtin_t f);
sl_v return_from_u64(u64int Uaccum);
sl_v return_from_s64(s64int Saccum);
+sl_v return_from_p32(u32int p);
+sl_v return_from_p64(u32int p);
sl_v sl_add_any(sl_v *args, u32int nargs);
sl_v sl_neg(sl_v n);
sl_v sl_mul_any(sl_v *args, u32int nargs);
@@ -52,9 +48,18 @@
sl_v mk_u32(u32int n);
sl_v mk_s64(s64int n);
sl_v mk_u64(u64int n);
-sl_v mk_ptr(uintptr n);
+sl_v mk_p32(u32int n);
+sl_v mk_p64(u64int n);
sl_v mk_bignum(mpint *n);
sl_v mk_float(float n);
sl_v mk_double(double n);
usize llength(sl_v v) sl_purefn;
+
+#if defined(BITS64)
+#define NWORDS(sz) (((sz)+7)>>3)
+#define mk_ptr(n) mk_p64(n)
+#else
+#define NWORDS(sz) (((sz)+3)>>2)
+#define mk_ptr(n) mk_p32(n)
+#endif
--- a/src/operators.c
+++ b/src/operators.c
@@ -5,18 +5,17 @@
conv_to_bignum(sl_v v, void *data, sl_numtype tag)
{ switch(tag){- case T_S8: return itomp(*(s8int*)data, nil);
- case T_U8: return uitomp(*(u8int*)data, nil);
- case T_S16: return itomp(*(s16int*)data, nil);
- case T_U16: return uitomp(*(u16int*)data, nil);
- case T_S32: return itomp(*(s32int*)data, nil);
- case T_U32: return uitomp(*(u32int*)data, nil);
- case T_S64: return vtomp(*(s64int*)data, nil);
- case T_U64: return uvtomp(*(u64int*)data, nil);
- case T_PTR: return uvtomp(*(uintptr*)data, nil);
- case T_BIGNUM: return mpcopy(*(mpint**)data);
- case T_FLOAT: return dtomp(*(float*)data, nil);
- case T_DOUBLE: return dtomp(*(double*)data, nil);
+ case T_S8: return itomp(*(s8int*)data, nil);
+ case T_U8: return uitomp(*(u8int*)data, nil);
+ case T_S16: return itomp(*(s16int*)data, nil);
+ case T_U16: return uitomp(*(u16int*)data, nil);
+ case T_S32: return itomp(*(s32int*)data, nil);
+ case T_U32: case T_P32: return uitomp(*(u32int*)data, nil);
+ case T_S64: return vtomp(*(s64int*)data, nil);
+ case T_U64: case T_P64: return uvtomp(*(u64int*)data, nil);
+ case T_BIG: return mpcopy(*(mpint**)data);
+ case T_FLT: return dtomp(*(float*)data, nil);
+ case T_DBL: return dtomp(*(double*)data, nil);
}
cthrow(type_error("num", v), v);}
@@ -27,22 +26,21 @@
{double d;
switch(tag){- case T_S8: return *(s8int*)data;
- case T_U8: return *(u8int*)data;
- case T_S16: return *(s16int*)data;
- case T_U16: return *(u16int*)data;
- case T_S32: return *(s32int*)data;
- case T_U32: return *(u32int*)data;
+ case T_S8: return *(s8int*)data;
+ case T_U8: return *(u8int*)data;
+ case T_S16: return *(s16int*)data;
+ case T_U16: return *(u16int*)data;
+ case T_S32: return *(s32int*)data;
+ case T_U32: case T_P32: return *(u32int*)data;
case T_S64:
d = *(s64int*)data;
if(d > 0 && *(s64int*)data < 0) // can happen!
d = -d;
return d;
- case T_U64: return *(u64int*)data;
- case T_PTR: return *(uintptr*)data;
- case T_BIGNUM: return mptod(*(mpint**)data);
- case T_FLOAT: return *(float*)data;
- case T_DOUBLE: return *(double*)data;
+ case T_U64: case T_P64: return *(u64int*)data;
+ case T_BIG: return mptod(*(mpint**)data);
+ case T_FLT: return *(float*)data;
+ case T_DBL: return *(double*)data;
}
cthrow(type_error("num", v), v);}
@@ -54,18 +52,17 @@
conv_to_##name(sl_v v, void *data, sl_numtype tag) \
{ \ switch(tag){ \- case T_S8: return (ctype)*(s8int*)data; \
- case T_U8: return (ctype)*(u8int*)data; \
- case T_S16: return (ctype)*(s16int*)data; \
- case T_U16: return (ctype)*(u16int*)data; \
- case T_S32: return (ctype)*(s32int*)data; \
- case T_U32: return (ctype)*(u32int*)data; \
- case T_S64: return (ctype)*(s64int*)data; \
- case T_U64: return (ctype)*(u64int*)data; \
- case T_PTR: return (ctype)*(uintptr*)data; \
- case T_BIGNUM: return (ctype)mptov(*(mpint**)data); \
- case T_FLOAT: return (ctype)*(float*)data; \
- case T_DOUBLE: return (ctype)*(double*)data; \
+ case T_S8: return (ctype)*(s8int*)data; \
+ case T_U8: return (ctype)*(u8int*)data; \
+ case T_S16: return (ctype)*(s16int*)data; \
+ case T_U16: return (ctype)*(u16int*)data; \
+ case T_S32: return (ctype)*(s32int*)data; \
+ case T_U32: case T_P32: return (ctype)*(u32int*)data; \
+ case T_S64: case T_P64: return (ctype)*(s64int*)data; \
+ case T_U64: return (ctype)*(u64int*)data; \
+ case T_BIG: return (ctype)mptov(*(mpint**)data); \
+ case T_FLT: return (ctype)*(float*)data; \
+ case T_DBL: return (ctype)*(double*)data; \
} \
cthrow(type_error("num", v), v); \}
@@ -83,22 +80,21 @@
{s64int s;
switch(tag){- case T_S8: return *(s8int*)data; break;
- case T_U8: return *(u8int*)data; break;
- case T_S16: return *(s16int*)data; break;
- case T_U16: return *(u16int*)data; break;
- case T_S32: return *(s32int*)data; break;
- case T_U32: return *(u32int*)data; break;
- case T_S64: return *(s64int*)data; break;
- case T_U64: return *(u64int*)data; break;
- case T_PTR: return *(uintptr*)data; break;
- case T_BIGNUM: return mptouv(*(mpint**)data); break;
- case T_FLOAT:
+ case T_S8: return *(s8int*)data; break;
+ case T_U8: return *(u8int*)data; break;
+ case T_S16: return *(s16int*)data; break;
+ case T_U16: return *(u16int*)data; break;
+ case T_S32: return *(s32int*)data; break;
+ case T_U32: case T_P32: return *(u32int*)data; break;
+ case T_S64: return *(s64int*)data; break;
+ case T_U64: case T_P64: return *(u64int*)data; break;
+ case T_BIG: return mptouv(*(mpint**)data); break;
+ case T_FLT:
if(*(float*)data >= 0)
return *(float*)data;
s = *(float*)data;
return s;
- case T_DOUBLE:
+ case T_DBL:
if(*(double*)data >= 0)
return *(double*)data;
s = *(double*)data;
@@ -112,18 +108,17 @@
cmp_same_lt(void *a, void *b, sl_numtype tag)
{ switch(tag){- case T_S8: return *(s8int*)a < *(s8int*)b;
- case T_U8: return *(u8int*)a < *(u8int*)b;
- case T_S16: return *(s16int*)a < *(s16int*)b;
- case T_U16: return *(u16int*)a < *(u16int*)b;
- case T_S32: return *(s32int*)a < *(s32int*)b;
- case T_U32: return *(u32int*)a < *(u32int*)b;
- case T_S64: return *(s64int*)a < *(s64int*)b;
- case T_U64: return *(u64int*)a < *(u64int*)b;
- case T_PTR: return *(uintptr*)a < *(uintptr*)b;
- case T_BIGNUM: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
- case T_FLOAT: return *(float*)a < *(float*)b;
- case T_DOUBLE: return *(double*)a < *(double*)b;
+ case T_S8: return *(s8int*)a < *(s8int*)b;
+ case T_U8: return *(u8int*)a < *(u8int*)b;
+ case T_S16: return *(s16int*)a < *(s16int*)b;
+ case T_U16: return *(u16int*)a < *(u16int*)b;
+ case T_S32: return *(s32int*)a < *(s32int*)b;
+ case T_U32: case T_P32: return *(u32int*)a < *(u32int*)b;
+ case T_S64: return *(s64int*)a < *(s64int*)b;
+ case T_U64: case T_P64: return *(u64int*)a < *(u64int*)b;
+ case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
+ case T_FLT: return *(float*)a < *(float*)b;
+ case T_DBL: return *(double*)a < *(double*)b;
}
return false;
}
@@ -133,18 +128,17 @@
cmp_same_eq(void *a, void *b, sl_numtype tag)
{ switch(tag){- case T_S8: return *(s8int*)a == *(s8int*)b;
- case T_U8: return *(u8int*)a == *(u8int*)b;
- case T_S16: return *(s16int*)a == *(s16int*)b;
- case T_U16: return *(u16int*)a == *(u16int*)b;
- case T_S32: return *(s32int*)a == *(s32int*)b;
- case T_U32: return *(u32int*)a == *(u32int*)b;
- case T_S64: return *(s64int*)a == *(s64int*)b;
- case T_U64: return *(u64int*)a == *(u64int*)b;
- case T_PTR: return *(uintptr*)a == *(uintptr*)b;
- case T_BIGNUM: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
- case T_FLOAT: return *(float*)a == *(float*)b && !isnan(*(float*)a);
- case T_DOUBLE: return *(double*)a == *(double*)b && !isnan(*(double*)b);
+ case T_S8: return *(s8int*)a == *(s8int*)b;
+ case T_U8: return *(u8int*)a == *(u8int*)b;
+ case T_S16: return *(s16int*)a == *(s16int*)b;
+ case T_U16: return *(u16int*)a == *(u16int*)b;
+ case T_S32: return *(s32int*)a == *(s32int*)b;
+ case T_U32: case T_P32: return *(u32int*)a == *(u32int*)b;
+ case T_S64: return *(s64int*)a == *(s64int*)b;
+ case T_U64: case T_P64: return *(u64int*)a == *(u64int*)b;
+ case T_BIG: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
+ case T_FLT: return *(float*)a == *(float*)b && !isnan(*(float*)a);
+ case T_DBL: return *(double*)a == *(double*)b && !isnan(*(double*)b);
}
return false;
}
@@ -171,35 +165,35 @@
if(db < da)
return false;
- if(cmpmpint == nil && (atag == T_BIGNUM || btag == T_BIGNUM))
+ if(cmpmpint == nil && (atag == T_BIG || btag == T_BIG))
cmpmpint = mpnew(0);
if(atag == T_U64){if(btag == T_S64)
return *(s64int*)b >= 0 && *(u64int*)a < (u64int)*(s64int*)b;
- if(btag == T_DOUBLE)
+ if(btag == T_DBL)
return db >= 0 ? *(u64int*)a < (u64int)*(double*)b : 0;
- if(btag == T_BIGNUM)
+ if(btag == T_BIG)
return mpcmp(uvtomp(*(u64int*)a, cmpmpint), *(mpint**)b) < 0;
}
if(atag == T_S64){if(btag == T_U64)
return *(s64int*)a >= 0 && (u64int)*(s64int*)a < *(u64int*)b;
- if(btag == T_DOUBLE)
+ if(btag == T_DBL)
return db == db ? *(s64int*)a < (s64int)*(double*)b : 0;
- if(btag == T_BIGNUM)
+ if(btag == T_BIG)
return mpcmp(vtomp(*(s64int*)a, cmpmpint), *(mpint**)b) < 0;
}
if(btag == T_U64){- if(atag == T_DOUBLE)
+ if(atag == T_DBL)
return da >= 0 ? *(u64int*)b > (u64int)*(double*)a : 0;
- if(atag == T_BIGNUM)
+ if(atag == T_BIG)
return mpcmp(*(mpint**)a, uvtomp(*(u64int*)b, cmpmpint)) < 0;
}
if(btag == T_S64){- if(atag == T_DOUBLE)
+ if(atag == T_DBL)
return da == da ? *(s64int*)b > (s64int)*(double*)a : 0;
- if(atag == T_BIGNUM)
+ if(atag == T_BIG)
return mpcmp(*(mpint**)a, vtomp(*(s64int*)b, cmpmpint)) < 0;
}
return false;
@@ -213,13 +207,13 @@
s64int i64;
}u, v;
- if(atag == btag && (!equalnans || atag < T_FLOAT))
+ if(atag == btag && (!equalnans || atag < T_FLT))
return cmp_same_eq(a, b, atag);
double da = conv_to_double(sl_nil, a, atag);
double db = conv_to_double(sl_nil, b, btag);
- if((int)atag >= T_FLOAT && (int)btag >= T_FLOAT){+ if((int)atag >= T_FLT && (int)btag >= T_FLT){ if(equalnans){u.d = da; v.d = db;
return u.i64 == v.i64;
@@ -230,7 +224,7 @@
if(da != db)
return false;
- if(cmpmpint == nil && (atag == T_BIGNUM || btag == T_BIGNUM))
+ if(cmpmpint == nil && (atag == T_BIG || btag == T_BIG))
cmpmpint = mpnew(0);
if(atag == T_U64){@@ -238,33 +232,33 @@
// we would already have concluded that it's bigger than b.
if(btag == T_S64)
return *(s64int*)b >= 0 && *(u64int*)a == *(u64int*)b;
- if(btag == T_DOUBLE)
+ if(btag == T_DBL)
return *(double*)b >= 0 && *(u64int*)a == (u64int)*(double*)b;
- if(btag == T_BIGNUM)
+ if(btag == T_BIG)
return mpcmp(uvtomp(*(u64int*)a, cmpmpint), *(mpint**)b) == 0;
}
if(atag == T_S64){if(btag == T_U64)
return *(s64int*)a >= 0 && *(u64int*)a == *(u64int*)b;
- if(btag == T_DOUBLE)
+ if(btag == T_DBL)
return *(s64int*)a == (s64int)*(double*)b;
- if(btag == T_BIGNUM)
+ if(btag == T_BIG)
return mpcmp(vtomp(*(s64int*)a, cmpmpint), *(mpint**)b) == 0;
}
if(btag == T_U64){if(atag == T_S64)
return *(s64int*)a >= 0 && *(u64int*)b == *(u64int*)a;
- if(atag == T_DOUBLE)
+ if(atag == T_DBL)
return *(double*)a >= 0 && *(u64int*)b == (u64int)*(double*)a;
- if(atag == T_BIGNUM)
+ if(atag == T_BIG)
return mpcmp(*(mpint**)a, uvtomp(*(u64int*)b, cmpmpint)) == 0;
}
if(btag == T_S64){if(atag == T_U64)
return *(s64int*)b >= 0 && *(u64int*)b == *(u64int*)a;
- if(atag == T_DOUBLE)
+ if(atag == T_DBL)
return *(s64int*)b == (s64int)*(double*)a;
- if(atag == T_BIGNUM)
+ if(atag == T_BIG)
return mpcmp(*(mpint**)a, vtomp(*(s64int*)b, cmpmpint)) == 0;
}
return true;
--- a/src/operators.h
+++ b/src/operators.h
@@ -7,10 +7,13 @@
mpint *conv_to_bignum(sl_v v, void *data, sl_numtype tag);
double conv_to_double(sl_v v, void *data, sl_numtype tag);
+#define conv_to_p32 conv_to_u32
+#define conv_to_p64 conv_to_u64
+
#if defined(BITS64)
-#define conv_to_ptr conv_to_u64
+#define conv_to_ptr conv_to_p64
#else
-#define conv_to_ptr conv_to_u32
+#define conv_to_ptr conv_to_p32
#endif
bool cmp_same_lt(void *a, void *b, sl_numtype tag);
--- a/src/print.c
+++ b/src/print.c
@@ -766,11 +766,19 @@
if(n < 1)
goto err;
sl.hpos += n;
- }else if(type == sl_ptrsym){- uintptr p = *(uintptr*)data;
+ }else if(type == sl_p32sym){+ u32int p = *(u32int*)data;
n = (weak || sl.print_princ)
- ? ios_printf(f, "0x%"PRIxPTR, p)
- : ios_printf(f, "#%s(0x%"PRIxPTR")", sym_name(type), p);
+ ? ios_printf(f, "0x%"PRIx32, p)
+ : ios_printf(f, "#%s(0x%"PRIx32")", sym_name(type), p);
+ if(n < 1)
+ goto err;
+ sl.hpos += n;
+ }else if(type == sl_p64sym){+ u64int p = *(u64int*)data;
+ n = (weak || sl.print_princ)
+ ? ios_printf(f, "0x%"PRIx64, p)
+ : ios_printf(f, "#%s(0x%"PRIx64")", sym_name(type), p);
if(n < 1)
goto err;
sl.hpos += n;
--- a/src/sl.c
+++ b/src/sl.c
@@ -27,7 +27,7 @@
sl_v sl_tablesym, sl_arrsym;
sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
-sl_v sl_s64sym, sl_u64sym, sl_ptrsym, sl_bignumsym;
+sl_v sl_s64sym, sl_u64sym, sl_p32sym, sl_p64sym, sl_ptrsym, sl_bignumsym;
sl_v sl_utf8sym, sl_runesym, sl_floatsym, sl_doublesym;
sl_type *sl_bignumtype, *sl_builtintype;
@@ -34,7 +34,8 @@
sl_type *sl_s8type, *sl_u8type;
sl_type *sl_s16type, *sl_u16type;
sl_type *sl_s32type, *sl_u32type;
-sl_type *sl_s64type, *sl_u64type, *sl_ptrtype;
+sl_type *sl_s64type, *sl_u64type;
+sl_type *sl_p32type, *sl_p64type;
sl_type *sl_floattype, *sl_doubletype;
sl_type *sl_utf8type, *sl_runetype;
sl_type *sl_strtype;
--- a/src/sl.h
+++ b/src/sl.h
@@ -36,11 +36,12 @@
T_S8, T_U8,
T_S16, T_U16,
T_S32, T_U32,
+ T_P32,
T_S64, T_U64,
- T_PTR,
+ T_P64,
T_UNBOXED_NUM,
- T_BIGNUM = T_UNBOXED_NUM,
- T_FLOAT, T_DOUBLE,
+ T_BIG = T_UNBOXED_NUM,
+ T_FLT, T_DBL,
}sl_numtype;
typedef uintptr sl_v;
@@ -103,7 +104,7 @@
#define ANYARGS -10000
#define NONNUMERIC (0xff)
-#define valid_numtype(v) ((v) <= T_DOUBLE)
+#define valid_numtype(v) ((v) <= T_DBL)
#define UNBOUND ((sl_v)1) // an invalid value
#define tag(x) ((x) & 7)
#define tagext(x) ((x) & 0xff)
@@ -348,7 +349,7 @@
#define value2c(type, v) ((type)cvalue_data(v))
#define cv_numtype(cv) (cv_class(cv)->numtype)
-#define isbignum(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_BIGNUM)
+#define isbignum(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_BIG)
#define tobignum(v) (*(mpint**)cv_data(ptr(v)))
#define BUILTIN(lname, cname) \
@@ -444,7 +445,7 @@
extern sl_v sl_arrsym;
extern sl_v sl_iosym, sl_rdsym, sl_wrsym, sl_apsym, sl_crsym, sl_truncsym;
extern sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;
-extern sl_v sl_s64sym, sl_u64sym, sl_ptrsym, sl_bignumsym;
+extern sl_v sl_s64sym, sl_u64sym, sl_p32sym, sl_p64sym, sl_ptrsym, sl_bignumsym;
extern sl_v sl_utf8sym, sl_runesym, sl_floatsym, sl_doublesym;
extern sl_type *sl_bignumtype, *sl_builtintype;
@@ -451,7 +452,8 @@
extern sl_type *sl_s8type, *sl_u8type;
extern sl_type *sl_s16type, *sl_u16type;
extern sl_type *sl_s32type, *sl_u32type;
-extern sl_type *sl_s64type, *sl_u64type, *sl_ptrtype;
+extern sl_type *sl_s64type, *sl_u64type;
+extern sl_type *sl_p32type, *sl_p64type;
extern sl_type *sl_floattype, *sl_doubletype;
extern sl_type *sl_utf8type, *sl_runetype;
extern sl_type *sl_strtype, *sl_runestrtype;
--- a/src/sl_arith_any.h
+++ b/src/sl_arith_any.h
@@ -6,10 +6,10 @@
mpint *Maccum = nil, *m = nil;
s64int Saccum = ACCUM_DEFAULT, x;
- u64int u64;
- uintptr uptr;
double Faccum = ACCUM_DEFAULT;
+ u64int u64;
bool inexact = false;
+ int forcetype = -1;
sl_v arg;
sl_numtype pt;
void *a;
@@ -35,15 +35,17 @@
type_error("num", arg);}
switch(pt){- case T_DOUBLE: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue;
- case T_FLOAT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue;
+ case T_DBL: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue;
+ case T_FLT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue;
case T_S8: x = *(s8int*)a; break;
case T_U8: x = *(u8int*)a; break;
case T_S16: x = *(s16int*)a; break;
case T_U16: x = *(u16int*)a; break;
case T_S32: x = *(s32int*)a; break;
+ case T_P32: if(forcetype < 0) forcetype = T_P32;
case T_U32: x = *(u32int*)a; break;
case T_S64: x = *(s64int*)a; break;
+ case T_P64: if(forcetype < 0) forcetype = T_P64;
case T_U64:
u64 = *(u64int*)a;
if(u64 > INT64_MAX){@@ -52,16 +54,7 @@
}
x = u64;
break;
- case T_PTR:
- uptr = *(uintptr*)a;
- if(uptr > INT64_MAX){- u64 = uptr;
- x = ACCUM_DEFAULT;
- goto overflow;
- }
- x = uptr;
- break;
- case T_BIGNUM:
+ case T_BIG:
x = ACCUM_DEFAULT;
u64 = ACCUM_DEFAULT;
m = mpcopy(*(mpint**)a);
@@ -79,6 +72,16 @@
Saccum = accu;
}
+ if(forcetype >= 0){+forcedptr:
+ if(inexact)
+ lerrorf(sl_errarg, "arithmetic on a mix of ptr and inexact types");
+ switch(forcetype){+ case T_P32: return mk_p32(Saccum);
+ case T_P64: return mk_p64(Saccum);
+ default: abort();
+ }
+ }
if(inexact)
return mk_double(ARITH_OP(Faccum, Saccum));
if(fits_fixnum(Saccum))
@@ -113,24 +116,22 @@
goto typeerr;
}
switch(pt){- case T_DOUBLE: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue;
- case T_FLOAT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue;
+ case T_DBL: Faccum = ARITH_OP(Faccum, *(double*)a); inexact = true; continue;
+ case T_FLT: Faccum = ARITH_OP(Faccum, *(float*)a); inexact = true; continue;
case T_S8: x = *(s8int*)a; break;
case T_U8: x = *(u8int*)a; break;
case T_S16: x = *(s16int*)a; break;
case T_U16: x = *(u16int*)a; break;
case T_S32: x = *(s32int*)a; break;
+ case T_P32: if(forcetype < 0) forcetype = T_P32;
case T_U32: x = *(u32int*)a; break;
case T_S64: x = *(s64int*)a; break;
+ case T_P64: if(forcetype < 0) forcetype = T_P64;
case T_U64:
uvtomp(*(u64int*)a, m);
MP_OP(Maccum, m, Maccum);
continue;
- case T_PTR:
- uvtomp(*(uintptr*)a, m);
- MP_OP(Maccum, m, Maccum);
- continue;
- case T_BIGNUM:
+ case T_BIG:
MP_OP(Maccum, *(mpint**)a, Maccum);
continue;
default:
@@ -140,6 +141,11 @@
MP_OP(Maccum, m, Maccum);
}
+ if(forcetype >= 0){+ Saccum = mptouv(Maccum);
+ goto forcedptr;
+ }
+
int n = mpsignif(Maccum);
if(n >= FIXNUM_BITS){ if(inexact){@@ -154,7 +160,6 @@
mpfree(m);
return mk_bignum(Maccum);
}
-
down:
mpfree(m);
Saccum = mptov(Maccum);
--- a/src/str.c
+++ b/src/str.c
@@ -365,7 +365,7 @@
return n;
}else if(iscvalue(n)){sl_cv *data = ptr(n);
- if(cv_numtype(data) < T_FLOAT)
+ if(cv_numtype(data) < T_FLT)
num = conv_to_u64(n, cv_data(data), cv_numtype(data));
else if(radix != 10)
bthrow(lerrorf(sl_errarg, "invalid radix with floating point"));
--- a/src/system.sl
+++ b/src/system.sl
@@ -1500,7 +1500,7 @@
(excludes '(*linefeed* *directory-separator* *argv* that *exit-hooks*
*print-pretty* *print-width* *print-readably*
*print-level* *print-length* *os-name* *interactive*
- *prompt* *os-version*)))
+ *prompt* *os-version* ptr)))
(with-bindings ((*print-pretty* T)
(*print-readably* T))
(let* ((syms
--- a/src/vm.h
+++ b/src/vm.h
@@ -475,10 +475,10 @@
else{sl_cv *p = ptr(v);
switch(cv_numtype(p)){- case T_DOUBLE:
+ case T_DBL:
v = isnan(*(double*)cv_data(p)) ? sl_t : sl_nil;
break;
- case T_FLOAT:
+ case T_FLT:
v = isnan(*(float*)cv_data(p)) ? sl_t : sl_nil;
break;
default: