home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / sys / tahoe / math / Kldexpf.s < prev    next >
Encoding:
Text File  |  1991-05-04  |  3.6 KB  |  99 lines
  1. /*-
  2.  * Copyright (c) 1985 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * This code is derived from software contributed to Berkeley by
  6.  * Computer Consoles Inc.
  7.  *
  8.  * Redistribution and use in source and binary forms, with or without
  9.  * modification, are permitted provided that the following conditions
  10.  * are met:
  11.  * 1. Redistributions of source code must retain the above copyright
  12.  *    notice, this list of conditions and the following disclaimer.
  13.  * 2. Redistributions in binary form must reproduce the above copyright
  14.  *    notice, this list of conditions and the following disclaimer in the
  15.  *    documentation and/or other materials provided with the distribution.
  16.  * 3. All advertising materials mentioning features or use of this software
  17.  *    must display the following acknowledgement:
  18.  *    This product includes software developed by the University of
  19.  *    California, Berkeley and its contributors.
  20.  * 4. Neither the name of the University nor the names of its contributors
  21.  *    may be used to endorse or promote products derived from this software
  22.  *    without specific prior written permission.
  23.  *
  24.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  25.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  26.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  27.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  29.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  30.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  31.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  32.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  33.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  34.  * SUCH DAMAGE.
  35.  *
  36.  *    @(#)Kldexpf.s    7.1 (Berkeley) 12/6/90
  37.  */
  38.  
  39. #include "../tahoe/SYS.h"
  40. #include "../math/fp.h"
  41. #include "../math/Kfp.h"
  42.  
  43. /* @(*)Kldexpf.s    4.2 (Berkeley) 12/21/80
  44.  *    Tahoe         2/2/83
  45.  *
  46.  * float Kldexpf (op_most, op_least, exp, hfs)
  47.  *
  48.  * Ldexp returns value*2**exp, if that result is in range.
  49.  * If underflow occurs, it returns zero.  If overflow occurs,
  50.  * it returns a value of appropriate sign and largest
  51.  * possible magnitude.  In case of either overflow or underflow,
  52.  * the external int "errno" is set to ERANGE.  Note that errno is
  53.  * not modified if no error occurs, so if you intend to test it
  54.  * after you use Kldexpf, you had better set it to something
  55.  * other than ERANGE first (zero is a reasonable value to use).
  56.  */
  57.  
  58.     .text
  59. ENTRY(Kldexpf, R2)
  60.     movl    4(fp),r0    /* Fetch "value" */
  61.     movl    8(fp),r1
  62.  
  63.     andl3    $EXPMASK,r0,r2    /* r2 := shifted biased exponent */
  64.     jeql    ld1        /* If it's zero, we're done */
  65.     shar    $EXPSHIFT,r2,r2    /* shift to get value of exponent  */
  66.  
  67.     addl2    12(fp),r2    /* r2 := new biased exponent */
  68.     jleq    under        /* if it's <= 0, we have an underflow */
  69.     cmpl    r2,$256        /* Otherwise check if it's too big */
  70.     jgeq    over        /* jump if overflow */
  71. /*
  72.  *    Construct the result and return
  73.  */
  74.     andl2    $0!EXPMASK,r0    /* clear old exponent */
  75.     shal     $EXPSHIFT,r2,r2    /* Put the exponent back in the result */
  76.     orl2    r2,r0
  77. ld1:    ret
  78. /*
  79.  *    Underflow
  80.  */
  81. under:    clrl    r0        /* Result is zero */
  82.     clrl    r1
  83.     orl2    $HFS_UNDF,*16(fp)
  84.     jmp    err        /* Join general error code */
  85. /*
  86.  *    Overflow
  87.  */
  88. over:    movl    huge0,r0    /* Largest possible floating magnitude */
  89.     movl    huge1,r1
  90.     orl2    $HFS_OVF,*16(fp)
  91.     orl2    $SIGNBIT,r0    /* If arg < 0, make result negative */
  92.  
  93. err:    orl2    $HFS_RANGE,*16(fp)    /* Indicate range error */
  94.     ret
  95.  
  96.     .data
  97. huge0:    .long    0x7fffffff
  98. huge1:    .long    0xffffffff
  99.