Add new primitive, `compiled-closure->entry'.

diff --git a/v7/src/microcode/comutl.c b/v7/src/microcode/comutl.c
index 609c9cfec9d5fcf7d68d3b128d958192ffe4aac8..38f44a9d16967645712f3b080ab554f1da5f58d6 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.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 b4c07e66a1824717f0a5f999249dcb5589a5ef65..73d89f988aef2a072d458176c00b38b9a72504e3 100644 (file)
--- 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 6a27e0a88fe86d425b46e96e8a5fb09c6aa4f14d..2db752e06727f9053f8f15c12fcc8b879ed5e51a 100644 (file)
--- 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