From 4f516417201ad9b29e83078d16fd376917280c4f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 8 Nov 1988 07:31:15 +0000
Subject: [PATCH] Add new primitive, `compiled-closure->entry'.

---
 v7/src/microcode/comutl.c  | 42 ++++++++++++++++++++++++++++----------
 v7/src/microcode/version.h |  4 ++--
 v8/src/microcode/version.h |  4 ++--
 3 files changed, 35 insertions(+), 15 deletions(-)

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 609c9cfec..38f44a9d1 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.13 1988/08/15 20:44:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/comutl.c,v 1.14 1988/11/08 07:31:15 cph Exp $
 
 Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
@@ -50,24 +50,25 @@ extern void
 #define COMPILED_CODE_ADDRESS_P(object)			\
    ((OBJECT_TYPE (object)) == TC_COMPILED_ENTRY)
 
-DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", Prim_comp_code_address_block, 1, 1, 0)
+DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->BLOCK", Prim_comp_code_address_block, 1, 1,
+  "Given a compiled code address, return its compiled code block.")
 {
-  Pointer *address;
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
-  address = compiled_entry_to_block_address(Arg1);
-  PRIMITIVE_RETURN (Make_Pointer (TC_COMPILED_CODE_BLOCK, address));
+  PRIMITIVE_RETURN
+    (Make_Pointer (TC_COMPILED_CODE_BLOCK,
+		   (compiled_entry_to_block_address (ARG_REF (1)))));
 }
 
-DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", Prim_comp_code_address_offset, 1, 1, 0)
+DEFINE_PRIMITIVE ("COMPILED-CODE-ADDRESS->OFFSET", Prim_comp_code_address_offset, 1, 1,
+  "Given a compiled code address, return its offset into its block.")
 {
-  long offset;
-  Primitive_1_Arg ();
+  PRIMITIVE_HEADER (1);
 
   CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
-  offset = compiled_entry_to_block_offset(Arg1);
-  PRIMITIVE_RETURN (MAKE_SIGNED_FIXNUM (offset));
+  PRIMITIVE_RETURN
+    (MAKE_SIGNED_FIXNUM (compiled_entry_to_block_offset (ARG_REF (1))));
 }
 
 /*
@@ -129,3 +130,22 @@ DEFINE_PRIMITIVE ("COERCE-TO-COMPILED-PROCEDURE", Prim_coerce_to_closure, 2, 2,
       /*NOTREACHED*/
   }
 }
+
+DEFINE_PRIMITIVE ("COMPILED-CLOSURE->ENTRY", Prim_compiled_closure_to_entry, 1, 1,
+  "Given a compiled closure, return the entry point which it invokes.")
+{
+  Pointer entry_type [3];
+  Pointer closure;
+  extern void compiled_entry_type ();
+  extern long compiled_entry_manifest_closure_p ();
+  extern Pointer compiled_closure_to_entry ();
+  PRIMITIVE_HEADER (1);
+
+  CHECK_ARG (1, COMPILED_CODE_ADDRESS_P);
+  closure = (ARG_REF (1));
+  compiled_entry_type (closure, (& entry_type));
+  if (! (((entry_type [0]) == 0) &&
+	 (compiled_entry_manifest_closure_p (closure))))
+    error_bad_range_arg (1);
+  PRIMITIVE_RETURN (compiled_closure_to_entry (closure));
+}
diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index b4c07e66a..73d89f988 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.60 1988/11/03 08:35:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.61 1988/11/08 07:30:57 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	60
+#define SUBVERSION	61
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 6a27e0a88..2db752e06 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.60 1988/11/03 08:35:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.61 1988/11/08 07:30:57 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	60
+#define SUBVERSION	61
 #endif
 
 #ifndef UCODE_TABLES_FILENAME
-- 
2.25.1