mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00
Code Activity

don't truncate .go files, do an atomic rename to prevent SIGBUS

Browse source 
* module/system/base/compile.scm (call-with-output-file/atomic): New
  proc, outputs to a tempfile then does an atomic rename. Prevents SIGBUS
  if a compiled file is truncated and rewritten, as the file's objcode is
  mmap'd in.
  (compile-file): Use the new helper.
This commit is contained in:
Andy Wingo 2008-08-09 14:11:35 +02:00
parent fbea69ad42
commit e6d4e05cbd
1 changed files with 13 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

14
module/system/base/compile.scm
View file

@ -58,6 +58,18 @@
(define (scheme) (lookup-language 'scheme)) (define (scheme) (lookup-language 'scheme))
(define (call-with-output-file/atomic filename proc)
(let* ((template (string-append filename ".XXXXXX"))
(tmp (mkstemp! template)))
(catch #t
(lambda ()
(with-output-to-port tmp
(lambda () (proc (current-output-port))))
(rename-file template filename))
(lambda args
(delete-file template)
(apply throw args)))))
(define (compile-file file . opts) (define (compile-file file . opts)
(let ((comp (compiled-file-name file)) (let ((comp (compiled-file-name file))
(scheme (scheme))) (scheme (scheme)))
@ -65,7 +77,7 @@
(lambda () (lambda ()
(call-with-compile-error-catch (call-with-compile-error-catch
(lambda () (lambda ()
(call-with-output-file comp (call-with-output-file/atomic comp
(lambda (port) (lambda (port)
(let* ((source (read-file-in file scheme)) (let* ((source (read-file-in file scheme))
(objcode (apply compile-in source (current-module) (objcode (apply compile-in source (current-module)