From 82d8959e5d137b2061a68878d78a8f74a238ac44 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Apr 2020 17:34:38 +0200 Subject: syscalls: 'readdir*' chooses between the Linux and Hurd code at run time. Partly fixes . Reported by Jan Nieuwenhuizen . 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(-) (limited to 'guix') 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 . (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