Added primitive COMPILED-CODE-ADDRESS->OFFSET

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 9d3e67eeffb53d7250a798ec6dd69531f5a26d48..e7204be27fb315aefe959575b31c9f0357acface 100644 (file)
--- 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 ce058d9e48aeba1aee4ebf921010f6039c835aef..52285d1ce6f8a150e2e995560298b1c2bf97d40f 100644 (file)
--- 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 c2d239ebd8802c34501e1cb23399c787b6d10864..6391826b7eb8c05a8a09a8ea423cc7d8b7ef334c 100644 (file)
--- 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 $"