ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Make 'errno' procedure more robust.

Browse source 
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:
Ludovic Courtès 2014-04-07 18:11:36 +02:00
parent 68ec0450d1
commit af4535c58c
1 changed files with 22 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/utils.scm
View file

@ -377,14 +377,30 @@ (define %libc-errno-pointer
(let ((proc (pointer->procedure '* errno-loc '())))
(proc)))))
(define (errno)
(define errno
(if %libc-errno-pointer
(let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
(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.
(if %libc-errno-pointer
(let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int))))
(bytevector-sint-ref bv 0 (native-endianness) (sizeof int)))
0))
;; 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)))