aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-04-25 14:57:26 +0200
committerLudovic Courtès <ludo@gnu.org>2016-04-25 23:27:09 +0200
commit73f38d5ff3621c7fbc69a6a5eea598ba269e8b2a (patch)
treed984698712b5a0ac0372c74032f743ba529cf050
parentf489ce3c9343e3ba9927645d11fcb91bb69f0fa7 (diff)
downloadguix-73f38d5ff3621c7fbc69a6a5eea598ba269e8b2a.tar
guix-73f38d5ff3621c7fbc69a6a5eea598ba269e8b2a.tar.gz
syscalls: Move code around [NFC].
* guix/build/syscalls.scm: Move packed structure handling to the top.
-rw-r--r--guix/build/syscalls.scm217
1 files changed, 116 insertions, 101 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 04fc3ef5fe..45555060f8 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -101,6 +101,112 @@
;;;
;;; Code:
+
+;;;
+;;; Packed structures.
+;;;
+
+(define-syntax sizeof*
+ ;; XXX: This duplicates 'compile-time-value'.
+ (syntax-rules (int128)
+ ((_ int128)
+ 16)
+ ((_ type)
+ (let-syntax ((v (lambda (s)
+ (let ((val (sizeof type)))
+ (syntax-case s ()
+ (_ val))))))
+ v))))
+
+(define-syntax alignof*
+ ;; XXX: This duplicates 'compile-time-value'.
+ (syntax-rules (int128)
+ ((_ int128)
+ 16)
+ ((_ type)
+ (let-syntax ((v (lambda (s)
+ (let ((val (alignof type)))
+ (syntax-case s ()
+ (_ val))))))
+ v))))
+
+(define-syntax align ;as found in (system foreign)
+ (syntax-rules (~)
+ "Add to OFFSET whatever it takes to get proper alignment for TYPE."
+ ((_ offset (type ~ endianness))
+ (align offset type))
+ ((_ offset type)
+ (1+ (logior (1- offset) (1- (alignof* type)))))))
+
+(define-syntax type-size
+ (syntax-rules (~)
+ ((_ (type ~ order))
+ (sizeof* type))
+ ((_ type)
+ (sizeof* type))))
+
+(define-syntax write-type
+ (syntax-rules (~)
+ ((_ bv offset (type ~ order) value)
+ (bytevector-uint-set! bv offset value
+ (endianness order) (sizeof* type)))
+ ((_ bv offset type value)
+ (bytevector-uint-set! bv offset value
+ (native-endianness) (sizeof* type)))))
+
+(define-syntax write-types
+ (syntax-rules ()
+ ((_ bv offset () ())
+ #t)
+ ((_ bv offset (type0 types ...) (field0 fields ...))
+ (begin
+ (write-type bv (align offset type0) type0 field0)
+ (write-types bv
+ (+ (align offset type0) (type-size type0))
+ (types ...) (fields ...))))))
+
+(define-syntax read-type
+ (syntax-rules (~ quote *)
+ ((_ bv offset '*)
+ (make-pointer (bytevector-uint-ref bv offset
+ (native-endianness)
+ (sizeof* '*))))
+ ((_ bv offset (type ~ order))
+ (bytevector-uint-ref bv offset
+ (endianness order) (sizeof* type)))
+ ((_ bv offset type)
+ (bytevector-uint-ref bv offset
+ (native-endianness) (sizeof* type)))))
+
+(define-syntax read-types
+ (syntax-rules ()
+ ((_ return bv offset () (values ...))
+ (return values ...))
+ ((_ return bv offset (type0 types ...) (values ...))
+ (read-types return
+ bv
+ (+ (align offset type0) (type-size type0))
+ (types ...)
+ (values ... (read-type bv
+ (align offset type0)
+ type0))))))
+
+(define-syntax define-c-struct
+ (syntax-rules ()
+ "Define READ as a deserializer and WRITE! as a serializer for the C
+structure with the given TYPES. READ uses WRAP-FIELDS to return its value."
+ ((_ name wrap-fields read write! (fields types) ...)
+ (begin
+ (define (write! bv offset fields ...)
+ (write-types bv offset (types ...) (fields ...)))
+ (define (read bv offset)
+ (read-types wrap-fields bv offset (types ...) ()))))))
+
+
+;;;
+;;; FFI.
+;;;
+
(define %libc-errno-pointer
;; Glibc's 'errno' pointer.
(let ((errno-loc (dynamic-func "__errno_location" (dynamic-link))))
@@ -159,6 +265,11 @@ the returned procedure is called."
(error (format #f "~a: syscall->procedure failed: ~s"
name args))))))
+
+;;;
+;;; File systems.
+;;;
+
(define (augment-mtab source target type options)
"Augment /etc/mtab with information about the given mount point."
(let ((port (open-file "/etc/mtab" "a")))
@@ -322,6 +433,11 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
(list err)))
(pointer->string result)))))
+
+;;;
+;;; Containers.
+;;;
+
;; Linux clone flags, from linux/sched.h
(define CLONE_CHILD_CLEARTID #x00200000)
(define CLONE_CHILD_SETTID #x01000000)
@@ -397,107 +513,6 @@ system to PUT-OLD."
;;;
-;;; Packed structures.
-;;;
-
-(define-syntax sizeof*
- ;; XXX: This duplicates 'compile-time-value'.
- (syntax-rules (int128)
- ((_ int128)
- 16)
- ((_ type)
- (let-syntax ((v (lambda (s)
- (let ((val (sizeof type)))
- (syntax-case s ()
- (_ val))))))
- v))))
-
-(define-syntax alignof*
- ;; XXX: This duplicates 'compile-time-value'.
- (syntax-rules (int128)
- ((_ int128)
- 16)
- ((_ type)
- (let-syntax ((v (lambda (s)
- (let ((val (alignof type)))
- (syntax-case s ()
- (_ val))))))
- v))))
-
-(define-syntax align ;as found in (system foreign)
- (syntax-rules (~)
- "Add to OFFSET whatever it takes to get proper alignment for TYPE."
- ((_ offset (type ~ endianness))
- (align offset type))
- ((_ offset type)
- (1+ (logior (1- offset) (1- (alignof* type)))))))
-
-(define-syntax type-size
- (syntax-rules (~)
- ((_ (type ~ order))
- (sizeof* type))
- ((_ type)
- (sizeof* type))))
-
-(define-syntax write-type
- (syntax-rules (~)
- ((_ bv offset (type ~ order) value)
- (bytevector-uint-set! bv offset value
- (endianness order) (sizeof* type)))
- ((_ bv offset type value)
- (bytevector-uint-set! bv offset value
- (native-endianness) (sizeof* type)))))
-
-(define-syntax write-types
- (syntax-rules ()
- ((_ bv offset () ())
- #t)
- ((_ bv offset (type0 types ...) (field0 fields ...))
- (begin
- (write-type bv (align offset type0) type0 field0)
- (write-types bv
- (+ (align offset type0) (type-size type0))
- (types ...) (fields ...))))))
-
-(define-syntax read-type
- (syntax-rules (~ quote *)
- ((_ bv offset '*)
- (make-pointer (bytevector-uint-ref bv offset
- (native-endianness)
- (sizeof* '*))))
- ((_ bv offset (type ~ order))
- (bytevector-uint-ref bv offset
- (endianness order) (sizeof* type)))
- ((_ bv offset type)
- (bytevector-uint-ref bv offset
- (native-endianness) (sizeof* type)))))
-
-(define-syntax read-types
- (syntax-rules ()
- ((_ return bv offset () (values ...))
- (return values ...))
- ((_ return bv offset (type0 types ...) (values ...))
- (read-types return
- bv
- (+ (align offset type0) (type-size type0))
- (types ...)
- (values ... (read-type bv
- (align offset type0)
- type0))))))
-
-(define-syntax define-c-struct
- (syntax-rules ()
- "Define READ as a deserializer and WRITE! as a serializer for the C
-structure with the given TYPES. READ uses WRAP-FIELDS to return its value."
- ((_ name wrap-fields read write! (fields types) ...)
- (begin
- (define (write! bv offset fields ...)
- (write-types bv offset (types ...) (fields ...)))
- (define (read bv offset)
- (read-types wrap-fields bv offset (types ...) ()))))))
-
-
-;;;
;;; Network interfaces.
;;;