From 54976d718e1d8f60c966a78bd7c5551a81ee62bf Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 4 Jul 2004 05:23:43 +0000
Subject: [PATCH] Add new primitive TYPE->GC-TYPE.

---
 v7/src/microcode/prim.c | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c
index d817a8078..53e2cf15a 100644
--- 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;
-- 
2.25.1