Eliminate support for compiled C code.
authorChris Hanson <org/chris-hanson/cph>
Fri, 5 Aug 2005 20:03:05 +0000 (20:03 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 5 Aug 2005 20:03:05 +0000 (20:03 +0000)
v7/src/runtime/make.scm
v7/src/runtime/option.scm
v7/src/runtime/packag.scm

index 6a47c3d9f76b64dc1e64ff87d3ffbe65a870ea9e..7f288873e5490bd8bccbd0646433e1e72efca934 100644 (file)
@@ -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))
 
index 2916efff6c87ed2192961b74984a3aba642e2d5d..8694c9291146d9de4b126117bd78e07cbe467eeb 100644 (file)
@@ -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))))
index f3ad6d2b573966e21d8a1c857b2e6c283f21ee34..a2de009e3a59dea34d39ce46f3038de70c9a8b7c 100644 (file)
@@ -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))))))
 \f
 (define-integrable (make-package-file tag version descriptions loads)
   (vector tag version descriptions loads))