From 3cd64feb2e069042f453305a0736f8ae277b2015 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 8 Jan 2023 23:32:34 +0100 Subject: linker: Do not store entire ELF in memory when writing to a file. This reduces the amount of memory that needs to be allocated while writing the ELF file to disk. Note: We're abusing #:page-aligned? in 'link-elf' to choose whether to return a bytevector or a procedure. * module/system/vm/linker.scm (process-reloc): Subtract SECTION-OFFSET when writing to BV. (write-linker-object): Pass BV directly to the linker object writer. (link-elf): When PAGE-ALIGNED? is false, call 'bytevector-slice' from here. When it is true, return a procedure that takes a port and writes to it, without having to allocate a bytevector for the whole ELF container. * module/language/bytecode/spec.scm (bytecode->value): Handle X being a procedure instead of a bytevector. (bytecode) <#:printer>: Likewise. * test-suite/tests/linker.test (link-elf-with-one-main-section): Pass #:page-aligned? #f. --- module/language/bytecode/spec.scm | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'module/language/bytecode/spec.scm') diff --git a/module/language/bytecode/spec.scm b/module/language/bytecode/spec.scm index 89256c5c2..6f77dc359 100644 --- a/module/language/bytecode/spec.scm +++ b/module/language/bytecode/spec.scm @@ -1,6 +1,6 @@ ;;; Bytecode -;; Copyright (C) 2013 Free Software Foundation, Inc. +;; Copyright (C) 2013, 2023 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -21,11 +21,19 @@ (define-module (language bytecode spec) #:use-module (system base language) #:use-module (system vm loader) + #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) + #:use-module (srfi srfi-71) #:export (bytecode)) (define (bytecode->value x e opts) - (let ((thunk (load-thunk-from-memory x))) + (let ((thunk (load-thunk-from-memory + (if (bytevector? x) + x + (let ((port get-bv (open-bytevector-output-port))) + (x port) + (close-port port) + (get-bv)))))) (if (eq? e (current-module)) ;; save a cons in this case (values (thunk) e e) @@ -37,6 +45,9 @@ (define-language bytecode #:title "Bytecode" #:compilers `((value . ,bytecode->value)) - #:printer (lambda (bytecode port) (put-bytevector port bytecode)) + #:printer (lambda (bytecode port) + (if (bytevector? bytecode) + (put-bytevector port bytecode) + (bytecode port))) #:reader get-bytevector-all #:for-humans? #f) -- cgit v1.2.1