Changeset 8618


Ignore:
Timestamp:
Feb 29, 2008, 4:05:38 AM (12 years ago)
Author:
gb
Message:

FRAME-SUPPLIED-ARGS: be a little more defensive.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/1.1/ccl/lib/backtrace-lds.lisp

    r7255 r8618  
    3939(defun frame-supplied-args (frame lfun pc child context)
    4040  (declare (ignore child))
    41   (let* ((arglist (arglist-from-map lfun))
    42          (args (arguments-and-locals context frame lfun pc))
    43          (state :required))
    44     (collect ((arg-values)
    45               (types)
    46               (names))
    47       (dolist (arg arglist)
    48         (if (or (member arg lambda-list-keywords)
    49                 (eq arg '&lexpr))
    50           (setq state arg)
    51           (let* ((pair (pop args)))
    52             (case state
    53               (&lexpr
    54                (with-list-from-lexpr (rest (cdr pair))
    55                  (dolist (r rest) (arg-values r) (names nil) (types nil)))
    56                (return))
    57               (&rest
    58                (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
    59                (return))
    60               (&key
    61                (arg-values arg)
    62                (names nil)
    63                (types nil)))
    64             (let* ((value (cdr pair)))
    65               (if (eq value (%unbound-marker))
    66                 (return))
    67               (names (car pair))
    68               (arg-values value)
    69               (types nil)))))
    70       (values (arg-values) (types) (names)))))
     41  (handler-case
     42      (let* ((arglist (arglist-from-map lfun))
     43             (args (arguments-and-locals context frame lfun pc))
     44             (state :required))
     45        (collect ((arg-values)
     46                  (types)
     47                  (names))
     48          (when args
     49            (dolist (arg arglist)
     50              (if (or (member arg lambda-list-keywords)
     51                      (eq arg '&lexpr))
     52                (setq state arg)
     53                (let* ((pair (pop args)))
     54                  (case state
     55                    (&lexpr
     56                     (with-list-from-lexpr (rest (cdr pair))
     57                       (dolist (r rest) (arg-values r) (names nil) (types nil)))
     58                     (return))
     59                    (&rest
     60                     (dolist (r (cdr pair)) (arg-values r) (names nil) (types nil))
     61                     (return))
     62                    (&key
     63                     (arg-values arg)
     64                     (names nil)
     65                     (types nil)))
     66                  (let* ((value (cdr pair)))
     67                    (if (eq value (%unbound-marker))
     68                      (return))
     69                    (names (car pair))
     70                    (arg-values value)
     71                    (types nil))))))
     72          (values (arg-values) (types) (names))))
     73    (error () (values nil nil nil))))
    7174
    7275;;; I'm skeptical about a lot of this stuff on the PPC, but if anything it's
Note: See TracChangeset for help on using the changeset viewer.