Changeset 14074


Ignore:
Timestamp:
08/12/12 19:57:53 (8 years ago)
Author:
ehuelsmann
Message:

Flatten (and simplify) AND and OR compilation.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r14073 r14074  
    61936193      (1
    61946194       (compile-form (%car args) target representation))
    6195       (2
    6196        (let ((arg1 (%car args))
    6197              (arg2 (%cadr args))
    6198              (FAIL (gensym))
    6199              (DONE (gensym)))
    6200          (compile-forms-and-maybe-emit-clear-values arg1 'stack :boolean)
    6201          (emit 'ifeq FAIL)
    6202          (ecase representation
    6203            (:boolean
    6204             (compile-forms-and-maybe-emit-clear-values arg2 'stack :boolean)
    6205             (emit 'goto DONE)
    6206             (label FAIL)
    6207             (emit 'iconst_0))
    6208            ((nil)
    6209             (compile-form arg2 'stack nil)
    6210             (emit 'goto DONE)
    6211             (label FAIL)
    6212             (emit-push-nil)))
    6213          (label DONE)
    6214          (emit-move-from-stack target representation)))
    62156195      (t
    6216        ;; (and a b c d e f) => (and a (and b c d e f))
    6217        (let ((new-form `(and ,(%car args) (and ,@(%cdr args)))))
    6218          (p2-and new-form target representation))))))
     6196       (let ((FAIL (gensym))
     6197             (DONE (gensym))
     6198             (butlast-args (butlast args)))
     6199         (loop
     6200            for form in butlast-args
     6201            do (compile-form form 'stack nil)
     6202            do (emit-push-nil)
     6203            do (emit 'if_acmpeq FAIL))
     6204         (apply #'maybe-emit-clear-values butlast-args)
     6205         (compile-form (car (last args)) target representation)
     6206         (emit 'goto DONE)
     6207         (label FAIL)
     6208         (apply #'maybe-emit-clear-values butlast-args)
     6209         (emit-push-false representation)
     6210         (emit-move-from-stack target representation)
     6211         (label DONE))))))
    62196212
    62206213(defknown p2-or (t t t) t)
     
    62276220      (1
    62286221       (compile-form (%car args) target representation))
    6229       (2
    6230        (let ((arg1 (%car args))
    6231              (arg2 (%cadr args))
    6232              (LABEL1 (gensym))
    6233              (LABEL2 (gensym)))
    6234          (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    6235          (emit 'dup)
    6236          (emit-push-nil)
    6237          (emit 'if_acmpne LABEL1)
    6238          (emit 'pop)
    6239          (compile-form arg2 'stack representation)
    6240          (emit 'goto LABEL2)
    6241          (label LABEL1)
    6242          (fix-boxing representation nil) ; FIXME use derived result type
    6243          (label LABEL2)
    6244          (emit-move-from-stack target representation)))
    62456222      (t
    6246        ;; (or a b c d e f) => (or a (or b c d e f))
    6247        (let ((new-form `(or ,(%car args) (or ,@(%cdr args)))))
    6248          (p2-or new-form target representation))))))
     6223       (let ((SUCCESS (gensym))
     6224             (DONE (gensym))
     6225             (butlast-args (butlast args)))
     6226         (loop
     6227            for form in butlast-args
     6228            do (compile-form form 'stack nil)
     6229            do (emit 'dup)  ;; leave value on the stack for SUCCESS to use
     6230            do (emit-push-nil)
     6231            do (emit 'if_acmpne SUCCESS)
     6232            do (emit 'pop))
     6233         (apply #'maybe-emit-clear-values butlast-args)
     6234         (compile-form (car (last args)) target representation)
     6235         (emit 'goto DONE)
     6236         (label SUCCESS)
     6237         (fix-boxing representation nil)  ;; value is still on the stack
     6238         (emit-move-from-stack target representation)
     6239         (apply #'maybe-emit-clear-values butlast-args)
     6240         (label DONE))))))
    62496241
    62506242(defun p2-values (form target representation)
Note: See TracChangeset for help on using the changeset viewer.