--- microscheme/scheme.c	2015/11/27 02:12:08	1.24
+++ microscheme/scheme.c	2015/12/01 01:56:22	1.52
@@ -18,8 +18,12 @@
  *
  */
 
+#define EXPERIMENT 1
+
+#if 1
 #define PAGE_SIZE 4096 /* does not work on sparc/alpha */
 #include "malloc.c"
+#endif
 
 #define SCHEME_SOURCE
 #include "scheme-private.h"
@@ -36,20 +40,35 @@
 #include <sys/stat.h>
 #include <fcntl.h>
 
-#include <string.h>
+#if !USE_ERROR_CHECKING
+# define NDEBUG
+#endif
+
+#include <assert.h>
 #include <stdlib.h>
+#include <string.h>
 
 #include <limits.h>
 #include <inttypes.h>
 #include <float.h>
 //#include <ctype.h>
 
+#if '1' != '0' + 1 \
+ || '2' != '0' + 2 || '3' != '0' + 3 || '4' != '0' + 4 || '5' != '0' + 5 \
+ || '6' != '0' + 6 || '7' != '0' + 7 || '8' != '0' + 8 || '9' != '0' + 9 \
+ || 'b' != 'a' + 1 || 'c' != 'a' + 2 || 'd' != 'a' + 3 || 'e' != 'a' + 4 \
+ || 'f' != 'a' + 5
+# error "execution character set digits not consecutive"
+#endif
+
 enum {
   TOK_EOF,
   TOK_LPAREN,
   TOK_RPAREN,
   TOK_DOT,
   TOK_ATOM,
+  TOK_DOTATOM, /* atom name starting with '.' */
+  TOK_STRATOM, /* atom name enclosed in | */
   TOK_QUOTE,
   TOK_DQUOTE,
   TOK_BQUOTE,
@@ -61,13 +80,14 @@
 };
 
 #define BACKQUOTE '`'
-#define DELIMITERS  "()\";\f\t\v\n\r "
+#define WHITESPACE " \t\r\n\v\f"
+#define DELIMITERS  "()\";" WHITESPACE
 
-#define NIL    (&SCHEME_V->xNIL) //TODO: make this 0?
-#define S_T    (&SCHEME_V->xT)   //TODO: magic ptr value?
-#define S_F    (&SCHEME_V->xF)   //TODO: magic ptr value?
-#define S_SINK (&SCHEME_V->xsink)
-#define S_EOF  (&SCHEME_V->xEOF_OBJ)
+#define NIL    POINTER (&SCHEME_V->xNIL)
+#define S_T    POINTER (&SCHEME_V->xT)
+#define S_F    POINTER (&SCHEME_V->xF)
+#define S_SINK POINTER (&SCHEME_V->xsink)
+#define S_EOF  POINTER (&SCHEME_V->xEOF_OBJ)
 
 #if !USE_MULTIPLICITY
 static scheme sc;
@@ -178,18 +198,14 @@
 # define InitFile "init.scm"
 #endif
 
-#ifndef FIRST_CELLSEGS
-# define FIRST_CELLSEGS 3
-#endif
-
 enum scheme_types
 {
-  T_FREE,
+  T_INTEGER,
+  T_REAL,
   T_STRING,
-  T_NUMBER,
   T_SYMBOL,
   T_PROC,
-  T_PAIR,
+  T_PAIR, /* also used for free cells */
   T_CLOSURE,
   T_CONTINUATION,
   T_FOREIGN,
@@ -209,6 +225,32 @@
 #define T_ATOM       0x0040 /* only for gc */
 #define T_MARK       0x0080 /* only for gc */
 
+/* num, for generic arithmetic */
+struct num
+{
+  IVALUE ivalue;
+#if USE_REAL
+  RVALUE rvalue;
+  char is_fixnum;
+#endif
+};
+
+#if USE_REAL
+# define num_is_fixnum(n)    (n).is_fixnum
+# define num_set_fixnum(n,f) (n).is_fixnum = (f)
+# define num_ivalue(n)       (n).ivalue
+# define num_rvalue(n)       (n).rvalue
+# define num_set_ivalue(n,i) (n).rvalue = (n).ivalue = (i)
+# define num_set_rvalue(n,r) (n).rvalue = (r)
+#else
+# define num_is_fixnum(n)    1
+# define num_set_fixnum(n,f) 0
+# define num_ivalue(n)       (n).ivalue
+# define num_rvalue(n)       (n).ivalue
+# define num_set_ivalue(n,i) (n).ivalue = (i)
+# define num_set_rvalue(n,r) (n).ivalue = (r)
+#endif
+
 enum num_op { NUM_ADD, NUM_SUB, NUM_MUL, NUM_INTDIV };
 
 static num num_op (enum num_op op, num a, num b);
@@ -221,18 +263,16 @@
 #endif
 static int is_zero_rvalue (RVALUE x);
 
-ecb_inline int
-num_is_integer (pointer p)
-{
-  return num_is_fixnum (p->object.number);
-}
-
 static num num_zero;
 static num num_one;
 
+/* convert "pointer" to cell* / cell* to pointer */
+#define CELL(p) ((struct cell *)(p) + 0)
+#define POINTER(c) ((void *)((c) - 0))
+
 /* macros for cell operations */
-#define typeflag(p)       ((p)->flag + 0)
-#define set_typeflag(p,v) ((p)->flag = (v))
+#define typeflag(p)       (CELL(p)->flag + 0)
+#define set_typeflag(p,v) (CELL(p)->flag = (v))
 #define type(p)           (typeflag (p) & T_MASKTYPE)
 
 INTERFACE int
@@ -241,10 +281,8 @@
   return type (p) == T_STRING;
 }
 
-#define strvalue(p)      ((p)->object.string.svalue)
-#define strlength(p)     ((p)->object.string.length)
-
-INTERFACE int is_list (SCHEME_P_ pointer p);
+#define strvalue(p)      (CELL(p)->object.string.svalue)
+#define strlength(p)     (CELL(p)->object.string.length)
 
 INTERFACE int
 is_vector (pointer p)
@@ -252,41 +290,29 @@
   return type (p) == T_VECTOR;
 }
 
-#define vecvalue(p)	((p)->object.vector.vvalue)
-#define veclength(p)    ((p)->object.vector.length)
-INTERFACE void fill_vector (pointer vec, pointer obj);
-INTERFACE uint32_t vector_length (pointer vec);
-INTERFACE pointer vector_elem (pointer vec, uint32_t ielem);
-INTERFACE void set_vector_elem (pointer vec, uint32_t ielem, pointer a);
-
-INTERFACE uint32_t
-vector_length (pointer vec)
-{
-  return vec->object.vector.length;
-}
+#define vecvalue(p)	(CELL(p)->object.vector.vvalue)
+#define veclength(p)    (CELL(p)->object.vector.length)
+INTERFACE void fill_vector (pointer vec, uint32_t start, pointer obj);
+INTERFACE pointer vector_get (pointer vec, uint32_t ielem);
+INTERFACE void vector_set (pointer vec, uint32_t ielem, pointer a);
 
 INTERFACE int
-is_number (pointer p)
+is_integer (pointer p)
 {
-  return type (p) == T_NUMBER;
+  return type (p) == T_INTEGER;
 }
 
+/* not the same as in scheme, where integers are (correctly :) reals */
 INTERFACE int
-is_integer (pointer p)
+is_real (pointer p)
 {
-  if (!is_number (p))
-    return 0;
-
-  if (num_is_integer (p) || ivalue (p) == rvalue (p))
-    return 1;
-
-  return 0;
+  return type (p) == T_REAL;
 }
 
 INTERFACE int
-is_real (pointer p)
+is_number (pointer p)
 {
-  return is_number (p) && !num_is_fixnum (p->object.number);
+  return is_integer (p) || is_real (p);
 }
 
 INTERFACE int
@@ -301,45 +327,15 @@
   return strvalue (p);
 }
 
-ecb_inline num
-nvalue (pointer p)
-{
-  return (p)->object.number;
-}
-
-static IVALUE
-num_get_ivalue (const num n)
-{
-  return num_is_fixnum (n) ? num_ivalue (n) : (IVALUE)num_rvalue (n);
-}
-
-static RVALUE
-num_get_rvalue (const num n)
-{
-  return num_is_fixnum (n) ? (RVALUE)num_ivalue (n) : num_rvalue (n);
-}
+#define ivalue_unchecked(p) CELL(p)->object.ivalue
+#define set_ivalue(p,v)     CELL(p)->object.ivalue = (v)
 
-INTERFACE IVALUE
-ivalue (pointer p)
-{
-  return num_get_ivalue (p->object.number);
-}
-
-INTERFACE RVALUE
-rvalue (pointer p)
-{
-  return num_get_rvalue (p->object.number);
-}
-
-#define ivalue_unchecked(p)  ((p)->object.number.value.ivalue)
 #if USE_REAL
-# define rvalue_unchecked(p)  ((p)->object.number.value.rvalue)
-# define set_num_integer(p)   (p)->object.number.is_fixnum=1;
-# define set_num_real(p)      (p)->object.number.is_fixnum=0;
+#define rvalue_unchecked(p) CELL(p)->object.rvalue
+#define set_rvalue(p,v)     CELL(p)->object.rvalue = (v)
 #else
-# define rvalue_unchecked(p)  ((p)->object.number.value.ivalue)
-# define set_num_integer(p)   0
-# define set_num_real(p)      0
+#define rvalue_unchecked(p) CELL(p)->object.ivalue
+#define set_rvalue(p,v)     CELL(p)->object.ivalue = (v)
 #endif
 
 INTERFACE long
@@ -348,6 +344,8 @@
   return ivalue_unchecked (p);
 }
 
+#define port(p)             CELL(p)->object.port
+#define set_port(p,v)       port(p) = (v)
 INTERFACE int
 is_port (pointer p)
 {
@@ -357,13 +355,13 @@
 INTERFACE int
 is_inport (pointer p)
 {
-  return is_port (p) && p->object.port->kind & port_input;
+  return is_port (p) && port (p)->kind & port_input;
 }
 
 INTERFACE int
 is_outport (pointer p)
 {
-  return is_port (p) && p->object.port->kind & port_output;
+  return is_port (p) && port (p)->kind & port_output;
 }
 
 INTERFACE int
@@ -372,8 +370,8 @@
   return type (p) == T_PAIR;
 }
 
-#define car(p)           ((p)->object.cons.car + 0)
-#define cdr(p)           ((p)->object.cons.cdr + 0)
+#define car(p)           (POINTER (CELL(p)->object.cons.car))
+#define cdr(p)           (POINTER (CELL(p)->object.cons.cdr))
 
 static pointer caar (pointer p) { return car (car (p)); }
 static pointer cadr (pointer p) { return car (cdr (p)); }
@@ -387,13 +385,13 @@
 INTERFACE void
 set_car (pointer p, pointer q)
 {
-  p->object.cons.car = q;
+  CELL(p)->object.cons.car = CELL (q);
 }
 
 INTERFACE void
 set_cdr (pointer p, pointer q)
 {
-  p->object.cons.cdr = q;
+  CELL(p)->object.cons.cdr = CELL (q);
 }
 
 INTERFACE pointer
@@ -417,17 +415,17 @@
 INTERFACE char *
 symname (pointer p)
 {
-  return strvalue (car (p));
+  return strvalue (p);
 }
 
 #if USE_PLIST
+#error plists are broken because symbols are no longer pairs
+#define symprop(p)       cdr(p)
 SCHEME_EXPORT int
 hasprop (pointer p)
 {
   return typeflag (p) & T_SYMBOL;
 }
-
-# define symprop(p)       cdr(p)
 #endif
 
 INTERFACE int
@@ -451,10 +449,10 @@
 INTERFACE char *
 syntaxname (pointer p)
 {
-  return strvalue (car (p));
+  return strvalue (p);
 }
 
-#define procnum(p)       ivalue (p)
+#define procnum(p)       ivalue_unchecked (p)
 static const char *procname (pointer x);
 
 INTERFACE int
@@ -527,6 +525,60 @@
 #endif
 }
 
+/* Result is:
+   proper list: length
+   circular list: -1
+   not even a pair: -2
+   dotted list: -2 minus length before dot
+*/
+INTERFACE int
+list_length (SCHEME_P_ pointer a)
+{
+  int i = 0;
+  pointer slow, fast;
+
+  slow = fast = a;
+
+  while (1)
+    {
+      if (fast == NIL)
+        return i;
+
+      if (!is_pair (fast))
+        return -2 - i;
+
+      fast = cdr (fast);
+      ++i;
+
+      if (fast == NIL)
+        return i;
+
+      if (!is_pair (fast))
+        return -2 - i;
+
+      ++i;
+      fast = cdr (fast);
+
+      /* Safe because we would have already returned if `fast'
+         encountered a non-pair. */
+      slow = cdr (slow);
+
+      if (fast == slow)
+        {
+          /* the fast pointer has looped back around and caught up
+             with the slow pointer, hence the structure is circular,
+             not of finite length, and therefore not a list */
+          return -1;
+        }
+    }
+}
+
+INTERFACE int
+is_list (SCHEME_P_ pointer a)
+{
+  return list_length (SCHEME_A_ a) >= 0;
+}
+
 #if USE_CHAR_CLASSIFIERS
 ecb_inline int
 Cisalpha (int c)
@@ -623,8 +675,8 @@
 static int file_push (SCHEME_P_ const char *fname);
 static void file_pop (SCHEME_P);
 static int file_interactive (SCHEME_P);
-ecb_inline int is_one_of (char *s, int c);
-static int alloc_cellseg (SCHEME_P_ int n);
+ecb_inline int is_one_of (const char *s, int c);
+static int alloc_cellseg (SCHEME_P);
 ecb_inline pointer get_cell (SCHEME_P_ pointer a, pointer b);
 static void finalize_cell (SCHEME_P_ pointer a);
 static int count_consecutive_cells (pointer x, int needed);
@@ -650,8 +702,8 @@
 static int basic_inchar (port *pt);
 static int inchar (SCHEME_P);
 static void backchar (SCHEME_P_ int c);
-static char *readstr_upto (SCHEME_P_ char *delim);
-static pointer readstrexp (SCHEME_P);
+static char *readstr_upto (SCHEME_P_ int skip, const char *delim);
+static pointer readstrexp (SCHEME_P_ char delim);
 ecb_inline int skipspace (SCHEME_P);
 static int token (SCHEME_P);
 static void printslashstring (SCHEME_P_ char *s, int len);
@@ -678,6 +730,33 @@
 static int syntaxnum (pointer p);
 static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);
 
+static IVALUE
+ivalue (pointer x)
+{
+  return is_integer (x) ? ivalue_unchecked (x) : rvalue_unchecked (x);
+}
+
+static RVALUE
+rvalue (pointer x)
+{
+  return is_integer (x) ? ivalue_unchecked (x) : rvalue_unchecked (x);
+}
+
+INTERFACE num
+nvalue (pointer x)
+{
+  num n;
+
+  num_set_fixnum (n, is_integer (x));
+
+  if (num_is_fixnum (n))
+    num_set_ivalue (n, ivalue_unchecked (x));
+  else
+    num_set_rvalue (n, rvalue_unchecked (x));
+
+  return n;
+}
+
 static num
 num_op (enum num_op op, num a, num b)
 {
@@ -687,34 +766,30 @@
 
   if (num_is_fixnum (ret))
     {
-      IVALUE av = num_get_ivalue (a);
-      IVALUE bv = num_get_ivalue (b);
-
       switch (op)
         {
-          case NUM_ADD: av += bv; break;
-          case NUM_SUB: av -= bv; break;
-          case NUM_MUL: av *= bv; break;
-          case NUM_INTDIV: av /= bv; break;
+          case NUM_ADD:    a.ivalue += b.ivalue; break;
+          case NUM_SUB:    a.ivalue -= b.ivalue; break;
+          case NUM_MUL:    a.ivalue *= b.ivalue; break;
+          case NUM_INTDIV: a.ivalue /= b.ivalue; break;
         }
 
-      num_set_ivalue (ret, av);
+      num_set_ivalue (ret, a.ivalue);
     }
+#if USE_REAL
   else
     {
-      RVALUE av = num_get_rvalue (a);
-      RVALUE bv = num_get_rvalue (b);
-
       switch (op)
         {
-          case NUM_ADD: av += bv; break;
-          case NUM_SUB: av -= bv; break;
-          case NUM_MUL: av *= bv; break;
-          case NUM_INTDIV: av /= bv; break;
+          case NUM_ADD:    a.rvalue += b.rvalue; break;
+          case NUM_SUB:    a.rvalue -= b.rvalue; break;
+          case NUM_MUL:    a.rvalue *= b.rvalue; break;
+          case NUM_INTDIV: a.rvalue /= b.rvalue; break;
         }
 
-      num_set_rvalue (ret, av);
+      num_set_rvalue (ret, a.rvalue);
     }
+#endif
 
   return ret;
 }
@@ -724,12 +799,12 @@
 {
   num ret;
 
-  num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b) && num_get_ivalue (a) % num_get_ivalue (b) == 0);
+  num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b) && num_ivalue (a) % num_ivalue (b) == 0);
 
   if (num_is_fixnum (ret))
-    num_set_ivalue (ret, num_get_ivalue (a) / num_get_ivalue (b));
+    num_set_ivalue (ret, num_ivalue (a) / num_ivalue (b));
   else
-    num_set_rvalue (ret, num_get_rvalue (a) / num_get_rvalue (b));
+    num_set_rvalue (ret, num_rvalue (a) / num_rvalue (b));
 
   return ret;
 }
@@ -741,8 +816,8 @@
   long e1, e2, res;
 
   num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
-  e1 = num_get_ivalue (a);
-  e2 = num_get_ivalue (b);
+  e1 = num_ivalue (a);
+  e2 = num_ivalue (b);
   res = e1 % e2;
 
   /* remainder should have same sign as second operand */
@@ -768,8 +843,8 @@
   long e1, e2, res;
 
   num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
-  e1 = num_get_ivalue (a);
-  e2 = num_get_ivalue (b);
+  e1 = num_ivalue (a);
+  e2 = num_ivalue (b);
   res = e1 % e2;
 
   /* modulo should have same sign as second operand */
@@ -789,15 +864,15 @@
 
   if (is_fixnum)
     {
-      IVALUE av = num_get_ivalue (a);
-      IVALUE bv = num_get_ivalue (b);
+      IVALUE av = num_ivalue (a);
+      IVALUE bv = num_ivalue (b);
 
       ret = av == bv ? 0 : av < bv ? -1 : +1;
     }
   else
     {
-      RVALUE av = num_get_rvalue (a);
-      RVALUE bv = num_get_rvalue (b);
+      RVALUE av = num_rvalue (a);
+      RVALUE bv = num_rvalue (b);
 
       ret = av == bv ? 0 : av < bv ? -1 : +1;
     }
@@ -845,11 +920,11 @@
 
 /* allocate new cell segment */
 static int
-alloc_cellseg (SCHEME_P_ int n)
+alloc_cellseg (SCHEME_P)
 {
-  pointer newp;
-  pointer last;
-  pointer p;
+  struct cell *newp;
+  struct cell *last;
+  struct cell *p;
   char *cp;
   long i;
   int k;
@@ -857,67 +932,32 @@
   static int segsize = CELL_SEGSIZE >> 1;
   segsize <<= 1;
 
-  for (k = 0; k < n; k++)
-    {
-      if (SCHEME_V->last_cell_seg >= CELL_NSEGMENT - 1)
-        return k;
-
-      cp = malloc (segsize * sizeof (struct cell));
-
-      if (!cp && USE_ERROR_CHECKING)
-        return k;
-
-      i = ++SCHEME_V->last_cell_seg;
-      SCHEME_V->alloc_seg[i] = cp;
-
-      /* insert new segment in address order */
-      newp = (pointer)cp;
-      SCHEME_V->cell_seg[i] = newp;
-      SCHEME_V->cell_segsize[i] = segsize;
-
-      //TODO: insert, not swap
-      while (i > 0 && SCHEME_V->cell_seg[i - 1] > SCHEME_V->cell_seg[i])
-        {
-          p = SCHEME_V->cell_seg[i];
-          SCHEME_V->cell_seg[i] = SCHEME_V->cell_seg[i - 1];
-          SCHEME_V->cell_seg[i - 1] = p;
-
-          k = SCHEME_V->cell_segsize[i];
-          SCHEME_V->cell_segsize[i] = SCHEME_V->cell_segsize[i - 1];
-          SCHEME_V->cell_segsize[i - 1] = k;
-
-          --i;
-        }
+  cp = malloc (segsize * sizeof (struct cell));
 
-      SCHEME_V->fcells += segsize;
-      last = newp + segsize - 1;
-
-      for (p = newp; p <= last; p++)
-        {
-          set_typeflag (p, T_FREE);
-          set_car (p, NIL);
-          set_cdr (p, p + 1);
-        }
+  if (!cp && USE_ERROR_CHECKING)
+    return k;
 
-      /* insert new cells in address order on free list */
-      if (SCHEME_V->free_cell == NIL || p < SCHEME_V->free_cell)
-        {
-          set_cdr (last, SCHEME_V->free_cell);
-          SCHEME_V->free_cell = newp;
-        }
-      else
-        {
-          p = SCHEME_V->free_cell;
+  i = ++SCHEME_V->last_cell_seg;
+  SCHEME_V->alloc_seg[i] = cp;
 
-          while (cdr (p) != NIL && newp > cdr (p))
-            p = cdr (p);
+  newp = (struct cell *)cp;
+  SCHEME_V->cell_seg[i] = newp;
+  SCHEME_V->cell_segsize[i] = segsize;
+  SCHEME_V->fcells += segsize;
+  last = newp + segsize - 1;
 
-          set_cdr (last, cdr (p));
-          set_cdr (p, newp);
-        }
+  for (p = newp; p <= last; p++)
+    {
+      pointer cp = POINTER (p);
+      set_typeflag (cp, T_PAIR);
+      set_car (cp, NIL);
+      set_cdr (cp, POINTER (p + 1));
     }
 
-  return n;
+  set_cdr (POINTER (last), SCHEME_V->free_cell);
+  SCHEME_V->free_cell = POINTER (newp);
+
+  return 1;
 }
 
 /* get new cell. parameter a, b is marked by gc. */
@@ -931,14 +971,14 @@
 
       if (SCHEME_V->free_cell == NIL)
         {
-          const int min_to_be_recovered = SCHEME_V->last_cell_seg < 128 ? 128 * 8 : SCHEME_V->last_cell_seg * 8;
+          const int min_to_be_recovered = SCHEME_V->cell_segsize [SCHEME_V->last_cell_seg] >> 1;
 
           gc (SCHEME_A_ a, b);
 
           if (SCHEME_V->fcells < min_to_be_recovered || SCHEME_V->free_cell == NIL)
             {
               /* if only a few recovered, get more to avoid fruitless gc's */
-              if (!alloc_cellseg (SCHEME_A_ 1) && SCHEME_V->free_cell == NIL)
+              if (!alloc_cellseg (SCHEME_A) && SCHEME_V->free_cell == NIL)
                 {
 #if USE_ERROR_CHECKING
                   SCHEME_V->no_memory = 1;
@@ -960,7 +1000,6 @@
 
 /* To retain recent allocs before interpreter knows about them -
    Tehom */
-
 static void
 push_recent_alloc (SCHEME_P_ pointer recent, pointer extra)
 {
@@ -992,7 +1031,7 @@
 static pointer
 get_vector_object (SCHEME_P_ uint32_t len, pointer init)
 {
-  pointer v = get_cell_x (SCHEME_A_ 0, 0);
+  pointer v = get_cell_x (SCHEME_A_ NIL, NIL);
   pointer *e = malloc (len * sizeof (pointer));
 
   if (!e && USE_ERROR_CHECKING)
@@ -1001,9 +1040,9 @@
   /* Record it as a vector so that gc understands it. */
   set_typeflag (v, T_VECTOR | T_ATOM);
 
-  v->object.vector.vvalue = e;
-  v->object.vector.length = len;
-  fill_vector (v, init);
+  CELL(v)->object.vector.vvalue = e;
+  CELL(v)->object.vector.length = len;
+  fill_vector (v, 0, init);
   push_recent_alloc (SCHEME_A_ v, NIL);
 
   return v;
@@ -1056,11 +1095,30 @@
   return x;
 }
 
+static pointer
+generate_symbol (SCHEME_P_ const char *name)
+{
+  pointer x = mk_string (SCHEME_A_ name);
+  setimmutable (x);
+  set_typeflag (x, T_SYMBOL | T_ATOM);
+  return x;
+}
+
 /* ========== oblist implementation  ========== */
 
 #ifndef USE_OBJECT_LIST
 
-static int hash_fn (const char *key, int table_size);
+static int
+hash_fn (const char *key, int table_size)
+{
+  const unsigned char *p = key;
+  uint32_t hash = 2166136261;
+
+  while (*p)
+    hash = (hash ^ *p++) * 16777619;
+
+  return hash % table_size;
+}
 
 static pointer
 oblist_initial_value (SCHEME_P)
@@ -1072,14 +1130,9 @@
 static pointer
 oblist_add_by_name (SCHEME_P_ const char *name)
 {
-  int location;
-
-  pointer x = immutable_cons (mk_string (SCHEME_A_ name), NIL);
-  set_typeflag (x, T_SYMBOL);
-  setimmutable (car (x));
-
-  location = hash_fn (name, veclength (SCHEME_V->oblist));
-  set_vector_elem (SCHEME_V->oblist, location, immutable_cons (x, vector_elem (SCHEME_V->oblist, location)));
+  pointer x = generate_symbol (SCHEME_A_ name);
+  int location = hash_fn (name, veclength (SCHEME_V->oblist));
+  vector_set (SCHEME_V->oblist, location, immutable_cons (x, vector_get (SCHEME_V->oblist, location)));
   return x;
 }
 
@@ -1092,7 +1145,7 @@
 
   location = hash_fn (name, veclength (SCHEME_V->oblist));
 
-  for (x = vector_elem (SCHEME_V->oblist, location); x != NIL; x = cdr (x))
+  for (x = vector_get (SCHEME_V->oblist, location); x != NIL; x = cdr (x))
     {
       s = symname (car (x));
 
@@ -1112,7 +1165,7 @@
   pointer ob_list = NIL;
 
   for (i = 0; i < veclength (SCHEME_V->oblist); i++)
-    for (x = vector_elem (SCHEME_V->oblist, i); x != NIL; x = cdr (x))
+    for (x = vector_get (SCHEME_V->oblist, i); x != NIL; x = cdr (x))
        ob_list = cons (x, ob_list);
 
   return ob_list;
@@ -1148,11 +1201,7 @@
 static pointer
 oblist_add_by_name (SCHEME_P_ const char *name)
 {
-  pointer x;
-
-  x = immutable_cons (mk_string (SCHEME_A_ name), NIL);
-  set_typeflag (x, T_SYMBOL);
-  setimmutable (car (x));
+  pointer x = generate_symbol (SCHEME_A_ name);
   SCHEME_V->oblist = immutable_cons (x, SCHEME_V->oblist);
   return x;
 }
@@ -1172,7 +1221,7 @@
   pointer x = get_cell (SCHEME_A_ NIL, NIL);
 
   set_typeflag (x, T_PORT | T_ATOM);
-  x->object.port = p;
+  set_port (x, p);
 
   return x;
 }
@@ -1183,8 +1232,8 @@
 {
   pointer x = get_cell (SCHEME_A_ NIL, NIL);
 
-  set_typeflag (x, (T_FOREIGN | T_ATOM));
-  x->object.ff = f;
+  set_typeflag (x, T_FOREIGN | T_ATOM);
+  CELL(x)->object.ff = f;
 
   return x;
 }
@@ -1194,42 +1243,63 @@
 {
   pointer x = get_cell (SCHEME_A_ NIL, NIL);
 
-  set_typeflag (x, (T_CHARACTER | T_ATOM));
-  ivalue_unchecked (x) = c & 0xff;
-  set_num_integer (x);
+  set_typeflag (x, T_CHARACTER | T_ATOM);
+  set_ivalue (x, c & 0xff);
+
   return x;
 }
 
 /* get number atom (integer) */
 INTERFACE pointer
-mk_integer (SCHEME_P_ long num)
+mk_integer (SCHEME_P_ long n)
 {
-  pointer x = get_cell (SCHEME_A_ NIL, NIL);
+  pointer p = 0;
+  pointer *pp = &p;
 
-  set_typeflag (x, (T_NUMBER | T_ATOM));
-  ivalue_unchecked (x) = num;
-  set_num_integer (x);
-  return x;
+#if USE_INTCACHE
+  if (n >= INTCACHE_MIN && n <= INTCACHE_MAX)
+    pp = &SCHEME_V->intcache[n - INTCACHE_MIN];
+#endif
+
+  if (!*pp)
+    {
+      pointer x = get_cell (SCHEME_A_ NIL, NIL);
+
+      set_typeflag (x, T_INTEGER | T_ATOM);
+      setimmutable (x); /* shouldn't do anythi9ng, doesn't cost anything */
+      set_ivalue (x, n);
+
+      *pp = x;
+    }
+
+  return *pp;
 }
 
 INTERFACE pointer
 mk_real (SCHEME_P_ RVALUE n)
 {
+#if USE_REAL
   pointer x = get_cell (SCHEME_A_ NIL, NIL);
 
-  set_typeflag (x, (T_NUMBER | T_ATOM));
-  rvalue_unchecked (x) = n;
-  set_num_real (x);
+  set_typeflag (x, T_REAL | T_ATOM);
+  set_rvalue (x, n);
+
   return x;
+#else
+  return mk_integer (SCHEME_A_ n);
+#endif
 }
 
 static pointer
 mk_number (SCHEME_P_ const num n)
 {
-  if (num_is_fixnum (n))
-    return mk_integer (SCHEME_A_ num_get_ivalue (n));
-  else
-    return mk_real (SCHEME_A_ num_get_rvalue (n));
+#if USE_REAL
+  return num_is_fixnum (n)
+      ? mk_integer (SCHEME_A_ num_ivalue (n))
+      : mk_real    (SCHEME_A_ num_rvalue (n));
+#else
+  return mk_integer (SCHEME_A_ num_ivalue (n));
+#endif
 }
 
 /* allocate name to string area */
@@ -1245,20 +1315,11 @@
     }
 
   if (str)
-    {
-      int l = strlen (str);
-
-      if (l > len_str)
-        l = len_str;
-
-      memcpy (q, str, l);
-      q[l] = 0;
-    }
+    memcpy (q, str , len_str); /* caller must ensure that *str has length len_str */
   else
-    {
-      memset (q, fill, len_str);
-      q[len_str] = 0;
-    }
+    memset (q, fill, len_str);
+
+  q[len_str] = 0;
 
   return q;
 }
@@ -1282,6 +1343,7 @@
   set_typeflag (x, T_STRING | T_ATOM);
   strvalue (x) = store_string (SCHEME_A_ len, str, 0);
   strlength (x) = len;
+
   return x;
 }
 
@@ -1298,22 +1360,31 @@
 }
 
 INTERFACE void
-fill_vector (pointer vec, pointer obj)
+fill_vector (pointer vec, uint32_t start, pointer obj)
 {
   int i;
 
-  for (i = 0; i < vec->object.vector.length; i++)
+  for (i = start; i < veclength (vec); i++)
     vecvalue (vec)[i] = obj;
 }
 
+INTERFACE void
+vector_resize (pointer vec, uint32_t newsize, pointer fill)
+{
+  uint32_t oldsize = veclength (vec);
+  vecvalue (vec) = realloc (vecvalue (vec), newsize * sizeof (pointer));
+  veclength (vec) = newsize;
+  fill_vector (vec, oldsize, fill);
+}
+
 INTERFACE pointer
-vector_elem (pointer vec, uint32_t ielem)
+vector_get (pointer vec, uint32_t ielem)
 {
   return vecvalue(vec)[ielem];
 }
 
 INTERFACE void
-set_vector_elem (pointer vec, uint32_t ielem, pointer a)
+vector_set (pointer vec, uint32_t ielem, pointer a)
 {
   vecvalue(vec)[ielem] = a;
 }
@@ -1335,23 +1406,16 @@
 gensym (SCHEME_P)
 {
   pointer x;
+  char name[40] = "gensym-";
+  xnum (name + 7, ++SCHEME_V->gensym_cnt);
 
-  for (; SCHEME_V->gensym_cnt < LONG_MAX; SCHEME_V->gensym_cnt++)
-    {
-      char name[40] = "gensym-";
-      xnum (name + 7, SCHEME_V->gensym_cnt);
-
-      /* first check oblist */
-      x = oblist_find_by_name (SCHEME_A_ name);
-
-      if (x == NIL)
-        {
-          x = oblist_add_by_name (SCHEME_A_ name);
-          return x;
-        }
-    }
+  return generate_symbol (SCHEME_A_ name);
+}
 
-  return NIL;
+static int
+is_gensym (SCHEME_P_ pointer x)
+{
+  return is_symbol (x) && oblist_find_by_name (SCHEME_A_ strvalue (x)) != x;
 }
 
 /* make symbol or number atom from string */
@@ -1415,8 +1479,7 @@
             {
               if (!has_fp_exp)
                 {
-                  has_dec_point = 1;    /* decimal point illegal
-                                           from now on */
+                  has_dec_point = 1;    /* decimal point illegal from now on */
                   p++;
 
                   if ((*p == '-') || (*p == '+') || isdigit (*p))
@@ -1514,7 +1577,7 @@
     {
       int i;
 
-      for (i = 0; i < p->object.vector.length; i++)
+      for (i = 0; i < veclength (p); i++)
         mark (vecvalue (p)[i]);
     }
 
@@ -1571,7 +1634,6 @@
 static void
 gc (SCHEME_P_ pointer a, pointer b)
 {
-  pointer p;
   int i;
 
   if (SCHEME_V->gc_verbose)
@@ -1597,6 +1659,13 @@
   /* Mark any older stuff above nested C calls */
   mark (SCHEME_V->c_nest);
 
+#if USE_INTCACHE
+  /* mark intcache */
+  for (i = INTCACHE_MIN; i <= INTCACHE_MAX; ++i)
+    if (SCHEME_V->intcache[i - INTCACHE_MIN])
+      mark (SCHEME_V->intcache[i - INTCACHE_MIN]);
+#endif
+
   /* mark variables a, b */
   mark (a);
   mark (b);
@@ -1606,55 +1675,62 @@
   SCHEME_V->fcells = 0;
   SCHEME_V->free_cell = NIL;
 
-  /* free-list is kept sorted by address so as to maintain consecutive
-     ranges, if possible, for use with vectors. Here we scan the cells
-     (which are also kept sorted by address) downwards to build the
-     free-list in sorted order.
-   */
+  if (SCHEME_V->gc_verbose)
+    xwrstr ("freeing...");
+
+  uint32_t total = 0;
+
+  /* Here we scan the cells to build the free-list. */
   for (i = SCHEME_V->last_cell_seg; i >= 0; i--)
     {
-      p = SCHEME_V->cell_seg[i] + SCHEME_V->cell_segsize [i];
+      struct cell *end = SCHEME_V->cell_seg[i] + SCHEME_V->cell_segsize [i];
+      struct cell *p;
+      total += SCHEME_V->cell_segsize [i];
 
-      while (--p >= SCHEME_V->cell_seg[i])
+      for (p = SCHEME_V->cell_seg[i]; p < end; ++p)
         {
-          if (is_mark (p))
-            clrmark (p);
+          pointer c = POINTER (p);
+
+          if (is_mark (c))
+            clrmark (c);
           else
             {
               /* reclaim cell */
-              if (typeflag (p) != T_FREE)
+              if (typeflag (c) != T_PAIR)
                 {
-                  finalize_cell (SCHEME_A_ p);
-                  set_typeflag (p, T_FREE);
-                  set_car (p, NIL);
+                  finalize_cell (SCHEME_A_ c);
+                  set_typeflag (c, T_PAIR);
+                  set_car (c, NIL);
                 }
 
               ++SCHEME_V->fcells;
-              set_cdr (p, SCHEME_V->free_cell);
-              SCHEME_V->free_cell = p;
+              set_cdr (c, SCHEME_V->free_cell);
+              SCHEME_V->free_cell = c;
             }
         }
     }
 
   if (SCHEME_V->gc_verbose)
-    xwrstr ("done: "); xwrnum (SCHEME_V->fcells); xwrstr (" cells were recovered.\n");
+    {
+      xwrstr ("done: "); xwrnum (SCHEME_V->fcells); xwrstr (" out of "); xwrnum (total); xwrstr (" cells were recovered.\n");
+    }
 }
 
 static void
 finalize_cell (SCHEME_P_ pointer a)
 {
   /* TODO, fast bitmap check? */
-  if (is_string (a))
+  if (is_string (a) || is_symbol (a))
     free (strvalue (a));
   else if (is_vector (a))
     free (vecvalue (a));
 #if USE_PORTS
   else if (is_port (a))
     {
-      if (a->object.port->kind & port_file && a->object.port->rep.stdio.closeit)
+      if (port(a)->kind & port_file && port (a)->rep.stdio.closeit)
         port_close (SCHEME_A_ a, port_input | port_output);
 
-      free (a->object.port);
+      free (port (a));
     }
 #endif
 }
@@ -1680,7 +1756,7 @@
       SCHEME_V->load_stack[SCHEME_V->file_i].rep.stdio.file = fin;
       SCHEME_V->load_stack[SCHEME_V->file_i].rep.stdio.closeit = 1;
       SCHEME_V->nesting_stack[SCHEME_V->file_i] = 0;
-      SCHEME_V->loadport->object.port = SCHEME_V->load_stack + SCHEME_V->file_i;
+      set_port (SCHEME_V->loadport, SCHEME_V->load_stack + SCHEME_V->file_i);
 
 #if SHOW_ERROR_LINE
       SCHEME_V->load_stack[SCHEME_V->file_i].rep.stdio.curr_line = 0;
@@ -1707,7 +1783,7 @@
       port_close (SCHEME_A_ SCHEME_V->loadport, port_input);
 #endif
       SCHEME_V->file_i--;
-      SCHEME_V->loadport->object.port = SCHEME_V->load_stack + SCHEME_V->file_i;
+      set_port (SCHEME_V->loadport, SCHEME_V->load_stack + SCHEME_V->file_i);
     }
 }
 
@@ -1717,7 +1793,7 @@
 #if USE_PORTS
   return SCHEME_V->file_i == 0
       && SCHEME_V->load_stack[0].rep.stdio.file == STDIN_FILENO
-      && (SCHEME_V->inport->object.port->kind & port_file);
+      && (port (SCHEME_V->inport)->kind & port_file);
 #else
   return 0;
 #endif
@@ -1861,7 +1937,7 @@
 static void
 port_close (SCHEME_P_ pointer p, int flag)
 {
-  port *pt = p->object.port;
+  port *pt = port (p);
 
   pt->kind &= ~flag;
 
@@ -1892,9 +1968,7 @@
 inchar (SCHEME_P)
 {
   int c;
-  port *pt;
-
-  pt = SCHEME_V->inport->object.port;
+  port *pt = port (SCHEME_V->inport);
 
   if (pt->kind & port_saw_EOF)
     return EOF;
@@ -1971,7 +2045,7 @@
   if (c == EOF)
     return;
 
-  pt = SCHEME_V->inport->object.port;
+  pt = port (SCHEME_V->inport);
   pt->unget = c;
 #else
   if (c == EOF)
@@ -2009,7 +2083,7 @@
 putstr (SCHEME_P_ const char *s)
 {
 #if USE_PORTS
-  port *pt = SCHEME_V->outport->object.port;
+  port *pt = port (SCHEME_V->outport);
 
   if (pt->kind & port_file)
     write (pt->rep.stdio.file, s, strlen (s));
@@ -2029,7 +2103,7 @@
 putchars (SCHEME_P_ const char *s, int len)
 {
 #if USE_PORTS
-  port *pt = SCHEME_V->outport->object.port;
+  port *pt = port (SCHEME_V->outport);
 
   if (pt->kind & port_file)
     write (pt->rep.stdio.file, s, len);
@@ -2053,7 +2127,7 @@
 putcharacter (SCHEME_P_ int c)
 {
 #if USE_PORTS
-  port *pt = SCHEME_V->outport->object.port;
+  port *pt = port (SCHEME_V->outport);
 
   if (pt->kind & port_file)
     {
@@ -2076,9 +2150,9 @@
 
 /* read characters up to delimiter, but cater to character constants */
 static char *
-readstr_upto (SCHEME_P_ char *delim)
+readstr_upto (SCHEME_P_ int skip, const char *delim)
 {
-  char *p = SCHEME_V->strbuff;
+  char *p = SCHEME_V->strbuff + skip;
 
   while ((p - SCHEME_V->strbuff < sizeof (SCHEME_V->strbuff)) && !is_one_of (delim, (*p++ = inchar (SCHEME_A))));
 
@@ -2095,13 +2169,12 @@
 
 /* read string expression "xxx...xxx" */
 static pointer
-readstrexp (SCHEME_P)
+readstrexp (SCHEME_P_ char delim)
 {
   char *p = SCHEME_V->strbuff;
   int c;
   int c1 = 0;
-  enum
-  { st_ok, st_bsl, st_x1, st_x2, st_oct1, st_oct2 } state = st_ok;
+  enum { st_ok, st_bsl, st_x1, st_x2, st_oct1, st_oct2 } state = st_ok;
 
   for (;;)
     {
@@ -2113,20 +2186,13 @@
       switch (state)
         {
           case st_ok:
-            switch (c)
-              {
-                case '\\':
-                  state = st_bsl;
-                  break;
+            if (ecb_expect_false (c == delim))
+              return mk_counted_string (SCHEME_A_ SCHEME_V->strbuff, p - SCHEME_V->strbuff);
 
-                case '"':
-                  *p = 0;
-                  return mk_counted_string (SCHEME_A_ SCHEME_V->strbuff, p - SCHEME_V->strbuff);
-
-                default:
-                  *p++ = c;
-                  break;
-              }
+            if (ecb_expect_false (c == '\\'))
+              state = st_bsl;
+            else
+              *p++ = c;
 
             break;
 
@@ -2166,11 +2232,6 @@
                   state = st_ok;
                   break;
 
-                case '"':
-                  *p++ = '"';
-                  state = st_ok;
-                  break;
-
                 default:
                   *p++ = c;
                   state = st_ok;
@@ -2181,26 +2242,23 @@
 
           case st_x1:
           case st_x2:
-            c = toupper (c);
+            c = tolower (c);
 
-            if (c >= '0' && c <= 'F')
-              {
-                if (c <= '9')
-                  c1 = (c1 << 4) + c - '0';
-                else
-                  c1 = (c1 << 4) + c - 'A' + 10;
-
-                if (state == st_x1)
-                  state = st_x2;
-                else
-                  {
-                    *p++ = c1;
-                    state = st_ok;
-                  }
-              }
+            if (c >= '0' && c <= '9')
+              c1 = (c1 << 4) + c - '0';
+            else if (c >= 'a' && c <= 'f')
+              c1 = (c1 << 4) + c - 'a' + 10;
             else
               return S_F;
 
+            if (state == st_x1)
+              state = st_x2;
+            else
+              {
+                *p++ = c1;
+                state = st_ok;
+              }
+
             break;
 
           case st_oct1:
@@ -2213,7 +2271,7 @@
               }
             else
               {
-                if (state == st_oct2 && c1 >= 32)
+                if (state == st_oct2 && c1 >= ' ')
                   return S_F;
 
                 c1 = (c1 << 3) + (c - '0');
@@ -2228,19 +2286,15 @@
               }
 
             break;
-
         }
     }
 }
 
 /* check c is in chars */
 ecb_inline int
-is_one_of (char *s, int c)
+is_one_of (const char *s, int c)
 {
-  if (c == EOF)
-    return 1;
-
-  return !!strchr (s, c);
+  return c == EOF || !!strchr (s, c);
 }
 
 /* skip white characters */
@@ -2252,12 +2306,16 @@
   do
     {
       c = inchar (SCHEME_A);
+
 #if SHOW_ERROR_LINE
-      if (c == '\n')
+      if (ecb_expect_false (c == '\n'))
         curr_line++;
 #endif
+
+      if (ecb_expect_false (c == EOF))
+        return c;
     }
-  while (c == ' ' || c == '\n' || c == '\r' || c == '\t');
+  while (is_one_of (WHITESPACE, c));
 
   /* record it */
 #if SHOW_ERROR_LINE
@@ -2265,13 +2323,8 @@
     SCHEME_V->load_stack[SCHEME_V->file_i].rep.stdio.curr_line += curr_line;
 #endif
 
-  if (c != EOF)
-    {
-      backchar (SCHEME_A_ c);
-      return 1;
-    }
-  else
-    return EOF;
+  backchar (SCHEME_A_ c);
+  return 1;
 }
 
 /* get token */
@@ -2297,16 +2350,17 @@
       case '.':
         c = inchar (SCHEME_A);
 
-        if (is_one_of (" \n\t", c))
+        if (is_one_of (WHITESPACE, c))
           return TOK_DOT;
         else
           {
-            //TODO: ungetc twice in a row is not supported in C
             backchar (SCHEME_A_ c);
-            backchar (SCHEME_A_ '.');
-            return TOK_ATOM;
+            return TOK_DOTATOM;
           }
 
+      case '|':
+        return TOK_STRATOM;
+
       case '\'':
         return TOK_QUOTE;
 
@@ -2447,7 +2501,6 @@
   putcharacter (SCHEME_A_ '"');
 }
 
-
 /* print atoms */
 static void
 printatom (SCHEME_P_ pointer l, int f)
@@ -2459,7 +2512,6 @@
   putchars (SCHEME_A_ p, len);
 }
 
-
 /* Uses internal buffer unless string pointer is already available */
 static void
 atom2str (SCHEME_P_ pointer l, int f, char **pp, int *plen)
@@ -2482,7 +2534,7 @@
 
       if (f <= 1 || f == 10)    /* f is the base for numbers if > 1 */
         {
-          if (num_is_integer (l))
+          if (is_integer (l))
             xnum (p, ivalue_unchecked (l));
 #if USE_REAL
           else
@@ -2629,7 +2681,14 @@
   else if (is_continuation (l))
     p = "#<CONTINUATION>";
   else
-    p = "#<ERROR>";
+    {
+#if USE_PRINTF
+      p = SCHEME_V->strbuff;
+      snprintf (p, STRBUFFSIZE, "#<ERROR %x>", (int)typeflag (l));
+#else
+      p = "#<ERROR>";
+#endif
+    }
 
   *pp = p;
   *plen = strlen (p);
@@ -2747,8 +2806,7 @@
   else if (is_number (a))
     {
       if (is_number (b))
-        if (num_is_integer (a) == num_is_integer (b))
-          return num_cmp (nvalue (a), nvalue (b)) == 0;
+        return num_cmp (nvalue (a), nvalue (b)) == 0;
 
       return 0;
     }
@@ -2785,21 +2843,6 @@
 
 /* ========== Environment implementation  ========== */
 
-#if !defined(USE_ALIST_ENV) || !defined(USE_OBJECT_LIST)
-
-static int
-hash_fn (const char *key, int table_size)
-{
-  const unsigned char *p = key;
-  uint32_t hash = 2166136261;
-
-  while (*p)
-    hash = (hash ^ *p++) * 16777619;
-
-  return hash % table_size;
-}
-#endif
-
 #ifndef USE_ALIST_ENV
 
 /*
@@ -2825,6 +2868,21 @@
   setenvironment (SCHEME_V->envir);
 }
 
+static uint32_t
+sym_hash (pointer sym, uint32_t size)
+{
+  uintptr_t ptr = (uintptr_t)sym;
+
+#if 0
+  /* table size is prime, so why mix */
+  ptr += ptr >> 32;
+  ptr += ptr >> 16;
+  ptr += ptr >>  8;
+#endif
+
+  return ptr % size;
+}
+
 ecb_inline void
 new_slot_spec_in_env (SCHEME_P_ pointer env, pointer variable, pointer value)
 {
@@ -2832,9 +2890,8 @@
 
   if (is_vector (car (env)))
     {
-      int location = hash_fn (symname (variable), veclength (car (env)));
-
-      set_vector_elem (car (env), location, immutable_cons (slot, vector_elem (car (env), location)));
+      int location = sym_hash (variable, veclength (car (env)));
+      vector_set (car (env), location, immutable_cons (slot, vector_get (car (env), location)));
     }
   else
     set_car (env, immutable_cons (slot, car (env)));
@@ -2844,14 +2901,13 @@
 find_slot_in_env (SCHEME_P_ pointer env, pointer hdl, int all)
 {
   pointer x, y;
-  int location;
 
   for (x = env; x != NIL; x = cdr (x))
     {
       if (is_vector (car (x)))
         {
-          location = hash_fn (symname (hdl), veclength (car (x)));
-          y = vector_elem (car (x), location);
+          int location = sym_hash (hdl, veclength (car (x)));
+          y = vector_get (car (x), location);
         }
       else
         y = car (x);
@@ -2861,15 +2917,12 @@
           break;
 
       if (y != NIL)
-        break;
+        return car (y);
 
       if (!all)
-        return NIL;
+        break;
     }
 
-  if (x != NIL)
-    return car (y);
-
   return NIL;
 }
 
@@ -2900,15 +2953,13 @@
           break;
 
       if (y != NIL)
+        return car (y);
         break;
 
       if (!all)
-        return NIL;
+        break;
     }
 
-  if (x != NIL)
-    return car (y);
-
   return NIL;
 }
 
@@ -2917,6 +2968,7 @@
 ecb_inline void
 new_slot_in_env (SCHEME_P_ pointer variable, pointer value)
 {
+  assert (is_symbol (variable));//TODO: bug in current-ws/OP_LET2
   new_slot_spec_in_env (SCHEME_A_ SCHEME_V->envir, variable, value);
 }
 
@@ -3027,7 +3079,7 @@
   struct dump_stack_frame *next_frame;
 
   /* enough room for the next frame? */
-  if (nframes >= SCHEME_V->dump_size)
+  if (ecb_expect_false (nframes >= SCHEME_V->dump_size))
     {
       SCHEME_V->dump_size += STACK_GROWTH;
       SCHEME_V->dump_base = realloc (SCHEME_V->dump_base, sizeof (struct dump_stack_frame) * SCHEME_V->dump_size);
@@ -3134,10 +3186,10 @@
 
   while (cont != NIL)
     {
-      frame->op    = ivalue (car (cont)); cont = cdr (cont);
-      frame->args  =             car (cont) ; cont = cdr (cont);
-      frame->envir =             car (cont) ; cont = cdr (cont);
-      frame->code  =             car (cont) ; cont = cdr (cont);
+      frame->op    = ivalue_unchecked (car (cont)); cont = cdr (cont);
+      frame->args  =                   car (cont) ; cont = cdr (cont);
+      frame->envir =                   car (cont) ; cont = cdr (cont);
+      frame->code  =                   car (cont) ; cont = cdr (cont);
 
       ++frame;
       ++i;
@@ -3176,10 +3228,10 @@
   if (dump == NIL)
     return -1;
 
-  SCHEME_V->op    = ivalue (car (dump)); dump = cdr (dump);
-  SCHEME_V->args  =             car (dump) ; dump = cdr (dump);
-  SCHEME_V->envir =             car (dump) ; dump = cdr (dump);
-  SCHEME_V->code  =             car (dump) ; dump = cdr (dump);
+  SCHEME_V->op    = ivalue_unchecked (car (dump)); dump = cdr (dump);
+  SCHEME_V->args  =                   car (dump) ; dump = cdr (dump);
+  SCHEME_V->envir =                   car (dump) ; dump = cdr (dump);
+  SCHEME_V->code  =                   car (dump) ; dump = cdr (dump);
 
   SCHEME_V->dump = dump;
 
@@ -3218,6 +3270,64 @@
 
 #define s_retbool(tf)    s_return ((tf) ? S_T : S_F)
 
+#if EXPERIMENT
+static int
+debug (SCHEME_P_ int indent, pointer x)
+{
+  int c;
+
+  if (is_syntax (x))
+    {
+      printf ("%*ssyntax<%s,%d>\n", indent, "", syntaxname(x),syntaxnum(x));
+      return 8 + 8;
+    }
+
+  if (x == NIL)
+    {
+      printf ("%*sNIL\n", indent, "");
+      return 3;
+    }
+
+  switch (type (x))
+    {
+      case T_INTEGER:
+        printf ("%*sI<%d>%p\n", indent, "", (int)ivalue_unchecked (x), x);
+        return 32+8;
+
+      case T_SYMBOL:
+        printf ("%*sS<%s>\n", indent, "", symname (x));
+        return 24+8;
+
+      case T_CLOSURE:
+        printf ("%*sS<%s>\n", indent, "", "closure");
+        debug (SCHEME_A_ indent + 3, cdr(x));
+        return 32 + debug (SCHEME_A_ indent + 3, car (x));
+
+      case T_PAIR:
+        printf ("%*spair %p %p\n", indent, "", car(x),cdr(x));
+        c = debug (SCHEME_A_ indent + 3, car (x));
+        c += debug (SCHEME_A_ indent + 3, cdr (x));
+        return c + 1;
+
+      case T_PORT:
+        printf ("%*sS<%s>\n", indent, "", "port");
+        return 24+8;
+
+      case T_VECTOR:
+        printf ("%*sS<%s>\n", indent, "", "vector");
+        return 24+8;
+
+      case T_ENVIRONMENT:
+        printf ("%*sS<%s>\n", indent, "", "environment");
+        return 0 + debug (SCHEME_A_ indent + 3, car (x));
+
+      default:
+        printf ("unhandled type %d\n", type (x));
+        break;
+    }
+}
+#endif
+
 static int
 opexe_0 (SCHEME_P_ enum scheme_opcodes op)
 {
@@ -3226,11 +3336,17 @@
 
   switch (op)
     {
+#if EXPERIMENT //D
+      case OP_DEBUG:
+        printf ("len = %d\n", debug (SCHEME_A_ 0, args) / 8);
+        printf ("\n");
+        s_return (S_T);
+#endif
       case OP_LOAD:            /* load */
         if (file_interactive (SCHEME_A))
           {
             xwrstr ("Loading "); xwrstr (strvalue (car (args))); xwrstr ("\n");
-            //D fprintf (SCHEME_V->outport->object.port->rep.stdio.file, "Loading %s\n", strvalue (car (args)));
+            //D fprintf (port (SCHEME_V->outport)->rep.stdio.file, "Loading %s\n", strvalue (car (args)));
           }
 
         if (!file_push (SCHEME_A_ strvalue (car (args))))
@@ -3244,7 +3360,7 @@
       case OP_T0LVL:           /* top level */
 
         /* If we reached the end of file, this loop is done. */
-        if (SCHEME_V->loadport->object.port->kind & port_saw_EOF)
+        if (port (SCHEME_V->loadport)->kind & port_saw_EOF)
           {
             if (SCHEME_V->file_i == 0)
               {
@@ -3332,10 +3448,10 @@
           {
             x = find_slot_in_env (SCHEME_A_ SCHEME_V->envir, SCHEME_V->code, 1);
 
-            if (x != NIL)
-              s_return (slot_value_in_env (x));
-            else
+            if (x == NIL)
               Error_1 ("eval: unbound variable:", SCHEME_V->code);
+
+            s_return (slot_value_in_env (x));
           }
         else if (is_pair (SCHEME_V->code))
           {
@@ -3358,7 +3474,7 @@
           s_return (SCHEME_V->code);
 
       case OP_E0ARGS:          /* eval arguments */
-        if (is_macro (SCHEME_V->value)) /* macro expansion */
+        if (ecb_expect_false (is_macro (SCHEME_V->value))) /* macro expansion */
           {
             s_save (SCHEME_A_ OP_DOMACRO, NIL, NIL);
             SCHEME_V->args = cons (SCHEME_V->code, NIL);
@@ -3395,7 +3511,7 @@
         {
           int tr = SCHEME_V->tracing;
 
-          SCHEME_V->tracing = ivalue (car (args));
+          SCHEME_V->tracing = ivalue_unchecked (car (args));
           s_return (mk_integer (SCHEME_A_ tr));
         }
 
@@ -3422,7 +3538,7 @@
           {
             /* Keep nested calls from GC'ing the arglist */
             push_recent_alloc (SCHEME_A_ args, NIL);
-            x = SCHEME_V->code->object.ff (SCHEME_A_ args);
+            x = CELL(SCHEME_V->code)->object.ff (SCHEME_A_ args);
 
             s_return (x);
           }
@@ -3469,8 +3585,6 @@
         SCHEME_V->code = SCHEME_V->value;
         s_goto (OP_EVAL);
 
-#if 1
-
       case OP_LAMBDA:          /* lambda */
         /* If the hook is defined, apply it to SCHEME_V->code, otherwise
            set SCHEME_V->value fall thru */
@@ -3486,19 +3600,12 @@
             }
 
             SCHEME_V->value = SCHEME_V->code;
-            /* Fallthru */
         }
+        /* Fallthru */
 
       case OP_LAMBDA1:
         s_return (mk_closure (SCHEME_A_ SCHEME_V->value, SCHEME_V->envir));
 
-#else
-
-      case OP_LAMBDA:          /* lambda */
-        s_return (mk_closure (SCHEME_A_ SCHEME_V->code, SCHEME_V->envir));
-
-#endif
-
       case OP_MKCLOSURE:       /* make-closure */
         x = car (args);
 
@@ -3924,20 +4031,21 @@
   pointer x = car (args);
   num v;
 
-#if USE_MATH
-  RVALUE dd;
-#endif
-
   switch (op)
     {
 #if USE_MATH
       case OP_INEX2EX:         /* inexact->exact */
-        if (num_is_integer (x))
-          s_return (x);
-        else if (modf (rvalue_unchecked (x), &dd) == 0)
-          s_return (mk_integer (SCHEME_A_ ivalue (x)));
-        else
-          Error_1 ("inexact->exact: not integral:", x);
+        {
+          if (is_integer (x))
+            s_return (x);
+
+          RVALUE r = rvalue_unchecked (x);
+
+          if (r == (RVALUE)(IVALUE)r)
+            s_return (mk_integer (SCHEME_A_ rvalue_unchecked (x)));
+          else
+            Error_1 ("inexact->exact: not integral:", x);
+        }
 
       case OP_EXP:  s_return (mk_real (SCHEME_A_ exp  (rvalue (x))));
       case OP_LOG:  s_return (mk_real (SCHEME_A_ log  (rvalue (x))));
@@ -3965,7 +4073,7 @@
           int real_result = 1;
           pointer y = cadr (args);
 
-          if (num_is_integer (x) && num_is_integer (y))
+          if (is_integer (x) && is_integer (y))
             real_result = 0;
 
           /* This 'if' is an R5RS compatibility fix. */
@@ -3981,7 +4089,7 @@
             {
               long result_as_long = result;
 
-              if (result != (RVALUE) result_as_long)
+              if (result != result_as_long)
                 real_result = 1;
             }
 
@@ -3996,18 +4104,12 @@
 
       case OP_TRUNCATE:
         {
-          RVALUE rvalue_of_x;
-
-          rvalue_of_x = rvalue (x);
-
-          if (rvalue_of_x > 0)
-            s_return (mk_real (SCHEME_A_ floor (rvalue_of_x)));
-          else
-            s_return (mk_real (SCHEME_A_ ceil (rvalue_of_x)));
+          RVALUE n = rvalue (x);
+          s_return (mk_real (SCHEME_A_ n > 0 ? floor (n) : ceil (n)));
         }
 
       case OP_ROUND:
-        if (num_is_integer (x))
+        if (is_integer (x))
           s_return (x);
 
         s_return (mk_real (SCHEME_A_ round_per_R5RS (rvalue (x))));
@@ -4108,11 +4210,37 @@
 
         s_return (mk_number (SCHEME_A_ v));
 
-      case OP_CAR:             /* car */
-        s_return (caar (args));
-
-      case OP_CDR:             /* cdr */
-        s_return (cdar (args));
+      /* the compiler will optimize this mess... */
+      case OP_CAR:    op_car:   s_return (car (x));
+      case OP_CDR:    op_cdr:   s_return (cdr (x));
+      case OP_CAAR:   op_caar:  x = car (x); goto op_car;
+      case OP_CADR:   op_cadr:  x = cdr (x); goto op_car;
+      case OP_CDAR:   op_cdar:  x = car (x); goto op_cdr;
+      case OP_CDDR:   op_cddr:  x = cdr (x); goto op_cdr;
+      case OP_CAAAR:  op_caaar: x = car (x); goto op_caar;
+      case OP_CAADR:  op_caadr: x = cdr (x); goto op_caar;
+      case OP_CADAR:  op_cadar: x = car (x); goto op_cadr;
+      case OP_CADDR:  op_caddr: x = cdr (x); goto op_cadr;
+      case OP_CDAAR:  op_cdaar: x = car (x); goto op_cdar;
+      case OP_CDADR:  op_cdadr: x = cdr (x); goto op_cdar;
+      case OP_CDDAR:  op_cddar: x = car (x); goto op_cddr;
+      case OP_CDDDR:  op_cdddr: x = cdr (x); goto op_cddr;
+      case OP_CAAAAR:           x = car (x); goto op_caaar;
+      case OP_CAAADR:           x = cdr (x); goto op_caaar;
+      case OP_CAADAR:           x = car (x); goto op_caadr;
+      case OP_CAADDR:           x = cdr (x); goto op_caadr;
+      case OP_CADAAR:           x = car (x); goto op_cadar;
+      case OP_CADADR:           x = cdr (x); goto op_cadar;
+      case OP_CADDAR:           x = car (x); goto op_caddr;
+      case OP_CADDDR:           x = cdr (x); goto op_caddr;
+      case OP_CDAAAR:           x = car (x); goto op_cdaar;
+      case OP_CDAADR:           x = cdr (x); goto op_cdaar;
+      case OP_CDADAR:           x = car (x); goto op_cdadr;
+      case OP_CDADDR:           x = cdr (x); goto op_cdadr;
+      case OP_CDDAAR:           x = car (x); goto op_cddar;
+      case OP_CDDADR:           x = cdr (x); goto op_cddar;
+      case OP_CDDDAR:           x = car (x); goto op_cdddr;
+      case OP_CDDDDR:           x = cdr (x); goto op_cdddr;
 
       case OP_CONS:            /* cons */
         set_cdr (args, cadr (args));
@@ -4137,21 +4265,21 @@
           Error_0 ("set-cdr!: unable to alter immutable pair");
 
       case OP_CHAR2INT:        /* char->integer */
-        s_return (mk_integer (SCHEME_A_ ivalue (x)));
+        s_return (mk_integer (SCHEME_A_ ivalue_unchecked (x)));
 
       case OP_INT2CHAR:        /* integer->char */
-        s_return (mk_character (SCHEME_A_ ivalue (x)));
+        s_return (mk_character (SCHEME_A_ ivalue_unchecked (x)));
 
       case OP_CHARUPCASE:
         {
-          unsigned char c = ivalue (x);
+          unsigned char c = ivalue_unchecked (x);
           c = toupper (c);
           s_return (mk_character (SCHEME_A_ c));
         }
 
       case OP_CHARDNCASE:
         {
-          unsigned char c = ivalue (x);
+          unsigned char c = ivalue_unchecked (x);
           c = tolower (c);
           s_return (mk_character (SCHEME_A_ c));
         }
@@ -4238,13 +4366,8 @@
 
       case OP_MKSTRING:        /* make-string */
         {
-          int fill = ' ';
-          int len;
-
-          len = ivalue (x);
-
-          if (cdr (args) != NIL)
-            fill = charvalue (cadr (args));
+          int fill = cdr (args) != NIL ? charvalue (cadr (args)) : ' ';
+          int len = ivalue_unchecked (x);
 
           s_return (mk_empty_string (SCHEME_A_ len, fill));
         }
@@ -4254,12 +4377,8 @@
 
       case OP_STRREF:          /* string-ref */
         {
-          char *str;
-          int index;
-
-          str = strvalue (x);
-
-          index = ivalue (cadr (args));
+          char *str = strvalue (x);
+          int index = ivalue_unchecked (cadr (args));
 
           if (index >= strlength (x))
             Error_1 ("string-ref: out of bounds:", cadr (args));
@@ -4269,17 +4388,13 @@
 
       case OP_STRSET:          /* string-set! */
         {
-          char *str;
-          int index;
+          char *str = strvalue (x);
+          int index = ivalue_unchecked (cadr (args));
           int c;
 
           if (is_immutable (x))
             Error_1 ("string-set!: unable to alter immutable string:", x);
 
-          str = strvalue (x);
-
-          index = ivalue (cadr (args));
-
           if (index >= strlength (x))
             Error_1 ("string-set!: out of bounds:", cadr (args));
 
@@ -4311,21 +4426,17 @@
 
       case OP_SUBSTR:          /* substring */
         {
-          char *str;
-          int index0;
+          char *str = strvalue (x);
+          int index0 = ivalue_unchecked (cadr (args));
           int index1;
           int len;
 
-          str = strvalue (x);
-
-          index0 = ivalue (cadr (args));
-
           if (index0 > strlength (x))
             Error_1 ("substring: start out of bounds:", cadr (args));
 
           if (cddr (args) != NIL)
             {
-              index1 = ivalue (caddr (args));
+              index1 = ivalue_unchecked (caddr (args));
 
               if (index1 > strlength (x) || index1 < index0)
                 Error_1 ("substring: end out of bounds:", caddr (args));
@@ -4358,7 +4469,7 @@
 #endif
 
           for (x = args, i = 0; is_pair (x); x = cdr (x), i++)
-            set_vector_elem (vec, i, car (x));
+            vector_set (vec, i, car (x));
 
           s_return (vec);
         }
@@ -4366,10 +4477,8 @@
       case OP_MKVECTOR:        /* make-vector */
         {
           pointer fill = NIL;
-          int len;
           pointer vec;
-
-          len = ivalue (x);
+          int len = ivalue_unchecked (x);
 
           if (cdr (args) != NIL)
             fill = cadr (args);
@@ -4382,7 +4491,7 @@
 #endif
 
           if (fill != NIL)
-            fill_vector (vec, fill);
+            fill_vector (vec, 0, fill);
 
           s_return (vec);
         }
@@ -4390,31 +4499,31 @@
       case OP_VECLEN:          /* vector-length */
         s_return (mk_integer (SCHEME_A_ veclength (x)));
 
+      case OP_VECRESIZE:
+        vector_resize (x, ivalue_unchecked (cadr (args)), caddr (args));
+        s_return (x);
+
       case OP_VECREF:          /* vector-ref */
         {
-          int index;
-
-          index = ivalue (cadr (args));
+          int index = ivalue_unchecked (cadr (args));
 
           if (index >= veclength (car (args)) && USE_ERROR_CHECKING)
             Error_1 ("vector-ref: out of bounds:", cadr (args));
 
-          s_return (vector_elem (x, index));
+          s_return (vector_get (x, index));
         }
 
       case OP_VECSET:          /* vector-set! */
         {
-          int index;
+          int index = ivalue_unchecked (cadr (args));
 
           if (is_immutable (x))
             Error_1 ("vector-set!: unable to alter immutable vector:", x);
 
-          index = ivalue (cadr (args));
-
           if (index >= veclength (car (args)) && USE_ERROR_CHECKING)
             Error_1 ("vector-set!: out of bounds:", cadr (args));
 
-          set_vector_elem (x, index, caddr (args));
+          vector_set (x, index, caddr (args));
           s_return (x);
         }
     }
@@ -4422,60 +4531,6 @@
   if (USE_ERROR_CHECKING) abort ();
 }
 
-INTERFACE int
-is_list (SCHEME_P_ pointer a)
-{
-  return list_length (SCHEME_A_ a) >= 0;
-}
-
-/* Result is:
-   proper list: length
-   circular list: -1
-   not even a pair: -2
-   dotted list: -2 minus length before dot
-*/
-INTERFACE int
-list_length (SCHEME_P_ pointer a)
-{
-  int i = 0;
-  pointer slow, fast;
-
-  slow = fast = a;
-
-  while (1)
-    {
-      if (fast == NIL)
-        return i;
-
-      if (!is_pair (fast))
-        return -2 - i;
-
-      fast = cdr (fast);
-      ++i;
-
-      if (fast == NIL)
-        return i;
-
-      if (!is_pair (fast))
-        return -2 - i;
-
-      ++i;
-      fast = cdr (fast);
-
-      /* Safe because we would have already returned if `fast'
-         encountered a non-pair. */
-      slow = cdr (slow);
-
-      if (fast == slow)
-        {
-          /* the fast pointer has looped back around and caught up
-             with the slow pointer, hence the structure is circular,
-             not of finite length, and therefore not a list */
-          return -1;
-        }
-    }
-}
-
 static int
 opexe_2 (SCHEME_P_ enum scheme_opcodes op)
 {
@@ -4517,23 +4572,24 @@
 
   switch (op)
     {
-      case OP_NOT:             /* not */          r = is_false (a)        ; break;
-      case OP_BOOLP:           /* boolean? */     r = a == S_F || a == S_T; break;
-      case OP_EOFOBJP:         /* eof-object? */  r = a == S_EOF          ; break;
-      case OP_NULLP:           /* null? */        r = a == NIL            ; break;
-      case OP_SYMBOLP:         /* symbol? */      r = is_symbol (a)       ; break;
-      case OP_NUMBERP:         /* number? */      r = is_number (a)       ; break;
-      case OP_STRINGP:         /* string? */      r = is_string (a)       ; break;
-      case OP_INTEGERP:        /* integer? */     r = is_integer (a)      ; break;
-      case OP_REALP:           /* real? */        r = is_number (a)       ; break; /* all numbers are real */
-      case OP_CHARP:           /* char? */        r = is_character (a)    ; break;
+      case OP_NOT:             /* not */          r = is_false (a)           ; break;
+      case OP_BOOLP:           /* boolean? */     r = a == S_F || a == S_T   ; break;
+      case OP_EOFOBJP:         /* eof-object? */  r = a == S_EOF             ; break;
+      case OP_NULLP:           /* null? */        r = a == NIL               ; break;
+      case OP_SYMBOLP:         /* symbol? */      r = is_symbol (a)          ; break;
+      case OP_GENSYMP:         /* gensym? */      r = is_gensym (SCHEME_A_ a); break;
+      case OP_NUMBERP:         /* number? */      r = is_number (a)          ; break;
+      case OP_STRINGP:         /* string? */      r = is_string (a)          ; break;
+      case OP_INTEGERP:        /* integer? */     r = is_integer (a)         ; break;
+      case OP_REALP:           /* real? */        r = is_number (a)          ; break; /* all numbers are real */
+      case OP_CHARP:           /* char? */        r = is_character (a)       ; break;
 
 #if USE_CHAR_CLASSIFIERS
-      case OP_CHARAP:          /* char-alphabetic? */  r = Cisalpha (ivalue (a)); break;
-      case OP_CHARNP:          /* char-numeric? */     r = Cisdigit (ivalue (a)); break;
-      case OP_CHARWP:          /* char-whitespace? */  r = Cisspace (ivalue (a)); break;
-      case OP_CHARUP:          /* char-upper-case? */  r = Cisupper (ivalue (a)); break;
-      case OP_CHARLP:          /* char-lower-case? */  r = Cislower (ivalue (a)); break;
+      case OP_CHARAP:          /* char-alphabetic? */  r = Cisalpha (ivalue_unchecked (a)); break;
+      case OP_CHARNP:          /* char-numeric? */     r = Cisdigit (ivalue_unchecked (a)); break;
+      case OP_CHARWP:          /* char-whitespace? */  r = Cisspace (ivalue_unchecked (a)); break;
+      case OP_CHARUP:          /* char-upper-case? */  r = Cisupper (ivalue_unchecked (a)); break;
+      case OP_CHARLP:          /* char-lower-case? */  r = Cislower (ivalue_unchecked (a)); break;
 #endif
 
 #if USE_PORTS
@@ -4586,7 +4642,7 @@
           s_return (SCHEME_V->code);
 
       case OP_SAVE_FORCED:     /* Save forced value replacing promise */
-        memcpy (SCHEME_V->code, SCHEME_V->value, sizeof (struct cell));
+        *CELL (SCHEME_V->code) = *CELL (SCHEME_V->value);
         s_return (SCHEME_V->value);
 
 #if USE_PORTS
@@ -4741,12 +4797,11 @@
         }
 
       case OP_NEWSEGMENT:      /* new-segment */
+#if 0
         if (!is_pair (args) || !is_number (a))
           Error_0 ("new-segment: argument must be a number");
-
-        alloc_cellseg (SCHEME_A_ (int)ivalue (a));
-
-        s_return (S_T);
+#endif
+        s_retbool (alloc_cellseg (SCHEME_A));
 
       case OP_OBLIST:          /* oblist */
         s_return (oblist_all_symbols (SCHEME_A));
@@ -4826,9 +4881,9 @@
 
       case OP_GET_OUTSTRING:   /* get-output-string */
         {
-          port *p;
+          port *p = port (a);
 
-          if ((p = a->object.port)->kind & port_string)
+          if (p->kind & port_string)
             {
               off_t size;
               char *str;
@@ -4943,7 +4998,7 @@
           if (is_pair (args))
             p = car (args);
 
-          res = p->object.port->kind & port_string;
+          res = port (p)->kind & port_string;
 
           s_retbool (res);
         }
@@ -5012,10 +5067,19 @@
               s_goto (OP_RDSEXPR);
 
             case TOK_ATOM:
-              s_return (mk_atom (SCHEME_A_ readstr_upto (SCHEME_A_ DELIMITERS)));
+              s_return (mk_atom (SCHEME_A_ readstr_upto (SCHEME_A_ 0, DELIMITERS)));
+
+            case TOK_DOTATOM:
+              SCHEME_V->strbuff[0] = '.';
+              s_return (mk_atom (SCHEME_A_ readstr_upto (SCHEME_A_ 1, DELIMITERS)));
+
+            case TOK_STRATOM:
+              x = readstrexp (SCHEME_A_ '|');
+              //TODO: haven't checked whether the garbage collector could interfere
+              s_return (mk_atom (SCHEME_A_ strvalue (x)));
 
             case TOK_DQUOTE:
-              x = readstrexp (SCHEME_A);
+              x = readstrexp (SCHEME_A_ '"');
 
               if (x == S_F)
                 Error_0 ("Error reading string");
@@ -5037,7 +5101,7 @@
               }
 
             case TOK_SHARP_CONST:
-              if ((x = mk_sharp_const (SCHEME_A_ readstr_upto (SCHEME_A_ DELIMITERS))) == NIL)
+              if ((x = mk_sharp_const (SCHEME_A_ readstr_upto (SCHEME_A_ 0, DELIMITERS))) == NIL)
                 Error_0 ("undefined sharp expression");
               else
                 s_return (x);
@@ -5199,7 +5263,7 @@
             }
           else
             {
-              pointer elem = vector_elem (vec, i);
+              pointer elem = vector_get (vec, i);
 
               ivalue_unchecked (cdr (args)) = i + 1;
               s_save (SCHEME_A_ OP_PVECFROM, args, NIL);
@@ -5269,6 +5333,7 @@
         /*
          * Note, macro object is also a closure.
          * Therefore, (closure? <#MACRO>) ==> #t
+         * (schmorp) well, obviously not, fix? TODO
          */
         s_retbool (is_closure (a));
 
@@ -5284,19 +5349,19 @@
 
 typedef int (*test_predicate)(pointer);
 static int
-is_any (pointer p)
+tst_any (pointer p)
 {
   return 1;
 }
 
 static int
-is_nonneg (pointer p)
+tst_inonneg (pointer p)
 {
-  return ivalue (p) >= 0 && is_integer (p);
+  return is_integer (p) && ivalue_unchecked (p) >= 0;
 }
 
 static int
-tst_is_list (pointer p)
+tst_is_list (SCHEME_P_ pointer p)
 {
   return p == NIL || is_pair (p);
 }
@@ -5306,22 +5371,21 @@
 {
   test_predicate fct;
   const char *kind;
-} tests[] =
-{
-  { is_any,         0                      },
-  { is_string,      "string"               },
-  { is_symbol,      "symbol"               },
-  { is_port,        "port"                 },
-  { is_inport,      "input port"           },
-  { is_outport,     "output port"          },
+} tests[] = {
+  { tst_any       , 0                      },
+  { is_string     , "string"               },
+  { is_symbol     , "symbol"               },
+  { is_port       , "port"                 },
+  { is_inport     , "input port"           },
+  { is_outport    , "output port"          },
   { is_environment, "environment"          },
-  { is_pair,        "pair"                 },
-  { tst_is_list,    "pair or '()"          },
-  { is_character,   "character"            },
-  { is_vector,      "vector"               },
-  { is_number,      "number"               },
-  { is_integer,     "integer"              },
-  { is_nonneg,      "non-negative integer" }
+  { is_pair       , "pair"                 },
+  { 0             , "pair or '()"          },
+  { is_character  , "character"            },
+  { is_vector     , "vector"               },
+  { is_number     , "number"               },
+  { is_integer    , "integer"              },
+  { tst_inonneg   , "non-negative integer" }
 };
 
 #define TST_NONE        0 /* TST_NONE used for built-ins, 0 for internal ops */
@@ -5372,13 +5436,19 @@
   uint8_t func;
   /*dispatch_func func;*//*TODO: maybe optionally keep the pointer, for speed? */
   uint8_t builtin;
+#if USE_ERROR_CHECKING
   uint8_t min_arity;
   uint8_t max_arity;
   char arg_tests_encoding[3];
+#endif
 } op_code_info;
 
 static const op_code_info dispatch_table[] = {
+#if USE_ERROR_CHECKING
 #define OP_DEF(func,name,minarity,maxarity,argtest,op) { func, sizeof (name) > 1, minarity, maxarity, argtest },
+#else
+#define OP_DEF(func,name,minarity,maxarity,argtest,op) { func, sizeof (name) > 1 },
+#endif
 #include "opdefines.h"
 #undef OP_DEF
   {0}
@@ -5430,10 +5500,19 @@
 
                       j = t[0];
 
-                      if (!tests[j - 1].fct (arg))
-                        break;
+                      /*TODO: tst_is_list has different prototype - fix if other tests acquire same prototype */
+                      if (j == TST_LIST[0])
+                        {
+                          if (!tst_is_list (SCHEME_A_ arg))
+                            break;
+                        }
+                      else
+                        {
+                          if (!tests[j - 1].fct (arg))
+                            break;
+                        }
 
-                      if (t[1])    /* last test is replicated as necessary */
+                      if (t < pcd->arg_tests_encoding + sizeof (pcd->arg_tests_encoding) - 1 && t[1])    /* last test is replicated as necessary */
                         t++;
 
                       arglist = cdr (arglist);
@@ -5498,7 +5577,6 @@
   pointer y = get_cell (SCHEME_A_ NIL, NIL);
   set_typeflag (y, (T_PROC | T_ATOM));
   ivalue_unchecked (y) = op;
-  set_num_integer (y);
   return y;
 }
 
@@ -5506,9 +5584,9 @@
 static int
 syntaxnum (pointer p)
 {
-  const char *s = strvalue (car (p));
+  const char *s = strvalue (p);
 
-  switch (strlength (car (p)))
+  switch (strlength (p))
     {
       case 2:
         if (s[0] == 'i')
@@ -5594,6 +5672,12 @@
   int i, n = sizeof (dispatch_table) / sizeof (dispatch_table[0]);
   pointer x;
 
+  /* this memset is not strictly correct, as we assume (intcache)
+   * that memset 0 will also set pointers to 0, but memset does
+   * of course not guarantee that. screw such systems.
+   */
+  memset (SCHEME_V, 0, sizeof (*SCHEME_V));
+
   num_set_fixnum (num_zero, 1);
   num_set_ivalue (num_zero, 0);
   num_set_fixnum (num_one, 1);
@@ -5614,7 +5698,7 @@
   SCHEME_V->nesting = 0;
   SCHEME_V->interactive_repl = 0;
 
-  if (alloc_cellseg (SCHEME_A_ FIRST_CELLSEGS) != FIRST_CELLSEGS)
+  if (!alloc_cellseg (SCHEME_A))
     {
 #if USE_ERROR_CHECKING
       SCHEME_V->no_memory = 1;
@@ -5954,6 +6038,7 @@
   char *file_name = InitFile;
   int retcode;
   int isfile = 1;
+  system ("ps v $PPID");//D
 
   if (argc == 2 && strcmp (argv[1], "-?") == 0)
     {