[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/07: syscalls: Move code around [NFC].
From: |
Ludovic Courtès |
Subject: |
02/07: syscalls: Move code around [NFC]. |
Date: |
Mon, 25 Apr 2016 21:35:32 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit 73f38d5ff3621c7fbc69a6a5eea598ba269e8b2a
Author: Ludovic Courtès <address@hidden>
Date: Mon Apr 25 14:57:26 2016 +0200
syscalls: Move code around [NFC].
* guix/build/syscalls.scm: Move packed structure handling to the top.
---
guix/build/syscalls.scm | 217 +++++++++++++++++++++++++----------------------
1 file changed, 116 insertions(+), 101 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 04fc3ef..4555506 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.
;;;
- branch master updated (a800018 -> 5cd25aa), Ludovic Courtès, 2016/04/25
- 07/07: syscalls: 'terminal-columns' catches EINVAL on the TIOCGWINSZ ioctl., Ludovic Courtès, 2016/04/25
- 06/07: guix gc: Add '--free-space'., Ludovic Courtès, 2016/04/25
- 01/07: Add "TasksMax=1024" in 'guix-daemon.service'., Ludovic Courtès, 2016/04/25
- 04/07: syscalls: 'define-c-struct' computes the struct size., Ludovic Courtès, 2016/04/25
- 02/07: syscalls: Move code around [NFC].,
Ludovic Courtès <=
- 03/07: syscalls: Second argument of packed-struct read is now optional., Ludovic Courtès, 2016/04/25
- 05/07: syscalls: Add 'statfs'., Ludovic Courtès, 2016/04/25