diff options
author | Ludovic Courtès <ludo@gnu.org> | 2024-04-16 00:34:01 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-04-16 00:34:01 +0200 |
commit | 112b617f5921c67b4b2c45aae39f54cccd34d7ef (patch) | |
tree | 30d482ef1606c72b5986b2a48141a54a9e94e726 /module/system | |
parent | 696acfc9e590ecff70ff369460304e96b269efe5 (diff) | |
download | guile-112b617f5921c67b4b2c45aae39f54cccd34d7ef.tar.gz |
linker: Create a sparse file only when writing to a file port.
Fixes a regression introduced in
4a0c2433d97be9d995b3be74d90bc074d8efb5a7: the strategy wouldn’t work
when writing to, say, a bytevector output port.
* module/system/vm/linker.scm (link-elf)[write-padding]: Reintroduce
loop for when PORT is not a file port. Remove first argument.
Diffstat (limited to 'module/system')
-rw-r--r-- | module/system/vm/linker.scm | 21 |
1 files changed, 16 insertions, 5 deletions
diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm index 952e85c30..7f3a625a1 100644 --- a/module/system/vm/linker.scm +++ b/module/system/vm/linker.scm @@ -769,10 +769,21 @@ Returns a bytevector." objects) bv) (lambda (port) - (define (write-padding port size) - ;; Write SIZE bytes of padding to PORT. Use 'seek' to - ;; create a sparse file. - (seek port size SEEK_CUR)) + (define write-padding + ;; Write SIZE bytes of padding to PORT. + (if (file-port? port) + (lambda (size) + ;; Use 'seek' to create a sparse file. + (seek port size SEEK_CUR)) + (let ((blank (make-bytevector 4096 0))) + (lambda (size) + ;; Write SIZE zeros. + (let loop ((size size)) + (unless (zero? size) + (let ((count (min size + (bytevector-length blank)))) + (put-bytevector port blank 0 count) + (loop (- size count))))))))) (define (compute-padding objects) ;; Return the list of padding in between OBJECTS--the list @@ -796,7 +807,7 @@ Returns a bytevector." (for-each (lambda (object padding) (let ((bv (make-bytevector (linker-object-size object) 0))) - (write-padding port padding) + (write-padding padding) (write-linker-object bv object symtab endianness) (put-bytevector port bv))) objects |