Resending the correct patch.
From c2800b786f62c190b35e306e59af7a73a19094e0 Mon Sep 17 00:00:00 2001
From: Manolis Ragkousis <manolis...@gmail.com>
Date: Fri, 21 Aug 2015 22:00:16 +0300
Subject: [PATCH] syscalls: Turn syscalls wrappers into procedures.
* guix/build/syscalls.scm (mount, umount, swapon, swapoff,
setns, pivot-root, clone): Turn into procedures.
---
guix/build/syscalls.scm | 17 ++++++++++-------
1 file changed, 10 insertions(+), 7 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index fc801a5..c65456f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -182,7 +182,10 @@
(define MNT_EXPIRE 4)
(define UMOUNT_NOFOLLOW 8)
-(define mount
+;; By turning the syscalls wrappers into procedures we can delegate their evaluation
+;; till they are actually needed, thus enabling Guix to build on systems which the
+;; syscalls are not available.
+(define (mount)
(let* ((ptr (dynamic-func "mount" (dynamic-link)))
(proc (pointer->procedure int ptr `(* * * ,unsigned-long *))))
(lambda* (source target type #:optional (flags 0) options
@@ -211,7 +214,7 @@ error."
(when update-mtab?
(augment-mtab source target type options))))))
-(define umount
+(define (umount)
(let* ((ptr (dynamic-func "umount2" (dynamic-link)))
(proc (pointer->procedure int ptr `(* ,int))))
(lambda* (target #:optional (flags 0)
@@ -239,7 +242,7 @@ constants from <sys/mount.h>."
((source mount-point _ ...)
(loop (cons mount-point result))))))))))
-(define swapon
+(define (swapon)
(let* ((ptr (dynamic-func "swapon" (dynamic-link)))
(proc (pointer->procedure int ptr (list '* int))))
(lambda* (device #:optional (flags 0))
@@ -251,7 +254,7 @@ constants from <sys/mount.h>."
(list device (strerror err))
(list err)))))))
-(define swapoff
+(define (swapoff)
(let* ((ptr (dynamic-func "swapoff" (dynamic-link)))
(proc (pointer->procedure int ptr '(*))))
(lambda (device)
@@ -312,7 +315,7 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
;; The libc interface to sys_clone is not useful for Scheme programs, so the
;; low-level system call is wrapped instead.
-(define clone
+(define (clone)
(let* ((ptr (dynamic-func "syscall" (dynamic-link)))
(proc (pointer->procedure int ptr (list int int '*)))
;; TODO: Don't do this.
@@ -327,7 +330,7 @@ Unlike the fork system call, clone accepts FLAGS that specify which resources
are shared between the parent and child processes."
(proc syscall-id flags %null-pointer))))
-(define setns
+(define (setns)
;; Some systems may be using an old (pre-2.14) version of glibc where there
;; is no 'setns' function available.
(false-if-exception
@@ -345,7 +348,7 @@ there is no such limitation."
(list fdes nstype (strerror err))
(list err))))))))
-(define pivot-root
+(define (pivot-root)
(let* ((ptr (dynamic-func "pivot_root" (dynamic-link)))
(proc (pointer->procedure int ptr (list '* '*))))
(lambda (new-root put-old)
--
2.5.0
