This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=26c19d79d90d3b3bdb05db2aa592869db55a3fba The branch, master has been updated via 26c19d79d90d3b3bdb05db2aa592869db55a3fba (commit) from 3c08b6c1b2a8c51c3ea281c047fbbdae95bc5494 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 26c19d79d90d3b3bdb05db2aa592869db55a3fba Author: Andy Wingo <[email protected]> Date: Mon Feb 17 14:15:30 2014 +0100 PT_DYNAMIC inside some other PT_LOAD segment * libguile/loader.c (load_thunk_from_memory): Only load PT_LOAD segments, as libc does. The PT_DYNAMIC segment should be inside some other PT_LOAD segment. * module/system/vm/linker.scm (segment-kind): Give the .dynamic segment PT_LOAD kind, so that it is written in a PT_LOAD segment. (count-segments): Add one if there is a SHT_DYNAMIC segment. (allocate-segment): Set the paddr to the addr, as binutils do. (record-special-segments): New routine, to write out special segments like PT_DYNAMIC. (allocate-elf): Call record-special-segments. ----------------------------------------------------------------------- Summary of changes: libguile/loader.c | 6 ++++ module/system/vm/linker.scm | 56 +++++++++++++++++++++++++++++------------- 2 files changed, 44 insertions(+), 18 deletions(-) diff --git a/libguile/loader.c b/libguile/loader.c index 83c5bb5..a55bd15 100644 --- a/libguile/loader.c +++ b/libguile/loader.c @@ -392,8 +392,12 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only) if (dynamic_segment >= 0) ABORT ("expected only one PT_DYNAMIC segment"); dynamic_segment = i; + continue; } + if (ph[i].p_type != PT_LOAD) + ABORT ("unknown segment type"); + if (i == 0) { if (ph[i].p_vaddr != 0) @@ -421,6 +425,8 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only) #ifdef HAVE_SYS_MMAN_H for (i = 0; i < n; i++) { + if (ph[i].p_type != PT_LOAD) + continue; if (ph[i].p_flags == PF_R) continue; if (ph[i].p_align != 4096) diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm index 9987a6c..8151462 100644 --- a/module/system/vm/linker.scm +++ b/module/system/vm/linker.scm @@ -209,31 +209,29 @@ The car is the @code{PT_} segment type, or @code{#f} if the section doesn't need to be present in a loadable segment. The cdr is a bitfield of associated @code{PF_} permissions." (let ((flags (elf-section-flags section))) - (cons (cond - ((= (elf-section-type section) SHT_DYNAMIC) PT_DYNAMIC) - ;; Sections without SHF_ALLOC don't go in segments. - ((zero? flags) #f) - (else PT_LOAD)) - (logior (if (zero? (logand SHF_ALLOC flags)) - 0 - PF_R) - (if (zero? (logand SHF_EXECINSTR flags)) - 0 - PF_X) - (if (zero? (logand SHF_WRITE flags)) - 0 - PF_W))))) + ;; Sections without SHF_ALLOC don't go in segments. + (cons (if (zero? flags) #f PT_LOAD) + (logior (if (logtest SHF_ALLOC flags) PF_R 0) + (if (logtest SHF_EXECINSTR flags) PF_X 0) + (if (logtest SHF_WRITE flags) PF_W 0))))) (define (count-segments objects) "Return the total number of segments needed to represent the linker objects in @var{objects}, including the segment needed for the ELF header and segment table." + (define (adjoin x xs) + (if (member x xs) xs (cons x xs))) (length (fold-values (lambda (object kinds) (let ((kind (segment-kind (linker-object-section object)))) - (if (and (car kind) (not (member kind kinds))) - (cons kind kinds) - kinds))) + (if (= (elf-section-type (linker-object-section object)) + SHT_DYNAMIC) + ;; The dynamic section is part of a loadable + ;; segment, and also gets the additional + ;; PT_DYNAMIC segment header. + (cons (cons PT_DYNAMIC (cdr kind)) + (adjoin kind kinds)) + (if (car kind) (adjoin kind kinds) kinds)))) objects ;; We know there will be at least one segment, ;; containing at least the header and segment table. @@ -375,7 +373,7 @@ the segment table using @code{write-segment-header!}." (when type (write-segment-header! (make-elf-segment #:index phidx #:type type - #:offset addr #:vaddr addr + #:offset addr #:vaddr addr #:paddr addr #:filesz (- endaddr addr) #:memsz (- endaddr addr) #:flags flags #:align alignment))) (values endaddr @@ -580,6 +578,27 @@ list of objects, augmented with objects for the special ELF sections." (values write-segment-header! objects))) +(define (record-special-segments write-segment-header! phidx all-objects) + (let lp ((phidx phidx) (objects all-objects)) + (match objects + (() #t) + ((object . objects) + (let ((section (linker-object-section object))) + (cond + ((eqv? (elf-section-type section) SHT_DYNAMIC) + (let ((addr (elf-section-offset section)) + (size (elf-section-size section)) + (align (elf-section-addralign section)) + (flags (cdr (segment-kind section)))) + (write-segment-header! + (make-elf-segment #:index phidx #:type PT_DYNAMIC + #:offset addr #:vaddr addr #:paddr addr + #:filesz size #:memsz size + #:flags flags #:align align)) + (lp (1+ phidx) objects))) + (else + (lp phidx objects)))))))) + (define (allocate-elf objects page-aligned? endianness word-size abi type machine-type) "Lay out @var{objects} into an ELF image, computing the size of the @@ -623,6 +642,7 @@ relocated headers, and the global symbol table." symtab flags))) (() + (record-special-segments write-segment-header! phidx objects) (values addr (reverse objects) symtab)))))) hooks/post-receive -- GNU Guile
