ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Implement arrays in 'define-c-struct' and use it.

Browse source 
* guix/build/syscalls.scm (sizeof*, alignof*, write-type, read-type):
Add support for (array ...) forms.
* guix/build/syscalls.scm (<file-system>)[spare0, spare1]: Remove.
[spare]: New field.
* guix/build/syscalls.scm (%statfs)[identifier]: Change to (array int 2).
[spare0, spare1]: Remove.
[spare]: New field.
This commit is contained in:
Ludovic Courtès 2016-05-01 21:38:53 +02:00
parent acb31b5dcd
commit 00cd41974e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 27 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
guix/build/syscalls.scm
View file

@ -123,9 +123,11 @@ (define-module (guix build syscalls)
(define-syntax sizeof*
;; XXX: This duplicates 'compile-time-value'.
(syntax-rules (int128)
(syntax-rules (int128 array)
((_ int128)
16)
((_ (array type n))
(* (sizeof* type) n))
((_ type)
(let-syntax ((v (lambda (s)
(let ((val (sizeof type)))
@ -135,9 +137,11 @@ (define-syntax sizeof*
(define-syntax alignof*
;; XXX: This duplicates 'compile-time-value'.
(syntax-rules (int128)
(syntax-rules (int128 array)
((_ int128)
16)
((_ (array type n))
(alignof* type))
((_ type)
(let-syntax ((v (lambda (s)
(let ((val (alignof type)))
@ -182,10 +186,19 @@ (define-syntax struct-size
types ...))))
(define-syntax write-type
(syntax-rules (~)
(syntax-rules (~ array)
((_ bv offset (type ~ order) value)
(bytevector-uint-set! bv offset value
(endianness order) (sizeof* type)))
((_ bv offset (array type n) value)
(let loop ((i 0)
(value value)
(o offset))
(unless (= i n)
(match value
((head . tail)
(write-type bv o type head)
(loop (+ 1 i) tail (+ o (sizeof* type))))))))
((_ bv offset type value)
(bytevector-uint-set! bv offset value
(native-endianness) (sizeof* type)))))
@ -202,7 +215,7 @@ (define-syntax write-types
(types ...) (fields ...))))))
(define-syntax read-type
(syntax-rules (~ quote *)
(syntax-rules (~ array quote *)
((_ bv offset '*)
(make-pointer (bytevector-uint-ref bv offset
(native-endianness)
@ -210,6 +223,12 @@ (define-syntax read-type
((_ bv offset (type ~ order))
(bytevector-uint-ref bv offset
(endianness order) (sizeof* type)))
((_ bv offset (array type n))
(unfold (lambda (i) (= i n))
(lambda (i)
(read-type bv (+ offset (* i (sizeof* type))) type))
1+
0))
((_ bv offset type)
(bytevector-uint-ref bv offset
(native-endianness) (sizeof* type)))))
@ -476,7 +495,7 @@ (define mkdtemp!
(define-record-type <file-system>
(file-system type block-size blocks blocks-free
blocks-available files free-files identifier
name-length fragment-size mount-flags spare0 spare1)
name-length fragment-size mount-flags spare)
file-system?
(type file-system-type)
(block-size file-system-block-size)
@ -489,8 +508,7 @@ (define-record-type <file-system>
(name-length file-system-maximum-name-length)
(fragment-size file-system-fragment-size)
(mount-flags file-system-mount-flags)
(spare0 file-system--spare0)
(spare1 file-system--spare1))
(spare file-system--spare))
(define-syntax fsword ;fsword_t
(identifier-syntax long))
@ -507,12 +525,11 @@ (define-c-struct %statfs ;<bits/statfs.h>
(blocks-available uint64)
(files uint64)
(free-files uint64)
(identifier uint64) ;really "int[2]"
(identifier (array int 2))
(name-length fsword)
(fragment-size fsword)
(mount-flags fsword)
(spare0 int128) ;really "fsword[4]"
(spare1 int128))
(spare (array fsword 4)))
(define statfs
(let ((proc (syscall->procedure int "statfs64" '(* *))))