summaryrefslogtreecommitdiff
path: root/guix/build/syscalls.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-16 17:34:38 +0200
committerLudovic Courtès <ludo@gnu.org>2020-04-16 18:33:21 +0200
commit82d8959e5d137b2061a68878d78a8f74a238ac44 (patch)
tree18021f7ae89f5f2f74c571fe104aa3f7b08208bc /guix/build/syscalls.scm
parent33f3fef383d066460b4bffc4b5af89b639cb55f3 (diff)
syscalls: 'readdir*' chooses between the Linux and Hurd code at run time.
Partly fixes <https://bugs.gnu.org/40574>. Reported by Jan Nieuwenhuizen <janneke@gnu.org>. 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.
Diffstat (limited to 'guix/build/syscalls.scm')
-rw-r--r--guix/build/syscalls.scm50
1 files changed, 15 insertions, 35 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 0938ec0ff1..7ef03417c1 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)