Changeset 11602


Ignore:
Timestamp:
01/29/09 20:23:51 (13 years ago)
Author:
ehuelsmann
Message:

Implement generic type-representation derivations and conversions;
shorten P2-MINUS and P2-PLUS implementations by using them.

File:
1 edited

Legend:

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

    r11601 r11602  
    499499      (setf pretty-string (concatenate 'string pretty-string "[]")))
    500500    pretty-string))
     501
     502(defvar type-representations '((:int fixnum)
     503                               (:long (integer #.most-negative-java-long
     504                                               #.most-positive-java-long))
     505                               (:float single-float)
     506                               (:double double-float)
     507                               (:char base-char character)
     508                               (:boolean boolean)
     509                               )
     510  "Lists the widest Lisp types to be stored in each of the Java primitives
     511supported (and used) by the compiler.")
     512
     513(defun type-representation (the-type)
     514  "Converts a type specification or compiler type into a representation."
     515  (do* ((types type-representations (cdr types)))
     516       ((endp types) nil)
     517    (do* ((type-list (cdr (car types)) (cdr type-list))
     518          (type (car type-list) (car type-list)))
     519         ((endp type-list))
     520      (when (or (subtypep the-type type)
     521                (compiler-subtypep the-type (make-compiler-type type)))
     522        (return-from type-representation (caar types))))))
    501523
    502524;;                     source type /
     
    68326854               arg2 nil nil)
    68336855              (emit-move-from-stack target representation))
    6834              ((and (fixnum-type-p type1) (fixnum-type-p type2))
    6835         (fixnum-result-plus/minus target representation result-type
    6836           arg1 arg2 'iadd 'ladd))
    6837              ((and (java-long-type-p type1)
    6838                    (java-long-type-p type2)
    6839                    (java-long-type-p result-type))
    6840               (cond ((fixnum-type-p type1)
    6841                      (compile-form arg1 'stack :int)
    6842                      (emit 'i2l))
     6856             (result-rep
     6857              (compile-forms-and-maybe-emit-clear-values
     6858                        arg1 'stack result-rep
     6859                        arg2 'stack result-rep)
     6860              (emit (case result-rep
     6861                      (:int 'iadd)
     6862                      (:long 'ladd)
     6863                      (:float 'fadd)
     6864                      (:double 'dadd)
    68436865                      (t
    6844                      (compile-form arg1 'stack :long)))
    6845               (cond ((fixnum-type-p type2)
    6846                      (compile-form arg2 'stack :int)
    6847                      (emit 'i2l))
    6848                     (t
    6849                      (compile-form arg2 'stack :long)))
    6850               (maybe-emit-clear-values arg1 arg2)
    6851               (emit 'ladd)
    6852               (convert-representation :long representation)
     6866                       (sys::format
     6867                        t "p2-plus: Unexpected result-rep ~S for form ~S."
     6868                        result-rep form)
     6869                       (assert nil))))
     6870              (convert-representation result-rep representation)
    68536871              (emit-move-from-stack target representation))
    68546872             ((eql arg2 1)
     
    68816899    (2
    68826900     (let* ((arg (%cadr form))
    6883             (type (derive-compiler-type arg)))
    6884        (cond ((eql (fixnum-constant-value type) 0)
    6885               (case representation
    6886                 (:int
    6887                  (emit 'iconst_0))
    6888                 (:long
    6889                  (emit 'lconst_0))
    6890                 (t
    6891                  (emit 'getstatic +lisp-fixnum-class+ "ZERO" +lisp-fixnum+)))
     6901            (type (derive-compiler-type form))
     6902            (type-rep (type-representation type)))
     6903       (cond ((numberp arg)
     6904              (compile-constant (- arg) 'stack representation)
    68926905              (emit-move-from-stack target representation))
    6893              ((and (fixnum-type-p type)
    6894                    (integer-type-low type)
    6895                    (> (integer-type-low type) most-negative-fixnum))
    6896         (new-fixnum (null representation))
    6897               (compile-form arg 'stack :int)
    6898               (emit 'ineg)
    6899         (emit-fixnum-init representation)
    6900               (emit-move-from-stack target representation))
    6901              ((and (java-long-type-p type)
    6902                    (integer-type-low type)
    6903                    (> (integer-type-low type) most-negative-java-long))
    6904               (compile-form arg 'stack :long)
    6905               (emit 'lneg)
    6906               (case representation
    6907                 (:int
    6908                  (emit 'l2i))
    6909                 (:long)
     6906             (type-rep
     6907              (compile-form arg 'stack type-rep)
     6908              (emit (case type-rep
     6909                      (:int    'ineg)
     6910                      (:long   'lneg)
     6911                      (:float  'fneg)
     6912                      (:double 'dneg)
    69106913                      (t
    6911                  (convert-representation :long nil)))
     6914                       (sys::format t
     6915                                    "p2-minus: unsupported rep (~S) for '~S'~%"
     6916                                    type-rep form)
     6917                       (assert nil))))
     6918              (convert-representation type-rep representation)
    69126919              (emit-move-from-stack target representation))
    69136920             (t
     
    69216928            (arg1 (first args))
    69226929            (arg2 (second args))
    6923             (type1 (derive-compiler-type arg1))
    69246930            (type2 (derive-compiler-type arg2))
    6925             (result-type (derive-compiler-type form)))
     6931            (result-type (derive-compiler-type form))
     6932            (result-rep (type-representation result-type)))
    69266933       (cond ((and (numberp arg1) (numberp arg2))
    69276934              (compile-constant (- arg1 arg2) target representation))
    6928              ((and (fixnum-type-p type1) (fixnum-type-p type2))
    6929         (fixnum-result-plus/minus target representation result-type
    6930           arg1 arg2 'isub 'lsub))
    6931              ((and (java-long-type-p type1) (java-long-type-p type2)
    6932                    (java-long-type-p result-type))
    6933         (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
    6934                arg2 'stack :long)
    6935               (emit 'lsub)
    6936               (convert-representation :long representation)
     6935             (result-rep
     6936        (compile-forms-and-maybe-emit-clear-values
     6937                        arg1 'stack result-rep
     6938                        arg2 'stack result-rep)
     6939              (emit (case result-rep
     6940                      (:int 'isub)
     6941                      (:long 'lsub)
     6942                      (:float 'fsub)
     6943                      (:double 'dsub)
     6944                      (t
     6945                       (sys::%format t "p2-minus sub-instruction (rep: ~S); form: ~S~%"
     6946                                     result-rep form)
     6947                       (assert nil))))
     6948              (convert-representation result-rep representation)
    69376949              (emit-move-from-stack target representation))
    69386950             ((fixnum-type-p type2)
Note: See TracChangeset for help on using the changeset viewer.