From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 4 Jul 2004 05:23:43 +0000 (+0000)
Subject: Add new primitive TYPE->GC-TYPE.
X-Git-Tag: 20090517-FFI~1627
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=54976d718e1d8f60c966a78bd7c5551a81ee62bf;p=mit-scheme.git

Add new primitive TYPE->GC-TYPE.
---

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;