From: Henry M. Wu <edu/mit/csail/zurich/mhwu>
Date: Tue, 14 Jul 1987 04:57:04 +0000 (+0000)
Subject: Added primitive COMPILED-CODE-ADDRESS->OFFSET
X-Git-Tag: 20090517-FFI~13258
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=980829e88ff8bcc3fa9268532206df03152bbcaa;p=mit-scheme.git

Added primitive COMPILED-CODE-ADDRESS->OFFSET
---

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 9d3e67eef..e7204be27 100644
--- a/v7/src/microcode/comutl.c
+++ b/v7/src/microcode/comutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.4 1987/06/15 23:02:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.5 1987/07/14 04:56:41 mhwu Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -58,3 +58,20 @@ Built_In_Primitive (Prim_compiled_code_address_block, 1,
   error_external_return ();
 #endif /* CMPGCFILE */
 }
+
+Built_In_Primitive (Prim_compiled_code_address_offset, 1,
+		    "COMPILED-CODE-ADDRESS->OFFSET", 0xAC)
+{
+  Pointer *address;
+  Primitive_1_Arg ();
+
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+  address = (Get_Pointer (Arg1));
+
+#ifdef CMPGCFILE
+  return (Make_Non_Pointer (TC_FIXNUM,
+			    (Get_Compiled_Offset (address))));
+#else /* not CMPGCFILE */
+  error_external_return ();
+#endif /* CMPGCFILE */
+}
diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm
index ce058d9e4..52285d1ce 100644
--- a/v7/src/microcode/utabmd.scm
+++ b/v7/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.35 1987/07/14 02:59:08 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.36 1987/07/14 04:57:04 mhwu Rel $
 
 (declare (usual-integrations))
 
@@ -500,7 +500,7 @@
 	       NEGATIVE-FLONUM?				;$A9
 	       GREATER-THAN-FLONUM?			;$AA
 	       INTERN-CHARACTER-LIST			;$AB
-	       #F					;$AC
+	       COMPILED-CODE-ADDRESS->OFFSET		;$AC
 	       (STRING-SIZE VECTOR-8B-SIZE)		;$AD
 	       SYSTEM-VECTOR-SIZE			;$AE
 	       FORCE					;$AF
@@ -863,4 +863,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.35 1987/07/14 02:59:08 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.36 1987/07/14 04:57:04 mhwu Rel $"
diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm
index c2d239ebd..6391826b7 100644
--- a/v8/src/microcode/utabmd.scm
+++ b/v8/src/microcode/utabmd.scm
@@ -37,7 +37,7 @@
 
 ;;;; Machine Dependent Type Tables
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.35 1987/07/14 02:59:08 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.36 1987/07/14 04:57:04 mhwu Rel $
 
 (declare (usual-integrations))
 
@@ -500,7 +500,7 @@
 	       NEGATIVE-FLONUM?				;$A9
 	       GREATER-THAN-FLONUM?			;$AA
 	       INTERN-CHARACTER-LIST			;$AB
-	       #F					;$AC
+	       COMPILED-CODE-ADDRESS->OFFSET		;$AC
 	       (STRING-SIZE VECTOR-8B-SIZE)		;$AD
 	       SYSTEM-VECTOR-SIZE			;$AE
 	       FORCE					;$AF
@@ -863,4 +863,4 @@
 
 ;;; This identification string is saved by the system.
 
-"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.35 1987/07/14 02:59:08 cph Exp $"
+"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.36 1987/07/14 04:57:04 mhwu Rel $"