Add new primitive TYPE->GC-TYPE.

diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c
index d817a80780764c13ee4a7dcab8be32b4aef926fa..53e2cf15ae76d33489535c3b208fd84cde0802e2 100644 (file)
--- a/v7/src/microcode/prim.c
+++ b/v7/src/microcode/prim.c
@@ -1,8 +1,9 @@
 /* -*-C-*-
 
-$Id: prim.c,v 9.41 2003/02/14 18:28:22 cph Exp $
+$Id: prim.c,v 9.42 2004/07/04 05:23:43 cph Exp $
 
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1992,1993 Massachusetts Institute of Technology
+Copyright 1996,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -133,6 +134,14 @@ DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1, 1, 0)
   PRIMITIVE_RETURN (LONG_TO_FIXNUM (GC_Type (object)));
 }
 
+DEFINE_PRIMITIVE ("TYPE->GC-TYPE", Prim_type_to_gc_type, 1, 1, 0)
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    (LONG_TO_FIXNUM
+     (GC_Type_Map [arg_ulong_index_integer (1, (MAX_TYPE_CODE + 1))]));
+}
+
 DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2, 2, 0)
 {
   fast SCHEME_OBJECT object;