diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-10-17 11:53:25 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-17 11:53:25 +0200 |
| commit | 0e3cc3116de1145545a51d598bece890eb6d8424 (patch) | |
| tree | c65c8e9835dd46ece303cb810f3188af92ba0ba2 | |
| parent | d82633d06a0b7f24e98f12a2686c1ffdf12f5cd3 (diff) | |
| download | guix-0e3cc3116de1145545a51d598bece890eb6d8424.tar guix-0e3cc3116de1145545a51d598bece890eb6d8424.tar.gz | |
syscalls: Fix ABI mismatch for 'clone'.
Fixes <http://bugs.gnu.org/21694>.
* guix/build/syscalls.scm (clone): Change 'syscall' parameter types to
LONG, UNSIGNED-LONG, or '*; make sure it has 6 parameters. Adjust
caller accordingly.
| -rw-r--r-- | guix/build/syscalls.scm | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 2c2fbde0a3..a3b68c4537 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -315,10 +315,16 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'." (define CLONE_NEWNET #x40000000) ;; The libc interface to sys_clone is not useful for Scheme programs, so the -;; low-level system call is wrapped instead. +;; low-level system call is wrapped instead. The 'syscall' function is +;; declared in <unistd.h> as a variadic function; in practice, it expects 6 +;; pointer-sized arguments, as shown in, e.g., x86_64/syscall.S. (define clone (let* ((ptr (dynamic-func "syscall" (dynamic-link))) - (proc (pointer->procedure int ptr (list int int '*))) + (proc (pointer->procedure long ptr + (list long ;sysno + unsigned-long ;flags + '* '* '* + '*))) ;; TODO: Don't do this. (syscall-id (match (utsname:machine (uname)) ("i686" 120) @@ -329,7 +335,10 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'." "Create a new child process by duplicating the current parent process. Unlike the fork system call, clone accepts FLAGS that specify which resources are shared between the parent and child processes." - (let ((ret (proc syscall-id flags %null-pointer)) + (let ((ret (proc syscall-id flags + %null-pointer ;child stack + %null-pointer %null-pointer ;ptid & ctid + %null-pointer)) ;unused (err (errno))) (if (= ret -1) (throw 'system-error "clone" "~d: ~A" |