Changeset 11648


Ignore:
Timestamp:
02/08/09 22:45:55 (12 years ago)
Author:
ehuelsmann
Message:

Strict checking of representations delivered vs requested - inspired by Ville's find: r11646.

File:
1 edited

Legend:

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

    r11646 r11648  
    350350(defun emit-push-false (representation)
    351351  (declare (optimize speed (safety 0)))
    352   (case representation
     352  (ecase representation
    353353    (:boolean
    354354     (emit 'iconst_0))
    355     (t
     355    ((nil)
    356356     (emit-push-nil))))
    357357
     
    359359(defun emit-push-true (representation)
    360360  (declare (optimize speed (safety 0)))
    361   (case representation
     361  (ecase representation
    362362    (:boolean
    363363     (emit 'iconst_1))
    364     (t
     364    ((nil)
    365365     (emit-push-t))))
    366366
     
    976976  (declare (optimize speed))
    977977  (cond ((null target)
    978          (case representation
     978         (ecase representation
    979979           ((:long :double)
    980980            (emit 'pop2))
    981            (t
     981           ((NIL :int :boolean :char :float)
    982982            (emit 'pop))))
    983983        ((eq target 'stack)) ; Nothing to do.
     
    985985         ;; A register.
    986986         (emit
    987           (case representation
     987          (ecase representation
    988988            ((:int :boolean :char)
    989989             'istore)
     
    994994            (:double
    995995             'dstore)
    996             (t
     996            ((nil)
    997997             'astore))
    998998          target))
     
    23812381  (unless target
    23822382    (return-from compile-constant))
    2383   (case representation
     2383  (ecase representation
    23842384    (:int
    23852385     (cond ((fixnump form)
     
    24392439            (assert nil)))
    24402440     (emit-move-from-stack target representation)
    2441      (return-from compile-constant)))
     2441     (return-from compile-constant))
     2442    ((NIL)))
    24422443  (cond ((fixnump form)
    24432444         (let ((translation (case form
     
    25692570           (let ((arg (cadr form)))
    25702571       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    2571              (case representation
     2572             (ecase representation
    25722573               (:boolean
    25732574                (emit-invokevirtual +lisp-object-class+
    25742575                                    unboxed-method-name
    25752576                                    nil "Z"))
    2576                (t
     2577               ((NIL)
    25772578                (emit-invokevirtual +lisp-object-class+
    25782579                                    boxed-method-name
     
    27522753     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    27532754                  arg2 'stack nil)
    2754            (case representation
     2755           (ecase representation
    27552756             (:boolean
    27562757              (emit-invokevirtual +lisp-object-class+ "eql"
    27572758                                  (lisp-object-arg-types 1) "Z"))
    2758              (t
     2759             ((NIL)
    27592760              (emit-invokevirtual +lisp-object-class+ "EQL"
    27602761                                  (lisp-object-arg-types 1) +lisp-object+)))))
     
    42594260  (let ((representation (variable-representation variable)))
    42604261    (flet ((emit-array-store (representation)
    4261              (emit (or (case representation
    4262                          ((:int :boolean :char)
    4263                                   'iastore)
    4264                          (:long   'lastore)
    4265                          (:float  'fastore)
    4266                          (:double 'dastore))
    4267                        'aastore))))
     4262             (emit (ecase representation
     4263                     ((:int :boolean :char)
     4264                              'iastore)
     4265                     (:long   'lastore)
     4266                     (:float  'fastore)
     4267                     (:double 'dastore)
     4268                     ((nil)   'aastore)))))
    42684269      (cond ((variable-register variable)
    4269              (emit (or (case (variable-representation variable)
    4270                          ((:int :boolean :char)
    4271                                   'istore)
    4272                          (:long   'lstore)
    4273                          (:float  'fstore)
    4274                          (:double 'dstore))
    4275                        'astore)
     4270             (emit (ecase (variable-representation variable)
     4271                     ((:int :boolean :char)
     4272                              'istore)
     4273                     (:long   'lstore)
     4274                     (:float  'fstore)
     4275                     (:double 'dstore)
     4276                     ((nil)   'astore))
    42764277                   (variable-register variable)))
    42774278            ((variable-index variable)
     
    42934294(defun emit-push-variable (variable)
    42944295  (flet ((emit-array-store (representation)
    4295            (emit (or (case representation
     4296           (emit (ecase representation
    42964297                       ((:int :boolean :char)
    42974298                                'iaload)
    42984299                       (:long   'laload)
    42994300                       (:float  'faload)
    4300                        (:double 'daload))
    4301                    'aaload))))
     4301                       (:double 'daload)
     4302                       ((nil)   'aaload)))))
    43024303    (cond ((variable-register variable)
    4303            (emit (or (case (variable-representation variable)
     4304           (emit (ecase (variable-representation variable)
    43044305                       ((:int :boolean :char)
    43054306                                'iload)
    43064307                       (:long   'lload)
    43074308                       (:float  'fload)
    4308                        (:double 'dload))
    4309                      'aload)
     4309                       (:double 'dload)
     4310                       ((nil)   'aload))
    43104311                 (variable-register variable)))
    43114312          ((variable-index variable)
     
    46504651        (LABEL2 (gensym)))
    46514652    (emit 'ifeq LABEL1)
    4652     (case representation
     4653    (ecase representation
    46534654      (:boolean
    46544655       (emit 'iconst_0))
    4655       (t
     4656      ((nil)
    46564657       (emit-push-nil)))
    46574658    (emit 'goto LABEL2)
    46584659    (label LABEL1)
    4659     (case representation
     4660    (ecase representation
    46604661      (:boolean
    46614662       (emit 'iconst_1))
    4662       (t
     4663      ((nil)
    46634664       (emit-push-t)))
    46644665    (label LABEL2)
     
    57195720                 (LABEL2 (gensym)))
    57205721             (emit 'ifne LABEL1)
    5721              (case representation
     5722             (ecase representation
    57225723               (:boolean
    57235724                (emit 'iconst_1))
    5724                (t
     5725               ((nil)
    57255726                (emit-push-t)))
    57265727             (emit 'goto LABEL2)
    57275728             (label LABEL1)
    5728              (case representation
     5729             (ecase representation
    57295730               (:boolean
    57305731                (emit 'iconst_0))
    5731                (t
     5732               ((nil)
    57325733                (emit-push-nil)))
    57335734             (label LABEL2)
     
    65906591  (let ((arg (cadr form)))
    65916592    (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    6592     (case representation
     6593    (ecase representation
    65936594      (:int
    65946595       (emit-invokevirtual +lisp-object-class+ "length" nil "I"))
     
    66046605       (sys::%format t "p2-length: :char case~%")
    66056606       (aver nil))
    6606       (t
     6607      ((nil)
    66076608       (emit-invokevirtual +lisp-object-class+ "LENGTH" nil +lisp-object+)))
    66086609    (emit-move-from-stack target representation)))
     
    71187119            (arg2 (%caddr form))
    71197120            (type1 (derive-compiler-type arg1)))
    7120        (case representation
     7121       (ecase representation
    71217122         (:int
    71227123    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    71237124                 arg2 'stack :int)
    71247125          (emit-invokevirtual +lisp-object-class+ "aref" '("I") "I"))
    7125          ((:long :float :double)
     7126         (:long
    71267127    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    71277128                 arg2 'stack :int)
    7128           (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J")
    7129           (when (or (eq representation :float)
    7130                     (eq representation :double))
    7131             (convert-represenation :long representation)))
     7129          (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J"))
    71327130         (:char
    71337131          (cond ((compiler-subtypep type1 'string)
     
    71437141                 (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    71447142                 (emit-unbox-character))))
    7145          (t
     7143         ((nil :float :double :boolean)
     7144          ;;###FIXME for float and double, we probably want
     7145          ;; separate java methods to retrieve the values.
    71467146    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    71477147                 arg2 'stack :int)
    71487148          (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
    7149           (fix-boxing representation nil)))
     7149          (convert-representation nil representation)))
    71507150       (emit-move-from-stack target representation)))
    71517151    (t
     
    72497249     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
    72507250           (emit-push-constant-int arg2)
    7251            (case representation
     7251           (ecase representation
    72527252             (:int
    72537253              (emit-invokevirtual +lisp-object-class+ "getFixnumSlotValue"
    72547254                                  '("I") "I"))
    7255              (:long
     7255             ((nil :char :long :float :double)
    72567256              (emit-invokevirtual +lisp-object-class+ "getSlotValue"
    72577257                                  '("I") +lisp-object+)
    7258               (emit-invokevirtual +lisp-object-class+ "longValue"
    7259                                   nil "J"))
    7260              (:char
    7261               (emit-invokevirtual +lisp-object-class+ "getSlotValue"
    7262                                   '("I") +lisp-object+)
    7263               (emit-unbox-character))
     7258              ;; (convert-representation NIL NIL) is a no-op
     7259              (convert-representation nil representation))
    72647260             (:boolean
    72657261              (emit-invokevirtual +lisp-object-class+ "getSlotValueAsBoolean"
    7266                                   '("I") "Z"))
    7267              (t
    7268               (emit-invokevirtual +lisp-object-class+ "getSlotValue"
    7269                                   '("I") +lisp-object+)))
     7262                                  '("I") "Z")))
    72707263           (emit-move-from-stack target representation))
    72717264          (t
     
    73937386   (compile-forms-and-maybe-emit-clear-values arg1 'stack :boolean)
    73947387         (emit 'ifeq FAIL)
    7395          (case representation
     7388         (ecase representation
    73967389           (:boolean
    73977390      (compile-forms-and-maybe-emit-clear-values arg2 'stack :boolean)
     
    73997392            (label FAIL)
    74007393            (emit 'iconst_0))
    7401            (t
     7394           ((nil)
    74027395            (compile-form arg2 'stack nil)
    74037396            (emit 'goto DONE)
     
    80128005                (emit-move-from-stack target representation))
    80138006               ((keywordp form)
    8014                 (case representation
     8007                (ecase representation
    80158008                  (:boolean
    80168009                   (emit 'iconst_1))
    8017                   (t
     8010                  ((nil)
    80188011                   (let ((name (lookup-known-keyword form)))
    80198012                     (if name
Note: See TracChangeset for help on using the changeset viewer.