06/48: syscalls: 'readdir*' chooses between the Linux and Hurd code at run time.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit b48def9eaea90b55efe1f5068ab369c8b47c828c
Author: Ludovic Courtès <address@hidden>
AuthorDate: Thu Apr 16 17:34:38 2020 +0200

    syscalls: 'readdir*' chooses between the Linux and Hurd code at run time.
    
    Partly fixes <https://bugs.gnu.org/40574>.
    Reported by Jan Nieuwenhuizen <address@hidden>.
    
    Previously, we'd choose at expansion time whether to use the Hurd or the
    Linux variant, taking the cross-compilation target into account.  This
    would lead to the wrong decision when (guix build syscalls) is evaluated
    while we're cross-compiling to GNU/Hurd.
    
    This is a followup to 1ab9e483391f8b62b873833ea71cb0074efa03e7.
    
    * guix/build/syscalls.scm (define-generic-identifier)
    (read-dirent-header, %struct-dirent-header, sizeof-dirent-header):
    Remove.
    (readdir*): Rename to...
    (readdir-procedure): ... this, and add parameters.
    (readdir*): Define as a call to 'readdir-procedure' as a function of
    %HOST-TYPE.
---
 guix/build/syscalls.scm | 50 +++++++++++++++----------------------------------
 1 file changed, 15 insertions(+), 35 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0938ec0..7ef0341 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -22,7 +22,6 @@
 
 (define-module (guix build syscalls)
   #:use-module (system foreign)
-  #:use-module (system base target)             ;for cross-compilation support
   #:use-module (rnrs bytevectors)
   #:autoload   (ice-9 binary-ports) (get-bytevector-n)
   #:use-module (srfi srfi-1)
@@ -892,36 +891,6 @@ system to PUT-OLD."
   (namelen uint8)
   (name    uint8))
 
-(define-syntax define-generic-identifier
-  (syntax-rules (gnu/linux gnu/hurd =>)
-    "Define a generic identifier that adjust to the current GNU variant."
-    ((_ id (gnu/linux => linux) (gnu/hurd => hurd))
-     (define-syntax id
-       (lambda (s)
-         (syntax-case s ()
-           ((_ args (... ...))
-            (if (string-contains (or (target-type) %host-type)
-                                 "linux")
-                #'(linux args (... ...))
-                #'(hurd args (... ...))))
-           (_
-            (if (string-contains (or (target-type) %host-type)
-                                 "linux")
-                #'linux
-                #'hurd))))))))
-
-(define-generic-identifier read-dirent-header
-  (gnu/linux => read-dirent-header/linux)
-  (gnu/hurd  => read-dirent-header/hurd))
-
-(define-generic-identifier %struct-dirent-header
-  (gnu/linux => %struct-dirent-header/linux)
-  (gnu/hurd  => %struct-dirent-header/hurd))
-
-(define-generic-identifier sizeof-dirent-header
-  (gnu/linux => sizeof-dirent-header/linux)
-  (gnu/hurd  => sizeof-dirent-header/hurd))
-
 ;; Constants for the 'type' field, from <dirent.h>.
 (define DT_UNKNOWN 0)
 (define DT_FIFO 1)
@@ -960,19 +929,30 @@ system to PUT-OLD."
                  "closedir: ~A" (list (strerror err))
                  (list err)))))))
 
-(define readdir*
+(define (readdir-procedure name-field-offset sizeof-dirent-header
+                           read-dirent-header)
   (let ((proc (syscall->procedure '* "readdir64" '(*))))
     (lambda* (directory #:optional (pointer->string pointer->string/utf-8))
       (let ((ptr (proc directory)))
         (and (not (null-pointer? ptr))
              (cons (pointer->string
-                    (make-pointer (+ (pointer-address ptr)
-                                     (c-struct-field-offset
-                                      %struct-dirent-header name)))
+                    (make-pointer (+ (pointer-address ptr) name-field-offset))
                     -1)
                    (read-dirent-header
                     (pointer->bytevector ptr sizeof-dirent-header))))))))
 
+(define readdir*
+  ;; Decide at run time which one must be used.
+  (if (string-suffix? "linux-gnu" %host-type)
+      (readdir-procedure (c-struct-field-offset %struct-dirent-header/linux
+                                                name)
+                         sizeof-dirent-header/linux
+                         read-dirent-header/linux)
+      (readdir-procedure (c-struct-field-offset %struct-dirent-header/hurd
+                                                name)
+                         sizeof-dirent-header/hurd
+                         read-dirent-header/hurd)))
+
 (define* (scandir* name #:optional
                    (select? (const #t))
                    (entry<? (lambda (entry1 entry2)