From 5e1d8186a74eb3f1ee2ac2a60292f5123f380074 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 26 Jul 1996 14:38:26 +0000
Subject: [PATCH] Initial cut at writing COERCE-TO-COMPILED-PROCEDURE in
 Scheme.  The next change will be to make the compiler generate calls to this
 procedure rather than the primitive COERCE-TO-COMPILED-PROCEDURE, which
 should result in both faster generation and invocation of trampolines.

Eventually we might make the linker use this code too.

The code is a bit hairy and needs special initialization, hence the
changes in make.scm.
---
 v8/src/runtime/coerce.scm  | 16 ++++++++--------
 v8/src/runtime/make.scm    | 10 +++++++++-
 v8/src/runtime/runtime.pkg | 11 +++++++++--
 3 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/v8/src/runtime/coerce.scm b/v8/src/runtime/coerce.scm
index d3565984c..9b7ff26da 100644
--- a/v8/src/runtime/coerce.scm
+++ b/v8/src/runtime/coerce.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: coerce.scm,v 1.1 1996/07/26 14:25:07 adams Exp $
+$Id: coerce.scm,v 1.2 1996/07/26 14:38:01 adams Exp $
 
 Copyright (c) 1996 Massachusetts Institute of Technology
 
@@ -35,7 +35,7 @@ MIT in each case. |#
 ;;;; Coerce-to-compiled-procedure
 ;;; package: (runtime coerce-to-compiled-procedure)
 
-;;  This file must be syntaxed with teh 8.0 compiler loaded
+;;  This file must be syntaxed with the 8.0 compiler loaded
 
 (declare (usual-integrations))
 
@@ -97,18 +97,18 @@ MIT in each case. |#
 	     (else (default))))
 	  ((2)
 	   (case max
-	     ((3)  (lambda (a1) (f a1 xx)))
-	     ((4)  (lambda (a1) (f a1 xx xx)))
-	     ((5)  (lambda (a1) (f a1 xx xx xx)))
+	     ((3)  (lambda (a1) (%funcall f a1 xx)))
+	     ((4)  (lambda (a1) (%funcall f a1 xx xx)))
+	     ((5)  (lambda (a1) (%funcall f a1 xx xx xx)))
 	     (else (default))))
 	  ((3)
 	   (case max
-	     ((4)  (lambda (a1 a2) (f a1 a2 xx)))
-	     ((5)  (lambda (a1 a2) (f a1 a2 xx xx)))
+	     ((4)  (lambda (a1 a2) (%funcall f a1 a2 xx)))
+	     ((5)  (lambda (a1 a2) (%funcall f a1 a2 xx xx)))
 	     (else (default))))
 	  ((4)
 	   (case max
-	     ((5)  (lambda (a1 a2 a3) (f a1 a2 a3 xx)))
+	     ((5)  (lambda (a1 a2 a3) (%funcall f a1 a2 a3 xx)))
 	     (else (default))))
 	  (else (default))))
        (else;; max >= 128
diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm
index 66c0a134f..51f25ee43 100644
--- a/v8/src/runtime/make.scm
+++ b/v8/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.60 1996/07/23 03:44:03 adams Exp $
+$Id: make.scm,v 14.61 1996/07/26 14:38:26 adams Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -64,6 +64,11 @@ MIT in each case. |#
 
 (define apply (ucode-primitive apply 2))
 
+;; So is this definition.
+
+(define coerce-to-compiled-procedure
+  (ucode-primitive coerce-to-compiled-procedure 2))
+
 ;; This must go before the uses of the-environment later,
 ;; and after apply above.
 
@@ -347,6 +352,7 @@ MIT in each case. |#
 	 ("list" . (RUNTIME LIST))
 	 ("symbol" . ())
 	 ("uproc" . (RUNTIME PROCEDURE))
+	 ("coerce" . (RUNTIME COERCE-TO-COMPILED-PROCEDURE))
 	 ("fixart" . ())
 	 ("random" . (RUNTIME RANDOM-NUMBER))
 	 ("gentag" . (RUNTIME GENERIC-PROCEDURE))
@@ -370,6 +376,8 @@ MIT in each case. |#
 		      'CONSTANT-SPACE/BASE
 		      constant-space/base)
   (package-initialize '(RUNTIME LIST) 'INITIALIZE-PACKAGE! true)
+  (package-initialize '(RUNTIME COERCE-TO-COMPILED-PROCEDURE)
+		      'INITIALIZE-PACKAGE! true)
   (package-initialize '(RUNTIME RANDOM-NUMBER) 'INITIALIZE-PACKAGE! #t)
   (package-initialize '(RUNTIME GENERIC-PROCEDURE) 'INITIALIZE-TAG-CONSTANTS!
 		      #t)
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 9e451a284..6d14d3a5c 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.274 1996/07/26 00:36:11 adams Exp $
+$Id: runtime.pkg,v 14.275 1996/07/26 14:38:16 adams Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -3307,4 +3307,11 @@ MIT in each case. |#
 	  eqht/for-each
 	  eqht/get
 	  eqht/put!
-	  make-eqht))
\ No newline at end of file
+	  make-eqht))
+
+
+(define-package (runtime coerce-to-compiled-procedure)
+  (files "coerce")
+  (parent ())
+  (export ()
+	  coerce-to-compiled-procedure))
-- 
2.25.1