![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to modf.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / lib / libc / tahoe / fpe|
Return to modf.s CVS log | Up to [CSRG BSD Unix] / 43BSDReno / lib / libc / tahoe / fpe |
1.1 root 1: /*
2: * Copyright (c) 1986 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 are permitted
9: * provided that: (1) source distributions retain this entire copyright
10: * notice and comment, and (2) distributions including binaries display
11: * the following acknowledgement: ``This product includes software
12: * developed by the University of California, Berkeley and its contributors''
13: * in the documentation or other materials provided with the distribution
14: * and in all advertising materials mentioning features or use of this
15: * software. Neither the name of the University nor the names of its
16: * contributors may be used to endorse or promote products derived
17: * from this software without specific prior written permission.
18: * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
19: * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
20: * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
21: */
22:
23: #if defined(SYSLIBC_SCCS) && !defined(lint)
24: .asciz "@(#)modf.s 1.3 (Berkeley) 6/1/90"
25: #endif /* SYSLIBC_SCCS and not lint */
26:
27: /*
28: * double modf (value, iptr)
29: * double value, *iptr;
30: *
31: * Modf returns the fractional part of "value",
32: * and stores the integer part indirectly through "iptr".
33: */
34: #include <tahoemath/fp.h>
35: #include "DEFS.h"
36:
37: ENTRY(modf, R2|R3|R4|R5)
38: /*
39: * Some initializations:
40: */
41: ldd 4(fp) /* load accumulator, for converison */
42: cvdl r2 /* to an integer. */
43: bvs gsb /* iff too big grunt it out */
44: cvld r2 /* float the integer part */
45: std r2
46: ldd 4(fp) /* isolate the fraction */
47: subd r2
48: std r0
49: movl 12(fp),r6 /* get int return address */
50: movl r2,(r6)
51: movl r3,4(r6)
52: ret
53: gsb: clrl r3
54: movl 4(fp),r0 /* fetch operand to r0,r1. */
55: movl 8(fp),r1
56: movl 12(fp),r6 /* fetch addr of int to r6. */
57: /*
58: * get exponent
59: */
60: andl3 $EXPMASK,r0,r2 /* r2 will hold the exponent. */
61: jeql is_reserved /* check for reserved operand. */
62: shrl $EXPSHIFT,r2,r2
63: subl2 $BIAS,r2 /* unbias it. */
64: jleq allfrac /* it's int part is zero. */
65: cmpl r2,$56
66: jgeq allint /* it's fraction part is zero. */
67: /*
68: * get fraction
69: */
70: movl r0,r4 /* remember the original number. */
71: movl r1,r5
72: bbc $31,r0,positive /* if negative remember it. */
73: incl r3
74: positive:
75: /* clear the non fraction parts. */
76: andl2 $(0!(EXPMASK | SIGNBIT)),r0
77: /* add the hidden bit. */
78: orl2 $(0!CLEARHID),r0
79:
80: cmpl r2,$HID_POS /* see if there are bits to clear only in r0 */
81: /* or r1 has to be taken care of. */
82: /* ( for fraction calculation) */
83:
84: jgtr in_r1 /* some bytes in r1. */
85:
86: jeql onlyallr0 /* all r0 must be cleared,r1 unchanged. */
87:
88: /* only r0 must be canged. */
89: mnegl r2,r7 /* r7 - loop counter. */
90: movl $CLEARHID,r8 /* first bit to clear. */
91: 1:
92: andl2 r8,r0 /* clear int. bits from fraction part. */
93: shar $1,r8,r8
94: aoblss $0,r7,1b
95: 1:
96: andl2 r8,r4 /* clear frac bits for int calculation: */
97: shar $1,r8,r8
98: cmpl $0xffffffff,r8
99: jneq 1b
100: clrl r5
101: jmp norm
102:
103: onlyallr0:
104: clrl r0
105: clrl r5
106: jmp norm
107:
108: in_r1:
109: clrl r0 /* clear int part for frac. calculation. */
110: subl3 r2,$HID_POS,r7
111: movl $0x7fffffff,r8
112: 1:
113: andl2 r8,r1
114: shar $1,r8,r8
115: orl2 $0x80000000,r8 /* force the 'sign' bit to be on. */
116: aoblss $0,r7,1b
117: 1:
118: andl2 r8,r5
119: shar $1,r8,r8
120: cmpl $0xffffffff,r8
121: jneq 1b
122:
123: norm:
124: addl2 $BIAS,r2 /* fnorm expects it biased. */
125: callf $4,fnorm /* normelize fraction part. */
126: cmpl $0,r0
127: jeql 1f
128: bbc $0,r3,1f
129: orl2 $0x80000000,r0
130: 1:
131: movl r4,(r6) /* put int part in place. */
132: movl r5,4(r6)
133: ret
134:
135: allint:
136: movl r0,(r6) /* copy the argument to the int addr. */
137: movl r1,4(r6)
138: clrl r0 /* clear the fraction part. */
139: clrl r1
140: ret
141:
142: allfrac:
143: /* the fraction is ready in r0,r1. */
144: clrl (r6) /* zero the int part. */
145: clrl 4(r6)
146: ret
147:
148: ret_zero:
149: clrl (r6)
150: clrl 4(r6)
151: clrl r0
152: clrl r1
153: ret
154:
155: is_reserved:
156: bbc $31,r0,ret_zero
157: callf $4,fpresop
158: ret
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.