From 8c038b4d686e2a9738b7c7aca5d72237562ea0b4 Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 10 Jun 1993 06:04:40 +0000
Subject: [PATCH] Add support for code compiled to C.

---
 v7/src/runtime/packag.scm  | 37 +++++++++++++++++++++++++++++++++----
 v7/src/runtime/runtime.pkg |  5 ++++-
 v8/src/runtime/runtime.pkg |  5 ++++-
 3 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm
index 2cae8e832..4c0cdc5bd 100644
--- a/v7/src/runtime/packag.scm
+++ b/v7/src/runtime/packag.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: packag.scm,v 14.12 1992/12/07 19:06:51 cph Exp $
+$Id: packag.scm,v 14.13 1993/06/10 06:04:33 gjr Exp $
 
-Copyright (c) 1988-1992 Massachusetts Institute of Technology
+Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -163,14 +163,43 @@ MIT in each case. |#
 	    ((load (pathname-new-type pathname "bldr")
 		   system-global-environment
 		   syntax-table false)
-	     (lambda (filename environment)
-	       (load filename environment syntax-table true))
+	     (lambda (component environment)
+	       (cond ((filename->compiled-object filename component)
+		      => (lambda (value)
+			   (purify (load/purification-root value))
+			   (scode-eval value environment)))
+		     (else
+		      (load component environment syntax-table true))))
 	     options))))))
   ;; Make sure that everything we just loaded is purified.  If the
   ;; program runs before it gets purified, some of its run-time state
   ;; can end up being purified also.
   (flush-purification-queue!))
 
+(define (filename->compiled-object system component)
+  (let ((prim (ucode-primitive initialize-c-compiled-block 1)))
+    (and (implemented-primitive-procedure? prim)
+	 (let ((name
+		(let* ((p (->pathname component))
+		       (d (pathname-directory p)))
+		  (string-append
+		   (if (or (not d) (null? d))
+		       system
+		       (car (last-pair d)))
+		   "_"
+		   (string-replace (pathname-name p) ; kludge
+				   #\-
+				   #\_)))))
+	   (if suppress-loading-message?
+	       (prim name)
+	       (let ((port (nearest-cmdl/port)))
+		 (fresh-line port)
+		 (write-string ";Initializing " port)
+		 (write name port)
+		 (let ((value (prim name)))
+		   (write-string " -- done" port)
+		   value)))))))
+
 (define-integrable (package/reference package name)
   (lexical-reference (package/environment package) name))
 
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index c8cc5e690..5f8019d6e 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.178 1993/04/27 20:21:14 hal Exp $
+$Id: runtime.pkg,v 14.179 1993/06/10 06:04:40 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1212,6 +1212,9 @@ MIT in each case. |#
 	  load/suppress-loading-message?
 	  read-file
 	  set-command-line-parser!)
+  (export (package)
+	  suppress-loading-message?
+	  load/purification-root)
   (initialization (initialize-package!)))
 
 (define-package (runtime macros)
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index c8cc5e690..5f8019d6e 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.178 1993/04/27 20:21:14 hal Exp $
+$Id: runtime.pkg,v 14.179 1993/06/10 06:04:40 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1212,6 +1212,9 @@ MIT in each case. |#
 	  load/suppress-loading-message?
 	  read-file
 	  set-command-line-parser!)
+  (export (package)
+	  suppress-loading-message?
+	  load/purification-root)
   (initialization (initialize-package!)))
 
 (define-package (runtime macros)
-- 
2.25.1