syscalls: 'define-c-struct' computes the struct size.

* guix/build/syscalls.scm (struct-alignment, struct-size): New macros.
(define-c-struct): Add 'size' parameter and honor it.
(sockaddr-in, sockaddr-in6, ifaddrs, winsize): Adjust accordingly.
(%struct-ifaddrs-type, %sizeof-ifaddrs, winsize-struct): Remove.
(terminal-window-size): Use 'make-bytevector' instead of 'make-c-struct'.
master
Ludovic Courtès 2016-04-25 16:47:23 +02:00
parent f77863a09e
commit 785cfa8791
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 35 additions and 17 deletions

View File

@ -145,6 +145,27 @@
((_ type) ((_ type)
(sizeof* type)))) (sizeof* type))))
(define-syntax struct-alignment
(syntax-rules ()
"Compute the alignment for the aggregate made of TYPES at OFFSET. The
result is the alignment of the \"most strictly aligned component\"."
((_ offset types ...)
(max (align offset types) ...))))
(define-syntax struct-size
(syntax-rules ()
"Return the size in bytes of the structure made of TYPES."
((_ offset (types-processed ...))
;; The SysV ABI P.S. says: "Aggregates (structures and arrays) and unions
;; assume the alignment of their most strictly aligned component." As an
;; example, a struct such as "int32, int16" has size 8, not 6.
(1+ (logior (1- offset)
(1- (struct-alignment offset types-processed ...)))))
((_ offset (types-processed ...) type0 types ...)
(struct-size (+ (type-size type0) (align offset type0))
(type0 types-processed ...)
types ...))))
(define-syntax write-type (define-syntax write-type
(syntax-rules (~) (syntax-rules (~)
((_ bv offset (type ~ order) value) ((_ bv offset (type ~ order) value)
@ -193,10 +214,13 @@
(define-syntax define-c-struct (define-syntax define-c-struct
(syntax-rules () (syntax-rules ()
"Define READ as a deserializer and WRITE! as a serializer for the C "Define SIZE as the size in bytes of the C structure made of FIELDS. READ
structure with the given TYPES. READ uses WRAP-FIELDS to return its value." as a deserializer and WRITE! as a serializer for the C structure with the
((_ name wrap-fields read write! (fields types) ...) given TYPES. READ uses WRAP-FIELDS to return its value."
((_ name size wrap-fields read write! (fields types) ...)
(begin (begin
(define size
(struct-size 0 () types ...))
(define (write! bv offset fields ...) (define (write! bv offset fields ...)
(write-types bv offset (types ...) (fields ...))) (write-types bv offset (types ...) (fields ...)))
(define* (read bv #:optional (offset 0)) (define* (read bv #:optional (offset 0))
@ -559,6 +583,7 @@ system to PUT-OLD."
32)) 32))
(define-c-struct sockaddr-in ;<linux/in.h> (define-c-struct sockaddr-in ;<linux/in.h>
sizeof-sockaddrin
(lambda (family port address) (lambda (family port address)
(make-socket-address family address port)) (make-socket-address family address port))
read-sockaddr-in read-sockaddr-in
@ -568,6 +593,7 @@ system to PUT-OLD."
(address (int32 ~ big))) (address (int32 ~ big)))
(define-c-struct sockaddr-in6 ;<linux/in6.h> (define-c-struct sockaddr-in6 ;<linux/in6.h>
sizeof-sockaddr-in6
(lambda (family port flowinfo address scopeid) (lambda (family port flowinfo address scopeid)
(make-socket-address family address port flowinfo scopeid)) (make-socket-address family address port flowinfo scopeid))
read-sockaddr-in6 read-sockaddr-in6
@ -832,6 +858,7 @@ an <interface> object, and whose cdr is the pointer NEXT."
next)) next))
(define-c-struct ifaddrs ;<ifaddrs.h> (define-c-struct ifaddrs ;<ifaddrs.h>
%sizeof-ifaddrs
values->interface values->interface
read-ifaddrs read-ifaddrs
write-ifaddrs! write-ifaddrs!
@ -843,14 +870,6 @@ an <interface> object, and whose cdr is the pointer NEXT."
(broadcastaddr '*) (broadcastaddr '*)
(data '*)) (data '*))
(define-syntax %struct-ifaddrs-type
(identifier-syntax
`(* * ,unsigned-int * * * *)))
(define-syntax %sizeof-ifaddrs
(identifier-syntax
(sizeof* %struct-ifaddrs-type)))
(define (unfold-interface-list ptr) (define (unfold-interface-list ptr)
"Call 'read-ifaddrs' on PTR and all its 'next' fields, recursively, and "Call 'read-ifaddrs' on PTR and all its 'next' fields, recursively, and
return the list of resulting <interface> objects." return the list of resulting <interface> objects."
@ -901,6 +920,7 @@ network interface. This is implemented using the 'getifaddrs' libc function."
(y-pixels window-size-y-pixels)) (y-pixels window-size-y-pixels))
(define-c-struct winsize ;<bits/ioctl-types.h> (define-c-struct winsize ;<bits/ioctl-types.h>
sizeof-winsize
window-size window-size
read-winsize read-winsize
write-winsize! write-winsize!
@ -909,18 +929,16 @@ network interface. This is implemented using the 'getifaddrs' libc function."
(x-pixels unsigned-short) (x-pixels unsigned-short)
(y-pixels unsigned-short)) (y-pixels unsigned-short))
(define winsize-struct
(list unsigned-short unsigned-short unsigned-short unsigned-short))
(define* (terminal-window-size #:optional (port (current-output-port))) (define* (terminal-window-size #:optional (port (current-output-port)))
"Return a <window-size> structure describing the terminal at PORT, or raise "Return a <window-size> structure describing the terminal at PORT, or raise
a 'system-error' if PORT is not backed by a terminal. This procedure a 'system-error' if PORT is not backed by a terminal. This procedure
corresponds to the TIOCGWINSZ ioctl." corresponds to the TIOCGWINSZ ioctl."
(let* ((size (make-c-struct winsize-struct '(0 0 0 0))) (let* ((size (make-bytevector sizeof-winsize))
(ret (%ioctl (fileno port) TIOCGWINSZ size)) (ret (%ioctl (fileno port) TIOCGWINSZ
(bytevector->pointer size)))
(err (errno))) (err (errno)))
(if (zero? ret) (if (zero? ret)
(read-winsize (pointer->bytevector size (sizeof winsize-struct))) (read-winsize size)
(throw 'system-error "terminal-window-size" "~A" (throw 'system-error "terminal-window-size" "~A"
(list (strerror err)) (list (strerror err))
(list err))))) (list err)))))