- Timestamp:
- 01/19/11 22:02:41 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r13158 r13159 1782 1782 (arg1 (first args)) 1783 1783 (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))) 1786 1788 (emit-invokestatic +lisp+ "memq" 1787 1789 (lisp-object-arg-types 2) :boolean) … … 1798 1800 (arg2 (second args)) 1799 1801 (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))) 1802 1806 (cond ((eq type1 'SYMBOL) ; FIXME 1803 1807 (emit-invokestatic +lisp+ "memq" … … 1827 1831 (case (length args) 1828 1832 ((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))) 1836 1839 (emit-invokestatic +lisp+ "get" 1837 1840 (lisp-object-arg-types (if arg3 3 2)) … … 1853 1856 (arg2 (second args)) 1854 1857 (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))) 1858 1863 (emit-invokestatic +lisp+ "getf" 1859 1864 (lisp-object-arg-types 3) +lisp-object+) … … 1870 1875 (let ((key-form (%cadr form)) 1871 1876 (ht-form (%caddr form))) 1872 ( compile-form ht-form 'stack nil)1873 (emit-checkcast+lisp-hash-table+)1874 (compile-form key-form 'stacknil)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))) 1876 1881 (emit-invokevirtual +lisp-hash-table+ "gethash1" 1877 1882 (lisp-object-arg-types 1) +lisp-object+) … … 1888 1893 (ht-form (%caddr form)) 1889 1894 (value-form (fourth form))) 1890 ( compile-form ht-form 'stack nil)1891 (emit-checkcast+lisp-hash-table+)1892 (compile-form key-form 'stacknil)1893 (compile-form value-form 'stacknil)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))) 1895 1900 (cond (target 1896 1901 (emit-invokevirtual +lisp-hash-table+ "puthash" … … 4811 4816 (case arg-count 4812 4817 (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) 4815 4822 (emit 'swap) 4816 4823 (cond (target … … 4888 4895 (cond ((and (compiler-subtypep type1 '(UNSIGNED-BYTE 8)) 4889 4896 (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+))) 4893 4900 (maybe-emit-clear-values arg1 arg2) 4894 4901 (emit 'swap) … … 4898 4905 (emit-move-from-stack target))) 4899 4906 ((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))) 4902 4910 (maybe-emit-clear-values arg1 arg2) 4903 4911 (emit-invokestatic +lisp+ "writeByte" … … 5479 5487 (test (if (memq type1 '(SYMBOL NULL)) 'eq 'eql))) 5480 5488 (cond ((subtypep type2 'VECTOR) 5481 ( compile-form arg1 'stack nil)5482 (compile-form arg2 'stacknil)5483 (emit-checkcast +lisp-abstract-vector+)5489 (with-operand-accumulation 5490 ((compile-operand arg1 nil) 5491 (compile-operand arg2 nil +lisp-abstract-vector+))) 5484 5492 (maybe-emit-clear-values arg1 arg2) 5485 5493 (emit 'swap) … … 5951 5959 (fixnum-type-p (derive-compiler-type (third form))) 5952 5960 (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)))) 5955 5965 (emit-invokevirtual +lisp-object+ "elt" '(:int) +lisp-object+) 5956 5966 (fix-boxing representation nil) ; FIXME use derived result type … … 6289 6299 (emit 'dup)) 6290 6300 (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)))))) 6293 6305 (emit-invokevirtual +lisp-thread+ 6294 6306 "setValues" … … 6298 6310 (emit-move-from-stack target)) 6299 6311 ((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)) 6303 6318 (emit-invokevirtual +lisp-thread+ 6304 6319 "setValues" … … 6697 6712 (return-from p2-char=)) 6698 6713 (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))) 6701 6717 ((characterp arg2) 6702 6718 (compile-forms-and-maybe-emit-clear-values arg1 'stack :char) 6703 6719 (emit-push-constant-int (char-code arg2))) 6704 6720 (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))))) 6707 6725 (let ((LABEL1 (gensym)) 6708 6726 (LABEL2 (gensym)))
Note: See TracChangeset
for help on using the changeset viewer.
