X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Ffloat.lisp;h=9fa88d7d2c2d9aba692380f93d22ca77687896ac;hb=e67cc0f952040723f7d0f37ddb88fe895f4b1464;hp=6a0fcf4795f2f09f7435b2edcdd3071c0bd45f7f;hpb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;p=sbcl.git diff --git a/src/compiler/hppa/float.lisp b/src/compiler/hppa/float.lisp index 6a0fcf4..9fa88d7 100644 --- a/src/compiler/hppa/float.lisp +++ b/src/compiler/hppa/float.lisp @@ -1,8 +1,17 @@ -(in-package "SB!VM") +;;;; the HPPA 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") ;;;; Move functions. - (define-move-fun (load-fp-zero 1) (vop x y) ((fp-single-zero) (single-reg) (fp-double-zero) (double-reg)) @@ -33,10 +42,8 @@ (double-reg) (double-stack)) (let ((offset (* (tn-offset y) n-word-bytes))) (str-float x offset (current-nfp-tn vop)))) - ;;;; Move VOPs - (define-vop (move-float) (:args (x :scs (single-reg double-reg) :target y @@ -47,11 +54,9 @@ (:generator 0 (unless (location= y x) (inst funop :copy x y)))) - (define-move-vop move-float :move (single-reg) (single-reg)) (define-move-vop move-float :move (double-reg) (double-reg)) - (define-vop (move-from-float) (:args (x :to :save)) (:results (y :scs (descriptor-reg))) @@ -59,8 +64,8 @@ (:variant-vars size type data) (:note "float to pointer coercion") (:generator 13 - (with-fixed-allocation (y ndescr type size)) - (inst fsts x (- (* data n-word-bytes) other-pointer-lowtag) y))) + (with-fixed-allocation (y ndescr type size) + (inst fsts x (- (* data n-word-bytes) other-pointer-lowtag) y)))) (macrolet ((frob (name sc &rest args) `(progn @@ -90,8 +95,7 @@ (frob move-to-single single-reg single-float-value-slot) (frob move-to-double double-reg double-float-value-slot)) - -(define-vop (move-float-argument) +(define-vop (move-float-arg) (:args (x :scs (single-reg double-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y single-reg double-reg)))) @@ -105,15 +109,12 @@ ((single-stack double-stack) (let ((offset (* (tn-offset y) n-word-bytes))) (str-float x offset nfp)))))) - -(define-move-vop move-float-argument :move-arg +(define-move-vop move-float-arg :move-arg (single-reg descriptor-reg) (single-reg)) -(define-move-vop move-float-argument :move-arg +(define-move-vop move-float-arg :move-arg (double-reg descriptor-reg) (double-reg)) - ;;;; Complex float move functions - (defun complex-single-reg-real-tn (x) (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg) :offset (tn-offset x))) @@ -128,7 +129,6 @@ (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset (1+ (tn-offset x)))) - (define-move-fun (load-complex-single 2) (vop x y) ((complex-single-stack) (complex-single-reg)) (let ((nfp (current-nfp-tn vop)) @@ -147,7 +147,6 @@ (let ((imag-tn (complex-single-reg-imag-tn x))) (str-float imag-tn (+ offset n-word-bytes) nfp)))) - (define-move-fun (load-complex-double 4) (vop x y) ((complex-double-stack) (complex-double-reg)) (let ((nfp (current-nfp-tn vop)) @@ -166,9 +165,7 @@ (let ((imag-tn (complex-double-reg-imag-tn x))) (str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp)))) -;;; ;;; 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)))) @@ -184,7 +181,6 @@ (let ((x-imag (complex-single-reg-imag-tn x)) (y-imag (complex-single-reg-imag-tn y))) (inst funop :copy x-imag y-imag))))) -;;; (define-move-vop complex-single-move :move (complex-single-reg) (complex-single-reg)) @@ -203,14 +199,11 @@ (let ((x-imag (complex-double-reg-imag-tn x)) (y-imag (complex-double-reg-imag-tn y))) (inst funop :copy x-imag y-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))) @@ -218,16 +211,15 @@ (:note "complex single float to pointer coercion") (:generator 13 (with-fixed-allocation (y ndescr complex-single-float-widetag - complex-single-float-size)) - (let ((real-tn (complex-single-reg-real-tn x))) - (inst fsts real-tn (- (* complex-single-float-real-slot n-word-bytes) - other-pointer-lowtag) - y)) - (let ((imag-tn (complex-single-reg-imag-tn x))) - (inst fsts imag-tn (- (* complex-single-float-imag-slot n-word-bytes) - other-pointer-lowtag) - y)))) -;;; + complex-single-float-size) + (let ((real-tn (complex-single-reg-real-tn x))) + (inst fsts real-tn (- (* complex-single-float-real-slot n-word-bytes) + other-pointer-lowtag) + y)) + (let ((imag-tn (complex-single-reg-imag-tn x))) + (inst fsts imag-tn (- (* complex-single-float-imag-slot n-word-bytes) + other-pointer-lowtag) + y))))) (define-move-vop move-from-complex-single :move (complex-single-reg) (descriptor-reg)) @@ -238,22 +230,19 @@ (:note "complex double float to pointer coercion") (:generator 13 (with-fixed-allocation (y ndescr complex-double-float-widetag - complex-double-float-size)) - (let ((real-tn (complex-double-reg-real-tn x))) - (inst fsts real-tn (- (* complex-double-float-real-slot n-word-bytes) - other-pointer-lowtag) - y)) - (let ((imag-tn (complex-double-reg-imag-tn x))) - (inst fsts imag-tn (- (* complex-double-float-imag-slot n-word-bytes) - other-pointer-lowtag) - y)))) -;;; + complex-double-float-size) + (let ((real-tn (complex-double-reg-real-tn x))) + (inst fsts real-tn (- (* complex-double-float-real-slot n-word-bytes) + other-pointer-lowtag) + y)) + (let ((imag-tn (complex-double-reg-imag-tn x))) + (inst fsts imag-tn (- (* complex-double-float-imag-slot n-word-bytes) + other-pointer-lowtag) + y))))) (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))) @@ -286,10 +275,8 @@ (define-move-vop move-to-complex-double :move (descriptor-reg) (complex-double-reg)) -;;; -;;; Complex float move-argument vop -;;; -(define-vop (move-complex-single-float-argument) +;;; 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)))) (:results (y)) @@ -310,11 +297,10 @@ (str-float real-tn offset nfp)) (let ((imag-tn (complex-single-reg-imag-tn x))) (str-float imag-tn (+ offset n-word-bytes) nfp))))))) -;;; -(define-move-vop move-complex-single-float-argument :move-arg +(define-move-vop move-complex-single-float-arg :move-arg (complex-single-reg descriptor-reg) (complex-single-reg)) -(define-vop (move-complex-double-float-argument) +(define-vop (move-complex-double-float-arg) (:args (x :scs (complex-double-reg) :target y) (nfp :scs (any-reg) :load-if (not (sc-is y complex-double-reg)))) (:results (y)) @@ -335,15 +321,12 @@ (str-float real-tn offset nfp)) (let ((imag-tn (complex-double-reg-imag-tn x))) (str-float imag-tn (+ offset (* 2 n-word-bytes)) nfp))))))) -;;; -(define-move-vop move-complex-double-float-argument :move-arg +(define-move-vop move-complex-double-float-arg :move-arg (complex-double-reg descriptor-reg) (complex-double-reg)) - -(define-move-vop move-argument :move-arg +(define-move-vop move-arg :move-arg (single-reg double-reg complex-single-reg complex-double-reg) (descriptor-reg)) - ;;;; Arithmetic VOPs.