mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
Ludovic Courtès
parent
041f11b353
commit
4ab71e1f0d
3 changed files with 35 additions and 46 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
'()))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue