ref: f21c244d8c9be1d5e20c7be7fadf7169db82024a
parent: e9039ef075ee2d96fbd8dd6eae191448acf43751
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Apr 2 18:02:39 EDT 2023
reformat and move around
--- /dev/null
+++ b/3rd/lookup3.c
@@ -1,0 +1,412 @@
+/*
+-------------------------------------------------------------------------------
+lookup3.c, by Bob Jenkins, May 2006, Public Domain.
+
+These are functions for producing 32-bit hashes for hash table lookup.
+hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final()
+are externally useful functions. You can use this free for any purpose.
+It's in the public domain. It has no warranty.
+
+If you want to find a hash of, say, exactly 7 integers, do
+ a = i1; b = i2; c = i3;
+ mix(a,b,c);
+ a += i4; b += i5; c += i6;
+ mix(a,b,c);
+ a += i7;
+ final(a,b,c);
+then use c as the hash value. If you have a variable length array of
+4-byte integers to hash, use hashword(). If you have a byte array (like
+a character string), use hashlittle(). If you have several byte arrays, or
+a mix of things, see the comments above hashlittle().
+
+Why is this so big? I read 12 bytes at a time into 3 4-byte integers,
+then mix those integers. This is fast (you can do a lot more thorough
+mixing with 12*3 instructions on 3 integers than you can with 3 instructions
+on 1 byte), but shoehorning those bytes into integers efficiently is messy.
+-------------------------------------------------------------------------------
+*/
+
+/*
+ * My best guess at if you are big-endian or little-endian. This may
+ * need adjustment.
+ */
+#if defined(BYTE_ORDER) && defined(LITTLE_ENDIAN) && BYTE_ORDER == LITTLE_ENDIAN
+#define HASH_LITTLE_ENDIAN 1
+#define HASH_BIG_ENDIAN 0
+#elif defined(BYTE_ORDER) && defined(BIG_ENDIAN) && BYTE_ORDER == BIG_ENDIAN
+#define HASH_LITTLE_ENDIAN 0
+#define HASH_BIG_ENDIAN 1
+#else
+#error endianess unknown
+#endif
+
+#define hashsize(n) ((uint32_t)1<<(n))
+#define hashmask(n) (hashsize(n)-1)
+#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k))))
+
+/*
+-------------------------------------------------------------------------------
+mix -- mix 3 32-bit values reversibly.
+
+This is reversible, so any information in (a,b,c) before mix() is
+still in (a,b,c) after mix().
+
+If four pairs of (a,b,c) inputs are run through mix(), or through
+mix() in reverse, there are at least 32 bits of the output that
+are sometimes the same for one pair and different for another pair.
+This was tested for:
+* pairs that differed by one bit, by two bits, in any combination
+ of top bits of (a,b,c), or in any combination of bottom bits of
+ (a,b,c).
+* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed
+ the output delta to a Gray code (a^(a>>1)) so a string of 1's (as
+ is commonly produced by subtraction) look like a single 1-bit
+ difference.
+* the base values were pseudorandom, all zero but one bit set, or
+ all zero plus a counter that starts at zero.
+
+Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that
+satisfy this are
+ 4 6 8 16 19 4
+ 9 15 3 18 27 15
+ 14 9 3 7 17 3
+Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing
+for "differ" defined as + with a one-bit base and a two-bit delta. I
+used http://burtleburtle.net/bob/hash/avalanche.html to choose
+the operations, constants, and arrangements of the variables.
+
+This does not achieve avalanche. There are input bits of (a,b,c)
+that fail to affect some output bits of (a,b,c), especially of a. The
+most thoroughly mixed value is c, but it doesn't really even achieve
+avalanche in c.
+
+This allows some parallelism. Read-after-writes are good at doubling
+the number of bits affected, so the goal of mixing pulls in the opposite
+direction as the goal of parallelism. I did what I could. Rotates
+seem to cost as much as shifts on every machine I could lay my hands
+on, and rotates are much kinder to the top and bottom bits, so I used
+rotates.
+-------------------------------------------------------------------------------
+*/
+#define mix(a,b,c) \
+{ \+ a -= c; a ^= rot(c, 4); c += b; \
+ b -= a; b ^= rot(a, 6); a += c; \
+ c -= b; c ^= rot(b, 8); b += a; \
+ a -= c; a ^= rot(c,16); c += b; \
+ b -= a; b ^= rot(a,19); a += c; \
+ c -= b; c ^= rot(b, 4); b += a; \
+}
+
+/*
+-------------------------------------------------------------------------------
+final -- final mixing of 3 32-bit values (a,b,c) into c
+
+Pairs of (a,b,c) values differing in only a few bits will usually
+produce values of c that look totally different. This was tested for
+* pairs that differed by one bit, by two bits, in any combination
+ of top bits of (a,b,c), or in any combination of bottom bits of
+ (a,b,c).
+* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed
+ the output delta to a Gray code (a^(a>>1)) so a string of 1's (as
+ is commonly produced by subtraction) look like a single 1-bit
+ difference.
+* the base values were pseudorandom, all zero but one bit set, or
+ all zero plus a counter that starts at zero.
+
+These constants passed:
+ 14 11 25 16 4 14 24
+ 12 14 25 16 4 14 24
+and these came close:
+ 4 8 15 26 3 22 24
+ 10 8 15 26 3 22 24
+ 11 8 15 26 3 22 24
+-------------------------------------------------------------------------------
+*/
+#define final(a,b,c) \
+{ \+ c ^= b; c -= rot(b,14); \
+ a ^= c; a -= rot(c,11); \
+ b ^= a; b -= rot(a,25); \
+ c ^= b; c -= rot(b,16); \
+ a ^= c; a -= rot(c,4); \
+ b ^= a; b -= rot(a,14); \
+ c ^= b; c -= rot(b,24); \
+}
+
+/*
+--------------------------------------------------------------------
+ This works on all machines. To be useful, it requires
+ -- that the key be an array of uint32_t's, and
+ -- that the length be the number of uint32_t's in the key
+
+ The function hashword() is identical to hashlittle() on little-endian
+ machines, and identical to hashbig() on big-endian machines,
+ except that the length has to be measured in uint32_ts rather than in
+ bytes. hashlittle() is more complicated than hashword() only because
+ hashlittle() has to dance around fitting the key bytes into registers.
+--------------------------------------------------------------------
+*/
+uint32_t hashword(
+const uint32_t *k, /* the key, an array of uint32_t values */
+size_t length, /* the length of the key, in uint32_ts */
+uint32_t initval) /* the previous hash, or an arbitrary value */
+{+ uint32_t a,b,c;
+
+ /* Set up the internal state */
+ a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval;
+
+ /*------------------------------------------------- handle most of the key */
+ while (length > 3)
+ {+ a += k[0];
+ b += k[1];
+ c += k[2];
+ mix(a,b,c);
+ length -= 3;
+ k += 3;
+ }
+
+ /*------------------------------------------- handle the last 3 uint32_t's */
+ switch(length) /* all the case statements fall through */
+ {+ case 3 : c+=k[2]; // fallthrough
+ case 2 : b+=k[1]; // fallthrough
+ case 1 : a+=k[0]; // fallthrough
+ final(a,b,c);
+ case 0: /* case 0: nothing left to add */
+ break;
+ }
+ /*------------------------------------------------------ report the result */
+ return c;
+}
+
+/*
+--------------------------------------------------------------------
+hashword2() -- same as hashword(), but take two seeds and return two
+32-bit values. pc and pb must both be nonnull, and *pc and *pb must
+both be initialized with seeds. If you pass in (*pb)==0, the output
+(*pc) will be the same as the return value from hashword().
+--------------------------------------------------------------------
+*/
+void hashword2 (
+const uint32_t *k, /* the key, an array of uint32_t values */
+size_t length, /* the length of the key, in uint32_ts */
+uint32_t *pc, /* IN: seed OUT: primary hash value */
+uint32_t *pb) /* IN: more seed OUT: secondary hash value */
+{+ uint32_t a,b,c;
+
+ /* Set up the internal state */
+ a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc;
+ c += *pb;
+
+ /*------------------------------------------------- handle most of the key */
+ while (length > 3)
+ {+ a += k[0];
+ b += k[1];
+ c += k[2];
+ mix(a,b,c);
+ length -= 3;
+ k += 3;
+ }
+
+ /*------------------------------------------- handle the last 3 uint32_t's */
+ switch(length) /* all the case statements fall through */
+ {+ case 3 : c+=k[2]; // fallthrough
+ case 2 : b+=k[1]; // fallthrough
+ case 1 : a+=k[0]; // fallthrough
+ final(a,b,c);
+ case 0: /* case 0: nothing left to add */
+ break;
+ }
+ /*------------------------------------------------------ report the result */
+ *pc=c; *pb=b;
+}
+
+/*
+ * hashlittle2: return 2 32-bit hash values
+ *
+ * This is identical to hashlittle(), except it returns two 32-bit hash
+ * values instead of just one. This is good enough for hash table
+ * lookup with 2^^64 buckets, or if you want a second hash if you're not
+ * happy with the first, or if you want a probably-unique 64-bit ID for
+ * the key. *pc is better mixed than *pb, so use *pc first. If you want
+ * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)".
+ */
+void hashlittle2(
+ const void *key, /* the key to hash */
+ size_t length, /* length of the key */
+ uint32_t *pc, /* IN: primary initval, OUT: primary hash */
+ uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */
+{+ uint32_t a,b,c; /* internal state */
+ union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */+
+ /* Set up the internal state */
+ a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc;
+ c += *pb;
+
+ u.ptr = key;
+ if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {+ const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */
+ const uint8_t *k8;
+
+ /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
+ while (length > 12)
+ {+ a += k[0];
+ b += k[1];
+ c += k[2];
+ mix(a,b,c);
+ length -= 12;
+ k += 3;
+ }
+
+ /*----------------------------- handle the last (probably partial) block */
+ /*
+ * "k[2]&0xffffff" actually reads beyond the end of the string, but
+ * then masks off the part it's not allowed to read. Because the
+ * string is aligned, the masked-off tail is in the same word as the
+ * rest of the string. Every machine with memory protection I've seen
+ * does it on word boundaries, so is OK with this. But VALGRIND will
+ * still catch it and complain. The masking trick does make the hash
+ * noticably faster for short strings (like English words).
+ */
+#ifndef VALGRIND
+ (void)k8;
+ switch(length)
+ {+ case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;
+ case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break;
+ case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break;
+ case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break;
+ case 8 : b+=k[1]; a+=k[0]; break;
+ case 7 : b+=k[1]&0xffffff; a+=k[0]; break;
+ case 6 : b+=k[1]&0xffff; a+=k[0]; break;
+ case 5 : b+=k[1]&0xff; a+=k[0]; break;
+ case 4 : a+=k[0]; break;
+ case 3 : a+=k[0]&0xffffff; break;
+ case 2 : a+=k[0]&0xffff; break;
+ case 1 : a+=k[0]&0xff; break;
+ case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
+ }
+
+#else /* make valgrind happy */
+
+ k8 = (const uint8_t *)k;
+ switch(length)
+ {+ case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;
+ case 11: c+=((uint32_t)k8[10])<<16; /* fall through */
+ case 10: c+=((uint32_t)k8[9])<<8; /* fall through */
+ case 9 : c+=k8[8]; /* fall through */
+ case 8 : b+=k[1]; a+=k[0]; break;
+ case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */
+ case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */
+ case 5 : b+=k8[4]; /* fall through */
+ case 4 : a+=k[0]; break;
+ case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */
+ case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */
+ case 1 : a+=k8[0]; break;
+ case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
+ }
+
+#endif /* !valgrind */
+
+ } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) {+ const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */
+ const uint8_t *k8;
+
+ /*--------------- all but last block: aligned reads and different mixing */
+ while (length > 12)
+ {+ a += k[0] + (((uint32_t)k[1])<<16);
+ b += k[2] + (((uint32_t)k[3])<<16);
+ c += k[4] + (((uint32_t)k[5])<<16);
+ mix(a,b,c);
+ length -= 12;
+ k += 6;
+ }
+
+ /*----------------------------- handle the last (probably partial) block */
+ k8 = (const uint8_t *)k;
+ switch(length)
+ {+ case 12: c+=k[4]+(((uint32_t)k[5])<<16);
+ b+=k[2]+(((uint32_t)k[3])<<16);
+ a+=k[0]+(((uint32_t)k[1])<<16);
+ break;
+ case 11: c+=((uint32_t)k8[10])<<16; /* fall through */
+ case 10: c+=k[4];
+ b+=k[2]+(((uint32_t)k[3])<<16);
+ a+=k[0]+(((uint32_t)k[1])<<16);
+ break;
+ case 9 : c+=k8[8]; /* fall through */
+ case 8 : b+=k[2]+(((uint32_t)k[3])<<16);
+ a+=k[0]+(((uint32_t)k[1])<<16);
+ break;
+ case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */
+ case 6 : b+=k[2];
+ a+=k[0]+(((uint32_t)k[1])<<16);
+ break;
+ case 5 : b+=k8[4]; /* fall through */
+ case 4 : a+=k[0]+(((uint32_t)k[1])<<16);
+ break;
+ case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */
+ case 2 : a+=k[0];
+ break;
+ case 1 : a+=k8[0];
+ break;
+ case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
+ }
+
+ } else { /* need to read the key one byte at a time */+ const uint8_t *k = (const uint8_t *)key;
+
+ /*--------------- all but the last block: affect some 32 bits of (a,b,c) */
+ while (length > 12)
+ {+ a += k[0];
+ a += ((uint32_t)k[1])<<8;
+ a += ((uint32_t)k[2])<<16;
+ a += ((uint32_t)k[3])<<24;
+ b += k[4];
+ b += ((uint32_t)k[5])<<8;
+ b += ((uint32_t)k[6])<<16;
+ b += ((uint32_t)k[7])<<24;
+ c += k[8];
+ c += ((uint32_t)k[9])<<8;
+ c += ((uint32_t)k[10])<<16;
+ c += ((uint32_t)k[11])<<24;
+ mix(a,b,c);
+ length -= 12;
+ k += 12;
+ }
+
+ /*-------------------------------- last block: affect all 32 bits of (c) */
+ switch(length) /* all the case statements fall through */
+ {+ case 12: c+=((uint32_t)k[11])<<24; // fallthrough
+ case 11: c+=((uint32_t)k[10])<<16; // fallthrough
+ case 10: c+=((uint32_t)k[9])<<8; // fallthrough
+ case 9 : c+=k[8]; // fallthrough
+ case 8 : b+=((uint32_t)k[7])<<24; // fallthrough
+ case 7 : b+=((uint32_t)k[6])<<16; // fallthrough
+ case 6 : b+=((uint32_t)k[5])<<8; // fallthrough
+ case 5 : b+=k[4]; // fallthrough
+ case 4 : a+=((uint32_t)k[3])<<24; // fallthrough
+ case 3 : a+=((uint32_t)k[2])<<16; // fallthrough
+ case 2 : a+=((uint32_t)k[1])<<8; // fallthrough
+ case 1 : a+=k[0];
+ break;
+ case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
+ }
+ }
+
+ final(a,b,c);
+ *pc=c; *pb=b;
+}
--- /dev/null
+++ b/3rd/mp/mpadd.c
@@ -1,0 +1,56 @@
+#include "platform.h"
+
+// sum = abs(b1) + abs(b2), i.e., add the magnitudes
+void
+mpmagadd(mpint *b1, mpint *b2, mpint *sum)
+{+ int m, n;
+ mpint *t;
+
+ sum->flags |= (b1->flags | b2->flags) & MPtimesafe;
+
+ // get the sizes right
+ if(b2->top > b1->top){+ t = b1;
+ b1 = b2;
+ b2 = t;
+ }
+ n = b1->top;
+ m = b2->top;
+ if(n == 0){+ mpassign(mpzero, sum);
+ return;
+ }
+ if(m == 0){+ mpassign(b1, sum);
+ sum->sign = 1;
+ return;
+ }
+ mpbits(sum, (n+1)*Dbits);
+ sum->top = n+1;
+
+ mpvecadd(b1->p, n, b2->p, m, sum->p);
+ sum->sign = 1;
+
+ mpnorm(sum);
+}
+
+// sum = b1 + b2
+void
+mpadd(mpint *b1, mpint *b2, mpint *sum)
+{+ int sign;
+
+ if(b1->sign != b2->sign){+ assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
+ if(b1->sign < 0)
+ mpmagsub(b2, b1, sum);
+ else
+ mpmagsub(b1, b2, sum);
+ } else {+ sign = b1->sign;
+ mpmagadd(b1, b2, sum);
+ if(sum->top != 0)
+ sum->sign = sign;
+ }
+}
--- /dev/null
+++ b/3rd/mp/mpaux.c
@@ -1,0 +1,201 @@
+#include "platform.h"
+
+static mpdigit _mptwodata[1] = { 2 };+static mpint _mptwo =
+{+ 1, 1, 1,
+ _mptwodata,
+ MPstatic|MPnorm
+};
+mpint *mptwo = &_mptwo;
+
+static mpdigit _mponedata[1] = { 1 };+static mpint _mpone =
+{+ 1, 1, 1,
+ _mponedata,
+ MPstatic|MPnorm
+};
+mpint *mpone = &_mpone;
+
+static mpdigit _mpzerodata[1] = { 0 };+static mpint _mpzero =
+{+ 1, 1, 0,
+ _mpzerodata,
+ MPstatic|MPnorm
+};
+mpint *mpzero = &_mpzero;
+
+static int mpmindigits = 33;
+
+// set minimum digit allocation
+void
+mpsetminbits(int n)
+{+ if(n < 0)
+ sysfatal("mpsetminbits: n < 0");+ if(n == 0)
+ n = 1;
+ mpmindigits = DIGITS(n);
+}
+
+// allocate an n bit 0'd number
+mpint*
+mpnew(int n)
+{+ mpint *b;
+
+ if(n < 0)
+ sysfatal("mpsetminbits: n < 0");+
+ n = DIGITS(n);
+ if(n < mpmindigits)
+ n = mpmindigits;
+ b = calloc(1, sizeof(mpint) + n*Dbytes);
+ if(b == nil)
+ sysfatal("mpnew: %r");+ b->p = (mpdigit*)&b[1];
+ b->size = n;
+ b->sign = 1;
+ b->flags = MPnorm;
+
+ return b;
+}
+
+// guarantee at least n significant bits
+void
+mpbits(mpint *b, int m)
+{+ int n;
+
+ n = DIGITS(m);
+ if(b->size >= n){+ if(b->top >= n)
+ return;
+ } else {+ if(b->p == (mpdigit*)&b[1]){+ b->p = (mpdigit*)malloc(n*Dbytes);
+ if(b->p == nil)
+ sysfatal("mpbits: %r");+ memmove(b->p, &b[1], Dbytes*b->top);
+ memset(&b[1], 0, Dbytes*b->size);
+ } else {+ b->p = (mpdigit*)realloc(b->p, n*Dbytes);
+ if(b->p == nil)
+ sysfatal("mpbits: %r");+ }
+ b->size = n;
+ }
+ memset(&b->p[b->top], 0, Dbytes*(n - b->top));
+ b->top = n;
+ b->flags &= ~MPnorm;
+}
+
+void
+mpfree(mpint *b)
+{+ if(b == nil)
+ return;
+ if(b->flags & MPstatic)
+ sysfatal("freeing mp constant");+ memset(b->p, 0, b->size*Dbytes);
+ if(b->p != (mpdigit*)&b[1])
+ free(b->p);
+ free(b);
+}
+
+mpint*
+mpnorm(mpint *b)
+{+ int i;
+
+ if(b->flags & MPtimesafe){+ assert(b->sign == 1);
+ b->flags &= ~MPnorm;
+ return b;
+ }
+ for(i = b->top-1; i >= 0; i--)
+ if(b->p[i] != 0)
+ break;
+ b->top = i+1;
+ if(b->top == 0)
+ b->sign = 1;
+ b->flags |= MPnorm;
+ return b;
+}
+
+mpint*
+mpcopy(mpint *old)
+{+ mpint *new;
+
+ new = mpnew(Dbits*old->size);
+ new->sign = old->sign;
+ new->top = old->top;
+ new->flags = old->flags & ~(MPstatic|MPfield);
+ memmove(new->p, old->p, Dbytes*old->top);
+ return new;
+}
+
+void
+mpassign(mpint *old, mpint *new)
+{+ if(new == nil || old == new)
+ return;
+ new->top = 0;
+ mpbits(new, Dbits*old->top);
+ new->sign = old->sign;
+ new->top = old->top;
+ new->flags &= ~MPnorm;
+ new->flags |= old->flags & ~(MPstatic|MPfield);
+ memmove(new->p, old->p, Dbytes*old->top);
+}
+
+// number of significant bits in mantissa
+int
+mpsignif(mpint *n)
+{+ int i, j;
+ mpdigit d;
+
+ if(n->top == 0)
+ return 0;
+ for(i = n->top-1; i >= 0; i--){+ d = n->p[i];
+ for(j = Dbits-1; j >= 0; j--){+ if(d & (((mpdigit)1)<<j))
+ return i*Dbits + j + 1;
+ }
+ }
+ return 0;
+}
+
+// k, where n = 2**k * q for odd q
+int
+mplowbits0(mpint *n)
+{+ int k, bit, digit;
+ mpdigit d;
+
+ assert(n->flags & MPnorm);
+ if(n->top==0)
+ return 0;
+ k = 0;
+ bit = 0;
+ digit = 0;
+ d = n->p[0];
+ for(;;){+ if(d & (1<<bit))
+ break;
+ k++;
+ bit++;
+ if(bit==Dbits){+ if(++digit >= n->top)
+ return 0;
+ d = n->p[digit];
+ bit = 0;
+ }
+ }
+ return k;
+}
--- /dev/null
+++ b/3rd/mp/mpcmp.c
@@ -1,0 +1,28 @@
+#include "platform.h"
+
+// return neg, 0, pos as abs(b1)-abs(b2) is neg, 0, pos
+int
+mpmagcmp(mpint *b1, mpint *b2)
+{+ int i;
+
+ i = b1->flags | b2->flags;
+ if(i & MPtimesafe)
+ return mpvectscmp(b1->p, b1->top, b2->p, b2->top);
+ if(i & MPnorm){+ i = b1->top - b2->top;
+ if(i)
+ return i;
+ }
+ return mpveccmp(b1->p, b1->top, b2->p, b2->top);
+}
+
+// return neg, 0, pos as b1-b2 is neg, 0, pos
+int
+mpcmp(mpint *b1, mpint *b2)
+{+ int sign;
+
+ sign = (b1->sign - b2->sign) >> 1; // -1, 0, 1
+ return sign | (sign&1)-1 & mpmagcmp(b1, b2)*b1->sign;
+}
--- /dev/null
+++ b/3rd/mp/mpdigdiv.c
@@ -1,0 +1,54 @@
+#include "platform.h"
+
+//
+// divide two digits by one and return quotient
+//
+void
+mpdigdiv(mpdigit *dividend, mpdigit divisor, mpdigit *quotient)
+{+ mpdigit hi, lo, q, x, y;
+ int i;
+
+ hi = dividend[1];
+ lo = dividend[0];
+
+ // return highest digit value if the result >= 2**32
+ if(hi >= divisor || divisor == 0){+ divisor = 0;
+ *quotient = ~divisor;
+ return;
+ }
+
+ // very common case
+ if(~divisor == 0){+ lo += hi;
+ if(lo < hi){+ hi++;
+ lo++;
+ }
+ if(lo+1 == 0)
+ hi++;
+ *quotient = hi;
+ return;
+ }
+
+ // at this point we know that hi < divisor
+ // just shift and subtract till we're done
+ q = 0;
+ x = divisor;
+ for(i = Dbits-1; hi > 0 && i >= 0; i--){+ x >>= 1;
+ if(x > hi)
+ continue;
+ y = divisor<<i;
+ if(x == hi && y > lo)
+ continue;
+ if(y > lo)
+ hi--;
+ lo -= y;
+ hi -= x;
+ q |= 1U<<i;
+ }
+ q += lo/divisor;
+ *quotient = q;
+}
--- /dev/null
+++ b/3rd/mp/mpdiv.c
@@ -1,0 +1,140 @@
+#include "platform.h"
+
+// division ala knuth, seminumerical algorithms, pp 237-238
+// the numbers are stored backwards to what knuth expects so j
+// counts down rather than up.
+
+void
+mpdiv(mpint *dividend, mpint *divisor, mpint *quotient, mpint *remainder)
+{+ int j, s, vn, sign, qsign, rsign;
+ mpdigit qd, *up, *vp, *qp;
+ mpint *u, *v, *t;
+
+ assert(quotient != remainder);
+ assert(divisor->flags & MPnorm);
+
+ // divide bv zero
+ if(divisor->top == 0)
+ abort();
+
+ // division by one or small powers of two
+ if(divisor->top == 1 && (divisor->p[0] & divisor->p[0]-1) == 0){+ vlong r = 0;
+ if(dividend->top > 0)
+ r = (vlong)dividend->sign * (dividend->p[0] & divisor->p[0]-1);
+ if(quotient != nil){+ sign = divisor->sign;
+ for(s = 0; ((divisor->p[0] >> s) & 1) == 0; s++)
+ ;
+ mpright(dividend, s, quotient);
+ if(sign < 0)
+ quotient->sign ^= (-mpmagcmp(quotient, mpzero) >> 31) << 1;
+ }
+ if(remainder != nil){+ remainder->flags |= dividend->flags & MPtimesafe;
+ vtomp(r, remainder);
+ }
+ return;
+ }
+ assert((dividend->flags & MPtimesafe) == 0);
+
+ // quick check
+ if(mpmagcmp(dividend, divisor) < 0){+ if(remainder != nil)
+ mpassign(dividend, remainder);
+ if(quotient != nil)
+ mpassign(mpzero, quotient);
+ return;
+ }
+
+ qsign = divisor->sign * dividend->sign;
+ rsign = dividend->sign;
+
+ // D1: shift until divisor, v, has hi bit set (needed to make trial
+ // divisor accurate)
+ qd = divisor->p[divisor->top-1];
+ for(s = 0; (qd & mpdighi) == 0; s++)
+ qd <<= 1;
+ u = mpnew((dividend->top+2)*Dbits + s);
+ if(s == 0 && divisor != quotient && divisor != remainder) {+ mpassign(dividend, u);
+ v = divisor;
+ } else {+ mpleft(dividend, s, u);
+ v = mpnew(divisor->top*Dbits);
+ mpleft(divisor, s, v);
+ }
+ up = u->p+u->top-1;
+ vp = v->p+v->top-1;
+ vn = v->top;
+
+ // D1a: make sure high digit of dividend is less than high digit of divisor
+ if(*up >= *vp){+ *++up = 0;
+ u->top++;
+ }
+
+ // storage for multiplies
+ t = mpnew(4*Dbits);
+
+ qp = nil;
+ if(quotient != nil){+ mpbits(quotient, (u->top - v->top)*Dbits);
+ quotient->top = u->top - v->top;
+ qp = quotient->p+quotient->top-1;
+ }
+
+ // D2, D7: loop on length of dividend
+ for(j = u->top; j > vn; j--){+
+ // D3: calculate trial divisor
+ mpdigdiv(up-1, *vp, &qd);
+
+ // D3a: rule out trial divisors 2 greater than real divisor
+ if(vn > 1) for(;;){+ memset(t->p, 0, 3*Dbytes); // mpvecdigmuladd adds to what's there
+ mpvecdigmuladd(vp-1, 2, qd, t->p);
+ if(mpveccmp(t->p, 3, up-2, 3) > 0)
+ qd--;
+ else
+ break;
+ }
+
+ // D4: u -= v*qd << j*Dbits
+ sign = mpvecdigmulsub(v->p, vn, qd, up-vn);
+ if(sign < 0){+
+ // D6: trial divisor was too high, add back borrowed
+ // value and decrease divisor
+ mpvecadd(up-vn, vn+1, v->p, vn, up-vn);
+ qd--;
+ }
+
+ // D5: save quotient digit
+ if(qp != nil)
+ *qp-- = qd;
+
+ // push top of u down one
+ u->top--;
+ *up-- = 0;
+ }
+ if(qp != nil){+ assert((quotient->flags & MPtimesafe) == 0);
+ mpnorm(quotient);
+ if(quotient->top != 0)
+ quotient->sign = qsign;
+ }
+
+ if(remainder != nil){+ assert((remainder->flags & MPtimesafe) == 0);
+ mpright(u, s, remainder); // u is the remainder shifted
+ if(remainder->top != 0)
+ remainder->sign = rsign;
+ }
+
+ mpfree(t);
+ mpfree(u);
+ if(v != divisor)
+ mpfree(v);
+}
--- /dev/null
+++ b/3rd/mp/mpfmt.c
@@ -1,0 +1,207 @@
+#include "platform.h"
+
+static int
+toencx(mpint *b, char *buf, int len, int (*enc)(char*, int, uchar*, int))
+{+ uchar *p;
+ int n, rv;
+
+ p = nil;
+ n = mptobe(b, nil, 0, &p);
+ if(n < 0)
+ return -1;
+ rv = (*enc)(buf, len, p, n);
+ free(p);
+ return rv;
+}
+
+static int
+topow2(mpint *b, char *buf, int len, int s)
+{+ mpdigit *p, x;
+ int i, j, sn;
+ char *out, *eout;
+
+ if(len < 1)
+ return -1;
+
+ sn = 1<<s;
+ out = buf;
+ eout = buf+len;
+ for(p = &b->p[b->top-1]; p >= b->p; p--){+ x = *p;
+ for(i = Dbits-s; i >= 0; i -= s){+ j = x >> i & sn - 1;
+ if(j != 0 || out != buf){+ if(out >= eout)
+ return -1;
+ *out++ = enc16chr(j);
+ }
+ }
+ }
+ if(out == buf)
+ *out++ = '0';
+ if(out >= eout)
+ return -1;
+ *out = 0;
+ return 0;
+}
+
+static char*
+modbillion(int rem, ulong r, char *out, char *buf)
+{+ ulong rr;
+ int i;
+
+ for(i = 0; i < 9; i++){+ rr = r%10;
+ r /= 10;
+ if(out <= buf)
+ return nil;
+ *--out = '0' + rr;
+ if(rem == 0 && r == 0)
+ break;
+ }
+ return out;
+}
+
+static int
+to10(mpint *b, char *buf, int len)
+{+ mpint *d, *r, *billion;
+ char *out;
+
+ if(len < 1)
+ return -1;
+
+ d = mpcopy(b);
+ d->flags &= ~MPtimesafe;
+ mpnorm(d);
+ r = mpnew(0);
+ billion = uitomp(1000000000, nil);
+ out = buf+len;
+ *--out = 0;
+ do {+ mpdiv(d, billion, d, r);
+ out = modbillion(d->top, r->p[0], out, buf);
+ if(out == nil)
+ break;
+ } while(d->top != 0);
+ mpfree(d);
+ mpfree(r);
+ mpfree(billion);
+
+ if(out == nil)
+ return -1;
+ len -= out-buf;
+ if(out != buf)
+ memmove(buf, out, len);
+ return 0;
+}
+
+static int
+to8(mpint *b, char *buf, int len)
+{+ mpdigit x, y;
+ char *out;
+ int i, j;
+
+ if(len < 2)
+ return -1;
+
+ out = buf+len;
+ *--out = 0;
+
+ i = j = 0;
+ x = y = 0;
+ while(j < b->top){+ y = b->p[j++];
+ if(i > 0)
+ x |= y << i;
+ else
+ x = y;
+ i += Dbits;
+ while(i >= 3){+Digout: i -= 3;
+ if(out > buf)
+ out--;
+ else if(x != 0)
+ return -1;
+ *out = '0' + (x & 7);
+ x = y >> (Dbits-i);
+ }
+ }
+ if(i > 0)
+ goto Digout;
+
+ while(*out == '0') out++;
+ if(*out == '\0')
+ *--out = '0';
+
+ len -= out-buf;
+ if(out != buf)
+ memmove(buf, out, len);
+ return 0;
+}
+
+char*
+mptoa(mpint *b, int base, char *buf, int len)
+{+ char *out;
+ int rv, alloced;
+
+ if(base == 0)
+ base = 16; /* default */
+ alloced = 0;
+ if(buf == nil){+ /* rv <= log₂(base) */
+ for(rv=1; (base >> rv) > 1; rv++)
+ ;
+ len = 10 + (b->top*Dbits / rv);
+ buf = malloc(len);
+ if(buf == nil)
+ return nil;
+ alloced = 1;
+ }
+
+ if(len < 2)
+ return nil;
+
+ out = buf;
+ if(b->sign < 0){+ *out++ = '-';
+ len--;
+ }
+ switch(base){+ case 64:
+ rv = toencx(b, out, len, enc64);
+ break;
+ case 32:
+ rv = toencx(b, out, len, enc32);
+ break;
+ case 16:
+ rv = topow2(b, out, len, 4);
+ break;
+ case 10:
+ rv = to10(b, out, len);
+ break;
+ case 8:
+ rv = to8(b, out, len);
+ break;
+ case 4:
+ rv = topow2(b, out, len, 2);
+ break;
+ case 2:
+ rv = topow2(b, out, len, 1);
+ break;
+ default:
+ abort();
+ return nil;
+ }
+ if(rv < 0){+ if(alloced)
+ free(buf);
+ return nil;
+ }
+ return buf;
+}
--- /dev/null
+++ b/3rd/mp/mpleft.c
@@ -1,0 +1,49 @@
+#include "platform.h"
+
+// res = b << shift
+void
+mpleft(mpint *b, int shift, mpint *res)
+{+ int d, l, r, i, otop;
+ mpdigit this, last;
+
+ res->sign = b->sign;
+ if(b->top==0){+ res->top = 0;
+ return;
+ }
+
+ // a zero or negative left shift is a right shift
+ if(shift <= 0){+ mpright(b, -shift, res);
+ return;
+ }
+
+ // b and res may be the same so remember the old top
+ otop = b->top;
+
+ // shift
+ mpbits(res, otop*Dbits + shift); // overkill
+ res->top = DIGITS(otop*Dbits + shift);
+ d = shift/Dbits;
+ l = shift - d*Dbits;
+ r = Dbits - l;
+
+ if(l == 0){+ for(i = otop-1; i >= 0; i--)
+ res->p[i+d] = b->p[i];
+ } else {+ last = 0;
+ for(i = otop-1; i >= 0; i--) {+ this = b->p[i];
+ res->p[i+d+1] = (last<<l) | (this>>r);
+ last = this;
+ }
+ res->p[d] = last<<l;
+ }
+ for(i = 0; i < d; i++)
+ res->p[i] = 0;
+
+ res->flags |= b->flags & MPtimesafe;
+ mpnorm(res);
+}
--- /dev/null
+++ b/3rd/mp/mplogic.c
@@ -1,0 +1,210 @@
+#include "platform.h"
+
+/*
+ mplogic calculates b1|b2 subject to the
+ following flag bits (fl)
+
+ bit 0: subtract 1 from b1
+ bit 1: invert b1
+ bit 2: subtract 1 from b2
+ bit 3: invert b2
+ bit 4: add 1 to output
+ bit 5: invert output
+
+ it inverts appropriate bits automatically
+ depending on the signs of the inputs
+*/
+
+static void
+mplogic(mpint *b1, mpint *b2, mpint *sum, int fl)
+{+ mpint *t;
+ mpdigit *dp1, *dp2, *dpo, d1, d2, d;
+ int c1, c2, co;
+ int i;
+
+ assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
+ if(b1->sign < 0) fl ^= 0x03;
+ if(b2->sign < 0) fl ^= 0x0c;
+ sum->sign = (int)(((fl|fl>>2)^fl>>4)<<30)>>31|1;
+ if(sum->sign < 0) fl ^= 0x30;
+ if(b2->top > b1->top){+ t = b1;
+ b1 = b2;
+ b2 = t;
+ fl = fl >> 2 & 0x03 | fl << 2 & 0x0c | fl & 0x30;
+ }
+ mpbits(sum, b1->top*Dbits+1);
+ dp1 = b1->p;
+ dp2 = b2->p;
+ dpo = sum->p;
+ c1 = fl & 1;
+ c2 = fl >> 2 & 1;
+ co = fl >> 4 & 1;
+ for(i = 0; i < b1->top; i++){+ d1 = dp1[i] - c1;
+ if(i < b2->top)
+ d2 = dp2[i] - c2;
+ else
+ d2 = 0;
+ if(d1 != (mpdigit)-1) c1 = 0;
+ if(d2 != (mpdigit)-1) c2 = 0;
+ if((fl & 2) != 0) d1 ^= -1;
+ if((fl & 8) != 0) d2 ^= -1;
+ d = d1 | d2;
+ if((fl & 32) != 0) d ^= -1;
+ d += co;
+ if(d != 0) co = 0;
+ dpo[i] = d;
+ }
+ sum->top = i;
+ if(co)
+ dpo[sum->top++] = co;
+ mpnorm(sum);
+}
+
+void
+mpor(mpint *b1, mpint *b2, mpint *sum)
+{+ mplogic(b1, b2, sum, 0);
+}
+
+void
+mpand(mpint *b1, mpint *b2, mpint *sum)
+{+ mplogic(b1, b2, sum, 0x2a);
+}
+
+void
+mpbic(mpint *b1, mpint *b2, mpint *sum)
+{+ mplogic(b1, b2, sum, 0x22);
+}
+
+void
+mpnot(mpint *b, mpint *r)
+{+ mpadd(b, mpone, r);
+ if(r->top != 0)
+ r->sign ^= -2;
+}
+
+void
+mpxor(mpint *b1, mpint *b2, mpint *sum)
+{+ mpint *t;
+ mpdigit *dp1, *dp2, *dpo, d1, d2, d;
+ int c1, c2, co;
+ int i, fl;
+
+ assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
+ if(b2->top > b1->top){+ t = b1;
+ b1 = b2;
+ b2 = t;
+ }
+ fl = (b1->sign & 10) ^ (b2->sign & 12);
+ sum->sign = (int)(fl << 28) >> 31 | 1;
+ mpbits(sum, b1->top*Dbits+1);
+ dp1 = b1->p;
+ dp2 = b2->p;
+ dpo = sum->p;
+ c1 = fl >> 1 & 1;
+ c2 = fl >> 2 & 1;
+ co = fl >> 3 & 1;
+ for(i = 0; i < b1->top; i++){+ d1 = dp1[i] - c1;
+ if(i < b2->top)
+ d2 = dp2[i] - c2;
+ else
+ d2 = 0;
+ if(d1 != (mpdigit)-1) c1 = 0;
+ if(d2 != (mpdigit)-1) c2 = 0;
+ d = d1 ^ d2;
+ d += co;
+ if(d != 0) co = 0;
+ dpo[i] = d;
+ }
+ sum->top = i;
+ if(co)
+ dpo[sum->top++] = co;
+ mpnorm(sum);
+}
+
+void
+mptrunc(mpint *b, int n, mpint *r)
+{+ int d, m, i, c;
+
+ assert(((b->flags | r->flags) & MPtimesafe) == 0);
+ mpbits(r, n);
+ r->top = DIGITS(n);
+ d = n / Dbits;
+ m = n % Dbits;
+ if(b->sign == -1){+ c = 1;
+ for(i = 0; i < r->top; i++){+ if(i < b->top)
+ r->p[i] = ~(b->p[i] - c);
+ else
+ r->p[i] = -1;
+ if(r->p[i] != 0)
+ c = 0;
+ }
+ if(m != 0)
+ r->p[d] &= (1<<m) - 1;
+ }else if(b->sign == 1){+ if(d >= b->top){+ mpassign(b, r);
+ mpnorm(r);
+ return;
+ }
+ if(b != r)
+ for(i = 0; i < d; i++)
+ r->p[i] = b->p[i];
+ if(m != 0)
+ r->p[d] = b->p[d] & (1<<m)-1;
+ }
+ r->sign = 1;
+ mpnorm(r);
+}
+
+void
+mpxtend(mpint *b, int n, mpint *r)
+{+ int d, m, c, i;
+
+ d = (n - 1) / Dbits;
+ m = (n - 1) % Dbits;
+ if(d >= b->top){+ mpassign(b, r);
+ return;
+ }
+ mptrunc(b, n, r);
+ mpbits(r, n);
+ if((r->p[d] & 1<<m) == 0){+ mpnorm(r);
+ return;
+ }
+ r->p[d] |= -(1<<m);
+ r->sign = -1;
+ c = 1;
+ for(i = 0; i < r->top; i++){+ r->p[i] = ~(r->p[i] - c);
+ if(r->p[i] != 0)
+ c = 0;
+ }
+ mpnorm(r);
+}
+
+void
+mpasr(mpint *b, int n, mpint *r)
+{+ if(b->sign > 0 || n <= 0){+ mpright(b, n, r);
+ return;
+ }
+ mpadd(b, mpone, r);
+ mpright(r, n, r);
+ mpsub(r, mpone, r);
+}
--- /dev/null
+++ b/3rd/mp/mpmul.c
@@ -1,0 +1,174 @@
+#include "platform.h"
+
+//
+// from knuth's 1969 seminumberical algorithms, pp 233-235 and pp 258-260
+//
+// mpvecmul is an assembly language routine that performs the inner
+// loop.
+//
+// the karatsuba trade off is set empiricly by measuring the algs on
+// a 400 MHz Pentium II.
+//
+
+// karatsuba like (see knuth pg 258)
+// prereq: p is already zeroed
+static void
+mpkaratsuba(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
+{+ mpdigit *t, *u0, *u1, *v0, *v1, *u0v0, *u1v1, *res, *diffprod;
+ int u0len, u1len, v0len, v1len, reslen;
+ int sign, n;
+
+ // divide each piece in half
+ n = alen/2;
+ if(alen&1)
+ n++;
+ u0len = n;
+ u1len = alen-n;
+ if(blen > n){+ v0len = n;
+ v1len = blen-n;
+ } else {+ v0len = blen;
+ v1len = 0;
+ }
+ u0 = a;
+ u1 = a + u0len;
+ v0 = b;
+ v1 = b + v0len;
+
+ // room for the partial products
+ t = calloc(1, Dbytes*5*(2*n+1));
+ if(t == nil)
+ sysfatal("mpkaratsuba: %r");+ u0v0 = t;
+ u1v1 = t + (2*n+1);
+ diffprod = t + 2*(2*n+1);
+ res = t + 3*(2*n+1);
+ reslen = 4*n+1;
+
+ // t[0] = (u1-u0)
+ sign = 1;
+ if(mpveccmp(u1, u1len, u0, u0len) < 0){+ sign = -1;
+ mpvecsub(u0, u0len, u1, u1len, u0v0);
+ } else
+ mpvecsub(u1, u1len, u0, u1len, u0v0);
+
+ // t[1] = (v0-v1)
+ if(mpveccmp(v0, v0len, v1, v1len) < 0){+ sign *= -1;
+ mpvecsub(v1, v1len, v0, v1len, u1v1);
+ } else
+ mpvecsub(v0, v0len, v1, v1len, u1v1);
+
+ // t[4:5] = (u1-u0)*(v0-v1)
+ mpvecmul(u0v0, u0len, u1v1, v0len, diffprod);
+
+ // t[0:1] = u1*v1
+ memset(t, 0, 2*(2*n+1)*Dbytes);
+ if(v1len > 0)
+ mpvecmul(u1, u1len, v1, v1len, u1v1);
+
+ // t[2:3] = u0v0
+ mpvecmul(u0, u0len, v0, v0len, u0v0);
+
+ // res = u0*v0<<n + u0*v0
+ mpvecadd(res, reslen, u0v0, u0len+v0len, res);
+ mpvecadd(res+n, reslen-n, u0v0, u0len+v0len, res+n);
+
+ // res += u1*v1<<n + u1*v1<<2*n
+ if(v1len > 0){+ mpvecadd(res+n, reslen-n, u1v1, u1len+v1len, res+n);
+ mpvecadd(res+2*n, reslen-2*n, u1v1, u1len+v1len, res+2*n);
+ }
+
+ // res += (u1-u0)*(v0-v1)<<n
+ if(sign < 0)
+ mpvecsub(res+n, reslen-n, diffprod, u0len+v0len, res+n);
+ else
+ mpvecadd(res+n, reslen-n, diffprod, u0len+v0len, res+n);
+ memmove(p, res, (alen+blen)*Dbytes);
+
+ free(t);
+}
+
+#define KARATSUBAMIN 32
+
+void
+mpvecmul(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
+{+ int i;
+ mpdigit d;
+ mpdigit *t;
+
+ // both mpvecdigmuladd and karatsuba are fastest when a is the longer vector
+ if(alen < blen){+ i = alen;
+ alen = blen;
+ blen = i;
+ t = a;
+ a = b;
+ b = t;
+ }
+
+ if(alen >= KARATSUBAMIN && blen > 1){+ // O(n^1.585)
+ mpkaratsuba(a, alen, b, blen, p);
+ } else {+ // O(n^2)
+ for(i = 0; i < blen; i++){+ d = b[i];
+ if(d != 0)
+ mpvecdigmuladd(a, alen, d, &p[i]);
+ }
+ }
+}
+
+void
+mpvectsmul(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
+{+ int i;
+ mpdigit *t;
+
+ if(alen < blen){+ i = alen;
+ alen = blen;
+ blen = i;
+ t = a;
+ a = b;
+ b = t;
+ }
+ if(blen == 0)
+ return;
+ for(i = 0; i < blen; i++)
+ mpvecdigmuladd(a, alen, b[i], &p[i]);
+}
+
+void
+mpmul(mpint *b1, mpint *b2, mpint *prod)
+{+ mpint *oprod;
+
+ oprod = prod;
+ if(prod == b1 || prod == b2){+ prod = mpnew(0);
+ prod->flags = oprod->flags;
+ }
+ prod->flags |= (b1->flags | b2->flags) & MPtimesafe;
+
+ prod->top = 0;
+ mpbits(prod, (b1->top+b2->top+1)*Dbits);
+ if(prod->flags & MPtimesafe)
+ mpvectsmul(b1->p, b1->top, b2->p, b2->top, prod->p);
+ else
+ mpvecmul(b1->p, b1->top, b2->p, b2->top, prod->p);
+ prod->top = b1->top+b2->top+1;
+ prod->sign = b1->sign*b2->sign;
+ mpnorm(prod);
+
+ if(oprod != prod){+ mpassign(prod, oprod);
+ mpfree(prod);
+ }
+}
--- /dev/null
+++ b/3rd/mp/mpright.c
@@ -1,0 +1,55 @@
+#include "platform.h"
+
+// res = b >> shift
+void
+mpright(mpint *b, int shift, mpint *res)
+{+ int d, l, r, i;
+ mpdigit this, last;
+
+ res->sign = b->sign;
+ if(b->top==0){+ res->top = 0;
+ return;
+ }
+
+ // a negative right shift is a left shift
+ if(shift < 0){+ mpleft(b, -shift, res);
+ return;
+ }
+
+ if(res != b)
+ mpbits(res, b->top*Dbits - shift);
+ else if(shift == 0)
+ return;
+
+ d = shift/Dbits;
+ r = shift - d*Dbits;
+ l = Dbits - r;
+
+ // shift all the bits out == zero
+ if(d>=b->top){+ res->sign = 1;
+ res->top = 0;
+ return;
+ }
+
+ // special case digit shifts
+ if(r == 0){+ for(i = 0; i < b->top-d; i++)
+ res->p[i] = b->p[i+d];
+ } else {+ last = b->p[d];
+ for(i = 0; i < b->top-d-1; i++){+ this = b->p[i+d+1];
+ res->p[i] = (this<<l) | (last>>r);
+ last = this;
+ }
+ res->p[i++] = last>>r;
+ }
+
+ res->top = i;
+ res->flags |= b->flags & MPtimesafe;
+ mpnorm(res);
+}
--- /dev/null
+++ b/3rd/mp/mpsub.c
@@ -1,0 +1,54 @@
+#include "platform.h"
+
+// diff = abs(b1) - abs(b2), i.e., subtract the magnitudes
+void
+mpmagsub(mpint *b1, mpint *b2, mpint *diff)
+{+ int n, m, sign;
+ mpint *t;
+
+ // get the sizes right
+ if(mpmagcmp(b1, b2) < 0){+ assert(((b1->flags | b2->flags | diff->flags) & MPtimesafe) == 0);
+ sign = -1;
+ t = b1;
+ b1 = b2;
+ b2 = t;
+ } else {+ diff->flags |= (b1->flags | b2->flags) & MPtimesafe;
+ sign = 1;
+ }
+ n = b1->top;
+ m = b2->top;
+ if(m == 0){+ mpassign(b1, diff);
+ diff->sign = sign;
+ return;
+ }
+ mpbits(diff, n*Dbits);
+
+ mpvecsub(b1->p, n, b2->p, m, diff->p);
+ diff->sign = sign;
+ diff->top = n;
+ mpnorm(diff);
+}
+
+// diff = b1 - b2
+void
+mpsub(mpint *b1, mpint *b2, mpint *diff)
+{+ int sign;
+
+ if(b1->sign != b2->sign){+ assert(((b1->flags | b2->flags | diff->flags) & MPtimesafe) == 0);
+ sign = b1->sign;
+ mpmagadd(b1, b2, diff);
+ diff->sign = sign;
+ return;
+ }
+
+ sign = b1->sign;
+ mpmagsub(b1, b2, diff);
+ if(diff->top != 0)
+ diff->sign *= sign;
+}
--- /dev/null
+++ b/3rd/mp/mptobe.c
@@ -1,0 +1,29 @@
+#include "platform.h"
+
+// convert an mpint into a big endian byte array (most significant byte first; left adjusted)
+// return number of bytes converted
+// if p == nil, allocate and result array
+int
+mptobe(mpint *b, uchar *p, uint n, uchar **pp)
+{+ uint m;
+
+ m = (mpsignif(b)+7)/8;
+ if(m == 0)
+ m++;
+ if(p == nil){+ n = m;
+ p = malloc(n);
+ if(p == nil)
+ sysfatal("mptobe: %r");+ } else {+ if(n < m)
+ return -1;
+ if(n > m)
+ memset(p+m, 0, n-m);
+ }
+ if(pp != nil)
+ *pp = p;
+ mptober(b, p, m);
+ return m;
+}
--- /dev/null
+++ b/3rd/mp/mptober.c
@@ -1,0 +1,32 @@
+#include "platform.h"
+
+void
+mptober(mpint *b, uchar *p, int n)
+{+ int i, j, m;
+ mpdigit x;
+
+ memset(p, 0, n);
+
+ p += n;
+ m = b->top*Dbytes;
+ if(m < n)
+ n = m;
+
+ i = 0;
+ while(n >= Dbytes){+ n -= Dbytes;
+ x = b->p[i++];
+ for(j = 0; j < Dbytes; j++){+ *--p = x;
+ x >>= 8;
+ }
+ }
+ if(n > 0){+ x = b->p[i];
+ for(j = 0; j < n; j++){+ *--p = x;
+ x >>= 8;
+ }
+ }
+}
--- /dev/null
+++ b/3rd/mp/mptod.c
@@ -1,0 +1,83 @@
+#include "platform.h"
+
+extern double D_PINF, D_NINF;
+
+double
+mptod(mpint *a)
+{+ u64int v;
+ mpdigit w, r;
+ int sf, i, n, m, s;
+ FPdbleword x;
+
+ if(a->top == 0) return 0.0;
+ sf = mpsignif(a);
+ if(sf > 1024) return a->sign < 0 ? D_NINF : D_PINF;
+ i = a->top - 1;
+ v = a->p[i];
+ n = sf & Dbits - 1;
+ n |= n - 1 & Dbits;
+ r = 0;
+ if(n > 54){+ s = n - 54;
+ r = v & (1<<s) - 1;
+ v >>= s;
+ }
+ while(n < 54){+ if(--i < 0)
+ w = 0;
+ else
+ w = a->p[i];
+ m = 54 - n;
+ if(m > Dbits) m = Dbits;
+ s = Dbits - m & Dbits - 1;
+ v = v << m | w >> s;
+ r = w & (1<<s) - 1;
+ n += m;
+ }
+ if((v & 3) == 1){+ while(--i >= 0)
+ r |= a->p[i];
+ if(r != 0)
+ v++;
+ }else
+ v++;
+ v >>= 1;
+ while((v >> 53) != 0){+ v >>= 1;
+ if(++sf > 1024)
+ return a->sign < 0 ? D_NINF : D_PINF;
+ }
+ x.lo = v;
+ x.hi = (u32int)(v >> 32) & (1<<20) - 1 | (sf + 1022) << 20 | a->sign & 1<<31;
+ return x.x;
+}
+
+mpint *
+dtomp(double d, mpint *a)
+{+ FPdbleword x;
+ uvlong v;
+ int e;
+
+ if(a == nil)
+ a = mpnew(0);
+ x.x = d;
+ e = x.hi >> 20 & 2047;
+ assert(e != 2047);
+ if(e < 1022){+ mpassign(mpzero, a);
+ return a;
+ }
+ v = x.lo | (uvlong)(x.hi & (1<<20) - 1) << 32 | 1ULL<<52;
+ if(e < 1075){+ v += (1ULL<<(1074 - e)) - (~v >> (1075 - e) & 1);
+ v >>= 1075 - e;
+ }
+ uvtomp(v, a);
+ if(e > 1075)
+ mpleft(a, e - 1075, a);
+ if((int)x.hi < 0)
+ a->sign = -1;
+ return a;
+}
--- /dev/null
+++ b/3rd/mp/mptoi.c
@@ -1,0 +1,41 @@
+#include "platform.h"
+
+/*
+ * this code assumes that mpdigit is at least as
+ * big as an int.
+ */
+
+mpint*
+itomp(int i, mpint *b)
+{+ if(b == nil){+ b = mpnew(0);
+ }
+ b->sign = (i >> (sizeof(i)*8 - 1)) | 1;
+ i *= b->sign;
+ *b->p = i;
+ b->top = 1;
+ return mpnorm(b);
+}
+
+int
+mptoi(mpint *b)
+{+ uint x;
+
+ if(b->top==0)
+ return 0;
+ x = *b->p;
+ if(b->sign > 0){+ if(b->top > 1 || (x > MAXINT))
+ x = (int)MAXINT;
+ else
+ x = (int)x;
+ } else {+ if(b->top > 1 || x > MAXINT+1)
+ x = (int)MININT;
+ else
+ x = -(int)x;
+ }
+ return x;
+}
--- /dev/null
+++ b/3rd/mp/mptoui.c
@@ -1,0 +1,31 @@
+#include "platform.h"
+
+/*
+ * this code assumes that mpdigit is at least as
+ * big as an int.
+ */
+
+mpint*
+uitomp(uint i, mpint *b)
+{+ if(b == nil){+ b = mpnew(0);
+ }
+ *b->p = i;
+ b->top = 1;
+ b->sign = 1;
+ return mpnorm(b);
+}
+
+uint
+mptoui(mpint *b)
+{+ uint x;
+
+ x = *b->p;
+ if(b->sign < 0)
+ x = 0;
+ else if(b->top > 1 || (sizeof(mpdigit) > sizeof(uint) && x > MAXUINT))
+ x = MAXUINT;
+ return x;
+}
--- /dev/null
+++ b/3rd/mp/mptouv.c
@@ -1,0 +1,44 @@
+#include "platform.h"
+
+#define VLDIGITS (int)(sizeof(vlong)/sizeof(mpdigit))
+
+/*
+ * this code assumes that a vlong is an integral number of
+ * mpdigits long.
+ */
+mpint*
+uvtomp(uvlong v, mpint *b)
+{+ int s;
+
+ if(b == nil){+ b = mpnew(VLDIGITS*Dbits);
+ }else
+ mpbits(b, VLDIGITS*Dbits);
+ b->sign = 1;
+ for(s = 0; s < VLDIGITS; s++){+ b->p[s] = v;
+ v >>= sizeof(mpdigit)*8;
+ }
+ b->top = s;
+ return mpnorm(b);
+}
+
+uvlong
+mptouv(mpint *b)
+{+ uvlong v;
+ int s;
+
+ if(b->top == 0 || b->sign < 0)
+ return 0LL;
+
+ if(b->top > VLDIGITS)
+ return -1LL;
+
+ v = 0ULL;
+ for(s = 0; s < b->top; s++)
+ v |= (uvlong)b->p[s]<<(s*sizeof(mpdigit)*8);
+
+ return v;
+}
--- /dev/null
+++ b/3rd/mp/mptov.c
@@ -1,0 +1,60 @@
+#include "platform.h"
+
+#define VLDIGITS (int)(sizeof(vlong)/sizeof(mpdigit))
+
+/*
+ * this code assumes that a vlong is an integral number of
+ * mpdigits long.
+ */
+mpint*
+vtomp(vlong v, mpint *b)
+{+ int s;
+ uvlong uv;
+
+ if(b == nil){+ b = mpnew(VLDIGITS*Dbits);
+ }else
+ mpbits(b, VLDIGITS*Dbits);
+ b->sign = (v >> (sizeof(v)*8 - 1)) | 1;
+ uv = v * b->sign;
+ for(s = 0; s < VLDIGITS; s++){+ b->p[s] = uv;
+ uv >>= sizeof(mpdigit)*8;
+ }
+ b->top = s;
+ return mpnorm(b);
+}
+
+vlong
+mptov(mpint *b)
+{+ uvlong v;
+ int s;
+
+ if(b->top == 0)
+ return 0LL;
+
+ if(b->top > VLDIGITS){+ if(b->sign > 0)
+ return (vlong)MAXVLONG;
+ else
+ return (vlong)MINVLONG;
+ }
+
+ v = 0ULL;
+ for(s = 0; s < b->top; s++)
+ v |= (uvlong)b->p[s]<<(s*sizeof(mpdigit)*8);
+
+ if(b->sign > 0){+ if(v > MAXVLONG)
+ v = MAXVLONG;
+ } else {+ if(v > MINVLONG)
+ v = MINVLONG;
+ else
+ v = -(vlong)v;
+ }
+
+ return (vlong)v;
+}
--- /dev/null
+++ b/3rd/mp/mpvecadd.c
@@ -1,0 +1,34 @@
+#include "platform.h"
+
+// prereq: alen >= blen, sum has at least blen+1 digits
+void
+mpvecadd(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *sum)
+{+ int i;
+ uint carry;
+ mpdigit x, y;
+
+ carry = 0;
+ for(i = 0; i < blen; i++){+ x = *a++;
+ y = *b++;
+ x += carry;
+ if(x < carry)
+ carry = 1;
+ else
+ carry = 0;
+ x += y;
+ if(x < y)
+ carry++;
+ *sum++ = x;
+ }
+ for(; i < alen; i++){+ x = *a++ + carry;
+ if(x < carry)
+ carry = 1;
+ else
+ carry = 0;
+ *sum++ = x;
+ }
+ *sum = carry;
+}
--- /dev/null
+++ b/3rd/mp/mpveccmp.c
@@ -1,0 +1,25 @@
+#include "platform.h"
+
+int
+mpveccmp(mpdigit *a, int alen, mpdigit *b, int blen)
+{+ mpdigit x;
+
+ while(alen > blen)
+ if(a[--alen] != 0)
+ return 1;
+ while(blen > alen)
+ if(b[--blen] != 0)
+ return -1;
+ while(alen > 0){+ --alen;
+ x = a[alen] - b[alen];
+ if(x == 0)
+ continue;
+ if(x > a[alen])
+ return -1;
+ else
+ return 1;
+ }
+ return 0;
+}
--- /dev/null
+++ b/3rd/mp/mpvecdigmuladd.c
@@ -1,0 +1,101 @@
+#include "platform.h"
+
+#define LO(x) ((x) & ((1<<(Dbits/2))-1))
+#define HI(x) ((x) >> (Dbits/2))
+
+static void
+mpdigmul(mpdigit a, mpdigit b, mpdigit *p)
+{+ mpdigit x, ah, al, bh, bl, p1, p2, p3, p4;
+ int carry;
+
+ // half digits
+ ah = HI(a);
+ al = LO(a);
+ bh = HI(b);
+ bl = LO(b);
+
+ // partial products
+ p1 = ah*bl;
+ p2 = bh*al;
+ p3 = bl*al;
+ p4 = ah*bh;
+
+ // p = ((p1+p2)<<(Dbits/2)) + (p4<<Dbits) + p3
+ carry = 0;
+ x = p1<<(Dbits/2);
+ p3 += x;
+ if(p3 < x)
+ carry++;
+ x = p2<<(Dbits/2);
+ p3 += x;
+ if(p3 < x)
+ carry++;
+ p4 += carry + HI(p1) + HI(p2); // can't carry out of the high digit
+ p[0] = p3;
+ p[1] = p4;
+}
+
+// prereq: p must have room for n+1 digits
+void
+mpvecdigmuladd(mpdigit *b, int n, mpdigit m, mpdigit *p)
+{+ int i;
+ mpdigit carry, x, y, part[2];
+
+ carry = 0;
+ part[1] = 0;
+ for(i = 0; i < n; i++){+ x = part[1] + carry;
+ if(x < carry)
+ carry = 1;
+ else
+ carry = 0;
+ y = *p;
+ mpdigmul(*b++, m, part);
+ x += part[0];
+ if(x < part[0])
+ carry++;
+ x += y;
+ if(x < y)
+ carry++;
+ *p++ = x;
+ }
+ *p = part[1] + carry;
+}
+
+// prereq: p must have room for n+1 digits
+int
+mpvecdigmulsub(mpdigit *b, int n, mpdigit m, mpdigit *p)
+{+ int i;
+ mpdigit x, y, part[2], borrow;
+
+ borrow = 0;
+ part[1] = 0;
+ for(i = 0; i < n; i++){+ x = *p;
+ y = x - borrow;
+ if(y > x)
+ borrow = 1;
+ else
+ borrow = 0;
+ x = part[1];
+ mpdigmul(*b++, m, part);
+ x += part[0];
+ if(x < part[0])
+ borrow++;
+ x = y - x;
+ if(x > y)
+ borrow++;
+ *p++ = x;
+ }
+
+ x = *p;
+ y = x - borrow - part[1];
+ *p = y;
+ if(y > x)
+ return -1;
+ else
+ return 1;
+}
--- /dev/null
+++ b/3rd/mp/mpvecsub.c
@@ -1,0 +1,32 @@
+#include "platform.h"
+
+// prereq: a >= b, alen >= blen, diff has at least alen digits
+void
+mpvecsub(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *diff)
+{+ int i, borrow;
+ mpdigit x, y;
+
+ borrow = 0;
+ for(i = 0; i < blen; i++){+ x = *a++;
+ y = *b++;
+ y += borrow;
+ if(y < (mpdigit)borrow)
+ borrow = 1;
+ else
+ borrow = 0;
+ if(x < y)
+ borrow++;
+ *diff++ = x - y;
+ }
+ for(; i < alen; i++){+ x = *a++;
+ y = x - borrow;
+ if(y > x)
+ borrow = 1;
+ else
+ borrow = 0;
+ *diff++ = y;
+ }
+}
--- /dev/null
+++ b/3rd/mp/mpvectscmp.c
@@ -1,0 +1,32 @@
+#include "platform.h"
+
+int
+mpvectscmp(mpdigit *a, int alen, mpdigit *b, int blen)
+{+ mpdigit x, y, z, v;
+ int m, p;
+
+ if(alen > blen){+ v = 0;
+ while(alen > blen)
+ v |= a[--alen];
+ m = p = (-v^v|v)>>(Dbits-1);
+ } else if(blen > alen){+ v = 0;
+ while(blen > alen)
+ v |= b[--blen];
+ m = (-v^v|v)>>(Dbits-1);
+ p = m^1;
+ } else
+ m = p = 0;
+ while(alen-- > 0){+ x = a[alen];
+ y = b[alen];
+ z = x - y;
+ x = ~x;
+ v = ((-z^z|z)>>(Dbits-1)) & ~m;
+ p = ((~(x&y|x&z|y&z)>>(Dbits-1)) & v) | (p & ~v);
+ m |= v;
+ }
+ return (p-m) | m;
+}
--- /dev/null
+++ b/3rd/mp/strtomp.c
@@ -1,0 +1,174 @@
+#include "platform.h"
+
+static char*
+frompow2(char *a, mpint *b, int s)
+{+ char *p, *next;
+ mpdigit x;
+ int i;
+
+ i = 1<<s;
+ for(p = a; (dec16chr(*p) & 255) < i; p++)
+ ;
+
+ mpbits(b, (p-a)*s);
+ b->top = 0;
+ next = p;
+
+ while(p > a){+ x = 0;
+ for(i = 0; i < Dbits; i += s){+ if(p <= a)
+ break;
+ x |= dec16chr(*--p)<<i;
+ }
+ b->p[b->top++] = x;
+ }
+ return next;
+}
+
+static char*
+from8(char *a, mpint *b)
+{+ char *p, *next;
+ mpdigit x, y;
+ int i;
+
+ for(p = a; ((*p - '0') & 255) < 8; p++)
+ ;
+
+ mpbits(b, (p-a)*3);
+ b->top = 0;
+ next = p;
+
+ i = 0;
+ x = y = 0;
+ while(p > a){+ y = *--p - '0';
+ x |= y << i;
+ i += 3;
+ if(i >= Dbits){+Digout:
+ i -= Dbits;
+ b->p[b->top++] = x;
+ x = y >> (3-i);
+ }
+ }
+ if(i > 0)
+ goto Digout;
+
+ return next;
+}
+
+static ulong mppow10[] = {+ 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000
+};
+
+static char*
+from10(char *a, mpint *b)
+{+ ulong x, y;
+ mpint *pow, *r;
+ int i;
+
+ pow = mpnew(0);
+ r = mpnew(0);
+
+ b->top = 0;
+ for(;;){+ // do a billion at a time in native arithmetic
+ x = 0;
+ for(i = 0; i < 9; i++){+ y = *a - '0';
+ if(y > 9)
+ break;
+ a++;
+ x *= 10;
+ x += y;
+ }
+ if(i == 0)
+ break;
+
+ // accumulate into mpint
+ uitomp(mppow10[i], pow);
+ uitomp(x, r);
+ mpmul(b, pow, b);
+ mpadd(b, r, b);
+ if(i < 9)
+ break;
+ }
+ mpfree(pow);
+ mpfree(r);
+ return a;
+}
+
+mpint*
+strtomp(char *a, char **pp, int base, mpint *b)
+{+ int sign;
+ char *e;
+
+ if(b == nil){+ b = mpnew(0);
+ }
+
+ while(*a==' ' || *a=='\t')
+ a++;
+
+ sign = 1;
+ for(;; a++){+ switch(*a){+ case '-':
+ sign *= -1;
+ continue;
+ }
+ break;
+ }
+
+ if(base == 0){+ base = 10;
+ if(a[0] == '0'){+ if(a[1] == 'x' || a[1] == 'X') {+ a += 2;
+ base = 16;
+ } else if(a[1] == 'b' || a[1] == 'B') {+ a += 2;
+ base = 2;
+ } else if(a[1] >= '0' && a[1] <= '7') {+ a++;
+ base = 8;
+ }
+ }
+ }
+
+ switch(base){+ case 2:
+ e = frompow2(a, b, 1);
+ break;
+ case 4:
+ e = frompow2(a, b, 2);
+ break;
+ case 8:
+ e = from8(a, b);
+ break;
+ case 10:
+ e = from10(a, b);
+ break;
+ case 16:
+ e = frompow2(a, b, 4);
+ break;
+ default:
+ abort();
+ return nil;
+ }
+
+ if(pp != nil)
+ *pp = e;
+
+ // if no characters parsed, there wasn't a number to convert
+ if(e == a)
+ return nil;
+
+ b->sign = sign;
+ return mpnorm(b);
+}
--- /dev/null
+++ b/3rd/mp/u16.c
@@ -1,0 +1,68 @@
+#include "platform.h"
+
+#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
+
+int
+enc16chr(int o)
+{+ int c;
+
+ c = between(o, 0, 9) & ('0'+o);+ c |= between(o, 10, 15) & ('A'+(o-10));+ return c;
+}
+
+int
+dec16chr(int c)
+{+ int o;
+
+ o = between(c, '0', '9') & (1+(c-'0'));
+ o |= between(c, 'A', 'F') & (1+10+(c-'A'));
+ o |= between(c, 'a', 'f') & (1+10+(c-'a'));
+ return o-1;
+}
+
+int
+dec16(uchar *out, int lim, char *in, int n)
+{+ int c, w = 0, i = 0;
+ uchar *start = out;
+ uchar *eout = out + lim;
+
+ while(n-- > 0){+ c = dec16chr(*in++);
+ if(c < 0)
+ continue;
+ w = (w<<4) + c;
+ i++;
+ if(i == 2){+ if(out + 1 > eout)
+ goto exhausted;
+ *out++ = w;
+ w = 0;
+ i = 0;
+ }
+ }
+exhausted:
+ return out - start;
+}
+
+int
+enc16(char *out, int lim, uchar *in, int n)
+{+ uint c;
+ char *eout = out + lim;
+ char *start = out;
+
+ while(n-- > 0){+ c = *in++;
+ if(out + 2 >= eout)
+ goto exhausted;
+ *out++ = enc16chr(c>>4);
+ *out++ = enc16chr(c&15);
+ }
+exhausted:
+ *out = 0;
+ return out - start;
+}
--- /dev/null
+++ b/3rd/mp/u32.c
@@ -1,0 +1,143 @@
+#include "platform.h"
+
+#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
+
+int
+enc32chr(int o)
+{+ int c;
+
+ c = between(o, 0, 25) & ('A'+o);+ c |= between(o, 26, 31) & ('2'+(o-26));+ return c;
+}
+
+int
+dec32chr(int c)
+{+ int o;
+
+ o = between(c, 'A', 'Z') & (1+(c-'A'));
+ o |= between(c, 'a', 'z') & (1+(c-'a'));
+ o |= between(c, '2', '7') & (1+26+(c-'2'));
+ return o-1;
+}
+
+int
+dec32x(uchar *dest, int ndest, char *src, int nsrc, int (*chr)(int))
+{+ uchar *start;
+ int i, j, u[8];
+
+ if(ndest+1 < (5*nsrc+7)/8)
+ return -1;
+ start = dest;
+ while(nsrc>=8){+ for(i=0; i<8; i++){+ j = chr(src[i]);
+ if(j < 0)
+ j = 0;
+ u[i] = j;
+ }
+ *dest++ = (u[0]<<3) | (0x7 & (u[1]>>2));
+ *dest++ = ((0x3 & u[1])<<6) | (u[2]<<1) | (0x1 & (u[3]>>4));
+ *dest++ = ((0xf & u[3])<<4) | (0xf & (u[4]>>1));
+ *dest++ = ((0x1 & u[4])<<7) | (u[5]<<2) | (0x3 & (u[6]>>3));
+ *dest++ = ((0x7 & u[6])<<5) | u[7];
+ src += 8;
+ nsrc -= 8;
+ }
+ if(nsrc > 0){+ if(nsrc == 1 || nsrc == 3 || nsrc == 6)
+ return -1;
+ for(i=0; i<nsrc; i++){+ j = chr(src[i]);
+ if(j < 0)
+ j = 0;
+ u[i] = j;
+ }
+ *dest++ = (u[0]<<3) | (0x7 & (u[1]>>2));
+ if(nsrc == 2)
+ goto out;
+ *dest++ = ((0x3 & u[1])<<6) | (u[2]<<1) | (0x1 & (u[3]>>4));
+ if(nsrc == 4)
+ goto out;
+ *dest++ = ((0xf & u[3])<<4) | (0xf & (u[4]>>1));
+ if(nsrc == 5)
+ goto out;
+ *dest++ = ((0x1 & u[4])<<7) | (u[5]<<2) | (0x3 & (u[6]>>3));
+ }
+out:
+ return dest-start;
+}
+
+int
+enc32x(char *dest, int ndest, uchar *src, int nsrc, int (*chr)(int))
+{+ char *start;
+ int j;
+
+ if(ndest <= (8*nsrc+4)/5)
+ return -1;
+ start = dest;
+ while(nsrc>=5){+ j = (0x1f & (src[0]>>3));
+ *dest++ = chr(j);
+ j = (0x1c & (src[0]<<2)) | (0x03 & (src[1]>>6));
+ *dest++ = chr(j);
+ j = (0x1f & (src[1]>>1));
+ *dest++ = chr(j);
+ j = (0x10 & (src[1]<<4)) | (0x0f & (src[2]>>4));
+ *dest++ = chr(j);
+ j = (0x1e & (src[2]<<1)) | (0x01 & (src[3]>>7));
+ *dest++ = chr(j);
+ j = (0x1f & (src[3]>>2));
+ *dest++ = chr(j);
+ j = (0x18 & (src[3]<<3)) | (0x07 & (src[4]>>5));
+ *dest++ = chr(j);
+ j = (0x1f & (src[4]));
+ *dest++ = chr(j);
+ src += 5;
+ nsrc -= 5;
+ }
+ if(nsrc){+ j = (0x1f & (src[0]>>3));
+ *dest++ = chr(j);
+ j = (0x1c & (src[0]<<2));
+ if(nsrc == 1)
+ goto out;
+ j |= (0x03 & (src[1]>>6));
+ *dest++ = chr(j);
+ j = (0x1f & (src[1]>>1));
+ *dest++ = chr(j);
+ j = (0x10 & (src[1]<<4));
+ if(nsrc == 2)
+ goto out;
+ j |= (0x0f & (src[2]>>4));
+ *dest++ = chr(j);
+ j = (0x1e & (src[2]<<1));
+ if(nsrc == 3)
+ goto out;
+ j |= (0x01 & (src[3]>>7));
+ *dest++ = chr(j);
+ j = (0x1f & (src[3]>>2));
+ *dest++ = chr(j);
+ j = (0x18 & (src[3]<<3));
+out:
+ *dest++ = chr(j);
+ }
+ *dest = 0;
+ return dest-start;
+}
+
+int
+enc32(char *dest, int ndest, uchar *src, int nsrc)
+{+ return enc32x(dest, ndest, src, nsrc, enc32chr);
+}
+
+int
+dec32(uchar *dest, int ndest, char *src, int nsrc)
+{+ return dec32x(dest, ndest, src, nsrc, dec32chr);
+}
--- /dev/null
+++ b/3rd/mp/u64.c
@@ -1,0 +1,141 @@
+#include "platform.h"
+
+#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
+
+int
+enc64chr(int o)
+{+ int c;
+
+ c = between(o, 0, 25) & ('A'+o);+ c |= between(o, 26, 51) & ('a'+(o-26));+ c |= between(o, 52, 61) & ('0'+(o-52));+ c |= between(o, 62, 62) & ('+');+ c |= between(o, 63, 63) & ('/');+ return c;
+}
+
+int
+dec64chr(int c)
+{+ int o;
+
+ o = between(c, 'A', 'Z') & (1+(c-'A'));
+ o |= between(c, 'a', 'z') & (1+26+(c-'a'));
+ o |= between(c, '0', '9') & (1+52+(c-'0'));
+ o |= between(c, '+', '+') & (1+62);
+ o |= between(c, '/', '/') & (1+63);
+ return o-1;
+}
+
+int
+dec64x(uchar *out, int lim, char *in, int n, int (*chr)(int))
+{+ ulong b24;
+ uchar *start = out;
+ uchar *e = out + lim;
+ int i, c;
+
+ b24 = 0;
+ i = 0;
+ while(n-- > 0){+ c = chr(*in++);
+ if(c < 0)
+ continue;
+ switch(i){+ case 0:
+ b24 = c<<18;
+ break;
+ case 1:
+ b24 |= c<<12;
+ break;
+ case 2:
+ b24 |= c<<6;
+ break;
+ case 3:
+ if(out + 3 > e)
+ goto exhausted;
+
+ b24 |= c;
+ *out++ = b24>>16;
+ *out++ = b24>>8;
+ *out++ = b24;
+ i = 0;
+ continue;
+ }
+ i++;
+ }
+ switch(i){+ case 2:
+ if(out + 1 > e)
+ goto exhausted;
+ *out++ = b24>>16;
+ break;
+ case 3:
+ if(out + 2 > e)
+ goto exhausted;
+ *out++ = b24>>16;
+ *out++ = b24>>8;
+ break;
+ }
+exhausted:
+ return out - start;
+}
+
+int
+enc64x(char *out, int lim, uchar *in, int n, int (*chr)(int))
+{+ int i;
+ ulong b24;
+ char *start = out;
+ char *e = out + lim;
+
+ for(i = n/3; i > 0; i--){+ b24 = *in++<<16;
+ b24 |= *in++<<8;
+ b24 |= *in++;
+ if(out + 4 >= e)
+ goto exhausted;
+ *out++ = chr(b24>>18);
+ *out++ = chr((b24>>12)&0x3f);
+ *out++ = chr((b24>>6)&0x3f);
+ *out++ = chr(b24&0x3f);
+ }
+
+ switch(n%3){+ case 2:
+ b24 = *in++<<16;
+ b24 |= *in<<8;
+ if(out + 4 >= e)
+ goto exhausted;
+ *out++ = chr(b24>>18);
+ *out++ = chr((b24>>12)&0x3f);
+ *out++ = chr((b24>>6)&0x3f);
+ *out++ = '=';
+ break;
+ case 1:
+ b24 = *in<<16;
+ if(out + 4 >= e)
+ goto exhausted;
+ *out++ = chr(b24>>18);
+ *out++ = chr((b24>>12)&0x3f);
+ *out++ = '=';
+ *out++ = '=';
+ break;
+ }
+exhausted:
+ *out = 0;
+ return out - start;
+}
+
+int
+enc64(char *out, int lim, uchar *in, int n)
+{+ return enc64x(out, lim, in, n, enc64chr);
+}
+
+int
+dec64(uchar *out, int lim, char *in, int n)
+{+ return dec64x(out, lim, in, n, dec64chr);
+}
--- /dev/null
+++ b/3rd/mt19937ar.c
@@ -1,0 +1,171 @@
+/*
+ A C-program for MT19937, with initialization improved 2002/1/26.
+ Coded by Takuji Nishimura and Makoto Matsumoto.
+
+ Before using, initialize the state by using init_genrand(seed)
+ or init_by_array(init_key, key_length).
+
+ Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. The names of its contributors may not be used to endorse or promote
+ products derived from this software without specific prior written
+ permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+ Any feedback is very welcome.
+ http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html
+ email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space)
+*/
+
+/* Period parameters */
+#define mtN 624
+#define mtM 397
+#define MATRIX_A 0x9908b0dfU /* constant vector a */
+#define UPPER_MASK 0x80000000U /* most significant w-r bits */
+#define LOWER_MASK 0x7fffffffU /* least significant r bits */
+
+static uint32_t mt[mtN]; /* the array for the state vector */
+static int mti=mtN+1; /* mti==mtN+1 means mt[mtN] is not initialized */
+
+/* initializes mt[mtN] with a seed */
+void init_genrand(uint32_t s)
+{+ mt[0]= s & 0xffffffffU;
+ for (mti=1; mti<mtN; mti++) {+ mt[mti] =
+ (1812433253U * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
+ /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
+ /* In the previous versions, MSBs of the seed affect */
+ /* only MSBs of the array mt[]. */
+ /* 2002/01/09 modified by Makoto Matsumoto */
+ mt[mti] &= 0xffffffffU;
+ /* for >32 bit machines */
+ }
+}
+
+/* initialize by an array with array-length */
+/* init_key is the array for initializing keys */
+/* key_length is its length */
+/* slight change for C++, 2004/2/26 */
+void init_by_array(uint32_t init_key[], int key_length)
+{+ int i, j, k;
+ init_genrand(19650218U);
+ i=1; j=0;
+ k = (mtN>key_length ? mtN : key_length);
+ for (; k; k--) {+ mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525U))
+ + init_key[j] + j; /* non linear */
+ mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
+ i++; j++;
+ if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; }+ if (j>=key_length) j=0;
+ }
+ for (k=mtN-1; k; k--) {+ mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941U))
+ - i; /* non linear */
+ mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
+ i++;
+ if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; }+ }
+
+ mt[0] = 0x80000000U; /* MSB is 1; assuring non-zero initial array */
+}
+
+/* generates a random number on [0,0xffffffff]-interval */
+uint32_t genrand_int32(void)
+{+ uint32_t y;
+ static uint32_t mag01[2]={0x0U, MATRIX_A};+ /* mag01[x] = x * MATRIX_A for x=0,1 */
+
+ if (mti >= mtN) { /* generate mtN words at one time */+ int kk;
+
+ if (mti == mtN+1) /* if init_genrand() has not been called, */
+ init_genrand(5489U); /* a default initial seed is used */
+
+ for (kk=0;kk<mtN-mtM;kk++) {+ y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
+ mt[kk] = mt[kk+mtM] ^ (y >> 1) ^ mag01[y & 0x1U];
+ }
+ for (;kk<mtN-1;kk++) {+ y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
+ mt[kk] = mt[kk+(mtM-mtN)] ^ (y >> 1) ^ mag01[y & 0x1U];
+ }
+ y = (mt[mtN-1]&UPPER_MASK)|(mt[0]&LOWER_MASK);
+ mt[mtN-1] = mt[mtM-1] ^ (y >> 1) ^ mag01[y & 0x1U];
+
+ mti = 0;
+ }
+
+ y = mt[mti++];
+
+ /* Tempering */
+ y ^= (y >> 11);
+ y ^= (y << 7) & 0x9d2c5680U;
+ y ^= (y << 15) & 0xefc60000U;
+ y ^= (y >> 18);
+
+ return y;
+}
+
+#if 0
+/* generates a random number on [0,0x7fffffff]-interval */
+long genrand_int31(void)
+{+ return (long)(genrand_int32()>>1);
+}
+
+/* generates a random number on [0,1]-real-interval */
+double genrand_real1(void)
+{+ return genrand_int32()*(1.0/4294967295.0);
+ /* divided by 2^32-1 */
+}
+
+/* generates a random number on [0,1)-real-interval */
+double genrand_real2(void)
+{+ return genrand_int32()*(1.0/4294967296.0);
+ /* divided by 2^32 */
+}
+
+/* generates a random number on (0,1)-real-interval */
+double genrand_real3(void)
+{+ return (((double)genrand_int32()) + 0.5)*(1.0/4294967296.0);
+ /* divided by 2^32 */
+}
+
+/* generates a random number on [0,1) with 53-bit resolution*/
+double genrand_res53(void)
+{+ uint32_t a=genrand_int32()>>5, b=genrand_int32()>>6;
+ return(a*67108864.0+b)*(1.0/9007199254740992.0);
+}
+#endif
--- /dev/null
+++ b/3rd/wcwidth.c
@@ -1,0 +1,542 @@
+/*
+ * Copyright (C) Fredrik Fornwall 2016.
+ * Distributed under the MIT License.
+ *
+ * Implementation of wcwidth(3) as a C port of:
+ * https://github.com/jquast/wcwidth
+ *
+ * Report issues at:
+ * https://github.com/termux/wcwidth
+ *
+ * IMPORTANT:
+ * Must be kept in sync with the following:
+ * https://github.com/termux/termux-app/blob/master/terminal-emulator/src/main/java/com/termux/terminal/WcWidth.java
+ * https://github.com/termux/libandroid-support
+ * https://github.com/termux/termux-packages/tree/master/packages/libandroid-support
+ */
+
+#include "llt.h"
+
+struct width_interval {+ int start;
+ int end;
+};
+
+// From https://github.com/jquast/wcwidth/blob/master/wcwidth/table_zero.py
+// from https://github.com/jquast/wcwidth/pull/64
+// at commit 1b9b6585b0080ea5cb88dc9815796505724793fe (2022-12-16):
+static struct width_interval ZERO_WIDTH[] = {+ {0x00300, 0x0036f}, // Combining Grave Accent ..Combining Latin Small Le+ {0x00483, 0x00489}, // Combining Cyrillic Titlo..Combining Cyrillic Milli+ {0x00591, 0x005bd}, // Hebrew Accent Etnahta ..Hebrew Point Meteg+ {0x005bf, 0x005bf}, // Hebrew Point Rafe ..Hebrew Point Rafe+ {0x005c1, 0x005c2}, // Hebrew Point Shin Dot ..Hebrew Point Sin Dot+ {0x005c4, 0x005c5}, // Hebrew Mark Upper Dot ..Hebrew Mark Lower Dot+ {0x005c7, 0x005c7}, // Hebrew Point Qamats Qata..Hebrew Point Qamats Qata+ {0x00610, 0x0061a}, // Arabic Sign Sallallahou ..Arabic Small Kasra+ {0x0064b, 0x0065f}, // Arabic Fathatan ..Arabic Wavy Hamza Below+ {0x00670, 0x00670}, // Arabic Letter Superscrip..Arabic Letter Superscrip+ {0x006d6, 0x006dc}, // Arabic Small High Ligatu..Arabic Small High Seen+ {0x006df, 0x006e4}, // Arabic Small High Rounde..Arabic Small High Madda+ {0x006e7, 0x006e8}, // Arabic Small High Yeh ..Arabic Small High Noon+ {0x006ea, 0x006ed}, // Arabic Empty Centre Low ..Arabic Small Low Meem+ {0x00711, 0x00711}, // Syriac Letter Superscrip..Syriac Letter Superscrip+ {0x00730, 0x0074a}, // Syriac Pthaha Above ..Syriac Barrekh+ {0x007a6, 0x007b0}, // Thaana Abafili ..Thaana Sukun+ {0x007eb, 0x007f3}, // Nko Combining Short High..Nko Combining Double Dot+ {0x007fd, 0x007fd}, // Nko Dantayalan ..Nko Dantayalan+ {0x00816, 0x00819}, // Samaritan Mark In ..Samaritan Mark Dagesh+ {0x0081b, 0x00823}, // Samaritan Mark Epentheti..Samaritan Vowel Sign A+ {0x00825, 0x00827}, // Samaritan Vowel Sign Sho..Samaritan Vowel Sign U+ {0x00829, 0x0082d}, // Samaritan Vowel Sign Lon..Samaritan Mark Nequdaa+ {0x00859, 0x0085b}, // Mandaic Affrication Mark..Mandaic Gemination Mark+ {0x00898, 0x0089f}, // Arabic Small High Word A..Arabic Half Madda Over M+ {0x008ca, 0x008e1}, // Arabic Small High Farsi ..Arabic Small High Sign S+ {0x008e3, 0x00902}, // Arabic Turned Damma Belo..Devanagari Sign Anusvara+ {0x0093a, 0x0093a}, // Devanagari Vowel Sign Oe..Devanagari Vowel Sign Oe+ {0x0093c, 0x0093c}, // Devanagari Sign Nukta ..Devanagari Sign Nukta+ {0x00941, 0x00948}, // Devanagari Vowel Sign U ..Devanagari Vowel Sign Ai+ {0x0094d, 0x0094d}, // Devanagari Sign Virama ..Devanagari Sign Virama+ {0x00951, 0x00957}, // Devanagari Stress Sign U..Devanagari Vowel Sign Uu+ {0x00962, 0x00963}, // Devanagari Vowel Sign Vo..Devanagari Vowel Sign Vo+ {0x00981, 0x00981}, // Bengali Sign Candrabindu..Bengali Sign Candrabindu+ {0x009bc, 0x009bc}, // Bengali Sign Nukta ..Bengali Sign Nukta+ {0x009c1, 0x009c4}, // Bengali Vowel Sign U ..Bengali Vowel Sign Vocal+ {0x009cd, 0x009cd}, // Bengali Sign Virama ..Bengali Sign Virama+ {0x009e2, 0x009e3}, // Bengali Vowel Sign Vocal..Bengali Vowel Sign Vocal+ {0x009fe, 0x009fe}, // Bengali Sandhi Mark ..Bengali Sandhi Mark+ {0x00a01, 0x00a02}, // Gurmukhi Sign Adak Bindi..Gurmukhi Sign Bindi+ {0x00a3c, 0x00a3c}, // Gurmukhi Sign Nukta ..Gurmukhi Sign Nukta+ {0x00a41, 0x00a42}, // Gurmukhi Vowel Sign U ..Gurmukhi Vowel Sign Uu+ {0x00a47, 0x00a48}, // Gurmukhi Vowel Sign Ee ..Gurmukhi Vowel Sign Ai+ {0x00a4b, 0x00a4d}, // Gurmukhi Vowel Sign Oo ..Gurmukhi Sign Virama+ {0x00a51, 0x00a51}, // Gurmukhi Sign Udaat ..Gurmukhi Sign Udaat+ {0x00a70, 0x00a71}, // Gurmukhi Tippi ..Gurmukhi Addak+ {0x00a75, 0x00a75}, // Gurmukhi Sign Yakash ..Gurmukhi Sign Yakash+ {0x00a81, 0x00a82}, // Gujarati Sign Candrabind..Gujarati Sign Anusvara+ {0x00abc, 0x00abc}, // Gujarati Sign Nukta ..Gujarati Sign Nukta+ {0x00ac1, 0x00ac5}, // Gujarati Vowel Sign U ..Gujarati Vowel Sign Cand+ {0x00ac7, 0x00ac8}, // Gujarati Vowel Sign E ..Gujarati Vowel Sign Ai+ {0x00acd, 0x00acd}, // Gujarati Sign Virama ..Gujarati Sign Virama+ {0x00ae2, 0x00ae3}, // Gujarati Vowel Sign Voca..Gujarati Vowel Sign Voca+ {0x00afa, 0x00aff}, // Gujarati Sign Sukun ..Gujarati Sign Two-circle+ {0x00b01, 0x00b01}, // Oriya Sign Candrabindu ..Oriya Sign Candrabindu+ {0x00b3c, 0x00b3c}, // Oriya Sign Nukta ..Oriya Sign Nukta+ {0x00b3f, 0x00b3f}, // Oriya Vowel Sign I ..Oriya Vowel Sign I+ {0x00b41, 0x00b44}, // Oriya Vowel Sign U ..Oriya Vowel Sign Vocalic+ {0x00b4d, 0x00b4d}, // Oriya Sign Virama ..Oriya Sign Virama+ {0x00b55, 0x00b56}, // Oriya Sign Overline ..Oriya Ai Length Mark+ {0x00b62, 0x00b63}, // Oriya Vowel Sign Vocalic..Oriya Vowel Sign Vocalic+ {0x00b82, 0x00b82}, // Tamil Sign Anusvara ..Tamil Sign Anusvara+ {0x00bc0, 0x00bc0}, // Tamil Vowel Sign Ii ..Tamil Vowel Sign Ii+ {0x00bcd, 0x00bcd}, // Tamil Sign Virama ..Tamil Sign Virama+ {0x00c00, 0x00c00}, // Telugu Sign Combining Ca..Telugu Sign Combining Ca+ {0x00c04, 0x00c04}, // Telugu Sign Combining An..Telugu Sign Combining An+ {0x00c3c, 0x00c3c}, // Telugu Sign Nukta ..Telugu Sign Nukta+ {0x00c3e, 0x00c40}, // Telugu Vowel Sign Aa ..Telugu Vowel Sign Ii+ {0x00c46, 0x00c48}, // Telugu Vowel Sign E ..Telugu Vowel Sign Ai+ {0x00c4a, 0x00c4d}, // Telugu Vowel Sign O ..Telugu Sign Virama+ {0x00c55, 0x00c56}, // Telugu Length Mark ..Telugu Ai Length Mark+ {0x00c62, 0x00c63}, // Telugu Vowel Sign Vocali..Telugu Vowel Sign Vocali+ {0x00c81, 0x00c81}, // Kannada Sign Candrabindu..Kannada Sign Candrabindu+ {0x00cbc, 0x00cbc}, // Kannada Sign Nukta ..Kannada Sign Nukta+ {0x00cbf, 0x00cbf}, // Kannada Vowel Sign I ..Kannada Vowel Sign I+ {0x00cc6, 0x00cc6}, // Kannada Vowel Sign E ..Kannada Vowel Sign E+ {0x00ccc, 0x00ccd}, // Kannada Vowel Sign Au ..Kannada Sign Virama+ {0x00ce2, 0x00ce3}, // Kannada Vowel Sign Vocal..Kannada Vowel Sign Vocal+ {0x00d00, 0x00d01}, // Malayalam Sign Combining..Malayalam Sign Candrabin+ {0x00d3b, 0x00d3c}, // Malayalam Sign Vertical ..Malayalam Sign Circular+ {0x00d41, 0x00d44}, // Malayalam Vowel Sign U ..Malayalam Vowel Sign Voc+ {0x00d4d, 0x00d4d}, // Malayalam Sign Virama ..Malayalam Sign Virama+ {0x00d62, 0x00d63}, // Malayalam Vowel Sign Voc..Malayalam Vowel Sign Voc+ {0x00d81, 0x00d81}, // Sinhala Sign Candrabindu..Sinhala Sign Candrabindu+ {0x00dca, 0x00dca}, // Sinhala Sign Al-lakuna ..Sinhala Sign Al-lakuna+ {0x00dd2, 0x00dd4}, // Sinhala Vowel Sign Ketti..Sinhala Vowel Sign Ketti+ {0x00dd6, 0x00dd6}, // Sinhala Vowel Sign Diga ..Sinhala Vowel Sign Diga+ {0x00e31, 0x00e31}, // Thai Character Mai Han-a..Thai Character Mai Han-a+ {0x00e34, 0x00e3a}, // Thai Character Sara I ..Thai Character Phinthu+ {0x00e47, 0x00e4e}, // Thai Character Maitaikhu..Thai Character Yamakkan+ {0x00eb1, 0x00eb1}, // Lao Vowel Sign Mai Kan ..Lao Vowel Sign Mai Kan+ {0x00eb4, 0x00ebc}, // Lao Vowel Sign I ..Lao Semivowel Sign Lo+ {0x00ec8, 0x00ece}, // Lao Tone Mai Ek ..(nil)+ {0x00f18, 0x00f19}, // Tibetan Astrological Sig..Tibetan Astrological Sig+ {0x00f35, 0x00f35}, // Tibetan Mark Ngas Bzung ..Tibetan Mark Ngas Bzung+ {0x00f37, 0x00f37}, // Tibetan Mark Ngas Bzung ..Tibetan Mark Ngas Bzung+ {0x00f39, 0x00f39}, // Tibetan Mark Tsa -phru ..Tibetan Mark Tsa -phru+ {0x00f71, 0x00f7e}, // Tibetan Vowel Sign Aa ..Tibetan Sign Rjes Su Nga+ {0x00f80, 0x00f84}, // Tibetan Vowel Sign Rever..Tibetan Mark Halanta+ {0x00f86, 0x00f87}, // Tibetan Sign Lci Rtags ..Tibetan Sign Yang Rtags+ {0x00f8d, 0x00f97}, // Tibetan Subjoined Sign L..Tibetan Subjoined Letter+ {0x00f99, 0x00fbc}, // Tibetan Subjoined Letter..Tibetan Subjoined Letter+ {0x00fc6, 0x00fc6}, // Tibetan Symbol Padma Gda..Tibetan Symbol Padma Gda+ {0x0102d, 0x01030}, // Myanmar Vowel Sign I ..Myanmar Vowel Sign Uu+ {0x01032, 0x01037}, // Myanmar Vowel Sign Ai ..Myanmar Sign Dot Below+ {0x01039, 0x0103a}, // Myanmar Sign Virama ..Myanmar Sign Asat+ {0x0103d, 0x0103e}, // Myanmar Consonant Sign M..Myanmar Consonant Sign M+ {0x01058, 0x01059}, // Myanmar Vowel Sign Vocal..Myanmar Vowel Sign Vocal+ {0x0105e, 0x01060}, // Myanmar Consonant Sign M..Myanmar Consonant Sign M+ {0x01071, 0x01074}, // Myanmar Vowel Sign Geba ..Myanmar Vowel Sign Kayah+ {0x01082, 0x01082}, // Myanmar Consonant Sign S..Myanmar Consonant Sign S+ {0x01085, 0x01086}, // Myanmar Vowel Sign Shan ..Myanmar Vowel Sign Shan+ {0x0108d, 0x0108d}, // Myanmar Sign Shan Counci..Myanmar Sign Shan Counci+ {0x0109d, 0x0109d}, // Myanmar Vowel Sign Aiton..Myanmar Vowel Sign Aiton+ {0x0135d, 0x0135f}, // Ethiopic Combining Gemin..Ethiopic Combining Gemin+ {0x01712, 0x01714}, // Tagalog Vowel Sign I ..Tagalog Sign Virama+ {0x01732, 0x01733}, // Hanunoo Vowel Sign I ..Hanunoo Vowel Sign U+ {0x01752, 0x01753}, // Buhid Vowel Sign I ..Buhid Vowel Sign U+ {0x01772, 0x01773}, // Tagbanwa Vowel Sign I ..Tagbanwa Vowel Sign U+ {0x017b4, 0x017b5}, // Khmer Vowel Inherent Aq ..Khmer Vowel Inherent Aa+ {0x017b7, 0x017bd}, // Khmer Vowel Sign I ..Khmer Vowel Sign Ua+ {0x017c6, 0x017c6}, // Khmer Sign Nikahit ..Khmer Sign Nikahit+ {0x017c9, 0x017d3}, // Khmer Sign Muusikatoan ..Khmer Sign Bathamasat+ {0x017dd, 0x017dd}, // Khmer Sign Atthacan ..Khmer Sign Atthacan+ {0x0180b, 0x0180d}, // Mongolian Free Variation..Mongolian Free Variation+ {0x0180f, 0x0180f}, // Mongolian Free Variation..Mongolian Free Variation+ {0x01885, 0x01886}, // Mongolian Letter Ali Gal..Mongolian Letter Ali Gal+ {0x018a9, 0x018a9}, // Mongolian Letter Ali Gal..Mongolian Letter Ali Gal+ {0x01920, 0x01922}, // Limbu Vowel Sign A ..Limbu Vowel Sign U+ {0x01927, 0x01928}, // Limbu Vowel Sign E ..Limbu Vowel Sign O+ {0x01932, 0x01932}, // Limbu Small Letter Anusv..Limbu Small Letter Anusv+ {0x01939, 0x0193b}, // Limbu Sign Mukphreng ..Limbu Sign Sa-i+ {0x01a17, 0x01a18}, // Buginese Vowel Sign I ..Buginese Vowel Sign U+ {0x01a1b, 0x01a1b}, // Buginese Vowel Sign Ae ..Buginese Vowel Sign Ae+ {0x01a56, 0x01a56}, // Tai Tham Consonant Sign ..Tai Tham Consonant Sign+ {0x01a58, 0x01a5e}, // Tai Tham Sign Mai Kang L..Tai Tham Consonant Sign+ {0x01a60, 0x01a60}, // Tai Tham Sign Sakot ..Tai Tham Sign Sakot+ {0x01a62, 0x01a62}, // Tai Tham Vowel Sign Mai ..Tai Tham Vowel Sign Mai+ {0x01a65, 0x01a6c}, // Tai Tham Vowel Sign I ..Tai Tham Vowel Sign Oa B+ {0x01a73, 0x01a7c}, // Tai Tham Vowel Sign Oa A..Tai Tham Sign Khuen-lue+ {0x01a7f, 0x01a7f}, // Tai Tham Combining Crypt..Tai Tham Combining Crypt+ {0x01ab0, 0x01ace}, // Combining Doubled Circum..Combining Latin Small Le+ {0x01b00, 0x01b03}, // Balinese Sign Ulu Ricem ..Balinese Sign Surang+ {0x01b34, 0x01b34}, // Balinese Sign Rerekan ..Balinese Sign Rerekan+ {0x01b36, 0x01b3a}, // Balinese Vowel Sign Ulu ..Balinese Vowel Sign Ra R+ {0x01b3c, 0x01b3c}, // Balinese Vowel Sign La L..Balinese Vowel Sign La L+ {0x01b42, 0x01b42}, // Balinese Vowel Sign Pepe..Balinese Vowel Sign Pepe+ {0x01b6b, 0x01b73}, // Balinese Musical Symbol ..Balinese Musical Symbol+ {0x01b80, 0x01b81}, // Sundanese Sign Panyecek ..Sundanese Sign Panglayar+ {0x01ba2, 0x01ba5}, // Sundanese Consonant Sign..Sundanese Vowel Sign Pan+ {0x01ba8, 0x01ba9}, // Sundanese Vowel Sign Pam..Sundanese Vowel Sign Pan+ {0x01bab, 0x01bad}, // Sundanese Sign Virama ..Sundanese Consonant Sign+ {0x01be6, 0x01be6}, // Batak Sign Tompi ..Batak Sign Tompi+ {0x01be8, 0x01be9}, // Batak Vowel Sign Pakpak ..Batak Vowel Sign Ee+ {0x01bed, 0x01bed}, // Batak Vowel Sign Karo O ..Batak Vowel Sign Karo O+ {0x01bef, 0x01bf1}, // Batak Vowel Sign U For S..Batak Consonant Sign H+ {0x01c2c, 0x01c33}, // Lepcha Vowel Sign E ..Lepcha Consonant Sign T+ {0x01c36, 0x01c37}, // Lepcha Sign Ran ..Lepcha Sign Nukta+ {0x01cd0, 0x01cd2}, // Vedic Tone Karshana ..Vedic Tone Prenkha+ {0x01cd4, 0x01ce0}, // Vedic Sign Yajurvedic Mi..Vedic Tone Rigvedic Kash+ {0x01ce2, 0x01ce8}, // Vedic Sign Visarga Svari..Vedic Sign Visarga Anuda+ {0x01ced, 0x01ced}, // Vedic Sign Tiryak ..Vedic Sign Tiryak+ {0x01cf4, 0x01cf4}, // Vedic Tone Candra Above ..Vedic Tone Candra Above+ {0x01cf8, 0x01cf9}, // Vedic Tone Ring Above ..Vedic Tone Double Ring A+ {0x01dc0, 0x01dff}, // Combining Dotted Grave A..Combining Right Arrowhea+ {0x020d0, 0x020f0}, // Combining Left Harpoon A..Combining Asterisk Above+ {0x02cef, 0x02cf1}, // Coptic Combining Ni Abov..Coptic Combining Spiritu+ {0x02d7f, 0x02d7f}, // Tifinagh Consonant Joine..Tifinagh Consonant Joine+ {0x02de0, 0x02dff}, // Combining Cyrillic Lette..Combining Cyrillic Lette+ {0x0302a, 0x0302d}, // Ideographic Level Tone M..Ideographic Entering Ton+ {0x03099, 0x0309a}, // Combining Katakana-hirag..Combining Katakana-hirag+ {0x0a66f, 0x0a672}, // Combining Cyrillic Vzmet..Combining Cyrillic Thous+ {0x0a674, 0x0a67d}, // Combining Cyrillic Lette..Combining Cyrillic Payer+ {0x0a69e, 0x0a69f}, // Combining Cyrillic Lette..Combining Cyrillic Lette+ {0x0a6f0, 0x0a6f1}, // Bamum Combining Mark Koq..Bamum Combining Mark Tuk+ {0x0a802, 0x0a802}, // Syloti Nagri Sign Dvisva..Syloti Nagri Sign Dvisva+ {0x0a806, 0x0a806}, // Syloti Nagri Sign Hasant..Syloti Nagri Sign Hasant+ {0x0a80b, 0x0a80b}, // Syloti Nagri Sign Anusva..Syloti Nagri Sign Anusva+ {0x0a825, 0x0a826}, // Syloti Nagri Vowel Sign ..Syloti Nagri Vowel Sign+ {0x0a82c, 0x0a82c}, // Syloti Nagri Sign Altern..Syloti Nagri Sign Altern+ {0x0a8c4, 0x0a8c5}, // Saurashtra Sign Virama ..Saurashtra Sign Candrabi+ {0x0a8e0, 0x0a8f1}, // Combining Devanagari Dig..Combining Devanagari Sig+ {0x0a8ff, 0x0a8ff}, // Devanagari Vowel Sign Ay..Devanagari Vowel Sign Ay+ {0x0a926, 0x0a92d}, // Kayah Li Vowel Ue ..Kayah Li Tone Calya Plop+ {0x0a947, 0x0a951}, // Rejang Vowel Sign I ..Rejang Consonant Sign R+ {0x0a980, 0x0a982}, // Javanese Sign Panyangga ..Javanese Sign Layar+ {0x0a9b3, 0x0a9b3}, // Javanese Sign Cecak Telu..Javanese Sign Cecak Telu+ {0x0a9b6, 0x0a9b9}, // Javanese Vowel Sign Wulu..Javanese Vowel Sign Suku+ {0x0a9bc, 0x0a9bd}, // Javanese Vowel Sign Pepe..Javanese Consonant Sign+ {0x0a9e5, 0x0a9e5}, // Myanmar Sign Shan Saw ..Myanmar Sign Shan Saw+ {0x0aa29, 0x0aa2e}, // Cham Vowel Sign Aa ..Cham Vowel Sign Oe+ {0x0aa31, 0x0aa32}, // Cham Vowel Sign Au ..Cham Vowel Sign Ue+ {0x0aa35, 0x0aa36}, // Cham Consonant Sign La ..Cham Consonant Sign Wa+ {0x0aa43, 0x0aa43}, // Cham Consonant Sign Fina..Cham Consonant Sign Fina+ {0x0aa4c, 0x0aa4c}, // Cham Consonant Sign Fina..Cham Consonant Sign Fina+ {0x0aa7c, 0x0aa7c}, // Myanmar Sign Tai Laing T..Myanmar Sign Tai Laing T+ {0x0aab0, 0x0aab0}, // Tai Viet Mai Kang ..Tai Viet Mai Kang+ {0x0aab2, 0x0aab4}, // Tai Viet Vowel I ..Tai Viet Vowel U+ {0x0aab7, 0x0aab8}, // Tai Viet Mai Khit ..Tai Viet Vowel Ia+ {0x0aabe, 0x0aabf}, // Tai Viet Vowel Am ..Tai Viet Tone Mai Ek+ {0x0aac1, 0x0aac1}, // Tai Viet Tone Mai Tho ..Tai Viet Tone Mai Tho+ {0x0aaec, 0x0aaed}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign+ {0x0aaf6, 0x0aaf6}, // Meetei Mayek Virama ..Meetei Mayek Virama+ {0x0abe5, 0x0abe5}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign+ {0x0abe8, 0x0abe8}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign+ {0x0abed, 0x0abed}, // Meetei Mayek Apun Iyek ..Meetei Mayek Apun Iyek+ {0x0fb1e, 0x0fb1e}, // Hebrew Point Judeo-spani..Hebrew Point Judeo-spani+ {0x0fe00, 0x0fe0f}, // Variation Selector-1 ..Variation Selector-16+ {0x0fe20, 0x0fe2f}, // Combining Ligature Left ..Combining Cyrillic Titlo+ {0x101fd, 0x101fd}, // Phaistos Disc Sign Combi..Phaistos Disc Sign Combi+ {0x102e0, 0x102e0}, // Coptic Epact Thousands M..Coptic Epact Thousands M+ {0x10376, 0x1037a}, // Combining Old Permic Let..Combining Old Permic Let+ {0x10a01, 0x10a03}, // Kharoshthi Vowel Sign I ..Kharoshthi Vowel Sign Vo+ {0x10a05, 0x10a06}, // Kharoshthi Vowel Sign E ..Kharoshthi Vowel Sign O+ {0x10a0c, 0x10a0f}, // Kharoshthi Vowel Length ..Kharoshthi Sign Visarga+ {0x10a38, 0x10a3a}, // Kharoshthi Sign Bar Abov..Kharoshthi Sign Dot Belo+ {0x10a3f, 0x10a3f}, // Kharoshthi Virama ..Kharoshthi Virama+ {0x10ae5, 0x10ae6}, // Manichaean Abbreviation ..Manichaean Abbreviation+ {0x10d24, 0x10d27}, // Hanifi Rohingya Sign Har..Hanifi Rohingya Sign Tas+ {0x10eab, 0x10eac}, // Yezidi Combining Hamza M..Yezidi Combining Madda M+ {0x10efd, 0x10eff}, // (nil) ..(nil)+ {0x10f46, 0x10f50}, // Sogdian Combining Dot Be..Sogdian Combining Stroke+ {0x10f82, 0x10f85}, // Old Uyghur Combining Dot..Old Uyghur Combining Two+ {0x11001, 0x11001}, // Brahmi Sign Anusvara ..Brahmi Sign Anusvara+ {0x11038, 0x11046}, // Brahmi Vowel Sign Aa ..Brahmi Virama+ {0x11070, 0x11070}, // Brahmi Sign Old Tamil Vi..Brahmi Sign Old Tamil Vi+ {0x11073, 0x11074}, // Brahmi Vowel Sign Old Ta..Brahmi Vowel Sign Old Ta+ {0x1107f, 0x11081}, // Brahmi Number Joiner ..Kaithi Sign Anusvara+ {0x110b3, 0x110b6}, // Kaithi Vowel Sign U ..Kaithi Vowel Sign Ai+ {0x110b9, 0x110ba}, // Kaithi Sign Virama ..Kaithi Sign Nukta+ {0x110c2, 0x110c2}, // Kaithi Vowel Sign Vocali..Kaithi Vowel Sign Vocali+ {0x11100, 0x11102}, // Chakma Sign Candrabindu ..Chakma Sign Visarga+ {0x11127, 0x1112b}, // Chakma Vowel Sign A ..Chakma Vowel Sign Uu+ {0x1112d, 0x11134}, // Chakma Vowel Sign Ai ..Chakma Maayyaa+ {0x11173, 0x11173}, // Mahajani Sign Nukta ..Mahajani Sign Nukta+ {0x11180, 0x11181}, // Sharada Sign Candrabindu..Sharada Sign Anusvara+ {0x111b6, 0x111be}, // Sharada Vowel Sign U ..Sharada Vowel Sign O+ {0x111c9, 0x111cc}, // Sharada Sandhi Mark ..Sharada Extra Short Vowe+ {0x111cf, 0x111cf}, // Sharada Sign Inverted Ca..Sharada Sign Inverted Ca+ {0x1122f, 0x11231}, // Khojki Vowel Sign U ..Khojki Vowel Sign Ai+ {0x11234, 0x11234}, // Khojki Sign Anusvara ..Khojki Sign Anusvara+ {0x11236, 0x11237}, // Khojki Sign Nukta ..Khojki Sign Shadda+ {0x1123e, 0x1123e}, // Khojki Sign Sukun ..Khojki Sign Sukun+ {0x11241, 0x11241}, // (nil) ..(nil)+ {0x112df, 0x112df}, // Khudawadi Sign Anusvara ..Khudawadi Sign Anusvara+ {0x112e3, 0x112ea}, // Khudawadi Vowel Sign U ..Khudawadi Sign Virama+ {0x11300, 0x11301}, // Grantha Sign Combining A..Grantha Sign Candrabindu+ {0x1133b, 0x1133c}, // Combining Bindu Below ..Grantha Sign Nukta+ {0x11340, 0x11340}, // Grantha Vowel Sign Ii ..Grantha Vowel Sign Ii+ {0x11366, 0x1136c}, // Combining Grantha Digit ..Combining Grantha Digit+ {0x11370, 0x11374}, // Combining Grantha Letter..Combining Grantha Letter+ {0x11438, 0x1143f}, // Newa Vowel Sign U ..Newa Vowel Sign Ai+ {0x11442, 0x11444}, // Newa Sign Virama ..Newa Sign Anusvara+ {0x11446, 0x11446}, // Newa Sign Nukta ..Newa Sign Nukta+ {0x1145e, 0x1145e}, // Newa Sandhi Mark ..Newa Sandhi Mark+ {0x114b3, 0x114b8}, // Tirhuta Vowel Sign U ..Tirhuta Vowel Sign Vocal+ {0x114ba, 0x114ba}, // Tirhuta Vowel Sign Short..Tirhuta Vowel Sign Short+ {0x114bf, 0x114c0}, // Tirhuta Sign Candrabindu..Tirhuta Sign Anusvara+ {0x114c2, 0x114c3}, // Tirhuta Sign Virama ..Tirhuta Sign Nukta+ {0x115b2, 0x115b5}, // Siddham Vowel Sign U ..Siddham Vowel Sign Vocal+ {0x115bc, 0x115bd}, // Siddham Sign Candrabindu..Siddham Sign Anusvara+ {0x115bf, 0x115c0}, // Siddham Sign Virama ..Siddham Sign Nukta+ {0x115dc, 0x115dd}, // Siddham Vowel Sign Alter..Siddham Vowel Sign Alter+ {0x11633, 0x1163a}, // Modi Vowel Sign U ..Modi Vowel Sign Ai+ {0x1163d, 0x1163d}, // Modi Sign Anusvara ..Modi Sign Anusvara+ {0x1163f, 0x11640}, // Modi Sign Virama ..Modi Sign Ardhacandra+ {0x116ab, 0x116ab}, // Takri Sign Anusvara ..Takri Sign Anusvara+ {0x116ad, 0x116ad}, // Takri Vowel Sign Aa ..Takri Vowel Sign Aa+ {0x116b0, 0x116b5}, // Takri Vowel Sign U ..Takri Vowel Sign Au+ {0x116b7, 0x116b7}, // Takri Sign Nukta ..Takri Sign Nukta+ {0x1171d, 0x1171f}, // Ahom Consonant Sign Medi..Ahom Consonant Sign Medi+ {0x11722, 0x11725}, // Ahom Vowel Sign I ..Ahom Vowel Sign Uu+ {0x11727, 0x1172b}, // Ahom Vowel Sign Aw ..Ahom Sign Killer+ {0x1182f, 0x11837}, // Dogra Vowel Sign U ..Dogra Sign Anusvara+ {0x11839, 0x1183a}, // Dogra Sign Virama ..Dogra Sign Nukta+ {0x1193b, 0x1193c}, // Dives Akuru Sign Anusvar..Dives Akuru Sign Candrab+ {0x1193e, 0x1193e}, // Dives Akuru Virama ..Dives Akuru Virama+ {0x11943, 0x11943}, // Dives Akuru Sign Nukta ..Dives Akuru Sign Nukta+ {0x119d4, 0x119d7}, // Nandinagari Vowel Sign U..Nandinagari Vowel Sign V+ {0x119da, 0x119db}, // Nandinagari Vowel Sign E..Nandinagari Vowel Sign A+ {0x119e0, 0x119e0}, // Nandinagari Sign Virama ..Nandinagari Sign Virama+ {0x11a01, 0x11a0a}, // Zanabazar Square Vowel S..Zanabazar Square Vowel L+ {0x11a33, 0x11a38}, // Zanabazar Square Final C..Zanabazar Square Sign An+ {0x11a3b, 0x11a3e}, // Zanabazar Square Cluster..Zanabazar Square Cluster+ {0x11a47, 0x11a47}, // Zanabazar Square Subjoin..Zanabazar Square Subjoin+ {0x11a51, 0x11a56}, // Soyombo Vowel Sign I ..Soyombo Vowel Sign Oe+ {0x11a59, 0x11a5b}, // Soyombo Vowel Sign Vocal..Soyombo Vowel Length Mar+ {0x11a8a, 0x11a96}, // Soyombo Final Consonant ..Soyombo Sign Anusvara+ {0x11a98, 0x11a99}, // Soyombo Gemination Mark ..Soyombo Subjoiner+ {0x11c30, 0x11c36}, // Bhaiksuki Vowel Sign I ..Bhaiksuki Vowel Sign Voc+ {0x11c38, 0x11c3d}, // Bhaiksuki Vowel Sign E ..Bhaiksuki Sign Anusvara+ {0x11c3f, 0x11c3f}, // Bhaiksuki Sign Virama ..Bhaiksuki Sign Virama+ {0x11c92, 0x11ca7}, // Marchen Subjoined Letter..Marchen Subjoined Letter+ {0x11caa, 0x11cb0}, // Marchen Subjoined Letter..Marchen Vowel Sign Aa+ {0x11cb2, 0x11cb3}, // Marchen Vowel Sign U ..Marchen Vowel Sign E+ {0x11cb5, 0x11cb6}, // Marchen Sign Anusvara ..Marchen Sign Candrabindu+ {0x11d31, 0x11d36}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign+ {0x11d3a, 0x11d3a}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign+ {0x11d3c, 0x11d3d}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign+ {0x11d3f, 0x11d45}, // Masaram Gondi Vowel Sign..Masaram Gondi Virama+ {0x11d47, 0x11d47}, // Masaram Gondi Ra-kara ..Masaram Gondi Ra-kara+ {0x11d90, 0x11d91}, // Gunjala Gondi Vowel Sign..Gunjala Gondi Vowel Sign+ {0x11d95, 0x11d95}, // Gunjala Gondi Sign Anusv..Gunjala Gondi Sign Anusv+ {0x11d97, 0x11d97}, // Gunjala Gondi Virama ..Gunjala Gondi Virama+ {0x11ef3, 0x11ef4}, // Makasar Vowel Sign I ..Makasar Vowel Sign U+ {0x11f00, 0x11f01}, // (nil) ..(nil)+ {0x11f36, 0x11f3a}, // (nil) ..(nil)+ {0x11f40, 0x11f40}, // (nil) ..(nil)+ {0x11f42, 0x11f42}, // (nil) ..(nil)+ {0x13440, 0x13440}, // (nil) ..(nil)+ {0x13447, 0x13455}, // (nil) ..(nil)+ {0x16af0, 0x16af4}, // Bassa Vah Combining High..Bassa Vah Combining High+ {0x16b30, 0x16b36}, // Pahawh Hmong Mark Cim Tu..Pahawh Hmong Mark Cim Ta+ {0x16f4f, 0x16f4f}, // Miao Sign Consonant Modi..Miao Sign Consonant Modi+ {0x16f8f, 0x16f92}, // Miao Tone Right ..Miao Tone Below+ {0x16fe4, 0x16fe4}, // Khitan Small Script Fill..Khitan Small Script Fill+ {0x1bc9d, 0x1bc9e}, // Duployan Thick Letter Se..Duployan Double Mark+ {0x1cf00, 0x1cf2d}, // Znamenny Combining Mark ..Znamenny Combining Mark+ {0x1cf30, 0x1cf46}, // Znamenny Combining Tonal..Znamenny Priznak Modifie+ {0x1d167, 0x1d169}, // Musical Symbol Combining..Musical Symbol Combining+ {0x1d17b, 0x1d182}, // Musical Symbol Combining..Musical Symbol Combining+ {0x1d185, 0x1d18b}, // Musical Symbol Combining..Musical Symbol Combining+ {0x1d1aa, 0x1d1ad}, // Musical Symbol Combining..Musical Symbol Combining+ {0x1d242, 0x1d244}, // Combining Greek Musical ..Combining Greek Musical+ {0x1da00, 0x1da36}, // Signwriting Head Rim ..Signwriting Air Sucking+ {0x1da3b, 0x1da6c}, // Signwriting Mouth Closed..Signwriting Excitement+ {0x1da75, 0x1da75}, // Signwriting Upper Body T..Signwriting Upper Body T+ {0x1da84, 0x1da84}, // Signwriting Location Hea..Signwriting Location Hea+ {0x1da9b, 0x1da9f}, // Signwriting Fill Modifie..Signwriting Fill Modifie+ {0x1daa1, 0x1daaf}, // Signwriting Rotation Mod..Signwriting Rotation Mod+ {0x1e000, 0x1e006}, // Combining Glagolitic Let..Combining Glagolitic Let+ {0x1e008, 0x1e018}, // Combining Glagolitic Let..Combining Glagolitic Let+ {0x1e01b, 0x1e021}, // Combining Glagolitic Let..Combining Glagolitic Let+ {0x1e023, 0x1e024}, // Combining Glagolitic Let..Combining Glagolitic Let+ {0x1e026, 0x1e02a}, // Combining Glagolitic Let..Combining Glagolitic Let+ {0x1e08f, 0x1e08f}, // (nil) ..(nil)+ {0x1e130, 0x1e136}, // Nyiakeng Puachue Hmong T..Nyiakeng Puachue Hmong T+ {0x1e2ae, 0x1e2ae}, // Toto Sign Rising Tone ..Toto Sign Rising Tone+ {0x1e2ec, 0x1e2ef}, // Wancho Tone Tup ..Wancho Tone Koini+ {0x1e4ec, 0x1e4ef}, // (nil) ..(nil)+ {0x1e8d0, 0x1e8d6}, // Mende Kikakui Combining ..Mende Kikakui Combining+ {0x1e944, 0x1e94a}, // Adlam Alif Lengthener ..Adlam Nukta+ {0xe0100, 0xe01ef}, // Variation Selector-17 ..Variation Selector-256+};
+
+// https://github.com/jquast/wcwidth/blob/master/wcwidth/table_wide.py
+// from https://github.com/jquast/wcwidth/pull/64
+// at commit 1b9b6585b0080ea5cb88dc9815796505724793fe (2022-12-16):
+static struct width_interval WIDE_EASTASIAN[] = {+ {0x01100, 0x0115f}, // Hangul Choseong Kiyeok ..Hangul Choseong Filler+ {0x0231a, 0x0231b}, // Watch ..Hourglass+ {0x02329, 0x0232a}, // Left-pointing Angle Brac..Right-pointing Angle Bra+ {0x023e9, 0x023ec}, // Black Right-pointing Dou..Black Down-pointing Doub+ {0x023f0, 0x023f0}, // Alarm Clock ..Alarm Clock+ {0x023f3, 0x023f3}, // Hourglass With Flowing S..Hourglass With Flowing S+ {0x025fd, 0x025fe}, // White Medium Small Squar..Black Medium Small Squar+ {0x02614, 0x02615}, // Umbrella With Rain Drops..Hot Beverage+ {0x02648, 0x02653}, // Aries ..Pisces+ {0x0267f, 0x0267f}, // Wheelchair Symbol ..Wheelchair Symbol+ {0x02693, 0x02693}, // Anchor ..Anchor+ {0x026a1, 0x026a1}, // High Voltage Sign ..High Voltage Sign+ {0x026aa, 0x026ab}, // Medium White Circle ..Medium Black Circle+ {0x026bd, 0x026be}, // Soccer Ball ..Baseball+ {0x026c4, 0x026c5}, // Snowman Without Snow ..Sun Behind Cloud+ {0x026ce, 0x026ce}, // Ophiuchus ..Ophiuchus+ {0x026d4, 0x026d4}, // No Entry ..No Entry+ {0x026ea, 0x026ea}, // Church ..Church+ {0x026f2, 0x026f3}, // Fountain ..Flag In Hole+ {0x026f5, 0x026f5}, // Sailboat ..Sailboat+ {0x026fa, 0x026fa}, // Tent ..Tent+ {0x026fd, 0x026fd}, // Fuel Pump ..Fuel Pump+ {0x02705, 0x02705}, // White Heavy Check Mark ..White Heavy Check Mark+ {0x0270a, 0x0270b}, // Raised Fist ..Raised Hand+ {0x02728, 0x02728}, // Sparkles ..Sparkles+ {0x0274c, 0x0274c}, // Cross Mark ..Cross Mark+ {0x0274e, 0x0274e}, // Negative Squared Cross M..Negative Squared Cross M+ {0x02753, 0x02755}, // Black Question Mark Orna..White Exclamation Mark O+ {0x02757, 0x02757}, // Heavy Exclamation Mark S..Heavy Exclamation Mark S+ {0x02795, 0x02797}, // Heavy Plus Sign ..Heavy Division Sign+ {0x027b0, 0x027b0}, // Curly Loop ..Curly Loop+ {0x027bf, 0x027bf}, // Double Curly Loop ..Double Curly Loop+ {0x02b1b, 0x02b1c}, // Black Large Square ..White Large Square+ {0x02b50, 0x02b50}, // White Medium Star ..White Medium Star+ {0x02b55, 0x02b55}, // Heavy Large Circle ..Heavy Large Circle+ {0x02e80, 0x02e99}, // Cjk Radical Repeat ..Cjk Radical Rap+ {0x02e9b, 0x02ef3}, // Cjk Radical Choke ..Cjk Radical C-simplified+ {0x02f00, 0x02fd5}, // Kangxi Radical One ..Kangxi Radical Flute+ {0x02ff0, 0x02ffb}, // Ideographic Description ..Ideographic Description+ {0x03000, 0x0303e}, // Ideographic Space ..Ideographic Variation In+ {0x03041, 0x03096}, // Hiragana Letter Small A ..Hiragana Letter Small Ke+ {0x03099, 0x030ff}, // Combining Katakana-hirag..Katakana Digraph Koto+ {0x03105, 0x0312f}, // Bopomofo Letter B ..Bopomofo Letter Nn+ {0x03131, 0x0318e}, // Hangul Letter Kiyeok ..Hangul Letter Araeae+ {0x03190, 0x031e3}, // Ideographic Annotation L..Cjk Stroke Q+ {0x031f0, 0x0321e}, // Katakana Letter Small Ku..Parenthesized Korean Cha+ {0x03220, 0x03247}, // Parenthesized Ideograph ..Circled Ideograph Koto+ {0x03250, 0x04dbf}, // Partnership Sign ..Cjk Unified Ideograph-4d+ {0x04e00, 0x0a48c}, // Cjk Unified Ideograph-4e..Yi Syllable Yyr+ {0x0a490, 0x0a4c6}, // Yi Radical Qot ..Yi Radical Ke+ {0x0a960, 0x0a97c}, // Hangul Choseong Tikeut-m..Hangul Choseong Ssangyeo+ {0x0ac00, 0x0d7a3}, // Hangul Syllable Ga ..Hangul Syllable Hih+ {0x0f900, 0x0faff}, // Cjk Compatibility Ideogr..(nil)+ {0x0fe10, 0x0fe19}, // Presentation Form For Ve..Presentation Form For Ve+ {0x0fe30, 0x0fe52}, // Presentation Form For Ve..Small Full Stop+ {0x0fe54, 0x0fe66}, // Small Semicolon ..Small Equals Sign+ {0x0fe68, 0x0fe6b}, // Small Reverse Solidus ..Small Commercial At+ {0x0ff01, 0x0ff60}, // Fullwidth Exclamation Ma..Fullwidth Right White Pa+ {0x0ffe0, 0x0ffe6}, // Fullwidth Cent Sign ..Fullwidth Won Sign+ {0x16fe0, 0x16fe4}, // Tangut Iteration Mark ..Khitan Small Script Fill+ {0x16ff0, 0x16ff1}, // Vietnamese Alternate Rea..Vietnamese Alternate Rea+ {0x17000, 0x187f7}, // (nil) ..(nil)+ {0x18800, 0x18cd5}, // Tangut Component-001 ..Khitan Small Script Char+ {0x18d00, 0x18d08}, // (nil) ..(nil)+ {0x1aff0, 0x1aff3}, // Katakana Letter Minnan T..Katakana Letter Minnan T+ {0x1aff5, 0x1affb}, // Katakana Letter Minnan T..Katakana Letter Minnan N+ {0x1affd, 0x1affe}, // Katakana Letter Minnan N..Katakana Letter Minnan N+ {0x1b000, 0x1b122}, // Katakana Letter Archaic ..Katakana Letter Archaic+ {0x1b132, 0x1b132}, // (nil) ..(nil)+ {0x1b150, 0x1b152}, // Hiragana Letter Small Wi..Hiragana Letter Small Wo+ {0x1b155, 0x1b155}, // (nil) ..(nil)+ {0x1b164, 0x1b167}, // Katakana Letter Small Wi..Katakana Letter Small N+ {0x1b170, 0x1b2fb}, // Nushu Character-1b170 ..Nushu Character-1b2fb+ {0x1f004, 0x1f004}, // Mahjong Tile Red Dragon ..Mahjong Tile Red Dragon+ {0x1f0cf, 0x1f0cf}, // Playing Card Black Joker..Playing Card Black Joker+ {0x1f18e, 0x1f18e}, // Negative Squared Ab ..Negative Squared Ab+ {0x1f191, 0x1f19a}, // Squared Cl ..Squared Vs+ {0x1f200, 0x1f202}, // Square Hiragana Hoka ..Squared Katakana Sa+ {0x1f210, 0x1f23b}, // Squared Cjk Unified Ideo..Squared Cjk Unified Ideo+ {0x1f240, 0x1f248}, // Tortoise Shell Bracketed..Tortoise Shell Bracketed+ {0x1f250, 0x1f251}, // Circled Ideograph Advant..Circled Ideograph Accept+ {0x1f260, 0x1f265}, // Rounded Symbol For Fu ..Rounded Symbol For Cai+ {0x1f300, 0x1f320}, // Cyclone ..Shooting Star+ {0x1f32d, 0x1f335}, // Hot Dog ..Cactus+ {0x1f337, 0x1f37c}, // Tulip ..Baby Bottle+ {0x1f37e, 0x1f393}, // Bottle With Popping Cork..Graduation Cap+ {0x1f3a0, 0x1f3ca}, // Carousel Horse ..Swimmer+ {0x1f3cf, 0x1f3d3}, // Cricket Bat And Ball ..Table Tennis Paddle And+ {0x1f3e0, 0x1f3f0}, // House Building ..European Castle+ {0x1f3f4, 0x1f3f4}, // Waving Black Flag ..Waving Black Flag+ {0x1f3f8, 0x1f43e}, // Badminton Racquet And Sh..Paw Prints+ {0x1f440, 0x1f440}, // Eyes ..Eyes+ {0x1f442, 0x1f4fc}, // Ear ..Videocassette+ {0x1f4ff, 0x1f53d}, // Prayer Beads ..Down-pointing Small Red+ {0x1f54b, 0x1f54e}, // Kaaba ..Menorah With Nine Branch+ {0x1f550, 0x1f567}, // Clock Face One Oclock ..Clock Face Twelve-thirty+ {0x1f57a, 0x1f57a}, // Man Dancing ..Man Dancing+ {0x1f595, 0x1f596}, // Reversed Hand With Middl..Raised Hand With Part Be+ {0x1f5a4, 0x1f5a4}, // Black Heart ..Black Heart+ {0x1f5fb, 0x1f64f}, // Mount Fuji ..Person With Folded Hands+ {0x1f680, 0x1f6c5}, // Rocket ..Left Luggage+ {0x1f6cc, 0x1f6cc}, // Sleeping Accommodation ..Sleeping Accommodation+ {0x1f6d0, 0x1f6d2}, // Place Of Worship ..Shopping Trolley+ {0x1f6d5, 0x1f6d7}, // Hindu Temple ..Elevator+ {0x1f6dc, 0x1f6df}, // (nil) ..Ring Buoy+ {0x1f6eb, 0x1f6ec}, // Airplane Departure ..Airplane Arriving+ {0x1f6f4, 0x1f6fc}, // Scooter ..Roller Skate+ {0x1f7e0, 0x1f7eb}, // Large Orange Circle ..Large Brown Square+ {0x1f7f0, 0x1f7f0}, // Heavy Equals Sign ..Heavy Equals Sign+ {0x1f90c, 0x1f93a}, // Pinched Fingers ..Fencer+ {0x1f93c, 0x1f945}, // Wrestlers ..Goal Net+ {0x1f947, 0x1f9ff}, // First Place Medal ..Nazar Amulet+ {0x1fa70, 0x1fa7c}, // Ballet Shoes ..Crutch+ {0x1fa80, 0x1fa88}, // Yo-yo ..(nil)+ {0x1fa90, 0x1fabd}, // Ringed Planet ..(nil)+ {0x1fabf, 0x1fac5}, // (nil) ..Person With Crown+ {0x1face, 0x1fadb}, // (nil) ..(nil)+ {0x1fae0, 0x1fae8}, // Melting Face ..(nil)+ {0x1faf0, 0x1faf8}, // Hand With Index Finger A..(nil)+ {0x20000, 0x2fffd}, // Cjk Unified Ideograph-20..(nil)+ {0x30000, 0x3fffd}, // Cjk Unified Ideograph-30..(nil)+};
+
+static bool intable(struct width_interval* table, int table_length, int c) {+ // First quick check for Latin1 etc. characters.
+ if (c < table[0].start) return false;
+
+ // Binary search in table.
+ int bot = 0;
+ int top = table_length - 1;
+ while (top >= bot) {+ int mid = (bot + top) / 2;
+ if (table[mid].end < c) {+ bot = mid + 1;
+ } else if (table[mid].start > c) {+ top = mid - 1;
+ } else {+ return true;
+ }
+ }
+ return false;
+}
+
+int wcwidth(wchar_t ucs) {+ // NOTE: created by hand, there isn't anything identifiable other than
+ // general Cf category code to identify these, and some characters in Cf
+ // category code are of non-zero width.
+ if (ucs == 0 ||
+ ucs == 0x034F ||
+ (0x200B <= ucs && ucs <= 0x200F) ||
+ ucs == 0x2028 ||
+ ucs == 0x2029 ||
+ (0x202A <= ucs && ucs <= 0x202E) ||
+ (0x2060 <= ucs && ucs <= 0x2063)) {+ return 0;
+ }
+
+ // C0/C1 control characters.
+ if (ucs < 32 || (0x07F <= ucs && ucs < 0x0A0)) return -1;
+
+ // Combining characters with zero width.
+ if (intable(ZERO_WIDTH, sizeof(ZERO_WIDTH)/sizeof(struct width_interval), ucs)) return 0;
+
+ return intable(WIDE_EASTASIAN, sizeof(WIDE_EASTASIAN)/sizeof(struct width_interval), ucs) ? 2 : 1;
+}
--- a/Makefile
+++ b/Makefile
@@ -4,7 +4,7 @@
TARG=flisp
CFLAGS?=-O2 -g
-CFLAGS+=-Wall -Wextra -Wno-parentheses -std=c99
+CFLAGS+=-Wall -Wextra -Wno-parentheses -std=c99 -I3rd -Illt -Iposix
LDFLAGS?=
OBJS=\
@@ -27,33 +27,33 @@
llt/random.o\
llt/timefuncs.o\
llt/utf8.o\
- mp/mpadd.o\
- mp/mpaux.o\
- mp/mpcmp.o\
- mp/mpdigdiv.o\
- mp/mpdiv.o\
- mp/mpfmt.o\
- mp/mpleft.o\
- mp/mplogic.o\
- mp/mpmul.o\
- mp/mpright.o\
- mp/mpsub.o\
- mp/mptobe.o\
- mp/mptober.o\
- mp/mptod.o\
- mp/mptoi.o\
- mp/mptoui.o\
- mp/mptouv.o\
- mp/mptov.o\
- mp/mpvecadd.o\
- mp/mpveccmp.o\
- mp/mpvecdigmuladd.o\
- mp/mpvecsub.o\
- mp/mpvectscmp.o\
- mp/strtomp.o\
- mp/u16.o\
- mp/u32.o\
- mp/u64.o\
+ 3rd/mp/mpadd.o\
+ 3rd/mp/mpaux.o\
+ 3rd/mp/mpcmp.o\
+ 3rd/mp/mpdigdiv.o\
+ 3rd/mp/mpdiv.o\
+ 3rd/mp/mpfmt.o\
+ 3rd/mp/mpleft.o\
+ 3rd/mp/mplogic.o\
+ 3rd/mp/mpmul.o\
+ 3rd/mp/mpright.o\
+ 3rd/mp/mpsub.o\
+ 3rd/mp/mptobe.o\
+ 3rd/mp/mptober.o\
+ 3rd/mp/mptod.o\
+ 3rd/mp/mptoi.o\
+ 3rd/mp/mptoui.o\
+ 3rd/mp/mptouv.o\
+ 3rd/mp/mptov.o\
+ 3rd/mp/mpvecadd.o\
+ 3rd/mp/mpveccmp.o\
+ 3rd/mp/mpvecdigmuladd.o\
+ 3rd/mp/mpvecsub.o\
+ 3rd/mp/mpvectscmp.o\
+ 3rd/mp/strtomp.o\
+ 3rd/mp/u16.o\
+ 3rd/mp/u32.o\
+ 3rd/mp/u64.o\
.PHONY: all default test clean
@@ -69,7 +69,7 @@
.SUFFIXES: .c .o
.c.o:
- ${CC} -o $@ -c $< ${CFLAGS} -Iposix -Illt+ ${CC} -o $@ -c $< ${CFLAGS}flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc opcodes.h builtin_fns.h
flmain.o: flmain.c boot.h flisp.h
--- a/builtins.c
+++ b/builtins.c
@@ -5,155 +5,154 @@
#include "llt.h"
#include "flisp.h"
-size_t llength(value_t v)
+size_t
+llength(value_t v)
{- size_t n = 0;
- while (iscons(v)) {- n++;
- v = cdr_(v);
- }
- return n;
+ size_t n = 0;
+ while(iscons(v)){+ n++;
+ v = cdr_(v);
+ }
+ return n;
}
BUILTIN("nconc", nconc) {- if (nargs == 0)
- return FL_NIL;
- value_t lst, first=FL_NIL;
- value_t *pcdr = &first;
- cons_t *c;
- int i=0;
- while (1) {- lst = args[i++];
- if (i >= nargs) break;
- if (iscons(lst)) {- *pcdr = lst;
- c = (cons_t*)ptr(lst);
- while (iscons(c->cdr))
- c = (cons_t*)ptr(c->cdr);
- pcdr = &c->cdr;
- }
- else if (lst != FL_NIL) {- type_error("cons", lst);- }
- }
- *pcdr = lst;
- return first;
+ if(nargs == 0)
+ return FL_NIL;
+
+ value_t lst, first = FL_NIL;
+ value_t *pcdr = &first;
+ cons_t *c;
+ int i = 0;
+
+ while(1){+ lst = args[i++];
+ if(i >= nargs)
+ break;
+ if(iscons(lst)){+ *pcdr = lst;
+ c = (cons_t*)ptr(lst);
+ while(iscons(c->cdr))
+ c = (cons_t*)ptr(c->cdr);
+ pcdr = &c->cdr;
+ }else if(lst != FL_NIL)
+ type_error("cons", lst);+ }
+ *pcdr = lst;
+ return first;
}
BUILTIN("assq", assq) {- argcount(nargs, 2);
- value_t item = args[0];
- value_t v = args[1];
- value_t bind;
+ argcount(nargs, 2);
- while (iscons(v)) {- bind = car_(v);
- if (iscons(bind) && car_(bind) == item)
- return bind;
- v = cdr_(v);
- }
- return FL_F;
+ value_t item = args[0];
+ value_t v = args[1];
+ value_t bind;
+
+ while(iscons(v)){+ bind = car_(v);
+ if(iscons(bind) && car_(bind) == item)
+ return bind;
+ v = cdr_(v);
+ }
+ return FL_F;
}
BUILTIN("memq", memq) {- value_t v;
- cons_t *c;
- argcount(nargs, 2);
- for (v = args[1]; iscons(v); v = c->cdr) {- if ((c = ptr(v))->car == args[0])
- return v;
- }
- return FL_F;
+ argcount(nargs, 2);
+
+ value_t v;
+ cons_t *c;
+ for(v = args[1]; iscons(v); v = c->cdr){+ if((c = ptr(v))->car == args[0])
+ return v;
+ }
+ return FL_F;
}
BUILTIN("length", length) {- argcount(nargs, 1);
- value_t a = args[0];
- cvalue_t *cv;
- if (isvector(a)) {- return fixnum(vector_size(a));
- }
- else if (iscprim(a)) {- cv = (cvalue_t*)ptr(a);
- if (cp_class(cv) == bytetype)
- return fixnum(1);
- else if (cp_class(cv) == wchartype)
- return fixnum(u8_charlen(*(uint32_t*)cp_data((cprim_t*)cv)));
- }
- else if (iscvalue(a)) {- cv = (cvalue_t*)ptr(a);
- if (cv_class(cv)->eltype != nil)
- return size_wrap(cvalue_arraylen(a));
- }
- else if (a == FL_NIL) {- return fixnum(0);
- }
- else if (iscons(a)) {- return fixnum(llength(a));
- }
- type_error("sequence", a);+ argcount(nargs, 1);
+
+ value_t a = args[0];
+ cvalue_t *cv;
+
+ if(isvector(a))
+ return fixnum(vector_size(a));
+ if(a == FL_NIL)
+ return fixnum(0);
+ if(iscons(a))
+ return fixnum(llength(a));
+ if(iscprim(a)){+ cv = (cvalue_t*)ptr(a);
+ if(cp_class(cv) == bytetype)
+ return fixnum(1);
+ if(cp_class(cv) == wchartype)
+ return fixnum(u8_charlen(*(uint32_t*)cp_data(cv)));
+ }
+ if(iscvalue(a) && cv_class(ptr(a))->eltype != nil)
+ return size_wrap(cvalue_arraylen(a));
+ type_error("sequence", a);}
BUILTIN("raise", raise) {- argcount(nargs, 1);
- fl_raise(args[0]);
+ argcount(nargs, 1);
+ fl_raise(args[0]);
}
BUILTIN("exit", exit) {- if (nargs > 0)
- exit(tofixnum(args[0]));
- exit(0);
- return FL_NIL;
+ if(nargs > 1)
+ argcount(nargs, 1);
+ exit(nargs > 0 ? tofixnum(args[0]) : 0);
+ return FL_NIL;
}
BUILTIN("symbol", symbol) {- argcount(nargs, 1);
- if (!fl_isstring(args[0]))
- type_error("string", args[0]);- return symbol(cvalue_data(args[0]));
+ argcount(nargs, 1);
+ if(!fl_isstring(args[0]))
+ type_error("string", args[0]);+ return symbol(cvalue_data(args[0]));
}
BUILTIN("keyword?", keywordp) {- argcount(nargs, 1);
- return (issymbol(args[0]) &&
- iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return (issymbol(args[0]) &&
+ iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
}
BUILTIN("top-level-value", top_level_value) {- argcount(nargs, 1);
- symbol_t *sym = tosymbol(args[0]);
- if (sym->binding == UNBOUND)
- unbound_error(args[0]);
- return sym->binding;
+ argcount(nargs, 1);
+ symbol_t *sym = tosymbol(args[0]);
+ if(sym->binding == UNBOUND)
+ unbound_error(args[0]);
+ return sym->binding;
}
BUILTIN("set-top-level-value!", set_top_level_value) {- argcount(nargs, 2);
- symbol_t *sym = tosymbol(args[0]);
- if (!isconstant(sym))
- sym->binding = args[1];
- return args[1];
+ argcount(nargs, 2);
+ symbol_t *sym = tosymbol(args[0]);
+ if(!isconstant(sym))
+ sym->binding = args[1];
+ return args[1];
}
static void global_env_list(symbol_t *root, value_t *pv)
{- while (root != nil) {- if (root->name[0] != ':' && (root->binding != UNBOUND)) {- *pv = fl_cons(tagptr(root,TAG_SYM), *pv);
- }
- global_env_list(root->left, pv);
- root = root->right;
- }
+ while(root != nil){+ if(root->name[0] != ':' && (root->binding != UNBOUND))
+ *pv = fl_cons(tagptr(root,TAG_SYM), *pv);
+ global_env_list(root->left, pv);
+ root = root->right;
+ }
}
extern symbol_t *symtab;
@@ -160,13 +159,13 @@
BUILTIN("environment", environment) {- USED(args);
- argcount(nargs, 0);
- value_t lst = FL_NIL;
- fl_gc_handle(&lst);
- global_env_list(symtab, &lst);
- fl_free_gc_handles(1);
- return lst;
+ USED(args);
+ argcount(nargs, 0);
+ value_t lst = FL_NIL;
+ fl_gc_handle(&lst);
+ global_env_list(symtab, &lst);
+ fl_free_gc_handles(1);
+ return lst;
}
extern value_t QUOTE;
@@ -173,258 +172,256 @@
BUILTIN("constant?", constantp) {- argcount(nargs, 1);
- if (issymbol(args[0]))
- return (isconstant((symbol_t*)ptr(args[0])) ? FL_T : FL_F);
- if (iscons(args[0])) {- if (car_(args[0]) == QUOTE)
- return FL_T;
- return FL_F;
- }
- return FL_T;
+ argcount(nargs, 1);
+ if(issymbol(args[0]))
+ return isconstant((symbol_t*)ptr(args[0])) ? FL_T : FL_F;
+ if(iscons(args[0])){+ if(car_(args[0]) == QUOTE)
+ return FL_T;
+ return FL_F;
+ }
+ return FL_T;
}
BUILTIN("integer-valued?", integer_valuedp) {- argcount(nargs, 1);
- value_t v = args[0];
- if (isfixnum(v)) {- return FL_T;
- }
- else if (iscprim(v)) {- numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
- if (nt < T_FLOAT)
- return FL_T;
- void *data = cp_data((cprim_t*)ptr(v));
- if (nt == T_FLOAT) {- float f = *(float*)data;
- if (f < 0) f = -f;
- if (f <= FLT_MAXINT && (float)(int32_t)f == f)
- return FL_T;
- }
- else {- assert(nt == T_DOUBLE);
- double d = *(double*)data;
- if (d < 0) d = -d;
- if (d <= DBL_MAXINT && (double)(int64_t)d == d)
- return FL_T;
- }
- }
- return FL_F;
+ argcount(nargs, 1);
+ value_t v = args[0];
+ if(isfixnum(v))
+ return FL_T;
+ if(iscprim(v)){+ numerictype_t nt = cp_numtype((cprim_t*)ptr(v));
+ if(nt < T_FLOAT)
+ return FL_T;
+ void *data = cp_data((cprim_t*)ptr(v));
+ if(nt == T_FLOAT){+ float f = *(float*)data;
+ if(f < 0)
+ f = -f;
+ if(f <= FLT_MAXINT && (float)(int32_t)f == f)
+ return FL_T;
+ }else{+ assert(nt == T_DOUBLE);
+ double d = *(double*)data;
+ if(d < 0)
+ d = -d;
+ if(d <= DBL_MAXINT && (double)(int64_t)d == d)
+ return FL_T;
+ }
+ }
+ return FL_F;
}
BUILTIN("integer?", integerp) {- argcount(nargs, 1);
- value_t v = args[0];
- return (isfixnum(v) ||
- (iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ?
- FL_T : FL_F;
+ argcount(nargs, 1);
+ value_t v = args[0];
+ return (isfixnum(v) ||
+ (iscprim(v) && cp_numtype((cprim_t*)ptr(v)) < T_FLOAT)) ?
+ FL_T : FL_F;
}
BUILTIN("fixnum", fixnum) {- argcount(nargs, 1);
- if (isfixnum(args[0])) {- return args[0];
- }
- else if (iscprim(args[0])) {- cprim_t *cp = (cprim_t*)ptr(args[0]);
- return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
- }
- type_error("number", args[0]);+ argcount(nargs, 1);
+ if(isfixnum(args[0]))
+ return args[0];
+ if(iscprim(args[0])){+ cprim_t *cp = (cprim_t*)ptr(args[0]);
+ return fixnum(conv_to_long(cp_data(cp), cp_numtype(cp)));
+ }
+ type_error("number", args[0]);}
-double trunc(double x);
-
BUILTIN("truncate", truncate) {- argcount(nargs, 1);
- if (isfixnum(args[0]))
- return args[0];
- if (iscprim(args[0])) {- cprim_t *cp = (cprim_t*)ptr(args[0]);
- void *data = cp_data(cp);
- numerictype_t nt = cp_numtype(cp);
- double d;
- if (nt == T_FLOAT)
- d = (double)*(float*)data;
- else if (nt == T_DOUBLE)
- d = *(double*)data;
- else
- return args[0];
+ argcount(nargs, 1);
+ if(isfixnum(args[0]))
+ return args[0];
+ if(iscprim(args[0])){+ cprim_t *cp = (cprim_t*)ptr(args[0]);
+ void *data = cp_data(cp);
+ numerictype_t nt = cp_numtype(cp);
+ double d;
+ if(nt == T_FLOAT)
+ d = (double)*(float*)data;
+ else if(nt == T_DOUBLE)
+ d = *(double*)data;
+ else
+ return args[0];
- if (d > 0) {- if (d > (double)INT64_MAX)
- return args[0];
- return return_from_uint64((uint64_t)d);
- }
- if (d > (double)INT64_MAX || d < (double)INT64_MIN)
- return args[0];
- return return_from_int64((int64_t)d);
- }
- type_error("number", args[0]);+ if(d > 0){+ if(d > (double)INT64_MAX)
+ return args[0];
+ return return_from_uint64((uint64_t)d);
+ }
+ if(d > (double)INT64_MAX || d < (double)INT64_MIN)
+ return args[0];
+ return return_from_int64((int64_t)d);
+ }
+ type_error("number", args[0]);}
BUILTIN("vector.alloc", vector_alloc) {- fixnum_t i;
- value_t f, v;
- if (nargs == 0)
- lerrorf(ArgError, "too few arguments");
- i = (fixnum_t)toulong(args[0]);
- if (i < 0)
- lerrorf(ArgError, "invalid size");
- v = alloc_vector((unsigned)i, 0);
- if (nargs == 2)
- f = args[1];
- else
- f = FL_UNSPECIFIED;
- int k;
- for(k=0; k < i; k++)
- vector_elt(v,k) = f;
- return v;
+ int i, k;
+ value_t f, v;
+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 1);
+ i = toulong(args[0]);
+ if(i < 0)
+ lerrorf(ArgError, "invalid size: %d", i);
+ v = alloc_vector((unsigned)i, 0);
+ f = nargs == 2 ? args[1] : FL_UNSPECIFIED;
+ for(k = 0; k < i; k++)
+ vector_elt(v,k) = f;
+ return v;
}
BUILTIN("time.now", time_now) {- argcount(nargs, 0);
- USED(args);
- return mk_double(clock_now());
+ argcount(nargs, 0);
+ USED(args);
+ return mk_double(clock_now());
}
-static double todouble(value_t a)
+static double
+todouble(value_t a)
{- if (isfixnum(a))
- return (double)numval(a);
- if (iscprim(a)) {- cprim_t *cp = (cprim_t*)ptr(a);
- numerictype_t nt = cp_numtype(cp);
- return conv_to_double(cp_data(cp), nt);
- }
- type_error("number", a);+ if(isfixnum(a))
+ return (double)numval(a);
+ if(iscprim(a)){+ cprim_t *cp = (cprim_t*)ptr(a);
+ numerictype_t nt = cp_numtype(cp);
+ return conv_to_double(cp_data(cp), nt);
+ }
+ type_error("number", a);}
BUILTIN("time.string", time_string) {- argcount(nargs, 1);
- double t = todouble(args[0]);
- char buf[64];
- timestring(t, buf, sizeof(buf));
- return string_from_cstr(buf);
+ argcount(nargs, 1);
+ double t = todouble(args[0]);
+ char buf[64];
+ timestring(t, buf, sizeof(buf));
+ return string_from_cstr(buf);
}
BUILTIN("time.fromstring", time_fromstring) {- argcount(nargs, 1);
- char *ptr = tostring(args[0]);
- double t = parsetime(ptr);
- int64_t it = (int64_t)t;
- if ((double)it == t && fits_fixnum(it))
- return fixnum(it);
- return mk_double(t);
+ argcount(nargs, 1);
+ char *ptr = tostring(args[0]);
+ double t = parsetime(ptr);
+ int64_t it = (int64_t)t;
+ if((double)it == t && fits_fixnum(it))
+ return fixnum(it);
+ return mk_double(t);
}
BUILTIN("path.cwd", path_cwd) {- if (nargs > 1)
- argcount(nargs, 1);
- if (nargs == 0) {- char buf[1024];
- getcwd(buf, sizeof(buf));
- return string_from_cstr(buf);
- }
- char *ptr = tostring(args[0]);
- if (chdir(ptr))
- lerrorf(IOError, "could not cd to %s", ptr);
- return FL_T;
+ if(nargs > 1)
+ argcount(nargs, 1);
+ if(nargs == 0){+ char buf[1024];
+ getcwd(buf, sizeof(buf));
+ return string_from_cstr(buf);
+ }
+ char *ptr = tostring(args[0]);
+ if(chdir(ptr))
+ lerrorf(IOError, "could not cd to %s", ptr);
+ return FL_T;
}
BUILTIN("path.exists?", path_existsp) {- argcount(nargs, 1);
- char *path = tostring(args[0]);
- return access(path, F_OK) == 0 ? FL_T : FL_F;
+ argcount(nargs, 1);
+ char *path = tostring(args[0]);
+ return access(path, F_OK) == 0 ? FL_T : FL_F;
}
BUILTIN("os.getenv", os_getenv) {- argcount(nargs, 1);
- char *name = tostring(args[0]);
- char *val = getenv(name);
- if (val == nil) return FL_F;
- if (*val == 0)
- return symbol_value(emptystringsym);
- return cvalue_static_cstring(val);
+ argcount(nargs, 1);
+ char *name = tostring(args[0]);
+ char *val = getenv(name);
+ if(val == nil)
+ return FL_F;
+ if(*val == 0)
+ return symbol_value(emptystringsym);
+ return cvalue_static_cstring(val);
}
BUILTIN("os.setenv", os_setenv) {- argcount(nargs, 2);
- char *name = tostring(args[0]);
- int result;
- if (args[1] == FL_F) {- result = unsetenv(name);
- }
- else {- char *val = tostring(args[1]);
- result = setenv(name, val, 1);
- }
- if (result != 0)
- lerrorf(ArgError, "invalid environment variable");
- return FL_T;
+ argcount(nargs, 2);
+ char *name = tostring(args[0]);
+ int result;
+ if(args[1] == FL_F)
+ result = unsetenv(name);
+ else{+ char *val = tostring(args[1]);
+ result = setenv(name, val, 1);
+ }
+ if(result != 0)
+ lerrorf(ArgError, "invalid environment variable");
+ return FL_T;
}
BUILTIN("rand", rand) {- USED(args); USED(nargs);
- fixnum_t r;
+ USED(args); USED(nargs);
+ fixnum_t r;
#ifdef BITS64
- r = ((((uint64_t)random())<<32) | random()) & 0x1fffffffffffffffLL;
+ r = ((((uint64_t)random())<<32) | random()) & 0x1fffffffffffffffLL;
#else
- r = random() & 0x1fffffff;
+ r = random() & 0x1fffffff;
#endif
- return fixnum(r);
+ return fixnum(r);
}
+
BUILTIN("rand.uint32", rand_uint32) {- USED(args); USED(nargs);
- uint32_t r = random();
+ USED(args); USED(nargs);
+ uint32_t r = random();
#ifdef BITS64
- return fixnum(r);
+ return fixnum(r);
#else
- return mk_uint32(r);
+ return mk_uint32(r);
#endif
}
+
BUILTIN("rand.uint64", rand_uint64) {- USED(args); USED(nargs);
- uint64_t r = (((uint64_t)random())<<32) | random();
- return mk_uint64(r);
+ USED(args); USED(nargs);
+ uint64_t r = (((uint64_t)random())<<32) | random();
+ return mk_uint64(r);
}
+
BUILTIN("rand.double", rand_double) {- USED(args); USED(nargs);
- return mk_double(rand_double());
+ USED(args); USED(nargs);
+ return mk_double(rand_double());
}
+
BUILTIN("rand.float", rand_float) {- USED(args); USED(nargs);
- return mk_float(rand_float());
+ USED(args); USED(nargs);
+ return mk_float(rand_float());
}
-#define BUILTIN_(lname, cname) \
-BUILTIN(lname, cname) \
-{ \- argcount(nargs, 1); \
- if (iscprim(args[0])) { \- cprim_t *cp = (cprim_t*)ptr(args[0]); \
- numerictype_t nt = cp_numtype(cp); \
- if (nt == T_FLOAT) \
- return mk_float(cname##f(*(float*)cp_data(cp))); \
- } \
- return mk_double(cname(todouble(args[0]))); \
-}
+#define BUILTIN_(lname, cname) \
+ BUILTIN(lname, cname) \
+ { \+ argcount(nargs, 1); \
+ if(iscprim(args[0])){ \+ cprim_t *cp = (cprim_t*)ptr(args[0]); \
+ numerictype_t nt = cp_numtype(cp); \
+ if(nt == T_FLOAT) \
+ return mk_float(cname##f(*(float*)cp_data(cp))); \
+ } \
+ return mk_double(cname(todouble(args[0]))); \
+ }
BUILTIN_("sqrt", sqrt) BUILTIN_("exp", exp)@@ -435,12 +432,3 @@
BUILTIN_("asin", asin) BUILTIN_("acos", acos) BUILTIN_("atan", atan)-
-extern void table_init(void);
-extern void iostream_init(void);
-
-void builtins_init(void)
-{- table_init();
- iostream_init();
-}
--- a/cvalues.c
+++ b/cvalues.c
@@ -25,9 +25,9 @@
static fltype_t *longtype, *ulongtype;
static fltype_t *mpinttype;
static fltype_t *floattype, *doubletype;
- fltype_t *bytetype, *wchartype;
- fltype_t *stringtype, *wcstringtype;
- fltype_t *builtintype;
+fltype_t *bytetype, *wchartype;
+fltype_t *stringtype, *wcstringtype;
+fltype_t *builtintype;
static void cvalue_init(fltype_t *type, value_t v, void *dest);
@@ -37,137 +37,139 @@
static size_t malloc_pressure = 0;
static cvalue_t **Finalizers = nil;
-static size_t nfinalizers=0;
-static size_t maxfinalizers=0;
+static size_t nfinalizers = 0;
+static size_t maxfinalizers = 0;
-void add_finalizer(cvalue_t *cv)
+void
+add_finalizer(cvalue_t *cv)
{- if (nfinalizers == maxfinalizers) {- size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2);
- cvalue_t **temp = realloc(Finalizers, nn*sizeof(cvalue_t*));
- if (temp == nil)
- lerrorf(MemoryError, "out of memory");
- Finalizers = temp;
- maxfinalizers = nn;
- }
- Finalizers[nfinalizers++] = cv;
+ if(nfinalizers == maxfinalizers){+ size_t nn = maxfinalizers == 0 ? 256 : maxfinalizers*2;
+ cvalue_t **temp = realloc(Finalizers, nn*sizeof(cvalue_t*));
+ if(temp == nil)
+ lerrorf(MemoryError, "out of memory");
+ Finalizers = temp;
+ maxfinalizers = nn;
+ }
+ Finalizers[nfinalizers++] = cv;
}
// remove dead objects from finalization list in-place
static void sweep_finalizers(void)
{- cvalue_t **lst = Finalizers;
- size_t n=0, ndel=0, l=nfinalizers;
- cvalue_t *tmp;
-#define SWAP_sf(a,b) (tmp=a,a=b,b=tmp,1)
- if (l == 0)
- return;
- do {- tmp = lst[n];
- if (isforwarded((value_t)tmp)) {- // object is alive
- lst[n] = (cvalue_t*)ptr(forwardloc((value_t)tmp));
- n++;
- }
- else {- fltype_t *t = cv_class(tmp);
- if (t->vtable != nil && t->vtable->finalize != nil) {- t->vtable->finalize(tagptr(tmp, TAG_CVALUE));
- }
- if (!isinlined(tmp) && owned(tmp)) {- memset(cv_data(tmp), 0xbb, cv_len(tmp));
- free(cv_data(tmp));
- }
- ndel++;
- }
- } while ((n < l-ndel) && SWAP_sf(lst[n],lst[n+ndel]));
+ cvalue_t **lst = Finalizers;
+ size_t n = 0, ndel = 0, l = nfinalizers;
+ cvalue_t *tmp;
+#define SWAP_sf(a,b) (tmp = a, a = b, b= tmp, 1)
+ if(l == 0)
+ return;
+ do{+ tmp = lst[n];
+ if(isforwarded((value_t)tmp)){+ // object is alive
+ lst[n] = ptr(forwardloc((value_t)tmp));
+ n++;
+ }else{+ fltype_t *t = cv_class(tmp);
+ if(t->vtable != nil && t->vtable->finalize != nil)
+ t->vtable->finalize(tagptr(tmp, TAG_CVALUE));
+ if(!isinlined(tmp) && owned(tmp)){+ memset(cv_data(tmp), 0xbb, cv_len(tmp));
+ free(cv_data(tmp));
+ }
+ ndel++;
+ }
+ }while((n < l-ndel) && SWAP_sf(lst[n], lst[n+ndel]));
- nfinalizers -= ndel;
+ nfinalizers -= ndel;
#ifdef VERBOSEGC
- if (ndel > 0)
- printf("GC: finalized %d objects\n", ndel);+ if(ndel > 0)
+ printf("GC: finalized %d objects\n", ndel);#endif
- malloc_pressure = 0;
+ malloc_pressure = 0;
}
// compute the size of the metadata object for a cvalue
-static size_t cv_nwords(cvalue_t *cv)
+static size_t
+cv_nwords(cvalue_t *cv)
{- if (isinlined(cv)) {- size_t n = cv_len(cv);
- if (n==0 || cv_isstr(cv))
- n++;
- return CVALUE_NWORDS - 1 + NWORDS(n);
- }
- return CVALUE_NWORDS;
+ if(isinlined(cv)){+ size_t n = cv_len(cv);
+ if(n == 0 || cv_isstr(cv))
+ n++;
+ return CVALUE_NWORDS - 1 + NWORDS(n);
+ }
+ return CVALUE_NWORDS;
}
-static void autorelease(cvalue_t *cv)
+static void
+autorelease(cvalue_t *cv)
{- cv->type = (fltype_t*)(((uintptr_t)cv->type) | CV_OWNED_BIT);
- add_finalizer(cv);
+ cv->type = (fltype_t*)(((uintptr_t)cv->type) | CV_OWNED_BIT);
+ add_finalizer(cv);
}
-void cv_autorelease(cvalue_t *cv)
+void
+cv_autorelease(cvalue_t *cv)
{- autorelease(cv);
+ autorelease(cv);
}
-static value_t cprim(fltype_t *type, size_t sz)
+static value_t
+cprim(fltype_t *type, size_t sz)
{- assert(!ismanaged((uintptr_t)type));
- assert(sz == type->size);
- cprim_t *pcp = (cprim_t*)alloc_words(CPRIM_NWORDS-1+NWORDS(sz));
- pcp->type = type;
- return tagptr(pcp, TAG_CPRIM);
+ assert(!ismanaged((uintptr_t)type));
+ assert(sz == type->size);
+ cprim_t *pcp = alloc_words(CPRIM_NWORDS-1+NWORDS(sz));
+ pcp->type = type;
+ return tagptr(pcp, TAG_CPRIM);
}
-value_t cvalue(fltype_t *type, size_t sz)
+value_t
+cvalue(fltype_t *type, size_t sz)
{- cvalue_t *pcv;
- int str=0;
+ cvalue_t *pcv;
+ int str = 0;
- if (valid_numtype(type->numtype) && type->numtype != T_MPINT)
- return cprim(type, sz);
+ if(valid_numtype(type->numtype) && type->numtype != T_MPINT)
+ return cprim(type, sz);
- if (type->eltype == bytetype) {- if (sz == 0)
- return symbol_value(emptystringsym);
- sz++;
- str=1;
- }
- if (sz <= MAX_INL_SIZE) {- size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz==0 ? 1 : 0);
- pcv = (cvalue_t*)alloc_words(nw);
- pcv->type = type;
- pcv->data = &pcv->_space[0];
- if (type->vtable != nil && type->vtable->finalize != nil)
- add_finalizer(pcv);
- }
- else {- if (malloc_pressure > ALLOC_LIMIT_TRIGGER)
- gc(0);
- pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS);
- pcv->type = type;
- pcv->data = malloc(sz);
- autorelease(pcv);
- malloc_pressure += sz;
- }
- if (str) {- sz--;
- ((char*)pcv->data)[sz] = '\0';
- }
- pcv->len = sz;
- return tagptr(pcv, TAG_CVALUE);
+ if(type->eltype == bytetype){+ if(sz == 0)
+ return symbol_value(emptystringsym);
+ sz++;
+ str = 1;
+ }
+ if(sz <= MAX_INL_SIZE){+ size_t nw = CVALUE_NWORDS - 1 + NWORDS(sz) + (sz == 0 ? 1 : 0);
+ pcv = alloc_words(nw);
+ pcv->type = type;
+ pcv->data = &pcv->_space[0];
+ if(type->vtable != nil && type->vtable->finalize != nil)
+ add_finalizer(pcv);
+ }else{+ if(malloc_pressure > ALLOC_LIMIT_TRIGGER)
+ gc(0);
+ pcv = alloc_words(CVALUE_NWORDS);
+ pcv->type = type;
+ pcv->data = malloc(sz);
+ autorelease(pcv);
+ malloc_pressure += sz;
+ }
+ if(str)
+ ((char*)pcv->data)[--sz] = '\0';
+ pcv->len = sz;
+ return tagptr(pcv, TAG_CVALUE);
}
-value_t cvalue_from_data(fltype_t *type, void *data, size_t sz)
+value_t
+cvalue_from_data(fltype_t *type, void *data, size_t sz)
{- value_t cv;
- cv = cvalue(type, sz);
- memmove(cptr(cv), data, sz);
- return cv;
+ value_t cv;
+ cv = cvalue(type, sz);
+ memmove(cptr(cv), data, sz);
+ return cv;
}
// this effectively dereferences a pointer
@@ -178,83 +180,89 @@
// user explicitly calls (autorelease ) on the result of this function.
// 'parent' is an optional cvalue that this pointer is known to point
// into; NIL if none.
-value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent)
+value_t
+cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent)
{- cvalue_t *pcv;
- value_t cv;
+ cvalue_t *pcv;
+ value_t cv;
- pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS);
- pcv->data = ptr;
- pcv->len = sz;
- pcv->type = type;
- if (parent != NIL) {- pcv->type = (fltype_t*)(((uintptr_t)pcv->type) | CV_PARENT_BIT);
- pcv->parent = parent;
- }
- cv = tagptr(pcv, TAG_CVALUE);
- return cv;
+ pcv = alloc_words(CVALUE_NWORDS);
+ pcv->data = ptr;
+ pcv->len = sz;
+ pcv->type = type;
+ if(parent != NIL){+ pcv->type = (fltype_t*)(((uintptr_t)pcv->type) | CV_PARENT_BIT);
+ pcv->parent = parent;
+ }
+ cv = tagptr(pcv, TAG_CVALUE);
+ return cv;
}
-value_t cvalue_string(size_t sz)
+value_t
+cvalue_string(size_t sz)
{- return cvalue(stringtype, sz);
+ return cvalue(stringtype, sz);
}
-value_t cvalue_static_cstring(const char *str)
+value_t
+cvalue_static_cstring(const char *str)
{- return cvalue_from_ref(stringtype, (char*)str, strlen(str), NIL);
+ return cvalue_from_ref(stringtype, (char*)str, strlen(str), NIL);
}
-value_t string_from_cstrn(char *str, size_t n)
+value_t
+string_from_cstrn(char *str, size_t n)
{- value_t v = cvalue_string(n);
- memmove(cvalue_data(v), str, n);
- return v;
+ value_t v = cvalue_string(n);
+ memmove(cvalue_data(v), str, n);
+ return v;
}
-value_t string_from_cstr(char *str)
+value_t
+string_from_cstr(char *str)
{- return string_from_cstrn(str, strlen(str));
+ return string_from_cstrn(str, strlen(str));
}
-int fl_isstring(value_t v)
+int
+fl_isstring(value_t v)
{- return (iscvalue(v) && cv_isstr((cvalue_t*)ptr(v)));
+ return iscvalue(v) && cv_isstr((cvalue_t*)ptr(v));
}
// convert to malloc representation (fixed address)
-void cv_pin(cvalue_t *cv)
+void
+cv_pin(cvalue_t *cv)
{- if (!isinlined(cv))
- return;
- size_t sz = cv_len(cv);
- if (cv_isstr(cv)) sz++;
- void *data = malloc(sz);
- memmove(data, cv_data(cv), sz);
- cv->data = data;
- autorelease(cv);
+ if(!isinlined(cv))
+ return;
+ size_t sz = cv_len(cv);
+ if(cv_isstr(cv))
+ sz++;
+ void *data = malloc(sz);
+ memmove(data, cv_data(cv), sz);
+ cv->data = data;
+ autorelease(cv);
}
-#define num_init(ctype, cnvt, tag) \
-static int cvalue_##ctype##_init(fltype_t *type, value_t arg, \
- void *dest) \
-{ \- ctype n; \
- USED(type); \
- if (isfixnum(arg)) { \- n = numval(arg); \
- } \
- else if (iscprim(arg)) { \- cprim_t *cp = (cprim_t*)ptr(arg); \
- void *p = cp_data(cp); \
- n = (ctype)conv_to_##cnvt(p, cp_numtype(cp)); \
- } \
- else { \- return 1; \
- } \
- *((ctype*)dest) = n; \
- return 0; \
-}
+#define num_init(ctype, cnvt, tag) \
+ static int \
+ cvalue_##ctype##_init(fltype_t *type, value_t arg, void *dest) \
+ { \+ ctype n; \
+ USED(type); \
+ if(isfixnum(arg)) \
+ n = numval(arg); \
+ else if(iscprim(arg)){ \+ cprim_t *cp = (cprim_t*)ptr(arg); \
+ void *p = cp_data(cp); \
+ n = (ctype)conv_to_##cnvt(p, cp_numtype(cp)); \
+ }else \
+ return 1; \
+ *((ctype*)dest) = n; \
+ return 0; \
+ }
+
num_init(int8_t, int32, T_INT8)
num_init(uint8_t, uint32, T_UINT8)
num_init(int16_t, int32, T_INT16)
@@ -266,28 +274,30 @@
num_init(float, double, T_FLOAT)
num_init(double, double, T_DOUBLE)
-#define num_ctor_init(typenam, ctype, tag) \
-BUILTIN(#typenam, typenam) \
-{ \- if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; } \- value_t cp = cprim(typenam##type, sizeof(ctype)); \
- if (cvalue_##ctype##_init(typenam##type, \
- args[0], cp_data((cprim_t*)ptr(cp)))) \
- type_error("number", args[0]); \- return cp; \
-}
+#define num_ctor_init(typenam, ctype, tag) \
+ BUILTIN(#typenam, typenam) \
+ { \+ if(nargs == 0){ \+ PUSH(fixnum(0)); \
+ args = &Stack[SP-1]; \
+ } \
+ value_t cp = cprim(typenam##type, sizeof(ctype)); \
+ if(cvalue_##ctype##_init(typenam##type, args[0], cp_data((cprim_t*)ptr(cp)))) \
+ type_error("number", args[0]); \+ return cp; \
+ }
-#define num_ctor_ctor(typenam, ctype, tag) \
-value_t mk_##typenam(ctype n) \
-{ \- value_t cp = cprim(typenam##type, sizeof(ctype)); \
- *(ctype*)cp_data((cprim_t*)ptr(cp)) = n; \
- return cp; \
-}
+#define num_ctor_ctor(typenam, ctype, tag) \
+ value_t mk_##typenam(ctype n) \
+ { \+ value_t cp = cprim(typenam##type, sizeof(ctype)); \
+ *(ctype*)cp_data((cprim_t*)ptr(cp)) = n; \
+ return cp; \
+ }
#define num_ctor(typenam, ctype, tag) \
- num_ctor_init(typenam, ctype, tag) \
- num_ctor_ctor(typenam, ctype, tag)
+ num_ctor_init(typenam, ctype, tag) \
+ num_ctor_ctor(typenam, ctype, tag)
num_ctor(int8, int8_t, T_INT8)
num_ctor(uint8, uint8_t, T_UINT8)
@@ -309,453 +319,463 @@
num_ctor(float, float, T_FLOAT)
num_ctor(double, double, T_DOUBLE)
-static int cvalue_mpint_init(fltype_t *type, value_t arg, void *dest)
+static int
+cvalue_mpint_init(fltype_t *type, value_t arg, void *dest)
{- mpint *n;
- USED(type);
- if (isfixnum(arg)) {- n = vtomp(numval(arg), nil);
- }
- else if (iscprim(arg)) {- cprim_t *cp = (cprim_t*)ptr(arg);
- void *p = cp_data(cp);
- n = conv_to_mpint(p, cp_numtype(cp));
- }
- else {- return 1;
- }
- *((mpint**)dest) = n;
- return 0;
+ mpint *n;
+ USED(type);
+ if(isfixnum(arg)){+ n = vtomp(numval(arg), nil);
+ }else if(iscprim(arg)){+ cprim_t *cp = (cprim_t*)ptr(arg);
+ void *p = cp_data(cp);
+ n = conv_to_mpint(p, cp_numtype(cp));
+ }else{+ return 1;
+ }
+ *((mpint**)dest) = n;
+ return 0;
}
/* */ BUILTIN("mpint", mpint) {- if (nargs==0) { PUSH(fixnum(0)); args = &Stack[SP-1]; }- value_t cv = cvalue(mpinttype, sizeof(mpint*));
- if (cvalue_mpint_init(mpinttype, args[0], cv_data((cvalue_t*)ptr(cv))))
- type_error("number", args[0]);- return cv;
+ if(nargs == 0){+ PUSH(fixnum(0));
+ args = &Stack[SP-1];
+ }
+ value_t cv = cvalue(mpinttype, sizeof(mpint*));
+ if(cvalue_mpint_init(mpinttype, args[0], cv_data((cvalue_t*)ptr(cv))))
+ type_error("number", args[0]);+ return cv;
}
-value_t mk_mpint(mpint *n)
+value_t
+mk_mpint(mpint *n)
{- value_t cv = cvalue(mpinttype, sizeof(mpint*));
- *(mpint**)cvalue_data(cv) = n;
- return cv;
+ value_t cv = cvalue(mpinttype, sizeof(mpint*));
+ *(mpint**)cvalue_data(cv) = n;
+ return cv;
}
-static void free_mpint(value_t self)
+static void
+free_mpint(value_t self)
{- mpint **s = value2c(mpint**, self);
- if (*s != mpzero && *s != mpone && *s != mptwo)
- mpfree(*s);
+ mpint **s = value2c(mpint**, self);
+ if(*s != mpzero && *s != mpone && *s != mptwo)
+ mpfree(*s);
}
static cvtable_t mpint_vtable = { nil, nil, free_mpint, nil };-value_t size_wrap(size_t sz)
+value_t
+size_wrap(size_t sz)
{- if (fits_fixnum(sz))
- return fixnum(sz);
- assert(sizeof(void*) == sizeof(size_t));
- return mk_ulong(sz);
+ if(fits_fixnum(sz))
+ return fixnum(sz);
+ assert(sizeof(void*) == sizeof(size_t));
+ return mk_ulong(sz);
}
-size_t toulong(value_t n)
+size_t
+toulong(value_t n)
{- if (isfixnum(n))
- return numval(n);
- if (iscprim(n)) {- cprim_t *cp = (cprim_t*)ptr(n);
- return conv_to_ulong(cp_data(cp), cp_numtype(cp));
- }
- type_error("number", n);+ if(isfixnum(n))
+ return numval(n);
+ if(iscprim(n)){+ cprim_t *cp = (cprim_t*)ptr(n);
+ return conv_to_ulong(cp_data(cp), cp_numtype(cp));
+ }
+ type_error("number", n);}
-off_t tooffset(value_t n)
+off_t
+tooffset(value_t n)
{- if (isfixnum(n))
- return numval(n);
- if (iscprim(n)) {- cprim_t *cp = (cprim_t*)ptr(n);
- return conv_to_int64(cp_data(cp), cp_numtype(cp));
- }
- type_error("number", n);+ if(isfixnum(n))
+ return numval(n);
+ if(iscprim(n)){+ cprim_t *cp = (cprim_t*)ptr(n);
+ return conv_to_int64(cp_data(cp), cp_numtype(cp));
+ }
+ type_error("number", n);}
-static int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
+static int
+cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
{- int n;
- value_t syms;
- value_t type = ft->type;
+ int n;
+ value_t syms;
+ value_t type = ft->type;
- syms = car(cdr(type));
- if (!isvector(syms))
- type_error("vector", syms);- if (issymbol(arg)) {- for(n=0; n < (int)vector_size(syms); n++) {- if (vector_elt(syms, n) == arg) {- *(int*)dest = n;
- return 0;
- }
- }
- lerrorf(ArgError, "invalid enum value");
- }
- if (isfixnum(arg)) {- n = (int)numval(arg);
- }
- else if (iscprim(arg)) {- cprim_t *cp = (cprim_t*)ptr(arg);
- n = conv_to_int32(cp_data(cp), cp_numtype(cp));
- }
- else {- type_error("number", arg);- }
- if ((unsigned)n >= vector_size(syms))
- lerrorf(ArgError, "value out of range");
- *(int*)dest = n;
- return 0;
+ syms = car(cdr(type));
+ if(!isvector(syms))
+ type_error("vector", syms);+ if(issymbol(arg)){+ for(n = 0; n < (int)vector_size(syms); n++){+ if(vector_elt(syms, n) == arg){+ *(int*)dest = n;
+ return 0;
+ }
+ }
+ lerrorf(ArgError, "invalid enum value");
+ }
+ if(isfixnum(arg))
+ n = (int)numval(arg);
+ else if(iscprim(arg)){+ cprim_t *cp = (cprim_t*)ptr(arg);
+ n = conv_to_int32(cp_data(cp), cp_numtype(cp));
+ }else
+ type_error("number", arg);+ if((unsigned)n >= vector_size(syms))
+ lerrorf(ArgError, "value out of range");
+ *(int*)dest = n;
+ return 0;
}
BUILTIN("enum", enum) {- argcount(nargs, 2);
- value_t type = fl_list2(enumsym, args[0]);
- fltype_t *ft = get_type(type);
- value_t cv = cvalue(ft, sizeof(int32_t));
- cvalue_enum_init(ft, args[1], cp_data((cprim_t*)ptr(cv)));
- return cv;
+ argcount(nargs, 2);
+ value_t type = fl_list2(enumsym, args[0]);
+ fltype_t *ft = get_type(type);
+ value_t cv = cvalue(ft, sizeof(int32_t));
+ cvalue_enum_init(ft, args[1], cp_data((cprim_t*)ptr(cv)));
+ return cv;
}
-static int isarray(value_t v)
+static int
+isarray(value_t v)
{- return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != nil;
+ return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != nil;
}
-static size_t predict_arraylen(value_t arg)
+static size_t
+predict_arraylen(value_t arg)
{- if (isvector(arg))
- return vector_size(arg);
- else if (iscons(arg))
- return llength(arg);
- else if (arg == NIL)
- return 0;
- if (isarray(arg))
- return cvalue_arraylen(arg);
- return 1;
+ if(isvector(arg))
+ return vector_size(arg);
+ if(iscons(arg))
+ return llength(arg);
+ if(arg == NIL)
+ return 0;
+ if(isarray(arg))
+ return cvalue_arraylen(arg);
+ return 1;
}
-static int cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
+static int
+cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
{- value_t type = ft->type;
- size_t elsize, i, cnt, sz;
- fltype_t *eltype = ft->eltype;
+ value_t type = ft->type;
+ size_t elsize, i, cnt, sz;
+ fltype_t *eltype = ft->eltype;
- elsize = ft->elsz;
- cnt = predict_arraylen(arg);
+ elsize = ft->elsz;
+ cnt = predict_arraylen(arg);
- if (iscons(cdr_(cdr_(type)))) {- size_t tc = toulong(car_(cdr_(cdr_(type))));
- if (tc != cnt)
- lerrorf(ArgError, "size mismatch");
- }
+ if(iscons(cdr_(cdr_(type)))){+ size_t tc = toulong(car_(cdr_(cdr_(type))));
+ if(tc != cnt)
+ lerrorf(ArgError, "size mismatch");
+ }
- sz = elsize * cnt;
+ sz = elsize * cnt;
- if (isvector(arg)) {- assert(cnt <= vector_size(arg));
- for(i=0; i < cnt; i++) {- cvalue_init(eltype, vector_elt(arg,i), dest);
- dest = (char*)dest + elsize;
- }
- return 0;
- }
- else if (iscons(arg) || arg==NIL) {- i = 0;
- while (iscons(arg)) {- if (i == cnt) { i++; break; } // trigger error- cvalue_init(eltype, car_(arg), dest);
- i++;
- dest = (char*)dest + elsize;
- arg = cdr_(arg);
- }
- if (i != cnt)
- lerrorf(ArgError, "size mismatch");
- return 0;
- }
- else if (iscvalue(arg)) {- cvalue_t *cv = (cvalue_t*)ptr(arg);
- if (isarray(arg)) {- fltype_t *aet = cv_class(cv)->eltype;
- if (aet == eltype) {- if (cv_len(cv) == sz)
- memmove(dest, cv_data(cv), sz);
- else
- lerrorf(ArgError, "size mismatch");
- return 0;
- }
- else {- // TODO: initialize array from different type elements
- lerrorf(ArgError, "element type mismatch");
- }
- }
- }
- if (cnt == 1)
- cvalue_init(eltype, arg, dest);
- else
- type_error("sequence", arg);- return 0;
+ if(isvector(arg)){+ assert(cnt <= vector_size(arg));
+ for(i = 0; i < cnt; i++){+ cvalue_init(eltype, vector_elt(arg,i), dest);
+ dest = (char*)dest + elsize;
+ }
+ return 0;
+ }
+ if(iscons(arg) || arg == NIL){+ i = 0;
+ while(iscons(arg)){+ if(i == cnt){+ i++;
+ break;
+ } // trigger error
+ cvalue_init(eltype, car_(arg), dest);
+ i++;
+ dest = (char*)dest + elsize;
+ arg = cdr_(arg);
+ }
+ if(i != cnt)
+ lerrorf(ArgError, "size mismatch");
+ return 0;
+ }
+ if(iscvalue(arg)){+ cvalue_t *cv = (cvalue_t*)ptr(arg);
+ if(isarray(arg)){+ fltype_t *aet = cv_class(cv)->eltype;
+ if(aet == eltype){+ if(cv_len(cv) == sz)
+ memmove(dest, cv_data(cv), sz);
+ else
+ lerrorf(ArgError, "size mismatch");
+ return 0;
+ }else{+ // TODO: initialize array from different type elements
+ lerrorf(ArgError, "element type mismatch");
+ }
+ }
+ }
+ if(cnt == 1)
+ cvalue_init(eltype, arg, dest);
+ type_error("sequence", arg);}
BUILTIN("array", array) {- size_t elsize, cnt, sz;
- value_t arg;
- int i;
+ size_t elsize, cnt, sz;
+ value_t arg;
+ int i;
- if (nargs < 1)
- argcount(nargs, 1);
+ if(nargs < 1)
+ argcount(nargs, 1);
- cnt = nargs - 1;
- fltype_t *type = get_array_type(args[0]);
- elsize = type->elsz;
- sz = elsize * cnt;
+ cnt = nargs - 1;
+ fltype_t *type = get_array_type(args[0]);
+ elsize = type->elsz;
+ sz = elsize * cnt;
- value_t cv = cvalue(type, sz);
- char *dest = cv_data((cvalue_t*)ptr(cv));
- FOR_ARGS(i,1,arg,args) {- cvalue_init(type->eltype, arg, dest);
- dest += elsize;
- }
- return cv;
+ value_t cv = cvalue(type, sz);
+ char *dest = cv_data(ptr(cv));
+ FOR_ARGS(i, 1, arg, args){+ cvalue_init(type->eltype, arg, dest);
+ dest += elsize;
+ }
+ return cv;
}
// NOTE: v must be an array
-size_t cvalue_arraylen(value_t v)
+size_t
+cvalue_arraylen(value_t v)
{- cvalue_t *cv = (cvalue_t*)ptr(v);
- return cv_len(cv)/(cv_class(cv)->elsz);
+ cvalue_t *cv = ptr(v);
+ return cv_len(cv)/cv_class(cv)->elsz;
}
-static size_t cvalue_struct_offs(value_t type, value_t field, int computeTotal,
- int *palign)
+static size_t
+cvalue_struct_offs(value_t type, value_t field, int computeTotal, int *palign)
{- value_t fld = car(cdr_(type));
- size_t fsz, ssz = 0;
- int al;
- *palign = 0;
+ value_t fld = car(cdr_(type));
+ size_t fsz, ssz = 0;
+ int al;
+ *palign = 0;
- while (iscons(fld)) {- fsz = ctype_sizeof(car(cdr(car_(fld))), &al);
+ while(iscons(fld)){+ fsz = ctype_sizeof(car(cdr(car_(fld))), &al);
- ssz = LLT_ALIGN(ssz, al);
- if (al > *palign)
- *palign = al;
+ ssz = LLT_ALIGN(ssz, al);
+ if(al > *palign)
+ *palign = al;
- if (!computeTotal && field==car_(car_(fld))) {- // found target field
- return ssz;
- }
+ if(!computeTotal && field == car_(car_(fld))) // found target field
+ return ssz;
- ssz += fsz;
- fld = cdr_(fld);
- }
- return LLT_ALIGN(ssz, *palign);
+ ssz += fsz;
+ fld = cdr_(fld);
+ }
+ return LLT_ALIGN(ssz, *palign);
}
-static size_t cvalue_union_size(value_t type, int *palign)
+static size_t
+cvalue_union_size(value_t type, int *palign)
{- value_t fld = car(cdr_(type));
- size_t fsz, usz = 0;
- int al;
- *palign = 0;
+ value_t fld = car(cdr_(type));
+ size_t fsz, usz = 0;
+ int al;
+ *palign = 0;
- while (iscons(fld)) {- fsz = ctype_sizeof(car(cdr(car_(fld))), &al);
- if (al > *palign) *palign = al;
- if (fsz > usz) usz = fsz;
- fld = cdr_(fld);
- }
- return LLT_ALIGN(usz, *palign);
+ while(iscons(fld)){+ fsz = ctype_sizeof(car(cdr(car_(fld))), &al);
+ if(al > *palign)
+ *palign = al;
+ if(fsz > usz)
+ usz = fsz;
+ fld = cdr_(fld);
+ }
+ return LLT_ALIGN(usz, *palign);
}
// *palign is an output argument giving the alignment required by type
-size_t ctype_sizeof(value_t type, int *palign)
+size_t
+ctype_sizeof(value_t type, int *palign)
{- symbol_t *s;
+ symbol_t *s;
- if (issymbol(type) && (s = ptr(type)) != nil && valid_numtype(s->numtype)) {- *palign = s->align;
- return s->size;
- }
+ if(issymbol(type) && (s = ptr(type)) != nil && valid_numtype(s->numtype)){+ *palign = s->align;
+ return s->size;
+ }
- if (iscons(type)) {- value_t hed = car_(type);
- if (hed == pointersym || hed == cfunctionsym) {- *palign = sizeof(struct { char a; void *i; }) - sizeof(void*);- return sizeof(void*);
- }
- if (hed == arraysym) {- value_t t = car(cdr_(type));
- if (!iscons(cdr_(cdr_(type))))
- lerrorf(ArgError, "incomplete type");
- value_t n = car_(cdr_(cdr_(type)));
- size_t sz = toulong(n);
- return sz * ctype_sizeof(t, palign);
- }
- else if (hed == structsym) {- return cvalue_struct_offs(type, NIL, 1, palign);
- }
- else if (hed == unionsym) {- return cvalue_union_size(type, palign);
- }
- else if (hed == enumsym) {- *palign = sizeof(struct { char c; numerictype_t e; }) - sizeof(numerictype_t);- return sizeof(numerictype_t);
- }
- }
+ if(iscons(type)){+ value_t hed = car_(type);
+ if(hed == structsym)
+ return cvalue_struct_offs(type, NIL, 1, palign);
+ if(hed == unionsym)
+ return cvalue_union_size(type, palign);
+ if(hed == pointersym || hed == cfunctionsym){+ *palign = offsetof(struct{ char a; void *i; }, i);+ return sizeof(void*);
+ }
+ if(hed == arraysym){+ value_t t = car(cdr_(type));
+ if(!iscons(cdr_(cdr_(type))))
+ lerrorf(ArgError, "incomplete type");
+ value_t n = car_(cdr_(cdr_(type)));
+ size_t sz = toulong(n);
+ return sz * ctype_sizeof(t, palign);
+ }
+ if(hed == enumsym){+ *palign = offsetof(struct{ char c; numerictype_t e; }, e);+ return sizeof(numerictype_t);
+ }
+ }
- lerrorf(ArgError, "invalid c type");
+ lerrorf(ArgError, "invalid c type");
}
extern fltype_t *iostreamtype;
// get pointer and size for any plain-old-data value
-void to_sized_ptr(value_t v, char **pdata, size_t *psz)
+void
+to_sized_ptr(value_t v, char **pdata, size_t *psz)
{- if (iscvalue(v)) {- cvalue_t *pcv = (cvalue_t*)ptr(v);
- ios_t *x = value2c(ios_t*,v);
- if (cv_class(pcv) == iostreamtype && (x->bm == bm_mem)) {- *pdata = x->buf;
- *psz = x->size;
- return;
- }
- else if (cv_isPOD(pcv)) {- *pdata = cv_data(pcv);
- *psz = cv_len(pcv);
- return;
- }
- }
- else if (iscprim(v)) {- cprim_t *pcp = (cprim_t*)ptr(v);
- *pdata = cp_data(pcp);
- *psz = cp_class(pcp)->size;
- return;
- }
- type_error("plain-old-data", v);+ if(iscvalue(v)){+ cvalue_t *pcv = ptr(v);
+ ios_t *x = value2c(ios_t*, v);
+ if(cv_class(pcv) == iostreamtype && x->bm == bm_mem){+ *pdata = x->buf;
+ *psz = x->size;
+ return;
+ }
+ if(cv_isPOD(pcv)){+ *pdata = cv_data(pcv);
+ *psz = cv_len(pcv);
+ return;
+ }
+ }
+ if(iscprim(v)){+ cprim_t *pcp = (cprim_t*)ptr(v);
+ *pdata = cp_data(pcp);
+ *psz = cp_class(pcp)->size;
+ return;
+ }
+ type_error("plain-old-data", v);}
BUILTIN("sizeof", sizeof) {- argcount(nargs, 1);
- if (issymbol(args[0]) || iscons(args[0])) {- int a;
- return size_wrap(ctype_sizeof(args[0], &a));
- }
- size_t n; char *data;
- to_sized_ptr(args[0], &data, &n);
- return size_wrap(n);
+ argcount(nargs, 1);
+ size_t n; char *data;
+ int a;
+ if(issymbol(args[0]) || iscons(args[0]))
+ return size_wrap(ctype_sizeof(args[0], &a));
+ to_sized_ptr(args[0], &data, &n);
+ return size_wrap(n);
}
BUILTIN("typeof", typeof) {- argcount(nargs, 1);
- switch(tag(args[0])) {- case TAG_CONS: return pairsym;
- case TAG_NUM1:
- case TAG_NUM: return fixnumsym;
- case TAG_SYM: return symbolsym;
- case TAG_VECTOR: return vectorsym;
- case TAG_FUNCTION:
- if (args[0] == FL_T || args[0] == FL_F)
- return booleansym;
- if (args[0] == NIL)
- return nullsym;
- if (args[0] == FL_EOF)
- return symbol("eof-object");- if (isbuiltin(args[0]))
- return builtinsym;
- return FUNCTION;
- }
- return cv_type((cvalue_t*)ptr(args[0]));
+ argcount(nargs, 1);
+ switch(tag(args[0])){+ case TAG_CONS: return pairsym;
+ case TAG_NUM1: case TAG_NUM: return fixnumsym;
+ case TAG_SYM: return symbolsym;
+ case TAG_VECTOR: return vectorsym;
+ case TAG_FUNCTION:
+ if(args[0] == FL_T || args[0] == FL_F)
+ return booleansym;
+ if(args[0] == NIL)
+ return nullsym;
+ if(args[0] == FL_EOF)
+ return symbol("eof-object");+ if(isbuiltin(args[0]))
+ return builtinsym;
+ return FUNCTION;
+ }
+ return cv_type(ptr(args[0]));
}
-static value_t cvalue_relocate(value_t v)
+static value_t
+cvalue_relocate(value_t v)
{- size_t nw;
- cvalue_t *cv = (cvalue_t*)ptr(v);
- cvalue_t *nv;
- value_t ncv;
+ size_t nw;
+ cvalue_t *cv = ptr(v);
+ cvalue_t *nv;
+ value_t ncv;
- nw = cv_nwords(cv);
- nv = (cvalue_t*)alloc_words(nw);
- memmove(nv, cv, nw*sizeof(value_t));
- if (isinlined(cv))
- nv->data = &nv->_space[0];
- ncv = tagptr(nv, TAG_CVALUE);
- fltype_t *t = cv_class(cv);
- if (t->vtable != nil && t->vtable->relocate != nil)
- t->vtable->relocate(v, ncv);
- forward(v, ncv);
- return ncv;
+ nw = cv_nwords(cv);
+ nv = alloc_words(nw);
+ memmove(nv, cv, nw*sizeof(value_t));
+ if(isinlined(cv))
+ nv->data = &nv->_space[0];
+ ncv = tagptr(nv, TAG_CVALUE);
+ fltype_t *t = cv_class(cv);
+ if(t->vtable != nil && t->vtable->relocate != nil)
+ t->vtable->relocate(v, ncv);
+ forward(v, ncv);
+ return ncv;
}
-value_t cvalue_copy(value_t v)
+value_t
+cvalue_copy(value_t v)
{- assert(iscvalue(v));
- PUSH(v);
- cvalue_t *cv = (cvalue_t*)ptr(v);
- size_t nw = cv_nwords(cv);
- cvalue_t *ncv = (cvalue_t*)alloc_words(nw);
- v = POP(); cv = (cvalue_t*)ptr(v);
- memmove(ncv, cv, nw * sizeof(value_t));
- if (!isinlined(cv)) {- size_t len = cv_len(cv);
- if (cv_isstr(cv)) len++;
- ncv->data = malloc(len);
- memmove(ncv->data, cv_data(cv), len);
- autorelease(ncv);
- if (hasparent(cv)) {- ncv->type = (fltype_t*)(((uintptr_t)ncv->type) & ~CV_PARENT_BIT);
- ncv->parent = NIL;
- }
- }
- else {- ncv->data = &ncv->_space[0];
- }
+ assert(iscvalue(v));
+ PUSH(v);
+ cvalue_t *cv = ptr(v);
+ size_t nw = cv_nwords(cv);
+ cvalue_t *ncv = alloc_words(nw);
+ v = POP();
+ cv = ptr(v);
+ memmove(ncv, cv, nw * sizeof(value_t));
+ if(!isinlined(cv)){+ size_t len = cv_len(cv);
+ if(cv_isstr(cv))
+ len++;
+ ncv->data = malloc(len);
+ memmove(ncv->data, cv_data(cv), len);
+ autorelease(ncv);
+ if(hasparent(cv)){+ ncv->type = (fltype_t*)(((uintptr_t)ncv->type) & ~CV_PARENT_BIT);
+ ncv->parent = NIL;
+ }
+ }else{+ ncv->data = &ncv->_space[0];
+ }
- return tagptr(ncv, TAG_CVALUE);
+ return tagptr(ncv, TAG_CVALUE);
}
BUILTIN("copy", copy) {- argcount(nargs, 1);
- if (iscons(args[0]) || isvector(args[0]))
- lerrorf(ArgError, "argument must be a leaf atom");
- if (!iscvalue(args[0]))
- return args[0];
- if (!cv_isPOD((cvalue_t*)ptr(args[0])))
- lerrorf(ArgError, "argument must be a plain-old-data type");
- return cvalue_copy(args[0]);
+ argcount(nargs, 1);
+ if(iscons(args[0]) || isvector(args[0]))
+ lerrorf(ArgError, "argument must be a leaf atom");
+ if(!iscvalue(args[0]))
+ return args[0];
+ if(!cv_isPOD(ptr(args[0])))
+ lerrorf(ArgError, "argument must be a plain-old-data type");
+ return cvalue_copy(args[0]);
}
BUILTIN("plain-old-data?", plain_old_datap) {- argcount(nargs, 1);
- return (iscprim(args[0]) ||
- (iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ?
- FL_T : FL_F;
+ argcount(nargs, 1);
+ return (iscprim(args[0]) ||
+ (iscvalue(args[0]) && cv_isPOD((cvalue_t*)ptr(args[0])))) ?
+ FL_T : FL_F;
}
-static void cvalue_init(fltype_t *type, value_t v, void *dest)
+static void
+cvalue_init(fltype_t *type, value_t v, void *dest)
{- cvinitfunc_t f=type->init;
-
- if (f == nil)
- lerrorf(ArgError, "invalid c type");
-
- f(type, v, dest);
+ cvinitfunc_t f = type->init;
+ if(f == nil)
+ lerrorf(ArgError, "invalid c type");
+ f(type, v, dest);
}
// (new type . args)
@@ -764,442 +784,439 @@
// type, including user-defined.
BUILTIN("c-value", c_value) {- if (nargs < 1 || nargs > 2)
- argcount(nargs, 2);
- value_t type = args[0];
- fltype_t *ft = get_type(type);
- value_t cv;
- if (ft->eltype != nil) {- // special case to handle incomplete array types bla[]
- size_t elsz = ft->elsz;
- size_t cnt;
+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 2);
+ value_t type = args[0];
+ fltype_t *ft = get_type(type);
+ value_t cv;
+ if(ft->eltype != nil){+ // special case to handle incomplete array types bla[]
+ size_t elsz = ft->elsz;
+ size_t cnt;
- if (iscons(cdr_(cdr_(type))))
- cnt = toulong(car_(cdr_(cdr_(type))));
- else if (nargs == 2)
- cnt = predict_arraylen(args[1]);
- else
- cnt = 0;
- cv = cvalue(ft, elsz * cnt);
- if (nargs == 2)
- cvalue_array_init(ft, args[1], cv_data((cvalue_t*)ptr(cv)));
- }
- else {- cv = cvalue(ft, ft->size);
- if (nargs == 2)
- cvalue_init(ft, args[1], cptr(cv));
- }
- return cv;
+ if(iscons(cdr_(cdr_(type))))
+ cnt = toulong(car_(cdr_(cdr_(type))));
+ else if(nargs == 2)
+ cnt = predict_arraylen(args[1]);
+ else
+ cnt = 0;
+ cv = cvalue(ft, elsz * cnt);
+ if(nargs == 2)
+ cvalue_array_init(ft, args[1], cv_data(ptr(cv)));
+ }else{+ cv = cvalue(ft, ft->size);
+ if(nargs == 2)
+ cvalue_init(ft, args[1], cptr(cv));
+ }
+ return cv;
}
// NOTE: this only compares lexicographically; it ignores numeric formats
-value_t cvalue_compare(value_t a, value_t b)
+value_t
+cvalue_compare(value_t a, value_t b)
{- cvalue_t *ca = (cvalue_t*)ptr(a);
- cvalue_t *cb = (cvalue_t*)ptr(b);
- char *adata = cv_data(ca);
- char *bdata = cv_data(cb);
- size_t asz = cv_len(ca);
- size_t bsz = cv_len(cb);
- size_t minsz = asz < bsz ? asz : bsz;
- int diff = memcmp(adata, bdata, minsz);
- if (diff == 0) {- if (asz > bsz)
- return fixnum(1);
- else if (asz < bsz)
- return fixnum(-1);
- }
- return fixnum(diff);
+ cvalue_t *ca = ptr(a);
+ cvalue_t *cb = ptr(b);
+ char *adata = cv_data(ca);
+ char *bdata = cv_data(cb);
+ size_t asz = cv_len(ca);
+ size_t bsz = cv_len(cb);
+ size_t minsz = asz < bsz ? asz : bsz;
+ int diff = memcmp(adata, bdata, minsz);
+ if(diff == 0){+ if(asz > bsz)
+ return fixnum(1);
+ if(asz < bsz)
+ return fixnum(-1);
+ }
+ return fixnum(diff);
}
-static void check_addr_args(value_t arr, value_t ind,
- char **data, int *index)
+static void
+check_addr_args(value_t arr, value_t ind, char **data, int *index)
{- int numel;
- cvalue_t *cv = (cvalue_t*)ptr(arr);
- *data = cv_data(cv);
- numel = cv_len(cv)/(cv_class(cv)->elsz);
- *index = toulong(ind);
- if (*index >= numel)
- bounds_error(arr, ind);
+ int numel;
+ cvalue_t *cv = ptr(arr);
+ *data = cv_data(cv);
+ numel = cv_len(cv)/cv_class(cv)->elsz;
+ *index = toulong(ind);
+ if(*index >= numel)
+ bounds_error(arr, ind);
}
-static value_t cvalue_array_aref(value_t *args)
+static value_t
+cvalue_array_aref(value_t *args)
{- char *data; int index;
- fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype;
- value_t el = 0;
- numerictype_t nt = eltype->numtype;
- if (nt >= T_INT32)
- el = cvalue(eltype, eltype->size);
- check_addr_args(args[0], args[1], &data, &index);
- if (nt < T_INT32) {- if (nt == T_INT8)
- return fixnum((int8_t)data[index]);
- else if (nt == T_UINT8)
- return fixnum((uint8_t)data[index]);
- else if (nt == T_INT16)
- return fixnum(((int16_t*)data)[index]);
- return fixnum(((uint16_t*)data)[index]);
- }
- char *dest = cptr(el);
- size_t sz = eltype->size;
- if (sz == 1)
- *dest = data[index];
- else if (sz == 2)
- *(int16_t*)dest = ((int16_t*)data)[index];
- else if (sz == 4)
- *(int32_t*)dest = ((int32_t*)data)[index];
- else if (sz == 8)
- *(int64_t*)dest = ((int64_t*)data)[index];
- else
- memmove(dest, data + index*sz, sz);
- return el;
+ char *data; int index;
+ fltype_t *eltype = cv_class(ptr(args[0]))->eltype;
+ value_t el = 0;
+ numerictype_t nt = eltype->numtype;
+ if(nt >= T_INT32)
+ el = cvalue(eltype, eltype->size);
+ check_addr_args(args[0], args[1], &data, &index);
+ if(nt < T_INT32){+ if(nt == T_INT8)
+ return fixnum((int8_t)data[index]);
+ if(nt == T_UINT8)
+ return fixnum((uint8_t)data[index]);
+ if(nt == T_INT16)
+ return fixnum(((int16_t*)data)[index]);
+ return fixnum(((uint16_t*)data)[index]);
+ }
+ char *dest = cptr(el);
+ size_t sz = eltype->size;
+ if(sz == 1)
+ *dest = data[index];
+ else if(sz == 2)
+ *(int16_t*)dest = ((int16_t*)data)[index];
+ else if(sz == 4)
+ *(int32_t*)dest = ((int32_t*)data)[index];
+ else if(sz == 8)
+ *(int64_t*)dest = ((int64_t*)data)[index];
+ else
+ memmove(dest, data + index*sz, sz);
+ return el;
}
static value_t cvalue_array_aset(value_t *args)
{- char *data; int index;
- fltype_t *eltype = cv_class((cvalue_t*)ptr(args[0]))->eltype;
- check_addr_args(args[0], args[1], &data, &index);
- char *dest = data + index*eltype->size;
- cvalue_init(eltype, args[2], dest);
- return args[2];
+ char *data; int index;
+ fltype_t *eltype = cv_class(ptr(args[0]))->eltype;
+ check_addr_args(args[0], args[1], &data, &index);
+ char *dest = data + index*eltype->size;
+ cvalue_init(eltype, args[2], dest);
+ return args[2];
}
BUILTIN("builtin", builtin) {- argcount(nargs, 1);
- symbol_t *name = tosymbol(args[0]);
- cvalue_t *cv;
- if (ismanaged(args[0]) || (cv=name->dlcache) == nil)
- lerrorf(ArgError, "function %s not found", name->name);
- return tagptr(cv, TAG_CVALUE);
+ argcount(nargs, 1);
+ symbol_t *name = tosymbol(args[0]);
+ cvalue_t *cv;
+ if(ismanaged(args[0]) || (cv = name->dlcache) == nil)
+ lerrorf(ArgError, "function %s not found", name->name);
+ return tagptr(cv, TAG_CVALUE);
}
-value_t cbuiltin(char *name, builtin_t f)
+value_t
+cbuiltin(char *name, builtin_t f)
{- cvalue_t *cv;
- cv = calloc(CVALUE_NWORDS, sizeof(*cv));
- cv->type = builtintype;
- cv->data = &cv->_space[0];
- cv->len = sizeof(value_t);
- *(void**)cv->data = f;
+ cvalue_t *cv;
+ cv = calloc(CVALUE_NWORDS, sizeof(*cv));
+ cv->type = builtintype;
+ cv->data = &cv->_space[0];
+ cv->len = sizeof(value_t);
+ *(void**)cv->data = f;
- value_t sym = symbol(name);
- ((symbol_t*)ptr(sym))->dlcache = cv;
- ptrhash_put(&reverse_dlsym_lookup_table, cv, (void*)sym);
+ value_t sym = symbol(name);
+ ((symbol_t*)ptr(sym))->dlcache = cv;
+ ptrhash_put(&reverse_dlsym_lookup_table, cv, (void*)sym);
- return tagptr(cv, TAG_CVALUE);
+ return tagptr(cv, TAG_CVALUE);
}
-#define cv_intern(tok) \
- do{ \- tok##sym = symbol(#tok); \
- }while(0)
+#define cv_intern(tok) \
+ do{ \+ tok##sym = symbol(#tok); \
+ }while(0)
-#define ctor_cv_intern(tok, nt, ctype) \
- do{ \- symbol_t *s; \
- cv_intern(tok); \
- set(tok##sym, cbuiltin(#tok, fn_builtin_##tok)); \
- if (valid_numtype(nt)) { \- s = ptr(tok##sym); \
- s->numtype = nt; \
- s->size = sizeof(ctype); \
- s->align = offsetof(struct{char c; ctype x;}, x); \- } \
- }while(0)
+#define ctor_cv_intern(tok, nt, ctype) \
+ do{ \+ symbol_t *s; \
+ cv_intern(tok); \
+ set(tok##sym, cbuiltin(#tok, fn_builtin_##tok)); \
+ if(valid_numtype(nt)){ \+ s = ptr(tok##sym); \
+ s->numtype = nt; \
+ s->size = sizeof(ctype); \
+ s->align = offsetof(struct{char c; ctype x;}, x); \+ } \
+ }while(0)
#define mk_primtype(name, ctype) \
- do{ \- name##type=get_type(name##sym); \
- name##type->init = cvalue_##ctype##_init; \
- }while(0)
+ do{ \+ name##type = get_type(name##sym); \
+ name##type->init = cvalue_##ctype##_init; \
+ }while(0)
#define RETURN_NUM_AS(var, type) return(mk_##type(var))
-value_t return_from_uint64(uint64_t Uaccum)
+value_t
+return_from_uint64(uint64_t Uaccum)
{- if (fits_fixnum(Uaccum)) {- return fixnum((fixnum_t)Uaccum);
- }
- if (Uaccum > (uint64_t)INT64_MAX) {- RETURN_NUM_AS(Uaccum, uint64);
- }
- else if (Uaccum > (uint64_t)UINT32_MAX) {- RETURN_NUM_AS(Uaccum, int64);
- }
- else if (Uaccum > (uint64_t)INT32_MAX) {- RETURN_NUM_AS(Uaccum, uint32);
- }
- RETURN_NUM_AS(Uaccum, int32);
+ if(fits_fixnum(Uaccum))
+ return fixnum((fixnum_t)Uaccum);
+ if(Uaccum > (uint64_t)INT64_MAX)
+ RETURN_NUM_AS(Uaccum, uint64);
+ if(Uaccum > (uint64_t)UINT32_MAX)
+ RETURN_NUM_AS(Uaccum, int64);
+ if(Uaccum > (uint64_t)INT32_MAX)
+ RETURN_NUM_AS(Uaccum, uint32);
+ RETURN_NUM_AS(Uaccum, int32);
}
-value_t return_from_int64(int64_t Saccum)
+value_t
+return_from_int64(int64_t Saccum)
{- if (fits_fixnum(Saccum)) {- return fixnum((fixnum_t)Saccum);
- }
- if (Saccum > (int64_t)UINT32_MAX || Saccum < (int64_t)INT32_MIN) {- RETURN_NUM_AS(Saccum, int64);
- }
- else if (Saccum > (int64_t)INT32_MAX) {- RETURN_NUM_AS(Saccum, uint32);
- }
- RETURN_NUM_AS(Saccum, int32);
+ if(fits_fixnum(Saccum))
+ return fixnum((fixnum_t)Saccum);
+ if(Saccum > (int64_t)UINT32_MAX || Saccum < (int64_t)INT32_MIN)
+ RETURN_NUM_AS(Saccum, int64);
+ if(Saccum > (int64_t)INT32_MAX)
+ RETURN_NUM_AS(Saccum, uint32);
+ RETURN_NUM_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)
{- uint64_t Uaccum=0;
- int64_t Saccum = carryIn;
- double Faccum=0;
- int32_t inexact = 0;
- uint32_t i;
- int64_t i64;
- value_t arg;
- mpint *Maccum = nil, *x;
- numerictype_t pt;
- fixnum_t pi;
- void *a;
+ uint64_t Uaccum = 0;
+ int64_t Saccum = carryIn;
+ double Faccum = 0;
+ int32_t inexact = 0;
+ uint32_t i;
+ int64_t i64;
+ value_t arg;
+ mpint *Maccum = nil, *x;
+ numerictype_t pt;
+ fixnum_t pi;
+ void *a;
- FOR_ARGS(i,0,arg,args) {- if (isfixnum(arg)) {- Saccum += numval(arg);
- continue;
- }
- if (num_to_ptr(arg, &pi, &pt, &a)) {- switch(pt) {- case T_INT8: Saccum += *(int8_t*)a; break;
- case T_UINT8: Uaccum += *(uint8_t*)a; break;
- case T_INT16: Saccum += *(int16_t*)a; break;
- case T_UINT16: Uaccum += *(uint16_t*)a; break;
- case T_INT32: Saccum += *(int32_t*)a; break;
- case T_UINT32: Uaccum += *(uint32_t*)a; break;
- case T_INT64:
- i64 = *(int64_t*)a;
- if (i64 > 0)
- Uaccum += (uint64_t)i64;
- else
- Saccum += i64;
- break;
- case T_UINT64: Uaccum += *(uint64_t*)a; break;
- case T_MPINT:
- if (Maccum == nil)
- Maccum = mpnew(0);
- mpadd(Maccum, *(mpint**)a, Maccum);
- break;
- case T_FLOAT: Faccum += *(float*)a; inexact = 1; break;
- case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
- default:
- goto add_type_error;
- }
- continue;
- }
+ FOR_ARGS(i, 0, arg, args){+ if(isfixnum(arg)){+ Saccum += numval(arg);
+ continue;
+ }
+ if(num_to_ptr(arg, &pi, &pt, &a)){+ switch(pt){+ case T_INT8: Saccum += *(int8_t*)a; break;
+ case T_UINT8: Uaccum += *(uint8_t*)a; break;
+ case T_INT16: Saccum += *(int16_t*)a; break;
+ case T_UINT16: Uaccum += *(uint16_t*)a; break;
+ case T_INT32: Saccum += *(int32_t*)a; break;
+ case T_UINT32: Uaccum += *(uint32_t*)a; break;
+ case T_INT64:
+ i64 = *(int64_t*)a;
+ if(i64 > 0)
+ Uaccum += (uint64_t)i64;
+ else
+ Saccum += i64;
+ break;
+ case T_UINT64: Uaccum += *(uint64_t*)a; break;
+ case T_MPINT:
+ if(Maccum == nil)
+ Maccum = mpnew(0);
+ mpadd(Maccum, *(mpint**)a, Maccum);
+ break;
+ case T_FLOAT: Faccum += *(float*)a; inexact = 1; break;
+ case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
+ default:
+ goto add_type_error;
+ }
+ continue;
+ }
add_type_error:
- mpfree(Maccum);
- type_error("number", arg);- }
- if (inexact) {- Faccum += Uaccum;
- Faccum += Saccum;
- if (Maccum != nil) {- Faccum += mptod(Maccum);
- mpfree(Maccum);
- }
- return mk_double(Faccum);
- }
- if (Maccum != nil) {- /* FIXME - check if it fits into fixnum first, etc */
- x = vtomp(Saccum, nil);
- mpadd(Maccum, x, Maccum);
- x = uvtomp(Uaccum, x);
- mpadd(Maccum, x, Maccum);
- mpfree(x);
- return mk_mpint(Maccum);
- }
- if (Saccum < 0) {- uint64_t negpart = (uint64_t)(-Saccum);
- if (negpart > Uaccum) {- Saccum += (int64_t)Uaccum;
- // return value in Saccum
- if (Saccum >= INT32_MIN) {- if (fits_fixnum(Saccum)) {- return fixnum((fixnum_t)Saccum);
- }
- RETURN_NUM_AS(Saccum, int32);
- }
- RETURN_NUM_AS(Saccum, int64);
- }
- Uaccum -= negpart;
- }
- else {- Uaccum += (uint64_t)Saccum;
- }
- // return value in Uaccum
- return return_from_uint64(Uaccum);
-}
+ mpfree(Maccum);
+ type_error("number", arg);+ }
+ if(inexact){+ Faccum += Uaccum;
+ Faccum += Saccum;
+ if(Maccum != nil){+ Faccum += mptod(Maccum);
+ mpfree(Maccum);
+ }
+ return mk_double(Faccum);
+ }
+ if(Maccum != nil){+ /* FIXME - check if it fits into fixnum first, etc */
+ x = vtomp(Saccum, nil);
+ mpadd(Maccum, x, Maccum);
+ x = uvtomp(Uaccum, x);
+ mpadd(Maccum, x, Maccum);
+ mpfree(x);
+ return mk_mpint(Maccum);
+ }
+ if(Saccum < 0){+ uint64_t negpart = (uint64_t)(-Saccum);
+ if(negpart > Uaccum){+ Saccum += (int64_t)Uaccum;
+ // return value in Saccum
+ if(Saccum >= INT32_MIN){+ if(fits_fixnum(Saccum)){+ return fixnum((fixnum_t)Saccum);
+ }
+ RETURN_NUM_AS(Saccum, int32);
+ }
+ RETURN_NUM_AS(Saccum, int64);
+ }
+ Uaccum -= negpart;
+ }else{+ Uaccum += (uint64_t)Saccum;
+ }
+ // return value in Uaccum
+ return return_from_uint64(Uaccum);
+}
-static value_t fl_neg(value_t n)
+static value_t
+fl_neg(value_t n)
{- uint32_t ui32;
- int32_t i32;
- int64_t i64;
- mpint *mp;
- numerictype_t pt;
- fixnum_t pi;
- void *a;
+ uint32_t ui32;
+ int32_t i32;
+ int64_t i64;
+ mpint *mp;
+ numerictype_t pt;
+ fixnum_t pi;
+ void *a;
- if (isfixnum(n)) {- fixnum_t s = fixnum(-numval(n));
- if (__unlikely((value_t)s == n))
- return mk_xlong(-numval(n));
- return s;
- }
+ if(isfixnum(n)){+ fixnum_t s = fixnum(-numval(n));
+ if(__unlikely((value_t)s == n))
+ return mk_xlong(-numval(n));
+ return s;
+ }
- if (num_to_ptr(n, &pi, &pt, &a)) {- switch(pt) {- case T_INT8: return fixnum(-(int32_t)*(int8_t*)a);
- case T_UINT8: return fixnum(-(int32_t)*(uint8_t*)a);
- case T_INT16: return fixnum(-(int32_t)*(int16_t*)a);
- case T_UINT16: return fixnum(-(int32_t)*(uint16_t*)a);
- case T_INT32:
- i32 = *(int32_t*)a;
- if (i32 == (int32_t)BIT31)
- return mk_uint32((uint32_t)BIT31);
- return mk_int32(-i32);
- case T_UINT32:
- ui32 = *(uint32_t*)a;
- if (ui32 <= ((uint32_t)INT32_MAX)+1) return mk_int32(-(int32_t)ui32);
- return mk_int64(-(int64_t)ui32);
- case T_INT64:
- i64 = *(int64_t*)a;
- if (i64 == (int64_t)BIT63)
- return mk_uint64((uint64_t)BIT63);
- return mk_int64(-i64);
- case T_UINT64: return mk_int64(-(int64_t)*(uint64_t*)a);
- case T_MPINT:
- mp = mpcopy(*(mpint**)a);
- mpsub(mpzero, mp, mp);
- return mk_mpint(mp);
- case T_FLOAT: return mk_float(-*(float*)a);
- case T_DOUBLE: return mk_double(-*(double*)a);
- }
- }
+ if(num_to_ptr(n, &pi, &pt, &a)){+ switch(pt){+ case T_INT8: return fixnum(-(int32_t)*(int8_t*)a);
+ case T_UINT8: return fixnum(-(int32_t)*(uint8_t*)a);
+ case T_INT16: return fixnum(-(int32_t)*(int16_t*)a);
+ case T_UINT16: return fixnum(-(int32_t)*(uint16_t*)a);
+ case T_INT32:
+ i32 = *(int32_t*)a;
+ if(i32 == (int32_t)BIT31)
+ return mk_uint32((uint32_t)BIT31);
+ return mk_int32(-i32);
+ case T_UINT32:
+ ui32 = *(uint32_t*)a;
+ if(ui32 <= ((uint32_t)INT32_MAX)+1)
+ return mk_int32(-(int32_t)ui32);
+ return mk_int64(-(int64_t)ui32);
+ case T_INT64:
+ i64 = *(int64_t*)a;
+ if(i64 == (int64_t)BIT63)
+ return mk_uint64((uint64_t)BIT63);
+ return mk_int64(-i64);
+ case T_UINT64: return mk_int64(-(int64_t)*(uint64_t*)a);
+ case T_MPINT:
+ mp = mpcopy(*(mpint**)a);
+ mpsub(mpzero, mp, mp);
+ return mk_mpint(mp);
+ case T_FLOAT: return mk_float(-*(float*)a);
+ case T_DOUBLE: return mk_double(-*(double*)a);
+ }
+ }
- type_error("number", n);+ type_error("number", n);}
-static value_t fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
+static value_t
+fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
{- uint64_t Uaccum=1;
- double Faccum=1;
- int32_t inexact = 0;
- int64_t i64;
- uint32_t i;
- value_t arg;
- mpint *Maccum=nil, *x;
- numerictype_t pt;
- fixnum_t pi;
- void *a;
+ uint64_t Uaccum = 1;
+ double Faccum = 1;
+ int32_t inexact = 0;
+ int64_t i64;
+ uint32_t i;
+ value_t arg;
+ mpint *Maccum = nil, *x;
+ numerictype_t pt;
+ fixnum_t pi;
+ void *a;
- FOR_ARGS(i,0,arg,args) {- if (isfixnum(arg)) {- Saccum *= numval(arg);
- continue;
- }
- if (num_to_ptr(arg, &pi, &pt, &a)) {- switch(pt) {- case T_INT8: Saccum *= *(int8_t*)a; break;
- case T_UINT8: Uaccum *= *(uint8_t*)a; break;
- case T_INT16: Saccum *= *(int16_t*)a; break;
- case T_UINT16: Uaccum *= *(uint16_t*)a; break;
- case T_INT32: Saccum *= *(int32_t*)a; break;
- case T_UINT32: Uaccum *= *(uint32_t*)a; break;
- case T_INT64:
- i64 = *(int64_t*)a;
- if (i64 > 0)
- Uaccum *= (uint64_t)i64;
- else
- Saccum *= i64;
- break;
- case T_UINT64: Uaccum *= *(uint64_t*)a; break;
- case T_MPINT:
- if (Maccum == nil)
- Maccum = mpcopy(mpone);
- mpmul(Maccum, *(mpint**)a, Maccum);
- break;
- case T_FLOAT: Faccum *= *(float*)a; inexact = 1; break;
- case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
- default:
- goto mul_type_error;
- }
- continue;
- }
+ FOR_ARGS(i, 0, arg, args){+ if(isfixnum(arg)){+ Saccum *= numval(arg);
+ continue;
+ }
+ if(num_to_ptr(arg, &pi, &pt, &a)){+ switch(pt){+ case T_INT8: Saccum *= *(int8_t*)a; break;
+ case T_UINT8: Uaccum *= *(uint8_t*)a; break;
+ case T_INT16: Saccum *= *(int16_t*)a; break;
+ case T_UINT16: Uaccum *= *(uint16_t*)a; break;
+ case T_INT32: Saccum *= *(int32_t*)a; break;
+ case T_UINT32: Uaccum *= *(uint32_t*)a; break;
+ case T_INT64:
+ i64 = *(int64_t*)a;
+ if(i64 > 0)
+ Uaccum *= (uint64_t)i64;
+ else
+ Saccum *= i64;
+ break;
+ case T_UINT64: Uaccum *= *(uint64_t*)a; break;
+ case T_MPINT:
+ if(Maccum == nil)
+ Maccum = mpcopy(mpone);
+ mpmul(Maccum, *(mpint**)a, Maccum);
+ break;
+ case T_FLOAT: Faccum *= *(float*)a; inexact = 1; break;
+ case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
+ default:
+ goto mul_type_error;
+ }
+ continue;
+ }
mul_type_error:
- type_error("number", arg);- }
- if (inexact) {- Faccum *= Uaccum;
- Faccum *= Saccum;
- if (Maccum != nil) {- Faccum *= mptod(Maccum);
- mpfree(Maccum);
- }
- return mk_double(Faccum);
- }
- if (Maccum != nil) {- /* FIXME might still fit into a fixnum */
- x = vtomp(Saccum, nil);
- mpmul(Maccum, x, Maccum);
- x = uvtomp(Uaccum, x);
- mpmul(Maccum, x, Maccum);
- mpfree(x);
- return mk_mpint(Maccum);
- }
- if (Saccum < 0) {- Saccum *= (int64_t)Uaccum;
- if (Saccum >= INT32_MIN) {- if (fits_fixnum(Saccum)) {- return fixnum((fixnum_t)Saccum);
- }
- RETURN_NUM_AS(Saccum, int32);
- }
- RETURN_NUM_AS(Saccum, int64);
- }
- else {- Uaccum *= (uint64_t)Saccum;
- }
- return return_from_uint64(Uaccum);
+ type_error("number", arg);+ }
+ if(inexact){+ Faccum *= Uaccum;
+ Faccum *= Saccum;
+ if(Maccum != nil){+ Faccum *= mptod(Maccum);
+ mpfree(Maccum);
+ }
+ return mk_double(Faccum);
+ }
+ if(Maccum != nil){+ /* FIXME might still fit into a fixnum */
+ x = vtomp(Saccum, nil);
+ mpmul(Maccum, x, Maccum);
+ x = uvtomp(Uaccum, x);
+ mpmul(Maccum, x, Maccum);
+ mpfree(x);
+ return mk_mpint(Maccum);
+ }
+ if(Saccum < 0){+ Saccum *= (int64_t)Uaccum;
+ if(Saccum >= INT32_MIN){+ if(fits_fixnum(Saccum)){+ return fixnum((fixnum_t)Saccum);
+ }
+ RETURN_NUM_AS(Saccum, int32);
+ }
+ RETURN_NUM_AS(Saccum, int64);
+ }else{+ Uaccum *= (uint64_t)Saccum;
+ }
+ return return_from_uint64(Uaccum);
}
-int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp)
+int
+num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp)
{- cprim_t *cp;
- cvalue_t *cv;
- if (isfixnum(a)) {- *pi = numval(a);
- *pp = pi;
- *pt = T_FIXNUM;
- }
- else if (iscprim(a)) {- cp = (cprim_t*)ptr(a);
- *pp = cp_data(cp);
- *pt = cp_numtype(cp);
- }
- else if (iscvalue(a)) {- cv = (cvalue_t*)ptr(a);
- *pp = cv_data(cv);
- *pt = cv_class(cv)->numtype;
- return valid_numtype(*pt);
- }
- else {- return 0;
- }
- return 1;
+ cprim_t *cp;
+ cvalue_t *cv;
+ if(isfixnum(a)){+ *pi = numval(a);
+ *pp = pi;
+ *pt = T_FIXNUM;
+ return 1;
+ }else if(iscprim(a)){+ cp = (cprim_t*)ptr(a);
+ *pp = cp_data(cp);
+ *pt = cp_numtype(cp);
+ return 1;
+ }else if(iscvalue(a)){+ cv = (cvalue_t*)ptr(a);
+ *pp = cv_data(cv);
+ *pt = cv_class(cv)->numtype;
+ return valid_numtype(*pt);
+ }
+ return 0;
}
/*
@@ -1206,408 +1223,417 @@
returns -1, 0, or 1 based on ordering of a and b
eq: consider equality only, returning 0 or nonzero
eqnans: NaNs considered equal to each other
- -0.0 not considered equal to 0.0
- inexact not considered equal to exact
+ -0.0 not considered equal to 0.0
+ inexact not considered equal to exact
typeerr: if not 0, throws type errors, else returns 2 for type errors
*/
-int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr)
+int
+numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr)
{- lltint_t ai, bi;
- numerictype_t ta, tb;
- void *aptr, *bptr;
+ lltint_t ai, bi;
+ numerictype_t ta, tb;
+ void *aptr, *bptr;
- if (bothfixnums(a,b)) {- if (a==b) return 0;
- if (numval(a) < numval(b)) return -1;
- return 1;
- }
- if (!num_to_ptr(a, &ai, &ta, &aptr)) {- if (typeerr)
- type_error("number", a);- else
- return 2;
- }
- if (!num_to_ptr(b, &bi, &tb, &bptr)) {- if (typeerr)
- type_error("number", b);- else
- return 2;
- }
- if (eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
- return 1;
- if (cmp_eq(aptr, ta, bptr, tb, eqnans))
- return 0;
- if (eq) return 1;
- if (cmp_lt(aptr, ta, bptr, tb))
- return -1;
- return 1;
+ if(bothfixnums(a,b)){+ if(a == b)
+ return 0;
+ if(numval(a) < numval(b))
+ return -1;
+ return 1;
+ }
+ if(!num_to_ptr(a, &ai, &ta, &aptr)){+ if(typeerr)
+ type_error("number", a);+ return 2;
+ }
+ if(!num_to_ptr(b, &bi, &tb, &bptr)){+ if(typeerr)
+ type_error("number", b);+ return 2;
+ }
+ if(eq && eqnans && ((ta >= T_FLOAT) != (tb >= T_FLOAT)))
+ return 1;
+ if(cmp_eq(aptr, ta, bptr, tb, eqnans))
+ return 0;
+ if(eq)
+ return 1;
+ if(cmp_lt(aptr, ta, bptr, tb))
+ return -1;
+ return 1;
}
-static _Noreturn void DivideByZeroError(void)
+static _Noreturn void
+DivideByZeroError(void)
{- lerrorf(DivideError, "/: division by zero");
+ lerrorf(DivideError, "/: division by zero");
}
-static value_t fl_div2(value_t a, value_t b)
+static value_t
+fl_div2(value_t a, value_t b)
{- double da, db;
- lltint_t ai, bi;
- numerictype_t ta, tb;
- void *aptr, *bptr;
+ double da, db;
+ lltint_t ai, bi;
+ numerictype_t ta, tb;
+ void *aptr, *bptr;
- if (!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("number", a);- if (!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("number", b);+ if(!num_to_ptr(a, &ai, &ta, &aptr))
+ type_error("number", a);+ if(!num_to_ptr(b, &bi, &tb, &bptr))
+ type_error("number", b);- da = conv_to_double(aptr, ta);
- db = conv_to_double(bptr, tb);
+ da = conv_to_double(aptr, ta);
+ db = conv_to_double(bptr, tb);
- if (db == 0 && tb < T_FLOAT) // exact 0
- DivideByZeroError();
+ if(db == 0 && tb < T_FLOAT) // exact 0
+ DivideByZeroError();
- da = da/db;
+ da = da/db;
- if (ta < T_FLOAT && tb < T_FLOAT && (double)(int64_t)da == da)
- return return_from_int64((int64_t)da);
- return mk_double(da);
+ if(ta < T_FLOAT && tb < T_FLOAT && (double)(int64_t)da == da)
+ return return_from_int64((int64_t)da);
+ return mk_double(da);
}
static value_t fl_idiv2(value_t a, value_t b)
{- lltint_t ai, bi;
- numerictype_t ta, tb;
- void *aptr, *bptr;
- int64_t a64, b64;
- mpint *x;
+ lltint_t ai, bi;
+ numerictype_t ta, tb;
+ void *aptr, *bptr;
+ int64_t a64, b64;
+ mpint *x;
- if (!num_to_ptr(a, &ai, &ta, &aptr))
- type_error("number", a);- if (!num_to_ptr(b, &bi, &tb, &bptr))
- type_error("number", b);+ if(!num_to_ptr(a, &ai, &ta, &aptr))
+ type_error("number", a);+ if(!num_to_ptr(b, &bi, &tb, &bptr))
+ type_error("number", b);- if (ta == T_MPINT) {- if (tb == T_MPINT) {- if (mpsignif(*(mpint**)bptr) == 0)
- goto div_error;
- x = mpnew(0);
- mpdiv(*(mpint**)aptr, *(mpint**)bptr, x, nil);
- return mk_mpint(x);
- } else {- b64 = conv_to_int64(bptr, tb);
- if (b64 == 0)
- goto div_error;
- x = tb == T_UINT64 ? uvtomp(b64, nil) : vtomp(b64, nil);
- mpdiv(*(mpint**)aptr, x, x, nil);
- return mk_mpint(x);
- }
- }
- if (ta == T_UINT64) {- if (tb == T_UINT64) {- if (*(uint64_t*)bptr == 0) goto div_error;
- return return_from_uint64(*(uint64_t*)aptr / *(uint64_t*)bptr);
- }
- b64 = conv_to_int64(bptr, tb);
- if (b64 < 0) {- return return_from_int64(-(int64_t)(*(uint64_t*)aptr /
- (uint64_t)(-b64)));
- }
- if (b64 == 0)
- goto div_error;
- return return_from_uint64(*(uint64_t*)aptr / (uint64_t)b64);
- }
- if (tb == T_UINT64) {- if (*(uint64_t*)bptr == 0) goto div_error;
- a64 = conv_to_int64(aptr, ta);
- if (a64 < 0) {- return return_from_int64(-((int64_t)((uint64_t)(-a64) /
- *(uint64_t*)bptr)));
- }
- return return_from_uint64((uint64_t)a64 / *(uint64_t*)bptr);
- }
+ if(ta == T_MPINT){+ if(tb == T_MPINT){+ if(mpsignif(*(mpint**)bptr) == 0)
+ goto div_error;
+ x = mpnew(0);
+ mpdiv(*(mpint**)aptr, *(mpint**)bptr, x, nil);
+ return mk_mpint(x);
+ }else{+ b64 = conv_to_int64(bptr, tb);
+ if(b64 == 0)
+ goto div_error;
+ x = tb == T_UINT64 ? uvtomp(b64, nil) : vtomp(b64, nil);
+ mpdiv(*(mpint**)aptr, x, x, nil);
+ return mk_mpint(x);
+ }
+ }
+ if(ta == T_UINT64){+ if(tb == T_UINT64){+ if(*(uint64_t*)bptr == 0)
+ goto div_error;
+ return return_from_uint64(*(uint64_t*)aptr / *(uint64_t*)bptr);
+ }
+ b64 = conv_to_int64(bptr, tb);
+ if(b64 < 0)
+ return return_from_int64(-(int64_t)(*(uint64_t*)aptr / (uint64_t)(-b64)));
+ if(b64 == 0)
+ goto div_error;
+ return return_from_uint64(*(uint64_t*)aptr / (uint64_t)b64);
+ }
+ if(tb == T_UINT64){+ if(*(uint64_t*)bptr == 0)
+ goto div_error;
+ a64 = conv_to_int64(aptr, ta);
+ if(a64 < 0)
+ return return_from_int64(-((int64_t)((uint64_t)(-a64) / *(uint64_t*)bptr)));
+ return return_from_uint64((uint64_t)a64 / *(uint64_t*)bptr);
+ }
- b64 = conv_to_int64(bptr, tb);
- if (b64 == 0) goto div_error;
+ b64 = conv_to_int64(bptr, tb);
+ if(b64 == 0)
+ goto div_error;
- return return_from_int64(conv_to_int64(aptr, ta) / b64);
+ return return_from_int64(conv_to_int64(aptr, ta) / b64);
div_error:
- DivideByZeroError();
+ DivideByZeroError();
}
-static value_t fl_bitwise_op(value_t a, value_t b, int opcode)
+static value_t
+fl_bitwise_op(value_t a, value_t b, int opcode)
{- lltint_t ai, bi;
- numerictype_t ta, tb, itmp;
- void *aptr=nil, *bptr=nil, *ptmp;
- mpint *bmp = nil, *resmp = nil;
- int64_t b64;
+ lltint_t ai, bi;
+ numerictype_t ta, tb, itmp;
+ void *aptr = nil, *bptr = nil, *ptmp;
+ mpint *bmp = nil, *resmp = nil;
+ int64_t b64;
- if (!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
- type_error("integer", a);- if (!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
- type_error("integer", b);+ if(!num_to_ptr(a, &ai, &ta, &aptr) || ta >= T_FLOAT)
+ type_error("integer", a);+ if(!num_to_ptr(b, &bi, &tb, &bptr) || tb >= T_FLOAT)
+ type_error("integer", b);- if (ta < tb) {- itmp = ta; ta = tb; tb = itmp;
- ptmp = aptr; aptr = bptr; bptr = ptmp;
- }
- // now a's type is larger than or same as b's
- if (ta == T_MPINT) {- if (tb == T_MPINT) {- bmp = *(mpint**)bptr;
- resmp = mpnew(0);
- } else {- bmp = conv_to_mpint(bptr, tb);
- resmp = bmp;
- }
- b64 = 0;
- }
- else
- b64 = conv_to_int64(bptr, tb);
- switch (opcode) {- case 0:
- switch (ta) {- case T_INT8: return fixnum( *(int8_t *)aptr & (int8_t )b64);
- case T_UINT8: return fixnum( *(uint8_t *)aptr & (uint8_t )b64);
- case T_INT16: return fixnum( *(int16_t*)aptr & (int16_t )b64);
- case T_UINT16: return fixnum( *(uint16_t*)aptr & (uint16_t)b64);
- case T_INT32: return mk_int32( *(int32_t*)aptr & (int32_t )b64);
- case T_UINT32: return mk_uint32(*(uint32_t*)aptr & (uint32_t)b64);
- case T_INT64: return mk_int64( *(int64_t*)aptr & (int64_t )b64);
- case T_UINT64: return mk_uint64(*(uint64_t*)aptr & (uint64_t)b64);
- case T_MPINT: mpand(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
- }
- break;
- case 1:
- switch (ta) {- case T_INT8: return fixnum( *(int8_t *)aptr | (int8_t )b64);
- case T_UINT8: return fixnum( *(uint8_t *)aptr | (uint8_t )b64);
- case T_INT16: return fixnum( *(int16_t*)aptr | (int16_t )b64);
- case T_UINT16: return fixnum( *(uint16_t*)aptr | (uint16_t)b64);
- case T_INT32: return mk_int32( *(int32_t*)aptr | (int32_t )b64);
- case T_UINT32: return mk_uint32(*(uint32_t*)aptr | (uint32_t)b64);
- case T_INT64: return mk_int64( *(int64_t*)aptr | (int64_t )b64);
- case T_UINT64: return mk_uint64(*(uint64_t*)aptr | (uint64_t)b64);
- case T_MPINT: mpor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
- }
- break;
- case 2:
- switch (ta) {- case T_INT8: return fixnum( *(int8_t *)aptr ^ (int8_t )b64);
- case T_UINT8: return fixnum( *(uint8_t *)aptr ^ (uint8_t )b64);
- case T_INT16: return fixnum( *(int16_t*)aptr ^ (int16_t )b64);
- case T_UINT16: return fixnum( *(uint16_t*)aptr ^ (uint16_t)b64);
- case T_INT32: return mk_int32( *(int32_t*)aptr ^ (int32_t )b64);
- case T_UINT32: return mk_uint32(*(uint32_t*)aptr ^ (uint32_t)b64);
- case T_INT64: return mk_int64( *(int64_t*)aptr ^ (int64_t )b64);
- case T_UINT64: return mk_uint64(*(uint64_t*)aptr ^ (uint64_t)b64);
- case T_MPINT: mpxor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
- case T_FLOAT:
- case T_DOUBLE: assert(0);
- }
- }
- assert(0);
- return NIL;
+ if(ta < tb){+ itmp = ta; ta = tb; tb = itmp;
+ ptmp = aptr; aptr = bptr; bptr = ptmp;
+ }
+ // now a's type is larger than or same as b's
+ if(ta == T_MPINT){+ if(tb == T_MPINT){+ bmp = *(mpint**)bptr;
+ resmp = mpnew(0);
+ }else{+ bmp = conv_to_mpint(bptr, tb);
+ resmp = bmp;
+ }
+ b64 = 0;
+ }else
+ b64 = conv_to_int64(bptr, tb);
+ switch(opcode){+ case 0:
+ switch(ta){+ case T_INT8: return fixnum( *(int8_t *)aptr & (int8_t )b64);
+ case T_UINT8: return fixnum( *(uint8_t *)aptr & (uint8_t )b64);
+ case T_INT16: return fixnum( *(int16_t*)aptr & (int16_t )b64);
+ case T_UINT16: return fixnum( *(uint16_t*)aptr & (uint16_t)b64);
+ case T_INT32: return mk_int32( *(int32_t*)aptr & (int32_t )b64);
+ case T_UINT32: return mk_uint32(*(uint32_t*)aptr & (uint32_t)b64);
+ case T_INT64: return mk_int64( *(int64_t*)aptr & (int64_t )b64);
+ case T_UINT64: return mk_uint64(*(uint64_t*)aptr & (uint64_t)b64);
+ case T_MPINT: mpand(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: assert(0);
+ }
+ break;
+ case 1:
+ switch(ta){+ case T_INT8: return fixnum( *(int8_t *)aptr | (int8_t )b64);
+ case T_UINT8: return fixnum( *(uint8_t *)aptr | (uint8_t )b64);
+ case T_INT16: return fixnum( *(int16_t*)aptr | (int16_t )b64);
+ case T_UINT16: return fixnum( *(uint16_t*)aptr | (uint16_t)b64);
+ case T_INT32: return mk_int32( *(int32_t*)aptr | (int32_t )b64);
+ case T_UINT32: return mk_uint32(*(uint32_t*)aptr | (uint32_t)b64);
+ case T_INT64: return mk_int64( *(int64_t*)aptr | (int64_t )b64);
+ case T_UINT64: return mk_uint64(*(uint64_t*)aptr | (uint64_t)b64);
+ case T_MPINT: mpor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: assert(0);
+ }
+ break;
+ case 2:
+ switch(ta){+ case T_INT8: return fixnum( *(int8_t *)aptr ^ (int8_t )b64);
+ case T_UINT8: return fixnum( *(uint8_t *)aptr ^ (uint8_t )b64);
+ case T_INT16: return fixnum( *(int16_t*)aptr ^ (int16_t )b64);
+ case T_UINT16: return fixnum( *(uint16_t*)aptr ^ (uint16_t)b64);
+ case T_INT32: return mk_int32( *(int32_t*)aptr ^ (int32_t )b64);
+ case T_UINT32: return mk_uint32(*(uint32_t*)aptr ^ (uint32_t)b64);
+ case T_INT64: return mk_int64( *(int64_t*)aptr ^ (int64_t )b64);
+ case T_UINT64: return mk_uint64(*(uint64_t*)aptr ^ (uint64_t)b64);
+ case T_MPINT: mpxor(*(mpint**)aptr, bmp, resmp); return mk_mpint(resmp);
+ case T_FLOAT:
+ case T_DOUBLE: assert(0);
+ }
+ }
+ assert(0);
+ return NIL;
}
BUILTIN("logand", logand) {- value_t v, e;
- int i;
- if (nargs == 0)
- return fixnum(-1);
- v = args[0];
- FOR_ARGS(i,1,e,args) {- if (bothfixnums(v, e))
- v = v & e;
- else
- v = fl_bitwise_op(v, e, 0);
- }
- return v;
+ value_t v, e;
+ int i;
+ if(nargs == 0)
+ return fixnum(-1);
+ v = args[0];
+ FOR_ARGS(i, 1, e, args){+ if(bothfixnums(v, e))
+ v = v & e;
+ else
+ v = fl_bitwise_op(v, e, 0);
+ }
+ return v;
}
BUILTIN("logior", logior) {- value_t v, e;
- int i;
- if (nargs == 0)
- return fixnum(0);
- v = args[0];
- FOR_ARGS(i,1,e,args) {- if (bothfixnums(v, e))
- v = v | e;
- else
- v = fl_bitwise_op(v, e, 1);
- }
- return v;
+ value_t v, e;
+ int i;
+ if(nargs == 0)
+ return fixnum(0);
+ v = args[0];
+ FOR_ARGS(i, 1, e, args){+ if(bothfixnums(v, e))
+ v = v | e;
+ else
+ v = fl_bitwise_op(v, e, 1);
+ }
+ return v;
}
BUILTIN("logxor", logxor) {- value_t v, e;
- int i;
- if (nargs == 0)
- return fixnum(0);
- v = args[0];
- FOR_ARGS(i,1,e,args) {- if (bothfixnums(v, e))
- v = fixnum(numval(v) ^ numval(e));
- else
- v = fl_bitwise_op(v, e, 2);
- }
- return v;
+ value_t v, e;
+ int i;
+ if(nargs == 0)
+ return fixnum(0);
+ v = args[0];
+ FOR_ARGS(i, 1, e, args){+ if(bothfixnums(v, e))
+ v = fixnum(numval(v) ^ numval(e));
+ else
+ v = fl_bitwise_op(v, e, 2);
+ }
+ return v;
}
BUILTIN("lognot", lognot) {- argcount(nargs, 1);
- value_t a = args[0];
- if (isfixnum(a))
- return fixnum(~numval(a));
- cprim_t *cp;
- int ta;
- void *aptr;
+ argcount(nargs, 1);
+ value_t a = args[0];
+ cprim_t *cp;
+ int ta;
+ void *aptr;
- if (iscprim(a)) {- cp = (cprim_t*)ptr(a);
- ta = cp_numtype(cp);
- aptr = cp_data(cp);
- switch (ta) {- case T_INT8: return fixnum(~*(int8_t *)aptr);
- case T_UINT8: return fixnum(~*(uint8_t *)aptr & 0xff);
- case T_INT16: return fixnum(~*(int16_t *)aptr);
- case T_UINT16: return fixnum(~*(uint16_t*)aptr & 0xffff);
- case T_INT32: return mk_int32(~*(int32_t *)aptr);
- case T_UINT32: return mk_uint32(~*(uint32_t*)aptr);
- case T_INT64: return mk_int64(~*(int64_t *)aptr);
- case T_UINT64: return mk_uint64(~*(uint64_t*)aptr);
- }
- }
- type_error("integer", a);+ if(isfixnum(a))
+ return fixnum(~numval(a));
+ if(iscprim(a)){+ cp = ptr(a);
+ ta = cp_numtype(cp);
+ aptr = cp_data(cp);
+ switch(ta){+ case T_INT8: return fixnum(~*(int8_t *)aptr);
+ case T_UINT8: return fixnum(~*(uint8_t *)aptr & 0xff);
+ case T_INT16: return fixnum(~*(int16_t *)aptr);
+ case T_UINT16: return fixnum(~*(uint16_t*)aptr & 0xffff);
+ case T_INT32: return mk_int32(~*(int32_t *)aptr);
+ case T_UINT32: return mk_uint32(~*(uint32_t*)aptr);
+ case T_INT64: return mk_int64(~*(int64_t *)aptr);
+ case T_UINT64: return mk_uint64(~*(uint64_t*)aptr);
+ }
+ }
+ type_error("integer", a);}
BUILTIN("ash", ash) {- fixnum_t n;
- int64_t accum;
- argcount(nargs, 2);
- value_t a = args[0];
- n = tofixnum(args[1]);
- if (isfixnum(a)) {- if (n <= 0)
- return fixnum(numval(a)>>(-n));
- accum = ((int64_t)numval(a))<<n;
- if (fits_fixnum(accum))
- return fixnum(accum);
- else
- return return_from_int64(accum);
- }
- cprim_t *cp;
- int ta;
- void *aptr;
- if (iscprim(a)) {- if (n == 0) return a;
- cp = (cprim_t*)ptr(a);
- ta = cp_numtype(cp);
- aptr = cp_data(cp);
- if (n < 0) {- n = -n;
- switch (ta) {- case T_INT8: return fixnum((*(int8_t *)aptr) >> n);
- case T_UINT8: return fixnum((*(uint8_t *)aptr) >> n);
- case T_INT16: return fixnum((*(int16_t *)aptr) >> n);
- case T_UINT16: return fixnum((*(uint16_t*)aptr) >> n);
- case T_INT32: return mk_int32((*(int32_t *)aptr) >> n);
- case T_UINT32: return mk_uint32((*(uint32_t*)aptr) >> n);
- case T_INT64: return mk_int64((*(int64_t *)aptr) >> n);
- case T_UINT64: return mk_uint64((*(uint64_t*)aptr) >> n);
- }
- }
- else {- if (ta == T_UINT64)
- return return_from_uint64((*(uint64_t*)aptr)<<n);
- else if (ta < T_FLOAT) {- int64_t i64 = conv_to_int64(aptr, ta);
- return return_from_int64(i64<<n);
- }
- }
- }
- type_error("integer", a);+ fixnum_t n;
+ int64_t accum;
+ cprim_t *cp;
+ int ta;
+ mpint *mp;
+ void *aptr;
+
+ argcount(nargs, 2);
+ value_t a = args[0];
+ n = tofixnum(args[1]);
+ if(isfixnum(a)){+ if(n <= 0)
+ return fixnum(numval(a)>>(-n));
+ accum = ((int64_t)numval(a))<<n;
+ return fits_fixnum(accum) ? fixnum(accum) : return_from_int64(accum);
+ }
+ if(iscprim(a)){+ if(n == 0)
+ return a;
+ cp = ptr(a);
+ ta = cp_numtype(cp);
+ aptr = cp_data(cp);
+ if(n < 0){+ n = -n;
+ switch(ta){+ case T_INT8: return fixnum((*(int8_t *)aptr) >> n);
+ case T_UINT8: return fixnum((*(uint8_t *)aptr) >> n);
+ case T_INT16: return fixnum((*(int16_t *)aptr) >> n);
+ case T_UINT16: return fixnum((*(uint16_t*)aptr) >> n);
+ case T_INT32: return mk_int32((*(int32_t *)aptr) >> n);
+ case T_UINT32: return mk_uint32((*(uint32_t*)aptr) >> n);
+ case T_INT64: return mk_int64((*(int64_t *)aptr) >> n);
+ case T_UINT64: return mk_uint64((*(uint64_t*)aptr) >> n);
+ case T_MPINT:
+ mp = mpnew(0);
+ mpright(*(mpint**)aptr, n, mp);
+ return mk_mpint(mp);
+ }
+ }
+ if(ta == T_MPINT){+ mp = mpnew(0);
+ mpleft(*(mpint**)aptr, n, nil);
+ return mk_mpint(mp);
+ }
+ if(ta == T_UINT64)
+ return return_from_uint64((*(uint64_t*)aptr)<<n);
+ if(ta < T_FLOAT)
+ return return_from_int64(conv_to_int64(aptr, ta)<<n);
+ }
+ type_error("integer", a);}
-static void cvalues_init(void)
+static void
+cvalues_init(void)
{- htable_new(&TypeTable, 256);
- htable_new(&reverse_dlsym_lookup_table, 256);
+ htable_new(&TypeTable, 256);
+ htable_new(&reverse_dlsym_lookup_table, 256);
- builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), nil, nil);
+ builtintype = define_opaque_type(builtinsym, sizeof(builtin_t), nil, nil);
- ctor_cv_intern(int8, T_INT8, int8_t);
- ctor_cv_intern(uint8, T_UINT8, uint8_t);
- ctor_cv_intern(int16, T_INT16, int16_t);
- ctor_cv_intern(uint16, T_UINT16, uint16_t);
- ctor_cv_intern(int32, T_INT32, int32_t);
- ctor_cv_intern(uint32, T_UINT32, uint32_t);
- ctor_cv_intern(int64, T_INT64, int64_t);
- ctor_cv_intern(uint64, T_UINT64, uint64_t);
- ctor_cv_intern(byte, T_UINT8, uint8_t);
- ctor_cv_intern(wchar, T_INT32, int32_t);
+ ctor_cv_intern(int8, T_INT8, int8_t);
+ ctor_cv_intern(uint8, T_UINT8, uint8_t);
+ ctor_cv_intern(int16, T_INT16, int16_t);
+ ctor_cv_intern(uint16, T_UINT16, uint16_t);
+ ctor_cv_intern(int32, T_INT32, int32_t);
+ ctor_cv_intern(uint32, T_UINT32, uint32_t);
+ ctor_cv_intern(int64, T_INT64, int64_t);
+ ctor_cv_intern(uint64, T_UINT64, uint64_t);
+ ctor_cv_intern(byte, T_UINT8, uint8_t);
+ ctor_cv_intern(wchar, T_INT32, int32_t);
#if defined(ULONG64)
- ctor_cv_intern(long, T_INT64, int64_t);
- ctor_cv_intern(ulong, T_UINT64, uint64_t);
+ ctor_cv_intern(long, T_INT64, int64_t);
+ ctor_cv_intern(ulong, T_UINT64, uint64_t);
#else
- ctor_cv_intern(long, T_INT32, int32_t);
- ctor_cv_intern(ulong, T_UINT32, uint32_t);
+ ctor_cv_intern(long, T_INT32, int32_t);
+ ctor_cv_intern(ulong, T_UINT32, uint32_t);
#endif
- ctor_cv_intern(float, T_FLOAT, float);
- ctor_cv_intern(double, T_DOUBLE, double);
+ ctor_cv_intern(float, T_FLOAT, float);
+ ctor_cv_intern(double, T_DOUBLE, double);
- ctor_cv_intern(array, NONNUMERIC, int);
- ctor_cv_intern(enum, NONNUMERIC, int);
- cv_intern(pointer);
- cv_intern(struct);
- cv_intern(union);
- cv_intern(void);
- cfunctionsym = symbol("c-function");+ ctor_cv_intern(array, NONNUMERIC, int);
+ ctor_cv_intern(enum, NONNUMERIC, int);
+ cv_intern(pointer);
+ cv_intern(struct);
+ cv_intern(union);
+ cv_intern(void);
+ cfunctionsym = symbol("c-function");- stringtypesym = symbol("*string-type*");- setc(stringtypesym, fl_list2(arraysym, bytesym));
+ stringtypesym = symbol("*string-type*");+ setc(stringtypesym, fl_list2(arraysym, bytesym));
- wcstringtypesym = symbol("*wcstring-type*");- setc(wcstringtypesym, fl_list2(arraysym, wcharsym));
+ wcstringtypesym = symbol("*wcstring-type*");+ setc(wcstringtypesym, fl_list2(arraysym, wcharsym));
- mk_primtype(int8, int8_t);
- mk_primtype(uint8, uint8_t);
- mk_primtype(int16, int16_t);
- mk_primtype(uint16, uint16_t);
- mk_primtype(int32, int32_t);
- mk_primtype(uint32, uint32_t);
- mk_primtype(int64, int64_t);
- mk_primtype(uint64, uint64_t);
+ mk_primtype(int8, int8_t);
+ mk_primtype(uint8, uint8_t);
+ mk_primtype(int16, int16_t);
+ mk_primtype(uint16, uint16_t);
+ mk_primtype(int32, int32_t);
+ mk_primtype(uint32, uint32_t);
+ mk_primtype(int64, int64_t);
+ mk_primtype(uint64, uint64_t);
#if defined(ULONG64)
- mk_primtype(long, int64_t);
- mk_primtype(ulong, uint64_t);
+ mk_primtype(long, int64_t);
+ mk_primtype(ulong, uint64_t);
#else
- mk_primtype(long, int32_t);
- mk_primtype(ulong, uint32_t);
+ mk_primtype(long, int32_t);
+ mk_primtype(ulong, uint32_t);
#endif
- mk_primtype(byte, uint8_t);
- mk_primtype(wchar, int32_t);
- mk_primtype(float, float);
- mk_primtype(double, double);
+ mk_primtype(byte, uint8_t);
+ mk_primtype(wchar, int32_t);
+ mk_primtype(float, float);
+ mk_primtype(double, double);
- ctor_cv_intern(mpint, T_MPINT, mpint*);
- mpinttype = get_type(mpintsym);
- mpinttype->init = cvalue_mpint_init;
- mpinttype->vtable = &mpint_vtable;
+ ctor_cv_intern(mpint, T_MPINT, mpint*);
+ mpinttype = get_type(mpintsym);
+ mpinttype->init = cvalue_mpint_init;
+ mpinttype->vtable = &mpint_vtable;
- stringtype = get_type(symbol_value(stringtypesym));
- wcstringtype = get_type(symbol_value(wcstringtypesym));
+ stringtype = get_type(symbol_value(stringtypesym));
+ wcstringtype = get_type(symbol_value(wcstringtypesym));
- emptystringsym = symbol("*empty-string*");- setc(emptystringsym, cvalue_static_cstring(""));+ emptystringsym = symbol("*empty-string*");+ setc(emptystringsym, cvalue_static_cstring(""));}
--- a/equal.c
+++ b/equal.c
@@ -1,5 +1,5 @@
#define BOUNDED_COMPARE_BOUND 128
-#define BOUNDED_HASH_BOUND 16384
+#define BOUNDED_HASH_BOUND 16384
#ifdef BITS64
#define inthash int64hash
@@ -10,287 +10,313 @@
// comparable tag
#define cmptag(v) (isfixnum(v) ? TAG_NUM : tag(v))
-static value_t eq_class(htable_t *table, value_t key)
+static value_t
+eq_class(htable_t *table, value_t key)
{- value_t c = (value_t)ptrhash_get(table, (void*)key);
- if (c == (value_t)HT_NOTFOUND)
- return NIL;
- if (c == key)
- return c;
- return eq_class(table, c);
+ value_t c = (value_t)ptrhash_get(table, (void*)key);
+ if(c == (value_t)HT_NOTFOUND)
+ return NIL;
+ if(c == key)
+ return c;
+ return eq_class(table, c);
}
-static void eq_union(htable_t *table, value_t a, value_t b,
- value_t c, value_t cb)
+static void
+eq_union(htable_t *table, value_t a, value_t b, value_t c, value_t cb)
{- value_t ca = (c==NIL ? a : c);
- if (cb != NIL)
- ptrhash_put(table, (void*)cb, (void*)ca);
- ptrhash_put(table, (void*)a, (void*)ca);
- ptrhash_put(table, (void*)b, (void*)ca);
+ value_t ca = c == NIL ? a : c;
+ if(cb != NIL)
+ ptrhash_put(table, (void*)cb, (void*)ca);
+ ptrhash_put(table, (void*)a, (void*)ca);
+ ptrhash_put(table, (void*)b, (void*)ca);
}
static value_t bounded_compare(value_t a, value_t b, int bound, int eq);
static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq);
-static value_t bounded_vector_compare(value_t a, value_t b, int bound, int eq)
+static value_t
+bounded_vector_compare(value_t a, value_t b, int bound, int eq)
{- size_t la = vector_size(a);
- size_t lb = vector_size(b);
- size_t m, i;
- if (eq && (la!=lb)) return fixnum(1);
- m = la < lb ? la : lb;
- for (i = 0; i < m; i++) {- value_t d = bounded_compare(vector_elt(a,i), vector_elt(b,i),
- bound-1, eq);
- if (d==NIL || numval(d)!=0) return d;
- }
- if (la < lb) return fixnum(-1);
- if (la > lb) return fixnum(1);
- return fixnum(0);
+ size_t la = vector_size(a);
+ size_t lb = vector_size(b);
+ size_t m, i;
+ if(eq && la != lb)
+ return fixnum(1);
+ m = la < lb ? la : lb;
+ for(i = 0; i < m; i++){+ value_t d = bounded_compare(vector_elt(a, i), vector_elt(b, i), bound-1, eq);
+ if(d == NIL || numval(d) != 0)
+ return d;
+ }
+ if(la < lb)
+ return fixnum(-1);
+ if(la > lb)
+ return fixnum(1);
+ return fixnum(0);
}
// strange comparisons are resolved arbitrarily but consistently.
// ordering: number < cprim < function < vector < cvalue < symbol < cons
-static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
+static value_t
+bounded_compare(value_t a, value_t b, int bound, int eq)
{- value_t d;
- cvalue_t *cv;
+ value_t d;
+ cvalue_t *cv;
- compare_top:
- if (a == b) return fixnum(0);
- if (bound <= 0)
- return NIL;
- int taga = tag(a);
- int tagb = cmptag(b);
- int c;
- switch (taga) {- case TAG_NUM :
- case TAG_NUM1:
- if (isfixnum(b)) {- return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
- }
- if (iscprim(b)) {- if (cp_class((cprim_t*)ptr(b)) == wchartype)
- return fixnum(1);
- return fixnum(numeric_compare(a, b, eq, 1, 0));
- }
- if (iscvalue(b)) {- cv = ptr(b);
- if (valid_numtype(cv_class(cv)->numtype))
- return fixnum(numeric_compare(a, b, eq, 1, 0));
- }
- return fixnum(-1);
- case TAG_SYM:
- if (eq) return fixnum(1);
- if (tagb < TAG_SYM) return fixnum(1);
- if (tagb > TAG_SYM) return fixnum(-1);
- return fixnum(strcmp(symbol_name(a), symbol_name(b)));
- case TAG_VECTOR:
- if (isvector(b))
- return bounded_vector_compare(a, b, bound, eq);
- break;
- case TAG_CPRIM:
- if (cp_class((cprim_t*)ptr(a)) == wchartype) {- if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype)
- return fixnum(-1);
- }
- else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) {- return fixnum(1);
- }
- c = numeric_compare(a, b, eq, 1, 0);
- if (c != 2)
- return fixnum(c);
- break;
- case TAG_CVALUE:
- cv = ptr(a);
- if (valid_numtype(cv_class(cv)->numtype)) {- if((c = numeric_compare(a, b, eq, 1, 0)) != 2)
- return fixnum(c);
- }
- if (iscvalue(b)) {- if (cv_isPOD((cvalue_t*)ptr(a)) && cv_isPOD((cvalue_t*)ptr(b)))
- return cvalue_compare(a, b);
- return fixnum(1);
- }
- break;
- case TAG_FUNCTION:
- if (tagb == TAG_FUNCTION) {- if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) {- function_t *fa = (function_t*)ptr(a);
- function_t *fb = (function_t*)ptr(b);
- d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);
- if (d==NIL || numval(d) != 0) return d;
- d = bounded_compare(fa->vals, fb->vals, bound-1, eq);
- if (d==NIL || numval(d) != 0) return d;
- d = bounded_compare(fa->env, fb->env, bound-1, eq);
- if (d==NIL || numval(d) != 0) return d;
- return fixnum(0);
- }
- return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1);
- }
- break;
- case TAG_CONS:
- if (tagb < TAG_CONS) return fixnum(1);
- d = bounded_compare(car_(a), car_(b), bound-1, eq);
- if (d==NIL || numval(d) != 0) return d;
- a = cdr_(a); b = cdr_(b);
- bound--;
- goto compare_top;
- }
- return (taga < tagb) ? fixnum(-1) : fixnum(1);
+compare_top:
+ if(a == b)
+ return fixnum(0);
+ if(bound <= 0)
+ return NIL;
+ int taga = tag(a);
+ int tagb = cmptag(b);
+ int c;
+ switch (taga){+ case TAG_NUM :
+ case TAG_NUM1:
+ if(isfixnum(b))
+ return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
+ if(iscprim(b)){+ if(cp_class((cprim_t*)ptr(b)) == wchartype)
+ return fixnum(1);
+ return fixnum(numeric_compare(a, b, eq, 1, 0));
+ }
+ if(iscvalue(b)){+ cv = ptr(b);
+ if(valid_numtype(cv_class(cv)->numtype))
+ return fixnum(numeric_compare(a, b, eq, 1, 0));
+ }
+ return fixnum(-1);
+ case TAG_SYM:
+ if(eq || tagb < TAG_SYM)
+ return fixnum(1);
+ if(tagb > TAG_SYM)
+ return fixnum(-1);
+ return fixnum(strcmp(symbol_name(a), symbol_name(b)));
+ case TAG_VECTOR:
+ if(isvector(b))
+ return bounded_vector_compare(a, b, bound, eq);
+ break;
+ case TAG_CPRIM:
+ if(cp_class((cprim_t*)ptr(a)) == wchartype){+ if(!iscprim(b) || cp_class(ptr(b)) != wchartype)
+ return fixnum(-1);
+ }else if(iscprim(b) && cp_class(ptr(b)) == wchartype)
+ return fixnum(1);
+ c = numeric_compare(a, b, eq, 1, 0);
+ if(c != 2)
+ return fixnum(c);
+ break;
+ case TAG_CVALUE:
+ cv = ptr(a);
+ if(valid_numtype(cv_class(cv)->numtype)){+ if((c = numeric_compare(a, b, eq, 1, 0)) != 2)
+ return fixnum(c);
+ }
+ if(iscvalue(b)){+ if(cv_isPOD(ptr(a)) && cv_isPOD(ptr(b)))
+ return cvalue_compare(a, b);
+ return fixnum(1);
+ }
+ break;
+ case TAG_FUNCTION:
+ if(tagb == TAG_FUNCTION){+ if(uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS){+ function_t *fa = ptr(a);
+ function_t *fb = ptr(b);
+ d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);
+ if(d == NIL || numval(d) != 0)
+ return d;
+ d = bounded_compare(fa->vals, fb->vals, bound-1, eq);
+ if(d == NIL || numval(d) != 0)
+ return d;
+ d = bounded_compare(fa->env, fb->env, bound-1, eq);
+ if(d == NIL || numval(d) != 0)
+ return d;
+ return fixnum(0);
+ }
+ return uintval(a) < uintval(b) ? fixnum(-1) : fixnum(1);
+ }
+ break;
+ case TAG_CONS:
+ if(tagb < TAG_CONS)
+ return fixnum(1);
+ d = bounded_compare(car_(a), car_(b), bound-1, eq);
+ if(d == NIL || numval(d) != 0)
+ return d;
+ a = cdr_(a); b = cdr_(b);
+ bound--;
+ goto compare_top;
+ }
+ return taga < tagb ? fixnum(-1) : fixnum(1);
}
-static value_t cyc_vector_compare(value_t a, value_t b, htable_t *table,
- int eq)
+static value_t
+cyc_vector_compare(value_t a, value_t b, htable_t *table, int eq)
{- size_t la = vector_size(a);
- size_t lb = vector_size(b);
- size_t m, i;
- value_t d, xa, xb, ca, cb;
+ size_t la = vector_size(a);
+ size_t lb = vector_size(b);
+ size_t m, i;
+ value_t d, xa, xb, ca, cb;
- // first try to prove them different with no recursion
- if (eq && (la!=lb)) return fixnum(1);
- m = la < lb ? la : lb;
- for (i = 0; i < m; i++) {- xa = vector_elt(a,i);
- xb = vector_elt(b,i);
- if (leafp(xa) || leafp(xb)) {- d = bounded_compare(xa, xb, 1, eq);
- if (d!=NIL && numval(d)!=0) return d;
- }
- else if (tag(xa) < tag(xb)) {- return fixnum(-1);
- }
- else if (tag(xa) > tag(xb)) {- return fixnum(1);
- }
- }
+ // first try to prove them different with no recursion
+ if(eq && la != lb)
+ return fixnum(1);
+ m = la < lb ? la : lb;
+ for(i = 0; i < m; i++){+ xa = vector_elt(a,i);
+ xb = vector_elt(b,i);
+ if(leafp(xa) || leafp(xb)){+ d = bounded_compare(xa, xb, 1, eq);
+ if(d != NIL && numval(d) != 0)
+ return d;
+ }else{+ if(tag(xa) < tag(xb))
+ return fixnum(-1);
+ else if(tag(xa) > tag(xb))
+ return fixnum(1);
+ }
+ }
- ca = eq_class(table, a);
- cb = eq_class(table, b);
- if (ca!=NIL && ca==cb)
- return fixnum(0);
+ ca = eq_class(table, a);
+ cb = eq_class(table, b);
+ if(ca != NIL && ca == cb)
+ return fixnum(0);
- eq_union(table, a, b, ca, cb);
+ eq_union(table, a, b, ca, cb);
- for (i = 0; i < m; i++) {- xa = vector_elt(a,i);
- xb = vector_elt(b,i);
- if (!leafp(xa) || tag(xa)==TAG_FUNCTION) {- d = cyc_compare(xa, xb, table, eq);
- if (numval(d)!=0)
- return d;
- }
- }
+ for(i = 0; i < m; i++){+ xa = vector_elt(a,i);
+ xb = vector_elt(b,i);
+ if(!leafp(xa) || tag(xa) == TAG_FUNCTION){+ d = cyc_compare(xa, xb, table, eq);
+ if(numval(d) != 0)
+ return d;
+ }
+ }
- if (la < lb) return fixnum(-1);
- if (la > lb) return fixnum(1);
- return fixnum(0);
+ if(la < lb)
+ return fixnum(-1);
+ if(la > lb)
+ return fixnum(1);
+ return fixnum(0);
}
-static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq)
+static value_t
+cyc_compare(value_t a, value_t b, htable_t *table, int eq)
{- value_t d, ca, cb;
- cyc_compare_top:
- if (a==b)
- return fixnum(0);
- if (iscons(a)) {- if (iscons(b)) {- value_t aa = car_(a); value_t da = cdr_(a);
- value_t ab = car_(b); value_t db = cdr_(b);
- int tagaa = tag(aa); int tagda = tag(da);
- int tagab = tag(ab); int tagdb = tag(db);
- if (leafp(aa) || leafp(ab)) {- d = bounded_compare(aa, ab, 1, eq);
- if (d!=NIL && numval(d)!=0) return d;
- }
- else if (tagaa < tagab)
- return fixnum(-1);
- else if (tagaa > tagab)
- return fixnum(1);
- if (leafp(da) || leafp(db)) {- d = bounded_compare(da, db, 1, eq);
- if (d!=NIL && numval(d)!=0) return d;
- }
- else if (tagda < tagdb)
- return fixnum(-1);
- else if (tagda > tagdb)
- return fixnum(1);
+ value_t d, ca, cb;
+cyc_compare_top:
+ if(a == b)
+ return fixnum(0);
+ if(iscons(a)){+ if(iscons(b)){+ value_t aa = car_(a);
+ value_t da = cdr_(a);
+ value_t ab = car_(b);
+ value_t db = cdr_(b);
+ int tagaa = tag(aa);
+ int tagda = tag(da);
+ int tagab = tag(ab);
+ int tagdb = tag(db);
+ if(leafp(aa) || leafp(ab)){+ d = bounded_compare(aa, ab, 1, eq);
+ if(d != NIL && numval(d) != 0)
+ return d;
+ }
+ if(tagaa < tagab)
+ return fixnum(-1);
+ if(tagaa > tagab)
+ return fixnum(1);
+ if(leafp(da) || leafp(db)){+ d = bounded_compare(da, db, 1, eq);
+ if(d != NIL && numval(d) != 0)
+ return d;
+ }
+ if(tagda < tagdb)
+ return fixnum(-1);
+ if(tagda > tagdb)
+ return fixnum(1);
- ca = eq_class(table, a);
- cb = eq_class(table, b);
- if (ca!=NIL && ca==cb)
- return fixnum(0);
+ ca = eq_class(table, a);
+ cb = eq_class(table, b);
+ if(ca != NIL && ca == cb)
+ return fixnum(0);
- eq_union(table, a, b, ca, cb);
- d = cyc_compare(aa, ab, table, eq);
- if (numval(d)!=0) return d;
- a = da;
- b = db;
- goto cyc_compare_top;
- }
- else {- return fixnum(1);
- }
- }
- else if (isvector(a) && isvector(b)) {- return cyc_vector_compare(a, b, table, eq);
- }
- else if (isclosure(a) && isclosure(b)) {- function_t *fa = (function_t*)ptr(a);
- function_t *fb = (function_t*)ptr(b);
- d = bounded_compare(fa->bcode, fb->bcode, 1, eq);
- if (numval(d) != 0) return d;
-
- ca = eq_class(table, a);
- cb = eq_class(table, b);
- if (ca!=NIL && ca==cb)
- return fixnum(0);
-
- eq_union(table, a, b, ca, cb);
- d = cyc_compare(fa->vals, fb->vals, table, eq);
- if (numval(d) != 0) return d;
- a = fa->env;
- b = fb->env;
- goto cyc_compare_top;
- }
- return bounded_compare(a, b, 1, eq);
+ eq_union(table, a, b, ca, cb);
+ d = cyc_compare(aa, ab, table, eq);
+ if(numval(d) != 0)
+ return d;
+ a = da;
+ b = db;
+ goto cyc_compare_top;
+ }else{+ return fixnum(1);
+ }
+ }
+ if(isvector(a) && isvector(b))
+ return cyc_vector_compare(a, b, table, eq);
+ if(isclosure(a) && isclosure(b)){+ function_t *fa = (function_t*)ptr(a);
+ function_t *fb = (function_t*)ptr(b);
+ d = bounded_compare(fa->bcode, fb->bcode, 1, eq);
+ if(numval(d) != 0)
+ return d;
+
+ ca = eq_class(table, a);
+ cb = eq_class(table, b);
+ if(ca != NIL && ca == cb)
+ return fixnum(0);
+
+ eq_union(table, a, b, ca, cb);
+ d = cyc_compare(fa->vals, fb->vals, table, eq);
+ if(numval(d) != 0)
+ return d;
+ a = fa->env;
+ b = fb->env;
+ goto cyc_compare_top;
+ }
+ return bounded_compare(a, b, 1, eq);
}
static htable_t equal_eq_hashtable;
-void comparehash_init(void)
+
+void
+comparehash_init(void)
{- htable_new(&equal_eq_hashtable, 512);
+ htable_new(&equal_eq_hashtable, 512);
}
// 'eq' means unordered comparison is sufficient
-static value_t compare_(value_t a, value_t b, int eq)
+static value_t
+compare_(value_t a, value_t b, int eq)
{- value_t guess = bounded_compare(a, b, BOUNDED_COMPARE_BOUND, eq);
- if (guess == NIL) {- guess = cyc_compare(a, b, &equal_eq_hashtable, eq);
- htable_reset(&equal_eq_hashtable, 512);
- }
- return guess;
+ value_t guess = bounded_compare(a, b, BOUNDED_COMPARE_BOUND, eq);
+ if(guess == NIL){+ guess = cyc_compare(a, b, &equal_eq_hashtable, eq);
+ htable_reset(&equal_eq_hashtable, 512);
+ }
+ return guess;
}
-value_t fl_compare(value_t a, value_t b)
+value_t
+fl_compare(value_t a, value_t b)
{- return compare_(a, b, 0);
+ return compare_(a, b, 0);
}
-value_t fl_equal(value_t a, value_t b)
+value_t
+fl_equal(value_t a, value_t b)
{- if (eq_comparable(a, b))
- return (a == b) ? FL_T : FL_F;
- return (numval(compare_(a,b,1))==0 ? FL_T : FL_F);
+ if(eq_comparable(a, b))
+ return a == b ? FL_T : FL_F;
+ return numval(compare_(a,b,1)) == 0 ? FL_T : FL_F;
}
/*
optimizations:
- use hash updates instead of calling lookup then insert. i.e. get the
- bp once and use it twice.
+ bp once and use it twice.
* preallocate hash table and call reset() instead of new/free
* less redundant tag checking, 3-bit tags
*/
@@ -304,106 +330,109 @@
#endif
// *oob: output argument, means we hit the limit specified by 'bound'
-static uintptr_t bounded_hash(value_t a, int bound, int *oob)
+static uintptr_t
+bounded_hash(value_t a, int bound, int *oob)
{- *oob = 0;
- union {- double d;
- int64_t i64;
- } u;
- numerictype_t nt;
- size_t i, len;
- cvalue_t *cv;
- cprim_t *cp;
- void *data;
- uintptr_t h = 0;
- int oob2, tg = tag(a);
- switch(tg) {- case TAG_NUM :
- case TAG_NUM1:
- u.d = (double)numval(a);
- return doublehash(u.i64);
- case TAG_FUNCTION:
- if (uintval(a) > N_BUILTINS)
- return bounded_hash(((function_t*)ptr(a))->bcode, bound, oob);
- return inthash(a);
- case TAG_SYM:
- return ((symbol_t*)ptr(a))->hash;
- case TAG_CPRIM:
- cp = (cprim_t*)ptr(a);
- data = cp_data(cp);
- if (cp_class(cp) == wchartype)
- return inthash(*(int32_t*)data);
- nt = cp_numtype(cp);
- u.d = conv_to_double(data, nt);
- return doublehash(u.i64);
- case TAG_CVALUE:
- cv = (cvalue_t*)ptr(a);
- data = cv_data(cv);
- if (cv->type == mpinttype) {- len = mptobe(*(mpint**)data, nil, 0, (uint8_t**)&data);
- h = memhash(data, len);
- free(data);
- } else {- h = memhash(data, cv_len(cv));
- }
- return h;
+ *oob = 0;
+ union {+ double d;
+ int64_t i64;
+ }u;
+ numerictype_t nt;
+ size_t i, len;
+ cvalue_t *cv;
+ cprim_t *cp;
+ void *data;
+ uintptr_t h = 0;
+ int oob2, tg = tag(a);
- case TAG_VECTOR:
- if (bound <= 0) {- *oob = 1;
- return 1;
- }
- len = vector_size(a);
- for(i=0; i < len; i++) {- h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1);
- if (oob2)
- bound/=2;
- *oob = *oob || oob2;
- }
- return h;
+ switch(tg){+ case TAG_NUM :
+ case TAG_NUM1:
+ u.d = (double)numval(a);
+ return doublehash(u.i64);
+ case TAG_FUNCTION:
+ if(uintval(a) > N_BUILTINS)
+ return bounded_hash(((function_t*)ptr(a))->bcode, bound, oob);
+ return inthash(a);
+ case TAG_SYM:
+ return ((symbol_t*)ptr(a))->hash;
+ case TAG_CPRIM:
+ cp = ptr(a);
+ data = cp_data(cp);
+ if(cp_class(cp) == wchartype)
+ return inthash(*(int32_t*)data);
+ nt = cp_numtype(cp);
+ u.d = conv_to_double(data, nt);
+ return doublehash(u.i64);
+ case TAG_CVALUE:
+ cv = (cvalue_t*)ptr(a);
+ data = cv_data(cv);
+ if(cv->type == mpinttype){+ len = mptobe(*(mpint**)data, nil, 0, (uint8_t**)&data);
+ h = memhash(data, len);
+ free(data);
+ }else{+ h = memhash(data, cv_len(cv));
+ }
+ return h;
- case TAG_CONS:
- do {- if (bound <= 0) {- *oob = 1;
- return h;
- }
- h = MIX(h, bounded_hash(car_(a), bound/2, &oob2));
- // bounds balancing: try to share the bounds efficiently
- // so we can hash better when a list is cdr-deep (a common case)
- if (oob2)
- bound/=2;
- else
- bound--;
- // recursive OOB propagation. otherwise this case is slow:
- // (hash '#2=((#0=(#1=(#1#) . #0#)) . #2#))
- *oob = *oob || oob2;
- a = cdr_(a);
- } while (iscons(a));
- h = MIX(h, bounded_hash(a, bound-1, &oob2)^2);
- *oob = *oob || oob2;
- return h;
- }
- return 0;
+ case TAG_VECTOR:
+ if(bound <= 0){+ *oob = 1;
+ return 1;
+ }
+ len = vector_size(a);
+ for(i = 0; i < len; i++){+ h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1);
+ if(oob2)
+ bound /= 2;
+ *oob = *oob || oob2;
+ }
+ return h;
+
+ case TAG_CONS:
+ do{+ if(bound <= 0){+ *oob = 1;
+ return h;
+ }
+ h = MIX(h, bounded_hash(car_(a), bound/2, &oob2));
+ // bounds balancing: try to share the bounds efficiently
+ // so we can hash better when a list is cdr-deep (a common case)
+ if(oob2)
+ bound /= 2;
+ else
+ bound--;
+ // recursive OOB propagation. otherwise this case is slow:
+ // (hash '#2=((#0=(#1=(#1#) . #0#)) . #2#))
+ *oob = *oob || oob2;
+ a = cdr_(a);
+ }while(iscons(a));
+ h = MIX(h, bounded_hash(a, bound-1, &oob2)^2);
+ *oob = *oob || oob2;
+ return h;
+ }
+ return 0;
}
-int equal_lispvalue(value_t a, value_t b)
+int
+equal_lispvalue(value_t a, value_t b)
{- if (eq_comparable(a, b))
- return (a==b);
- return (numval(compare_(a,b,1))==0);
+ if(eq_comparable(a, b))
+ return a == b;
+ return numval(compare_(a, b, 1)) == 0;
}
-uintptr_t hash_lispvalue(value_t a)
+uintptr_t
+hash_lispvalue(value_t a)
{- int oob=0;
- uintptr_t n = bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
- return n;
+ int oob = 0;
+ return bounded_hash(a, BOUNDED_HASH_BOUND, &oob);
}
BUILTIN("hash", hash) {- argcount(nargs, 1);
- return fixnum(hash_lispvalue(args[0]));
+ argcount(nargs, 1);
+ return fixnum(hash_lispvalue(args[0]));
}
--- a/flisp.c
+++ b/flisp.c
@@ -11,8 +11,8 @@
typedef struct Builtin Builtin;
struct Builtin {- char *name;
- int nargs;
+ char *name;
+ int nargs;
};
#define ANYARGS -10000
@@ -19,10 +19,11 @@
#include "opcodes.h"
-int isbuiltin(value_t x)
+int
+isbuiltin(value_t x)
{- int i = uintval(x);
- return tag(x) == TAG_FUNCTION && i < nelem(builtins) && builtins[i].name != nil;
+ int i = uintval(x);
+ return tag(x) == TAG_FUNCTION && i < nelem(builtins) && builtins[i].name != nil;
}
static uint32_t N_STACK;
@@ -30,9 +31,15 @@
static uint32_t SP = 0;
static uint32_t curr_frame = 0;
static char *curr_fname = nil;
-#define PUSH(v) (Stack[SP++] = (v))
+#define PUSH(v) \
+ do{ \+ Stack[SP++] = (v); \
+ }while(0)
#define POP() (Stack[--SP])
-#define POPN(n) (SP-=(n))
+#define POPN(n) \
+ do{ \+ SP -= (n); \
+ }while(0)
#define N_GC_HANDLES 1024
static value_t *GCHandleStack[N_GC_HANDLES];
@@ -56,15 +63,16 @@
static value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
static value_t apply_cl(uint32_t nargs);
-static value_t *alloc_words(int n);
+static void *alloc_words(int n);
static value_t relocate(value_t v);
static fl_readstate_t *readstate = nil;
-static void free_readstate(fl_readstate_t *rs)
+static void
+free_readstate(fl_readstate_t *rs)
{- htable_free(&rs->backrefs);
- htable_free(&rs->gensyms);
+ htable_free(&rs->backrefs);
+ htable_free(&rs->gensyms);
}
static uint8_t *fromspace;
@@ -78,119 +86,127 @@
// saved execution state for an unwind target
fl_exception_context_t *fl_ctx = nil;
-uint32_t fl_throwing_frame=0; // active frame when exception was thrown
+uint32_t fl_throwing_frame = 0; // active frame when exception was thrown
value_t fl_lasterror;
#define FL_TRY \
- fl_exception_context_t _ctx; int l__tr, l__ca; \
- _ctx.sp=SP; _ctx.frame=curr_frame; _ctx.rdst=readstate; _ctx.prev=fl_ctx; \
- _ctx.ngchnd = N_GCHND; fl_ctx = &_ctx; \
- if (!setjmp(_ctx.buf)) \
- for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx=fl_ctx->prev))
+ fl_exception_context_t _ctx; int l__tr, l__ca; \
+ _ctx.sp = SP; _ctx.frame = curr_frame; _ctx.rdst = readstate; _ctx.prev = fl_ctx; \
+ _ctx.ngchnd = N_GCHND; fl_ctx = &_ctx; \
+ if(!setjmp(_ctx.buf)) \
+ for(l__tr = 1; l__tr; l__tr = 0, (void)(fl_ctx = fl_ctx->prev))
#define FL_CATCH_INC \
- l__ca=0,fl_lasterror=FL_NIL,fl_throwing_frame=0,SP=_ctx.sp,curr_frame=_ctx.frame
+ l__ca = 0, fl_lasterror = FL_NIL, fl_throwing_frame = 0, SP = _ctx.sp, curr_frame = _ctx.frame
#define FL_CATCH \
- else \
- for(l__ca=1; l__ca;FL_CATCH_INC)
+ else \
+ for(l__ca = 1; l__ca; FL_CATCH_INC)
#define FL_CATCH_NO_INC \
- else \
- for(l__ca=1; l__ca;)
+ else \
+ for(l__ca = 1; l__ca;)
-void fl_savestate(fl_exception_context_t *_ctx)
+void
+fl_savestate(fl_exception_context_t *_ctx)
{- _ctx->sp = SP;
- _ctx->frame = curr_frame;
- _ctx->rdst = readstate;
- _ctx->prev = fl_ctx;
- _ctx->ngchnd = N_GCHND;
+ _ctx->sp = SP;
+ _ctx->frame = curr_frame;
+ _ctx->rdst = readstate;
+ _ctx->prev = fl_ctx;
+ _ctx->ngchnd = N_GCHND;
}
-void fl_restorestate(fl_exception_context_t *_ctx)
+void
+fl_restorestate(fl_exception_context_t *_ctx)
{- fl_lasterror = FL_NIL;
- fl_throwing_frame = 0;
- SP = _ctx->sp;
- curr_frame = _ctx->frame;
+ fl_lasterror = FL_NIL;
+ fl_throwing_frame = 0;
+ SP = _ctx->sp;
+ curr_frame = _ctx->frame;
}
-_Noreturn void fl_raise(value_t e)
+_Noreturn void
+fl_raise(value_t e)
{- fl_lasterror = e;
- // unwind read state
- while (readstate != fl_ctx->rdst) {- free_readstate(readstate);
- readstate = readstate->prev;
- }
- if (fl_throwing_frame == 0)
- fl_throwing_frame = curr_frame;
- N_GCHND = fl_ctx->ngchnd;
- fl_exception_context_t *thisctx = fl_ctx;
- if (fl_ctx->prev) // don't throw past toplevel
- fl_ctx = fl_ctx->prev;
- longjmp(thisctx->buf, 1);
+ fl_lasterror = e;
+ // unwind read state
+ while(readstate != fl_ctx->rdst){+ free_readstate(readstate);
+ readstate = readstate->prev;
+ }
+ if(fl_throwing_frame == 0)
+ fl_throwing_frame = curr_frame;
+ N_GCHND = fl_ctx->ngchnd;
+ fl_exception_context_t *thisctx = fl_ctx;
+ if(fl_ctx->prev) // don't throw past toplevel
+ fl_ctx = fl_ctx->prev;
+ longjmp(thisctx->buf, 1);
}
-static value_t make_error_msg(char *format, va_list args)
+static value_t
+make_error_msg(char *format, va_list args)
{- char msgbuf[512], *s;
- int n;
- if (curr_fname != nil) {- n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", curr_fname);
- curr_fname = nil;
- } else {- n = 0;
- }
- s = msgbuf + n;
- n = sizeof(msgbuf) - n;
- vsnprintf(s, n, format, args);
- return string_from_cstr(msgbuf);
+ char msgbuf[512], *s;
+ int n;
+ if(curr_fname != nil){+ n = snprintf(msgbuf, sizeof(msgbuf), "%s: ", curr_fname);
+ curr_fname = nil;
+ }else{+ n = 0;
+ }
+ s = msgbuf + n;
+ n = sizeof(msgbuf) - n;
+ vsnprintf(s, n, format, args);
+ return string_from_cstr(msgbuf);
}
-_Noreturn void lerrorf(value_t e, char *format, ...)
+_Noreturn void
+lerrorf(value_t e, char *format, ...)
{- va_list args;
- PUSH(e);
- va_start(args, format);
- value_t msg = make_error_msg(format, args);
- va_end(args);
+ va_list args;
+ PUSH(e);
+ va_start(args, format);
+ value_t msg = make_error_msg(format, args);
+ va_end(args);
- e = POP();
- fl_raise(fl_list2(e, msg));
+ e = POP();
+ fl_raise(fl_list2(e, msg));
}
-_Noreturn void type_error(char *expected, value_t got)
+_Noreturn void
+type_error(char *expected, value_t got)
{- fl_raise(fl_listn(4, TypeError, symbol(curr_fname), symbol(expected), got));
+ fl_raise(fl_listn(4, TypeError, symbol(curr_fname), symbol(expected), got));
}
-_Noreturn void bounds_error(value_t arr, value_t ind)
+_Noreturn void
+bounds_error(value_t arr, value_t ind)
{- fl_raise(fl_listn(4, BoundsError, symbol(curr_fname), arr, ind));
+ fl_raise(fl_listn(4, BoundsError, symbol(curr_fname), arr, ind));
}
-_Noreturn void unbound_error(value_t sym)
+_Noreturn void
+unbound_error(value_t sym)
{- fl_raise(fl_listn(3, UnboundError, symbol(curr_fname), sym));
+ fl_raise(fl_listn(3, UnboundError, symbol(curr_fname), sym));
}
// safe cast operators --------------------------------------------------------
#define isstring fl_isstring
-#define SAFECAST_OP(type,ctype,cnvt) \
-ctype to##type(value_t v) \
-{ \- if (is##type(v)) \
- return (ctype)cnvt(v); \
- type_error(#type, v); \
-}
+#define SAFECAST_OP(type,ctype,cnvt) \
+ ctype to##type(value_t v) \
+ { \+ if(is##type(v)) \
+ return (ctype)cnvt(v); \
+ type_error(#type, v); \
+ }
SAFECAST_OP(cons, cons_t*, ptr)
SAFECAST_OP(symbol,symbol_t*,ptr)
SAFECAST_OP(fixnum,fixnum_t, numval)
SAFECAST_OP(cvalue,cvalue_t*,ptr)
-SAFECAST_OP(string,char*, cvalue_data)
+SAFECAST_OP(string,char*, cvalue_data)
#undef isstring
// symbol table ---------------------------------------------------------------
@@ -197,96 +213,93 @@
symbol_t *symtab = nil;
-int fl_is_keyword_name(char *str, size_t len)
+int
+fl_is_keyword_name(char *str, size_t len)
{- return ((str[0] == ':' || str[len-1] == ':') && str[1] != '\0');
+ return ((str[0] == ':' || str[len-1] == ':') && str[1] != '\0');
}
-static symbol_t *mk_symbol(char *str)
+static symbol_t *
+mk_symbol(char *str)
{- symbol_t *sym;
- size_t len = strlen(str);
+ symbol_t *sym;
+ size_t len = strlen(str);
- sym = calloc(1, sizeof(*sym)-sizeof(void*) + len + 1);
- assert(((uintptr_t)sym & 0x7) == 0); // make sure malloc aligns 8
- sym->numtype = NONNUMERIC;
- if (fl_is_keyword_name(str, len)) {- value_t s = tagptr(sym, TAG_SYM);
- setc(s, s);
- sym->flags |= FLAG_KEYWORD;
- }
- else {- sym->binding = UNBOUND;
- }
- sym->hash = memhash32(str, len)^0xAAAAAAAA;
- memmove(sym->name, str, len+1);
- return sym;
+ sym = calloc(1, sizeof(*sym)-sizeof(void*) + len + 1);
+ assert(((uintptr_t)sym & 0x7) == 0); // make sure malloc aligns 8
+ sym->numtype = NONNUMERIC;
+ if(fl_is_keyword_name(str, len)){+ value_t s = tagptr(sym, TAG_SYM);
+ setc(s, s);
+ sym->flags |= FLAG_KEYWORD;
+ }else{+ sym->binding = UNBOUND;
+ }
+ sym->hash = memhash32(str, len)^0xAAAAAAAA;
+ memmove(sym->name, str, len+1);
+ return sym;
}
-static symbol_t **symtab_lookup(symbol_t **ptree, char *str)
+static symbol_t **
+symtab_lookup(symbol_t **ptree, char *str)
{- int x;
-
- while(*ptree != nil) {- x = strcmp(str, (*ptree)->name);
- if (x == 0)
- return ptree;
- if (x < 0)
- ptree = &(*ptree)->left;
- else
- ptree = &(*ptree)->right;
- }
- return ptree;
+ int x;
+ while(*ptree != nil && (x = strcmp(str, (*ptree)->name)) != 0)
+ ptree = x < 0 ? &(*ptree)->left : &(*ptree)->right;
+ return ptree;
}
-value_t symbol(char *str)
+value_t
+symbol(char *str)
{- symbol_t **pnode;
+ symbol_t **pnode;
- pnode = symtab_lookup(&symtab, str);
- if (*pnode == nil)
- *pnode = mk_symbol(str);
- return tagptr(*pnode, TAG_SYM);
+ pnode = symtab_lookup(&symtab, str);
+ if(*pnode == nil)
+ *pnode = mk_symbol(str);
+ return tagptr(*pnode, TAG_SYM);
}
-static uint32_t _gensym_ctr=0;
+static uint32_t _gensym_ctr = 0;
// two static buffers for gensym printing so there can be two
// gensym names available at a time, mostly for compare()
static char gsname[2][16];
-static int gsnameno=0;
+static int gsnameno = 0;
BUILTIN("gensym", gensym) {- argcount(nargs, 0);
- USED(args);
- gensym_t *gs = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*));
- gs->id = _gensym_ctr++;
- gs->binding = UNBOUND;
- gs->isconst = 0;
- gs->type = nil;
- return tagptr(gs, TAG_SYM);
+ argcount(nargs, 0);
+ USED(args);
+ gensym_t *gs = alloc_words(sizeof(gensym_t)/sizeof(void*));
+ gs->id = _gensym_ctr++;
+ gs->binding = UNBOUND;
+ gs->isconst = 0;
+ gs->type = nil;
+ return tagptr(gs, TAG_SYM);
}
-value_t gensym(void)
+value_t
+gensym(void)
{- return fn_builtin_gensym(nil, 0);
+ return fn_builtin_gensym(nil, 0);
}
BUILTIN("gensym?", gensymp) {- argcount(nargs, 1);
- return isgensym(args[0]) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return isgensym(args[0]) ? FL_T : FL_F;
}
-char *symbol_name(value_t v)
+char *
+symbol_name(value_t v)
{- if (ismanaged(v)) {- gensym_t *gs = (gensym_t*)ptr(v);
- gsnameno = 1-gsnameno;
- char *n = uint2str(gsname[gsnameno]+1, sizeof(gsname[0])-1, gs->id, 10);
- *(--n) = 'g';
- return n;
- }
- return ((symbol_t*)ptr(v))->name;
+ if(ismanaged(v)){+ gensym_t *gs = (gensym_t*)ptr(v);
+ gsnameno = 1-gsnameno;
+ char *n = uint2str(gsname[gsnameno]+1, sizeof(gsname[0])-1, gs->id, 10);
+ *(--n) = 'g';
+ return n;
+ }
+ return ((symbol_t*)ptr(v))->name;
}
// conses ---------------------------------------------------------------------
@@ -293,32 +306,34 @@
void gc(int mustgrow);
-static value_t mk_cons(void)
+static value_t
+mk_cons(void)
{- cons_t *c;
+ cons_t *c;
- if (__unlikely(curheap > lim))
- gc(0);
- c = (cons_t*)curheap;
- curheap += sizeof(cons_t);
- return tagptr(c, TAG_CONS);
+ if(__unlikely(curheap > lim))
+ gc(0);
+ c = (cons_t*)curheap;
+ curheap += sizeof(cons_t);
+ return tagptr(c, TAG_CONS);
}
-static value_t *alloc_words(int n)
+static void *
+alloc_words(int n)
{- value_t *first;
+ value_t *first;
- assert(n > 0);
- n = LLT_ALIGN(n, 2); // only allocate multiples of 2 words
- if (__unlikely((value_t*)curheap > ((value_t*)lim)+2-n)) {- gc(0);
- while ((value_t*)curheap > ((value_t*)lim)+2-n) {- gc(1);
- }
- }
- first = (value_t*)curheap;
- curheap += (n*sizeof(value_t));
- return first;
+ assert(n > 0);
+ n = LLT_ALIGN(n, 2); // only allocate multiples of 2 words
+ if(__unlikely((value_t*)curheap > ((value_t*)lim)+2-n)){+ gc(0);
+ while((value_t*)curheap > ((value_t*)lim)+2-n){+ gc(1);
+ }
+ }
+ first = (value_t*)curheap;
+ curheap += (n*sizeof(value_t));
+ return first;
}
// allocate n consecutive conses
@@ -325,24 +340,26 @@
#define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS)
#define cons_index(c) (((cons_t*)ptr(c))-((cons_t*)fromspace))
-#define ismarked(c) bitvector_get(consflags, cons_index(c))
+#define ismarked(c) bitvector_get(consflags, cons_index(c))
#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1)
#define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0)
static value_t the_empty_vector;
-value_t alloc_vector(size_t n, int init)
+value_t
+alloc_vector(size_t n, int init)
{- if (n == 0) return the_empty_vector;
- value_t *c = alloc_words(n+1);
- value_t v = tagptr(c, TAG_VECTOR);
- vector_setsize(v, n);
- if (init) {- unsigned int i;
- for(i=0; i < n; i++)
- vector_elt(v, i) = FL_UNSPECIFIED;
- }
- return v;
+ if(n == 0)
+ return the_empty_vector;
+ value_t *c = alloc_words(n+1);
+ value_t v = tagptr(c, TAG_VECTOR);
+ vector_setsize(v, n);
+ if(init){+ unsigned int i;
+ for(i = 0; i < n; i++)
+ vector_elt(v, i) = FL_UNSPECIFIED;
+ }
+ return v;
}
// cvalues --------------------------------------------------------------------
@@ -359,369 +376,382 @@
// collector ------------------------------------------------------------------
-void fl_gc_handle(value_t *pv)
+void
+fl_gc_handle(value_t *pv)
{- if (N_GCHND >= N_GC_HANDLES)
- lerrorf(MemoryError, "out of gc handles");
- GCHandleStack[N_GCHND++] = pv;
+ if(N_GCHND >= N_GC_HANDLES)
+ lerrorf(MemoryError, "out of gc handles");
+ GCHandleStack[N_GCHND++] = pv;
}
-void fl_free_gc_handles(uint32_t n)
+void
+fl_free_gc_handles(uint32_t n)
{- assert(N_GCHND >= n);
- N_GCHND -= n;
+ assert(N_GCHND >= n);
+ N_GCHND -= n;
}
-static value_t relocate(value_t v)
+static value_t
+relocate(value_t v)
{- value_t a, d, nc, first, *pcdr;
- uintptr_t t = tag(v);
+ value_t a, d, nc, first, *pcdr;
+ uintptr_t t = tag(v);
- if (t == TAG_CONS) {- // iterative implementation allows arbitrarily long cons chains
- pcdr = &first;
- do {- if ((a=car_(v)) == TAG_FWD) {- *pcdr = cdr_(v);
- return first;
- }
- *pcdr = nc = tagptr((cons_t*)curheap, TAG_CONS);
- curheap += sizeof(cons_t);
- d = cdr_(v);
- car_(v) = TAG_FWD; cdr_(v) = nc;
- car_(nc) = relocate(a);
- pcdr = &cdr_(nc);
- v = d;
- } while (iscons(v));
- *pcdr = (d==NIL) ? NIL : relocate(d);
- return first;
- }
+ if(t == TAG_CONS){+ // iterative implementation allows arbitrarily long cons chains
+ pcdr = &first;
+ do{+ if((a = car_(v)) == TAG_FWD){+ *pcdr = cdr_(v);
+ return first;
+ }
+ *pcdr = nc = tagptr((cons_t*)curheap, TAG_CONS);
+ curheap += sizeof(cons_t);
+ d = cdr_(v);
+ car_(v) = TAG_FWD; cdr_(v) = nc;
+ car_(nc) = relocate(a);
+ pcdr = &cdr_(nc);
+ v = d;
+ }while(iscons(v));
+ *pcdr = d == NIL ? NIL : relocate(d);
+ return first;
+ }
- if ((t&3) == 0) return v;
- if (!ismanaged(v)) return v;
- if (isforwarded(v)) return forwardloc(v);
+ if((t&3) == 0)
+ return v;
+ if(!ismanaged(v))
+ return v;
+ if(isforwarded(v))
+ return forwardloc(v);
- if (t == TAG_VECTOR) {- // N.B.: 0-length vectors secretly have space for a first element
- size_t i, sz = vector_size(v);
- if (vector_elt(v,-1) & 0x1) {- // grown vector
- nc = relocate(vector_elt(v,0));
- forward(v, nc);
- }
- else {- nc = tagptr(alloc_words(sz+1), TAG_VECTOR);
- vector_setsize(nc, sz);
- a = vector_elt(v,0);
- forward(v, nc);
- if (sz > 0) {- vector_elt(nc,0) = relocate(a);
- for(i=1; i < sz; i++)
- vector_elt(nc,i) = relocate(vector_elt(v,i));
- }
- }
- return nc;
- }
- else if (t == TAG_CPRIM) {- cprim_t *pcp = (cprim_t*)ptr(v);
- size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
- cprim_t *ncp = (cprim_t*)alloc_words(nw);
- while (nw--)
- ((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];
- nc = tagptr(ncp, TAG_CPRIM);
- forward(v, nc);
- return nc;
- }
- else if (t == TAG_CVALUE) {- return cvalue_relocate(v);
- }
- else if (t == TAG_FUNCTION) {- function_t *fn = (function_t*)ptr(v);
- function_t *nfn = (function_t*)alloc_words(4);
- nfn->bcode = fn->bcode;
- nfn->vals = fn->vals;
- nc = tagptr(nfn, TAG_FUNCTION);
- forward(v, nc);
- nfn->env = relocate(fn->env);
- nfn->vals = relocate(nfn->vals);
- nfn->bcode = relocate(nfn->bcode);
- assert(!ismanaged(fn->name));
- nfn->name = fn->name;
- return nc;
- }
- else if (t == TAG_SYM) {- gensym_t *gs = (gensym_t*)ptr(v);
- gensym_t *ng = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*));
- ng->id = gs->id;
- ng->binding = gs->binding;
- ng->isconst = 0;
- nc = tagptr(ng, TAG_SYM);
- forward(v, nc);
- if (ng->binding != UNBOUND)
- ng->binding = relocate(ng->binding);
- return nc;
- }
- return v;
+ if(t == TAG_VECTOR){+ // N.B.: 0-length vectors secretly have space for a first element
+ size_t i, sz = vector_size(v);
+ if(vector_elt(v,-1) & 0x1){+ // grown vector
+ nc = relocate(vector_elt(v,0));
+ forward(v, nc);
+ }else{+ nc = tagptr(alloc_words(sz+1), TAG_VECTOR);
+ vector_setsize(nc, sz);
+ a = vector_elt(v,0);
+ forward(v, nc);
+ if(sz > 0){+ vector_elt(nc,0) = relocate(a);
+ for(i = 1; i < sz; i++)
+ vector_elt(nc,i) = relocate(vector_elt(v,i));
+ }
+ }
+ return nc;
+ }
+ if(t == TAG_CPRIM){+ cprim_t *pcp = ptr(v);
+ size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
+ cprim_t *ncp = alloc_words(nw);
+ while(nw--)
+ ((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];
+ nc = tagptr(ncp, TAG_CPRIM);
+ forward(v, nc);
+ return nc;
+ }
+ if(t == TAG_CVALUE)
+ return cvalue_relocate(v);
+ if(t == TAG_FUNCTION){+ function_t *fn = ptr(v);
+ function_t *nfn = alloc_words(4);
+ nfn->bcode = fn->bcode;
+ nfn->vals = fn->vals;
+ nc = tagptr(nfn, TAG_FUNCTION);
+ forward(v, nc);
+ nfn->env = relocate(fn->env);
+ nfn->vals = relocate(nfn->vals);
+ nfn->bcode = relocate(nfn->bcode);
+ assert(!ismanaged(fn->name));
+ nfn->name = fn->name;
+ return nc;
+ }
+ if(t == TAG_SYM){+ gensym_t *gs = ptr(v);
+ gensym_t *ng = alloc_words(sizeof(gensym_t)/sizeof(void*));
+ ng->id = gs->id;
+ ng->binding = gs->binding;
+ ng->isconst = 0;
+ nc = tagptr(ng, TAG_SYM);
+ forward(v, nc);
+ if(ng->binding != UNBOUND)
+ ng->binding = relocate(ng->binding);
+ return nc;
+ }
+ return v;
}
-value_t relocate_lispvalue(value_t v)
+value_t
+relocate_lispvalue(value_t v)
{- return relocate(v);
+ return relocate(v);
}
-static void trace_globals(symbol_t *root)
+static void
+trace_globals(symbol_t *root)
{- while (root != nil) {- if (root->binding != UNBOUND)
- root->binding = relocate(root->binding);
- trace_globals(root->left);
- root = root->right;
- }
+ while(root != nil){+ if(root->binding != UNBOUND)
+ root->binding = relocate(root->binding);
+ trace_globals(root->left);
+ root = root->right;
+ }
}
static value_t memory_exception_value;
-void gc(int mustgrow)
+void
+gc(int mustgrow)
{- static int grew = 0;
- void *temp;
- uint32_t i, f, top;
- fl_readstate_t *rs;
+ static int grew = 0;
+ void *temp;
+ uint32_t i, f, top;
+ fl_readstate_t *rs;
- curheap = tospace;
- if (grew)
- lim = curheap+heapsize*2-sizeof(cons_t);
- else
- lim = curheap+heapsize-sizeof(cons_t);
+ curheap = tospace;
+ if(grew)
+ lim = curheap+heapsize*2-sizeof(cons_t);
+ else
+ lim = curheap+heapsize-sizeof(cons_t);
- if (fl_throwing_frame > curr_frame) {- top = fl_throwing_frame - 4;
- f = Stack[fl_throwing_frame-4];
- }
- else {- top = SP;
- f = curr_frame;
- }
- while (1) {- for (i=f; i < top; i++)
- Stack[i] = relocate(Stack[i]);
- if (f == 0) break;
- top = f - 4;
- f = Stack[f-4];
- }
- for (i=0; i < N_GCHND; i++)
- *GCHandleStack[i] = relocate(*GCHandleStack[i]);
- trace_globals(symtab);
- relocate_typetable();
- rs = readstate;
- while (rs) {- value_t ent;
- for(i=0; i < rs->backrefs.size; i++) {- ent = (value_t)rs->backrefs.table[i];
- if (ent != (value_t)HT_NOTFOUND)
- rs->backrefs.table[i] = (void*)relocate(ent);
- }
- for(i=0; i < rs->gensyms.size; i++) {- ent = (value_t)rs->gensyms.table[i];
- if (ent != (value_t)HT_NOTFOUND)
- rs->gensyms.table[i] = (void*)relocate(ent);
- }
- rs->source = relocate(rs->source);
- rs = rs->prev;
- }
- fl_lasterror = relocate(fl_lasterror);
- memory_exception_value = relocate(memory_exception_value);
- the_empty_vector = relocate(the_empty_vector);
+ if(fl_throwing_frame > curr_frame){+ top = fl_throwing_frame - 4;
+ f = Stack[fl_throwing_frame-4];
+ }else{+ top = SP;
+ f = curr_frame;
+ }
+ while(1){+ for(i = f; i < top; i++)
+ Stack[i] = relocate(Stack[i]);
+ if(f == 0)
+ break;
+ top = f - 4;
+ f = Stack[f-4];
+ }
+ for(i = 0; i < N_GCHND; i++)
+ *GCHandleStack[i] = relocate(*GCHandleStack[i]);
+ trace_globals(symtab);
+ relocate_typetable();
+ rs = readstate;
+ while(rs){+ value_t ent;
+ for(i = 0; i < rs->backrefs.size; i++){+ ent = (value_t)rs->backrefs.table[i];
+ if(ent != (value_t)HT_NOTFOUND)
+ rs->backrefs.table[i] = (void*)relocate(ent);
+ }
+ for(i = 0; i < rs->gensyms.size; i++){+ ent = (value_t)rs->gensyms.table[i];
+ if(ent != (value_t)HT_NOTFOUND)
+ rs->gensyms.table[i] = (void*)relocate(ent);
+ }
+ rs->source = relocate(rs->source);
+ rs = rs->prev;
+ }
+ fl_lasterror = relocate(fl_lasterror);
+ memory_exception_value = relocate(memory_exception_value);
+ the_empty_vector = relocate(the_empty_vector);
- sweep_finalizers();
+ sweep_finalizers();
#ifdef VERBOSEGC
- printf("GC: found %d/%d live conses\n",- (curheap-tospace)/sizeof(cons_t), heapsize/sizeof(cons_t));
+ printf("GC: found %d/%d live conses\n",+ (curheap-tospace)/sizeof(cons_t), heapsize/sizeof(cons_t));
#endif
- temp = tospace;
- tospace = fromspace;
- fromspace = temp;
+ temp = tospace;
+ tospace = fromspace;
+ fromspace = temp;
- // if we're using > 80% of the space, resize tospace so we have
- // more space to fill next time. if we grew tospace last time,
- // grow the other half of the heap this time to catch up.
- if (grew || ((lim-curheap) < (int)(heapsize/5)) || mustgrow) {- temp = LLT_REALLOC(tospace, heapsize*2);
- if (temp == nil)
- fl_raise(memory_exception_value);
- tospace = temp;
- if (grew) {- heapsize*=2;
- temp = bitvector_resize(consflags, 0, heapsize/sizeof(cons_t), 1);
- if (temp == nil)
- fl_raise(memory_exception_value);
- consflags = (uint32_t*)temp;
- }
- grew = !grew;
- }
- if (curheap > lim) // all data was live
- gc(0);
+ // if we're using > 80% of the space, resize tospace so we have
+ // more space to fill next time. if we grew tospace last time,
+ // grow the other half of the heap this time to catch up.
+ if(grew || ((lim-curheap) < (int)(heapsize/5)) || mustgrow){+ temp = LLT_REALLOC(tospace, heapsize*2);
+ if(temp == nil)
+ fl_raise(memory_exception_value);
+ tospace = temp;
+ if(grew){+ heapsize *= 2;
+ temp = bitvector_resize(consflags, 0, heapsize/sizeof(cons_t), 1);
+ if(temp == nil)
+ fl_raise(memory_exception_value);
+ consflags = (uint32_t*)temp;
+ }
+ grew = !grew;
+ }
+ if(curheap > lim) // all data was live
+ gc(0);
}
-static void grow_stack(void)
+static void
+grow_stack(void)
{- size_t newsz = N_STACK + (N_STACK>>1);
- value_t *ns = realloc(Stack, newsz*sizeof(value_t));
- if (ns == nil)
- lerrorf(MemoryError, "stack overflow");
- Stack = ns;
- N_STACK = newsz;
+ size_t newsz = N_STACK + (N_STACK>>1);
+ value_t *ns = realloc(Stack, newsz*sizeof(value_t));
+ if(ns == nil)
+ lerrorf(MemoryError, "stack overflow");
+ Stack = ns;
+ N_STACK = newsz;
}
// utils ----------------------------------------------------------------------
-static char *cvalue_name(value_t v)
+static char *
+cvalue_name(value_t v)
{- cvalue_t *cv = (cvalue_t*)ptr(v);
- static char name[64];
- value_t label;
+ cvalue_t *cv = ptr(v);
+ static char name[64];
+ value_t label;
- void *data = cptr(v);
- void *fptr = *(void**)data;
- label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
- if (label == (value_t)HT_NOTFOUND)
- snprintf(name, sizeof(name), "#<builtin @%p>", fptr);
- else
- snprintf(name, sizeof(name), "#fn(%s)", symbol_name(label));
- return name;
+ void *data = cptr(v);
+ void *fptr = *(void**)data;
+ label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
+ if(label == (value_t)HT_NOTFOUND)
+ snprintf(name, sizeof(name), "#<builtin @%p>", fptr);
+ else
+ snprintf(name, sizeof(name), "#fn(%s)", symbol_name(label));
+ return name;
}
// apply function with n args on the stack
-static value_t _applyn(uint32_t n)
+static value_t
+_applyn(uint32_t n)
{- value_t f = Stack[SP-n-1];
- uint32_t saveSP = SP;
- value_t v;
- if (iscbuiltin(f)) {- curr_fname = cvalue_name(f);
- v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n);
- }
- else if (isfunction(f)) {- v = apply_cl(n);
- }
- else if (isbuiltin(f)) {- value_t tab = symbol_value(builtins_table_sym);
- if (ptr(tab) == nil)
- unbound_error(tab);
- Stack[SP-n-1] = vector_elt(tab, uintval(f));
- curr_fname = builtins[uintval(f)].name;
- v = apply_cl(n);
- }
- else {- type_error("function", f);- }
- SP = saveSP;
- return v;
+ value_t f = Stack[SP-n-1];
+ uint32_t saveSP = SP;
+ value_t v;
+ if(iscbuiltin(f)){+ curr_fname = cvalue_name(f);
+ v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n);
+ }else if(isfunction(f)){+ v = apply_cl(n);
+ }else if(isbuiltin(f)){+ value_t tab = symbol_value(builtins_table_sym);
+ if(ptr(tab) == nil)
+ unbound_error(tab);
+ Stack[SP-n-1] = vector_elt(tab, uintval(f));
+ curr_fname = builtins[uintval(f)].name;
+ v = apply_cl(n);
+ }else{+ type_error("function", f);+ }
+ SP = saveSP;
+ return v;
}
-value_t fl_apply(value_t f, value_t l)
+value_t
+fl_apply(value_t f, value_t l)
{- value_t v = l;
- uint32_t n = SP;
+ value_t v = l;
+ uint32_t n = SP;
- PUSH(f);
- while (iscons(v)) {- if (SP >= N_STACK)
- grow_stack();
- PUSH(car_(v));
- v = cdr_(v);
- }
- n = SP - n - 1;
- v = _applyn(n);
- POPN(n+1);
- return v;
+ PUSH(f);
+ while(iscons(v)){+ if(SP >= N_STACK)
+ grow_stack();
+ PUSH(car_(v));
+ v = cdr_(v);
+ }
+ n = SP - n - 1;
+ v = _applyn(n);
+ POPN(n+1);
+ return v;
}
-value_t fl_applyn(uint32_t n, value_t f, ...)
+value_t
+fl_applyn(uint32_t n, value_t f, ...)
{- va_list ap;
- va_start(ap, f);
- size_t i;
+ va_list ap;
+ va_start(ap, f);
+ size_t i;
- PUSH(f);
- while (SP+n > N_STACK)
- grow_stack();
- for(i=0; i < n; i++) {- value_t a = va_arg(ap, value_t);
- PUSH(a);
- }
- value_t v = _applyn(n);
- POPN(n+1);
- va_end(ap);
- return v;
+ PUSH(f);
+ while(SP+n > N_STACK)
+ grow_stack();
+ for(i = 0; i < n; i++){+ value_t a = va_arg(ap, value_t);
+ PUSH(a);
+ }
+ value_t v = _applyn(n);
+ POPN(n+1);
+ va_end(ap);
+ return v;
}
-value_t fl_listn(size_t n, ...)
+value_t
+fl_listn(size_t n, ...)
{- va_list ap;
- va_start(ap, n);
- uint32_t si = SP;
- size_t i;
+ va_list ap;
+ va_start(ap, n);
+ uint32_t si = SP;
+ size_t i;
- while (SP+n > N_STACK)
- grow_stack();
- for(i=0; i < n; i++) {- value_t a = va_arg(ap, value_t);
- PUSH(a);
- }
- cons_t *c = (cons_t*)alloc_words(n*2);
- cons_t *l = c;
- for(i=0; i < n; i++) {- c->car = Stack[si++];
- c->cdr = tagptr(c+1, TAG_CONS);
- c++;
- }
- (c-1)->cdr = NIL;
+ while(SP+n > N_STACK)
+ grow_stack();
+ for(i = 0; i < n; i++){+ value_t a = va_arg(ap, value_t);
+ PUSH(a);
+ }
+ cons_t *c = alloc_words(n*2);
+ cons_t *l = c;
+ for(i = 0; i < n; i++){+ c->car = Stack[si++];
+ c->cdr = tagptr(c+1, TAG_CONS);
+ c++;
+ }
+ c[-1].cdr = NIL;
- POPN(n);
- va_end(ap);
- return tagptr(l, TAG_CONS);
+ POPN(n);
+ va_end(ap);
+ return tagptr(l, TAG_CONS);
}
-value_t fl_list2(value_t a, value_t b)
+value_t
+fl_list2(value_t a, value_t b)
{- PUSH(a);
- PUSH(b);
- cons_t *c = (cons_t*)alloc_words(4);
- b = POP();
- a = POP();
- c[0].car = a;
- c[0].cdr = tagptr(c+1, TAG_CONS);
- c[1].car = b;
- c[1].cdr = NIL;
- return tagptr(c, TAG_CONS);
+ PUSH(a);
+ PUSH(b);
+ cons_t *c = alloc_words(4);
+ b = POP();
+ a = POP();
+ c[0].car = a;
+ c[0].cdr = tagptr(c+1, TAG_CONS);
+ c[1].car = b;
+ c[1].cdr = NIL;
+ return tagptr(c, TAG_CONS);
}
-value_t fl_cons(value_t a, value_t b)
+value_t
+fl_cons(value_t a, value_t b)
{- PUSH(a);
- PUSH(b);
- value_t c = mk_cons();
- cdr_(c) = POP();
- car_(c) = POP();
- return c;
+ PUSH(a);
+ PUSH(b);
+ value_t c = mk_cons();
+ cdr_(c) = POP();
+ car_(c) = POP();
+ return c;
}
-int fl_isnumber(value_t v)
+int
+fl_isnumber(value_t v)
{- if (isfixnum(v))
- return 1;
- if (iscprim(v)) {- cprim_t *c = ptr(v);
- return c->type != wchartype;
- }
- if (iscvalue(v)) {- cvalue_t *c = ptr(v);
- return valid_numtype(cv_class(c)->numtype);
- }
- return 0;
+ if(isfixnum(v))
+ return 1;
+ if(iscprim(v)){+ cprim_t *c = ptr(v);
+ return c->type != wchartype;
+ }
+ if(iscvalue(v)){+ cvalue_t *c = ptr(v);
+ return valid_numtype(cv_class(c)->numtype);
+ }
+ return 0;
}
// read -----------------------------------------------------------------------
@@ -734,71 +764,74 @@
// eval -----------------------------------------------------------------------
-static value_t list(value_t *args, uint32_t nargs, int star)
+static value_t
+list(value_t *args, uint32_t nargs, int star)
{- cons_t *c;
- uint32_t i;
- value_t v;
- v = cons_reserve(nargs);
- c = (cons_t*)ptr(v);
- for(i=0; i < nargs; i++) {- c->car = args[i];
- c->cdr = tagptr(c+1, TAG_CONS);
- c++;
- }
- if (star)
- (c-2)->cdr = (c-1)->car;
- else
- (c-1)->cdr = NIL;
- return v;
+ cons_t *c;
+ uint32_t i;
+ value_t v;
+ v = cons_reserve(nargs);
+ c = ptr(v);
+ for(i = 0; i < nargs; i++){+ c->car = args[i];
+ c->cdr = tagptr(c+1, TAG_CONS);
+ c++;
+ }
+ if(star)
+ (c-2)->cdr = (c-1)->car;
+ else
+ (c-1)->cdr = NIL;
+ return v;
}
-static value_t copy_list(value_t L)
+static value_t
+copy_list(value_t L)
{- if (!iscons(L))
- return NIL;
- PUSH(NIL);
- PUSH(L);
- value_t *plcons = &Stack[SP-2];
- value_t *pL = &Stack[SP-1];
- value_t c;
- c = mk_cons(); PUSH(c); // save first cons
- car_(c) = car_(*pL);
- cdr_(c) = NIL;
- *plcons = c;
- *pL = cdr_(*pL);
- while (iscons(*pL)) {- c = mk_cons();
- car_(c) = car_(*pL);
- cdr_(c) = NIL;
- cdr_(*plcons) = c;
- *plcons = c;
- *pL = cdr_(*pL);
- }
- c = POP(); // first cons
- POPN(2);
- return c;
+ if(!iscons(L))
+ return NIL;
+ PUSH(NIL);
+ PUSH(L);
+ value_t *plcons = &Stack[SP-2];
+ value_t *pL = &Stack[SP-1];
+ value_t c;
+ c = mk_cons(); PUSH(c); // save first cons
+ car_(c) = car_(*pL);
+ cdr_(c) = NIL;
+ *plcons = c;
+ *pL = cdr_(*pL);
+ while(iscons(*pL)){+ c = mk_cons();
+ car_(c) = car_(*pL);
+ cdr_(c) = NIL;
+ cdr_(*plcons) = c;
+ *plcons = c;
+ *pL = cdr_(*pL);
+ }
+ c = POP(); // first cons
+ POPN(2);
+ return c;
}
-static value_t do_trycatch(void)
+static value_t
+do_trycatch(void)
{- uint32_t saveSP = SP;
- value_t v = NIL;
- value_t thunk = Stack[SP-2];
- Stack[SP-2] = Stack[SP-1];
- Stack[SP-1] = thunk;
+ uint32_t saveSP = SP;
+ value_t v = NIL;
+ value_t thunk = Stack[SP-2];
+ Stack[SP-2] = Stack[SP-1];
+ Stack[SP-1] = thunk;
- FL_TRY {- v = apply_cl(0);
- }
- FL_CATCH {- v = Stack[saveSP-2];
- PUSH(v);
- PUSH(fl_lasterror);
- v = apply_cl(1);
- }
- SP = saveSP;
- return v;
+ FL_TRY{+ v = apply_cl(0);
+ }
+ FL_CATCH{+ v = Stack[saveSP-2];
+ PUSH(v);
+ PUSH(fl_lasterror);
+ v = apply_cl(1);
+ }
+ SP = saveSP;
+ return v;
}
/*
@@ -805,88 +838,88 @@
argument layout on stack is
|--required args--|--opt args--|--kw args--|--rest args...
*/
-static uint32_t process_keys(value_t kwtable,
- uint32_t nreq, uint32_t nkw, uint32_t nopt,
- uint32_t bp, uint32_t nargs, int va)
+static uint32_t
+process_keys(value_t kwtable, uint32_t nreq, uint32_t nkw, uint32_t nopt, uint32_t bp, uint32_t nargs, int va)
{- uint32_t extr = nopt+nkw;
- uint32_t ntot = nreq+extr;
- value_t args[64], v = NIL;
- uint32_t i, a = 0, nrestargs;
- value_t s1 = Stack[SP-1];
- value_t s2 = Stack[SP-2];
- value_t s4 = Stack[SP-4];
- value_t s5 = Stack[SP-5];
- if (nargs < nreq)
- lerrorf(ArgError, "too few arguments");
- if (extr > nelem(args))
- lerrorf(ArgError, "too many arguments");
- for (i=0; i < extr; i++) args[i] = UNBOUND;
- for (i=nreq; i < nargs; i++) {- v = Stack[bp+i];
- if (issymbol(v) && iskeyword((symbol_t*)ptr(v)))
- break;
- if (a >= nopt)
- goto no_kw;
- args[a++] = v;
- }
- if (i >= nargs) goto no_kw;
- // now process keywords
- uintptr_t n = vector_size(kwtable)/2;
- do {- i++;
- if (i >= nargs)
- lerrorf(ArgError, "keyword %s requires an argument",
- symbol_name(v));
- value_t hv = fixnum(((symbol_t*)ptr(v))->hash);
- lltint_t lx = numval(hv);
- uintptr_t x = 2*((lx < 0 ? -lx : lx) % n);
- if (vector_elt(kwtable, x) == v) {- uintptr_t idx = numval(vector_elt(kwtable, x+1));
- assert(idx < nkw);
- idx += nopt;
- if (args[idx] == UNBOUND) {- // if duplicate key, keep first value
- args[idx] = Stack[bp+i];
- }
- }
- else {- lerrorf(ArgError, "unsupported keyword %s", symbol_name(v));
- }
- i++;
- if (i >= nargs) break;
- v = Stack[bp+i];
- } while (issymbol(v) && iskeyword((symbol_t*)ptr(v)));
- no_kw:
- nrestargs = nargs - i;
- if (!va && nrestargs > 0)
- lerrorf(ArgError, "too many arguments");
- nargs = ntot + nrestargs;
- if (nrestargs)
- memmove(&Stack[bp+ntot], &Stack[bp+i], nrestargs*sizeof(value_t));
- memmove(&Stack[bp+nreq], args, extr*sizeof(value_t));
- SP = bp + nargs;
- assert(SP < N_STACK-5);
- PUSH(s5);
- PUSH(s4);
- PUSH(nargs);
- PUSH(s2);
- PUSH(s1);
- curr_frame = SP;
- return nargs;
+ uint32_t extr = nopt+nkw;
+ uint32_t ntot = nreq+extr;
+ value_t args[64], v = NIL;
+ uint32_t i, a = 0, nrestargs;
+ value_t s1 = Stack[SP-1];
+ value_t s2 = Stack[SP-2];
+ value_t s4 = Stack[SP-4];
+ value_t s5 = Stack[SP-5];
+ if(nargs < nreq)
+ lerrorf(ArgError, "too few arguments");
+ if(extr > nelem(args))
+ lerrorf(ArgError, "too many arguments");
+ for(i = 0; i < extr; i++)
+ args[i] = UNBOUND;
+ for(i = nreq; i < nargs; i++){+ v = Stack[bp+i];
+ if(issymbol(v) && iskeyword((symbol_t*)ptr(v)))
+ break;
+ if(a >= nopt)
+ goto no_kw;
+ args[a++] = v;
+ }
+ if(i >= nargs)
+ goto no_kw;
+ // now process keywords
+ uintptr_t n = vector_size(kwtable)/2;
+ do{+ i++;
+ if(i >= nargs)
+ lerrorf(ArgError, "keyword %s requires an argument", symbol_name(v));
+ value_t hv = fixnum(((symbol_t*)ptr(v))->hash);
+ lltint_t lx = numval(hv);
+ uintptr_t x = 2*((lx < 0 ? -lx : lx) % n);
+ if(vector_elt(kwtable, x) == v){+ uintptr_t idx = numval(vector_elt(kwtable, x+1));
+ assert(idx < nkw);
+ idx += nopt;
+ if(args[idx] == UNBOUND){+ // if duplicate key, keep first value
+ args[idx] = Stack[bp+i];
+ }
+ }else{+ lerrorf(ArgError, "unsupported keyword %s", symbol_name(v));
+ }
+ i++;
+ if(i >= nargs)
+ break;
+ v = Stack[bp+i];
+ }while(issymbol(v) && iskeyword((symbol_t*)ptr(v)));
+no_kw:
+ nrestargs = nargs - i;
+ if(!va && nrestargs > 0)
+ lerrorf(ArgError, "too many arguments");
+ nargs = ntot + nrestargs;
+ if(nrestargs)
+ memmove(&Stack[bp+ntot], &Stack[bp+i], nrestargs*sizeof(value_t));
+ memmove(&Stack[bp+nreq], args, extr*sizeof(value_t));
+ SP = bp + nargs;
+ assert(SP < N_STACK-5);
+ PUSH(s5);
+ PUSH(s4);
+ PUSH(nargs);
+ PUSH(s2);
+ PUSH(s1);
+ curr_frame = SP;
+ return nargs;
}
#if BYTE_ORDER == BIG_ENDIAN
-#define GET_INT32(a) \
- ((int32_t) \
- ((((int32_t)a[0])<<0) | \
- (((int32_t)a[1])<<8) | \
- (((int32_t)a[2])<<16) | \
- (((int32_t)a[3])<<24)))
-#define GET_INT16(a) \
- ((int16_t) \
- ((((int16_t)a[0])<<0) | \
- (((int16_t)a[1])<<8)))
+#define GET_INT32(a) \
+ ((int32_t) \
+ ((((int32_t)a[0])<<0) | \
+ (((int32_t)a[1])<<8) | \
+ (((int32_t)a[2])<<16) | \
+ (((int32_t)a[3])<<24)))
+#define GET_INT16(a) \
+ ((int16_t) \
+ ((((int16_t)a[0])<<0) | \
+ (((int16_t)a[1])<<8)))
#define PUT_INT32(a,i) (*(int32_t*)(a) = bswap_32((int32_t)(i)))
#else
#define GET_INT32(a) (*(int32_t*)a)
@@ -910,885 +943,870 @@
- allocate vararg array
- push closed env, set up new environment
*/
-static value_t apply_cl(uint32_t nargs)
+static value_t
+apply_cl(uint32_t nargs)
{- uint32_t top_frame = curr_frame;
- // frame variables
- uint32_t n, captured;
- uint32_t bp;
- const uint8_t *ip;
- fixnum_t s, hi;
- int tail;
+ uint32_t top_frame = curr_frame;
+ // frame variables
+ uint32_t n, captured;
+ uint32_t bp;
+ const uint8_t *ip;
+ fixnum_t s, hi;
+ int tail;
- // temporary variables (not necessary to preserve across calls)
- uint32_t op, i;
- symbol_t *sym;
- cons_t *c;
- value_t *pv;
- int64_t accum;
- value_t func, v, e;
+ // temporary variables (not necessary to preserve across calls)
+ uint32_t op, i;
+ symbol_t *sym;
+ cons_t *c;
+ value_t *pv;
+ int64_t accum;
+ value_t func, v, e;
- n = 0;
- v = 0;
- USED(n);
- USED(v);
- apply_cl_top:
- captured = 0;
- func = Stack[SP-nargs-1];
- ip = cv_data((cvalue_t*)ptr(fn_bcode(func)));
- assert(!ismanaged((uintptr_t)ip));
- while (SP+GET_INT32(ip) > N_STACK) {- grow_stack();
- }
- ip += 4;
+ n = 0;
+ v = 0;
+ USED(n);
+ USED(v);
+apply_cl_top:
+ captured = 0;
+ func = Stack[SP-nargs-1];
+ ip = cv_data((cvalue_t*)ptr(fn_bcode(func)));
+ assert(!ismanaged((uintptr_t)ip));
+ while(SP+GET_INT32(ip) > N_STACK)
+ grow_stack();
+ ip += 4;
- bp = SP-nargs;
- PUSH(fn_env(func));
- PUSH(curr_frame);
- PUSH(nargs);
- SP++;//PUSH(0); //ip
- PUSH(0); //captured?
- curr_frame = SP;
+ bp = SP-nargs;
+ PUSH(fn_env(func));
+ PUSH(curr_frame);
+ PUSH(nargs);
+ SP++;//PUSH(0); //ip
+ PUSH(0); //captured?
+ curr_frame = SP;
- op = *ip++;
- while(1){- if(op < nelem(builtins) && builtins[op].name != nil)
- curr_fname = builtins[op].name;
- switch (op) {- OP(OP_LOADA0)
- v = captured ? vector_elt(Stack[bp], 0) : Stack[bp];
- PUSH(v);
- NEXT_OP;
+ op = *ip++;
+ while(1){+ if(op < nelem(builtins) && builtins[op].name != nil)
+ curr_fname = builtins[op].name;
- OP(OP_LOADA1)
- v = captured ? vector_elt(Stack[bp], 1) : Stack[bp+1];
- PUSH(v);
- NEXT_OP;
+ switch (op){+ OP(OP_LOADA0)
+ PUSH(captured ? vector_elt(Stack[bp], 0) : Stack[bp]);
+ NEXT_OP;
- OP(OP_LOADV)
- v = fn_vals(Stack[bp-1]);
- assert(*ip < vector_size(v));
- v = vector_elt(v, *ip);
- ip++;
- PUSH(v);
- NEXT_OP;
+ OP(OP_LOADA1)
+ PUSH(captured ? vector_elt(Stack[bp], 1) : Stack[bp+1]);
+ NEXT_OP;
- OP(OP_BRF)
- v = POP();
- ip += v == FL_F ? GET_INT16(ip) : 2;
- NEXT_OP;
+ OP(OP_LOADV)
+ v = fn_vals(Stack[bp-1]);
+ assert(*ip < vector_size(v));
+ PUSH(vector_elt(v, *ip++));
+ NEXT_OP;
- OP(OP_POP)
- POPN(1);
- NEXT_OP;
+ OP(OP_BRF)
+ ip += POP() == FL_F ? GET_INT16(ip) : 2;
+ NEXT_OP;
- OP(OP_TCALLL)
- tail = 1;
- if (0) {- OP(OP_CALLL)
- tail = 0;
- }
- n = GET_INT32(ip);
- ip += 4;
- if (0) {- OP(OP_TCALL)
- tail = 1;
- if (0) {- OP(OP_CALL)
- tail = 0;
- }
- n = *ip++; // nargs
- }
- do_call:
- func = Stack[SP-n-1];
- if (tag(func) == TAG_FUNCTION) {- if (func > (N_BUILTINS<<3)) {- if (tail) {- curr_frame = Stack[curr_frame-4];
- for(s=-1; s < (fixnum_t)n; s++)
- Stack[bp+s] = Stack[SP-n+s];
- SP = bp+n;
- } else {- Stack[curr_frame-2] = (uintptr_t)ip;
- }
- nargs = n;
- function_t *fn = (function_t*)ptr(func);
- curr_fname = fn->name == LAMBDA ? "lambda" : symbol_name(fn->name);
- goto apply_cl_top;
- }
- else {- i = uintval(func);
- if (isbuiltin(func)) {- s = builtins[i].nargs;
- if (s >= 0)
- argcount(n, s);
- else if (s != ANYARGS && (signed)n < -s)
- argcount(n, -s);
- // remove function arg
- for(s=SP-n-1; s < (int)SP-1; s++)
- Stack[s] = Stack[s+1];
- SP--;
- curr_fname = builtins[i].name;
- switch (i) {- case OP_LIST: goto apply_list;
- case OP_VECTOR: goto apply_vector;
- case OP_APPLY: goto apply_apply;
- case OP_ADD: goto apply_add;
- case OP_SUB: goto apply_sub;
- case OP_MUL: goto apply_mul;
- case OP_DIV: goto apply_div;
- default:
- op = i;
- continue;
- }
- }
- }
- }
- else if (iscbuiltin(func)) {- s = SP;
- curr_fname = cvalue_name(func);
- v = ((builtin_t)(((void**)ptr(func))[3]))(&Stack[SP-n], n);
- SP = s-n;
- Stack[SP-1] = v;
- NEXT_OP;
- }
- type_error("function", func);+ OP(OP_POP)
+ POPN(1);
+ NEXT_OP;
- OP(OP_LOADGL)
- v = fn_vals(Stack[bp-1]);
- v = vector_elt(v, GET_INT32(ip)); ip+=4;
- if (0) {- OP(OP_LOADG)
- v = fn_vals(Stack[bp-1]);
- assert(*ip < vector_size(v));
- v = vector_elt(v, *ip);
- ip++;
- }
- assert(issymbol(v));
- sym = (symbol_t*)ptr(v);
- if (sym->binding == UNBOUND)
- unbound_error(v);
- PUSH(sym->binding);
- NEXT_OP;
+ OP(OP_TCALLL)
+ tail = 1;
+ if(0){+ OP(OP_CALLL)
+ tail = 0;
+ }
+ n = GET_INT32(ip);
+ ip += 4;
+ if(0){+ OP(OP_TCALL)
+ tail = 1;
+ if(0){+ OP(OP_CALL)
+ tail = 0;
+ }
+ n = *ip++; // nargs
+ }
+ do_call:
+ func = Stack[SP-n-1];
+ if(tag(func) == TAG_FUNCTION){+ if(func > (N_BUILTINS<<3)){+ if(tail){+ curr_frame = Stack[curr_frame-4];
+ for(s = -1; s < (fixnum_t)n; s++)
+ Stack[bp+s] = Stack[SP-n+s];
+ SP = bp+n;
+ }else{+ Stack[curr_frame-2] = (uintptr_t)ip;
+ }
+ nargs = n;
+ function_t *fn = (function_t*)ptr(func);
+ curr_fname = fn->name == LAMBDA ? "lambda" : symbol_name(fn->name);
+ goto apply_cl_top;
+ }else{+ i = uintval(func);
+ if(isbuiltin(func)){+ s = builtins[i].nargs;
+ if(s >= 0)
+ argcount(n, s);
+ else if(s != ANYARGS && (signed)n < -s)
+ argcount(n, -s);
+ // remove function arg
+ for(s = SP-n-1; s < (int)SP-1; s++)
+ Stack[s] = Stack[s+1];
+ SP--;
+ curr_fname = builtins[i].name;
+ switch(i){+ case OP_LIST: goto apply_list;
+ case OP_VECTOR: goto apply_vector;
+ case OP_APPLY: goto apply_apply;
+ case OP_ADD: goto apply_add;
+ case OP_SUB: goto apply_sub;
+ case OP_MUL: goto apply_mul;
+ case OP_DIV: goto apply_div;
+ default:
+ op = i;
+ continue;
+ }
+ }
+ }
+ }else if(iscbuiltin(func)){+ s = SP;
+ curr_fname = cvalue_name(func);
+ v = ((builtin_t)(((void**)ptr(func))[3]))(&Stack[SP-n], n);
+ SP = s-n;
+ Stack[SP-1] = v;
+ NEXT_OP;
+ }
+ type_error("function", func);- OP(OP_LOADA)
- assert(nargs > 0);
- i = *ip++;
- if (captured) {- e = Stack[bp];
- assert(isvector(e));
- assert(i < vector_size(e));
- v = vector_elt(e, i);
- }
- else {- v = Stack[bp+i];
- }
- PUSH(v);
- NEXT_OP;
+ OP(OP_LOADGL)
+ v = fn_vals(Stack[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ if(0){+ OP(OP_LOADG)
+ v = fn_vals(Stack[bp-1]);
+ assert(*ip < vector_size(v));
+ v = vector_elt(v, *ip);
+ ip++;
+ }
+ assert(issymbol(v));
+ sym = (symbol_t*)ptr(v);
+ if(sym->binding == UNBOUND)
+ unbound_error(v);
+ PUSH(sym->binding);
+ NEXT_OP;
- OP(OP_LOADC)
- s = *ip++;
- i = *ip++;
- v = Stack[bp+nargs];
- while (s--)
- v = vector_elt(v, vector_size(v)-1);
- assert(isvector(v));
- assert(i < vector_size(v));
- PUSH(vector_elt(v, i));
- NEXT_OP;
+ OP(OP_LOADA)
+ assert(nargs > 0);
+ i = *ip++;
+ if(captured){+ e = Stack[bp];
+ assert(isvector(e));
+ assert(i < vector_size(e));
+ v = vector_elt(e, i);
+ }else{+ v = Stack[bp+i];
+ }
+ PUSH(v);
+ NEXT_OP;
- OP(OP_RET)
- v = POP();
- SP = curr_frame;
- curr_frame = Stack[SP-4];
- if (curr_frame == top_frame)
- return v;
- SP -= (5+nargs);
- captured = Stack[curr_frame-1];
- ip = (uint8_t*)Stack[curr_frame-2];
- nargs = Stack[curr_frame-3];
- bp = curr_frame - 5 - nargs;
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_LOADC)
+ s = *ip++;
+ i = *ip++;
+ v = Stack[bp+nargs];
+ while(s--)
+ v = vector_elt(v, vector_size(v)-1);
+ assert(isvector(v));
+ assert(i < vector_size(v));
+ PUSH(vector_elt(v, i));
+ NEXT_OP;
- OP(OP_DUP)
- SP++;
- Stack[SP-1] = Stack[SP-2];
- NEXT_OP;
+ OP(OP_RET)
+ v = POP();
+ SP = curr_frame;
+ curr_frame = Stack[SP-4];
+ if(curr_frame == top_frame)
+ return v;
+ SP -= 5+nargs;
+ captured = Stack[curr_frame-1];
+ ip = (uint8_t*)Stack[curr_frame-2];
+ nargs = Stack[curr_frame-3];
+ bp = curr_frame - 5 - nargs;
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_CAR)
- v = Stack[SP-1];
- if (!iscons(v))
- type_error("cons", v);- Stack[SP-1] = car_(v);
- NEXT_OP;
+ OP(OP_DUP)
+ SP++;
+ Stack[SP-1] = Stack[SP-2];
+ NEXT_OP;
- OP(OP_CDR)
- v = Stack[SP-1];
- if (!iscons(v))
- type_error("cons", v);- Stack[SP-1] = cdr_(v);
- NEXT_OP;
+ OP(OP_CAR)
+ v = Stack[SP-1];
+ if(!iscons(v))
+ type_error("cons", v);+ Stack[SP-1] = car_(v);
+ NEXT_OP;
- OP(OP_CLOSURE)
- // build a closure (lambda args body . env)
- if (nargs > 0 && !captured) {- // save temporary environment to the heap
- n = nargs;
- pv = alloc_words(n + 2);
- PUSH(tagptr(pv, TAG_VECTOR));
- pv[0] = fixnum(n+1);
- pv++;
- do {- pv[n] = Stack[bp+n];
- } while (n--);
- // environment representation changed; install
- // the new representation so everybody can see it
- captured = 1;
- Stack[curr_frame-1] = 1;
- Stack[bp] = Stack[SP-1];
- }
- else {- PUSH(Stack[bp]); // env has already been captured; share
- }
- if (curheap > lim-2)
- gc(0);
- pv = (value_t*)curheap;
- curheap += (4*sizeof(value_t));
- e = Stack[SP-2]; // closure to copy
- assert(isfunction(e));
- pv[0] = ((value_t*)ptr(e))[0];
- pv[1] = ((value_t*)ptr(e))[1];
- pv[2] = Stack[SP-1]; // env
- pv[3] = ((value_t*)ptr(e))[3];
- POPN(1);
- Stack[SP-1] = tagptr(pv, TAG_FUNCTION);
- NEXT_OP;
+ OP(OP_CDR)
+ v = Stack[SP-1];
+ if(!iscons(v))
+ type_error("cons", v);+ Stack[SP-1] = cdr_(v);
+ NEXT_OP;
- OP(OP_SETA)
- assert(nargs > 0);
- v = Stack[SP-1];
- i = *ip++;
- if (captured) {- e = Stack[bp];
- assert(isvector(e));
- assert(i < vector_size(e));
- vector_elt(e, i) = v;
- }
- else {- Stack[bp+i] = v;
- }
- NEXT_OP;
+ OP(OP_CLOSURE)
+ // build a closure (lambda args body . env)
+ if(nargs > 0 && !captured){+ // save temporary environment to the heap
+ n = nargs;
+ pv = alloc_words(n + 2);
+ PUSH(tagptr(pv, TAG_VECTOR));
+ pv[0] = fixnum(n+1);
+ pv++;
+ do{+ pv[n] = Stack[bp+n];
+ }while(n--);
+ // environment representation changed; install
+ // the new representation so everybody can see it
+ captured = 1;
+ Stack[curr_frame-1] = 1;
+ Stack[bp] = Stack[SP-1];
+ }else{+ PUSH(Stack[bp]); // env has already been captured; share
+ }
+ if(curheap > lim-2)
+ gc(0);
+ pv = (value_t*)curheap;
+ curheap += (4*sizeof(value_t));
+ e = Stack[SP-2]; // closure to copy
+ assert(isfunction(e));
+ pv[0] = ((value_t*)ptr(e))[0];
+ pv[1] = ((value_t*)ptr(e))[1];
+ pv[2] = Stack[SP-1]; // env
+ pv[3] = ((value_t*)ptr(e))[3];
+ POPN(1);
+ Stack[SP-1] = tagptr(pv, TAG_FUNCTION);
+ NEXT_OP;
- OP(OP_JMP)
- ip += GET_INT16(ip);
- NEXT_OP;
+ OP(OP_SETA)
+ assert(nargs > 0);
+ v = Stack[SP-1];
+ i = *ip++;
+ if(captured){+ e = Stack[bp];
+ assert(isvector(e));
+ assert(i < vector_size(e));
+ vector_elt(e, i) = v;
+ }else{+ Stack[bp+i] = v;
+ }
+ NEXT_OP;
- OP(OP_LOADC00)
- PUSH(vector_elt(Stack[bp+nargs], 0));
- NEXT_OP;
+ OP(OP_JMP)
+ ip += GET_INT16(ip);
+ NEXT_OP;
- OP(OP_PAIRP)
- Stack[SP-1] = iscons(Stack[SP-1]) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_LOADC00)
+ PUSH(vector_elt(Stack[bp+nargs], 0));
+ NEXT_OP;
- OP(OP_BRNE)
- ip += Stack[SP-2] != Stack[SP-1] ? GET_INT16(ip) : 2;
- POPN(2);
- NEXT_OP;
+ OP(OP_PAIRP)
+ Stack[SP-1] = iscons(Stack[SP-1]) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_LOADT)
- PUSH(FL_T);
- NEXT_OP;
+ OP(OP_BRNE)
+ ip += Stack[SP-2] != Stack[SP-1] ? GET_INT16(ip) : 2;
+ POPN(2);
+ NEXT_OP;
- OP(OP_LOAD0)
- PUSH(fixnum(0));
- NEXT_OP;
+ OP(OP_LOADT)
+ PUSH(FL_T);
+ NEXT_OP;
- OP(OP_LOADC01)
- PUSH(vector_elt(Stack[bp+nargs], 1));
- NEXT_OP;
+ OP(OP_LOAD0)
+ PUSH(fixnum(0));
+ NEXT_OP;
- OP(OP_AREF)
- v = Stack[SP-2];
- if (isvector(v)) {- e = Stack[SP-1];
- i = isfixnum(e) ? numval(e) : (uint32_t)toulong(e);
- if ((unsigned)i >= vector_size(v))
- bounds_error(v, e);
- v = vector_elt(v, i);
- }
- else if (isarray(v)) {- v = cvalue_array_aref(&Stack[SP-2]);
- }
- else {- type_error("sequence", v);- }
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_LOADC01)
+ PUSH(vector_elt(Stack[bp+nargs], 1));
+ NEXT_OP;
- OP(OP_ATOMP)
- Stack[SP-1] = iscons(Stack[SP-1]) ? FL_F : FL_T;
- NEXT_OP;
+ OP(OP_AREF)
+ v = Stack[SP-2];
+ if(isvector(v)){+ e = Stack[SP-1];
+ i = isfixnum(e) ? numval(e) : (uint32_t)toulong(e);
+ if((unsigned)i >= vector_size(v))
+ bounds_error(v, e);
+ v = vector_elt(v, i);
+ }else if(isarray(v)){+ v = cvalue_array_aref(&Stack[SP-2]);
+ }else{+ type_error("sequence", v);+ }
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_BRT)
- v = POP();
- ip += v != FL_F ? GET_INT16(ip) : 2;
- NEXT_OP;
+ OP(OP_ATOMP)
+ Stack[SP-1] = iscons(Stack[SP-1]) ? FL_F : FL_T;
+ NEXT_OP;
- OP(OP_BRNN)
- v = POP();
- ip += v != NIL ? GET_INT16(ip) : 2;
- NEXT_OP;
+ OP(OP_BRT)
+ ip += POP() != FL_F ? GET_INT16(ip) : 2;
+ NEXT_OP;
- OP(OP_LOAD1)
- PUSH(fixnum(1));
- NEXT_OP;
+ OP(OP_BRNN)
+ ip += POP() != NIL ? GET_INT16(ip) : 2;
+ NEXT_OP;
- OP(OP_LT)
- if (bothfixnums(Stack[SP-2], Stack[SP-1]))
- v = numval(Stack[SP-2]) < numval(Stack[SP-1]) ? FL_T : FL_F;
- else
- v = numval(fl_compare(Stack[SP-2], Stack[SP-1])) < 0 ? FL_T : FL_F;
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_LOAD1)
+ PUSH(fixnum(1));
+ NEXT_OP;
- OP(OP_ADD2)
- if (bothfixnums(Stack[SP-1], Stack[SP-2])) {- s = numval(Stack[SP-1]) + numval(Stack[SP-2]);
- v = fits_fixnum(s) ? fixnum(s) : mk_xlong(s);
- }
- else {- v = fl_add_any(&Stack[SP-2], 2, 0);
- }
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_LT)
+ if(bothfixnums(Stack[SP-2], Stack[SP-1]))
+ v = numval(Stack[SP-2]) < numval(Stack[SP-1]) ? FL_T : FL_F;
+ else
+ v = numval(fl_compare(Stack[SP-2], Stack[SP-1])) < 0 ? FL_T : FL_F;
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_SETCDR)
- cdr(Stack[SP-2]) = Stack[SP-1];
- POPN(1);
- NEXT_OP;
+ OP(OP_ADD2)
+ if(bothfixnums(Stack[SP-1], Stack[SP-2])){+ s = numval(Stack[SP-1]) + numval(Stack[SP-2]);
+ v = fits_fixnum(s) ? fixnum(s) : mk_xlong(s);
+ }else{+ v = fl_add_any(&Stack[SP-2], 2, 0);
+ }
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_LOADF)
- PUSH(FL_F);
- NEXT_OP;
+ OP(OP_SETCDR)
+ cdr(Stack[SP-2]) = Stack[SP-1];
+ POPN(1);
+ NEXT_OP;
- OP(OP_CONS)
- if (curheap > lim)
- gc(0);
- c = (cons_t*)curheap;
- curheap += sizeof(cons_t);
- c->car = Stack[SP-2];
- c->cdr = Stack[SP-1];
- Stack[SP-2] = tagptr(c, TAG_CONS);
- POPN(1); NEXT_OP;
+ OP(OP_LOADF)
+ PUSH(FL_F);
+ NEXT_OP;
- OP(OP_EQ)
- Stack[SP-2] = Stack[SP-2] == Stack[SP-1] ? FL_T : FL_F;
- POPN(1);
- NEXT_OP;
+ OP(OP_CONS)
+ if(curheap > lim)
+ gc(0);
+ c = (cons_t*)curheap;
+ curheap += sizeof(cons_t);
+ c->car = Stack[SP-2];
+ c->cdr = Stack[SP-1];
+ Stack[SP-2] = tagptr(c, TAG_CONS);
+ POPN(1); NEXT_OP;
- OP(OP_SYMBOLP)
- Stack[SP-1] = issymbol(Stack[SP-1]) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_EQ)
+ Stack[SP-2] = Stack[SP-2] == Stack[SP-1] ? FL_T : FL_F;
+ POPN(1);
+ NEXT_OP;
- OP(OP_NOT)
- Stack[SP-1] = Stack[SP-1]==FL_F ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_SYMBOLP)
+ Stack[SP-1] = issymbol(Stack[SP-1]) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_CADR)
- v = Stack[SP-1];
- if (!iscons(v))
- type_error("cons", v);- v = cdr_(v);
- if (!iscons(v))
- type_error("cons", v);- Stack[SP-1] = car_(v);
- NEXT_OP;
+ OP(OP_NOT)
+ Stack[SP-1] = Stack[SP-1] == FL_F ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_NEG)
- do_neg:
- Stack[SP-1] = fl_neg(Stack[SP-1]);
- NEXT_OP;
+ OP(OP_CADR)
+ v = Stack[SP-1];
+ if(!iscons(v))
+ type_error("cons", v);+ v = cdr_(v);
+ if(!iscons(v))
+ type_error("cons", v);+ Stack[SP-1] = car_(v);
+ NEXT_OP;
- OP(OP_NULLP)
- Stack[SP-1] = Stack[SP-1]==NIL ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_NEG)
+ do_neg:
+ Stack[SP-1] = fl_neg(Stack[SP-1]);
+ NEXT_OP;
- OP(OP_BOOLEANP)
- v = Stack[SP-1];
- Stack[SP-1] = (v == FL_T || v == FL_F) ? FL_T:FL_F;
- NEXT_OP;
+ OP(OP_NULLP)
+ Stack[SP-1] = Stack[SP-1] == NIL ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_NUMBERP)
- v = Stack[SP-1];
- Stack[SP-1] = fl_isnumber(v) ? FL_T:FL_F;
- NEXT_OP;
+ OP(OP_BOOLEANP)
+ v = Stack[SP-1];
+ Stack[SP-1] = (v == FL_T || v == FL_F) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_FIXNUMP)
- Stack[SP-1] = isfixnum(Stack[SP-1]) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_NUMBERP)
+ v = Stack[SP-1];
+ Stack[SP-1] = fl_isnumber(v) ? FL_T:FL_F;
+ NEXT_OP;
- OP(OP_BOUNDP)
- sym = tosymbol(Stack[SP-1]);
- Stack[SP-1] = sym->binding == UNBOUND ? FL_F : FL_T;
- NEXT_OP;
+ OP(OP_FIXNUMP)
+ Stack[SP-1] = isfixnum(Stack[SP-1]) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_BUILTINP)
- v = Stack[SP-1];
- Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_BOUNDP)
+ sym = tosymbol(Stack[SP-1]);
+ Stack[SP-1] = sym->binding == UNBOUND ? FL_F : FL_T;
+ NEXT_OP;
- OP(OP_FUNCTIONP)
- v = Stack[SP-1];
- Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&
- (isbuiltin(v) || v>(N_BUILTINS<<3))) ||
- iscbuiltin(v)) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_BUILTINP)
+ v = Stack[SP-1];
+ Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_VECTORP)
- Stack[SP-1] = isvector(Stack[SP-1]) ? FL_T : FL_F;
- NEXT_OP;
+ OP(OP_FUNCTIONP)
+ v = Stack[SP-1];
+ Stack[SP-1] = ((tag(v) == TAG_FUNCTION &&
+ (isbuiltin(v) || v>(N_BUILTINS<<3))) ||
+ iscbuiltin(v)) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_JMPL)
- ip += GET_INT32(ip);
- NEXT_OP;
+ OP(OP_VECTORP)
+ Stack[SP-1] = isvector(Stack[SP-1]) ? FL_T : FL_F;
+ NEXT_OP;
- OP(OP_BRFL)
- ip += POP() == FL_F ? GET_INT32(ip) : 4;
- NEXT_OP;
+ OP(OP_JMPL)
+ ip += GET_INT32(ip);
+ NEXT_OP;
- OP(OP_BRTL)
- ip += POP() != FL_F ? GET_INT32(ip) : 4;
- NEXT_OP;
+ OP(OP_BRFL)
+ ip += POP() == FL_F ? GET_INT32(ip) : 4;
+ NEXT_OP;
- OP(OP_BRNEL)
- ip += Stack[SP-2] != Stack[SP-1] ? GET_INT32(ip) : 4;
- POPN(2);
- NEXT_OP;
+ OP(OP_BRTL)
+ ip += POP() != FL_F ? GET_INT32(ip) : 4;
+ NEXT_OP;
- OP(OP_BRNNL)
- ip += POP() != NIL ? GET_INT32(ip) : 4;
- NEXT_OP;
+ OP(OP_BRNEL)
+ ip += Stack[SP-2] != Stack[SP-1] ? GET_INT32(ip) : 4;
+ POPN(2);
+ NEXT_OP;
- OP(OP_BRN)
- ip += POP() == NIL ? GET_INT16(ip) : 2;
- NEXT_OP;
+ OP(OP_BRNNL)
+ ip += POP() != NIL ? GET_INT32(ip) : 4;
+ NEXT_OP;
- OP(OP_BRNL)
- ip += POP() == NIL ? GET_INT32(ip) : 4;
- NEXT_OP;
+ OP(OP_BRN)
+ ip += POP() == NIL ? GET_INT16(ip) : 2;
+ NEXT_OP;
- OP(OP_EQV)
- if (Stack[SP-2] == Stack[SP-1])
- v = FL_T;
- else if (!leafp(Stack[SP-2]) || !leafp(Stack[SP-1]))
- v = FL_F;
- else
- v = (compare_(Stack[SP-2], Stack[SP-1], 1)==0 ? FL_T : FL_F);
- Stack[SP-2] = v;
- POPN(1);
- NEXT_OP;
+ OP(OP_BRNL)
+ ip += POP() == NIL ? GET_INT32(ip) : 4;
+ NEXT_OP;
- OP(OP_EQUAL)
- if (Stack[SP-2] == Stack[SP-1])
- v = FL_T;
- else
- v = (compare_(Stack[SP-2], Stack[SP-1], 1)==0 ? FL_T : FL_F);
- Stack[SP-2] = v;
- POPN(1);
- NEXT_OP;
+ OP(OP_EQV)
+ if(Stack[SP-2] == Stack[SP-1])
+ v = FL_T;
+ else if(!leafp(Stack[SP-2]) || !leafp(Stack[SP-1]))
+ v = FL_F;
+ else
+ v = compare_(Stack[SP-2], Stack[SP-1], 1) == 0 ? FL_T : FL_F;
+ Stack[SP-2] = v;
+ POPN(1);
+ NEXT_OP;
- OP(OP_SETCAR)
- car(Stack[SP-2]) = Stack[SP-1];
- POPN(1);
- NEXT_OP;
+ OP(OP_EQUAL)
+ if(Stack[SP-2] == Stack[SP-1])
+ v = FL_T;
+ else
+ v = compare_(Stack[SP-2], Stack[SP-1], 1) == 0 ? FL_T : FL_F;
+ Stack[SP-2] = v;
+ POPN(1);
+ NEXT_OP;
- OP(OP_LIST)
- n = *ip++;
- apply_list:
- if (n > 0) {- v = list(&Stack[SP-n], n, 0);
- POPN(n);
- PUSH(v);
- }
- else {- PUSH(NIL);
- }
- NEXT_OP;
+ OP(OP_SETCAR)
+ car(Stack[SP-2]) = Stack[SP-1];
+ POPN(1);
+ NEXT_OP;
- OP(OP_TAPPLY)
- tail = 1;
- if (0) {- OP(OP_APPLY)
- tail = 0;
- }
- n = *ip++;
- apply_apply:
- v = POP(); // arglist
- n = SP-(n-2); // n-2 == # leading arguments not in the list
- while (iscons(v)) {- if (SP >= N_STACK)
- grow_stack();
- PUSH(car_(v));
- v = cdr_(v);
- }
- n = SP-n;
- goto do_call;
+ OP(OP_LIST)
+ n = *ip++;
+ apply_list:
+ if(n > 0){+ v = list(&Stack[SP-n], n, 0);
+ POPN(n);
+ PUSH(v);
+ }else{+ PUSH(NIL);
+ }
+ NEXT_OP;
- OP(OP_ADD)
- n = *ip++;
- apply_add:
- s = 0;
- i = SP-n;
- for (; i < SP; i++) {- if (isfixnum(Stack[i])) {- s += numval(Stack[i]);
- if (!fits_fixnum(s)) {- i++;
- goto add_ovf;
- }
- }
- else {- add_ovf:
- v = fl_add_any(&Stack[i], SP-i, s);
- break;
- }
- }
- if (i==SP)
- v = fixnum(s);
- POPN(n);
- PUSH(v);
- NEXT_OP;
+ OP(OP_TAPPLY)
+ tail = 1;
+ if(0){+ OP(OP_APPLY)
+ tail = 0;
+ }
+ n = *ip++;
+ apply_apply:
+ v = POP(); // arglist
+ n = SP-(n-2); // n-2 == # leading arguments not in the list
+ while(iscons(v)){+ if(SP >= N_STACK)
+ grow_stack();
+ PUSH(car_(v));
+ v = cdr_(v);
+ }
+ n = SP-n;
+ goto do_call;
- OP(OP_SUB)
- n = *ip++;
- apply_sub:
- if (n == 2)
- goto do_sub2;
- if (n == 1)
- goto do_neg;
- i = SP-n;
- // we need to pass the full arglist on to fl_add_any
- // so it can handle rest args properly
- PUSH(Stack[i]);
- Stack[i] = fixnum(0);
- Stack[i+1] = fl_neg(fl_add_any(&Stack[i], n, 0));
- Stack[i] = POP();
- v = fl_add_any(&Stack[i], 2, 0);
- POPN(n);
- PUSH(v);
- NEXT_OP;
+ OP(OP_ADD)
+ n = *ip++;
+ apply_add:
+ s = 0;
+ i = SP-n;
+ for(; i < SP; i++){+ if(isfixnum(Stack[i])){+ s += numval(Stack[i]);
+ if(!fits_fixnum(s)){+ i++;
+ goto add_ovf;
+ }
+ }else{+ add_ovf:
+ v = fl_add_any(&Stack[i], SP-i, s);
+ break;
+ }
+ }
+ if(i == SP)
+ v = fixnum(s);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
- OP(OP_SUB2)
- do_sub2:
- if (bothfixnums(Stack[SP-2], Stack[SP-1])) {- s = numval(Stack[SP-2]) - numval(Stack[SP-1]);
- v = fits_fixnum(s) ? fixnum(s) : mk_xlong(s);
- }
- else {- Stack[SP-1] = fl_neg(Stack[SP-1]);
- v = fl_add_any(&Stack[SP-2], 2, 0);
- }
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_SUB)
+ n = *ip++;
+ apply_sub:
+ if(n == 2)
+ goto do_sub2;
+ if(n == 1)
+ goto do_neg;
+ i = SP-n;
+ // we need to pass the full arglist on to fl_add_any
+ // so it can handle rest args properly
+ PUSH(Stack[i]);
+ Stack[i] = fixnum(0);
+ Stack[i+1] = fl_neg(fl_add_any(&Stack[i], n, 0));
+ Stack[i] = POP();
+ v = fl_add_any(&Stack[i], 2, 0);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
- OP(OP_MUL)
- n = *ip++;
- apply_mul:
- accum = 1;
- i = SP-n;
- for (; i < SP; i++) {- if (isfixnum(Stack[i])) {- accum *= numval(Stack[i]);
- }
- else {- v = fl_mul_any(&Stack[i], SP-i, accum);
- break;
- }
- }
- if (i == SP)
- v = fits_fixnum(accum) ? fixnum(accum) : return_from_int64(accum);
- POPN(n);
- PUSH(v);
- NEXT_OP;
+ OP(OP_SUB2)
+ do_sub2:
+ if(bothfixnums(Stack[SP-2], Stack[SP-1])){+ s = numval(Stack[SP-2]) - numval(Stack[SP-1]);
+ v = fits_fixnum(s) ? fixnum(s) : mk_xlong(s);
+ }else{+ Stack[SP-1] = fl_neg(Stack[SP-1]);
+ v = fl_add_any(&Stack[SP-2], 2, 0);
+ }
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_DIV)
- n = *ip++;
- apply_div:
- i = SP-n;
- if (n == 1) {- Stack[SP-1] = fl_div2(fixnum(1), Stack[i]);
- }
- else {- if (n > 2) {- PUSH(Stack[i]);
- Stack[i] = fixnum(1);
- Stack[i+1] = fl_mul_any(&Stack[i], n, 1);
- Stack[i] = POP();
- }
- v = fl_div2(Stack[i], Stack[i+1]);
- POPN(n);
- PUSH(v);
- }
- NEXT_OP;
+ OP(OP_MUL)
+ n = *ip++;
+ apply_mul:
+ accum = 1;
+ for(i = SP-n; i < SP; i++){+ if(isfixnum(Stack[i])){+ accum *= numval(Stack[i]);
+ }else{+ v = fl_mul_any(&Stack[i], SP-i, accum);
+ break;
+ }
+ }
+ if(i == SP)
+ v = fits_fixnum(accum) ? fixnum(accum) : return_from_int64(accum);
+ POPN(n);
+ PUSH(v);
+ NEXT_OP;
- OP(OP_IDIV)
- v = Stack[SP-2]; e = Stack[SP-1];
- if (bothfixnums(v, e)) {- if (e==0) DivideByZeroError();
- v = fixnum(numval(v) / numval(e));
- }
- else
- v = fl_idiv2(v, e);
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_DIV)
+ n = *ip++;
+ apply_div:
+ i = SP-n;
+ if(n == 1){+ Stack[SP-1] = fl_div2(fixnum(1), Stack[i]);
+ }else{+ if(n > 2){+ PUSH(Stack[i]);
+ Stack[i] = fixnum(1);
+ Stack[i+1] = fl_mul_any(&Stack[i], n, 1);
+ Stack[i] = POP();
+ }
+ v = fl_div2(Stack[i], Stack[i+1]);
+ POPN(n);
+ PUSH(v);
+ }
+ NEXT_OP;
- OP(OP_NUMEQ)
- v = Stack[SP-2]; e = Stack[SP-1];
- if (bothfixnums(v, e))
- v = v == e ? FL_T : FL_F;
- else
- v = !numeric_compare(v,e,1,0,1) ? FL_T : FL_F;
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_IDIV)
+ v = Stack[SP-2]; e = Stack[SP-1];
+ if(bothfixnums(v, e)){+ if(e == 0)
+ DivideByZeroError();
+ v = fixnum(numval(v) / numval(e));
+ }else
+ v = fl_idiv2(v, e);
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_COMPARE)
- Stack[SP-2] = compare_(Stack[SP-2], Stack[SP-1], 0);
- POPN(1);
- NEXT_OP;
+ OP(OP_NUMEQ)
+ v = Stack[SP-2]; e = Stack[SP-1];
+ if(bothfixnums(v, e))
+ v = v == e ? FL_T : FL_F;
+ else
+ v = !numeric_compare(v,e,1,0,1) ? FL_T : FL_F;
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_ARGC)
- n = *ip++;
- if (0) {- OP(OP_LARGC)
- n = GET_INT32(ip);
- ip += 4;
- }
- if (nargs != n)
- lerrorf(ArgError, "too %s arguments", nargs > n ? "many" : "few");
- NEXT_OP;
+ OP(OP_COMPARE)
+ Stack[SP-2] = compare_(Stack[SP-2], Stack[SP-1], 0);
+ POPN(1);
+ NEXT_OP;
- OP(OP_VECTOR)
- n = *ip++;
- apply_vector:
- v = alloc_vector(n, 0);
- if (n) {- memmove(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t));
- POPN(n);
- }
- PUSH(v);
- NEXT_OP;
+ OP(OP_ARGC)
+ n = *ip++;
+ if(0){+ OP(OP_LARGC)
+ n = GET_INT32(ip);
+ ip += 4;
+ }
+ if(nargs != n)
+ lerrorf(ArgError, "too %s arguments", nargs > n ? "many" : "few");
+ NEXT_OP;
- OP(OP_ASET)
- e = Stack[SP-3];
- if (isvector(e)) {- i = tofixnum(Stack[SP-2]);
- if ((unsigned)i >= vector_size(e))
- bounds_error(v, Stack[SP-1]);
- vector_elt(e, i) = (v=Stack[SP-1]);
- }
- else if (isarray(e)) {- v = cvalue_array_aset(&Stack[SP-3]);
- }
- else {- type_error("sequence", e);- }
- POPN(2);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_VECTOR)
+ n = *ip++;
+ apply_vector:
+ v = alloc_vector(n, 0);
+ if(n){+ memmove(&vector_elt(v,0), &Stack[SP-n], n*sizeof(value_t));
+ POPN(n);
+ }
+ PUSH(v);
+ NEXT_OP;
- OP(OP_FOR)
- s = tofixnum(Stack[SP-3]);
- hi = tofixnum(Stack[SP-2]);
- //f = Stack[SP-1];
- v = FL_UNSPECIFIED;
- SP += 2;
- n = SP;
- for(; s <= hi; s++) {- Stack[SP-2] = Stack[SP-3];
- Stack[SP-1] = fixnum(s);
- v = apply_cl(1);
- SP = n;
- }
- POPN(4);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_ASET)
+ e = Stack[SP-3];
+ if(isvector(e)){+ i = tofixnum(Stack[SP-2]);
+ if((unsigned)i >= vector_size(e))
+ bounds_error(v, Stack[SP-1]);
+ vector_elt(e, i) = (v = Stack[SP-1]);
+ }else if(isarray(e)){+ v = cvalue_array_aset(&Stack[SP-3]);
+ }else{+ type_error("sequence", e);+ }
+ POPN(2);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_LOADNIL)
- PUSH(NIL);
- NEXT_OP;
+ OP(OP_FOR)
+ s = tofixnum(Stack[SP-3]);
+ hi = tofixnum(Stack[SP-2]);
+ //f = Stack[SP-1];
+ v = FL_UNSPECIFIED;
+ SP += 2;
+ n = SP;
+ for(; s <= hi; s++){+ Stack[SP-2] = Stack[SP-3];
+ Stack[SP-1] = fixnum(s);
+ v = apply_cl(1);
+ SP = n;
+ }
+ POPN(4);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_LOADI8)
- s = (int8_t)*ip++;
- PUSH(fixnum(s));
- NEXT_OP;
+ OP(OP_LOADNIL)
+ PUSH(NIL);
+ NEXT_OP;
- OP(OP_LOADVL)
- v = fn_vals(Stack[bp-1]);
- v = vector_elt(v, GET_INT32(ip));
- ip += 4;
- PUSH(v);
- NEXT_OP;
+ OP(OP_LOADI8)
+ s = (int8_t)*ip++;
+ PUSH(fixnum(s));
+ NEXT_OP;
- OP(OP_SETGL)
- v = fn_vals(Stack[bp-1]);
- v = vector_elt(v, GET_INT32(ip));
- ip += 4;
- if (0) {- OP(OP_SETG)
- v = fn_vals(Stack[bp-1]);
- assert(*ip < vector_size(v));
- v = vector_elt(v, *ip);
- ip++;
- }
- assert(issymbol(v));
- sym = (symbol_t*)ptr(v);
- v = Stack[SP-1];
- if (!isconstant(sym))
- sym->binding = v;
- NEXT_OP;
+ OP(OP_LOADVL)
+ v = fn_vals(Stack[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ PUSH(v);
+ NEXT_OP;
- OP(OP_LOADAL)
- assert(nargs > 0);
- i = GET_INT32(ip);
- ip += 4;
- v = captured ? vector_elt(Stack[bp], i) : Stack[bp+i];
- PUSH(v);
- NEXT_OP;
+ OP(OP_SETGL)
+ v = fn_vals(Stack[bp-1]);
+ v = vector_elt(v, GET_INT32(ip));
+ ip += 4;
+ if(0){+ OP(OP_SETG)
+ v = fn_vals(Stack[bp-1]);
+ assert(*ip < vector_size(v));
+ v = vector_elt(v, *ip);
+ ip++;
+ }
+ assert(issymbol(v));
+ sym = (symbol_t*)ptr(v);
+ v = Stack[SP-1];
+ if(!isconstant(sym))
+ sym->binding = v;
+ NEXT_OP;
- OP(OP_SETAL)
- assert(nargs > 0);
- v = Stack[SP-1];
- i = GET_INT32(ip); ip+=4;
- if (captured)
- vector_elt(Stack[bp], i) = v;
- else
- Stack[bp+i] = v;
- NEXT_OP;
+ OP(OP_LOADAL)
+ assert(nargs > 0);
+ i = GET_INT32(ip);
+ ip += 4;
+ v = captured ? vector_elt(Stack[bp], i) : Stack[bp+i];
+ PUSH(v);
+ NEXT_OP;
- OP(OP_SETC)
- s = *ip++;
- i = *ip++;
- v = Stack[bp+nargs];
- while (s--)
- v = vector_elt(v, vector_size(v)-1);
- assert(isvector(v));
- assert(i < vector_size(v));
- vector_elt(v, i) = Stack[SP-1];
- NEXT_OP;
+ OP(OP_SETAL)
+ assert(nargs > 0);
+ v = Stack[SP-1];
+ i = GET_INT32(ip);
+ ip += 4;
+ if(captured)
+ vector_elt(Stack[bp], i) = v;
+ else
+ Stack[bp+i] = v;
+ NEXT_OP;
- OP(OP_LOADCL)
- s = GET_INT32(ip); ip+=4;
- i = GET_INT32(ip); ip+=4;
- v = Stack[bp+nargs];
- while (s--)
- v = vector_elt(v, vector_size(v)-1);
- PUSH(vector_elt(v, i));
- NEXT_OP;
+ OP(OP_SETC)
+ s = *ip++;
+ i = *ip++;
+ v = Stack[bp+nargs];
+ while(s--)
+ v = vector_elt(v, vector_size(v)-1);
+ assert(isvector(v));
+ assert(i < vector_size(v));
+ vector_elt(v, i) = Stack[SP-1];
+ NEXT_OP;
- OP(OP_SETCL)
- s = GET_INT32(ip);
- ip += 4;
- i = GET_INT32(ip);
- ip += 4;
- v = Stack[bp+nargs];
- while (s--)
- v = vector_elt(v, vector_size(v)-1);
- assert(i < vector_size(v));
- vector_elt(v, i) = Stack[SP-1];
- NEXT_OP;
+ OP(OP_LOADCL)
+ s = GET_INT32(ip);
+ ip += 4;
+ i = GET_INT32(ip);
+ ip += 4;
+ v = Stack[bp+nargs];
+ while(s--)
+ v = vector_elt(v, vector_size(v)-1);
+ PUSH(vector_elt(v, i));
+ NEXT_OP;
- OP(OP_VARGC)
- i = *ip++;
- if (0) {- OP(OP_LVARGC)
- i = GET_INT32(ip);
- ip += 4;
- }
- s = (fixnum_t)nargs - (fixnum_t)i;
- if (s > 0) {- v = list(&Stack[bp+i], s, 0);
- Stack[bp+i] = v;
- if (s > 1) {- Stack[bp+i+1] = Stack[bp+nargs+0];
- Stack[bp+i+2] = Stack[bp+nargs+1];
- Stack[bp+i+3] = i+1;
- //Stack[bp+i+4] = 0;
- Stack[bp+i+5] = 0;
- SP = bp+i+6;
- curr_frame = SP;
- }
- }
- else if (s < 0) {- lerrorf(ArgError, "too few arguments");
- }
- else {- PUSH(0);
- Stack[SP-3] = i+1;
- Stack[SP-4] = Stack[SP-5];
- Stack[SP-5] = Stack[SP-6];
- Stack[SP-6] = NIL;
- curr_frame = SP;
- }
- nargs = i+1;
- NEXT_OP;
+ OP(OP_SETCL)
+ s = GET_INT32(ip);
+ ip += 4;
+ i = GET_INT32(ip);
+ ip += 4;
+ v = Stack[bp+nargs];
+ while(s--)
+ v = vector_elt(v, vector_size(v)-1);
+ assert(i < vector_size(v));
+ vector_elt(v, i) = Stack[SP-1];
+ NEXT_OP;
- OP(OP_TRYCATCH)
- v = do_trycatch();
- POPN(1);
- Stack[SP-1] = v;
- NEXT_OP;
+ OP(OP_VARGC)
+ i = *ip++;
+ if(0){+ OP(OP_LVARGC)
+ i = GET_INT32(ip);
+ ip += 4;
+ }
+ s = (fixnum_t)nargs - (fixnum_t)i;
+ if(s > 0){+ v = list(&Stack[bp+i], s, 0);
+ Stack[bp+i] = v;
+ if(s > 1){+ Stack[bp+i+1] = Stack[bp+nargs+0];
+ Stack[bp+i+2] = Stack[bp+nargs+1];
+ Stack[bp+i+3] = i+1;
+ //Stack[bp+i+4] = 0;
+ Stack[bp+i+5] = 0;
+ SP = bp+i+6;
+ curr_frame = SP;
+ }
+ }else if(s < 0){+ lerrorf(ArgError, "too few arguments");
+ }else{+ PUSH(0);
+ Stack[SP-3] = i+1;
+ Stack[SP-4] = Stack[SP-5];
+ Stack[SP-5] = Stack[SP-6];
+ Stack[SP-6] = NIL;
+ curr_frame = SP;
+ }
+ nargs = i+1;
+ NEXT_OP;
- OP(OP_OPTARGS)
- i = GET_INT32(ip); ip+=4;
- n = GET_INT32(ip); ip+=4;
- if (nargs < i)
- lerrorf(ArgError, "too few arguments");
- if ((int32_t)n > 0) {- if (nargs > n)
- lerrorf(ArgError, "too many arguments");
- }
- else n = -n;
- if (n > nargs) {- n -= nargs;
- SP += n;
- Stack[SP-1] = Stack[SP-n-1];
- Stack[SP-2] = Stack[SP-n-2];
- Stack[SP-3] = nargs+n;
- Stack[SP-4] = Stack[SP-n-4];
- Stack[SP-5] = Stack[SP-n-5];
- curr_frame = SP;
- for(i=0; i < n; i++) {- Stack[bp+nargs+i] = UNBOUND;
- }
- nargs += n;
- }
- NEXT_OP;
+ OP(OP_TRYCATCH)
+ v = do_trycatch();
+ POPN(1);
+ Stack[SP-1] = v;
+ NEXT_OP;
- OP(OP_BRBOUND)
- i = GET_INT32(ip); ip+=4;
- v = captured ? vector_elt(Stack[bp], i) : Stack[bp+i];
- PUSH(v != UNBOUND ? FL_T : FL_F);
- NEXT_OP;
+ OP(OP_OPTARGS)
+ i = GET_INT32(ip);
+ ip += 4;
+ n = GET_INT32(ip);
+ ip += 4;
+ if(nargs < i)
+ lerrorf(ArgError, "too few arguments");
+ if((int32_t)n > 0){+ if(nargs > n)
+ lerrorf(ArgError, "too many arguments");
+ }else
+ n = -n;
+ if(n > nargs){+ n -= nargs;
+ SP += n;
+ Stack[SP-1] = Stack[SP-n-1];
+ Stack[SP-2] = Stack[SP-n-2];
+ Stack[SP-3] = nargs+n;
+ Stack[SP-4] = Stack[SP-n-4];
+ Stack[SP-5] = Stack[SP-n-5];
+ curr_frame = SP;
+ for(i = 0; i < n; i++)
+ Stack[bp+nargs+i] = UNBOUND;
+ nargs += n;
+ }
+ NEXT_OP;
- OP(OP_KEYARGS)
- v = fn_vals(Stack[bp-1]);
- v = vector_elt(v, 0);
- i = GET_INT32(ip); ip+=4;
- n = GET_INT32(ip); ip+=4;
- s = GET_INT32(ip); ip+=4;
- nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0);
- NEXT_OP;
- }
- op = *ip++;
- }
+ OP(OP_BRBOUND)
+ i = GET_INT32(ip);
+ ip += 4;
+ v = captured ? vector_elt(Stack[bp], i) : Stack[bp+i];
+ PUSH(v != UNBOUND ? FL_T : FL_F);
+ NEXT_OP;
+
+ OP(OP_KEYARGS)
+ v = fn_vals(Stack[bp-1]);
+ v = vector_elt(v, 0);
+ i = GET_INT32(ip);
+ ip += 4;
+ n = GET_INT32(ip);
+ ip += 4;
+ s = GET_INT32(ip);
+ ip += 4;
+ nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0);
+ NEXT_OP;
+ }
+ op = *ip++;
+ }
}
#define SWAP_INT32(a)
@@ -1807,34 +1825,34 @@
#endif
// top = top frame pointer to start at
-static value_t _stacktrace(uint32_t top)
+static value_t
+_stacktrace(uint32_t top)
{- uint32_t bp, sz;
- value_t v, lst = NIL;
- fl_gc_handle(&lst);
- while (top > 0) {- sz = Stack[top-3]+1;
- bp = top-5-sz;
- v = alloc_vector(sz, 0);
- if (Stack[top-1] /*captured*/) {- vector_elt(v, 0) = Stack[bp];
- memmove(&vector_elt(v, 1),
- &vector_elt(Stack[bp+1],0), (sz-1)*sizeof(value_t));
- }
- else {- uint32_t i;
- for(i=0; i < sz; i++) {- value_t si = Stack[bp+i];
- // if there's an error evaluating argument defaults some slots
- // might be left set to UNBOUND (issue #22)
- vector_elt(v,i) = (si == UNBOUND ? FL_UNSPECIFIED : si);
- }
- }
- lst = fl_cons(v, lst);
- top = Stack[top-4];
- }
- fl_free_gc_handles(1);
- return lst;
+ uint32_t bp, sz;
+ value_t v, lst = NIL;
+ fl_gc_handle(&lst);
+ while(top > 0){+ sz = Stack[top-3]+1;
+ bp = top-5-sz;
+ v = alloc_vector(sz, 0);
+ if(Stack[top-1] /*captured*/){+ vector_elt(v, 0) = Stack[bp];
+ memmove(&vector_elt(v, 1),
+ &vector_elt(Stack[bp+1],0), (sz-1)*sizeof(value_t));
+ }else{+ uint32_t i;
+ for(i = 0; i < sz; i++){+ value_t si = Stack[bp+i];
+ // if there's an error evaluating argument defaults some slots
+ // might be left set to UNBOUND (issue #22)
+ vector_elt(v,i) = si == UNBOUND ? FL_UNSPECIFIED : si;
+ }
+ }
+ lst = fl_cons(v, lst);
+ top = Stack[top-4];
+ }
+ fl_free_gc_handles(1);
+ return lst;
}
// builtins -------------------------------------------------------------------
@@ -1841,209 +1859,217 @@
BUILTIN("gc", gc) {- USED(args);
- argcount(nargs, 0);
- gc(0);
- return FL_T;
+ USED(args);
+ argcount(nargs, 0);
+ gc(0);
+ return FL_T;
}
BUILTIN("function", function) {- if (nargs == 1 && issymbol(args[0]))
- return fn_builtin_builtin(args, nargs);
- if (nargs < 2 || nargs > 4)
- argcount(nargs, 2);
- if (!fl_isstring(args[0]))
- type_error("string", args[0]);- if (!isvector(args[1]))
- type_error("vector", args[1]);- cvalue_t *arr = (cvalue_t*)ptr(args[0]);
- cv_pin(arr);
- char *data = cv_data(arr);
- uint32_t ms;
- if ((uint8_t)data[4] >= N_OPCODES) {- // read syntax, shifted 48 for compact text representation
- size_t i, sz = cv_len(arr);
- for(i=0; i < sz; i++)
- data[i] -= 48;
+ if(nargs == 1 && issymbol(args[0]))
+ return fn_builtin_builtin(args, nargs);
+ if(nargs < 2 || nargs > 4)
+ argcount(nargs, 2);
+ if(!fl_isstring(args[0]))
+ type_error("string", args[0]);+ if(!isvector(args[1]))
+ type_error("vector", args[1]);+ cvalue_t *arr = (cvalue_t*)ptr(args[0]);
+ cv_pin(arr);
+ char *data = cv_data(arr);
+ uint32_t ms;
+ if((uint8_t)data[4] >= N_OPCODES){+ // read syntax, shifted 48 for compact text representation
+ size_t i, sz = cv_len(arr);
+ for(i = 0; i < sz; i++)
+ data[i] -= 48;
#if BYTE_ORDER == BIG_ENDIAN
- ms = compute_maxstack((uint8_t*)data, cv_len(arr));
- } else {- ms = compute_maxstack_swap((uint8_t*)data, cv_len(arr));
- }
+ ms = compute_maxstack((uint8_t*)data, cv_len(arr));
+ }else{+ ms = compute_maxstack_swap((uint8_t*)data, cv_len(arr));
+ }
#else
- }
- ms = compute_maxstack((uint8_t*)data, cv_len(arr));
+ }
+ ms = compute_maxstack((uint8_t*)data, cv_len(arr));
#endif
- PUT_INT32(data, ms);
- function_t *fn = (function_t*)alloc_words(4);
- value_t fv = tagptr(fn, TAG_FUNCTION);
- fn->bcode = args[0];
- fn->vals = args[1];
- fn->env = NIL;
- fn->name = LAMBDA;
- if (nargs > 2) {- if (issymbol(args[2])) {- fn->name = args[2];
- if (nargs > 3)
- fn->env = args[3];
- }
- else {- fn->env = args[2];
- if (nargs > 3) {- if (!issymbol(args[3]))
- type_error("symbol", args[3]);- fn->name = args[3];
- }
- }
- if (isgensym(fn->name))
- lerrorf(ArgError, "name should not be a gensym");
- }
- return fv;
+ PUT_INT32(data, ms);
+ function_t *fn = alloc_words(4);
+ value_t fv = tagptr(fn, TAG_FUNCTION);
+ fn->bcode = args[0];
+ fn->vals = args[1];
+ fn->env = NIL;
+ fn->name = LAMBDA;
+ if(nargs > 2){+ if(issymbol(args[2])){+ fn->name = args[2];
+ if(nargs > 3)
+ fn->env = args[3];
+ }else{+ fn->env = args[2];
+ if(nargs > 3){+ if(!issymbol(args[3]))
+ type_error("symbol", args[3]);+ fn->name = args[3];
+ }
+ }
+ if(isgensym(fn->name))
+ lerrorf(ArgError, "name should not be a gensym");
+ }
+ return fv;
}
BUILTIN("function:code", function_code) {- argcount(nargs, 1);
- value_t v = args[0];
- if (!isclosure(v)) type_error("function", v);- return fn_bcode(v);
+ argcount(nargs, 1);
+ value_t v = args[0];
+ if(!isclosure(v))
+ type_error("function", v);+ return fn_bcode(v);
}
+
BUILTIN("function:vals", function_vals) {- argcount(nargs, 1);
- value_t v = args[0];
- if (!isclosure(v)) type_error("function", v);- return fn_vals(v);
+ argcount(nargs, 1);
+ value_t v = args[0];
+ if(!isclosure(v))
+ type_error("function", v);+ return fn_vals(v);
}
+
BUILTIN("function:env", function_env) {- argcount(nargs, 1);
- value_t v = args[0];
- if (!isclosure(v)) type_error("function", v);- return fn_env(v);
+ argcount(nargs, 1);
+ value_t v = args[0];
+ if(!isclosure(v))
+ type_error("function", v);+ return fn_env(v);
}
+
BUILTIN("function:name", function_name) {- argcount(nargs, 1);
- value_t v = args[0];
- if (!isclosure(v)) type_error("function", v);- return fn_name(v);
+ argcount(nargs, 1);
+ value_t v = args[0];
+ if(!isclosure(v))
+ type_error("function", v);+ return fn_name(v);
}
BUILTIN("copy-list", copy_list) {- argcount(nargs, 1);
- return copy_list(args[0]);
+ argcount(nargs, 1);
+ return copy_list(args[0]);
}
BUILTIN("append", append) {- value_t first=NIL, lst, lastcons=NIL;
- int i;
- if (nargs == 0)
- return NIL;
- fl_gc_handle(&first);
- fl_gc_handle(&lastcons);
- for (i = 0; i < nargs; i++) {- lst = args[i];
- if (iscons(lst)) {- lst = copy_list(lst);
- if (first == NIL)
- first = lst;
- else
- cdr_(lastcons) = lst;
- lastcons = tagptr((((cons_t*)curheap)-1), TAG_CONS);
- }
- else if (lst != NIL) {- type_error("cons", lst);- }
- }
- fl_free_gc_handles(2);
- return first;
+ value_t first = NIL, lst, lastcons = NIL;
+ int i;
+ if(nargs == 0)
+ return NIL;
+ fl_gc_handle(&first);
+ fl_gc_handle(&lastcons);
+ for(i = 0; i < nargs; i++){+ lst = args[i];
+ if(iscons(lst)){+ lst = copy_list(lst);
+ if(first == NIL)
+ first = lst;
+ else
+ cdr_(lastcons) = lst;
+ lastcons = tagptr((((cons_t*)curheap)-1), TAG_CONS);
+ }else if(lst != NIL){+ type_error("cons", lst);+ }
+ }
+ fl_free_gc_handles(2);
+ return first;
}
BUILTIN("list*", liststar) {- if (nargs == 1) return args[0];
- else if (nargs == 0) argcount(nargs, 1);
- return list(args, nargs, 1);
+ if(nargs == 1)
+ return args[0];
+ if(nargs == 0)
+ argcount(nargs, 1);
+ return list(args, nargs, 1);
}
BUILTIN("stacktrace", stacktrace) {- USED(args);
- argcount(nargs, 0);
- return _stacktrace(fl_throwing_frame ? fl_throwing_frame : curr_frame);
+ USED(args);
+ argcount(nargs, 0);
+ return _stacktrace(fl_throwing_frame ? fl_throwing_frame : curr_frame);
}
BUILTIN("map", map) {- if (nargs < 2)
- lerrorf(ArgError, "too few arguments");
- if (!iscons(args[1])) return NIL;
- value_t first, last, v;
- int64_t argSP = args-Stack;
- assert(argSP >= 0 && argSP < N_STACK);
- if (nargs == 2) {- if (SP+3 > N_STACK) grow_stack();
- PUSH(Stack[argSP]);
- PUSH(car_(Stack[argSP+1]));
- v = _applyn(1);
- PUSH(v);
- v = mk_cons();
- car_(v) = POP(); cdr_(v) = NIL;
- last = first = v;
- Stack[argSP+1] = cdr_(Stack[argSP+1]);
- fl_gc_handle(&first);
- fl_gc_handle(&last);
- while (iscons(Stack[argSP+1])) {- Stack[SP-2] = Stack[argSP];
- Stack[SP-1] = car_(Stack[argSP+1]);
- v = _applyn(1);
- PUSH(v);
- v = mk_cons();
- car_(v) = POP(); cdr_(v) = NIL;
- cdr_(last) = v;
- last = v;
- Stack[argSP+1] = cdr_(Stack[argSP+1]);
- }
- POPN(2);
- fl_free_gc_handles(2);
- }
- else {- int i;
- while (SP+nargs+1 > N_STACK) grow_stack();
- PUSH(Stack[argSP]);
- for(i=1; i < nargs; i++) {- PUSH(car(Stack[argSP+i]));
- Stack[argSP+i] = cdr_(Stack[argSP+i]);
- }
- v = _applyn(nargs-1);
- POPN(nargs);
- PUSH(v);
- v = mk_cons();
- car_(v) = POP(); cdr_(v) = NIL;
- last = first = v;
- fl_gc_handle(&first);
- fl_gc_handle(&last);
- while (iscons(Stack[argSP+1])) {- PUSH(Stack[argSP]);
- for(i=1; i < nargs; i++) {- PUSH(car(Stack[argSP+i]));
- Stack[argSP+i] = cdr_(Stack[argSP+i]);
- }
- v = _applyn(nargs-1);
- POPN(nargs);
- PUSH(v);
- v = mk_cons();
- car_(v) = POP(); cdr_(v) = NIL;
- cdr_(last) = v;
- last = v;
- }
- fl_free_gc_handles(2);
- }
- return first;
+ if(nargs < 2)
+ lerrorf(ArgError, "too few arguments");
+ if(!iscons(args[1]))
+ return NIL;
+ value_t first, last, v;
+ int64_t argSP = args-Stack;
+ assert(argSP >= 0 && argSP < N_STACK);
+ if(nargs == 2){+ if(SP+3 > N_STACK)
+ grow_stack();
+ PUSH(Stack[argSP]);
+ PUSH(car_(Stack[argSP+1]));
+ v = _applyn(1);
+ PUSH(v);
+ v = mk_cons();
+ car_(v) = POP(); cdr_(v) = NIL;
+ last = first = v;
+ Stack[argSP+1] = cdr_(Stack[argSP+1]);
+ fl_gc_handle(&first);
+ fl_gc_handle(&last);
+ while(iscons(Stack[argSP+1])){+ Stack[SP-2] = Stack[argSP];
+ Stack[SP-1] = car_(Stack[argSP+1]);
+ v = _applyn(1);
+ PUSH(v);
+ v = mk_cons();
+ car_(v) = POP(); cdr_(v) = NIL;
+ cdr_(last) = v;
+ last = v;
+ Stack[argSP+1] = cdr_(Stack[argSP+1]);
+ }
+ POPN(2);
+ fl_free_gc_handles(2);
+ }else{+ int i;
+ while(SP+nargs+1 > N_STACK) grow_stack();
+ PUSH(Stack[argSP]);
+ for(i = 1; i < nargs; i++){+ PUSH(car(Stack[argSP+i]));
+ Stack[argSP+i] = cdr_(Stack[argSP+i]);
+ }
+ v = _applyn(nargs-1);
+ POPN(nargs);
+ PUSH(v);
+ v = mk_cons();
+ car_(v) = POP(); cdr_(v) = NIL;
+ last = first = v;
+ fl_gc_handle(&first);
+ fl_gc_handle(&last);
+ while(iscons(Stack[argSP+1])){+ PUSH(Stack[argSP]);
+ for(i = 1; i < nargs; i++){+ PUSH(car(Stack[argSP+i]));
+ Stack[argSP+i] = cdr_(Stack[argSP+i]);
+ }
+ v = _applyn(nargs-1);
+ POPN(nargs);
+ PUSH(v);
+ v = mk_cons();
+ car_(v) = POP(); cdr_(v) = NIL;
+ cdr_(last) = v;
+ last = v;
+ }
+ fl_free_gc_handles(2);
+ }
+ return first;
}
#define BUILTIN_FN(l,c) extern BUILTIN(l,c);
@@ -2051,7 +2077,7 @@
#undef BUILTIN_FN
static const builtinspec_t builtin_fns[] = {-#define BUILTIN_FN(l,c) {l,fn_builtin_##c},+#define BUILTIN_FN(l,c){l,fn_builtin_##c},#include "builtin_fns.h"
#undef BUILTIN_FN
};
@@ -2058,156 +2084,183 @@
// initialization -------------------------------------------------------------
-extern void builtins_init(void);
extern void comparehash_init(void);
+extern void table_init(void);
+extern void iostream_init(void);
-static void lisp_init(size_t initial_heapsize)
+static void
+lisp_init(size_t initial_heapsize)
{- int i;
+ int i;
- llt_init();
- setlocale(LC_NUMERIC, "C");
+ llt_init();
+ setlocale(LC_NUMERIC, "C");
- heapsize = initial_heapsize;
+ heapsize = initial_heapsize;
- fromspace = LLT_ALLOC(heapsize);
- tospace = LLT_ALLOC(heapsize);
- curheap = fromspace;
- lim = curheap+heapsize-sizeof(cons_t);
- consflags = bitvector_new(heapsize/sizeof(cons_t), 1);
- htable_new(&printconses, 32);
- comparehash_init();
- N_STACK = 262144;
- Stack = malloc(N_STACK*sizeof(value_t));
+ fromspace = LLT_ALLOC(heapsize);
+ tospace = LLT_ALLOC(heapsize);
+ curheap = fromspace;
+ lim = curheap+heapsize-sizeof(cons_t);
+ consflags = bitvector_new(heapsize/sizeof(cons_t), 1);
+ htable_new(&printconses, 32);
+ comparehash_init();
+ N_STACK = 262144;
+ Stack = malloc(N_STACK*sizeof(value_t));
- FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST);
- FL_T = builtin(OP_BOOL_CONST_T);
- FL_F = builtin(OP_BOOL_CONST_F);
- FL_EOF = builtin(OP_EOF_OBJECT);
- LAMBDA = symbol("lambda"); FUNCTION = symbol("function");- QUOTE = symbol("quote"); TRYCATCH = symbol("trycatch");- BACKQUOTE = symbol("quasiquote"); COMMA = symbol("unquote");- COMMAAT = symbol("unquote-splicing"); COMMADOT = symbol("unquote-nsplicing");- IOError = symbol("io-error"); ParseError = symbol("parse-error");- TypeError = symbol("type-error"); ArgError = symbol("arg-error");- UnboundError = symbol("unbound-error");- KeyError = symbol("key-error"); MemoryError = symbol("memory-error");- BoundsError = symbol("bounds-error");- DivideError = symbol("divide-error");- EnumerationError = symbol("enumeration-error");- Error = symbol("error"); pairsym = symbol("pair");- symbolsym = symbol("symbol"); fixnumsym = symbol("fixnum");- vectorsym = symbol("vector"); builtinsym = symbol("builtin");- booleansym = symbol("boolean"); nullsym = symbol("null");- definesym = symbol("define"); defmacrosym = symbol("define-macro");- forsym = symbol("for");- setqsym = symbol("set!"); evalsym = symbol("eval");- vu8sym = symbol("vu8"); fnsym = symbol("fn");- nulsym = symbol("nul"); alarmsym = symbol("alarm");- backspacesym = symbol("backspace"); tabsym = symbol("tab");- linefeedsym = symbol("linefeed"); vtabsym = symbol("vtab");- pagesym = symbol("page"); returnsym = symbol("return");- escsym = symbol("esc"); spacesym = symbol("space");- deletesym = symbol("delete"); newlinesym = symbol("newline");- tsym = symbol("t"); Tsym = symbol("T");- fsym = symbol("f"); Fsym = symbol("F");- set(printprettysym=symbol("*print-pretty*"), FL_T);- set(printreadablysym=symbol("*print-readably*"), FL_T);- set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH));- set(printlengthsym=symbol("*print-length*"), FL_F);- set(printlevelsym=symbol("*print-level*"), FL_F);- builtins_table_sym = symbol("*builtins*");- fl_lasterror = NIL;
- for (i=0; i < nelem(builtins); i++) {- if (builtins[i].name)
- setc(symbol(builtins[i].name), builtin(i));
- }
- setc(symbol("eq"), builtin(OP_EQ));- setc(symbol("procedure?"), builtin(OP_FUNCTIONP));- setc(symbol("top-level-bound?"), builtin(OP_BOUNDP));+ FL_NIL = NIL = builtin(OP_THE_EMPTY_LIST);
+ FL_T = builtin(OP_BOOL_CONST_T);
+ FL_F = builtin(OP_BOOL_CONST_F);
+ FL_EOF = builtin(OP_EOF_OBJECT);
+ LAMBDA = symbol("lambda");+ FUNCTION = symbol("function");+ QUOTE = symbol("quote");+ TRYCATCH = symbol("trycatch");+ BACKQUOTE = symbol("quasiquote");+ COMMA = symbol("unquote");+ COMMAAT = symbol("unquote-splicing");+ COMMADOT = symbol("unquote-nsplicing");+ IOError = symbol("io-error");+ ParseError = symbol("parse-error");+ TypeError = symbol("type-error");+ ArgError = symbol("arg-error");+ UnboundError = symbol("unbound-error");+ KeyError = symbol("key-error");+ MemoryError = symbol("memory-error");+ BoundsError = symbol("bounds-error");+ DivideError = symbol("divide-error");+ EnumerationError = symbol("enumeration-error");+ Error = symbol("error");+ pairsym = symbol("pair");+ symbolsym = symbol("symbol");+ fixnumsym = symbol("fixnum");+ vectorsym = symbol("vector");+ builtinsym = symbol("builtin");+ booleansym = symbol("boolean");+ nullsym = symbol("null");+ definesym = symbol("define");+ defmacrosym = symbol("define-macro");+ forsym = symbol("for");+ setqsym = symbol("set!");+ evalsym = symbol("eval");+ vu8sym = symbol("vu8");+ fnsym = symbol("fn");+ nulsym = symbol("nul");+ alarmsym = symbol("alarm");+ backspacesym = symbol("backspace");+ tabsym = symbol("tab");+ linefeedsym = symbol("linefeed");+ vtabsym = symbol("vtab");+ pagesym = symbol("page");+ returnsym = symbol("return");+ escsym = symbol("esc");+ spacesym = symbol("space");+ deletesym = symbol("delete");+ newlinesym = symbol("newline");+ tsym = symbol("t");+ Tsym = symbol("T");+ fsym = symbol("f");+ Fsym = symbol("F");+ builtins_table_sym = symbol("*builtins*");+ set(printprettysym = symbol("*print-pretty*"), FL_T);+ set(printreadablysym = symbol("*print-readably*"), FL_T);+ set(printwidthsym = symbol("*print-width*"), fixnum(SCR_WIDTH));+ set(printlengthsym = symbol("*print-length*"), FL_F);+ set(printlevelsym = symbol("*print-level*"), FL_F);+ fl_lasterror = NIL;
+ for(i = 0; i < nelem(builtins); i++){+ if(builtins[i].name)
+ setc(symbol(builtins[i].name), builtin(i));
+ }
+ setc(symbol("eq"), builtin(OP_EQ));+ setc(symbol("procedure?"), builtin(OP_FUNCTIONP));+ setc(symbol("top-level-bound?"), builtin(OP_BOUNDP));#if defined(__linux__)
- set(symbol("*os-name*"), symbol("linux"));+ set(symbol("*os-name*"), symbol("linux"));#elif defined(__OpenBSD__)
- set(symbol("*os-name*"), symbol("openbsd"));+ set(symbol("*os-name*"), symbol("openbsd"));#elif defined(__FreeBSD__)
- set(symbol("*os-name*"), symbol("freebsd"));+ set(symbol("*os-name*"), symbol("freebsd"));#elif defined(__NetBSD__)
- set(symbol("*os-name*"), symbol("netbsd"));+ set(symbol("*os-name*"), symbol("netbsd"));#elif defined(__plan9__)
- set(symbol("*os-name*"), symbol("plan9"));+ set(symbol("*os-name*"), symbol("plan9"));#else
- set(symbol("*os-name*"), symbol("unknown"));+ set(symbol("*os-name*"), symbol("unknown"));#endif
- the_empty_vector = tagptr(alloc_words(1), TAG_VECTOR);
- vector_setsize(the_empty_vector, 0);
+ the_empty_vector = tagptr(alloc_words(1), TAG_VECTOR);
+ vector_setsize(the_empty_vector, 0);
- cvalues_init();
+ cvalues_init();
- memory_exception_value = fl_list2(MemoryError,
- cvalue_static_cstring("out of memory"));- const builtinspec_t *b;
- for(i = 0, b = builtin_fns; i < nelem(builtin_fns); i++, b++)
- setc(symbol(b->name), cbuiltin(b->name, b->fptr));
+ memory_exception_value = fl_list2(MemoryError, cvalue_static_cstring("out of memory"));+ const builtinspec_t *b;
+ for(i = 0, b = builtin_fns; i < nelem(builtin_fns); i++, b++)
+ setc(symbol(b->name), cbuiltin(b->name, b->fptr));
- builtins_init();
+ table_init();
+ iostream_init();
}
// top level ------------------------------------------------------------------
-value_t fl_toplevel_eval(value_t expr)
+value_t
+fl_toplevel_eval(value_t expr)
{- return fl_applyn(1, symbol_value(evalsym), expr);
+ return fl_applyn(1, symbol_value(evalsym), expr);
}
-void fl_init(size_t initial_heapsize)
+void
+fl_init(size_t initial_heapsize)
{#ifdef BOEHM_GC
- GC_init();
+ GC_init();
#endif
- lisp_init(initial_heapsize);
+ lisp_init(initial_heapsize);
}
-int fl_load_system_image(value_t sys_image_iostream)
+int
+fl_load_system_image(value_t sys_image_iostream)
{- value_t e;
- int saveSP;
- symbol_t *sym;
+ value_t e;
+ int saveSP;
+ symbol_t *sym;
- PUSH(sys_image_iostream);
- saveSP = SP;
- FL_TRY {- curr_fname = "bootstrap";
- while (1) {- e = fl_read_sexpr(Stack[SP-1]);
- if (ios_eof(value2c(ios_t*,Stack[SP-1]))) break;
- if (isfunction(e)) {- // stage 0 format: series of thunks
- PUSH(e);
- (void)_applyn(0);
- SP = saveSP;
- }
- else {- // stage 1 format: list alternating symbol/value
- while (iscons(e)) {- sym = tosymbol(car_(e));
- e = cdr_(e);
- (void)tocons(e);
- sym->binding = car_(e);
- e = cdr_(e);
- }
- break;
- }
- }
- }
- FL_CATCH_NO_INC {- ios_puts("fatal error during bootstrap:\n", ios_stderr);- fl_print(ios_stderr, fl_lasterror);
- ios_putc('\n', ios_stderr);- return 1;
- }
- ios_close(value2c(ios_t*,Stack[SP-1]));
- POPN(1);
- return 0;
+ PUSH(sys_image_iostream);
+ saveSP = SP;
+ FL_TRY{+ curr_fname = "bootstrap";
+ while(1){+ e = fl_read_sexpr(Stack[SP-1]);
+ if(ios_eof(value2c(ios_t*, Stack[SP-1])))
+ break;
+ if(isfunction(e)){+ // stage 0 format: series of thunks
+ PUSH(e);
+ (void)_applyn(0);
+ SP = saveSP;
+ }else{+ // stage 1 format: list alternating symbol/value
+ while(iscons(e)){+ sym = tosymbol(car_(e));
+ e = cdr_(e);
+ (void)tocons(e);
+ sym->binding = car_(e);
+ e = cdr_(e);
+ }
+ break;
+ }
+ }
+ }
+ FL_CATCH_NO_INC{+ ios_puts("fatal error during bootstrap:\n", ios_stderr);+ fl_print(ios_stderr, fl_lasterror);
+ ios_putc('\n', ios_stderr);+ return 1;
+ }
+ ios_close(value2c(ios_t*, Stack[SP-1]));
+ POPN(1);
+ return 0;
}
--- a/flisp.h
+++ b/flisp.h
@@ -3,14 +3,14 @@
/* functions needed to implement the value interface (cvtable_t) */
typedef enum {- T_INT8, T_UINT8,
- T_INT16, T_UINT16,
- T_INT32, T_UINT32,
- T_INT64, T_UINT64,
- T_MPINT,
- T_FLOAT,
- T_DOUBLE,
-} numerictype_t;
+ T_INT8, T_UINT8,
+ T_INT16, T_UINT16,
+ T_INT32, T_UINT32,
+ T_INT64, T_UINT64,
+ T_MPINT,
+ T_FLOAT,
+ T_DOUBLE,
+}numerictype_t;
#define NONNUMERIC (0xff)
#define valid_numtype(v) ((v) <= T_DOUBLE)
@@ -29,70 +29,70 @@
#endif
typedef struct {- value_t car;
- value_t cdr;
-} cons_t;
+ value_t car;
+ value_t cdr;
+}cons_t;
typedef struct _symbol_t {- value_t binding; // global value binding
- uint32_t hash;
- uint8_t numtype;
- uint8_t size;
- uint8_t align;
- uint8_t flags;
- struct _fltype_t *type;
- void *dlcache; // dlsym address
- // below fields are private
- struct _symbol_t *left;
- struct _symbol_t *right;
- union {- char name[1];
- void *_pad; // ensure field aligned to pointer size
- };
-} symbol_t;
+ value_t binding; // global value binding
+ uint32_t hash;
+ uint8_t numtype;
+ uint8_t size;
+ uint8_t align;
+ uint8_t flags;
+ struct _fltype_t *type;
+ void *dlcache; // dlsym address
+ // below fields are private
+ struct _symbol_t *left;
+ struct _symbol_t *right;
+ union {+ char name[1];
+ void *_pad; // ensure field aligned to pointer size
+ };
+}symbol_t;
typedef struct {- value_t isconst;
- value_t binding; // global value binding
- struct _fltype_t *type;
- uint32_t id;
-} gensym_t;
+ value_t isconst;
+ value_t binding; // global value binding
+ struct _fltype_t *type;
+ uint32_t id;
+}gensym_t;
enum {- TAG_NUM,
- TAG_CPRIM,
- TAG_FUNCTION,
- TAG_VECTOR,
- TAG_NUM1,
- TAG_CVALUE,
- TAG_SYM,
- TAG_CONS,
+ TAG_NUM,
+ TAG_CPRIM,
+ TAG_FUNCTION,
+ TAG_VECTOR,
+ TAG_NUM1,
+ TAG_CVALUE,
+ TAG_SYM,
+ TAG_CONS,
};
enum {- FLAG_CONST = 1<<0,
- FLAG_KEYWORD = 1<<1,
+ FLAG_CONST = 1<<0,
+ FLAG_KEYWORD = 1<<1,
};
-#define UNBOUND ((value_t)0x1) // an invalid value
-#define TAG_FWD UNBOUND
-#define tag(x) ((x)&0x7)
-#define ptr(x) ((void*)((x)&(~(value_t)0x7)))
+#define UNBOUND ((value_t)0x1) // an invalid value
+#define TAG_FWD UNBOUND
+#define tag(x) ((x) & 0x7)
+#define ptr(x) ((void*)((x) & (~(value_t)0x7)))
#define tagptr(p,t) (((value_t)(p)) | (t))
#define fixnum(x) ((value_t)((fixnum_t)(x))<<2)
#define numval(x) (((fixnum_t)(x))>>2)
#define fits_bits(x,b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0)
-#define uintval(x) (((unsigned int)(x))>>3)
+#define uintval(x) (((unsigned int)(x))>>3)
#define builtin(n) tagptr((((int)n)<<3), TAG_FUNCTION)
-#define iscons(x) (tag(x) == TAG_CONS)
-#define issymbol(x) (tag(x) == TAG_SYM)
-#define isfixnum(x) (((x)&3) == TAG_NUM)
-#define bothfixnums(x,y) ((((x)|(y))&3) == TAG_NUM)
+#define iscons(x) (tag(x) == TAG_CONS)
+#define issymbol(x) (tag(x) == TAG_SYM)
+#define isfixnum(x) (((x)&3) == TAG_NUM)
+#define bothfixnums(x,y) ((((x)|(y)) & 3) == TAG_NUM)
int isbuiltin(value_t x);
#define isvector(x) (tag(x) == TAG_VECTOR)
#define iscvalue(x) (tag(x) == TAG_CVALUE)
#define iscprim(x) (tag(x) == TAG_CPRIM)
-#define selfevaluating(x) (tag(x)<6)
+#define selfevaluating(x) (tag(x) < 6)
// comparable with ==
#define eq_comparable(a,b) (!(((a)|(b))&1))
#define eq_comparablep(a) (!((a)&1))
@@ -102,9 +102,12 @@
int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD)
-#define forwardloc(v) (((value_t*)ptr(v))[1])
-#define forward(v,to) do { (((value_t*)ptr(v))[0] = TAG_FWD); \- (((value_t*)ptr(v))[1] = to); } while (0)
+#define forwardloc(v) (((value_t*)ptr(v))[1])
+#define forward(v,to) \
+ do{ \+ (((value_t*)ptr(v))[0] = TAG_FWD); \
+ (((value_t*)ptr(v))[1] = to); \
+ }while (0)
#define vector_size(v) (((size_t*)ptr(v))[0]>>2)
#define vector_setsize(v,n) (((size_t*)ptr(v))[0] = ((n)<<2))
@@ -113,8 +116,8 @@
// functions ending in _ are unsafe, faster versions
#define car_(v) (((cons_t*)ptr(v))->car)
#define cdr_(v) (((cons_t*)ptr(v))->cdr)
-#define car(v) (tocons((v))->car)
-#define cdr(v) (tocons((v))->cdr)
+#define car(v) (tocons((v))->car)
+#define cdr(v) (tocons((v))->cdr)
#define fn_bcode(f) (((value_t*)ptr(f))[0])
#define fn_vals(f) (((value_t*)ptr(f))[1])
#define fn_env(f) (((value_t*)ptr(f))[2])
@@ -121,20 +124,22 @@
#define fn_name(f) (((value_t*)ptr(f))[3])
#define set(s, v) (((symbol_t*)ptr(s))->binding = (v))
-#define setc(s, v) do { ((symbol_t*)ptr(s))->flags |= FLAG_CONST; \- ((symbol_t*)ptr(s))->binding = (v); } while (0)
-#define isconstant(s) ((s)->flags&FLAG_CONST)
-#define iskeyword(s) ((s)->flags&FLAG_KEYWORD)
+#define setc(s, v) \
+ do{ \+ ((symbol_t*)ptr(s))->flags |= FLAG_CONST; \
+ ((symbol_t*)ptr(s))->binding = (v); \
+ }while (0)
+#define isconstant(s) ((s)->flags & FLAG_CONST)
+#define iskeyword(s) ((s)->flags & FLAG_KEYWORD)
#define symbol_value(s) (((symbol_t*)ptr(s))->binding)
#define sym_to_numtype(s) (((symbol_t*)ptr(s))->numtype)
-#define ismanaged(v) ((((uint8_t*)ptr(v)) >= fromspace) && \
- (((uint8_t*)ptr(v)) < fromspace+heapsize))
+#define ismanaged(v) ((((uint8_t*)ptr(v)) >= fromspace) && (((uint8_t*)ptr(v)) < fromspace+heapsize))
#define isgensym(x) (issymbol(x) && ismanaged(x))
value_t gensym(void);
#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3))
#define isclosure(x) isfunction(x)
-#define iscbuiltin(x) (iscvalue(x) && (cv_class((cvalue_t*)ptr(x))==builtintype))
+#define iscbuiltin(x) (iscvalue(x) && cv_class(ptr(x)) == builtintype)
void fl_gc_handle(value_t *pv);
void fl_free_gc_handles(uint32_t n);
@@ -142,8 +147,8 @@
// utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array
// assumes "nargs" is the argument count
-#define FOR_ARGS(i, i0, arg, args) \
- for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)
+#define FOR_ARGS(i, i0, arg, args) \
+ for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)
#define N_BUILTINS ((int)N_OPCODES)
@@ -170,7 +175,7 @@
value_t alloc_vector(size_t n, int init);
size_t llength(value_t v);
value_t fl_compare(value_t a, value_t b); // -1, 0, or 1
-value_t fl_equal(value_t a, value_t b); // T or nil
+value_t fl_equal(value_t a, value_t b); // T or nil
int equal_lispvalue(value_t a, value_t b);
uintptr_t hash_lispvalue(value_t a);
int isnumtok_base(char *tok, value_t *pval, int base);
@@ -183,38 +188,38 @@
/* error handling */
typedef struct _fl_readstate_t {- htable_t backrefs;
- htable_t gensyms;
- value_t source;
- struct _fl_readstate_t *prev;
-} fl_readstate_t;
+ htable_t backrefs;
+ htable_t gensyms;
+ value_t source;
+ struct _fl_readstate_t *prev;
+}fl_readstate_t;
typedef struct _ectx_t {- jmp_buf buf;
- uint32_t sp;
- uint32_t frame;
- uint32_t ngchnd;
- fl_readstate_t *rdst;
- struct _ectx_t *prev;
-} fl_exception_context_t;
+ jmp_buf buf;
+ uint32_t sp;
+ uint32_t frame;
+ uint32_t ngchnd;
+ fl_readstate_t *rdst;
+ struct _ectx_t *prev;
+}fl_exception_context_t;
extern fl_exception_context_t *fl_ctx;
extern uint32_t fl_throwing_frame;
extern value_t fl_lasterror;
-#define FL_TRY_EXTERN \
- fl_exception_context_t _ctx; int l__tr, l__ca; \
- fl_savestate(&_ctx); fl_ctx = &_ctx; \
- if (!setjmp(_ctx.buf)) \
- for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx=fl_ctx->prev))
+#define FL_TRY_EXTERN \
+ fl_exception_context_t _ctx; int l__tr, l__ca; \
+ fl_savestate(&_ctx); fl_ctx = &_ctx; \
+ if(!setjmp(_ctx.buf)) \
+ for(l__tr=1; l__tr; l__tr=0, (void)(fl_ctx = fl_ctx->prev))
#define FL_CATCH_EXTERN_NO_RESTORE \
- else \
- for(l__ca=1; l__ca;)
+ else \
+ for(l__ca=1; l__ca;)
#define FL_CATCH_EXTERN \
- else \
- for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
+ else \
+ for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
_Noreturn void lerrorf(value_t e, char *format, ...);
void fl_savestate(fl_exception_context_t *_ctx);
@@ -224,19 +229,17 @@
_Noreturn void bounds_error(value_t arr, value_t ind);
_Noreturn void unbound_error(value_t sym);
extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
-#define argcount(nargs, c) \
- do { \- if (__unlikely(nargs != c)) { \- lerrorf(ArgError, \
- "arity mismatch: wanted %d, got %d", c, nargs); \
- } \
- } while(0)
+#define argcount(nargs, c) \
+ do{ \+ if(__unlikely(nargs != c)) \
+ lerrorf(ArgError, "arity mismatch: wanted %d, got %d", c, nargs); \
+ }while(0)
typedef struct {- void (*print)(value_t self, ios_t *f);
- void (*relocate)(value_t oldv, value_t newv);
- void (*finalize)(value_t self);
- void (*print_traverse)(value_t self);
+ void (*print)(value_t self, ios_t *f);
+ void (*relocate)(value_t oldv, value_t newv);
+ void (*finalize)(value_t self);
+ void (*print_traverse)(value_t self);
} cvtable_t;
value_t relocate_lispvalue(value_t v);
@@ -248,40 +251,40 @@
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
typedef struct _fltype_t {- value_t type;
- cvtable_t *vtable;
- struct _fltype_t *eltype; // for arrays
- struct _fltype_t *artype; // (array this)
- cvinitfunc_t init;
- size_t size;
- size_t elsz;
- int marked;
- numerictype_t numtype;
-} fltype_t;
+ value_t type;
+ cvtable_t *vtable;
+ struct _fltype_t *eltype; // for arrays
+ struct _fltype_t *artype; // (array this)
+ cvinitfunc_t init;
+ size_t size;
+ size_t elsz;
+ int marked;
+ numerictype_t numtype;
+}fltype_t;
typedef struct {- fltype_t *type;
- void *data;
- size_t len; // length of *data in bytes
- union {- value_t parent; // optional
- char _space[1]; // variable size
- };
-} cvalue_t;
+ fltype_t *type;
+ void *data;
+ size_t len; // length of *data in bytes
+ union {+ value_t parent; // optional
+ char _space[1]; // variable size
+ };
+}cvalue_t;
#define CVALUE_NWORDS 4
typedef struct {- fltype_t *type;
- char _space[1];
-} cprim_t;
+ fltype_t *type;
+ char _space[1];
+}cprim_t;
typedef struct {- value_t bcode;
- value_t vals;
- value_t env;
- value_t name;
-} function_t;
+ value_t bcode;
+ value_t vals;
+ value_t env;
+ value_t name;
+}function_t;
#define CPRIM_NWORDS 2
#define MAX_INL_SIZE 384
@@ -288,31 +291,30 @@
#define CV_OWNED_BIT 0x1
#define CV_PARENT_BIT 0x2
-#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT)
-#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT)
-#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
-#define cv_class(cv) ((fltype_t*)(((uintptr_t)(cv)->type)&~3))
-#define cv_len(cv) ((cv)->len)
-#define cv_type(cv) (cv_class(cv)->type)
-#define cv_data(cv) ((cv)->data)
-#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
-#define cv_isPOD(cv) (cv_class(cv)->init != nil)
+#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT)
+#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT)
+#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
+#define cv_class(cv) ((fltype_t*)(((uintptr_t)((cvalue_t*)cv)->type)&~3))
+#define cv_len(cv) (((cvalue_t*)(cv))->len)
+#define cv_type(cv) (cv_class(cv)->type)
+#define cv_data(cv) (((cvalue_t*)(cv))->data)
+#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
+#define cv_isPOD(cv) (cv_class(cv)->init != nil)
#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
#define cvalue_len(v) cv_len((cvalue_t*)ptr(v))
#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
-#define cp_class(cp) ((cp)->type)
-#define cp_type(cp) (cp_class(cp)->type)
+#define cp_class(cp) (((cprim_t*)(cp))->type)
+#define cp_type(cp) (cp_class(cp)->type)
#define cp_numtype(cp) (cp_class(cp)->numtype)
-#define cp_data(cp) (&(cp)->_space[0])
+#define cp_data(cp) (&((cprim_t*)(cp))->_space[0])
// WARNING: multiple evaluation!
-#define cptr(v) \
- (iscprim(v) ? cp_data((cprim_t*)ptr(v)) : cv_data((cvalue_t*)ptr(v)))
+#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cv_data(ptr(v)))
#define BUILTIN(lname, cname) \
- value_t fn_builtin_##cname(value_t *args, int nargs)
+ value_t fn_builtin_##cname(value_t *args, int nargs)
typedef value_t (*builtin_t)(value_t*, int);
@@ -355,8 +357,7 @@
fltype_t *get_type(value_t t);
fltype_t *get_array_type(value_t eltype);
-fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
- cvinitfunc_t init);
+fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init);
value_t mk_double(double n);
value_t mk_float(float n);
@@ -384,9 +385,9 @@
#endif
typedef struct {- char *name;
- builtin_t fptr;
-} builtinspec_t;
+ char *name;
+ builtin_t fptr;
+}builtinspec_t;
void fl_init(size_t initial_heapsize);
int fl_load_system_image(value_t ios);
--- a/flmain.c
+++ b/flmain.c
@@ -1,58 +1,65 @@
#include "llt.h"
#include "flisp.h"
-static value_t argv_list(int argc, char *argv[])
+static value_t
+argv_list(int argc, char *argv[])
{- int i;
- value_t lst=FL_NIL, temp;
- fl_gc_handle(&lst);
- fl_gc_handle(&temp);
- for(i=argc-1; i >= 0; i--) {- temp = cvalue_static_cstring(argv[i]);
- lst = fl_cons(temp, lst);
- }
- fl_free_gc_handles(2);
- return lst;
+ int i;
+ value_t lst = FL_NIL, temp;
+ fl_gc_handle(&lst);
+ fl_gc_handle(&temp);
+ for(i = argc-1; i >= 0; i--){+ temp = cvalue_static_cstring(argv[i]);
+ lst = fl_cons(temp, lst);
+ }
+ fl_free_gc_handles(2);
+ return lst;
}
extern fltype_t *iostreamtype;
+#if defined(__plan9__)
+void
+#else
int
+#endif
main(int argc, char **argv)
{- static const char bootraw[] = {+ static const char bootraw[] = {#include "boot.h"
- };
- value_t f;
- ios_t *s;
- int r;
+ };
+ value_t f;
+ ios_t *s;
+ int r;
#if defined(__plan9__)
argv0 = argv[0];
- setfcr(FPPDBL|FPRNR|FPOVFL);
- tmfmtinstall();
+ setfcr(FPPDBL|FPRNR|FPOVFL);
+ tmfmtinstall();
#endif
- fl_init(512*1024);
+ fl_init(512*1024);
- f = cvalue(iostreamtype, sizeof(ios_t));
- s = value2c(ios_t*, f);
- ios_static_buffer(s, bootraw, sizeof(bootraw));
+ f = cvalue(iostreamtype, sizeof(ios_t));
+ s = value2c(ios_t*, f);
+ ios_static_buffer(s, bootraw, sizeof(bootraw));
- r = 1;
- FL_TRY_EXTERN {- if (fl_load_system_image(f) == 0){- fl_applyn(1, symbol_value(symbol("__start")),- argv_list(argc, argv));
- r = 0;
- }
- }
- FL_CATCH_EXTERN_NO_RESTORE {- ios_puts("fatal error:\n", ios_stderr);- fl_print(ios_stderr, fl_lasterror);
- ios_putc('\n', ios_stderr);- break;
- }
- exit(r);
- return r;
+ r = 1;
+ FL_TRY_EXTERN{+ if(fl_load_system_image(f) == 0){+ fl_applyn(1, symbol_value(symbol("__start")), argv_list(argc, argv));+ r = 0;
+ }
+ }
+ FL_CATCH_EXTERN_NO_RESTORE{+ ios_puts("fatal error:\n", ios_stderr);+ fl_print(ios_stderr, fl_lasterror);
+ ios_putc('\n', ios_stderr);+ break;
+ }
+#if defined(__plan9__)
+ exit(r);
+#else
+ return r;
+#endif
}
--- a/gen.lsp
+++ b/gen.lsp
@@ -120,7 +120,7 @@
(for-each-n
(lambda (cop lop argc f)
(begin
- (io.write c-header " ")
+ (io.write c-header "\t")
(write cop c-header)
(io.write c-header ",\n")
@@ -130,10 +130,10 @@
(set! lms (cons f lms))
(set! i (1+ i))))
opcodes 4)
- (io.write c-header " N_OPCODES\n};\n\n")
+ (io.write c-header "\tN_OPCODES\n};\n\n")
(io.write c-header "static const Builtin builtins[] = {\n")(table.foreach
- (lambda (c la) (begin (io.write c-header " [")
+ (lambda (c la) (begin (io.write c-header "\t[")
(write c c-header)
(io.write c-header "] = {\"")(write (car la) c-header)
--- a/iostream.c
+++ b/iostream.c
@@ -5,427 +5,416 @@
static value_t instrsym, outstrsym;
fltype_t *iostreamtype;
-void print_iostream(value_t v, ios_t *f)
+void
+print_iostream(value_t v, ios_t *f)
{- USED(v);
- fl_print_str("#<io stream>", f);+ USED(v);
+ fl_print_str("#<io stream>", f);}
-void free_iostream(value_t self)
+void
+free_iostream(value_t self)
{- ios_t *s = value2c(ios_t*, self);
- ios_close(s);
+ ios_t *s = value2c(ios_t*, self);
+ ios_close(s);
}
-void relocate_iostream(value_t oldv, value_t newv)
+void
+relocate_iostream(value_t oldv, value_t newv)
{- ios_t *olds = value2c(ios_t*, oldv);
- ios_t *news = value2c(ios_t*, newv);
- if (news->buf == &olds->local[0]) {- news->buf = &news->local[0];
- }
+ ios_t *olds = value2c(ios_t*, oldv);
+ ios_t *news = value2c(ios_t*, newv);
+ if(news->buf == &olds->local[0])
+ news->buf = &news->local[0];
}
-cvtable_t iostream_vtable = { print_iostream, relocate_iostream,- free_iostream, nil };
+static cvtable_t iostream_vtable = {+ print_iostream,
+ relocate_iostream,
+ free_iostream,
+ nil
+};
-int fl_isiostream(value_t v)
+int
+fl_isiostream(value_t v)
{- return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == iostreamtype;
+ return iscvalue(v) && cv_class(ptr(v)) == iostreamtype;
}
BUILTIN("iostream?", iostreamp) {- argcount(nargs, 1);
- return fl_isiostream(args[0]) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return fl_isiostream(args[0]) ? FL_T : FL_F;
}
BUILTIN("eof-object", eof_object) {- USED(args);
- argcount(nargs, 0);
- return FL_EOF;
+ USED(args);
+ argcount(nargs, 0);
+ return FL_EOF;
}
BUILTIN("eof-object?", eof_objectp) {- argcount(nargs, 1);
- return (FL_EOF == args[0]) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return args[0] == FL_EOF ? FL_T : FL_F;
}
-static ios_t *toiostream(value_t v)
+ios_t *
+fl_toiostream(value_t v)
{- if (!fl_isiostream(v))
- type_error("iostream", v);- return value2c(ios_t*, v);
+ if(!fl_isiostream(v))
+ type_error("iostream", v);+ return value2c(ios_t*, v);
}
-ios_t *fl_toiostream(value_t v)
-{- return toiostream(v);
-}
-
BUILTIN("file", file) {- if (nargs < 1)
- argcount(nargs, 1);
- int i, r=0, w=0, c=0, t=0, a=0;
- for(i=1; i < (int)nargs; i++) {- if (args[i] == wrsym) w = 1;
- else if (args[i] == apsym) { a = 1; w = 1; }- else if (args[i] == crsym) { c = 1; w = 1; }- else if (args[i] == truncsym) { t = 1; w = 1; }- else if (args[i] == rdsym) r = 1;
- }
- if ((r|w|c|t|a) == 0) r = 1; // default to reading
- value_t f = cvalue(iostreamtype, sizeof(ios_t));
- char *fname = tostring(args[0]);
- ios_t *s = value2c(ios_t*, f);
- if (ios_file(s, fname, r, w, c, t) == nil)
- lerrorf(IOError, "could not open \"%s\"", fname);
- if (a) ios_seek_end(s);
- return f;
+ if(nargs < 1)
+ argcount(nargs, 1);
+ int i, r = 0, w = 0, c = 0, t = 0, a = 0;
+ for(i = 1; i < nargs; i++){+ if(args[i] == rdsym)
+ r = 1;
+ else if(args[i] == wrsym)
+ w = 1;
+ else if(args[i] == apsym)
+ a = w = 1;
+ else if(args[i] == crsym)
+ c = w = 1;
+ else if(args[i] == truncsym)
+ t = w = 1;
+ }
+ if((r|w|c|t|a) == 0)
+ r = 1; // default to reading
+ value_t f = cvalue(iostreamtype, sizeof(ios_t));
+ char *fname = tostring(args[0]);
+ ios_t *s = value2c(ios_t*, f);
+ if(ios_file(s, fname, r, w, c, t) == nil)
+ lerrorf(IOError, "could not open \"%s\"", fname);
+ if(a)
+ ios_seek_end(s);
+ return f;
}
BUILTIN("buffer", buffer) {- argcount(nargs, 0);
- USED(args);
- value_t f = cvalue(iostreamtype, sizeof(ios_t));
- ios_t *s = value2c(ios_t*, f);
- if (ios_mem(s, 0) == nil)
- lerrorf(MemoryError, "could not allocate stream");
- return f;
+ argcount(nargs, 0);
+ USED(args);
+ value_t f = cvalue(iostreamtype, sizeof(ios_t));
+ ios_t *s = value2c(ios_t*, f);
+ if(ios_mem(s, 0) == nil)
+ lerrorf(MemoryError, "could not allocate stream");
+ return f;
}
BUILTIN("read", read) {- value_t arg = 0;
- if (nargs > 1) {- argcount(nargs, 1);
- }
- else if (nargs == 0) {- arg = symbol_value(instrsym);
- }
- else {- arg = args[0];
- }
- (void)toiostream(arg);
- fl_gc_handle(&arg);
- value_t v = fl_read_sexpr(arg);
- fl_free_gc_handles(1);
- if (ios_eof(value2c(ios_t*,arg)))
- return FL_EOF;
- return v;
+ value_t arg = 0;
+ if(nargs > 1)
+ argcount(nargs, 1);
+ else if(nargs == 0)
+ arg = symbol_value(instrsym);
+ else
+ arg = args[0];
+ ios_t *s = fl_toiostream(arg);
+ fl_gc_handle(&arg);
+ value_t v = fl_read_sexpr(arg);
+ fl_free_gc_handles(1);
+ if(ios_eof(s))
+ return FL_EOF;
+ return v;
}
BUILTIN("io.getc", io_getc) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- uint32_t wc;
- int res;
- if ((res = ios_getutf8(s, &wc)) == IOS_EOF)
- //lerrorf(IOError, "end of file reached");
- return FL_EOF;
- if (res == 0)
- lerrorf(IOError, "invalid UTF-8 sequence");
- return mk_wchar(wc);
+ argcount(nargs, 1);
+ ios_t *s = fl_toiostream(args[0]);
+ uint32_t wc;
+ int res;
+ if((res = ios_getutf8(s, &wc)) == IOS_EOF)
+ //lerrorf(IOError, "end of file reached");
+ return FL_EOF;
+ if(res == 0)
+ lerrorf(IOError, "invalid UTF-8 sequence");
+ return mk_wchar(wc);
}
BUILTIN("io.peekc", io_peekc) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- uint32_t wc;
- int res;
- if ((res = ios_peekutf8(s, &wc)) == IOS_EOF)
- return FL_EOF;
- if (res == 0)
- lerrorf(IOError, "invalid UTF-8 sequence");
- return mk_wchar(wc);
+ argcount(nargs, 1);
+ ios_t *s = fl_toiostream(args[0]);
+ uint32_t wc;
+ int res;
+ if((res = ios_peekutf8(s, &wc)) == IOS_EOF)
+ return FL_EOF;
+ if(res == 0)
+ lerrorf(IOError, "invalid UTF-8 sequence");
+ return mk_wchar(wc);
}
BUILTIN("io.putc", io_putc) {- argcount(nargs, 2);
- ios_t *s = toiostream(args[0]);
- if (!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
- type_error("wchar", args[1]);- uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
- return fixnum(ios_pututf8(s, wc));
+ argcount(nargs, 2);
+ ios_t *s = fl_toiostream(args[0]);
+ if(!iscprim(args[1]) || ((cprim_t*)ptr(args[1]))->type != wchartype)
+ type_error("wchar", args[1]);+ uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
+ return fixnum(ios_pututf8(s, wc));
}
BUILTIN("io.skip", io_skip) {- argcount(nargs, 2);
- ios_t *s = toiostream(args[0]);
- off_t off = tooffset(args[1]);
- off_t res = ios_skip(s, off);
- if (res < 0)
- return FL_F;
- return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
+ argcount(nargs, 2);
+ ios_t *s = fl_toiostream(args[0]);
+ off_t off = tooffset(args[1]);
+ off_t res = ios_skip(s, off);
+ if(res < 0)
+ return FL_F;
+ return sizeof(res) == sizeof(int64_t) ? mk_int64(res) : mk_int32(res);
}
BUILTIN("io.flush", io_flush) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- if (ios_flush(s) != 0)
- return FL_F;
- return FL_T;
+ argcount(nargs, 1);
+ return ios_flush(fl_toiostream(args[0])) == 0 ? FL_T : FL_F;
}
BUILTIN("io.close", io_close) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- ios_close(s);
- return FL_T;
+ argcount(nargs, 1);
+ ios_close(fl_toiostream(args[0]));
+ return FL_T;
}
BUILTIN("io.discardbuffer", io_discardbuffer) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- ios_purge(s);
- return FL_T;
+ argcount(nargs, 1);
+ ios_purge(fl_toiostream(args[0]));
+ return FL_T;
}
BUILTIN("io.eof?", io_eofp) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- return (ios_eof(s) ? FL_T : FL_F);
+ argcount(nargs, 1);
+ return ios_eof(fl_toiostream(args[0])) ? FL_T : FL_F;
}
BUILTIN("io.seek", io_seek) {- argcount(nargs, 2);
- ios_t *s = toiostream(args[0]);
- size_t pos = toulong(args[1]);
- off_t res = ios_seek(s, (off_t)pos);
- if (res == -1)
- return FL_F;
- return FL_T;
+ argcount(nargs, 2);
+ ios_t *s = fl_toiostream(args[0]);
+ size_t pos = toulong(args[1]);
+ off_t res = ios_seek(s, (off_t)pos);
+ if(res == -1)
+ return FL_F;
+ return FL_T;
}
BUILTIN("io.pos", io_pos) {- argcount(nargs, 1);
- ios_t *s = toiostream(args[0]);
- off_t res = ios_pos(s);
- if (res == -1)
- return FL_F;
- return size_wrap((size_t)res);
+ argcount(nargs, 1);
+ ios_t *s = fl_toiostream(args[0]);
+ off_t res = ios_pos(s);
+ if(res == -1)
+ return FL_F;
+ return size_wrap((size_t)res);
}
BUILTIN("write", write) {- if (nargs < 1 || nargs > 2)
- argcount(nargs, 1);
- ios_t *s;
- if (nargs == 2)
- s = toiostream(args[1]);
- else
- s = toiostream(symbol_value(outstrsym));
- fl_print(s, args[0]);
- return args[0];
+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 1);
+ ios_t *s;
+ s = nargs == 2 ? fl_toiostream(args[1]) : fl_toiostream(symbol_value(outstrsym));
+ fl_print(s, args[0]);
+ return args[0];
}
BUILTIN("io.read", io_read) {- if (nargs != 3)
- argcount(nargs, 2);
- (void)toiostream(args[0]);
- size_t n;
- fltype_t *ft;
- if (nargs == 3) {- // form (io.read s type count)
- ft = get_array_type(args[1]);
- n = toulong(args[2]) * ft->elsz;
- }
- else {- ft = get_type(args[1]);
- if (ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
- lerrorf(ArgError, "incomplete type");
- n = ft->size;
- }
- value_t cv = cvalue(ft, n);
- char *data;
- if (iscvalue(cv)) data = cv_data((cvalue_t*)ptr(cv));
- else data = cp_data((cprim_t*)ptr(cv));
- size_t got = ios_read(value2c(ios_t*,args[0]), data, n);
- if (got < n)
- //lerrorf(IOError, "end of input reached");
- return FL_EOF;
- return cv;
+ if(nargs != 3)
+ argcount(nargs, 2);
+ ios_t *s = fl_toiostream(args[0]);
+ size_t n;
+ fltype_t *ft;
+ if(nargs == 3){+ // form (io.read s type count)
+ ft = get_array_type(args[1]);
+ n = toulong(args[2]) * ft->elsz;
+ }else{+ ft = get_type(args[1]);
+ if(ft->eltype != nil && !iscons(cdr_(cdr_(args[1]))))
+ lerrorf(ArgError, "incomplete type");
+ n = ft->size;
+ }
+ value_t cv = cvalue(ft, n);
+ char *data;
+ if(iscvalue(cv))
+ data = cv_data(ptr(cv));
+ else data = cp_data(ptr(cv));
+ size_t got = ios_read(s, data, n);
+ if(got < n)
+ //lerrorf(IOError, "end of input reached");
+ return FL_EOF;
+ return cv;
}
// args must contain data[, offset[, count]]
-static void get_start_count_args(value_t *args, uint32_t nargs, size_t sz,
- size_t *offs, size_t *nb)
+static void
+get_start_count_args(value_t *args, uint32_t nargs, size_t sz, size_t *offs, size_t *nb)
{- if (nargs > 1) {- *offs = toulong(args[1]);
- if (nargs > 2)
- *nb = toulong(args[2]);
- else
- *nb = sz - *offs;
- if (*offs >= sz || *offs + *nb > sz)
- bounds_error(args[0], args[1]);
- }
+ if(nargs > 1){+ *offs = toulong(args[1]);
+ *nb = nargs > 2 ? toulong(args[2]) : sz - *offs;
+ if(*offs >= sz || *offs + *nb > sz)
+ bounds_error(args[0], args[1]);
+ }
}
BUILTIN("io.write", io_write) {- if (nargs < 2 || nargs > 4)
- argcount(nargs, 2);
- ios_t *s = toiostream(args[0]);
- if (iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype) {- if (nargs > 2)
- lerrorf(ArgError,
- "io.write: offset argument not supported for characters");
- uint32_t wc = *(uint32_t*)cp_data((cprim_t*)ptr(args[1]));
- return fixnum(ios_pututf8(s, wc));
- }
- char *data;
- size_t sz, offs=0;
- to_sized_ptr(args[1], &data, &sz);
- size_t nb = sz;
- if (nargs > 2) {- get_start_count_args(&args[1], nargs-1, sz, &offs, &nb);
- data += offs;
- }
- return size_wrap(ios_write(s, data, nb));
+ if(nargs < 2 || nargs > 4)
+ argcount(nargs, 2);
+ ios_t *s = fl_toiostream(args[0]);
+ if(iscprim(args[1]) && ((cprim_t*)ptr(args[1]))->type == wchartype){+ if(nargs > 2)
+ lerrorf(ArgError, "offset argument not supported for characters");
+ uint32_t wc = *(uint32_t*)cp_data(ptr(args[1]));
+ return fixnum(ios_pututf8(s, wc));
+ }
+ char *data;
+ size_t sz, offs = 0;
+ to_sized_ptr(args[1], &data, &sz);
+ size_t nb = sz;
+ if(nargs > 2){+ get_start_count_args(&args[1], nargs-1, sz, &offs, &nb);
+ data += offs;
+ }
+ return size_wrap(ios_write(s, data, nb));
}
BUILTIN("dump", dump) {- if (nargs < 1 || nargs > 3)
- argcount(nargs, 1);
- ios_t *s = toiostream(symbol_value(outstrsym));
- char *data;
- size_t sz, offs=0;
- to_sized_ptr(args[0], &data, &sz);
- size_t nb = sz;
- if (nargs > 1) {- get_start_count_args(args, nargs, sz, &offs, &nb);
- data += offs;
- }
- hexdump(s, data, nb, offs);
- return FL_T;
+ if(nargs < 1 || nargs > 3)
+ argcount(nargs, 1);
+ ios_t *s = fl_toiostream(symbol_value(outstrsym));
+ char *data;
+ size_t sz, offs = 0;
+ to_sized_ptr(args[0], &data, &sz);
+ size_t nb = sz;
+ if(nargs > 1){+ get_start_count_args(args, nargs, sz, &offs, &nb);
+ data += offs;
+ }
+ hexdump(s, data, nb, offs);
+ return FL_T;
}
-static char get_delim_arg(value_t arg)
+static char
+get_delim_arg(value_t arg)
{- size_t uldelim = toulong(arg);
- if (uldelim > 0x7f) {- // wchars > 0x7f, or anything else > 0xff, are out of range
- if ((iscprim(arg) && cp_class((cprim_t*)ptr(arg))==wchartype) ||
- uldelim > 0xff)
- lerrorf(ArgError, "delimiter out of range");
- }
- return (char)uldelim;
+ size_t uldelim = toulong(arg);
+ if(uldelim > 0x7f){+ // wchars > 0x7f, or anything else > 0xff, are out of range
+ if((iscprim(arg) && cp_class(ptr(arg)) == wchartype) || uldelim > 0xff)
+ lerrorf(ArgError, "delimiter out of range");
+ }
+ return (char)uldelim;
}
BUILTIN("io.readuntil", io_readuntil) {- argcount(nargs, 2);
- value_t str = cvalue_string(80);
- cvalue_t *cv = (cvalue_t*)ptr(str);
- char *data = cv_data(cv);
- ios_t dest;
- ios_mem(&dest, 0);
- ios_setbuf(&dest, data, 80, 0);
- char delim = get_delim_arg(args[1]);
- ios_t *src = toiostream(args[0]);
- size_t n = ios_copyuntil(&dest, src, delim);
- cv->len = n;
- if (dest.buf != data) {- // outgrew initial space
- size_t sz;
- cv->data = ios_takebuf(&dest, &sz);
+ argcount(nargs, 2);
+ value_t str = cvalue_string(80);
+ cvalue_t *cv = ptr(str);
+ char *data = cv_data(cv);
+ ios_t dest;
+ ios_mem(&dest, 0);
+ ios_setbuf(&dest, data, 80, 0);
+ char delim = get_delim_arg(args[1]);
+ ios_t *src = fl_toiostream(args[0]);
+ size_t n = ios_copyuntil(&dest, src, delim);
+ cv->len = n;
+ if(dest.buf != data){+ // outgrew initial space
+ size_t sz;
+ cv->data = ios_takebuf(&dest, &sz);
#ifndef BOEHM_GC
- cv_autorelease(cv);
+ cv_autorelease(cv);
#endif
- } else {- ((char*)cv->data)[n] = '\0';
- }
- if (n == 0 && ios_eof(src))
- return FL_EOF;
- return str;
+ }else{+ ((char*)cv->data)[n] = '\0';
+ }
+ if(n == 0 && ios_eof(src))
+ return FL_EOF;
+ return str;
}
BUILTIN("io.copyuntil", io_copyuntil) {- argcount(nargs, 3);
- ios_t *dest = toiostream(args[0]);
- ios_t *src = toiostream(args[1]);
- char delim = get_delim_arg(args[2]);
- return size_wrap(ios_copyuntil(dest, src, delim));
+ argcount(nargs, 3);
+ ios_t *dest = fl_toiostream(args[0]);
+ ios_t *src = fl_toiostream(args[1]);
+ char delim = get_delim_arg(args[2]);
+ return size_wrap(ios_copyuntil(dest, src, delim));
}
BUILTIN("io.copy", io_copy) {- if (nargs < 2 || nargs > 3)
- argcount(nargs, 2);
- ios_t *dest = toiostream(args[0]);
- ios_t *src = toiostream(args[1]);
- if (nargs == 3) {- size_t n = toulong(args[2]);
- return size_wrap(ios_copy(dest, src, n));
- }
- return size_wrap(ios_copyall(dest, src));
+ if(nargs < 2 || nargs > 3)
+ argcount(nargs, 2);
+ ios_t *dest = fl_toiostream(args[0]);
+ ios_t *src = fl_toiostream(args[1]);
+ if(nargs == 3)
+ return size_wrap(ios_copy(dest, src, toulong(args[2])));
+ return size_wrap(ios_copyall(dest, src));
}
-value_t stream_to_string(value_t *ps)
+value_t
+stream_to_string(value_t *ps)
{- value_t str;
- size_t n;
- ios_t *st = value2c(ios_t*,*ps);
- if (st->buf == &st->local[0]) {- n = st->size;
- str = cvalue_string(n);
- memmove(cvalue_data(str), value2c(ios_t*,*ps)->buf, n);
- ios_trunc(value2c(ios_t*,*ps), 0);
- }
- else {- char *b = ios_takebuf(st, &n); n--;
- b[n] = '\0';
- str = cvalue_from_ref(stringtype, b, n, FL_NIL);
+ value_t str;
+ size_t n;
+ ios_t *st = value2c(ios_t*, *ps);
+ if(st->buf == &st->local[0]){+ n = st->size;
+ str = cvalue_string(n);
+ memmove(cvalue_data(str), st->buf, n);
+ ios_trunc(st, 0);
+ }else{+ char *b = ios_takebuf(st, &n); n--;
+ b[n] = '\0';
+ str = cvalue_from_ref(stringtype, b, n, FL_NIL);
#ifndef BOEHM_GC
- cv_autorelease((cvalue_t*)ptr(str));
+ cv_autorelease(ptr(str));
#endif
- }
- return str;
+ }
+ return str;
}
BUILTIN("io.tostring!", io_tostring) {- argcount(nargs, 1);
- ios_t *src = toiostream(args[0]);
- if (src->bm != bm_mem)
- lerrorf(ArgError, "requires memory stream");
- return stream_to_string(&args[0]);
+ argcount(nargs, 1);
+ ios_t *src = fl_toiostream(args[0]);
+ if(src->bm != bm_mem)
+ lerrorf(ArgError, "requires memory stream");
+ return stream_to_string(&args[0]);
}
-void iostream_init(void)
+void
+iostream_init(void)
{- iostreamsym = symbol("iostream");- rdsym = symbol(":read");- wrsym = symbol(":write");- apsym = symbol(":append");- crsym = symbol(":create");- truncsym = symbol(":truncate");- instrsym = symbol("*input-stream*");- outstrsym = symbol("*output-stream*");- iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t),
- &iostream_vtable, nil);
- setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout,- sizeof(ios_t), FL_NIL));
- setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr,- sizeof(ios_t), FL_NIL));
- setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin,- sizeof(ios_t), FL_NIL));
+ iostreamsym = symbol("iostream");+ rdsym = symbol(":read");+ wrsym = symbol(":write");+ apsym = symbol(":append");+ crsym = symbol(":create");+ truncsym = symbol(":truncate");+ instrsym = symbol("*input-stream*");+ outstrsym = symbol("*output-stream*");+ iostreamtype = define_opaque_type(iostreamsym, sizeof(ios_t), &iostream_vtable, nil);
+ setc(symbol("*stdout*"), cvalue_from_ref(iostreamtype, ios_stdout, sizeof(ios_t), FL_NIL));+ setc(symbol("*stderr*"), cvalue_from_ref(iostreamtype, ios_stderr, sizeof(ios_t), FL_NIL));+ setc(symbol("*stdin*" ), cvalue_from_ref(iostreamtype, ios_stdin, sizeof(ios_t), FL_NIL));}
--- a/llt/bitvector-ops.c
+++ b/llt/bitvector-ops.c
@@ -2,34 +2,37 @@
#define ONES32 ((uint32_t)0xffffffffUL)
-static inline uint32_t count_bits(uint32_t b)
-{- b = b - ((b>>1)&0x55555555);
- b = ((b>>2)&0x33333333) + (b&0x33333333);
- b = ((b>>4)+b)&0x0f0f0f0f;
- b += (b>>8);
- b += (b>>16);
- return b & 0x3f;
-}
// greater than this # of words we use malloc instead of alloca
#define MALLOC_CUTOFF 2000
-uint32_t bitreverse(uint32_t x)
+static inline
+uint32_t count_bits(uint32_t b)
{- uint32_t m;
+ b = b - ((b>>1)&0x55555555);
+ b = ((b>>2)&0x33333333) + (b&0x33333333);
+ b = ((b>>4)+b)&0x0f0f0f0f;
+ b += (b>>8);
+ b += (b>>16);
+ return b & 0x3f;
+}
+uint32_t
+bitreverse(uint32_t x)
+{+ uint32_t m;
+
#ifdef __INTEL_COMPILER
- x = _bswap(x);
+ x = _bswap(x);
#else
- x = (x >> 16) | (x << 16); m = 0xff00ff00;
- x = ((x & m) >> 8) | ((x & ~m) << 8);
+ x = (x >> 16) | (x << 16); m = 0xff00ff00;
+ x = ((x & m) >> 8) | ((x & ~m) << 8);
#endif
- m = 0xf0f0f0f0;
- x = ((x & m) >> 4) | ((x & ~m) << 4); m = 0xcccccccc;
- x = ((x & m) >> 2) | ((x & ~m) << 2); m = 0xaaaaaaaa;
- x = ((x & m) >> 1) | ((x & ~m) << 1);
+ m = 0xf0f0f0f0;
+ x = ((x & m) >> 4) | ((x & ~m) << 4); m = 0xcccccccc;
+ x = ((x & m) >> 2) | ((x & ~m) << 2); m = 0xaaaaaaaa;
+ x = ((x & m) >> 1) | ((x & ~m) << 1);
- return x;
+ return x;
}
// shift all bits in a long bit vector
@@ -36,21 +39,22 @@
// n is # of int32s to consider, s is shift distance
// lowest bit-index is bit 0 of word 0
// TODO: handle boundary case of shift distance >= data size?
-void bitvector_shr(uint32_t *b, size_t n, uint32_t s)
+void
+bitvector_shr(uint32_t *b, size_t n, uint32_t s)
{- uint32_t i;
- if (s == 0 || n == 0) return;
- i = (s>>5);
- if (i) {- n -= i;
- memmove(b, &b[i], n*4);
- memset(&b[n], 0, i*4);
- s &= 31;
- }
- for(i=0; i < n-1; i++) {- b[i] = (b[i]>>s) | (b[i+1]<<(32-s));
- }
- b[i]>>=s;
+ uint32_t i;
+ if(s == 0 || n == 0)
+ return;
+ i = s >> 5;
+ if(i){+ n -= i;
+ memmove(b, &b[i], n*4);
+ memset(&b[n], 0, i*4);
+ s &= 31;
+ }
+ for(i = 0; i < n-1; i++)
+ b[i] = (b[i] >> s) | (b[i+1] << (32-s));
+ b[i] >>= s;
}
// out-of-place version, good for re-aligning a strided submatrix to
@@ -57,222 +61,234 @@
// linear representation when a copy is needed
// assumes that dest has the same amount of space as source, even if it
// wouldn't have been necessary to hold the shifted bits
-void bitvector_shr_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s)
+void
+bitvector_shr_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s)
{- uint32_t i, j;
- if (n == 0) return;
- if (s == 0) {- memmove(dest, b, n*4);
- return;
- }
- j = (s>>5);
- if (j) {- n -= j;
- memset(&dest[n], 0, j*4);
- s &= 31;
- b = &b[j];
- }
- for(i=0; i < n-1; i++) {- dest[i] = (b[i]>>s) | (b[i+1]<<(32-s));
- }
- dest[i] = b[i]>>s;
+ uint32_t i, j;
+ if(n == 0)
+ return;
+ if(s == 0){+ memmove(dest, b, n*4);
+ return;
+ }
+ j = s >> 5;
+ if(j){+ n -= j;
+ memset(&dest[n], 0, j*4);
+ s &= 31;
+ b = &b[j];
+ }
+ for(i = 0; i < n-1; i++)
+ dest[i] = (b[i] >> s) | (b[i+1] << (32-s));
+ dest[i] = b[i]>>s;
}
-void bitvector_shl(uint32_t *b, size_t n, uint32_t s)
+void
+bitvector_shl(uint32_t *b, size_t n, uint32_t s)
{- uint32_t i, scrap=0, temp;
- if (s == 0 || n == 0) return;
- i = (s>>5);
- if (i) {- n -= i;
- memmove(&b[i], b, n*4);
- memset(b, 0, i*4);
- s &= 31;
- b = &b[i];
- }
- for(i=0; i < n; i++) {- temp = (b[i]<<s) | scrap;
- scrap = b[i]>>(32-s);
- b[i] = temp;
- }
+ uint32_t i, scrap = 0, temp;
+ if(s == 0 || n == 0)
+ return;
+ i = s >> 5;
+ if(i){+ n -= i;
+ memmove(&b[i], b, n*4);
+ memset(b, 0, i*4);
+ s &= 31;
+ b = &b[i];
+ }
+ for(i = 0; i < n; i++){+ temp = (b[i] << s) | scrap;
+ scrap = b[i] >> (32-s);
+ b[i] = temp;
+ }
}
// if dest has more space than source, set scrap to true to keep the
// top bits that would otherwise be shifted out
-void bitvector_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s,
- int scrap)
+void
+bitvector_shl_to(uint32_t *dest, uint32_t *b, size_t n, uint32_t s, int scrap)
{- uint32_t i, j, sc=0;
- if (n == 0) return;
- if (s == 0) {- memmove(dest, b, n*4);
- return;
- }
- j = (s>>5);
- if (j) {- n -= j;
- memset(dest, 0, j*4);
- s &= 31;
- dest = &dest[j];
- }
- for(i=0; i < n; i++) {- dest[i] = (b[i]<<s) | sc;
- sc = b[i]>>(32-s);
- }
- if (scrap)
- dest[i] = sc;
+ uint32_t i, j, sc = 0;
+ if(n == 0)
+ return;
+ if(s == 0){+ memmove(dest, b, n*4);
+ return;
+ }
+ j = s >> 5;
+ if(j){+ n -= j;
+ memset(dest, 0, j*4);
+ s &= 31;
+ dest = &dest[j];
+ }
+ for(i = 0; i < n; i++){+ dest[i] = (b[i] << s) | sc;
+ sc = b[i] >> (32-s);
+ }
+ if(scrap)
+ dest[i] = sc;
}
// set nbits to c, starting at given bit offset
// assumes offs < 32
-void bitvector_fill(uint32_t *b, uint32_t offs, uint32_t c, uint32_t nbits)
+void
+bitvector_fill(uint32_t *b, uint32_t offs, uint32_t c, uint32_t nbits)
{- uint32_t i, nw, tail, mask;
+ uint32_t i, nw, tail, mask;
- if (nbits == 0) return;
- nw = (offs+nbits+31)>>5;
+ if(nbits == 0)
+ return;
+ nw = (offs+nbits+31)>>5;
- if (nw == 1) {- mask = (lomask(nbits)<<offs);
- if (c) b[0]|=mask; else b[0]&=(~mask);
- return;
- }
+ if(nw == 1){+ mask = (lomask(nbits)<<offs);
+ if(c)
+ b[0] |= mask;
+ else
+ b[0] &= ~mask;
+ return;
+ }
- mask = lomask(offs);
- if (c) b[0]|=(~mask); else b[0]&=mask;
+ mask = lomask(offs);
+ if(c)
+ b[0] |= ~mask;
+ else
+ b[0] &= mask;
- if (c) mask=ONES32; else mask = 0;
- for(i=1; i < nw-1; i++)
- b[i] = mask;
+ mask = c ? ONES32 : 0;
- tail = (offs+nbits)&31;
- if (tail==0) {- b[i] = mask;
- }
- else {- mask = lomask(tail);
- if (c) b[i]|=mask; else b[i]&=(~mask);
- }
+ for(i = 1; i < nw-1; i++)
+ b[i] = mask;
+
+ tail = (offs+nbits) & 31;
+ if(tail == 0)
+ b[i] = mask;
+ else{+ mask = lomask(tail);
+ if(c)
+ b[i] |= mask;
+ else
+ b[i] &= ~mask;
+ }
}
-void bitvector_not(uint32_t *b, uint32_t offs, uint32_t nbits)
+void
+bitvector_not(uint32_t *b, uint32_t offs, uint32_t nbits)
{- uint32_t i, nw, tail, mask;
+ uint32_t i, nw, tail, mask;
- if (nbits == 0) return;
- nw = (offs+nbits+31)>>5;
+ if(nbits == 0)
+ return;
+ nw = (offs+nbits+31)>>5;
- if (nw == 1) {- mask = (lomask(nbits)<<offs);
- b[0] ^= mask;
- return;
- }
+ if(nw == 1){+ mask = lomask(nbits)<<offs;
+ b[0] ^= mask;
+ return;
+ }
- mask = ~lomask(offs);
- b[0]^=mask;
+ mask = ~lomask(offs);
+ b[0] ^= mask;
- for(i=1; i < nw-1; i++)
- b[i] = ~b[i];
+ for(i = 1; i < nw-1; i++)
+ b[i] = ~b[i];
- tail = (offs+nbits)&31;
- if (tail==0) {- b[i] = ~b[i];
- }
- else {- mask = lomask(tail);
- b[i]^=mask;
- }
+ tail = (offs+nbits)&31;
+ if(tail == 0)
+ b[i] = ~b[i];
+ else{+ mask = lomask(tail);
+ b[i] ^= mask;
+ }
}
// constant-space bit vector copy in a single pass, with arbitrary
// offsets and lengths. to get this right, there are 16 cases to handle!
-#define BITVECTOR_COPY_OP(name, OP) \
-void bitvector_##name(uint32_t *dest, uint32_t doffs, \
- uint32_t *src, uint32_t soffs, uint32_t nbits) \
-{ \- uint32_t i, s, nw, tail, snw, mask, scrap; \
- \
- if (nbits == 0) return; \
- nw = (doffs+nbits+31)>>5; \
- \
- if (soffs == doffs) { \- if (nw == 1) { \- mask = (lomask(nbits)<<doffs); \
- dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
- return; \
- } \
- mask = ~lomask(doffs); \
- dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
- for(i=1; i < nw-1; i++) \
- dest[i] = OP(src[i]); \
- tail = (doffs+nbits)&31; \
- if (tail==0) { dest[i]=src[i]; } else { \- mask = lomask(tail); \
- dest[i] = (dest[i] & ~mask) | (OP(src[i]) & mask); } \
- return; \
- } \
- snw = (soffs+nbits+31)>>5; \
- if (soffs < doffs) { \- s = doffs-soffs; \
- if (nw == 1) { \- mask = (lomask(nbits)<<doffs); \
- dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
- return; \
- } \
- mask = ~lomask(doffs); \
- dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
- scrap = OP(src[0])>>(32-s); \
- for(i=1; i < snw-1; i++) { \- dest[i] = (OP(src[i])<<s) | scrap; \
- scrap = OP(src[i])>>(32-s); \
- } \
- tail = (doffs+nbits)&31; \
- if (tail==0) { mask=ONES32; } else { mask = lomask(tail); } \- if (snw == nw) { \- dest[i] = (dest[i] & ~mask) | (((OP(src[i])<<s)|scrap) & mask); \
- } \
- else /* snw < nw */ { \- if (snw == 1) { \- dest[i] = (dest[i] & ~mask) | \
- (((OP(src[i])<<s) | scrap) & mask); \
- } \
- else { \- dest[i] = (OP(src[i])<<s) | scrap; \
- scrap = OP(src[i])>>(32-s); \
- i++; \
- dest[i] = (dest[i] & ~mask) | (scrap & mask); \
- } \
- } \
- } \
- else { \- s = soffs-doffs; \
- if (snw == 1) { \- mask = (lomask(nbits)<<doffs); \
- dest[0] = (dest[0] & ~mask) | ((OP(src[0])>>s) & mask); \
- return; \
- } \
- if (nw == 1) { \- mask = (lomask(nbits)<<doffs); \
- dest[0] = (dest[0] & ~mask) | \
- (((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
- return; \
- } \
- mask = ~lomask(doffs); \
- dest[0] = (dest[0] & ~mask) | \
- (((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
- for(i=1; i < nw-1; i++) { \- dest[i] = (OP(src[i])>>s) | (OP(src[i+1])<<(32-s)); \
- } \
- tail = (doffs+nbits)&31; \
- if (tail==0) { mask=ONES32; } else { mask = lomask(tail); } \- if (snw == nw) { \- dest[i] = (dest[i] & ~mask) | ((OP(src[i])>>s) & mask); \
- } \
- else /* snw > nw */ { \- dest[i] = (dest[i] & ~mask) | \
- (((OP(src[i])>>s)|(OP(src[i+1])<<(32-s))) & mask); \
- } \
- } \
+#define BITVECTOR_COPY_OP(name, OP) \
+void \
+bitvector_##name(uint32_t *dest, uint32_t doffs, uint32_t *src, uint32_t soffs, uint32_t nbits) \
+{ \+ uint32_t i, s, nw, tail, snw, mask, scrap; \
+ if(nbits == 0) \
+ return; \
+ nw = (doffs+nbits+31)>>5; \
+ if(soffs == doffs){ \+ if(nw == 1){ \+ mask = (lomask(nbits)<<doffs); \
+ dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
+ return; \
+ } \
+ mask = ~lomask(doffs); \
+ dest[0] = (dest[0] & ~mask) | (OP(src[0]) & mask); \
+ for(i = 1; i < nw-1; i++) \
+ dest[i] = OP(src[i]); \
+ tail = (doffs+nbits)&31; \
+ if(tail == 0) \
+ dest[i] = src[i]; \
+ else { \+ mask = lomask(tail); \
+ dest[i] = (dest[i] & ~mask) | (OP(src[i]) & mask); \
+ } \
+ return; \
+ } \
+ snw = (soffs+nbits+31)>>5; \
+ if(soffs < doffs){ \+ s = doffs-soffs; \
+ if(nw == 1){ \+ mask = lomask(nbits) << doffs; \
+ dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
+ return; \
+ } \
+ mask = ~lomask(doffs); \
+ dest[0] = (dest[0] & ~mask) | ((OP(src[0])<<s) & mask); \
+ scrap = OP(src[0])>>(32-s); \
+ for(i = 1; i < snw-1; i++){ \+ dest[i] = (OP(src[i])<<s) | scrap; \
+ scrap = OP(src[i])>>(32-s); \
+ } \
+ tail = (doffs+nbits)&31; \
+ mask = tail ? lomask(tail) : ONES32; \
+ if(snw == nw) \
+ dest[i] = (dest[i] & ~mask) | (((OP(src[i])<<s)|scrap) & mask); \
+ else{ /* snw < nw */ \+ if(snw == 1) \
+ dest[i] = (dest[i] & ~mask) | (((OP(src[i])<<s) | scrap) & mask); \
+ else{ \+ dest[i] = (OP(src[i])<<s) | scrap; \
+ scrap = OP(src[i])>>(32-s); \
+ i++; \
+ dest[i] = (dest[i] & ~mask) | (scrap & mask); \
+ } \
+ } \
+ }else{ \+ s = soffs-doffs; \
+ if(snw == 1){ \+ mask = (lomask(nbits)<<doffs); \
+ dest[0] = (dest[0] & ~mask) | ((OP(src[0])>>s) & mask); \
+ return; \
+ } \
+ if(nw == 1){ \+ mask = (lomask(nbits)<<doffs); \
+ dest[0] = (dest[0] & ~mask) | \
+ (((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
+ return; \
+ } \
+ mask = ~lomask(doffs); \
+ dest[0] = (dest[0] & ~mask) | (((OP(src[0])>>s)|(OP(src[1])<<(32-s))) & mask); \
+ for(i = 1; i < nw-1; i++) \
+ dest[i] = (OP(src[i])>>s) | (OP(src[i+1])<<(32-s)); \
+ tail = (doffs+nbits)&31; \
+ mask = tail ? lomask(tail) : ONES32; \
+ if(snw == nw){ \+ dest[i] = (dest[i] & ~mask) | ((OP(src[i])>>s) & mask); \
+ } \
+ else /* snw > nw */ { \+ dest[i] = (dest[i] & ~mask) | \
+ (((OP(src[i])>>s)|(OP(src[i+1])<<(32-s))) & mask); \
+ } \
+ } \
}
#define BV_COPY(a) (a)
@@ -280,190 +296,177 @@
BITVECTOR_COPY_OP(copy, BV_COPY)
BITVECTOR_COPY_OP(not_to, BV_NOT)
-// right-shift the bits in one logical "row" of a long 2d bit vector
-/*
-void bitvector_shr_row(uint32_t *b, uint32_t offs, size_t nbits, uint32_t s)
-{-}
-*/
-
// copy from source to dest while reversing bit-order
// assumes dest offset == 0
// assumes source and dest don't overlap
// assumes offset < 32
-void bitvector_reverse_to(uint32_t *dest, uint32_t *src, uint32_t soffs,
- uint32_t nbits)
+void
+bitvector_reverse_to(uint32_t *dest, uint32_t *src, uint32_t soffs, uint32_t nbits)
{- uint32_t i, nw, tail;
+ uint32_t i, nw, tail;
- if (nbits == 0) return;
+ if(nbits == 0)
+ return;
- nw = (soffs+nbits+31)>>5;
- // first, reverse the words while reversing bit order within each word
- for(i=0; i < nw/2; i++) {- dest[i] = bitreverse(src[nw-i-1]);
- dest[nw-i-1] = bitreverse(src[i]);
- }
- if (nw&0x1)
- dest[i] = bitreverse(src[i]);
+ nw = (soffs+nbits+31)>>5;
+ // first, reverse the words while reversing bit order within each word
+ for(i = 0; i < nw/2; i++){+ dest[i] = bitreverse(src[nw-i-1]);
+ dest[nw-i-1] = bitreverse(src[i]);
+ }
+ if(nw&0x1)
+ dest[i] = bitreverse(src[i]);
- tail = (soffs+nbits)&31;
- if (tail)
- bitvector_shr(dest, nw, 32-tail);
+ tail = (soffs+nbits)&31;
+ if(tail)
+ bitvector_shr(dest, nw, 32-tail);
}
-void bitvector_reverse(uint32_t *b, uint32_t offs, uint32_t nbits)
+void
+bitvector_reverse(uint32_t *b, uint32_t offs, uint32_t nbits)
{- uint32_t i, nw, tail, *temp, a[MALLOC_CUTOFF];
+ uint32_t i, nw, tail, *temp, a[MALLOC_CUTOFF];
- if (nbits == 0) return;
+ if(nbits == 0)
+ return;
- nw = (offs+nbits+31)>>5;
- temp = (nw > MALLOC_CUTOFF) ? malloc(nw*4) : a;
- for(i=0; i < nw/2; i++) {- temp[i] = bitreverse(b[nw-i-1]);
- temp[nw-i-1] = bitreverse(b[i]);
- }
- if (nw&0x1)
- temp[i] = bitreverse(b[i]);
+ nw = (offs+nbits+31)>>5;
+ temp = (nw > MALLOC_CUTOFF) ? malloc(nw*4) : a;
+ for(i = 0; i < nw/2; i++){+ temp[i] = bitreverse(b[nw-i-1]);
+ temp[nw-i-1] = bitreverse(b[i]);
+ }
+ if(nw & 1)
+ temp[i] = bitreverse(b[i]);
- tail = (offs+nbits)&31;
- bitvector_copy(b, offs, temp, (32-tail)&31, nbits);
- if (nw > MALLOC_CUTOFF) free(temp);
+ tail = (offs+nbits)&31;
+ bitvector_copy(b, offs, temp, (32-tail)&31, nbits);
+ if(nw > MALLOC_CUTOFF)
+ free(temp);
}
-uint64_t bitvector_count(uint32_t *b, uint32_t offs, uint64_t nbits)
+uint64_t
+bitvector_count(uint32_t *b, uint32_t offs, uint64_t nbits)
{- size_t i, nw;
- uint32_t ntail;
- uint64_t ans;
+ size_t i, nw;
+ uint32_t ntail;
+ uint64_t ans;
- if (nbits == 0) return 0;
- nw = ((uint64_t)offs+nbits+31)>>5;
+ if(nbits == 0)
+ return 0;
+ nw = ((uint64_t)offs+nbits+31)>>5;
- if (nw == 1) {- return count_bits(b[0] & (lomask(nbits)<<offs));
- }
+ if(nw == 1)
+ return count_bits(b[0] & (lomask(nbits)<<offs));
- ans = count_bits(b[0]>>offs); // first end cap
+ ans = count_bits(b[0]>>offs); // first end cap
- for(i=1; i < nw-1; i++) {- /* popcnt can be computed branch-free, so these special cases
- probably don't help much */
- /*
- v = b[i];
- if (v == 0)
- continue;
- if (v == ONES32)
- ans += 32;
- else
- */
- ans += count_bits(b[i]);
- }
+ for(i = 1; i < nw-1; i++)
+ ans += count_bits(b[i]);
- ntail = (offs+(uint32_t)nbits)&31;
- ans += count_bits(b[i]&(ntail>0?lomask(ntail):ONES32)); // last end cap
+ ntail = (offs + (uint32_t)nbits) & 31;
+ ans += count_bits(b[i] & (ntail > 0 ? lomask(ntail) : ONES32)); // last end cap
- return ans;
+ return ans;
}
-uint32_t bitvector_any0(uint32_t *b, uint32_t offs, uint32_t nbits)
+uint32_t
+bitvector_any0(uint32_t *b, uint32_t offs, uint32_t nbits)
{- uint32_t i, nw, tail, mask;
+ uint32_t i, nw, tail, mask;
- if (nbits == 0) return 0;
- nw = (offs+nbits+31)>>5;
+ if(nbits == 0)
+ return 0;
+ nw = (offs+nbits+31)>>5;
- if (nw == 1) {- mask = (lomask(nbits)<<offs);
- if ((b[0] & mask) != mask) return 1;
- return 0;
- }
+ if(nw == 1){+ mask = (lomask(nbits)<<offs);
+ if((b[0] & mask) != mask)
+ return 1;
+ return 0;
+ }
- mask = ~lomask(offs);
- if ((b[0] & mask) != mask) return 1;
+ mask = ~lomask(offs);
+ if((b[0] & mask) != mask)
+ return 1;
- for(i=1; i < nw-1; i++) {- if (b[i] != ONES32) return 1;
- }
+ for(i = 1; i < nw-1; i++)
+ if(b[i] != ONES32)
+ return 1;
- tail = (offs+nbits)&31;
- if (tail==0) {- if (b[i] != ONES32) return 1;
- }
- else {- mask = lomask(tail);
- if ((b[i] & mask) != mask) return 1;
- }
- return 0;
+ tail = (offs+nbits)&31;
+ if(tail == 0)
+ return b[i] != ONES32;
+ mask = lomask(tail);
+ return (b[i] & mask) != mask;
}
-uint32_t bitvector_any1(uint32_t *b, uint32_t offs, uint32_t nbits)
+uint32_t
+bitvector_any1(uint32_t *b, uint32_t offs, uint32_t nbits)
{- uint32_t i, nw, tail, mask;
+ uint32_t i, nw, tail, mask;
- if (nbits == 0) return 0;
- nw = (offs+nbits+31)>>5;
+ if(nbits == 0)
+ return 0;
+ nw = (offs+nbits+31)>>5;
- if (nw == 1) {- mask = (lomask(nbits)<<offs);
- if ((b[0] & mask) != 0) return 1;
- return 0;
- }
+ if(nw == 1){+ mask = lomask(nbits)<<offs;
+ return (b[0] & mask) != 0;
+ }
- mask = ~lomask(offs);
- if ((b[0] & mask) != 0) return 1;
+ mask = ~lomask(offs);
+ if((b[0] & mask) != 0)
+ return 1;
- for(i=1; i < nw-1; i++) {- if (b[i] != 0) return 1;
- }
+ for(i = 1; i < nw-1; i++){+ if(b[i] != 0)
+ return 1;
+ }
- tail = (offs+nbits)&31;
- if (tail==0) {- if (b[i] != 0) return 1;
- }
- else {- mask = lomask(tail);
- if ((b[i] & mask) != 0) return 1;
- }
- return 0;
+ tail = (offs+nbits)&31;
+ if(tail == 0)
+ return b[i] != 0;
+ return (b[i] & lomask(tail)) != 0;
}
-static void adjust_offset_to(uint32_t *dest, uint32_t *src, uint32_t nw,
- uint32_t soffs, uint32_t newoffs)
+static void
+adjust_offset_to(uint32_t *dest, uint32_t *src, uint32_t nw, uint32_t soffs, uint32_t newoffs)
{- if (newoffs > soffs)
- bitvector_shl_to(dest, src, nw, newoffs-soffs, 1);
- else
- bitvector_shr_to(dest, src, nw, soffs-newoffs);
+ if(newoffs > soffs)
+ bitvector_shl_to(dest, src, nw, newoffs-soffs, 1);
+ else
+ bitvector_shr_to(dest, src, nw, soffs-newoffs);
}
-#define BITVECTOR_BINARY_OP_TO(opname, OP) \
-void bitvector_##opname##_to(uint32_t *dest, uint32_t doffs, \
- uint32_t *a, uint32_t aoffs, \
- uint32_t *b, uint32_t boffs, uint32_t nbits) \
-{ \- uint32_t nw = (doffs+nbits+31)>>5; \
- uint32_t atmp[MALLOC_CUTOFF+1]; \
- uint32_t *temp = nw>MALLOC_CUTOFF ? malloc((nw+1)*4) : atmp; \
- uint32_t i, anw, bnw; \
- if (aoffs == boffs) { \- anw = (aoffs+nbits+31)>>5; \
- } \
- else if (aoffs == doffs) { \- bnw = (boffs+nbits+31)>>5; \
- adjust_offset_to(temp, b, bnw, boffs, aoffs); \
- b = temp; anw = nw; \
- } \
- else { \- anw = (aoffs+nbits+31)>>5; \
- bnw = (boffs+nbits+31)>>5; \
- adjust_offset_to(temp, a, anw, aoffs, boffs); \
- a = temp; aoffs = boffs; anw = bnw; \
- } \
- for(i=0; i < anw; i++) temp[i] = OP(a[i], b[i]); \
- bitvector_copy(dest, doffs, temp, aoffs, nbits); \
- if (nw>MALLOC_CUTOFF) free(temp); \
+#define BITVECTOR_BINARY_OP_TO(opname, OP) \
+void \
+bitvector_##opname##_to(uint32_t *dest, uint32_t doffs, uint32_t *a, uint32_t aoffs, uint32_t *b, uint32_t boffs, uint32_t nbits) \
+{ \+ uint32_t nw = (doffs+nbits+31)>>5; \
+ uint32_t atmp[MALLOC_CUTOFF+1]; \
+ uint32_t *temp = nw>MALLOC_CUTOFF ? malloc((nw+1)*4) : atmp; \
+ uint32_t i, anw, bnw; \
+ if(aoffs == boffs){ \+ anw = (aoffs+nbits+31)>>5; \
+ }else if(aoffs == doffs){ \+ bnw = (boffs+nbits+31)>>5; \
+ adjust_offset_to(temp, b, bnw, boffs, aoffs); \
+ b = temp; \
+ anw = nw; \
+ }else{ \+ anw = (aoffs+nbits+31)>>5; \
+ bnw = (boffs+nbits+31)>>5; \
+ adjust_offset_to(temp, a, anw, aoffs, boffs); \
+ a = temp; \
+ aoffs = boffs; \
+ anw = bnw; \
+ } \
+ for(i = 0; i < anw; i++) \
+ temp[i] = OP(a[i], b[i]); \
+ bitvector_copy(dest, doffs, temp, aoffs, nbits); \
+ if(nw>MALLOC_CUTOFF) \
+ free(temp); \
}
#define BV_AND(a,b) ((a)&(b))
--- a/llt/bitvector.c
+++ b/llt/bitvector.c
@@ -15,11 +15,11 @@
efficient implementation due to the bit-vector nature of machine integers.
These are:
done:
- & | $ ~ copy reverse fill sum prod
+ & | $ ~ copy reverse fill sum prod
todo:
- shift trans rowswap
+ shift trans rowswap
would be nice:
- channel interleave
+ channel interleave
Important note:
Out-of-place functions always assume dest and source have the same amount
@@ -31,90 +31,110 @@
#include "llt.h"
-uint32_t *bitvector_resize(uint32_t *b, uint64_t oldsz, uint64_t newsz,
- int initzero)
+uint32_t *
+bitvector_resize(uint32_t *b, uint64_t oldsz, uint64_t newsz, int initzero)
{- uint32_t *p;
- size_t sz = ((newsz+31)>>5) * sizeof(uint32_t);
- p = LLT_REALLOC(b, sz);
- if (p == nil) return nil;
- if (initzero && newsz>oldsz) {- size_t osz = ((oldsz+31)>>5) * sizeof(uint32_t);
- memset(&p[osz/sizeof(uint32_t)], 0, sz-osz);
- }
- return p;
+ uint32_t *p;
+ size_t sz = ((newsz+31)>>5) * sizeof(uint32_t);
+ p = LLT_REALLOC(b, sz);
+ if(p == nil)
+ return nil;
+ if(initzero && newsz>oldsz){+ size_t osz = ((oldsz+31)>>5) * sizeof(uint32_t);
+ memset(&p[osz/sizeof(uint32_t)], 0, sz-osz);
+ }
+ return p;
}
-uint32_t *bitvector_new(uint64_t n, int initzero)
+uint32_t *
+bitvector_new(uint64_t n, int initzero)
{- return bitvector_resize(nil, 0, n, initzero);
+ return bitvector_resize(nil, 0, n, initzero);
}
-size_t bitvector_nwords(uint64_t nbits)
+size_t
+bitvector_nwords(uint64_t nbits)
{- return ((nbits+31)>>5);
+ return (nbits+31)>>5;
}
-void bitvector_set(uint32_t *b, uint64_t n, uint32_t c)
+void
+bitvector_set(uint32_t *b, uint64_t n, uint32_t c)
{- if (c)
- b[n>>5] |= (1<<(n&31));
- else
- b[n>>5] &= ~(1<<(n&31));
+ if(c)
+ b[n>>5] |= 1<<(n&31);
+ else
+ b[n>>5] &= ~(1<<(n&31));
}
-uint32_t bitvector_get(uint32_t *b, uint64_t n)
+uint32_t
+bitvector_get(uint32_t *b, uint64_t n)
{- return b[n>>5] & (1<<(n&31));
+ return b[n>>5] & (1<<(n&31));
}
-static int ntz(uint32_t x)
+static int
+ntz(uint32_t x)
{- int n;
+ int n;
- if (x == 0) return 32;
- n = 1;
- if ((x & 0x0000FFFF) == 0) {n = n +16; x = x >>16;}- if ((x & 0x000000FF) == 0) {n = n + 8; x = x >> 8;}- if ((x & 0x0000000F) == 0) {n = n + 4; x = x >> 4;}- if ((x & 0x00000003) == 0) {n = n + 2; x = x >> 2;}- return n - (x & 1);
+ if(x == 0)
+ return 32;
+ n = 1;
+ if((x & 0x0000FFFF) == 0){+ n = n +16;
+ x = x >>16;
+ }
+ if((x & 0x000000FF) == 0){+ n = n + 8;
+ x = x >> 8;
+ }
+ if((x & 0x0000000F) == 0){+ n = n + 4;
+ x = x >> 4;
+ }
+ if((x & 0x00000003) == 0){+ n = n + 2;
+ x = x >> 2;
+ }
+ return n - (x & 1);
}
// given a bitvector of n bits, starting at bit n0 find the next
// set bit, including n0.
// returns n if no set bits.
-uint32_t bitvector_next(uint32_t *b, uint64_t n0, uint64_t n)
+uint32_t
+bitvector_next(uint32_t *b, uint64_t n0, uint64_t n)
{- if (n0 >= n) return n;
+ if(n0 >= n)
+ return n;
- uint32_t i = n0>>5;
- uint32_t nb = n0&31;
- uint32_t nw = (n+31)>>5;
- uint32_t w;
+ uint32_t i = n0>>5;
+ uint32_t nb = n0&31;
+ uint32_t nw = (n+31)>>5;
+ uint32_t w;
- if (i < nw-1 || (n&31)==0)
- w = b[i]>>nb;
- else
- w = (b[i]&lomask(n&31))>>nb;
- if (w != 0)
- return ntz(w)+n0;
- if (i == nw-1)
- return n;
- i++;
- while (i < nw-1) {- w = b[i];
- if (w != 0) {- return ntz(w) + (i<<5);
- }
- i++;
- }
- w = b[i];
- nb = n&31;
- i = ntz(w);
- if (nb == 0)
- return i + (n-32);
- if (i >= nb)
- return n;
- return i + (n-nb);
+ if(i < nw-1 || (n&31) == 0)
+ w = b[i]>>nb;
+ else
+ w = (b[i]&lomask(n&31)) >> nb;
+ if(w != 0)
+ return ntz(w) + n0;
+ if(i == nw-1)
+ return n;
+ i++;
+ while(i < nw-1){+ w = b[i];
+ if(w != 0)
+ return ntz(w) + (i<<5);
+ i++;
+ }
+ w = b[i];
+ nb = n&31;
+ i = ntz(w);
+ if(nb == 0)
+ return i + (n-32);
+ if(i >= nb)
+ return n;
+ return i + (n-nb);
}
--- a/llt/dump.c
+++ b/llt/dump.c
@@ -6,30 +6,30 @@
display a given number of bytes from a buffer, with the first
address label being startoffs
*/
-void hexdump(ios_t *dest, const char *buffer, size_t len, size_t startoffs)
+void
+hexdump(ios_t *dest, const char *buffer, size_t len, size_t startoffs)
{- size_t offs=0;
- size_t i, pos;
- char ch, linebuffer[16];
- char hexc[4];
- static char *spc50 = " ";
+ size_t offs = 0;
+ size_t i, pos;
+ char ch, linebuffer[16], hexc[4];
+ static const char *spc50 = " ";
- hexc[2] = hexc[3] = ' ';
- do {- ios_printf(dest, "%.8x ", offs+startoffs);
- pos = 10;
- for(i=0; i < 16 && offs < len; i++, offs++) {- ch = buffer[offs];
- linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch;
- hexc[0] = hexdig[((uint8_t)ch)>>4];
- hexc[1] = hexdig[ch&0x0f];
- pos += ios_write(dest, hexc, (i==7 || i==15) ? 4 : 3);
- }
- for(; i < 16; i++)
- linebuffer[i] = ' ';
- ios_write(dest, spc50, 60-pos);
- ios_putc('|', dest);- ios_write(dest, linebuffer, 16);
- ios_write(dest, "|\n", 2);
- } while (offs < len);
+ hexc[2] = hexc[3] = ' ';
+ do{+ ios_printf(dest, "%.8x ", offs+startoffs);
+ pos = 10;
+ for(i = 0; i < 16 && offs < len; i++, offs++){+ ch = buffer[offs];
+ linebuffer[i] = (ch < 32 || ch >= 0x7f) ? '.' : ch;
+ hexc[0] = hexdig[((uint8_t)ch)>>4];
+ hexc[1] = hexdig[ch & 0x0f];
+ pos += ios_write(dest, hexc, (i == 7 || i == 15) ? 4 : 3);
+ }
+ for(; i < 16; i++)
+ linebuffer[i] = ' ';
+ ios_write(dest, spc50, 60-pos);
+ ios_putc('|', dest);+ ios_write(dest, linebuffer, 16);
+ ios_write(dest, "|\n", 2);
+ }while(offs < len);
}
--- a/llt/hashing.c
+++ b/llt/hashing.c
@@ -1,68 +1,75 @@
#include "llt.h"
-lltuint_t nextipow2(lltuint_t i)
+lltuint_t
+nextipow2(lltuint_t i)
{- if (i==0) return 1;
- i |= i >> 1;
- i |= i >> 2;
- i |= i >> 4;
- i |= i >> 8;
- i |= i >> 16;
+ if (i == 0)
+ return 1;
+ i |= i >> 1;
+ i |= i >> 2;
+ i |= i >> 4;
+ i |= i >> 8;
+ i |= i >> 16;
#ifdef BITS64
- i |= i >> 32;
+ i |= i >> 32;
#endif
- i++;
- return i ? i : TOP_BIT;
+ i++;
+ return i ? i : TOP_BIT;
}
-uint32_t int32hash(uint32_t a)
+uint32_t
+int32hash(uint32_t a)
{- a = (a+0x7ed55d16) + (a<<12);
- a = (a^0xc761c23c) ^ (a>>19);
- a = (a+0x165667b1) + (a<<5);
- a = (a+0xd3a2646c) ^ (a<<9);
- a = (a+0xfd7046c5) + (a<<3);
- a = (a^0xb55a4f09) ^ (a>>16);
- return a;
+ a = (a+0x7ed55d16) + (a<<12);
+ a = (a^0xc761c23c) ^ (a>>19);
+ a = (a+0x165667b1) + (a<<5);
+ a = (a+0xd3a2646c) ^ (a<<9);
+ a = (a+0xfd7046c5) + (a<<3);
+ a = (a^0xb55a4f09) ^ (a>>16);
+ return a;
}
-uint64_t int64hash(uint64_t key)
+uint64_t
+int64hash(uint64_t key)
{- key = (~key) + (key << 21); // key = (key << 21) - key - 1;
- key = key ^ (key >> 24);
- key = (key + (key << 3)) + (key << 8); // key * 265
- key = key ^ (key >> 14);
- key = (key + (key << 2)) + (key << 4); // key * 21
- key = key ^ (key >> 28);
- key = key + (key << 31);
- return key;
+ key = (~key) + (key << 21); // key = (key << 21) - key - 1;
+ key = key ^ (key >> 24);
+ key = (key + (key << 3)) + (key << 8); // key * 265
+ key = key ^ (key >> 14);
+ key = (key + (key << 2)) + (key << 4); // key * 21
+ key = key ^ (key >> 28);
+ key = key + (key << 31);
+ return key;
}
-uint32_t int64to32hash(uint64_t key)
+uint32_t
+int64to32hash(uint64_t key)
{- key = (~key) + (key << 18); // key = (key << 18) - key - 1;
- key = key ^ (key >> 31);
- key = key * 21; // key = (key + (key << 2)) + (key << 4);
- key = key ^ (key >> 11);
- key = key + (key << 6);
- key = key ^ (key >> 22);
- return (uint32_t)key;
+ key = (~key) + (key << 18); // key = (key << 18) - key - 1;
+ key = key ^ (key >> 31);
+ key = key * 21; // key = (key + (key << 2)) + (key << 4);
+ key = key ^ (key >> 11);
+ key = key + (key << 6);
+ key = key ^ (key >> 22);
+ return (uint32_t)key;
}
#include "lookup3.c"
-uint64_t memhash(const char* buf, size_t n)
+uint64_t
+memhash(const char* buf, size_t n)
{- uint32_t c=0xcafe8881, b=0x4d6a087c;
+ uint32_t c = 0xcafe8881, b = 0x4d6a087c;
- hashlittle2(buf, n, &c, &b);
- return (uint64_t)c | (((uint64_t)b)<<32);
+ hashlittle2(buf, n, &c, &b);
+ return (uint64_t)c | (((uint64_t)b)<<32);
}
-uint32_t memhash32(const char* buf, size_t n)
+uint32_t
+memhash32(const char* buf, size_t n)
{- uint32_t c=0xcafe8881, b=0x4d6a087c;
+ uint32_t c = 0xcafe8881, b = 0x4d6a087c;
- hashlittle2(buf, n, &c, &b);
- return c;
+ hashlittle2(buf, n, &c, &b);
+ return c;
}
--- a/llt/htable.c
+++ b/llt/htable.c
@@ -5,45 +5,48 @@
#include "llt.h"
#include "htable.h"
-htable_t *htable_new(htable_t *h, size_t size)
+htable_t *
+htable_new(htable_t *h, size_t size)
{- if (size <= HT_N_INLINE/2) {- h->size = size = HT_N_INLINE;
- h->table = &h->_space[0];
- }
- else {- size = nextipow2(size);
- size *= 2; // 2 pointers per key/value pair
- size *= 2; // aim for 50% occupancy
- h->size = size;
- h->table = (void**)LLT_ALLOC(size*sizeof(void*));
- }
- if (h->table == nil) return nil;
- size_t i;
- for(i=0; i < size; i++)
- h->table[i] = HT_NOTFOUND;
- return h;
+ if(size <= HT_N_INLINE/2){+ h->size = size = HT_N_INLINE;
+ h->table = &h->_space[0];
+ }else{+ size = nextipow2(size);
+ size *= 2; // 2 pointers per key/value pair
+ size *= 2; // aim for 50% occupancy
+ h->size = size;
+ h->table = LLT_ALLOC(size*sizeof(void*));
+ }
+ if(h->table == nil)
+ return nil;
+ size_t i;
+ for(i = 0; i < size; i++)
+ h->table[i] = HT_NOTFOUND;
+ return h;
}
-void htable_free(htable_t *h)
+void
+htable_free(htable_t *h)
{- if (h->table != &h->_space[0])
- LLT_FREE(h->table);
+ if(h->table != &h->_space[0])
+ LLT_FREE(h->table);
}
// empty and reduce size
-void htable_reset(htable_t *h, size_t sz)
+void
+htable_reset(htable_t *h, size_t sz)
{- sz = nextipow2(sz);
- if (h->size > sz*4 && h->size > HT_N_INLINE) {- size_t newsz = sz*4;
- void **newtab = (void**)LLT_REALLOC(h->table, newsz*sizeof(void*));
- if (newtab == nil)
- return;
- h->size = newsz;
- h->table = newtab;
- }
- size_t i, hsz=h->size;
- for(i=0; i < hsz; i++)
- h->table[i] = HT_NOTFOUND;
+ sz = nextipow2(sz);
+ if(h->size > sz*4 && h->size > HT_N_INLINE){+ size_t newsz = sz*4;
+ void **newtab = LLT_REALLOC(h->table, newsz*sizeof(void*));
+ if(newtab == nil)
+ return;
+ h->size = newsz;
+ h->table = newtab;
+ }
+ size_t i, hsz = h->size;
+ for(i = 0; i < hsz; i++)
+ h->table[i] = HT_NOTFOUND;
}
--- a/llt/htable.h
+++ b/llt/htable.h
@@ -4,10 +4,10 @@
#define HT_N_INLINE 32
typedef struct {- size_t size;
- void **table;
- void *_space[HT_N_INLINE];
-} htable_t;
+ size_t size;
+ void **table;
+ void *_space[HT_N_INLINE];
+}htable_t;
// define this to be an invalid key/value
#define HT_NOTFOUND ((void*)1)
--- a/llt/htable.inc
+++ b/llt/htable.inc
@@ -7,139 +7,141 @@
#define hash_size(h) ((h)->size/2)
// compute empirical max-probe for a given size
-#define max_probe(size) ((size)<=(HT_N_INLINE*2) ? (HT_N_INLINE/2) : (size)>>3)
+#define max_probe(size) ((size) <= (HT_N_INLINE*2) ? (HT_N_INLINE/2) : (size)>>3)
-#define HTIMPL(HTNAME, HFUNC, EQFUNC) \
-static void **HTNAME##_lookup_bp(htable_t *h, void *key) \
-{ \- lltuint_t hv; \
- size_t i, orig, index, iter; \
- size_t newsz, sz = hash_size(h); \
- size_t maxprobe = max_probe(sz); \
- void **tab = h->table; \
- void **ol; \
- \
- hv = HFUNC((uintptr_t)key); \
- retry_bp: \
- iter = 0; \
- index = (hv & (sz-1)) * 2; \
- sz *= 2; \
- orig = index; \
- \
- do { \- if (tab[index+1] == HT_NOTFOUND) { \- tab[index] = key; \
- return &tab[index+1]; \
- } \
- \
- if (EQFUNC(key, tab[index])) \
- return &tab[index+1]; \
- \
- index = (index+2) & (sz-1); \
- iter++; \
- if (iter > maxprobe) \
- break; \
- } while (index != orig); \
- \
- /* table full */ \
- /* quadruple size, rehash, retry the insert */ \
- /* it's important to grow the table really fast; otherwise we waste */ \
- /* lots of time rehashing all the keys over and over. */ \
- sz = h->size; \
- ol = h->table; \
- if (sz >= (1<<19) || (sz <= (1<<8))) \
- newsz = sz<<1; \
- else if (sz <= HT_N_INLINE) \
- newsz = HT_N_INLINE; \
- else \
- newsz = sz<<2; \
- tab = (void**)LLT_ALLOC(newsz*sizeof(void*)); \
- if (tab == nil) \
- return nil; \
- for(i=0; i < newsz; i++) \
- tab[i] = HT_NOTFOUND; \
- h->table = tab; \
- h->size = newsz; \
- for(i=0; i < sz; i+=2) { \- if (ol[i+1] != HT_NOTFOUND) { \- (*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1]; \
- } \
- } \
- if (ol != &h->_space[0]) \
- LLT_FREE(ol); \
- \
- sz = hash_size(h); \
- maxprobe = max_probe(sz); \
- tab = h->table; \
- \
- goto retry_bp; \
+#define HTIMPL(HTNAME, HFUNC, EQFUNC) \
+static void ** \
+HTNAME##_lookup_bp(htable_t *h, void *key) \
+{ \+ lltuint_t hv; \
+ size_t i, orig, index, iter; \
+ size_t newsz, sz = hash_size(h); \
+ size_t maxprobe = max_probe(sz); \
+ void **tab = h->table; \
+ void **ol; \
+ \
+ hv = HFUNC((uintptr_t)key); \
+retry_bp: \
+ iter = 0; \
+ index = (hv & (sz-1)) * 2; \
+ sz *= 2; \
+ orig = index; \
+ \
+ do{ \+ if(tab[index+1] == HT_NOTFOUND){ \+ tab[index] = key; \
+ return &tab[index+1]; \
+ } \
+ if(EQFUNC(key, tab[index])) \
+ return &tab[index+1]; \
+ index = (index+2) & (sz-1); \
+ iter++; \
+ if(iter > maxprobe) \
+ break; \
+ }while(index != orig); \
+ \
+ /* table full */ \
+ /* quadruple size, rehash, retry the insert */ \
+ /* it's important to grow the table really fast; otherwise we waste */ \
+ /* lots of time rehashing all the keys over and over. */ \
+ sz = h->size; \
+ ol = h->table; \
+ if(sz >= (1<<19) || (sz <= (1<<8))) \
+ newsz = sz<<1; \
+ else if(sz <= HT_N_INLINE) \
+ newsz = HT_N_INLINE; \
+ else \
+ newsz = sz<<2; \
+ tab = (void**)LLT_ALLOC(newsz*sizeof(void*)); \
+ if(tab == nil) \
+ return nil; \
+ for(i = 0; i < newsz; i++) \
+ tab[i] = HT_NOTFOUND; \
+ h->table = tab; \
+ h->size = newsz; \
+ for(i = 0; i < sz; i += 2) { \+ if(ol[i+1] != HT_NOTFOUND) \
+ (*HTNAME##_lookup_bp(h, ol[i])) = ol[i+1]; \
+ } \
+ if(ol != &h->_space[0]) \
+ LLT_FREE(ol); \
+ sz = hash_size(h); \
+ maxprobe = max_probe(sz); \
+ tab = h->table; \
+ goto retry_bp; \
} \
- \
-void HTNAME##_put(htable_t *h, void *key, void *val) \
-{ \- void **bp = HTNAME##_lookup_bp(h, key); \
- \
- *bp = val; \
-} \
- \
-void **HTNAME##_bp(htable_t *h, void *key) \
-{ \- return HTNAME##_lookup_bp(h, key); \
-} \
- \
-/* returns bp if key is in hash, otherwise nil */ \
-/* if return is non-nil and *bp == HT_NOTFOUND then key was deleted */ \
-static void **HTNAME##_peek_bp(htable_t *h, void *key) \
-{ \- size_t sz = hash_size(h); \
- size_t maxprobe = max_probe(sz); \
- void **tab = h->table; \
- size_t index = (HFUNC((uintptr_t)key) & (sz-1)) * 2; \
- sz *= 2; \
- size_t orig = index; \
- size_t iter = 0; \
- \
- do { \- if (tab[index] == HT_NOTFOUND) \
- return nil; \
- if (EQFUNC(key, tab[index])) \
- return &tab[index+1]; \
- \
- index = (index+2) & (sz-1); \
- iter++; \
- if (iter > maxprobe) \
- break; \
- } while (index != orig); \
- \
- return nil; \
-} \
- \
-void *HTNAME##_get(htable_t *h, void *key) \
-{ \- void **bp = HTNAME##_peek_bp(h, key); \
- if (bp == nil) \
- return HT_NOTFOUND; \
- return *bp; \
-} \
- \
-int HTNAME##_has(htable_t *h, void *key) \
-{ \- return (HTNAME##_get(h,key) != HT_NOTFOUND); \
-} \
- \
-int HTNAME##_remove(htable_t *h, void *key) \
-{ \- void **bp = HTNAME##_peek_bp(h, key); \
- if (bp != nil) { \- *bp = HT_NOTFOUND; \
- return 1; \
- } \
- return 0; \
-} \
- \
-void HTNAME##_adjoin(htable_t *h, void *key, void *val) \
-{ \- void **bp = HTNAME##_lookup_bp(h, key); \
- if (*bp == HT_NOTFOUND) \
- *bp = val; \
+ \
+void \
+HTNAME##_put(htable_t *h, void *key, void *val) \
+{ \+ void **bp = HTNAME##_lookup_bp(h, key); \
+ *bp = val; \
+} \
+ \
+void ** \
+HTNAME##_bp(htable_t *h, void *key) \
+{ \+ return HTNAME##_lookup_bp(h, key); \
+} \
+ \
+/* returns bp if key is in hash, otherwise nil */ \
+/* if return is non-nil and *bp == HT_NOTFOUND then key was deleted */ \
+static void ** \
+HTNAME##_peek_bp(htable_t *h, void *key) \
+{ \+ size_t sz = hash_size(h); \
+ size_t maxprobe = max_probe(sz); \
+ void **tab = h->table; \
+ size_t index = (HFUNC((uintptr_t)key) & (sz-1)) * 2; \
+ sz *= 2; \
+ size_t orig = index; \
+ size_t iter = 0; \
+ \
+ do { \+ if(tab[index] == HT_NOTFOUND) \
+ return nil; \
+ if(EQFUNC(key, tab[index])) \
+ return &tab[index+1]; \
+ \
+ index = (index+2) & (sz-1); \
+ iter++; \
+ if(iter > maxprobe) \
+ break; \
+ }while(index != orig); \
+ \
+ return nil; \
+} \
+ \
+void *\
+HTNAME##_get(htable_t *h, void *key) \
+{ \+ void **bp = HTNAME##_peek_bp(h, key); \
+ if(bp == nil) \
+ return HT_NOTFOUND; \
+ return *bp; \
+} \
+ \
+int \
+HTNAME##_has(htable_t *h, void *key) \
+{ \+ return HTNAME##_get(h,key) != HT_NOTFOUND; \
+} \
+ \
+int \
+HTNAME##_remove(htable_t *h, void *key) \
+{ \+ void **bp = HTNAME##_peek_bp(h, key); \
+ if(bp != nil){ \+ *bp = HT_NOTFOUND; \
+ return 1; \
+ } \
+ return 0; \
+} \
+ \
+void \
+HTNAME##_adjoin(htable_t *h, void *key, void *val) \
+{ \+ void **bp = HTNAME##_lookup_bp(h, key); \
+ if(*bp == HT_NOTFOUND) \
+ *bp = val; \
}
--- a/llt/htableh.inc
+++ b/llt/htableh.inc
@@ -2,12 +2,12 @@
#include "htable.h"
-#define HTPROT(HTNAME) \
-void *HTNAME##_get(htable_t *h, void *key); \
-void HTNAME##_put(htable_t *h, void *key, void *val); \
-void HTNAME##_adjoin(htable_t *h, void *key, void *val); \
-int HTNAME##_has(htable_t *h, void *key); \
-int HTNAME##_remove(htable_t *h, void *key); \
+#define HTPROT(HTNAME) \
+void *HTNAME##_get(htable_t *h, void *key); \
+void HTNAME##_put(htable_t *h, void *key, void *val); \
+void HTNAME##_adjoin(htable_t *h, void *key, void *val); \
+int HTNAME##_has(htable_t *h, void *key); \
+int HTNAME##_remove(htable_t *h, void *key); \
void **HTNAME##_bp(htable_t *h, void *key);
// return value, or HT_NOTFOUND if key not found
--- a/llt/ieee754.h
+++ b/llt/ieee754.h
@@ -2,9 +2,9 @@
#define __IEEE754_H_
union ieee754_float {- float f;
+ float f;
- struct {+ struct {#if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:8;
@@ -16,35 +16,35 @@
#else
#error which endian?
#endif
- } ieee;
+ }ieee;
};
#define IEEE754_FLOAT_BIAS 0x7f
union ieee754_double {- double d;
+ double d;
- struct {+ struct {#if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:11;
unsigned int mantissa0:20;
unsigned int mantissa1:32;
-#elif BYTE_ORDER == LITTLE_ENDIAN
+#else
unsigned int mantissa1:32;
unsigned int mantissa0:20;
unsigned int exponent:11;
unsigned int negative:1;
#endif
- } ieee;
+ }ieee;
};
#define IEEE754_DOUBLE_BIAS 0x3ff
union ieee854_long_double {- long double d;
+ long double d;
- struct {+ struct {#if BYTE_ORDER == BIG_ENDIAN
unsigned int negative:1;
unsigned int exponent:15;
@@ -51,16 +51,14 @@
unsigned int empty:16;
unsigned int mantissa0:32;
unsigned int mantissa1:32;
-#elif BYTE_ORDER == LITTLE_ENDIAN
+#else
unsigned int mantissa1:32;
unsigned int mantissa0:32;
unsigned int exponent:15;
unsigned int negative:1;
unsigned int empty:16;
-#else
-#error which endian?
#endif
- } ieee;
+ }ieee;
};
#define IEEE854_LONG_DOUBLE_BIAS 0x3fff
--- a/llt/int2str.c
+++ b/llt/int2str.c
@@ -1,30 +1,30 @@
#include "llt.h"
-char *uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
+char *
+uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
{- int i = len-1;
- uint64_t b = (uint64_t)base;
- char ch;
- dest[i--] = '\0';
- while (i >= 0) {- ch = (char)(num % b);
- if (ch < 10)
- ch += '0';
- else
- ch = ch-10+'a';
- dest[i--] = ch;
- num /= b;
- if (num == 0)
- break;
- }
- return &dest[i+1];
+ int i = len-1;
+ uint64_t b = (uint64_t)base;
+ char ch;
+ dest[i--] = '\0';
+ while(i >= 0){+ ch = (char)(num % b);
+ if(ch < 10)
+ ch += '0';
+ else
+ ch = ch-10+'a';
+ dest[i--] = ch;
+ num /= b;
+ if(num == 0)
+ break;
+ }
+ return &dest[i+1];
}
-int isdigit_base(char c, int base)
+int
+isdigit_base(char c, int base)
{- if (base < 11)
- return (c >= '0' && c < '0'+base);
- return ((c >= '0' && c <= '9') ||
- (c >= 'a' && c < 'a'+base-10) ||
- (c >= 'A' && c < 'A'+base-10));
+ if(base < 11)
+ return c >= '0' && c < '0'+base;
+ return (c >= '0' && c <= '9') || (c >= 'a' && c < 'a'+base-10) || (c >= 'A' && c < 'A'+base-10);
}
--- a/llt/ios.c
+++ b/llt/ios.c
@@ -2,23 +2,28 @@
#define MOST_OF(x) ((x) - ((x)>>4))
+ios_t *ios_stdin = nil;
+ios_t *ios_stdout = nil;
+ios_t *ios_stderr = nil;
+
/* OS-level primitive wrappers */
-void *llt_memrchr(const void *s, int c, size_t n)
+void *
+llt_memrchr(const void *s, int c, size_t n)
{- const uint8_t *src = (const uint8_t*)s + n;
- uint8_t uc = c;
- while (--src >= (uint8_t *) s)
- if (*src == uc)
- return (void *) src;
- return nil;
+ const uint8_t *src = (const uint8_t*)s + n;
+ uint8_t uc = c;
+ while(--src >= (uint8_t*)s)
+ if(*src == uc)
+ return (void *)src;
+ return nil;
}
#if !defined(__plan9__)
-static int _enonfatal(int err)
+static int
+_enonfatal(int err)
{- return (err == EAGAIN || err == EINPROGRESS || err == EINTR ||
- err == EWOULDBLOCK);
+ return err == EAGAIN || err == EINPROGRESS || err == EINTR || err == EWOULDBLOCK;
}
#define SLEEP_TIME 5//ms
#endif
@@ -25,976 +30,988 @@
// return error code, #bytes read in *nread
// these wrappers retry operations until success or a fatal error
-static int _os_read(long fd, char *buf, size_t n, size_t *nread)
+static int
+_os_read(long fd, char *buf, size_t n, size_t *nread)
{- ssize_t r;
+ ssize_t r;
- while (1) {- r = read((int)fd, buf, n);
- if (r > -1) {- *nread = (size_t)r;
- break;
- }
+ while(1){+ r = read((int)fd, buf, n);
+ if(r > -1){+ *nread = (size_t)r;
+ break;
+ }
#if defined(__plan9__)
- return r;
+ return r;
#else
- if (!_enonfatal(errno)) {- *nread = 0;
- return errno;
- }
- sleep_ms(SLEEP_TIME);
+ if(!_enonfatal(errno)){+ *nread = 0;
+ return errno;
+ }
+ sleep_ms(SLEEP_TIME);
#endif
- }
- return 0;
+ }
+ return 0;
}
-static int _os_read_all(long fd, char *buf, size_t n, size_t *nread)
+static int
+_os_read_all(long fd, char *buf, size_t n, size_t *nread)
{- size_t got;
+ size_t got;
- *nread = 0;
+ *nread = 0;
- while (n>0) {- int err = _os_read(fd, buf, n, &got);
- n -= got;
- *nread += got;
- buf += got;
- if (err || got==0)
- return err;
- }
- return 0;
+ while(n > 0){+ int err = _os_read(fd, buf, n, &got);
+ n -= got;
+ *nread += got;
+ buf += got;
+ if(err || got == 0)
+ return err;
+ }
+ return 0;
}
-static int _os_write(long fd, void *buf, size_t n, size_t *nwritten)
+static int
+_os_write(long fd, const void *buf, size_t n, size_t *nwritten)
{- ssize_t r;
+ ssize_t r;
- while (1) {- r = write((int)fd, buf, n);
- if (r > -1) {- *nwritten = (size_t)r;
- break;
- }
+ while(1){+ r = write((int)fd, buf, n);
+ if(r > -1){+ *nwritten = (size_t)r;
+ break;
+ }
#if defined(__plan9__)
- return r;
+ return r;
#else
- if (!_enonfatal(errno)) {- *nwritten = 0;
- return errno;
- }
- sleep_ms(SLEEP_TIME);
+ if(!_enonfatal(errno)){+ *nwritten = 0;
+ return errno;
+ }
+ sleep_ms(SLEEP_TIME);
#endif
- }
- return 0;
+ }
+ return 0;
}
-static int _os_write_all(long fd, char *buf, size_t n, size_t *nwritten)
+static int
+_os_write_all(long fd, const char *buf, size_t n, size_t *nwritten)
{- size_t wrote;
+ size_t wrote;
- *nwritten = 0;
-
- while (n>0) {- int err = _os_write(fd, buf, n, &wrote);
- n -= wrote;
- *nwritten += wrote;
- buf += wrote;
- if (err)
- return err;
- }
- return 0;
+ *nwritten = 0;
+ while(n > 0){+ int err = _os_write(fd, buf, n, &wrote);
+ n -= wrote;
+ *nwritten += wrote;
+ buf += wrote;
+ if(err)
+ return err;
+ }
+ return 0;
}
/* internal utility functions */
-static char *_buf_realloc(ios_t *s, size_t sz)
+static char *
+_buf_realloc(ios_t *s, size_t sz)
{- char *temp;
+ char *temp;
- if ((s->buf==nil || s->buf==&s->local[0]) && (sz <= IOS_INLSIZE)) {- /* TODO: if we want to allow shrinking, see if the buffer shrank
- down to this size, in which case we need to copy. */
- s->buf = &s->local[0];
- s->maxsize = IOS_INLSIZE;
- s->ownbuf = 1;
- return s->buf;
- }
+ if((s->buf == nil || s->buf == &s->local[0]) && sz <= IOS_INLSIZE){+ /* TODO: if we want to allow shrinking, see if the buffer shrank
+ down to this size, in which case we need to copy. */
+ s->buf = &s->local[0];
+ s->maxsize = IOS_INLSIZE;
+ s->ownbuf = 1;
+ return s->buf;
+ }
- if (sz <= s->maxsize) return s->buf;
+ if(sz <= s->maxsize)
+ return s->buf;
- if (s->ownbuf && s->buf != &s->local[0]) {- // if we own the buffer we're free to resize it
- // always allocate 1 bigger in case user wants to add a NUL
- // terminator after taking over the buffer
- temp = LLT_REALLOC(s->buf, sz);
- if (temp == nil)
- return nil;
- }
- else {- temp = LLT_ALLOC(sz);
- if (temp == nil)
- return nil;
- s->ownbuf = 1;
- if (s->size > 0)
- memmove(temp, s->buf, s->size);
- }
+ if(s->ownbuf && s->buf != &s->local[0]){+ // if we own the buffer we're free to resize it
+ // always allocate 1 bigger in case user wants to add a NUL
+ // terminator after taking over the buffer
+ temp = LLT_REALLOC(s->buf, sz);
+ if(temp == nil)
+ return nil;
+ }else{+ temp = LLT_ALLOC(sz);
+ if(temp == nil)
+ return nil;
+ s->ownbuf = 1;
+ if(s->size > 0)
+ memmove(temp, s->buf, s->size);
+ }
- s->buf = temp;
- s->maxsize = sz;
- return s->buf;
+ s->buf = temp;
+ s->maxsize = sz;
+ return s->buf;
}
// write a block of data into the buffer at the current position, resizing
// if necessary. returns # written.
-static size_t _write_grow(ios_t *s, char *data, size_t n)
+static size_t
+_write_grow(ios_t *s, const char *data, size_t n)
{- size_t amt;
- size_t newsize;
+ size_t amt;
+ size_t newsize;
- if (n == 0)
- return 0;
+ if(n == 0)
+ return 0;
- if (s->bpos + n > s->size) {- if (s->bpos + n > s->maxsize) {- /* TODO: here you might want to add a mechanism for limiting
- the growth of the stream. */
- newsize = s->maxsize ? s->maxsize * 2 : 8;
- while (s->bpos + n > newsize)
- newsize *= 2;
- if (_buf_realloc(s, newsize) == nil) {- /* no more space; write as much as we can */
- amt = s->maxsize - s->bpos;
- if (amt > 0) {- memmove(&s->buf[s->bpos], data, amt);
- }
- s->bpos += amt;
- s->size = s->maxsize;
- return amt;
- }
- }
- s->size = s->bpos + n;
- }
- memmove(s->buf + s->bpos, data, n);
- s->bpos += n;
+ if(s->bpos + n > s->size){+ if(s->bpos + n > s->maxsize){+ /* TODO: here you might want to add a mechanism for limiting
+ the growth of the stream. */
+ newsize = s->maxsize ? s->maxsize * 2 : 8;
+ while(s->bpos + n > newsize)
+ newsize *= 2;
+ if(_buf_realloc(s, newsize) == nil){+ /* no more space; write as much as we can */
+ amt = s->maxsize - s->bpos;
+ if(amt > 0){+ memmove(&s->buf[s->bpos], data, amt);
+ }
+ s->bpos += amt;
+ s->size = s->maxsize;
+ return amt;
+ }
+ }
+ s->size = s->bpos + n;
+ }
+ memmove(s->buf + s->bpos, data, n);
+ s->bpos += n;
- return n;
+ return n;
}
/* interface functions, low level */
-static size_t _ios_read(ios_t *s, char *dest, size_t n, int all)
+static size_t
+_ios_read(ios_t *s, char *dest, size_t n, int all)
{- size_t tot = 0;
- size_t got, avail;
+ size_t tot = 0;
+ size_t got, avail;
- while (n > 0) {- avail = s->size - s->bpos;
-
- if (avail > 0) {- size_t ncopy = (avail >= n) ? n : avail;
- memmove(dest, s->buf + s->bpos, ncopy);
- s->bpos += ncopy;
- if (ncopy >= n) {- s->state = bst_rd;
- return tot+ncopy;
- }
- }
- if (s->bm == bm_mem || s->fd == -1) {- // can't get any more data
- s->state = bst_rd;
- if (avail == 0)
- s->_eof = 1;
- return avail;
- }
-
- dest += avail;
- n -= avail;
- tot += avail;
-
- ios_flush(s);
- s->bpos = s->size = 0;
- s->state = bst_rd;
-
- s->fpos = -1;
- if (n > MOST_OF(s->maxsize)) {- // doesn't fit comfortably in buffer; go direct
- if (all)
- _os_read_all(s->fd, dest, n, &got);
- else
- _os_read(s->fd, dest, n, &got);
- tot += got;
- if (got == 0)
- s->_eof = 1;
- return tot;
- }
- else {- // refill buffer
- if (_os_read(s->fd, s->buf, s->maxsize, &got)) {- s->_eof = 1;
- return tot;
- }
- if (got == 0) {- s->_eof = 1;
- return tot;
- }
- s->size = got;
- }
- }
+ while(n > 0){+ avail = s->size - s->bpos;
- return tot;
+ if(avail > 0){+ size_t ncopy = avail >= n ? n : avail;
+ memmove(dest, s->buf + s->bpos, ncopy);
+ s->bpos += ncopy;
+ if(ncopy >= n){+ s->state = bst_rd;
+ return tot+ncopy;
+ }
+ }
+ if(s->bm == bm_mem || s->fd == -1){+ // can't get any more data
+ s->state = bst_rd;
+ if(avail == 0)
+ s->_eof = 1;
+ return avail;
+ }
+
+ dest += avail;
+ n -= avail;
+ tot += avail;
+
+ ios_flush(s);
+ s->bpos = s->size = 0;
+ s->state = bst_rd;
+
+ s->fpos = -1;
+ if(n > MOST_OF(s->maxsize)){+ // doesn't fit comfortably in buffer; go direct
+ if(all)
+ _os_read_all(s->fd, dest, n, &got);
+ else
+ _os_read(s->fd, dest, n, &got);
+ tot += got;
+ if(got == 0)
+ s->_eof = 1;
+ return tot;
+ }else{+ // refill buffer
+ if(_os_read(s->fd, s->buf, s->maxsize, &got)){+ s->_eof = 1;
+ return tot;
+ }
+ if(got == 0){+ s->_eof = 1;
+ return tot;
+ }
+ s->size = got;
+ }
+ }
+
+ return tot;
}
-size_t ios_read(ios_t *s, char *dest, size_t n)
+size_t
+ios_read(ios_t *s, char *dest, size_t n)
{- return _ios_read(s, dest, n, 0);
+ return _ios_read(s, dest, n, 0);
}
-size_t ios_readall(ios_t *s, char *dest, size_t n)
+size_t
+ios_readall(ios_t *s, char *dest, size_t n)
{- return _ios_read(s, dest, n, 1);
+ return _ios_read(s, dest, n, 1);
}
-size_t ios_readprep(ios_t *s, size_t n)
+size_t
+ios_readprep(ios_t *s, size_t n)
{- if (s->state == bst_wr && s->bm != bm_mem) {- ios_flush(s);
- s->bpos = s->size = 0;
- }
- size_t space = s->size - s->bpos;
- s->state = bst_rd;
- if (space >= n || s->bm == bm_mem || s->fd == -1)
- return space;
- if (s->maxsize < s->bpos+n) {- // it won't fit. grow buffer or move data back.
- if (n <= s->maxsize && space <= ((s->maxsize)>>2)) {- if (space)
- memmove(s->buf, s->buf+s->bpos, space);
- s->size -= s->bpos;
- s->bpos = 0;
- }
- else {- if (_buf_realloc(s, s->bpos + n)==nil)
- return space;
- }
- }
- size_t got;
- int result = _os_read(s->fd, s->buf+s->size, s->maxsize - s->size, &got);
- if (result)
- return space;
- s->size += got;
- return s->size - s->bpos;
+ if(s->state == bst_wr && s->bm != bm_mem){+ ios_flush(s);
+ s->bpos = s->size = 0;
+ }
+ size_t space = s->size - s->bpos;
+ s->state = bst_rd;
+ if(space >= n || s->bm == bm_mem || s->fd == -1)
+ return space;
+ if(s->maxsize < s->bpos+n){+ // it won't fit. grow buffer or move data back.
+ if(n <= s->maxsize && space <= ((s->maxsize)>>2)){+ if(space)
+ memmove(s->buf, s->buf+s->bpos, space);
+ s->size -= s->bpos;
+ s->bpos = 0;
+ }
+ else {+ if(_buf_realloc(s, s->bpos + n) == nil)
+ return space;
+ }
+ }
+ size_t got;
+ int result = _os_read(s->fd, s->buf+s->size, s->maxsize - s->size, &got);
+ if(result)
+ return space;
+ s->size += got;
+ return s->size - s->bpos;
}
-static void _write_update_pos(ios_t *s)
+static void
+_write_update_pos(ios_t *s)
{- if (s->bpos > s->ndirty) s->ndirty = s->bpos;
- if (s->bpos > s->size) s->size = s->bpos;
+ if(s->bpos > s->ndirty)
+ s->ndirty = s->bpos;
+ if(s->bpos > s->size)
+ s->size = s->bpos;
}
-size_t ios_write(ios_t *s, char *data, size_t n)
+size_t
+ios_write(ios_t *s, const char *data, size_t n)
{- if (s->readonly) return 0;
- if (n == 0) return 0;
- size_t space;
- size_t wrote = 0;
+ if(s->readonly)
+ return 0;
+ if(n == 0)
+ return 0;
+ size_t space;
+ size_t wrote = 0;
- if (s->state == bst_none) s->state = bst_wr;
- if (s->state == bst_rd) {- if (!s->rereadable) {- s->size = 0;
- s->bpos = 0;
- }
- space = s->size - s->bpos;
- }
- else {- space = s->maxsize - s->bpos;
- }
+ if(s->state == bst_none)
+ s->state = bst_wr;
+ if(s->state == bst_rd){+ if(!s->rereadable){+ s->size = 0;
+ s->bpos = 0;
+ }
+ space = s->size - s->bpos;
+ }else{+ space = s->maxsize - s->bpos;
+ }
- if (s->bm == bm_mem) {- wrote = _write_grow(s, data, n);
- }
- else if (s->bm == bm_none) {- s->fpos = -1;
- _os_write_all(s->fd, data, n, &wrote);
- return wrote;
- }
- else if (n <= space) {- if (s->bm == bm_line) {- char *nl;
- if ((nl=llt_memrchr(data, '\n', n)) != nil) {- size_t linesz = nl-data+1;
- s->bm = bm_block;
- wrote += ios_write(s, data, linesz);
- ios_flush(s);
- s->bm = bm_line;
- n -= linesz;
- data += linesz;
- }
- }
- memmove(s->buf + s->bpos, data, n);
- s->bpos += n;
- wrote += n;
- }
- else {- s->state = bst_wr;
- ios_flush(s);
- if (n > MOST_OF(s->maxsize)) {- _os_write_all(s->fd, data, n, &wrote);
- return wrote;
- }
- return ios_write(s, data, n);
- }
- _write_update_pos(s);
- return wrote;
+ if(s->bm == bm_mem){+ wrote = _write_grow(s, data, n);
+ }else if(s->bm == bm_none){+ s->fpos = -1;
+ _os_write_all(s->fd, data, n, &wrote);
+ return wrote;
+ }else if(n <= space){+ if(s->bm == bm_line){+ char *nl;
+ if((nl = llt_memrchr(data, '\n', n)) != nil){+ size_t linesz = nl-data+1;
+ s->bm = bm_block;
+ wrote += ios_write(s, data, linesz);
+ ios_flush(s);
+ s->bm = bm_line;
+ n -= linesz;
+ data += linesz;
+ }
+ }
+ memmove(s->buf + s->bpos, data, n);
+ s->bpos += n;
+ wrote += n;
+ }else{+ s->state = bst_wr;
+ ios_flush(s);
+ if(n > MOST_OF(s->maxsize)){+ _os_write_all(s->fd, data, n, &wrote);
+ return wrote;
+ }
+ return ios_write(s, data, n);
+ }
+ _write_update_pos(s);
+ return wrote;
}
-off_t ios_seek(ios_t *s, off_t pos)
+off_t
+ios_seek(ios_t *s, off_t pos)
{- s->_eof = 0;
- if (s->bm == bm_mem) {- if ((size_t)pos > s->size)
- return -1;
- s->bpos = pos;
- }
- else {- ios_flush(s);
- off_t fdpos = lseek(s->fd, pos, SEEK_SET);
- if (fdpos == (off_t)-1)
- return fdpos;
- s->bpos = s->size = 0;
- }
- return 0;
+ s->_eof = 0;
+ if(s->bm == bm_mem){+ if((size_t)pos > s->size)
+ return -1;
+ s->bpos = pos;
+ }else{+ ios_flush(s);
+ off_t fdpos = lseek(s->fd, pos, SEEK_SET);
+ if(fdpos == (off_t)-1)
+ return fdpos;
+ s->bpos = s->size = 0;
+ }
+ return 0;
}
-off_t ios_seek_end(ios_t *s)
+off_t
+ios_seek_end(ios_t *s)
{- s->_eof = 1;
- if (s->bm == bm_mem) {- s->bpos = s->size;
- }
- else {- ios_flush(s);
- off_t fdpos = lseek(s->fd, 0, SEEK_END);
- if (fdpos == (off_t)-1)
- return fdpos;
- s->bpos = s->size = 0;
- }
- return 0;
+ s->_eof = 1;
+ if(s->bm == bm_mem){+ s->bpos = s->size;
+ }else{+ ios_flush(s);
+ off_t fdpos = lseek(s->fd, 0, SEEK_END);
+ if(fdpos == (off_t)-1)
+ return fdpos;
+ s->bpos = s->size = 0;
+ }
+ return 0;
}
-off_t ios_skip(ios_t *s, off_t offs)
+off_t
+ios_skip(ios_t *s, off_t offs)
{- if (offs != 0) {- if (offs > 0) {- if (offs <= (off_t)(s->size-s->bpos)) {- s->bpos += offs;
- return 0;
- }
- else if (s->bm == bm_mem) {- // TODO: maybe grow buffer
- return -1;
- }
- }
- else if (offs < 0) {- if (-offs <= (off_t)s->bpos) {- s->bpos += offs;
- s->_eof = 0;
- return 0;
- }
- else if (s->bm == bm_mem) {- return -1;
- }
- }
- ios_flush(s);
- if (s->state == bst_wr)
- offs += s->bpos;
- else if (s->state == bst_rd)
- offs -= (s->size - s->bpos);
- off_t fdpos = lseek(s->fd, offs, SEEK_CUR);
- if (fdpos == (off_t)-1)
- return fdpos;
- s->bpos = s->size = 0;
- s->_eof = 0;
- }
- return 0;
+ if(offs != 0){+ if(offs > 0){+ if(offs <= (off_t)(s->size-s->bpos)){+ s->bpos += offs;
+ return 0;
+ }else if(s->bm == bm_mem){+ // TODO: maybe grow buffer
+ return -1;
+ }
+ }else if(offs < 0){+ if(-offs <= (off_t)s->bpos){+ s->bpos += offs;
+ s->_eof = 0;
+ return 0;
+ }else if(s->bm == bm_mem){+ return -1;
+ }
+ }
+ ios_flush(s);
+ if(s->state == bst_wr)
+ offs += s->bpos;
+ else if(s->state == bst_rd)
+ offs -= s->size - s->bpos;
+ off_t fdpos = lseek(s->fd, offs, SEEK_CUR);
+ if(fdpos == (off_t)-1)
+ return fdpos;
+ s->bpos = s->size = 0;
+ s->_eof = 0;
+ }
+ return 0;
}
-off_t ios_pos(ios_t *s)
+off_t
+ios_pos(ios_t *s)
{- if (s->bm == bm_mem)
- return (off_t)s->bpos;
+ if(s->bm == bm_mem)
+ return (off_t)s->bpos;
- off_t fdpos = s->fpos;
- if (fdpos == (off_t)-1) {- fdpos = lseek(s->fd, 0, SEEK_CUR);
- if (fdpos == (off_t)-1)
- return fdpos;
- s->fpos = fdpos;
- }
+ off_t fdpos = s->fpos;
+ if(fdpos == (off_t)-1){+ fdpos = lseek(s->fd, 0, SEEK_CUR);
+ if(fdpos == (off_t)-1)
+ return fdpos;
+ s->fpos = fdpos;
+ }
- if (s->state == bst_wr)
- fdpos += s->bpos;
- else if (s->state == bst_rd)
- fdpos -= (s->size - s->bpos);
- return fdpos;
+ if(s->state == bst_wr)
+ fdpos += s->bpos;
+ else if(s->state == bst_rd)
+ fdpos -= s->size - s->bpos;
+ return fdpos;
}
-size_t ios_trunc(ios_t *s, size_t size)
+size_t
+ios_trunc(ios_t *s, size_t size)
{- if (s->bm == bm_mem) {- if (size == s->size)
- return s->size;
- if (size < s->size) {- if (s->bpos > size)
- s->bpos = size;
- }
- else {- if (_buf_realloc(s, size)==nil)
- return s->size;
- }
- s->size = size;
- return size;
- }
- //todo
- return 0;
+ if(s->bm == bm_mem){+ if(size == s->size)
+ return s->size;
+ if(size < s->size){+ if(s->bpos > size)
+ s->bpos = size;
+ }else if(_buf_realloc(s, size) == nil)
+ return s->size;
+ s->size = size;
+ return size;
+ }
+ //todo
+ return 0;
}
-int ios_eof(ios_t *s)
+int
+ios_eof(ios_t *s)
{- if (s->bm == bm_mem)
- return (s->_eof ? 1 : 0);
- if (s->fd == -1)
- return 1;
- if (s->_eof)
- return 1;
- return 0;
+ if(s->bm == bm_mem)
+ return s->_eof;
+ return s->fd == -1 || s->_eof;
}
-int ios_flush(ios_t *s)
+int
+ios_flush(ios_t *s)
{- if (s->ndirty == 0 || s->bm == bm_mem || s->buf == nil)
- return 0;
- if (s->fd == -1)
- return -1;
+ if(s->ndirty == 0 || s->bm == bm_mem || s->buf == nil)
+ return 0;
+ if(s->fd == -1)
+ return -1;
- if (s->state == bst_rd) {- if (lseek(s->fd, -(off_t)s->size, SEEK_CUR) == (off_t)-1) {- }
- }
+ if(s->state == bst_rd){+ if(lseek(s->fd, -(off_t)s->size, SEEK_CUR) == (off_t)-1){+ // FIXME eh?
+ }
+ }
- size_t nw, ntowrite=s->ndirty;
- s->fpos = -1;
- int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
- // todo: try recovering from some kinds of errors (e.g. retry)
+ size_t nw, ntowrite = s->ndirty;
+ s->fpos = -1;
+ int err = _os_write_all(s->fd, s->buf, ntowrite, &nw);
+ // todo: try recovering from some kinds of errors (e.g. retry)
- if (s->state == bst_rd) {- if (lseek(s->fd, s->size - nw, SEEK_CUR) == (off_t)-1) {- }
- }
- else if (s->state == bst_wr) {- if (s->bpos != nw &&
- lseek(s->fd, (off_t)s->bpos - (off_t)nw, SEEK_CUR) == (off_t)-1) {- }
- // now preserve the invariant that data to write
- // begins at the beginning of the buffer, and s->size refers
- // to how much valid file data is stored in the buffer.
- if (s->size > s->ndirty) {- size_t delta = s->size - s->ndirty;
- memmove(s->buf, s->buf + s->ndirty, delta);
- }
- s->size -= s->ndirty;
- s->bpos = 0;
- }
+ if(s->state == bst_rd){+ if(lseek(s->fd, s->size - nw, SEEK_CUR) == (off_t)-1){+ // FIXME eh?
+ }
+ }else if(s->state == bst_wr){+ if(s->bpos != nw && lseek(s->fd, (off_t)s->bpos - (off_t)nw, SEEK_CUR) == (off_t)-1){+ // FIXME eh?
+ }
+ // now preserve the invariant that data to write
+ // begins at the beginning of the buffer, and s->size refers
+ // to how much valid file data is stored in the buffer.
+ if(s->size > s->ndirty){+ size_t delta = s->size - s->ndirty;
+ memmove(s->buf, s->buf + s->ndirty, delta);
+ }
+ s->size -= s->ndirty;
+ s->bpos = 0;
+ }
- s->ndirty = 0;
+ s->ndirty = 0;
- if (err)
- return err;
- if (nw < ntowrite)
- return -1;
- return 0;
+ if(err)
+ return err;
+ if(nw < ntowrite)
+ return -1;
+ return 0;
}
-void ios_close(ios_t *s)
+void
+ios_close(ios_t *s)
{- ios_flush(s);
- if (s->fd != -1 && s->ownfd)
- close(s->fd);
- s->fd = -1;
- if (s->buf!=nil && s->ownbuf && s->buf!=&s->local[0])
- LLT_FREE(s->buf);
- s->buf = nil;
- s->size = s->maxsize = s->bpos = 0;
+ ios_flush(s);
+ if(s->fd != -1 && s->ownfd)
+ close(s->fd);
+ s->fd = -1;
+ if(s->buf != nil && s->ownbuf && s->buf != &s->local[0])
+ LLT_FREE(s->buf);
+ s->buf = nil;
+ s->size = s->maxsize = s->bpos = 0;
}
-static void _buf_init(ios_t *s, bufmode_t bm)
+static void
+_buf_init(ios_t *s, bufmode_t bm)
{- s->bm = bm;
- if (s->bm == bm_mem || s->bm == bm_none) {- s->buf = &s->local[0];
- s->maxsize = IOS_INLSIZE;
- }
- else {- s->buf = nil;
- _buf_realloc(s, IOS_BUFSIZE);
- }
- s->size = s->bpos = 0;
+ s->bm = bm;
+ if(s->bm == bm_mem || s->bm == bm_none){+ s->buf = &s->local[0];
+ s->maxsize = IOS_INLSIZE;
+ }else{+ s->buf = nil;
+ _buf_realloc(s, IOS_BUFSIZE);
+ }
+ s->size = s->bpos = 0;
}
-char *ios_takebuf(ios_t *s, size_t *psize)
+char *
+ios_takebuf(ios_t *s, size_t *psize)
{- char *buf;
+ char *buf;
- ios_flush(s);
+ ios_flush(s);
- if (s->buf == &s->local[0] || s->buf == nil || (!s->ownbuf && s->size == s->maxsize)) {- buf = LLT_ALLOC(s->size+1);
- if (buf == nil)
- return nil;
- if (s->size)
- memmove(buf, s->buf, s->size);
- }
- else if (s->size == s->maxsize) {- buf = LLT_REALLOC(s->buf, s->size + 1);
- if (buf == nil)
- return nil;
- }
- else {- buf = s->buf;
- }
- buf[s->size] = '\0';
+ if(s->buf == &s->local[0] || s->buf == nil || (!s->ownbuf && s->size == s->maxsize)){+ buf = LLT_ALLOC(s->size+1);
+ if(buf == nil)
+ return nil;
+ if(s->size)
+ memmove(buf, s->buf, s->size);
+ }else if(s->size == s->maxsize){+ buf = LLT_REALLOC(s->buf, s->size + 1);
+ if(buf == nil)
+ return nil;
+ }else{+ buf = s->buf;
+ }
+ buf[s->size] = '\0';
+ *psize = s->size + 1;
- *psize = s->size + 1;
+ /* empty stream and reinitialize */
+ _buf_init(s, s->bm);
- /* empty stream and reinitialize */
- _buf_init(s, s->bm);
-
- return buf;
+ return buf;
}
-int ios_setbuf(ios_t *s, char *buf, size_t size, int own)
+int
+ios_setbuf(ios_t *s, char *buf, size_t size, int own)
{- ios_flush(s);
- size_t nvalid;
+ ios_flush(s);
+ size_t nvalid;
- nvalid = (size < s->size) ? size : s->size;
- if (nvalid > 0)
- memmove(buf, s->buf, nvalid);
- if (s->bpos > nvalid) {- // truncated
- s->bpos = nvalid;
- }
- s->size = nvalid;
+ nvalid = size < s->size ? size : s->size;
+ if(nvalid > 0)
+ memmove(buf, s->buf, nvalid);
+ if(s->bpos > nvalid){+ // truncated
+ s->bpos = nvalid;
+ }
+ s->size = nvalid;
- if (s->buf!=nil && s->ownbuf && s->buf!=&s->local[0])
- LLT_FREE(s->buf);
- s->buf = buf;
- s->maxsize = size;
- s->ownbuf = own;
- return 0;
+ if(s->buf != nil && s->ownbuf && s->buf != &s->local[0])
+ LLT_FREE(s->buf);
+ s->buf = buf;
+ s->maxsize = size;
+ s->ownbuf = own;
+ return 0;
}
-int ios_bufmode(ios_t *s, bufmode_t mode)
+int
+ios_bufmode(ios_t *s, bufmode_t mode)
{- // no fd; can only do mem-only buffering
- if (s->fd == -1 && mode != bm_mem)
- return -1;
- s->bm = mode;
- return 0;
+ // no fd; can only do mem-only buffering
+ if(s->fd == -1 && mode != bm_mem)
+ return -1;
+ s->bm = mode;
+ return 0;
}
-void ios_set_readonly(ios_t *s)
+void
+ios_set_readonly(ios_t *s)
{- if (s->readonly) return;
- ios_flush(s);
- s->state = bst_none;
- s->readonly = 1;
+ if(s->readonly)
+ return;
+ ios_flush(s);
+ s->state = bst_none;
+ s->readonly = 1;
}
-static size_t ios_copy_(ios_t *to, ios_t *from, size_t nbytes, int all)
+static size_t
+ios_copy_(ios_t *to, ios_t *from, size_t nbytes, int all)
{- size_t total = 0, avail;
- if (!ios_eof(from)) {- do {- avail = ios_readprep(from, IOS_BUFSIZE/2);
- if (avail == 0) {- from->_eof = 1;
- break;
- }
- size_t written, ntowrite;
- ntowrite = (avail <= nbytes || all) ? avail : nbytes;
- written = ios_write(to, from->buf+from->bpos, ntowrite);
- // TODO: should this be +=written instead?
- from->bpos += ntowrite;
- total += written;
- if (!all) {- nbytes -= written;
- if (nbytes == 0)
- break;
- }
- if (written < ntowrite)
- break;
- } while (!ios_eof(from));
- }
- return total;
+ size_t total = 0, avail;
+ if(!ios_eof(from)){+ do{+ avail = ios_readprep(from, IOS_BUFSIZE/2);
+ if(avail == 0){+ from->_eof = 1;
+ break;
+ }
+ size_t written, ntowrite;
+ ntowrite = (avail <= nbytes || all) ? avail : nbytes;
+ written = ios_write(to, from->buf+from->bpos, ntowrite);
+ // TODO: should this be +=written instead?
+ from->bpos += ntowrite;
+ total += written;
+ if(!all){+ nbytes -= written;
+ if(nbytes == 0)
+ break;
+ }
+ if(written < ntowrite)
+ break;
+ }while(!ios_eof(from));
+ }
+ return total;
}
-size_t ios_copy(ios_t *to, ios_t *from, size_t nbytes)
+size_t
+ios_copy(ios_t *to, ios_t *from, size_t nbytes)
{- return ios_copy_(to, from, nbytes, 0);
+ return ios_copy_(to, from, nbytes, 0);
}
-size_t ios_copyall(ios_t *to, ios_t *from)
+size_t
+ios_copyall(ios_t *to, ios_t *from)
{- return ios_copy_(to, from, 0, 1);
+ return ios_copy_(to, from, 0, 1);
}
#define LINE_CHUNK_SIZE 160
-size_t ios_copyuntil(ios_t *to, ios_t *from, char delim)
+size_t
+ios_copyuntil(ios_t *to, ios_t *from, char delim)
{- size_t total = 0, avail=from->size - from->bpos;
- int first = 1;
- if (!ios_eof(from)) {- do {- if (avail == 0) {- first = 0;
- avail = ios_readprep(from, LINE_CHUNK_SIZE);
- }
- size_t written;
- char *pd = (char*)memchr(from->buf+from->bpos, delim, avail);
- if (pd == nil) {- written = ios_write(to, from->buf+from->bpos, avail);
- from->bpos += avail;
- total += written;
- avail = 0;
- }
- else {- size_t ntowrite = pd - (from->buf+from->bpos) + 1;
- written = ios_write(to, from->buf+from->bpos, ntowrite);
- from->bpos += ntowrite;
- total += written;
- return total;
- }
- } while (!ios_eof(from) && (first || avail >= LINE_CHUNK_SIZE));
- }
- from->_eof = 1;
- return total;
+ size_t total = 0, avail = from->size - from->bpos;
+ int first = 1;
+ if(!ios_eof(from)){+ do{+ if(avail == 0){+ first = 0;
+ avail = ios_readprep(from, LINE_CHUNK_SIZE);
+ }
+ size_t written;
+ char *pd = memchr(from->buf+from->bpos, delim, avail);
+ if(pd == nil){+ written = ios_write(to, from->buf+from->bpos, avail);
+ from->bpos += avail;
+ total += written;
+ avail = 0;
+ }else{+ size_t ntowrite = pd - (from->buf+from->bpos) + 1;
+ written = ios_write(to, from->buf+from->bpos, ntowrite);
+ from->bpos += ntowrite;
+ total += written;
+ return total;
+ }
+ }while(!ios_eof(from) && (first || avail >= LINE_CHUNK_SIZE));
+ }
+ from->_eof = 1;
+ return total;
}
-static void _ios_init(ios_t *s)
+static void
+_ios_init(ios_t *s)
{- // put all fields in a sane initial state
- s->bm = bm_block;
- s->state = bst_none;
- s->errcode = 0;
- s->buf = nil;
- s->maxsize = 0;
- s->size = 0;
- s->bpos = 0;
- s->ndirty = 0;
- s->fpos = -1;
- s->lineno = 1;
- s->fd = -1;
- s->ownbuf = 1;
- s->ownfd = 0;
- s->_eof = 0;
- s->rereadable = 0;
- s->readonly = 0;
+ // put all fields in a sane initial state
+ memset(s, 0, sizeof(*s));
+ s->bm = bm_block;
+ s->state = bst_none;
+ s->fpos = -1;
+ s->lineno = 1;
+ s->fd = -1;
+ s->ownbuf = 1;
}
/* stream object initializers. we do no allocation. */
-ios_t *ios_file(ios_t *s, char *fname, int rd, int wr, int creat, int trunc)
+ios_t *
+ios_file(ios_t *s, char *fname, int rd, int wr, int creat, int trunc)
{- int fd;
- if (!(rd || wr))
- // must specify read and/or write
- goto open_file_err;
- int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY;
- if (trunc) flags |= O_TRUNC;
+ int fd;
+ if(!(rd || wr)) // must specify read and/or write
+ goto open_file_err;
+ int flags = wr ? (rd ? O_RDWR : O_WRONLY) : O_RDONLY;
+ if(trunc)
+ flags |= O_TRUNC;
#if defined(__plan9__)
- fd = creat ? create(fname, flags, 0644) : open(fname, flags);
+ fd = creat ? create(fname, flags, 0644) : open(fname, flags);
#else
- if (creat) flags |= O_CREAT;
- fd = open(fname, flags, 0644);
+ if(creat)
+ flags |= O_CREAT;
+ fd = open(fname, flags, 0644);
#endif
- s = ios_fd(s, fd, 1, 1);
- if (fd < 0)
- goto open_file_err;
- if (!wr)
- s->readonly = 1;
- return s;
- open_file_err:
- s->fd = -1;
- return nil;
+ s = ios_fd(s, fd, 1, 1);
+ if(fd < 0)
+ goto open_file_err;
+ if(!wr)
+ s->readonly = 1;
+ return s;
+open_file_err:
+ s->fd = -1;
+ return nil;
}
-ios_t *ios_mem(ios_t *s, size_t initsize)
+ios_t *
+ios_mem(ios_t *s, size_t initsize)
{- _ios_init(s);
- s->bm = bm_mem;
- _buf_realloc(s, initsize);
- return s;
+ _ios_init(s);
+ s->bm = bm_mem;
+ _buf_realloc(s, initsize);
+ return s;
}
-ios_t *ios_str(ios_t *s, char *str)
+ios_t *
+ios_str(ios_t *s, char *str)
{- size_t n = strlen(str);
- if (ios_mem(s, n+1)==nil) return nil;
- ios_write(s, str, n+1);
- ios_seek(s, 0);
- return s;
+ size_t n = strlen(str);
+ if(ios_mem(s, n+1) == nil)
+ return nil;
+ ios_write(s, str, n+1);
+ ios_seek(s, 0);
+ return s;
}
-ios_t *ios_static_buffer(ios_t *s, const char *buf, size_t sz)
+ios_t *
+ios_static_buffer(ios_t *s, const char *buf, size_t sz)
{- ios_mem(s, 0);
- ios_setbuf(s, (char*)buf, sz, 0);
- s->size = sz;
- ios_set_readonly(s);
- return s;
+ ios_mem(s, 0);
+ ios_setbuf(s, (char*)buf, sz, 0);
+ s->size = sz;
+ ios_set_readonly(s);
+ return s;
}
-ios_t *ios_fd(ios_t *s, long fd, int isfile, int own)
+ios_t *
+ios_fd(ios_t *s, long fd, int isfile, int own)
{- _ios_init(s);
- s->fd = fd;
- if (isfile) s->rereadable = 1;
- _buf_init(s, bm_block);
- s->ownfd = own;
- if (fd == STDERR_FILENO)
- s->bm = bm_none;
- return s;
+ _ios_init(s);
+ s->fd = fd;
+ if(isfile)
+ s->rereadable = 1;
+ _buf_init(s, bm_block);
+ s->ownfd = own;
+ if(fd == STDERR_FILENO)
+ s->bm = bm_none;
+ return s;
}
-ios_t *ios_stdin = nil;
-ios_t *ios_stdout = nil;
-ios_t *ios_stderr = nil;
-
void ios_init_stdstreams(void)
{- ios_stdin = LLT_ALLOC(sizeof(ios_t));
- ios_fd(ios_stdin, STDIN_FILENO, 0, 0);
+ ios_stdin = LLT_ALLOC(sizeof(ios_t));
+ ios_fd(ios_stdin, STDIN_FILENO, 0, 0);
- ios_stdout = LLT_ALLOC(sizeof(ios_t));
- ios_fd(ios_stdout, STDOUT_FILENO, 0, 0);
- ios_stdout->bm = bm_line;
+ ios_stdout = LLT_ALLOC(sizeof(ios_t));
+ ios_fd(ios_stdout, STDOUT_FILENO, 0, 0);
+ ios_stdout->bm = bm_line;
- ios_stderr = LLT_ALLOC(sizeof(ios_t));
- ios_fd(ios_stderr, STDERR_FILENO, 0, 0);
- ios_stderr->bm = bm_none;
+ ios_stderr = LLT_ALLOC(sizeof(ios_t));
+ ios_fd(ios_stderr, STDERR_FILENO, 0, 0);
+ ios_stderr->bm = bm_none;
}
/* higher level interface */
-int ios_putc(int c, ios_t *s)
+int
+ios_putc(int c, ios_t *s)
{- char ch = (char)c;
+ char ch = c;
- if (s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none) {- s->buf[s->bpos++] = ch;
- _write_update_pos(s);
- if (s->bm == bm_line && ch == '\n')
- ios_flush(s);
- return 1;
- }
- return (int)ios_write(s, &ch, 1);
+ if(s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none){+ s->buf[s->bpos++] = ch;
+ _write_update_pos(s);
+ if(s->bm == bm_line && ch == '\n')
+ ios_flush(s);
+ return 1;
+ }
+ return ios_write(s, &ch, 1);
}
-int ios_getc(ios_t *s)
+int
+ios_getc(ios_t *s)
{- char ch;
- if (s->state == bst_rd && s->bpos < s->size) {- ch = s->buf[s->bpos++];
- }
- else {- if (s->_eof) return IOS_EOF;
- if (ios_read(s, &ch, 1) < 1)
- return IOS_EOF;
- }
- if (ch == '\n') s->lineno++;
- return (uint8_t)ch;
+ char ch;
+ if(s->state == bst_rd && s->bpos < s->size)
+ ch = s->buf[s->bpos++];
+ else if(s->_eof)
+ return IOS_EOF;
+ else if(ios_read(s, &ch, 1) < 1)
+ return IOS_EOF;
+ if(ch == '\n')
+ s->lineno++;
+ return (uint8_t)ch;
}
-int ios_peekc(ios_t *s)
+int
+ios_peekc(ios_t *s)
{- if (s->bpos < s->size)
- return (uint8_t)s->buf[s->bpos];
- if (s->_eof) return IOS_EOF;
- size_t n = ios_readprep(s, 1);
- if (n == 0) return IOS_EOF;
- return (uint8_t)s->buf[s->bpos];
+ if(s->bpos < s->size)
+ return (uint8_t)s->buf[s->bpos];
+ if(s->_eof)
+ return IOS_EOF;
+ size_t n = ios_readprep(s, 1);
+ if(n == 0)
+ return IOS_EOF;
+ return (uint8_t)s->buf[s->bpos];
}
-int ios_ungetc(int c, ios_t *s)
+int
+ios_ungetc(int c, ios_t *s)
{- if (s->state == bst_wr)
- return IOS_EOF;
- if (c == '\n')
- s->lineno--;
- if (s->bpos > 0) {- s->bpos--;
- if (s->buf[s->bpos] != (char)c)
- s->buf[s->bpos] = (char)c;
- s->_eof = 0;
- return c;
- }
- if (s->size == s->maxsize) {- if (_buf_realloc(s, s->maxsize*2) == nil)
- return IOS_EOF;
- }
- memmove(s->buf + 1, s->buf, s->size);
- s->buf[0] = (char)c;
- s->size++;
- s->_eof = 0;
- return c;
+ if(s->state == bst_wr)
+ return IOS_EOF;
+ if(c == '\n')
+ s->lineno--;
+ if(s->bpos > 0){+ s->bpos--;
+ if(s->buf[s->bpos] != (char)c)
+ s->buf[s->bpos] = (char)c;
+ s->_eof = 0;
+ return c;
+ }
+ if(s->size == s->maxsize && _buf_realloc(s, s->maxsize*2) == nil)
+ return IOS_EOF;
+ memmove(s->buf + 1, s->buf, s->size);
+ s->buf[0] = (char)c;
+ s->size++;
+ s->_eof = 0;
+ return c;
}
-int ios_getutf8(ios_t *s, uint32_t *pwc)
+int
+ios_getutf8(ios_t *s, uint32_t *pwc)
{- int c;
- size_t sz;
- char c0;
- char buf[8];
+ int c;
+ size_t sz;
+ char c0;
+ char buf[8];
- c = ios_peekc(s);
- if (c == IOS_EOF) {- s->_eof = 1;
- return IOS_EOF;
- }
- c0 = (char)c;
- if ((uint8_t)c0 < 0x80) {- ios_getc(s);
- *pwc = (uint32_t)(uint8_t)c0;
- return 1;
- }
- sz = u8_seqlen(&c0)-1;
- if (!isutf(c0) || sz > 3)
- return 0;
- if (ios_readprep(s, sz) < sz) {- // NOTE: this returns EOF even though some bytes are available
- // so we do not set s->_eof on this code path
- return IOS_EOF;
- }
- if (u8_isvalid(&s->buf[s->bpos], sz+1)) {- size_t i = s->bpos;
- *pwc = u8_nextchar(s->buf, &i);
- ios_read(s, buf, sz+1);
- return 1;
- }
- return 0;
+ c = ios_peekc(s);
+ if(c == IOS_EOF){+ s->_eof = 1;
+ return IOS_EOF;
+ }
+ c0 = (char)c;
+ if((uint8_t)c0 < 0x80){+ ios_getc(s);
+ *pwc = (uint32_t)(uint8_t)c0;
+ return 1;
+ }
+ sz = u8_seqlen(&c0)-1;
+ if(!isutf(c0) || sz > 3)
+ return 0;
+ if(ios_readprep(s, sz) < sz){+ // NOTE: this returns EOF even though some bytes are available
+ // so we do not set s->_eof on this code path
+ return IOS_EOF;
+ }
+ if(u8_isvalid(&s->buf[s->bpos], sz+1)){+ size_t i = s->bpos;
+ *pwc = u8_nextchar(s->buf, &i);
+ ios_read(s, buf, sz+1);
+ return 1;
+ }
+ return 0;
}
-int ios_peekutf8(ios_t *s, uint32_t *pwc)
+int
+ios_peekutf8(ios_t *s, uint32_t *pwc)
{- int c;
- size_t sz;
- char c0;
+ int c;
+ size_t sz;
+ char c0;
- c = ios_peekc(s);
- if (c == IOS_EOF)
- return IOS_EOF;
- c0 = (char)c;
- if ((uint8_t)c0 < 0x80) {- *pwc = (uint32_t)(uint8_t)c0;
- return 1;
- }
- sz = u8_seqlen(&c0)-1;
- if (!isutf(c0) || sz > 3)
- return 0;
- if (ios_readprep(s, sz) < sz)
- return IOS_EOF;
- if (u8_isvalid(&s->buf[s->bpos], sz+1)) {- size_t i = s->bpos;
- *pwc = u8_nextchar(s->buf, &i);
- return 1;
- }
- return 0;
+ c = ios_peekc(s);
+ if(c == IOS_EOF)
+ return IOS_EOF;
+ c0 = (char)c;
+ if((uint8_t)c0 < 0x80){+ *pwc = (uint32_t)(uint8_t)c0;
+ return 1;
+ }
+ sz = u8_seqlen(&c0)-1;
+ if(!isutf(c0) || sz > 3)
+ return 0;
+ if(ios_readprep(s, sz) < sz)
+ return IOS_EOF;
+ if(u8_isvalid(&s->buf[s->bpos], sz+1)){+ size_t i = s->bpos;
+ *pwc = u8_nextchar(s->buf, &i);
+ return 1;
+ }
+ return 0;
}
-int ios_pututf8(ios_t *s, uint32_t wc)
+int
+ios_pututf8(ios_t *s, uint32_t wc)
{- char buf[8];
- if (wc < 0x80)
- return ios_putc((int)wc, s);
- size_t n = u8_toutf8(buf, 8, &wc, 1);
- return ios_write(s, buf, n);
+ char buf[8];
+ if(wc < 0x80)
+ return ios_putc((int)wc, s);
+ size_t n = u8_toutf8(buf, 8, &wc, 1);
+ return ios_write(s, buf, n);
}
-void ios_purge(ios_t *s)
+void
+ios_purge(ios_t *s)
{- if (s->state == bst_rd) {- s->bpos = s->size;
- }
+ if(s->state == bst_rd)
+ s->bpos = s->size;
}
-char *ios_readline(ios_t *s)
+char *
+ios_readline(ios_t *s)
{- ios_t dest;
- ios_mem(&dest, 0);
- ios_copyuntil(&dest, s, '\n');
- size_t n;
- return ios_takebuf(&dest, &n);
+ ios_t dest;
+ ios_mem(&dest, 0);
+ ios_copyuntil(&dest, s, '\n');
+ size_t n;
+ return ios_takebuf(&dest, &n);
}
-int vasprintf(char **strp, const char *fmt, va_list ap);
-
-int ios_vprintf(ios_t *s, const char *format, va_list args)
+int
+ios_vprintf(ios_t *s, const char *format, va_list args)
{- char *str;
- int c;
+ char *str;
+ int c;
#if defined(__plan9__)
- // FIXME: this is wrong
- str = vsmprint(format, args);
- c = strlen(str);
- if (c >= 0) {- ios_write(s, str, c);
- free(str);
- }
- va_end(args);
+ str = vsmprint(format, args);
+ if((c = strlen(str)) >= 0)
+ ios_write(s, str, c);
+ free(str);
#else
- va_list al;
- va_copy(al, args);
+ va_list al;
+ va_copy(al, args);
- if (s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none) {- int avail = s->maxsize - s->bpos;
- char *start = s->buf + s->bpos;
- c = vsnprintf(start, avail, format, args);
- if (c < 0) {- va_end(al);
- return c;
- }
- if (c < avail) {- s->bpos += (size_t)c;
- _write_update_pos(s);
- // TODO: only works right if newline is at end
- if (s->bm == bm_line && llt_memrchr(start, '\n', (size_t)c))
- ios_flush(s);
- va_end(al);
- return c;
- }
- }
- c = vasprintf(&str, format, al);
- if (c >= 0) {- ios_write(s, str, c);
- LLT_FREE(str);
- }
- va_end(al);
+ if(s->state == bst_wr && s->bpos < s->maxsize && s->bm != bm_none){+ int avail = s->maxsize - s->bpos;
+ char *start = s->buf + s->bpos;
+ c = vsnprintf(start, avail, format, args);
+ if(c < 0){+ va_end(al);
+ return c;
+ }
+ if(c < avail){+ s->bpos += (size_t)c;
+ _write_update_pos(s);
+ // TODO: only works right if newline is at end
+ if(s->bm == bm_line && llt_memrchr(start, '\n', (size_t)c))
+ ios_flush(s);
+ va_end(al);
+ return c;
+ }
+ }
+ c = vasprintf(&str, format, al);
+ if(c >= 0){+ ios_write(s, str, c);
+ LLT_FREE(str);
+ }
+ va_end(al);
#endif
- return c;
+ return c;
}
-int ios_printf(ios_t *s, const char *format, ...)
+int
+ios_printf(ios_t *s, const char *format, ...)
{- va_list args;
- int c;
+ va_list args;
+ int c;
- va_start(args, format);
- c = ios_vprintf(s, format, args);
- va_end(args);
- return c;
+ va_start(args, format);
+ c = ios_vprintf(s, format, args);
+ va_end(args);
+ return c;
}
--- a/llt/ios.h
+++ b/llt/ios.h
@@ -1,60 +1,69 @@
// this flag controls when data actually moves out to the underlying I/O
// channel. memory streams are a special case of this where the data
// never moves out.
-typedef enum { bm_none, bm_line, bm_block, bm_mem } bufmode_t;+typedef enum {+ bm_none,
+ bm_line,
+ bm_block,
+ bm_mem,
+}bufmode_t;
-typedef enum { bst_none, bst_rd, bst_wr } bufstate_t;+typedef enum {+ bst_none,
+ bst_rd,
+ bst_wr,
+}bufstate_t;
#define IOS_INLSIZE 54
#define IOS_BUFSIZE 131072
typedef struct {- bufmode_t bm;
+ bufmode_t bm;
- // the state only indicates where the underlying file position is relative
- // to the buffer. reading: at the end. writing: at the beginning.
- // in general, you can do any operation in any state.
- bufstate_t state;
+ // the state only indicates where the underlying file position is relative
+ // to the buffer. reading: at the end. writing: at the beginning.
+ // in general, you can do any operation in any state.
+ bufstate_t state;
- int errcode;
+ int errcode;
- char *buf; // start of buffer
- size_t maxsize; // space allocated to buffer
- size_t size; // length of valid data in buf, >=ndirty
- size_t bpos; // current position in buffer
- size_t ndirty; // # bytes at &buf[0] that need to be written
+ char *buf; // start of buffer
+ size_t maxsize; // space allocated to buffer
+ size_t size; // length of valid data in buf, >=ndirty
+ size_t bpos; // current position in buffer
+ size_t ndirty; // # bytes at &buf[0] that need to be written
- off_t fpos; // cached file pos
- size_t lineno; // current line number
+ off_t fpos; // cached file pos
+ size_t lineno; // current line number
- int fd;
+ int fd;
- uint8_t readonly:1;
- uint8_t ownbuf:1;
- uint8_t ownfd:1;
- uint8_t _eof:1;
+ uint8_t readonly:1;
+ uint8_t ownbuf:1;
+ uint8_t ownfd:1;
+ uint8_t _eof:1;
- // this means you can read, seek back, then read the same data
- // again any number of times. usually only true for files and strings.
- uint8_t rereadable:1;
+ // this means you can read, seek back, then read the same data
+ // again any number of times. usually only true for files and strings.
+ uint8_t rereadable:1;
- // this enables "stenciled writes". you can alternately write and
- // seek without flushing in between. this performs read-before-write
- // to populate the buffer, so "rereadable" capability is required.
- // this is off by default.
- //uint8_t stenciled:1;
+ // this enables "stenciled writes". you can alternately write and
+ // seek without flushing in between. this performs read-before-write
+ // to populate the buffer, so "rereadable" capability is required.
+ // this is off by default.
+ //uint8_t stenciled:1;
- // request durable writes (fsync)
- // uint8_t durable:1;
+ // request durable writes (fsync)
+ // uint8_t durable:1;
- // todo: mutex
- char local[IOS_INLSIZE];
-} ios_t;
+ // todo: mutex
+ char local[IOS_INLSIZE];
+}ios_t;
/* low-level interface functions */
size_t ios_read(ios_t *s, char *dest, size_t n);
size_t ios_readall(ios_t *s, char *dest, size_t n);
-size_t ios_write(ios_t *s, char *data, size_t n);
+size_t ios_write(ios_t *s, const char *data, size_t n);
off_t ios_seek(ios_t *s, off_t pos); // absolute seek
off_t ios_seek_end(ios_t *s);
off_t ios_skip(ios_t *s, off_t offs); // relative seek
@@ -174,7 +183,7 @@
- expose buffer to user, allow user-owned buffers
- allow direct I/O, don't always go through buffer
- buffer-internal seeking. makes seeking back 1-2 bytes very fast,
- and makes it possible for sockets where it otherwise wouldn't be
+ and makes it possible for sockets where it otherwise wouldn't be
- tries to allow switching between reading and writing
- support 64-bit and large files
- efficient, low-latency buffering
--- a/llt/llt.h
+++ b/llt/llt.h
@@ -58,7 +58,7 @@
#define sign_bit(r) ((*(uint64_t*)&(r)) & BIT63)
#define LABS(n) (((n)^((n)>>(NBITS-1))) - ((n)>>(NBITS-1)))
#define NBABS(n,nb) (((n)^((n)>>((nb)-1))) - ((n)>>((nb)-1)))
-#define DFINITE(d) (((*(uint64_t*)&(d))&0x7ff0000000000000ULL)!=0x7ff0000000000000ULL)
+#define DFINITE(d) (((*(uint64_t*)&(d))&0x7ff0000000000000ULL) != 0x7ff0000000000000ULL)
#define LLT_ALIGN(x, sz) (((x) + (sz-1)) & (-sz))
// a mask with n set lo or hi bits
--- a/llt/lltinit.c
+++ b/llt/lltinit.c
@@ -1,34 +1,21 @@
#include "llt.h"
-double D_PNAN;
-double D_NNAN;
-double D_PINF;
-double D_NINF;
-float F_PNAN;
-float F_NNAN;
-float F_PINF;
-float F_NINF;
+double D_PNAN, D_NNAN, D_PINF, D_NINF;
+float F_PNAN, F_NNAN, F_PINF, F_NINF;
-void llt_init(void)
+void
+llt_init(void)
{- randomize();
+ D_PNAN = strtod("+NaN", nil);+ D_NNAN = strtod("-NaN", nil);+ D_PINF = strtod("+Inf", nil);+ D_NINF = strtod("-Inf", nil);- ios_init_stdstreams();
+ *(uint32_t*)&F_PNAN = 0x7fc00000;
+ *(uint32_t*)&F_NNAN = 0xffc00000;
+ *(uint32_t*)&F_PINF = 0x7f800000;
+ *(uint32_t*)&F_NINF = 0xff800000;
- D_PNAN = strtod("+NaN",nil);- D_NNAN = strtod("-NaN",nil);- D_PINF = strtod("+Inf",nil);- D_NINF = strtod("-Inf",nil);-#if defined(__plan9__)
- u32int x;
- x = 0x7fc00000; memmove(&F_PNAN, &x, 4);
- x = 0xffc00000; memmove(&F_NNAN, &x, 4);
- x = 0x7f800000; memmove(&F_PINF, &x, 4);
- x = 0xff800000; memmove(&F_NINF, &x, 4);
-#else
- F_PNAN = strtof("+NaN",nil);- F_NNAN = -strtof("+NaN",nil);- F_PINF = strtof("+Inf",nil);- F_NINF = strtof("-Inf",nil);-#endif
+ randomize();
+ ios_init_stdstreams();
}
--- a/llt/lookup3.c
+++ /dev/null
@@ -1,412 +1,0 @@
-/*
--------------------------------------------------------------------------------
-lookup3.c, by Bob Jenkins, May 2006, Public Domain.
-
-These are functions for producing 32-bit hashes for hash table lookup.
-hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final()
-are externally useful functions. You can use this free for any purpose.
-It's in the public domain. It has no warranty.
-
-If you want to find a hash of, say, exactly 7 integers, do
- a = i1; b = i2; c = i3;
- mix(a,b,c);
- a += i4; b += i5; c += i6;
- mix(a,b,c);
- a += i7;
- final(a,b,c);
-then use c as the hash value. If you have a variable length array of
-4-byte integers to hash, use hashword(). If you have a byte array (like
-a character string), use hashlittle(). If you have several byte arrays, or
-a mix of things, see the comments above hashlittle().
-
-Why is this so big? I read 12 bytes at a time into 3 4-byte integers,
-then mix those integers. This is fast (you can do a lot more thorough
-mixing with 12*3 instructions on 3 integers than you can with 3 instructions
-on 1 byte), but shoehorning those bytes into integers efficiently is messy.
--------------------------------------------------------------------------------
-*/
-
-/*
- * My best guess at if you are big-endian or little-endian. This may
- * need adjustment.
- */
-#if defined(BYTE_ORDER) && defined(LITTLE_ENDIAN) && BYTE_ORDER == LITTLE_ENDIAN
-#define HASH_LITTLE_ENDIAN 1
-#define HASH_BIG_ENDIAN 0
-#elif defined(BYTE_ORDER) && defined(BIG_ENDIAN) && BYTE_ORDER == BIG_ENDIAN
-#define HASH_LITTLE_ENDIAN 0
-#define HASH_BIG_ENDIAN 1
-#else
-#error endianess unknown
-#endif
-
-#define hashsize(n) ((uint32_t)1<<(n))
-#define hashmask(n) (hashsize(n)-1)
-#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k))))
-
-/*
--------------------------------------------------------------------------------
-mix -- mix 3 32-bit values reversibly.
-
-This is reversible, so any information in (a,b,c) before mix() is
-still in (a,b,c) after mix().
-
-If four pairs of (a,b,c) inputs are run through mix(), or through
-mix() in reverse, there are at least 32 bits of the output that
-are sometimes the same for one pair and different for another pair.
-This was tested for:
-* pairs that differed by one bit, by two bits, in any combination
- of top bits of (a,b,c), or in any combination of bottom bits of
- (a,b,c).
-* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed
- the output delta to a Gray code (a^(a>>1)) so a string of 1's (as
- is commonly produced by subtraction) look like a single 1-bit
- difference.
-* the base values were pseudorandom, all zero but one bit set, or
- all zero plus a counter that starts at zero.
-
-Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that
-satisfy this are
- 4 6 8 16 19 4
- 9 15 3 18 27 15
- 14 9 3 7 17 3
-Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing
-for "differ" defined as + with a one-bit base and a two-bit delta. I
-used http://burtleburtle.net/bob/hash/avalanche.html to choose
-the operations, constants, and arrangements of the variables.
-
-This does not achieve avalanche. There are input bits of (a,b,c)
-that fail to affect some output bits of (a,b,c), especially of a. The
-most thoroughly mixed value is c, but it doesn't really even achieve
-avalanche in c.
-
-This allows some parallelism. Read-after-writes are good at doubling
-the number of bits affected, so the goal of mixing pulls in the opposite
-direction as the goal of parallelism. I did what I could. Rotates
-seem to cost as much as shifts on every machine I could lay my hands
-on, and rotates are much kinder to the top and bottom bits, so I used
-rotates.
--------------------------------------------------------------------------------
-*/
-#define mix(a,b,c) \
-{ \- a -= c; a ^= rot(c, 4); c += b; \
- b -= a; b ^= rot(a, 6); a += c; \
- c -= b; c ^= rot(b, 8); b += a; \
- a -= c; a ^= rot(c,16); c += b; \
- b -= a; b ^= rot(a,19); a += c; \
- c -= b; c ^= rot(b, 4); b += a; \
-}
-
-/*
--------------------------------------------------------------------------------
-final -- final mixing of 3 32-bit values (a,b,c) into c
-
-Pairs of (a,b,c) values differing in only a few bits will usually
-produce values of c that look totally different. This was tested for
-* pairs that differed by one bit, by two bits, in any combination
- of top bits of (a,b,c), or in any combination of bottom bits of
- (a,b,c).
-* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed
- the output delta to a Gray code (a^(a>>1)) so a string of 1's (as
- is commonly produced by subtraction) look like a single 1-bit
- difference.
-* the base values were pseudorandom, all zero but one bit set, or
- all zero plus a counter that starts at zero.
-
-These constants passed:
- 14 11 25 16 4 14 24
- 12 14 25 16 4 14 24
-and these came close:
- 4 8 15 26 3 22 24
- 10 8 15 26 3 22 24
- 11 8 15 26 3 22 24
--------------------------------------------------------------------------------
-*/
-#define final(a,b,c) \
-{ \- c ^= b; c -= rot(b,14); \
- a ^= c; a -= rot(c,11); \
- b ^= a; b -= rot(a,25); \
- c ^= b; c -= rot(b,16); \
- a ^= c; a -= rot(c,4); \
- b ^= a; b -= rot(a,14); \
- c ^= b; c -= rot(b,24); \
-}
-
-/*
---------------------------------------------------------------------
- This works on all machines. To be useful, it requires
- -- that the key be an array of uint32_t's, and
- -- that the length be the number of uint32_t's in the key
-
- The function hashword() is identical to hashlittle() on little-endian
- machines, and identical to hashbig() on big-endian machines,
- except that the length has to be measured in uint32_ts rather than in
- bytes. hashlittle() is more complicated than hashword() only because
- hashlittle() has to dance around fitting the key bytes into registers.
---------------------------------------------------------------------
-*/
-uint32_t hashword(
-const uint32_t *k, /* the key, an array of uint32_t values */
-size_t length, /* the length of the key, in uint32_ts */
-uint32_t initval) /* the previous hash, or an arbitrary value */
-{- uint32_t a,b,c;
-
- /* Set up the internal state */
- a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval;
-
- /*------------------------------------------------- handle most of the key */
- while (length > 3)
- {- a += k[0];
- b += k[1];
- c += k[2];
- mix(a,b,c);
- length -= 3;
- k += 3;
- }
-
- /*------------------------------------------- handle the last 3 uint32_t's */
- switch(length) /* all the case statements fall through */
- { - case 3 : c+=k[2]; // fallthrough
- case 2 : b+=k[1]; // fallthrough
- case 1 : a+=k[0]; // fallthrough
- final(a,b,c);
- case 0: /* case 0: nothing left to add */
- break;
- }
- /*------------------------------------------------------ report the result */
- return c;
-}
-
-/*
---------------------------------------------------------------------
-hashword2() -- same as hashword(), but take two seeds and return two
-32-bit values. pc and pb must both be nonnull, and *pc and *pb must
-both be initialized with seeds. If you pass in (*pb)==0, the output
-(*pc) will be the same as the return value from hashword().
---------------------------------------------------------------------
-*/
-void hashword2 (
-const uint32_t *k, /* the key, an array of uint32_t values */
-size_t length, /* the length of the key, in uint32_ts */
-uint32_t *pc, /* IN: seed OUT: primary hash value */
-uint32_t *pb) /* IN: more seed OUT: secondary hash value */
-{- uint32_t a,b,c;
-
- /* Set up the internal state */
- a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc;
- c += *pb;
-
- /*------------------------------------------------- handle most of the key */
- while (length > 3)
- {- a += k[0];
- b += k[1];
- c += k[2];
- mix(a,b,c);
- length -= 3;
- k += 3;
- }
-
- /*------------------------------------------- handle the last 3 uint32_t's */
- switch(length) /* all the case statements fall through */
- { - case 3 : c+=k[2]; // fallthrough
- case 2 : b+=k[1]; // fallthrough
- case 1 : a+=k[0]; // fallthrough
- final(a,b,c);
- case 0: /* case 0: nothing left to add */
- break;
- }
- /*------------------------------------------------------ report the result */
- *pc=c; *pb=b;
-}
-
-/*
- * hashlittle2: return 2 32-bit hash values
- *
- * This is identical to hashlittle(), except it returns two 32-bit hash
- * values instead of just one. This is good enough for hash table
- * lookup with 2^^64 buckets, or if you want a second hash if you're not
- * happy with the first, or if you want a probably-unique 64-bit ID for
- * the key. *pc is better mixed than *pb, so use *pc first. If you want
- * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)".
- */
-void hashlittle2(
- const void *key, /* the key to hash */
- size_t length, /* length of the key */
- uint32_t *pc, /* IN: primary initval, OUT: primary hash */
- uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */
-{- uint32_t a,b,c; /* internal state */
- union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */-
- /* Set up the internal state */
- a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc;
- c += *pb;
-
- u.ptr = key;
- if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) {- const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */
- const uint8_t *k8;
-
- /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */
- while (length > 12)
- {- a += k[0];
- b += k[1];
- c += k[2];
- mix(a,b,c);
- length -= 12;
- k += 3;
- }
-
- /*----------------------------- handle the last (probably partial) block */
- /*
- * "k[2]&0xffffff" actually reads beyond the end of the string, but
- * then masks off the part it's not allowed to read. Because the
- * string is aligned, the masked-off tail is in the same word as the
- * rest of the string. Every machine with memory protection I've seen
- * does it on word boundaries, so is OK with this. But VALGRIND will
- * still catch it and complain. The masking trick does make the hash
- * noticably faster for short strings (like English words).
- */
-#ifndef VALGRIND
- (void)k8;
- switch(length)
- {- case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;
- case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break;
- case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break;
- case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break;
- case 8 : b+=k[1]; a+=k[0]; break;
- case 7 : b+=k[1]&0xffffff; a+=k[0]; break;
- case 6 : b+=k[1]&0xffff; a+=k[0]; break;
- case 5 : b+=k[1]&0xff; a+=k[0]; break;
- case 4 : a+=k[0]; break;
- case 3 : a+=k[0]&0xffffff; break;
- case 2 : a+=k[0]&0xffff; break;
- case 1 : a+=k[0]&0xff; break;
- case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
- }
-
-#else /* make valgrind happy */
-
- k8 = (const uint8_t *)k;
- switch(length)
- {- case 12: c+=k[2]; b+=k[1]; a+=k[0]; break;
- case 11: c+=((uint32_t)k8[10])<<16; /* fall through */
- case 10: c+=((uint32_t)k8[9])<<8; /* fall through */
- case 9 : c+=k8[8]; /* fall through */
- case 8 : b+=k[1]; a+=k[0]; break;
- case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */
- case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */
- case 5 : b+=k8[4]; /* fall through */
- case 4 : a+=k[0]; break;
- case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */
- case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */
- case 1 : a+=k8[0]; break;
- case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
- }
-
-#endif /* !valgrind */
-
- } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) {- const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */
- const uint8_t *k8;
-
- /*--------------- all but last block: aligned reads and different mixing */
- while (length > 12)
- {- a += k[0] + (((uint32_t)k[1])<<16);
- b += k[2] + (((uint32_t)k[3])<<16);
- c += k[4] + (((uint32_t)k[5])<<16);
- mix(a,b,c);
- length -= 12;
- k += 6;
- }
-
- /*----------------------------- handle the last (probably partial) block */
- k8 = (const uint8_t *)k;
- switch(length)
- {- case 12: c+=k[4]+(((uint32_t)k[5])<<16);
- b+=k[2]+(((uint32_t)k[3])<<16);
- a+=k[0]+(((uint32_t)k[1])<<16);
- break;
- case 11: c+=((uint32_t)k8[10])<<16; /* fall through */
- case 10: c+=k[4];
- b+=k[2]+(((uint32_t)k[3])<<16);
- a+=k[0]+(((uint32_t)k[1])<<16);
- break;
- case 9 : c+=k8[8]; /* fall through */
- case 8 : b+=k[2]+(((uint32_t)k[3])<<16);
- a+=k[0]+(((uint32_t)k[1])<<16);
- break;
- case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */
- case 6 : b+=k[2];
- a+=k[0]+(((uint32_t)k[1])<<16);
- break;
- case 5 : b+=k8[4]; /* fall through */
- case 4 : a+=k[0]+(((uint32_t)k[1])<<16);
- break;
- case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */
- case 2 : a+=k[0];
- break;
- case 1 : a+=k8[0];
- break;
- case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
- }
-
- } else { /* need to read the key one byte at a time */- const uint8_t *k = (const uint8_t *)key;
-
- /*--------------- all but the last block: affect some 32 bits of (a,b,c) */
- while (length > 12)
- {- a += k[0];
- a += ((uint32_t)k[1])<<8;
- a += ((uint32_t)k[2])<<16;
- a += ((uint32_t)k[3])<<24;
- b += k[4];
- b += ((uint32_t)k[5])<<8;
- b += ((uint32_t)k[6])<<16;
- b += ((uint32_t)k[7])<<24;
- c += k[8];
- c += ((uint32_t)k[9])<<8;
- c += ((uint32_t)k[10])<<16;
- c += ((uint32_t)k[11])<<24;
- mix(a,b,c);
- length -= 12;
- k += 12;
- }
-
- /*-------------------------------- last block: affect all 32 bits of (c) */
- switch(length) /* all the case statements fall through */
- {- case 12: c+=((uint32_t)k[11])<<24; // fallthrough
- case 11: c+=((uint32_t)k[10])<<16; // fallthrough
- case 10: c+=((uint32_t)k[9])<<8; // fallthrough
- case 9 : c+=k[8]; // fallthrough
- case 8 : b+=((uint32_t)k[7])<<24; // fallthrough
- case 7 : b+=((uint32_t)k[6])<<16; // fallthrough
- case 6 : b+=((uint32_t)k[5])<<8; // fallthrough
- case 5 : b+=k[4]; // fallthrough
- case 4 : a+=((uint32_t)k[3])<<24; // fallthrough
- case 3 : a+=((uint32_t)k[2])<<16; // fallthrough
- case 2 : a+=((uint32_t)k[1])<<8; // fallthrough
- case 1 : a+=k[0];
- break;
- case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */
- }
- }
-
- final(a,b,c);
- *pc=c; *pb=b;
-}
--- a/llt/mt19937ar.c
+++ /dev/null
@@ -1,171 +1,0 @@
-/*
- A C-program for MT19937, with initialization improved 2002/1/26.
- Coded by Takuji Nishimura and Makoto Matsumoto.
-
- Before using, initialize the state by using init_genrand(seed)
- or init_by_array(init_key, key_length).
-
- Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura,
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
-
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
-
- 3. The names of its contributors may not be used to endorse or promote
- products derived from this software without specific prior written
- permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
- Any feedback is very welcome.
- http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html
- email: m-mat @ math.sci.hiroshima-u.ac.jp (remove space)
-*/
-
-/* Period parameters */
-#define mtN 624
-#define mtM 397
-#define MATRIX_A 0x9908b0dfU /* constant vector a */
-#define UPPER_MASK 0x80000000U /* most significant w-r bits */
-#define LOWER_MASK 0x7fffffffU /* least significant r bits */
-
-static uint32_t mt[mtN]; /* the array for the state vector */
-static int mti=mtN+1; /* mti==mtN+1 means mt[mtN] is not initialized */
-
-/* initializes mt[mtN] with a seed */
-void init_genrand(uint32_t s)
-{- mt[0]= s & 0xffffffffU;
- for (mti=1; mti<mtN; mti++) {- mt[mti] =
- (1812433253U * (mt[mti-1] ^ (mt[mti-1] >> 30)) + mti);
- /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */
- /* In the previous versions, MSBs of the seed affect */
- /* only MSBs of the array mt[]. */
- /* 2002/01/09 modified by Makoto Matsumoto */
- mt[mti] &= 0xffffffffU;
- /* for >32 bit machines */
- }
-}
-
-/* initialize by an array with array-length */
-/* init_key is the array for initializing keys */
-/* key_length is its length */
-/* slight change for C++, 2004/2/26 */
-void init_by_array(uint32_t init_key[], int key_length)
-{- int i, j, k;
- init_genrand(19650218U);
- i=1; j=0;
- k = (mtN>key_length ? mtN : key_length);
- for (; k; k--) {- mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525U))
- + init_key[j] + j; /* non linear */
- mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
- i++; j++;
- if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; }- if (j>=key_length) j=0;
- }
- for (k=mtN-1; k; k--) {- mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941U))
- - i; /* non linear */
- mt[i] &= 0xffffffffU; /* for WORDSIZE > 32 machines */
- i++;
- if (i>=mtN) { mt[0] = mt[mtN-1]; i=1; }- }
-
- mt[0] = 0x80000000U; /* MSB is 1; assuring non-zero initial array */
-}
-
-/* generates a random number on [0,0xffffffff]-interval */
-uint32_t genrand_int32(void)
-{- uint32_t y;
- static uint32_t mag01[2]={0x0U, MATRIX_A};- /* mag01[x] = x * MATRIX_A for x=0,1 */
-
- if (mti >= mtN) { /* generate mtN words at one time */- int kk;
-
- if (mti == mtN+1) /* if init_genrand() has not been called, */
- init_genrand(5489U); /* a default initial seed is used */
-
- for (kk=0;kk<mtN-mtM;kk++) {- y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
- mt[kk] = mt[kk+mtM] ^ (y >> 1) ^ mag01[y & 0x1U];
- }
- for (;kk<mtN-1;kk++) {- y = (mt[kk]&UPPER_MASK)|(mt[kk+1]&LOWER_MASK);
- mt[kk] = mt[kk+(mtM-mtN)] ^ (y >> 1) ^ mag01[y & 0x1U];
- }
- y = (mt[mtN-1]&UPPER_MASK)|(mt[0]&LOWER_MASK);
- mt[mtN-1] = mt[mtM-1] ^ (y >> 1) ^ mag01[y & 0x1U];
-
- mti = 0;
- }
-
- y = mt[mti++];
-
- /* Tempering */
- y ^= (y >> 11);
- y ^= (y << 7) & 0x9d2c5680U;
- y ^= (y << 15) & 0xefc60000U;
- y ^= (y >> 18);
-
- return y;
-}
-
-#if 0
-/* generates a random number on [0,0x7fffffff]-interval */
-long genrand_int31(void)
-{- return (long)(genrand_int32()>>1);
-}
-
-/* generates a random number on [0,1]-real-interval */
-double genrand_real1(void)
-{- return genrand_int32()*(1.0/4294967295.0);
- /* divided by 2^32-1 */
-}
-
-/* generates a random number on [0,1)-real-interval */
-double genrand_real2(void)
-{- return genrand_int32()*(1.0/4294967296.0);
- /* divided by 2^32 */
-}
-
-/* generates a random number on (0,1)-real-interval */
-double genrand_real3(void)
-{- return (((double)genrand_int32()) + 0.5)*(1.0/4294967296.0);
- /* divided by 2^32 */
-}
-
-/* generates a random number on [0,1) with 53-bit resolution*/
-double genrand_res53(void)
-{ - uint32_t a=genrand_int32()>>5, b=genrand_int32()>>6;
- return(a*67108864.0+b)*(1.0/9007199254740992.0);
-}
-#endif
--- a/llt/ptrhash.c
+++ b/llt/ptrhash.c
@@ -5,30 +5,32 @@
#include "llt.h"
-#define OP_EQ(x,y) ((x)==(y))
+#define OP_EQ(x,y) ((x) == (y))
#ifdef BITS64
-static uint64_t _pinthash(uint64_t key)
+static uint64_t
+_pinthash(uint64_t key)
{- key = (~key) + (key << 21); // key = (key << 21) - key - 1;
- key = key ^ (key >> 24);
- key = (key + (key << 3)) + (key << 8); // key * 265
- key = key ^ (key >> 14);
- key = (key + (key << 2)) + (key << 4); // key * 21
- key = key ^ (key >> 28);
- key = key + (key << 31);
- return key;
+ key = (~key) + (key << 21); // key = (key << 21) - key - 1;
+ key = key ^ (key >> 24);
+ key = (key + (key << 3)) + (key << 8); // key * 265
+ key = key ^ (key >> 14);
+ key = (key + (key << 2)) + (key << 4); // key * 21
+ key = key ^ (key >> 28);
+ key = key + (key << 31);
+ return key;
}
#else
-static uint32_t _pinthash(uint32_t a)
+static uint32_t
+_pinthash(uint32_t a)
{- a = (a+0x7ed55d16) + (a<<12);
- a = (a^0xc761c23c) ^ (a>>19);
- a = (a+0x165667b1) + (a<<5);
- a = (a+0xd3a2646c) ^ (a<<9);
- a = (a+0xfd7046c5) + (a<<3);
- a = (a^0xb55a4f09) ^ (a>>16);
- return a;
+ a = (a+0x7ed55d16) + (a<<12);
+ a = (a^0xc761c23c) ^ (a>>19);
+ a = (a+0x165667b1) + (a<<5);
+ a = (a+0xd3a2646c) ^ (a<<9);
+ a = (a+0xfd7046c5) + (a<<3);
+ a = (a^0xb55a4f09) ^ (a>>16);
+ return a;
}
#endif
--- a/llt/random.c
+++ b/llt/random.c
@@ -3,54 +3,57 @@
*/
#include "llt.h"
#include "ieee754.h"
-
#include "mt19937ar.c"
-double rand_double()
+double
+rand_double()
{- union ieee754_double d;
+ union ieee754_double d;
- d.ieee.mantissa0 = genrand_int32();
- d.ieee.mantissa1 = genrand_int32();
- d.ieee.negative = 0;
- d.ieee.exponent = IEEE754_DOUBLE_BIAS + 0; /* 2^0 */
- return d.d - 1.0;
+ d.ieee.mantissa0 = genrand_int32();
+ d.ieee.mantissa1 = genrand_int32();
+ d.ieee.negative = 0;
+ d.ieee.exponent = IEEE754_DOUBLE_BIAS + 0; /* 2^0 */
+ return d.d - 1.0;
}
-float rand_float()
+float
+rand_float()
{- union ieee754_float f;
+ union ieee754_float f;
- f.ieee.mantissa = genrand_int32();
- f.ieee.negative = 0;
- f.ieee.exponent = IEEE754_FLOAT_BIAS + 0; /* 2^0 */
- return f.f - 1.0;
+ f.ieee.mantissa = genrand_int32();
+ f.ieee.negative = 0;
+ f.ieee.exponent = IEEE754_FLOAT_BIAS + 0; /* 2^0 */
+ return f.f - 1.0;
}
-double randn()
+double
+randn()
{- double s, vre, vim, ure, uim;
- static double next = -42;
+ double s, vre, vim, ure, uim;
+ static double next = -42;
- if (next != -42) {- s = next;
- next = -42;
- return s;
- }
- do {- ure = rand_double();
- uim = rand_double();
- vre = 2*ure - 1;
- vim = 2*uim - 1;
- s = vre*vre + vim*vim;
- } while (s >= 1);
- s = sqrt(-2*log(s)/s);
- next = s * vre;
- return s * vim;
+ if(next != -42){+ s = next;
+ next = -42;
+ return s;
+ }
+ do{+ ure = rand_double();
+ uim = rand_double();
+ vre = 2*ure - 1;
+ vim = 2*uim - 1;
+ s = vre*vre + vim*vim;
+ }while(s >= 1);
+ s = sqrt(-2*log(s)/s);
+ next = s * vre;
+ return s * vim;
}
-void randomize(void)
+void
+randomize(void)
{- uint64_t tm = i64time();
- init_by_array((uint32_t*)&tm, 2);
+ uint64_t tm = i64time();
+ init_by_array((uint32_t*)&tm, 2);
}
--- a/llt/timefuncs.c
+++ b/llt/timefuncs.c
@@ -1,108 +1,116 @@
#include "platform.h"
#if defined(__plan9__)
-double floattime(void)
+double
+floattime(void)
{- return (double)nsec() / 1.0e9;
+ return (double)nsec() / 1.0e9;
}
#else
-double tv2float(struct timeval *tv)
+double
+tv2float(struct timeval *tv)
{- return (double)tv->tv_sec + (double)tv->tv_usec/1.0e6;
+ return (double)tv->tv_sec + (double)tv->tv_usec/1.0e6;
}
-double diff_time(struct timeval *tv1, struct timeval *tv2)
+double
+diff_time(struct timeval *tv1, struct timeval *tv2)
{- return tv2float(tv1) - tv2float(tv2);
+ return tv2float(tv1) - tv2float(tv2);
}
#endif
// return as many bits of system randomness as we can get our hands on
-uint64_t i64time(void)
+uint64_t
+i64time(void)
{- uint64_t a;
+ uint64_t a;
#if defined(__plan9__)
- a = nsec();
+ a = nsec();
#else
- struct timeval now;
- gettimeofday(&now, nil);
- a = (((uint64_t)now.tv_sec)<<32) + (uint64_t)now.tv_usec;
+ struct timeval now;
+ gettimeofday(&now, nil);
+ a = (((uint64_t)now.tv_sec)<<32) + (uint64_t)now.tv_usec;
#endif
- return a;
+ return a;
}
-double clock_now(void)
+double
+clock_now(void)
{#if defined(__plan9__)
- return floattime();
+ return floattime();
#else
- struct timeval now;
-
- gettimeofday(&now, nil);
- return tv2float(&now);
+ struct timeval now;
+ gettimeofday(&now, nil);
+ return tv2float(&now);
#endif
}
-void timestring(double seconds, char *buffer, size_t len)
+void
+timestring(double seconds, char *buffer, size_t len)
{#if defined(__plan9__)
- Tm tm;
- snprint(buffer, len, "%τ", tmfmt(tmtime(&tm, seconds, tzload("local")), nil));+ Tm tm;
+ snprint(buffer, len, "%τ", tmfmt(tmtime(&tm, seconds, tzload("local")), nil));#else
- time_t tme = (time_t)seconds;
+ time_t tme = (time_t)seconds;
- char *fmt = "%c"; /* needed to suppress GCC warning */
- struct tm tm;
+ char *fmt = "%c"; /* needed to suppress GCC warning */
+ struct tm tm;
- localtime_r(&tme, &tm);
- strftime(buffer, len, fmt, &tm);
+ localtime_r(&tme, &tm);
+ strftime(buffer, len, fmt, &tm);
#endif
}
#if defined(__plan9__)
-double parsetime(const char *str)
+double
+parsetime(const char *str)
{- Tm tm;
-
- if (tmparse(&tm, "?WWW, ?MM ?DD hh:mm:ss ?Z YYYY", str, tzload("local"), nil) == nil)- return -1;
-
- return tmnorm(&tm);
+ Tm tm;
+ if(tmparse(&tm, "?WWW, ?MM ?DD hh:mm:ss ?Z YYYY", str, tzload("local"), nil) == nil)+ return -1;
+ return tmnorm(&tm);
}
#else
-double parsetime(const char *str)
+double
+parsetime(const char *str)
{- char *fmt = "%c"; /* needed to suppress GCC warning */
- char *res;
- time_t t;
- struct tm tm;
+ char *fmt = "%c"; /* needed to suppress GCC warning */
+ char *res;
+ time_t t;
+ struct tm tm;
- res = strptime(str, fmt, &tm);
- if (res != nil) {- tm.tm_isdst = -1; /* Not set by strptime(); tells mktime() to determine
- whether daylight saving time is in effect */
- t = mktime(&tm);
- if (t == ((time_t)-1))
- return -1;
- return (double)t;
- }
- return -1;
+ res = strptime(str, fmt, &tm);
+ if(res != nil){+ /* Not set by strptime(); tells mktime() to determine
+ * whether daylight saving time is in effect
+ */
+ tm.tm_isdst = -1;
+ t = mktime(&tm);
+ if(t == (time_t)-1)
+ return -1;
+ return (double)t;
+ }
+ return -1;
}
#endif
-void sleep_ms(int ms)
+void
+sleep_ms(int ms)
{- if (ms == 0)
- return;
+ if(ms == 0)
+ return;
#if defined(__plan9__)
- sleep(ms);
+ sleep(ms);
#else
- struct timeval timeout;
+ struct timeval timeout;
- timeout.tv_sec = ms/1000;
- timeout.tv_usec = (ms % 1000) * 1000;
- select(0, nil, nil, nil, &timeout);
+ timeout.tv_sec = ms/1000;
+ timeout.tv_usec = (ms % 1000) * 1000;
+ select(0, nil, nil, nil, &timeout);
#endif
}
--- a/llt/utf8.c
+++ b/llt/utf8.c
@@ -16,19 +16,19 @@
#include "llt.h"
static const uint32_t offsetsFromUTF8[6] = {- 0x00000000UL, 0x00003080UL, 0x000E2080UL,
- 0x03C82080UL, 0xFA082080UL, 0x82082080UL
+ 0x00000000UL, 0x00003080UL, 0x000E2080UL,
+ 0x03C82080UL, 0xFA082080UL, 0x82082080UL
};
static const char trailingBytesForUTF8[256] = {- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
- 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
- 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
};
// straight from musl
@@ -43,33 +43,36 @@
}
/* returns length of next utf-8 sequence */
-size_t u8_seqlen(const char *s)
+size_t
+u8_seqlen(const char *s)
{- return trailingBytesForUTF8[(unsigned int)(uint8_t)s[0]] + 1;
+ return trailingBytesForUTF8[(unsigned int)(uint8_t)s[0]] + 1;
}
/* returns the # of bytes needed to encode a certain character
0 means the character cannot (or should not) be encoded. */
-size_t u8_charlen(uint32_t ch)
+size_t
+u8_charlen(uint32_t ch)
{- if (ch < 0x80)
- return 1;
- else if (ch < 0x800)
- return 2;
- else if (ch < 0x10000)
- return 3;
- else if (ch < 0x110000)
- return 4;
- return 0;
+ if(ch < 0x80)
+ return 1;
+ if(ch < 0x800)
+ return 2;
+ if(ch < 0x10000)
+ return 3;
+ if(ch < 0x110000)
+ return 4;
+ return 0;
}
-size_t u8_codingsize(uint32_t *wcstr, size_t n)
+size_t
+u8_codingsize(uint32_t *wcstr, size_t n)
{- size_t i, c=0;
+ size_t i, c = 0;
- for(i=0; i < n; i++)
- c += u8_charlen(wcstr[i]);
- return c;
+ for(i = 0; i < n; i++)
+ c += u8_charlen(wcstr[i]);
+ return c;
}
/* conversions without error checking
@@ -80,514 +83,518 @@
returns # characters converted
if sz == srcsz+1 (i.e. 4*srcsz+4 bytes), there will always be enough space.
*/
-size_t u8_toucs(uint32_t *dest, size_t sz, const char *src, size_t srcsz)
+size_t
+u8_toucs(uint32_t *dest, size_t sz, const char *src, size_t srcsz)
{- uint32_t ch;
- const char *src_end = src + srcsz;
- size_t nb;
- size_t i=0;
+ uint32_t ch;
+ const char *src_end = src + srcsz;
+ size_t nb, i = 0;
- if (sz == 0 || srcsz == 0)
- return 0;
+ if(sz == 0 || srcsz == 0)
+ return 0;
- while (i < sz) {- if (!isutf(*src)) { // invalid sequence- dest[i++] = 0xFFFD;
- src++;
- if (src >= src_end) break;
- continue;
- }
- nb = trailingBytesForUTF8[(uint8_t)*src];
- if (src + nb >= src_end)
- break;
- ch = 0;
- switch (nb) {- case 5: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
- case 4: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
- case 3: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
- case 2: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
- case 1: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
- case 0: ch += (uint8_t)*src++;
- }
- ch -= offsetsFromUTF8[nb];
- dest[i++] = ch;
- }
- return i;
+ while(i < sz){+ if(!isutf(*src)){ // invalid sequence+ dest[i++] = 0xFFFD;
+ src++;
+ if(src >= src_end)
+ break;
+ continue;
+ }
+ nb = trailingBytesForUTF8[(uint8_t)*src];
+ if(src + nb >= src_end)
+ break;
+ ch = 0;
+ switch(nb){+ case 5: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
+ case 4: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
+ case 3: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
+ case 2: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
+ case 1: ch += (uint8_t)*src++; ch <<= 6; // fallthrough
+ case 0: ch += (uint8_t)*src++;
+ }
+ ch -= offsetsFromUTF8[nb];
+ dest[i++] = ch;
+ }
+ return i;
}
-/* srcsz = number of source characters
- sz = size of dest buffer in bytes
-
- returns # bytes stored in dest
- the destination string will never be bigger than the source string.
+/*
+ * srcsz = number of source characters
+ * sz = size of dest buffer in bytes
+ * returns # bytes stored in dest
+ * the destination string will never be bigger than the source string.
*/
-size_t u8_toutf8(char *dest, size_t sz, const uint32_t *src, size_t srcsz)
+size_t
+u8_toutf8(char *dest, size_t sz, const uint32_t *src, size_t srcsz)
{- uint32_t ch;
- size_t i = 0;
- char *dest0 = dest;
- char *dest_end = dest + sz;
+ uint32_t ch;
+ size_t i = 0;
+ char *dest0 = dest;
+ char *dest_end = dest + sz;
- while (i < srcsz) {- ch = src[i];
- if (ch < 0x80) {- if (dest >= dest_end)
- break;
- *dest++ = (char)ch;
- }
- else if (ch < 0x800) {- if (dest >= dest_end-1)
- break;
- *dest++ = (ch>>6) | 0xC0;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- else if (ch < 0x10000) {- if (dest >= dest_end-2)
- break;
- *dest++ = (ch>>12) | 0xE0;
- *dest++ = ((ch>>6) & 0x3F) | 0x80;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- else if (ch < 0x110000) {- if (dest >= dest_end-3)
- break;
- *dest++ = (ch>>18) | 0xF0;
- *dest++ = ((ch>>12) & 0x3F) | 0x80;
- *dest++ = ((ch>>6) & 0x3F) | 0x80;
- *dest++ = (ch & 0x3F) | 0x80;
- }
- i++;
- }
- return (dest-dest0);
+ while(i < srcsz){+ ch = src[i];
+ if(ch < 0x80){+ if(dest >= dest_end)
+ break;
+ *dest++ = (char)ch;
+ }else if(ch < 0x800){+ if(dest >= dest_end-1)
+ break;
+ *dest++ = (ch>>6) | 0xC0;
+ *dest++ = (ch & 0x3F) | 0x80;
+ }else if(ch < 0x10000){+ if(dest >= dest_end-2)
+ break;
+ *dest++ = (ch>>12) | 0xE0;
+ *dest++ = ((ch>>6) & 0x3F) | 0x80;
+ *dest++ = (ch & 0x3F) | 0x80;
+ }else if(ch < 0x110000){+ if(dest >= dest_end-3)
+ break;
+ *dest++ = (ch>>18) | 0xF0;
+ *dest++ = ((ch>>12) & 0x3F) | 0x80;
+ *dest++ = ((ch>>6) & 0x3F) | 0x80;
+ *dest++ = (ch & 0x3F) | 0x80;
+ }
+ i++;
+ }
+ return dest-dest0;
}
-size_t u8_wc_toutf8(char *dest, uint32_t ch)
+size_t
+u8_wc_toutf8(char *dest, uint32_t ch)
{- if (ch < 0x80) {- dest[0] = (char)ch;
- return 1;
- }
- if (ch < 0x800) {- dest[0] = (ch>>6) | 0xC0;
- dest[1] = (ch & 0x3F) | 0x80;
- return 2;
- }
- if (ch < 0x10000) {- dest[0] = (ch>>12) | 0xE0;
- dest[1] = ((ch>>6) & 0x3F) | 0x80;
- dest[2] = (ch & 0x3F) | 0x80;
- return 3;
- }
- if (ch < 0x110000) {- dest[0] = (ch>>18) | 0xF0;
- dest[1] = ((ch>>12) & 0x3F) | 0x80;
- dest[2] = ((ch>>6) & 0x3F) | 0x80;
- dest[3] = (ch & 0x3F) | 0x80;
- return 4;
- }
- return 0;
+ if(ch < 0x80){+ dest[0] = (char)ch;
+ return 1;
+ }
+ if(ch < 0x800){+ dest[0] = (ch>>6) | 0xC0;
+ dest[1] = (ch & 0x3F) | 0x80;
+ return 2;
+ }
+ if(ch < 0x10000){+ dest[0] = (ch>>12) | 0xE0;
+ dest[1] = ((ch>>6) & 0x3F) | 0x80;
+ dest[2] = (ch & 0x3F) | 0x80;
+ return 3;
+ }
+ if(ch < 0x110000){+ dest[0] = (ch>>18) | 0xF0;
+ dest[1] = ((ch>>12) & 0x3F) | 0x80;
+ dest[2] = ((ch>>6) & 0x3F) | 0x80;
+ dest[3] = (ch & 0x3F) | 0x80;
+ return 4;
+ }
+ return 0;
}
/* charnum => byte offset */
-size_t u8_offset(const char *s, size_t charnum)
+size_t
+u8_offset(const char *s, size_t charnum)
{- size_t i=0;
+ size_t i = 0;
- while (charnum > 0) {- if (s[i++] & 0x80) {- (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
- }
- charnum--;
- }
- return i;
+ while(charnum > 0){+ if(s[i++] & 0x80)
+ (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
+ charnum--;
+ }
+ return i;
}
/* byte offset => charnum */
-size_t u8_charnum(const char *s, size_t offset)
+size_t
+u8_charnum(const char *s, size_t offset)
{- size_t charnum = 0, i=0;
+ size_t charnum = 0, i = 0;
- while (i < offset) {- if (s[i++] & 0x80) {- (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
- }
- charnum++;
- }
- return charnum;
+ while(i < offset){+ if((s[i++] & 0x80) != 0 && !isutf(s[++i]) && !isutf(s[++i]))
+ i++;
+ charnum++;
+ }
+ return charnum;
}
/* number of characters in NUL-terminated string */
-size_t u8_strlen(const char *s)
+size_t
+u8_strlen(const char *s)
{- size_t count = 0;
- size_t i = 0, lasti;
+ size_t count = 0;
+ size_t i = 0, lasti;
- while (1) {- lasti = i;
- while (s[i] > 0)
- i++;
- count += (i-lasti);
- if (s[i++]==0) break;
- (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
- count++;
- }
- return count;
+ while(1) {+ lasti = i;
+ while(s[i] > 0)
+ i++;
+ count += (i-lasti);
+ if(s[i++] == 0)
+ break;
+ (void)(isutf(s[++i]) || isutf(s[++i]) || ++i);
+ count++;
+ }
+ return count;
}
-size_t u8_strwidth(const char *s)
+size_t
+u8_strwidth(const char *s)
{- uint32_t ch;
- size_t nb, tot=0;
- int w;
- signed char sc;
+ uint32_t ch;
+ size_t nb, tot = 0;
+ int w;
+ signed char sc;
- while ((sc = (signed char)*s) != 0) {- if (sc >= 0) {- s++;
- if (sc) tot++;
- }
- else {- if (!isutf(sc)) { tot++; s++; continue; }- nb = trailingBytesForUTF8[(uint8_t)sc];
- ch = 0;
- switch (nb) {- case 5: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
- case 4: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
- case 3: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
- case 2: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
- case 1: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
- case 0: ch += (uint8_t)*s++;
- }
- ch -= offsetsFromUTF8[nb];
- w = wcwidth(ch); // might return -1
- if (w > 0) tot += w;
- }
- }
- return tot;
+ while((sc = (signed char)*s) != 0){+ if(sc >= 0){+ s++;
+ if(sc)
+ tot++;
+ }else{+ if(!isutf(sc)){+ tot++;
+ s++;
+ continue;
+ }
+ nb = trailingBytesForUTF8[(uint8_t)sc];
+ ch = 0;
+ switch(nb){+ case 5: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
+ case 4: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
+ case 3: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
+ case 2: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
+ case 1: ch += (uint8_t)*s++; ch <<= 6; // fallthrough
+ case 0: ch += (uint8_t)*s++;
+ }
+ ch -= offsetsFromUTF8[nb];
+ w = wcwidth(ch); // might return -1
+ if(w > 0)
+ tot += w;
+ }
+ }
+ return tot;
}
/* reads the next utf-8 sequence out of a string, updating an index */
-uint32_t u8_nextchar(const char *s, size_t *i)
+uint32_t
+u8_nextchar(const char *s, size_t *i)
{- uint32_t ch = 0;
- size_t sz = 0;
+ uint32_t ch = 0;
+ size_t sz = 0;
- do {- ch <<= 6;
- ch += (uint8_t)s[(*i)];
- sz++;
- } while (s[*i] && (++(*i)) && !isutf(s[*i]));
- ch -= offsetsFromUTF8[sz-1];
-
- return ch;
+ do{+ ch <<= 6;
+ ch += (uint8_t)s[(*i)];
+ sz++;
+ }while(s[*i] && (++(*i)) && !isutf(s[*i]));
+ return ch - offsetsFromUTF8[sz-1];
}
/* next character without NUL character terminator */
-uint32_t u8_nextmemchar(const char *s, size_t *i)
+uint32_t
+u8_nextmemchar(const char *s, size_t *i)
{- uint32_t ch = 0;
- size_t sz = 0;
+ uint32_t ch = 0;
+ size_t sz = 0;
- do {- ch <<= 6;
- ch += (uint8_t)s[(*i)++];
- sz++;
- } while (!isutf(s[*i]));
- ch -= offsetsFromUTF8[sz-1];
-
- return ch;
+ do{+ ch <<= 6;
+ ch += (uint8_t)s[(*i)++];
+ sz++;
+ }while(!isutf(s[*i]));
+ return ch - offsetsFromUTF8[sz-1];
}
-void u8_inc(const char *s, size_t *i)
+void
+u8_inc(const char *s, size_t *i)
{- (void)(isutf(s[++(*i)]) || isutf(s[++(*i)]) || isutf(s[++(*i)]) || ++(*i));
+ (void)(isutf(s[++(*i)]) || isutf(s[++(*i)]) || isutf(s[++(*i)]) || ++(*i));
}
-void u8_dec(const char *s, size_t *i)
+void
+u8_dec(const char *s, size_t *i)
{- (void)(isutf(s[--(*i)]) || isutf(s[--(*i)]) || isutf(s[--(*i)]) || --(*i));
+ (void)(isutf(s[--(*i)]) || isutf(s[--(*i)]) || isutf(s[--(*i)]) || --(*i));
}
-int octal_digit(char c)
+int
+octal_digit(char c)
{- return (c >= '0' && c <= '7');
+ return (c >= '0' && c <= '7');
}
-int hex_digit(char c)
+int
+hex_digit(char c)
{- return ((c >= '0' && c <= '9') ||
- (c >= 'A' && c <= 'F') ||
- (c >= 'a' && c <= 'f'));
+ return (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F');
}
-char read_escape_control_char(char c)
+char
+read_escape_control_char(char c)
{- if (c == 'n')
- return '\n';
- else if (c == 't')
- return '\t';
- else if (c == 'r')
- return '\r';
- else if (c == 'e')
- return '\e';
- else if (c == 'b')
- return '\b';
- else if (c == 'f')
- return '\f';
- else if (c == 'v')
- return '\v';
- else if (c == 'a')
- return '\a';
- return c;
+ switch(c){+ case 'n': return '\n';
+ case 't': return '\t';
+ case 'a': return '\a';
+ case 'b': return '\b';
+ case 'e': return '\e';
+ case 'f': return '\f';
+ case 'r': return '\r';
+ case 'v': return '\v';
+ }
+ return c;
}
/* assumes that src points to the character after a backslash
returns number of input characters processed, 0 if error */
-size_t u8_read_escape_sequence(const char *str, size_t ssz, uint32_t *dest)
+size_t
+u8_read_escape_sequence(const char *str, size_t ssz, uint32_t *dest)
{- assert(ssz > 0);
- uint32_t ch;
- char digs[10];
- int dno=0, ndig;
- size_t i=1;
- char c0 = str[0];
+ assert(ssz > 0);
+ uint32_t ch;
+ char digs[10];
+ int dno = 0, ndig;
+ size_t i = 1;
+ char c0 = str[0];
- if (octal_digit(c0)) {- i = 0;
- do {- digs[dno++] = str[i++];
- } while (i<ssz && octal_digit(str[i]) && dno<3);
- digs[dno] = '\0';
- ch = strtol(digs, nil, 8);
- }
- else if ((c0=='x' && (ndig=2)) ||
- (c0=='u' && (ndig=4)) ||
- (c0=='U' && (ndig=8))) {- while (i<ssz && hex_digit(str[i]) && dno<ndig) {- digs[dno++] = str[i++];
- }
- if (dno == 0) return 0;
- digs[dno] = '\0';
- ch = strtol(digs, nil, 16);
- }
- else {- ch = (uint32_t)read_escape_control_char(c0);
- }
- *dest = ch;
+ if(octal_digit(c0)){+ i = 0;
+ do{+ digs[dno++] = str[i++];
+ }while(i < ssz && octal_digit(str[i]) && dno < 3);
+ digs[dno] = '\0';
+ ch = strtol(digs, nil, 8);
+ }else if((c0 == 'x' && (ndig = 2)) || (c0 == 'u' && (ndig = 4)) || (c0 == 'U' && (ndig = 8))){+ while(i<ssz && hex_digit(str[i]) && dno < ndig)
+ digs[dno++] = str[i++];
+ if(dno == 0)
+ return 0;
+ digs[dno] = '\0';
+ ch = strtol(digs, nil, 16);
+ }else{+ ch = (uint32_t)read_escape_control_char(c0);
+ }
+ *dest = ch;
- return i;
+ return i;
}
/* convert a string with literal \uxxxx or \Uxxxxxxxx characters to UTF-8
example: u8_unescape(mybuf, 256, "hello\\u220e")
note the double backslash is needed if called on a C string literal */
-size_t u8_unescape(char *buf, size_t sz, const char *src)
+size_t
+u8_unescape(char *buf, size_t sz, const char *src)
{- size_t c=0, amt;
- uint32_t ch;
- char temp[4];
+ size_t c = 0, amt;
+ uint32_t ch;
+ char temp[4];
- while (*src && c < sz) {- if (*src == '\\') {- src++;
- amt = u8_read_escape_sequence(src, 1000, &ch);
- }
- else {- ch = (uint32_t)*src;
- amt = 1;
- }
- src += amt;
- amt = u8_wc_toutf8(temp, ch);
- if (amt > sz-c)
- break;
- memmove(&buf[c], temp, amt);
- c += amt;
- }
- if (c < sz)
- buf[c] = '\0';
- return c;
+ while(*src && c < sz){+ if(*src == '\\'){+ src++;
+ amt = u8_read_escape_sequence(src, 1000, &ch);
+ }else{+ ch = (uint32_t)*src;
+ amt = 1;
+ }
+ src += amt;
+ amt = u8_wc_toutf8(temp, ch);
+ if(amt > sz-c)
+ break;
+ memmove(&buf[c], temp, amt);
+ c += amt;
+ }
+ if(c < sz)
+ buf[c] = '\0';
+ return c;
}
-static inline int buf_put2c(char *buf, const char *src)
+static inline int
+buf_put2c(char *buf, const char *src)
{- buf[0] = src[0];
- buf[1] = src[1];
- buf[2] = '\0';
- return 2;
+ buf[0] = src[0];
+ buf[1] = src[1];
+ buf[2] = '\0';
+ return 2;
}
-int u8_escape_wchar(char *buf, size_t sz, uint32_t ch)
+int
+u8_escape_wchar(char *buf, size_t sz, uint32_t ch)
{- assert(sz > 2);
- if (ch >= 0x20 && ch < 0x7f) {- buf[0] = ch;
- buf[1] = '\0';
- return 1;
- }
- if (ch > 0xffff)
- return snprintf(buf, sz, "\\U%.8x", ch);
- if (ch >= 0x80)
- return snprintf(buf, sz, "\\u%04x", ch);
- switch (ch) {- case '\n': return buf_put2c(buf, "\\n");
- case '\t': return buf_put2c(buf, "\\t");
- case '\r': return buf_put2c(buf, "\\r");
- case '\e': return buf_put2c(buf, "\\e");
- case '\b': return buf_put2c(buf, "\\b");
- case '\f': return buf_put2c(buf, "\\f");
- case '\v': return buf_put2c(buf, "\\v");
- case '\a': return buf_put2c(buf, "\\a");
- case '\\': return buf_put2c(buf, "\\\\");
- }
- return snprintf(buf, sz, "\\x%02x", ch);
+ assert(sz > 2);
+ if(ch >= 0x20 && ch < 0x7f){+ buf[0] = ch;
+ buf[1] = '\0';
+ return 1;
+ }
+ if(ch > 0xffff)
+ return snprintf(buf, sz, "\\U%.8x", ch);
+ if(ch >= 0x80)
+ return snprintf(buf, sz, "\\u%04x", ch);
+ switch(ch){+ case '\n': return buf_put2c(buf, "\\n");
+ case '\t': return buf_put2c(buf, "\\t");
+ case '\\': return buf_put2c(buf, "\\\\");
+ case '\a': return buf_put2c(buf, "\\a");
+ case '\b': return buf_put2c(buf, "\\b");
+ case '\e': return buf_put2c(buf, "\\e");
+ case '\f': return buf_put2c(buf, "\\f");
+ case '\r': return buf_put2c(buf, "\\r");
+ case '\v': return buf_put2c(buf, "\\v");
+ }
+ return snprintf(buf, sz, "\\x%02x", ch);
}
-size_t u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end,
- int escape_quotes, int ascii)
+size_t
+u8_escape(char *buf, size_t sz, const char *src, size_t *pi, size_t end, int escape_quotes, int ascii)
{- size_t i = *pi, i0;
- uint32_t ch;
- char *start = buf;
- char *blim = start + sz-11;
- assert(sz > 11);
+ size_t i = *pi, i0;
+ uint32_t ch;
+ char *start = buf;
+ char *blim = start + sz-11;
+ assert(sz > 11);
- while (i<end && buf<blim) {- // sz-11: leaves room for longest escape sequence
- if (escape_quotes && src[i] == '"') {- buf += buf_put2c(buf, "\\\"");
- i++;
- }
- else if (src[i] == '\\') {- buf += buf_put2c(buf, "\\\\");
- i++;
- }
- else {- i0 = i;
- ch = u8_nextmemchar(src, &i);
- if (ascii || !u8_iswprint(ch)) {- buf += u8_escape_wchar(buf, sz - (buf-start), ch);
- }
- else {- i = i0;
- do {- *buf++ = src[i++];
- } while (!isutf(src[i]));
- }
- }
- }
- *buf++ = '\0';
- *pi = i;
- return (buf-start);
+ while(i < end && buf < blim){+ // sz-11: leaves room for longest escape sequence
+ if(escape_quotes && src[i] == '"'){+ buf += buf_put2c(buf, "\\\"");
+ i++;
+ }else if(src[i] == '\\'){+ buf += buf_put2c(buf, "\\\\");
+ i++;
+ }else{+ i0 = i;
+ ch = u8_nextmemchar(src, &i);
+ if(ascii || !u8_iswprint(ch)){+ buf += u8_escape_wchar(buf, sz - (buf-start), ch);
+ }else{+ i = i0;
+ do{+ *buf++ = src[i++];
+ }while(!isutf(src[i]));
+ }
+ }
+ }
+ *buf++ = '\0';
+ *pi = i;
+ return (buf-start);
}
-char *u8_strchr(const char *s, uint32_t ch, size_t *charn)
+char *
+u8_strchr(const char *s, uint32_t ch, size_t *charn)
{- size_t i = 0, lasti=0;
- uint32_t c;
+ size_t i = 0, lasti = 0;
+ uint32_t c;
- *charn = 0;
- while (s[i]) {- c = u8_nextchar(s, &i);
- if (c == ch) {- /* it's const for us, but not necessarily the caller */
- return (char*)&s[lasti];
- }
- lasti = i;
- (*charn)++;
- }
- return nil;
+ *charn = 0;
+ while(s[i]){+ c = u8_nextchar(s, &i);
+ if(c == ch){+ /* it's const for us, but not necessarily the caller */
+ return (char*)&s[lasti];
+ }
+ lasti = i;
+ (*charn)++;
+ }
+ return nil;
}
-char *u8_memchr(const char *s, uint32_t ch, size_t sz, size_t *charn)
+char *
+u8_memchr(const char *s, uint32_t ch, size_t sz, size_t *charn)
{- size_t i = 0, lasti=0;
- uint32_t c;
- int csz;
+ size_t i = 0, lasti = 0;
+ uint32_t c;
+ int csz;
- *charn = 0;
- while (i < sz) {- c = csz = 0;
- do {- c <<= 6;
- c += (uint8_t)s[i++];
- csz++;
- } while (i < sz && !isutf(s[i]));
- c -= offsetsFromUTF8[csz-1];
+ *charn = 0;
+ while(i < sz){+ c = csz = 0;
+ do{+ c <<= 6;
+ c += (uint8_t)s[i++];
+ csz++;
+ }while(i < sz && !isutf(s[i]));
+ c -= offsetsFromUTF8[csz-1];
- if (c == ch) {- return (char*)&s[lasti];
- }
- lasti = i;
- (*charn)++;
- }
- return nil;
+ if(c == ch)
+ return (char*)&s[lasti];
+ lasti = i;
+ (*charn)++;
+ }
+ return nil;
}
-char *u8_memrchr(const char *s, uint32_t ch, size_t sz)
+char *
+u8_memrchr(const char *s, uint32_t ch, size_t sz)
{- size_t i = sz-1, tempi=0;
- uint32_t c;
+ size_t i = sz-1, tempi = 0;
+ uint32_t c;
- if (sz == 0) return nil;
+ if(sz == 0)
+ return nil;
- while (i && !isutf(s[i])) i--;
+ while(i && !isutf(s[i]))
+ i--;
- while (1) {- tempi = i;
- c = u8_nextmemchar(s, &tempi);
- if (c == ch) {- return (char*)&s[i];
- }
- if (i == 0)
- break;
- tempi = i;
- u8_dec(s, &i);
- if (i > tempi)
- break;
- }
- return nil;
+ while(1){+ tempi = i;
+ c = u8_nextmemchar(s, &tempi);
+ if(c == ch)
+ return (char*)&s[i];
+ if(i == 0)
+ break;
+ tempi = i;
+ u8_dec(s, &i);
+ if(i > tempi)
+ break;
+ }
+ return nil;
}
-size_t u8_vprintf(const char *fmt, va_list ap)
+size_t
+u8_vprintf(const char *fmt, va_list ap)
{- size_t cnt, sz, nc, needfree=0;
- char *buf, tmp[512];
- uint32_t *wcs;
+ size_t cnt, sz, nc, needfree = 0;
+ char *buf, tmp[512];
+ uint32_t *wcs;
- sz = 512;
- buf = tmp;
- cnt = vsnprintf(buf, sz, fmt, ap);
- if ((ssize_t)cnt < 0)
- return 0;
- if (cnt >= sz) {- buf = (char*)malloc(cnt + 1);
- needfree = 1;
- vsnprintf(buf, cnt+1, fmt, ap);
- }
- wcs = (uint32_t*)malloc((cnt+1) * sizeof(uint32_t));
- nc = u8_toucs(wcs, cnt+1, buf, cnt);
- wcs[nc] = 0;
+ sz = 512;
+ buf = tmp;
+ cnt = vsnprintf(buf, sz, fmt, ap);
+ if((ssize_t)cnt < 0)
+ return 0;
+ if(cnt >= sz){+ buf = (char*)malloc(cnt + 1);
+ needfree = 1;
+ vsnprintf(buf, cnt+1, fmt, ap);
+ }
+ wcs = (uint32_t*)malloc((cnt+1) * sizeof(uint32_t));
+ nc = u8_toucs(wcs, cnt+1, buf, cnt);
+ wcs[nc] = 0;
#if defined(__plan9__)
- print("%S", (Rune*)wcs);+ print("%S", (Rune*)wcs);#else
- printf("%ls", (wchar_t*)wcs);+ printf("%ls", (wchar_t*)wcs);#endif
- free(wcs);
- if (needfree) free(buf);
- return nc;
+ free(wcs);
+ if(needfree)
+ free(buf);
+ return nc;
}
-size_t u8_printf(const char *fmt, ...)
+size_t
+u8_printf(const char *fmt, ...)
{- size_t cnt;
- va_list args;
+ size_t cnt;
+ va_list args;
- va_start(args, fmt);
+ va_start(args, fmt);
+ cnt = u8_vprintf(fmt, args);
- cnt = u8_vprintf(fmt, args);
-
- va_end(args);
- return cnt;
+ va_end(args);
+ return cnt;
}
/* based on the valid_utf8 routine from the PCRE library by Philip Hazel
@@ -594,103 +601,107 @@
length is in bytes, since without knowing whether the string is valid
it's hard to know how many characters there are! */
-int u8_isvalid(const char *str, int length)
+int
+u8_isvalid(const char *str, int length)
{- const uint8_t *p, *pend = (uint8_t*)str + length;
- uint8_t c;
- int ab;
+ const uint8_t *p, *pend = (uint8_t*)str + length;
+ uint8_t c;
+ int ab;
- for (p = (uint8_t*)str; p < pend; p++) {- c = *p;
- if (c < 128)
- continue;
- if ((c & 0xc0) != 0xc0)
- return 0;
- ab = trailingBytesForUTF8[c];
- if (length < ab)
- return 0;
- length -= ab;
+ for(p = (uint8_t*)str; p < pend; p++){+ c = *p;
+ if(c < 128)
+ continue;
+ if((c & 0xc0) != 0xc0)
+ return 0;
+ ab = trailingBytesForUTF8[c];
+ if(length < ab)
+ return 0;
+ length -= ab;
- p++;
- /* Check top bits in the second byte */
- if ((*p & 0xc0) != 0x80)
- return 0;
+ p++;
+ /* Check top bits in the second byte */
+ if((*p & 0xc0) != 0x80)
+ return 0;
- /* Check for overlong sequences for each different length */
- switch (ab) {- /* Check for xx00 000x */
- case 1:
- if ((c & 0x3e) == 0) return 0;
- continue; /* We know there aren't any more bytes to check */
+ /* Check for overlong sequences for each different length */
+ switch(ab) {+ /* Check for xx00 000x */
+ case 1:
+ if((c & 0x3e) == 0)
+ return 0;
+ continue; /* We know there aren't any more bytes to check */
- /* Check for 1110 0000, xx0x xxxx */
- case 2:
- if (c == 0xe0 && (*p & 0x20) == 0) return 0;
- break;
+ /* Check for 1110 0000, xx0x xxxx */
+ case 2:
+ if(c == 0xe0 && (*p & 0x20) == 0)
+ return 0;
+ break;
- /* Check for 1111 0000, xx00 xxxx */
- case 3:
- if (c == 0xf0 && (*p & 0x30) == 0) return 0;
- break;
+ /* Check for 1111 0000, xx00 xxxx */
+ case 3:
+ if(c == 0xf0 && (*p & 0x30) == 0)
+ return 0;
+ break;
- /* Check for 1111 1000, xx00 0xxx */
- case 4:
- if (c == 0xf8 && (*p & 0x38) == 0) return 0;
- break;
+ /* Check for 1111 1000, xx00 0xxx */
+ case 4:
+ if(c == 0xf8 && (*p & 0x38) == 0)
+ return 0;
+ break;
- /* Check for leading 0xfe or 0xff,
- and then for 1111 1100, xx00 00xx */
- case 5:
- if (c == 0xfe || c == 0xff ||
- (c == 0xfc && (*p & 0x3c) == 0)) return 0;
- break;
- }
+ /* Check for leading 0xfe or 0xff and then for 1111 1100, xx00 00xx */
+ case 5:
+ if(c == 0xfe || c == 0xff || (c == 0xfc && (*p & 0x3c) == 0))
+ return 0;
+ break;
+ }
- /* Check for valid bytes after the 2nd, if any; all must start 10 */
- while (--ab > 0) {- if ((*(++p) & 0xc0) != 0x80) return 0;
- }
- }
+ /* Check for valid bytes after the 2nd, if any; all must start 10 */
+ while(--ab > 0)
+ if((*(++p) & 0xc0) != 0x80)
+ return 0;
+ }
- return 1;
+ return 1;
}
-int u8_reverse(char *dest, char * src, size_t len)
+int
+u8_reverse(char *dest, char * src, size_t len)
{- size_t si=0, di=len;
- uint8_t c;
+ size_t si = 0, di = len;
+ uint8_t c;
- dest[di] = '\0';
- while (si < len) {- c = (uint8_t)src[si];
- if ((~c) & 0x80) {- di--;
- dest[di] = c;
- si++;
- }
- else {- switch (c>>4) {- case 0xC:
- case 0xD:
- di -= 2;
- *((int16_t*)&dest[di]) = *((int16_t*)&src[si]);
- si += 2;
- break;
- case 0xE:
- di -= 3;
- dest[di] = src[si];
- *((int16_t*)&dest[di+1]) = *((int16_t*)&src[si+1]);
- si += 3;
- break;
- case 0xF:
- di -= 4;
- *((int32_t*)&dest[di]) = *((int32_t*)&src[si]);
- si += 4;
- break;
- default:
- return 1;
- }
- }
- }
- return 0;
+ dest[di] = '\0';
+ while(si < len){+ c = (uint8_t)src[si];
+ if((~c) & 0x80){+ di--;
+ dest[di] = c;
+ si++;
+ }else{+ switch(c>>4){+ case 0xc:
+ case 0xd:
+ di -= 2;
+ *((int16_t*)&dest[di]) = *((int16_t*)&src[si]);
+ si += 2;
+ break;
+ case 0xe:
+ di -= 3;
+ dest[di] = src[si];
+ *((int16_t*)&dest[di+1]) = *((int16_t*)&src[si+1]);
+ si += 3;
+ break;
+ case 0xf:
+ di -= 4;
+ *((int32_t*)&dest[di]) = *((int32_t*)&src[si]);
+ si += 4;
+ break;
+ default:
+ return 1;
+ }
+ }
+ }
+ return 0;
}
--- a/llt/utf8.h
+++ b/llt/utf8.h
@@ -2,7 +2,7 @@
#define __UTF8_H_
/* is c the start of a utf8 sequence? */
-#define isutf(c) (((c)&0xC0)!=0x80)
+#define isutf(c) (((c)&0xC0) != 0x80)
int u8_iswprint(uint32_t c);
--- a/llt/wcwidth.c
+++ /dev/null
@@ -1,542 +1,0 @@
-/*
- * Copyright (C) Fredrik Fornwall 2016.
- * Distributed under the MIT License.
- *
- * Implementation of wcwidth(3) as a C port of:
- * https://github.com/jquast/wcwidth
- *
- * Report issues at:
- * https://github.com/termux/wcwidth
- *
- * IMPORTANT:
- * Must be kept in sync with the following:
- * https://github.com/termux/termux-app/blob/master/terminal-emulator/src/main/java/com/termux/terminal/WcWidth.java
- * https://github.com/termux/libandroid-support
- * https://github.com/termux/termux-packages/tree/master/packages/libandroid-support
- */
-
-#include "llt.h"
-
-struct width_interval {- int start;
- int end;
-};
-
-// From https://github.com/jquast/wcwidth/blob/master/wcwidth/table_zero.py
-// from https://github.com/jquast/wcwidth/pull/64
-// at commit 1b9b6585b0080ea5cb88dc9815796505724793fe (2022-12-16):
-static struct width_interval ZERO_WIDTH[] = {- {0x00300, 0x0036f}, // Combining Grave Accent ..Combining Latin Small Le- {0x00483, 0x00489}, // Combining Cyrillic Titlo..Combining Cyrillic Milli- {0x00591, 0x005bd}, // Hebrew Accent Etnahta ..Hebrew Point Meteg- {0x005bf, 0x005bf}, // Hebrew Point Rafe ..Hebrew Point Rafe- {0x005c1, 0x005c2}, // Hebrew Point Shin Dot ..Hebrew Point Sin Dot- {0x005c4, 0x005c5}, // Hebrew Mark Upper Dot ..Hebrew Mark Lower Dot- {0x005c7, 0x005c7}, // Hebrew Point Qamats Qata..Hebrew Point Qamats Qata- {0x00610, 0x0061a}, // Arabic Sign Sallallahou ..Arabic Small Kasra- {0x0064b, 0x0065f}, // Arabic Fathatan ..Arabic Wavy Hamza Below- {0x00670, 0x00670}, // Arabic Letter Superscrip..Arabic Letter Superscrip- {0x006d6, 0x006dc}, // Arabic Small High Ligatu..Arabic Small High Seen- {0x006df, 0x006e4}, // Arabic Small High Rounde..Arabic Small High Madda- {0x006e7, 0x006e8}, // Arabic Small High Yeh ..Arabic Small High Noon- {0x006ea, 0x006ed}, // Arabic Empty Centre Low ..Arabic Small Low Meem- {0x00711, 0x00711}, // Syriac Letter Superscrip..Syriac Letter Superscrip- {0x00730, 0x0074a}, // Syriac Pthaha Above ..Syriac Barrekh- {0x007a6, 0x007b0}, // Thaana Abafili ..Thaana Sukun- {0x007eb, 0x007f3}, // Nko Combining Short High..Nko Combining Double Dot- {0x007fd, 0x007fd}, // Nko Dantayalan ..Nko Dantayalan- {0x00816, 0x00819}, // Samaritan Mark In ..Samaritan Mark Dagesh- {0x0081b, 0x00823}, // Samaritan Mark Epentheti..Samaritan Vowel Sign A- {0x00825, 0x00827}, // Samaritan Vowel Sign Sho..Samaritan Vowel Sign U- {0x00829, 0x0082d}, // Samaritan Vowel Sign Lon..Samaritan Mark Nequdaa- {0x00859, 0x0085b}, // Mandaic Affrication Mark..Mandaic Gemination Mark- {0x00898, 0x0089f}, // Arabic Small High Word A..Arabic Half Madda Over M- {0x008ca, 0x008e1}, // Arabic Small High Farsi ..Arabic Small High Sign S- {0x008e3, 0x00902}, // Arabic Turned Damma Belo..Devanagari Sign Anusvara- {0x0093a, 0x0093a}, // Devanagari Vowel Sign Oe..Devanagari Vowel Sign Oe- {0x0093c, 0x0093c}, // Devanagari Sign Nukta ..Devanagari Sign Nukta- {0x00941, 0x00948}, // Devanagari Vowel Sign U ..Devanagari Vowel Sign Ai- {0x0094d, 0x0094d}, // Devanagari Sign Virama ..Devanagari Sign Virama- {0x00951, 0x00957}, // Devanagari Stress Sign U..Devanagari Vowel Sign Uu- {0x00962, 0x00963}, // Devanagari Vowel Sign Vo..Devanagari Vowel Sign Vo- {0x00981, 0x00981}, // Bengali Sign Candrabindu..Bengali Sign Candrabindu- {0x009bc, 0x009bc}, // Bengali Sign Nukta ..Bengali Sign Nukta- {0x009c1, 0x009c4}, // Bengali Vowel Sign U ..Bengali Vowel Sign Vocal- {0x009cd, 0x009cd}, // Bengali Sign Virama ..Bengali Sign Virama- {0x009e2, 0x009e3}, // Bengali Vowel Sign Vocal..Bengali Vowel Sign Vocal- {0x009fe, 0x009fe}, // Bengali Sandhi Mark ..Bengali Sandhi Mark- {0x00a01, 0x00a02}, // Gurmukhi Sign Adak Bindi..Gurmukhi Sign Bindi- {0x00a3c, 0x00a3c}, // Gurmukhi Sign Nukta ..Gurmukhi Sign Nukta- {0x00a41, 0x00a42}, // Gurmukhi Vowel Sign U ..Gurmukhi Vowel Sign Uu- {0x00a47, 0x00a48}, // Gurmukhi Vowel Sign Ee ..Gurmukhi Vowel Sign Ai- {0x00a4b, 0x00a4d}, // Gurmukhi Vowel Sign Oo ..Gurmukhi Sign Virama- {0x00a51, 0x00a51}, // Gurmukhi Sign Udaat ..Gurmukhi Sign Udaat- {0x00a70, 0x00a71}, // Gurmukhi Tippi ..Gurmukhi Addak- {0x00a75, 0x00a75}, // Gurmukhi Sign Yakash ..Gurmukhi Sign Yakash- {0x00a81, 0x00a82}, // Gujarati Sign Candrabind..Gujarati Sign Anusvara- {0x00abc, 0x00abc}, // Gujarati Sign Nukta ..Gujarati Sign Nukta- {0x00ac1, 0x00ac5}, // Gujarati Vowel Sign U ..Gujarati Vowel Sign Cand- {0x00ac7, 0x00ac8}, // Gujarati Vowel Sign E ..Gujarati Vowel Sign Ai- {0x00acd, 0x00acd}, // Gujarati Sign Virama ..Gujarati Sign Virama- {0x00ae2, 0x00ae3}, // Gujarati Vowel Sign Voca..Gujarati Vowel Sign Voca- {0x00afa, 0x00aff}, // Gujarati Sign Sukun ..Gujarati Sign Two-circle- {0x00b01, 0x00b01}, // Oriya Sign Candrabindu ..Oriya Sign Candrabindu- {0x00b3c, 0x00b3c}, // Oriya Sign Nukta ..Oriya Sign Nukta- {0x00b3f, 0x00b3f}, // Oriya Vowel Sign I ..Oriya Vowel Sign I- {0x00b41, 0x00b44}, // Oriya Vowel Sign U ..Oriya Vowel Sign Vocalic- {0x00b4d, 0x00b4d}, // Oriya Sign Virama ..Oriya Sign Virama- {0x00b55, 0x00b56}, // Oriya Sign Overline ..Oriya Ai Length Mark- {0x00b62, 0x00b63}, // Oriya Vowel Sign Vocalic..Oriya Vowel Sign Vocalic- {0x00b82, 0x00b82}, // Tamil Sign Anusvara ..Tamil Sign Anusvara- {0x00bc0, 0x00bc0}, // Tamil Vowel Sign Ii ..Tamil Vowel Sign Ii- {0x00bcd, 0x00bcd}, // Tamil Sign Virama ..Tamil Sign Virama- {0x00c00, 0x00c00}, // Telugu Sign Combining Ca..Telugu Sign Combining Ca- {0x00c04, 0x00c04}, // Telugu Sign Combining An..Telugu Sign Combining An- {0x00c3c, 0x00c3c}, // Telugu Sign Nukta ..Telugu Sign Nukta- {0x00c3e, 0x00c40}, // Telugu Vowel Sign Aa ..Telugu Vowel Sign Ii- {0x00c46, 0x00c48}, // Telugu Vowel Sign E ..Telugu Vowel Sign Ai- {0x00c4a, 0x00c4d}, // Telugu Vowel Sign O ..Telugu Sign Virama- {0x00c55, 0x00c56}, // Telugu Length Mark ..Telugu Ai Length Mark- {0x00c62, 0x00c63}, // Telugu Vowel Sign Vocali..Telugu Vowel Sign Vocali- {0x00c81, 0x00c81}, // Kannada Sign Candrabindu..Kannada Sign Candrabindu- {0x00cbc, 0x00cbc}, // Kannada Sign Nukta ..Kannada Sign Nukta- {0x00cbf, 0x00cbf}, // Kannada Vowel Sign I ..Kannada Vowel Sign I- {0x00cc6, 0x00cc6}, // Kannada Vowel Sign E ..Kannada Vowel Sign E- {0x00ccc, 0x00ccd}, // Kannada Vowel Sign Au ..Kannada Sign Virama- {0x00ce2, 0x00ce3}, // Kannada Vowel Sign Vocal..Kannada Vowel Sign Vocal- {0x00d00, 0x00d01}, // Malayalam Sign Combining..Malayalam Sign Candrabin- {0x00d3b, 0x00d3c}, // Malayalam Sign Vertical ..Malayalam Sign Circular- {0x00d41, 0x00d44}, // Malayalam Vowel Sign U ..Malayalam Vowel Sign Voc- {0x00d4d, 0x00d4d}, // Malayalam Sign Virama ..Malayalam Sign Virama- {0x00d62, 0x00d63}, // Malayalam Vowel Sign Voc..Malayalam Vowel Sign Voc- {0x00d81, 0x00d81}, // Sinhala Sign Candrabindu..Sinhala Sign Candrabindu- {0x00dca, 0x00dca}, // Sinhala Sign Al-lakuna ..Sinhala Sign Al-lakuna- {0x00dd2, 0x00dd4}, // Sinhala Vowel Sign Ketti..Sinhala Vowel Sign Ketti- {0x00dd6, 0x00dd6}, // Sinhala Vowel Sign Diga ..Sinhala Vowel Sign Diga- {0x00e31, 0x00e31}, // Thai Character Mai Han-a..Thai Character Mai Han-a- {0x00e34, 0x00e3a}, // Thai Character Sara I ..Thai Character Phinthu- {0x00e47, 0x00e4e}, // Thai Character Maitaikhu..Thai Character Yamakkan- {0x00eb1, 0x00eb1}, // Lao Vowel Sign Mai Kan ..Lao Vowel Sign Mai Kan- {0x00eb4, 0x00ebc}, // Lao Vowel Sign I ..Lao Semivowel Sign Lo- {0x00ec8, 0x00ece}, // Lao Tone Mai Ek ..(nil)- {0x00f18, 0x00f19}, // Tibetan Astrological Sig..Tibetan Astrological Sig- {0x00f35, 0x00f35}, // Tibetan Mark Ngas Bzung ..Tibetan Mark Ngas Bzung- {0x00f37, 0x00f37}, // Tibetan Mark Ngas Bzung ..Tibetan Mark Ngas Bzung- {0x00f39, 0x00f39}, // Tibetan Mark Tsa -phru ..Tibetan Mark Tsa -phru- {0x00f71, 0x00f7e}, // Tibetan Vowel Sign Aa ..Tibetan Sign Rjes Su Nga- {0x00f80, 0x00f84}, // Tibetan Vowel Sign Rever..Tibetan Mark Halanta- {0x00f86, 0x00f87}, // Tibetan Sign Lci Rtags ..Tibetan Sign Yang Rtags- {0x00f8d, 0x00f97}, // Tibetan Subjoined Sign L..Tibetan Subjoined Letter- {0x00f99, 0x00fbc}, // Tibetan Subjoined Letter..Tibetan Subjoined Letter- {0x00fc6, 0x00fc6}, // Tibetan Symbol Padma Gda..Tibetan Symbol Padma Gda- {0x0102d, 0x01030}, // Myanmar Vowel Sign I ..Myanmar Vowel Sign Uu- {0x01032, 0x01037}, // Myanmar Vowel Sign Ai ..Myanmar Sign Dot Below- {0x01039, 0x0103a}, // Myanmar Sign Virama ..Myanmar Sign Asat- {0x0103d, 0x0103e}, // Myanmar Consonant Sign M..Myanmar Consonant Sign M- {0x01058, 0x01059}, // Myanmar Vowel Sign Vocal..Myanmar Vowel Sign Vocal- {0x0105e, 0x01060}, // Myanmar Consonant Sign M..Myanmar Consonant Sign M- {0x01071, 0x01074}, // Myanmar Vowel Sign Geba ..Myanmar Vowel Sign Kayah- {0x01082, 0x01082}, // Myanmar Consonant Sign S..Myanmar Consonant Sign S- {0x01085, 0x01086}, // Myanmar Vowel Sign Shan ..Myanmar Vowel Sign Shan- {0x0108d, 0x0108d}, // Myanmar Sign Shan Counci..Myanmar Sign Shan Counci- {0x0109d, 0x0109d}, // Myanmar Vowel Sign Aiton..Myanmar Vowel Sign Aiton- {0x0135d, 0x0135f}, // Ethiopic Combining Gemin..Ethiopic Combining Gemin- {0x01712, 0x01714}, // Tagalog Vowel Sign I ..Tagalog Sign Virama- {0x01732, 0x01733}, // Hanunoo Vowel Sign I ..Hanunoo Vowel Sign U- {0x01752, 0x01753}, // Buhid Vowel Sign I ..Buhid Vowel Sign U- {0x01772, 0x01773}, // Tagbanwa Vowel Sign I ..Tagbanwa Vowel Sign U- {0x017b4, 0x017b5}, // Khmer Vowel Inherent Aq ..Khmer Vowel Inherent Aa- {0x017b7, 0x017bd}, // Khmer Vowel Sign I ..Khmer Vowel Sign Ua- {0x017c6, 0x017c6}, // Khmer Sign Nikahit ..Khmer Sign Nikahit- {0x017c9, 0x017d3}, // Khmer Sign Muusikatoan ..Khmer Sign Bathamasat- {0x017dd, 0x017dd}, // Khmer Sign Atthacan ..Khmer Sign Atthacan- {0x0180b, 0x0180d}, // Mongolian Free Variation..Mongolian Free Variation- {0x0180f, 0x0180f}, // Mongolian Free Variation..Mongolian Free Variation- {0x01885, 0x01886}, // Mongolian Letter Ali Gal..Mongolian Letter Ali Gal- {0x018a9, 0x018a9}, // Mongolian Letter Ali Gal..Mongolian Letter Ali Gal- {0x01920, 0x01922}, // Limbu Vowel Sign A ..Limbu Vowel Sign U- {0x01927, 0x01928}, // Limbu Vowel Sign E ..Limbu Vowel Sign O- {0x01932, 0x01932}, // Limbu Small Letter Anusv..Limbu Small Letter Anusv- {0x01939, 0x0193b}, // Limbu Sign Mukphreng ..Limbu Sign Sa-i- {0x01a17, 0x01a18}, // Buginese Vowel Sign I ..Buginese Vowel Sign U- {0x01a1b, 0x01a1b}, // Buginese Vowel Sign Ae ..Buginese Vowel Sign Ae- {0x01a56, 0x01a56}, // Tai Tham Consonant Sign ..Tai Tham Consonant Sign- {0x01a58, 0x01a5e}, // Tai Tham Sign Mai Kang L..Tai Tham Consonant Sign- {0x01a60, 0x01a60}, // Tai Tham Sign Sakot ..Tai Tham Sign Sakot- {0x01a62, 0x01a62}, // Tai Tham Vowel Sign Mai ..Tai Tham Vowel Sign Mai- {0x01a65, 0x01a6c}, // Tai Tham Vowel Sign I ..Tai Tham Vowel Sign Oa B- {0x01a73, 0x01a7c}, // Tai Tham Vowel Sign Oa A..Tai Tham Sign Khuen-lue- {0x01a7f, 0x01a7f}, // Tai Tham Combining Crypt..Tai Tham Combining Crypt- {0x01ab0, 0x01ace}, // Combining Doubled Circum..Combining Latin Small Le- {0x01b00, 0x01b03}, // Balinese Sign Ulu Ricem ..Balinese Sign Surang- {0x01b34, 0x01b34}, // Balinese Sign Rerekan ..Balinese Sign Rerekan- {0x01b36, 0x01b3a}, // Balinese Vowel Sign Ulu ..Balinese Vowel Sign Ra R- {0x01b3c, 0x01b3c}, // Balinese Vowel Sign La L..Balinese Vowel Sign La L- {0x01b42, 0x01b42}, // Balinese Vowel Sign Pepe..Balinese Vowel Sign Pepe- {0x01b6b, 0x01b73}, // Balinese Musical Symbol ..Balinese Musical Symbol- {0x01b80, 0x01b81}, // Sundanese Sign Panyecek ..Sundanese Sign Panglayar- {0x01ba2, 0x01ba5}, // Sundanese Consonant Sign..Sundanese Vowel Sign Pan- {0x01ba8, 0x01ba9}, // Sundanese Vowel Sign Pam..Sundanese Vowel Sign Pan- {0x01bab, 0x01bad}, // Sundanese Sign Virama ..Sundanese Consonant Sign- {0x01be6, 0x01be6}, // Batak Sign Tompi ..Batak Sign Tompi- {0x01be8, 0x01be9}, // Batak Vowel Sign Pakpak ..Batak Vowel Sign Ee- {0x01bed, 0x01bed}, // Batak Vowel Sign Karo O ..Batak Vowel Sign Karo O- {0x01bef, 0x01bf1}, // Batak Vowel Sign U For S..Batak Consonant Sign H- {0x01c2c, 0x01c33}, // Lepcha Vowel Sign E ..Lepcha Consonant Sign T- {0x01c36, 0x01c37}, // Lepcha Sign Ran ..Lepcha Sign Nukta- {0x01cd0, 0x01cd2}, // Vedic Tone Karshana ..Vedic Tone Prenkha- {0x01cd4, 0x01ce0}, // Vedic Sign Yajurvedic Mi..Vedic Tone Rigvedic Kash- {0x01ce2, 0x01ce8}, // Vedic Sign Visarga Svari..Vedic Sign Visarga Anuda- {0x01ced, 0x01ced}, // Vedic Sign Tiryak ..Vedic Sign Tiryak- {0x01cf4, 0x01cf4}, // Vedic Tone Candra Above ..Vedic Tone Candra Above- {0x01cf8, 0x01cf9}, // Vedic Tone Ring Above ..Vedic Tone Double Ring A- {0x01dc0, 0x01dff}, // Combining Dotted Grave A..Combining Right Arrowhea- {0x020d0, 0x020f0}, // Combining Left Harpoon A..Combining Asterisk Above- {0x02cef, 0x02cf1}, // Coptic Combining Ni Abov..Coptic Combining Spiritu- {0x02d7f, 0x02d7f}, // Tifinagh Consonant Joine..Tifinagh Consonant Joine- {0x02de0, 0x02dff}, // Combining Cyrillic Lette..Combining Cyrillic Lette- {0x0302a, 0x0302d}, // Ideographic Level Tone M..Ideographic Entering Ton- {0x03099, 0x0309a}, // Combining Katakana-hirag..Combining Katakana-hirag- {0x0a66f, 0x0a672}, // Combining Cyrillic Vzmet..Combining Cyrillic Thous- {0x0a674, 0x0a67d}, // Combining Cyrillic Lette..Combining Cyrillic Payer- {0x0a69e, 0x0a69f}, // Combining Cyrillic Lette..Combining Cyrillic Lette- {0x0a6f0, 0x0a6f1}, // Bamum Combining Mark Koq..Bamum Combining Mark Tuk- {0x0a802, 0x0a802}, // Syloti Nagri Sign Dvisva..Syloti Nagri Sign Dvisva- {0x0a806, 0x0a806}, // Syloti Nagri Sign Hasant..Syloti Nagri Sign Hasant- {0x0a80b, 0x0a80b}, // Syloti Nagri Sign Anusva..Syloti Nagri Sign Anusva- {0x0a825, 0x0a826}, // Syloti Nagri Vowel Sign ..Syloti Nagri Vowel Sign- {0x0a82c, 0x0a82c}, // Syloti Nagri Sign Altern..Syloti Nagri Sign Altern- {0x0a8c4, 0x0a8c5}, // Saurashtra Sign Virama ..Saurashtra Sign Candrabi- {0x0a8e0, 0x0a8f1}, // Combining Devanagari Dig..Combining Devanagari Sig- {0x0a8ff, 0x0a8ff}, // Devanagari Vowel Sign Ay..Devanagari Vowel Sign Ay- {0x0a926, 0x0a92d}, // Kayah Li Vowel Ue ..Kayah Li Tone Calya Plop- {0x0a947, 0x0a951}, // Rejang Vowel Sign I ..Rejang Consonant Sign R- {0x0a980, 0x0a982}, // Javanese Sign Panyangga ..Javanese Sign Layar- {0x0a9b3, 0x0a9b3}, // Javanese Sign Cecak Telu..Javanese Sign Cecak Telu- {0x0a9b6, 0x0a9b9}, // Javanese Vowel Sign Wulu..Javanese Vowel Sign Suku- {0x0a9bc, 0x0a9bd}, // Javanese Vowel Sign Pepe..Javanese Consonant Sign- {0x0a9e5, 0x0a9e5}, // Myanmar Sign Shan Saw ..Myanmar Sign Shan Saw- {0x0aa29, 0x0aa2e}, // Cham Vowel Sign Aa ..Cham Vowel Sign Oe- {0x0aa31, 0x0aa32}, // Cham Vowel Sign Au ..Cham Vowel Sign Ue- {0x0aa35, 0x0aa36}, // Cham Consonant Sign La ..Cham Consonant Sign Wa- {0x0aa43, 0x0aa43}, // Cham Consonant Sign Fina..Cham Consonant Sign Fina- {0x0aa4c, 0x0aa4c}, // Cham Consonant Sign Fina..Cham Consonant Sign Fina- {0x0aa7c, 0x0aa7c}, // Myanmar Sign Tai Laing T..Myanmar Sign Tai Laing T- {0x0aab0, 0x0aab0}, // Tai Viet Mai Kang ..Tai Viet Mai Kang- {0x0aab2, 0x0aab4}, // Tai Viet Vowel I ..Tai Viet Vowel U- {0x0aab7, 0x0aab8}, // Tai Viet Mai Khit ..Tai Viet Vowel Ia- {0x0aabe, 0x0aabf}, // Tai Viet Vowel Am ..Tai Viet Tone Mai Ek- {0x0aac1, 0x0aac1}, // Tai Viet Tone Mai Tho ..Tai Viet Tone Mai Tho- {0x0aaec, 0x0aaed}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign- {0x0aaf6, 0x0aaf6}, // Meetei Mayek Virama ..Meetei Mayek Virama- {0x0abe5, 0x0abe5}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign- {0x0abe8, 0x0abe8}, // Meetei Mayek Vowel Sign ..Meetei Mayek Vowel Sign- {0x0abed, 0x0abed}, // Meetei Mayek Apun Iyek ..Meetei Mayek Apun Iyek- {0x0fb1e, 0x0fb1e}, // Hebrew Point Judeo-spani..Hebrew Point Judeo-spani- {0x0fe00, 0x0fe0f}, // Variation Selector-1 ..Variation Selector-16- {0x0fe20, 0x0fe2f}, // Combining Ligature Left ..Combining Cyrillic Titlo- {0x101fd, 0x101fd}, // Phaistos Disc Sign Combi..Phaistos Disc Sign Combi- {0x102e0, 0x102e0}, // Coptic Epact Thousands M..Coptic Epact Thousands M- {0x10376, 0x1037a}, // Combining Old Permic Let..Combining Old Permic Let- {0x10a01, 0x10a03}, // Kharoshthi Vowel Sign I ..Kharoshthi Vowel Sign Vo- {0x10a05, 0x10a06}, // Kharoshthi Vowel Sign E ..Kharoshthi Vowel Sign O- {0x10a0c, 0x10a0f}, // Kharoshthi Vowel Length ..Kharoshthi Sign Visarga- {0x10a38, 0x10a3a}, // Kharoshthi Sign Bar Abov..Kharoshthi Sign Dot Belo- {0x10a3f, 0x10a3f}, // Kharoshthi Virama ..Kharoshthi Virama- {0x10ae5, 0x10ae6}, // Manichaean Abbreviation ..Manichaean Abbreviation- {0x10d24, 0x10d27}, // Hanifi Rohingya Sign Har..Hanifi Rohingya Sign Tas- {0x10eab, 0x10eac}, // Yezidi Combining Hamza M..Yezidi Combining Madda M- {0x10efd, 0x10eff}, // (nil) ..(nil)- {0x10f46, 0x10f50}, // Sogdian Combining Dot Be..Sogdian Combining Stroke- {0x10f82, 0x10f85}, // Old Uyghur Combining Dot..Old Uyghur Combining Two- {0x11001, 0x11001}, // Brahmi Sign Anusvara ..Brahmi Sign Anusvara- {0x11038, 0x11046}, // Brahmi Vowel Sign Aa ..Brahmi Virama- {0x11070, 0x11070}, // Brahmi Sign Old Tamil Vi..Brahmi Sign Old Tamil Vi- {0x11073, 0x11074}, // Brahmi Vowel Sign Old Ta..Brahmi Vowel Sign Old Ta- {0x1107f, 0x11081}, // Brahmi Number Joiner ..Kaithi Sign Anusvara- {0x110b3, 0x110b6}, // Kaithi Vowel Sign U ..Kaithi Vowel Sign Ai- {0x110b9, 0x110ba}, // Kaithi Sign Virama ..Kaithi Sign Nukta- {0x110c2, 0x110c2}, // Kaithi Vowel Sign Vocali..Kaithi Vowel Sign Vocali- {0x11100, 0x11102}, // Chakma Sign Candrabindu ..Chakma Sign Visarga- {0x11127, 0x1112b}, // Chakma Vowel Sign A ..Chakma Vowel Sign Uu- {0x1112d, 0x11134}, // Chakma Vowel Sign Ai ..Chakma Maayyaa- {0x11173, 0x11173}, // Mahajani Sign Nukta ..Mahajani Sign Nukta- {0x11180, 0x11181}, // Sharada Sign Candrabindu..Sharada Sign Anusvara- {0x111b6, 0x111be}, // Sharada Vowel Sign U ..Sharada Vowel Sign O- {0x111c9, 0x111cc}, // Sharada Sandhi Mark ..Sharada Extra Short Vowe- {0x111cf, 0x111cf}, // Sharada Sign Inverted Ca..Sharada Sign Inverted Ca- {0x1122f, 0x11231}, // Khojki Vowel Sign U ..Khojki Vowel Sign Ai- {0x11234, 0x11234}, // Khojki Sign Anusvara ..Khojki Sign Anusvara- {0x11236, 0x11237}, // Khojki Sign Nukta ..Khojki Sign Shadda- {0x1123e, 0x1123e}, // Khojki Sign Sukun ..Khojki Sign Sukun- {0x11241, 0x11241}, // (nil) ..(nil)- {0x112df, 0x112df}, // Khudawadi Sign Anusvara ..Khudawadi Sign Anusvara- {0x112e3, 0x112ea}, // Khudawadi Vowel Sign U ..Khudawadi Sign Virama- {0x11300, 0x11301}, // Grantha Sign Combining A..Grantha Sign Candrabindu- {0x1133b, 0x1133c}, // Combining Bindu Below ..Grantha Sign Nukta- {0x11340, 0x11340}, // Grantha Vowel Sign Ii ..Grantha Vowel Sign Ii- {0x11366, 0x1136c}, // Combining Grantha Digit ..Combining Grantha Digit- {0x11370, 0x11374}, // Combining Grantha Letter..Combining Grantha Letter- {0x11438, 0x1143f}, // Newa Vowel Sign U ..Newa Vowel Sign Ai- {0x11442, 0x11444}, // Newa Sign Virama ..Newa Sign Anusvara- {0x11446, 0x11446}, // Newa Sign Nukta ..Newa Sign Nukta- {0x1145e, 0x1145e}, // Newa Sandhi Mark ..Newa Sandhi Mark- {0x114b3, 0x114b8}, // Tirhuta Vowel Sign U ..Tirhuta Vowel Sign Vocal- {0x114ba, 0x114ba}, // Tirhuta Vowel Sign Short..Tirhuta Vowel Sign Short- {0x114bf, 0x114c0}, // Tirhuta Sign Candrabindu..Tirhuta Sign Anusvara- {0x114c2, 0x114c3}, // Tirhuta Sign Virama ..Tirhuta Sign Nukta- {0x115b2, 0x115b5}, // Siddham Vowel Sign U ..Siddham Vowel Sign Vocal- {0x115bc, 0x115bd}, // Siddham Sign Candrabindu..Siddham Sign Anusvara- {0x115bf, 0x115c0}, // Siddham Sign Virama ..Siddham Sign Nukta- {0x115dc, 0x115dd}, // Siddham Vowel Sign Alter..Siddham Vowel Sign Alter- {0x11633, 0x1163a}, // Modi Vowel Sign U ..Modi Vowel Sign Ai- {0x1163d, 0x1163d}, // Modi Sign Anusvara ..Modi Sign Anusvara- {0x1163f, 0x11640}, // Modi Sign Virama ..Modi Sign Ardhacandra- {0x116ab, 0x116ab}, // Takri Sign Anusvara ..Takri Sign Anusvara- {0x116ad, 0x116ad}, // Takri Vowel Sign Aa ..Takri Vowel Sign Aa- {0x116b0, 0x116b5}, // Takri Vowel Sign U ..Takri Vowel Sign Au- {0x116b7, 0x116b7}, // Takri Sign Nukta ..Takri Sign Nukta- {0x1171d, 0x1171f}, // Ahom Consonant Sign Medi..Ahom Consonant Sign Medi- {0x11722, 0x11725}, // Ahom Vowel Sign I ..Ahom Vowel Sign Uu- {0x11727, 0x1172b}, // Ahom Vowel Sign Aw ..Ahom Sign Killer- {0x1182f, 0x11837}, // Dogra Vowel Sign U ..Dogra Sign Anusvara- {0x11839, 0x1183a}, // Dogra Sign Virama ..Dogra Sign Nukta- {0x1193b, 0x1193c}, // Dives Akuru Sign Anusvar..Dives Akuru Sign Candrab- {0x1193e, 0x1193e}, // Dives Akuru Virama ..Dives Akuru Virama- {0x11943, 0x11943}, // Dives Akuru Sign Nukta ..Dives Akuru Sign Nukta- {0x119d4, 0x119d7}, // Nandinagari Vowel Sign U..Nandinagari Vowel Sign V- {0x119da, 0x119db}, // Nandinagari Vowel Sign E..Nandinagari Vowel Sign A- {0x119e0, 0x119e0}, // Nandinagari Sign Virama ..Nandinagari Sign Virama- {0x11a01, 0x11a0a}, // Zanabazar Square Vowel S..Zanabazar Square Vowel L- {0x11a33, 0x11a38}, // Zanabazar Square Final C..Zanabazar Square Sign An- {0x11a3b, 0x11a3e}, // Zanabazar Square Cluster..Zanabazar Square Cluster- {0x11a47, 0x11a47}, // Zanabazar Square Subjoin..Zanabazar Square Subjoin- {0x11a51, 0x11a56}, // Soyombo Vowel Sign I ..Soyombo Vowel Sign Oe- {0x11a59, 0x11a5b}, // Soyombo Vowel Sign Vocal..Soyombo Vowel Length Mar- {0x11a8a, 0x11a96}, // Soyombo Final Consonant ..Soyombo Sign Anusvara- {0x11a98, 0x11a99}, // Soyombo Gemination Mark ..Soyombo Subjoiner- {0x11c30, 0x11c36}, // Bhaiksuki Vowel Sign I ..Bhaiksuki Vowel Sign Voc- {0x11c38, 0x11c3d}, // Bhaiksuki Vowel Sign E ..Bhaiksuki Sign Anusvara- {0x11c3f, 0x11c3f}, // Bhaiksuki Sign Virama ..Bhaiksuki Sign Virama- {0x11c92, 0x11ca7}, // Marchen Subjoined Letter..Marchen Subjoined Letter- {0x11caa, 0x11cb0}, // Marchen Subjoined Letter..Marchen Vowel Sign Aa- {0x11cb2, 0x11cb3}, // Marchen Vowel Sign U ..Marchen Vowel Sign E- {0x11cb5, 0x11cb6}, // Marchen Sign Anusvara ..Marchen Sign Candrabindu- {0x11d31, 0x11d36}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign- {0x11d3a, 0x11d3a}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign- {0x11d3c, 0x11d3d}, // Masaram Gondi Vowel Sign..Masaram Gondi Vowel Sign- {0x11d3f, 0x11d45}, // Masaram Gondi Vowel Sign..Masaram Gondi Virama- {0x11d47, 0x11d47}, // Masaram Gondi Ra-kara ..Masaram Gondi Ra-kara- {0x11d90, 0x11d91}, // Gunjala Gondi Vowel Sign..Gunjala Gondi Vowel Sign- {0x11d95, 0x11d95}, // Gunjala Gondi Sign Anusv..Gunjala Gondi Sign Anusv- {0x11d97, 0x11d97}, // Gunjala Gondi Virama ..Gunjala Gondi Virama- {0x11ef3, 0x11ef4}, // Makasar Vowel Sign I ..Makasar Vowel Sign U- {0x11f00, 0x11f01}, // (nil) ..(nil)- {0x11f36, 0x11f3a}, // (nil) ..(nil)- {0x11f40, 0x11f40}, // (nil) ..(nil)- {0x11f42, 0x11f42}, // (nil) ..(nil)- {0x13440, 0x13440}, // (nil) ..(nil)- {0x13447, 0x13455}, // (nil) ..(nil)- {0x16af0, 0x16af4}, // Bassa Vah Combining High..Bassa Vah Combining High- {0x16b30, 0x16b36}, // Pahawh Hmong Mark Cim Tu..Pahawh Hmong Mark Cim Ta- {0x16f4f, 0x16f4f}, // Miao Sign Consonant Modi..Miao Sign Consonant Modi- {0x16f8f, 0x16f92}, // Miao Tone Right ..Miao Tone Below- {0x16fe4, 0x16fe4}, // Khitan Small Script Fill..Khitan Small Script Fill- {0x1bc9d, 0x1bc9e}, // Duployan Thick Letter Se..Duployan Double Mark- {0x1cf00, 0x1cf2d}, // Znamenny Combining Mark ..Znamenny Combining Mark- {0x1cf30, 0x1cf46}, // Znamenny Combining Tonal..Znamenny Priznak Modifie- {0x1d167, 0x1d169}, // Musical Symbol Combining..Musical Symbol Combining- {0x1d17b, 0x1d182}, // Musical Symbol Combining..Musical Symbol Combining- {0x1d185, 0x1d18b}, // Musical Symbol Combining..Musical Symbol Combining- {0x1d1aa, 0x1d1ad}, // Musical Symbol Combining..Musical Symbol Combining- {0x1d242, 0x1d244}, // Combining Greek Musical ..Combining Greek Musical- {0x1da00, 0x1da36}, // Signwriting Head Rim ..Signwriting Air Sucking- {0x1da3b, 0x1da6c}, // Signwriting Mouth Closed..Signwriting Excitement- {0x1da75, 0x1da75}, // Signwriting Upper Body T..Signwriting Upper Body T- {0x1da84, 0x1da84}, // Signwriting Location Hea..Signwriting Location Hea- {0x1da9b, 0x1da9f}, // Signwriting Fill Modifie..Signwriting Fill Modifie- {0x1daa1, 0x1daaf}, // Signwriting Rotation Mod..Signwriting Rotation Mod- {0x1e000, 0x1e006}, // Combining Glagolitic Let..Combining Glagolitic Let- {0x1e008, 0x1e018}, // Combining Glagolitic Let..Combining Glagolitic Let- {0x1e01b, 0x1e021}, // Combining Glagolitic Let..Combining Glagolitic Let- {0x1e023, 0x1e024}, // Combining Glagolitic Let..Combining Glagolitic Let- {0x1e026, 0x1e02a}, // Combining Glagolitic Let..Combining Glagolitic Let- {0x1e08f, 0x1e08f}, // (nil) ..(nil)- {0x1e130, 0x1e136}, // Nyiakeng Puachue Hmong T..Nyiakeng Puachue Hmong T- {0x1e2ae, 0x1e2ae}, // Toto Sign Rising Tone ..Toto Sign Rising Tone- {0x1e2ec, 0x1e2ef}, // Wancho Tone Tup ..Wancho Tone Koini- {0x1e4ec, 0x1e4ef}, // (nil) ..(nil)- {0x1e8d0, 0x1e8d6}, // Mende Kikakui Combining ..Mende Kikakui Combining- {0x1e944, 0x1e94a}, // Adlam Alif Lengthener ..Adlam Nukta- {0xe0100, 0xe01ef}, // Variation Selector-17 ..Variation Selector-256-};
-
-// https://github.com/jquast/wcwidth/blob/master/wcwidth/table_wide.py
-// from https://github.com/jquast/wcwidth/pull/64
-// at commit 1b9b6585b0080ea5cb88dc9815796505724793fe (2022-12-16):
-static struct width_interval WIDE_EASTASIAN[] = {- {0x01100, 0x0115f}, // Hangul Choseong Kiyeok ..Hangul Choseong Filler- {0x0231a, 0x0231b}, // Watch ..Hourglass- {0x02329, 0x0232a}, // Left-pointing Angle Brac..Right-pointing Angle Bra- {0x023e9, 0x023ec}, // Black Right-pointing Dou..Black Down-pointing Doub- {0x023f0, 0x023f0}, // Alarm Clock ..Alarm Clock- {0x023f3, 0x023f3}, // Hourglass With Flowing S..Hourglass With Flowing S- {0x025fd, 0x025fe}, // White Medium Small Squar..Black Medium Small Squar- {0x02614, 0x02615}, // Umbrella With Rain Drops..Hot Beverage- {0x02648, 0x02653}, // Aries ..Pisces- {0x0267f, 0x0267f}, // Wheelchair Symbol ..Wheelchair Symbol- {0x02693, 0x02693}, // Anchor ..Anchor- {0x026a1, 0x026a1}, // High Voltage Sign ..High Voltage Sign- {0x026aa, 0x026ab}, // Medium White Circle ..Medium Black Circle- {0x026bd, 0x026be}, // Soccer Ball ..Baseball- {0x026c4, 0x026c5}, // Snowman Without Snow ..Sun Behind Cloud- {0x026ce, 0x026ce}, // Ophiuchus ..Ophiuchus- {0x026d4, 0x026d4}, // No Entry ..No Entry- {0x026ea, 0x026ea}, // Church ..Church- {0x026f2, 0x026f3}, // Fountain ..Flag In Hole- {0x026f5, 0x026f5}, // Sailboat ..Sailboat- {0x026fa, 0x026fa}, // Tent ..Tent- {0x026fd, 0x026fd}, // Fuel Pump ..Fuel Pump- {0x02705, 0x02705}, // White Heavy Check Mark ..White Heavy Check Mark- {0x0270a, 0x0270b}, // Raised Fist ..Raised Hand- {0x02728, 0x02728}, // Sparkles ..Sparkles- {0x0274c, 0x0274c}, // Cross Mark ..Cross Mark- {0x0274e, 0x0274e}, // Negative Squared Cross M..Negative Squared Cross M- {0x02753, 0x02755}, // Black Question Mark Orna..White Exclamation Mark O- {0x02757, 0x02757}, // Heavy Exclamation Mark S..Heavy Exclamation Mark S- {0x02795, 0x02797}, // Heavy Plus Sign ..Heavy Division Sign- {0x027b0, 0x027b0}, // Curly Loop ..Curly Loop- {0x027bf, 0x027bf}, // Double Curly Loop ..Double Curly Loop- {0x02b1b, 0x02b1c}, // Black Large Square ..White Large Square- {0x02b50, 0x02b50}, // White Medium Star ..White Medium Star- {0x02b55, 0x02b55}, // Heavy Large Circle ..Heavy Large Circle- {0x02e80, 0x02e99}, // Cjk Radical Repeat ..Cjk Radical Rap- {0x02e9b, 0x02ef3}, // Cjk Radical Choke ..Cjk Radical C-simplified- {0x02f00, 0x02fd5}, // Kangxi Radical One ..Kangxi Radical Flute- {0x02ff0, 0x02ffb}, // Ideographic Description ..Ideographic Description- {0x03000, 0x0303e}, // Ideographic Space ..Ideographic Variation In- {0x03041, 0x03096}, // Hiragana Letter Small A ..Hiragana Letter Small Ke- {0x03099, 0x030ff}, // Combining Katakana-hirag..Katakana Digraph Koto- {0x03105, 0x0312f}, // Bopomofo Letter B ..Bopomofo Letter Nn- {0x03131, 0x0318e}, // Hangul Letter Kiyeok ..Hangul Letter Araeae- {0x03190, 0x031e3}, // Ideographic Annotation L..Cjk Stroke Q- {0x031f0, 0x0321e}, // Katakana Letter Small Ku..Parenthesized Korean Cha- {0x03220, 0x03247}, // Parenthesized Ideograph ..Circled Ideograph Koto- {0x03250, 0x04dbf}, // Partnership Sign ..Cjk Unified Ideograph-4d- {0x04e00, 0x0a48c}, // Cjk Unified Ideograph-4e..Yi Syllable Yyr- {0x0a490, 0x0a4c6}, // Yi Radical Qot ..Yi Radical Ke- {0x0a960, 0x0a97c}, // Hangul Choseong Tikeut-m..Hangul Choseong Ssangyeo- {0x0ac00, 0x0d7a3}, // Hangul Syllable Ga ..Hangul Syllable Hih- {0x0f900, 0x0faff}, // Cjk Compatibility Ideogr..(nil)- {0x0fe10, 0x0fe19}, // Presentation Form For Ve..Presentation Form For Ve- {0x0fe30, 0x0fe52}, // Presentation Form For Ve..Small Full Stop- {0x0fe54, 0x0fe66}, // Small Semicolon ..Small Equals Sign- {0x0fe68, 0x0fe6b}, // Small Reverse Solidus ..Small Commercial At- {0x0ff01, 0x0ff60}, // Fullwidth Exclamation Ma..Fullwidth Right White Pa- {0x0ffe0, 0x0ffe6}, // Fullwidth Cent Sign ..Fullwidth Won Sign- {0x16fe0, 0x16fe4}, // Tangut Iteration Mark ..Khitan Small Script Fill- {0x16ff0, 0x16ff1}, // Vietnamese Alternate Rea..Vietnamese Alternate Rea- {0x17000, 0x187f7}, // (nil) ..(nil)- {0x18800, 0x18cd5}, // Tangut Component-001 ..Khitan Small Script Char- {0x18d00, 0x18d08}, // (nil) ..(nil)- {0x1aff0, 0x1aff3}, // Katakana Letter Minnan T..Katakana Letter Minnan T- {0x1aff5, 0x1affb}, // Katakana Letter Minnan T..Katakana Letter Minnan N- {0x1affd, 0x1affe}, // Katakana Letter Minnan N..Katakana Letter Minnan N- {0x1b000, 0x1b122}, // Katakana Letter Archaic ..Katakana Letter Archaic- {0x1b132, 0x1b132}, // (nil) ..(nil)- {0x1b150, 0x1b152}, // Hiragana Letter Small Wi..Hiragana Letter Small Wo- {0x1b155, 0x1b155}, // (nil) ..(nil)- {0x1b164, 0x1b167}, // Katakana Letter Small Wi..Katakana Letter Small N- {0x1b170, 0x1b2fb}, // Nushu Character-1b170 ..Nushu Character-1b2fb- {0x1f004, 0x1f004}, // Mahjong Tile Red Dragon ..Mahjong Tile Red Dragon- {0x1f0cf, 0x1f0cf}, // Playing Card Black Joker..Playing Card Black Joker- {0x1f18e, 0x1f18e}, // Negative Squared Ab ..Negative Squared Ab- {0x1f191, 0x1f19a}, // Squared Cl ..Squared Vs- {0x1f200, 0x1f202}, // Square Hiragana Hoka ..Squared Katakana Sa- {0x1f210, 0x1f23b}, // Squared Cjk Unified Ideo..Squared Cjk Unified Ideo- {0x1f240, 0x1f248}, // Tortoise Shell Bracketed..Tortoise Shell Bracketed- {0x1f250, 0x1f251}, // Circled Ideograph Advant..Circled Ideograph Accept- {0x1f260, 0x1f265}, // Rounded Symbol For Fu ..Rounded Symbol For Cai- {0x1f300, 0x1f320}, // Cyclone ..Shooting Star- {0x1f32d, 0x1f335}, // Hot Dog ..Cactus- {0x1f337, 0x1f37c}, // Tulip ..Baby Bottle- {0x1f37e, 0x1f393}, // Bottle With Popping Cork..Graduation Cap- {0x1f3a0, 0x1f3ca}, // Carousel Horse ..Swimmer- {0x1f3cf, 0x1f3d3}, // Cricket Bat And Ball ..Table Tennis Paddle And- {0x1f3e0, 0x1f3f0}, // House Building ..European Castle- {0x1f3f4, 0x1f3f4}, // Waving Black Flag ..Waving Black Flag- {0x1f3f8, 0x1f43e}, // Badminton Racquet And Sh..Paw Prints- {0x1f440, 0x1f440}, // Eyes ..Eyes- {0x1f442, 0x1f4fc}, // Ear ..Videocassette- {0x1f4ff, 0x1f53d}, // Prayer Beads ..Down-pointing Small Red- {0x1f54b, 0x1f54e}, // Kaaba ..Menorah With Nine Branch- {0x1f550, 0x1f567}, // Clock Face One Oclock ..Clock Face Twelve-thirty- {0x1f57a, 0x1f57a}, // Man Dancing ..Man Dancing- {0x1f595, 0x1f596}, // Reversed Hand With Middl..Raised Hand With Part Be- {0x1f5a4, 0x1f5a4}, // Black Heart ..Black Heart- {0x1f5fb, 0x1f64f}, // Mount Fuji ..Person With Folded Hands- {0x1f680, 0x1f6c5}, // Rocket ..Left Luggage- {0x1f6cc, 0x1f6cc}, // Sleeping Accommodation ..Sleeping Accommodation- {0x1f6d0, 0x1f6d2}, // Place Of Worship ..Shopping Trolley- {0x1f6d5, 0x1f6d7}, // Hindu Temple ..Elevator- {0x1f6dc, 0x1f6df}, // (nil) ..Ring Buoy- {0x1f6eb, 0x1f6ec}, // Airplane Departure ..Airplane Arriving- {0x1f6f4, 0x1f6fc}, // Scooter ..Roller Skate- {0x1f7e0, 0x1f7eb}, // Large Orange Circle ..Large Brown Square- {0x1f7f0, 0x1f7f0}, // Heavy Equals Sign ..Heavy Equals Sign- {0x1f90c, 0x1f93a}, // Pinched Fingers ..Fencer- {0x1f93c, 0x1f945}, // Wrestlers ..Goal Net- {0x1f947, 0x1f9ff}, // First Place Medal ..Nazar Amulet- {0x1fa70, 0x1fa7c}, // Ballet Shoes ..Crutch- {0x1fa80, 0x1fa88}, // Yo-yo ..(nil)- {0x1fa90, 0x1fabd}, // Ringed Planet ..(nil)- {0x1fabf, 0x1fac5}, // (nil) ..Person With Crown- {0x1face, 0x1fadb}, // (nil) ..(nil)- {0x1fae0, 0x1fae8}, // Melting Face ..(nil)- {0x1faf0, 0x1faf8}, // Hand With Index Finger A..(nil)- {0x20000, 0x2fffd}, // Cjk Unified Ideograph-20..(nil)- {0x30000, 0x3fffd}, // Cjk Unified Ideograph-30..(nil)-};
-
-static bool intable(struct width_interval* table, int table_length, int c) {- // First quick check for Latin1 etc. characters.
- if (c < table[0].start) return false;
-
- // Binary search in table.
- int bot = 0;
- int top = table_length - 1;
- while (top >= bot) {- int mid = (bot + top) / 2;
- if (table[mid].end < c) {- bot = mid + 1;
- } else if (table[mid].start > c) {- top = mid - 1;
- } else {- return true;
- }
- }
- return false;
-}
-
-int wcwidth(wchar_t ucs) {- // NOTE: created by hand, there isn't anything identifiable other than
- // general Cf category code to identify these, and some characters in Cf
- // category code are of non-zero width.
- if (ucs == 0 ||
- ucs == 0x034F ||
- (0x200B <= ucs && ucs <= 0x200F) ||
- ucs == 0x2028 ||
- ucs == 0x2029 ||
- (0x202A <= ucs && ucs <= 0x202E) ||
- (0x2060 <= ucs && ucs <= 0x2063)) {- return 0;
- }
-
- // C0/C1 control characters.
- if (ucs < 32 || (0x07F <= ucs && ucs < 0x0A0)) return -1;
-
- // Combining characters with zero width.
- if (intable(ZERO_WIDTH, sizeof(ZERO_WIDTH)/sizeof(struct width_interval), ucs)) return 0;
-
- return intable(WIDE_EASTASIAN, sizeof(WIDE_EASTASIAN)/sizeof(struct width_interval), ucs) ? 2 : 1;
-}
--- a/maxstack.inc
+++ b/maxstack.inc
@@ -1,149 +1,150 @@
-static uint32_t compute_maxstack(uint8_t *code, size_t len)
+static uint32_t
+compute_maxstack(uint8_t *code, size_t len)
{- uint8_t *ip = code+4, *end = code+len;
- uint8_t op;
- uint32_t i, n, sp = 0, maxsp = 0;
+ uint8_t *ip = code+4, *end = code+len;
+ uint8_t op;
+ uint32_t i, n, sp = 0, maxsp = 0;
- while (ip < end) {- if ((int32_t)sp > (int32_t)maxsp)
- maxsp = sp;
- op = *ip++;
- switch (op) {- case OP_LOADA: case OP_LOADI8: case OP_LOADV: case OP_LOADG:
- ip++; // fallthrough
- case OP_LOADA0: case OP_LOADA1:
- case OP_DUP: case OP_LOADT: case OP_LOADF: case OP_LOADNIL:
- case OP_LOAD0:
- case OP_LOAD1: case OP_LOADC00:
- case OP_LOADC01:
- sp++;
- break;
+ while(ip < end){+ if((int32_t)sp > (int32_t)maxsp)
+ maxsp = sp;
+ op = *ip++;
+ switch(op){+ case OP_LOADA: case OP_LOADI8: case OP_LOADV: case OP_LOADG:
+ ip++; // fallthrough
+ case OP_LOADA0: case OP_LOADA1:
+ case OP_DUP: case OP_LOADT: case OP_LOADF: case OP_LOADNIL:
+ case OP_LOAD0:
+ case OP_LOAD1: case OP_LOADC00:
+ case OP_LOADC01:
+ sp++;
+ break;
- case OP_BRF: case OP_BRT:
- SWAP_INT16(ip);
- ip += 2;
- sp--;
- break;
+ case OP_BRF: case OP_BRT:
+ SWAP_INT16(ip);
+ ip += 2;
+ sp--;
+ break;
- case OP_POP: case OP_RET:
- case OP_CONS: case OP_SETCAR: case OP_SETCDR:
- case OP_EQ: case OP_EQV: case OP_EQUAL: case OP_ADD2: case OP_SUB2:
- case OP_IDIV: case OP_NUMEQ: case OP_LT: case OP_COMPARE:
- case OP_AREF: case OP_TRYCATCH:
- sp--;
- break;
+ case OP_POP: case OP_RET:
+ case OP_CONS: case OP_SETCAR: case OP_SETCDR:
+ case OP_EQ: case OP_EQV: case OP_EQUAL: case OP_ADD2: case OP_SUB2:
+ case OP_IDIV: case OP_NUMEQ: case OP_LT: case OP_COMPARE:
+ case OP_AREF: case OP_TRYCATCH:
+ sp--;
+ break;
- case OP_ARGC: case OP_SETG: case OP_SETA:
- ip++;
- break;
+ case OP_ARGC: case OP_SETG: case OP_SETA:
+ ip++;
+ break;
- case OP_TCALL: case OP_CALL:
- n = *ip++; // nargs
- sp -= n;
- break;
+ case OP_TCALL: case OP_CALL:
+ n = *ip++; // nargs
+ sp -= n;
+ break;
- case OP_LOADVL: case OP_LOADGL: case OP_LOADAL:
- sp++; // fallthrough
- case OP_SETGL: case OP_SETAL: case OP_LARGC:
- SWAP_INT32(ip);
- ip += 4;
- break;
+ case OP_LOADVL: case OP_LOADGL: case OP_LOADAL:
+ sp++; // fallthrough
+ case OP_SETGL: case OP_SETAL: case OP_LARGC:
+ SWAP_INT32(ip);
+ ip += 4;
+ break;
- case OP_LOADC:
- sp++; // fallthrough
- case OP_SETC:
- ip += 2;
- break;
+ case OP_LOADC:
+ sp++; // fallthrough
+ case OP_SETC:
+ ip += 2;
+ break;
- case OP_VARGC:
- n = *ip++;
- sp += n+2;
- break;
- case OP_LVARGC:
- SWAP_INT32(ip);
- n = GET_INT32(ip); ip += 4;
- sp += n+2;
- break;
- case OP_OPTARGS:
- SWAP_INT32(ip);
- i = GET_INT32(ip); ip += 4;
- SWAP_INT32(ip);
- n = abs(GET_INT32(ip)); ip += 4;
- sp += n-i;
- break;
- case OP_KEYARGS:
- SWAP_INT32(ip);
- i = GET_INT32(ip); ip += 4;
- SWAP_INT32(ip);
- ip += 4;
- SWAP_INT32(ip);
- n = abs(GET_INT32(ip)); ip += 4;
- sp += n-i;
- break;
- case OP_BRBOUND:
- SWAP_INT32(ip);
- ip += 4;
- sp++;
- break;
- case OP_TCALLL: case OP_CALLL:
- SWAP_INT32(ip);
- n = GET_INT32(ip); ip+=4;
- sp -= n;
- break;
- case OP_JMP:
- SWAP_INT16(ip);
- ip += 2; break;
- case OP_JMPL:
- SWAP_INT32(ip);
- ip += 4; break;
- case OP_BRFL: case OP_BRTL:
- SWAP_INT32(ip);
- ip += 4;
- sp--;
- break;
- case OP_BRNE:
- SWAP_INT16(ip);
- ip += 2;
- sp -= 2;
- break;
- case OP_BRNEL:
- SWAP_INT32(ip);
- ip += 4;
- sp -= 2;
- break;
- case OP_BRNN: case OP_BRN:
- SWAP_INT16(ip);
- ip += 2;
- sp--;
- break;
- case OP_BRNNL: case OP_BRNL:
- SWAP_INT32(ip);
- ip += 4; // fallthrough
+ case OP_VARGC:
+ n = *ip++;
+ sp += n+2;
+ break;
+ case OP_LVARGC:
+ SWAP_INT32(ip);
+ n = GET_INT32(ip); ip += 4;
+ sp += n+2;
+ break;
+ case OP_OPTARGS:
+ SWAP_INT32(ip);
+ i = GET_INT32(ip); ip += 4;
+ SWAP_INT32(ip);
+ n = abs(GET_INT32(ip)); ip += 4;
+ sp += n-i;
+ break;
+ case OP_KEYARGS:
+ SWAP_INT32(ip);
+ i = GET_INT32(ip); ip += 4;
+ SWAP_INT32(ip);
+ ip += 4;
+ SWAP_INT32(ip);
+ n = abs(GET_INT32(ip)); ip += 4;
+ sp += n-i;
+ break;
+ case OP_BRBOUND:
+ SWAP_INT32(ip);
+ ip += 4;
+ sp++;
+ break;
+ case OP_TCALLL: case OP_CALLL:
+ SWAP_INT32(ip);
+ n = GET_INT32(ip); ip+=4;
+ sp -= n;
+ break;
+ case OP_JMP:
+ SWAP_INT16(ip);
+ ip += 2; break;
+ case OP_JMPL:
+ SWAP_INT32(ip);
+ ip += 4; break;
+ case OP_BRFL: case OP_BRTL:
+ SWAP_INT32(ip);
+ ip += 4;
+ sp--;
+ break;
+ case OP_BRNE:
+ SWAP_INT16(ip);
+ ip += 2;
+ sp -= 2;
+ break;
+ case OP_BRNEL:
+ SWAP_INT32(ip);
+ ip += 4;
+ sp -= 2;
+ break;
+ case OP_BRNN: case OP_BRN:
+ SWAP_INT16(ip);
+ ip += 2;
+ sp--;
+ break;
+ case OP_BRNNL: case OP_BRNL:
+ SWAP_INT32(ip);
+ ip += 4; // fallthrough
- case OP_TAPPLY: case OP_APPLY:
- case OP_LIST: case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV:
- case OP_VECTOR:
- n = *ip++;
- sp -= n-1;
- break;
+ case OP_TAPPLY: case OP_APPLY:
+ case OP_LIST: case OP_ADD: case OP_SUB: case OP_MUL: case OP_DIV:
+ case OP_VECTOR:
+ n = *ip++;
+ sp -= n-1;
+ break;
- case OP_FOR:
- if (maxsp < sp+2)
- maxsp = sp+2; // fallthrough
- case OP_ASET:
- sp -= 2;
- break;
+ case OP_FOR:
+ if(maxsp < sp+2)
+ maxsp = sp+2; // fallthrough
+ case OP_ASET:
+ sp -= 2;
+ break;
- case OP_LOADCL:
- sp++; // fallthrough
- case OP_SETCL:
- SWAP_INT32(ip);
- ip += 4;
- SWAP_INT32(ip);
- ip += 4;
- break;
- }
- }
- assert(ip == end);
- return maxsp+5;
+ case OP_LOADCL:
+ sp++; // fallthrough
+ case OP_SETCL:
+ SWAP_INT32(ip);
+ ip += 4;
+ SWAP_INT32(ip);
+ ip += 4;
+ break;
+ }
+ }
+ assert(ip == end);
+ return maxsp+5;
}
--- a/mkfile
+++ b/mkfile
@@ -2,7 +2,7 @@
BIN=/$objtype/bin
TARG=flisp
-CFLAGS=$CFLAGS -p -D__plan9__ -D__${objtype}__ -Iplan9 -Illt+CFLAGS=$CFLAGS -p -D__plan9__ -D__${objtype}__ -I3rd -Illt -Iplan9CLEANFILES=boot.h builtin_fns.h
HFILES=\
@@ -25,6 +25,7 @@
iostream.$O\
string.$O\
table.$O\
+ 3rd/wcwidth.$O\
llt/bitvector-ops.$O\
llt/bitvector.$O\
llt/dump.$O\
@@ -37,7 +38,6 @@
llt/random.$O\
llt/timefuncs.$O\
llt/utf8.$O\
- llt/wcwidth.$O\
default:V: all
--- a/mp/mpadd.c
+++ /dev/null
@@ -1,56 +1,0 @@
-#include "platform.h"
-
-// sum = abs(b1) + abs(b2), i.e., add the magnitudes
-void
-mpmagadd(mpint *b1, mpint *b2, mpint *sum)
-{- int m, n;
- mpint *t;
-
- sum->flags |= (b1->flags | b2->flags) & MPtimesafe;
-
- // get the sizes right
- if(b2->top > b1->top){- t = b1;
- b1 = b2;
- b2 = t;
- }
- n = b1->top;
- m = b2->top;
- if(n == 0){- mpassign(mpzero, sum);
- return;
- }
- if(m == 0){- mpassign(b1, sum);
- sum->sign = 1;
- return;
- }
- mpbits(sum, (n+1)*Dbits);
- sum->top = n+1;
-
- mpvecadd(b1->p, n, b2->p, m, sum->p);
- sum->sign = 1;
-
- mpnorm(sum);
-}
-
-// sum = b1 + b2
-void
-mpadd(mpint *b1, mpint *b2, mpint *sum)
-{- int sign;
-
- if(b1->sign != b2->sign){- assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
- if(b1->sign < 0)
- mpmagsub(b2, b1, sum);
- else
- mpmagsub(b1, b2, sum);
- } else {- sign = b1->sign;
- mpmagadd(b1, b2, sum);
- if(sum->top != 0)
- sum->sign = sign;
- }
-}
--- a/mp/mpaux.c
+++ /dev/null
@@ -1,201 +1,0 @@
-#include "platform.h"
-
-static mpdigit _mptwodata[1] = { 2 };-static mpint _mptwo =
-{- 1, 1, 1,
- _mptwodata,
- MPstatic|MPnorm
-};
-mpint *mptwo = &_mptwo;
-
-static mpdigit _mponedata[1] = { 1 };-static mpint _mpone =
-{- 1, 1, 1,
- _mponedata,
- MPstatic|MPnorm
-};
-mpint *mpone = &_mpone;
-
-static mpdigit _mpzerodata[1] = { 0 };-static mpint _mpzero =
-{- 1, 1, 0,
- _mpzerodata,
- MPstatic|MPnorm
-};
-mpint *mpzero = &_mpzero;
-
-static int mpmindigits = 33;
-
-// set minimum digit allocation
-void
-mpsetminbits(int n)
-{- if(n < 0)
- sysfatal("mpsetminbits: n < 0");- if(n == 0)
- n = 1;
- mpmindigits = DIGITS(n);
-}
-
-// allocate an n bit 0'd number
-mpint*
-mpnew(int n)
-{- mpint *b;
-
- if(n < 0)
- sysfatal("mpsetminbits: n < 0");-
- n = DIGITS(n);
- if(n < mpmindigits)
- n = mpmindigits;
- b = calloc(1, sizeof(mpint) + n*Dbytes);
- if(b == nil)
- sysfatal("mpnew: %r");- b->p = (mpdigit*)&b[1];
- b->size = n;
- b->sign = 1;
- b->flags = MPnorm;
-
- return b;
-}
-
-// guarantee at least n significant bits
-void
-mpbits(mpint *b, int m)
-{- int n;
-
- n = DIGITS(m);
- if(b->size >= n){- if(b->top >= n)
- return;
- } else {- if(b->p == (mpdigit*)&b[1]){- b->p = (mpdigit*)malloc(n*Dbytes);
- if(b->p == nil)
- sysfatal("mpbits: %r");- memmove(b->p, &b[1], Dbytes*b->top);
- memset(&b[1], 0, Dbytes*b->size);
- } else {- b->p = (mpdigit*)realloc(b->p, n*Dbytes);
- if(b->p == nil)
- sysfatal("mpbits: %r");- }
- b->size = n;
- }
- memset(&b->p[b->top], 0, Dbytes*(n - b->top));
- b->top = n;
- b->flags &= ~MPnorm;
-}
-
-void
-mpfree(mpint *b)
-{- if(b == nil)
- return;
- if(b->flags & MPstatic)
- sysfatal("freeing mp constant");- memset(b->p, 0, b->size*Dbytes);
- if(b->p != (mpdigit*)&b[1])
- free(b->p);
- free(b);
-}
-
-mpint*
-mpnorm(mpint *b)
-{- int i;
-
- if(b->flags & MPtimesafe){- assert(b->sign == 1);
- b->flags &= ~MPnorm;
- return b;
- }
- for(i = b->top-1; i >= 0; i--)
- if(b->p[i] != 0)
- break;
- b->top = i+1;
- if(b->top == 0)
- b->sign = 1;
- b->flags |= MPnorm;
- return b;
-}
-
-mpint*
-mpcopy(mpint *old)
-{- mpint *new;
-
- new = mpnew(Dbits*old->size);
- new->sign = old->sign;
- new->top = old->top;
- new->flags = old->flags & ~(MPstatic|MPfield);
- memmove(new->p, old->p, Dbytes*old->top);
- return new;
-}
-
-void
-mpassign(mpint *old, mpint *new)
-{- if(new == nil || old == new)
- return;
- new->top = 0;
- mpbits(new, Dbits*old->top);
- new->sign = old->sign;
- new->top = old->top;
- new->flags &= ~MPnorm;
- new->flags |= old->flags & ~(MPstatic|MPfield);
- memmove(new->p, old->p, Dbytes*old->top);
-}
-
-// number of significant bits in mantissa
-int
-mpsignif(mpint *n)
-{- int i, j;
- mpdigit d;
-
- if(n->top == 0)
- return 0;
- for(i = n->top-1; i >= 0; i--){- d = n->p[i];
- for(j = Dbits-1; j >= 0; j--){- if(d & (((mpdigit)1)<<j))
- return i*Dbits + j + 1;
- }
- }
- return 0;
-}
-
-// k, where n = 2**k * q for odd q
-int
-mplowbits0(mpint *n)
-{- int k, bit, digit;
- mpdigit d;
-
- assert(n->flags & MPnorm);
- if(n->top==0)
- return 0;
- k = 0;
- bit = 0;
- digit = 0;
- d = n->p[0];
- for(;;){- if(d & (1<<bit))
- break;
- k++;
- bit++;
- if(bit==Dbits){- if(++digit >= n->top)
- return 0;
- d = n->p[digit];
- bit = 0;
- }
- }
- return k;
-}
--- a/mp/mpcmp.c
+++ /dev/null
@@ -1,28 +1,0 @@
-#include "platform.h"
-
-// return neg, 0, pos as abs(b1)-abs(b2) is neg, 0, pos
-int
-mpmagcmp(mpint *b1, mpint *b2)
-{- int i;
-
- i = b1->flags | b2->flags;
- if(i & MPtimesafe)
- return mpvectscmp(b1->p, b1->top, b2->p, b2->top);
- if(i & MPnorm){- i = b1->top - b2->top;
- if(i)
- return i;
- }
- return mpveccmp(b1->p, b1->top, b2->p, b2->top);
-}
-
-// return neg, 0, pos as b1-b2 is neg, 0, pos
-int
-mpcmp(mpint *b1, mpint *b2)
-{- int sign;
-
- sign = (b1->sign - b2->sign) >> 1; // -1, 0, 1
- return sign | (sign&1)-1 & mpmagcmp(b1, b2)*b1->sign;
-}
--- a/mp/mpdigdiv.c
+++ /dev/null
@@ -1,54 +1,0 @@
-#include "platform.h"
-
-//
-// divide two digits by one and return quotient
-//
-void
-mpdigdiv(mpdigit *dividend, mpdigit divisor, mpdigit *quotient)
-{- mpdigit hi, lo, q, x, y;
- int i;
-
- hi = dividend[1];
- lo = dividend[0];
-
- // return highest digit value if the result >= 2**32
- if(hi >= divisor || divisor == 0){- divisor = 0;
- *quotient = ~divisor;
- return;
- }
-
- // very common case
- if(~divisor == 0){- lo += hi;
- if(lo < hi){- hi++;
- lo++;
- }
- if(lo+1 == 0)
- hi++;
- *quotient = hi;
- return;
- }
-
- // at this point we know that hi < divisor
- // just shift and subtract till we're done
- q = 0;
- x = divisor;
- for(i = Dbits-1; hi > 0 && i >= 0; i--){- x >>= 1;
- if(x > hi)
- continue;
- y = divisor<<i;
- if(x == hi && y > lo)
- continue;
- if(y > lo)
- hi--;
- lo -= y;
- hi -= x;
- q |= 1U<<i;
- }
- q += lo/divisor;
- *quotient = q;
-}
--- a/mp/mpdiv.c
+++ /dev/null
@@ -1,140 +1,0 @@
-#include "platform.h"
-
-// division ala knuth, seminumerical algorithms, pp 237-238
-// the numbers are stored backwards to what knuth expects so j
-// counts down rather than up.
-
-void
-mpdiv(mpint *dividend, mpint *divisor, mpint *quotient, mpint *remainder)
-{- int j, s, vn, sign, qsign, rsign;
- mpdigit qd, *up, *vp, *qp;
- mpint *u, *v, *t;
-
- assert(quotient != remainder);
- assert(divisor->flags & MPnorm);
-
- // divide bv zero
- if(divisor->top == 0)
- abort();
-
- // division by one or small powers of two
- if(divisor->top == 1 && (divisor->p[0] & divisor->p[0]-1) == 0){- vlong r = 0;
- if(dividend->top > 0)
- r = (vlong)dividend->sign * (dividend->p[0] & divisor->p[0]-1);
- if(quotient != nil){- sign = divisor->sign;
- for(s = 0; ((divisor->p[0] >> s) & 1) == 0; s++)
- ;
- mpright(dividend, s, quotient);
- if(sign < 0)
- quotient->sign ^= (-mpmagcmp(quotient, mpzero) >> 31) << 1;
- }
- if(remainder != nil){- remainder->flags |= dividend->flags & MPtimesafe;
- vtomp(r, remainder);
- }
- return;
- }
- assert((dividend->flags & MPtimesafe) == 0);
-
- // quick check
- if(mpmagcmp(dividend, divisor) < 0){- if(remainder != nil)
- mpassign(dividend, remainder);
- if(quotient != nil)
- mpassign(mpzero, quotient);
- return;
- }
-
- qsign = divisor->sign * dividend->sign;
- rsign = dividend->sign;
-
- // D1: shift until divisor, v, has hi bit set (needed to make trial
- // divisor accurate)
- qd = divisor->p[divisor->top-1];
- for(s = 0; (qd & mpdighi) == 0; s++)
- qd <<= 1;
- u = mpnew((dividend->top+2)*Dbits + s);
- if(s == 0 && divisor != quotient && divisor != remainder) {- mpassign(dividend, u);
- v = divisor;
- } else {- mpleft(dividend, s, u);
- v = mpnew(divisor->top*Dbits);
- mpleft(divisor, s, v);
- }
- up = u->p+u->top-1;
- vp = v->p+v->top-1;
- vn = v->top;
-
- // D1a: make sure high digit of dividend is less than high digit of divisor
- if(*up >= *vp){- *++up = 0;
- u->top++;
- }
-
- // storage for multiplies
- t = mpnew(4*Dbits);
-
- qp = nil;
- if(quotient != nil){- mpbits(quotient, (u->top - v->top)*Dbits);
- quotient->top = u->top - v->top;
- qp = quotient->p+quotient->top-1;
- }
-
- // D2, D7: loop on length of dividend
- for(j = u->top; j > vn; j--){-
- // D3: calculate trial divisor
- mpdigdiv(up-1, *vp, &qd);
-
- // D3a: rule out trial divisors 2 greater than real divisor
- if(vn > 1) for(;;){- memset(t->p, 0, 3*Dbytes); // mpvecdigmuladd adds to what's there
- mpvecdigmuladd(vp-1, 2, qd, t->p);
- if(mpveccmp(t->p, 3, up-2, 3) > 0)
- qd--;
- else
- break;
- }
-
- // D4: u -= v*qd << j*Dbits
- sign = mpvecdigmulsub(v->p, vn, qd, up-vn);
- if(sign < 0){-
- // D6: trial divisor was too high, add back borrowed
- // value and decrease divisor
- mpvecadd(up-vn, vn+1, v->p, vn, up-vn);
- qd--;
- }
-
- // D5: save quotient digit
- if(qp != nil)
- *qp-- = qd;
-
- // push top of u down one
- u->top--;
- *up-- = 0;
- }
- if(qp != nil){- assert((quotient->flags & MPtimesafe) == 0);
- mpnorm(quotient);
- if(quotient->top != 0)
- quotient->sign = qsign;
- }
-
- if(remainder != nil){- assert((remainder->flags & MPtimesafe) == 0);
- mpright(u, s, remainder); // u is the remainder shifted
- if(remainder->top != 0)
- remainder->sign = rsign;
- }
-
- mpfree(t);
- mpfree(u);
- if(v != divisor)
- mpfree(v);
-}
--- a/mp/mpfmt.c
+++ /dev/null
@@ -1,207 +1,0 @@
-#include "platform.h"
-
-static int
-toencx(mpint *b, char *buf, int len, int (*enc)(char*, int, uchar*, int))
-{- uchar *p;
- int n, rv;
-
- p = nil;
- n = mptobe(b, nil, 0, &p);
- if(n < 0)
- return -1;
- rv = (*enc)(buf, len, p, n);
- free(p);
- return rv;
-}
-
-static int
-topow2(mpint *b, char *buf, int len, int s)
-{- mpdigit *p, x;
- int i, j, sn;
- char *out, *eout;
-
- if(len < 1)
- return -1;
-
- sn = 1<<s;
- out = buf;
- eout = buf+len;
- for(p = &b->p[b->top-1]; p >= b->p; p--){- x = *p;
- for(i = Dbits-s; i >= 0; i -= s){- j = x >> i & sn - 1;
- if(j != 0 || out != buf){- if(out >= eout)
- return -1;
- *out++ = enc16chr(j);
- }
- }
- }
- if(out == buf)
- *out++ = '0';
- if(out >= eout)
- return -1;
- *out = 0;
- return 0;
-}
-
-static char*
-modbillion(int rem, ulong r, char *out, char *buf)
-{- ulong rr;
- int i;
-
- for(i = 0; i < 9; i++){- rr = r%10;
- r /= 10;
- if(out <= buf)
- return nil;
- *--out = '0' + rr;
- if(rem == 0 && r == 0)
- break;
- }
- return out;
-}
-
-static int
-to10(mpint *b, char *buf, int len)
-{- mpint *d, *r, *billion;
- char *out;
-
- if(len < 1)
- return -1;
-
- d = mpcopy(b);
- d->flags &= ~MPtimesafe;
- mpnorm(d);
- r = mpnew(0);
- billion = uitomp(1000000000, nil);
- out = buf+len;
- *--out = 0;
- do {- mpdiv(d, billion, d, r);
- out = modbillion(d->top, r->p[0], out, buf);
- if(out == nil)
- break;
- } while(d->top != 0);
- mpfree(d);
- mpfree(r);
- mpfree(billion);
-
- if(out == nil)
- return -1;
- len -= out-buf;
- if(out != buf)
- memmove(buf, out, len);
- return 0;
-}
-
-static int
-to8(mpint *b, char *buf, int len)
-{- mpdigit x, y;
- char *out;
- int i, j;
-
- if(len < 2)
- return -1;
-
- out = buf+len;
- *--out = 0;
-
- i = j = 0;
- x = y = 0;
- while(j < b->top){- y = b->p[j++];
- if(i > 0)
- x |= y << i;
- else
- x = y;
- i += Dbits;
- while(i >= 3){-Digout: i -= 3;
- if(out > buf)
- out--;
- else if(x != 0)
- return -1;
- *out = '0' + (x & 7);
- x = y >> (Dbits-i);
- }
- }
- if(i > 0)
- goto Digout;
-
- while(*out == '0') out++;
- if(*out == '\0')
- *--out = '0';
-
- len -= out-buf;
- if(out != buf)
- memmove(buf, out, len);
- return 0;
-}
-
-char*
-mptoa(mpint *b, int base, char *buf, int len)
-{- char *out;
- int rv, alloced;
-
- if(base == 0)
- base = 16; /* default */
- alloced = 0;
- if(buf == nil){- /* rv <= log₂(base) */
- for(rv=1; (base >> rv) > 1; rv++)
- ;
- len = 10 + (b->top*Dbits / rv);
- buf = malloc(len);
- if(buf == nil)
- return nil;
- alloced = 1;
- }
-
- if(len < 2)
- return nil;
-
- out = buf;
- if(b->sign < 0){- *out++ = '-';
- len--;
- }
- switch(base){- case 64:
- rv = toencx(b, out, len, enc64);
- break;
- case 32:
- rv = toencx(b, out, len, enc32);
- break;
- case 16:
- rv = topow2(b, out, len, 4);
- break;
- case 10:
- rv = to10(b, out, len);
- break;
- case 8:
- rv = to8(b, out, len);
- break;
- case 4:
- rv = topow2(b, out, len, 2);
- break;
- case 2:
- rv = topow2(b, out, len, 1);
- break;
- default:
- abort();
- return nil;
- }
- if(rv < 0){- if(alloced)
- free(buf);
- return nil;
- }
- return buf;
-}
--- a/mp/mpleft.c
+++ /dev/null
@@ -1,49 +1,0 @@
-#include "platform.h"
-
-// res = b << shift
-void
-mpleft(mpint *b, int shift, mpint *res)
-{- int d, l, r, i, otop;
- mpdigit this, last;
-
- res->sign = b->sign;
- if(b->top==0){- res->top = 0;
- return;
- }
-
- // a zero or negative left shift is a right shift
- if(shift <= 0){- mpright(b, -shift, res);
- return;
- }
-
- // b and res may be the same so remember the old top
- otop = b->top;
-
- // shift
- mpbits(res, otop*Dbits + shift); // overkill
- res->top = DIGITS(otop*Dbits + shift);
- d = shift/Dbits;
- l = shift - d*Dbits;
- r = Dbits - l;
-
- if(l == 0){- for(i = otop-1; i >= 0; i--)
- res->p[i+d] = b->p[i];
- } else {- last = 0;
- for(i = otop-1; i >= 0; i--) {- this = b->p[i];
- res->p[i+d+1] = (last<<l) | (this>>r);
- last = this;
- }
- res->p[d] = last<<l;
- }
- for(i = 0; i < d; i++)
- res->p[i] = 0;
-
- res->flags |= b->flags & MPtimesafe;
- mpnorm(res);
-}
--- a/mp/mplogic.c
+++ /dev/null
@@ -1,210 +1,0 @@
-#include "platform.h"
-
-/*
- mplogic calculates b1|b2 subject to the
- following flag bits (fl)
-
- bit 0: subtract 1 from b1
- bit 1: invert b1
- bit 2: subtract 1 from b2
- bit 3: invert b2
- bit 4: add 1 to output
- bit 5: invert output
-
- it inverts appropriate bits automatically
- depending on the signs of the inputs
-*/
-
-static void
-mplogic(mpint *b1, mpint *b2, mpint *sum, int fl)
-{- mpint *t;
- mpdigit *dp1, *dp2, *dpo, d1, d2, d;
- int c1, c2, co;
- int i;
-
- assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
- if(b1->sign < 0) fl ^= 0x03;
- if(b2->sign < 0) fl ^= 0x0c;
- sum->sign = (int)(((fl|fl>>2)^fl>>4)<<30)>>31|1;
- if(sum->sign < 0) fl ^= 0x30;
- if(b2->top > b1->top){- t = b1;
- b1 = b2;
- b2 = t;
- fl = fl >> 2 & 0x03 | fl << 2 & 0x0c | fl & 0x30;
- }
- mpbits(sum, b1->top*Dbits+1);
- dp1 = b1->p;
- dp2 = b2->p;
- dpo = sum->p;
- c1 = fl & 1;
- c2 = fl >> 2 & 1;
- co = fl >> 4 & 1;
- for(i = 0; i < b1->top; i++){- d1 = dp1[i] - c1;
- if(i < b2->top)
- d2 = dp2[i] - c2;
- else
- d2 = 0;
- if(d1 != (mpdigit)-1) c1 = 0;
- if(d2 != (mpdigit)-1) c2 = 0;
- if((fl & 2) != 0) d1 ^= -1;
- if((fl & 8) != 0) d2 ^= -1;
- d = d1 | d2;
- if((fl & 32) != 0) d ^= -1;
- d += co;
- if(d != 0) co = 0;
- dpo[i] = d;
- }
- sum->top = i;
- if(co)
- dpo[sum->top++] = co;
- mpnorm(sum);
-}
-
-void
-mpor(mpint *b1, mpint *b2, mpint *sum)
-{- mplogic(b1, b2, sum, 0);
-}
-
-void
-mpand(mpint *b1, mpint *b2, mpint *sum)
-{- mplogic(b1, b2, sum, 0x2a);
-}
-
-void
-mpbic(mpint *b1, mpint *b2, mpint *sum)
-{- mplogic(b1, b2, sum, 0x22);
-}
-
-void
-mpnot(mpint *b, mpint *r)
-{- mpadd(b, mpone, r);
- if(r->top != 0)
- r->sign ^= -2;
-}
-
-void
-mpxor(mpint *b1, mpint *b2, mpint *sum)
-{- mpint *t;
- mpdigit *dp1, *dp2, *dpo, d1, d2, d;
- int c1, c2, co;
- int i, fl;
-
- assert(((b1->flags | b2->flags | sum->flags) & MPtimesafe) == 0);
- if(b2->top > b1->top){- t = b1;
- b1 = b2;
- b2 = t;
- }
- fl = (b1->sign & 10) ^ (b2->sign & 12);
- sum->sign = (int)(fl << 28) >> 31 | 1;
- mpbits(sum, b1->top*Dbits+1);
- dp1 = b1->p;
- dp2 = b2->p;
- dpo = sum->p;
- c1 = fl >> 1 & 1;
- c2 = fl >> 2 & 1;
- co = fl >> 3 & 1;
- for(i = 0; i < b1->top; i++){- d1 = dp1[i] - c1;
- if(i < b2->top)
- d2 = dp2[i] - c2;
- else
- d2 = 0;
- if(d1 != (mpdigit)-1) c1 = 0;
- if(d2 != (mpdigit)-1) c2 = 0;
- d = d1 ^ d2;
- d += co;
- if(d != 0) co = 0;
- dpo[i] = d;
- }
- sum->top = i;
- if(co)
- dpo[sum->top++] = co;
- mpnorm(sum);
-}
-
-void
-mptrunc(mpint *b, int n, mpint *r)
-{- int d, m, i, c;
-
- assert(((b->flags | r->flags) & MPtimesafe) == 0);
- mpbits(r, n);
- r->top = DIGITS(n);
- d = n / Dbits;
- m = n % Dbits;
- if(b->sign == -1){- c = 1;
- for(i = 0; i < r->top; i++){- if(i < b->top)
- r->p[i] = ~(b->p[i] - c);
- else
- r->p[i] = -1;
- if(r->p[i] != 0)
- c = 0;
- }
- if(m != 0)
- r->p[d] &= (1<<m) - 1;
- }else if(b->sign == 1){- if(d >= b->top){- mpassign(b, r);
- mpnorm(r);
- return;
- }
- if(b != r)
- for(i = 0; i < d; i++)
- r->p[i] = b->p[i];
- if(m != 0)
- r->p[d] = b->p[d] & (1<<m)-1;
- }
- r->sign = 1;
- mpnorm(r);
-}
-
-void
-mpxtend(mpint *b, int n, mpint *r)
-{- int d, m, c, i;
-
- d = (n - 1) / Dbits;
- m = (n - 1) % Dbits;
- if(d >= b->top){- mpassign(b, r);
- return;
- }
- mptrunc(b, n, r);
- mpbits(r, n);
- if((r->p[d] & 1<<m) == 0){- mpnorm(r);
- return;
- }
- r->p[d] |= -(1<<m);
- r->sign = -1;
- c = 1;
- for(i = 0; i < r->top; i++){- r->p[i] = ~(r->p[i] - c);
- if(r->p[i] != 0)
- c = 0;
- }
- mpnorm(r);
-}
-
-void
-mpasr(mpint *b, int n, mpint *r)
-{- if(b->sign > 0 || n <= 0){- mpright(b, n, r);
- return;
- }
- mpadd(b, mpone, r);
- mpright(r, n, r);
- mpsub(r, mpone, r);
-}
--- a/mp/mpmul.c
+++ /dev/null
@@ -1,174 +1,0 @@
-#include "platform.h"
-
-//
-// from knuth's 1969 seminumberical algorithms, pp 233-235 and pp 258-260
-//
-// mpvecmul is an assembly language routine that performs the inner
-// loop.
-//
-// the karatsuba trade off is set empiricly by measuring the algs on
-// a 400 MHz Pentium II.
-//
-
-// karatsuba like (see knuth pg 258)
-// prereq: p is already zeroed
-static void
-mpkaratsuba(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
-{- mpdigit *t, *u0, *u1, *v0, *v1, *u0v0, *u1v1, *res, *diffprod;
- int u0len, u1len, v0len, v1len, reslen;
- int sign, n;
-
- // divide each piece in half
- n = alen/2;
- if(alen&1)
- n++;
- u0len = n;
- u1len = alen-n;
- if(blen > n){- v0len = n;
- v1len = blen-n;
- } else {- v0len = blen;
- v1len = 0;
- }
- u0 = a;
- u1 = a + u0len;
- v0 = b;
- v1 = b + v0len;
-
- // room for the partial products
- t = calloc(1, Dbytes*5*(2*n+1));
- if(t == nil)
- sysfatal("mpkaratsuba: %r");- u0v0 = t;
- u1v1 = t + (2*n+1);
- diffprod = t + 2*(2*n+1);
- res = t + 3*(2*n+1);
- reslen = 4*n+1;
-
- // t[0] = (u1-u0)
- sign = 1;
- if(mpveccmp(u1, u1len, u0, u0len) < 0){- sign = -1;
- mpvecsub(u0, u0len, u1, u1len, u0v0);
- } else
- mpvecsub(u1, u1len, u0, u1len, u0v0);
-
- // t[1] = (v0-v1)
- if(mpveccmp(v0, v0len, v1, v1len) < 0){- sign *= -1;
- mpvecsub(v1, v1len, v0, v1len, u1v1);
- } else
- mpvecsub(v0, v0len, v1, v1len, u1v1);
-
- // t[4:5] = (u1-u0)*(v0-v1)
- mpvecmul(u0v0, u0len, u1v1, v0len, diffprod);
-
- // t[0:1] = u1*v1
- memset(t, 0, 2*(2*n+1)*Dbytes);
- if(v1len > 0)
- mpvecmul(u1, u1len, v1, v1len, u1v1);
-
- // t[2:3] = u0v0
- mpvecmul(u0, u0len, v0, v0len, u0v0);
-
- // res = u0*v0<<n + u0*v0
- mpvecadd(res, reslen, u0v0, u0len+v0len, res);
- mpvecadd(res+n, reslen-n, u0v0, u0len+v0len, res+n);
-
- // res += u1*v1<<n + u1*v1<<2*n
- if(v1len > 0){- mpvecadd(res+n, reslen-n, u1v1, u1len+v1len, res+n);
- mpvecadd(res+2*n, reslen-2*n, u1v1, u1len+v1len, res+2*n);
- }
-
- // res += (u1-u0)*(v0-v1)<<n
- if(sign < 0)
- mpvecsub(res+n, reslen-n, diffprod, u0len+v0len, res+n);
- else
- mpvecadd(res+n, reslen-n, diffprod, u0len+v0len, res+n);
- memmove(p, res, (alen+blen)*Dbytes);
-
- free(t);
-}
-
-#define KARATSUBAMIN 32
-
-void
-mpvecmul(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
-{- int i;
- mpdigit d;
- mpdigit *t;
-
- // both mpvecdigmuladd and karatsuba are fastest when a is the longer vector
- if(alen < blen){- i = alen;
- alen = blen;
- blen = i;
- t = a;
- a = b;
- b = t;
- }
-
- if(alen >= KARATSUBAMIN && blen > 1){- // O(n^1.585)
- mpkaratsuba(a, alen, b, blen, p);
- } else {- // O(n^2)
- for(i = 0; i < blen; i++){- d = b[i];
- if(d != 0)
- mpvecdigmuladd(a, alen, d, &p[i]);
- }
- }
-}
-
-void
-mpvectsmul(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *p)
-{- int i;
- mpdigit *t;
-
- if(alen < blen){- i = alen;
- alen = blen;
- blen = i;
- t = a;
- a = b;
- b = t;
- }
- if(blen == 0)
- return;
- for(i = 0; i < blen; i++)
- mpvecdigmuladd(a, alen, b[i], &p[i]);
-}
-
-void
-mpmul(mpint *b1, mpint *b2, mpint *prod)
-{- mpint *oprod;
-
- oprod = prod;
- if(prod == b1 || prod == b2){- prod = mpnew(0);
- prod->flags = oprod->flags;
- }
- prod->flags |= (b1->flags | b2->flags) & MPtimesafe;
-
- prod->top = 0;
- mpbits(prod, (b1->top+b2->top+1)*Dbits);
- if(prod->flags & MPtimesafe)
- mpvectsmul(b1->p, b1->top, b2->p, b2->top, prod->p);
- else
- mpvecmul(b1->p, b1->top, b2->p, b2->top, prod->p);
- prod->top = b1->top+b2->top+1;
- prod->sign = b1->sign*b2->sign;
- mpnorm(prod);
-
- if(oprod != prod){- mpassign(prod, oprod);
- mpfree(prod);
- }
-}
--- a/mp/mpright.c
+++ /dev/null
@@ -1,55 +1,0 @@
-#include "platform.h"
-
-// res = b >> shift
-void
-mpright(mpint *b, int shift, mpint *res)
-{- int d, l, r, i;
- mpdigit this, last;
-
- res->sign = b->sign;
- if(b->top==0){- res->top = 0;
- return;
- }
-
- // a negative right shift is a left shift
- if(shift < 0){- mpleft(b, -shift, res);
- return;
- }
-
- if(res != b)
- mpbits(res, b->top*Dbits - shift);
- else if(shift == 0)
- return;
-
- d = shift/Dbits;
- r = shift - d*Dbits;
- l = Dbits - r;
-
- // shift all the bits out == zero
- if(d>=b->top){- res->sign = 1;
- res->top = 0;
- return;
- }
-
- // special case digit shifts
- if(r == 0){- for(i = 0; i < b->top-d; i++)
- res->p[i] = b->p[i+d];
- } else {- last = b->p[d];
- for(i = 0; i < b->top-d-1; i++){- this = b->p[i+d+1];
- res->p[i] = (this<<l) | (last>>r);
- last = this;
- }
- res->p[i++] = last>>r;
- }
-
- res->top = i;
- res->flags |= b->flags & MPtimesafe;
- mpnorm(res);
-}
--- a/mp/mpsub.c
+++ /dev/null
@@ -1,54 +1,0 @@
-#include "platform.h"
-
-// diff = abs(b1) - abs(b2), i.e., subtract the magnitudes
-void
-mpmagsub(mpint *b1, mpint *b2, mpint *diff)
-{- int n, m, sign;
- mpint *t;
-
- // get the sizes right
- if(mpmagcmp(b1, b2) < 0){- assert(((b1->flags | b2->flags | diff->flags) & MPtimesafe) == 0);
- sign = -1;
- t = b1;
- b1 = b2;
- b2 = t;
- } else {- diff->flags |= (b1->flags | b2->flags) & MPtimesafe;
- sign = 1;
- }
- n = b1->top;
- m = b2->top;
- if(m == 0){- mpassign(b1, diff);
- diff->sign = sign;
- return;
- }
- mpbits(diff, n*Dbits);
-
- mpvecsub(b1->p, n, b2->p, m, diff->p);
- diff->sign = sign;
- diff->top = n;
- mpnorm(diff);
-}
-
-// diff = b1 - b2
-void
-mpsub(mpint *b1, mpint *b2, mpint *diff)
-{- int sign;
-
- if(b1->sign != b2->sign){- assert(((b1->flags | b2->flags | diff->flags) & MPtimesafe) == 0);
- sign = b1->sign;
- mpmagadd(b1, b2, diff);
- diff->sign = sign;
- return;
- }
-
- sign = b1->sign;
- mpmagsub(b1, b2, diff);
- if(diff->top != 0)
- diff->sign *= sign;
-}
--- a/mp/mptobe.c
+++ /dev/null
@@ -1,29 +1,0 @@
-#include "platform.h"
-
-// convert an mpint into a big endian byte array (most significant byte first; left adjusted)
-// return number of bytes converted
-// if p == nil, allocate and result array
-int
-mptobe(mpint *b, uchar *p, uint n, uchar **pp)
-{- uint m;
-
- m = (mpsignif(b)+7)/8;
- if(m == 0)
- m++;
- if(p == nil){- n = m;
- p = malloc(n);
- if(p == nil)
- sysfatal("mptobe: %r");- } else {- if(n < m)
- return -1;
- if(n > m)
- memset(p+m, 0, n-m);
- }
- if(pp != nil)
- *pp = p;
- mptober(b, p, m);
- return m;
-}
--- a/mp/mptober.c
+++ /dev/null
@@ -1,32 +1,0 @@
-#include "platform.h"
-
-void
-mptober(mpint *b, uchar *p, int n)
-{- int i, j, m;
- mpdigit x;
-
- memset(p, 0, n);
-
- p += n;
- m = b->top*Dbytes;
- if(m < n)
- n = m;
-
- i = 0;
- while(n >= Dbytes){- n -= Dbytes;
- x = b->p[i++];
- for(j = 0; j < Dbytes; j++){- *--p = x;
- x >>= 8;
- }
- }
- if(n > 0){- x = b->p[i];
- for(j = 0; j < n; j++){- *--p = x;
- x >>= 8;
- }
- }
-}
--- a/mp/mptod.c
+++ /dev/null
@@ -1,83 +1,0 @@
-#include "platform.h"
-
-extern double D_PINF, D_NINF;
-
-double
-mptod(mpint *a)
-{- u64int v;
- mpdigit w, r;
- int sf, i, n, m, s;
- FPdbleword x;
-
- if(a->top == 0) return 0.0;
- sf = mpsignif(a);
- if(sf > 1024) return a->sign < 0 ? D_NINF : D_PINF;
- i = a->top - 1;
- v = a->p[i];
- n = sf & Dbits - 1;
- n |= n - 1 & Dbits;
- r = 0;
- if(n > 54){- s = n - 54;
- r = v & (1<<s) - 1;
- v >>= s;
- }
- while(n < 54){- if(--i < 0)
- w = 0;
- else
- w = a->p[i];
- m = 54 - n;
- if(m > Dbits) m = Dbits;
- s = Dbits - m & Dbits - 1;
- v = v << m | w >> s;
- r = w & (1<<s) - 1;
- n += m;
- }
- if((v & 3) == 1){- while(--i >= 0)
- r |= a->p[i];
- if(r != 0)
- v++;
- }else
- v++;
- v >>= 1;
- while((v >> 53) != 0){- v >>= 1;
- if(++sf > 1024)
- return a->sign < 0 ? D_NINF : D_PINF;
- }
- x.lo = v;
- x.hi = (u32int)(v >> 32) & (1<<20) - 1 | (sf + 1022) << 20 | a->sign & 1<<31;
- return x.x;
-}
-
-mpint *
-dtomp(double d, mpint *a)
-{- FPdbleword x;
- uvlong v;
- int e;
-
- if(a == nil)
- a = mpnew(0);
- x.x = d;
- e = x.hi >> 20 & 2047;
- assert(e != 2047);
- if(e < 1022){- mpassign(mpzero, a);
- return a;
- }
- v = x.lo | (uvlong)(x.hi & (1<<20) - 1) << 32 | 1ULL<<52;
- if(e < 1075){- v += (1ULL<<(1074 - e)) - (~v >> (1075 - e) & 1);
- v >>= 1075 - e;
- }
- uvtomp(v, a);
- if(e > 1075)
- mpleft(a, e - 1075, a);
- if((int)x.hi < 0)
- a->sign = -1;
- return a;
-}
--- a/mp/mptoi.c
+++ /dev/null
@@ -1,41 +1,0 @@
-#include "platform.h"
-
-/*
- * this code assumes that mpdigit is at least as
- * big as an int.
- */
-
-mpint*
-itomp(int i, mpint *b)
-{- if(b == nil){- b = mpnew(0);
- }
- b->sign = (i >> (sizeof(i)*8 - 1)) | 1;
- i *= b->sign;
- *b->p = i;
- b->top = 1;
- return mpnorm(b);
-}
-
-int
-mptoi(mpint *b)
-{- uint x;
-
- if(b->top==0)
- return 0;
- x = *b->p;
- if(b->sign > 0){- if(b->top > 1 || (x > MAXINT))
- x = (int)MAXINT;
- else
- x = (int)x;
- } else {- if(b->top > 1 || x > MAXINT+1)
- x = (int)MININT;
- else
- x = -(int)x;
- }
- return x;
-}
--- a/mp/mptoui.c
+++ /dev/null
@@ -1,31 +1,0 @@
-#include "platform.h"
-
-/*
- * this code assumes that mpdigit is at least as
- * big as an int.
- */
-
-mpint*
-uitomp(uint i, mpint *b)
-{- if(b == nil){- b = mpnew(0);
- }
- *b->p = i;
- b->top = 1;
- b->sign = 1;
- return mpnorm(b);
-}
-
-uint
-mptoui(mpint *b)
-{- uint x;
-
- x = *b->p;
- if(b->sign < 0)
- x = 0;
- else if(b->top > 1 || (sizeof(mpdigit) > sizeof(uint) && x > MAXUINT))
- x = MAXUINT;
- return x;
-}
--- a/mp/mptouv.c
+++ /dev/null
@@ -1,44 +1,0 @@
-#include "platform.h"
-
-#define VLDIGITS (int)(sizeof(vlong)/sizeof(mpdigit))
-
-/*
- * this code assumes that a vlong is an integral number of
- * mpdigits long.
- */
-mpint*
-uvtomp(uvlong v, mpint *b)
-{- int s;
-
- if(b == nil){- b = mpnew(VLDIGITS*Dbits);
- }else
- mpbits(b, VLDIGITS*Dbits);
- b->sign = 1;
- for(s = 0; s < VLDIGITS; s++){- b->p[s] = v;
- v >>= sizeof(mpdigit)*8;
- }
- b->top = s;
- return mpnorm(b);
-}
-
-uvlong
-mptouv(mpint *b)
-{- uvlong v;
- int s;
-
- if(b->top == 0 || b->sign < 0)
- return 0LL;
-
- if(b->top > VLDIGITS)
- return -1LL;
-
- v = 0ULL;
- for(s = 0; s < b->top; s++)
- v |= (uvlong)b->p[s]<<(s*sizeof(mpdigit)*8);
-
- return v;
-}
--- a/mp/mptov.c
+++ /dev/null
@@ -1,60 +1,0 @@
-#include "platform.h"
-
-#define VLDIGITS (int)(sizeof(vlong)/sizeof(mpdigit))
-
-/*
- * this code assumes that a vlong is an integral number of
- * mpdigits long.
- */
-mpint*
-vtomp(vlong v, mpint *b)
-{- int s;
- uvlong uv;
-
- if(b == nil){- b = mpnew(VLDIGITS*Dbits);
- }else
- mpbits(b, VLDIGITS*Dbits);
- b->sign = (v >> (sizeof(v)*8 - 1)) | 1;
- uv = v * b->sign;
- for(s = 0; s < VLDIGITS; s++){- b->p[s] = uv;
- uv >>= sizeof(mpdigit)*8;
- }
- b->top = s;
- return mpnorm(b);
-}
-
-vlong
-mptov(mpint *b)
-{- uvlong v;
- int s;
-
- if(b->top == 0)
- return 0LL;
-
- if(b->top > VLDIGITS){- if(b->sign > 0)
- return (vlong)MAXVLONG;
- else
- return (vlong)MINVLONG;
- }
-
- v = 0ULL;
- for(s = 0; s < b->top; s++)
- v |= (uvlong)b->p[s]<<(s*sizeof(mpdigit)*8);
-
- if(b->sign > 0){- if(v > MAXVLONG)
- v = MAXVLONG;
- } else {- if(v > MINVLONG)
- v = MINVLONG;
- else
- v = -(vlong)v;
- }
-
- return (vlong)v;
-}
--- a/mp/mpvecadd.c
+++ /dev/null
@@ -1,34 +1,0 @@
-#include "platform.h"
-
-// prereq: alen >= blen, sum has at least blen+1 digits
-void
-mpvecadd(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *sum)
-{- int i;
- uint carry;
- mpdigit x, y;
-
- carry = 0;
- for(i = 0; i < blen; i++){- x = *a++;
- y = *b++;
- x += carry;
- if(x < carry)
- carry = 1;
- else
- carry = 0;
- x += y;
- if(x < y)
- carry++;
- *sum++ = x;
- }
- for(; i < alen; i++){- x = *a++ + carry;
- if(x < carry)
- carry = 1;
- else
- carry = 0;
- *sum++ = x;
- }
- *sum = carry;
-}
--- a/mp/mpveccmp.c
+++ /dev/null
@@ -1,25 +1,0 @@
-#include "platform.h"
-
-int
-mpveccmp(mpdigit *a, int alen, mpdigit *b, int blen)
-{- mpdigit x;
-
- while(alen > blen)
- if(a[--alen] != 0)
- return 1;
- while(blen > alen)
- if(b[--blen] != 0)
- return -1;
- while(alen > 0){- --alen;
- x = a[alen] - b[alen];
- if(x == 0)
- continue;
- if(x > a[alen])
- return -1;
- else
- return 1;
- }
- return 0;
-}
--- a/mp/mpvecdigmuladd.c
+++ /dev/null
@@ -1,101 +1,0 @@
-#include "platform.h"
-
-#define LO(x) ((x) & ((1<<(Dbits/2))-1))
-#define HI(x) ((x) >> (Dbits/2))
-
-static void
-mpdigmul(mpdigit a, mpdigit b, mpdigit *p)
-{- mpdigit x, ah, al, bh, bl, p1, p2, p3, p4;
- int carry;
-
- // half digits
- ah = HI(a);
- al = LO(a);
- bh = HI(b);
- bl = LO(b);
-
- // partial products
- p1 = ah*bl;
- p2 = bh*al;
- p3 = bl*al;
- p4 = ah*bh;
-
- // p = ((p1+p2)<<(Dbits/2)) + (p4<<Dbits) + p3
- carry = 0;
- x = p1<<(Dbits/2);
- p3 += x;
- if(p3 < x)
- carry++;
- x = p2<<(Dbits/2);
- p3 += x;
- if(p3 < x)
- carry++;
- p4 += carry + HI(p1) + HI(p2); // can't carry out of the high digit
- p[0] = p3;
- p[1] = p4;
-}
-
-// prereq: p must have room for n+1 digits
-void
-mpvecdigmuladd(mpdigit *b, int n, mpdigit m, mpdigit *p)
-{- int i;
- mpdigit carry, x, y, part[2];
-
- carry = 0;
- part[1] = 0;
- for(i = 0; i < n; i++){- x = part[1] + carry;
- if(x < carry)
- carry = 1;
- else
- carry = 0;
- y = *p;
- mpdigmul(*b++, m, part);
- x += part[0];
- if(x < part[0])
- carry++;
- x += y;
- if(x < y)
- carry++;
- *p++ = x;
- }
- *p = part[1] + carry;
-}
-
-// prereq: p must have room for n+1 digits
-int
-mpvecdigmulsub(mpdigit *b, int n, mpdigit m, mpdigit *p)
-{- int i;
- mpdigit x, y, part[2], borrow;
-
- borrow = 0;
- part[1] = 0;
- for(i = 0; i < n; i++){- x = *p;
- y = x - borrow;
- if(y > x)
- borrow = 1;
- else
- borrow = 0;
- x = part[1];
- mpdigmul(*b++, m, part);
- x += part[0];
- if(x < part[0])
- borrow++;
- x = y - x;
- if(x > y)
- borrow++;
- *p++ = x;
- }
-
- x = *p;
- y = x - borrow - part[1];
- *p = y;
- if(y > x)
- return -1;
- else
- return 1;
-}
--- a/mp/mpvecsub.c
+++ /dev/null
@@ -1,32 +1,0 @@
-#include "platform.h"
-
-// prereq: a >= b, alen >= blen, diff has at least alen digits
-void
-mpvecsub(mpdigit *a, int alen, mpdigit *b, int blen, mpdigit *diff)
-{- int i, borrow;
- mpdigit x, y;
-
- borrow = 0;
- for(i = 0; i < blen; i++){- x = *a++;
- y = *b++;
- y += borrow;
- if(y < (mpdigit)borrow)
- borrow = 1;
- else
- borrow = 0;
- if(x < y)
- borrow++;
- *diff++ = x - y;
- }
- for(; i < alen; i++){- x = *a++;
- y = x - borrow;
- if(y > x)
- borrow = 1;
- else
- borrow = 0;
- *diff++ = y;
- }
-}
--- a/mp/mpvectscmp.c
+++ /dev/null
@@ -1,32 +1,0 @@
-#include "platform.h"
-
-int
-mpvectscmp(mpdigit *a, int alen, mpdigit *b, int blen)
-{- mpdigit x, y, z, v;
- int m, p;
-
- if(alen > blen){- v = 0;
- while(alen > blen)
- v |= a[--alen];
- m = p = (-v^v|v)>>(Dbits-1);
- } else if(blen > alen){- v = 0;
- while(blen > alen)
- v |= b[--blen];
- m = (-v^v|v)>>(Dbits-1);
- p = m^1;
- } else
- m = p = 0;
- while(alen-- > 0){- x = a[alen];
- y = b[alen];
- z = x - y;
- x = ~x;
- v = ((-z^z|z)>>(Dbits-1)) & ~m;
- p = ((~(x&y|x&z|y&z)>>(Dbits-1)) & v) | (p & ~v);
- m |= v;
- }
- return (p-m) | m;
-}
--- a/mp/strtomp.c
+++ /dev/null
@@ -1,174 +1,0 @@
-#include "platform.h"
-
-static char*
-frompow2(char *a, mpint *b, int s)
-{- char *p, *next;
- mpdigit x;
- int i;
-
- i = 1<<s;
- for(p = a; (dec16chr(*p) & 255) < i; p++)
- ;
-
- mpbits(b, (p-a)*s);
- b->top = 0;
- next = p;
-
- while(p > a){- x = 0;
- for(i = 0; i < Dbits; i += s){- if(p <= a)
- break;
- x |= dec16chr(*--p)<<i;
- }
- b->p[b->top++] = x;
- }
- return next;
-}
-
-static char*
-from8(char *a, mpint *b)
-{- char *p, *next;
- mpdigit x, y;
- int i;
-
- for(p = a; ((*p - '0') & 255) < 8; p++)
- ;
-
- mpbits(b, (p-a)*3);
- b->top = 0;
- next = p;
-
- i = 0;
- x = y = 0;
- while(p > a){- y = *--p - '0';
- x |= y << i;
- i += 3;
- if(i >= Dbits){-Digout:
- i -= Dbits;
- b->p[b->top++] = x;
- x = y >> (3-i);
- }
- }
- if(i > 0)
- goto Digout;
-
- return next;
-}
-
-static ulong mppow10[] = {- 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000
-};
-
-static char*
-from10(char *a, mpint *b)
-{- ulong x, y;
- mpint *pow, *r;
- int i;
-
- pow = mpnew(0);
- r = mpnew(0);
-
- b->top = 0;
- for(;;){- // do a billion at a time in native arithmetic
- x = 0;
- for(i = 0; i < 9; i++){- y = *a - '0';
- if(y > 9)
- break;
- a++;
- x *= 10;
- x += y;
- }
- if(i == 0)
- break;
-
- // accumulate into mpint
- uitomp(mppow10[i], pow);
- uitomp(x, r);
- mpmul(b, pow, b);
- mpadd(b, r, b);
- if(i < 9)
- break;
- }
- mpfree(pow);
- mpfree(r);
- return a;
-}
-
-mpint*
-strtomp(char *a, char **pp, int base, mpint *b)
-{- int sign;
- char *e;
-
- if(b == nil){- b = mpnew(0);
- }
-
- while(*a==' ' || *a=='\t')
- a++;
-
- sign = 1;
- for(;; a++){- switch(*a){- case '-':
- sign *= -1;
- continue;
- }
- break;
- }
-
- if(base == 0){- base = 10;
- if(a[0] == '0'){- if(a[1] == 'x' || a[1] == 'X') {- a += 2;
- base = 16;
- } else if(a[1] == 'b' || a[1] == 'B') {- a += 2;
- base = 2;
- } else if(a[1] >= '0' && a[1] <= '7') {- a++;
- base = 8;
- }
- }
- }
-
- switch(base){- case 2:
- e = frompow2(a, b, 1);
- break;
- case 4:
- e = frompow2(a, b, 2);
- break;
- case 8:
- e = from8(a, b);
- break;
- case 10:
- e = from10(a, b);
- break;
- case 16:
- e = frompow2(a, b, 4);
- break;
- default:
- abort();
- return nil;
- }
-
- if(pp != nil)
- *pp = e;
-
- // if no characters parsed, there wasn't a number to convert
- if(e == a)
- return nil;
-
- b->sign = sign;
- return mpnorm(b);
-}
--- a/mp/u16.c
+++ /dev/null
@@ -1,68 +1,0 @@
-#include "platform.h"
-
-#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
-
-int
-enc16chr(int o)
-{- int c;
-
- c = between(o, 0, 9) & ('0'+o);- c |= between(o, 10, 15) & ('A'+(o-10));- return c;
-}
-
-int
-dec16chr(int c)
-{- int o;
-
- o = between(c, '0', '9') & (1+(c-'0'));
- o |= between(c, 'A', 'F') & (1+10+(c-'A'));
- o |= between(c, 'a', 'f') & (1+10+(c-'a'));
- return o-1;
-}
-
-int
-dec16(uchar *out, int lim, char *in, int n)
-{- int c, w = 0, i = 0;
- uchar *start = out;
- uchar *eout = out + lim;
-
- while(n-- > 0){- c = dec16chr(*in++);
- if(c < 0)
- continue;
- w = (w<<4) + c;
- i++;
- if(i == 2){- if(out + 1 > eout)
- goto exhausted;
- *out++ = w;
- w = 0;
- i = 0;
- }
- }
-exhausted:
- return out - start;
-}
-
-int
-enc16(char *out, int lim, uchar *in, int n)
-{- uint c;
- char *eout = out + lim;
- char *start = out;
-
- while(n-- > 0){- c = *in++;
- if(out + 2 >= eout)
- goto exhausted;
- *out++ = enc16chr(c>>4);
- *out++ = enc16chr(c&15);
- }
-exhausted:
- *out = 0;
- return out - start;
-}
--- a/mp/u32.c
+++ /dev/null
@@ -1,143 +1,0 @@
-#include "platform.h"
-
-#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
-
-int
-enc32chr(int o)
-{- int c;
-
- c = between(o, 0, 25) & ('A'+o);- c |= between(o, 26, 31) & ('2'+(o-26));- return c;
-}
-
-int
-dec32chr(int c)
-{- int o;
-
- o = between(c, 'A', 'Z') & (1+(c-'A'));
- o |= between(c, 'a', 'z') & (1+(c-'a'));
- o |= between(c, '2', '7') & (1+26+(c-'2'));
- return o-1;
-}
-
-int
-dec32x(uchar *dest, int ndest, char *src, int nsrc, int (*chr)(int))
-{- uchar *start;
- int i, j, u[8];
-
- if(ndest+1 < (5*nsrc+7)/8)
- return -1;
- start = dest;
- while(nsrc>=8){- for(i=0; i<8; i++){- j = chr(src[i]);
- if(j < 0)
- j = 0;
- u[i] = j;
- }
- *dest++ = (u[0]<<3) | (0x7 & (u[1]>>2));
- *dest++ = ((0x3 & u[1])<<6) | (u[2]<<1) | (0x1 & (u[3]>>4));
- *dest++ = ((0xf & u[3])<<4) | (0xf & (u[4]>>1));
- *dest++ = ((0x1 & u[4])<<7) | (u[5]<<2) | (0x3 & (u[6]>>3));
- *dest++ = ((0x7 & u[6])<<5) | u[7];
- src += 8;
- nsrc -= 8;
- }
- if(nsrc > 0){- if(nsrc == 1 || nsrc == 3 || nsrc == 6)
- return -1;
- for(i=0; i<nsrc; i++){- j = chr(src[i]);
- if(j < 0)
- j = 0;
- u[i] = j;
- }
- *dest++ = (u[0]<<3) | (0x7 & (u[1]>>2));
- if(nsrc == 2)
- goto out;
- *dest++ = ((0x3 & u[1])<<6) | (u[2]<<1) | (0x1 & (u[3]>>4));
- if(nsrc == 4)
- goto out;
- *dest++ = ((0xf & u[3])<<4) | (0xf & (u[4]>>1));
- if(nsrc == 5)
- goto out;
- *dest++ = ((0x1 & u[4])<<7) | (u[5]<<2) | (0x3 & (u[6]>>3));
- }
-out:
- return dest-start;
-}
-
-int
-enc32x(char *dest, int ndest, uchar *src, int nsrc, int (*chr)(int))
-{- char *start;
- int j;
-
- if(ndest <= (8*nsrc+4)/5)
- return -1;
- start = dest;
- while(nsrc>=5){- j = (0x1f & (src[0]>>3));
- *dest++ = chr(j);
- j = (0x1c & (src[0]<<2)) | (0x03 & (src[1]>>6));
- *dest++ = chr(j);
- j = (0x1f & (src[1]>>1));
- *dest++ = chr(j);
- j = (0x10 & (src[1]<<4)) | (0x0f & (src[2]>>4));
- *dest++ = chr(j);
- j = (0x1e & (src[2]<<1)) | (0x01 & (src[3]>>7));
- *dest++ = chr(j);
- j = (0x1f & (src[3]>>2));
- *dest++ = chr(j);
- j = (0x18 & (src[3]<<3)) | (0x07 & (src[4]>>5));
- *dest++ = chr(j);
- j = (0x1f & (src[4]));
- *dest++ = chr(j);
- src += 5;
- nsrc -= 5;
- }
- if(nsrc){- j = (0x1f & (src[0]>>3));
- *dest++ = chr(j);
- j = (0x1c & (src[0]<<2));
- if(nsrc == 1)
- goto out;
- j |= (0x03 & (src[1]>>6));
- *dest++ = chr(j);
- j = (0x1f & (src[1]>>1));
- *dest++ = chr(j);
- j = (0x10 & (src[1]<<4));
- if(nsrc == 2)
- goto out;
- j |= (0x0f & (src[2]>>4));
- *dest++ = chr(j);
- j = (0x1e & (src[2]<<1));
- if(nsrc == 3)
- goto out;
- j |= (0x01 & (src[3]>>7));
- *dest++ = chr(j);
- j = (0x1f & (src[3]>>2));
- *dest++ = chr(j);
- j = (0x18 & (src[3]<<3));
-out:
- *dest++ = chr(j);
- }
- *dest = 0;
- return dest-start;
-}
-
-int
-enc32(char *dest, int ndest, uchar *src, int nsrc)
-{- return enc32x(dest, ndest, src, nsrc, enc32chr);
-}
-
-int
-dec32(uchar *dest, int ndest, char *src, int nsrc)
-{- return dec32x(dest, ndest, src, nsrc, dec32chr);
-}
--- a/mp/u64.c
+++ /dev/null
@@ -1,141 +1,0 @@
-#include "platform.h"
-
-#define between(x,min,max) (((min-1-x) & (x-max-1))>>8)
-
-int
-enc64chr(int o)
-{- int c;
-
- c = between(o, 0, 25) & ('A'+o);- c |= between(o, 26, 51) & ('a'+(o-26));- c |= between(o, 52, 61) & ('0'+(o-52));- c |= between(o, 62, 62) & ('+');- c |= between(o, 63, 63) & ('/');- return c;
-}
-
-int
-dec64chr(int c)
-{- int o;
-
- o = between(c, 'A', 'Z') & (1+(c-'A'));
- o |= between(c, 'a', 'z') & (1+26+(c-'a'));
- o |= between(c, '0', '9') & (1+52+(c-'0'));
- o |= between(c, '+', '+') & (1+62);
- o |= between(c, '/', '/') & (1+63);
- return o-1;
-}
-
-int
-dec64x(uchar *out, int lim, char *in, int n, int (*chr)(int))
-{- ulong b24;
- uchar *start = out;
- uchar *e = out + lim;
- int i, c;
-
- b24 = 0;
- i = 0;
- while(n-- > 0){- c = chr(*in++);
- if(c < 0)
- continue;
- switch(i){- case 0:
- b24 = c<<18;
- break;
- case 1:
- b24 |= c<<12;
- break;
- case 2:
- b24 |= c<<6;
- break;
- case 3:
- if(out + 3 > e)
- goto exhausted;
-
- b24 |= c;
- *out++ = b24>>16;
- *out++ = b24>>8;
- *out++ = b24;
- i = 0;
- continue;
- }
- i++;
- }
- switch(i){- case 2:
- if(out + 1 > e)
- goto exhausted;
- *out++ = b24>>16;
- break;
- case 3:
- if(out + 2 > e)
- goto exhausted;
- *out++ = b24>>16;
- *out++ = b24>>8;
- break;
- }
-exhausted:
- return out - start;
-}
-
-int
-enc64x(char *out, int lim, uchar *in, int n, int (*chr)(int))
-{- int i;
- ulong b24;
- char *start = out;
- char *e = out + lim;
-
- for(i = n/3; i > 0; i--){- b24 = *in++<<16;
- b24 |= *in++<<8;
- b24 |= *in++;
- if(out + 4 >= e)
- goto exhausted;
- *out++ = chr(b24>>18);
- *out++ = chr((b24>>12)&0x3f);
- *out++ = chr((b24>>6)&0x3f);
- *out++ = chr(b24&0x3f);
- }
-
- switch(n%3){- case 2:
- b24 = *in++<<16;
- b24 |= *in<<8;
- if(out + 4 >= e)
- goto exhausted;
- *out++ = chr(b24>>18);
- *out++ = chr((b24>>12)&0x3f);
- *out++ = chr((b24>>6)&0x3f);
- *out++ = '=';
- break;
- case 1:
- b24 = *in<<16;
- if(out + 4 >= e)
- goto exhausted;
- *out++ = chr(b24>>18);
- *out++ = chr((b24>>12)&0x3f);
- *out++ = '=';
- *out++ = '=';
- break;
- }
-exhausted:
- *out = 0;
- return out - start;
-}
-
-int
-enc64(char *out, int lim, uchar *in, int n)
-{- return enc64x(out, lim, in, n, enc64chr);
-}
-
-int
-dec64(uchar *out, int lim, char *in, int n)
-{- return dec64x(out, lim, in, n, dec64chr);
-}
--- a/opcodes.h
+++ b/opcodes.h
@@ -1,136 +1,136 @@
enum {- OP_LOADA0,
- OP_LOADA1,
- OP_LOADV,
- OP_BRF,
- OP_POP,
- OP_CALL,
- OP_TCALL,
- OP_LOADG,
- OP_LOADA,
- OP_LOADC,
- OP_RET,
- OP_DUP,
- OP_CAR,
- OP_CDR,
- OP_CLOSURE,
- OP_SETA,
- OP_JMP,
- OP_LOADC00,
- OP_PAIRP,
- OP_BRNE,
- OP_LOADT,
- OP_LOAD0,
- OP_LOADC01,
- OP_AREF,
- OP_ATOMP,
- OP_BRT,
- OP_BRNN,
- OP_LOAD1,
- OP_LT,
- OP_ADD2,
- OP_SETCDR,
- OP_LOADF,
- OP_CONS,
- OP_EQ,
- OP_SYMBOLP,
- OP_NOT,
- OP_CADR,
- OP_NEG,
- OP_NULLP,
- OP_BOOLEANP,
- OP_NUMBERP,
- OP_FIXNUMP,
- OP_BOUNDP,
- OP_BUILTINP,
- OP_FUNCTIONP,
- OP_VECTORP,
- OP_NOP,
- OP_SETCAR,
- OP_JMPL,
- OP_BRFL,
- OP_BRTL,
- OP_EQV,
- OP_EQUAL,
- OP_LIST,
- OP_APPLY,
- OP_ADD,
- OP_SUB,
- OP_MUL,
- OP_DIV,
- OP_IDIV,
- OP_NUMEQ,
- OP_COMPARE,
- OP_ARGC,
- OP_VECTOR,
- OP_ASET,
- OP_LOADNIL,
- OP_LOADI8,
- OP_LOADVL,
- OP_LOADGL,
- OP_LOADAL,
- OP_LOADCL,
- OP_SETG,
- OP_SETGL,
- OP_SETAL,
- OP_SETC,
- OP_SETCL,
- OP_VARGC,
- OP_TRYCATCH,
- OP_FOR,
- OP_TAPPLY,
- OP_SUB2,
- OP_LARGC,
- OP_LVARGC,
- OP_CALLL,
- OP_TCALLL,
- OP_BRNEL,
- OP_BRNNL,
- OP_BRN,
- OP_BRNL,
- OP_OPTARGS,
- OP_BRBOUND,
- OP_KEYARGS,
- OP_BOOL_CONST_F,
- OP_BOOL_CONST_T,
- OP_THE_EMPTY_LIST,
- OP_EOF_OBJECT,
- N_OPCODES
+ OP_LOADA0,
+ OP_LOADA1,
+ OP_LOADV,
+ OP_BRF,
+ OP_POP,
+ OP_CALL,
+ OP_TCALL,
+ OP_LOADG,
+ OP_LOADA,
+ OP_LOADC,
+ OP_RET,
+ OP_DUP,
+ OP_CAR,
+ OP_CDR,
+ OP_CLOSURE,
+ OP_SETA,
+ OP_JMP,
+ OP_LOADC00,
+ OP_PAIRP,
+ OP_BRNE,
+ OP_LOADT,
+ OP_LOAD0,
+ OP_LOADC01,
+ OP_AREF,
+ OP_ATOMP,
+ OP_BRT,
+ OP_BRNN,
+ OP_LOAD1,
+ OP_LT,
+ OP_ADD2,
+ OP_SETCDR,
+ OP_LOADF,
+ OP_CONS,
+ OP_EQ,
+ OP_SYMBOLP,
+ OP_NOT,
+ OP_CADR,
+ OP_NEG,
+ OP_NULLP,
+ OP_BOOLEANP,
+ OP_NUMBERP,
+ OP_FIXNUMP,
+ OP_BOUNDP,
+ OP_BUILTINP,
+ OP_FUNCTIONP,
+ OP_VECTORP,
+ OP_NOP,
+ OP_SETCAR,
+ OP_JMPL,
+ OP_BRFL,
+ OP_BRTL,
+ OP_EQV,
+ OP_EQUAL,
+ OP_LIST,
+ OP_APPLY,
+ OP_ADD,
+ OP_SUB,
+ OP_MUL,
+ OP_DIV,
+ OP_IDIV,
+ OP_NUMEQ,
+ OP_COMPARE,
+ OP_ARGC,
+ OP_VECTOR,
+ OP_ASET,
+ OP_LOADNIL,
+ OP_LOADI8,
+ OP_LOADVL,
+ OP_LOADGL,
+ OP_LOADAL,
+ OP_LOADCL,
+ OP_SETG,
+ OP_SETGL,
+ OP_SETAL,
+ OP_SETC,
+ OP_SETCL,
+ OP_VARGC,
+ OP_TRYCATCH,
+ OP_FOR,
+ OP_TAPPLY,
+ OP_SUB2,
+ OP_LARGC,
+ OP_LVARGC,
+ OP_CALLL,
+ OP_TCALLL,
+ OP_BRNEL,
+ OP_BRNNL,
+ OP_BRN,
+ OP_BRNL,
+ OP_OPTARGS,
+ OP_BRBOUND,
+ OP_KEYARGS,
+ OP_BOOL_CONST_F,
+ OP_BOOL_CONST_T,
+ OP_THE_EMPTY_LIST,
+ OP_EOF_OBJECT,
+ N_OPCODES
};
static const Builtin builtins[] = {- [OP_NUMBERP] = {"number?", 1},- [OP_NUMEQ] = {"=", 2},- [OP_BOOLEANP] = {"boolean?", 1},- [OP_IDIV] = {"div0", 2},- [OP_DIV] = {"/", -1},- [OP_PAIRP] = {"pair?", 1},- [OP_ATOMP] = {"atom?", 1},- [OP_SYMBOLP] = {"symbol?", 1},- [OP_APPLY] = {"apply", -2},- [OP_BOUNDP] = {"bound?", 1},- [OP_EQV] = {"eqv?", 2},- [OP_NOT] = {"not", 1},- [OP_SUB] = {"-", -1},- [OP_NULLP] = {"null?", 1},- [OP_CAR] = {"car", 1},- [OP_VECTOR] = {"vector", ANYARGS},- [OP_ASET] = {"aset!", 3},- [OP_FUNCTIONP] = {"function?", 1},- [OP_EQ] = {"eq?", 2},- [OP_BUILTINP] = {"builtin?", 1},- [OP_LIST] = {"list", ANYARGS},- [OP_AREF] = {"aref", 2},- [OP_FIXNUMP] = {"fixnum?", 1},- [OP_VECTORP] = {"vector?", 1},- [OP_ADD] = {"+", ANYARGS},- [OP_CONS] = {"cons", 2},- [OP_SETCDR] = {"set-cdr!", 2},- [OP_COMPARE] = {"compare", 2},- [OP_SETCAR] = {"set-car!", 2},- [OP_LT] = {"<", 2},- [OP_EQUAL] = {"equal?", 2},- [OP_MUL] = {"*", ANYARGS},- [OP_CADR] = {"cadr", 1},- [OP_CDR] = {"cdr", 1},+ [OP_NUMBERP] = {"number?", 1},+ [OP_NUMEQ] = {"=", 2},+ [OP_BOOLEANP] = {"boolean?", 1},+ [OP_IDIV] = {"div0", 2},+ [OP_DIV] = {"/", -1},+ [OP_PAIRP] = {"pair?", 1},+ [OP_ATOMP] = {"atom?", 1},+ [OP_SYMBOLP] = {"symbol?", 1},+ [OP_APPLY] = {"apply", -2},+ [OP_BOUNDP] = {"bound?", 1},+ [OP_EQV] = {"eqv?", 2},+ [OP_NOT] = {"not", 1},+ [OP_SUB] = {"-", -1},+ [OP_NULLP] = {"null?", 1},+ [OP_CAR] = {"car", 1},+ [OP_VECTOR] = {"vector", ANYARGS},+ [OP_ASET] = {"aset!", 3},+ [OP_FUNCTIONP] = {"function?", 1},+ [OP_EQ] = {"eq?", 2},+ [OP_BUILTINP] = {"builtin?", 1},+ [OP_LIST] = {"list", ANYARGS},+ [OP_AREF] = {"aref", 2},+ [OP_FIXNUMP] = {"fixnum?", 1},+ [OP_VECTORP] = {"vector?", 1},+ [OP_ADD] = {"+", ANYARGS},+ [OP_CONS] = {"cons", 2},+ [OP_SETCDR] = {"set-cdr!", 2},+ [OP_COMPARE] = {"compare", 2},+ [OP_SETCAR] = {"set-car!", 2},+ [OP_LT] = {"<", 2},+ [OP_EQUAL] = {"equal?", 2},+ [OP_MUL] = {"*", ANYARGS},+ [OP_CADR] = {"cadr", 1},+ [OP_CDR] = {"cdr", 1},};
--- a/operators.c
+++ b/operators.c
@@ -1,86 +1,90 @@
#include "llt.h"
-mpint *conv_to_mpint(void *data, numerictype_t tag)
+mpint *
+conv_to_mpint(void *data, numerictype_t tag)
{- mpint *i = mpzero;
- switch (tag) {- case T_INT8: i = itomp(*(int8_t*)data, nil); break;
- case T_UINT8: i = uitomp(*(uint8_t*)data, nil); break;
- case T_INT16: i = itomp(*(int16_t*)data, nil); break;
- case T_UINT16: i = uitomp(*(uint16_t*)data, nil); break;
- case T_INT32: i = itomp(*(int32_t*)data, nil); break;
- case T_UINT32: i = uitomp(*(uint32_t*)data, nil); break;
- case T_INT64: i = vtomp(*(int64_t*)data, nil); break;
- case T_UINT64: i = uvtomp(*(int64_t*)data, nil); break;
- case T_MPINT: i = mpcopy(*(mpint**)data); break;
- case T_FLOAT: i = dtomp(*(float*)data, nil); break;
- case T_DOUBLE: i = dtomp(*(double*)data, nil); break;
- }
- return i;
+ mpint *i = mpzero;
+ switch(tag){+ case T_INT8: i = itomp(*(int8_t*)data, nil); break;
+ case T_UINT8: i = uitomp(*(uint8_t*)data, nil); break;
+ case T_INT16: i = itomp(*(int16_t*)data, nil); break;
+ case T_UINT16: i = uitomp(*(uint16_t*)data, nil); break;
+ case T_INT32: i = itomp(*(int32_t*)data, nil); break;
+ case T_UINT32: i = uitomp(*(uint32_t*)data, nil); break;
+ case T_INT64: i = vtomp(*(int64_t*)data, nil); break;
+ case T_UINT64: i = uvtomp(*(int64_t*)data, nil); break;
+ case T_MPINT: i = mpcopy(*(mpint**)data); break;
+ case T_FLOAT: i = dtomp(*(float*)data, nil); break;
+ case T_DOUBLE: i = dtomp(*(double*)data, nil); break;
+ }
+ return i;
}
-double conv_to_double(void *data, numerictype_t tag)
+double
+conv_to_double(void *data, numerictype_t tag)
{- double d=0;
- switch (tag) {- case T_INT8: d = (double)*(int8_t*)data; break;
- case T_UINT8: d = (double)*(uint8_t*)data; break;
- case T_INT16: d = (double)*(int16_t*)data; break;
- case T_UINT16: d = (double)*(uint16_t*)data; break;
- case T_INT32: d = (double)*(int32_t*)data; break;
- case T_UINT32: d = (double)*(uint32_t*)data; break;
- case T_INT64:
- d = (double)*(int64_t*)data;
- if (d > 0 && *(int64_t*)data < 0) // can happen!
- d = -d;
- break;
- case T_UINT64: d = (double)*(uint64_t*)data; break;
- case T_MPINT: d = mptod(*(mpint**)data); break;
- case T_FLOAT: d = (double)*(float*)data; break;
- case T_DOUBLE: return *(double*)data;
- }
- return d;
+ double d = 0;
+ switch(tag){+ case T_INT8: d = (double)*(int8_t*)data; break;
+ case T_UINT8: d = (double)*(uint8_t*)data; break;
+ case T_INT16: d = (double)*(int16_t*)data; break;
+ case T_UINT16: d = (double)*(uint16_t*)data; break;
+ case T_INT32: d = (double)*(int32_t*)data; break;
+ case T_UINT32: d = (double)*(uint32_t*)data; break;
+ case T_INT64:
+ d = (double)*(int64_t*)data;
+ if(d > 0 && *(int64_t*)data < 0) // can happen!
+ d = -d;
+ break;
+ case T_UINT64: d = (double)*(uint64_t*)data; break;
+ case T_MPINT: d = mptod(*(mpint**)data); break;
+ case T_FLOAT: d = (double)*(float*)data; break;
+ case T_DOUBLE: return *(double*)data;
+ }
+ return d;
}
-void conv_from_double(void *dest, double d, numerictype_t tag)
+void
+conv_from_double(void *dest, double d, numerictype_t tag)
{- switch (tag) {- case T_INT8: *(int8_t*)dest = d; break;
- case T_UINT8: *(uint8_t*)dest = d; break;
- case T_INT16: *(int16_t*)dest = d; break;
- case T_UINT16: *(uint16_t*)dest = d; break;
- case T_INT32: *(int32_t*)dest = d; break;
- case T_UINT32: *(uint32_t*)dest = d; break;
- case T_INT64:
- *(int64_t*)dest = d;
- if (d > 0 && *(int64_t*)dest < 0) // 0x8000000000000000 is a bitch
- *(int64_t*)dest = INT64_MAX;
- break;
- case T_UINT64: *(uint64_t*)dest = (int64_t)d; break;
- case T_MPINT: *(mpint**)dest = dtomp(d, nil); break;
- case T_FLOAT: *(float*)dest = d; break;
- case T_DOUBLE: *(double*)dest = d; break;
- }
+ switch(tag){+ case T_INT8: *(int8_t*)dest = d; break;
+ case T_UINT8: *(uint8_t*)dest = d; break;
+ case T_INT16: *(int16_t*)dest = d; break;
+ case T_UINT16: *(uint16_t*)dest = d; break;
+ case T_INT32: *(int32_t*)dest = d; break;
+ case T_UINT32: *(uint32_t*)dest = d; break;
+ case T_INT64:
+ *(int64_t*)dest = d;
+ if(d > 0 && *(int64_t*)dest < 0) // 0x8000000000000000 is a bitch
+ *(int64_t*)dest = INT64_MAX;
+ break;
+ case T_UINT64: *(uint64_t*)dest = (int64_t)d; break;
+ case T_MPINT: *(mpint**)dest = dtomp(d, nil); break;
+ case T_FLOAT: *(float*)dest = d; break;
+ case T_DOUBLE: *(double*)dest = d; break;
+ }
}
// FIXME sign with mpint
-#define CONV_TO_INTTYPE(name, ctype) \
-ctype conv_to_##name(void *data, numerictype_t tag) \
-{ \- switch (tag) { \- case T_INT8: return *(int8_t*)data; \
- case T_UINT8: return *(uint8_t*)data; \
- case T_INT16: return *(int16_t*)data; \
- case T_UINT16: return *(uint16_t*)data; \
- case T_INT32: return *(int32_t*)data; \
- case T_UINT32: return *(uint32_t*)data; \
- case T_INT64: return *(int64_t*)data; \
- case T_UINT64: return *(uint64_t*)data; \
- case T_MPINT: return mptov(*(mpint**)data); \
- case T_FLOAT: return *(float*)data; \
- case T_DOUBLE: return *(double*)data; \
- } \
- return 0; \
+#define CONV_TO_INTTYPE(name, ctype) \
+ctype \
+conv_to_##name(void *data, numerictype_t tag) \
+{ \+ switch(tag){ \+ case T_INT8: return *(int8_t*)data; \
+ case T_UINT8: return *(uint8_t*)data; \
+ case T_INT16: return *(int16_t*)data; \
+ case T_UINT16: return *(uint16_t*)data; \
+ case T_INT32: return *(int32_t*)data; \
+ case T_UINT32: return *(uint32_t*)data; \
+ case T_INT64: return *(int64_t*)data; \
+ case T_UINT64: return *(uint64_t*)data; \
+ case T_MPINT: return mptov(*(mpint**)data); \
+ case T_FLOAT: return *(float*)data; \
+ case T_DOUBLE: return *(double*)data; \
+ } \
+ return 0; \
}
CONV_TO_INTTYPE(int64, int64_t)
@@ -90,196 +94,192 @@
// this is needed to work around an UB casting negative
// floats and doubles to uint64. you need to cast to int64
// first.
-uint64_t conv_to_uint64(void *data, numerictype_t tag)
+uint64_t
+conv_to_uint64(void *data, numerictype_t tag)
{- int64_t s;
- switch (tag) {- case T_INT8: return *(int8_t*)data; break;
- case T_UINT8: return *(uint8_t*)data; break;
- case T_INT16: return *(int16_t*)data; break;
- case T_UINT16: return *(uint16_t*)data; break;
- case T_INT32: return *(int32_t*)data; break;
- case T_UINT32: return *(uint32_t*)data; break;
- case T_INT64: return *(int64_t*)data; break;
- case T_UINT64: return *(uint64_t*)data; break;
- case T_MPINT: return mptouv(*(mpint**)data); break;
- case T_FLOAT:
- if (*(float*)data >= 0)
- return *(float*)data;
- s = *(float*)data;
- return s;
- case T_DOUBLE:
- if (*(double*)data >= 0)
- return *(double*)data;
- s = *(double*)data;
- return s;
- }
- return 0;
+ int64_t s;
+ switch(tag){+ case T_INT8: return *(int8_t*)data; break;
+ case T_UINT8: return *(uint8_t*)data; break;
+ case T_INT16: return *(int16_t*)data; break;
+ case T_UINT16: return *(uint16_t*)data; break;
+ case T_INT32: return *(int32_t*)data; break;
+ case T_UINT32: return *(uint32_t*)data; break;
+ case T_INT64: return *(int64_t*)data; break;
+ case T_UINT64: return *(uint64_t*)data; break;
+ case T_MPINT: return mptouv(*(mpint**)data); break;
+ case T_FLOAT:
+ if(*(float*)data >= 0)
+ return *(float*)data;
+ s = *(float*)data;
+ return s;
+ case T_DOUBLE:
+ if(*(double*)data >= 0)
+ return *(double*)data;
+ s = *(double*)data;
+ return s;
+ }
+ return 0;
}
-int cmp_same_lt(void *a, void *b, numerictype_t tag)
+int
+cmp_same_lt(void *a, void *b, numerictype_t tag)
{- switch (tag) {- case T_INT8: return *(int8_t*)a < *(int8_t*)b;
- case T_UINT8: return *(uint8_t*)a < *(uint8_t*)b;
- case T_INT16: return *(int16_t*)a < *(int16_t*)b;
- case T_UINT16: return *(uint16_t*)a < *(uint16_t*)b;
- case T_INT32: return *(int32_t*)a < *(int32_t*)b;
- case T_UINT32: return *(uint32_t*)a < *(uint32_t*)b;
- case T_INT64: return *(int64_t*)a < *(int64_t*)b;
- case T_UINT64: return *(uint64_t*)a < *(uint64_t*)b;
- case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
- case T_FLOAT: return *(float*)a < *(float*)b;
- case T_DOUBLE: return *(double*)a < *(double*)b;
- }
- return 0;
+ switch(tag){+ case T_INT8: return *(int8_t*)a < *(int8_t*)b;
+ case T_UINT8: return *(uint8_t*)a < *(uint8_t*)b;
+ case T_INT16: return *(int16_t*)a < *(int16_t*)b;
+ case T_UINT16: return *(uint16_t*)a < *(uint16_t*)b;
+ case T_INT32: return *(int32_t*)a < *(int32_t*)b;
+ case T_UINT32: return *(uint32_t*)a < *(uint32_t*)b;
+ case T_INT64: return *(int64_t*)a < *(int64_t*)b;
+ case T_UINT64: return *(uint64_t*)a < *(uint64_t*)b;
+ case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) < 0;
+ case T_FLOAT: return *(float*)a < *(float*)b;
+ case T_DOUBLE: return *(double*)a < *(double*)b;
+ }
+ return 0;
}
-int cmp_same_eq(void *a, void *b, numerictype_t tag)
+int
+cmp_same_eq(void *a, void *b, numerictype_t tag)
{- switch (tag) {- case T_INT8: return *(int8_t*)a == *(int8_t*)b;
- case T_UINT8: return *(uint8_t*)a == *(uint8_t*)b;
- case T_INT16: return *(int16_t*)a == *(int16_t*)b;
- case T_UINT16: return *(uint16_t*)a == *(uint16_t*)b;
- case T_INT32: return *(int32_t*)a == *(int32_t*)b;
- case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b;
- case T_INT64: return *(int64_t*)a == *(int64_t*)b;
- case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b;
- case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
- case T_FLOAT: return *(float*)a == *(float*)b;
- case T_DOUBLE: return *(double*)a == *(double*)b;
- }
- return 0;
+ switch(tag){+ case T_INT8: return *(int8_t*)a == *(int8_t*)b;
+ case T_UINT8: return *(uint8_t*)a == *(uint8_t*)b;
+ case T_INT16: return *(int16_t*)a == *(int16_t*)b;
+ case T_UINT16: return *(uint16_t*)a == *(uint16_t*)b;
+ case T_INT32: return *(int32_t*)a == *(int32_t*)b;
+ case T_UINT32: return *(uint32_t*)a == *(uint32_t*)b;
+ case T_INT64: return *(int64_t*)a == *(int64_t*)b;
+ case T_UINT64: return *(uint64_t*)a == *(uint64_t*)b;
+ case T_MPINT: return mpcmp(*(mpint**)a, *(mpint**)b) == 0;
+ case T_FLOAT: return *(float*)a == *(float*)b;
+ case T_DOUBLE: return *(double*)a == *(double*)b;
+ }
+ return 0;
}
/* FIXME one is allocated for all compare ops */
static mpint *cmpmpint;
-int cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
+int
+cmp_lt(void *a, numerictype_t atag, void *b, numerictype_t btag)
{- if (atag==btag)
- return cmp_same_lt(a, b, atag);
+ if(atag == btag)
+ return cmp_same_lt(a, b, atag);
- double da = conv_to_double(a, atag);
- double db = conv_to_double(b, btag);
+ double da = conv_to_double(a, atag);
+ double db = conv_to_double(b, btag);
- // casting to double will only get the wrong answer for big int64s
- // that differ in low bits
- if (da < db && !isnan(da) && !isnan(db))
- return 1;
- if (db < da)
- return 0;
+ // casting to double will only get the wrong answer for big int64s
+ // that differ in low bits
+ if(da < db && !isnan(da) && !isnan(db))
+ return 1;
+ if(db < da)
+ return 0;
- if (cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
- cmpmpint = mpnew(0);
+ if(cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
+ cmpmpint = mpnew(0);
- if (atag == T_UINT64) {- if (btag == T_INT64) {- if (*(int64_t*)b >= 0)
- return (*(uint64_t*)a < (uint64_t)*(int64_t*)b);
- return ((int64_t)*(uint64_t*)a < *(int64_t*)b);
- }
- else if (btag == T_DOUBLE) {- if (db != db) return 0;
- return (*(uint64_t*)a < (uint64_t)*(double*)b);
- }
- else if (btag == T_MPINT) {- return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) < 0;
- }
- }
- else if (atag == T_INT64) {- if (btag == T_UINT64) {- if (*(int64_t*)a >= 0)
- return ((uint64_t)*(int64_t*)a < *(uint64_t*)b);
- return (*(int64_t*)a < (int64_t)*(uint64_t*)b);
- }
- else if (btag == T_DOUBLE) {- if (db != db) return 0;
- return (*(int64_t*)a < (int64_t)*(double*)b);
- }
- else if (btag == T_MPINT) {- return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) < 0;
- }
- }
- if (btag == T_UINT64) {- if (atag == T_DOUBLE) {- if (da != da) return 0;
- return (*(uint64_t*)b > (uint64_t)*(double*)a);
- }
- else if (atag == T_MPINT) {- return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) < 0;
- }
- }
- else if (btag == T_INT64) {- if (atag == T_DOUBLE) {- if (da != da) return 0;
- return (*(int64_t*)b > (int64_t)*(double*)a);
- }
- else if (atag == T_MPINT) {- return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) < 0;
- }
- }
- return 0;
+ if(atag == T_UINT64){+ if(btag == T_INT64){+ if(*(int64_t*)b >= 0)
+ return (*(uint64_t*)a < (uint64_t)*(int64_t*)b);
+ return ((int64_t)*(uint64_t*)a < *(int64_t*)b);
+ }
+ if(btag == T_DOUBLE)
+ return db == db ? (*(uint64_t*)a < (uint64_t)*(double*)b) : 0;
+ if(btag == T_MPINT)
+ return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) < 0;
+ }
+ if(atag == T_INT64){+ if(btag == T_UINT64){+ if(*(int64_t*)a >= 0)
+ return ((uint64_t)*(int64_t*)a < *(uint64_t*)b);
+ return (*(int64_t*)a < (int64_t)*(uint64_t*)b);
+ }
+ if(btag == T_DOUBLE)
+ return db == db ? (*(int64_t*)a < (int64_t)*(double*)b) : 0;
+ if(btag == T_MPINT)
+ return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) < 0;
+ }
+ if(btag == T_UINT64){+ if(atag == T_DOUBLE)
+ return da == da ? (*(uint64_t*)b > (uint64_t)*(double*)a) : 0;
+ if(atag == T_MPINT)
+ return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) < 0;
+ }
+ if(btag == T_INT64){+ if(atag == T_DOUBLE)
+ return da == da ? (*(int64_t*)b > (int64_t)*(double*)a) : 0;
+ if(atag == T_MPINT)
+ return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) < 0;
+ }
+ return 0;
}
-int cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag,
- int equalnans)
+int
+cmp_eq(void *a, numerictype_t atag, void *b, numerictype_t btag, int equalnans)
{- union { double d; int64_t i64; } u, v;- if (atag==btag && (!equalnans || atag < T_FLOAT))
- return cmp_same_eq(a, b, atag);
+ union {+ double d;
+ int64_t i64;
+ }u, v;
- double da = conv_to_double(a, atag);
- double db = conv_to_double(b, btag);
+ if(atag == btag && (!equalnans || atag < T_FLOAT))
+ return cmp_same_eq(a, b, atag);
- if ((int)atag >= T_FLOAT && (int)btag >= T_FLOAT) {- if (equalnans) {- u.d = da; v.d = db;
- return u.i64 == v.i64;
- }
- return (da == db);
- }
+ double da = conv_to_double(a, atag);
+ double db = conv_to_double(b, btag);
- if (da != db)
- return 0;
+ if((int)atag >= T_FLOAT && (int)btag >= T_FLOAT){+ if(equalnans){+ u.d = da; v.d = db;
+ return u.i64 == v.i64;
+ }
+ return da == db;
+ }
- if (cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
- cmpmpint = mpnew(0);
+ if(da != db)
+ return 0;
- if (atag == T_UINT64) {- // this is safe because if a had been bigger than INT64_MAX,
- // we would already have concluded that it's bigger than b.
- if (btag == T_INT64)
- return ((int64_t)*(uint64_t*)a == *(int64_t*)b);
- else if (btag == T_DOUBLE)
- return (*(uint64_t*)a == (uint64_t)(int64_t)*(double*)b);
- else if (btag == T_MPINT)
- return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) == 0;
- }
- else if (atag == T_INT64) {- if (btag == T_UINT64)
- return (*(int64_t*)a == (int64_t)*(uint64_t*)b);
- else if (btag == T_DOUBLE)
- return (*(int64_t*)a == (int64_t)*(double*)b);
- else if (btag == T_MPINT)
- return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) == 0;
- }
- else if (btag == T_UINT64) {- if (atag == T_INT64)
- return ((int64_t)*(uint64_t*)b == *(int64_t*)a);
- else if (atag == T_DOUBLE)
- return (*(uint64_t*)b == (uint64_t)(int64_t)*(double*)a);
- else if (atag == T_MPINT)
- return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) == 0;
- }
- else if (btag == T_INT64) {- if (atag == T_UINT64)
- return (*(int64_t*)b == (int64_t)*(uint64_t*)a);
- else if (atag == T_DOUBLE)
- return (*(int64_t*)b == (int64_t)*(double*)a);
- else if (atag == T_MPINT)
- return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) == 0;
- }
- return 1;
+ if(cmpmpint == nil && (atag == T_MPINT || btag == T_MPINT))
+ cmpmpint = mpnew(0);
+
+ if(atag == T_UINT64){+ // this is safe because if a had been bigger than INT64_MAX,
+ // we would already have concluded that it's bigger than b.
+ if(btag == T_INT64)
+ return ((int64_t)*(uint64_t*)a == *(int64_t*)b);
+ if(btag == T_DOUBLE)
+ return (*(uint64_t*)a == (uint64_t)(int64_t)*(double*)b);
+ if(btag == T_MPINT)
+ return mpcmp(uvtomp(*(uint64_t*)a, cmpmpint), *(mpint**)b) == 0;
+ }
+ if(atag == T_INT64){+ if(btag == T_UINT64)
+ return (*(int64_t*)a == (int64_t)*(uint64_t*)b);
+ if(btag == T_DOUBLE)
+ return (*(int64_t*)a == (int64_t)*(double*)b);
+ if(btag == T_MPINT)
+ return mpcmp(vtomp(*(int64_t*)a, cmpmpint), *(mpint**)b) == 0;
+ }
+ if(btag == T_UINT64){+ if(atag == T_INT64)
+ return ((int64_t)*(uint64_t*)b == *(int64_t*)a);
+ if(atag == T_DOUBLE)
+ return (*(uint64_t*)b == (uint64_t)(int64_t)*(double*)a);
+ if(atag == T_MPINT)
+ return mpcmp(*(mpint**)a, uvtomp(*(uint64_t*)b, cmpmpint)) == 0;
+ }
+ if(btag == T_INT64){+ if(atag == T_UINT64)
+ return (*(int64_t*)b == (int64_t)*(uint64_t*)a);
+ if(atag == T_DOUBLE)
+ return (*(int64_t*)b == (int64_t)*(double*)a);
+ if(atag == T_MPINT)
+ return mpcmp(*(mpint**)a, vtomp(*(int64_t*)b, cmpmpint)) == 0;
+ }
+ return 1;
}
--- a/plan9/platform.h
+++ b/plan9/platform.h
@@ -13,7 +13,7 @@
#define unsetenv(name) putenv(name, "")
#define setenv(name, val, overwrite) putenv(name, val)
-#define exit(x) exits(x ? "error" : nil)
+#define exit(x) exits((x) ? "error" : nil)
#define isnan(x) isNaN(x)
#define getcwd getwd
@@ -56,7 +56,7 @@
#define PATHSEPSTRING "/"
#define PATHLISTSEP ':'
#define PATHLISTSEPSTRING ":"
-#define ISPATHSEP(c) ((c)=='/')
+#define ISPATHSEP(c) ((c) == '/')
enum {SEEK_SET,
@@ -100,4 +100,5 @@
typedef uintptr size_t;
typedef Rune wchar_t;
typedef enum { false, true } bool;+
int wcwidth(wchar_t c);
--- a/posix/platform.h
+++ b/posix/platform.h
@@ -11,9 +11,9 @@
#include <math.h>
#include <setjmp.h>
#include <stdarg.h>
+#include <stdio.h>
#include <stddef.h>
#include <stdint.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>
@@ -40,7 +40,7 @@
#define PATHSEPSTRING "/"
#define PATHLISTSEP ':'
#define PATHLISTSEPSTRING ":"
-#define ISPATHSEP(c) ((c)=='/')
+#define ISPATHSEP(c) ((c) == '/')
#ifndef BYTE_ORDER
#define LITTLE_ENDIAN __LITTLE_ENDIAN
--- a/print.c
+++ b/print.c
@@ -8,147 +8,153 @@
static fixnum_t print_level;
static fixnum_t P_LEVEL;
static int SCR_WIDTH = 80;
+static int HPOS = 0, VPOS;
-static int HPOS=0, VPOS;
-static void outc(char c, ios_t *f)
+static void
+outc(char c, ios_t *f)
{- ios_putc(c, f);
- if (c == '\n')
- HPOS = 0;
- else
- HPOS++;
+ ios_putc(c, f);
+ if(c == '\n')
+ HPOS = 0;
+ else
+ HPOS++;
}
-static void outs(char *s, ios_t *f)
+
+static void
+outs(char *s, ios_t *f)
{- ios_puts(s, f);
- HPOS += u8_strwidth(s);
+ ios_puts(s, f);
+ HPOS += u8_strwidth(s);
}
-static void outsn(char *s, ios_t *f, size_t n)
+
+static void
+outsn(char *s, ios_t *f, size_t n)
{- ios_write(f, s, n);
- HPOS += u8_strwidth(s);
+ ios_write(f, s, n);
+ HPOS += u8_strwidth(s);
}
-static int outindent(int n, ios_t *f)
+
+static int
+outindent(int n, ios_t *f)
{- // move back to left margin if we get too indented
- if (n > SCR_WIDTH-12)
- n = 2;
- int n0 = n;
- ios_putc('\n', f);- VPOS++;
- HPOS = n;
- while (n >= 8) {- ios_putc('\t', f);- n -= 8;
- }
- while (n) {- ios_putc(' ', f);- n--;
- }
- return n0;
+ // move back to left margin if we get too indented
+ if(n > SCR_WIDTH-12)
+ n = 2;
+ int n0 = n;
+ ios_putc('\n', f);+ VPOS++;
+ HPOS = n;
+ while(n >= 8){+ ios_putc('\t', f);+ n -= 8;
+ }
+ while(n){+ ios_putc(' ', f);+ n--;
+ }
+ return n0;
}
-void fl_print_chr(char c, ios_t *f)
+void
+fl_print_chr(char c, ios_t *f)
{- outc(c, f);
+ outc(c, f);
}
-void fl_print_str(char *s, ios_t *f)
+void
+fl_print_str(char *s, ios_t *f)
{- outs(s, f);
+ outs(s, f);
}
-void print_traverse(value_t v)
-{- value_t *bp;
- while (iscons(v)) {- if (ismarked(v)) {- bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
- if (*bp == (value_t)HT_NOTFOUND)
- *bp = fixnum(printlabel++);
- return;
- }
- mark_cons(v);
- print_traverse(car_(v));
- v = cdr_(v);
- }
- if (!ismanaged(v) || issymbol(v))
- return;
- if (ismarked(v)) {- bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
- if (*bp == (value_t)HT_NOTFOUND)
- *bp = fixnum(printlabel++);
- return;
- }
- if (isvector(v)) {- if (vector_size(v) > 0)
- mark_cons(v);
- unsigned int i;
- for(i=0; i < vector_size(v); i++)
- print_traverse(vector_elt(v,i));
- }
- else if (iscprim(v)) {- // don't consider shared references to e.g. chars
- }
- else if (isclosure(v)) {- mark_cons(v);
- function_t *f = (function_t*)ptr(v);
- print_traverse(f->bcode);
- print_traverse(f->vals);
- print_traverse(f->env);
- }
- else if (iscvalue(v)) {- cvalue_t *cv = (cvalue_t*)ptr(v);
- // don't consider shared references to ""
- if (!cv_isstr(cv) || cv_len(cv)!=0)
- mark_cons(v);
- fltype_t *t = cv_class(cv);
- if (t->vtable != nil && t->vtable->print_traverse != nil)
- t->vtable->print_traverse(v);
- }
+void
+print_traverse(value_t v)
+{+ value_t *bp;
+ while(iscons(v)){+ if(ismarked(v)){+ bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
+ if(*bp == (value_t)HT_NOTFOUND)
+ *bp = fixnum(printlabel++);
+ return;
+ }
+ mark_cons(v);
+ print_traverse(car_(v));
+ v = cdr_(v);
+ }
+ if(!ismanaged(v) || issymbol(v))
+ return;
+ if(ismarked(v)){+ bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
+ if(*bp == (value_t)HT_NOTFOUND)
+ *bp = fixnum(printlabel++);
+ return;
+ }
+ if(isvector(v)){+ if(vector_size(v) > 0)
+ mark_cons(v);
+ unsigned int i;
+ for(i = 0; i < vector_size(v); i++)
+ print_traverse(vector_elt(v,i));
+ }else if(iscprim(v)){+ // don't consider shared references to e.g. chars
+ }else if(isclosure(v)){+ mark_cons(v);
+ function_t *f = ptr(v);
+ print_traverse(f->bcode);
+ print_traverse(f->vals);
+ print_traverse(f->env);
+ }else if(iscvalue(v)){+ cvalue_t *cv = ptr(v);
+ // don't consider shared references to ""
+ if(!cv_isstr(cv) || cv_len(cv) != 0)
+ mark_cons(v);
+ fltype_t *t = cv_class(cv);
+ if(t->vtable != nil && t->vtable->print_traverse != nil)
+ t->vtable->print_traverse(v);
+ }
}
-static void print_symbol_name(ios_t *f, char *name)
+static void
+print_symbol_name(ios_t *f, char *name)
{- int i, escape=0, charescape=0;
+ int i, escape = 0, charescape = 0;
- if ((name[0] == '\0') ||
- (name[0] == '.' && name[1] == '\0') ||
- (name[0] == '#') ||
- isnumtok(name, nil))
- escape = 1;
- i=0;
- while (name[i]) {- if (!symchar(name[i])) {- escape = 1;
- if (name[i]=='|' || name[i]=='\\') {- charescape = 1;
- break;
- }
- }
- i++;
- }
- if (escape) {- if (charescape) {- outc('|', f);- i=0;
- while (name[i]) {- if (name[i]=='|' || name[i]=='\\')
- outc('\\', f);- outc(name[i], f);
- i++;
- }
- outc('|', f);- }
- else {- outc('|', f);- outs(name, f);
- outc('|', f);- }
- }
- else {- outs(name, f);
- }
+ if((name[0] == '\0') ||
+ (name[0] == '.' && name[1] == '\0') ||
+ (name[0] == '#') ||
+ isnumtok(name, nil))
+ escape = 1;
+ i = 0;
+ while(name[i]){+ if(!symchar(name[i])){+ escape = 1;
+ if(name[i] == '|' || name[i] == '\\'){+ charescape = 1;
+ break;
+ }
+ }
+ i++;
+ }
+ if(escape){+ if(charescape){+ outc('|', f);+ i = 0;
+ while(name[i]){+ if(name[i] == '|' || name[i] == '\\')
+ outc('\\', f);+ outc(name[i], f);
+ i++;
+ }
+ outc('|', f);+ }else{+ outc('|', f);+ outs(name, f);
+ outc('|', f);+ }
+ }else{+ outs(name, f);
+ }
}
/*
@@ -161,452 +167,461 @@
to print anyway.
*/
#define SMALL_STR_LEN 20
-static inline int tinyp(value_t v)
+static inline int
+tinyp(value_t v)
{- if (issymbol(v))
- return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN);
- if (fl_isstring(v))
- return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
- return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL ||
- v == FL_EOF || iscprim(v));
+ if(issymbol(v))
+ return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN);
+ if(fl_isstring(v))
+ return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
+ return (
+ isfixnum(v) || isbuiltin(v) || iscprim(v) ||
+ v == FL_F || v == FL_T ||
+ v == FL_NIL || v == FL_EOF
+ );
}
-static int smallp(value_t v)
+static int
+smallp(value_t v)
{- if (tinyp(v)) return 1;
- if (fl_isnumber(v)) return 1;
- if (iscons(v)) {- if (tinyp(car_(v)) && (tinyp(cdr_(v)) ||
- (iscons(cdr_(v)) && tinyp(car_(cdr_(v))) &&
- cdr_(cdr_(v))==NIL)))
- return 1;
- return 0;
- }
- if (isvector(v)) {- size_t s = vector_size(v);
- return (s == 0 || (tinyp(vector_elt(v,0)) &&
- (s == 1 || (s == 2 &&
- tinyp(vector_elt(v,1))))));
- }
- return 0;
+ if(tinyp(v))
+ return 1;
+ if(fl_isnumber(v))
+ return 1;
+ if(iscons(v)){+ if(tinyp(car_(v)) &&
+ (tinyp(cdr_(v)) || (iscons(cdr_(v)) && tinyp(car_(cdr_(v))) && cdr_(cdr_(v)) == NIL)))
+ return 1;
+ return 0;
+ }
+ if(isvector(v)){+ size_t s = vector_size(v);
+ return (s == 0 || (tinyp(vector_elt(v,0)) &&
+ (s == 1 || (s == 2 &&
+ tinyp(vector_elt(v,1))))));
+ }
+ return 0;
}
-static int specialindent(value_t head)
+static int
+specialindent(value_t head)
{- // indent these forms 2 spaces, not lined up with the first argument
- if (head == LAMBDA || head == TRYCATCH || head == definesym ||
- head == defmacrosym || head == forsym)
- return 2;
- return -1;
+ // indent these forms 2 spaces, not lined up with the first argument
+ if(head == LAMBDA || head == TRYCATCH || head == definesym ||
+ head == defmacrosym || head == forsym)
+ return 2;
+ return -1;
}
-static int lengthestimate(value_t v)
+static int
+lengthestimate(value_t v)
{- // get the width of an expression if we can do so cheaply
- if (issymbol(v))
- return u8_strwidth(symbol_name(v));
- if (iscprim(v) && ptr(v) != nil && cp_class((cprim_t*)ptr(v)) == wchartype)
- return 4;
- return -1;
+ // get the width of an expression if we can do so cheaply
+ if(issymbol(v))
+ return u8_strwidth(symbol_name(v));
+ if(iscprim(v) && ptr(v) != nil && cp_class((cprim_t*)ptr(v)) == wchartype)
+ return 4;
+ return -1;
}
-static int allsmallp(value_t v)
+static int
+allsmallp(value_t v)
{- int n = 1;
- while (iscons(v)) {- if (!smallp(car_(v)))
- return 0;
- v = cdr_(v);
- n++;
- if (n > 25)
- return n;
- }
- return n;
+ int n = 1;
+ while(iscons(v)){+ if(!smallp(car_(v)))
+ return 0;
+ v = cdr_(v);
+ n++;
+ if(n > 25)
+ return n;
+ }
+ return n;
}
-static int indentafter3(value_t head, value_t v)
+static int
+indentafter3(value_t head, value_t v)
{- // for certain X always indent (X a b c) after b
- return ((head == forsym) && !allsmallp(cdr_(v)));
+ // for certain X always indent (X a b c) after b
+ return ((head == forsym) && !allsmallp(cdr_(v)));
}
-static int indentafter2(value_t head, value_t v)
+static int
+indentafter2(value_t head, value_t v)
{- // for certain X always indent (X a b) after a
- return ((head == definesym || head == defmacrosym) &&
- !allsmallp(cdr_(v)));
+ // for certain X always indent (X a b) after a
+ return ((head == definesym || head == defmacrosym) &&
+ !allsmallp(cdr_(v)));
}
-static int indentevery(value_t v)
+static int
+indentevery(value_t v)
{- // indent before every subform of a special form, unless every
- // subform is "small"
- value_t c = car_(v);
- if (c == LAMBDA || c == setqsym)
- return 0;
- if (c == IF) // TODO: others
- return !allsmallp(cdr_(v));
- return 0;
+ // indent before every subform of a special form, unless every
+ // subform is "small"
+ value_t c = car_(v);
+ if(c == LAMBDA || c == setqsym)
+ return 0;
+ if(c == IF) // TODO: others
+ return !allsmallp(cdr_(v));
+ return 0;
}
-static int blockindent(value_t v)
+static int
+blockindent(value_t v)
{- // in this case we switch to block indent mode, where the head
- // is no longer considered special:
- // (a b c d e
- // f g h i j)
- return (allsmallp(v) > 9);
+ // in this case we switch to block indent mode, where the head
+ // is no longer considered special:
+ // (a b c d e
+ // f g h i j)
+ return (allsmallp(v) > 9);
}
-static void print_pair(ios_t *f, value_t v)
+static void
+print_pair(ios_t *f, value_t v)
{- value_t cd;
- char *op;
- if (iscons(cdr_(v)) && cdr_(cdr_(v)) == NIL &&
- !ptrhash_has(&printconses, (void*)cdr_(v)) &&
- (((car_(v) == QUOTE) && (op = "'")) ||
- ((car_(v) == BACKQUOTE) && (op = "`")) ||
- ((car_(v) == COMMA) && (op = ",")) ||
- ((car_(v) == COMMAAT) && (op = ",@")) ||
- ((car_(v) == COMMADOT) && (op = ",.")))) {- // special prefix syntax
- unmark_cons(v);
- unmark_cons(cdr_(v));
- outs(op, f);
- fl_print_child(f, car_(cdr_(v)));
- return;
- }
- int startpos = HPOS;
- outc('(', f);- int newindent=HPOS, blk=blockindent(v);
- int lastv, n=0, si, ind, est, always=0, nextsmall, thistiny;
- if (!blk) always = indentevery(v);
- value_t head = car_(v);
- int after3 = indentafter3(head, v);
- int after2 = indentafter2(head, v);
- int n_unindented = 1;
- while (1) {- cd = cdr_(v);
- if (print_length >= 0 && n >= print_length && cd!=NIL) {- outsn("...)", f, 4);- break;
- }
- lastv = VPOS;
- unmark_cons(v);
- fl_print_child(f, car_(v));
- if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) {- if (cd != NIL) {- outsn(" . ", f, 3);- fl_print_child(f, cd);
- }
- outc(')', f);- break;
- }
+ value_t cd;
+ char *op;
+ if(iscons(cdr_(v)) && cdr_(cdr_(v)) == NIL &&
+ !ptrhash_has(&printconses, (void*)cdr_(v)) &&
+ (((car_(v) == QUOTE) && (op = "'")) ||
+ ((car_(v) == BACKQUOTE) && (op = "`")) ||
+ ((car_(v) == COMMA) && (op = ",")) ||
+ ((car_(v) == COMMAAT) && (op = ",@")) ||
+ ((car_(v) == COMMADOT) && (op = ",.")))){+ // special prefix syntax
+ unmark_cons(v);
+ unmark_cons(cdr_(v));
+ outs(op, f);
+ fl_print_child(f, car_(cdr_(v)));
+ return;
+ }
+ int startpos = HPOS;
+ outc('(', f);+ int newindent = HPOS, blk = blockindent(v);
+ int lastv, n = 0, si, ind, est, always = 0, nextsmall, thistiny;
+ if(!blk)
+ always = indentevery(v);
+ value_t head = car_(v);
+ int after3 = indentafter3(head, v);
+ int after2 = indentafter2(head, v);
+ int n_unindented = 1;
+ while(1){+ cd = cdr_(v);
+ if(print_length >= 0 && n >= print_length && cd != NIL){+ outsn("...)", f, 4);+ break;
+ }
+ lastv = VPOS;
+ unmark_cons(v);
+ fl_print_child(f, car_(v));
+ if(!iscons(cd) || ptrhash_has(&printconses, (void*)cd)){+ if(cd != NIL){+ outsn(" . ", f, 3);+ fl_print_child(f, cd);
+ }
+ outc(')', f);+ break;
+ }
- if (!print_pretty ||
- ((head == LAMBDA) && n == 0)) {- // never break line before lambda-list
- ind = 0;
- }
- else {- est = lengthestimate(car_(cd));
- nextsmall = smallp(car_(cd));
- thistiny = tinyp(car_(v));
- ind = (((VPOS > lastv) ||
- (HPOS>SCR_WIDTH/2 && !nextsmall && !thistiny && n>0)) ||
-
- (HPOS > SCR_WIDTH-4) ||
-
- (est!=-1 && (HPOS+est > SCR_WIDTH-2)) ||
-
- ((head == LAMBDA) && !nextsmall) ||
-
- (n > 0 && always) ||
-
- (n == 2 && after3) ||
- (n == 1 && after2) ||
+ if(!print_pretty ||
+ ((head == LAMBDA) && n == 0)){+ // never break line before lambda-list
+ ind = 0;
+ }else{+ est = lengthestimate(car_(cd));
+ nextsmall = smallp(car_(cd));
+ thistiny = tinyp(car_(v));
+ ind = (((VPOS > lastv) ||
+ (HPOS>SCR_WIDTH/2 && !nextsmall && !thistiny && n>0)) ||
- (n_unindented >= 3 && !nextsmall) ||
-
- (n == 0 && !smallp(head)));
- }
+ (HPOS > SCR_WIDTH-4) ||
- if (ind) {- newindent = outindent(newindent, f);
- n_unindented = 1;
- }
- else {- n_unindented++;
- outc(' ', f);- if (n==0) {- // set indent level after printing head
- si = specialindent(head);
- if (si != -1)
- newindent = startpos + si;
- else if (!blk)
- newindent = HPOS;
- }
- }
- n++;
- v = cd;
- }
+ (est != -1 && (HPOS+est > SCR_WIDTH-2)) ||
+
+ ((head == LAMBDA) && !nextsmall) ||
+
+ (n > 0 && always) ||
+
+ (n == 2 && after3) ||
+ (n == 1 && after2) ||
+
+ (n_unindented >= 3 && !nextsmall) ||
+
+ (n == 0 && !smallp(head)));
+ }
+
+ if(ind){+ newindent = outindent(newindent, f);
+ n_unindented = 1;
+ }else{+ n_unindented++;
+ outc(' ', f);+ if(n == 0){+ // set indent level after printing head
+ si = specialindent(head);
+ if(si != -1)
+ newindent = startpos + si;
+ else if(!blk)
+ newindent = HPOS;
+ }
+ }
+ n++;
+ v = cd;
+ }
}
static void cvalue_print(ios_t *f, value_t v);
-static int print_circle_prefix(ios_t *f, value_t v)
+static int
+print_circle_prefix(ios_t *f, value_t v)
{- value_t label;
- if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
- (value_t)HT_NOTFOUND) {- if (!ismarked(v)) {- HPOS+=ios_printf(f, "#%"PRIdPTR"#", numval(label));
- return 1;
- }
- HPOS+=ios_printf(f, "#%"PRIdPTR"=", numval(label));
- }
- if (ismanaged(v))
- unmark_cons(v);
- return 0;
+ value_t label;
+ if((label = (value_t)ptrhash_get(&printconses, (void*)v)) != (value_t)HT_NOTFOUND){+ if(!ismarked(v)){+ HPOS += ios_printf(f, "#%"PRIdPTR"#", numval(label));
+ return 1;
+ }
+ HPOS += ios_printf(f, "#%"PRIdPTR"=", numval(label));
+ }
+ if(ismanaged(v))
+ unmark_cons(v);
+ return 0;
}
-void fl_print_child(ios_t *f, value_t v)
+void
+fl_print_child(ios_t *f, value_t v)
{- char *name;
- if (print_level >= 0 && P_LEVEL >= print_level &&
- (iscons(v) || isvector(v) || isclosure(v))) {- outc('#', f);- return;
- }
- P_LEVEL++;
+ char *name;
+ if(print_level >= 0 && P_LEVEL >= print_level && (iscons(v) || isvector(v) || isclosure(v))){+ outc('#', f);+ return;
+ }
+ P_LEVEL++;
- switch (tag(v)) {- case TAG_NUM :
- case TAG_NUM1: HPOS+=ios_printf(f, "%"PRId64, (int64_t)numval(v)); break;
- case TAG_SYM:
- name = symbol_name(v);
- if (print_princ)
- outs(name, f);
- else if (ismanaged(v)) {- outsn("#:", f, 2);- outs(name, f);
- }
- else
- print_symbol_name(f, name);
- break;
- case TAG_FUNCTION:
- if (v == FL_T) {- outsn("#t", f, 2);- }
- else if (v == FL_F) {- outsn("#f", f, 2);- }
- else if (v == FL_NIL) {- outsn("()", f, 2);- }
- else if (v == FL_EOF) {- outsn("#<eof>", f, 6);- }
- else if (isbuiltin(v)) {- if (!print_princ)
- outsn("#.", f, 2);- outs(builtins[uintval(v)].name, f);
- }
- else {- assert(isclosure(v));
- if (!print_princ) {- if (print_circle_prefix(f, v)) break;
- function_t *fn = (function_t*)ptr(v);
- outs("#fn(", f);- char *data = cvalue_data(fn->bcode);
- size_t i, sz = cvalue_len(fn->bcode);
- for(i=0; i < sz; i++) data[i] += 48;
- fl_print_child(f, fn->bcode);
- for(i=0; i < sz; i++) data[i] -= 48;
- outc(' ', f);- fl_print_child(f, fn->vals);
- if (fn->env != NIL) {- outc(' ', f);- fl_print_child(f, fn->env);
- }
- if (fn->name != LAMBDA) {- outc(' ', f);- fl_print_child(f, fn->name);
- }
- outc(')', f);- }
- else {- outs("#<function>", f);- }
- }
- break;
- case TAG_CPRIM:
- if (v == UNBOUND)
- outs("#<undefined>", f);- else
- cvalue_print(f, v);
- break;
- case TAG_CVALUE:
- case TAG_VECTOR:
- case TAG_CONS:
- if (!print_princ && print_circle_prefix(f, v)) break;
- if (isvector(v)) {- outs("#(", f);- int newindent = HPOS, est;
- int i, sz = vector_size(v);
- for(i=0; i < sz; i++) {- if (print_length >= 0 && i >= print_length && i < sz-1) {- outsn("...", f, 3);- break;
- }
- fl_print_child(f, vector_elt(v,i));
- if (i < sz-1) {- if (!print_pretty) {- outc(' ', f);- }
- else {- est = lengthestimate(vector_elt(v,i+1));
- if (HPOS > SCR_WIDTH-4 ||
- (est!=-1 && (HPOS+est > SCR_WIDTH-2)) ||
- (HPOS > SCR_WIDTH/2 &&
- !smallp(vector_elt(v,i+1)) &&
- !tinyp(vector_elt(v,i))))
- newindent = outindent(newindent, f);
- else
- outc(' ', f);- }
- }
- }
- outc(')', f);- break;
- }
- if (iscvalue(v))
- cvalue_print(f, v);
- else
- print_pair(f, v);
- break;
- }
- P_LEVEL--;
-}
+ switch (tag(v)){+ case TAG_NUM: case TAG_NUM1:
+ HPOS += ios_printf(f, "%"PRId64, (int64_t)numval(v));
+ break;
+ case TAG_SYM:
+ name = symbol_name(v);
+ if(print_princ)
+ outs(name, f);
+ else if(ismanaged(v)){+ outsn("#:", f, 2);+ outs(name, f);
+ }else
+ print_symbol_name(f, name);
+ break;
+ case TAG_FUNCTION:
+ if(v == FL_T)
+ outsn("#t", f, 2);+ else if(v == FL_F)
+ outsn("#f", f, 2);+ else if(v == FL_NIL)
+ outsn("()", f, 2);+ else if(v == FL_EOF)
+ outsn("#<eof>", f, 6);+ else if(isbuiltin(v)){+ if(!print_princ)
+ outsn("#.", f, 2);+ outs(builtins[uintval(v)].name, f);
+ }else{+ assert(isclosure(v));
+ if(!print_princ){+ if(print_circle_prefix(f, v))
+ break;
+ function_t *fn = ptr(v);
+ outs("#fn(", f);+ char *data = cvalue_data(fn->bcode);
+ size_t i, sz = cvalue_len(fn->bcode);
+ for(i = 0; i < sz; i++)
+ data[i] += 48;
+ fl_print_child(f, fn->bcode);
+ for(i = 0; i < sz; i++)
+ data[i] -= 48;
+ outc(' ', f);+ fl_print_child(f, fn->vals);
+ if(fn->env != NIL){+ outc(' ', f);+ fl_print_child(f, fn->env);
+ }
+ if(fn->name != LAMBDA){+ outc(' ', f);+ fl_print_child(f, fn->name);
+ }
+ outc(')', f);+ }else{+ outs("#<function>", f);+ }
+ }
+ break;
+ case TAG_CPRIM:
+ if(v == UNBOUND)
+ outs("#<undefined>", f);+ else
+ cvalue_print(f, v);
+ break;
+ case TAG_CVALUE:
+ case TAG_VECTOR:
+ case TAG_CONS:
+ if(!print_princ && print_circle_prefix(f, v))
+ break;
+ if(isvector(v)){+ outs("#(", f);+ int newindent = HPOS, est;
+ int i, sz = vector_size(v);
+ for(i = 0; i < sz; i++){+ if(print_length >= 0 && i >= print_length && i < sz-1){+ outsn("...", f, 3);+ break;
+ }
+ fl_print_child(f, vector_elt(v,i));
+ if(i < sz-1){+ if(!print_pretty)
+ outc(' ', f);+ else{+ est = lengthestimate(vector_elt(v,i+1));
+ if(HPOS > SCR_WIDTH-4 ||
+ (est != -1 && (HPOS+est > SCR_WIDTH-2)) ||
+ (HPOS > SCR_WIDTH/2 &&
+ !smallp(vector_elt(v,i+1)) &&
+ !tinyp(vector_elt(v,i))))
+ newindent = outindent(newindent, f);
+ else
+ outc(' ', f);+ }
+ }
+ }
+ outc(')', f);+ break;
+ }
+ if(iscvalue(v))
+ cvalue_print(f, v);
+ else
+ print_pair(f, v);
+ break;
+ }
+ P_LEVEL--;
+}
-static void print_string(ios_t *f, char *str, size_t sz)
+static void
+print_string(ios_t *f, char *str, size_t sz)
{- char buf[512];
- size_t i = 0;
- uint8_t c;
- static char hexdig[] = "0123456789abcdef";
+ char buf[512];
+ size_t i = 0;
+ uint8_t c;
+ static char hexdig[] = "0123456789abcdef";
- outc('"', f);- if (!u8_isvalid(str, sz)) {- // alternate print algorithm that preserves data if it's not UTF-8
- for(i=0; i < sz; i++) {- c = str[i];
- if (c == '\\')
- outsn("\\\\", f, 2);- else if (c == '"')
- outsn("\\\"", f, 2);- else if (c >= 32 && c < 0x7f)
- outc(c, f);
- else {- outsn("\\x", f, 2);- outc(hexdig[c>>4], f);
- outc(hexdig[c&0xf], f);
- }
- }
- }
- else {- while (i < sz) {- size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);
- outsn(buf, f, n-1);
- }
- }
- outc('"', f);+ outc('"', f);+ if(!u8_isvalid(str, sz)){+ // alternate print algorithm that preserves data if it's not UTF-8
+ for(i = 0; i < sz; i++){+ c = str[i];
+ if(c == '\\')
+ outsn("\\\\", f, 2);+ else if(c == '"')
+ outsn("\\\"", f, 2);+ else if(c >= 32 && c < 0x7f)
+ outc(c, f);
+ else{+ outsn("\\x", f, 2);+ outc(hexdig[c>>4], f);
+ outc(hexdig[c&0xf], f);
+ }
+ }
+ }else{+ while(i < sz){+ size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);
+ outsn(buf, f, n-1);
+ }
+ }
+ outc('"', f);}
-int double_exponent(double d)
+int
+double_exponent(double d)
{- union ieee754_double dl;
+ union ieee754_double dl;
- dl.d = d;
- return dl.ieee.exponent - IEEE754_DOUBLE_BIAS;
+ dl.d = d;
+ return dl.ieee.exponent - IEEE754_DOUBLE_BIAS;
}
-void snprint_real(char *s, size_t cnt, double r,
- int width, // printf field width, or 0
- int dec, // # decimal digits desired, recommend 16
- // # of zeros in .00...0x before using scientific notation
- // recommend 3-4 or so
- int max_digs_rt,
- // # of digits left of decimal before scientific notation
- // recommend 10
- int max_digs_lf)
+void
+snprint_real(char *s, size_t cnt, double r,
+ int width, // printf field width, or 0
+ int dec, // # decimal digits desired, recommend 16
+ // # of zeros in .00...0x before using scientific notation
+ // recommend 3-4 or so
+ int max_digs_rt,
+ // # of digits left of decimal before scientific notation
+ // recommend 10
+ int max_digs_lf)
{- int mag;
- double fpart, temp;
- char format[8];
- char num_format[3];
- int sz, keepz=0;
+ int mag;
+ double fpart, temp;
+ char format[8];
+ char num_format[3];
+ int sz, keepz = 0;
- s[0] = '\0';
- if (width == -1) {- width = 0;
- keepz=1;
- }
- if (isnan(r)) {- if (sign_bit(r))
- strncpy(s, "-nan", cnt);
- else
- strncpy(s, "nan", cnt);
- return;
- }
- if (r == 0) {- strncpy(s, "0", cnt);
- return;
- }
+ s[0] = '\0';
+ if(width == -1){+ width = 0;
+ keepz = 1;
+ }
+ if(isnan(r)){+ if(sign_bit(r))
+ strncpy(s, "-nan", cnt);
+ else
+ strncpy(s, "nan", cnt);
+ return;
+ }
+ if(r == 0){+ strncpy(s, "0", cnt);
+ return;
+ }
- num_format[0] = 'l';
- num_format[2] = '\0';
+ num_format[0] = 'l';
+ num_format[2] = '\0';
- mag = double_exponent(r);
+ mag = double_exponent(r);
- mag = (int)(((double)mag)/LOG2_10 + 0.5);
- if (r == 0)
- mag = 0;
- if ((mag > max_digs_lf-1) || (mag < -max_digs_rt)) {- num_format[1] = 'e';
- temp = r/pow(10, mag); /* see if number will have a decimal */
- fpart = temp - floor(temp); /* when written in scientific notation */
- }
- else {- num_format[1] = 'f';
- fpart = r - floor(r);
- }
- if (fpart == 0)
- dec = 0;
- if (width == 0) {- snprintf(format, 8, "%%.%d%s", dec, num_format);
- }
- else {- snprintf(format, 8, "%%%d.%d%s", width, dec, num_format);
- }
- sz = snprintf(s, cnt, format, r);
- /* trim trailing zeros from fractions. not when using scientific
- notation, since we might have e.g. 1.2000e+100. also not when we
- need a specific output width */
- if (width == 0 && !keepz) {- if (sz > 2 && fpart && num_format[1]!='e') {- while (s[sz-1] == '0') {- s[sz-1]='\0';
- sz--;
- }
- // don't need trailing .
- if (s[sz-1] == '.') {- s[--sz] = '\0';
- }
- }
- }
- // TODO. currently 1.1e20 prints as 1.1000000000000000e+20; be able to
- // get rid of all those zeros.
+ mag = (int)(((double)mag)/LOG2_10 + 0.5);
+ if(r == 0)
+ mag = 0;
+ if((mag > max_digs_lf-1) || (mag < -max_digs_rt)){+ num_format[1] = 'e';
+ temp = r/pow(10, mag); /* see if number will have a decimal */
+ fpart = temp - floor(temp); /* when written in scientific notation */
+ }else{+ num_format[1] = 'f';
+ fpart = r - floor(r);
+ }
+ if(fpart == 0)
+ dec = 0;
+ if(width == 0)
+ snprintf(format, 8, "%%.%d%s", dec, num_format);
+ else
+ snprintf(format, 8, "%%%d.%d%s", width, dec, num_format);
+ sz = snprintf(s, cnt, format, r);
+ /* trim trailing zeros from fractions. not when using scientific
+ notation, since we might have e.g. 1.2000e+100. also not when we
+ need a specific output width */
+ if(width == 0 && !keepz){+ if(sz > 2 && fpart && num_format[1] != 'e'){+ while(s[sz-1] == '0'){+ s[sz-1] = '\0';
+ sz--;
+ }
+ // don't need trailing .
+ if(s[sz-1] == '.'){+ s[--sz] = '\0';
+ }
+ }
+ }
+ // TODO. currently 1.1e20 prints as 1.1000000000000000e+20; be able to
+ // get rid of all those zeros.
}
// 'weak' means we don't need to accurately reproduce the type, so
@@ -613,264 +628,253 @@
// for example #int32(0) can be printed as just 0. this is used
// printing in a context where a type is already implied, e.g. inside
// an array.
-static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
- int weak)
+static void
+cvalue_printdata(ios_t *f, void *data, size_t len, value_t type, int weak)
{- if (type == bytesym) {- uint8_t ch = *(uint8_t*)data;
- if (print_princ)
- outc(ch, f);
- else if (weak)
- HPOS+=ios_printf(f, "0x%hhx", ch);
- else
- HPOS+=ios_printf(f, "#byte(0x%hhx)", ch);
- }
- else if (type == wcharsym) {- uint32_t wc = *(uint32_t*)data;
- char seq[8];
- size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
- seq[nb] = '\0';
- if (print_princ) {- // TODO: better multibyte handling
- if (wc == 0)
- ios_putc(0, f);
- else
- outs(seq, f);
- }
- else {- outsn("#\\", f, 2);- if (wc == 0x00) outsn("nul", f, 3);- else if (wc == 0x07) outsn("alarm", f, 5);- else if (wc == 0x08) outsn("backspace", f, 9);- else if (wc == 0x09) outsn("tab", f, 3);- else if (wc == 'l') outsn("linefeed", f, 8);- else if (wc == 0x0A) outsn("newline", f, 7);- else if (wc == 0x0B) outsn("vtab", f, 4);- else if (wc == 0x0C) outsn("page", f, 4);- else if (wc == 0x0D) outsn("return", f, 6);- else if (wc == 0x1B) outsn("esc", f, 3);- else if (wc == 's') outsn("space", f, 5);- else if (wc == 0x7F) outsn("delete", f, 6);- else if (u8_iswprint(wc)) outs(seq, f);
- else HPOS+=ios_printf(f, "x%04x", (int)wc);
- }
- }
- else if (type == floatsym || type == doublesym) {- char buf[64];
- double d;
- int ndec;
- if (type == floatsym) { d = (double)*(float*)data; ndec = 8; }- else { d = *(double*)data; ndec = 16; }- if (!DFINITE(d)) {- char *rep;
- if (isnan(d))
- rep = sign_bit(d) ? "-nan.0" : "+nan.0";
- else
- rep = sign_bit(d) ? "-inf.0" : "+inf.0";
- if (type == floatsym && !print_princ && !weak)
- HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep);
- else
- outs(rep, f);
- }
- else if (d == 0) {- if (1/d < 0)
- outsn("-0.0", f, 4);- else
- outsn("0.0", f, 3);- if (type == floatsym && !print_princ && !weak)
- outc('f', f);- }
- else {- snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
- int hasdec = (strpbrk(buf, ".eE") != nil);
- outs(buf, f);
- if (!hasdec) outsn(".0", f, 2);- if (type == floatsym && !print_princ && !weak)
- outc('f', f);- }
- }
- else if (type == uint64sym
+ if(type == bytesym){+ uint8_t ch = *(uint8_t*)data;
+ if(print_princ)
+ outc(ch, f);
+ else if(weak)
+ HPOS += ios_printf(f, "0x%hhx", ch);
+ else
+ HPOS += ios_printf(f, "#byte(0x%hhx)", ch);
+ }else if(type == wcharsym){+ uint32_t wc = *(uint32_t*)data;
+ char seq[8];
+ size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
+ seq[nb] = '\0';
+ if(print_princ){+ // TODO: better multibyte handling
+ if(wc == 0)
+ ios_putc(0, f);
+ else
+ outs(seq, f);
+ }else{+ outsn("#\\", f, 2);+ switch(wc){+ case 0x00: outsn("nul", f, 3); break;+ case 0x07: outsn("alarm", f, 5); break;+ case 0x08: outsn("backspace", f, 9); break;+ case 0x09: outsn("tab", f, 3); break;+ case 'l': outsn("linefeed", f, 8); break;+ case 0x0a: outsn("newline", f, 7); break;+ case 0x0B: outsn("vtab", f, 4); break;+ case 0x0C: outsn("page", f, 4); break;+ case 0x0D: outsn("return", f, 6); break;+ case 0x1B: outsn("esc", f, 3); break;+ case 's': outsn("space", f, 5); break;+ case 0x7F: outsn("delete", f, 6); break;+ default:
+ if(u8_iswprint(wc))
+ outs(seq, f);
+ else
+ HPOS += ios_printf(f, "x%04x", (int)wc);
+ break;
+ }
+ }
+ }else if(type == floatsym || type == doublesym){+ char buf[64];
+ double d;
+ int ndec;
+ if(type == floatsym){+ d = (double)*(float*)data;
+ ndec = 8;
+ }else{+ d = *(double*)data;
+ ndec = 16;
+ }
+ if(!DFINITE(d)){+ char *rep;
+ if(isnan(d))
+ rep = sign_bit(d) ? "-nan.0" : "+nan.0";
+ else
+ rep = sign_bit(d) ? "-inf.0" : "+inf.0";
+ if(type == floatsym && !print_princ && !weak)
+ HPOS += ios_printf(f, "#%s(%s)", symbol_name(type), rep);
+ else
+ outs(rep, f);
+ }else if(d == 0){+ if(1/d < 0)
+ outsn("-0.0", f, 4);+ else
+ outsn("0.0", f, 3);+ if(type == floatsym && !print_princ && !weak)
+ outc('f', f);+ }else{+ snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
+ int hasdec = (strpbrk(buf, ".eE") != nil);
+ outs(buf, f);
+ if(!hasdec)
+ outsn(".0", f, 2);+ if(type == floatsym && !print_princ && !weak)
+ outc('f', f);+ }
#if defined(ULONG64)
- || type == ulongsym
+ }else if(type == uint64sym || type == ulongsym){+#else
+ }else if(type == uint64sym){#endif
- ) {- uint64_t ui64 = *(uint64_t*)data;
- if (weak || print_princ)
- HPOS += ios_printf(f, "%"PRIu64, ui64);
- else
- HPOS += ios_printf(f, "#%s(%"PRIu64")", symbol_name(type), ui64);
- }
- else if (type == mpintsym) {- mpint *i = *(mpint**)data;
- char *s = mptoa(i, 10, nil, 0);
- if (weak || print_princ)
- HPOS += ios_printf(f, "%s", s);
- else
- HPOS += ios_printf(f, "#%s(%s)", symbol_name(type), s);
- free(s);
- }
- else if (issymbol(type)) {- // handle other integer prims. we know it's smaller than uint64
- // at this point, so int64 is big enough to capture everything.
- numerictype_t nt = sym_to_numtype(type);
- if (valid_numtype(nt)) {- int64_t i64 = conv_to_int64(data, nt);
- if (weak || print_princ)
- HPOS += ios_printf(f, "%"PRId64, i64);
- else
- HPOS += ios_printf(f, "#%s(%"PRId64")", symbol_name(type), i64);
- }
- else {- HPOS += ios_printf(f, "#<%s>", symbol_name(type));
- }
- }
- else if (iscons(type)) {- if (car_(type) == arraysym) {- value_t eltype = car(cdr_(type));
- size_t cnt, elsize;
- if (iscons(cdr_(cdr_(type)))) {- cnt = toulong(car_(cdr_(cdr_(type))));
- elsize = cnt ? len/cnt : 0;
- }
- else {- // incomplete array type
- int junk;
- elsize = ctype_sizeof(eltype, &junk);
- cnt = elsize ? len/elsize : 0;
- }
- if (eltype == bytesym) {- if (print_princ) {- ios_write(f, data, len);
- /*
- char *nl = llt_memrchr(data, '\n', len);
- if (nl)
- HPOS = u8_strwidth(nl+1);
- else
- HPOS += u8_strwidth(data);
- */
- }
- else {- print_string(f, (char*)data, len);
- }
- return;
- }
- else if (eltype == wcharsym) {- // TODO wchar
- }
- else {- }
- size_t i;
- if (!weak) {- if (eltype == uint8sym) {- outsn("#vu8(", f, 5);- }
- else {- outsn("#array(", f, 7);- fl_print_child(f, eltype);
- if (cnt > 0)
- outc(' ', f);- }
- }
- else {- outs("#(", f);- }
- for(i=0; i < cnt; i++) {- if (i > 0)
- outc(' ', f);- cvalue_printdata(f, data, elsize, eltype, 1);
- data = (char*)data + elsize;
- }
- outc(')', f);- }
- else if (car_(type) == enumsym) {- int n = *(int*)data;
- value_t syms = car(cdr_(type));
- assert(isvector(syms));
- if (!weak) {- outsn("#enum(", f, 6);- fl_print_child(f, syms);
- outc(' ', f);- }
- if (n >= (int)vector_size(syms)) {- cvalue_printdata(f, data, len, int32sym, 1);
- }
- else {- fl_print_child(f, vector_elt(syms, n));
- }
- if (!weak)
- outc(')', f);- }
- }
-}
+ uint64_t ui64 = *(uint64_t*)data;
+ if(weak || print_princ)
+ HPOS += ios_printf(f, "%"PRIu64, ui64);
+ else
+ HPOS += ios_printf(f, "#%s(%"PRIu64")", symbol_name(type), ui64);
+ }else if(type == mpintsym){+ mpint *i = *(mpint**)data;
+ char *s = mptoa(i, 10, nil, 0);
+ if(weak || print_princ)
+ HPOS += ios_printf(f, "%s", s);
+ else
+ HPOS += ios_printf(f, "#%s(%s)", symbol_name(type), s);
+ free(s);
+ }else if(issymbol(type)){+ // handle other integer prims. we know it's smaller than uint64
+ // at this point, so int64 is big enough to capture everything.
+ numerictype_t nt = sym_to_numtype(type);
+ if(valid_numtype(nt)){+ int64_t i64 = conv_to_int64(data, nt);
+ if(weak || print_princ)
+ HPOS += ios_printf(f, "%"PRId64, i64);
+ else
+ HPOS += ios_printf(f, "#%s(%"PRId64")", symbol_name(type), i64);
+ }else{+ HPOS += ios_printf(f, "#<%s>", symbol_name(type));
+ }
+ }else if(iscons(type)){+ if(car_(type) == arraysym){+ value_t eltype = car(cdr_(type));
+ size_t cnt, elsize;
+ if(iscons(cdr_(cdr_(type)))){+ cnt = toulong(car_(cdr_(cdr_(type))));
+ elsize = cnt ? len/cnt : 0;
+ }else{+ // incomplete array type
+ int junk;
+ elsize = ctype_sizeof(eltype, &junk);
+ cnt = elsize ? len/elsize : 0;
+ }
+ if(eltype == bytesym){+ if(print_princ){+ ios_write(f, data, len);
+ /*
+ char *nl = llt_memrchr(data, '\n', len);
+ if(nl)
+ HPOS = u8_strwidth(nl+1);
+ else
+ HPOS += u8_strwidth(data);
+ */
+ }else{+ print_string(f, (char*)data, len);
+ }
+ return;
+ }else if(eltype == wcharsym){+ // TODO wchar
+ }else{+ }
+ size_t i;
+ if(!weak){+ if(eltype == uint8sym){+ outsn("#vu8(", f, 5);+ }else{+ outsn("#array(", f, 7);+ fl_print_child(f, eltype);
+ if(cnt > 0)
+ outc(' ', f);+ }
+ }else{+ outs("#(", f);+ }
+ for(i = 0; i < cnt; i++){+ if(i > 0)
+ outc(' ', f);+ cvalue_printdata(f, data, elsize, eltype, 1);
+ data = (char*)data + elsize;
+ }
+ outc(')', f);+ }else if(car_(type) == enumsym){+ int n = *(int*)data;
+ value_t syms = car(cdr_(type));
+ assert(isvector(syms));
+ if(!weak){+ outsn("#enum(", f, 6);+ fl_print_child(f, syms);
+ outc(' ', f);+ }
+ if(n >= (int)vector_size(syms)){+ cvalue_printdata(f, data, len, int32sym, 1);
+ }else{+ fl_print_child(f, vector_elt(syms, n));
+ }
+ if(!weak)
+ outc(')', f);+ }
+ }
+}
-static void cvalue_print(ios_t *f, value_t v)
+static void
+cvalue_print(ios_t *f, value_t v)
{- cvalue_t *cv = (cvalue_t*)ptr(v);
- void *data = cptr(v);
- value_t label;
+ cvalue_t *cv = (cvalue_t*)ptr(v);
+ void *data = cptr(v);
+ value_t label;
- if (cv_class(cv) == builtintype) {- void *fptr = *(void**)data;
- label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
- if (label == (value_t)HT_NOTFOUND) {- HPOS += ios_printf(f, "#<builtin @%p>", fptr);
- }
- else {- if (print_princ) {- outs(symbol_name(label), f);
- }
- else {- outsn("#fn(", f, 4);- outs(symbol_name(label), f);
- outc(')', f);- }
- }
- }
- else if (cv_class(cv)->vtable != nil &&
- cv_class(cv)->vtable->print != nil) {- cv_class(cv)->vtable->print(v, f);
- }
- else {- value_t type = cv_type(cv);
- size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
- cvalue_printdata(f, data, len, type, 0);
- }
+ if(cv_class(cv) == builtintype){+ void *fptr = *(void**)data;
+ label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv);
+ if(label == (value_t)HT_NOTFOUND){+ HPOS += ios_printf(f, "#<builtin @%p>", fptr);
+ }else{+ if(print_princ){+ outs(symbol_name(label), f);
+ }else{+ outsn("#fn(", f, 4);+ outs(symbol_name(label), f);
+ outc(')', f);+ }
+ }
+ }else if(cv_class(cv)->vtable != nil && cv_class(cv)->vtable->print != nil){+ cv_class(cv)->vtable->print(v, f);
+ }else{+ value_t type = cv_type(cv);
+ size_t len = iscprim(v) ? cv_class(cv)->size : cv_len(cv);
+ cvalue_printdata(f, data, len, type, 0);
+ }
}
-static void set_print_width(void)
+static void
+set_print_width(void)
{- value_t pw = symbol_value(printwidthsym);
- if (!isfixnum(pw)) return;
- SCR_WIDTH = numval(pw);
+ value_t pw = symbol_value(printwidthsym);
+ if(!isfixnum(pw))
+ return;
+ SCR_WIDTH = numval(pw);
}
-void fl_print(ios_t *f, value_t v)
+void
+fl_print(ios_t *f, value_t v)
{- print_pretty = (symbol_value(printprettysym) != FL_F);
- if (print_pretty)
- set_print_width();
- print_princ = (symbol_value(printreadablysym) == FL_F);
+ print_pretty = symbol_value(printprettysym) != FL_F;
+ if(print_pretty)
+ set_print_width();
+ print_princ = symbol_value(printreadablysym) == FL_F;
+ value_t pl = symbol_value(printlengthsym);
+ print_length = isfixnum(pl) ? numval(pl) : -1;
+ pl = symbol_value(printlevelsym);
+ print_level = isfixnum(pl) ? numval(pl) : -1;
+ P_LEVEL = 0;
- value_t pl = symbol_value(printlengthsym);
- if (isfixnum(pl)) print_length = numval(pl);
- else print_length = -1;
- pl = symbol_value(printlevelsym);
- if (isfixnum(pl)) print_level = numval(pl);
- else print_level = -1;
- P_LEVEL = 0;
+ printlabel = 0;
+ if(!print_princ)
+ print_traverse(v);
+ HPOS = VPOS = 0;
- printlabel = 0;
- if (!print_princ) print_traverse(v);
- HPOS = VPOS = 0;
+ fl_print_child(f, v);
- fl_print_child(f, v);
+ if(print_level >= 0 || print_length >= 0)
+ memset(consflags, 0, 4*bitvector_nwords(heapsize/sizeof(cons_t)));
- if (print_level >= 0 || print_length >= 0) {- memset(consflags, 0, 4*bitvector_nwords(heapsize/sizeof(cons_t)));
- }
-
- if ((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) &&
- !fl_isstring(v) && v!=FL_T && v!=FL_F && v!=FL_NIL) {- htable_reset(&printconses, 32);
- }
+ if((iscons(v) || isvector(v) || isfunction(v) || iscvalue(v)) &&
+ !fl_isstring(v) && v != FL_T && v != FL_F && v != FL_NIL)
+ htable_reset(&printconses, 32);
}
--- a/read.c
+++ b/read.c
@@ -1,8 +1,8 @@
enum {- TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
- TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
- TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN,
- TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE
+ TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
+ TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
+ TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN,
+ TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE
};
#if defined(__plan9__)
@@ -13,141 +13,153 @@
static mpint *mp_vlong_min, *mp_vlong_max, *mp_uvlong_max;
#endif
-static int64_t strtoll_mp(char *nptr, char **rptr, int base, mpint **mp)
+static int64_t
+strtoll_mp(char *nptr, char **rptr, int base, mpint **mp)
{- int64_t x;
- mpint *m;
+ int64_t x;
+ mpint *m;
- *mp = nil;
- errno = 0;
- x = strtoll(nptr, rptr, base);
+ *mp = nil;
+ errno = 0;
+ x = strtoll(nptr, rptr, base);
#if defined(__plan9__)
- if((x != VLONG_MAX && x != VLONG_MIN) || *rptr == nptr)
- return x;
- mpint *c;
- m = strtomp(nptr, rptr, base, nil);
- if(x == VLONG_MAX){- if(mp_vlong_max == nil) mp_vlong_max = vtomp(VLONG_MAX, nil);
- c = mp_vlong_max;
- }else{- if(mp_vlong_min == nil) mp_vlong_min = vtomp(VLONG_MIN, nil);
- c = mp_vlong_min;
- }
- if (mpcmp(c, m) == 0) {- mpfree(m);
- m = nil;
- }
+ if((x != VLONG_MAX && x != VLONG_MIN) || *rptr == nptr)
+ return x;
+ mpint *c;
+ m = strtomp(nptr, rptr, base, nil);
+ if(x == VLONG_MAX){+ if(mp_vlong_max == nil)
+ mp_vlong_max = vtomp(VLONG_MAX, nil);
+ c = mp_vlong_max;
+ }else{+ if(mp_vlong_min == nil)
+ mp_vlong_min = vtomp(VLONG_MIN, nil);
+ c = mp_vlong_min;
+ }
+ if(mpcmp(c, m) == 0){+ mpfree(m);
+ m = nil;
+ }
#else
- m = nil;
- if (errno == ERANGE && (x == LLONG_MAX || x == LLONG_MIN))
- m = strtomp(nptr, rptr, base, nil);
+ m = nil;
+ if(errno == ERANGE && (x == LLONG_MAX || x == LLONG_MIN))
+ m = strtomp(nptr, rptr, base, nil);
#endif
- *mp = m;
- return x;
+ *mp = m;
+ return x;
}
-static uint64_t strtoull_mp(char *nptr, char **rptr, int base, mpint **mp)
+static uint64_t
+strtoull_mp(char *nptr, char **rptr, int base, mpint **mp)
{- uint64_t x;
- mpint *m;
+ uint64_t x;
+ mpint *m;
- *mp = nil;
- errno = 0;
- x = strtoull(nptr, rptr, base);
+ *mp = nil;
+ errno = 0;
+ x = strtoull(nptr, rptr, base);
#if defined(__plan9__)
- if(x != UVLONG_MAX || *rptr == nptr)
- return x;
- m = strtomp(nptr, rptr, base, nil);
- if(mp_uvlong_max == nil)
- mp_uvlong_max = uvtomp(UVLONG_MAX, nil);
- if(mpcmp(mp_uvlong_max, m) == 0){- mpfree(m);
- m = nil;
- }
+ if(x != UVLONG_MAX || *rptr == nptr)
+ return x;
+ m = strtomp(nptr, rptr, base, nil);
+ if(mp_uvlong_max == nil)
+ mp_uvlong_max = uvtomp(UVLONG_MAX, nil);
+ if(mpcmp(mp_uvlong_max, m) == 0){+ mpfree(m);
+ m = nil;
+ }
#else
- m = nil;
- if (errno == ERANGE && x == ULLONG_MAX)
- m = strtomp(nptr, rptr, base, nil);
+ m = nil;
+ if(errno == ERANGE && x == ULLONG_MAX)
+ m = strtomp(nptr, rptr, base, nil);
#endif
- *mp = m;
- return x;
+ *mp = m;
+ return x;
}
-#define F value2c(ios_t*,readstate->source)
+#define F value2c(ios_t*, readstate->source)
// defines which characters are ordinary symbol characters.
// exceptions are '.', which is an ordinary symbol character
// unless it's the only character in the symbol, and '#', which is
// an ordinary symbol character unless it's the first character.
-static inline int symchar(char c)
+static inline int
+symchar(char c)
{- static char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
- return !strchr(special, c);
+ static char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
+ return !strchr(special, c);
}
-int isnumtok_base(char *tok, value_t *pval, int base)
+int
+isnumtok_base(char *tok, value_t *pval, int base)
{- char *end;
- int64_t i64;
- uint64_t ui64;
- double d;
- mpint *mp = nil;
- if (*tok == '\0')
- return 0;
- if (!((tok[0]=='0' && tok[1]=='x') || (base >= 15)) &&
- strpbrk(tok, ".eEpP")) {- d = strtod(tok, &end);
- if (*end == '\0') {- if (pval) *pval = mk_double(d);
- return 1;
- }
- // floats can end in f or f0
- if (end > tok && end[0] == 'f' &&
- (end[1] == '\0' ||
- (end[1] == '0' && end[2] == '\0'))) {- if (pval) *pval = mk_float((float)d);
- return 1;
- }
- }
+ char *end;
+ int64_t i64;
+ uint64_t ui64;
+ double d;
+ mpint *mp = nil;
+ if(*tok == '\0')
+ return 0;
+ if(!((tok[0] == '0' && tok[1] == 'x') || (base >= 15)) && strpbrk(tok, ".eEpP")){+ d = strtod(tok, &end);
+ if(*end == '\0'){+ if(pval)
+ *pval = mk_double(d);
+ return 1;
+ }
+ // floats can end in f or f0
+ if(end > tok && end[0] == 'f' &&
+ (end[1] == '\0' ||
+ (end[1] == '0' && end[2] == '\0'))){+ if(pval)
+ *pval = mk_float((float)d);
+ return 1;
+ }
+ }
- if (tok[0] == '+') {- if (!strcmp(tok,"+NaN") || !strcasecmp(tok,"+nan.0")) {- if (pval) *pval = mk_double(D_PNAN);
- return 1;
- }
- if (!strcmp(tok,"+Inf") || !strcasecmp(tok,"+inf.0")) {- if (pval) *pval = mk_double(D_PINF);
- return 1;
- }
- }
- else if (tok[0] == '-') {- if (!strcmp(tok,"-NaN") || !strcasecmp(tok,"-nan.0")) {- if (pval) *pval = mk_double(D_NNAN);
- return 1;
- }
- if (!strcmp(tok,"-Inf") || !strcasecmp(tok,"-inf.0")) {- if (pval) *pval = mk_double(D_NINF);
- return 1;
- }
- i64 = strtoll_mp(tok, &end, base, &mp);
- if (pval)
- *pval = mp == nil ? return_from_int64(i64) : mk_mpint(mp);
- return (*end == '\0');
- }
- ui64 = strtoull_mp(tok, &end, base, &mp);
- if (pval)
- *pval = mp == nil ? return_from_uint64(ui64) : mk_mpint(mp);
- return (*end == '\0');
+ if(tok[0] == '+'){+ if(!strcmp(tok,"+NaN") || !strcasecmp(tok,"+nan.0")){+ if(pval)
+ *pval = mk_double(D_PNAN);
+ return 1;
+ }
+ if(!strcmp(tok,"+Inf") || !strcasecmp(tok,"+inf.0")){+ if(pval)
+ *pval = mk_double(D_PINF);
+ return 1;
+ }
+ }else if(tok[0] == '-'){+ if(!strcmp(tok,"-NaN") || !strcasecmp(tok,"-nan.0")){+ if(pval)
+ *pval = mk_double(D_NNAN);
+ return 1;
+ }
+ if(!strcmp(tok,"-Inf") || !strcasecmp(tok,"-inf.0")){+ if(pval)
+ *pval = mk_double(D_NINF);
+ return 1;
+ }
+ i64 = strtoll_mp(tok, &end, base, &mp);
+ if(pval)
+ *pval = mp == nil ? return_from_int64(i64) : mk_mpint(mp);
+ return *end == '\0';
+ }
+ ui64 = strtoull_mp(tok, &end, base, &mp);
+ if(pval)
+ *pval = mp == nil ? return_from_uint64(ui64) : mk_mpint(mp);
+ return *end == '\0';
}
-static int isnumtok(char *tok, value_t *pval)
+static int
+isnumtok(char *tok, value_t *pval)
{- return isnumtok_base(tok, pval, 0);
+ return isnumtok_base(tok, pval, 0);
}
-static int read_numtok(char *tok, value_t *pval, int base)
+static int
+read_numtok(char *tok, value_t *pval, int base)
{- return isnumtok_base(tok, pval, base);
+ return isnumtok_base(tok, pval, base);
}
static uint32_t toktype = TOK_NONE;
@@ -154,611 +166,582 @@
static value_t tokval;
static char buf[256];
-static char nextchar(void)
+static char
+nextchar(void)
{- int ch;
- char c;
- ios_t *f = F;
+ int ch;
+ char c;
+ ios_t *f = F;
- do {- if (f->bpos < f->size) {- ch = f->buf[f->bpos++];
- }
- else {- ch = ios_getc(f);
- if (ch == IOS_EOF)
- return 0;
- }
- c = (char)ch;
- if (c == ';') {- // single-line comment
- do {- ch = ios_getc(f);
- if (ch == IOS_EOF)
- return 0;
- } while ((char)ch != '\n');
- c = (char)ch;
- }
- } while (c==' ' || isspace(c));
- return c;
+ do{+ if(f->bpos < f->size){+ ch = f->buf[f->bpos++];
+ }else{+ ch = ios_getc(f);
+ if(ch == IOS_EOF)
+ return 0;
+ }
+ c = (char)ch;
+ if(c == ';'){+ // single-line comment
+ do{+ ch = ios_getc(f);
+ if(ch == IOS_EOF)
+ return 0;
+ }while((char)ch != '\n');
+ c = (char)ch;
+ }
+ }while(c == ' ' || isspace(c));
+ return c;
}
-static void take(void)
+static void
+take(void)
{- toktype = TOK_NONE;
+ toktype = TOK_NONE;
}
-static void accumchar(char c, int *pi)
+static void
+accumchar(char c, int *pi)
{- buf[(*pi)++] = c;
- if (*pi >= (int)(sizeof(buf)-1))
- lerrorf(ParseError, "token too long");
+ buf[(*pi)++] = c;
+ if(*pi >= (int)(sizeof(buf)-1))
+ lerrorf(ParseError, "token too long");
}
// return: 1 if escaped (forced to be symbol)
-static int read_token(char c, int digits)
+static int
+read_token(char c, int digits)
{- int i=0, ch, escaped=0, issym=0, nc=0;
+ int i = 0, ch, escaped = 0, issym = 0, nc = 0;
- while (1) {- if (nc != 0) {- if (nc != 1)
- ios_getc(F);
- ch = ios_peekc(F);
- if (ch == IOS_EOF)
- goto terminate;
- c = (char)ch;
- }
- if (c == '|') {- issym = 1;
- escaped = !escaped;
- }
- else if (c == '\\') {- issym = 1;
- ios_getc(F);
- ch = ios_peekc(F);
- if (ch == IOS_EOF)
- goto terminate;
- accumchar((char)ch, &i);
- }
- else if (!escaped && !(symchar(c) && (!digits || isdigit(c)))) {- break;
- }
- else {- accumchar(c, &i);
- }
- nc++;
- }
- if (nc == 0)
- ios_skip(F, -1);
+ while(1){+ if(nc != 0){+ if(nc != 1)
+ ios_getc(F);
+ ch = ios_peekc(F);
+ if(ch == IOS_EOF)
+ goto terminate;
+ c = (char)ch;
+ }
+ if(c == '|'){+ issym = 1;
+ escaped = !escaped;
+ }else if(c == '\\'){+ issym = 1;
+ ios_getc(F);
+ ch = ios_peekc(F);
+ if(ch == IOS_EOF)
+ goto terminate;
+ accumchar((char)ch, &i);
+ }else if(!escaped && !(symchar(c) && (!digits || isdigit(c)))){+ break;
+ }else{+ accumchar(c, &i);
+ }
+ nc++;
+ }
+ if(nc == 0)
+ ios_skip(F, -1);
terminate:
- buf[i++] = '\0';
- return issym;
+ buf[i++] = '\0';
+ return issym;
}
static value_t do_read_sexpr(value_t label);
-static uint32_t peek(void)
+static uint32_t
+peek(void)
{- char c, *end;
- fixnum_t x;
- int ch, base;
+ char c, *end;
+ fixnum_t x;
+ int ch, base;
- if (toktype != TOK_NONE)
- return toktype;
- c = nextchar();
- if (ios_eof(F)) return TOK_NONE;
- if (c == '(') {- toktype = TOK_OPEN;
- }
- else if (c == ')') {- toktype = TOK_CLOSE;
- }
- else if (c == '[') {- toktype = TOK_OPENB;
- }
- else if (c == ']') {- toktype = TOK_CLOSEB;
- }
- else if (c == '\'') {- toktype = TOK_QUOTE;
- }
- else if (c == '`') {- toktype = TOK_BQ;
- }
- else if (c == '"') {- toktype = TOK_DOUBLEQUOTE;
- }
- else if (c == '#') {- ch = ios_getc(F); c = (char)ch;
- if (ch == IOS_EOF)
- lerrorf(ParseError, "invalid read macro");
- if (c == '.') {- toktype = TOK_SHARPDOT;
- }
- else if (c == '\'') {- toktype = TOK_SHARPQUOTE;
- }
- else if (c == '\\') {- uint32_t cval;
- if (ios_getutf8(F, &cval) == IOS_EOF)
- lerrorf(ParseError, "end of input in character constant");
- if (cval == (uint32_t)'u' || cval == (uint32_t)'U' ||
- cval == (uint32_t)'x') {- read_token('u', 0);- if (buf[1] != '\0') { // not a solitary 'u','U','x'- if (!read_numtok(&buf[1], &tokval, 16))
- lerrorf(ParseError,
- "read: invalid hex character constant");
- cval = numval(tokval);
- }
- }
- else if (cval >= 'a' && cval <= 'z') {- read_token((char)cval, 0);
- tokval = symbol(buf);
- if (buf[1] == '\0') { USED(cval); } /* one character */- else if (tokval == nulsym) cval = 0x00;
- else if (tokval == alarmsym) cval = 0x07;
- else if (tokval == backspacesym) cval = 0x08;
- else if (tokval == tabsym) cval = 0x09;
- else if (tokval == linefeedsym) cval = 0x0A;
- else if (tokval == newlinesym) cval = 0x0A;
- else if (tokval == vtabsym) cval = 0x0B;
- else if (tokval == pagesym) cval = 0x0C;
- else if (tokval == returnsym) cval = 0x0D;
- else if (tokval == escsym) cval = 0x1B;
- else if (tokval == spacesym) cval = 0x20;
- else if (tokval == deletesym) cval = 0x7F;
- else
- lerrorf(ParseError, "unknown character #\\%s", buf);
- }
- toktype = TOK_NUM;
- tokval = mk_wchar(cval);
- }
- else if (c == '(') {- toktype = TOK_SHARPOPEN;
- }
- else if (c == '<') {- lerrorf(ParseError, "unreadable object");
- }
- else if (isdigit(c)) {- read_token(c, 1);
- c = (char)ios_getc(F);
- if (c == '#')
- toktype = TOK_BACKREF;
- else if (c == '=')
- toktype = TOK_LABEL;
- else
- lerrorf(ParseError, "invalid label");
- x = strtoll(buf, &end, 10);
- if (*end != '\0')
- lerrorf(ParseError, "invalid label");
- tokval = fixnum(x);
- }
- else if (c == '!') {- // #! single line comment for shbang script support
- do {- ch = ios_getc(F);
- } while (ch != IOS_EOF && (char)ch != '\n');
- return peek();
- }
- else if (c == '|') {- // multiline comment
- int commentlevel=1;
- while (1) {- ch = ios_getc(F);
- hashpipe_gotc:
- if (ch == IOS_EOF)
- lerrorf(ParseError, "eof within comment");
- if ((char)ch == '|') {- ch = ios_getc(F);
- if ((char)ch == '#') {- commentlevel--;
- if (commentlevel == 0)
- break;
- else
- continue;
- }
- goto hashpipe_gotc;
- }
- else if ((char)ch == '#') {- ch = ios_getc(F);
- if ((char)ch == '|')
- commentlevel++;
- else
- goto hashpipe_gotc;
- }
- }
- // this was whitespace, so keep peeking
- return peek();
- }
- else if (c == ';') {- // datum comment
- (void)do_read_sexpr(UNBOUND); // skip
- return peek();
- }
- else if (c == ':') {- // gensym
- ch = ios_getc(F);
- if ((char)ch == 'g')
- ch = ios_getc(F);
- read_token((char)ch, 0);
- x = strtol(buf, &end, 10);
- if (*end != '\0' || buf[0] == '\0')
- lerrorf(ParseError, "invalid gensym label");
- toktype = TOK_GENSYM;
- tokval = fixnum(x);
- }
- else if (symchar(c)) {- read_token(ch, 0);
+ if(toktype != TOK_NONE)
+ return toktype;
+ c = nextchar();
+ if(ios_eof(F))
+ return TOK_NONE;
+ if(c == '(')+ toktype = TOK_OPEN;
+ else if(c == ')')
+ toktype = TOK_CLOSE;
+ else if(c == '[')
+ toktype = TOK_OPENB;
+ else if(c == ']')
+ toktype = TOK_CLOSEB;
+ else if(c == '\'')
+ toktype = TOK_QUOTE;
+ else if(c == '`')
+ toktype = TOK_BQ;
+ else if(c == '"')
+ toktype = TOK_DOUBLEQUOTE;
+ else if(c == '#'){+ ch = ios_getc(F); c = (char)ch;
+ if(ch == IOS_EOF)
+ lerrorf(ParseError, "invalid read macro");
+ if(c == '.')
+ toktype = TOK_SHARPDOT;
+ else if(c == '\'')
+ toktype = TOK_SHARPQUOTE;
+ else if(c == '\\'){+ uint32_t cval;
+ if(ios_getutf8(F, &cval) == IOS_EOF)
+ lerrorf(ParseError, "end of input in character constant");
+ if(cval == (uint32_t)'u' || cval == (uint32_t)'U' || cval == (uint32_t)'x'){+ read_token('u', 0);+ if(buf[1] != '\0'){ // not a solitary 'u','U','x'+ if(!read_numtok(&buf[1], &tokval, 16))
+ lerrorf(ParseError, "invalid hex character constant");
+ cval = numval(tokval);
+ }
+ }else if(cval >= 'a' && cval <= 'z'){+ read_token((char)cval, 0);
+ tokval = symbol(buf);
+ if(buf[1] == '\0') USED(cval); /* one character */
+ else if(tokval == nulsym) cval = 0x00;
+ else if(tokval == alarmsym) cval = 0x07;
+ else if(tokval == backspacesym) cval = 0x08;
+ else if(tokval == tabsym) cval = 0x09;
+ else if(tokval == linefeedsym) cval = 0x0A;
+ else if(tokval == newlinesym) cval = 0x0A;
+ else if(tokval == vtabsym) cval = 0x0B;
+ else if(tokval == pagesym) cval = 0x0C;
+ else if(tokval == returnsym) cval = 0x0D;
+ else if(tokval == escsym) cval = 0x1B;
+ else if(tokval == spacesym) cval = 0x20;
+ else if(tokval == deletesym) cval = 0x7F;
+ else
+ lerrorf(ParseError, "unknown character #\\%s", buf);
+ }
+ toktype = TOK_NUM;
+ tokval = mk_wchar(cval);
+ }else if(c == '('){+ toktype = TOK_SHARPOPEN;
+ }else if(c == '<'){+ lerrorf(ParseError, "unreadable object");
+ }else if(isdigit(c)){+ read_token(c, 1);
+ c = (char)ios_getc(F);
+ if(c == '#')
+ toktype = TOK_BACKREF;
+ else if(c == '=')
+ toktype = TOK_LABEL;
+ else
+ lerrorf(ParseError, "invalid label");
+ x = strtoll(buf, &end, 10);
+ if(*end != '\0')
+ lerrorf(ParseError, "invalid label");
+ tokval = fixnum(x);
+ }else if(c == '!'){+ // #! single line comment for shbang script support
+ do{+ ch = ios_getc(F);
+ }while(ch != IOS_EOF && (char)ch != '\n');
+ return peek();
+ }else if(c == '|'){+ // multiline comment
+ int commentlevel = 1;
+ while(1){+ ch = ios_getc(F);
+ hashpipe_gotc:
+ if(ch == IOS_EOF)
+ lerrorf(ParseError, "eof within comment");
+ if((char)ch == '|'){+ ch = ios_getc(F);
+ if((char)ch == '#'){+ commentlevel--;
+ if(commentlevel == 0)
+ break;
+ else
+ continue;
+ }
+ goto hashpipe_gotc;
+ }else if((char)ch == '#'){+ ch = ios_getc(F);
+ if((char)ch == '|')
+ commentlevel++;
+ else
+ goto hashpipe_gotc;
+ }
+ }
+ // this was whitespace, so keep peeking
+ return peek();
+ }else if(c == ';'){+ // datum comment
+ (void)do_read_sexpr(UNBOUND); // skip
+ return peek();
+ }else if(c == ':'){+ // gensym
+ ch = ios_getc(F);
+ if((char)ch == 'g')
+ ch = ios_getc(F);
+ read_token((char)ch, 0);
+ x = strtol(buf, &end, 10);
+ if(*end != '\0' || buf[0] == '\0')
+ lerrorf(ParseError, "invalid gensym label");
+ toktype = TOK_GENSYM;
+ tokval = fixnum(x);
+ }else if(symchar(c)){+ read_token(ch, 0);
- if (((c == 'b' && (base= 2)) ||
- (c == 'o' && (base= 8)) ||
- (c == 'd' && (base=10)) ||
- (c == 'x' && (base=16))) &&
- (isdigit_base(buf[1],base) ||
- buf[1]=='-')) {- if (!read_numtok(&buf[1], &tokval, base))
- lerrorf(ParseError, "invalid base %d constant", base);
- return (toktype=TOK_NUM);
- }
+ if(((c == 'b' && (base = 2)) ||
+ (c == 'o' && (base = 8)) ||
+ (c == 'd' && (base = 10)) ||
+ (c == 'x' && (base = 16))) && (isdigit_base(buf[1], base) || buf[1] == '-')){+ if(!read_numtok(&buf[1], &tokval, base))
+ lerrorf(ParseError, "invalid base %d constant", base);
+ return (toktype = TOK_NUM);
+ }
- toktype = TOK_SHARPSYM;
- tokval = symbol(buf);
- }
- else {- lerrorf(ParseError, "unknown read macro");
- }
- }
- else if (c == ',') {- toktype = TOK_COMMA;
- ch = ios_peekc(F);
- if (ch == IOS_EOF)
- return toktype;
- if ((char)ch == '@')
- toktype = TOK_COMMAAT;
- else if ((char)ch == '.')
- toktype = TOK_COMMADOT;
- else
- return toktype;
- ios_getc(F);
- }
- else if (c == '{' || c == '}') {- lerrorf(ParseError, "invalid character %c", c);
- }
- else {- if (!read_token(c, 0)) {- if (buf[0]=='.' && buf[1]=='\0') {- return (toktype=TOK_DOT);
- }
- else {- if (read_numtok(buf, &tokval, 0))
- return (toktype=TOK_NUM);
- }
- }
- toktype = TOK_SYM;
- tokval = symbol(buf);
- }
- return toktype;
+ toktype = TOK_SHARPSYM;
+ tokval = symbol(buf);
+ }else{+ lerrorf(ParseError, "unknown read macro");
+ }
+ }else if(c == ','){+ toktype = TOK_COMMA;
+ ch = ios_peekc(F);
+ if(ch == IOS_EOF)
+ return toktype;
+ if((char)ch == '@')
+ toktype = TOK_COMMAAT;
+ else if((char)ch == '.')
+ toktype = TOK_COMMADOT;
+ else
+ return toktype;
+ ios_getc(F);
+ }else if(c == '{' || c == '}'){+ lerrorf(ParseError, "invalid character %c", c);
+ }else{+ if(!read_token(c, 0)){+ if(buf[0] == '.' && buf[1] == '\0')
+ return (toktype = TOK_DOT);
+ if(read_numtok(buf, &tokval, 0))
+ return (toktype = TOK_NUM);
+ }
+ toktype = TOK_SYM;
+ tokval = symbol(buf);
+ }
+ return toktype;
}
// NOTE: this is NOT an efficient operation. it is only used by the
// reader, and requires at least 1 and up to 3 garbage collections!
-static value_t vector_grow(value_t v)
+static value_t
+vector_grow(value_t v)
{- size_t i, s = vector_size(v);
- size_t d = vector_grow_amt(s);
- PUSH(v);
- assert(s+d > s);
- value_t newv = alloc_vector(s+d, 1);
- v = Stack[SP-1];
- for(i=0; i < s; i++)
- vector_elt(newv, i) = vector_elt(v, i);
- // use gc to rewrite references from the old vector to the new
- Stack[SP-1] = newv;
- if (s > 0) {- ((size_t*)ptr(v))[0] |= 0x1;
- vector_elt(v, 0) = newv;
- gc(0);
- }
- return POP();
+ size_t i, s = vector_size(v);
+ size_t d = vector_grow_amt(s);
+ PUSH(v);
+ assert(s+d > s);
+ value_t newv = alloc_vector(s+d, 1);
+ v = Stack[SP-1];
+ for(i = 0; i < s; i++)
+ vector_elt(newv, i) = vector_elt(v, i);
+ // use gc to rewrite references from the old vector to the new
+ Stack[SP-1] = newv;
+ if(s > 0){+ ((size_t*)ptr(v))[0] |= 0x1;
+ vector_elt(v, 0) = newv;
+ gc(0);
+ }
+ return POP();
}
-static value_t read_vector(value_t label, uint32_t closer)
+static value_t
+read_vector(value_t label, uint32_t closer)
{- value_t v=the_empty_vector, elt;
- uint32_t i=0;
- PUSH(v);
- if (label != UNBOUND)
- ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
- while (peek() != closer) {- if (ios_eof(F))
- lerrorf(ParseError, "unexpected end of input");
- if (i >= vector_size(v)) {- v = Stack[SP-1] = vector_grow(v);
- if (label != UNBOUND)
- ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
- }
- elt = do_read_sexpr(UNBOUND);
- v = Stack[SP-1];
- assert(i < vector_size(v));
- vector_elt(v,i) = elt;
- i++;
- }
- take();
- if (i > 0)
- vector_setsize(v, i);
- return POP();
+ value_t v = the_empty_vector, elt;
+ uint32_t i = 0;
+ PUSH(v);
+ if(label != UNBOUND)
+ ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
+ while(peek() != closer){+ if(ios_eof(F))
+ lerrorf(ParseError, "unexpected end of input");
+ if(i >= vector_size(v)){+ v = Stack[SP-1] = vector_grow(v);
+ if(label != UNBOUND)
+ ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
+ }
+ elt = do_read_sexpr(UNBOUND);
+ v = Stack[SP-1];
+ assert(i < vector_size(v));
+ vector_elt(v,i) = elt;
+ i++;
+ }
+ take();
+ if(i > 0)
+ vector_setsize(v, i);
+ return POP();
}
-static value_t read_string(void)
+static value_t
+read_string(void)
{- char *buf, *temp;
- char eseq[10];
- size_t i=0, j, sz = 64, ndig;
- int c;
- value_t s;
- uint32_t wc=0;
+ char *buf, *temp;
+ char eseq[10];
+ size_t i = 0, j, sz = 64, ndig;
+ int c;
+ value_t s;
+ uint32_t wc = 0;
- buf = malloc(sz);
- while (1) {- if (i >= sz-4) { // -4: leaves room for longest utf8 sequence- sz *= 2;
- temp = realloc(buf, sz);
- if (temp == nil) {- free(buf);
- lerrorf(ParseError, "out of memory reading string");
- }
- buf = temp;
- }
- c = ios_getc(F);
- if (c == IOS_EOF) {- free(buf);
- lerrorf(ParseError, "unexpected end of input in string");
- }
- if (c == '"')
- break;
- else if (c == '\\') {- c = ios_getc(F);
- if (c == IOS_EOF) {- free(buf);
- lerrorf(ParseError, "end of input in escape sequence");
- }
- j = 0;
- if (octal_digit(c)) {- while (1) {- eseq[j++] = c;
- c = ios_peekc(F);
- if (c == IOS_EOF || !octal_digit(c) || j >= 3)
- break;
- ios_getc(F);
- }
- eseq[j] = '\0';
- wc = strtol(eseq, nil, 8);
- // \DDD and \xXX read bytes, not characters
- buf[i++] = ((char)wc);
- }
- else if ((c=='x' && (ndig=2)) ||
- (c=='u' && (ndig=4)) ||
- (c=='U' && (ndig=8))) {- while (1) {- c = ios_peekc(F);
- if (c == IOS_EOF || !hex_digit(c) || j >= ndig)
- break;
- eseq[j++] = c;
- ios_getc(F);
- }
- eseq[j] = '\0';
- if (j) wc = strtol(eseq, nil, 16);
- if (!j || wc > 0x10ffff) {- free(buf);
- lerrorf(ParseError, "invalid escape sequence");
- }
- if (ndig == 2)
- buf[i++] = ((char)wc);
- else
- i += u8_wc_toutf8(&buf[i], wc);
- }
- else {- char esc = read_escape_control_char((char)c);
- if (esc == (char)c && !strchr("\\'\"`", esc)) {- free(buf);
- lerrorf(ParseError, "invalid escape sequence: \\%c", (char)c);
- }
- buf[i++] = esc;
- }
- }
- else {- buf[i++] = c;
- }
- }
- s = cvalue_string(i);
- memmove(cvalue_data(s), buf, i);
- free(buf);
- return s;
-}
+ buf = malloc(sz);
+ while(1){+ if(i >= sz-4){ // -4: leaves room for longest utf8 sequence+ sz *= 2;
+ temp = realloc(buf, sz);
+ if(temp == nil){+ free(buf);
+ lerrorf(ParseError, "out of memory reading string");
+ }
+ buf = temp;
+ }
+ c = ios_getc(F);
+ if(c == IOS_EOF){+ free(buf);
+ lerrorf(ParseError, "unexpected end of input in string");
+ }
+ if(c == '"')
+ break;
+ else if(c == '\\'){+ c = ios_getc(F);
+ if(c == IOS_EOF){+ free(buf);
+ lerrorf(ParseError, "end of input in escape sequence");
+ }
+ j = 0;
+ if(octal_digit(c)){+ while(1){+ eseq[j++] = c;
+ c = ios_peekc(F);
+ if(c == IOS_EOF || !octal_digit(c) || j >= 3)
+ break;
+ ios_getc(F);
+ }
+ eseq[j] = '\0';
+ wc = strtol(eseq, nil, 8);
+ // \DDD and \xXX read bytes, not characters
+ buf[i++] = ((char)wc);
+ }else if((c == 'x' && (ndig = 2)) || (c == 'u' && (ndig = 4)) || (c == 'U' && (ndig = 8))){+ while(1){+ c = ios_peekc(F);
+ if(c == IOS_EOF || !hex_digit(c) || j >= ndig)
+ break;
+ eseq[j++] = c;
+ ios_getc(F);
+ }
+ eseq[j] = '\0';
+ if(j)
+ wc = strtol(eseq, nil, 16);
+ if(!j || wc > 0x10ffff){+ free(buf);
+ lerrorf(ParseError, "invalid escape sequence");
+ }
+ if(ndig == 2)
+ buf[i++] = ((char)wc);
+ else
+ i += u8_wc_toutf8(&buf[i], wc);
+ }else{+ char esc = read_escape_control_char((char)c);
+ if(esc == (char)c && !strchr("\\'\"`", esc)){+ free(buf);
+ lerrorf(ParseError, "invalid escape sequence: \\%c", (char)c);
+ }
+ buf[i++] = esc;
+ }
+ }else{+ buf[i++] = c;
+ }
+ }
+ s = cvalue_string(i);
+ memmove(cvalue_data(s), buf, i);
+ free(buf);
+ return s;
+}
// build a list of conses. this is complicated by the fact that all conses
// can move whenever a new cons is allocated. we have to refer to every cons
// through a handle to a relocatable pointer (i.e. a pointer on the stack).
-static void read_list(value_t *pval, value_t label, uint32_t closer)
+static void
+read_list(value_t *pval, value_t label, uint32_t closer)
{- value_t c, *pc;
- uint32_t t;
+ value_t c, *pc;
+ uint32_t t;
- PUSH(NIL);
- pc = &Stack[SP-1]; // to keep track of current cons cell
- t = peek();
- while (t != closer) {- if (ios_eof(F))
- lerrorf(ParseError, "unexpected end of input");
- c = mk_cons(); car_(c) = cdr_(c) = NIL;
- if (iscons(*pc)) {- cdr_(*pc) = c;
- }
- else {- *pval = c;
- if (label != UNBOUND)
- ptrhash_put(&readstate->backrefs, (void*)label, (void*)c);
- }
- *pc = c;
- c = do_read_sexpr(UNBOUND); // must be on separate lines due to
- car_(*pc) = c; // undefined evaluation order
+ PUSH(NIL);
+ pc = &Stack[SP-1]; // to keep track of current cons cell
+ t = peek();
+ while(t != closer){+ if(ios_eof(F))
+ lerrorf(ParseError, "unexpected end of input");
+ c = mk_cons(); car_(c) = cdr_(c) = NIL;
+ if(iscons(*pc))
+ cdr_(*pc) = c;
+ else{+ *pval = c;
+ if(label != UNBOUND)
+ ptrhash_put(&readstate->backrefs, (void*)label, (void*)c);
+ }
+ *pc = c;
+ c = do_read_sexpr(UNBOUND); // must be on separate lines due to
+ car_(*pc) = c; // undefined evaluation order
- t = peek();
- if (t == TOK_DOT) {- take();
- c = do_read_sexpr(UNBOUND);
- cdr_(*pc) = c;
- t = peek();
- if (ios_eof(F))
- lerrorf(ParseError, "unexpected end of input");
- if (t != closer) {- take();
- lerrorf(ParseError, "expected '%c'", closer==TOK_CLOSEB ? ']' : ')');
- }
- }
- }
- take();
- c = POP();
- USED(c);
+ t = peek();
+ if(t == TOK_DOT){+ take();
+ c = do_read_sexpr(UNBOUND);
+ cdr_(*pc) = c;
+ t = peek();
+ if(ios_eof(F))
+ lerrorf(ParseError, "unexpected end of input");
+ if(t != closer){+ take();
+ lerrorf(ParseError, "expected '%c'", closer == TOK_CLOSEB ? ']' : ')');
+ }
+ }
+ }
+ take();
+ c = POP();
+ USED(c);
}
// label is the backreference we'd like to fix up with this read
-static value_t do_read_sexpr(value_t label)
+static value_t
+do_read_sexpr(value_t label)
{- value_t v, sym, oldtokval, *head;
- value_t *pv;
- uint32_t t;
- char c;
+ value_t v, sym, oldtokval, *head;
+ value_t *pv;
+ uint32_t t;
+ char c;
- t = peek();
- take();
- switch (t) {- case TOK_CLOSE:
- lerrorf(ParseError, "unexpected ')'");
- case TOK_CLOSEB:
- lerrorf(ParseError, "unexpected ']'");
- case TOK_DOT:
- lerrorf(ParseError, "unexpected '.'");
- case TOK_SYM:
- case TOK_NUM:
- return tokval;
- case TOK_COMMA:
- head = &COMMA; goto listwith;
- case TOK_COMMAAT:
- head = &COMMAAT; goto listwith;
- case TOK_COMMADOT:
- head = &COMMADOT; goto listwith;
- case TOK_BQ:
- head = &BACKQUOTE; goto listwith;
- case TOK_QUOTE:
- head = "E;
- listwith:
- v = cons_reserve(2);
- car_(v) = *head;
- cdr_(v) = tagptr(((cons_t*)ptr(v))+1, TAG_CONS);
- car_(cdr_(v)) = cdr_(cdr_(v)) = NIL;
- PUSH(v);
- if (label != UNBOUND)
- ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
- v = do_read_sexpr(UNBOUND);
- car_(cdr_(Stack[SP-1])) = v;
- return POP();
- case TOK_SHARPQUOTE:
- // femtoLisp doesn't need symbol-function, so #' does nothing
- return do_read_sexpr(label);
- case TOK_OPEN:
- PUSH(NIL);
- read_list(&Stack[SP-1], label, TOK_CLOSE);
- return POP();
- case TOK_OPENB:
- PUSH(NIL);
- read_list(&Stack[SP-1], label, TOK_CLOSEB);
- return POP();
- case TOK_SHARPSYM:
- sym = tokval;
- if (sym == tsym || sym == Tsym)
- return FL_T;
- else if (sym == fsym || sym == Fsym)
- return FL_F;
- // constructor notation
- c = nextchar();
- if (c != '(') {- take();
- lerrorf(ParseError, "expected argument list for %s",
- symbol_name(tokval));
- }
- PUSH(NIL);
- read_list(&Stack[SP-1], UNBOUND, TOK_CLOSE);
- if (sym == vu8sym) {- sym = arraysym;
- Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
- }
- else if (sym == fnsym) {- sym = FUNCTION;
- }
- v = symbol_value(sym);
- if (v == UNBOUND)
- unbound_error(sym);
- return fl_apply(v, POP());
- case TOK_SHARPOPEN:
- return read_vector(label, TOK_CLOSE);
- case TOK_SHARPDOT:
- // eval-when-read
- // evaluated expressions can refer to existing backreferences, but they
- // cannot see pending labels. in other words:
- // (... #2=#.#0# ... ) OK
- // (... #2=#.(#2#) ... ) DO NOT WANT
- sym = do_read_sexpr(UNBOUND);
- if (issymbol(sym)) {- v = symbol_value(sym);
- if (v == UNBOUND)
- unbound_error(sym);
- return v;
- }
- return fl_toplevel_eval(sym);
- case TOK_LABEL:
- // create backreference label
- if (ptrhash_has(&readstate->backrefs, (void*)tokval))
- lerrorf(ParseError, "label %"PRIdPTR" redefined", numval(tokval));
- oldtokval = tokval;
- v = do_read_sexpr(tokval);
- ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v);
- return v;
- case TOK_BACKREF:
- // look up backreference
- v = (value_t)ptrhash_get(&readstate->backrefs, (void*)tokval);
- if (v == (value_t)HT_NOTFOUND)
- lerrorf(ParseError, "undefined label %"PRIdPTR, numval(tokval));
- return v;
- case TOK_GENSYM:
- pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval);
- if (*pv == (value_t)HT_NOTFOUND)
- *pv = gensym();
- return *pv;
- case TOK_DOUBLEQUOTE:
- return read_string();
- }
- return FL_UNSPECIFIED;
+ t = peek();
+ take();
+ switch(t){+ case TOK_CLOSE:
+ lerrorf(ParseError, "unexpected ')'");
+ case TOK_CLOSEB:
+ lerrorf(ParseError, "unexpected ']'");
+ case TOK_DOT:
+ lerrorf(ParseError, "unexpected '.'");
+ case TOK_SYM:
+ case TOK_NUM:
+ return tokval;
+ case TOK_COMMA:
+ head = &COMMA; goto listwith;
+ case TOK_COMMAAT:
+ head = &COMMAAT; goto listwith;
+ case TOK_COMMADOT:
+ head = &COMMADOT; goto listwith;
+ case TOK_BQ:
+ head = &BACKQUOTE; goto listwith;
+ case TOK_QUOTE:
+ head = "E;
+ listwith:
+ v = cons_reserve(2);
+ car_(v) = *head;
+ cdr_(v) = tagptr(((cons_t*)ptr(v))+1, TAG_CONS);
+ car_(cdr_(v)) = cdr_(cdr_(v)) = NIL;
+ PUSH(v);
+ if(label != UNBOUND)
+ ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
+ v = do_read_sexpr(UNBOUND);
+ car_(cdr_(Stack[SP-1])) = v;
+ return POP();
+ case TOK_SHARPQUOTE:
+ // femtoLisp doesn't need symbol-function, so #' does nothing
+ return do_read_sexpr(label);
+ case TOK_OPEN:
+ PUSH(NIL);
+ read_list(&Stack[SP-1], label, TOK_CLOSE);
+ return POP();
+ case TOK_OPENB:
+ PUSH(NIL);
+ read_list(&Stack[SP-1], label, TOK_CLOSEB);
+ return POP();
+ case TOK_SHARPSYM:
+ sym = tokval;
+ if(sym == tsym || sym == Tsym)
+ return FL_T;
+ if(sym == fsym || sym == Fsym)
+ return FL_F;
+ // constructor notation
+ c = nextchar();
+ if(c != '('){+ take();
+ lerrorf(ParseError, "expected argument list for %s", symbol_name(tokval));
+ }
+ PUSH(NIL);
+ read_list(&Stack[SP-1], UNBOUND, TOK_CLOSE);
+ if(sym == vu8sym){+ sym = arraysym;
+ Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
+ }else if(sym == fnsym){+ sym = FUNCTION;
+ }
+ v = symbol_value(sym);
+ if(v == UNBOUND)
+ unbound_error(sym);
+ return fl_apply(v, POP());
+ case TOK_SHARPOPEN:
+ return read_vector(label, TOK_CLOSE);
+ case TOK_SHARPDOT:
+ // eval-when-read
+ // evaluated expressions can refer to existing backreferences, but they
+ // cannot see pending labels. in other words:
+ // (... #2=#.#0# ... ) OK
+ // (... #2=#.(#2#) ... ) DO NOT WANT
+ sym = do_read_sexpr(UNBOUND);
+ if(issymbol(sym)){+ v = symbol_value(sym);
+ if(v == UNBOUND)
+ unbound_error(sym);
+ return v;
+ }
+ return fl_toplevel_eval(sym);
+ case TOK_LABEL:
+ // create backreference label
+ if(ptrhash_has(&readstate->backrefs, (void*)tokval))
+ lerrorf(ParseError, "label %"PRIdPTR" redefined", numval(tokval));
+ oldtokval = tokval;
+ v = do_read_sexpr(tokval);
+ ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v);
+ return v;
+ case TOK_BACKREF:
+ // look up backreference
+ v = (value_t)ptrhash_get(&readstate->backrefs, (void*)tokval);
+ if(v == (value_t)HT_NOTFOUND)
+ lerrorf(ParseError, "undefined label %"PRIdPTR, numval(tokval));
+ return v;
+ case TOK_GENSYM:
+ pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval);
+ if(*pv == (value_t)HT_NOTFOUND)
+ *pv = gensym();
+ return *pv;
+ case TOK_DOUBLEQUOTE:
+ return read_string();
+ }
+ return FL_UNSPECIFIED;
}
-value_t fl_read_sexpr(value_t f)
+value_t
+fl_read_sexpr(value_t f)
{- value_t v;
- fl_readstate_t state;
- state.prev = readstate;
- htable_new(&state.backrefs, 8);
- htable_new(&state.gensyms, 8);
- state.source = f;
- readstate = &state;
- assert(toktype == TOK_NONE);
- fl_gc_handle(&tokval);
+ value_t v;
+ fl_readstate_t state;
+ state.prev = readstate;
+ htable_new(&state.backrefs, 8);
+ htable_new(&state.gensyms, 8);
+ state.source = f;
+ readstate = &state;
+ assert(toktype == TOK_NONE);
+ fl_gc_handle(&tokval);
- v = do_read_sexpr(UNBOUND);
+ v = do_read_sexpr(UNBOUND);
- fl_free_gc_handles(1);
- readstate = state.prev;
- free_readstate(&state);
- return v;
+ fl_free_gc_handles(1);
+ readstate = state.prev;
+ free_readstate(&state);
+ return v;
}
--- a/string.c
+++ b/string.c
@@ -6,104 +6,101 @@
BUILTIN("string?", stringp) {- argcount(nargs, 1);
- return fl_isstring(args[0]) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return fl_isstring(args[0]) ? FL_T : FL_F;
}
BUILTIN("string.count", string_count) {- size_t start = 0;
- if (nargs < 1 || nargs > 3)
- argcount(nargs, 1);
- if (!fl_isstring(args[0]))
- type_error("string", args[0]);- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t stop = len;
- if (nargs > 1) {- start = toulong(args[1]);
- if (start > len)
- bounds_error(args[0], args[1]);
- if (nargs > 2) {- stop = toulong(args[2]);
- if (stop > len)
- bounds_error(args[0], args[2]);
- if (stop <= start)
- return fixnum(0);
- }
- }
- char *str = cvalue_data(args[0]);
- return size_wrap(u8_charnum(str+start, stop-start));
+ size_t start = 0;
+ if(nargs < 1 || nargs > 3)
+ argcount(nargs, 1);
+ if(!fl_isstring(args[0]))
+ type_error("string", args[0]);+ size_t len = cv_len((cvalue_t*)ptr(args[0]));
+ size_t stop = len;
+ if(nargs > 1){+ start = toulong(args[1]);
+ if(start > len)
+ bounds_error(args[0], args[1]);
+ if(nargs > 2){+ stop = toulong(args[2]);
+ if(stop > len)
+ bounds_error(args[0], args[2]);
+ if(stop <= start)
+ return fixnum(0);
+ }
+ }
+ char *str = cvalue_data(args[0]);
+ return size_wrap(u8_charnum(str+start, stop-start));
}
BUILTIN("string.width", string_width) {- argcount(nargs, 1);
- if (iscprim(args[0])) {- cprim_t *cp = (cprim_t*)ptr(args[0]);
- if (cp_class(cp) == wchartype) {- int w = wcwidth(*(wchar_t*)cp_data(cp));
- if (w < 0)
- return FL_F;
- return fixnum(w);
- }
- }
- char *s = tostring(args[0]);
- return size_wrap(u8_strwidth(s));
+ argcount(nargs, 1);
+ if(iscprim(args[0])){+ cprim_t *cp = ptr(args[0]);
+ if(cp_class(cp) == wchartype){+ int w = wcwidth(*(wchar_t*)cp_data(cp));
+ return w < 0 ? FL_F : fixnum(w);
+ }
+ }
+ return size_wrap(u8_strwidth(tostring(args[0])));
}
BUILTIN("string.reverse", string_reverse) {- argcount(nargs, 1);
- if (!fl_isstring(args[0]))
- type_error("string", args[0]);- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- value_t ns = cvalue_string(len);
- u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
- return ns;
+ argcount(nargs, 1);
+ if(!fl_isstring(args[0]))
+ type_error("string", args[0]);+ size_t len = cv_len(ptr(args[0]));
+ value_t ns = cvalue_string(len);
+ u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);
+ return ns;
}
BUILTIN("string.encode", string_encode) {- argcount(nargs, 1);
- if (iscvalue(args[0])) {- cvalue_t *cv = (cvalue_t*)ptr(args[0]);
- fltype_t *t = cv_class(cv);
- if (t->eltype == wchartype) {- size_t nc = cv_len(cv) / sizeof(uint32_t);
- uint32_t *ptr = (uint32_t*)cv_data(cv);
- size_t nbytes = u8_codingsize(ptr, nc);
- value_t str = cvalue_string(nbytes);
- ptr = cv_data((cvalue_t*)ptr(args[0])); // relocatable pointer
- u8_toutf8(cvalue_data(str), nbytes, ptr, nc);
- return str;
- }
- }
- type_error("wchar array", args[0]);+ argcount(nargs, 1);
+ if(iscvalue(args[0])){+ cvalue_t *cv = ptr(args[0]);
+ fltype_t *t = cv_class(cv);
+ if(t->eltype == wchartype){+ size_t nc = cv_len(cv) / sizeof(uint32_t);
+ uint32_t *ptr = (uint32_t*)cv_data(cv);
+ size_t nbytes = u8_codingsize(ptr, nc);
+ value_t str = cvalue_string(nbytes);
+ ptr = cv_data(ptr(args[0])); // relocatable pointer
+ u8_toutf8(cvalue_data(str), nbytes, ptr, nc);
+ return str;
+ }
+ }
+ type_error("wchar array", args[0]);}
BUILTIN("string.decode", string_decode) {- int term=0;
- if (nargs == 2) {- term = (args[1] != FL_F);
- }
- else {- argcount(nargs, 1);
- }
- if (!fl_isstring(args[0]))
- type_error("string", args[0]);- cvalue_t *cv = (cvalue_t*)ptr(args[0]);
- char *ptr = (char*)cv_data(cv);
- size_t nb = cv_len(cv);
- size_t nc = u8_charnum(ptr, nb);
- size_t newsz = nc*sizeof(uint32_t);
- if (term) newsz += sizeof(uint32_t);
- value_t wcstr = cvalue(wcstringtype, newsz);
- ptr = cv_data((cvalue_t*)ptr(args[0])); // relocatable pointer
- uint32_t *pwc = cvalue_data(wcstr);
- u8_toucs(pwc, nc, ptr, nb);
- if (term) pwc[nc] = 0;
- return wcstr;
+ int term = 0;
+ if(nargs == 2)
+ term = args[1] != FL_F;
+ else
+ argcount(nargs, 1);
+ if(!fl_isstring(args[0]))
+ type_error("string", args[0]);+ cvalue_t *cv = ptr(args[0]);
+ char *ptr = (char*)cv_data(cv);
+ size_t nb = cv_len(cv);
+ size_t nc = u8_charnum(ptr, nb);
+ size_t newsz = nc*sizeof(uint32_t);
+ if(term)
+ newsz += sizeof(uint32_t);
+ value_t wcstr = cvalue(wcstringtype, newsz);
+ ptr = cv_data(ptr(args[0])); // relocatable pointer
+ uint32_t *pwc = cvalue_data(wcstr);
+ u8_toucs(pwc, nc, ptr, nb);
+ if(term)
+ pwc[nc] = 0;
+ return wcstr;
}
extern BUILTIN("buffer", buffer);@@ -111,283 +108,282 @@
BUILTIN("string", string) {- if (nargs == 1 && fl_isstring(args[0]))
- return args[0];
- value_t arg, buf = fn_builtin_buffer(nil, 0);
- fl_gc_handle(&buf);
- ios_t *s = value2c(ios_t*,buf);
- int i;
- value_t oldpr = symbol_value(printreadablysym);
- value_t oldpp = symbol_value(printprettysym);
- set(printreadablysym, FL_F);
- set(printprettysym, FL_F);
- FOR_ARGS(i,0,arg,args) {- USED(arg);
- fl_print(s, args[i]);
- }
- set(printreadablysym, oldpr);
- set(printprettysym, oldpp);
- value_t outp = stream_to_string(&buf);
- fl_free_gc_handles(1);
- return outp;
+ if(nargs == 1 && fl_isstring(args[0]))
+ return args[0];
+ value_t arg, buf = fn_builtin_buffer(nil, 0);
+ fl_gc_handle(&buf);
+ ios_t *s = value2c(ios_t*, buf);
+ int i;
+ value_t oldpr = symbol_value(printreadablysym);
+ value_t oldpp = symbol_value(printprettysym);
+ set(printreadablysym, FL_F);
+ set(printprettysym, FL_F);
+ FOR_ARGS(i, 0, arg, args){+ USED(arg);
+ fl_print(s, args[i]);
+ }
+ set(printreadablysym, oldpr);
+ set(printprettysym, oldpp);
+ value_t outp = stream_to_string(&buf);
+ fl_free_gc_handles(1);
+ return outp;
}
BUILTIN("string.split", string_split) {- argcount(nargs, 2);
- char *s = tostring(args[0]);
- char *delim = tostring(args[1]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t dlen = cv_len((cvalue_t*)ptr(args[1]));
- size_t ssz, tokend, tokstart, i=0;
- value_t first=FL_NIL, c=FL_NIL, last;
- size_t junk;
- fl_gc_handle(&first);
- fl_gc_handle(&last);
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ char *delim = tostring(args[1]);
+ size_t len = cv_len(ptr(args[0]));
+ size_t dlen = cv_len(ptr(args[1]));
+ size_t ssz, tokend, tokstart, i = 0;
+ value_t first = FL_NIL, c = FL_NIL, last;
+ size_t junk;
+ fl_gc_handle(&first);
+ fl_gc_handle(&last);
- do {- // find and allocate next token
- tokstart = tokend = i;
- while (i < len &&
- !u8_memchr(delim, u8_nextmemchar(s, &i), dlen, &junk))
- tokend = i;
- ssz = tokend - tokstart;
- last = c; // save previous cons cell
- c = fl_cons(cvalue_string(ssz), FL_NIL);
+ do{+ // find and allocate next token
+ tokstart = tokend = i;
+ while(i < len && !u8_memchr(delim, u8_nextmemchar(s, &i), dlen, &junk))
+ tokend = i;
+ ssz = tokend - tokstart;
+ last = c; // save previous cons cell
+ c = fl_cons(cvalue_string(ssz), FL_NIL);
- // we've done allocation; reload movable pointers
- s = cv_data((cvalue_t*)ptr(args[0]));
- delim = cv_data((cvalue_t*)ptr(args[1]));
+ // we've done allocation; reload movable pointers
+ s = cv_data(ptr(args[0]));
+ delim = cv_data(ptr(args[1]));
- if (ssz) memmove(cv_data((cvalue_t*)ptr(car_(c))), &s[tokstart], ssz);
+ if(ssz)
+ memmove(cv_data(ptr(car_(c))), &s[tokstart], ssz);
- // link new cell
- if (last == FL_NIL)
- first = c; // first time, save first cons
- else
- ((cons_t*)ptr(last))->cdr = c;
+ // link new cell
+ if(last == FL_NIL)
+ first = c; // first time, save first cons
+ else
+ ((cons_t*)ptr(last))->cdr = c;
- // note this tricky condition: if the string ends with a
- // delimiter, we need to go around one more time to add an
- // empty string. this happens when (i==len && tokend<i)
- } while (i < len || (i==len && (tokend!=i)));
- fl_free_gc_handles(2);
- return first;
+ // note this tricky condition: if the string ends with a
+ // delimiter, we need to go around one more time to add an
+ // empty string. this happens when (i == len && tokend < i)
+ }while(i < len || (i == len && (tokend != i)));
+ fl_free_gc_handles(2);
+ return first;
}
BUILTIN("string.sub", string_sub) {- if (nargs != 2)
- argcount(nargs, 3);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i1, i2;
- i1 = toulong(args[1]);
- if (i1 > len)
- bounds_error(args[0], args[1]);
- if (nargs == 3) {- i2 = toulong(args[2]);
- if (i2 > len)
- bounds_error(args[0], args[2]);
- }
- else {- i2 = len;
- }
- if (i2 <= i1)
- return cvalue_string(0);
- value_t ns = cvalue_string(i2-i1);
- memmove(cv_data((cvalue_t*)ptr(ns)), &s[i1], i2-i1);
- return ns;
+ if(nargs != 2)
+ argcount(nargs, 3);
+ char *s = tostring(args[0]);
+ size_t len = cv_len((cvalue_t*)ptr(args[0]));
+ size_t i1, i2;
+ i1 = toulong(args[1]);
+ if(i1 > len)
+ bounds_error(args[0], args[1]);
+ if(nargs == 3){+ i2 = toulong(args[2]);
+ if(i2 > len)
+ bounds_error(args[0], args[2]);
+ }else{+ i2 = len;
+ }
+ if(i2 <= i1)
+ return cvalue_string(0);
+ value_t ns = cvalue_string(i2-i1);
+ memmove(cv_data((cvalue_t*)ptr(ns)), &s[i1], i2-i1);
+ return ns;
}
BUILTIN("string.char", string_char) {- argcount(nargs, 2);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1]);
- if (i >= len)
- bounds_error(args[0], args[1]);
- size_t sl = u8_seqlen(&s[i]);
- if (sl > len || i > len-sl)
- bounds_error(args[0], args[1]);
- return mk_wchar(u8_nextchar(s, &i));
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ size_t len = cv_len(ptr(args[0]));
+ size_t i = toulong(args[1]);
+ if(i >= len)
+ bounds_error(args[0], args[1]);
+ size_t sl = u8_seqlen(&s[i]);
+ if(sl > len || i > len-sl)
+ bounds_error(args[0], args[1]);
+ return mk_wchar(u8_nextchar(s, &i));
}
BUILTIN("char.upcase", char_upcase) {- argcount(nargs, 1);
- cprim_t *cp = (cprim_t*)ptr(args[0]);
- if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("wchar", args[0]);- return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
+ argcount(nargs, 1);
+ cprim_t *cp = (cprim_t*)ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != wchartype)
+ type_error("wchar", args[0]);+ return mk_wchar(towupper(*(int32_t*)cp_data(cp)));
}
+
BUILTIN("char.downcase", char_downcase) {- argcount(nargs, 1);
- cprim_t *cp = (cprim_t*)ptr(args[0]);
- if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("wchar", args[0]);- return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
+ argcount(nargs, 1);
+ cprim_t *cp = ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != wchartype)
+ type_error("wchar", args[0]);+ return mk_wchar(towlower(*(int32_t*)cp_data(cp)));
}
BUILTIN("char-alphabetic?", char_alphabeticp) {- argcount(nargs, 1);
- cprim_t *cp = (cprim_t*)ptr(args[0]);
- if (!iscprim(args[0]) || cp_class(cp) != wchartype)
- type_error("wchar", args[0]);- return iswalpha(*(int32_t*)cp_data(cp)) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ cprim_t *cp = (cprim_t*)ptr(args[0]);
+ if(!iscprim(args[0]) || cp_class(cp) != wchartype)
+ type_error("wchar", args[0]);+ return iswalpha(*(int32_t*)cp_data(cp)) ? FL_T : FL_F;
}
-static value_t mem_find_byte(char *s, char c, size_t start, size_t len)
+static value_t
+mem_find_byte(char *s, char c, size_t start, size_t len)
{- char *p = memchr(s+start, c, len-start);
- if (p == nil)
- return FL_F;
- return size_wrap((size_t)(p - s));
+ char *p = memchr(s+start, c, len-start);
+ if(p == nil)
+ return FL_F;
+ return size_wrap((size_t)(p - s));
}
BUILTIN("string.find", string_find) {- char cbuf[8];
- size_t start = 0;
- if (nargs == 3)
- start = toulong(args[2]);
- else
- argcount(nargs, 2);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- if (start > len)
- bounds_error(args[0], args[2]);
- char *needle; size_t needlesz;
+ char cbuf[8];
+ size_t start = 0;
+ if(nargs == 3)
+ start = toulong(args[2]);
+ else
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ size_t len = cv_len(ptr(args[0]));
+ if(start > len)
+ bounds_error(args[0], args[2]);
+ char *needle; size_t needlesz;
- value_t v = args[1];
- cprim_t *cp = (cprim_t*)ptr(v);
- if (iscprim(v) && cp_class(cp) == wchartype) {- uint32_t c = *(uint32_t*)cp_data(cp);
- if (c <= 0x7f)
- return mem_find_byte(s, (char)c, start, len);
- needlesz = u8_toutf8(cbuf, sizeof(cbuf), &c, 1);
- needle = cbuf;
- }
- else if (iscprim(v) && cp_class(cp) == bytetype) {- return mem_find_byte(s, *(char*)cp_data(cp), start, len);
- }
- else if (fl_isstring(v)) {- cvalue_t *cv = (cvalue_t*)ptr(v);
- needlesz = cv_len(cv);
- needle = (char*)cv_data(cv);
- }
- else {- type_error("string", args[1]);- }
- if (needlesz > len-start)
- return FL_F;
- else if (needlesz == 1)
- return mem_find_byte(s, needle[0], start, len);
- else if (needlesz == 0)
- return size_wrap(start);
- size_t i;
- for(i=start; i < len-needlesz+1; i++) {- if (s[i] == needle[0]) {- if (!memcmp(&s[i+1], needle+1, needlesz-1))
- return size_wrap(i);
- }
- }
- return FL_F;
+ value_t v = args[1];
+ cprim_t *cp = ptr(v);
+ if(iscprim(v) && cp_class(cp) == wchartype){+ uint32_t c = *(uint32_t*)cp_data(cp);
+ if(c <= 0x7f)
+ return mem_find_byte(s, (char)c, start, len);
+ needlesz = u8_toutf8(cbuf, sizeof(cbuf), &c, 1);
+ needle = cbuf;
+ }else if(iscprim(v) && cp_class(cp) == bytetype){+ return mem_find_byte(s, *(char*)cp_data(cp), start, len);
+ }else if(fl_isstring(v)){+ cvalue_t *cv = (cvalue_t*)ptr(v);
+ needlesz = cv_len(cv);
+ needle = (char*)cv_data(cv);
+ }else{+ type_error("string", args[1]);+ }
+ if(needlesz > len-start)
+ return FL_F;
+ if(needlesz == 1)
+ return mem_find_byte(s, needle[0], start, len);
+ if(needlesz == 0)
+ return size_wrap(start);
+ size_t i;
+ for(i = start; i < len-needlesz+1; i++){+ if(s[i] == needle[0] && memcmp(&s[i+1], needle+1, needlesz-1) == 0)
+ return size_wrap(i);
+ }
+ return FL_F;
}
BUILTIN("string.inc", string_inc) {- if (nargs < 2 || nargs > 3)
- argcount(nargs, 2);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1]);
- size_t cnt = 1;
- if (nargs == 3)
- cnt = toulong(args[2]);
- while (cnt--) {- if (i >= len)
- bounds_error(args[0], args[1]);
- (void)(isutf(s[++i]) || isutf(s[++i]) || isutf(s[++i]) || ++i);
- }
- return size_wrap(i);
+ if(nargs < 2 || nargs > 3)
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ size_t len = cv_len((cvalue_t*)ptr(args[0]));
+ size_t i = toulong(args[1]);
+ size_t cnt = 1;
+ if(nargs == 3)
+ cnt = toulong(args[2]);
+ while(cnt--){+ if(i >= len)
+ bounds_error(args[0], args[1]);
+ (void)(isutf(s[++i]) || isutf(s[++i]) || isutf(s[++i]) || ++i);
+ }
+ return size_wrap(i);
}
BUILTIN("string.dec", string_dec) {- if (nargs < 2 || nargs > 3)
- argcount(nargs, 2);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- size_t i = toulong(args[1]);
- size_t cnt = 1;
- if (nargs == 3)
- cnt = toulong(args[2]);
- // note: i is allowed to start at index len
- if (i > len)
- bounds_error(args[0], args[1]);
- while (cnt--) {- if (i == 0)
- bounds_error(args[0], args[1]);
- (void)(isutf(s[--i]) || isutf(s[--i]) || isutf(s[--i]) || --i);
- }
- return size_wrap(i);
+ if(nargs < 2 || nargs > 3)
+ argcount(nargs, 2);
+ char *s = tostring(args[0]);
+ size_t len = cv_len((cvalue_t*)ptr(args[0]));
+ size_t i = toulong(args[1]);
+ size_t cnt = 1;
+ if(nargs == 3)
+ cnt = toulong(args[2]);
+ // note: i is allowed to start at index len
+ if(i > len)
+ bounds_error(args[0], args[1]);
+ while(cnt--){+ if(i == 0)
+ bounds_error(args[0], args[1]);
+ (void)(isutf(s[--i]) || isutf(s[--i]) || isutf(s[--i]) || --i);
+ }
+ return size_wrap(i);
}
-static unsigned long get_radix_arg(value_t arg)
+static unsigned long
+get_radix_arg(value_t arg)
{- unsigned long radix = toulong(arg);
- if (radix < 2 || radix > 36)
- lerrorf(ArgError, "invalid radix");
- return radix;
+ unsigned long radix = toulong(arg);
+ if(radix < 2 || radix > 36)
+ lerrorf(ArgError, "invalid radix");
+ return radix;
}
BUILTIN("number->string", number_2_string) {- if (nargs < 1 || nargs > 2)
- argcount(nargs, 2);
- value_t n = args[0];
- int neg = 0;
- uint64_t num;
- if (isfixnum(n)) num = numval(n);
- else if (!iscprim(n)) type_error("integer", n);- else num = conv_to_uint64(cp_data((cprim_t*)ptr(n)),
- cp_numtype((cprim_t*)ptr(n)));
- if (numval(fl_compare(args[0],fixnum(0))) < 0) {- num = -num;
- neg = 1;
- }
- unsigned long radix = 10;
- if (nargs == 2)
- radix = get_radix_arg(args[1]);
- char buf[128];
- char *str = uint2str(buf, sizeof(buf), num, radix);
- if (neg && str > &buf[0])
- *(--str) = '-';
- return string_from_cstr(str);
+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 2);
+ value_t n = args[0];
+ int neg = 0;
+ uint64_t num;
+ if(isfixnum(n))
+ num = numval(n);
+ else if(!iscprim(n))
+ type_error("integer", n);+ else
+ num = conv_to_uint64(cp_data(ptr(n)), cp_numtype(ptr(n)));
+ if(numval(fl_compare(args[0],fixnum(0))) < 0){+ num = -num;
+ neg = 1;
+ }
+ unsigned long radix = 10;
+ if(nargs == 2)
+ radix = get_radix_arg(args[1]);
+ char buf[128];
+ char *str = uint2str(buf, sizeof(buf), num, radix);
+ if(neg && str > &buf[0])
+ *(--str) = '-';
+ return string_from_cstr(str);
}
BUILTIN("string->number", string_2_number) {- if (nargs < 1 || nargs > 2)
- argcount(nargs, 2);
- char *str = tostring(args[0]);
- value_t n;
- unsigned long radix = 0;
- if (nargs == 2)
- radix = get_radix_arg(args[1]);
- if (!isnumtok_base(str, &n, (int)radix))
- return FL_F;
- return n;
+ if(nargs < 1 || nargs > 2)
+ argcount(nargs, 2);
+ char *str = tostring(args[0]);
+ value_t n;
+ unsigned long radix = 0;
+ if(nargs == 2)
+ radix = get_radix_arg(args[1]);
+ if(!isnumtok_base(str, &n, (int)radix))
+ return FL_F;
+ return n;
}
BUILTIN("string.isutf8", string_isutf8) {- argcount(nargs, 1);
- char *s = tostring(args[0]);
- size_t len = cv_len((cvalue_t*)ptr(args[0]));
- return u8_isvalid(s, len) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ char *s = tostring(args[0]);
+ size_t len = cv_len((cvalue_t*)ptr(args[0]));
+ return u8_isvalid(s, len) ? FL_T : FL_F;
}
--- a/table.c
+++ b/table.c
@@ -5,188 +5,196 @@
static value_t tablesym;
static fltype_t *tabletype;
-void print_htable(value_t v, ios_t *f)
+void
+print_htable(value_t v, ios_t *f)
{- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v));
- size_t i;
- int first=1;
- fl_print_str("#table(", f);- for(i=0; i < h->size; i+=2) {- if (h->table[i+1] != HT_NOTFOUND) {- if (!first) fl_print_str(" ", f);- fl_print_child(f, (value_t)h->table[i]);
- fl_print_chr(' ', f);- fl_print_child(f, (value_t)h->table[i+1]);
- first = 0;
- }
- }
- fl_print_chr(')', f);+ htable_t *h = (htable_t*)cv_data(ptr(v));
+ size_t i;
+ int first = 1;
+ fl_print_str("#table(", f);+ for(i = 0; i < h->size; i += 2){+ if(h->table[i+1] != HT_NOTFOUND){+ if(!first)
+ fl_print_str(" ", f);+ fl_print_child(f, (value_t)h->table[i]);
+ fl_print_chr(' ', f);+ fl_print_child(f, (value_t)h->table[i+1]);
+ first = 0;
+ }
+ }
+ fl_print_chr(')', f);}
-void print_traverse_htable(value_t self)
+void
+print_traverse_htable(value_t self)
{- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
- size_t i;
- for(i=0; i < h->size; i+=2) {- if (h->table[i+1] != HT_NOTFOUND) {- print_traverse((value_t)h->table[i]);
- print_traverse((value_t)h->table[i+1]);
- }
- }
+ htable_t *h = (htable_t*)cv_data(ptr(self));
+ size_t i;
+ for(i = 0; i < h->size; i += 2){+ if(h->table[i+1] != HT_NOTFOUND){+ print_traverse((value_t)h->table[i]);
+ print_traverse((value_t)h->table[i+1]);
+ }
+ }
}
-void free_htable(value_t self)
+void
+free_htable(value_t self)
{- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
- htable_free(h);
+ htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
+ htable_free(h);
}
-void relocate_htable(value_t oldv, value_t newv)
+void
+relocate_htable(value_t oldv, value_t newv)
{- htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv));
- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv));
- if (oldh->table == &oldh->_space[0])
- h->table = &h->_space[0];
- size_t i;
- for(i=0; i < h->size; i++) {- if (h->table[i] != HT_NOTFOUND)
- h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]);
- }
+ htable_t *oldh = (htable_t*)cv_data(ptr(oldv));
+ htable_t *h = (htable_t*)cv_data(ptr(newv));
+ if(oldh->table == &oldh->_space[0])
+ h->table = &h->_space[0];
+ size_t i;
+ for(i = 0; i < h->size; i++){+ if(h->table[i] != HT_NOTFOUND)
+ h->table[i] = (void*)relocate_lispvalue((value_t)h->table[i]);
+ }
}
-cvtable_t table_vtable = { print_htable, relocate_htable, free_htable,- print_traverse_htable };
+static cvtable_t table_vtable = {+ print_htable,
+ relocate_htable,
+ free_htable,
+ print_traverse_htable,
+};
-int ishashtable(value_t v)
+int
+ishashtable(value_t v)
{- return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == tabletype;
+ return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == tabletype;
}
BUILTIN("table?", tablep) {- argcount(nargs, 1);
- return ishashtable(args[0]) ? FL_T : FL_F;
+ argcount(nargs, 1);
+ return ishashtable(args[0]) ? FL_T : FL_F;
}
-static htable_t *totable(value_t v)
+static htable_t *
+totable(value_t v)
{- if (!ishashtable(v))
- type_error("table", v);- return (htable_t*)cv_data((cvalue_t*)ptr(v));
+ if(!ishashtable(v))
+ type_error("table", v);+ return (htable_t*)cv_data((cvalue_t*)ptr(v));
}
BUILTIN("table", table) {- size_t cnt = (size_t)nargs;
- if (cnt & 1)
- lerrorf(ArgError, "arguments must come in pairs");
- value_t nt;
- // prevent small tables from being added to finalizer list
- if (cnt <= HT_N_INLINE) {- tabletype->vtable->finalize = nil;
- nt = cvalue(tabletype, sizeof(htable_t));
- tabletype->vtable->finalize = free_htable;
- }
- else {- nt = cvalue(tabletype, 2*sizeof(void*));
- }
- htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
- htable_new(h, cnt/2);
- int i;
- value_t k=FL_NIL, arg;
- FOR_ARGS(i,0,arg,args) {- if (i&1)
- equalhash_put(h, (void*)k, (void*)arg);
- else
- k = arg;
- }
- return nt;
+ size_t cnt = (size_t)nargs;
+ if(cnt & 1)
+ lerrorf(ArgError, "arguments must come in pairs");
+ value_t nt;
+ // prevent small tables from being added to finalizer list
+ if(cnt <= HT_N_INLINE){+ tabletype->vtable->finalize = nil;
+ nt = cvalue(tabletype, sizeof(htable_t));
+ tabletype->vtable->finalize = free_htable;
+ }else{+ nt = cvalue(tabletype, 2*sizeof(void*));
+ }
+ htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
+ htable_new(h, cnt/2);
+ int i;
+ value_t k = FL_NIL, arg;
+ FOR_ARGS(i, 0, arg, args){+ if(i & 1)
+ equalhash_put(h, (void*)k, (void*)arg);
+ else
+ k = arg;
+ }
+ return nt;
}
// (put! table key value)
BUILTIN("put!", put) {- argcount(nargs, 3);
- htable_t *h = totable(args[0]);
- void **table0 = h->table;
- equalhash_put(h, (void*)args[1], (void*)args[2]);
- // register finalizer if we outgrew inline space
- if (table0 == &h->_space[0] && h->table != &h->_space[0]) {- cvalue_t *cv = (cvalue_t*)ptr(args[0]);
- add_finalizer(cv);
- cv->len = 2*sizeof(void*);
- }
- return args[0];
+ argcount(nargs, 3);
+ htable_t *h = totable(args[0]);
+ void **table0 = h->table;
+ equalhash_put(h, (void*)args[1], (void*)args[2]);
+ // register finalizer if we outgrew inline space
+ if(table0 == &h->_space[0] && h->table != &h->_space[0]){+ cvalue_t *cv = (cvalue_t*)ptr(args[0]);
+ add_finalizer(cv);
+ cv->len = 2*sizeof(void*);
+ }
+ return args[0];
}
-static void key_error(value_t key)
+static void
+key_error(value_t key)
{- lerrorf(fl_list2(KeyError, key), "key not found");
+ lerrorf(fl_list2(KeyError, key), "key not found");
}
// (get table key [default])
BUILTIN("get", get) {- if (nargs != 3)
- argcount(nargs, 2);
- htable_t *h = totable(args[0]);
- value_t v = (value_t)equalhash_get(h, (void*)args[1]);
- if (v == (value_t)HT_NOTFOUND) {- if (nargs == 3)
- return args[2];
- key_error(args[1]);
- }
- return v;
+ if(nargs != 3)
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
+ value_t v = (value_t)equalhash_get(h, (void*)args[1]);
+ if(v == (value_t)HT_NOTFOUND){+ if(nargs == 3)
+ return args[2];
+ key_error(args[1]);
+ }
+ return v;
}
// (has? table key)
BUILTIN("has?", has) {- argcount(nargs, 2);
- htable_t *h = totable(args[0]);
- return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F;
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
+ return equalhash_has(h, (void*)args[1]) ? FL_T : FL_F;
}
// (del! table key)
BUILTIN("del!", del) {- argcount(nargs, 2);
- htable_t *h = totable(args[0]);
- if (!equalhash_remove(h, (void*)args[1]))
- key_error(args[1]);
- return args[0];
+ argcount(nargs, 2);
+ htable_t *h = totable(args[0]);
+ if(!equalhash_remove(h, (void*)args[1]))
+ key_error(args[1]);
+ return args[0];
}
BUILTIN("table.foldl", table_foldl) {- argcount(nargs, 3);
- value_t f=args[0], zero=args[1], t=args[2];
- htable_t *h = totable(t);
- size_t i, n = h->size;
- void **table = h->table;
- fl_gc_handle(&f);
- fl_gc_handle(&zero);
- fl_gc_handle(&t);
- for(i=0; i < n; i+=2) {- if (table[i+1] != HT_NOTFOUND) {- zero = fl_applyn(3, f,
- (value_t)table[i],
- (value_t)table[i+1],
- zero);
- // reload pointer
- h = (htable_t*)cv_data((cvalue_t*)ptr(t));
- if (h->size != n)
- lerrorf(EnumerationError, "table modified");
- table = h->table;
- }
- }
- fl_free_gc_handles(3);
- return zero;
+ argcount(nargs, 3);
+ value_t f = args[0], zero = args[1], t = args[2];
+ htable_t *h = totable(t);
+ size_t i, n = h->size;
+ void **table = h->table;
+ fl_gc_handle(&f);
+ fl_gc_handle(&zero);
+ fl_gc_handle(&t);
+ for(i = 0; i < n; i += 2){+ if(table[i+1] != HT_NOTFOUND){+ zero = fl_applyn(3, f, (value_t)table[i], (value_t)table[i+1], zero);
+ // reload pointer
+ h = (htable_t*)cv_data(ptr(t));
+ if(h->size != n)
+ lerrorf(EnumerationError, "table modified");
+ table = h->table;
+ }
+ }
+ fl_free_gc_handles(3);
+ return zero;
}
-void table_init(void)
+void
+table_init(void)
{- tablesym = symbol("table");- tabletype = define_opaque_type(tablesym, sizeof(htable_t),
- &table_vtable, nil);
+ tablesym = symbol("table");+ tabletype = define_opaque_type(tablesym, sizeof(htable_t), &table_vtable, nil);
}
--- a/types.c
+++ b/types.c
@@ -1,90 +1,91 @@
#include "equalhash.h"
-fltype_t *get_type(value_t t)
+fltype_t *
+get_type(value_t t)
{- fltype_t *ft;
- if (issymbol(t)) {- ft = ((symbol_t*)ptr(t))->type;
- if (ft != nil)
- return ft;
- }
- void **bp = equalhash_bp(&TypeTable, (void*)t);
- if (*bp != HT_NOTFOUND)
- return *bp;
+ fltype_t *ft;
+ if(issymbol(t)){+ ft = ((symbol_t*)ptr(t))->type;
+ if(ft != nil)
+ return ft;
+ }
+ void **bp = equalhash_bp(&TypeTable, (void*)t);
+ if(*bp != HT_NOTFOUND)
+ return *bp;
- int align, isarray=(iscons(t) && car_(t) == arraysym && iscons(cdr_(t)));
- size_t sz;
- if (isarray && !iscons(cdr_(cdr_(t)))) {- // special case: incomplete array type
- sz = 0;
- }
- else {- sz = ctype_sizeof(t, &align);
- }
+ int align, isarray = iscons(t) && car_(t) == arraysym && iscons(cdr_(t));
+ size_t sz;
+ if(isarray && !iscons(cdr_(cdr_(t)))){+ // special case: incomplete array type
+ sz = 0;
+ }else{+ sz = ctype_sizeof(t, &align);
+ }
- ft = calloc(1, sizeof(fltype_t));
- ft->type = t;
- ft->numtype = NONNUMERIC;
- if (issymbol(t)) {- ft->numtype = sym_to_numtype(t);
- assert(valid_numtype(ft->numtype));
- ((symbol_t*)ptr(t))->type = ft;
- }
- ft->size = sz;
- ft->marked = 1;
- if (iscons(t)) {- if (isarray) {- fltype_t *eltype = get_type(car_(cdr_(t)));
- if (eltype->size == 0) {- free(ft);
- lerrorf(ArgError, "invalid array element type");
- }
- ft->elsz = eltype->size;
- ft->eltype = eltype;
- ft->init = cvalue_array_init;
- //eltype->artype = ft; -- this is a bad idea since some types carry array sizes
- }
- else if (car_(t) == enumsym) {- ft->numtype = T_INT32;
- ft->init = cvalue_enum_init;
- }
- }
- *bp = ft;
- return ft;
+ ft = calloc(1, sizeof(fltype_t));
+ ft->type = t;
+ ft->numtype = NONNUMERIC;
+ if(issymbol(t)){+ ft->numtype = sym_to_numtype(t);
+ assert(valid_numtype(ft->numtype));
+ ((symbol_t*)ptr(t))->type = ft;
+ }
+ ft->size = sz;
+ ft->marked = 1;
+ if(iscons(t)){+ if(isarray){+ fltype_t *eltype = get_type(car_(cdr_(t)));
+ if(eltype->size == 0){+ free(ft);
+ lerrorf(ArgError, "invalid array element type");
+ }
+ ft->elsz = eltype->size;
+ ft->eltype = eltype;
+ ft->init = cvalue_array_init;
+ //eltype->artype = ft; -- this is a bad idea since some types carry array sizes
+ }else if(car_(t) == enumsym){+ ft->numtype = T_INT32;
+ ft->init = cvalue_enum_init;
+ }
+ }
+ *bp = ft;
+ return ft;
}
-fltype_t *get_array_type(value_t eltype)
+fltype_t *
+get_array_type(value_t eltype)
{- fltype_t *et = get_type(eltype);
- if (et->artype == nil)
- et->artype = get_type(fl_list2(arraysym, eltype));
- return et->artype;
+ fltype_t *et = get_type(eltype);
+ if(et->artype == nil)
+ et->artype = get_type(fl_list2(arraysym, eltype));
+ return et->artype;
}
-fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
- cvinitfunc_t init)
+fltype_t *
+define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init)
{- fltype_t *ft = calloc(1, sizeof(fltype_t));
- ft->type = sym;
- ft->numtype = NONNUMERIC;
- ft->size = sz;
- ft->vtable = vtab;
- ft->marked = 1;
- ft->init = init;
- return ft;
+ fltype_t *ft = calloc(1, sizeof(fltype_t));
+ ft->type = sym;
+ ft->numtype = NONNUMERIC;
+ ft->size = sz;
+ ft->vtable = vtab;
+ ft->marked = 1;
+ ft->init = init;
+ return ft;
}
-void relocate_typetable(void)
+void
+relocate_typetable(void)
{- htable_t *h = &TypeTable;
- size_t i;
- void *nv;
- for(i=0; i < h->size; i+=2) {- if (h->table[i] != HT_NOTFOUND) {- nv = (void*)relocate((value_t)h->table[i]);
- h->table[i] = nv;
- if (h->table[i+1] != HT_NOTFOUND)
- ((fltype_t*)h->table[i+1])->type = (value_t)nv;
- }
- }
+ htable_t *h = &TypeTable;
+ size_t i;
+ void *nv;
+ for(i = 0; i < h->size; i += 2){+ if(h->table[i] != HT_NOTFOUND){+ nv = (void*)relocate((value_t)h->table[i]);
+ h->table[i] = nv;
+ if(h->table[i+1] != HT_NOTFOUND)
+ ((fltype_t*)h->table[i+1])->type = (value_t)nv;
+ }
+ }
}