Changeset 13159


Ignore:
Timestamp:
01/19/11 22:02:41 (11 years ago)
Author:
ehuelsmann
Message:

Further transition to unsafety detection in pass2.

Location:
branches/unsafe-p-removal/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r13158 r13159  
    11531153(defvar *pass2-unsafe-p-special-treatment-functions*
    11541154  '(
    1155 
    1156      char-code
    1157      java:jclass
    1158      java:jconstructor
    1159      java:jmethod
    1160      char=
    11611155     coerce-to-function
    11621156     cons
    11631157     sys::backq-cons
    1164      delete
    1165      elt
    11661158     find-class
    1167      funcall
    1168      function
    1169      gensym
    1170      get
    1171      getf
    1172      gethash
    1173      gethash1
    1174      sys::%length
    11751159     list
    11761160     sys::backq-list
     
    11831167     logxor
    11841168     max
    1185      memq
    1186      memql
    11871169     min
    11881170     mod
    1189      not
    1190      null
    1191      or
    1192      puthash
    1193      read-line
    11941171       stream-element-type
    1195        sxhash
    1196        symbol-name
    1197        symbol-package
    1198        symbol-value
    11991172       truncate
    1200        values
    1201        vector-push-extend
    1202        write-8-bits
    12031173)
    12041174"The functions named in the list bound to this variable
  • branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r13158 r13159  
    17821782                (arg1 (first args))
    17831783                (arg2 (second args)))
    1784            (compile-form arg1 'stack nil)
    1785            (compile-form arg2 'stack nil)
     1784           (with-operand-accumulation
     1785               ((compile-operand arg1 nil)
     1786                (compile-operand arg2 nil)
     1787                (maybe-emit-clear-values arg1 arg2)))
    17861788           (emit-invokestatic +lisp+ "memq"
    17871789                              (lisp-object-arg-types 2) :boolean)
     
    17981800                (arg2 (second args))
    17991801                (type1 (derive-compiler-type arg1)))
    1800            (compile-form arg1 'stack nil)
    1801            (compile-form arg2 'stack nil)
     1802           (with-operand-accumulation
     1803               ((compile-operand arg1 nil)
     1804                (compile-operand arg2 nil)
     1805                (maybe-emit-clear-values arg1 arg2)))
    18021806           (cond ((eq type1 'SYMBOL) ; FIXME
    18031807                  (emit-invokestatic +lisp+ "memq"
     
    18271831    (case (length args)
    18281832      ((2 3)
    1829        (compile-form arg1 'stack nil)
    1830        (compile-form arg2 'stack nil)
    1831        (cond ((null arg3)
    1832               (maybe-emit-clear-values arg1 arg2))
    1833              (t
    1834               (compile-form arg3 'stack nil)
    1835               (maybe-emit-clear-values arg1 arg2 arg3)))
     1833       (with-operand-accumulation
     1834           ((compile-operand arg1 nil)
     1835            (compile-operand arg2 nil)
     1836            (when arg3
     1837              (compile-operand arg3 nil))
     1838            (maybe-emit-clear-values arg1 arg2 arg3)))
    18361839       (emit-invokestatic +lisp+ "get"
    18371840                          (lisp-object-arg-types (if arg3 3 2))
     
    18531856             (arg2 (second args))
    18541857             (arg3 (third args)))
    1855          (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    1856                                                     arg2 'stack nil
    1857                                                     arg3 'stack nil)
     1858       (with-operand-accumulation
     1859           ((compile-operand arg1 nil)
     1860            (compile-operand arg2 nil)
     1861            (compile-operand arg3 nil)
     1862            (maybe-emit-clear-values arg1 arg2 arg3)))
    18581863         (emit-invokestatic +lisp+ "getf"
    18591864                            (lisp-object-arg-types 3) +lisp-object+)
     
    18701875         (let ((key-form (%cadr form))
    18711876               (ht-form (%caddr form)))
    1872            (compile-form ht-form 'stack nil)
    1873            (emit-checkcast +lisp-hash-table+)
    1874            (compile-form key-form 'stack nil)
    1875            (maybe-emit-clear-values ht-form key-form)
     1877           (with-operand-accumulation
     1878               ((compile-operand ht-form nil +lisp-hash-table+)
     1879                (compile-operand key-form nil)
     1880                (maybe-emit-clear-values ht-form key-form)))
    18761881           (emit-invokevirtual +lisp-hash-table+ "gethash1"
    18771882                               (lisp-object-arg-types 1) +lisp-object+)
     
    18881893               (ht-form (%caddr form))
    18891894               (value-form (fourth form)))
    1890            (compile-form ht-form 'stack nil)
    1891            (emit-checkcast +lisp-hash-table+)
    1892            (compile-form key-form 'stack nil)
    1893            (compile-form value-form 'stack nil)
    1894            (maybe-emit-clear-values ht-form key-form value-form)
     1895           (with-operand-accumulation
     1896               ((compile-operand ht-form nil +lisp-hash-table+)
     1897                (compile-operand key-form nil)
     1898                (compile-operand value-form nil)
     1899                (maybe-emit-clear-values ht-form key-form value-form)))
    18951900           (cond (target
    18961901                  (emit-invokevirtual +lisp-hash-table+ "puthash"
     
    48114816    (case arg-count
    48124817      (2
    4813        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
    4814                                                   arg2 'stack nil)
     4818       (with-operand-accumulation
     4819           ((compile-operand arg1 nil)
     4820            (compile-operand arg2 nil)))
     4821       (maybe-emit-clear-values arg1 arg2)
    48154822       (emit 'swap)
    48164823       (cond (target
     
    48884895    (cond ((and (compiler-subtypep type1 '(UNSIGNED-BYTE 8))
    48894896                (eq type2 'STREAM))
    4890            (compile-form arg1 'stack :int)
    4891            (compile-form arg2 'stack nil)
    4892            (emit-checkcast +lisp-stream+)
     4897           (with-operand-accumulation
     4898               ((compile-operand arg1 :int)
     4899                (compile-operand arg2 nil +lisp-stream+)))
    48934900           (maybe-emit-clear-values arg1 arg2)
    48944901           (emit 'swap)
     
    48984905             (emit-move-from-stack target)))
    48994906          ((fixnum-type-p type1)
    4900            (compile-form arg1 'stack :int)
    4901            (compile-form arg2 'stack nil)
     4907           (with-operand-accumulation
     4908               ((compile-operand arg1 :int)
     4909                (compile-operand arg2 nil)))
    49024910           (maybe-emit-clear-values arg1 arg2)
    49034911           (emit-invokestatic +lisp+ "writeByte"
     
    54795487             (test (if (memq type1 '(SYMBOL NULL)) 'eq 'eql)))
    54805488        (cond ((subtypep type2 'VECTOR)
    5481                (compile-form arg1 'stack nil)
    5482                (compile-form arg2 'stack nil)
    5483                (emit-checkcast +lisp-abstract-vector+)
     5489               (with-operand-accumulation
     5490                    ((compile-operand arg1 nil)
     5491                     (compile-operand arg2 nil +lisp-abstract-vector+)))
    54845492               (maybe-emit-clear-values arg1 arg2)
    54855493               (emit 'swap)
     
    59515959              (fixnum-type-p (derive-compiler-type (third form)))
    59525960              (neq representation :char)) ; FIXME
    5953          (compile-form (second form) 'stack nil)
    5954          (compile-form (third form) 'stack :int)
     5961         (with-operand-accumulation
     5962              ((compile-operand (second form) nil)
     5963               (compile-operand (third form) :int)
     5964               (maybe-emit-clear-values (second form) (third form))))
    59555965         (emit-invokevirtual +lisp-object+ "elt" '(:int) +lisp-object+)
    59565966         (fix-boxing representation nil) ; FIXME use derived result type
     
    62896299                (emit 'dup))
    62906300               (t
    6291                 (compile-form arg1 'stack nil)
    6292                 (compile-form arg2 'stack nil))))
     6301                (with-operand-accumulation
     6302                   ((compile-operand arg1 nil)
     6303                    (compile-operand arg2 nil)
     6304                    (maybe-emit-clear-values arg1 arg2))))))
    62936305       (emit-invokevirtual +lisp-thread+
    62946306                           "setValues"
     
    62986310       (emit-move-from-stack target))
    62996311      ((3 4)
    6300        (emit-push-current-thread)
    6301        (dolist (arg args)
    6302          (compile-form arg 'stack nil))
     6312       (with-operand-accumulation
     6313           ((emit-thread-operand)
     6314            (dolist (arg args)
     6315              (compile-operand arg nil))))
     6316       (when (notevery #'single-valued-p args)
     6317         (emit-clear-values))
    63036318       (emit-invokevirtual +lisp-thread+
    63046319                           "setValues"
     
    66976712        (return-from p2-char=))
    66986713      (cond ((characterp arg1)
    6699              (emit-push-constant-int (char-code arg1))
    6700              (compile-forms-and-maybe-emit-clear-values arg2 'stack :char))
     6714               ;; prevent need for with-operand-accumulation: reverse args
     6715             (compile-forms-and-maybe-emit-clear-values arg2 'stack :char)
     6716             (emit-push-constant-int (char-code arg1)))
    67016717            ((characterp arg2)
    67026718             (compile-forms-and-maybe-emit-clear-values arg1 'stack :char)
    67036719             (emit-push-constant-int (char-code arg2)))
    67046720            (t
    6705              (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
    6706                                                         arg2 'stack :char)))
     6721             (with-operand-accumulation
     6722                 ((compile-operand arg1 :char)
     6723                  (compile-operand arg2 :char)
     6724                  (maybe-emit-clear-values arg1 arg2)))))
    67076725      (let ((LABEL1 (gensym))
    67086726            (LABEL2 (gensym)))
Note: See TracChangeset for help on using the changeset viewer.