me
/
guix
Archived
1
0
Fork 0

linux-modules: Use 'load-linux-module/fd'.

This should be more efficient than loading the whole thing in user space.

* gnu/build/linux-modules.scm (load-linux-module*): Use
'load-linux-module/fd' instead of 'load-linux-module'.  Remove 'slurp'.
master
Ludovic Courtès 2018-02-28 22:02:27 +01:00
parent 4c853b7c11
commit 3c14e7e6bb
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 7 additions and 7 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -180,10 +180,6 @@ success, false otherwise. When RECURSIVE? is true, load its dependencies
first (à la 'modprobe'.) The actual files containing modules depended on are first (à la 'modprobe'.) The actual files containing modules depended on are
obtained by calling LOOKUP-MODULE with the module name. Modules whose name obtained by calling LOOKUP-MODULE with the module name. Modules whose name
appears in BLACK-LIST are not loaded." appears in BLACK-LIST are not loaded."
(define (slurp module)
;; TODO: Use 'finit_module' to reduce memory usage.
(call-with-input-file file get-bytevector-all))
(define (black-listed? module) (define (black-listed? module)
(let ((result (member module black-list))) (let ((result (member module black-list)))
(when result (when result
@ -200,16 +196,20 @@ appears in BLACK-LIST are not loaded."
(and (not (black-listed? (file-name->module-name file))) (and (not (black-listed? (file-name->module-name file)))
(or (not recursive?) (or (not recursive?)
(load-dependencies file)) (load-dependencies file))
(begin (let ((fd #f))
(format (current-module-debugging-port) (format (current-module-debugging-port)
"loading Linux module from '~a'...~%" file) "loading Linux module from '~a'...~%" file)
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(load-linux-module (slurp file))) (set! fd (open-fdes file O_RDONLY))
(load-linux-module/fd fd)
(close-fdes fd)
#t)
(lambda args (lambda args
;; If this module was already loaded and we're in modprobe style, ignore ;; If this module was already loaded and we're in modprobe style, ignore
;; the error. ;; the error.
(when fd (close-fdes fd))
(or (and recursive? (= EEXIST (system-error-errno args))) (or (and recursive? (= EEXIST (system-error-errno args)))
(apply throw args))))))) (apply throw args)))))))