From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Aug 2005 20:03:05 +0000 (+0000)
Subject: Eliminate support for compiled C code.
X-Git-Tag: 20090517-FFI~1233
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1b982e28dd6814c0a92b29f1d0ba2c168e2a7a76;p=mit-scheme.git

Eliminate support for compiled C code.
---

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index 6a47c3d9f..7f288873e 100644
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.99 2005/07/31 02:54:44 cph Exp $
+$Id: make.scm,v 14.100 2005/08/05 20:02:56 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,2000 Massachusetts Institute of Technology
@@ -247,20 +247,12 @@ USA.
 	       bin-file)))))
 
 (define (file->object filename purify? optional?)
-  (let* ((block-name (string-append "runtime_" filename))
-	 (value (initialize-c-compiled-block block-name)))
-    (cond (value
-	   (tty-write-string newline-string)
-	   (tty-write-string block-name)
-	   (tty-write-string " initialized")
-	   (remember-to-purify purify? filename value))
-	  ((map-filename filename)
-	   => (lambda (mapped)
-		(fasload mapped purify?)))
-	  ((not optional?)
-	   (fatal-error (string-append "Could not find " filename)))
-	  (else
-	   #f))))
+  (cond ((map-filename filename)
+	 => (lambda (mapped)
+	      (fasload mapped purify?)))
+	((not optional?)
+	 (fatal-error (string-append "Could not find " filename)))
+	(else #f)))
 
 (define (eval object environment)
   (let ((value (scode-eval object environment)))
@@ -296,14 +288,6 @@ USA.
 (define fasload-purification-queue
   '())
 
-(define initialize-c-compiled-block
-  (let ((prim (ucode-primitive initialize-c-compiled-block 1)))
-    (if (implemented-primitive-procedure? prim)
-	prim
-	(lambda (name)
-	  name				; ignored
-	  #f))))
-
 (define os-name
   (intern os-name-string))
 
diff --git a/v7/src/runtime/option.scm b/v7/src/runtime/option.scm
index 2916efff6..8694c9291 100644
--- a/v7/src/runtime/option.scm
+++ b/v7/src/runtime/option.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: option.scm,v 14.47 2005/04/30 05:10:37 cph Exp $
+$Id: option.scm,v 14.48 2005/08/05 20:03:01 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1997,1998,2001,2002 Massachusetts Institute of Technology
@@ -117,24 +117,17 @@ USA.
 	  (runtime (pathname-as-directory "runtime")))
       (for-each (lambda (file)
 		  (let ((file (force* file)))
-		    (cond 
-		     (((ucode-primitive initialize-c-compiled-block 1)
-		       (string-append "runtime_" file))
-		      => (lambda (obj)
-			   (purify obj)
-			   (scode-eval obj environment)))
-		     (else
-		      (let* ((options (library-directory-pathname "options"))
-			     (pathname (merge-pathnames file options)))
-			(with-directory-rewriting-rule options runtime
-			  (lambda ()
-			    (with-working-directory-pathname
-				(directory-pathname pathname)
-			      (lambda ()
-				(load pathname
-				      environment
-				      'DEFAULT
-				      #t))))))))))
+		    (let* ((options (library-directory-pathname "options"))
+			   (pathname (merge-pathnames file options)))
+		      (with-directory-rewriting-rule options runtime
+			(lambda ()
+			  (with-working-directory-pathname
+			      (directory-pathname pathname)
+			    (lambda ()
+			      (load pathname
+				    environment
+				    'DEFAULT
+				    #t))))))))
 		files)
       (flush-purification-queue!)
       (eval init-expression environment))))
diff --git a/v7/src/runtime/packag.scm b/v7/src/runtime/packag.scm
index f3ad6d2b5..a2de009e3 100644
--- a/v7/src/runtime/packag.scm
+++ b/v7/src/runtime/packag.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: packag.scm,v 14.46 2004/12/13 04:46:58 cph Exp $
+$Id: packag.scm,v 14.47 2005/08/05 20:03:05 cph Exp $
 
 Copyright 1988,1989,1991,1992,1993,1994 Massachusetts Institute of Technology
 Copyright 1995,1996,1998,2001,2002,2003 Massachusetts Institute of Technology
-Copyright 2004 Massachusetts Institute of Technology
+Copyright 2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -188,13 +188,7 @@ USA.
 		     (lookup-option 'ALTERNATE-PACKAGE-LOADER options))
 		    (load-component
 		     (lambda (component environment)
-		       (let ((value
-			      (filename->compiled-object filename component)))
-			 (if value
-			     (begin
-			       (purify (load/purification-root value))
-			       (scode-eval value environment))
-			     (load component environment 'DEFAULT #t))))))
+		       (load component environment 'DEFAULT #t))))
 		(if alternate-loader
 		    (alternate-loader load-component options)
 		    (begin
@@ -219,24 +213,6 @@ USA.
 				  (else "-unk")))
 		 "pkd"
 		 (pathname-version pathname)))
-
-(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 (pair? d) (car (last-pair d)) system)
-				  "_"
-				  (string-replace (pathname-name p) #\- #\_))))
-		(value (prim name)))
-	   (if (or (not value) load/suppress-loading-message?)
-	       value
-	       (let ((port (notification-output-port)))
-		 (fresh-line port)
-		 (write-string ";Initialized " port)
-		 (write name port)
-		 value))))))
 
 (define-integrable (make-package-file tag version descriptions loads)
   (vector tag version descriptions loads))