#| -*-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
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)))
(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))
#| -*-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
(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))))
#| -*-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.
(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
(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))