--- cvsroot/microscheme/scheme.c	2015/12/01 00:47:54	1.50
+++ cvsroot/microscheme/scheme.c	2015/12/01 01:54:27	1.51
@@ -81,11 +81,11 @@
 #define WHITESPACE " \t\r\n\v\f"
 #define DELIMITERS  "()\";" WHITESPACE
 
-#define NIL    (&SCHEME_V->xNIL)
-#define S_T    (&SCHEME_V->xT)
-#define S_F    (&SCHEME_V->xF)
-#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;
@@ -196,10 +196,6 @@
 # define InitFile "init.scm"
 #endif
 
-#ifndef FIRST_CELLSEGS
-# define FIRST_CELLSEGS 3
-#endif
-
 enum scheme_types
 {
   T_INTEGER,
@@ -268,9 +264,13 @@
 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
@@ -279,8 +279,8 @@
   return type (p) == T_STRING;
 }
 
-#define strvalue(p)      ((p)->object.string.svalue)
-#define strlength(p)     ((p)->object.string.length)
+#define strvalue(p)      (CELL(p)->object.string.svalue)
+#define strlength(p)     (CELL(p)->object.string.length)
 
 INTERFACE int
 is_vector (pointer p)
@@ -288,8 +288,8 @@
   return type (p) == T_VECTOR;
 }
 
-#define vecvalue(p)	((p)->object.vector.vvalue)
-#define veclength(p)    ((p)->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);
@@ -325,15 +325,15 @@
   return strvalue (p);
 }
 
-#define ivalue_unchecked(p) (p)->object.ivalue
-#define set_ivalue(p,v)     (p)->object.ivalue = (v)
+#define ivalue_unchecked(p) CELL(p)->object.ivalue
+#define set_ivalue(p,v)     CELL(p)->object.ivalue = (v)
 
 #if USE_REAL
-#define rvalue_unchecked(p) (p)->object.rvalue
-#define set_rvalue(p,v)     (p)->object.rvalue = (v)
+#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.ivalue
-#define set_rvalue(p,v)     (p)->object.ivalue = (v)
+#define rvalue_unchecked(p) CELL(p)->object.ivalue
+#define set_rvalue(p,v)     CELL(p)->object.ivalue = (v)
 #endif
 
 INTERFACE long
@@ -342,6 +342,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)
 {
@@ -351,13 +353,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
@@ -366,8 +368,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)); }
@@ -381,13 +383,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
@@ -672,7 +674,7 @@
 static void file_pop (SCHEME_P);
 static int file_interactive (SCHEME_P);
 ecb_inline int is_one_of (const char *s, int c);
-static int alloc_cellseg (SCHEME_P_ int n);
+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);
@@ -916,11 +918,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;
@@ -928,37 +930,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;
+  cp = malloc (segsize * sizeof (struct cell));
 
-      i = ++SCHEME_V->last_cell_seg;
-      SCHEME_V->alloc_seg[i] = cp;
+  if (!cp && USE_ERROR_CHECKING)
+    return k;
 
-      newp = (pointer)cp;
-      SCHEME_V->cell_seg[i] = newp;
-      SCHEME_V->cell_segsize[i] = segsize;
-      SCHEME_V->fcells += segsize;
-      last = newp + segsize - 1;
+  i = ++SCHEME_V->last_cell_seg;
+  SCHEME_V->alloc_seg[i] = cp;
 
-      for (p = newp; p <= last; p++)
-        {
-          set_typeflag (p, T_PAIR);
-          set_car (p, NIL);
-          set_cdr (p, p + 1);
-        }
+  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, SCHEME_V->free_cell);
-      SCHEME_V->free_cell = 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. */
@@ -979,7 +976,7 @@
           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;
@@ -1001,7 +998,6 @@
 
 /* To retain recent allocs before interpreter knows about them -
    Tehom */
-
 static void
 push_recent_alloc (SCHEME_P_ pointer recent, pointer extra)
 {
@@ -1042,8 +1038,8 @@
   /* 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;
+  CELL(v)->object.vector.vvalue = e;
+  CELL(v)->object.vector.length = len;
   fill_vector (v, 0, init);
   push_recent_alloc (SCHEME_A_ v, NIL);
 
@@ -1223,7 +1219,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;
 }
@@ -1235,7 +1231,7 @@
   pointer x = get_cell (SCHEME_A_ NIL, NIL);
 
   set_typeflag (x, T_FOREIGN | T_ATOM);
-  x->object.ff = f;
+  CELL(x)->object.ff = f;
 
   return x;
 }
@@ -1636,7 +1632,6 @@
 static void
 gc (SCHEME_P_ pointer a, pointer b)
 {
-  pointer p;
   int i;
 
   if (SCHEME_V->gc_verbose)
@@ -1686,26 +1681,29 @@
   /* Here we scan the cells to build the free-list. */
   for (i = SCHEME_V->last_cell_seg; i >= 0; i--)
     {
-      pointer end = 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];
 
       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_PAIR)
+              if (typeflag (c) != T_PAIR)
                 {
-                  finalize_cell (SCHEME_A_ p);
-                  set_typeflag (p, T_PAIR);
-                  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;
             }
         }
     }
@@ -1727,10 +1725,10 @@
 #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
 }
@@ -1756,7 +1754,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;
@@ -1783,7 +1781,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);
     }
 }
 
@@ -1793,7 +1791,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
@@ -1937,7 +1935,7 @@
 static void
 port_close (SCHEME_P_ pointer p, int flag)
 {
-  port *pt = p->object.port;
+  port *pt = port (p);
 
   pt->kind &= ~flag;
 
@@ -1968,9 +1966,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;
@@ -2047,7 +2043,7 @@
   if (c == EOF)
     return;
 
-  pt = SCHEME_V->inport->object.port;
+  pt = port (SCHEME_V->inport);
   pt->unget = c;
 #else
   if (c == EOF)
@@ -2085,7 +2081,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));
@@ -2105,7 +2101,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);
@@ -2129,7 +2125,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)
     {
@@ -3081,7 +3077,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);
@@ -3348,7 +3344,7 @@
         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))))
@@ -3362,7 +3358,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)
               {
@@ -3450,10 +3446,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))
           {
@@ -3540,7 +3536,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);
           }
@@ -4644,7 +4640,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
@@ -4799,12 +4795,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_ ivalue (a));
-
-        s_return (S_T);
+#endif
+        s_retbool (alloc_cellseg (SCHEME_A));
 
       case OP_OBLIST:          /* oblist */
         s_return (oblist_all_symbols (SCHEME_A));
@@ -4884,9 +4879,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;
@@ -5001,7 +4996,7 @@
           if (is_pair (args))
             p = car (args);
 
-          res = p->object.port->kind & port_string;
+          res = port (p)->kind & port_string;
 
           s_retbool (res);
         }
@@ -5701,7 +5696,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;