[armedbear-cvs] r11622 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Wed Feb 4 21:07:47 UTC 2009
Author: ehuelsmann
Date: Wed Feb 4 21:07:44 2009
New Revision: 11622
Log:
Eliminate NEW-FIXNUM and EMIT-FIXNUM-INIT in favor of CONVERT-REPRESENTATION.
Modified:
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Wed Feb 4 21:07:44 2009
@@ -2160,11 +2160,6 @@
(setf *static-code* *code*)
(setf (gethash local-function ht) g))))
-(defun new-fixnum (&optional (test-val t))
- (when test-val
- (emit 'new +lisp-fixnum-class+)
- (emit 'dup)))
-
(defknown declare-fixnum (fixnum) string)
(defun declare-fixnum (n)
(declare (type fixnum n))
@@ -2180,9 +2175,8 @@
(emit-push-constant-int n)
(emit 'aaload))
(t
- (new-fixnum)
(emit-push-constant-int n)
- (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))
+ (convert-representation :int nil)))
(emit 'putstatic *this-class* g +lisp-fixnum+)
(setf *static-code* *code*)
(setf (gethash n ht) g))))
@@ -5231,14 +5225,6 @@
(t
(compiler-unsupported "p2-function: unsupported case: ~S" form)))))
-(defun emit-fixnum-init (representation)
- (case representation
- (:int)
- (:long
- (emit 'i2l))
- (t
- (emit-invokespecial-init +lisp-fixnum-class+ '("I")))))
-
(defknown p2-ash (t t t) t)
(define-inlined-function p2-ash (form target representation)
((check-arg-count form 2))
@@ -5262,7 +5248,6 @@
(<= -31 constant-shift 31)
(fixnum-type-p type1)
(fixnum-type-p result-type))
- (new-fixnum (null representation))
(compile-form arg1 'stack :int)
(cond ((plusp constant-shift)
(compile-form arg2 'stack :int)
@@ -5278,7 +5263,7 @@
(emit 'ishr))
((zerop constant-shift)
(compile-form arg2 nil nil))) ; for effect
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((and constant-shift
;; lshl/lshr only use the low six bits of the mask.
@@ -5304,12 +5289,11 @@
(emit-move-from-stack target representation))
((and (fixnum-type-p type1)
low2 high2 (<= -31 low2 high2 0)) ; Negative shift.
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :int
arg2 'stack :int)
(emit 'ineg)
(emit 'ishr)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((fixnum-type-p type2)
(cond ((and low2 high2 (<= 0 low2 high2 63) ; Non-negative shift.
@@ -5374,22 +5358,20 @@
((and (fixnum-type-p type1) (fixnum-type-p type2))
;; (format t "p2-logand fixnum case~%")
;; Both arguments are fixnums.
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :int
arg2 'stack :int)
(emit 'iand)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((or (and (fixnum-type-p type1)
(compiler-subtypep type1 'unsigned-byte))
(and (fixnum-type-p type2)
(compiler-subtypep type2 'unsigned-byte)))
;; One of the arguments is a positive fixnum.
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :int
arg2 'stack :int)
(emit 'iand)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((and (java-long-type-p type1) (java-long-type-p type2))
;; Both arguments are longs.
@@ -5465,11 +5447,10 @@
(fixnum-constant-value type2))
target representation))
((and (fixnum-type-p type1) (fixnum-type-p type2))
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :int
arg2 'stack :int)
(emit 'ior)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((and (eql (fixnum-constant-value type1) 0) (< *safety* 3))
(compile-forms-and-maybe-emit-clear-values arg1 nil nil
@@ -5540,11 +5521,10 @@
(emit 'ixor))
((and (fixnum-type-p type1) (fixnum-type-p type2))
;; (format t "p2-logxor case 2~%")
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :int
arg2 'stack :int)
(emit 'ixor)
- (emit-fixnum-init representation))
+ (convert-representation :int representation))
((and (java-long-type-p type1) (java-long-type-p type2))
(compile-forms-and-maybe-emit-clear-values arg1 'stack :long
arg2 'stack :long)
@@ -5572,11 +5552,10 @@
((check-arg-count form 1))
(cond ((and (fixnum-type-p (derive-compiler-type form)))
(let ((arg (%cadr form)))
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values arg 'stack :int)
(emit 'iconst_m1)
(emit 'ixor)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation)))
(t
(let ((arg (%cadr form)))
@@ -5607,7 +5586,6 @@
(compile-constant 0 target representation))
((and size position)
(cond ((<= (+ position size) 31)
- (new-fixnum (null representation))
(compile-forms-and-maybe-emit-clear-values size-arg nil nil
position-arg nil nil
arg3 'stack :int)
@@ -5616,10 +5594,9 @@
(emit 'ishr))
(emit-push-constant-int (1- (expt 2 size))) ; mask
(emit 'iand)
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((<= (+ position size) 63)
- (new-fixnum (and (null representation) (<= size 31)))
(compile-forms-and-maybe-emit-clear-values size-arg nil nil
position-arg nil nil
arg3 'stack :long)
@@ -5630,7 +5607,7 @@
(emit 'l2i)
(emit-push-constant-int (1- (expt 2 size)))
(emit 'iand)
- (emit-fixnum-init representation))
+ (convert-representation :int representation))
(t
(emit-push-constant-long (1- (expt 2 size))) ; mask
(emit 'land)
@@ -6825,29 +6802,28 @@
(let ((type1 (derive-compiler-type arg1))
(type2 (derive-compiler-type arg2)))
(cond ((and (fixnum-type-p type1) (fixnum-type-p type2))
- (new-fixnum (null representation))
- (compile-form arg1 'stack :int)
- (emit 'dup)
- (compile-form arg2 'stack :int)
+ (compile-form arg1 'stack :int)
+ (emit 'dup)
+ (compile-form arg2 'stack :int)
(emit 'dup_x1)
(let ((LABEL1 (gensym)))
(emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1)
(emit 'swap) ;; The lower stack value is greater-or-equal
- (label LABEL1)
+ (label LABEL1)
(emit 'pop)) ;; Throw away the lower stack value
- (emit-fixnum-init representation)
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
((and (java-long-type-p type1) (java-long-type-p type2))
- (compile-form arg1 'stack :long)
- (emit 'dup2)
- (compile-form arg2 'stack :long)
+ (compile-form arg1 'stack :long)
+ (emit 'dup2)
+ (compile-form arg2 'stack :long)
(emit 'dup2_x2)
- (emit 'lcmp)
+ (emit 'lcmp)
(let ((LABEL1 (gensym)))
(emit (if (eq op 'max) 'ifge 'ifle) LABEL1)
(emit 'dup2_x2) ;; pour-mans swap2
(emit 'pop2)
- (label LABEL1)
+ (label LABEL1)
(emit 'pop2))
(convert-representation :long representation)
(emit-move-from-stack target representation))
@@ -7090,12 +7066,8 @@
(maybe-emit-clear-values arg1 arg2 arg3)
(emit-invokevirtual class "setCharAt" '("I" "C") nil)
(when target
- (new-fixnum (null representation))
(emit 'iload value-register)
- (case representation
- (:char)
- (t
- (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))
+ (convert-representation :char representation)
(emit-move-from-stack target representation))))
(t
;; (format t "p2-set-char/schar not optimized~%")
@@ -7270,9 +7242,8 @@
(emit-invokevirtual +lisp-object-class+ "aset" (list "I" +lisp-object+) nil)))
(when value-register
(cond ((fixnum-type-p type3)
- (new-fixnum (null representation))
(emit 'iload value-register)
- (emit-fixnum-init representation))
+ (convert-representation :int representation))
(t
(aload value-register)
(fix-boxing representation type3)))
@@ -7726,13 +7697,9 @@
(defun p2-sxhash (form target representation)
(cond ((check-arg-count form 1)
(let ((arg (%cadr form)))
- (unless (eq representation :int)
- (new-fixnum))
(compile-forms-and-maybe-emit-clear-values arg 'stack nil)
(emit-invokevirtual +lisp-object-class+ "sxhash" nil "I")
- (unless (eq representation :int)
- (emit-invokespecial-init +lisp-fixnum-class+ '("I"))
- (fix-boxing representation 'fixnum))
+ (convert-representation :int representation)
(emit-move-from-stack target representation)))
(t
(compile-function-call form target representation))))
@@ -7846,9 +7813,10 @@
(compile-constant (char-code arg) target representation))
((and (< *safety* 3)
(eq (derive-compiler-type arg) 'character))
- (new-fixnum (null representation))
(compile-form arg 'stack :char)
- (emit-fixnum-init representation)
+ ;; we change the representation between the above and here
+ ;; ON PURPOSE!
+ (convert-representation :int representation)
(emit-move-from-stack target representation))
(t
(compile-function-call form target representation)))))
@@ -8318,12 +8286,16 @@
(not (variable-special-p variable))
(not (variable-used-non-locally-p variable))
(zerop (compiland-children *current-compiland*)))
- (emit-push-variable variable)
- (derive-variable-representation variable nil) ;; nil == no block
- (when (< 1 (representation-size (variable-representation variable)))
- (allocate-variable-register variable))
- (convert-representation nil (variable-representation variable))
- (emit-move-to-variable variable)))
+ (when (memq (type-representation (variable-declared-type variable))
+ '(:int :long))
+ (emit-push-variable variable)
+;; (sys::%format t "declared type: ~S~%" (variable-declared-type variable))
+ (derive-variable-representation variable nil)
+;; (sys::%format t "representation: ~S~%" (variable-representation variable))
+ (when (< 1 (representation-size (variable-representation variable)))
+ (allocate-variable-register variable))
+ (convert-representation nil (variable-representation variable))
+ (emit-move-to-variable variable))))
t)
(defknown p2-compiland (t) t)
More information about the armedbear-cvs
mailing list