syscalls: Adjust 'dirent64' struct for GNU/Hurd.
Reported by rennes@openmailbox.org. * guix/build/syscalls.scm (file-type->symbol): New procedure. (%struct-dirent-header): Rename to... (%struct-dirent-header/linux): ... this. Rename introduced bindings as well. (%struct-dirent-header/hurd): New C struct. (define-generic-identifier): New macro. (read-dirent-header, %struct-dirent-header, sizeof-dirent-header): Define in terms of 'define-generic-identifier'.
This commit is contained in:
parent
4883f70907
commit
1ab9e48339
|
@ -21,6 +21,7 @@
|
||||||
|
|
||||||
(define-module (guix build syscalls)
|
(define-module (guix build syscalls)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
|
#:use-module (system base target) ;for cross-compilation support
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:autoload (ice-9 binary-ports) (get-bytevector-n)
|
#:autoload (ice-9 binary-ports) (get-bytevector-n)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
@ -824,28 +825,75 @@ system to PUT-OLD."
|
||||||
;;; Opendir & co.
|
;;; Opendir & co.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define-c-struct %struct-dirent-header
|
(define (file-type->symbol type)
|
||||||
sizeof-dirent-header
|
;; Convert TYPE to symbols like 'stat:type' does.
|
||||||
|
(cond ((= type DT_REG) 'regular)
|
||||||
|
((= type DT_LNK) 'symlink)
|
||||||
|
((= type DT_DIR) 'directory)
|
||||||
|
((= type DT_FIFO) 'fifo)
|
||||||
|
((= type DT_CHR) 'char-special)
|
||||||
|
((= type DT_BLK) 'block-special)
|
||||||
|
((= type DT_SOCK) 'socket)
|
||||||
|
(else 'unknown)))
|
||||||
|
|
||||||
|
;; 'struct dirent64' for GNU/Linux.
|
||||||
|
(define-c-struct %struct-dirent-header/linux
|
||||||
|
sizeof-dirent-header/linux
|
||||||
(lambda (inode offset length type name)
|
(lambda (inode offset length type name)
|
||||||
;; Convert TYPE to symbols like 'stat:type' does.
|
`((type . ,(file-type->symbol type))
|
||||||
(let ((type (cond ((= type DT_REG) 'regular)
|
(inode . ,inode)))
|
||||||
((= type DT_LNK) 'symlink)
|
read-dirent-header/linux
|
||||||
((= type DT_DIR) 'directory)
|
write-dirent-header!/linux
|
||||||
((= type DT_FIFO) 'fifo)
|
|
||||||
((= type DT_CHR) 'char-special)
|
|
||||||
((= type DT_BLK) 'block-special)
|
|
||||||
((= type DT_SOCK) 'socket)
|
|
||||||
(else 'unknown))))
|
|
||||||
`((type . ,type)
|
|
||||||
(inode . ,inode))))
|
|
||||||
read-dirent-header
|
|
||||||
write-dirent-header!
|
|
||||||
(inode int64)
|
(inode int64)
|
||||||
(offset int64)
|
(offset int64)
|
||||||
(length unsigned-short)
|
(length unsigned-short)
|
||||||
(type uint8)
|
(type uint8)
|
||||||
(name uint8)) ;first byte of 'd_name'
|
(name uint8)) ;first byte of 'd_name'
|
||||||
|
|
||||||
|
;; 'struct dirent64' for GNU/Hurd.
|
||||||
|
(define-c-struct %struct-dirent-header/hurd
|
||||||
|
sizeof-dirent-header/hurd
|
||||||
|
(lambda (inode length type name-length name)
|
||||||
|
`((type . ,(file-type->symbol type))
|
||||||
|
(inode . ,inode)))
|
||||||
|
read-dirent-header/hurd
|
||||||
|
write-dirent-header!/hurd
|
||||||
|
(inode int64)
|
||||||
|
(length unsigned-short)
|
||||||
|
(type uint8)
|
||||||
|
(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>.
|
;; Constants for the 'type' field, from <dirent.h>.
|
||||||
(define DT_UNKNOWN 0)
|
(define DT_UNKNOWN 0)
|
||||||
(define DT_FIFO 1)
|
(define DT_FIFO 1)
|
||||||
|
|
Loading…
Reference in New Issue