0.8.21.28:
[sbcl.git] / src / compiler / mips / float.lisp
index 0f4c07b..68655a1 100644 (file)
@@ -1,9 +1,18 @@
+;;;; the MIPS VM definition of floating point operations
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
 (in-package "SB!VM")
 
 \f
 ;;;; Move functions:
-
-
 (define-move-fun (load-single 1) (vop x y)
   ((single-stack) (single-reg))
   (inst lwc1 y (current-nfp-tn vop) (* (tn-offset x) n-word-bytes))
@@ -13,7 +22,6 @@
   ((single-reg) (single-stack))
   (inst swc1 x (current-nfp-tn vop) (* (tn-offset y) n-word-bytes)))
 
-
 (defun ld-double (r base offset)
   (ecase *backend-byte-order*
     (:big-endian
   (let ((nfp (current-nfp-tn vop))
        (offset (* (tn-offset y) n-word-bytes)))
     (str-double x nfp offset)))
-
-
 \f
 ;;;; Move VOPs:
-
 (macrolet ((frob (vop sc format)
             `(progn
                (define-vop (,vop)
@@ -65,7 +70,6 @@
   (frob single-move single-reg :single)
   (frob double-move double-reg :double))
 
-
 (define-vop (move-from-float)
   (:args (x :to :save))
   (:results (y))
@@ -91,7 +95,6 @@
   (frob move-from-double double-reg
     t double-float-size double-float-widetag double-float-value-slot))
 
-
 (macrolet ((frob (name sc double-p value)
             `(progn
                (define-vop (,name)
   (frob move-to-single single-reg nil single-float-value-slot)
   (frob move-to-double double-reg t double-float-value-slot))
 
-
 (macrolet ((frob (name sc stack-sc format double-p)
             `(progn
                (define-vop (,name)
                  (,sc descriptor-reg) (,sc)))))
   (frob move-single-float-arg single-reg single-stack :single nil)
   (frob move-double-float-arg double-reg double-stack :double t))
-
 \f
 ;;;; Complex float move functions
 
   (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
                  :offset (+ (tn-offset x) 2)))
 
-
 (define-move-fun (load-complex-single 2) (vop x y)
   ((complex-single-stack) (complex-single-reg))
   (let ((nfp (current-nfp-tn vop))
     (let ((imag-tn (complex-single-reg-imag-tn x)))
       (inst swc1 imag-tn nfp (+ offset n-word-bytes)))))
 
-
 (define-move-fun (load-complex-double 4) (vop x y)
   ((complex-double-stack) (complex-double-reg))
   (let ((nfp (current-nfp-tn vop))
     (let ((imag-tn (complex-double-reg-imag-tn x)))
       (str-double imag-tn nfp (+ offset (* 2 n-word-bytes))))))
 
-;;;
 ;;; Complex float register to register moves.
-;;;
 (define-vop (complex-single-move)
   (:args (x :scs (complex-single-reg) :target y
            :load-if (not (location= x y))))
        (let ((x-imag (complex-single-reg-imag-tn x))
             (y-imag (complex-single-reg-imag-tn y)))
         (inst fmove :single y-imag x-imag)))))
-;;;
 (define-move-vop complex-single-move :move
   (complex-single-reg) (complex-single-reg))
 
        (let ((x-imag (complex-double-reg-imag-tn x))
             (y-imag (complex-double-reg-imag-tn y)))
         (inst fmove :double y-imag x-imag)))))
-;;;
 (define-move-vop complex-double-move :move
   (complex-double-reg) (complex-double-reg))
 
-;;;
 ;;; Move from a complex float to a descriptor register allocating a
 ;;; new complex float object in the process.
-;;;
 (define-vop (move-from-complex-single)
   (:args (x :scs (complex-single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
        (inst swc1 imag-tn y (- (* complex-single-float-imag-slot
                                   n-word-bytes)
                                other-pointer-lowtag))))))
-;;;
 (define-move-vop move-from-complex-single :move
   (complex-single-reg) (descriptor-reg))
 
        (str-double imag-tn y (- (* complex-double-float-imag-slot
                                    n-word-bytes)
                                 other-pointer-lowtag))))))
-;;;
 (define-move-vop move-from-complex-double :move
   (complex-double-reg) (descriptor-reg))
 
-;;;
 ;;; Move from a descriptor to a complex float register
-;;;
 (define-vop (move-to-complex-single)
   (:args (x :scs (descriptor-reg)))
   (:results (y :scs (complex-single-reg)))
 (define-move-vop move-to-complex-double :move
   (descriptor-reg) (complex-double-reg))
 
-;;;
-;;; Complex float move-argument vop
-;;;
+;;; complex float MOVE-ARG VOP
 (define-vop (move-complex-single-float-arg)
   (:args (x :scs (complex-single-reg) :target y)
         (nfp :scs (any-reg) :load-if (not (sc-is y complex-single-reg))))
 (define-move-vop move-complex-double-float-arg :move-arg
   (complex-double-reg descriptor-reg) (complex-double-reg))
 
-
 (define-move-vop move-arg :move-arg
   (single-reg double-reg complex-single-reg complex-double-reg)
   (descriptor-reg))
 
 \f
 ;;;; stuff for c-call float-in-int-register arguments
-
 (define-vop (move-to-single-int-reg)
   (:args (x :scs (single-reg descriptor-reg)))
   (:results (y :scs (single-int-carg-reg) :load-if nil))