unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
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

  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

  List information: https://guix.gnu.org/

* 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 public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).