Changeset 11607


Ignore:
Timestamp:
01/31/09 08:38:52 (12 years ago)
Author:
ehuelsmann
Message:

Implement inline float and double calculations for P2-TIMES.
Cleanup some functions which are now unused.

File:
1 edited

Legend:

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

    r11604 r11607  
    513513(defun type-representation (the-type)
    514514  "Converts a type specification or compiler type into a representation."
     515  (when (null the-type)
     516    (return-from type-representation))
    515517  (do* ((types type-representations (cdr types)))
    516518       ((endp types) nil)
     
    10721074                 104 ; imul
    10731075                 105 ; lmul
     1076                 106 ; fmul
     1077                 107 ; dmul
    10741078                 116 ; ineg
    10751079                 117 ; lneg
     
    10881092                 133 ; i2l
    10891093                 134 ; i2f
     1094                 135 ; i2d
    10901095                 136 ; l2i
    10911096                 148 ; lcmp
     
    62906295
    62916296(defvar numeric-op-type-derivation
    6292   `(((+ - * /)
     6297  `(((+ - *)
    62936298     (integer integer ,#'derive-integer-type)
     6299     (integer single-float single-float)
     6300     (integer double-float double-float)
     6301     (single-float integer single-float)
     6302     (single-float double-float double-float)
     6303     (double-float integer double-float)
     6304     (double-float single-float double-float))
     6305    ((/)
    62946306     (integer single-float single-float)
    62956307     (integer double-float double-float)
     
    63776389    result-type))
    63786390
     6391(define-int-bounds-derivation * (low1 high1 low2 high2)
     6392  (cond ((or (null low1) (null low2))
     6393         (values nil nil))
     6394        ((or (null high1) (null high2))
     6395         (values (if (or (minusp low1) (minusp low2))
     6396                     (- (* (abs low1) (abs low2)))
     6397                     (* low1 low2))
     6398                 nil))
     6399        ((or (minusp low1) (minusp low2))
     6400         (let ((max (* (max (abs low1) (abs high1))
     6401                       (max (abs low2) (abs high2)))))
     6402           (values (- max) max)))
     6403        (t
     6404         (values (* low1 low2) (* high1 high2)))))
     6405
    63796406(defun derive-type-times (form)
    63806407  (let ((args (cdr form))
    63816408        (result-type t))
    63826409    (when (= (length args) 2)
    6383       (let ((arg1 (%car args))
    6384             (arg2 (%cadr args)))
    6385         (when (and (integerp arg1) (integerp arg2))
    6386           (let ((n (* arg1 arg2)))
    6387             (return-from derive-type-times (%make-integer-type n n))))
    6388   (when-args-integer
    6389    (arg1 arg2)
    6390    (type1 low1 high1 type2 low2 high2)
    6391    ((low nil)
    6392     (high nil))
    6393    (cond ((not (and low1 low2))
    6394     ;; Nothing to do.
    6395     )
    6396          ((or (minusp low1) (minusp low2))
    6397     (when (and high1 high2)
    6398       (let ((max (* (max (abs low1) (abs high1))
    6399         (max (abs low2) (abs high2)))))
    6400         (setf low (- max)
    6401         high max))))
    6402          (t
    6403     (setf low (* low1 low2))
    6404     (when (and high1 high2)
    6405       (setf high (* high1 high2)))))
    6406    (setf result-type (%make-integer-type low high)))))
     6410      (setf result-type
     6411            (derive-type-numeric-op (car form)
     6412                                    (derive-compiler-type (car args))
     6413                                    (derive-compiler-type (cadr args)))))
    64076414  result-type))
    64086415
     
    67656772    (emit-move-from-stack target representation)))
    67666773
    6767 (defun two-long-ints-times/plus/minus (arg1 arg2 instruction representation)
    6768   (compile-form arg1 'stack :int)
    6769   (emit 'i2l)
    6770   (compile-form arg2 'stack :int)
    6771   (emit 'i2l)
    6772   (maybe-emit-clear-values arg1 arg2)
    6773   (emit instruction)
    6774   (convert-representation :long representation))
    6775 
    67766774(defun p2-times (form target representation)
    67776775  (case (length form)
     
    67806778            (arg1 (%car args))
    67816779            (arg2 (%cadr args))
    6782             type1 type2 result-type value)
     6780            result-type result-rep value)
    67836781       (when (fixnump arg1)
    67846782         (rotatef arg1 arg2))
    6785        (setf type1 (make-integer-type (derive-type arg1))
    6786              type2 (make-integer-type (derive-type arg2))
    6787              result-type (make-integer-type (derive-type form)))
     6783       (setf result-type (derive-compiler-type form)
     6784             result-rep (type-representation result-type))
    67886785       (cond ((and (numberp arg1) (numberp arg2))
    67896786              (dformat t "p2-times case 1~%")
     
    67926789              (dformat t "p2-times case 1a~%")
    67936790              (compile-constant value target representation))
    6794              ((and (fixnum-type-p type1)
    6795                    (fixnum-type-p type2))
    6796               (cond ((fixnum-type-p result-type)
    6797                      (unless (eq representation :int)
    6798            (new-fixnum))
    6799          (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    6800                 arg2 'stack :int)
    6801                      (emit 'imul)
    6802                      (unless (eq representation :int)
    6803                        (emit-invokespecial-init +lisp-fixnum-class+ '("I"))
    6804                        (fix-boxing representation 'fixnum)))
     6791             (result-rep
     6792              (compile-forms-and-maybe-emit-clear-values
     6793                          arg1 'stack result-rep
     6794                          arg2 'stack result-rep)
     6795              (emit (case result-rep
     6796                      (:int    'imul)
     6797                      (:long   'lmul)
     6798                      (:float  'fmul)
     6799                      (:double 'dmul)
    68056800                      (t
    6806          (two-long-ints-times/plus/minus
    6807           arg1 arg2 'lmul representation)))
     6801                       (sys::format t "p2-times: unsupported rep case"))))
     6802              (convert-representation result-rep representation)
    68086803        (emit-move-from-stack target representation))
    6809              ((and (java-long-type-p type1)
    6810                    (java-long-type-p type2)
    6811                    (java-long-type-p result-type))
    6812         (compile-forms-and-maybe-emit-clear-values arg1 'stack :long
    6813                arg2 'stack :long)
    6814               (emit 'lmul)
    6815               (convert-representation :long representation)
    6816               (emit-move-from-stack target representation))
    68176804             ((fixnump arg2)
    68186805;;               (format t "p2-times case 3~%")
     
    68936880         (t
    68946881          (compile-function-call form target representation))))
    6895 
    6896 (defun fixnum-result-plus/minus (target representation result-type arg1 arg2
    6897          int-op long-op)
    6898   (cond ((or (eq representation :int)
    6899        (fixnum-type-p result-type))
    6900    (new-fixnum (null representation))
    6901    (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
    6902                 arg2 'stack :int)
    6903    (emit int-op)
    6904    (emit-fixnum-init representation))
    6905   (t
    6906    (two-long-ints-times/plus/minus
    6907     arg1 arg2 long-op representation)))
    6908   (emit-move-from-stack target representation))
    69096882
    69106883(defun p2-plus (form target representation)
Note: See TracChangeset for help on using the changeset viewer.