From 89840596c64647dbbd64d54fa13b10eca68da88d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 28 Aug 1989 18:30:12 +0000
Subject: [PATCH] * Add Jinx's changes to support 6 bit type codes.  Make these
 the default for HP 9000 series 300.

* Update Ppband to handle compiled code.

* Significant rewrite of parts of the bignum code.  This is the
beginning of a redesign of this code.

* Regularize some of the object selector macros.
---
 v7/src/microcode/bchmmg.c    |  10 +-
 v7/src/microcode/bignum.c    | 572 +++++++++++++++++++----------------
 v7/src/microcode/char.c      |   8 +-
 v7/src/microcode/config.h    |  53 +++-
 v7/src/microcode/const.h     |  32 +-
 v7/src/microcode/edwin.h     |  16 +-
 v7/src/microcode/extern.h    |   6 +-
 v7/src/microcode/gctype.c    |  26 +-
 v7/src/microcode/intern.c    |   4 +-
 v7/src/microcode/list.c      |  50 ++-
 v7/src/microcode/lookup.h    |  28 +-
 v7/src/microcode/m/hp9k300.h |   6 +-
 v7/src/microcode/memmag.c    |  12 +-
 v7/src/microcode/object.h    | 140 +++++----
 v7/src/microcode/ppband.c    |  32 +-
 v7/src/microcode/prim.c      |  23 +-
 v7/src/microcode/prims.h     |  28 +-
 v7/src/microcode/psbmap.h    |   6 +-
 v7/src/microcode/psbtobin.c  |  10 +-
 v7/src/microcode/syntax.c    |   8 +-
 v7/src/microcode/syntax.h    |   5 +-
 v7/src/microcode/trap.h      |  52 ++--
 v7/src/microcode/types.h     |  12 +-
 v7/src/microcode/utils.c     |  19 +-
 v7/src/microcode/version.h   |   4 +-
 v7/src/microcode/wsize.c     |   4 +-
 v8/src/microcode/const.h     |  32 +-
 v8/src/microcode/gctype.c    |  26 +-
 v8/src/microcode/lookup.h    |  28 +-
 v8/src/microcode/object.h    | 140 +++++----
 v8/src/microcode/ppband.c    |  32 +-
 v8/src/microcode/psbmap.h    |   6 +-
 v8/src/microcode/psbtobin.c  |  10 +-
 v8/src/microcode/trap.h      |  52 ++--
 v8/src/microcode/types.h     |  12 +-
 v8/src/microcode/version.h   |   4 +-
 36 files changed, 906 insertions(+), 602 deletions(-)

diff --git a/v7/src/microcode/bchmmg.c b/v7/src/microcode/bchmmg.c
index e7f72f2c7..b39b2d520 100644
--- a/v7/src/microcode/bchmmg.c
+++ b/v7/src/microcode/bchmmg.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.46 1989/08/15 07:15:47 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchmmg.c,v 9.47 1989/08/28 18:28:15 cph Exp $ */
 
 /* Memory management top level.  Garbage collection to disk.
 
@@ -212,6 +212,7 @@ void
 Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
      int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size;
 {
+  Pointer test_value;
   int Real_Stack_Size;
 
   Real_Stack_Size = Stack_Allocation_Size(Our_Stack_Size);
@@ -249,7 +250,10 @@ Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
   gc_disk_buffer_2 = (gc_disk_buffer_1 + GC_BUFFER_SPACE);
 
   /* Consistency check 3 */
-  if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0)
+  test_value = (Make_Pointer(LAST_TYPE_CODE, Highest_Allocated_Address));
+
+  if (((OBJECT_TYPE(test_value)) != LAST_TYPE_CODE) ||
+      ((Get_Pointer(test_value)) != Highest_Allocated_Address))
   {
     fprintf(stderr,
 	    "Largest address does not fit in datum field of Pointer.\n");
@@ -878,7 +882,7 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
   }
   ENTER_CRITICAL_SECTION ("garbage collector");
   gc_counter += 1;
-  GC_Reserve = Get_Integer(Arg1);
+  GC_Reserve = (UNSIGNED_FIXNUM_VALUE (Arg1));
   GC(EMPTY_LIST);
   CLEAR_INTERRUPT(INT_GC);
   Pop_Primitive_Frame(1);
diff --git a/v7/src/microcode/bignum.c b/v7/src/microcode/bignum.c
index df100683d..c23877733 100644
--- a/v7/src/microcode/bignum.c
+++ b/v7/src/microcode/bignum.c
@@ -1,6 +1,8 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.27 1989/08/28 18:28:19 cph Exp $
+
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,10 +32,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/bignum.c,v 9.26 1988/08/15 20:36:45 cph Rel $
-
-   This file contains the procedures for handling BIGNUM Arithmetic. 
-*/
+/* BIG NUMber arithmetic */
 
 #include "scheme.h"
 #include <math.h>
@@ -42,20 +41,157 @@ MIT in each case. */
 #include "flonum.h"
 #include "zones.h"
 
-/* General Purpose Utilities */
+/* The following macros are the beginnings of a redesign of the bignum
+   code.  Some of the procedures and primitives defined here use these
+   new conventions.  Please update things as you work on them. */
 
-Pointer
-return_bignum_zero()
+#define DIGITS_PER_POINTER ((sizeof (Pointer)) / (sizeof (bigdigit)))
+
+#define DIGITS_TO_POINTERS(n_digits)					\
+  (((n_digits) + (DIGITS_PER_POINTER - 1)) / DIGITS_PER_POINTER)
+
+#define DIGITS_TO_GC_LENGTH(n_digits) (DIGITS_TO_POINTERS ((n_digits) + 2))
+
+#define DIGITS_TO_GC_HEADER(n_digits)					\
+  (Make_Non_Pointer (TC_MANIFEST_NM_VECTOR, (DIGITS_TO_GC_LENGTH (n_digits))))
+
+#define BIGNUM_PTR(bignum, index)					\
+  (((bigdigit *) (Nth_Vector_Loc ((bignum), 1))) + (index))
+
+#define BIGNUM_REF(bignum, index) (* (BIGNUM_PTR ((bignum), (index))))
+#define BIGNUM_SIGN(bignum) (BIGNUM_REF ((bignum), 0))
+#define BIGNUM_LENGTH(bignum) (BIGNUM_REF ((bignum), 1))
+#define BIGNUM_START_PTR(bignum) (BIGNUM_PTR ((bignum), 2))
+#define BIGNUM_END_PTR(bignum)						\
+  (BIGNUM_PTR ((bignum), (2 + (BIGNUM_LENGTH (bignum)))))
+
+#define BIGNUM_NEGATIVE_P(bignum) ((BIGNUM_SIGN (bignum)) == 0)
+#define BIGNUM_ZERO_P(bignum) ((BIGNUM_LENGTH (bignum)) == 0)
+
+static Pointer
+make_bignum_zero ()
+{
+  Pointer bignum =
+    (allocate_non_marked_vector
+     (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (0)), true));
+  (BIGNUM_SIGN (bignum)) = 1;
+  (BIGNUM_LENGTH (bignum)) = 0;
+  return (bignum);
+}
+
+static Pointer
+bignum_allocate (n_digits, negative_p)
+     long n_digits;
+     Boolean negative_p;
+{
+  Pointer bignum =
+    (allocate_non_marked_vector
+     (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (n_digits)), true));
+  (BIGNUM_SIGN (bignum)) = (negative_p ? 0 : 1);
+  (BIGNUM_LENGTH (bignum)) = n_digits;
+  return (bignum);
+}
+
+static void
+bignum_destructive_copy (source, target)
+     Pointer source;
+     Pointer target;
+{
+  fast bigdigit * scan_source;
+  fast bigdigit * end_source;
+  fast bigdigit * scan_target;
+
+  (BIGNUM_SIGN (target)) = (BIGNUM_SIGN (source));
+  (BIGNUM_LENGTH (target)) = (BIGNUM_LENGTH (source));
+  scan_source = (BIGNUM_START_PTR (source));
+  end_source = (BIGNUM_END_PTR (source));
+  scan_target = (BIGNUM_START_PTR (target));
+  while (scan_source < end_source)
+    (*scan_target++) = (*scan_source++);
+  return;
+}
+
+static Pointer
+bignum_copy (source)
+     Pointer source;
+{
+  Pointer target =
+    (allocate_non_marked_vector
+     (TC_BIG_FIXNUM, (DIGITS_TO_GC_LENGTH (BIGNUM_LENGTH (source))), true));
+  bignum_destructive_copy (source, target);
+  return (target);
+}
+
+static int
+bignum_length_in_bits (bignum)
+     Pointer bignum;
+{
+  if (BIGNUM_ZERO_P (bignum))
+    return (0);
+  {
+    int max_index = ((BIGNUM_LENGTH (bignum)) - 1);
+    fast int result = (max_index * SHIFT);
+    fast unsigned long max_digit = (BIGNUM_REF (bignum, max_index));
+    while (max_digit > 0)
+      {
+	result += 1;
+	max_digit >>= 1;
+      }
+    return (result);
+  }
+}
+
+static unsigned long
+scale_down (source, target, denominator)
+     Pointer source;
+     Pointer target;
+     unsigned long denominator;
 {
-  bigdigit *REG;
-  long Align_0 = Align(0);
-  Primitive_GC_If_Needed(Align_0);
-  REG = BIGNUM(Free);
-  Prepare_Header(REG, 0, POSITIVE);
-  Free += Align_0;
-  return Make_Pointer(TC_BIG_FIXNUM, Free-Align_0);
+  fast unsigned long remainder;
+  fast unsigned long quotient;
+  fast bigdigit * scan_source;
+  fast bigdigit * scan_target;
+  fast bigdigit * start_source;
+
+  (BIGNUM_SIGN (target)) = (BIGNUM_SIGN (source));
+  (BIGNUM_LENGTH (target)) = (BIGNUM_LENGTH (source));
+  scan_source = (BIGNUM_END_PTR (source));
+  start_source = (BIGNUM_START_PTR (source));
+  scan_target = (BIGNUM_END_PTR (target));
+  remainder = 0;
+  while (scan_source > start_source)
+    {
+      remainder = ((remainder << SHIFT) + (*--scan_source));
+      quotient = (remainder / denominator);
+      remainder = (remainder % denominator);
+      (*--scan_target) = quotient;
+    }
+  return (remainder);
 }
 
+static unsigned long
+scale_down_self (bignum, denominator)
+     Pointer bignum;
+     unsigned long denominator;
+{
+  fast unsigned long remainder;
+  fast unsigned long quotient;
+  fast bigdigit * scan;
+  fast bigdigit * start;
+
+  scan = (BIGNUM_END_PTR (bignum));
+  start = (BIGNUM_START_PTR (bignum));
+  remainder = 0;
+  while (scan > start)
+    {
+      remainder = ((remainder << SHIFT) + (*--scan));
+      quotient = (remainder / denominator);
+      remainder = (remainder % denominator);
+      (*scan) = quotient;
+    }
+  return (remainder);
+}
+
 void
 trim_bignum(ARG)
      bigdigit *ARG;
@@ -87,22 +223,6 @@ copy_bignum(SOURCE, TARGET)
     *TARGET++ = *SOURCE++;
   return;
 }
-
-long
-Find_Length(pradix, length)
-     fast long pradix;
-     bigdigit length;
-{
-  fast int log_pradix;
-
-  log_pradix = 0;
-  while (pradix != 1)
-  {
-    pradix = pradix >> 1;
-    log_pradix += 1;
-  }
-  return (((SHIFT / log_pradix) + 1) * length);
-}
 
 /* scale() and unscale() used by Division and Listify */
 
@@ -220,132 +340,90 @@ big_compare(ARG1, ARG2)
 }
 
 Pointer
-Fix_To_Big(Arg1)
-     Pointer Arg1;
+Fix_To_Big (object)
+     Pointer object;
 {
-  fast bigdigit *Answer, *SCAN, *size;
-  long Length, ARG1;
-
-  if (Type_Code(Arg1) != TC_FIXNUM) Primitive_Error(ERR_ARG_1_WRONG_TYPE);
-  if (Get_Integer(Arg1) == 0)
-  { long Align_0 = Align(0);
-    bigdigit *REG;
-    Primitive_GC_If_Needed(2);
-    REG = BIGNUM(Free);
-    Prepare_Header(REG, 0, POSITIVE);
-    Free += Align_0;
-    return Make_Pointer(TC_BIG_FIXNUM, Free-Align_0);
-  }
-  Length = Align(FIXNUM_LENGTH_AS_BIGNUM);
-  Primitive_GC_If_Needed(Length);
-  Sign_Extend(Arg1, ARG1);
-  Answer = BIGNUM(Free); 
-  Prepare_Header(Answer, 0, (ARG1 >= 0) ? POSITIVE : NEGATIVE);
-  size   = &LEN(Answer);
-  if (ARG1 < 0) ARG1 = - ARG1;
-  for (SCAN = Bignum_Bottom(Answer); ARG1 != 0; *size += 1)
-  { *SCAN++ = Rem_Radix(ARG1);
-    ARG1    = Div_Radix(ARG1);
+  fast long value;
+  fast Pointer result;
+
+  FIXNUM_VALUE (object, value);
+  if (value == 0)
+    return (make_bignum_zero ());
+  else if (value > 0)
+    result = (bignum_allocate (FIXNUM_LENGTH_AS_BIGNUM, false));
+  else
+    {
+      result = (bignum_allocate (FIXNUM_LENGTH_AS_BIGNUM, true));
+      value = (- value);
+    }
+  {
+    fast bigdigit * scan = (BIGNUM_START_PTR (result));
+    fast long length = 0;
+    while (value > 0)
+      {
+	(*scan++) = (value & DIGIT_MASK);
+	value = (value >> SHIFT);
+	length += 1;
+      }
+    (BIGNUM_LENGTH (result)) = length;
+    Fast_Vector_Set (result, 0, (DIGITS_TO_GC_HEADER (length)));
   }
-  Length = Align(*size);
-  *((Pointer *) Answer) = Make_Header(Length);
-  Free  += Length;
-  Debug_Test(Free-Length);
-  return Make_Pointer(TC_BIG_FIXNUM, Free-Length);
+  return (result);
 }
-
+
 Pointer
-Big_To_Fix (bignum_object)
-     Pointer bignum_object;
+Big_To_Fix (object)
+     Pointer object;
 {
-  fast bigdigit *bptr, *scan;
-  fast long result, i;
-  long Length;
-
-  if ((Type_Code (bignum_object)) != TC_BIG_FIXNUM)
-    return (bignum_object);
-  bptr = BIGNUM (Get_Pointer (bignum_object));
-  Length = LEN (bptr);
-  if (Length == 0)
-    return (Make_Unsigned_Fixnum(0));
-  if (Length > FIXNUM_LENGTH_AS_BIGNUM)
-    return (bignum_object);
-
-  scan = Bignum_Top (bptr);
-  result = *scan--;
-
-  if (result < 0)
-    return (bignum_object);
-
-  if (Length == FIXNUM_LENGTH_AS_BIGNUM)
+  if (! (BIGNUM_P (object)))
+    return (object);
+  if (BIGNUM_ZERO_P (object))
+    return (MAKE_UNSIGNED_FIXNUM (0));
   {
-    long saved_result, length_in_bits;
-
-    saved_result = result;
-
-    for (i = 0; result != 0; i+= 1)
-      result = result >> 1;
-
-    length_in_bits = i + ((Length == 0) ? 0 : ((Length - 1)  * SHIFT));
-
-    if (length_in_bits > FIXNUM_LENGTH)
-      return (bignum_object);
-
-    result = (saved_result &
-	      ((1 << ((FIXNUM_LENGTH + 1) -
-		       ((FIXNUM_LENGTH + 1) % SHIFT))) - 1));
-
+    long length = (BIGNUM_LENGTH (object));
+    if (length > FIXNUM_LENGTH_AS_BIGNUM)
+      return (object);
+    {
+      fast bigdigit * start = (BIGNUM_START_PTR (object));
+      fast bigdigit * scan = (start + length);
+      fast long result = (*--scan);
+      if (length == FIXNUM_LENGTH_AS_BIGNUM)
+	{
+	  long max_value = (1 << (FIXNUM_LENGTH - ((length - 1) * SHIFT)));
+
+	  if ((result > max_value) ||
+	      ((result == max_value) && (! (BIGNUM_NEGATIVE_P (object)))))
+	    return (object);
+	}
+      while (scan > start)
+	result = ((result << SHIFT) + (*--scan));
+      if (BIGNUM_NEGATIVE_P (object))
+	result = (- result);
+      return ((Fixnum_Fits (result)) ? (MAKE_SIGNED_FIXNUM (result)) : object);
+    }
   }
-
-  for (i = (Length - 1); (i > 0); i -= 1)
-    result = (Mul_Radix (result) + *scan--);
-
-  if (result < 0)
-    return (bignum_object);
-  if (NEG_BIGNUM (bptr))
-    result = (- result);
-  return (Fixnum_Fits (result)
-	  ? Make_Signed_Fixnum (result)
-	  : bignum_object);
 }
 
-Boolean
-Fits_Into_Flonum(Bignum)
-     bigdigit *Bignum;
-{
-  fast int k;
-  quick bigdigit top_digit;
-
-  k = (LEN(Bignum) - 1) * SHIFT;
-  for (top_digit = *Bignum_Top(Bignum); top_digit != 0; k++)
-    top_digit >>= 1;
-
-/* If precision should not be lost,
-  if (k <= FLONUM_MANTISSA_BITS) return true;
-   Otherwise,
-*/
-
-  if (k <= MAX_FLONUM_EXPONENT) return true;
-  return false;
-}
-
 Pointer
-Big_To_Float(Arg1)
-     Pointer Arg1;
+Big_To_Float (bignum)
+     Pointer bignum;
 {
-  fast bigdigit *ARG1, *LIMIT;
-  fast double F = 0.0;
-
-  ARG1 = BIGNUM(Get_Pointer(Arg1));
-  if (!Fits_Into_Flonum(ARG1)) return Arg1;
-  Primitive_GC_If_Needed(FLONUM_SIZE+1);
-  LIMIT = Bignum_Bottom(ARG1);
-  ARG1 = Bignum_Top(ARG1);
-  while (ARG1 >= LIMIT)  F = (F * ((double) RADIX)) + ((double) *ARG1--);
-  if (NEG_BIGNUM(BIGNUM(Get_Pointer(Arg1)))) F = -F;
-  return Allocate_Float(F);
+  /* If precision should not be lost,
+     compare to FLONUM_MANTISSA_BITS instead. */
+  if ((bignum_length_in_bits (bignum)) > MAX_FLONUM_EXPONENT)
+    return (bignum);
+  {
+    fast bigdigit * start = (BIGNUM_START_PTR (bignum));
+    fast bigdigit * scan = (BIGNUM_END_PTR (bignum));
+    fast double accumulator = (0.0);
+    while (scan > start)
+      accumulator = ((accumulator * ((double) RADIX)) + ((double) (*--scan)));
+    if (BIGNUM_NEGATIVE_P (bignum))
+      accumulator = (- accumulator);
+    Primitive_GC_If_Needed (FLONUM_SIZE + 1);
+    return (Allocate_Float (accumulator));
+  }
 }
-
 
 #ifdef HAS_FREXP
 extern double frexp(), ldexp();
@@ -363,7 +441,7 @@ Float_To_Big(flonum)
   long Align_size;
 
   if (flonum == 0.0)
-    return return_bignum_zero();
+    return (make_bignum_zero ());
   mantissa = frexp(flonum, &exponent);
   if (flonum < 0) mantissa = -mantissa;
   if (mantissa >= 1.0)
@@ -522,7 +600,7 @@ plus_signed_bignum(ARG1, ARG2)
      bigdigit *ARG1, *ARG2;
 { /* Special Case for answer being zero */
   if (ZERO_BIGNUM(ARG1) && ZERO_BIGNUM(ARG2))
-     return return_bignum_zero();
+     return (make_bignum_zero ());
   switch(Categorize_Sign(ARG1, ARG2))
   { case BOTH_POSITIVE : return(plus_unsigned_bignum(ARG1, ARG2, POSITIVE));
     case ARG1_NEGATIVE : return(minus_unsigned_bignum(ARG2, ARG1, POSITIVE));
@@ -542,7 +620,7 @@ minus_signed_bignum(ARG1, ARG2)
   /* Special Case for answer being zero */
 
   if (ZERO_BIGNUM(ARG1) && ZERO_BIGNUM(ARG2))
-     return return_bignum_zero();
+     return (make_bignum_zero ());
 
   /* Dispatches According to Sign of Args */
 
@@ -619,7 +697,7 @@ multiply_signed_bignum(ARG1, ARG2)
      bigdigit *ARG1, *ARG2;
 {
   if (ZERO_BIGNUM(ARG1) || ZERO_BIGNUM(ARG2))
-     return return_bignum_zero();
+     return (make_bignum_zero ());
 
   switch(Categorize_Sign(ARG1,ARG2))
   { case BOTH_POSITIVE :
@@ -744,7 +822,7 @@ div_internal(ARG1, ARG2, Quotient)
  */
 
 Pointer
-div_signed_bignum(ARG1, ARG2)
+div_signed_bignum (ARG1, ARG2)
      bigdigit *ARG1, *ARG2;
 {
   bigdigit *SARG2;
@@ -760,8 +838,7 @@ div_signed_bignum(ARG1, ARG2)
   if (big_compare_unsigned(ARG1, ARG2) == TWO_BIGGER)
   {
     /* Trivial Solution for ARG1 > ARG2 
-     * Quotient is zero and the remainder is just a copy of Arg_1.
-     */
+       Quotient is zero and the remainder is just a copy of Arg_1. */
 
     Primitive_GC_If_Needed(Align(0)+Align(LEN(ARG1)));
     QUOT = BIGNUM(Free);
@@ -774,9 +851,8 @@ div_signed_bignum(ARG1, ARG2)
   else if (LEN(ARG2)==1)
   {
     /* Divisor is only one digit long.
-     * unscale() is used to divide out Arg_1 and the remainder is the
-     * single digit returned by unscale(), coerced to a bignum.
-     */
+       unscale() is used to divide out Arg_1 and the remainder is the
+       single digit returned by unscale(), coerced to a bignum. */
 
     Primitive_GC_If_Needed(Align(LEN(ARG1))+Align(1));
     QUOT = BIGNUM(Free);
@@ -791,18 +867,14 @@ div_signed_bignum(ARG1, ARG2)
     trim_bignum(QUOT);
   }
   else
-
   {
     /* Usual case. div_internal() is called.  A normalized copy of Arg_1
-     * resides in REMD, which ultimately becomes the remainder.  The
-     * normalized copy of Arg_2 is in SARG2.
-     */
+       resides in REMD, which ultimately becomes the remainder.  The
+       normalized copy of Arg_2 is in SARG2. */
 
-    bigdouble temp;
-
-    temp = (Align(LEN(ARG1)-LEN(ARG2)+1) + Align(LEN(ARG1)+1)
-	    + Align(LEN(ARG2)+1));
-    Primitive_GC_If_Needed(temp);
+    bigdouble temp =
+      (Align(LEN(ARG1)-LEN(ARG2)+1) + Align(LEN(ARG1)+1) + Align(LEN(ARG2)+1));
+    Primitive_GC_If_Needed (temp);
     QUOT = BIGNUM(Free);
     *Free = Make_Header(Align(LEN(ARG1)-LEN(ARG2)+1));
     Free += Align(LEN(ARG1)-LEN(ARG2)+1);
@@ -876,122 +948,100 @@ print_digits(name, num, how_many)
 }
 #endif
 
-/* Top level bignum primitives */
-/* Coercion primitives. */
-
-/* (COERCE-FIXNUM-TO-BIGNUM FIXNUM)
-      Returns its argument if FIXNUM isn't a fixnum.  Otherwise 
-      it returns the corresponding bignum.
-*/
-DEFINE_PRIMITIVE ("COERCE-FIXNUM-TO-BIGNUM", Prim_fix_to_big, 1, 1, 0)
+DEFINE_PRIMITIVE ("COERCE-FIXNUM-TO-BIGNUM", Prim_fix_to_big, 1, 1,
+  "Returns the bignum that corresponds to FIXNUM.")
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Arg_1_Type(TC_FIXNUM);
-  return Fix_To_Big(Arg1);
+  CHECK_ARG (1, FIXNUM_P);
+  PRIMITIVE_RETURN (Fix_To_Big (ARG_REF (1)));
 }
 
-/* (COERCE-BIGNUM-TO-FIXNUM BIGNUM)
-   When given a bignum, returns the equivalent fixnum if there is
-   one. If BIGNUM is out of range, or isn't a bignum, returns
-   BIGNUM. */
-
-DEFINE_PRIMITIVE ("COERCE-BIGNUM-TO-FIXNUM", Prim_big_to_fix, 1, 1, 0)
+DEFINE_PRIMITIVE ("COERCE-BIGNUM-TO-FIXNUM", Prim_big_to_fix, 1, 1,
+  "Returns the fixnum that corresponds to BIGNUM.
+If BIGNUM cannot be represented as a fixnum, returns BIGNUM.")
 {
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
-  Arg_1_Type (TC_BIG_FIXNUM);
-  return (Big_To_Fix (Arg1));
+  CHECK_ARG (1, BIGNUM_P);
+  PRIMITIVE_RETURN (Big_To_Fix (ARG_REF (1)));
 }
-
-/* (LISTIFY-BIGNUM BIGNUM RADIX)
-      Returns a list of numbers, in the range 0 through RADIX-1, which
-      represent the BIGNUM in that radix.
-*/
-DEFINE_PRIMITIVE ("LISTIFY-BIGNUM", Prim_listify_bignum, 2, 2, 0)
+
+DEFINE_PRIMITIVE ("LISTIFY-BIGNUM", Prim_listify_bignum, 2, 2,
+  "Returns a list of the digits of BIGNUM in RADIX.")
 {
-  fast bigdigit *TOP1, *size;
-  quick Pointer *RFree;
-  fast bigdigit *ARG1;
-  fast long pradix;
-  Primitive_2_Args();
+  Pointer bignum;
+  long radix;
+  PRIMITIVE_HEADER (2);
 
-  Arg_1_Type(TC_BIG_FIXNUM);
-  Arg_2_Type(TC_FIXNUM);
-  Set_Time_Zone(Zone_Math);
+  Set_Time_Zone (Zone_Math);
 
-  ARG1 = BIGNUM(Get_Pointer(Arg1));
-  size = &LEN(ARG1);  
-  if (*size == 0)
-  {
-    Primitive_GC_If_Needed(2);
-    *Free++ = Make_Unsigned_Fixnum(0);
-    *Free++ = EMPTY_LIST;
-    return Make_Pointer(TC_LIST, Free-2);
-  }
-  Sign_Extend(Arg2, pradix);
-  Primitive_GC_If_Needed(Find_Length(pradix, *size)+Align(*size));
-  ARG1  = BIGNUM(Free);
-  copy_bignum(BIGNUM(Get_Pointer(Arg1)), ARG1);
-  Free += Align(*size);
-  RFree = Free;
-  size = &LEN(ARG1);
-  TOP1 = Bignum_Top(ARG1);
-  while (*size > 0)
+  CHECK_ARG (1, BIGNUM_P);
+  bignum = (ARG_REF (1));
+  radix = (arg_nonnegative_integer (2, (BIGGEST_FIXNUM + 1)));
+  if (BIGNUM_ZERO_P (bignum))
+    PRIMITIVE_RETURN (cons ((MAKE_UNSIGNED_FIXNUM (0)), EMPTY_LIST));
   {
-    *RFree++ = Make_Unsigned_Fixnum(unscale(ARG1, ARG1, pradix));
-    *RFree = Make_Pointer(TC_LIST, RFree-3); 
-    RFree += 1; 
-    if (*TOP1 == 0) 
-    {
-      *size -= 1;
-      TOP1--;
-    }
+    Pointer working_copy = (bignum_copy (bignum));
+    fast bigdigit * start_copy = (BIGNUM_START_PTR (working_copy));
+    fast bigdigit * end_copy = (BIGNUM_END_PTR (working_copy));
+    fast Pointer previous_cdr = EMPTY_LIST;
+    while (end_copy > start_copy)
+      {
+	if ((end_copy [-1]) == 0)
+	  end_copy -= 1;
+	else
+	  previous_cdr =
+	    (cons
+	     ((MAKE_UNSIGNED_FIXNUM (scale_down_self (working_copy, radix))),
+	      previous_cdr));
+      }
+    PRIMITIVE_RETURN (previous_cdr);
   }
-  Free[CONS_CDR] = EMPTY_LIST;
-  Free = RFree;
-  return Make_Pointer(TC_LIST, RFree-2);
 }
 
-/* All the binary bignum primitives take two arguments and return NIL
-   if either of them is not a bignum.  If both arguments are bignums,
-   the perform the operation and return the answer.
-*/
-
-#define Binary_Primitive(Op)						\
+#define BINARY_PRIMITIVE(operator)					\
 {									\
-  Pointer Result, *Orig_Free;						\
-  Primitive_2_Args();							\
+  PRIMITIVE_HEADER (2);							\
 									\
-  Arg_1_Type(TC_BIG_FIXNUM);						\
-  Arg_2_Type(TC_BIG_FIXNUM);						\
-  Set_Time_Zone(Zone_Math);						\
-  Orig_Free = Free;							\
-  Result = Op(BIGNUM(Get_Pointer(Arg1)), BIGNUM(Get_Pointer(Arg2)));	\
-  if (Consistency_Check && (Get_Pointer(Result) != Orig_Free))		\
-  {									\
-    fprintf(stderr, "\nBignum operation result at 0x%x, Free was 0x%x\n", \
-           Address(Result), Free);					\
-    Microcode_Termination(TERM_EXIT);					\
-  }									\
-  Free = Nth_Vector_Loc(Result, Vector_Length(Result)+1);		\
-  if (Consistency_Check && (Free > Heap_Top))				\
+  Set_Time_Zone (Zone_Math);						\
+  CHECK_ARG (1, BIGNUM_P);						\
+  CHECK_ARG (2, BIGNUM_P);						\
   {									\
-    fprintf(stderr, "\nBignum operation result at 0x%x, length 0x%x\n",	\
-           Address(Result), Vector_Length(Result));			\
-    Microcode_Termination(TERM_EXIT);					\
+    Pointer * original_free = Free;					\
+    Pointer result =							\
+      (operator								\
+       ((BIGNUM (Get_Pointer (ARG_REF (1)))),				\
+	(BIGNUM (Get_Pointer (ARG_REF (2))))));				\
+    if (Consistency_Check && ((Get_Pointer (result)) != original_free))	\
+      {									\
+	fprintf (stderr,						\
+		 "\nBignum operation result at 0x%x, Free was 0x%x\n",	\
+		 (Address (result)),					\
+		 Free);							\
+	Microcode_Termination (TERM_EXIT);				\
+      }									\
+    Free = (Nth_Vector_Loc (result, ((Vector_Length (result)) + 1)));	\
+    if (Consistency_Check && (Free > Heap_Top))				\
+      {									\
+	fprintf (stderr,						\
+		 "\nBignum operation result at 0x%x, length 0x%x\n",	\
+		 (Address (result)),					\
+		 (Vector_Length (result)));				\
+	Microcode_Termination (TERM_EXIT);				\
+      }									\
+    PRIMITIVE_RETURN (result);						\
   }									\
-  return Result;							\
 }
 
 DEFINE_PRIMITIVE ("PLUS-BIGNUM", Prim_plus_bignum, 2, 2, 0)
-Binary_Primitive(plus_signed_bignum)
+BINARY_PRIMITIVE (plus_signed_bignum)
 
 DEFINE_PRIMITIVE ("MINUS-BIGNUM", Prim_minus_bignum, 2, 2, 0)
-Binary_Primitive(minus_signed_bignum)
+BINARY_PRIMITIVE (minus_signed_bignum)
 
 DEFINE_PRIMITIVE ("MULTIPLY-BIGNUM", Prim_multiply_bignum, 2, 2, 0)
-Binary_Primitive(multiply_signed_bignum)
+BINARY_PRIMITIVE (multiply_signed_bignum)
 
 /* (DIVIDE-BIGNUM ONE-BIGNUM ANOTHER_BIGNUM)
  * returns a cons of the bignum quotient and remainder of both arguments.
@@ -999,7 +1049,7 @@ Binary_Primitive(multiply_signed_bignum)
 
 DEFINE_PRIMITIVE ("DIVIDE-BIGNUM", Prim_divide_bignum, 2, 2, 0)
 {
-  Pointer Result, *End_Of_First, *First, *Second, *Orig_Free=Free;
+  Pointer Result, *End_Of_First, *First, *Second, *original_free=Free;
   Primitive_2_Args();
 
   Arg_1_Type(TC_BIG_FIXNUM);
@@ -1021,13 +1071,13 @@ DEFINE_PRIMITIVE ("DIVIDE-BIGNUM", Prim_divide_bignum, 2, 2, 0)
       fprintf(stderr, "\nBignum_Divide: results swapped.\n");
       Microcode_Termination(TERM_EXIT);
     }
-    else if (First != Orig_Free+2)
+    else if (First != original_free+2)
     {
       fprintf(stderr, "\nBignum Divide: hole at start\n");
       Microcode_Termination(TERM_EXIT);
     }
   }
-  End_Of_First = First + 1 + Get_Integer(First[0]);
+  End_Of_First = First + 1 + (OBJECT_DATUM (First[0]));
   if (Bignum_Debug)
     printf("\nEnd_Of_First=0x%x\n", End_Of_First);
   if (End_Of_First != Second)
@@ -1037,7 +1087,7 @@ DEFINE_PRIMITIVE ("DIVIDE-BIGNUM", Prim_divide_bignum, 2, 2, 0)
     if (Bignum_Debug)
       printf("\nGap=0x%x\n", (Second-End_Of_First)-1);
   }
-  Free = Second + 1 + Get_Integer(Second[0]);
+  Free = Second + 1 + (OBJECT_DATUM (Second[0]));
   if (Bignum_Debug)
     printf("\nEnd=0x%x\n", Free);
   return Result;
@@ -1058,7 +1108,7 @@ DEFINE_PRIMITIVE ("DIVIDE-BIGNUM", Prim_divide_bignum, 2, 2, 0)
   Arg_1_Type(TC_BIG_FIXNUM);						\
   Set_Time_Zone(Zone_Math);						\
   ARG = BIGNUM(Get_Pointer(Arg1));					\
-  return Make_Unsigned_Fixnum(((Test) ? 1 : 0));			\
+  return (MAKE_UNSIGNED_FIXNUM (((Test) ? 1 : 0)));			\
 }
 
 DEFINE_PRIMITIVE ("ZERO-BIGNUM?", Prim_zero_bignum, 1, 1, 0)
@@ -1088,7 +1138,7 @@ Unary_Predicate((LEN(ARG) != 0) && NEG_BIGNUM(ARG))
     result = 1;								\
   else									\
     result = 0;								\
-  return Make_Unsigned_Fixnum(result);					\
+  return (MAKE_UNSIGNED_FIXNUM (result));				\
 }
 
 DEFINE_PRIMITIVE ("EQUAL-BIGNUM?", Prim_equal_bignum, 2, 2, 0)
diff --git a/v7/src/microcode/char.c b/v7/src/microcode/char.c
index c4392256d..0950a564a 100644
--- a/v7/src/microcode/char.c
+++ b/v7/src/microcode/char.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.26 1988/08/15 20:43:16 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/char.c,v 9.27 1989/08/28 18:28:24 cph Exp $ */
 
 /* Character primitives. */
 
@@ -47,7 +47,7 @@ arg_ascii_char (n)
 
   CHECK_ARG (n, CHARACTER_P);
   ascii = ARG_REF(n);
-  if (pointer_datum(ascii) >= MAX_ASCII)
+  if (OBJECT_DATUM(ascii) >= MAX_ASCII)
     error_bad_range_arg (n);
   return (scheme_char_to_c_char(ascii));
 }
@@ -170,7 +170,7 @@ DEFINE_PRIMITIVE ("CHAR-ASCII?", Prim_char_ascii_p, 1, 1, 0)
   CHECK_ARG (1, CHARACTER_P);
   character = ARG_REF (1);
   PRIMITIVE_RETURN
-    ((pointer_datum(character) >= MAX_ASCII) ?
+    ((OBJECT_DATUM(character) >= MAX_ASCII) ?
      NIL :
      (MAKE_UNSIGNED_FIXNUM (scheme_char_to_c_char(character))));
 }
diff --git a/v7/src/microcode/config.h b/v7/src/microcode/config.h
index cfc6c4b55..d24dddcea 100644
--- a/v7/src/microcode/config.h
+++ b/v7/src/microcode/config.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.45 1989/08/02 17:04:43 cph Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.46 1989/08/28 18:28:38 cph Exp $
  *
  * This file contains the configuration information and the information
  * given on the command line on Unix.
@@ -452,14 +452,9 @@ longjmp(Exit_Point, NORMAL_EXIT)
 #define FLONUM_MANTISSA_BITS 	53
 #define MAX_FLONUM_EXPONENT	2047
 #endif
-
+
 #ifdef hp9000s800
-/* Heap resides in "Quad 1", and hence memory addresses have a 1
-   in the second MSBit. This is taken care of in object.h, and is
-   still considered Heap_In_Low_Memory.
-*/
 #define MACHINE_TYPE		"hp9000s800"
-#define Heap_In_Low_Memory
 #define UNSIGNED_SHIFT
 #define CHAR_SIZE		8
 #define USHORT_SIZE		16
@@ -472,7 +467,43 @@ longjmp(Exit_Point, NORMAL_EXIT)
 #define FLOATING_ALIGNMENT	0x7	/* Low 3 MBZ for float storage */
 #define HAS_FLOOR
 #define HAS_FREXP
-#endif
+
+#ifndef AVOID_SPECTRUM_TC_KLUDGE
+
+/* Heap resides in "Quad 1", and hence memory addresses have a 1
+   in the second MSBit. This is kludged by the definitions below, and is
+   still considered Heap_In_Low_Memory.
+*/
+
+#define Heap_In_Low_Memory
+
+/* It must be at least one more than the minimum necessary,
+   and it may not work if it is not even.
+ */
+
+#define TYPE_CODE_LENGTH	8
+
+/* Clear the quad tag if there */
+
+#define TC_BITS_TO_TC(BITS)	((BITS) & 0x3F)
+
+/* This assumes that the max type code is 6, so that it does not
+   overflow into the quad tag.
+ */
+
+#define TC_TO_TC_BITS(TC)	(TC)
+
+#define OBJECT_TYPE(O)		(TC_BITS_TO_TC((O) >> ADDRESS_LENGTH))
+
+/* Keep quad bit. */
+
+#define OBJECT_DATUM(O)		((O) & 0x40FFFFFF)
+
+#define MAKE_OBJECT(TC, D)						\
+  ((((unsigned) (TC_TO_TC_BITS(TC))) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+
+#endif /* AVOID_SPECTRUM_TC_KLUDGE */
+#endif /* spectrum */
 
 #ifdef umax
 #define MACHINE_TYPE		"umax"
@@ -580,9 +611,9 @@ longjmp(Exit_Point, NORMAL_EXIT)
 #endif
 
 #ifndef COMPILER_HEAP_SIZE
-#define COMPILER_HEAP_SIZE	1000
+#define COMPILER_HEAP_SIZE	500
 #endif
 
 #ifndef COMPILER_CONSTANT_SIZE
-#define COMPILER_CONSTANT_SIZE	800
+#define COMPILER_CONSTANT_SIZE	1000
 #endif
diff --git a/v7/src/microcode/const.h b/v7/src/microcode/const.h
index ad7689aaa..4e6fee929 100644
--- a/v7/src/microcode/const.h
+++ b/v7/src/microcode/const.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.33 1989/06/16 09:37:04 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/const.h,v 9.34 1989/08/28 18:28:42 cph Exp $
  *
  * Named constants used throughout the interpreter
  *
@@ -46,21 +46,33 @@ MIT in each case. */
 #define STACK_FRAME_HEADER	1
 
 /* Precomputed typed pointers */
-#ifndef b32			/* Safe version */
+#ifdef b32			/* 32 bit word */
 
-#define SHARP_F			Make_Non_Pointer(TC_NULL, 0)
-#define SHARP_T			Make_Non_Pointer(TC_TRUE, 0)
-#define UNSPECIFIC		Make_Non_Pointer(TC_TRUE, 1)
-#define FIXNUM_ZERO		Make_Non_Pointer(TC_FIXNUM, 0)
-#define BROKEN_HEART_ZERO	Make_Non_Pointer(TC_BROKEN_HEART, 0)
-
-#else				/* 32 bit word */
+#if (TYPE_CODE_LENGTH == 8)
 #define SHARP_F			0x00000000
 #define SHARP_T			0x08000000
 #define UNSPECIFIC		0x08000001
 #define FIXNUM_ZERO		0x1A000000
 #define BROKEN_HEART_ZERO	0x22000000
-#endif				/* b32 */
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define SHARP_F			0x00000000
+#define SHARP_T			0x20000000
+#define UNSPECIFIC		0x20000001
+#define FIXNUM_ZERO		0x68000000
+#define BROKEN_HEART_ZERO	0x88000000
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef SHARP_F			/* Safe version */
+#define SHARP_F			Make_Non_Pointer(TC_NULL, 0)
+#define SHARP_T			Make_Non_Pointer(TC_TRUE, 0)
+#define UNSPECIFIC		Make_Non_Pointer(TC_TRUE, 1)
+#define FIXNUM_ZERO		Make_Non_Pointer(TC_FIXNUM, 0)
+#define BROKEN_HEART_ZERO	Make_Non_Pointer(TC_BROKEN_HEART, 0)
+#endif /* SHARP_F */
 
 #define EMPTY_LIST SHARP_F
 #define NIL SHARP_F
diff --git a/v7/src/microcode/edwin.h b/v7/src/microcode/edwin.h
index 255a3f2a7..c949dbc87 100644
--- a/v7/src/microcode/edwin.h
+++ b/v7/src/microcode/edwin.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.2 1988/08/15 20:45:21 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/edwin.h,v 1.3 1989/08/28 18:28:45 cph Exp $
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -35,14 +35,14 @@ MIT in each case. */
 /* Definitions for Edwin data structures.
    This MUST match the definitions in the Edwin source code. */
 
-#define GROUP_P(object) ((pointer_type (object)) == TC_VECTOR)
+#define GROUP_P(object) ((OBJECT_TYPE (object)) == TC_VECTOR)
 #define GROUP_TEXT(group) (User_Vector_Ref ((group), 1))
-#define GROUP_GAP_START(group) (Get_Integer (User_Vector_Ref ((group), 2)))
-#define GROUP_GAP_LENGTH(group) (Get_Integer (User_Vector_Ref ((group), 3)))
-#define GROUP_GAP_END(group) (Get_Integer (User_Vector_Ref ((group), 4)))
+#define GROUP_GAP_START(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 2)))
+#define GROUP_GAP_LENGTH(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 3)))
+#define GROUP_GAP_END(group) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((group), 4)))
 #define GROUP_START_MARK(group) (User_Vector_Ref ((group), 6))
 #define GROUP_END_MARK(group) (User_Vector_Ref ((group), 7))
 
 #define MARK_GROUP(mark) (User_Vector_Ref ((mark), 1))
-#define MARK_POSITION(mark) (Get_Integer (User_Vector_Ref ((mark), 2)))
-#define MARK_LEFT_INSERTING(mark) ((User_Vector_Ref ((mark), 3)) != NIL)
+#define MARK_POSITION(mark) (UNSIGNED_FIXNUM_VALUE (User_Vector_Ref ((mark), 2)))
+#define MARK_LEFT_INSERTING(mark) ((User_Vector_Ref ((mark), 3)) != SHARP_F)
diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 5cd63d027..e66dcdd1c 100644
--- a/v7/src/microcode/extern.h
+++ b/v7/src/microcode/extern.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.31 1989/06/16 09:37:49 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.32 1989/08/28 18:28:48 cph Exp $
  *
  * External declarations.
  *
@@ -164,6 +164,10 @@ extern int Parse_Option();
 extern Boolean Restore_History();
 extern long NColumns(), NLines(), OS_process_clock ();
 extern void OS_Flush_Output_Buffer(), OS_Re_Init();
+extern Pointer cons ();
+extern Pointer allocate_non_marked_vector ();
+extern Pointer allocate_marked_vector ();
+extern Pointer make_vector ();
 
 /* Memory management utilities */
 
diff --git a/v7/src/microcode/gctype.c b/v7/src/microcode/gctype.c
index 13f1d10bd..44abdf494 100644
--- a/v7/src/microcode/gctype.c
+++ b/v7/src/microcode/gctype.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/gctype.c,v 9.30 1989/08/28 18:28:51 cph Rel $
  *
  * This file contains the table which maps between Types and
  * GC Types.
@@ -110,6 +110,13 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_COMPLEX */
     GC_Vector,			/* TC_COMPILED_CODE_BLOCK */
     GC_Undefined,			/* 0x3E */
+
+#if (TYPE_CODE_LENGTH == 6)
+
+    GC_Undefined			/* 0x3F */
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
     GC_Undefined,			/* 0x3F */
     GC_Undefined,			/* 0x40 */
     GC_Undefined,			/* 0x41 */
@@ -310,10 +317,21 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Undefined,			/* 0xFC */
     GC_Undefined,			/* 0xFD */
     GC_Undefined,			/* 0xFE */
-    GC_Undefined			/* 0xFF */
+    GC_Undefined			/* last */
+#endif /* (TYPE_CODE_LENGTH != 6) */
+
     };
 
+#if (TYPE_CODE_LENGTH == 6)
+
+#if (MAX_TYPE_CODE != 0x3F)
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
+#endif
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
 #if (MAX_TYPE_CODE != 0xFF)
-#include "gctype.c and scheme.h inconsistent -- GC_Type_Map"
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
 #endif
 
+#endif /* (TYPE_CODE_LENGTH == 6) */
diff --git a/v7/src/microcode/intern.c b/v7/src/microcode/intern.c
index e9fe85f08..0eb590b33 100644
--- a/v7/src/microcode/intern.c
+++ b/v7/src/microcode/intern.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intern.c,v 9.49 1989/07/05 18:45:54 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/intern.c,v 9.50 1989/08/28 18:28:55 cph Exp $ */
 
 /* String hash functions and interning of symbols. */
 
@@ -124,7 +124,7 @@ link_new_symbol (symbol, cell)
      list in the bucket by 1 new element). */
 
   fast Pointer result =
-    (Make_Object (TC_INTERNED_SYMBOL, (OBJECT_DATUM (symbol))));
+    (MAKE_OBJECT (TC_INTERNED_SYMBOL, (OBJECT_DATUM (symbol))));
   Primitive_GC_If_Needed (2);
   (*cell) = (Make_Pointer (TC_LIST, Free));
   (Free [CONS_CAR]) = result;
diff --git a/v7/src/microcode/list.c b/v7/src/microcode/list.c
index 24bb957b2..5e27a17f7 100644
--- a/v7/src/microcode/list.c
+++ b/v7/src/microcode/list.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/list.c,v 9.26 1988/08/15 20:50:44 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/list.c,v 9.27 1989/08/28 18:28:59 cph Exp $
  *
  * List creation and manipulation primitives.
  */
@@ -38,40 +38,36 @@ MIT in each case. */
 #include "scheme.h"
 #include "prims.h"
 
-/* (CONS LEFT RIGHT)
-   Creates a pair with left component LEFT and right component
-   RIGHT.
-*/
-DEFINE_PRIMITIVE ("CONS", Prim_cons, 2, 2, 0)
+Pointer
+cons (car, cdr)
+     Pointer car;
+     Pointer cdr;
 {
-  Primitive_2_Args();
-
-  Primitive_GC_If_Needed(2);
-  *Free++ = Arg1;
-  *Free++ = Arg2;
-  return Make_Pointer(TC_LIST, Free-2);
+  Pointer result = (Make_Pointer (TC_LIST, Free));
+  Primitive_GC_If_Needed (2);
+  (*Free++) = car;
+  (*Free++) = cdr;
+  return (result);
 }
 
-/* (CDR PAIR)
-   Returns the second element in the pair.
-*/
-DEFINE_PRIMITIVE ("CDR", Prim_cdr, 1, 1, 0)
+DEFINE_PRIMITIVE ("CONS", Prim_cons, 2, 2, 0)
 {
-  Primitive_1_Arg();
-
-  Arg_1_Type(TC_LIST);
-  return Vector_Ref(Arg1, CONS_CDR);
+  PRIMITIVE_HEADER (2);
+  PRIMITIVE_RETURN (cons ((ARG_REF (1)), (ARG_REF (2))));
 }
       
-/* (CAR PAIR)
-   Returns the first element in the pair.
-*/
 DEFINE_PRIMITIVE ("CAR", Prim_car, 1, 1, 0)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
+  CHECK_ARG (1, PAIR_P);
+  PRIMITIVE_RETURN (Vector_Ref ((ARG_REF (1)), CONS_CAR));
+}
 
-  Arg_1_Type(TC_LIST);
-  return Vector_Ref(Arg1, CONS_CAR);
+DEFINE_PRIMITIVE ("CDR", Prim_cdr, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  CHECK_ARG (1, PAIR_P);
+  PRIMITIVE_RETURN (Vector_Ref ((ARG_REF (1)), CONS_CDR));
 }
 
 /* (GENERAL-CAR-CDR LIST DIRECTIONS)
diff --git a/v7/src/microcode/lookup.h b/v7/src/microcode/lookup.h
index d20bc9d85..c8484533c 100644
--- a/v7/src/microcode/lookup.h
+++ b/v7/src/microcode/lookup.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/lookup.h,v 9.43 1989/08/28 18:29:03 cph Exp $ */
 
 /* Macros and declarations for the variable lookup code. */
 
@@ -68,12 +68,26 @@ extern Pointer
 
 /* Common constants. */
 
-#ifndef b32
-#define UNCOMPILED_VARIABLE		Make_Non_Pointer(UNCOMPILED_REF, 0)
-#else
+#ifdef b32				/* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
 #define UNCOMPILED_VARIABLE		0x08000000
 #endif
 
+#if (TYPE_CODE_LENGTH == 6)
+#define UNCOMPILED_VARIABLE		0x20000000
+#endif
+
+#if (TC_TRUE != 0x08)
+#include "error:lookup.h and types.h are inconsistent"
+#endif
+
+#endif /* b32 */
+
+#ifndef UNCOMPILED_VARIABLE		/* Safe version */
+#define UNCOMPILED_VARIABLE		Make_Non_Pointer(UNCOMPILED_REF, 0)
+#endif
+
 /* Macros for speedy variable reference. */
 
 #if (LOCAL_REF == 0)
@@ -214,7 +228,7 @@ label:									\
   fast long depth;							\
 									\
   verify(FORMAL_REF, offset, get_offset(hunk), label);			\
-  depth = Get_Integer(frame);						\
+  depth = (OBJECT_DATUM (frame));					\
   frame = env;								\
   while(--depth >= 0)							\
   {									\
@@ -233,7 +247,7 @@ label:									\
   fast long depth;							\
 									\
   verify(AUX_REF, offset, get_offset(hunk), label);			\
-  depth = Get_Integer(frame);						\
+  depth = (OBJECT_DATUM (frame));					\
   frame = env;								\
   while(--depth >= 0)							\
   {									\
diff --git a/v7/src/microcode/m/hp9k300.h b/v7/src/microcode/m/hp9k300.h
index db4d51406..0cf71df72 100644
--- a/v7/src/microcode/m/hp9k300.h
+++ b/v7/src/microcode/m/hp9k300.h
@@ -1,7 +1,7 @@
 /* -*-C-*-
    Machine file for HP9000 series 300 (or 200)
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/m/Attic/hp9k300.h,v 1.4 1989/07/27 08:17:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/m/Attic/hp9k300.h,v 1.5 1989/08/28 18:30:12 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -37,8 +37,10 @@ MIT in each case. */
    model 310. */
 #define PROC_TYPE PROC_TYPE_68020
 
+#define C_SWITCH_MACHINE -DTYPE_CODE_LENGTH=6
+
 #if (PROC_TYPE == PROC_TYPE_68020)
-#define M4_SWITCH_MACHINE -DMC68881
+#define M4_SWITCH_MACHINE -DMC68881 -DTYPE_CODE_LENGTH=6
 #define AS_SWITCH_MACHINE +x -V 3
 #else
 #define M4_SWITCH_MACHINE
diff --git a/v7/src/microcode/memmag.c b/v7/src/microcode/memmag.c
index 90d9b88cd..d6b4654ed 100644
--- a/v7/src/microcode/memmag.c
+++ b/v7/src/microcode/memmag.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.38 1989/06/08 00:24:10 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/memmag.c,v 9.39 1989/08/28 18:29:06 cph Exp $ */
 
 /* Memory management top level.
 
@@ -103,6 +103,8 @@ void
 Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
      int Our_Heap_Size, Our_Stack_Size, Our_Constant_Size;
 {
+  Pointer test_value;
+
   /* Consistency check 1 */
   if (Our_Heap_Size == 0)
   {
@@ -133,7 +135,11 @@ Setup_Memory(Our_Heap_Size, Our_Stack_Size, Our_Constant_Size)
   Align_Float(Constant_Space);
 
   /* Consistency check 3 */
-  if (((C_To_Scheme(Highest_Allocated_Address)) & TYPE_CODE_MASK) != 0)
+
+  test_value = (Make_Pointer(LAST_TYPE_CODE, Highest_Allocated_Address));
+
+  if (((OBJECT_TYPE(test_value)) != LAST_TYPE_CODE) ||
+      ((Get_Pointer(test_value)) != Highest_Allocated_Address))
   {
     fprintf(stderr,
 	    "Largest address does not fit in datum field of Pointer.\n");
@@ -403,7 +409,7 @@ DEFINE_PRIMITIVE ("GARBAGE-COLLECT", Prim_garbage_collect, 1, 1, 0)
   }
   ENTER_CRITICAL_SECTION ("garbage collector");
   gc_counter += 1;
-  GC_Reserve = Get_Integer(Arg1);
+  GC_Reserve = (UNSIGNED_FIXNUM_VALUE (Arg1));
   GCFlip();
   GC();
   CLEAR_INTERRUPT(INT_GC);
diff --git a/v7/src/microcode/object.h b/v7/src/microcode/object.h
index 278933fa8..344612835 100644
--- a/v7/src/microcode/object.h
+++ b/v7/src/microcode/object.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.30 1989/05/24 18:14:52 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/object.h,v 9.31 1989/08/28 18:29:10 cph Exp $ */
 
 /* This file contains definitions pertaining to the C view of 
    Scheme pointers: widths of fields, extraction macros, pre-computed
@@ -42,27 +42,35 @@ MIT in each case. */
    POINTER_LENGTH is defined this way to make it available to
    the preprocessor. */
 
-/* TYPE_CODE_LENGTH must match the value in Wsize.c! */
-#define TYPE_CODE_LENGTH	8	/* Not CHAR_SIZE!! */
-#define MAX_TYPE_CODE		0xFF	/* ((1<<TYPE_CODE_LENGTH) - 1) */
-#define POINTER_LENGTH		ULONG_SIZE
-
-#ifndef b32			/* Portable versions */
+/* The value in Wsize.c for TYPE_CODE_LENGTH must match this!! */
+  
+#ifndef TYPE_CODE_LENGTH
+#define TYPE_CODE_LENGTH	8
+#endif
+  
+#if (TYPE_CODE_LENGTH == 8)
+#define MAX_TYPE_CODE		0xFF
+#endif
+  
+#if (TYPE_CODE_LENGTH == 6)
+#define MAX_TYPE_CODE		0x3F
+#endif
 
-#define ADDRESS_LENGTH		(POINTER_LENGTH-TYPE_CODE_LENGTH)
-#define ADDRESS_MASK		((1 << ADDRESS_LENGTH) - 1)
-#define TYPE_CODE_MASK		(~ADDRESS_MASK)
-/* FIXNUM_LENGTH does NOT include the sign bit! */
-#define FIXNUM_LENGTH		(ADDRESS_LENGTH - 1)
-#define FIXNUM_SIGN_BIT		(1 << FIXNUM_LENGTH)
-#define SIGN_MASK		(TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
-#define SMALLEST_FIXNUM		((long) (-1 << FIXNUM_LENGTH))
-#define BIGGEST_FIXNUM		((long) (~(-1 << FIXNUM_LENGTH)))
+#ifdef MIN_TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
+  
+#ifndef MAX_TYPE_CODE
+#define MAX_TYPE_CODE		((1 << TYPE_CODE_LENGTH) - 1)
+#endif
 
-#define HALF_ADDRESS_LENGTH	(ADDRESS_LENGTH / 2)
-#define HALF_ADDRESS_MASK	((1 << HALF_ADDRESS_LENGTH) - 1)
+#define POINTER_LENGTH		ULONG_SIZE
+  
+#ifdef b32			/* 32 bit word versions */
 
-#else				/* 32 bit word versions */
+#if (TYPE_CODE_LENGTH == 8)
 
 #define ADDRESS_LENGTH		24
 #define ADDRESS_MASK		0x00FFFFFF
@@ -72,29 +80,59 @@ MIT in each case. */
 #define SIGN_MASK		0xFF800000
 #define SMALLEST_FIXNUM		((long) 0xFF800000)
 #define BIGGEST_FIXNUM		((long) 0x007FFFFF)
-
 #define HALF_ADDRESS_LENGTH	12
 #define HALF_ADDRESS_MASK	0x00000FFF
-
-#endif
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define ADDRESS_LENGTH		26
+#define ADDRESS_MASK		0x03FFFFFF
+#define TYPE_CODE_MASK		0XFC000000
+#define FIXNUM_LENGTH		25
+#define FIXNUM_SIGN_BIT		0x02000000
+#define SIGN_MASK		0xFE000000
+#define SMALLEST_FIXNUM		((long) 0xFE000000)
+#define BIGGEST_FIXNUM		((long) 0x01FFFFFF)
+#define HALF_ADDRESS_LENGTH	13
+#define HALF_ADDRESS_MASK	0x00001FFF
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef ADDRESS_LENGTH		/* Safe versions */
+#define ADDRESS_LENGTH		(POINTER_LENGTH-TYPE_CODE_LENGTH)
+#define ADDRESS_MASK		((1 << ADDRESS_LENGTH) - 1)
+#define TYPE_CODE_MASK		(~ADDRESS_MASK)
+/* FIXNUM_LENGTH does NOT include the sign bit! */
+#define FIXNUM_LENGTH		(ADDRESS_LENGTH - 1)
+#define FIXNUM_SIGN_BIT		(1 << FIXNUM_LENGTH)
+#define SIGN_MASK		(TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
+#define SMALLEST_FIXNUM		((long) (-1 << FIXNUM_LENGTH))
+#define BIGGEST_FIXNUM		((long) (~(-1 << FIXNUM_LENGTH)))
+#define HALF_ADDRESS_LENGTH	(ADDRESS_LENGTH / 2)
+#define HALF_ADDRESS_MASK	((1 << HALF_ADDRESS_LENGTH) - 1)
+#endif /* ADDRESS_LENGTH */
 
+#ifndef OBJECT_TYPE
 #ifndef UNSIGNED_SHIFT		/* Portable version */
 #define OBJECT_TYPE(P)		(((P) >> ADDRESS_LENGTH) & MAX_TYPE_CODE)
 #else				/* Faster for logical shifts */
 #define OBJECT_TYPE(P)		((P) >> ADDRESS_LENGTH)
 #endif
+#endif /* OBJECT_TYPE */
 
+#ifndef OBJECT_DATUM
 #define OBJECT_DATUM(P)		((P) & ADDRESS_MASK)
+#endif
+
+#ifndef MAKE_OBJECT
+#define MAKE_OBJECT(TC, D)						\
+  ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+#endif
 
 /* compatibility definitions */
 #define Type_Code(P)		(OBJECT_TYPE (P))
 #define Datum(P)		(OBJECT_DATUM (P))
-
-#define pointer_type(P)		(OBJECT_TYPE (P))
-#define pointer_datum(P)	(OBJECT_DATUM (P))
-
-#define Make_Object(TC, D)						\
-  ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
 
 #ifndef Heap_In_Low_Memory	/* Portable version */
 
@@ -113,7 +151,8 @@ extern Pointer *Memory_Base;
 #define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P))))
 #define C_To_Scheme(P) ((Pointer) ((P) - Memory_Base))
 
-#else				/* Storing absolute addresses */
+#else /* not Heap_In_Low_Memory */
+/* Storing absolute addresses */
 
 typedef long relocation_type;	/* Used to relocate pointers on fasload */
 
@@ -121,29 +160,20 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
   (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))),	\
    ((Heap + (space)) - 1))
 
-#ifdef spectrum
-
-#define Quad1_Tag 	0x40000000
-#define Get_Pointer(P)	((Pointer *) (((P) & ADDRESS_MASK) | Quad1_Tag))
-#define C_To_Scheme(P)  ((Pointer) (((long) (P)) & ADDRESS_MASK))
-
-#else /* Not Spectrum, fast case */
-
 #define Get_Pointer(P)		((Pointer *) (OBJECT_DATUM (P)))
 #define C_To_Scheme(P)          ((Pointer) (P))
 
-#endif /* spectrum */
 #endif /* Heap_In_Low_Memory */
 
-#define Make_Pointer(TC, A)	Make_Object((TC), C_To_Scheme(A))
-#define Make_Non_Pointer(TC, D)	Make_Object(TC, ((Pointer) (D)))
+#define Make_Pointer(TC, A)	MAKE_OBJECT((TC), C_To_Scheme(A))
+#define Make_Non_Pointer(TC, D)	MAKE_OBJECT(TC, ((Pointer) (D)))
 
 /* (Make_New_Pointer (TC, A)) may be more efficient than
    (Make_Pointer (TC, (Get_Pointer (A)))) */
 
-#define Make_New_Pointer(TC, A) (Make_Object (TC, ((Pointer) A)))
+#define Make_New_Pointer(TC, A) (MAKE_OBJECT (TC, ((Pointer) A)))
 
-#define Store_Type_Code(P, TC)	P = (Make_Object ((TC), (P)))
+#define Store_Type_Code(P, TC)	P = (MAKE_OBJECT ((TC), (P)))
 
 #define Store_Address(P, A)						\
   P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A))))
@@ -158,7 +188,7 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
 #define Fast_User_Vector_Ref(P, N) 	Fast_Vector_Ref(P, (N)+1)
 #define Fast_User_Vector_Set(P, N, S)	Fast_Vector_Set(P, (N)+1, S)
 #define Nth_Vector_Loc(P, N)		(&(Fast_Vector_Ref(P, N)))
-#define Vector_Length(P)		(Get_Integer(Fast_Vector_Ref((P), 0)))
+#define Vector_Length(P) (OBJECT_DATUM (Fast_Vector_Ref((P), 0)))
 
 /* General case vector handling requires atomicity for parallel processors */
 
@@ -209,9 +239,9 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
 #define MAKE_FIXNUM(N) (Make_Non_Pointer (TC_FIXNUM, (N)))
 #define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
 #define MAKE_UNSIGNED_FIXNUM(N)	(FIXNUM_ZERO + (N))
-#define UNSIGNED_FIXNUM_VALUE(fixnum) (OBJECT_DATUM (fixnum))
-#define MAKE_SIGNED_FIXNUM Make_Signed_Fixnum
-#define long_to_object C_Integer_To_Scheme_Integer
+#define UNSIGNED_FIXNUM_VALUE OBJECT_DATUM
+#define MAKE_SIGNED_FIXNUM MAKE_FIXNUM
+#define NONNEGATIVE_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
 
 #define FIXNUM_VALUE(fixnum, target)					\
 do									\
@@ -221,20 +251,16 @@ do									\
     (target) |= (-1 << ADDRESS_LENGTH);					\
 } while (0)
 
+/* Compatibility */
+#define Make_Unsigned_Fixnum MAKE_UNSIGNED_FIXNUM
+#define Make_Signed_Fixnum MAKE_FIXNUM
+#define Get_Integer OBJECT_DATUM
+#define Sign_Extend FIXNUM_VALUE
+
 #define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
 
 #define Make_Broken_Heart(N)	(BROKEN_HEART_ZERO + (N))
-#define Make_Unsigned_Fixnum(N)	(FIXNUM_ZERO + (N))
-#define Make_Signed_Fixnum(N)	Make_Non_Pointer( TC_FIXNUM, (N))
 #define Get_Float(P)   (* ((double *) (Nth_Vector_Loc ((P), 1))))
-#define Get_Integer(P) (OBJECT_DATUM (P))
-
-#define Sign_Extend(P, S)						\
-{									\
-  (S) = (Get_Integer (P));						\
-  if (((S) & FIXNUM_SIGN_BIT) != 0)					\
-    (S) |= (-1 << ADDRESS_LENGTH);					\
-}
 
 #define Fixnum_Fits(x)							\
   ((((x) & SIGN_MASK) == 0) ||						\
diff --git a/v7/src/microcode/ppband.c b/v7/src/microcode/ppband.c
index dc4390f7b..bdf93802a 100644
--- a/v7/src/microcode/ppband.c
+++ b/v7/src/microcode/ppband.c
@@ -1,6 +1,8 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.34 1989/08/28 18:28:03 cph Exp $
+
+Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,16 +32,14 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.33 1989/02/14 20:41:32 jinx Rel $
- *
- * Dumps Scheme FASL in user-readable form .
- */
+/* Dumps Scheme FASL in user-readable form. */
 
 #include <stdio.h>
 #include "config.h"
 #include "types.h"
 #include "const.h"
 #include "object.h"
+#include "gccode.h"
 #include "sdata.h"
 
 #define fast register
@@ -281,21 +281,27 @@ Display(Location, Type, The_Datum)
 }
 
 Pointer *
-show_area(area, size, name)
+show_area(area, start, end, name)
      fast Pointer *area;
-     fast long size;
+     long start;
+     fast long end;
      char *name;
 {
   fast long i;
 
   printf("\n%s contents:\n\n", name);
-  for (i = 0; i < size;  area++, i++)
+  for (i = start; i < end;  area++, i++)
   {
-    if (OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR)
+    if ((OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR) ||
+	(OBJECT_TYPE(*area) == TC_MANIFEST_CLOSURE) ||
+	(OBJECT_TYPE(*area) == TC_LINKAGE_SECTION))
     {
       fast long j, count;
 
-      count = Get_Integer(*area);
+      count =
+	((OBJECT_TYPE(*area) == TC_LINKAGE_SECTION)
+	 ? (READ_CACHE_LINKAGE_COUNT (*area))
+	 : (OBJECT_DATUM (*area)));
       Display(i, OBJECT_TYPE(*area), OBJECT_DATUM(*area));
       area += 1;
       for (j = 0; j < count ; j++, area++)
@@ -376,11 +382,11 @@ main(argc, argv)
 
   if (Heap_Count > 0)
   {
-    Next = show_area(Data, Heap_Count, "Heap");
+    Next = show_area(Data, 0, Heap_Count, "Heap");
   }
   if (Const_Count > 0)
   {
-    Next = show_area(Next, Const_Count, "Constant Space");
+    Next = show_area(Next, Heap_Count, Const_Count, "Constant Space");
   }
   if ((Primitive_Table_Size > 0) && (Next < end_of_memory))
   {
@@ -401,7 +407,7 @@ main(argc, argv)
 	 count += 1)
     {
       Sign_Extend(*Next++, arity);
-      size = Get_Integer(*Next);
+      size = (OBJECT_DATUM (*Next));
       printf("Number = %3lx; Arity = %2ld; Name = ", count, arity);
       scheme_string((Next - Data), true);
       Next += (1 + size);
diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c
index 01bf5dfcd..cce9e9ddf 100644
--- a/v7/src/microcode/prim.c
+++ b/v7/src/microcode/prim.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.31 1988/08/15 20:52:46 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.32 1989/08/28 18:29:14 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -84,21 +84,26 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1, 1, 0)
   PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OBJECT_DATUM (ARG_REF (1))));
 }
 
-/* (MAKE-NON-POINTER-OBJECT NUMBER)
-   Converts the unsigned integer NUMBER into a fixnum, by creating an
-   object whose type is TC_FIXNUM and whose datum is NUMBER.  */
-
-DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1, 1, 0)
+DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1, 1,
+  "Convert the unsigned integer NUMBER into a fixnum.\n\
+The result has a fixnum type and a datum of NUMBER.")
 {
+  fast Pointer result;
   fast long datum;
   PRIMITIVE_HEADER (1);
 
   datum = (object_to_long ((ARG_REF (1)),
 			   ERR_ARG_1_WRONG_TYPE,
 			   ERR_ARG_1_BAD_RANGE));
-  if ((datum < 0) || (datum > ADDRESS_MASK))
+
+  result = (MAKE_FIXNUM (datum));
+  if ((datum < 0) ||
+      (!(FIXNUM_P(result))) ||
+      ((OBJECT_DATUM(result)) != datum))
+  {
     error_bad_range_arg (1);
-  PRIMITIVE_RETURN (MAKE_FIXNUM (datum));
+  }
+  PRIMITIVE_RETURN (result);
 }
 
 /* (PRIMITIVE-OBJECT-SET-TYPE TYPE-CODE OBJECT)
diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h
index 805974319..5c2c96dca 100644
--- a/v7/src/microcode/prims.h
+++ b/v7/src/microcode/prims.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.34 1989/05/31 01:50:51 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prims.h,v 9.35 1989/08/28 18:29:17 cph Exp $ */
 
 /* This file contains some macros for defining primitives,
    for argument type or value checking, and for accessing
@@ -169,11 +169,13 @@ extern void canonicalize_primitive_context();
 }
 
 #define Primitive_GC_If_Needed(Amount)					\
-  if (GC_Check (Amount)) Primitive_GC(Amount)
+{									\
+  if (GC_Check (Amount)) Primitive_GC(Amount);				\
+}
 
 #define Range_Check(To_Where, P, Low, High, Error)			\
 {									\
-  To_Where = Get_Integer (P);						\
+  To_Where = UNSIGNED_FIXNUM_VALUE (P);					\
   if ((To_Where < (Low)) || (To_Where > (High)))			\
     Primitive_Error (Error);						\
 }
@@ -206,34 +208,34 @@ extern Pointer allocate_marked_vector ();
 /* Instances of the following should be flushed. */
 
 #define Arg_1_Type(TC)  					\
-do { if ((pointer_type (Arg1)) != (TC)) error_wrong_type_arg (1); } while (0)
+do { if ((OBJECT_TYPE (Arg1)) != (TC)) error_wrong_type_arg (1); } while (0)
 
 #define Arg_2_Type(TC)  					\
-do { if ((pointer_type (Arg2)) != (TC)) error_wrong_type_arg (2); } while (0)
+do { if ((OBJECT_TYPE (Arg2)) != (TC)) error_wrong_type_arg (2); } while (0)
 
 #define Arg_3_Type(TC)						\
-do { if ((pointer_type (Arg3)) != (TC)) error_wrong_type_arg (3); } while (0)
+do { if ((OBJECT_TYPE (Arg3)) != (TC)) error_wrong_type_arg (3); } while (0)
 
 #define Arg_4_Type(TC)  					\
-do { if ((pointer_type (Arg4)) != (TC)) error_wrong_type_arg (4); } while (0)
+do { if ((OBJECT_TYPE (Arg4)) != (TC)) error_wrong_type_arg (4); } while (0)
 
 #define Arg_5_Type(TC)  					\
-do { if ((pointer_type (Arg5)) != (TC)) error_wrong_type_arg (5); } while (0)
+do { if ((OBJECT_TYPE (Arg5)) != (TC)) error_wrong_type_arg (5); } while (0)
 
 #define Arg_6_Type(TC)						\
-do { if ((pointer_type (Arg6)) != (TC)) error_wrong_type_arg (6); } while (0)
+do { if ((OBJECT_TYPE (Arg6)) != (TC)) error_wrong_type_arg (6); } while (0)
 
 #define Arg_7_Type(TC)						\
-do { if ((pointer_type (Arg7)) != (TC)) error_wrong_type_arg (7); } while (0)
+do { if ((OBJECT_TYPE (Arg7)) != (TC)) error_wrong_type_arg (7); } while (0)
 
 #define Arg_8_Type(TC)						\
-do { if ((pointer_type (Arg8)) != (TC)) error_wrong_type_arg (8); } while (0)
+do { if ((OBJECT_TYPE (Arg8)) != (TC)) error_wrong_type_arg (8); } while (0)
 
 #define Arg_9_Type(TC)						\
-do { if ((pointer_type (Arg9)) != (TC)) error_wrong_type_arg (9); } while (0)
+do { if ((OBJECT_TYPE (Arg9)) != (TC)) error_wrong_type_arg (9); } while (0)
 
 #define Arg_10_Type(TC)						\
-do { if ((pointer_type (Arg10)) != (TC)) error_wrong_type_arg (10); } while (0)
+do { if ((OBJECT_TYPE (Arg10)) != (TC)) error_wrong_type_arg (10); } while (0)
 
 
 #define Arg_1_GC_Type(GCTC)                                     \
diff --git a/v7/src/microcode/psbmap.h b/v7/src/microcode/psbmap.h
index 29abbc0d0..5fd1a5271 100644
--- a/v7/src/microcode/psbmap.h
+++ b/v7/src/microcode/psbmap.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbmap.h,v 9.28 1989/08/28 18:29:21 cph Exp $
  *
  * This file contains macros and declarations for Bintopsb.c
  * and Psbtobin.c
@@ -45,10 +45,10 @@ MIT in each case. */
 
 #include <stdio.h>
 #include "config.h"
+#include "types.h"
 #include "object.h"
 #include "bignum.h"
 #include "bitstr.h"
-#include "types.h"
 #include "sdata.h"
 #include "const.h"
 #include "gccode.h"
diff --git a/v7/src/microcode/psbtobin.c b/v7/src/microcode/psbtobin.c
index 684613ee3..bbc1d4015 100644
--- a/v7/src/microcode/psbtobin.c
+++ b/v7/src/microcode/psbtobin.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.34 1988/04/25 17:30:02 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.35 1989/08/28 18:28:07 cph Exp $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -547,7 +547,7 @@ Relocate_Objects(from, how_many, disp)
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
-	*from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
+	*from++ == MAKE_OBJECT(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
 	break;
 
       default:
@@ -746,8 +746,8 @@ print_external_objects(area_name, Table, N)
         fprintf(stderr,
 		"Table[%6d] = Character %c = 0x%02x\n",
 		(N - (Table_End - Table)),
-		Get_Integer(*Table),
-		Get_Integer(*Table));
+		(OBJECT_DATUM (*Table)),
+		(OBJECT_DATUM (*Table)));
 	break;
 
       case TC_CHARACTER_STRING:
diff --git a/v7/src/microcode/syntax.c b/v7/src/microcode/syntax.c
index 92785ea88..ce2b9925d 100644
--- a/v7/src/microcode/syntax.c
+++ b/v7/src/microcode/syntax.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.18 1989/05/16 18:19:32 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.c,v 1.19 1989/08/28 18:29:24 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -681,7 +681,7 @@ DEFINE_PRIMITIVE ("SCAN-SEXPS-FORWARD", Prim_scan_sexps_forward, 7, 7, 0)
       in_comment = 0;
       quoted = false;
     }
-  else if (((pointer_type (state_argument)) == TC_VECTOR) &&
+  else if (((OBJECT_TYPE (state_argument)) == TC_VECTOR) &&
 	   (Vector_Length (state_argument)) == 7)
     {
       Pointer temp;
@@ -697,8 +697,8 @@ DEFINE_PRIMITIVE ("SCAN-SEXPS-FORWARD", Prim_scan_sexps_forward, 7, 7, 0)
       temp = (User_Vector_Ref (state_argument, 1));
       if (temp == NIL)
 	in_string = -1;
-      else if ((FIXNUM_P (temp)) && ((pointer_datum (temp)) < MAX_ASCII))
-	in_string = (pointer_datum (temp));
+      else if ((FIXNUM_P (temp)) && ((OBJECT_DATUM (temp)) < MAX_ASCII))
+	in_string = (OBJECT_DATUM (temp));
       else
 	error_bad_range_arg (7);
 
diff --git a/v7/src/microcode/syntax.h b/v7/src/microcode/syntax.h
index 7bf55d5c1..bd43a4ac8 100644
--- a/v7/src/microcode/syntax.h
+++ b/v7/src/microcode/syntax.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.5 1989/05/16 16:39:58 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/syntax.h,v 1.6 1989/08/28 18:29:28 cph Exp $
 
 Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
@@ -88,8 +88,7 @@ enum syntaxcode			/* The possible syntax codes. */
 extern char syntax_spec_code[0200];
 
 #define SYNTAX_TABLE_P(argument)					\
-  (((pointer_type (argument)) == TC_VECTOR) &&				\
-   ((Vector_Length (argument)) == 0x100))
+  ((VECTOR_P (argument)) && ((Vector_Length (argument)) == 0x100))
 
 #define SYNTAX_TABLE_TYPE Pointer
 
diff --git a/v7/src/microcode/trap.h b/v7/src/microcode/trap.h
index 7f026f7cd..7ec07a897 100644
--- a/v7/src/microcode/trap.h
+++ b/v7/src/microcode/trap.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/trap.h,v 9.41 1989/08/28 18:29:32 cph Exp $ */
 
 /* Kinds of traps:
 
@@ -81,16 +81,9 @@ MIT in each case. */
 
 /* Common constants */
 
-#ifndef b32
-#define UNASSIGNED_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
-#define DANGEROUS_UNASSIGNED_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
-#define UNBOUND_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
-#define DANGEROUS_UNBOUND_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
-#define ILLEGAL_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
-#define DANGEROUS_ILLEGAL_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
-#define EXPENSIVE_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
-#define DANGEROUS_EXPENSIVE_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
-#else
+#ifdef b32				/* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
 #define UNASSIGNED_OBJECT		0x32000000
 #define DANGEROUS_UNASSIGNED_OBJECT	0x32000001
 #define UNBOUND_OBJECT			0x32000002
@@ -99,14 +92,37 @@ MIT in each case. */
 #define DANGEROUS_ILLEGAL_OBJECT	0x32000005
 #define EXPENSIVE_OBJECT		0x32000006
 #define DANGEROUS_EXPENSIVE_OBJECT	0x32000007
-#endif
-
-#define NOP_OBJECT			Make_Unsigned_Fixnum(TRAP_NOP)
-#define DANGEROUS_OBJECT		Make_Unsigned_Fixnum(TRAP_DANGEROUS)
-#define REQUEST_RECACHE_OBJECT		DANGEROUS_ILLEGAL_OBJECT
-#define EXPENSIVE_ASSIGNMENT_OBJECT	EXPENSIVE_OBJECT
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define UNASSIGNED_OBJECT		0xc8000000
+#define DANGEROUS_UNASSIGNED_OBJECT	0xc8000001
+#define UNBOUND_OBJECT			0xc8000002
+#define DANGEROUS_UNBOUND_OBJECT	0xc8000003
+#define ILLEGAL_OBJECT			0xc8000004
+#define DANGEROUS_ILLEGAL_OBJECT	0xc8000005
+#define EXPENSIVE_OBJECT		0xc8000006
+#define DANGEROUS_EXPENSIVE_OBJECT	0xc8000007
+#endif /* (TYPE_CODE_LENGTH == 6) */
 
 #if (TC_REFERENCE_TRAP != 0x32)
 #include "error: trap.h and types.h are inconsistent"
 #endif
 
+#endif /* b32 */
+
+#ifndef UNASSIGNED_OBJECT		/* Safe version */
+#define UNASSIGNED_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#define ILLEGAL_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
+#define DANGEROUS_ILLEGAL_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
+#define EXPENSIVE_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
+#define DANGEROUS_EXPENSIVE_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
+#endif /* UNASSIGNED_OBJECT */
+
+#define NOP_OBJECT			MAKE_UNSIGNED_FIXNUM(TRAP_NOP)
+#define DANGEROUS_OBJECT		MAKE_UNSIGNED_FIXNUM(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT		DANGEROUS_ILLEGAL_OBJECT
+#define EXPENSIVE_ASSIGNMENT_OBJECT	EXPENSIVE_OBJECT
diff --git a/v7/src/microcode/types.h b/v7/src/microcode/types.h
index 01c2fc9db..52386fc11 100644
--- a/v7/src/microcode/types.h
+++ b/v7/src/microcode/types.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/types.h,v 9.30 1989/08/28 18:29:35 cph Exp $
  *
  * Type code definitions, numerical order
  *
@@ -107,6 +107,14 @@ MIT in each case. */
  */
 
 #define LAST_TYPE_CODE			0X3D
+
+#define MIN_TYPE_CODE_LENGTH		6
+
+#ifdef TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
 
 #define TYPE_NAME_TABLE							\
 {									\
diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c
index f2df22854..6760c2f7f 100644
--- a/v7/src/microcode/utils.c
+++ b/v7/src/microcode/utils.c
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.42 1989/05/31 01:51:07 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.43 1989/08/28 18:29:38 cph Exp $ */
 
 /* This file contains utilities for interrupts, errors, etc. */
 
@@ -834,7 +834,7 @@ record_primitive_entry (primitive)
   {
     long index, old_value;
 
-    index = (1 + (pointer_datum (primitive)));
+    index = (1 + (OBJECT_DATUM (primitive)));
     Scheme_Integer_To_C_Integer ((Vector_Ref (table, index)), &old_value);
     Vector_Set (table, index, (C_Integer_To_Scheme_Integer (1 + old_value)));
   }
@@ -873,7 +873,7 @@ Allocate_New_Stacklet (N)
   Terminate_Old_Stacklet();
   if ((Free_Stacklets == NULL) ||
       ((N + STACKLET_SLACK) >
-       Get_Integer(Free_Stacklets[STACKLET_LENGTH])))
+       (OBJECT_DATUM (Free_Stacklets[STACKLET_LENGTH]))))
   {
     long size;
 
@@ -905,7 +905,7 @@ Allocate_New_Stacklet (N)
     New_Stacklet = Free_Stacklets;
     Free_Stacklets = ((Pointer *) Free_Stacklets[STACKLET_FREE_LIST_LINK]);
     Stack_Pointer =
-      &New_Stacklet[1 + Get_Integer(New_Stacklet[STACKLET_LENGTH])];
+      &New_Stacklet[1 + (OBJECT_DATUM (New_Stacklet[STACKLET_LENGTH]))];
     Stack_Guard = &New_Stacklet[STACKLET_HEADER_SIZE];
   }
   Old_Expression = Fetch_Expression();
@@ -929,8 +929,9 @@ Pointer
 Find_State_Space (State_Point)
      Pointer State_Point;
 {
-  long How_Far = Get_Integer(Fast_Vector_Ref(State_Point,
-					     STATE_POINT_DISTANCE_TO_ROOT));
+  long How_Far =
+    (UNSIGNED_FIXNUM_VALUE
+     (Fast_Vector_Ref (State_Point, STATE_POINT_DISTANCE_TO_ROOT)));
   long i;
   fast Pointer Point = State_Point;
 
@@ -988,7 +989,8 @@ Translate_To_Point (Target)
   Path = Free;
   guarantee_state_point();
   Distance =
-    Get_Integer(Fast_Vector_Ref(Target, STATE_POINT_DISTANCE_TO_ROOT));
+    (UNSIGNED_FIXNUM_VALUE
+     (Fast_Vector_Ref (Target, STATE_POINT_DISTANCE_TO_ROOT)));
   if (State_Space == NIL)
   {
     Current_Location = Current_State_Point;
@@ -1013,7 +1015,8 @@ Translate_To_Point (Target)
   }
 
   From_Depth =
-    Get_Integer(Fast_Vector_Ref(Current_Location, STATE_POINT_DISTANCE_TO_ROOT));
+    (UNSIGNED_FIXNUM_VALUE
+     (Fast_Vector_Ref (Current_Location, STATE_POINT_DISTANCE_TO_ROOT)));
 
   for (Path_Point = Current_Location, Merge_Depth = From_Depth;
        Merge_Depth > Distance;
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 9f8014bc4..4e6342856 100644
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.87 1989/08/04 02:08:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.88 1989/08/28 18:29:43 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	87
+#define SUBVERSION	88
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v7/src/microcode/wsize.c b/v7/src/microcode/wsize.c
index b574a46d7..66fed906b 100644
--- a/v7/src/microcode/wsize.c
+++ b/v7/src/microcode/wsize.c
@@ -30,14 +30,16 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/wsize.c,v 9.26 1989/05/24 18:42:37 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/wsize.c,v 9.27 1989/08/28 18:28:11 cph Exp $ */
 
 #include <stdio.h>
 #include <math.h>
 #include <errno.h>
 
+#ifndef TYPE_CODE_LENGTH
 /* This MUST match object.h */ 
 #define TYPE_CODE_LENGTH	8
+#endif
 
 #define ASCII_LOWER_A		0141
 #define ASCII_UPPER_A		0101
diff --git a/v8/src/microcode/const.h b/v8/src/microcode/const.h
index 897a9976e..ca1f0ee92 100644
--- a/v8/src/microcode/const.h
+++ b/v8/src/microcode/const.h
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.33 1989/06/16 09:37:04 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/const.h,v 9.34 1989/08/28 18:28:42 cph Exp $
  *
  * Named constants used throughout the interpreter
  *
@@ -46,21 +46,33 @@ MIT in each case. */
 #define STACK_FRAME_HEADER	1
 
 /* Precomputed typed pointers */
-#ifndef b32			/* Safe version */
+#ifdef b32			/* 32 bit word */
 
-#define SHARP_F			Make_Non_Pointer(TC_NULL, 0)
-#define SHARP_T			Make_Non_Pointer(TC_TRUE, 0)
-#define UNSPECIFIC		Make_Non_Pointer(TC_TRUE, 1)
-#define FIXNUM_ZERO		Make_Non_Pointer(TC_FIXNUM, 0)
-#define BROKEN_HEART_ZERO	Make_Non_Pointer(TC_BROKEN_HEART, 0)
-
-#else				/* 32 bit word */
+#if (TYPE_CODE_LENGTH == 8)
 #define SHARP_F			0x00000000
 #define SHARP_T			0x08000000
 #define UNSPECIFIC		0x08000001
 #define FIXNUM_ZERO		0x1A000000
 #define BROKEN_HEART_ZERO	0x22000000
-#endif				/* b32 */
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define SHARP_F			0x00000000
+#define SHARP_T			0x20000000
+#define UNSPECIFIC		0x20000001
+#define FIXNUM_ZERO		0x68000000
+#define BROKEN_HEART_ZERO	0x88000000
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef SHARP_F			/* Safe version */
+#define SHARP_F			Make_Non_Pointer(TC_NULL, 0)
+#define SHARP_T			Make_Non_Pointer(TC_TRUE, 0)
+#define UNSPECIFIC		Make_Non_Pointer(TC_TRUE, 1)
+#define FIXNUM_ZERO		Make_Non_Pointer(TC_FIXNUM, 0)
+#define BROKEN_HEART_ZERO	Make_Non_Pointer(TC_BROKEN_HEART, 0)
+#endif /* SHARP_F */
 
 #define EMPTY_LIST SHARP_F
 #define NIL SHARP_F
diff --git a/v8/src/microcode/gctype.c b/v8/src/microcode/gctype.c
index ab762a0a8..eda31b53a 100644
--- a/v8/src/microcode/gctype.c
+++ b/v8/src/microcode/gctype.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.29 1988/08/15 20:48:26 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/gctype.c,v 9.30 1989/08/28 18:28:51 cph Rel $
  *
  * This file contains the table which maps between Types and
  * GC Types.
@@ -110,6 +110,13 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Pair,			/* TC_COMPLEX */
     GC_Vector,			/* TC_COMPILED_CODE_BLOCK */
     GC_Undefined,			/* 0x3E */
+
+#if (TYPE_CODE_LENGTH == 6)
+
+    GC_Undefined			/* 0x3F */
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
     GC_Undefined,			/* 0x3F */
     GC_Undefined,			/* 0x40 */
     GC_Undefined,			/* 0x41 */
@@ -310,10 +317,21 @@ int GC_Type_Map[MAX_TYPE_CODE + 1] = {
     GC_Undefined,			/* 0xFC */
     GC_Undefined,			/* 0xFD */
     GC_Undefined,			/* 0xFE */
-    GC_Undefined			/* 0xFF */
+    GC_Undefined			/* last */
+#endif /* (TYPE_CODE_LENGTH != 6) */
+
     };
 
+#if (TYPE_CODE_LENGTH == 6)
+
+#if (MAX_TYPE_CODE != 0x3F)
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
+#endif
+
+#else /* (TYPE_CODE_LENGTH != 6) */
+
 #if (MAX_TYPE_CODE != 0xFF)
-#include "gctype.c and scheme.h inconsistent -- GC_Type_Map"
+#include "gctype.c and object.h inconsistent -- GC_Type_Map"
 #endif
 
+#endif /* (TYPE_CODE_LENGTH == 6) */
diff --git a/v8/src/microcode/lookup.h b/v8/src/microcode/lookup.h
index cc69294b9..dcf1fab1d 100644
--- a/v8/src/microcode/lookup.h
+++ b/v8/src/microcode/lookup.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.42 1989/05/31 01:50:41 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/lookup.h,v 9.43 1989/08/28 18:29:03 cph Exp $ */
 
 /* Macros and declarations for the variable lookup code. */
 
@@ -68,12 +68,26 @@ extern Pointer
 
 /* Common constants. */
 
-#ifndef b32
-#define UNCOMPILED_VARIABLE		Make_Non_Pointer(UNCOMPILED_REF, 0)
-#else
+#ifdef b32				/* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
 #define UNCOMPILED_VARIABLE		0x08000000
 #endif
 
+#if (TYPE_CODE_LENGTH == 6)
+#define UNCOMPILED_VARIABLE		0x20000000
+#endif
+
+#if (TC_TRUE != 0x08)
+#include "error:lookup.h and types.h are inconsistent"
+#endif
+
+#endif /* b32 */
+
+#ifndef UNCOMPILED_VARIABLE		/* Safe version */
+#define UNCOMPILED_VARIABLE		Make_Non_Pointer(UNCOMPILED_REF, 0)
+#endif
+
 /* Macros for speedy variable reference. */
 
 #if (LOCAL_REF == 0)
@@ -214,7 +228,7 @@ label:									\
   fast long depth;							\
 									\
   verify(FORMAL_REF, offset, get_offset(hunk), label);			\
-  depth = Get_Integer(frame);						\
+  depth = (OBJECT_DATUM (frame));					\
   frame = env;								\
   while(--depth >= 0)							\
   {									\
@@ -233,7 +247,7 @@ label:									\
   fast long depth;							\
 									\
   verify(AUX_REF, offset, get_offset(hunk), label);			\
-  depth = Get_Integer(frame);						\
+  depth = (OBJECT_DATUM (frame));					\
   frame = env;								\
   while(--depth >= 0)							\
   {									\
diff --git a/v8/src/microcode/object.h b/v8/src/microcode/object.h
index 55c4ed399..b85cd94f4 100644
--- a/v8/src/microcode/object.h
+++ b/v8/src/microcode/object.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.30 1989/05/24 18:14:52 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/object.h,v 9.31 1989/08/28 18:29:10 cph Exp $ */
 
 /* This file contains definitions pertaining to the C view of 
    Scheme pointers: widths of fields, extraction macros, pre-computed
@@ -42,27 +42,35 @@ MIT in each case. */
    POINTER_LENGTH is defined this way to make it available to
    the preprocessor. */
 
-/* TYPE_CODE_LENGTH must match the value in Wsize.c! */
-#define TYPE_CODE_LENGTH	8	/* Not CHAR_SIZE!! */
-#define MAX_TYPE_CODE		0xFF	/* ((1<<TYPE_CODE_LENGTH) - 1) */
-#define POINTER_LENGTH		ULONG_SIZE
-
-#ifndef b32			/* Portable versions */
+/* The value in Wsize.c for TYPE_CODE_LENGTH must match this!! */
+  
+#ifndef TYPE_CODE_LENGTH
+#define TYPE_CODE_LENGTH	8
+#endif
+  
+#if (TYPE_CODE_LENGTH == 8)
+#define MAX_TYPE_CODE		0xFF
+#endif
+  
+#if (TYPE_CODE_LENGTH == 6)
+#define MAX_TYPE_CODE		0x3F
+#endif
 
-#define ADDRESS_LENGTH		(POINTER_LENGTH-TYPE_CODE_LENGTH)
-#define ADDRESS_MASK		((1 << ADDRESS_LENGTH) - 1)
-#define TYPE_CODE_MASK		(~ADDRESS_MASK)
-/* FIXNUM_LENGTH does NOT include the sign bit! */
-#define FIXNUM_LENGTH		(ADDRESS_LENGTH - 1)
-#define FIXNUM_SIGN_BIT		(1 << FIXNUM_LENGTH)
-#define SIGN_MASK		(TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
-#define SMALLEST_FIXNUM		((long) (-1 << FIXNUM_LENGTH))
-#define BIGGEST_FIXNUM		((long) (~(-1 << FIXNUM_LENGTH)))
+#ifdef MIN_TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
+  
+#ifndef MAX_TYPE_CODE
+#define MAX_TYPE_CODE		((1 << TYPE_CODE_LENGTH) - 1)
+#endif
 
-#define HALF_ADDRESS_LENGTH	(ADDRESS_LENGTH / 2)
-#define HALF_ADDRESS_MASK	((1 << HALF_ADDRESS_LENGTH) - 1)
+#define POINTER_LENGTH		ULONG_SIZE
+  
+#ifdef b32			/* 32 bit word versions */
 
-#else				/* 32 bit word versions */
+#if (TYPE_CODE_LENGTH == 8)
 
 #define ADDRESS_LENGTH		24
 #define ADDRESS_MASK		0x00FFFFFF
@@ -72,29 +80,59 @@ MIT in each case. */
 #define SIGN_MASK		0xFF800000
 #define SMALLEST_FIXNUM		((long) 0xFF800000)
 #define BIGGEST_FIXNUM		((long) 0x007FFFFF)
-
 #define HALF_ADDRESS_LENGTH	12
 #define HALF_ADDRESS_MASK	0x00000FFF
-
-#endif
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define ADDRESS_LENGTH		26
+#define ADDRESS_MASK		0x03FFFFFF
+#define TYPE_CODE_MASK		0XFC000000
+#define FIXNUM_LENGTH		25
+#define FIXNUM_SIGN_BIT		0x02000000
+#define SIGN_MASK		0xFE000000
+#define SMALLEST_FIXNUM		((long) 0xFE000000)
+#define BIGGEST_FIXNUM		((long) 0x01FFFFFF)
+#define HALF_ADDRESS_LENGTH	13
+#define HALF_ADDRESS_MASK	0x00001FFF
+#endif /* (TYPE_CODE_LENGTH == 6) */
+
+#endif /* b32 */
+
+#ifndef ADDRESS_LENGTH		/* Safe versions */
+#define ADDRESS_LENGTH		(POINTER_LENGTH-TYPE_CODE_LENGTH)
+#define ADDRESS_MASK		((1 << ADDRESS_LENGTH) - 1)
+#define TYPE_CODE_MASK		(~ADDRESS_MASK)
+/* FIXNUM_LENGTH does NOT include the sign bit! */
+#define FIXNUM_LENGTH		(ADDRESS_LENGTH - 1)
+#define FIXNUM_SIGN_BIT		(1 << FIXNUM_LENGTH)
+#define SIGN_MASK		(TYPE_CODE_MASK | FIXNUM_SIGN_BIT)
+#define SMALLEST_FIXNUM		((long) (-1 << FIXNUM_LENGTH))
+#define BIGGEST_FIXNUM		((long) (~(-1 << FIXNUM_LENGTH)))
+#define HALF_ADDRESS_LENGTH	(ADDRESS_LENGTH / 2)
+#define HALF_ADDRESS_MASK	((1 << HALF_ADDRESS_LENGTH) - 1)
+#endif /* ADDRESS_LENGTH */
 
+#ifndef OBJECT_TYPE
 #ifndef UNSIGNED_SHIFT		/* Portable version */
 #define OBJECT_TYPE(P)		(((P) >> ADDRESS_LENGTH) & MAX_TYPE_CODE)
 #else				/* Faster for logical shifts */
 #define OBJECT_TYPE(P)		((P) >> ADDRESS_LENGTH)
 #endif
+#endif /* OBJECT_TYPE */
 
+#ifndef OBJECT_DATUM
 #define OBJECT_DATUM(P)		((P) & ADDRESS_MASK)
+#endif
+
+#ifndef MAKE_OBJECT
+#define MAKE_OBJECT(TC, D)						\
+  ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
+#endif
 
 /* compatibility definitions */
 #define Type_Code(P)		(OBJECT_TYPE (P))
 #define Datum(P)		(OBJECT_DATUM (P))
-
-#define pointer_type(P)		(OBJECT_TYPE (P))
-#define pointer_datum(P)	(OBJECT_DATUM (P))
-
-#define Make_Object(TC, D)						\
-  ((((unsigned) (TC)) << ADDRESS_LENGTH) | (OBJECT_DATUM (D)))
 
 #ifndef Heap_In_Low_Memory	/* Portable version */
 
@@ -113,7 +151,8 @@ extern Pointer *Memory_Base;
 #define Get_Pointer(P) ((Pointer *) (Memory_Base + (OBJECT_DATUM (P))))
 #define C_To_Scheme(P) ((Pointer) ((P) - Memory_Base))
 
-#else				/* Storing absolute addresses */
+#else /* not Heap_In_Low_Memory */
+/* Storing absolute addresses */
 
 typedef long relocation_type;	/* Used to relocate pointers on fasload */
 
@@ -121,29 +160,20 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
   (Heap = ((Pointer *) (malloc ((sizeof (Pointer)) * (space)))),	\
    ((Heap + (space)) - 1))
 
-#ifdef spectrum
-
-#define Quad1_Tag 	0x40000000
-#define Get_Pointer(P)	((Pointer *) (((P) & ADDRESS_MASK) | Quad1_Tag))
-#define C_To_Scheme(P)  ((Pointer) (((long) (P)) & ADDRESS_MASK))
-
-#else /* Not Spectrum, fast case */
-
 #define Get_Pointer(P)		((Pointer *) (OBJECT_DATUM (P)))
 #define C_To_Scheme(P)          ((Pointer) (P))
 
-#endif /* spectrum */
 #endif /* Heap_In_Low_Memory */
 
-#define Make_Pointer(TC, A)	Make_Object((TC), C_To_Scheme(A))
-#define Make_Non_Pointer(TC, D)	Make_Object(TC, ((Pointer) (D)))
+#define Make_Pointer(TC, A)	MAKE_OBJECT((TC), C_To_Scheme(A))
+#define Make_Non_Pointer(TC, D)	MAKE_OBJECT(TC, ((Pointer) (D)))
 
 /* (Make_New_Pointer (TC, A)) may be more efficient than
    (Make_Pointer (TC, (Get_Pointer (A)))) */
 
-#define Make_New_Pointer(TC, A) (Make_Object (TC, ((Pointer) A)))
+#define Make_New_Pointer(TC, A) (MAKE_OBJECT (TC, ((Pointer) A)))
 
-#define Store_Type_Code(P, TC)	P = (Make_Object ((TC), (P)))
+#define Store_Type_Code(P, TC)	P = (MAKE_OBJECT ((TC), (P)))
 
 #define Store_Address(P, A)						\
   P = (((P) & TYPE_CODE_MASK) | (OBJECT_DATUM ((Pointer) (A))))
@@ -158,7 +188,7 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
 #define Fast_User_Vector_Ref(P, N) 	Fast_Vector_Ref(P, (N)+1)
 #define Fast_User_Vector_Set(P, N, S)	Fast_Vector_Set(P, (N)+1, S)
 #define Nth_Vector_Loc(P, N)		(&(Fast_Vector_Ref(P, N)))
-#define Vector_Length(P)		(Get_Integer(Fast_Vector_Ref((P), 0)))
+#define Vector_Length(P) (OBJECT_DATUM (Fast_Vector_Ref((P), 0)))
 
 /* General case vector handling requires atomicity for parallel processors */
 
@@ -209,9 +239,9 @@ typedef long relocation_type;	/* Used to relocate pointers on fasload */
 #define MAKE_FIXNUM(N) (Make_Non_Pointer (TC_FIXNUM, (N)))
 #define FIXNUM_NEGATIVE_P(fixnum) (((fixnum) & FIXNUM_SIGN_BIT) != 0)
 #define MAKE_UNSIGNED_FIXNUM(N)	(FIXNUM_ZERO + (N))
-#define UNSIGNED_FIXNUM_VALUE(fixnum) (OBJECT_DATUM (fixnum))
-#define MAKE_SIGNED_FIXNUM Make_Signed_Fixnum
-#define long_to_object C_Integer_To_Scheme_Integer
+#define UNSIGNED_FIXNUM_VALUE OBJECT_DATUM
+#define MAKE_SIGNED_FIXNUM MAKE_FIXNUM
+#define NONNEGATIVE_FIXNUM_P(x) ((FIXNUM_P (x)) && (! (FIXNUM_NEGATIVE_P (x))))
 
 #define FIXNUM_VALUE(fixnum, target)					\
 do									\
@@ -221,20 +251,16 @@ do									\
     (target) |= (-1 << ADDRESS_LENGTH);					\
 } while (0)
 
+/* Compatibility */
+#define Make_Unsigned_Fixnum MAKE_UNSIGNED_FIXNUM
+#define Make_Signed_Fixnum MAKE_FIXNUM
+#define Get_Integer OBJECT_DATUM
+#define Sign_Extend FIXNUM_VALUE
+
 #define BOOLEAN_TO_OBJECT(expression) ((expression) ? SHARP_T : SHARP_F)
 
 #define Make_Broken_Heart(N)	(BROKEN_HEART_ZERO + (N))
-#define Make_Unsigned_Fixnum(N)	(FIXNUM_ZERO + (N))
-#define Make_Signed_Fixnum(N)	Make_Non_Pointer( TC_FIXNUM, (N))
 #define Get_Float(P)   (* ((double *) (Nth_Vector_Loc ((P), 1))))
-#define Get_Integer(P) (OBJECT_DATUM (P))
-
-#define Sign_Extend(P, S)						\
-{									\
-  (S) = (Get_Integer (P));						\
-  if (((S) & FIXNUM_SIGN_BIT) != 0)					\
-    (S) |= (-1 << ADDRESS_LENGTH);					\
-}
 
 #define Fixnum_Fits(x)							\
   ((((x) & SIGN_MASK) == 0) ||						\
diff --git a/v8/src/microcode/ppband.c b/v8/src/microcode/ppband.c
index 0f7ac9670..53a5312c7 100644
--- a/v8/src/microcode/ppband.c
+++ b/v8/src/microcode/ppband.c
@@ -1,6 +1,8 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.34 1989/08/28 18:28:03 cph Exp $
+
+Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,16 +32,14 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.33 1989/02/14 20:41:32 jinx Rel $
- *
- * Dumps Scheme FASL in user-readable form .
- */
+/* Dumps Scheme FASL in user-readable form. */
 
 #include <stdio.h>
 #include "config.h"
 #include "types.h"
 #include "const.h"
 #include "object.h"
+#include "gccode.h"
 #include "sdata.h"
 
 #define fast register
@@ -281,21 +281,27 @@ Display(Location, Type, The_Datum)
 }
 
 Pointer *
-show_area(area, size, name)
+show_area(area, start, end, name)
      fast Pointer *area;
-     fast long size;
+     long start;
+     fast long end;
      char *name;
 {
   fast long i;
 
   printf("\n%s contents:\n\n", name);
-  for (i = 0; i < size;  area++, i++)
+  for (i = start; i < end;  area++, i++)
   {
-    if (OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR)
+    if ((OBJECT_TYPE(*area) == TC_MANIFEST_NM_VECTOR) ||
+	(OBJECT_TYPE(*area) == TC_MANIFEST_CLOSURE) ||
+	(OBJECT_TYPE(*area) == TC_LINKAGE_SECTION))
     {
       fast long j, count;
 
-      count = Get_Integer(*area);
+      count =
+	((OBJECT_TYPE(*area) == TC_LINKAGE_SECTION)
+	 ? (READ_CACHE_LINKAGE_COUNT (*area))
+	 : (OBJECT_DATUM (*area)));
       Display(i, OBJECT_TYPE(*area), OBJECT_DATUM(*area));
       area += 1;
       for (j = 0; j < count ; j++, area++)
@@ -376,11 +382,11 @@ main(argc, argv)
 
   if (Heap_Count > 0)
   {
-    Next = show_area(Data, Heap_Count, "Heap");
+    Next = show_area(Data, 0, Heap_Count, "Heap");
   }
   if (Const_Count > 0)
   {
-    Next = show_area(Next, Const_Count, "Constant Space");
+    Next = show_area(Next, Heap_Count, Const_Count, "Constant Space");
   }
   if ((Primitive_Table_Size > 0) && (Next < end_of_memory))
   {
@@ -401,7 +407,7 @@ main(argc, argv)
 	 count += 1)
     {
       Sign_Extend(*Next++, arity);
-      size = Get_Integer(*Next);
+      size = (OBJECT_DATUM (*Next));
       printf("Number = %3lx; Arity = %2ld; Name = ", count, arity);
       scheme_string((Next - Data), true);
       Next += (1 + size);
diff --git a/v8/src/microcode/psbmap.h b/v8/src/microcode/psbmap.h
index 4a4628754..6906c615a 100644
--- a/v8/src/microcode/psbmap.h
+++ b/v8/src/microcode/psbmap.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.27 1988/08/15 20:53:22 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbmap.h,v 9.28 1989/08/28 18:29:21 cph Exp $
  *
  * This file contains macros and declarations for Bintopsb.c
  * and Psbtobin.c
@@ -45,10 +45,10 @@ MIT in each case. */
 
 #include <stdio.h>
 #include "config.h"
+#include "types.h"
 #include "object.h"
 #include "bignum.h"
 #include "bitstr.h"
-#include "types.h"
 #include "sdata.h"
 #include "const.h"
 #include "gccode.h"
diff --git a/v8/src/microcode/psbtobin.c b/v8/src/microcode/psbtobin.c
index bf8873bad..fa3ef7e44 100644
--- a/v8/src/microcode/psbtobin.c
+++ b/v8/src/microcode/psbtobin.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.34 1988/04/25 17:30:02 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.35 1989/08/28 18:28:07 cph Exp $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -547,7 +547,7 @@ Relocate_Objects(from, how_many, disp)
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
-	*from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
+	*from++ == MAKE_OBJECT(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
 	break;
 
       default:
@@ -746,8 +746,8 @@ print_external_objects(area_name, Table, N)
         fprintf(stderr,
 		"Table[%6d] = Character %c = 0x%02x\n",
 		(N - (Table_End - Table)),
-		Get_Integer(*Table),
-		Get_Integer(*Table));
+		(OBJECT_DATUM (*Table)),
+		(OBJECT_DATUM (*Table)));
 	break;
 
       case TC_CHARACTER_STRING:
diff --git a/v8/src/microcode/trap.h b/v8/src/microcode/trap.h
index 65e52be1d..44e604cf0 100644
--- a/v8/src/microcode/trap.h
+++ b/v8/src/microcode/trap.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.40 1988/08/15 20:56:29 cph Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/trap.h,v 9.41 1989/08/28 18:29:32 cph Exp $ */
 
 /* Kinds of traps:
 
@@ -81,16 +81,9 @@ MIT in each case. */
 
 /* Common constants */
 
-#ifndef b32
-#define UNASSIGNED_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
-#define DANGEROUS_UNASSIGNED_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
-#define UNBOUND_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
-#define DANGEROUS_UNBOUND_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
-#define ILLEGAL_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
-#define DANGEROUS_ILLEGAL_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
-#define EXPENSIVE_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
-#define DANGEROUS_EXPENSIVE_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
-#else
+#ifdef b32				/* 32 bit objects */
+
+#if (TYPE_CODE_LENGTH == 8)
 #define UNASSIGNED_OBJECT		0x32000000
 #define DANGEROUS_UNASSIGNED_OBJECT	0x32000001
 #define UNBOUND_OBJECT			0x32000002
@@ -99,14 +92,37 @@ MIT in each case. */
 #define DANGEROUS_ILLEGAL_OBJECT	0x32000005
 #define EXPENSIVE_OBJECT		0x32000006
 #define DANGEROUS_EXPENSIVE_OBJECT	0x32000007
-#endif
-
-#define NOP_OBJECT			Make_Unsigned_Fixnum(TRAP_NOP)
-#define DANGEROUS_OBJECT		Make_Unsigned_Fixnum(TRAP_DANGEROUS)
-#define REQUEST_RECACHE_OBJECT		DANGEROUS_ILLEGAL_OBJECT
-#define EXPENSIVE_ASSIGNMENT_OBJECT	EXPENSIVE_OBJECT
+#endif /* (TYPE_CODE_LENGTH == 8) */
+
+#if (TYPE_CODE_LENGTH == 6)
+#define UNASSIGNED_OBJECT		0xc8000000
+#define DANGEROUS_UNASSIGNED_OBJECT	0xc8000001
+#define UNBOUND_OBJECT			0xc8000002
+#define DANGEROUS_UNBOUND_OBJECT	0xc8000003
+#define ILLEGAL_OBJECT			0xc8000004
+#define DANGEROUS_ILLEGAL_OBJECT	0xc8000005
+#define EXPENSIVE_OBJECT		0xc8000006
+#define DANGEROUS_EXPENSIVE_OBJECT	0xc8000007
+#endif /* (TYPE_CODE_LENGTH == 6) */
 
 #if (TC_REFERENCE_TRAP != 0x32)
 #include "error: trap.h and types.h are inconsistent"
 #endif
 
+#endif /* b32 */
+
+#ifndef UNASSIGNED_OBJECT		/* Safe version */
+#define UNASSIGNED_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED)
+#define DANGEROUS_UNASSIGNED_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNASSIGNED_DANGEROUS)
+#define UNBOUND_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND)
+#define DANGEROUS_UNBOUND_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_UNBOUND_DANGEROUS)
+#define ILLEGAL_OBJECT			Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL)
+#define DANGEROUS_ILLEGAL_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_ILLEGAL_DANGEROUS)
+#define EXPENSIVE_OBJECT		Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE)
+#define DANGEROUS_EXPENSIVE_OBJECT	Make_Non_Pointer(TC_REFERENCE_TRAP, TRAP_EXPENSIVE_DANGEROUS)
+#endif /* UNASSIGNED_OBJECT */
+
+#define NOP_OBJECT			MAKE_UNSIGNED_FIXNUM(TRAP_NOP)
+#define DANGEROUS_OBJECT		MAKE_UNSIGNED_FIXNUM(TRAP_DANGEROUS)
+#define REQUEST_RECACHE_OBJECT		DANGEROUS_ILLEGAL_OBJECT
+#define EXPENSIVE_ASSIGNMENT_OBJECT	EXPENSIVE_OBJECT
diff --git a/v8/src/microcode/types.h b/v8/src/microcode/types.h
index 8968926c3..4949322f0 100644
--- a/v8/src/microcode/types.h
+++ b/v8/src/microcode/types.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987, 1988 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,7 +30,7 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.29 1988/08/15 20:56:46 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/types.h,v 9.30 1989/08/28 18:29:35 cph Exp $
  *
  * Type code definitions, numerical order
  *
@@ -107,6 +107,14 @@ MIT in each case. */
  */
 
 #define LAST_TYPE_CODE			0X3D
+
+#define MIN_TYPE_CODE_LENGTH		6
+
+#ifdef TYPE_CODE_LENGTH
+#if (TYPE_CODE_LENGTH < MIN_TYPE_CODE_LENGTH)
+#include ";; inconsistency between object.h and types.h: MIN_TYPE_CODE_LENGTH"
+#endif
+#endif
 
 #define TYPE_NAME_TABLE							\
 {									\
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index ad4b62f8b..e54b3fb9f 100644
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.87 1989/08/04 02:08:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.88 1989/08/28 18:29:43 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	87
+#define SUBVERSION	88
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
-- 
2.25.1