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:
parent
d0d9743607
commit
041f11b353
3 changed files with 175 additions and 106 deletions
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue