![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bcmch.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [MW Coherent from dump] / coherent / d / bin / bc|
Return to bcmch.c CVS log | Up to [MW Coherent from dump] / coherent / d / bin / bc |
1.1 root 1: #include <stdio.h>
2: #include <assert.h>
3: #include "bc.h"
4:
5: /*
6: * Sscale takes the rvalue pointed to by lval and sets
7: * the scale register to it if it is in range (ie. non-negative
8: * and small enough to fit in an int).
9: */
10:
11: sscale(lval)
12: rvalue *lval;
13: {
14: register int res;
15:
16: res = rtoint(lval);
17: if (res < 0)
18: bcmerr("Invalid scale register value");
19: scale = res;
20: }
21:
22: /*
23: * Bcclean frees up the automatic variables and parameters on
24: * function exit. `fnc' is the function from which we are returning
25: * and `stkp' is a pointer to the top thing to remove.
26: */
27:
28: bcclean(fnc, stkp)
29: func *fnc;
30: stkent *stkp;
31: {
32: register type *tp;
33: register int left;
34:
35: tp = &fnc->types[fnc->nautos + fnc->nparams];
36: for (left = fnc->nautos; --left >= 0; --stkp)
37: switch (*--tp) {
38: case SCALAR:
39: mvfree(&stkp->rvalue.mantissa);
40: break;
41: case ARRAY:
42: arfree(stkp->alvalue);
43: mpfree(stkp->alvalue);
44: break;
45: default:
46: assert(FALSE);
47: }
48: for (left = fnc->nparams; --left >= 0; --stkp)
49: switch (*--tp) {
50: case SCALAR:
51: mvfree(&stkp->rvalue.mantissa);
52: break;
53: case ARRAY:
54: break;
55: default:
56: assert(FALSE);
57: }
58: }
59:
60: /*
61: * Bcadd adds the rvalue pointed to by `src' to that pointed to
62: * by `dst'. Note that `src' is freed.
63: */
64:
65: bcadd(src, dst)
66: register rvalue *src, *dst;
67: {
68: if (dst->scale >= src->scale)
69: rescale(src, dst->scale);
70: else
71: rescale(dst, src->scale);
72: madd(&dst->mantissa, &src->mantissa, &dst->mantissa);
73: mvfree(&src->mantissa);
74: }
75:
76: /*
77: * Bcmul multiplies the rvalue pointed to by `dst' by that
78: * pointed to by `src'. Note that `src' is freed.
79: * The scale factor of the result is set to
80: * min( src->scale + dst->scale, max(scale, src->scale, dst->scale)).
81: */
82:
83: bcmul(src, dst)
84: register rvalue *src, *dst;
85: {
86: register int scl;
87:
88: mult(&dst->mantissa, &src->mantissa, &dst->mantissa);
89: mvfree(&src->mantissa);
90: scl = src->scale;
91: if (scl < scale)
92: scl = scale;
93: if (scl < dst->scale)
94: scl = dst->scale;
95: dst->scale += src->scale;
96: if (scl < dst->scale)
97: rescale(dst, scl);
98: }
99:
100: /*
101: * Bcdiv divides the rvalue pointed to by `dst' by that pointed
102: * to by `src'. Note that `src' is freed. The scale of the
103: * result is alway equal to the value of the scale register.
104: */
105:
106: bcdiv(src, dst)
107: register rvalue *src, *dst;
108: {
109: if (zerop(&src->mantissa))
110: bcmerr("Division by zero");
111: rescale(dst, src->scale + scale);
112: mdiv(&dst->mantissa, &src->mantissa, &dst->mantissa, &src->mantissa);
113: dst->scale = scale;
114: mvfree(&src->mantissa);
115: }
116:
117: /*
118: * Bcrem sets the rvalue pointed to by `dst' to the remainder one
119: * would get when divideing `dst' by `src'. Note that `src' is freed.
120: */
121:
122: bcrem(src, dst)
123: register rvalue *src, *dst;
124: {
125: if (zerop(&src->mantissa))
126: bcmerr("Modulo zero");
127: rescale(dst, src->scale + scale);
128: mdiv(&dst->mantissa, &src->mantissa, &src->mantissa, &dst->mantissa);
129: mvfree(&src->mantissa);
130: }
131:
132: /*
133: * Bcexp raises the rvalue pointed to by `dst' to the `src' power.
134: * Note that first `src' is truncated to an integer. Note that
135: * `src' is freed. The scale factor of the result is as if the
136: * corresponding multiplications had been done.
137: * Negative exponents are computed by inverting dst.
138: */
139:
140: bcexp(src, dst)
141: register rvalue *src, *dst;
142: {
143: register int limit;
144: rvalue temp;
145: int rem;
146:
147: minit(&temp.mantissa);
148: if ( ! ispos(&src->mantissa)) {
149: mneg(&src->mantissa, &src->mantissa);
150: mcopy(mone, &temp.mantissa);
151: temp.scale = 0;
152: bcdiv(dst, &temp);
153: *dst = temp;
154: minit(&temp.mantissa);
155: }
156: shift(&src->mantissa, - src->scale, &temp.mantissa);
157: sdiv(&temp.mantissa, 2, &temp.mantissa, &rem);
158: if (rem == 0) {
159: mvfree(&src->mantissa);
160: *src = *dst;
161: minit(&dst->mantissa);
162: mcopy(mone, &dst->mantissa);
163: dst->scale = 0;
164: } else {
165: mcopy(&dst->mantissa, &src->mantissa);
166: src->scale = dst->scale;
167: }
168: limit = (src->scale > scale ? src->scale : scale);
169: while (!zerop(&temp.mantissa)) {
170: mult(&src->mantissa, &src->mantissa, &src->mantissa);
171: src->scale *= 2;
172: if (src->scale > limit)
173: rescale(src, limit);
174: sdiv(&temp.mantissa, 2, &temp.mantissa, &rem);
175: if (rem != 0) {
176: mult(&src->mantissa, &dst->mantissa, &dst->mantissa);
177: dst->scale += src->scale;
178: if (dst->scale > limit)
179: rescale(dst, limit);
180: }
181: }
182: mvfree(&temp.mantissa);
183: mvfree(&src->mantissa);
184: }
185:
186: /*
187: * Bcsqrt relaces the rvalue pointed to by `dst' with its
188: * square root. The scale factor of the result is the maximum
189: * of the scale register and of the scale of the argument.
190: */
191:
192: bcsqrt(dst)
193: register rvalue *dst;
194: {
195: register int prec;
196: mint temp;
197:
198: if ( ! ispos(&dst->mantissa))
199: bcmerr("Square root of negative");
200: prec = scale;
201: if (prec < dst->scale)
202: prec = dst->scale;
203: rescale(dst, 2 * prec);
204: minit(&temp);
205: msqrt(&dst->mantissa, &dst->mantissa, &temp);
206: mvfree(&temp);
207: dst->scale = prec;
208: }
209:
210: /*
211: * Bccmp returns an int which compares to zero as the rvalue `dst'
212: * compares to the rvalue `src'. Note that both `src' and `dst'
213: * are freed.
214: */
215:
216: bccmp(src, dst)
217: register rvalue *src, *dst;
218: {
219: register int res;
220:
221: if (dst->scale >= src->scale)
222: rescale(src, dst->scale);
223: else
224: rescale(dst, src->scale);
225: res = mcmp(&dst->mantissa, &src->mantissa);
226: mvfree(&src->mantissa);
227: mvfree(&dst->mantissa);
228: return (res);
229: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.