Changeset 14440 for trunk/source/level-1


Ignore:
Timestamp:
Nov 22, 2010, 9:46:04 AM (9 years ago)
Author:
gb
Message:

Catch :toplevel around the body of STARTUP-CCL.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-boot-lds.lisp

    r13067 r14440  
    2929
    3030(defun startup-ccl (&optional init-file)
    31   (with-simple-restart (abort "Abort startup.")
    32     (let ((init-files (if (listp init-file) init-file (list init-file))))
    33       (dolist (init-file init-files)
    34         (with-simple-restart (continue "Skip loading init file.")
    35           (when (load init-file :if-does-not-exist nil :verbose nil)
    36             (return)))))
    37     (flet ((eval-string (s)
    38              (with-simple-restart (continue "Skip evaluation of ~a" s)
    39                (eval (read-from-string s))))
    40            (load-file (name)
    41              (with-simple-restart (continue "Skip loading ~s" name)
    42                (load name))))
    43       (dolist (p *lisp-startup-parameters*)
    44         (let* ((param (cdr p)))
    45           (case (car p)
    46             (:gc-threshold
    47              (multiple-value-bind (n last) (parse-integer param :junk-allowed t)
    48                (when n
    49                  (if (< last (length param))
    50                    (case (schar param last)
    51                      ((#\k #\K) (setq n (ash n 10)))
    52                      ((#\m #\M) (setq n (ash n 20)))))
    53                  (set-lisp-heap-gc-threshold n)
    54                  (use-lisp-heap-gc-threshold))))
    55             (:eval (eval-string param))
    56             (:load (load-file param))))))))
     31  ;; Many of the things done here could enter a break loop on error.
     32  ;; If that break loop is exited via :q, quietly exit to here.
     33  (catch :toplevel
     34    (with-simple-restart (abort "Abort startup.")
     35      (let ((init-files (if (listp init-file) init-file (list init-file))))
     36        (dolist (init-file init-files)
     37          (with-simple-restart (continue "Skip loading init file.")
     38            (when (load init-file :if-does-not-exist nil :verbose nil)
     39              (return)))))
     40      (flet ((eval-string (s)
     41               (with-simple-restart (continue "Skip evaluation of ~a" s)
     42                 (eval (read-from-string s))))
     43             (load-file (name)
     44               (with-simple-restart (continue "Skip loading ~s" name)
     45                 (load name))))
     46        (dolist (p *lisp-startup-parameters*)
     47          (let* ((param (cdr p)))
     48            (case (car p)
     49              (:gc-threshold
     50               (multiple-value-bind (n last) (parse-integer param :junk-allowed t)
     51                 (when n
     52                   (if (< last (length param))
     53                     (case (schar param last)
     54                       ((#\k #\K) (setq n (ash n 10)))
     55                       ((#\m #\M) (setq n (ash n 20)))))
     56                   (set-lisp-heap-gc-threshold n)
     57                   (use-lisp-heap-gc-threshold))))
     58              (:eval (eval-string param))
     59              (:load (load-file param)))))))))
    5760
    5861
Note: See TracChangeset for help on using the changeset viewer.