Changeset 13241


Ignore:
Timestamp:
03/10/11 20:30:06 (11 years ago)
Author:
ehuelsmann
Message:

Reduce the amount of code in our compiler by changing the way
COMPILE-TEST-FORM works. Instead of returning a conditional jump,
pass the labels around for the conditional jump.

File:
1 edited

Legend:

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

    r13233 r13241  
    23802380                    (>=                 p2-test-numeric-comparison)
    23812381                    (AND                p2-test-and)
     2382                    (OR                 p2-test-or)
    23822383                    (ATOM               p2-test-atom)
    23832384                    (BIT-VECTOR-P       p2-test-bit-vector-p)
     
    24222423(initialize-p2-test-handlers)
    24232424
     2425(defknown negate-jump-condition (t) t)
     2426(defun negate-jump-condition (jump-instruction)
     2427  (ecase jump-instruction
     2428    ('if_acmpeq  'if_acmpne)
     2429    ('if_acmpne  'if_acmpeq)
     2430    ('ifeq       'ifne)
     2431    ('ifne       'ifeq)
     2432    ('iflt       'ifge)
     2433    ('ifge       'iflt)
     2434    ('ifgt       'ifle)
     2435    ('ifle       'ifgt)
     2436    ('if_icmpeq  'if_icmpne)
     2437    ('if_icmpne  'if_icmpeq)
     2438    ('if_icmplt  'if_icmpge)
     2439    ('if_icmpge  'if_icmplt)
     2440    ('if_icmpgt  'if_icmple)
     2441    ('if_icmple  'if_icmpgt)))
     2442
     2443(defknown emit-test-jump (t t t) t)
     2444(defun emit-test-jump (jump success-label failure-label)
     2445  (cond
     2446    (failure-label
     2447     (emit jump failure-label)
     2448     (when success-label
     2449       (emit 'goto success-label)))
     2450    (t
     2451     (emit (negate-jump-condition jump) success-label)))
     2452  t)
     2453
    24242454(defknown p2-test-predicate (t t) t)
    2425 (defun p2-test-predicate (form java-predicate)
     2455(defun p2-test-predicate (form java-predicate success-label failure-label)
    24262456  (when (check-arg-count form 1)
    24272457    (let ((arg (%cadr form)))
    24282458      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    24292459      (emit-invokevirtual +lisp-object+ java-predicate nil :boolean)
    2430       'ifeq)))
    2431 
    2432 (declaim (ftype (function (t t) t) p2-test-instanceof-predicate))
    2433 (defun p2-test-instanceof-predicate (form java-class)
     2460      (emit-test-jump 'ifeq success-label failure-label))))
     2461
     2462(declaim (ftype (function (t t t t) t) p2-test-instanceof-predicate))
     2463(defun p2-test-instanceof-predicate (form java-class
     2464                                     success-label failure-label)
    24342465  (when (check-arg-count form 1)
    24352466    (let ((arg (%cadr form)))
    24362467      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    24372468      (emit-instanceof java-class)
    2438       'ifeq)))
    2439 
    2440 (defun p2-test-bit-vector-p (form)
    2441   (p2-test-instanceof-predicate form +lisp-abstract-bit-vector+))
    2442 
    2443 (defun p2-test-characterp (form)
    2444   (p2-test-instanceof-predicate form +lisp-character+))
     2469      (emit-test-jump 'ifeq success-label failure-label))))
     2470
     2471(defun p2-test-bit-vector-p (form success-label failure-label)
     2472  (p2-test-instanceof-predicate form +lisp-abstract-bit-vector+
     2473                                success-label failure-label))
     2474
     2475(defun p2-test-characterp (form success-label failure-label)
     2476  (p2-test-instanceof-predicate form +lisp-character+
     2477                                success-label failure-label))
    24452478
    24462479;; constantp form &optional environment => generalized-boolean
    2447 (defun p2-test-constantp (form)
     2480(defun p2-test-constantp (form success-label failure-label)
    24482481  (when (= (length form) 2)
    24492482    (let ((arg (%cadr form)))
    24502483      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    24512484      (emit-invokevirtual +lisp-object+ "constantp" nil :boolean)
    2452       'ifeq)))
    2453 
    2454 (defun p2-test-endp (form)
    2455   (p2-test-predicate form "endp"))
    2456 
    2457 (defmacro p2-test-integer-predicate (form predicate &body instructions)
     2485      (emit-test-jump 'ifeq success-label failure-label))))
     2486
     2487(defun p2-test-endp (form success-label failure-label)
     2488  (p2-test-predicate form "endp" success-label failure-label))
     2489
     2490(defmacro p2-test-integer-predicate ((form predicate
     2491                                           success-label failure-label)
     2492                                     &body instructions)
    24582493  (let ((tmpform (gensym)))
    24592494    `(let ((,tmpform ,form))
     
    24642499                  ,@instructions)
    24652500                 (t
    2466                   (p2-test-predicate ,tmpform ,predicate))))))))
    2467 
    2468 (defun p2-test-evenp (form)
    2469   (p2-test-integer-predicate form "evenp"
    2470                              (emit-push-constant-int 1)
    2471                              (emit 'iand)
    2472                              'ifne))
    2473 
    2474 (defun p2-test-oddp (form)
    2475   (p2-test-integer-predicate form "oddp"
    2476                              (emit-push-constant-int 1)
    2477                              (emit 'iand)
    2478                              'ifeq))
    2479 
    2480 (defun p2-test-floatp (form)
    2481   (p2-test-predicate form "floatp"))
    2482 
    2483 (defun p2-test-integerp (form)
    2484   (p2-test-predicate form "integerp"))
    2485 
    2486 (defun p2-test-listp (form)
     2501                  (p2-test-predicate ,tmpform ,predicate
     2502                                     ,success-label ,failure-label))))))))
     2503
     2504(defun p2-test-evenp (form success-label failure-label)
     2505  (p2-test-integer-predicate (form "evenp" success-label failure-label)
     2506    (emit-push-constant-int 1)
     2507    (emit 'iand)
     2508    (emit-test-jump 'ifne success-label failure-label)))
     2509
     2510(defun p2-test-oddp (form success-label failure-label)
     2511  (p2-test-integer-predicate (form "oddp" success-label failure-label)
     2512    (emit-push-constant-int 1)
     2513    (emit 'iand)
     2514    (emit-test-jump 'ifeq success-label failure-label)))
     2515
     2516(defun p2-test-floatp (form success-label failure-label)
     2517  (p2-test-predicate form "floatp" success-label failure-label))
     2518
     2519(defun p2-test-integerp (form success-label failure-label)
     2520  (p2-test-predicate form "integerp" success-label failure-label))
     2521
     2522(defun p2-test-listp (form success-label failure-label)
    24872523  (when (check-arg-count form 1)
    24882524    (let* ((arg (%cadr form))
     
    24952531             :alternate)
    24962532            (t
    2497              (p2-test-predicate form "listp"))))))
    2498 
    2499 (defun p2-test-minusp (form)
    2500   (p2-test-integer-predicate form "minusp" 'ifge))
    2501 
    2502 (defun p2-test-plusp (form)
    2503   (p2-test-integer-predicate form "plusp" 'ifle))
    2504 
    2505 (defun p2-test-zerop (form)
    2506   (p2-test-integer-predicate form "zerop" 'ifne))
    2507 
    2508 (defun p2-test-numberp (form)
    2509   (p2-test-predicate form "numberp"))
    2510 
    2511 (defun p2-test-packagep (form)
    2512   (p2-test-instanceof-predicate form +lisp-package+))
    2513 
    2514 (defun p2-test-rationalp (form)
    2515   (p2-test-predicate form "rationalp"))
    2516 
    2517 (defun p2-test-realp (form)
    2518   (p2-test-predicate form "realp"))
    2519 
    2520 (defun p2-test-special-operator-p (form)
    2521   (p2-test-predicate form "isSpecialOperator"))
    2522 
    2523 (defun p2-test-special-variable-p (form)
    2524   (p2-test-predicate form "isSpecialVariable"))
    2525 
    2526 (defun p2-test-symbolp (form)
    2527   (p2-test-instanceof-predicate form +lisp-symbol+))
    2528 
    2529 (defun p2-test-consp (form)
    2530   (p2-test-instanceof-predicate form +lisp-cons+))
    2531 
    2532 (defun p2-test-atom (form)
    2533   (p2-test-instanceof-predicate form +lisp-cons+)
    2534   'ifne)
    2535 
    2536 (defun p2-test-fixnump (form)
    2537   (p2-test-instanceof-predicate form +lisp-fixnum+))
    2538 
    2539 (defun p2-test-stringp (form)
    2540   (p2-test-instanceof-predicate form +lisp-abstract-string+))
    2541 
    2542 (defun p2-test-vectorp (form)
    2543   (p2-test-instanceof-predicate form +lisp-abstract-vector+))
    2544 
    2545 (defun p2-test-simple-vector-p (form)
    2546   (p2-test-instanceof-predicate form +lisp-simple-vector+))
     2533             (p2-test-predicate form "listp" success-label failure-label))))))
     2534
     2535(defun p2-test-minusp (form success-label failure-label)
     2536  (p2-test-integer-predicate (form "minusp"  success-label failure-label)
     2537    (emit-test-jump 'ifge success-label failure-label)))
     2538
     2539(defun p2-test-plusp (form success-label failure-label)
     2540  (p2-test-integer-predicate (form "plusp" success-label failure-label)
     2541    (emit-test-jump 'ifle success-label failure-label)))
     2542
     2543(defun p2-test-zerop (form success-label failure-label)
     2544  (p2-test-integer-predicate (form "zerop" success-label failure-label)
     2545    (emit-test-jump 'ifne success-label failure-label)))
     2546
     2547(defun p2-test-numberp (form success-label failure-label)
     2548  (p2-test-predicate form "numberp" success-label failure-label))
     2549
     2550(defun p2-test-packagep (form success-label failure-label)
     2551  (p2-test-instanceof-predicate form +lisp-package+
     2552                                success-label failure-label))
     2553
     2554(defun p2-test-rationalp (form success-label failure-label)
     2555  (p2-test-predicate form "rationalp" success-label failure-label))
     2556
     2557(defun p2-test-realp (form success-label failure-label)
     2558  (p2-test-predicate form "realp" success-label failure-label))
     2559
     2560(defun p2-test-special-operator-p (form success-label failure-label)
     2561  (p2-test-predicate form "isSpecialOperator" success-label failure-label))
     2562
     2563(defun p2-test-special-variable-p (form success-label failure-label)
     2564  (p2-test-predicate form "isSpecialVariable" success-label failure-label))
     2565
     2566(defun p2-test-symbolp (form success-label failure-label)
     2567  (p2-test-instanceof-predicate form +lisp-symbol+ success-label failure-label))
     2568
     2569(defun p2-test-consp (form success-label failure-label)
     2570  (p2-test-instanceof-predicate form +lisp-cons+ success-label failure-label))
     2571
     2572(defun p2-test-atom (form success-label failure-label)
     2573  ;; The test below is a negative test, so, reverse the labels for failure and success
     2574  (p2-test-instanceof-predicate form +lisp-cons+ failure-label success-label))
     2575
     2576(defun p2-test-fixnump (form success-label failure-label)
     2577  (p2-test-instanceof-predicate form +lisp-fixnum+ success-label failure-label))
     2578
     2579(defun p2-test-stringp (form success-label failure-label)
     2580  (p2-test-instanceof-predicate form +lisp-abstract-string+
     2581                                success-label failure-label))
     2582
     2583(defun p2-test-vectorp (form success-label failure-label)
     2584  (p2-test-instanceof-predicate form +lisp-abstract-vector+
     2585                                success-label failure-label))
     2586
     2587(defun p2-test-simple-vector-p (form success-label failure-label)
     2588  (p2-test-instanceof-predicate form +lisp-simple-vector+
     2589                                success-label failure-label))
    25472590
    25482591(defknown compile-test-form (t) t)
    2549 (defun compile-test-form (test-form)
     2592(defun compile-test-form (test-form success-label failure-label)
    25502593  (when (consp test-form)
    25512594    (let* ((op (%car test-form))
    25522595           (handler (p2-test-handler op))
    2553            (result (and handler (funcall handler test-form))))
     2596           (result (and handler (funcall handler test-form success-label
     2597                                         failure-label))))
    25542598      (when result
    25552599        (return-from compile-test-form result))))
    25562600  (cond ((eq test-form t)
    25572601         :consequent)
    2558         ((null test-form)
    2559          :alternate)
    25602602        ((eq (derive-compiler-type test-form) 'BOOLEAN)
    25612603         (compile-forms-and-maybe-emit-clear-values test-form 'stack :boolean)
    2562          'ifeq)
     2604         (emit-test-jump 'ifeq success-label failure-label))
    25632605        (t
    25642606         (compile-forms-and-maybe-emit-clear-values test-form 'stack nil)
    25652607         (emit-push-nil)
    2566          'if_acmpeq)))
    2567 
    2568 (defun p2-test-not/null (form)
     2608         (emit-test-jump 'if_acmpeq success-label failure-label))))
     2609
     2610(defun p2-test-not/null (form success-label failure-label)
    25692611  (when (check-arg-count form 1)
    25702612    (let* ((arg (%cadr form))
    2571            (result (compile-test-form arg)))
    2572       (ecase result
    2573         ('if_acmpeq  'if_acmpne)
    2574         ('if_acmpne  'if_acmpeq)
    2575         ('ifeq       'ifne)
    2576         ('ifne       'ifeq)
    2577         ('iflt       'ifge)
    2578         ('ifge       'iflt)
    2579         ('ifgt       'ifle)
    2580         ('ifle       'ifgt)
    2581         ('if_icmpeq  'if_icmpne)
    2582         ('if_icmpne  'if_icmpeq)
    2583         ('if_icmplt  'if_icmpge)
    2584         ('if_icmpge  'if_icmplt)
    2585         ('if_icmpgt  'if_icmple)
    2586         ('if_icmple  'if_icmpgt)
    2587         (:alternate  :consequent)
    2588         (:consequent :alternate)))))
    2589 
    2590 (defun p2-test-char= (form)
     2613           (result (compile-test-form arg failure-label success-label)))
     2614      (case result
     2615        (:consequent :alternate)
     2616        (:alternate :consequent)
     2617        (t result)))))
     2618
     2619(defun p2-test-char= (form success-label failure-label)
    25912620  (when (check-arg-count form 2)
    25922621    (let* ((arg1 (%cadr form))
     
    25962625            (compile-operand arg2 :char)
    25972626            (maybe-emit-clear-values arg1 arg2)))
    2598       'if_icmpne)))
    2599 
    2600 (defun p2-test-eq (form)
     2627      (emit-test-jump 'if_icmpne success-label failure-label))))
     2628
     2629(defun p2-test-eq (form success-label failure-label)
    26012630  (when (check-arg-count form 2)
    26022631    (let ((arg1 (%cadr form))
     
    26062635            (compile-operand arg2 nil)
    26072636            (maybe-emit-clear-values arg1 arg2)))
    2608      'if_acmpne)))
    2609 
    2610 (defun p2-test-and (form)
     2637      (emit-test-jump 'if_acmpne success-label failure-label))))
     2638
     2639(defun p2-test-or (form success-label failure-label)
     2640  (let ((args (cdr form)))
     2641    (case (length args)
     2642      (0
     2643       :alternate)
     2644      (1
     2645       (compile-test-form (%car args) success-label failure-label))
     2646      (t
     2647       (loop
     2648          with local-success-label = (or success-label (gensym))
     2649          for arg in args
     2650          for result = (compile-test-form arg local-success-label nil)
     2651          when (eq :consequent result)
     2652          do (progn
     2653               (emit 'goto local-success-label)
     2654               (loop-finish))
     2655          finally (progn
     2656                    (when failure-label
     2657                      (emit 'goto failure-label))
     2658                    (unless (eq success-label local-success-label)
     2659                      (label local-success-label))
     2660                    (return t)))))))
     2661
     2662(defun p2-test-and (form success-label failure-label)
    26112663  (let ((args (cdr form)))
    26122664    (case (length args)
     
    26142666       :consequent)
    26152667      (1
    2616        (compile-test-form (%car args)))
    2617       (2
    2618        (compile-form form 'stack :boolean)
    2619        'ifeq)
     2668       (compile-test-form (%car args) success-label failure-label))
    26202669      (t
    2621        (compile-forms-and-maybe-emit-clear-values form 'stack nil)
    2622        (emit-push-nil)
    2623        'if_acmpeq))))
    2624 
    2625 (defun p2-test-neq (form)
    2626   (p2-test-eq form)
    2627   'if_acmpeq)
    2628 
    2629 (defun p2-test-eql (form)
     2670       (loop
     2671          with local-fail-label = (or failure-label (gensym))
     2672          for arg in args
     2673          for result = (compile-test-form arg nil local-fail-label)
     2674          when (eq :alternate result)
     2675          do (progn
     2676               (emit 'goto local-fail-label)
     2677               (loop-finish))
     2678          finally (progn
     2679                    (when success-label
     2680                      (emit 'goto success-label))
     2681                    (unless (eq failure-label local-fail-label)
     2682                      (label local-fail-label))
     2683                    (return t)))))))
     2684
     2685(defun p2-test-neq (form success-label failure-label)
     2686  (p2-test-eq form failure-label success-label))
     2687
     2688(defun p2-test-eql (form success-label failure-label)
    26302689  (when (check-arg-count form 2)
    26312690    (let* ((arg1 (%cadr form))
     
    26382697                   (compile-operand arg2 :int)
    26392698                   (maybe-emit-clear-values arg1 arg2)))
    2640              'if_icmpne)
     2699             (emit-test-jump 'if_icmpne success-label failure-label))
    26412700            ((and (eq type1 'CHARACTER) (eq type2 'CHARACTER))
    26422701             (with-operand-accumulation
     
    26442703                   (compile-operand arg2 :char)
    26452704                   (maybe-emit-clear-values arg1 arg2)))
    2646              'if_icmpne)
     2705             (emit-test-jump 'if_icmpne success-label failure-label))
    26472706            ((eq type2 'CHARACTER)
    26482707             (with-operand-accumulation
     
    26512710                   (maybe-emit-clear-values arg1 arg2)))
    26522711             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
    2653              'ifeq)
     2712             (emit-test-jump 'ifeq success-label failure-label))
    26542713            ((eq type1 'CHARACTER)
    26552714             (with-operand-accumulation
     
    26592718             (emit 'swap)
    26602719             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
    2661              'ifeq)
     2720             (emit-test-jump 'ifeq success-label failure-label))
    26622721            ((fixnum-type-p type2)
    26632722             (with-operand-accumulation
     
    26662725                   (maybe-emit-clear-values arg1 arg2)))
    26672726             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
    2668              'ifeq)
     2727             (emit-test-jump 'ifeq success-label failure-label))
    26692728            ((fixnum-type-p type1)
    26702729             (with-operand-accumulation
     
    26742733             (emit 'swap)
    26752734             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
    2676              'ifeq)
     2735             (emit-test-jump 'ifeq success-label failure-label))
    26772736            (t
    26782737             (with-operand-accumulation
     
    26822741             (emit-invokevirtual +lisp-object+ "eql"
    26832742                                 (lisp-object-arg-types 1) :boolean)
    2684              'ifeq)))))
    2685 
    2686 (defun p2-test-equality (form)
     2743             (emit-test-jump 'ifeq success-label failure-label))))))
     2744
     2745(defun p2-test-equality (form success-label failure-label)
    26872746  (when (check-arg-count form 2)
    26882747    (let* ((op (%car form))
     
    27082767                                 translated-op
    27092768                                 (lisp-object-arg-types 1) :boolean)))
    2710       'ifeq)))
    2711 
    2712 (defun p2-test-simple-typep (form)
     2769      (emit-test-jump 'ifeq success-label failure-label))))
     2770
     2771(defun p2-test-simple-typep (form success-label failure-label)
    27132772  (when (check-arg-count form 2)
    27142773    (let ((arg1 (%cadr form))
     
    27212780                          (lisp-object-arg-types 1) +lisp-object+)
    27222781      (emit-push-nil)
    2723       'if_acmpeq)))
    2724 
    2725 (defun p2-test-memq (form)
     2782      (emit-test-jump 'if_acmpeq success-label failure-label))))
     2783
     2784(defun p2-test-memq (form success-label failure-label)
    27262785  (when (check-arg-count form 2)
    27272786    (let ((arg1 (%cadr form))
     
    27332792      (emit-invokestatic +lisp+ "memq"
    27342793                         (lisp-object-arg-types 2) :boolean)
    2735       'ifeq)))
    2736 
    2737 (defun p2-test-memql (form)
     2794      (emit-test-jump 'ifeq success-label failure-label))))
     2795
     2796(defun p2-test-memql (form success-label failure-label)
    27382797  (when (check-arg-count form 2)
    27392798    (let ((arg1 (%cadr form))
     
    27452804      (emit-invokestatic +lisp+ "memql"
    27462805                         (lisp-object-arg-types 2) :boolean)
    2747       'ifeq)))
    2748 
    2749 (defun p2-test-/= (form)
     2806      (emit-test-jump 'ifeq success-label failure-label))))
     2807
     2808(defun p2-test-/= (form success-label failure-label)
    27502809  (when (= (length form) 3)
    27512810    (let* ((arg1 (%cadr form))
     
    27612820                  (compile-operand arg2 :int)
    27622821                  (maybe-emit-clear-values arg1 arg2)))
    2763              'if_icmpeq)
     2822             (emit-test-jump 'if_icmpeq success-label failure-label))
    27642823            ((fixnum-type-p type2)
    27652824             (with-operand-accumulation
     
    27682827                  (maybe-emit-clear-values arg1 arg2)))
    27692828             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
    2770              'ifeq)
     2829             (emit-test-jump 'ifeq success-label failure-label))
    27712830            ((fixnum-type-p type1)
    27722831             ;; FIXME Compile the args in reverse order and avoid the swap if
     
    27782837             (emit 'swap)
    27792838             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
    2780              'ifeq)
     2839             (emit-test-jump 'ifeq success-label failure-label))
    27812840            (t
    27822841             (with-operand-accumulation
     
    27862845             (emit-invokevirtual +lisp-object+ "isNotEqualTo"
    27872846                                 (lisp-object-arg-types 1) :boolean)
    2788              'ifeq)))))
    2789 
    2790 (defun p2-test-numeric-comparison (form)
     2847             (emit-test-jump 'ifeq success-label failure-label))))))
     2848
     2849(defun p2-test-numeric-comparison (form success-label failure-label)
    27912850  (when (check-min-args form 1)
    27922851    (when (= (length form) 3)
     
    28042863                  (compile-operand arg2 :int)
    28052864                  (maybe-emit-clear-values arg1 arg2)))
    2806                (ecase op
    2807                  (<  'if_icmpge)
    2808                  (<= 'if_icmpgt)
    2809                  (>  'if_icmple)
    2810                  (>= 'if_icmplt)
    2811                  (=  'if_icmpne)))
     2865               (emit-test-jump (ecase op
     2866                                 (<  'if_icmpge)
     2867                                 (<= 'if_icmpgt)
     2868                                 (>  'if_icmple)
     2869                                 (>= 'if_icmplt)
     2870                                 (=  'if_icmpne))
     2871                                success-label failure-label))
    28122872              ((and (java-long-type-p type1) (java-long-type-p type2))
    28132873               (with-operand-accumulation
     
    28162876                  (maybe-emit-clear-values arg1 arg2)))
    28172877               (emit 'lcmp)
    2818                (ecase op
    2819                  (<  'ifge)
    2820                  (<= 'ifgt)
    2821                  (>  'ifle)
    2822                  (>= 'iflt)
    2823                  (=  'ifne)))
     2878               (emit-test-jump (ecase op
     2879                                 (<  'ifge)
     2880                                 (<= 'ifgt)
     2881                                 (>  'ifle)
     2882                                 (>= 'iflt)
     2883                                 (=  'ifne))
     2884                                success-label failure-label))
    28242885              ((fixnum-type-p type2)
    28252886               (with-operand-accumulation
     
    28352896                                     (=  "isEqualTo"))
    28362897                                   '(:int) :boolean)
    2837                'ifeq)
     2898               (emit-test-jump 'ifeq success-label failure-label))
    28382899              ((fixnum-type-p type1)
    28392900               ;; FIXME We can compile the args in reverse order and avoid
     
    28522913                                     (=  "isEqualTo"))
    28532914                                   '(:int) :boolean)
    2854                'ifeq)
     2915               (emit-test-jump 'ifeq success-label failure-label))
    28552916              (t
    28562917               (with-operand-accumulation
     
    28662927                                     (=  "isEqualTo"))
    28672928                                   (lisp-object-arg-types 1) :boolean)
    2868                'ifeq))))))
    2869 
    2870 (defknown p2-if-or (t t t) t)
    2871 (defun p2-if-or (form target representation)
    2872   (let* ((test (second form))
    2873          (consequent (third form))
    2874          (alternate (fourth form))
    2875          (LABEL1 (gensym))
    2876          (LABEL2 (gensym)))
    2877     (aver (and (consp test) (eq (car test) 'OR)))
    2878     (let* ((args (cdr test)))
    2879       (case (length args)
    2880         (0
    2881          (compile-form alternate target representation))
    2882         (1
    2883          (p2-if (list 'IF (%car args) consequent alternate) target representation))
    2884         (t
    2885          (dolist (arg args)
    2886            (cond ((and (consp arg) (eq (first arg) 'EQ))
    2887                   ;; ERROR CHECKING HERE!
    2888                   (let ((arg1 (second arg))
    2889                         (arg2 (third arg)))
    2890                     (with-operand-accumulation
    2891                          ((compile-operand arg1 nil)
    2892                           (compile-operand arg2 nil)
    2893                           (maybe-emit-clear-values arg1 arg2)))
    2894                     (emit 'if_acmpeq LABEL1)))
    2895                  ((eq (derive-compiler-type arg) 'BOOLEAN)
    2896                   (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    2897                   (emit 'ifne LABEL1))
    2898                  (t
    2899                   (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    2900                   (emit-push-nil)
    2901                   (emit 'if_acmpne LABEL1))))
    2902          (compile-form alternate target representation)
    2903          (emit 'goto LABEL2)
    2904          (label LABEL1)
    2905          (compile-form consequent target representation)
    2906          (label LABEL2))))))
    2907 
    2908 (defknown p2-if-and (t t t) t)
    2909 (defun p2-if-and (form target representation)
    2910   (let* ((test (second form))
    2911          (consequent (third form))
    2912          (alternate (fourth form))
    2913          (LABEL1 (gensym))
    2914          (LABEL2 (gensym)))
    2915     (aver (and (consp test) (eq (car test) 'AND)))
    2916     (let* ((args (cdr test)))
    2917       (case (length args)
    2918         (0
    2919          (compile-form consequent target representation))
    2920         (1
    2921          (p2-if (list 'IF (%car args) consequent alternate) target representation))
    2922         (t
    2923          (dolist (arg args)
    2924            (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    2925            (emit 'ifeq LABEL1))
    2926          (compile-form consequent target representation)
    2927          (emit 'goto LABEL2)
    2928          (label LABEL1)
    2929          (compile-form alternate target representation)
    2930          (label LABEL2))))))
    2931 
    2932 (defknown p2-if-not-and (t t t) t)
    2933 (defun p2-if-not-and (form target representation)
    2934   (let* ((inverted-test (second (second form)))
    2935          (consequent (third form))
    2936          (alternate (fourth form))
    2937          (LABEL1 (gensym))
    2938          (LABEL2 (gensym)))
    2939     (let* ((args (cdr inverted-test)))
    2940       (case (length args)
    2941         (0
    2942          (compile-form alternate target representation))
    2943         (1
    2944          (p2-if (list 'IF (%car args) alternate consequent) target representation))
    2945         (t
    2946          (dolist (arg args)
    2947            (let ((type (derive-compiler-type arg)))
    2948              (cond ((eq type 'BOOLEAN)
    2949                     (compile-forms-and-maybe-emit-clear-values arg 'stack :boolean)
    2950                     (emit 'ifeq LABEL1))
    2951                    (t
    2952                     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    2953                     (emit-push-nil)
    2954                     (emit 'if_acmpeq LABEL1)))))
    2955          (compile-form alternate target representation)
    2956          (emit 'goto LABEL2)
    2957          (label LABEL1)
    2958          (compile-form consequent target representation)
    2959          (label LABEL2))))))
     2929               (emit-test-jump 'ifeq success-label failure-label)))))))
    29602930
    29612931(defknown p2-if (t t t) t)
     
    29662936         (LABEL1 (gensym))
    29672937         (LABEL2 (gensym)))
    2968     (cond ((eq test t)
    2969            (compile-form consequent target representation))
    2970           ((null test)
    2971            (compile-form alternate target representation))
    2972           ((numberp test)
    2973            (compile-form consequent target representation))
    2974           ((equal (derive-compiler-type test) +true-type+)
    2975            (compile-forms-and-maybe-emit-clear-values test nil nil)
    2976            (compile-form consequent target representation))
    2977           ((and (consp test) (eq (car test) 'OR))
    2978            (p2-if-or form target representation))
    2979           ((and (consp test) (eq (car test) 'AND))
    2980            (p2-if-and form target representation))
    2981           ((and (consp test)
    2982                 (memq (first test) '(NOT NULL))
    2983                 (consp (second test))
    2984                 (eq (first (second test)) 'AND))
    2985            (p2-if-not-and form target representation))
    2986           (t
    2987            (let ((result (compile-test-form test)))
    2988              (case result
    2989                (:consequent
    2990                 (compile-form consequent target representation))
    2991                (:alternate
    2992                 (compile-form alternate target representation))
    2993                (t
    2994                 (emit result LABEL1)
    2995                 (compile-form consequent target representation)
    2996                 (emit 'goto LABEL2)
    2997                 (label LABEL1)
    2998                 (compile-form alternate target representation)
    2999                 (label LABEL2))))))))
     2938    (let ((result (compile-test-form test nil LABEL1)))
     2939      (case result
     2940        (:consequent
     2941         (compile-form consequent target representation))
     2942        (:alternate
     2943         (compile-form alternate target representation))
     2944        (t
     2945         (compile-form consequent target representation)
     2946         (emit 'goto LABEL2)
     2947         (label LABEL1)
     2948         (compile-form alternate target representation)
     2949         (label LABEL2))))))
    30002950
    30012951(defun compile-multiple-value-list (form target representation)
Note: See TracChangeset for help on using the changeset viewer.