[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: linker: Linker object writer takes a single argum
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] 01/02: linker: Linker object writer takes a single argument. |
|
Date: |
Sun, 8 Jan 2023 17:38:43 -0500 (EST) |
civodul pushed a commit to branch wip-linker-assembler-memory-consumption
in repository guile.
commit 048651993f90721caa082a30834069e6efff4ae5
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Jan 8 16:28:55 2023 +0100
linker: Linker object writer takes a single argument.
* module/system/vm/linker.scm (write-linker-object): Pass the
'linker-object-writer' a single argument.
(string-table-writer, add-elf-objects): Adjust writers accordingly.
(string-table-writer):
(add-elf-objects):
* module/system/vm/assembler.scm (link-data, link-text-object)
(link-frame-maps, link-dynamic-section)
(link-symtab, link-arities, link-docstrs)
(link-procprops, link-debug): Likewise.
* test-suite/tests/linker.test (link-elf-with-one-main-section):
Likewise.
---
module/system/vm/assembler.scm | 50 ++++++++++++++++++------------------------
module/system/vm/linker.scm | 27 ++++++++++-------------
test-suite/tests/linker.test | 4 ++--
3 files changed, 35 insertions(+), 46 deletions(-)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 2ecfce78c..165976363 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -2113,8 +2113,8 @@ should be .data or .rodata), and return the resulting
linker object.
(add-relocs obj pos relocs)
(cons (make-linker-symbol obj-label pos) symbols))))
(make-object asm name byte-len
- (lambda (bv offset)
- (let loop ((i 0) (pos offset))
+ (lambda (bv)
+ (let loop ((i 0) (pos 0))
(when (< i (vlist-length data))
(match (vlist-ref data i)
((obj . obj-label)
@@ -2231,12 +2231,11 @@ The offsets are expected to be expressed in words."
needed."
(let ((size (asm-pos asm)))
(make-object asm '.rtl-text size
- (lambda (bv offset)
- (let ((buf (bytevector-slice bv offset size)))
- (bytevector-copy! (asm-buf asm) 0 buf 0 size)
- (unless (eq? (asm-endianness asm) (native-endianness))
- (byte-swap/4! buf))
- (patch-relocs! buf (asm-relocs asm) (asm-labels asm))))
+ (lambda (buf)
+ (bytevector-copy! (asm-buf asm) 0 buf 0 size)
+ (unless (eq? (asm-endianness asm) (native-endianness))
+ (byte-swap/4! buf))
+ (patch-relocs! buf (asm-relocs asm) (asm-labels asm)))
(process-relocs (asm-relocs asm)
(asm-labels asm))
(process-labels (asm-labels asm)))))
@@ -2292,9 +2291,7 @@ needed."
(write-bytes (1+ map-pos) (ash map -8)
(1- byte-length)))))))))
- (make-object asm '.guile.frame-maps size
- (lambda (bv offset)
- (write! (bytevector-slice bv offset)))
+ (make-object asm '.guile.frame-maps size write!
(list (make-linker-reloc 'abs32/1 0 0 '.rtl-text))
'() #:type SHT_PROGBITS #:flags SHF_ALLOC)))
(match (asm-slot-maps asm)
@@ -2374,9 +2371,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
(set-uword! (- words 2) DT_NULL)
(set-uword! (- words 1) 0))
- (make-object asm '.dynamic size
- (lambda (bv offset)
- (write! (bytevector-slice bv offset)))
+ (make-object asm '.dynamic size write!
relocs '()
#:type SHT_DYNAMIC #:flags SHF_ALLOC)))
(case (asm-word-size asm)
@@ -2406,9 +2401,9 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
(map (lambda (meta n)
(intern-string! (meta-name meta)))
meta (iota n)))
- (define (write-symbols! bv offset)
+ (define (write-symbols! bv)
(for-each (lambda (name meta n)
- (write-elf-symbol bv (+ offset (* n size))
+ (write-elf-symbol bv (* n size)
endianness word-size
(make-elf-symbol
#:name name
@@ -2658,14 +2653,11 @@ procedure with label @var{rw-init}. @var{rw-init} may
be false. If
#:type SHT_STRTAB #:flags 0)))
(values (make-object asm '.guile.arities
(+ header-size (bytevector-length name-bv))
- (lambda (bv offset)
+ (lambda (bv)
;; FIXME: Avoid extra allocation + copy.
- (bytevector-copy! headers 0
- bv offset
+ (bytevector-copy! headers 0 bv 0
header-size)
- (bytevector-copy! name-bv 0
- bv
- (+ offset header-size)
+ (bytevector-copy! name-bv 0 bv header-size
(bytevector-length name-bv)))
relocs '()
#:type SHT_PROGBITS #:flags 0
@@ -2703,7 +2695,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
((pc . str)
(cons pc (string-table-intern! strtab str))))
(find-docstrings))))
- (define (write-docstrings! bv offset)
+ (define (write-docstrings! bv)
(fold (lambda (pair pos)
(match pair
((pc . string-pos)
@@ -2712,7 +2704,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
string-pos
endianness)
(+ pos docstr-size))))
- offset
+ 0
docstrings))
(let ((strtab (make-object asm '.guile.docstrs.strtab
@@ -2772,8 +2764,8 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
(let* ((endianness (asm-endianness asm))
(procprops (find-procprops))
(size (* (length procprops) procprops-size)))
- (define (write-procprops! bv offset)
- (let lp ((procprops procprops) (pos offset))
+ (define (write-procprops! bv)
+ (let lp ((procprops procprops) (pos 0))
(match procprops
(()
#t)
@@ -3114,8 +3106,8 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
(put-uleb128 die-port 0))))))
(define (copy-writer source)
- (lambda (bv offset)
- (bytevector-copy! source 0 bv offset
+ (lambda (bv)
+ (bytevector-copy! source 0 bv 0
(bytevector-length source))))
;; Compilation unit header.
@@ -3151,7 +3143,7 @@ procedure with label @var{rw-init}. @var{rw-init} may be
false. If
'() '()
#:type SHT_PROGBITS #:flags 0)
(make-object asm '.debug_loc
- 0 (lambda (bv offset) #t)
+ 0 (lambda (bv) #t)
'() '()
#:type SHT_PROGBITS #:flags 0)
(let ((bv (get-line-bv)))
diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm
index 56e19c285..6858850ef 100644
--- a/module/system/vm/linker.scm
+++ b/module/system/vm/linker.scm
@@ -205,12 +205,12 @@ Returns the byte index of the string in that table."
"Return a <linker-object> \"writer\" procedure that links the string
table @var{table} into a sequence of bytes, suitable for use as the
contents of an ELF string table section."
- (lambda (bv offset)
+ (lambda (bv)
(match table
(($ <string-table> strings #f)
(for-each (match-lambda
((_ pos bytes)
- (bytevector-copy! bytes 0 bv (+ pos offset)
+ (bytevector-copy! bytes 0 bv pos
(bytevector-length bytes))))
strings)
(set-string-table-linked?! table #t)))))
@@ -478,7 +478,7 @@ locations, as given in @var{symtab}."
(begin
(unless (= len (linker-object-size o))
(error "unexpected length" section o))
- ((linker-object-writer o) bv offset)
+ ((linker-object-writer o) (bytevector-slice bv offset len))
(for-each (lambda (reloc)
(process-reloc reloc bv offset symtab endianness))
relocs)))))
@@ -524,7 +524,7 @@ list of objects, augmented with objects for the special ELF
sections."
(make-linker-object ""
(make-elf-section #:index 0 #:type SHT_NULL
#:flags 0 #:addralign 0)
- 0 (lambda (bv offset) #t) '() '()))
+ 0 (lambda (bv) #t) '() '()))
;; The ELF header and the segment table.
;;
@@ -545,8 +545,8 @@ list of objects, augmented with objects for the special ELF
sections."
(make-elf-section #:index index #:type SHT_PROGBITS
#:flags SHF_ALLOC #:size size)
size
- (lambda (bv offset)
- (write-elf-header (bytevector-slice bv offset)
header))
+ (lambda (bv)
+ (write-elf-header bv header))
(list shoff-reloc)
'())))
@@ -580,10 +580,9 @@ list of objects, augmented with objects for the special
ELF sections."
section-label)
relocs))))))
- (define (write-object-elf-header! bv offset object)
+ (define (write-object-elf-header! bv object)
(let ((section (linker-object-section object)))
- (let ((offset (+ offset
- (* shentsize (elf-section-index section)))))
+ (let ((offset (* shentsize (elf-section-index section))))
(write-elf-section-header bv offset endianness word-size
section))))
(let ((relocs (fold-values
@@ -596,10 +595,9 @@ list of objects, augmented with objects for the special
ELF sections."
objects
(compute-reloc shoff-label section-table '()))))
(%make-linker-object #f section-table size
- (lambda (bv offset)
+ (lambda (bv)
(for-each (lambda (object)
(write-object-elf-header! bv
- offset
object))
objects))
relocs
@@ -630,17 +628,16 @@ list of objects, augmented with objects for the special
ELF sections."
(define write-header!
(linker-object-writer header))
- (define (write-header+segments! bv offset)
+ (define (write-header+segments! bv)
(for-each (lambda (segment)
- (let ((offset (+ offset
- phoff
+ (let ((offset (+ phoff
(* (elf-segment-index segment) phentsize))))
(write-elf-program-header bv offset
endianness
word-size
segment)))
segments)
- (write-header! bv offset))
+ (write-header! bv))
(set-linker-object-writer! header write-header+segments!)
(values add-header-segment! objects)))
diff --git a/test-suite/tests/linker.test b/test-suite/tests/linker.test
index ea54618b4..2dc70963d 100644
--- a/test-suite/tests/linker.test
+++ b/test-suite/tests/linker.test
@@ -46,8 +46,8 @@
(endianness (target-endianness))
(sec (make-object 1 name
(bytevector-length bytes)
- (lambda (bv offset)
- (bytevector-copy! bytes 0 bv offset
+ (lambda (bv)
+ (bytevector-copy! bytes 0 bv 0
(bytevector-length
bytes)))
'()))