Changeset 12044

May 13, 2009, 4:28:42 PM (10 years ago)

NX2-RECORDED-SYMBOLS-IN-ARGLIST-ORDER: if necessary, sort the backend's
recorded-symbols list so that ARGLIST-FROM-MAP can better deal with
functions whose lambda lists contain supplied-p variables.

1 edited


  • trunk/source/compiler/nx2.lisp

    r12039 r12044  
    179179       (eql (hard-regspec-class reg) hard-reg-class-gpr)
    180180       (eql (get-regspec-mode reg) hard-reg-class-gpr-mode-node)))
     182;;; ENTRIES is a list of recorded-symbol entries, built by pushing
     183;;; info for each variable referenced by the function AFUNC as it
     184;;; comes into scope.  (Inherited variables "come into scope" before
     185;;; anything else, then required arguments, etc.)  Supplied-p variables
     186;;; may come into scope before "real" arglist entries do, which confuses
     187;;; functions that try to construct a function's arglist from the symbol
     188;;; map.  I -think- that confusion only exists when supplied-p variables
     189;;; are involved, so this returns its first argument unless they are;
     190;;; otherwise, it ensures that all toplevel arglist symbols are followed
     191;;; only by any inherited variables, and that the arglist symbols are
     192;;; in the correct (reversed) order
     193(defun nx2-recorded-symbols-in-arglist-order (entries afunc)
     194  (let* ((alambda (afunc-acode afunc)))
     195    (when (and (acode-p alambda)
     196               (eq (acode-operator alambda) (%nx1-operator lambda-list)))
     197      (destructuring-bind (req opt rest keys &rest ignore) (cdr alambda)
     198        (declare (ignore ignore))
     199        (when (or (dolist (sp (caddr opt))
     200                    (when sp (return t)))
     201                  (dolist (sp (caddr keys))
     202                    (when sp (return t))))
     203          (flet ((info-for-var (var)
     204                   (or (assoc var entries :test #'eq)
     205                       (error "Missing info for var ~s" (var-name var)))))
     206            (let* ((new ()))
     207              (setq entries (nreverse entries))
     208              (dolist (var (afunc-inherited-vars afunc))
     209                (push (info-for-var var) new))
     210              (dolist (r req)
     211                (push (info-for-var r) new))
     212              (dolist (o (car opt))
     213                (push (info-for-var o) new))
     214              (when (consp rest)
     215                (setq rest (car rest)))
     216              (when rest
     217                (push (info-for-var rest) new))
     218              (dolist (k (cadr keys))
     219                (push (info-for-var k) new))
     220              (dolist (e entries)
     221                (unless (member e new :test #'eq)
     222                  (push e new)))
     223              (setq entries new))))))
     224    entries))
Note: See TracChangeset for help on using the changeset viewer.