mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-05 19:50:23 +02:00
d4da9ba9c0
* module/system/vm/linker.scm (make-linker-object): (linker-object-section-symbol): (linker-object-symbols*): Create a symbol to the start of a linker object. Hide it from the external linker-object-symbols* accessor. (segment-kind, count-segments): Sections without SHF_ALLOC don't get segments. (collate-objects-into-segments): Allow for #f segment types. If two sections have the same type and flags, leave them in the same order. (align): Allow for 0 alignment. (add-elf-objects): New helper: puts the ELF data structures (header, segment table, and section table) in sections of their own. This lends a nice clarity and conceptual unity to the linker. (relocate-section-header, allocate-segment): Lay out segments with congruent, contiguous addresses, so that we can just mmap the file and if debugging sections that are not in segments are present, they can be lazily paged in if needed by the kernel's VM system. (link-elf): Refactor to use the new interfaces. * test-suite/tests/linker.test: Update to expect the additional sections for the header and section table.
88 lines
3.5 KiB
Scheme
88 lines
3.5 KiB
Scheme
;;;; linker.test -*- scheme -*-
|
|
;;;;
|
|
;;;; Copyright 2013 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
|
|
;;;; License as published by the Free Software Foundation; either
|
|
;;;; version 3 of the License, or (at your option) any later version.
|
|
;;;;
|
|
;;;; This library is distributed in the hope that it will be useful,
|
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
;;;; Lesser General Public License for more details.
|
|
;;;;
|
|
;;;; You should have received a copy of the GNU Lesser General Public
|
|
;;;; License along with this library; if not, write to the Free Software
|
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
|
|
(define-module (test-suite test-linker)
|
|
#:use-module (test-suite lib)
|
|
#:use-module (rnrs bytevectors)
|
|
#:use-module (system base target)
|
|
#:use-module (system vm elf)
|
|
#:use-module (system vm linker))
|
|
|
|
(define (link-elf-with-one-main-section name bytes)
|
|
(let ((string-table (make-string-table)))
|
|
(define (intern-string! string)
|
|
(call-with-values
|
|
(lambda () (string-table-intern string-table string))
|
|
(lambda (table idx)
|
|
(set! string-table table)
|
|
idx)))
|
|
(define (make-object index name bv relocs . kwargs)
|
|
(let ((name-idx (intern-string! (symbol->string name))))
|
|
(make-linker-object (apply make-elf-section
|
|
#:index index
|
|
#:name name-idx
|
|
#:size (bytevector-length bv)
|
|
kwargs)
|
|
bv relocs
|
|
(list (make-linker-symbol name 0)))))
|
|
(define (make-string-table)
|
|
(intern-string! ".shstrtab")
|
|
(make-object 2 '.shstrtab (link-string-table string-table) '()
|
|
#:type SHT_STRTAB #:flags 0))
|
|
(let* ((word-size (target-word-size))
|
|
(endianness (target-endianness))
|
|
(sec (make-object 1 name bytes '()))
|
|
;; This needs to be linked last, because linking other
|
|
;; sections adds entries to the string table.
|
|
(shstrtab (make-string-table)))
|
|
(link-elf (list sec shstrtab)
|
|
#:endianness endianness #:word-size word-size))))
|
|
|
|
(with-test-prefix "simple"
|
|
(define foo-bytes #vu8(0 1 2 3 4 5))
|
|
(define bytes #f)
|
|
(define elf #f)
|
|
|
|
(define (bytevectors-equal? bv-a bv-b start-a start-b size)
|
|
(or (zero? size)
|
|
(and (equal? (bytevector-u8-ref bv-a start-a)
|
|
(bytevector-u8-ref bv-b start-b))
|
|
(bytevectors-equal? bv-a bv-b (1+ start-a) (1+ start-b)
|
|
(1- size)))))
|
|
|
|
(pass-if "linking succeeds"
|
|
(begin
|
|
(set! bytes (link-elf-with-one-main-section '.foo foo-bytes))
|
|
#t))
|
|
|
|
(pass-if "parsing succeeds"
|
|
(begin
|
|
(set! elf (parse-elf bytes))
|
|
(elf? elf)))
|
|
|
|
;; 5 sections: the initial NULL section, .foo, .shstrtab, the initial
|
|
;; header with segment table, and the section table.
|
|
(pass-if-equal 5 (elf-shnum elf))
|
|
|
|
(pass-if ".foo section checks out"
|
|
(let ((sec (assoc-ref (elf-sections-by-name elf) ".foo")))
|
|
(and sec
|
|
(= (elf-section-size sec) (bytevector-length foo-bytes))
|
|
(bytevectors-equal? bytes foo-bytes
|
|
(elf-section-offset sec) 0
|
|
(bytevector-length foo-bytes))))))
|