From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 11 May 1988 17:21:16 +0000 (+0000)
Subject: Bugs: `object-gc-type' was using `MAKE_UNSIGNED_FIXNUM' to compute its
X-Git-Tag: 20090517-FFI~12760
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1e66e51a99eeebf5e824c38e6816c1c563e08e33;p=mit-scheme.git

Bugs: `object-gc-type' was using `MAKE_UNSIGNED_FIXNUM' to compute its
result when in fact the result was signed.  `object-set-type' was
going to `Microcode_Termination' when its first argument was an
unknown type code, rather than signalling a bad-range error.
---

diff --git a/v7/src/microcode/prim.c b/v7/src/microcode/prim.c
index fb9df150e..b98ea8eab 100644
--- a/v7/src/microcode/prim.c
+++ b/v7/src/microcode/prim.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$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 $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/prim.c,v 9.30 1988/05/11 17:20:18 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -56,7 +56,8 @@ DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-GC-TYPE", Prim_prim_obj_gc_type, 1)
 {
   PRIMITIVE_HEADER (1); 
 
-  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (GC_Type (ARG_REF (1))));
+  PRIMITIVE_RETURN
+    (MAKE_SIGNED_FIXNUM (GC_Type_Map [OBJECT_TYPE (ARG_REF (1))]));
 }
 
 /* (PRIMITIVE-OBJECT-TYPE? TYPE-CODE OBJECT)
@@ -173,7 +174,7 @@ DEFINE_PRIMITIVE ("OBJECT-GC-TYPE", Prim_object_gc_type, 1)
   PRIMITIVE_HEADER (1); 
 
   Touch_In_Primitive ((ARG_REF (1)), object);
-  PRIMITIVE_RETURN (MAKE_UNSIGNED_FIXNUM (GC_Type (object)));
+  PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM (GC_Type (object)));
 }
 
 DEFINE_PRIMITIVE ("OBJECT-TYPE?", Prim_object_type_p, 2)
@@ -201,16 +202,20 @@ DEFINE_PRIMITIVE ("OBJECT-DATUM", Prim_object_datum, 1)
 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);
+  {
+    fast long gc_type_code;
+
+    gc_type_code = (GC_Type_Map [type_code]);
+    if ((gc_type_code == GC_Undefined) ||
+	(! ((gc_type_code == GC_Non_Pointer) ||
+	    (gc_type_code == (GC_Type (object))))))
+      error_bad_range_arg (1);
+  }
   PRIMITIVE_RETURN (Make_New_Pointer (type_code, object));
 }
 
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 2484d8635..a94404e01 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.38 1988/05/10 18:14:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.39 1988/05/11 17:21:16 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	38
+#define SUBVERSION	39
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 98fcc7686..4206c31f0 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.38 1988/05/10 18:14:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.39 1988/05/11 17:21:16 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	38
+#define SUBVERSION	39
 #endif
 
 #ifndef UCODE_TABLES_FILENAME