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'.
This commit is contained in:
parent
68ec0450d1
commit
af4535c58c
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue