- Ikarus now recognizes IKARUS_FASL_DIRECTORY (and the corresponding

fasl-directory parameter) that works as follows:
  - if IKARUS_FASL_DIRECTORY is set to "", no fasl files are produced.
  - if IKARUS_FASL_DIRECTORY is set to something other than "", the
    string is used as a directory in which fasl files are placed.
  - if IKARUS_FASL_DIRECTORY is unset, the directory 
    $HOME/.ikarus/precompiled is used for fasl output.
  - library file names are cannonicalized using file-real-path.
  - the fasl file (if produced) is the result of
     (string-append (fasl-directory) (file-real-path filename) ext)
    where ext is either ".ikarus-32bit-fasl" or ".ikarus-64bit-fasl".

- The old behavior (placing the fasl files in the same place as the
  library files) can be achieved by setting IKARUS_FASL_DIRECTORY='/'.
This commit is contained in:
Abdulaziz Ghuloum 2009-05-26 13:39:32 +03:00
parent a050e28633
commit f759815a8c
4 changed files with 37 additions and 11 deletions

View File

@ -15,11 +15,11 @@
(library (ikarus load)
(export load load-r6rs-script)
(export load load-r6rs-script fasl-directory)
(import
(except (ikarus) load load-r6rs-script)
(except (ikarus) fasl-directory load load-r6rs-script)
(only (ikarus.compiler) compile-core-expr)
(only (psyntax library-manager)
(only (psyntax library-manager)
serialize-all current-precompiled-library-loader)
(only (psyntax expander) compile-r6rs-top-level)
(only (ikarus.reader.annotated) read-script-source-file))
@ -31,13 +31,28 @@
[(<= (fixnum-width) 32) ".ikarus-32bit-fasl"]
[else ".ikarus-64bit-fasl"]))
(define fasl-directory
(make-parameter
(cond
[(getenv "IKARUS_FASL_DIRECTORY")]
[(getenv "HOME") =>
(lambda (s)
(string-append s "/.ikarus/precompiled"))]
[else ""])
(lambda (s)
(if (string? s)
s
(die 'fasl-directory "not a string" s)))))
(define (fasl-path filename)
(string-append filename fasl-extension))
(let ([d (fasl-directory)])
(and (not (string=? d ""))
(string-append d (file-real-path filename) fasl-extension))))
(define (load-serialized-library filename sk)
(let ([ikfasl (fasl-path filename)])
(cond
[(not (file-exists? ikfasl)) #f]
[(or (not ikfasl) (not (file-exists? ikfasl))) #f]
[(< (file-mtime ikfasl) (file-mtime filename))
(fprintf (current-error-port)
"WARNING: not using fasl file ~s because it is older \
@ -62,10 +77,15 @@
(define (do-serialize-library filename contents)
(let ([ikfasl (fasl-path filename)])
(fprintf (current-error-port) "Serializing ~s ...\n" ikfasl)
(let ([p (open-file-output-port ikfasl (file-options no-fail))])
(fasl-write (make-serialized-library contents) p)
(close-output-port p))))
(cond
[(not ikfasl) (void)]
[else
(fprintf (current-error-port) "Serializing ~s ...\n" ikfasl)
(let-values ([(dir name) (split-file-name ikfasl)])
(make-directory* dir))
(let ([p (open-file-output-port ikfasl (file-options no-fail))])
(fasl-write (make-serialized-library contents) p)
(close-output-port p))])))
(define load-handler
(lambda (x)

View File

@ -368,7 +368,12 @@
(die who "not a string" x))
(let ([v (foreign-call "ikrt_realpath" (string->utf8 x))])
(cond
[(bytevector? v) (utf8->string v)]
[(bytevector? v)
(let ([s (utf8->string v)])
(when (or (string=? s "")
(not (char=? (string-ref s 0) #\/)))
(error who "unexpected value returned from OS" s x))
s)]
[else (raise/strerror who v x)])))
(define (getenv key)

View File

@ -1 +1 @@
1793
1794

View File

@ -620,6 +620,7 @@
[error@fxsub1 ]
[fasl-write i]
[fasl-read i]
[fasl-directory i]
[lambda i r ba se ne]
[and i r ba se ne]
[begin i r ba se ne]