mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-09 01:50:48 +00:00
parent f0c9993564
commit 58995613d9
6 changed files with 39 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/system/base/language.scm
View file

@ -90,21 +90,15 @@
(do ((x (read-in lang in) (read-in lang in))
(l '() (cons (lang.translator (lang.expander x)) l)))
((eof-object? x) (reverse! l))))))
(asm (apply compile (cons '@begin code) env opts))
(bytes (apply assemble asm env opts)))
(call-with-output-file (object-file-name file)
(lambda (out) (uniform-vector-write bytes out)))))
(asm (apply compile (cons '@begin code) env opts)))
(save-dumpcode (apply assemble asm env opts) (object-file-name file))))
(define (load-file-in file env lang . opts)
(let ((compiled (object-file-name file)))
(if (or (not (file-exists? compiled))
(> (stat:mtime (stat file)) (stat:mtime (stat compiled))))
(compile-file-in file env lang :O))
(call-with-input-file compiled
(lambda (p)
(let ((bytes (make-uniform-vector (stat:size (stat compiled)) #\a)))
(uniform-vector-read! bytes p)
bytes)))))
(load-dumpcode compiled)))
(define (object-file-name file)
(let ((m (string-match "\\.[^.]*$" file)))