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'.

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)))