[Guile-commits] GNU Guile branch, master, updated. v2.1.0-750-g26c19d7

[Andy Wingo]

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 <address@hidden>
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