From: Mathieu Othacehe <m.othacehe@gmail.com>
To: 26341@debbugs.gnu.org
Subject: bug#26341: [PATCH 1/5] build: syscalls: Add reboot.
Date: Mon, 10 Apr 2017 19:18:10 +0200 [thread overview]
Message-ID: <20170410171814.18461-1-m.othacehe@gmail.com> (raw)
In-Reply-To: <20170402150157.7149-1-m.othacehe@gmail.com>
* 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>
---
guix/build/syscalls.scm | 51 +++++++++++++++++++++++++++++++++++++++++++++++--
1 file changed, 49 insertions(+), 2 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 4bcb2a871..0de39aee6 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -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))))))
+
\f
;;;
;;; 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."
--
2.12.2
next prev parent reply other threads:[~2017-04-10 17:19 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-04-02 15:01 bug#26341: [PATCH] build: vm: Add missing module Mathieu Othacehe
2017-04-04 12:41 ` Ludovic Courtès
2017-04-05 10:30 ` Mathieu Othacehe
2017-04-05 10:32 ` Mathieu Othacehe
2017-04-05 21:39 ` Ludovic Courtès
2017-04-06 6:55 ` Mathieu Othacehe
2017-04-06 8:10 ` Ludovic Courtès
2017-04-07 21:36 ` Ludovic Courtès
2017-04-08 9:24 ` Mathieu Othacehe
2017-04-05 21:35 ` Ludovic Courtès
2017-04-06 6:55 ` bug#26341: [PATCH 1/2] build: syscalls: Allow mount and umount use from static Guile Mathieu Othacehe
2017-04-06 6:55 ` bug#26341: [PATCH 2/2] build: vm: Add missing module Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 0/5] Fix warnings related to syscalls in static Guile Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Mathieu Othacehe
2017-04-10 9:42 ` Ludovic Courtès
2017-04-10 13:18 ` Mathieu Othacehe
2017-04-10 13:41 ` Ludovic Courtès
2017-04-10 17:18 ` Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 2/5] build: syscalls: Allow use to network-interface syscalls independently of calling context Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 3/5] build: syscalls: Add mount and umount to #:replace list Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
2017-04-08 16:03 ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
2017-04-10 17:18 ` Mathieu Othacehe [this message]
2017-04-10 17:18 ` bug#26341: [PATCH 2/5] build: syscalls: Use define-as-needed for mount and umount Mathieu Othacehe
2017-04-10 17:18 ` bug#26341: [PATCH 3/5] build: syscalls: Use define-as-needed for network-interface syscalls Mathieu Othacehe
2017-04-10 17:18 ` bug#26341: [PATCH 4/5] build: syscalls: Add load-linux-module Mathieu Othacehe
2017-04-10 17:18 ` bug#26341: [PATCH 5/5] build: Fix compilation warnings Mathieu Othacehe
2017-04-11 9:15 ` bug#26341: [PATCH 1/5] build: syscalls: Add reboot Ludovic Courtès
2017-04-11 11:39 ` Mathieu Othacehe
2017-04-11 12:20 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170410171814.18461-1-m.othacehe@gmail.com \
--to=m.othacehe@gmail.com \
--cc=26341@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.