From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Sat, 13 Nov 1993 02:21:39 +0000 (+0000)
Subject: Add declare-shared-library for the C back end.
X-Git-Tag: 20090517-FFI~7521
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=efa9cfd5f801d9317c185645e49a97eb81f7e656;p=mit-scheme.git

Add declare-shared-library for the C back end.
---

diff --git a/v7/src/runtime/option.scm b/v7/src/runtime/option.scm
index 445d7b302..7faaf3354 100644
--- a/v7/src/runtime/option.scm
+++ b/v7/src/runtime/option.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: option.scm,v 14.25 1993/11/02 20:13:09 adams Exp $
+$Id: option.scm,v 14.26 1993/11/13 02:21:31 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -36,27 +36,35 @@ MIT in each case. |#
 ;;; package: (runtime options)
 
 (declare (usual-integrations))
-
+
 (define (load-option name)
   (let ((entry (assq name options)))
     (if (not entry)
 	(error "Unknown option name" name))
     (if (not (memq name loaded-options))
-	(let ((directory (library-directory-pathname "options")))
+	(let ((directory (delay (library-directory-pathname "options"))))
 	  (for-each
 	   (lambda (descriptor)
 	     (let ((environment
 		    (package/environment (find-package (car descriptor)))))
-	       (for-each (lambda (filename)
-			   (let ((path (merge-pathnames filename directory)))
-			     (with-working-directory-pathname
-			      (directory-pathname path)
-			      (lambda ()
-				(load path
-				      environment
-				      syntax-table/system-internal
-				      true)))))
-			 (cddr descriptor))
+	       (for-each
+		(lambda (filename)
+		  (cond (((ucode-primitive initialize-c-compiled-block 1)
+			  (string-append "runtime_" filename))
+			 => (lambda (obj)
+			      (purify obj)
+			      (scode-eval obj environment)))
+			(else
+			 (let ((path
+				(merge-pathnames filename (force directory))))
+			   (with-working-directory-pathname
+			     (directory-pathname path)
+			     (lambda ()
+			       (load path
+				     environment
+				     syntax-table/system-internal
+				     true)))))))
+		(cddr descriptor))
 	       (eval (cadr descriptor) environment)))
 	   (cdr entry))
 	  (set! loaded-options (cons name loaded-options))))
@@ -85,4 +93,17 @@ MIT in each case. |#
     (SUBPROCESS ((RUNTIME SUBPROCESS) (INITIALIZE-PACKAGE!) "process"))))
 
 (define loaded-options
-  '())
\ No newline at end of file
+  '())
+
+(define (declare-shared-library shared-library thunk)
+  (let ((thunk-valid?
+	 (lambda (thunk)
+	   (not (condition? (ignore-errors thunk))))))
+    (add-event-receiver!
+     event:after-restore
+     (lambda ()
+       (if (not (thunk-valid? thunk))
+	   (fluid-let ((load/suppress-loading-message? true))
+	     (load (merge-pathnames
+		    (library-directory-pathname "shared")
+		    shared-library))))))))
\ No newline at end of file
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 5b3844454..542d0b1de 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.212 1993/11/03 03:31:17 adams Exp $
+$Id: runtime.pkg,v 14.213 1993/11/13 02:21:39 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1437,6 +1437,7 @@ MIT in each case. |#
   (files "option")
   (parent ())
   (export ()
+	  declare-shared-library
 	  load-option))
 
 (define-package (runtime parser)
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 5b3844454..542d0b1de 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.212 1993/11/03 03:31:17 adams Exp $
+$Id: runtime.pkg,v 14.213 1993/11/13 02:21:39 gjr Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -1437,6 +1437,7 @@ MIT in each case. |#
   (files "option")
   (parent ())
   (export ()
+	  declare-shared-library
 	  load-option))
 
 (define-package (runtime parser)