guix
/
guix
mirror of git://git.savannah.gnu.org/guix.git
3
4
Fork 0
Code Issues Releases Wiki Activity

syscalls: Add reboot. 

* guix/build/syscalls.scm (define-as-needed): New macro.
(reboot): New procedure. Reimplemented from guile-linux-syscalls.patch.
(RB_AUTOBOOT, ..., RB_KEXEC): New flags copied from static Guile patch.

Co-Authored-By: Ludovic Courtès <ludo@gnu.org>
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Mathieu Othacehe 2017-04-10 19:18:10 +02:00 committed by Ludovic Courtès
parent e40335b275
commit 8336df0668
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 49 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
guix/build/syscalls.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -149,8 +150,19 @@
;;; Commentary:
;;;
;;; This module provides bindings to libc's syscall wrappers. It uses the
;;; FFI, and thus requires a dynamically-linked Guile. (For statically-linked
;;; Guile, we instead apply 'guile-linux-syscalls.patch'.)
;;; FFI, and thus requires a dynamically-linked Guile.
;;;
;;; Some syscalls are already defined in statically-linked Guile by applying
;;; 'guile-linux-syscalls.patch'.
;;;
;;; Visibility of syscall's symbols shared between this module and static Guile
;;; is a bit delicate. It is handled by 'define-as-needed' macro.
;;;
;;; This macro is used to export symbols in dynamic Guile context, and to
;;; re-export them in static Guile context.
;;;
;;; This way, even if they don't appear in #:export list, it is safe to use
;;; syscalls from this module in static or dynamic Guile context.
;;;
;;; Code:
@ -409,6 +421,25 @@ the returned procedure is called."
(error (format #f "~a: syscall->procedure failed: ~s"
name args))))))
(define-syntax define-as-needed
(syntax-rules ()
"Define VARIABLE. If VARIABLE already exists in (guile) then re-export it,
otherwise export the newly-defined VARIABLE."
((_ (proc args ...) body ...)
(define-as-needed proc (lambda* (args ...) body ...)))
((_ variable value)
(begin
(when (module-defined? the-scm-module 'variable)
(re-export variable))
(define variable
(if (module-defined? the-scm-module 'variable)
(module-ref the-scm-module 'variable)
value))
(unless (module-defined? the-scm-module 'variable)
(export variable))))))
;;;
;;; File systems.
@ -547,6 +578,22 @@ constants from <sys/mount.h>."
(list device (strerror err))
(list err)))))))
(define-as-needed RB_AUTOBOOT #x01234567)
(define-as-needed RB_HALT_SYSTEM #xcdef0123)
(define-as-needed RB_ENABLED_CAD #x89abcdef)
(define-as-needed RB_DISABLE_CAD 0)
(define-as-needed RB_POWER_OFF #x4321fedc)
(define-as-needed RB_SW_SUSPEND #xd000fce2)
(define-as-needed RB_KEXEC #x45584543)
(define-as-needed (reboot #:optional (cmd RB_AUTOBOOT))
(let ((proc (syscall->procedure int "reboot" (list int))))
(let-values (((ret err) (proc cmd)))
(unless (zero? ret)
(throw 'system-error "reboot" "~S: ~A"
(list cmd (strerror err))
(list err))))))
(define (kernel? pid)
"Return #t if PID designates a \"kernel thread\" rather than a normal
user-land process."