Changeset 8619


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

ARGUMENTS-AND-LOCALS: be a little more defensive.

File:
1 edited

Legend:

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

    r7594 r8619  
    393393(defun arguments-and-locals (context cfp lfun pc &optional unavailable)
    394394  (multiple-value-bind (vars map-indices) (variables-in-scope lfun pc)
    395     (collect ((args)
    396               (locals))
    397       (multiple-value-bind (valid req opt rest keys)
    398           (arg-names-from-map lfun pc)
    399         (when valid
    400           (let* ((nargs (+ (length req) (length opt) (if rest 1 0) (length keys)))
    401                  (nlocals (- (length vars) nargs))
    402                  (local-vars (nthcdr nargs vars))
    403                  (local-indices (nthcdr nargs map-indices))
    404                  (arg-vars (nbutlast vars nlocals))
    405                  (arg-indices (nbutlast map-indices nlocals)))
    406             (flet ((get-arg-value (name)
    407                      (let* ((pos (position name arg-vars :test #'eq)))
    408                        (when pos
    409                          (args (cons name (map-entry-value context cfp lfun pc (nth pos arg-indices) unavailable))))))
    410                    (get-local-value (name)
    411                      (when name
    412                        (locals (cons name (map-entry-value context cfp lfun pc (pop local-indices) unavailable))))))
    413               (dolist (name req)
    414                 (get-arg-value name))
    415               (dolist (name opt)
    416                 (get-arg-value name))
    417               (when rest
    418                 (get-arg-value rest))
    419               (dolist (name keys)
    420                 (get-arg-value name))
    421               #+no
    422               (setq local-vars (nreverse local-vars)
    423                     local-indices (nreverse local-indices))
    424               (dolist (name local-vars)
    425                 (get-local-value name)))))
    426         (values (args) (locals))))))
     395    (if (null map-indices)
     396      (values nil nil)
     397      (collect ((args)
     398                (locals))
     399        (multiple-value-bind (valid req opt rest keys)
     400            (arg-names-from-map lfun pc)
     401          (when valid
     402            (let* ((nargs (+ (length req) (length opt) (if rest 1 0) (length keys)))
     403                   (nlocals (- (length vars) nargs))
     404                   (local-vars (nthcdr nargs vars))
     405                   (local-indices (nthcdr nargs map-indices))
     406                   (arg-vars (nbutlast vars nlocals))
     407                   (arg-indices (nbutlast map-indices nlocals)))
     408              (flet ((get-arg-value (name)
     409                       (let* ((pos (position name arg-vars :test #'eq)))
     410                         (when pos
     411                           (args (cons name (map-entry-value context cfp lfun pc (nth pos arg-indices) unavailable))))))
     412                     (get-local-value (name)
     413                       (when name
     414                         (locals (cons name (map-entry-value context cfp lfun pc (pop local-indices) unavailable))))))
     415                (dolist (name req)
     416                  (get-arg-value name))
     417                (dolist (name opt)
     418                  (get-arg-value name))
     419                (when rest
     420                  (get-arg-value rest))
     421                (dolist (name keys)
     422                  (get-arg-value name))
     423                #+no
     424                (setq local-vars (nreverse local-vars)
     425                      local-indices (nreverse local-indices))
     426                (dolist (name local-vars)
     427                  (get-local-value name)))))
     428          (values (args) (locals)))))))
    427429                   
    428430           
Note: See TracChangeset for help on using the changeset viewer.