Changeset 11622
- Timestamp:
- 02/04/09 21:07:44 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r11621 r11622 2161 2161 (setf (gethash local-function ht) g)))) 2162 2162 2163 (defun new-fixnum (&optional (test-val t))2164 (when test-val2165 (emit 'new +lisp-fixnum-class+)2166 (emit 'dup)))2167 2168 2163 (defknown declare-fixnum (fixnum) string) 2169 2164 (defun declare-fixnum (n) … … 2181 2176 (emit 'aaload)) 2182 2177 (t 2183 (new-fixnum)2184 2178 (emit-push-constant-int n) 2185 (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))2179 (convert-representation :int nil))) 2186 2180 (emit 'putstatic *this-class* g +lisp-fixnum+) 2187 2181 (setf *static-code* *code*) … … 5232 5226 (compiler-unsupported "p2-function: unsupported case: ~S" form))))) 5233 5227 5234 (defun emit-fixnum-init (representation)5235 (case representation5236 (:int)5237 (:long5238 (emit 'i2l))5239 (t5240 (emit-invokespecial-init +lisp-fixnum-class+ '("I")))))5241 5242 5228 (defknown p2-ash (t t t) t) 5243 5229 (define-inlined-function p2-ash (form target representation) … … 5263 5249 (fixnum-type-p type1) 5264 5250 (fixnum-type-p result-type)) 5265 (new-fixnum (null representation))5266 5251 (compile-form arg1 'stack :int) 5267 5252 (cond ((plusp constant-shift) … … 5279 5264 ((zerop constant-shift) 5280 5265 (compile-form arg2 nil nil))) ; for effect 5281 (emit-fixnum-init representation)5266 (convert-representation :int representation) 5282 5267 (emit-move-from-stack target representation)) 5283 5268 ((and constant-shift … … 5305 5290 ((and (fixnum-type-p type1) 5306 5291 low2 high2 (<= -31 low2 high2 0)) ; Negative shift. 5307 (new-fixnum (null representation))5308 5292 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int 5309 5293 arg2 'stack :int) 5310 5294 (emit 'ineg) 5311 5295 (emit 'ishr) 5312 (emit-fixnum-init representation)5296 (convert-representation :int representation) 5313 5297 (emit-move-from-stack target representation)) 5314 5298 ((fixnum-type-p type2) … … 5375 5359 ;; (format t "p2-logand fixnum case~%") 5376 5360 ;; Both arguments are fixnums. 5377 (new-fixnum (null representation))5378 5361 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int 5379 5362 arg2 'stack :int) 5380 5363 (emit 'iand) 5381 (emit-fixnum-init representation)5364 (convert-representation :int representation) 5382 5365 (emit-move-from-stack target representation)) 5383 5366 ((or (and (fixnum-type-p type1) … … 5386 5369 (compiler-subtypep type2 'unsigned-byte))) 5387 5370 ;; One of the arguments is a positive fixnum. 5388 (new-fixnum (null representation))5389 5371 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int 5390 5372 arg2 'stack :int) 5391 5373 (emit 'iand) 5392 (emit-fixnum-init representation)5374 (convert-representation :int representation) 5393 5375 (emit-move-from-stack target representation)) 5394 5376 ((and (java-long-type-p type1) (java-long-type-p type2)) … … 5466 5448 target representation)) 5467 5449 ((and (fixnum-type-p type1) (fixnum-type-p type2)) 5468 (new-fixnum (null representation))5469 5450 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int 5470 5451 arg2 'stack :int) 5471 5452 (emit 'ior) 5472 (emit-fixnum-init representation)5453 (convert-representation :int representation) 5473 5454 (emit-move-from-stack target representation)) 5474 5455 ((and (eql (fixnum-constant-value type1) 0) (< *safety* 3)) … … 5541 5522 ((and (fixnum-type-p type1) (fixnum-type-p type2)) 5542 5523 ;; (format t "p2-logxor case 2~%") 5543 (new-fixnum (null representation))5544 5524 (compile-forms-and-maybe-emit-clear-values arg1 'stack :int 5545 5525 arg2 'stack :int) 5546 5526 (emit 'ixor) 5547 (emit-fixnum-init representation))5527 (convert-representation :int representation)) 5548 5528 ((and (java-long-type-p type1) (java-long-type-p type2)) 5549 5529 (compile-forms-and-maybe-emit-clear-values arg1 'stack :long … … 5573 5553 (cond ((and (fixnum-type-p (derive-compiler-type form))) 5574 5554 (let ((arg (%cadr form))) 5575 (new-fixnum (null representation))5576 5555 (compile-forms-and-maybe-emit-clear-values arg 'stack :int) 5577 5556 (emit 'iconst_m1) 5578 5557 (emit 'ixor) 5579 (emit-fixnum-init representation)5558 (convert-representation :int representation) 5580 5559 (emit-move-from-stack target representation))) 5581 5560 (t … … 5608 5587 ((and size position) 5609 5588 (cond ((<= (+ position size) 31) 5610 (new-fixnum (null representation))5611 5589 (compile-forms-and-maybe-emit-clear-values size-arg nil nil 5612 5590 position-arg nil nil … … 5617 5595 (emit-push-constant-int (1- (expt 2 size))) ; mask 5618 5596 (emit 'iand) 5619 (emit-fixnum-init representation)5597 (convert-representation :int representation) 5620 5598 (emit-move-from-stack target representation)) 5621 5599 ((<= (+ position size) 63) 5622 (new-fixnum (and (null representation) (<= size 31)))5623 5600 (compile-forms-and-maybe-emit-clear-values size-arg nil nil 5624 5601 position-arg nil nil … … 5631 5608 (emit-push-constant-int (1- (expt 2 size))) 5632 5609 (emit 'iand) 5633 (emit-fixnum-init representation))5610 (convert-representation :int representation)) 5634 5611 (t 5635 5612 (emit-push-constant-long (1- (expt 2 size))) ; mask … … 6826 6803 (type2 (derive-compiler-type arg2))) 6827 6804 (cond ((and (fixnum-type-p type1) (fixnum-type-p type2)) 6828 (new-fixnum (null representation)) 6829 (compile-form arg1 'stack :int) 6830 (emit 'dup) 6831 (compile-form arg2 'stack :int) 6805 (compile-form arg1 'stack :int) 6806 (emit 'dup) 6807 (compile-form arg2 'stack :int) 6832 6808 (emit 'dup_x1) 6833 6809 (let ((LABEL1 (gensym))) 6834 6810 (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) 6835 6811 (emit 'swap) ;; The lower stack value is greater-or-equal 6836 6812 (label LABEL1) 6837 6813 (emit 'pop)) ;; Throw away the lower stack value 6838 (emit-fixnum-init representation)6814 (convert-representation :int representation) 6839 6815 (emit-move-from-stack target representation)) 6840 6816 ((and (java-long-type-p type1) (java-long-type-p type2)) 6841 6842 6843 6817 (compile-form arg1 'stack :long) 6818 (emit 'dup2) 6819 (compile-form arg2 'stack :long) 6844 6820 (emit 'dup2_x2) 6845 6821 (emit 'lcmp) 6846 6822 (let ((LABEL1 (gensym))) 6847 6823 (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) 6848 6824 (emit 'dup2_x2) ;; pour-mans swap2 6849 6825 (emit 'pop2) 6850 6826 (label LABEL1) 6851 6827 (emit 'pop2)) 6852 6828 (convert-representation :long representation) … … 7091 7067 (emit-invokevirtual class "setCharAt" '("I" "C") nil) 7092 7068 (when target 7093 (new-fixnum (null representation))7094 7069 (emit 'iload value-register) 7095 (case representation 7096 (:char) 7097 (t 7098 (emit-invokespecial-init +lisp-fixnum-class+ '("I")))) 7070 (convert-representation :char representation) 7099 7071 (emit-move-from-stack target representation)))) 7100 7072 (t … … 7271 7243 (when value-register 7272 7244 (cond ((fixnum-type-p type3) 7273 (new-fixnum (null representation))7274 7245 (emit 'iload value-register) 7275 (emit-fixnum-init representation))7246 (convert-representation :int representation)) 7276 7247 (t 7277 7248 (aload value-register) … … 7727 7698 (cond ((check-arg-count form 1) 7728 7699 (let ((arg (%cadr form))) 7729 (unless (eq representation :int)7730 (new-fixnum))7731 7700 (compile-forms-and-maybe-emit-clear-values arg 'stack nil) 7732 7701 (emit-invokevirtual +lisp-object-class+ "sxhash" nil "I") 7733 (unless (eq representation :int) 7734 (emit-invokespecial-init +lisp-fixnum-class+ '("I")) 7735 (fix-boxing representation 'fixnum)) 7702 (convert-representation :int representation) 7736 7703 (emit-move-from-stack target representation))) 7737 7704 (t … … 7847 7814 ((and (< *safety* 3) 7848 7815 (eq (derive-compiler-type arg) 'character)) 7849 (new-fixnum (null representation))7850 7816 (compile-form arg 'stack :char) 7851 (emit-fixnum-init representation) 7817 ;; we change the representation between the above and here 7818 ;; ON PURPOSE! 7819 (convert-representation :int representation) 7852 7820 (emit-move-from-stack target representation)) 7853 7821 (t … … 8319 8287 (not (variable-used-non-locally-p variable)) 8320 8288 (zerop (compiland-children *current-compiland*))) 8321 (emit-push-variable variable) 8322 (derive-variable-representation variable nil) ;; nil == no block 8323 (when (< 1 (representation-size (variable-representation variable))) 8324 (allocate-variable-register variable)) 8325 (convert-representation nil (variable-representation variable)) 8326 (emit-move-to-variable variable))) 8289 (when (memq (type-representation (variable-declared-type variable)) 8290 '(:int :long)) 8291 (emit-push-variable variable) 8292 ;; (sys::%format t "declared type: ~S~%" (variable-declared-type variable)) 8293 (derive-variable-representation variable nil) 8294 ;; (sys::%format t "representation: ~S~%" (variable-representation variable)) 8295 (when (< 1 (representation-size (variable-representation variable))) 8296 (allocate-variable-register variable)) 8297 (convert-representation nil (variable-representation variable)) 8298 (emit-move-to-variable variable)))) 8327 8299 t) 8328 8300
Note: See TracChangeset
for help on using the changeset viewer.
