ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Adjust 'dirent64' struct for GNU/Hurd.

Browse source 
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:
Ludovic Courtès 2017-07-10 00:04:09 +02:00
parent 4883f70907
commit 1ab9e48339
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 63 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
guix/build/syscalls.scm
View file

@ -21,6 +21,7 @@
(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)
@ -824,28 +825,75 @@ (define pivot-root
;;; Opendir & co.
;;;
(define-c-struct %struct-dirent-header
sizeof-dirent-header
(define (file-type->symbol type)
;; 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)
;; Convert TYPE to symbols like 'stat:type' does.
(let ((type (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))))
`((type . ,type)
(inode . ,inode))))
read-dirent-header
write-dirent-header!
`((type . ,(file-type->symbol type))
(inode . ,inode)))
read-dirent-header/linux
write-dirent-header!/linux
(inode int64)
(offset int64)
(length unsigned-short)
(type uint8)
(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>.
(define DT_UNKNOWN 0)
(define DT_FIFO 1)