Changeset 12188


Ignore:
Timestamp:
10/10/09 17:55:32 (12 years ago)
Author:
ehuelsmann
Message:

Fix cl-bench BENCH-STRINGS/ADJUSTABLE:

We can't unbox variables which are in the argument array,
because all variables need to have the same type.

File:
1 edited

Legend:

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

    r12186 r12188  
    41504150  (when type-supplied-p
    41514151    (setf (variable-declared-type variable) type))
     4152  (when (or (variable-closure-index variable)
     4153            (variable-index variable))
     4154    ;; variables in one of the arrays cannot be represented
     4155    ;; other than by the boxed representation LispObject
     4156    (return-from derive-variable-representation))
    41524157  (let ((type (variable-declared-type variable)))
    41534158    (when (and (eq (variable-declared-type variable) :none)
    41544159               (eql (variable-writes variable) 0))
    4155       (setf type (variable-derived-type variable)))
     4160      (variable-derived-type variable))
    41564161    (cond ((neq type :none)
    41574162           (setf (variable-representation variable)
     
    41974202(defun emit-move-to-variable (variable)
    41984203  (let ((representation (variable-representation variable)))
    4199     (flet ((emit-array-store (representation)
    4200              (emit (ecase representation
    4201                      ((:int :boolean :char)
    4202                               'iastore)
    4203                      (:long   'lastore)
    4204                      (:float  'fastore)
    4205                      (:double 'dastore)
    4206                      ((nil)   'aastore)))))
    4207       (cond ((variable-register variable)
    4208              (emit (ecase (variable-representation variable)
    4209                      ((:int :boolean :char)
    4210                               'istore)
    4211                      (:long   'lstore)
    4212                      (:float  'fstore)
    4213                      (:double 'dstore)
    4214                      ((nil)   'astore))
    4215                    (variable-register variable)))
    4216             ((variable-index variable)
    4217              (aload (compiland-argument-register *current-compiland*))
    4218              (emit-swap representation nil)
    4219              (emit-push-constant-int (variable-index variable))
    4220              (emit-swap representation :int)
    4221              (emit-array-store (variable-representation variable)))
    4222             ((variable-closure-index variable)
    4223              (aload (compiland-closure-register *current-compiland*))
    4224              (emit-push-constant-int (variable-closure-index variable))
    4225              (emit 'aaload)
    4226              (emit-swap representation nil)
    4227              (emit 'putfield +closure-binding-class+ "value" +lisp-object+))
    4228             ((variable-environment variable)
    4229              (assert (not *file-compilation*))
    4230              (emit 'getstatic *this-class*
    4231                    (declare-object (variable-environment variable)
    4232                                    +lisp-environment+
    4233                                    +lisp-environment-class+)
    4234                    +lisp-environment+)
    4235              (emit 'swap)
    4236              (emit-push-variable-name variable)
    4237              (emit 'swap)
    4238              (emit-invokevirtual +lisp-environment-class+ "rebind"
    4239                                  (list +lisp-symbol+ +lisp-object+)
    4240                                  nil))
    4241             (t
    4242              (assert nil))))))
    4243 
    4244 (defun emit-push-variable (variable)
    4245   (flet ((emit-array-load (representation)
    4246            (emit (ecase representation
    4247                        ((:int :boolean :char)
    4248                                 'iaload)
    4249                        (:long   'laload)
    4250                        (:float  'faload)
    4251                        (:double 'daload)
    4252                        ((nil)   'aaload)))))
    42534204    (cond ((variable-register variable)
    42544205           (emit (ecase (variable-representation variable)
    4255                        ((:int :boolean :char)
    4256                                 'iload)
    4257                        (:long   'lload)
    4258                        (:float  'fload)
    4259                        (:double 'dload)
    4260                        ((nil)   'aload))
     4206                   ((:int :boolean :char)
     4207                    'istore)
     4208                   (:long   'lstore)
     4209                   (:float  'fstore)
     4210                   (:double 'dstore)
     4211                   ((nil)   'astore))
    42614212                 (variable-register variable)))
    42624213          ((variable-index variable)
    42634214           (aload (compiland-argument-register *current-compiland*))
     4215           (emit-swap representation nil)
    42644216           (emit-push-constant-int (variable-index variable))
    4265            (emit-array-load (variable-representation variable)))
     4217           (emit-swap representation :int)
     4218           (emit 'aastore))
    42664219          ((variable-closure-index variable)
    42674220           (aload (compiland-closure-register *current-compiland*))
    42684221           (emit-push-constant-int (variable-closure-index variable))
    42694222           (emit 'aaload)
    4270            (emit 'getfield +closure-binding-class+ "value" +lisp-object+))
     4223           (emit-swap representation nil)
     4224           (emit 'putfield +closure-binding-class+ "value" +lisp-object+))
    42714225          ((variable-environment variable)
    42724226           (assert (not *file-compilation*))
     
    42764230                                 +lisp-environment-class+)
    42774231                 +lisp-environment+)
     4232           (emit 'swap)
    42784233           (emit-push-variable-name variable)
    4279            (emit-invokevirtual +lisp-environment-class+ "lookup"
    4280                                (list +lisp-object+)
    4281                                +lisp-object+))
     4234           (emit 'swap)
     4235           (emit-invokevirtual +lisp-environment-class+ "rebind"
     4236                               (list +lisp-symbol+ +lisp-object+)
     4237                               nil))
    42824238          (t
    42834239           (assert nil)))))
     4240
     4241(defun emit-push-variable (variable)
     4242  (cond ((variable-register variable)
     4243         (emit (ecase (variable-representation variable)
     4244                 ((:int :boolean :char)
     4245                  'iload)
     4246                 (:long   'lload)
     4247                 (:float  'fload)
     4248                 (:double 'dload)
     4249                 ((nil)   'aload))
     4250               (variable-register variable)))
     4251        ((variable-index variable)
     4252         (aload (compiland-argument-register *current-compiland*))
     4253         (emit-push-constant-int (variable-index variable))
     4254         (emit 'aaload))
     4255        ((variable-closure-index variable)
     4256         (aload (compiland-closure-register *current-compiland*))
     4257         (emit-push-constant-int (variable-closure-index variable))
     4258         (emit 'aaload)
     4259         (emit 'getfield +closure-binding-class+ "value" +lisp-object+))
     4260        ((variable-environment variable)
     4261         (assert (not *file-compilation*))
     4262         (emit 'getstatic *this-class*
     4263               (declare-object (variable-environment variable)
     4264                               +lisp-environment+
     4265                               +lisp-environment-class+)
     4266               +lisp-environment+)
     4267         (emit-push-variable-name variable)
     4268         (emit-invokevirtual +lisp-environment-class+ "lookup"
     4269                             (list +lisp-object+)
     4270                             +lisp-object+))
     4271        (t
     4272         (assert nil))))
    42844273
    42854274
Note: See TracChangeset for help on using the changeset viewer.