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

linker, assembler: Avoid intermediate bytevectors.

This reduces the amount of memory used during linking and reduces the
number of copies to be done between bytevectors.

* module/system/vm/linker.scm (<linker-object>): Remove 'bv' field and
add 'size' and 'writer'.
(make-linker-object): Adjust accordingly.
(string-table-size): New procedure.
(link-string-table!): Remove.
(string-table-writer): New procedure.
(allocate-segment): Adjust 'make-linker-object' call.
(find-shstrndx): Call the 'linker-object-writer' of O.
(add-elf-objects): Adjust 'make-linker-object' call.  Remove
'make-bytevector' allocations and move serialization to lazy 'writer'
procedures.  Define 'segments' and 'add-header-segment!'.  Return the
latter as the first value.
* module/system/vm/assembler.scm (make-object): Remove 'bv' parameter
and add 'size' and 'writer'.
(link-data): Remove 'make-bytevector' call and move serialization to
a lazy 'writer' procedure.
(link-text-object): Likewise.
(link-frame-maps): Likewise.
(link-dynamic-section): Likewise.
(link-shstrtab): Likewise.
(link-symtab): Likewise.
(link-arities): Likewise, and remove 'bytevector-append'.
(link-docstrs): Likewise.
(link-procprops): Likewise.
(link-debug): Likewise, and define 'copy-writer'.
* test-suite/tests/linker.test (link-elf-with-one-main-section): Adjust
accordingly.
This commit is contained in:
Ludovic Courtès 2023-01-07 21:52:06 +01:00
parent d0d9743607
commit 041f11b353
3 changed files with 175 additions and 106 deletions

View file

@ -1,6 +1,6 @@
;;;; linker.test -*- scheme -*-
;;;;
;;;; Copyright 2013, 2019 Free Software Foundation, Inc.
;;;; Copyright 2013, 2019, 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
@ -25,23 +25,32 @@
(define (link-elf-with-one-main-section name bytes)
(let ((strtab (make-string-table)))
(define (make-object index name bv relocs . kwargs)
(define (make-object index name size writer relocs . kwargs)
(let ((name-idx (string-table-intern! strtab (symbol->string name))))
(make-linker-object (symbol->string name)
(apply make-elf-section
#:index index
#:name name-idx
#:size (bytevector-length bv)
#:size size
kwargs)
bv relocs
size writer relocs
(list (make-linker-symbol name 0)))))
(define (make-shstrtab)
(string-table-intern! strtab ".shstrtab")
(make-object 2 '.shstrtab (link-string-table! strtab) '()
(make-object 2 '.shstrtab
(string-table-size strtab)
(string-table-writer strtab)
'()
#:type SHT_STRTAB #:flags 0))
(let* ((word-size (target-word-size))
(endianness (target-endianness))
(sec (make-object 1 name bytes '()))
(sec (make-object 1 name
(bytevector-length bytes)
(lambda (bv offset)
(bytevector-copy! bytes 0 bv offset
(bytevector-length
bytes)))
'()))
;; This needs to be linked last, because linking other
;; sections adds entries to the string table.
(shstrtab (make-shstrtab)))