From 4ab71e1f0d623edc3d11eeba5db8b22229954dff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 8 Jan 2023 16:28:55 +0100 Subject: 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 \"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 (($ 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))) '())) -- cgit v1.2.1