Changeset 11620


Ignore:
Timestamp:
02/03/09 22:07:06 (13 years ago)
Author:
ehuelsmann
Message:

Kill long code repetitions in COMPILE-VAR-REF and P2-SETQ

  • making the resulting ones more generic.
File:
1 edited

Legend:

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

    r11619 r11620  
    412412    (t (emit 'ldc2_w (pool-double n)))))
    413413
     414(defknown emit-dup (symbol) t)
     415(defun emit-dup (representation)
     416  (ecase (representation-size representation)
     417    (1 (emit 'dup))
     418    (2 (emit 'dup2))))
     419
     420(defknown emit-swap (symbol symbol) t)
     421(defun emit-swap (rep1 rep2)
     422  "Swaps 2 values on the stack,
     423the top-most value's representation being 'rep1'."
     424  (let ((r1-size (representation-size rep1))
     425        (r2-size (representation-size rep2)))
     426    (cond ((and (= 1 r1-size)
     427                (= 1 r2-size))
     428           (emit 'swap))
     429          ((and (= 1 r1-size)
     430                (= 2 r2-size))
     431           (emit 'dup2_x1)
     432           (emit 'pop2))
     433          ((and (= 2 r1-size)
     434                (= 1 r2-size))
     435           (emit 'dup_x2)
     436           (emit 'pop))
     437          ((and (= 2 r1-size)
     438                (= 2 r2-size))
     439           (emit 'dup2_x2)
     440           (emit 'pop2)))))
     441
    414442(declaim (ftype (function (t t) cons) make-descriptor-info))
    415443(defun make-descriptor-info (arg-types return-type)
     
    529557    ((:long :double) 2)))
    530558
     559
     560(defknown emit-unbox-boolean () t)
     561(defun emit-unbox-boolean ()
     562  (emit 'instanceof +lisp-nil-class+)
     563  (emit 'iconst_1)
     564  (emit 'ixor))  ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit
     565
     566(defknown emit-unbox-character () t)
     567(defun emit-unbox-character ()
     568  (cond ((> *safety* 0)
     569         (emit-invokestatic +lisp-character-class+ "getValue"
     570                            (lisp-object-arg-types 1) "C"))
     571        (t
     572         (emit 'checkcast +lisp-character-class+)
     573         (emit 'getfield +lisp-character-class+ "value" "C"))))
     574
    531575;;                     source type /
    532576;;                         targets   :boolean :char    :int :long :float :double
    533 (defvar rep-conversion '((:boolean . #( NIL    :err    :err  :err  :err   :err))
     577(defvar rep-conversion `((NIL      . #( ,#'emit-unbox-boolean
     578                                        ,#'emit-unbox-character
     579                                       "intValue" "longValue"
     580                                       "floatValue" "doubleValue"))
     581                         (:boolean . #( NIL    :err    :err  :err  :err   :err))
    534582                         (:char    . #(  1     NIL     :err  :err  :err   :err))
    535583                         (:int     . #(  1     :err     NIL  i2l   i2f    i2d))
     
    577625      ;; Convert from one internal representation into another
    578626      (assert (neq op :err))
    579       (if (eql op 1)
    580           (progn
    581             (emit-move-from-stack nil in)
    582             (emit 'iconst_1))
    583           (emit op)))))
     627      (cond ((eql op 1)
     628             (emit-move-from-stack nil in)
     629             (emit 'iconst_1))
     630            ((functionp op)
     631             (funcall op))
     632            ((stringp op)
     633             (emit-invokevirtual +lisp-object-class+ op nil
     634                                 (cdr (assoc out rep-arg-chars))))
     635            (t
     636             (emit op))))))
    584637
    585638(defvar common-representations '((:int :long :long)
     
    859912         (emit 'getfield +lisp-fixnum-class+ "value" "I"))))
    860913
    861 (defknown emit-unbox-character () t)
    862 (defun emit-unbox-character ()
    863   (cond ((> *safety* 0)
    864          (emit-invokestatic +lisp-character-class+ "getValue"
    865                             (lisp-object-arg-types 1) "C"))
    866         (t
    867          (emit 'checkcast +lisp-character-class+)
    868          (emit 'getfield +lisp-character-class+ "value" "C"))))
    869 
    870914(defknown emit-unbox-long () t)
    871915(defun emit-unbox-long ()
     
    892936         (emit 'checkcast +lisp-double-float-class+)
    893937         (emit 'getfield +lisp-double-float-class+ "value" "D"))))
    894 
    895 (defknown emit-unbox-boolean () t)
    896 (defun emit-unbox-boolean ()
    897   (emit 'instanceof +lisp-nil-class+)
    898   (emit 'iconst_1)
    899   (emit 'ixor))  ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit
    900938
    901939(defknown fix-boxing (t t) t)
     
    42404278
    42414279(defun emit-move-to-variable (variable)
     4280  (let ((representation (variable-representation variable)))
     4281    (flet ((emit-array-store (representation)
     4282             (emit (or (case representation
     4283                         ((:int :boolean :char)
     4284                                  'iastore)
     4285                         (:long   'lastore)
     4286                         (:float  'fastore)
     4287                         (:double 'dastore))
     4288                       'aastore))))
     4289      (cond ((variable-register variable)
     4290             (emit (or (case (variable-representation variable)
     4291                         ((:int :boolean :char)
     4292                                  'istore)
     4293                         (:long   'lstore)
     4294                         (:float  'fstore)
     4295                         (:double 'dstore))
     4296                       'astore)
     4297                   (variable-register variable)))
     4298            ((variable-index variable)
     4299             (aload (compiland-argument-register *current-compiland*))
     4300             (emit-swap representation nil)
     4301             (emit-push-constant-int (variable-index variable))
     4302             (emit-swap representation :int)
     4303             (emit-array-store (variable-representation variable)))
     4304            ((variable-closure-index variable)
     4305             (aload (compiland-closure-register *current-compiland*))
     4306             (emit-swap representation nil)
     4307             (emit-push-constant-int (variable-closure-index variable))
     4308             (emit-swap representation :int)
     4309             (emit-array-store (variable-representation variable)))
     4310            (t
     4311             ;;###FIXME: We might want to address the "temp-register" case too.
     4312             (assert nil))))))
     4313
     4314(defun emit-push-variable (variable)
    42424315  (flet ((emit-array-store (representation)
    42434316           (emit (or (case representation
    42444317                       ((:int :boolean :char)
    4245                                 'iastore)
    4246                        (:long   'lastore)
    4247                        (:float  'fastore)
    4248                        (:double 'dastore))
    4249                    'aastore))))
     4318                                'iaload)
     4319                       (:long   'laload)
     4320                       (:float  'faload)
     4321                       (:double 'daload))
     4322                   'aaload))))
    42504323    (cond ((variable-register variable)
    42514324           (emit (or (case (variable-representation variable)
    42524325                       ((:int :boolean :char)
    4253                                 'istore)
    4254                        (:long   'lstore)
    4255                        (:float  'fstore)
    4256                        (:double 'dstore))
    4257                      'astore)
     4326                                'iload)
     4327                       (:long   'lload)
     4328                       (:float  'fload)
     4329                       (:double 'dload))
     4330                     'aload)
    42584331                 (variable-register variable)))
    42594332          ((variable-index variable)
     
    75377610          (cond ((variable-special-p variable)
    75387611                 (compile-special-reference (variable-name variable) target representation))
    7539                 ((eq (variable-representation variable) :int)
    7540                  (aver (variable-register variable))
    7541                  (emit 'iload (variable-register variable))
    7542                  (convert-representation :int representation)
    7543                  (emit-move-from-stack target representation))
    7544                 ((eq (variable-representation variable) :char)
    7545                  (aver (variable-register variable))
    7546                  (emit 'iload (variable-register variable))
    7547                  (convert-representation :char representation)
    7548                  (emit-move-from-stack target representation))
    7549                 ((eq (variable-representation variable) :long)
    7550                  (aver (variable-register variable))
    7551                  (emit 'lload (variable-register variable))
    7552                  (convert-representation :long representation)
    7553                  (emit-move-from-stack target representation))
    7554                 ((eq (variable-representation variable) :boolean)
    7555                  (aver (variable-register variable))
    7556                  (aver (or (null representation) (eq representation :boolean)))
    7557                  (emit 'iload (variable-register variable))
    7558                  (convert-representation :boolean representation)
    7559                  (emit-move-from-stack target representation))
    7560                 ((variable-register variable)
    7561                  (aload (variable-register variable))
    7562                  (fix-boxing representation (variable-derived-type variable))
    7563                  (emit-move-from-stack target representation))
    7564                 ((variable-closure-index variable)
    7565                  (aver (not (null (compiland-closure-register *current-compiland*))))
    7566                  (aload (compiland-closure-register *current-compiland*))
    7567                  (emit-push-constant-int (variable-closure-index variable))
    7568                  (emit 'aaload)
    7569                  (fix-boxing representation (derive-type ref))
    7570                  (emit-move-from-stack target representation))
    7571                 ((variable-index variable)
    7572                  (aver (not (null (compiland-argument-register *current-compiland*))))
    7573                  (aload (compiland-argument-register *current-compiland*))
    7574                  (emit-push-constant-int (variable-index variable))
    7575                  (emit 'aaload)
    7576                  (fix-boxing representation (variable-derived-type variable))
     7612                ((or (variable-representation variable)
     7613                     (variable-register variable)
     7614                     (variable-closure-index variable)
     7615                     (variable-index variable))
     7616                 (emit-push-variable variable)
     7617                 (convert-representation (variable-representation variable)
     7618                                         representation)
    75777619                 (emit-move-from-stack target representation))
    75787620                (t
     
    77017743             (convert-representation :int representation)
    77027744             (emit-move-from-stack target representation)))
    7703           ((eq (variable-representation variable) :int)
    7704            (dformat t "p2-setq :int case value-form = ~S~%"
    7705                     value-form)
    7706      (compile-forms-and-maybe-emit-clear-values value-form 'stack :int)
    7707            (when target
    7708              (emit 'dup))
    7709            (emit 'istore (variable-register variable))
    7710            (when target
    7711              ;; int on stack here
    7712              (convert-representation :int representation)
    7713              (emit-move-from-stack target representation)))
    7714           ((eq (variable-representation variable) :char)
    7715            (dformat t "p2-setq :char case~%")
    7716      (compile-forms-and-maybe-emit-clear-values value-form 'stack :char)
    7717            (when target
    7718              (emit 'dup))
    7719            (emit 'istore (variable-register variable))
    7720            (when target
    7721              ;; char on stack here
    7722              (convert-representation :char representation)
    7723              (emit-move-from-stack target representation)))
    7724           ((eq (variable-representation variable) :long)
    7725      (compile-forms-and-maybe-emit-clear-values value-form 'stack :long)
    7726            (when target
    7727              (emit 'dup2))
    7728            (emit 'lstore (variable-register variable))
    7729            (when target
    7730              ;; long on stack here
    7731              (convert-representation :long representation)
    7732              (emit-move-from-stack target representation)))
    7733           ((eq (variable-representation variable) :boolean)
    7734      (compile-forms-and-maybe-emit-clear-values value-form 'stack :boolean)
    7735            (when target
    7736              (emit 'dup))
    7737            (emit 'istore (variable-register variable))
    7738            (when target
    7739              ;; int on stack here
    7740              (convert-representation :boolean representation)
    7741              (emit-move-from-stack target representation)))
    77427745          (t
    7743      (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
    7744            (when target
    7745              (emit 'dup))
    7746            (emit 'var-set variable)
    7747            (when target
    7748              (fix-boxing representation nil)
    7749              (emit-move-from-stack target representation))))))
     7746           (let ((rep (variable-representation variable)))
     7747             (dformat t "p2-setq ~A case value-form = ~S~%" rep value-form)
     7748             (compile-forms-and-maybe-emit-clear-values value-form 'stack rep)
     7749             (when target
     7750               (emit-dup rep))
     7751             (emit-move-to-variable variable)
     7752             (when target
     7753               (convert-representation rep representation)
     7754               (emit-move-from-stack target representation)))))))
    77507755
    77517756(defun p2-sxhash (form target representation)
Note: See TracChangeset for help on using the changeset viewer.