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
					
				
					 1 changed files with 22 additions and 6 deletions
				
			
		|  | @ -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))) | ||||
|  |  | |||
		Reference in a new issue