From d0d9743607590b06fb978d09d3ddf98abbb7015a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 6 Jan 2023 17:18:14 +0100
Subject: 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.
---
 module/system/vm/linker.scm | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm
index ac1da6ecb..a618958f6 100644
--- a/module/system/vm/linker.scm
+++ b/module/system/vm/linker.scm
@@ -1,6 +1,6 @@
 ;;; 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
 ;;;; 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
                                             #:flags 0
                                             #:size size)))
-      (define (write-and-reloc section-label section relocs)
+      (define (compute-reloc section-label section relocs)
         (let ((offset (* shentsize (elf-section-index section))))
-          (write-elf-section-header bv offset endianness word-size section)
           (if (= (elf-section-type section) SHT_NULL)
               relocs
               (let ((relocs
@@ -572,15 +571,26 @@ list of objects, augmented with objects for the special ELF sections."
                             0
                             section-label)
                           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
                      (lambda (object relocs)
-                       (write-and-reloc
+                       (compute-reloc
                         (linker-symbol-name
                          (linker-object-section-symbol object))
                         (linker-object-section object)
                         relocs))
                      objects
-                     (write-and-reloc shoff-label section-table '()))))
+                     (compute-reloc shoff-label section-table '()))))
         (%make-linker-object #f section-table bv relocs
                              (list (make-linker-symbol shoff-label 0))))))
 
-- 
cgit v1.2.1