linux-initrd: Use 'call-with-error-handling' when booting.

* guix/build/linux-initrd.scm (canonicalize-device-spec): When label
  resolution fails, call 'error' instead of 'format' + 'start-repl'.
  (boot-system): Wrap most of body in 'call-with-error-handling'.
  Remove 'catch' around 'primitive-load' call.
This commit is contained in:
Ludovic Courtès 2014-07-03 22:44:14 +02:00
parent dccab4df20
commit e3ced65af0
1 changed files with 65 additions and 72 deletions

View File

@ -20,6 +20,7 @@
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (system foreign) #:use-module (system foreign)
#:use-module (system repl error-handling)
#:autoload (system repl repl) (start-repl) #:autoload (system repl repl) (start-repl)
#:autoload (system base compile) (compile-file) #:autoload (system base compile) (compile-file)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -250,10 +251,7 @@ the following:
;; Some devices take a bit of time to appear, most notably USB ;; Some devices take a bit of time to appear, most notably USB
;; storage devices. Thus, wait for the device to appear. ;; storage devices. Thus, wait for the device to appear.
(if (> count max-trials) (if (> count max-trials)
(begin (error "failed to resolve partition label" spec)
(format (current-error-port)
"failed to resolve partition label: ~s~%" spec)
(start-repl))
(begin (begin
(sleep 1) (sleep 1)
(loop (+ 1 count)))))))) (loop (+ 1 count))))))))
@ -615,6 +613,8 @@ to it are lost."
(display "Welcome, this is GNU's early boot Guile.\n") (display "Welcome, this is GNU's early boot Guile.\n")
(display "Use '--repl' for an initrd REPL.\n\n") (display "Use '--repl' for an initrd REPL.\n\n")
(call-with-error-handling
(lambda ()
(mount-essential-file-systems) (mount-essential-file-systems)
(let* ((args (linux-command-line)) (let* ((args (linux-command-line))
(to-load (find-long-option "--load" args)) (to-load (find-long-option "--load" args))
@ -676,15 +676,8 @@ to it are lost."
(mount "none" "/dev/pts" "devpts") (mount "none" "/dev/pts" "devpts")
;; TODO: Remove /lib, /share, and /loader.go. ;; TODO: Remove /lib, /share, and /loader.go.
(catch #t (primitive-load to-load)
(lambda ()
(primitive-load to-load))
(lambda args
(start-repl))
(lambda args
(format (current-error-port) "'~a' raised an exception: ~s~%"
to-load args)
(display-backtrace (make-stack #t) (current-error-port))))
(format (current-error-port) (format (current-error-port)
"boot program '~a' terminated, rebooting~%" "boot program '~a' terminated, rebooting~%"
to-load) to-load)
@ -693,6 +686,6 @@ to it are lost."
(begin (begin
(display "no boot file passed via '--load'\n") (display "no boot file passed via '--load'\n")
(display "entering a warm and cozy REPL\n") (display "entering a warm and cozy REPL\n")
(start-repl))))) (start-repl)))))))
;;; linux-initrd.scm ends here ;;; linux-initrd.scm ends here