summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2024-04-16 00:34:01 +0200
committerLudovic Courtès <ludo@gnu.org>2024-04-16 00:34:01 +0200
commit112b617f5921c67b4b2c45aae39f54cccd34d7ef (patch)
tree30d482ef1606c72b5986b2a48141a54a9e94e726 /module/system
parent696acfc9e590ecff70ff369460304e96b269efe5 (diff)
downloadguile-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.scm21
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