Changeset 11781
- Timestamp:
- 04/25/09 05:42:28 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11780 r11781 747 747 748 748 (defun emit-push-variable-name (variable) 749 (emit 'getstatic *this-class* (declare-symbol (variable-name variable)) 750 +lisp-symbol+)) 749 (multiple-value-bind 750 (name class) 751 (lookup-or-declare-symbol (variable-name variable)) 752 (emit 'getstatic class name +lisp-symbol+))) 751 753 752 754 (defknown generate-instanceof-type-check-for-variable (t t) t) … … 2039 2041 (setf (gethash symbol ht) g)))))) 2040 2042 2043 (defun lookup-or-declare-symbol (symbol) 2044 "Returns the value-pair (VALUES field class) from which 2045 the Java object representing SYMBOL can be retrieved." 2046 (multiple-value-bind 2047 (name class) 2048 (lookup-known-symbol symbol) 2049 (if name 2050 (values name class) 2051 (values (declare-symbol symbol) *this-class*)))) 2052 2041 2053 (defknown declare-keyword (symbol) string) 2042 2054 (defun declare-keyword (symbol) … … 2063 2075 (when s 2064 2076 (setf f (concatenate 'string f "_" s)))) 2065 (let ((*code* *static-code*) 2066 (g (gethash1 symbol (the hash-table *declared-symbols*)))) 2067 (cond (g 2068 (emit 'getstatic *this-class* g +lisp-symbol+)) 2069 (t 2070 (emit 'ldc (pool-string (symbol-name symbol))) 2071 (emit 'ldc (pool-string (package-name (symbol-package symbol)))) 2072 (emit-invokestatic +lisp-class+ "internInPackage" 2073 (list +java-string+ +java-string+) 2074 +lisp-symbol+))) 2075 (declare-field f +lisp-object+) 2076 (emit-invokevirtual +lisp-symbol-class+ "getSymbolFunctionOrDie" 2077 nil +lisp-object+) 2078 (emit 'putstatic *this-class* f +lisp-object+) 2079 (setf *static-code* *code*) 2080 (setf (gethash symbol ht) f)))) 2077 (declare-field f +lisp-object+) 2078 (multiple-value-bind 2079 (name class) 2080 (lookup-or-declare-symbol symbol) 2081 (let ((*code* *static-code*)) 2082 (emit 'getstatic class name +lisp-symbol+) 2083 (emit-invokevirtual +lisp-symbol-class+ "getSymbolFunctionOrDie" 2084 nil +lisp-object+) 2085 (emit 'putstatic *this-class* f +lisp-object+) 2086 (setf *static-code* *code*) 2087 (setf (gethash symbol ht) f))))) 2081 2088 2082 2089 (defknown declare-setf-function (name) string) … … 2090 2097 (when s 2091 2098 (setf f (concatenate 'string f "_SETF_" s)))) 2092 (let ((*code* *static-code*) 2093 (g (gethash1 symbol (the hash-table *declared-symbols*)))) 2094 (cond (g 2095 (emit 'getstatic *this-class* g +lisp-symbol+)) 2096 (t 2097 (emit 'ldc (pool-string (symbol-name symbol))) 2098 (emit 'ldc (pool-string (package-name (symbol-package symbol)))) 2099 (emit-invokestatic +lisp-class+ "internInPackage" 2100 (list +java-string+ +java-string+) 2101 +lisp-symbol+))) 2102 (declare-field f +lisp-object+) 2103 (emit-invokevirtual +lisp-symbol-class+ "getSymbolSetfFunctionOrDie" 2104 nil +lisp-object+) 2105 (emit 'putstatic *this-class* f +lisp-object+) 2106 (setf *static-code* *code*) 2107 (setf (gethash name ht) f))))) 2099 (multiple-value-bind 2100 (name class) 2101 (lookup-or-declare-symbol symbol) 2102 (let ((*code* *static-code*)) 2103 (emit 'getstatic class name +lisp-symbol+) 2104 (declare-field f +lisp-object+) 2105 (emit-invokevirtual +lisp-symbol-class+ "getSymbolSetfFunctionOrDie" 2106 nil +lisp-object+) 2107 (emit 'putstatic *this-class* f +lisp-object+) 2108 (setf *static-code* *code*) 2109 (setf (gethash name ht) f)))))) 2108 2110 2109 2111 … … 2950 2952 (cond ((eq op (compiland-name *current-compiland*)) ; recursive call 2951 2953 (if (notinline-p op) 2952 (emit 'getstatic *this-class* (declare-symbol op) +lisp-symbol+) 2954 (multiple-value-bind 2955 (name class) 2956 (lookup-or-declare-symbol op) 2957 (emit 'getstatic class name +lisp-symbol+)) 2953 2958 (aload 0))) 2954 ((null (symbol-package op))2955 (let ((g (if *file-compilation*2956 (declare-object-as-string op)2957 (declare-object op))))2958 (emit 'getstatic *this-class* g +lisp-object+)))2959 2959 (t 2960 2960 (multiple-value-bind 2961 2961 (name class) 2962 (lookup-known-symbol op) 2963 (if name 2964 (emit 'getstatic class name +lisp-symbol+) 2965 (emit 'getstatic *this-class* (declare-symbol op) +lisp-symbol+))))) 2962 (lookup-or-declare-symbol op) 2963 (emit 'getstatic class name +lisp-symbol+)))) 2966 2964 (process-args args) 2967 2965 (if (or (<= *speed* *debug*) *require-stack-frame*) … … 4927 4925 (multiple-value-bind 4928 4926 (name class) 4929 (lookup-known-symbol obj) 4930 (cond (name 4931 (emit 'getstatic class name +lisp-symbol+)) 4932 ((symbol-package (truly-the symbol obj)) 4933 (emit 'getstatic *this-class* (declare-symbol obj) 4934 +lisp-symbol+)) 4935 (t 4936 ;; An uninterned symbol. 4937 (let ((g (if *file-compilation* 4938 (declare-object-as-string obj) 4939 (declare-object obj)))) 4940 (emit 'getstatic *this-class* g +lisp-object+)))) 4941 (emit-move-from-stack target representation))) 4927 (lookup-or-declare-symbol obj) 4928 (emit 'getstatic class name +lisp-symbol+)) 4929 (emit-move-from-stack target representation)) 4942 4930 ((listp obj) 4943 4931 (let ((g (if *file-compilation* … … 5191 5179 (emit-move-from-stack target)) 5192 5180 (t 5193 (emit 'getstatic *this-class* 5194 (declare-symbol name) +lisp-symbol+) 5195 (emit-invokevirtual +lisp-object-class+ "getSymbolFunctionOrDie" 5181 (multiple-value-bind 5182 (name class) 5183 (lookup-or-declare-symbol name) 5184 (emit 'getstatic class name +lisp-symbol+)) 5185 (emit-invokevirtual +lisp-object-class+ 5186 "getSymbolFunctionOrDie" 5196 5187 nil +lisp-object+) 5197 5188 (emit-move-from-stack target)))) … … 5227 5218 (emit-move-from-stack target)) 5228 5219 (t 5229 (emit 'getstatic *this-class* 5230 (declare-symbol (cadr name)) +lisp-symbol+) 5220 (multiple-value-bind 5221 (name class) 5222 (lookup-or-declare-symbol (cadr name)) 5223 (emit 'getstatic class name +lisp-symbol+)) 5231 5224 (emit-invokevirtual +lisp-symbol-class+ 5232 5225 "getSymbolSetfFunctionOrDie" … … 7487 7480 (compile-constant value target representation) 7488 7481 (return-from compile-special-reference)))) 7489 (emit 'getstatic *this-class* (declare-symbol name) +lisp-symbol+) 7482 (multiple-value-bind 7483 (name class) 7484 (lookup-or-declare-symbol name) 7485 (emit 'getstatic class name +lisp-symbol+)) 7490 7486 (cond ((constantp name) 7491 7487 ;; "... a reference to a symbol declared with DEFCONSTANT always … … 7562 7558 ;; We're setting a special variable. 7563 7559 (emit-push-current-thread) 7564 (emit 'getstatic *this-class* (declare-symbol name) +lisp-symbol+) 7560 (multiple-value-bind 7561 (name class) 7562 (lookup-or-declare-symbol name) 7563 (emit 'getstatic class name +lisp-symbol+)) 7565 7564 ;; (let ((*print-structure* nil)) 7566 7565 ;; (format t "p2-setq name = ~S value-form = ~S~%" name value-form)) … … 8010 8009 (multiple-value-bind 8011 8010 (name class) 8012 (lookup-known-symbol form) 8013 (if name 8014 (emit 'getstatic class name +lisp-symbol+) 8015 (emit 'getstatic *this-class* (declare-keyword form) 8016 +lisp-symbol+))))) 8011 (lookup-or-declare-symbol form) 8012 (emit 'getstatic class name +lisp-symbol+)))) 8017 8013 (emit-move-from-stack target representation)) 8018 8014 (t
Note: See TracChangeset
for help on using the changeset viewer.