code.consxy.com Git - clnl/blob - resources/strictmath/otherconversions/gen-float64-sign.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: System; Base: 10 -*-
   2 ;;;;
   3 ;;;; evcl - 12 - Number - float64-sign
   4 ;;; arch/generic/lisp/math/gen-math-f32-sign.lisp
   5 ;;;
   6 ;;; This file is part of Evita Common Lisp.
   7 ;;;
   8 ;;; Copyright (C) 1996-2007 by Project Vogue.
   9 ;;; Written by Yoshifumi "VOGUE" INOUE. (yosi@msn.com)
  10 ;;;
  11 ;;; @(#)$Id: //proj/evcl3/mainline/arch/generic/lisp/libm/float64/gen-float64-sign.lisp#1 $
  12 ;;;
  13 ;;; Description:
  14 ;;;  This file contains implementation of float64-sign.
  15 ;
  16 (in-package #:strict-math)
  17
  18 #|
  19  * From fdlibm (http://www.netlib.org/fdlibm/)
  20 /* @(#)s_copysign.c 5.1 93/09/24 */
  21 /*
  22  * ====================================================
  23  * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
  24  *
  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
  28  * is preserved.
  29  * ====================================================
  30  */
  31
  32 /*
  33 FUNCTION
  34 <<copysign>>, <<copysignf>>---sign of <[y]>, magnitude of <[x]>
  35
  36 INDEX
  37         copysign
  38 INDEX
  39         copysignf
  40
  41 ANSI_SYNOPSIS
  42         #include <math.h>
  43         double copysign (double <[x]>, double <[y]>);
  44         float copysignf (float <[x]>, float <[y]>);
  45
  46 TRAD_SYNOPSIS
  47         #include <math.h>
  48         double copysign (<[x]>, <[y]>)
  49         double <[x]>;
  50         double <[y]>;
  51
  52         float copysignf (<[x]>, <[y]>)
  53         float <[x]>;
  54         float <[y]>;
  55
  56 DESCRIPTION
  57 <<copysign>> constructs a number with the magnitude (absolute value)
  58 of its first argument, <[x]>, and the sign of its second argument,
  59 <[y]>.
  60
  61 <<copysignf>> does the same thing; the two functions differ only in
  62 the type of their arguments and result.
  63
  64 RETURNS
  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]>.
  69
  70 PORTABILITY
  71 <<copysign>> is not required by either ANSI C or the System V Interface
  72 Definition (Issue 2).
  73
  74 */
  75
  76 /*
  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.
  80  */
  81 |#
  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)))
  87     (encode-float64
  88         (logior (logand hx #x7fffffff) (logand hy #x80000000))
  89         lx ) ) ) )