1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

linker: Separate effectful part of 'add-elf-objects'.

* module/system/vm/linker.scm (add-elf-objects)[write-and-reloc]: Split
into...
[compute-reloc, write-object-elf-header!]: ... this.
Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2023-01-06 17:18:14 +01:00
parent d439a3f671
commit d0d9743607

View file

@ -1,6 +1,6 @@
;;; Guile ELF linker ;;; Guile ELF linker
;; Copyright (C) 2011, 2012, 2013, 2014, 2018 Free Software Foundation, Inc. ;; Copyright (C) 2011, 2012, 2013, 2014, 2018, 2023 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -550,9 +550,8 @@ list of objects, augmented with objects for the special ELF sections."
#:type SHT_PROGBITS #:type SHT_PROGBITS
#:flags 0 #:flags 0
#:size size))) #:size size)))
(define (write-and-reloc section-label section relocs) (define (compute-reloc section-label section relocs)
(let ((offset (* shentsize (elf-section-index section)))) (let ((offset (* shentsize (elf-section-index section))))
(write-elf-section-header bv offset endianness word-size section)
(if (= (elf-section-type section) SHT_NULL) (if (= (elf-section-type section) SHT_NULL)
relocs relocs
(let ((relocs (let ((relocs
@ -572,15 +571,26 @@ list of objects, augmented with objects for the special ELF sections."
0 0
section-label) section-label)
relocs)))))) relocs))))))
(define (write-object-elf-header! bv offset object)
(let ((section (linker-object-section object)))
(let ((offset (+ offset
(* shentsize (elf-section-index section)))))
(write-elf-section-header bv offset endianness word-size section))))
(for-each (lambda (object)
(write-object-elf-header! bv 0 object))
objects)
(let ((relocs (fold-values (let ((relocs (fold-values
(lambda (object relocs) (lambda (object relocs)
(write-and-reloc (compute-reloc
(linker-symbol-name (linker-symbol-name
(linker-object-section-symbol object)) (linker-object-section-symbol object))
(linker-object-section object) (linker-object-section object)
relocs)) relocs))
objects objects
(write-and-reloc shoff-label section-table '())))) (compute-reloc shoff-label section-table '()))))
(%make-linker-object #f section-table bv relocs (%make-linker-object #f section-table bv relocs
(list (make-linker-symbol shoff-label 0)))))) (list (make-linker-symbol shoff-label 0))))))