Cygwin: mmap: allow remapping part of an existing anonymous mapping
[newlib-cygwin.git] / newlib / libc / stdlib / gdtoa-dmisc.c
blobf330f8ae7d5a8277d69b7f27d051dc71b93c07d5
1 /****************************************************************
3 The author of this software is David M. Gay.
5 Copyright (C) 1998 by Lucent Technologies
6 All Rights Reserved
8 Permission to use, copy, modify, and distribute this software and
9 its documentation for any purpose and without fee is hereby
10 granted, provided that the above copyright notice appear in all
11 copies and that both that the copyright notice and this
12 permission notice and warranty disclaimer appear in supporting
13 documentation, and that the name of Lucent or any of its entities
14 not be used in advertising or publicity pertaining to
15 distribution of the software without specific, written prior
16 permission.
18 LUCENT DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
19 INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.
20 IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY
21 SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
22 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER
23 IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
24 ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
25 THIS SOFTWARE.
27 ****************************************************************/
29 /* Please send bug reports to David M. Gay (dmg at acm dot org,
30 * with " at " changed at "@" and " dot " changed to "."). */
32 #include <newlib.h>
33 #include <sys/config.h>
35 #ifdef _USE_GDTOA
36 #include "gdtoaimp.h"
38 #ifndef MULTIPLE_THREADS
39 char *dtoa_result;
40 #endif
42 char *
43 #ifdef KR_headers
44 rv_alloc(ptr, i) struct _reent *ptr, int i;
45 #else
46 rv_alloc(struct _reent *ptr, int i)
47 #endif
49 int j;
50 char *r;
52 /* Allocate buffer in a compatible way with legacy _ldtoa_r(). */
53 j = sizeof(ULong);
54 for (_REENT_MP_RESULT_K (ptr) = 0;
55 sizeof (Bigint) - sizeof (ULong) + j <= i; j <<= 1)
56 _REENT_MP_RESULT_K (ptr)++;
57 _REENT_MP_RESULT (ptr) = eBalloc (ptr, _REENT_MP_RESULT_K (ptr));
58 r = (char *) _REENT_MP_RESULT (ptr);
60 if (r == NULL)
61 return (
62 #ifndef MULTIPLE_THREADS
63 dtoa_result =
64 #endif
65 NULL);
66 return
67 #ifndef MULTIPLE_THREADS
68 dtoa_result =
69 #endif
73 char *
74 #ifdef KR_headers
75 nrv_alloc(ptr, s, rve, n) struct _reent *ptr, char *s, **rve; int n;
76 #else
77 nrv_alloc(struct _reent *ptr, char *s, char **rve, int n)
78 #endif
80 char *rv, *t;
82 t = rv = rv_alloc(ptr, n);
83 if (t == NULL)
84 return (NULL);
85 while((*t = *s++) !=0)
86 t++;
87 if (rve)
88 *rve = t;
89 return rv;
92 /* freedtoa(s) must be used to free values s returned by dtoa
93 * when MULTIPLE_THREADS is #defined. It should be used in all cases,
94 * but for consistency with earlier versions of dtoa, it is optional
95 * when MULTIPLE_THREADS is not defined.
98 void
99 #ifdef KR_headers
100 freedtoa(ptr, s) struct _reent *ptr, char *s;
101 #else
102 freedtoa(struct _reent *ptr, char *s)
103 #endif
105 /* Free buffer allocated in a compatible way with legacy _ldtoa_r(). */
106 Bigint *b = (Bigint *)s;
107 b->_maxwds = 1 << (b->_k = _REENT_MP_RESULT_K (ptr));
108 Bfree(ptr, b);
109 #ifndef MULTIPLE_THREADS
110 if (s == dtoa_result)
111 dtoa_result = 0;
112 #endif
114 DEF_STRONG(freedtoa);
117 quorem
118 #ifdef KR_headers
119 (b, S) Bigint *b, *S;
120 #else
121 (Bigint *b, Bigint *S)
122 #endif
124 int n;
125 ULong *bx, *bxe, q, *sx, *sxe;
126 #ifdef ULLong
127 ULLong borrow, carry, y, ys;
128 #else
129 ULong borrow, carry, y, ys;
130 #ifdef Pack_32
131 ULong si, z, zs;
132 #endif
133 #endif
135 n = S->_wds;
136 #ifdef DEBUG
137 /*debug*/ if (b->_wds > n)
138 /*debug*/ Bug("oversize b in quorem");
139 #endif
140 if (b->_wds < n)
141 return 0;
142 sx = S->_x;
143 sxe = sx + --n;
144 bx = b->_x;
145 bxe = bx + n;
146 q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
147 #ifdef DEBUG
148 /*debug*/ if (q > 9)
149 /*debug*/ Bug("oversized quotient in quorem");
150 #endif
151 if (q) {
152 borrow = 0;
153 carry = 0;
154 do {
155 #ifdef ULLong
156 ys = *sx++ * (ULLong)q + carry;
157 carry = ys >> 32;
158 y = *bx - (ys & 0xffffffffUL) - borrow;
159 borrow = y >> 32 & 1UL;
160 *bx++ = y & 0xffffffffUL;
161 #else
162 #ifdef Pack_32
163 si = *sx++;
164 ys = (si & 0xffff) * q + carry;
165 zs = (si >> 16) * q + (ys >> 16);
166 carry = zs >> 16;
167 y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
168 borrow = (y & 0x10000) >> 16;
169 z = (*bx >> 16) - (zs & 0xffff) - borrow;
170 borrow = (z & 0x10000) >> 16;
171 Storeinc(bx, z, y);
172 #else
173 ys = *sx++ * q + carry;
174 carry = ys >> 16;
175 y = *bx - (ys & 0xffff) - borrow;
176 borrow = (y & 0x10000) >> 16;
177 *bx++ = y & 0xffff;
178 #endif
179 #endif
181 while(sx <= sxe);
182 if (!*bxe) {
183 bx = b->_x;
184 while(--bxe > bx && !*bxe)
185 --n;
186 b->_wds = n;
189 if (cmp(b, S) >= 0) {
190 q++;
191 borrow = 0;
192 carry = 0;
193 bx = b->_x;
194 sx = S->_x;
195 do {
196 #ifdef ULLong
197 ys = *sx++ + carry;
198 carry = ys >> 32;
199 y = *bx - (ys & 0xffffffffUL) - borrow;
200 borrow = y >> 32 & 1UL;
201 *bx++ = y & 0xffffffffUL;
202 #else
203 #ifdef Pack_32
204 si = *sx++;
205 ys = (si & 0xffff) + carry;
206 zs = (si >> 16) + (ys >> 16);
207 carry = zs >> 16;
208 y = (*bx & 0xffff) - (ys & 0xffff) - borrow;
209 borrow = (y & 0x10000) >> 16;
210 z = (*bx >> 16) - (zs & 0xffff) - borrow;
211 borrow = (z & 0x10000) >> 16;
212 Storeinc(bx, z, y);
213 #else
214 ys = *sx++ + carry;
215 carry = ys >> 16;
216 y = *bx - (ys & 0xffff) - borrow;
217 borrow = (y & 0x10000) >> 16;
218 *bx++ = y & 0xffff;
219 #endif
220 #endif
222 while(sx <= sxe);
223 bx = b->_x;
224 bxe = bx + n;
225 if (!*bxe) {
226 while(--bxe > bx && !*bxe)
227 --n;
228 b->_wds = n;
231 return q;
233 #endif /* _USE_GDTOA */