summaryrefslogtreecommitdiff
path: root/guix/utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-07 18:11:36 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-07 18:16:59 +0200
commitaf4535c58c29a3d20d6e76fd4bd4dd2714204e82 (patch)
tree5ba681689a3b0e21ab748272d60e8fc8e70ee46e /guix/utils.scm
parent68ec0450d1c3f125d7d290958dda6e89b6a0c37e (diff)
utils: Make 'errno' procedure more robust.
Partially fixes <http://bugs.gnu.org/17212>. * guix/utils.scm (errno): Move definition of 'bv' outside of the procedure. Use 'bytevector-s32-native-ref' or 'bytevector-s64-native-ref' instead of 'bytevector-sint-ref'.
Diffstat (limited to 'guix/utils.scm')
-rw-r--r--guix/utils.scm28
1 files changed, 22 insertions, 6 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index 7306c6011d..84cb5ae983 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -377,14 +377,30 @@ closed as soon as PROC's dynamic extent is entered."
(let ((proc (pointer->procedure '* errno-loc '())))
(proc)))))
-(define (errno)
- "Return the current errno."
- ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
- ;; In particular, that means that no async must be running here.
+(define errno
(if %libc-errno-pointer
(let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
- (bytevector-sint-ref bv 0 (native-endianness) (sizeof int)))
- 0))
+ (lambda ()
+ "Return the current errno."
+ ;; XXX: We assume that nothing changes 'errno' while we're doing all this.
+ ;; In particular, that means that no async must be running here.
+
+ ;; Use one of the fixed-size native-ref procedures because they are
+ ;; optimized down to a single VM instruction, which reduces the risk
+ ;; that we fiddle with 'errno' (needed on Guile 2.0.5, libc 2.11.)
+ (let-syntax ((ref (lambda (s)
+ (syntax-case s ()
+ ((_ bv)
+ (case (sizeof int)
+ ((4)
+ #'(bytevector-s32-native-ref bv 0))
+ ((8)
+ #'(bytevector-s64-native-ref bv 0))
+ (else
+ (error "unsupported 'int' size"
+ (sizeof int)))))))))
+ (ref bv))))
+ (lambda () 0)))
(define fcntl-flock
(let* ((ptr (dynamic-func "fcntl" (dynamic-link)))