Changeset 11534


Ignore:
Timestamp:
01/03/09 20:55:49 (12 years ago)
Author:
vvoutilainen
Message:

Helper function for creating a new fixnum and emitting
dup immediately after. I'll also at this point note
my copyright on the file, after numerous refactorings
done, and more to come.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11533 r11534  
    22;;;
    33;;; Copyright (C) 2003-2008 Peter Graves
     4;;; Copyright (C) 2008 Ville Voutilainen
    45;;; $Id$
    56;;;
     
    19301931    g))
    19311932
     1933(defun new-fixnum (&optional (test-val t))
     1934  (when test-val
     1935    (emit 'new +lisp-fixnum-class+)
     1936    (emit 'dup)))
     1937
    19321938(defknown declare-fixnum (fixnum) string)
    19331939(defun declare-fixnum (n)
     
    19471953               (emit 'aaload))
    19481954              (t
    1949                (emit 'new +lisp-fixnum-class+)
    1950                (emit 'dup)
     1955         (new-fixnum)
    19511956               (emit-push-constant-int n)
    19521957               (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))
     
    50085013                (fixnum-type-p type1)
    50095014                (fixnum-type-p result-type))
    5010            (when (null representation)
    5011              (emit 'new +lisp-fixnum-class+)
    5012              (emit 'dup))
     5015     (new-fixnum (null representation))
    50135016           (compile-form arg1 'stack :int)
    50145017           (cond ((plusp constant-shift)
     
    50525055          ((and (fixnum-type-p type1)
    50535056                low2 high2 (<= -31 low2 high2 0)) ; Negative shift.
    5054            (when (null representation)
    5055              (emit 'new +lisp-fixnum-class+)
    5056              (emit 'dup))
     5057     (new-fixnum (null representation))
    50575058     (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    50585059                  arg2 'stack :int)
     
    51245125                ;;                     (format t "p2-logand fixnum case~%")
    51255126                ;; Both arguments are fixnums.
    5126                 (when (null representation)
    5127                   (emit 'new +lisp-fixnum-class+)
    5128                   (emit 'dup))
     5127    (new-fixnum (null representation))
    51295128    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    51305129                 arg2 'stack :int)
     
    51375136                         (compiler-subtypep type2 'unsigned-byte)))
    51385137                ;; One of the arguments is a positive fixnum.
    5139                 (when (null representation)
    5140                   (emit 'new +lisp-fixnum-class+)
    5141                   (emit 'dup))
     5138    (new-fixnum (null representation))
    51425139    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    51435140                 arg2 'stack :int)
     
    52295226                                  target representation))
    52305227               ((and (fixnum-type-p type1) (fixnum-type-p type2))
    5231                 (when (null representation)
    5232                   (emit 'new +lisp-fixnum-class+)
    5233                   (emit 'dup))
     5228    (new-fixnum (null representation))
    52345229    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    52355230                 arg2 'stack :int)
     
    53065301               ((and (fixnum-type-p type1) (fixnum-type-p type2))
    53075302;;                 (format t "p2-logxor case 2~%")
    5308                 (when (null representation)
    5309                   (emit 'new +lisp-fixnum-class+)
    5310                   (emit 'dup))
     5303    (new-fixnum (null representation))
    53115304    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    53125305                 arg2 'stack :int)
     
    53425335  (cond ((and (fixnum-type-p (derive-compiler-type form)))
    53435336         (let ((arg (%cadr form)))
    5344            (when (null representation)
    5345              (emit 'new +lisp-fixnum-class+)
    5346              (emit 'dup))
     5337     (new-fixnum (null representation))
    53475338     (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
    53485339           (emit 'iconst_m1)
     
    53825373          ((and size position)
    53835374           (cond ((<= (+ position size) 31)
    5384                   (when (null representation)
    5385                     (emit 'new +lisp-fixnum-class+)
    5386                     (emit 'dup))
     5375      (new-fixnum (null representation))
    53875376      (compile-forms-and-maybe-emit-clear-values size-arg nil nil
    53885377                   position-arg nil nil
     
    53965385                  (emit-move-from-stack target representation))
    53975386                 ((<= (+ position size) 63)
    5398                   (when (and (null representation) (<= size 31))
    5399                     ;; Result is a fixnum.
    5400                     (emit 'new +lisp-fixnum-class+)
    5401                     (emit 'dup))
     5387      (new-fixnum (and (null representation) (<= size 31)))
    54025388      (compile-forms-and-maybe-emit-clear-values size-arg nil nil
    54035389                   position-arg nil nil
     
    64936479              (cond ((fixnum-type-p result-type)
    64946480                     (unless (eq representation :int)
    6495                        (emit 'new +lisp-fixnum-class+)
    6496                        (emit 'dup))
     6481           (new-fixnum))
    64976482         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    64986483                arg2 'stack :int)
     
    65556540                           (reg1 (allocate-register))
    65566541                           (reg2 (allocate-register)))
    6557                       (when (null representation)
    6558                         (emit 'new +lisp-fixnum-class+)
    6559                         (emit 'dup))
     6542          (new-fixnum (null representation))
    65606543                      (compile-form arg1 'stack :int)
    65616544                      (emit 'dup)
     
    66526635              (cond ((or (eq representation :int)
    66536636                         (fixnum-type-p result-type))
    6654                      (when (null representation)
    6655                        (emit 'new +lisp-fixnum-class+)
    6656                        (emit 'dup))
     6637         (new-fixnum (null representation))
    66576638         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    66586639                arg2 'stack :int)
     
    67306711                   (integer-type-low type)
    67316712                   (> (integer-type-low type) most-negative-fixnum))
    6732               (when (null representation)
    6733                 (emit 'new +lisp-fixnum-class+)
    6734                 (emit 'dup))
     6713        (new-fixnum (null representation))
    67356714              (compile-form arg 'stack :int)
    67366715              (emit 'ineg)
     
    67676746              (cond ((or (eq representation :int)
    67686747                         (fixnum-type-p result-type))
    6769                      (when (null representation)
    6770                        (emit 'new +lisp-fixnum-class+)
    6771                        (emit 'dup))
     6748         (new-fixnum (null representation))
    67726749         (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    67736750                arg2 'stack :int)
     
    68876864             (emit-invokevirtual class "setCharAt" '("I" "C") nil)
    68886865             (when target
    6889                (when (null representation)
    6890                  (emit 'new +lisp-fixnum-class+)
    6891                  (emit 'dup))
     6866         (new-fixnum (null representation))
    68926867               (emit 'iload value-register)
    68936868               (case representation
     
    70697044           (when value-register
    70707045             (cond ((fixnum-type-p type3)
    7071                     (when (null representation)
    7072                       (emit 'new +lisp-fixnum-class+)
    7073                       (emit 'dup))
     7046        (new-fixnum (null representation))
    70747047                    (emit 'iload value-register)
    70757048        (emit-fixnum-init representation))
     
    74017374                    (emit 'iconst_1))
    74027375                   (t
    7403                     (emit 'new +lisp-fixnum-class+)
    7404                     (emit 'dup)
     7376        (new-fixnum)
    74057377                    (emit 'iload (variable-register variable))
    74067378                    (emit-invokespecial-init +lisp-fixnum-class+ '("I"))))
     
    75717543             (emit 'i2l))
    75727544            (t
    7573              (emit 'new +lisp-fixnum-class+)
    7574              (emit 'dup)
     7545       (new-fixnum)
    75757546             (aver (variable-register variable))
    75767547             (emit 'iload (variable-register variable))
     
    75937564                    (dformat t "p2-setq constructing boxed fixnum for ~S~%"
    75947565                             (variable-name variable))
    7595                     (emit 'new +lisp-fixnum-class+)
    7596                     (emit 'dup)
     7566        (new-fixnum)
    75977567                    (aver (variable-register variable))
    75987568                    (emit 'iload (variable-register variable))
     
    76107580                    (dformat t "p2-setq constructing boxed fixnum for ~S~%"
    76117581                             (variable-name variable))
    7612                     (emit 'new +lisp-fixnum-class+)
    7613                     (emit 'dup)
     7582        (new-fixnum)
    76147583                    (aver (variable-register variable))
    76157584                    (emit 'iload (variable-register variable))
     
    76907659         (let ((arg (%cadr form)))
    76917660           (unless (eq representation :int)
    7692              (emit 'new +lisp-fixnum-class+)
    7693              (emit 'dup))
     7661       (new-fixnum))
    76947662     (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
    76957663           (emit-invokevirtual +lisp-object-class+ "sxhash" nil "I")
     
    78167784          ((and (< *safety* 3)
    78177785                (eq (derive-compiler-type arg) 'character))
    7818            (when (null representation)
    7819              (emit 'new +lisp-fixnum-class+)
    7820              (emit 'dup))
     7786     (new-fixnum (null representation))
    78217787           (compile-form arg 'stack :char)
    78227788     (emit-fixnum-init representation)
Note: See TracChangeset for help on using the changeset viewer.