1 ;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: System; Base: 10 -*-
3 ;;;; evcl - 12 - Number - float64-sign
4 ;;; arch/generic/lisp/math/gen-math-f32-sign.lisp
6 ;;; This file is part of Evita Common Lisp.
8 ;;; Copyright (C) 1996-2007 by Project Vogue.
9 ;;; Written by Yoshifumi "VOGUE" INOUE. (yosi@msn.com)
11 ;;; @(#)$Id: //proj/evcl3/mainline/arch/generic/lisp/libm/float64/gen-float64-sign.lisp#1 $
14 ;;; This file contains implementation of float64-sign.
16 (in-package #:strict-math)
19 * From fdlibm (http://www.netlib.org/fdlibm/)
20 /* @(#)s_copysign.c 5.1 93/09/24 */
22 * ====================================================
23 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
25 * Developed at SunPro, a Sun Microsystems, Inc. business.
26 * Permission to use, copy, modify, and distribute this
27 * software is freely granted, provided that this notice
29 * ====================================================
34 <<copysign>>, <<copysignf>>---sign of <[y]>, magnitude of <[x]>
43 double copysign (double <[x]>, double <[y]>);
44 float copysignf (float <[x]>, float <[y]>);
48 double copysign (<[x]>, <[y]>)
52 float copysignf (<[x]>, <[y]>)
57 <<copysign>> constructs a number with the magnitude (absolute value)
58 of its first argument, <[x]>, and the sign of its second argument,
61 <<copysignf>> does the same thing; the two functions differ only in
62 the type of their arguments and result.
65 <<copysign>> returns a <<double>> with the magnitude of
66 <[x]> and the sign of <[y]>.
67 <<copysignf>> returns a <<float>> with the magnitude of
68 <[x]> and the sign of <[y]>.
71 <<copysign>> is not required by either ANSI C or the System V Interface
77 * copysign(double x, double y)
78 * copysign(x,y) returns a value with the magnitude of x and
79 * with the sign bit of y.
82 (defun float64-sign (x y)
83 (declare (values double-float))
84 (declare (type double-float x y))
85 (multiple-value-bind (hx lx) (decode-float64 x)
86 (let ((hy (decode-float64 y)))
88 (logior (logand hx #x7fffffff) (logand hy #x80000000))