Changeset 16176

Aug 29, 2014, 4:32:57 AM (7 years ago)

Don't refuse to inline if &REST is present in NX1-LAMBDA-BIND. (We still punt on &LEXPR and &KEY; we could
handle &KEY with constant keywords if we really wanted to.)

Handling &REST means that we have to have a mechanism for eliminating it in the backends; failure to handle/
eliminate &REST led to excessive consing in CALL-NEXT-METHOD. This fixes ticket:1220 in the trunk.)

I haven't tested (or even natively compiled) the ARM and PPC backend changes yet.

4 edited


  • trunk/source/compiler/ARM/arm2.lisp

    r16163 r16176  
    26442644          (if (or (eq op (%nx1-operator lexical-function-call))
    26452645                  (eq op (%nx1-operator call)))
    2646             (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (%cdr body)
     2646            (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (acode-operands body)
    26472647               (unless (and (eq spread-p t)
    26482648                           (eq (arm2-lexical-reference-p (%car reg-args)) rest))
    26742674                  (return nil))))
    26752675            (if (eq op (%nx1-operator local-block))
    2676               (setq body (%cadr body))
     2676              (setq body (car (acode-operands body)))
    26772677              (if (and (eq op (%nx1-operator if))
    2678                        (eq (arm2-lexical-reference-p (%cadr body)) rest))
    2679                 (setq body (%caddr body))
     2678                       (eq (arm2-lexical-reference-p (car (acode-operands body)) rest))
     2679                (setq body (car (cdr (acode-operands body))))
    26802680                (return nil)))))))))
  • trunk/source/compiler/PPC/ppc2.lisp

    r16111 r16176  
    22112211          (if (or (eq op (%nx1-operator lexical-function-call))
    22122212                  (eq op (%nx1-operator call)))
    2213             (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (%cdr body)
     2213            (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (car (acode-operands body))
    22142214               (unless (and (eq spread-p t)
    22152215                           (eq (ppc2-lexical-reference-p (%car reg-args)) rest))
    22412241                  (return nil))))
    22422242            (if (eq op (%nx1-operator local-block))
    2243               (setq body (%cadr body))
     2243              (setq body (car (acode-operands body)))
    22442244              (if (and (eq op (%nx1-operator if))
    2245                        (eq (ppc2-lexical-reference-p (%cadr body)) rest))
    2246                 (setq body (%caddr body))
     2245                       (eq (ppc2-lexical-reference-p (car (acode-operands body))) rest))
     2246                (setq body (car (cdr (acode-operands body))))
    22472247                (return nil)))))))))
  • trunk/source/compiler/X86/x862.lisp

    r16130 r16176  
    31313131          (if (or (eq op (%nx1-operator lexical-function-call))
    31323132                  (eq op (%nx1-operator call)))
    3133             (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (%cdr body)
     3133            (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (acode-operands body)
    31343134               (unless (and (eq spread-p t)
    31353135                           (eq (nx2-lexical-reference-p (%car reg-args)) rest))
    31613161                  (return nil))))
    31623162            (if (eq op (%nx1-operator local-block))
    3163               (setq body (%cadr body))
     3163              (setq body (cadr body))
    31643164              (if (and (eq op (%nx1-operator if))
    3165                        (eq (nx2-lexical-reference-p (%cadr body)) rest))
    3166                 (setq body (%caddr body))
     3165                       (eq (nx2-lexical-reference-p (car (acode-operands body))) rest))
     3166                (setq body (car (cdr (acode-operands body))))
    31673167                (return nil)))))))))
  • trunk/source/compiler/nx1.lisp

    r16111 r16176  
    19351935      (declare (ignore req opttail))
    19361936      (when (and ok (or (eq (%car resttail) '&lexpr)
    1937                         (eq (%car resttail) '&rest)
    19381937                        (eq (%car keytail) '&key)))
    19391938        (return-from nx1-lambda-bind (nx1-call context (nx1-form context `(lambda ,lambda-list ,@body)) args))))
    19731972            (if arglist
    19741973              (when (and (not keys) (not rest))
    1975                 (nx-error "Extra args ~s for (LAMBDA ~s ...)" args lambda-list)))
     1974                (nx-error "Extra args ~s for (LAMBDA ~s ...)" args lambda-list))
     1975              (when rest
     1976                (push rest vars*) (push (make-nx-nil) vals*)
     1977                (nx1-punt-bindings (cons rest nil) (cons (make-nx-nil) nil))
     1978                (setq rest nil)))
    19761979            (destructuring-bind (&optional auxvars auxvals) auxen
    19771980              (let ((vars!% (nreconc vars* auxvars))
    19801983                            (append (nreverse vals) arglist)
    19811984                            (nreverse vars)
    1982                             nil
     1985                            rest
    19831986                            nil
    19841987                            (list vars!% vals!&)
Note: See TracChangeset for help on using the changeset viewer.