Changeset 11592


Ignore:
Timestamp:
01/26/09 21:02:42 (13 years ago)
Author:
ehuelsmann
Message:

Generic representation conversion (from one JVM type to another) and boxing (JVM type to LispObject) support.

Removes EMIT-BOX-* and CONVERT-* functions as they're now part of the generic framework.

File:
1 edited

Legend:

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

    r11588 r11592  
    499499    pretty-string))
    500500
     501;;                     source type /
     502;;                         targets   :boolean :char    :int :long :float :double
     503(defvar rep-conversion '((:boolean . #( NIL    :err    :err  :err  :err   :err))
     504                         (:char    . #(  1     NIL     :err  :err  :err   :err))
     505                         (:int     . #(  1     :err     NIL  i2l   i2f    i2d))
     506                         (:long    . #(  1     :err     l2i  NIL   l2f    l2d))
     507                         (:float   . #(  1     :err    :err  :err  NIL    f2d))
     508                         (:double  . #(  1     :err    :err  :err  d2f    NIL)))
     509  "Contains a table with operations to be performed to do
     510internal representation conversion.")
     511
     512(defvar rep-classes
     513  '((:boolean  #.+lisp-object-class+        #.+lisp-object+)
     514    (:char     #.+lisp-character-class+     #.+lisp-character+)
     515    (:int      #.+lisp-integer-class+       #.+lisp-integer+)
     516    (:long     #.+lisp-integer-class+       #.+lisp-integer+)
     517    (:float    #.+lisp-single-float-class+  #.+lisp-single-float+)
     518    (:double   #.+lisp-double-float-class+  #.+lisp-double-float+))
     519  "Lists the class on which to call the `getInstance' method on,
     520when converting the internal representation to a LispObject.")
     521
     522(defvar rep-arg-chars
     523  '((:boolean . "Z")
     524    (:char    . "C")
     525    (:int     . "I")
     526    (:long    . "J")
     527    (:float   . "F")
     528    (:double  . "D"))
     529  "Lists the argument type identifiers for each
     530of the internal representations.")
     531
     532(defun convert-representation (in out)
     533  "Converts the value on the stack in the `in' representation
     534to a value on the stack in the `out' representation."
     535  (when (null out)
     536    ;; Convert back to a lisp object
     537    (when in
     538      (let ((class (cdr (assoc in rep-classes)))
     539            (arg-spec (cdr (assoc in rep-arg-chars))))
     540        (emit-invokestatic (first class) "getInstance" (list arg-spec)
     541                           (second class))))
     542    (return-from convert-representation))
     543  (let* ((in-map (cdr (assoc in rep-conversion)))
     544         (op-num (position out '(:boolean :char :int :long :float :double)))
     545         (op (aref in-map op-num)))
     546    (when op
     547      ;; Convert from one internal representation into another
     548      (assert (neq op :err))
     549      (if (eql op 1)
     550          (progn
     551            (emit-move-from-stack nil in)
     552            (emit 'iconst_1))
     553          (emit op)))))
     554
    501555(declaim (ftype (function t string) pretty-java-class))
    502556(defun pretty-java-class (class)
     
    820874         (emit-invokevirtual +lisp-object-class+ "doubleValue" nil "D"))
    821875        (t (assert nil))))
    822 
    823 (defknown emit-box-int () t)
    824 (defun emit-box-int ()
    825   (declare (optimize speed))
    826   (new-fixnum)
    827   (emit 'dup_x1)
    828   (emit-fixnum-init nil))
    829 
    830 (defknown emit-box-long () t)
    831 (defun emit-box-long ()
    832   (declare (optimize speed))
    833   (emit-invokestatic +lisp-class+ "number" '("J") +lisp-object+))
    834 
    835 (defknown emit-box-float () t)
    836 (defun emit-box-float ()
    837   (emit 'new +lisp-single-float-class+)
    838   (emit 'dup_x1)
    839   (emit-invokespecial-init +lisp-single-float-class+ '("F")))
    840 
    841 (defknown emit-box-double () t)
    842 (defun emit-box-double ()
    843   (emit 'new +lisp-double-float-class+)
    844   (emit 'dup_x2)
    845   (emit-invokespecial-init +lisp-double-float-class+ '("D")))
    846 
    847 (defknown convert-long (t) t)
    848 (defun convert-long (representation)
    849   (case representation
    850     (:int
    851      (emit 'l2i))
    852     (:long)
    853     (t
    854      (emit-box-long))))
    855 
    856 (defknown emit-box-boolean () t)
    857 (defun emit-box-boolean ()
    858   (let ((LABEL1 (gensym))
    859         (LABEL2 (gensym)))
    860     (emit 'ifeq LABEL1)
    861     (emit-push-t)
    862     (emit 'goto LABEL2)
    863     (label LABEL1)
    864     (emit-push-nil)
    865     (label LABEL2)))
    866876
    867877(defknown emit-move-from-stack (t &optional t) t)
     
    52605270                 ((zerop constant-shift)
    52615271                  (compile-form arg2 nil nil))) ; for effect
    5262            (convert-long representation)
     5272           (convert-representation :long representation)
    52635273           (emit-move-from-stack target representation))
    52645274          ((and (fixnum-type-p type1)
     
    52785288                   arg2 'stack :int)
    52795289                  (emit 'lshl)
    5280                   (convert-long representation))
     5290                  (convert-representation :long representation))
    52815291                 ((and low2 high2 (<= -63 low2 high2 0) ; Negative shift.
    52825292                       (java-long-type-p type1)
     
    52865296                  (emit 'ineg)
    52875297                  (emit 'lshr)
    5288                   (convert-long representation))
     5298                  (convert-representation :long representation))
    52895299                 (t
    52905300;;                   (format t "p2-ash call to LispObject.ash(int)~%")
     
    53615371                  (:long)
    53625372                  (t
    5363                    (emit-box-long)))
     5373                   (convert-representation :long nil)))
    53645374                (emit-move-from-stack target representation))
    53655375               ((or (and (java-long-type-p type1)
     
    53765386                  (:long)
    53775387                  (t
    5378                    (emit-box-long)))
     5388                   (convert-representation :long nil)))
    53795389                (emit-move-from-stack target representation))
    53805390               ((fixnum-type-p type2)
     
    54525462                 arg2 'stack :long)
    54535463                (emit 'lor)
    5454                 (convert-long representation)
     5464                (convert-representation :long representation)
    54555465                (emit-move-from-stack target representation))
    54565466               ((fixnum-type-p type2)
     
    55195529                 arg2 'stack :long)
    55205530                (emit 'lxor)
    5521                 (convert-long representation))
     5531                (convert-representation :long representation))
    55225532               ((fixnum-type-p type2)
    55235533    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
     
    56045614                         (emit-push-constant-long (1- (expt 2 size))) ; mask
    56055615                         (emit 'land)
    5606                          (convert-long representation)))
     5616                         (convert-representation :long representation)))
    56075617                  (emit-move-from-stack target representation))
    56085618                 (t
     
    66526662  (maybe-emit-clear-values arg1 arg2)
    66536663  (emit instruction)
    6654   (convert-long representation))
     6664  (convert-representation :long representation))
    66556665
    66566666(defun p2-times (form target representation)
     
    66836693                       (emit-invokespecial-init +lisp-fixnum-class+ '("I"))
    66846694                       (fix-boxing representation 'fixnum)))
    6685                     (t
     6695                      (t
    66866696         (two-long-ints-times/plus/minus
    66876697          arg1 arg2 'lmul representation)))
     
    66936703               arg2 'stack :long)
    66946704              (emit 'lmul)
    6695               (convert-long representation)
     6705              (convert-representation :long representation)
    66966706              (emit-move-from-stack target representation))
    66976707             ((fixnump arg2)
     
    67286738                 (type2 (derive-compiler-type arg2)))
    67296739             (cond ((and (fixnum-type-p type1) (fixnum-type-p type2))
    6730                     (new-fixnum (null representation))
    6731                     (compile-form arg1 'stack :int)
    6732                     (emit 'dup)
    6733                     (compile-form arg2 'stack :int)
     6740          (new-fixnum (null representation))
     6741                      (compile-form arg1 'stack :int)
     6742                      (emit 'dup)
     6743                      (compile-form arg2 'stack :int)
    67346744                    (emit 'dup_x1)
    67356745                    (let ((LABEL1 (gensym)))
    67366746                      (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1)
    67376747                      (emit 'swap)  ;; The lower stack value is greater-or-equal
    6738                       (label LABEL1)
     6748                        (label LABEL1)
    67396749                      (emit 'pop))  ;; Throw away the lower stack value
    67406750        (emit-fixnum-init representation)
    67416751                    (emit-move-from-stack target representation))
    67426752                   ((and (java-long-type-p type1) (java-long-type-p type2))
    6743                     (compile-form arg1 'stack :long)
    6744                     (emit 'dup2)
    6745                     (compile-form arg2 'stack :long)
     6753                      (compile-form arg1 'stack :long)
     6754                      (emit 'dup2)
     6755                      (compile-form arg2 'stack :long)
    67466756                    (emit 'dup2_x2)
    6747                     (emit 'lcmp)
     6757                      (emit 'lcmp)
    67486758                    (let ((LABEL1 (gensym)))
    67496759                      (emit (if (eq op 'max) 'ifge 'ifle) LABEL1)
    67506760                      (emit 'dup2_x2) ;; pour-mans swap2
    67516761                      (emit 'pop2)
    6752                       (label LABEL1)
     6762                        (label LABEL1)
    67536763                      (emit 'pop2))
    6754                     (convert-long representation)
     6764                    (convert-representation :long representation)
    67556765                    (emit-move-from-stack target representation))
    67566766                   (t
     
    67646774                                            "isGreaterThanOrEqualTo")
    67656775                                        (lisp-object-arg-types 1) "Z")
    6766                       (let ((LABEL1 (gensym)))
    6767                         (emit 'ifeq LABEL1)
    6768                         (emit 'swap)
    6769                         (label LABEL1)
    6770                         (emit 'pop))
     6776                    (let ((LABEL1 (gensym)))
     6777                      (emit 'ifeq LABEL1)
     6778                      (emit 'swap)
     6779                      (label LABEL1)
     6780                      (emit 'pop))
    67716781                    (fix-boxing representation nil)
    67726782                    (emit-move-from-stack target representation))))))
     
    68326842              (maybe-emit-clear-values arg1 arg2)
    68336843              (emit 'ladd)
    6834               (convert-long representation)
     6844              (convert-representation :long representation)
    68356845              (emit-move-from-stack target representation))
    68366846             ((eql arg2 1)
     
    68916901                (:long)
    68926902                (t
    6893                  (emit-box-long)))
     6903                 (convert-representation :long nil)))
    68946904              (emit-move-from-stack target representation))
    68956905             (t
     
    69166926               arg2 'stack :long)
    69176927              (emit 'lsub)
    6918               (convert-long representation)
     6928              (convert-representation :long representation)
    69196929              (emit-move-from-stack target representation))
    69206930             ((fixnum-type-p type2)
     
    75497559                   (t
    75507560                    (emit 'lload (variable-register variable))
    7551                     (emit-box-long)))
     7561                    (convert-representation :long nil)))
    75527562                 (emit-move-from-stack target representation))
    75537563                ((eq (variable-representation variable) :boolean)
     
    75587568                   (:boolean)
    75597569                   (t
    7560                     (emit-box-boolean)))
     7570                    (convert-representation :boolean nil)))
    75617571                 (emit-move-from-stack target representation))
    75627572                ((variable-register variable)
     
    77767786               (:long)
    77777787               (t
    7778                 (emit-box-long)))
     7788                (convert-representation :long nil)))
    77797789             (emit-move-from-stack target representation)))
    77807790          ((eq (variable-representation variable) :boolean)
     
    77887798               (:boolean)
    77897799               (t
    7790                 (emit-box-boolean)))
     7800                (convert-representation :boolean nil)))
    77917801             (emit-move-from-stack target representation)))
    77927802          (t
Note: See TracChangeset for help on using the changeset viewer.