Changeset 11608


Ignore:
Timestamp:
01/31/09 14:00:58 (12 years ago)
Author:
ehuelsmann
Message:

Support inline comparisons for many types of compiler types (including single and double floats).

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r11607 r11608  
    577577            (emit 'iconst_1))
    578578          (emit op)))))
     579
     580(defvar common-representations '((:int :long :long)
     581                                 (:int :float :double)
     582                                 (:int :double :double)
     583                                 (:float :int :double)
     584                                 (:float :double :double)
     585                                 (:double :int :double)
     586                                 (:double :float :double))
     587  "Representations to convert unequal representations to, in order
     588to get the correct (exact where required) comparisons.")
     589
     590(defun common-representation (rep1 rep2)
     591  (when (eq rep1 rep2)
     592    (return-from common-representation rep1))
     593  (do* ((remaining common-representations (cdr remaining))
     594        (rep (car remaining) (car remaining)))
     595       ((endp remaining))
     596    (destructuring-bind
     597          (r1 r2 result) rep
     598      (when (and (eq rep1 r1) (eq rep2 r2))
     599        (return-from common-representation result)))))
     600
     601
    579602
    580603(declaim (ftype (function t string) pretty-java-class))
     
    10951118                 136 ; l2i
    10961119                 148 ; lcmp
     1120                 149 ; fcmpd
     1121                 150 ; fcmpg
     1122                 151 ; dcmpd
     1123                 152 ; dcmpg
    10971124                 153 ; ifeq
    10981125                 154 ; ifne
     
    31863213  t)
    31873214
     3215
     3216;;                            <        <=         >        >=         =
     3217(defvar comparison-ops '(< <= > >= =))
     3218(defvar comparison-ins
     3219  '((:int  . #(if_icmpge if_icmpgt if_icmple if_icmplt if_icmpne))
     3220    (:long . #((lcmp ifge) (lcmp ifgt) (lcmp ifle)
     3221               (lcmp iflt) (lcmp ifne)))
     3222    (:float . #((fcmpg ifge) (fcmpg ifgt) (fcmpl ifle)
     3223                (fcmpl iflt) (fcmpl ifne)))
     3224    (:double . #((dcmpg ifge) (dcmpg ifgt) (dcmpl ifle)
     3225                 (dcmpl iflt) (dcmpl ifne))))
     3226  "Instructions to be generated upon each comparison operation,
     3227given a specific common representation.")
     3228
     3229
    31883230;; Note that /= is not transitive, so we don't handle it here.
    31893231(defknown p2-numeric-comparison (t t t) t)
     
    31973239              (arg2 (%cadr args))
    31983240              (type1 (derive-compiler-type arg1))
    3199               (type2 (derive-compiler-type arg2)))
     3241              (type2 (derive-compiler-type arg2))
     3242              (common-rep (common-representation (type-representation type1)
     3243                                                 (type-representation type2))))
    32003244         (cond ((and (integerp arg1) (integerp arg2))
    32013245                (let ((result (funcall op arg1 arg2)))
     
    32053249                (emit-move-from-stack target representation)
    32063250                (return-from p2-numeric-comparison))
    3207                ((and (fixnum-type-p type1)
    3208                      (fixnum-type-p type2))
     3251               (common-rep
    32093252                (let ((LABEL1 (gensym))
    32103253                      (LABEL2 (gensym)))
    3211       (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    3212                    arg2 'stack :int)
    3213                   (emit (case op
    3214                           (<  'if_icmpge)
    3215                           (<= 'if_icmpgt)
    3216                           (>  'if_icmple)
    3217                           (>= 'if_icmplt)
    3218                           (=  'if_icmpne))
    3219                         LABEL1)
    3220                   (emit-push-true representation)
    3221                   (emit 'goto LABEL2)
    3222                   (label LABEL1)
    3223                   (emit-push-false representation)
    3224                   (label LABEL2))
    3225                 (emit-move-from-stack target representation)
    3226                 (return-from p2-numeric-comparison))
    3227                ((and (java-long-type-p type1)
    3228                      (java-long-type-p type2))
    3229                 (let ((LABEL1 (gensym))
    3230                       (LABEL2 (gensym)))
    3231       (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
    3232                    arg2 'stack :long)
    3233                   (emit 'lcmp)
    3234                   (emit (case op
    3235                           (<  'ifge)
    3236                           (<= 'ifgt)
    3237                           (>  'ifle)
    3238                           (>= 'iflt)
    3239                           (=  'ifne))
    3240                         LABEL1)
     3254      (compile-forms-and-maybe-emit-clear-values
     3255                          arg1 'stack common-rep
     3256                          arg2 'stack common-rep)
     3257                  (let* ((pos (position op comparison-ops))
     3258                         (ops-table (cdr (assoc common-rep comparison-ins)))
     3259                         (ops (aref ops-table pos)))
     3260                    (if (listp ops)
     3261                        (progn
     3262                          (emit (car ops))
     3263                          (emit (cadr ops) LABEL1))
     3264                        (emit ops LABEL1)))
    32413265                  (emit-push-true representation)
    32423266                  (emit 'goto LABEL2)
  • trunk/abcl/src/org/armedbear/lisp/opcodes.lisp

    r11600 r11608  
    202202(define-opcode i2s 147 1 nil)
    203203(define-opcode lcmp 148 1 -3)
    204 (define-opcode fcmpl 149 1 nil)
    205 (define-opcode fcmpg 150 1 nil)
    206 (define-opcode dcmpl 151 1 nil)
    207 (define-opcode dcmpg 152 1 nil)
     204(define-opcode fcmpl 149 1 -1)
     205(define-opcode fcmpg 150 1 -1)
     206(define-opcode dcmpl 151 1 -2)
     207(define-opcode dcmpg 152 1 -2)
    208208(define-opcode ifeq 153 3 -1)
    209209(define-opcode ifne 154 3 -1)
Note: See TracChangeset for help on using the changeset viewer.