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.

diff --git a/v8/src/runtime/coerce.scm b/v8/src/runtime/coerce.scm
index d3565984c7ecc92cc894e166ea2c08303072f4dc..9b7ff26da3dca708f5eb7d3de0ec4b81cf17a818 100644 (file)
--- 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))
 \f
@@ -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 66c0a134f283b51d8975f5d3100241b7db455bab..51f25ee4333d135d78394478401202bd39942801 100644 (file)
--- 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 9e451a28448b59c586b64a44638de7cefb577bff..6d14d3a5c90a34274fe1f5bcf96db954341de444 100644 (file)
--- 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))