mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
dermagen
GitHub
commit
ac9f21f469
8 changed files with 11968 additions and 6091 deletions
102
i.c
102
i.c
|
|
@ -13,7 +13,7 @@ extern obj cx__2Acurrent_2Dinput_2A;
|
|||
extern obj cx__2Acurrent_2Doutput_2A;
|
||||
extern obj cx__2Acurrent_2Derror_2A;
|
||||
|
||||
#define istagged(o, t) istagged_inlined(o, t)
|
||||
//#define istagged(o, t) istagged_inlined(o, t)
|
||||
|
||||
/* forwards */
|
||||
static struct intgtab_entry *lookup_integrable(int sym);
|
||||
|
|
@ -122,6 +122,12 @@ static obj *init_modules(obj *r, obj *sp, obj *hp);
|
|||
#define VM_STACK_RSZ 256 /* red zone for overflow checks */
|
||||
#define VM_STACK_GSZ (VM_STACK_LEN-VM_STACK_RSZ)
|
||||
|
||||
/* faster non-debug type testing */
|
||||
#ifdef NDEBUG /* quick */
|
||||
static int istagged_inline(obj o, int t) { return isobjptr(o) && hblkref(o, 0) == obj_from_size(t); }
|
||||
#define istagged(o, t) istagged_inline(o, t)
|
||||
#endif
|
||||
|
||||
/* box representation extras */
|
||||
#define boxbsz() hbsz(1+1)
|
||||
#define hend_box() (*--hp = obj_from_size(BOX_BTAG), hendblk(1+1))
|
||||
|
|
@ -135,8 +141,8 @@ static obj *init_modules(obj *r, obj *sp, obj *hp);
|
|||
#define hend_vec(n) (*--hp = obj_from_size(VECTOR_BTAG), hendblk((n)+1))
|
||||
|
||||
/* record representation extras */
|
||||
#define recbsz(c) hbsz((c)+2)
|
||||
#define hend_rec(rtd, c) (*--hp = rtd, *--hp = obj_from_size(RECORD_BTAG), hendblk((c)+2))
|
||||
#define recbsz(c) hbsz((c)+1)
|
||||
#define hend_rec(rtd, c) (*--hp = rtd, hendblk((c)+1))
|
||||
|
||||
/* vm closure representation */
|
||||
#ifdef NDEBUG /* quick */
|
||||
|
|
@ -154,11 +160,11 @@ static obj *init_modules(obj *r, obj *sp, obj *hp);
|
|||
#endif
|
||||
|
||||
/* vm tuple representation (c != 1) */
|
||||
#define istuple(x) isrecord
|
||||
#define tupleref recordref
|
||||
#define tuplelen recordlen
|
||||
#define tuplebsz(c) hbsz((c)+2)
|
||||
#define hend_tuple(c) (*--hp = 0, *--hp = obj_from_size(RECORD_BTAG), hendblk((c)+2))
|
||||
#define istuple(x) istagged(x, 0)
|
||||
#define tupleref(x,i) *taggedref(x, 0, i)
|
||||
#define tuplelen(x) taggedlen(x, 0)
|
||||
#define tuplebsz(c) hbsz((c)+1)
|
||||
#define hend_tuple(c) (*--hp = obj_from_size(0), hendblk((c)+1))
|
||||
|
||||
/* in/re-loading gc-save shadow registers */
|
||||
#define unload_ip() (rx = obj_from_fixnum(ip - &vectorref(vmcloref(rd, 0), 0)))
|
||||
|
|
@ -218,14 +224,20 @@ static void _sck(obj *s) {
|
|||
#define is_eof(o) ((o) == mkeof())
|
||||
#define fixnum_obj(x) obj_from_fixnum(x)
|
||||
#define is_fixnum(o) is_fixnum_obj(o)
|
||||
#define are_fixnums(o1, o2) are_fixnum_objs(o1, o2)
|
||||
#define get_fixnum(o) get_fixnum_unchecked(o)
|
||||
#define are_fixnums(o1, o2) (is_fixnum(o1) && is_fixnum(o2))
|
||||
#define get_fixnum(o) fixnum_from_obj(o)
|
||||
#define is_byte(o) is_byte_obj(o)
|
||||
#define byte_obj(x) obj_from_fixnum((unsigned char)(x))
|
||||
#define get_byte(o) ((unsigned char)get_fixnum_unchecked(o))
|
||||
#define get_byte(o) ((unsigned char)fixnum_from_obj(o))
|
||||
#ifdef FLONUMS_BOXED
|
||||
#define flonum_obj(x) hp_pushptr(dupflonum(x), FLONUM_NTAG)
|
||||
#define is_flonum(o) is_flonum_obj(o)
|
||||
#define get_flonum(o) flonum_from_obj(o)
|
||||
#else
|
||||
#define flonum_obj(x) obj_from_flonum(0, x)
|
||||
#define is_flonum(o) is_flonum_obj(o)
|
||||
#define get_flonum(o) flonum_from_obj(o)
|
||||
#endif
|
||||
#define is_symbol(o) issymbol(o)
|
||||
#define get_symbol(o) getsymbol(o)
|
||||
#define is_pair(o) ispair(o)
|
||||
|
|
@ -1362,7 +1374,7 @@ define_instruction(bvecp) {
|
|||
|
||||
define_instruction(bvec) {
|
||||
int i, n = get_fixnum(*ip++);
|
||||
obj o = bytevector_obj(allocbytevector(n, 0));
|
||||
obj o = bytevector_obj(allocbytevector(n));
|
||||
unsigned char *s = (unsigned char *)bytevectorbytes(o);
|
||||
for (i = 0; i < n; ++i) {
|
||||
obj x = sref(i); ck8(x); s[i] = byte_from_obj(x);
|
||||
|
|
@ -1375,7 +1387,7 @@ define_instruction(bmk) {
|
|||
int n, b; obj x = spop();
|
||||
ckk(ac); ck8(x);
|
||||
n = get_fixnum(ac), b = byte_from_obj(x);
|
||||
ac = bytevector_obj(allocbytevector(n, b));
|
||||
ac = bytevector_obj(makebytevector(n, b));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
|
@ -1558,7 +1570,7 @@ define_instruction(ltov) {
|
|||
define_instruction(ltob) {
|
||||
obj l = ac, o; int n = 0, i; unsigned char *s;
|
||||
while (is_pair(l)) { l = pair_cdr(l); ++n; } cku(l);
|
||||
o = bytevector_obj(allocbytevector(n, 0));
|
||||
o = bytevector_obj(allocbytevector(n));
|
||||
s = bytevectorbytes(o);
|
||||
for (i = 0, l = ac; i < n; ++i, l = pair_cdr(l)) {
|
||||
obj x = pair_car(l); ck8(x);
|
||||
|
|
@ -1994,12 +2006,6 @@ define_instruction(jdiv) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(jrem) {
|
||||
obj x = ac, y = spop(); ckj(x); ckj(y);
|
||||
ac = flonum_obj(flrem(get_flonum(x), get_flonum(y)));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(jlt) {
|
||||
obj x = ac, y = spop(); ckj(x); ckj(y);
|
||||
ac = bool_obj(get_flonum(x) < get_flonum(y));
|
||||
|
|
@ -2085,11 +2091,21 @@ define_instruction(jtoi) {
|
|||
}
|
||||
|
||||
define_instruction(jquo) {
|
||||
obj x = ac, y = spop(); ckj(x); ckj(y);
|
||||
ac = flonum_obj(flquo(get_flonum(x), get_flonum(y)));
|
||||
obj x = ac, y = spop(); double n, d, i;
|
||||
ckj(x); ckj(y);
|
||||
n = get_flonum(x), d = get_flonum(y); modf(n/d, &i);
|
||||
ac = flonum_obj(i);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(jrem) {
|
||||
/* NB: we keep sign: (flremainder -10.0 2.0) => -0.0 */
|
||||
obj x = ac, y = spop(); ckj(x); ckj(y);
|
||||
ac = flonum_obj(fmod(get_flonum(x), get_flonum(y)));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
define_instruction(jmqu) {
|
||||
obj x = ac, y = spop(); ckj(x); ckj(y);
|
||||
ac = flonum_obj(flmqu(get_flonum(x), get_flonum(y)));
|
||||
|
|
@ -2115,9 +2131,8 @@ define_instruction(jceil) {
|
|||
}
|
||||
|
||||
define_instruction(jtrunc) {
|
||||
double f, i; ckj(ac);
|
||||
f = get_flonum(ac);
|
||||
modf(f, &i);
|
||||
double i; ckj(ac);
|
||||
modf(get_flonum(ac), &i);
|
||||
ac = flonum_obj(i);
|
||||
gonexti();
|
||||
}
|
||||
|
|
@ -2300,14 +2315,15 @@ define_instruction(quo) {
|
|||
if (unlikely(y == fixnum_obj(0))) fail("division by zero");
|
||||
ac = fixnum_obj(fxquo(get_fixnum(x), get_fixnum(y)));
|
||||
} else {
|
||||
double dx, dy;
|
||||
if (likely(is_flonum(x))) dx = get_flonum(x);
|
||||
double dx, dy, dz;
|
||||
if (likely(is_flonum(x) && flisint(dx = get_flonum(x)))) /* ok */;
|
||||
else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
|
||||
else failtype(x, "number");
|
||||
if (likely(is_flonum(y))) dy = get_flonum(y);
|
||||
else failtype(x, "integer");
|
||||
if (likely(is_flonum(y) && flisint(dy = get_flonum(y)))) /* ok */;
|
||||
else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
|
||||
else failtype(y, "number");
|
||||
ac = flonum_obj(flquo(dx, dy));
|
||||
else failtype(y, "integer");
|
||||
modf(dx / dy, &dz);
|
||||
ac = flonum_obj(dz);
|
||||
}
|
||||
gonexti();
|
||||
}
|
||||
|
|
@ -2318,14 +2334,16 @@ define_instruction(rem) {
|
|||
if (unlikely(y == fixnum_obj(0))) fail("division by zero");
|
||||
ac = fixnum_obj(fxrem(get_fixnum(x), get_fixnum(y)));
|
||||
} else {
|
||||
double dx, dy;
|
||||
if (likely(is_flonum(x))) dx = get_flonum(x);
|
||||
double dx, dy, dz;
|
||||
if (likely(is_flonum(x) && flisint(dx = get_flonum(x)))) /* ok */;
|
||||
else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
|
||||
else failtype(x, "number");
|
||||
if (likely(is_flonum(y))) dy = get_flonum(y);
|
||||
else failtype(x, "integer");
|
||||
if (likely(is_flonum(y) && flisint(dy = get_flonum(y)))) /* ok */;
|
||||
else if (likely(is_fixnum(y))) dy = (double)get_fixnum(y);
|
||||
else failtype(y, "number");
|
||||
ac = flonum_obj(flrem(dx, dy));
|
||||
else failtype(y, "integer");
|
||||
dz = fmod(dx, dy);
|
||||
/* keep zero positive: (remainder -10.0 2.0) => 0.0, not -0.0 */
|
||||
ac = flonum_obj((dz == 0.0) ? 0.0 : dz);
|
||||
}
|
||||
gonexti();
|
||||
}
|
||||
|
|
@ -2437,8 +2455,9 @@ define_instruction(ge) {
|
|||
|
||||
define_instruction(eq) {
|
||||
obj x = ac, y = spop();
|
||||
if (x == y) ac = bool_obj(1);
|
||||
else if (is_flonum(x) || is_flonum(y)) {
|
||||
if (likely(are_fixnums(x, y))) {
|
||||
ac = bool_obj(x == y);
|
||||
} else if (is_flonum(x) || is_flonum(y)) {
|
||||
double dx, dy;
|
||||
if (likely(is_flonum(x))) dx = get_flonum(x);
|
||||
else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
|
||||
|
|
@ -2453,8 +2472,9 @@ define_instruction(eq) {
|
|||
|
||||
define_instruction(ne) {
|
||||
obj x = ac, y = spop();
|
||||
if (x == y) ac = bool_obj(0);
|
||||
else if (is_flonum(x) || is_flonum(y)) {
|
||||
if (likely(are_fixnums(x, y))) {
|
||||
ac = bool_obj(x != y);
|
||||
} else if (is_flonum(x) || is_flonum(y)) {
|
||||
double dx, dy;
|
||||
if (likely(is_flonum(x))) dx = get_flonum(x);
|
||||
else if (likely(is_fixnum(x))) dx = (double)get_fixnum(x);
|
||||
|
|
|
|||
136
n.h
136
n.h
|
|
@ -13,6 +13,20 @@
|
|||
#include <time.h>
|
||||
|
||||
/* standard definitions */
|
||||
#ifdef NAN_BOXING
|
||||
#include <stdint.h>
|
||||
typedef int64_t obj; /* pointers are this size, higher 16 bits and lower bit zero */
|
||||
typedef int64_t cxoint_t; /* same thing, used as integer */
|
||||
typedef struct { /* type descriptor */
|
||||
const char *tname; /* name (debug) */
|
||||
void (*free)(void*); /* deallocator */
|
||||
} cxtype_t;
|
||||
|
||||
#define notobjptr(o) (((cxoint_t)(o) - (cxoint_t)cxg_heap) & cxg_hmask)
|
||||
#define isobjptr(o) (!notobjptr(o))
|
||||
#define notaptr(o) ((o) & 0xffff000000000001ULL)
|
||||
#define isaptr(o) (!notaptr(o))
|
||||
#else
|
||||
typedef ptrdiff_t obj; /* pointers are this size, lower bit zero */
|
||||
typedef ptrdiff_t cxoint_t; /* same thing, used as integer */
|
||||
typedef struct { /* type descriptor */
|
||||
|
|
@ -24,6 +38,7 @@ typedef struct { /* type descriptor */
|
|||
#define isobjptr(o) (!notobjptr(o))
|
||||
#define notaptr(o) ((o) & 1)
|
||||
#define isaptr(o) (!notaptr(o))
|
||||
#endif
|
||||
|
||||
#define obj_from_obj(o) (o)
|
||||
#define obj_from_objptr(p) ((obj)(p))
|
||||
|
|
@ -74,18 +89,32 @@ extern char **cxg_argv;
|
|||
|
||||
/* extra definitions */
|
||||
/* basic object representation */
|
||||
#define isimm(o, t) (((o) & 0xf) == (((t) << 1) | 1))
|
||||
#define isimm2(o1, o2, t) (((((o1) & 0xf) << 4) | ((o2) & 0xf)) == (((((t) << 1) | 1) << 4) | (((t) << 1) | 1)))
|
||||
#define getimmu_unchecked(o) (long)(((o) >> 4) & 0xfffffff)
|
||||
#define getimms_unchecked(o) (long)(((((o) >> 4) & 0xfffffff) ^ 0x8000000) - 0x8000000)
|
||||
#ifdef NAN_BOXING
|
||||
#define isim0(o) (((o) & 0xffff000000000003ULL) == 3)
|
||||
#define isimm(o, t) (((o) & 0xffff0000000000ffULL) == (((t) << 2) | 1))
|
||||
#ifdef NDEBUG
|
||||
#define getimmu(o, t) getimmu_unchecked(o)
|
||||
#define getimms(o, t) getimms_unchecked(o)
|
||||
#define getim0s(o) (long)((((o >> 2) & 0x3fffffff) ^ 0x20000000) - 0x20000000)
|
||||
#define getimmu(o, t) (long)(((o) >> 8) & 0xffffff)
|
||||
#else
|
||||
extern long getim0s(obj o);
|
||||
extern long getimmu(obj o, int t);
|
||||
extern long getimms(obj o, int t);
|
||||
#endif
|
||||
#define mkimm(o, t) (obj)((((o) & 0xfffffff) << 4) | ((t) << 1) | 1)
|
||||
#define mkim0(v) ((obj)((((v) & 0x000000003fffffffULL) << 2) | 3))
|
||||
#define mkimm(v, t) ((obj)((((v) & 0x0000000000ffffffULL) << 8) | ((t) << 2) | 1))
|
||||
#else
|
||||
#define isim0(o) (((o) & 3) == 3)
|
||||
#define isimm(o, t) (((o) & 0xff) == (((t) << 2) | 1))
|
||||
#ifdef NDEBUG
|
||||
#define getim0s(o) (long)((((o >> 2) & 0x3fffffff) ^ 0x20000000) - 0x20000000)
|
||||
#define getimmu(o, t) (long)(((o) >> 8) & 0xffffff)
|
||||
#else
|
||||
extern long getim0s(obj o);
|
||||
extern long getimmu(obj o, int t);
|
||||
#endif
|
||||
#define mkim0(o) (obj)((((o) & 0x3fffffff) << 2) | 3)
|
||||
#define mkimm(o, t) (obj)((((o) & 0xffffff) << 8) | ((t) << 2) | 1)
|
||||
#define FLONUMS_BOXED
|
||||
#endif
|
||||
#ifdef NDEBUG
|
||||
static int isnative(obj o, cxtype_t *tp)
|
||||
{ return isobjptr(o) && objptr_from_obj(o)[-1] == (obj)tp; }
|
||||
|
|
@ -95,12 +124,6 @@ extern char **cxg_argv;
|
|||
extern void *getnative(obj o, cxtype_t *tp);
|
||||
#endif
|
||||
extern int istagged(obj o, int t);
|
||||
static /*inline*/ int istagged_inlined(obj o, int t) {
|
||||
if (!isobjptr(o)) return 0;
|
||||
else { obj h = objptr_from_obj(o)[-1];
|
||||
return notaptr(h) && size_from_obj(h) >= 1
|
||||
&& hblkref(o, 0) == obj_from_size(t); }
|
||||
}
|
||||
#ifdef NDEBUG
|
||||
#define cktagged(o, t) (o)
|
||||
#define taggedlen(o, t) (hblklen(o)-1)
|
||||
|
|
@ -110,8 +133,18 @@ static /*inline*/ int istagged_inlined(obj o, int t) {
|
|||
extern int taggedlen(obj o, int t);
|
||||
extern obj* taggedref(obj o, int t, int i);
|
||||
#endif
|
||||
/* unit */
|
||||
#define obj_from_unit() (obj_from_size(0x6DF6F577))
|
||||
extern int istyped(obj o);
|
||||
#ifdef NDEBUG
|
||||
#define cktyped(o, t) (o)
|
||||
#define typedtype(o) (&hblkref(o, 0))
|
||||
#define typedlen(o) (hblklen(o)-1)
|
||||
#define typedref(o, i) (&hblkref(o, (i)+1))
|
||||
#else
|
||||
extern obj cktyped(obj o);
|
||||
extern obj* typedtype(obj o);
|
||||
extern int typedlen(obj o);
|
||||
extern obj* typedref(obj o, int i);
|
||||
#endif
|
||||
/* booleans */
|
||||
#define TRUE_ITAG 0
|
||||
typedef int bool_t;
|
||||
|
|
@ -119,10 +152,18 @@ typedef int bool_t;
|
|||
#define is_bool_bool(b) ((void)(b), 1)
|
||||
#define void_from_bool(b) (void)(b)
|
||||
#define obj_from_bool(b) ((b) ? mkimm(0, TRUE_ITAG) : 0)
|
||||
/* void */
|
||||
#define VOID_ITAG 1
|
||||
#define mkvoid() mkimm(0, VOID_ITAG)
|
||||
#define isvoid(o) ((o) == mkimm(0, VOID_ITAG))
|
||||
#undef obj_from_void
|
||||
#define obj_from_void(v) ((void)(v), mkimm(0, VOID_ITAG))
|
||||
/* unit */
|
||||
#define obj_from_unit() (obj_from_size(0x6DF6F577))
|
||||
/* numbers */
|
||||
#define FIXNUM_BIT 28
|
||||
#define FIXNUM_MIN -134217728
|
||||
#define FIXNUM_MAX 134217727
|
||||
#define FIXNUM_BIT 30
|
||||
#define FIXNUM_MIN -536870912
|
||||
#define FIXNUM_MAX 536870911
|
||||
#ifdef NDEBUG
|
||||
#define fxneg(x) (-(x))
|
||||
#define fxabs(x) (labs(x))
|
||||
|
|
@ -185,21 +226,44 @@ extern double flgcd(double x, double y);
|
|||
extern double flround(double x);
|
||||
extern int strtofxfl(char *s, int radix, long *pl, double *pd);
|
||||
/* fixnums */
|
||||
#define FIXNUM_ITAG 1
|
||||
typedef long fixnum_t;
|
||||
#define is_fixnum_obj(o) (isimm(o, FIXNUM_ITAG))
|
||||
#define are_fixnum_objs(o1, o2) (isimm2((o1), (o2), FIXNUM_ITAG))
|
||||
#define get_fixnum_unchecked(o) (getimms_unchecked(o))
|
||||
#define is_fixnum_obj(o) (isim0(o))
|
||||
#define is_fixnum_fixnum(i) ((void)(i), 1)
|
||||
#define is_bool_fixnum(i) ((void)(i), 0)
|
||||
#define is_fixnum_bool(i) ((void)(i), 0)
|
||||
#define fixnum_from_obj(o) (getimms(o, FIXNUM_ITAG))
|
||||
#define fixnum_from_obj(o) (getim0s(o))
|
||||
#define fixnum_from_fixnum(i) (i)
|
||||
#define fixnum_from_flonum(l,x) ((fixnum_t)(x))
|
||||
#define bool_from_fixnum(i) ((void)(i), 1)
|
||||
#define void_from_fixnum(i) (void)(i)
|
||||
#define obj_from_fixnum(i) mkimm((fixnum_t)(i), FIXNUM_ITAG)
|
||||
#define obj_from_fixnum(i) mkim0((fixnum_t)(i))
|
||||
/* flonums */
|
||||
#ifndef FLONUMS_BOXED
|
||||
typedef double flonum_t;
|
||||
#define is_flonum_obj(o) (((o) & 0xffff000000000000ULL) != 0ULL)
|
||||
#define is_flonum_flonum(f) ((void)(f), 1)
|
||||
#define is_flonum_bool(f) ((void)(f), 0)
|
||||
#define is_bool_flonum(f) ((void)(f), 0)
|
||||
#define is_fixnum_flonum(i) ((void)(i), 0)
|
||||
#define is_flonum_fixnum(i) ((void)(i), 0)
|
||||
#define flonum_from_flonum(l, f) (f)
|
||||
#define flonum_from_fixnum(x) ((flonum_t)(x))
|
||||
#define bool_from_flonum(f) ((void)(f), 0)
|
||||
#define void_from_flonum(l, f) (void)(f)
|
||||
union iod { cxoint_t i; double d; };
|
||||
static double flonum_from_obj(obj o) {
|
||||
union iod u;
|
||||
assert(is_flonum_obj(o));
|
||||
u.i = ~o;
|
||||
return u.d;
|
||||
}
|
||||
static obj obj_from_flonum(int rc, double d) {
|
||||
union iod u;
|
||||
u.d = d;
|
||||
assert(is_flonum_obj(~u.i));
|
||||
return ~u.i;
|
||||
}
|
||||
#else /* FLONUMS_BOXED */
|
||||
extern cxtype_t *FLONUM_NTAG;
|
||||
typedef double flonum_t;
|
||||
#define is_flonum_obj(o) (isnative(o, FLONUM_NTAG))
|
||||
|
|
@ -215,6 +279,7 @@ typedef double flonum_t;
|
|||
#define void_from_flonum(l, f) (void)(f)
|
||||
#define obj_from_flonum(l, f) hpushptr(dupflonum(f), FLONUM_NTAG, l)
|
||||
extern flonum_t *dupflonum(flonum_t f);
|
||||
#endif
|
||||
/* characters */
|
||||
#define CHAR_ITAG 2
|
||||
typedef int char_t;
|
||||
|
|
@ -227,7 +292,7 @@ typedef int char_t;
|
|||
#define is_fixnum_char(i) ((void)(i), 0)
|
||||
#define is_char_flonum(i) ((void)(i), 0)
|
||||
#define is_flonum_char(i) ((void)(i), 0)
|
||||
#define char_from_obj(o) ((int)getimms(o, CHAR_ITAG))
|
||||
#define char_from_obj(o) ((int)getimmu(o, CHAR_ITAG))
|
||||
#define char_from_char(i) (i)
|
||||
#define bool_from_char(i) ((void)(i), 1)
|
||||
#define void_from_char(i) (void)(i)
|
||||
|
|
@ -246,12 +311,13 @@ extern cxtype_t *STRING_NTAG;
|
|||
extern char* stringref(obj o, int i);
|
||||
#endif
|
||||
extern int *newstring(char *s);
|
||||
extern int *newstringn(char *s, int n);
|
||||
extern int *allocstring(int n, int c);
|
||||
extern int *substring(int *d, int from, int to);
|
||||
extern int *stringcat(int *d0, int *d1);
|
||||
extern int *dupstring(int *d);
|
||||
extern void stringfill(int *d, int c);
|
||||
extern int strcmp_ci(char *s1, char*s2);
|
||||
extern int strcmp_ci(char *s1, char *s2);
|
||||
/* vectors */
|
||||
#define VECTOR_BTAG 1
|
||||
#define isvector(o) istagged(o, VECTOR_BTAG)
|
||||
|
|
@ -279,7 +345,8 @@ static int is_byte_obj(obj o) { return (obj_from_fixnum(0) <= o && o <= obj_from
|
|||
extern unsigned char* bytevectorref(obj o, int i);
|
||||
#endif
|
||||
extern int *newbytevector(unsigned char *s, int n);
|
||||
extern int *allocbytevector(int n, int c);
|
||||
extern int *makebytevector(int n, int c);
|
||||
extern int *allocbytevector(int n);
|
||||
extern int *dupbytevector(int *d);
|
||||
extern int bytevectoreq(int *d0, int *d1);
|
||||
extern int *subbytevector(int *d, int from, int to);
|
||||
|
|
@ -305,11 +372,10 @@ extern int islist(obj l);
|
|||
extern char *symbolname(int sym);
|
||||
extern int internsym(char *name);
|
||||
/* records */
|
||||
#define RECORD_BTAG 4
|
||||
#define isrecord(o) istagged(o, RECORD_BTAG)
|
||||
#define recordrtd(r) *taggedref(r, RECORD_BTAG, 0)
|
||||
#define recordref(r, i) *taggedref(r, RECORD_BTAG, (i)+1)
|
||||
#define recordlen(r) (taggedlen(r, RECORD_BTAG)-1)
|
||||
#define isrecord(o) istyped(o)
|
||||
#define recordrtd(r) *typedtype(r)
|
||||
#define recordlen(r) typedlen(r)
|
||||
#define recordref(r, i) *typedref(r, i)
|
||||
/* procedures */
|
||||
extern int isprocedure(obj o);
|
||||
extern int procedurelen(obj o);
|
||||
|
|
@ -318,8 +384,8 @@ extern obj* procedureref(obj o, int i);
|
|||
extern obj appcases[];
|
||||
/* eof */
|
||||
#define EOF_ITAG 7
|
||||
#define mkeof() mkimm(-1, EOF_ITAG)
|
||||
#define iseof(o) ((o) == mkimm(-1, EOF_ITAG))
|
||||
#define mkeof() mkimm(0, EOF_ITAG)
|
||||
#define iseof(o) ((o) == mkimm(0, EOF_ITAG))
|
||||
/* input ports */
|
||||
typedef struct { /* extends cxtype_t */
|
||||
const char *tname;
|
||||
|
|
|
|||
2
src/k.sf
2
src/k.sf
|
|
@ -457,6 +457,8 @@
|
|||
(cond
|
||||
[(null? tail)
|
||||
(list 'begin)]
|
||||
[(list1? tail) ; can't have defines there
|
||||
(xform #f (car tail) env)]
|
||||
[(not (list? tail))
|
||||
(x-error "improper body form" (cons 'body tail))]
|
||||
[else
|
||||
|
|
|
|||
|
|
@ -421,6 +421,8 @@
|
|||
(cond
|
||||
[(null? tail)
|
||||
(list 'begin)]
|
||||
[(list1? tail) ; can't have defines there
|
||||
(xform #f (car tail) env)]
|
||||
[(not (list? tail))
|
||||
(x-error "improper body form" (cons 'body tail))]
|
||||
[else
|
||||
|
|
|
|||
32
t.c
32
t.c
|
|
@ -250,22 +250,22 @@ char *t_code[] = {
|
|||
" form),@(y7:x-error)[22",
|
||||
|
||||
"P", "xform-body",
|
||||
"%2.0u?{'(y5:begin),l1]2}.0L0~?{.0,'(y4:body)c,'(s18:improper body form"
|
||||
"),@(y7:x-error)[22}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,.5a,.0a,."
|
||||
"1d,${.6,.4,t,@(y5:xform)[03},.0,'(y5:begin),.1v?{.2L0?{.5,.3L6,.(i10),"
|
||||
".(i10),.(i10),.(i10),:0^[(i11)5}.4,'(s19:improper begin form),@(y7:x-e"
|
||||
"rror)[(i11)2}'(y6:define),.1v?{${.4,@(y6:list2?)[01}?{.2au}{f}?{.2da,."
|
||||
"6,.(i11),fc,.(i11),.3c,.(i11),fc,.(i11),:0^[(i12)5}${.4,@(y6:list2?)[0"
|
||||
"1}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da,${${.5,@(y7:id->sym)[01},@(y6:ge"
|
||||
"nsym)[01},${.(i11),.3,.6,@(y7:add-var)[03},.9,.(i14),.3c,.(i14),.5c,.("
|
||||
"i14),.7c,.4,:0^[(i15)5}.4,'(s20:improper define form),@(y7:x-error)[(i"
|
||||
"11)2}'(y13:define-syntax),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)["
|
||||
"01}}{f}?{.2a,.3da,${.(i10),'(l1:y9:undefined;),.5,@(y11:add-binding)[0"
|
||||
"3},.8,.(i13),tc,.(i13),.4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:improper "
|
||||
"define-syntax form),@(y7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i1"
|
||||
"0),.(i10),.(i10),.(i10),:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11)A"
|
||||
"8,@(y12:xform-labels)[(i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)["
|
||||
"55}.!0.0^_1[25",
|
||||
"%2.0u?{'(y5:begin),l1]2}${.2,@(y6:list1?)[01}?{.1,.1a,f,@(y5:xform)[23"
|
||||
"}.0L0~?{.0,'(y4:body)c,'(s18:improper body form),@(y7:x-error)[22}.0,n"
|
||||
",n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,.5a,.0a,.1d,${.6,.4,t,@(y5:xform"
|
||||
")[03},.0,'(y5:begin),.1v?{.2L0?{.5,.3L6,.(i10),.(i10),.(i10),.(i10),:0"
|
||||
"^[(i11)5}.4,'(s19:improper begin form),@(y7:x-error)[(i11)2}'(y6:defin"
|
||||
"e),.1v?{${.4,@(y6:list2?)[01}?{.2au}{f}?{.2da,.6,.(i11),fc,.(i11),.3c,"
|
||||
".(i11),fc,.(i11),:0^[(i12)5}${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}"
|
||||
"}{f}?{.2a,.3da,${${.5,@(y7:id->sym)[01},@(y6:gensym)[01},${.(i11),.3,."
|
||||
"6,@(y7:add-var)[03},.9,.(i14),.3c,.(i14),.5c,.(i14),.7c,.4,:0^[(i15)5}"
|
||||
".4,'(s20:improper define form),@(y7:x-error)[(i11)2}'(y13:define-synta"
|
||||
"x),.1v?{${.4,@(y6:list2?)[01}?{${.4a,@(y3:id?)[01}}{f}?{.2a,.3da,${.(i"
|
||||
"10),'(l1:y9:undefined;),.5,@(y11:add-binding)[03},.8,.(i13),tc,.(i13),"
|
||||
".4c,.(i13),.6c,.4,:0^[(i14)5}.4,'(s27:improper define-syntax form),@(y"
|
||||
"7:x-error)[(i11)2}.1K0?{.5,${.9,.8,.6[02}c,.(i10),.(i10),.(i10),.(i10)"
|
||||
",:0^[(i11)5}.6,.(i11),.(i11)A8,.(i11)A8,.(i11)A8,@(y12:xform-labels)[("
|
||||
"i11)5}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)[55}.!0.0^_1[25",
|
||||
|
||||
"P", "xform-labels",
|
||||
"%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@(y5"
|
||||
|
|
|
|||
Loading…
Reference in a new issue