From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 24 Mar 1988 07:13:46 +0000 (+0000)
Subject: * Delete `with-threaded-continuation' primitive.
X-Git-Tag: 20090517-FFI~12850
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a05b80ba583282b2f45894fb99a0600b829ee4d8;p=mit-scheme.git

* Delete `with-threaded-continuation' primitive.

* Implement `get-interrupt-enables' primitive.

* Split `primitive-type' and friends into two classes: one which is
gc-safe and touches arguments, the other non-safe with no touching.

* Implement primitive-procedure name aliasing in microcode.  This
allows microcode name changes to reuse existing bands.

* Do not use "-q" ld switch.  This causes lossage when Scheme is
loaded over NFS.
---

diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c
index 442e0aa2b..b9cca8539 100644
--- a/v7/src/microcode/boot.c
+++ b/v7/src/microcode/boot.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.46 1988/02/20 19:50:46 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.47 1988/03/24 07:12:02 cph Rel $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -690,17 +690,24 @@ gc_death(code, message, scan, free)
 
 /* Utility primitives. */
 
-#define IDENTITY_LENGTH 	20		/* Plenty of room */
-#define ID_RELEASE		0		/* Scheme system release */
-#define ID_MICRO_VERSION	1		/* Microcode version */
-#define ID_MICRO_MOD		2		/* Microcode modification */
-#define ID_PRINTER_WIDTH	3		/* Width of console (chars) */
-#define ID_PRINTER_LENGTH	4		/* Height of console (chars) */
-#define ID_NEW_LINE_CHARACTER	5		/* #\Newline */
-#define ID_FLONUM_PRECISION	6		/* Flonum mantissa (bits) */
-#define ID_FLONUM_EXPONENT	7		/* Flonum exponent (bits) */
-#define ID_OS_NAME		8		/* OS name (string) */
-#define ID_OS_VARIANT		9		/* OS variant (string) */
+#define IDENTITY_LENGTH 	20	/* Plenty of room */
+#define ID_RELEASE		0	/* System release (string) */
+#define ID_MICRO_VERSION	1	/* Microcode version (fixnum) */
+#define ID_MICRO_MOD		2	/* Microcode modification (fixnum) */
+#define ID_PRINTER_WIDTH	3	/* TTY width (# chars) */
+#define ID_PRINTER_LENGTH	4	/* TTY height (# chars) */
+#define ID_NEW_LINE_CHARACTER	5	/* #\Newline */
+#define ID_FLONUM_PRECISION	6	/* Flonum mantissa (# bits) */
+#define ID_FLONUM_EXPONENT	7	/* Flonum exponent (# bits) */
+#define ID_OS_NAME		8	/* OS name (string) */
+#define ID_OS_VARIANT		9	/* OS variant (string) */
+#define ID_STACK_TYPE		10	/* Scheme stack type (string) */
+
+#ifdef USE_STACKLETS
+#define STACK_TYPE_STRING "stacklets"
+#else
+#define STACK_TYPE_STRING "standard"
+#endif
 
 DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_Microcode_Identify, 0)
 {
@@ -730,6 +737,8 @@ DEFINE_PRIMITIVE ("MICROCODE-IDENTIFY", Prim_Microcode_Identify, 0)
     (Result, ID_OS_NAME, (C_String_To_Scheme_String (OS_Name)));
   User_Vector_Set
     (Result, ID_OS_VARIANT, (C_String_To_Scheme_String (OS_Variant)));
+  User_Vector_Set
+    (Result, ID_STACK_TYPE, (C_String_To_Scheme_String (STACK_TYPE_STRING)));
   PRIMITIVE_RETURN (Result);
 }
 
diff --git a/v7/src/microcode/hooks.c b/v7/src/microcode/hooks.c
index 77bd9ed64..4fa78b781 100644
--- a/v7/src/microcode/hooks.c
+++ b/v7/src/microcode/hooks.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/hooks.c,v 9.29 1988/01/02 15:02:25 cph Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/hooks.c,v 9.30 1988/03/24 07:12:24 cph Rel $
  *
  * This file contains various hooks and handles which connect the
  * primitives with the main interpreter.
@@ -535,20 +535,29 @@ DEFINE_PRIMITIVE ("SCODE-EVAL", Prim_Scode_Eval, 2)
   /*NOTREACHED*/
 }
 
+/* (GET-INTERRUPT-ENABLES)
+   Returns the current interrupt mask.  */
+
+DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0)
+{
+  PRIMITIVE_HEADER (0);
+
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (FETCH_INTERRUPT_MASK ()));
+}
+
 /* (SET-INTERRUPT-ENABLES! NEW-INT-ENABLES)
    Changes the enabled interrupt bits to NEW-INT-ENABLES and
    returns the previous value.  See MASK_INTERRUPT_ENABLES for more
-   information on interrupts.
-*/
-DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_Set_Interrupt_Enables, 1)
+   information on interrupts.  */
+
+DEFINE_PRIMITIVE ("SET-INTERRUPT-ENABLES!", Prim_set_interrupt_enables, 1)
 {
   long previous;
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Arg_1_Type(TC_FIXNUM);
-  previous = FETCH_INTERRUPT_MASK();
-  SET_INTERRUPT_MASK(Get_Integer(Arg1) & INT_Mask);
-  PRIMITIVE_RETURN( MAKE_SIGNED_FIXNUM(previous));
+  previous = (FETCH_INTERRUPT_MASK ());
+  SET_INTERRUPT_MASK ((FIXNUM_ARG (1)) & INT_Mask);
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (previous));
 }
 
 /* (SET-CURRENT-HISTORY! TRIPLE)
@@ -748,28 +757,3 @@ DEFINE_PRIMITIVE ("WITHIN-CONTROL-POINT", Prim_Within_Control_Point, 2)
   PRIMITIVE_ABORT( PRIM_APPLY);
   /*NOTREACHED*/
 }
-
-/* (WITH-THREADED-CONTINUATION PROCEDURE THUNK)
-   THUNK must be a procedure or primitive procedure which takes no
-   arguments.  PROCEDURE must expect one argument.  Basically this
-   primitive does (PROCEDURE (THUNK)) ... it calls the THUNK and
-   passes the result on as an argument to PROCEDURE.  However, it
-   leaves a "well-known continuation code" on the stack for use by
-   the continuation parser in the Scheme runtime system.
-*/
-DEFINE_PRIMITIVE ("WITH-THREADED-CONTINUATION", Prim_With_Threaded_Stack, 2)
-{
-  Primitive_2_Args();
-
-  Pop_Primitive_Frame(2);
- Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS+1));
-  Store_Expression(Arg1);	/* Save procedure to call later */
-  Store_Return(RC_INVOKE_STACK_THREAD);
-  Save_Cont();
-  Push(Arg2);	/* Function to call now */
-  Push(STACK_FRAME_HEADER);
- Pushed();
-  PRIMITIVE_ABORT( PRIM_APPLY);
-  /*NOTREACHED*/
-}
-
diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c
index f453792c1..fb9df150e 100644
--- a/v7/src/microcode/prim.c
+++ b/v7/src/microcode/prim.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/prim.c,v 9.29 1988/03/24 07:12:47 cph Rel $
+
+Copyright (c) 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -30,247 +32,265 @@ 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/prim.c,v 9.28 1987/11/17 08:14:49 jinx Rel $
- *
- * The leftovers ... primitives that don't seem to belong elsewhere.
- *
- */
+/* The leftovers ... primitives that don't seem to belong elsewhere. */
 
 #include "scheme.h"
 #include "primitive.h"
 
-/* Random predicates: */
-
-/* (NULL? OBJECT)
-   Returns #!TRUE if OBJECT is NIL.  Otherwise returns NIL.  This is
-   the primitive known as NOT, NIL?, and NULL? in Scheme.
-*/
-Built_In_Primitive(Prim_Null, 1, "NULL?", 0xC)
-Define_Primitive(Prim_Null, 1, "NULL?")
+/* Low level object manipulation */
+
+/* (PRIMITIVE-OBJECT-TYPE OBJECT)
+   Returns the type code of OBJECT as an unsigned integer.  */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE", Prim_prim_obj_type, 1)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Touch_In_Primitive(Arg1, Arg1);
-  PRIMITIVE_RETURN((Arg1 == NIL) ? TRUTH : NIL);
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (OBJECT_TYPE (ARG_REF (1))));
 }
 
-/* (EQ? OBJECT-1 OBJECT-2)
-   Returns #!TRUE if the two objects have the same type code
-   and datum.  Returns NIL otherwise.
-*/
-Built_In_Primitive(Prim_Eq, 2, "EQ?", 0xD)
-Define_Primitive(Prim_Eq, 2, "EQ?")
+/* (PRIMITIVE-OBJECT-GC-TYPE OBJECT)
+   Returns an unsigned integer indicating the GC type of the object.  */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-GC-TYPE", Prim_prim_obj_gc_type, 1)
 {
-  Primitive_2_Args();
+  PRIMITIVE_HEADER (1); 
 
-  if (Arg1 == Arg2)
-    return TRUTH;
-  Touch_In_Primitive(Arg1, Arg1);
-  Touch_In_Primitive(Arg2, Arg2);
-  PRIMITIVE_RETURN((Arg1 == Arg2) ? TRUTH : NIL);
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (GC_Type (ARG_REF (1))));
 }
-
-/* Pointer manipulation */
 
-/* (MAKE-NON-POINTER-OBJECT NUMBER)
-   Returns an (extended) fixnum with the same value as NUMBER.  In
-   the CScheme interpreter this is basically a no-op, since fixnums
-   already store 24 bits.
-*/
-Built_In_Primitive(Prim_Make_Non_Pointer, 1,
-		   "MAKE-NON-POINTER-OBJECT", 0xB1)
-Define_Primitive(Prim_Make_Non_Pointer, 1,
-		   "MAKE-NON-POINTER-OBJECT")
+/* (PRIMITIVE-OBJECT-TYPE? TYPE-CODE OBJECT)
+   Return #T if the type code of OBJECT is TYPE-CODE, else #F.  */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE?", Prim_prim_obj_type_p, 2)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (2);
 
-  Arg_1_Type(TC_FIXNUM);
-  PRIMITIVE_RETURN(Arg1);
+  PRIMITIVE_RETURN
+    (((OBJECT_TYPE (ARG_REF (2))) ==
+      (arg_index_integer (1, (MAX_TYPE_CODE + 1))))
+     ? TRUTH
+     : NIL);
 }
 
-/* (PRIMITIVE-DATUM OBJECT)
-   Returns the datum part of OBJECT.
-*/
-Built_In_Primitive(Prim_Primitive_Datum, 1, "PRIMITIVE-DATUM", 0xB0)
-Define_Primitive(Prim_Primitive_Datum, 1, "PRIMITIVE-DATUM")
+/* (PRIMITIVE-OBJECT-DATUM OBJECT)
+   Returns the datum part of OBJECT as an unsigned integer. */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
+
+  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.  */
 
-  PRIMITIVE_RETURN(Make_New_Pointer(TC_ADDRESS, Arg1));
+DEFINE_PRIMITIVE ("MAKE-NON-POINTER-OBJECT", Prim_make_non_pointer_object, 1)
+{
+  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))
+    error_bad_range_arg (1);
+  PRIMITIVE_RETURN (MAKE_FIXNUM (datum));
 }
 
-/* (PRIMITIVE-TYPE OBJECT)
-   Returns the type code of OBJECT as a number.
-   Note: THE OBJECT IS TOUCHED FIRST.
-*/
-Built_In_Primitive(Prim_Prim_Type, 1, "PRIMITIVE-TYPE", 0x10)
-Define_Primitive(Prim_Prim_Type, 1, "PRIMITIVE-TYPE")
+/* (PRIMITIVE-OBJECT-SET-TYPE TYPE-CODE OBJECT)
+   Returns a new object with TYPE-CODE and the datum part of OBJECT.  */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET-TYPE", Prim_prim_obj_set_type, 2)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (2);
 
-  Touch_In_Primitive(Arg1, Arg1);
-  PRIMITIVE_RETURN(Make_Unsigned_Fixnum(OBJECT_TYPE(Arg1)));
+  PRIMITIVE_RETURN
+    (Make_New_Pointer ((arg_index_integer (1, (MAX_TYPE_CODE + 1))),
+		       (ARG_REF (2))));
 }
 
-/* (PRIMITIVE-GC-TYPE OBJECT)
-   Returns a fixnum indicating the GC type of the object.  The object
-   is NOT touched first.
-*/
+/* (PRIMITIVE-OBJECT-EQ? OBJECT-1 OBJECT-2)
+   Returns #T if the two objects have the same type code and datum.
+   Returns #F otherwise.  */
 
-Built_In_Primitive(Prim_Gc_Type, 1, "PRIMITIVE-GC-TYPE", 0xBC)
-Define_Primitive(Prim_Gc_Type, 1, "PRIMITIVE-GC-TYPE")
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-EQ?", Prim_prim_obj_eq_p, 2)
 {
-  Primitive_1_Arg(); 
+  PRIMITIVE_HEADER (2);
 
-  PRIMITIVE_RETURN(Make_Non_Pointer(TC_FIXNUM, GC_Type(Arg1)));
+  PRIMITIVE_RETURN (((ARG_REF (1)) == (ARG_REF (2))) ? TRUTH : NIL);
 }
 
-/* (PRIMITIVE-TYPE? TYPE-CODE OBJECT)
-   Return #!TRUE if the type code of OBJECT is TYPE-CODE, NIL
-   otherwise.
-   Note: THE OBJECT IS TOUCHED FIRST.
-*/
-Built_In_Primitive(Prim_Prim_Type_QM, 2, "PRIMITIVE-TYPE?", 0xF)
-Define_Primitive(Prim_Prim_Type_QM, 2, "PRIMITIVE-TYPE?")
+/* Low level memory references.
+
+   Many primitives can be built out of these, and eventually should be.
+   These are extremely unsafe, since there is no consistency checking.
+   In particular, they are not gc-safe: You can screw yourself royally
+   by using them.  */
+
+/* (PRIMITIVE-OBJECT-REF OBJECT INDEX)
+   Fetches the index'ed slot in object.
+   Performs no type checking on object.  */
+
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-REF", Prim_prim_obj_ref, 2)
 {
-  Primitive_2_Args();
+  PRIMITIVE_HEADER (2);
 
-  Arg_1_Type(TC_FIXNUM);
-  Touch_In_Primitive(Arg2, Arg2);
-  PRIMITIVE_RETURN((Type_Code(Arg2) == Get_Integer(Arg1)) ? TRUTH : NIL);
+  PRIMITIVE_RETURN (Vector_Ref ((ARG_REF (1)), (arg_nonnegative_integer (2))));
 }
 
-/* (PRIMITIVE-SET-TYPE TYPE-CODE OBJECT)
-   Returns a new object with TYPE-CODE and the datum part of
-   OBJECT.
-   Note : IT TOUCHES ITS SECOND ARGUMENT (for completeness sake).
-   This is a "gc-safe" (paranoid) operation.
-*/
+/* (PRIMITIVE-OBJECT-SET! OBJECT INDEX VALUE)
+   Stores value in the index'ed slot in object.
+   Performs no type checking on object.  */
 
-Built_In_Primitive(Prim_Primitive_Set_Type, 2, "PRIMITIVE-SET-TYPE", 0x11)
-Define_Primitive(Prim_Primitive_Set_Type, 2, "PRIMITIVE-SET-TYPE")
+DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET!", Prim_prim_obj_set, 3)
 {
-  long New_GC_Type, New_Type;
-  Primitive_2_Args();
-
-  Arg_1_Type(TC_FIXNUM);
-  Range_Check(New_Type, Arg1, 0, MAX_TYPE_CODE, ERR_ARG_1_BAD_RANGE);
-  Touch_In_Primitive(Arg2, Arg2);
-  New_GC_Type = GC_Type_Code(New_Type);
-  if ((GC_Type(Arg2) == New_GC_Type) ||
-      (New_GC_Type == GC_Non_Pointer))
-  {
-    PRIMITIVE_RETURN(Make_New_Pointer(New_Type, Arg2));
-  }
-  else
-  {
-    Primitive_Error(ERR_ARG_1_BAD_RANGE);
-  }
-  /*NOTREACHED*/
+  fast long index;
+  PRIMITIVE_HEADER (3);
+
+  index = (arg_nonnegative_integer (2));
+  PRIMITIVE_RETURN
+    (Swap_Pointers (Nth_Vector_Loc ((ARG_REF (1)), index), (ARG_REF (3))));
 }
 
-/* Subprimitives.  
-   Many primitives can be built out of these, and eventually should be.
-   These are extremely unsafe, since there is no consistency checking.
-   In particular, they are not gc-safe: You can screw yourself royally
-   by using them.  
-*/
+/* Safe versions of the object manipulators.
+   These touch their arguments, and provide GC safety tests.  */
+
+DEFINE_PRIMITIVE ("OBJECT-TYPE", Prim_object_type, 1)
+{
+  fast Pointer object;
+  PRIMITIVE_HEADER (1);
 
-/* (&MAKE-OBJECT TYPE-CODE OBJECT)
-   Makes a Scheme object whose datum field is the datum field of
-   OBJECT, and whose type code is TYPE-CODE.  It does not touch.
-*/
+  Touch_In_Primitive ((ARG_REF (1)), object);
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (OBJECT_TYPE (object)));
+}
 
-Built_In_Primitive(Prim_And_Make_Object, 2, "&MAKE-OBJECT", 0x8D)
-Define_Primitive(Prim_And_Make_Object, 2, "&MAKE-OBJECT")
+DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1)
 {
-  long New_Type;
-  Primitive_2_Args();
+  fast Pointer object;
+  PRIMITIVE_HEADER (1); 
 
-  Arg_1_Type(TC_FIXNUM);
-  Range_Check(New_Type, Arg1, 0, MAX_TYPE_CODE, ERR_ARG_1_BAD_RANGE);
-  PRIMITIVE_RETURN(Make_New_Pointer(New_Type, Arg2));
+  Touch_In_Primitive ((ARG_REF (1)), object);
+  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (GC_Type (object)));
 }
 
-/* (SYSTEM-MEMORY-REF OBJECT INDEX)
-   Fetches the index'ed slot in object.
-   Performs no type checking in object.
-*/
+DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2)
+{
+  fast Pointer object;
+  PRIMITIVE_HEADER (2);
+
+  Touch_In_Primitive ((ARG_REF (2)), object);
+  PRIMITIVE_RETURN
+    (((OBJECT_TYPE (object)) ==
+      (arg_index_integer (1, (MAX_TYPE_CODE + 1))))
+     ? TRUTH
+     : NIL);
+}
 
-Built_In_Primitive(Prim_System_Memory_Ref, 2, "SYSTEM-MEMORY-REF", 0x195)
-Define_Primitive(Prim_System_Memory_Ref, 2, "SYSTEM-MEMORY-REF")
+DEFINE_PRIMITIVE ("OBJECT-DATUM", Prim_object_datum, 1)
 {
-  Primitive_2_Args();
+  fast Pointer object;
+  PRIMITIVE_HEADER (1);
 
-  Arg_2_Type(TC_FIXNUM);
-  PRIMITIVE_RETURN(Vector_Ref(Arg1, Get_Integer(Arg2)));
+  Touch_In_Primitive ((ARG_REF (1)), object);
+  PRIMITIVE_RETURN (C_Integer_To_Scheme_Integer (OBJECT_DATUM (object)));
+}
+
+DEFINE_PRIMITIVE ("OBJECT-SET-TYPE", Prim_object_set_type, 2)
+{
+  fast long type_code;
+  fast long gc_type_code;
+  fast Pointer object;
+  PRIMITIVE_HEADER (2);
+
+  type_code = (arg_index_integer (1, (MAX_TYPE_CODE + 1)));
+  gc_type_code = (GC_Type_Code (type_code));
+  Touch_In_Primitive ((ARG_REF (2)), object);
+  if ((gc_type_code != (GC_Type (object))) &&
+      (gc_type_code != GC_Non_Pointer))
+    error_bad_range_arg (1);
+  PRIMITIVE_RETURN (Make_New_Pointer (type_code, object));
 }
 
-/* (SYSTEM-MEMORY-SET! OBJECT INDEX VALUE)
-   Stores value in the index'ed slot in object.
-   Performs no type checking in object.
-*/
+/* (EQ? OBJECT-1 OBJECT-2)
+   Returns #T if the two objects have the same type code and datum.
+   Returns #F otherwise.
+   Touches both arguments.  */
+
+DEFINE_PRIMITIVE ("EQ?", Prim_eq, 2)
+{
+  fast Pointer object_1;
+  fast Pointer object_2;
+  PRIMITIVE_HEADER (2);
+
+  Touch_In_Primitive ((ARG_REF (1)), object_1);
+  Touch_In_Primitive ((ARG_REF (2)), object_2);
+  PRIMITIVE_RETURN ((object_1 == object_2) ? TRUTH : NIL);
+}
+
+/* (NOT OBJECT)
+   Returns #T if OBJECT is #F.  Otherwise returns #F.  This is
+   the primitive known as NOT, NULL?, and FALSE? in Scheme.
+   Touches the argument.  */
 
-Built_In_Primitive(Prim_System_Memory_Set, 3, "SYSTEM-MEMORY-SET!", 0x196)
-Define_Primitive(Prim_System_Memory_Set, 3, "SYSTEM-MEMORY-SET!")
+DEFINE_PRIMITIVE ("NOT", Prim_not, 1)
 {
-  long index;
-  Primitive_3_Args();
+  fast Pointer object;
+  PRIMITIVE_HEADER (1);
 
-  Arg_2_Type(TC_FIXNUM);
-  index = Get_Integer(Arg2);
-  PRIMITIVE_RETURN(Swap_Pointers(Nth_Vector_Loc(Arg1, index), Arg3));
+  Touch_In_Primitive ((ARG_REF (1)), object);
+  PRIMITIVE_RETURN ((object == NIL) ? TRUTH : NIL);
 }
 
 /* Cells */
 
 /* (MAKE-CELL CONTENTS)
-   Creates a cell with contents CONTENTS.
-*/
-Built_In_Primitive(Prim_Make_Cell, 1, "MAKE-CELL", 0x61)
-Define_Primitive(Prim_Make_Cell, 1, "MAKE-CELL")
+   Creates a cell with contents CONTENTS. */
+
+DEFINE_PRIMITIVE ("MAKE-CELL", Prim_make_cell, 1)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Primitive_GC_If_Needed(1);
-  *Free++ = Arg1;
-  PRIMITIVE_RETURN(Make_Pointer(TC_CELL, (Free - 1)));
+  Primitive_GC_If_Needed (1);
+  (*Free++) = (ARG_REF (1));
+  PRIMITIVE_RETURN (Make_Pointer (TC_CELL, (Free - 1)));
 }
 
-/* (CELL-CONTENTS CELL)
-   Returns the contents of the cell CELL.
-*/
-Built_In_Primitive(Prim_Cell_Contents, 1, "CELL-CONTENTS", 0x62)
-Define_Primitive(Prim_Cell_Contents, 1, "CELL-CONTENTS")
+/* (CELL? OBJECT)
+   Returns #T if OBJECT is a cell, else #F.  */
+
+DEFINE_PRIMITIVE ("CELL?", Prim_cell_p, 1)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Arg_1_Type(TC_CELL);
-  PRIMITIVE_RETURN(Vector_Ref(Arg1, CELL_CONTENTS));
+  PRIMITIVE_RETURN ((CELL_P (ARG_REF (1))) ? TRUTH : NIL);
 }
 
-/* (CELL? OBJECT)
-   Returns #!TRUE if OBJECT has type-code CELL, otherwise returns
-   NIL.
-*/
-Built_In_Primitive(Prim_Cell, 1, "CELL?", 0x63)
-Define_Primitive(Prim_Cell, 1, "CELL?")
+/* (CELL-CONTENTS CELL)
+   Returns the contents of the cell CELL.  */
+
+DEFINE_PRIMITIVE ("CELL-CONTENTS", Prim_cell_contents, 1)
 {
-  Primitive_1_Arg();
+  PRIMITIVE_HEADER (1);
 
-  Touch_In_Primitive(Arg1,Arg1);
-  PRIMITIVE_RETURN(((Type_Code(Arg1)) == TC_CELL) ? TRUTH : NIL);
+  PRIMITIVE_RETURN (Vector_Ref ((CELL_ARG (1)), CELL_CONTENTS));
 }
 
-/* (SET-CELL-CONTENTS! CELL VALUE)
-   Stores VALUE as contents of CELL.  Returns the previous contents of CELL.
-*/
-Built_In_Primitive(Prim_Set_Cell_Contents, 2, "SET-CELL-CONTENTS!", 0x8C)
-Define_Primitive(Prim_Set_Cell_Contents, 2, "SET-CELL-CONTENTS!")
-{
-  Primitive_2_Args();
+/* (SET-CELL-CONTENTS! CELL OBJECT)
+   Stores OBJECT as contents of CELL.
+   Returns the previous contents of CELL. */
 
-  Arg_1_Type(TC_CELL);
-  Side_Effect_Impurify(Arg1, Arg2);
-  PRIMITIVE_RETURN(Swap_Pointers(Nth_Vector_Loc(Arg1, CELL_CONTENTS), Arg2));
+DEFINE_PRIMITIVE ("SET-CELL-CONTENTS!", Prim_set_cell_contents, 2)
+{
+  fast Pointer cell;
+  fast Pointer object;
+  PRIMITIVE_HEADER (2);
+
+  cell = (CELL_ARG (1));
+  object = (ARG_REF (2));
+  Side_Effect_Impurify (cell, object);
+  PRIMITIVE_RETURN
+    (Swap_Pointers ((Nth_Vector_Loc (cell, CELL_CONTENTS)), object));
 }
diff --git a/v7/src/microcode/primutl.c b/v7/src/microcode/primutl.c
index 0efa74079..1b9a05f3e 100644
--- a/v7/src/microcode/primutl.c
+++ b/v7/src/microcode/primutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1988 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/primutl.c,v 9.44 1987/12/04 22:18:58 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/primutl.c,v 9.45 1988/03/24 07:13:17 cph Rel $
  *
  * This file contains the support routines for mapping primitive names
  * to numbers within the microcode.  Primitives are written in C
@@ -48,6 +48,32 @@ Pointer Undefined_Primitives_Arity = NIL;
 
 /* Common utilities. */
 
+struct primitive_alias
+  {
+    char *alias;
+    char *name;
+  };
+
+#include "prename.h"
+
+static char *
+primitive_alias_to_name (alias)
+     char *alias;
+{
+  fast struct primitive_alias *alias_ptr;
+  fast struct primitive_alias *alias_end;
+
+  alias_ptr = aliases;
+  alias_end = (alias_ptr + N_ALIASES);
+  while (alias_ptr < alias_end)
+    {
+      if ((strcmp (alias, (alias_ptr -> alias))) == 0)
+	return (alias_ptr -> name);
+      alias_ptr += 1;
+    }
+  return (alias);
+}
+
 /*
   In primitive_name_to_code, size is really 1 less than size.
   It is really the index of the last valid entry.
@@ -65,6 +91,7 @@ primitive_name_to_code(name, table, size)
 {
   fast int i;
 
+  name = (primitive_alias_to_name (name));
   for (i = size; i >= 0; i -= 1)
   {
     fast char *s1, *s2;
@@ -98,6 +125,7 @@ primitive_name_to_code(name, table, size)
   extern int strcmp();
   fast int low, high, middle, result;
 
+  name = (primitive_alias_to_name (name));
   low = 0;
   high = size;
 
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 07fcdc50c..d5e34b8de 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.29 1988/03/21 21:17:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.30 1988/03/24 07:13:46 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	29
+#define SUBVERSION	30
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index bb3156cd4..4397a7543 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.29 1988/03/21 21:17:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.30 1988/03/24 07:13:46 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION		10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION	29
+#define SUBVERSION	30
 #endif
 
 #ifndef UCODE_TABLES_FILENAME