![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to bcmutil.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 bcmutil.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: /*
7: * Newscalar takes the rvalue pointed to by lval and initializes
8: * it to have a value of zero.
9: */
10:
11: newscalar(lval)
12: register rvalue *lval;
13: {
14: minit(&lval->mantissa);
15: mcopy(mzero, &lval->mantissa);
16: lval->scale = 0;
17: }
18:
19: /*
20: * Newarray takes the array pointed to by alval and initializes it
21: * to have one element, which will have the value of zero.
22: */
23:
24: newarray(alval)
25: register array *alval;
26: {
27: alval->size = 1;
28: alval->avalue = (rvalue *)mpalc(sizeof (rvalue));
29: newscalar(alval->avalue);
30: }
31:
32: /*
33: * Arfree frees all space associated with the array pointed to by
34: * `alv'.
35: */
36:
37: arfree(alv)
38: register array *alv;
39: {
40: register rvalue *rp;
41: register int left;
42:
43: for (rp = alv->avalue, left = alv->size; --left >= 0; ++rp)
44: mvfree(&rp->mantissa);
45: mpfree(alv->avalue);
46: }
47:
48: /*
49: * Pow10 returns a pointer to a mint which is 10 ^ `power'.
50: * Note that this pointer is to a static region, and hence
51: * should not be saved, but should be used immediately.
52: * Since pow10 is frequently used for scaleing, it first
53: * checks to see if the value being requested is the same
54: * as last time, and if so, simply returns it.
55: */
56:
57: mint *
58: pow10(power)
59: register int power;
60: {
61: static int oldpow = -1;
62: static mint oldres;
63:
64: if (power != oldpow) {
65: if (power == 0)
66: return (mone);
67: spow(&ten, power, &oldres);
68: oldpow = power;
69: }
70: return (&oldres);
71: }
72:
73: /*
74: * Select returns the lvalue of the `indx'th item in the array
75: * `arry'.
76: */
77:
78: rvalue *
79: select(arry, indx)
80: register array *arry;
81: int indx;
82: {
83: register rvalue *ptr;
84: register int nsize;
85:
86: if (indx < 0)
87: bcmerr("Negative subscript");
88: if (indx >= arry->size) {
89: nsize = indx + ABUMP - indx % ABUMP;
90: /*
91: * Should be:
92: * ptr = (rvalue *)realloc(arry->avalue,
93: * nsize * (sizeof (rvalue)));
94: * if (ptr == NULL)
95: * die("Out of space");
96: * But is:
97: */
98: ptr = (rvalue *)mpalc(nsize * (sizeof (rvalue)));
99: copy((char *)arry->avalue, (char *)ptr,
100: arry->size * sizeof (rvalue));
101: mpfree(arry->avalue);
102: /*
103: * End of kludge.
104: */
105: arry->avalue = ptr;
106: ptr += arry->size;
107: do {
108: newscalar(ptr++);
109: } while (++arry->size < nsize);
110: }
111: return (&arry->avalue[indx]);
112: }
113:
114: /*
115: * Shift sets the mint `b' to the mint `a' times 10 ^ `scnt'.
116: * If `scnt' is negative, then a divide (with truncation) is
117: * done. If `scnt' is zero and `a' and `b' are the same, then
118: * no action is taken.
119: */
120:
121:
122: shift(a, scnt, b)
123: register int scnt;
124: mint *a, *b;
125: {
126: mint temp;
127:
128: if (scnt > 0)
129: mult(a, pow10(scnt), b);
130: else if (scnt < 0) {
131: minit(&temp);
132: mdiv(a, pow10(-scnt), b, &temp);
133: mvfree(&temp);
134: } else if (a != b)
135: mcopy(a, b);
136: }
137:
138: /*
139: * Rescale adjusts the scale of the rvalue pointed to by `a'
140: * to `newsc'.
141: */
142:
143: rescale(a, newsc)
144: register rvalue *a;
145: register int newsc;
146: {
147: shift(a, newsc - a->scale, a);
148: a->scale = newsc;
149: }
150:
151: /*
152: * Rtoint returns an int equal to the rvalue `a'. Any
153: * fractional part is truncated. If `a' is too large,
154: * then rtoint exits via bcerr.
155: */
156:
157: int
158: rtoint(a)
159: rvalue *a;
160: {
161: register int res;
162: mint temp;
163:
164: minit(&temp);
165: shift(&a->mantissa, - a->scale, &temp);
166: if (mcmp(mminint, &temp) > 0 || mcmp(&temp, mmaxint) > 0)
167: bcmerr("Too big for int");
168: res = mtoi(&temp);
169: mvfree(&temp);
170: return (res);
171: }
172:
173: /*
174: * Chkcall checks to make sure that a function is defined and has
175: * the right number of arguments. `fnc' is a pointer to the
176: * dictionary entry for the function and `npars' is the number
177: * of parameters with which it is called.
178: */
179:
180: chkcall(fnc, npars)
181: register dicent *fnc;
182: register int npars;
183: {
184: if (fnc->globalt != FUNCTION)
185: bcmerr("'%s' not function", fnc->word);
186: if (fnc->globalv.fvalue.body == NULL)
187: bcmerr("Function '%s' not defined", fnc->word);
188: if (fnc->globalv.fvalue.nparams != npars)
189: bcmerr("Function '%s' needs %d arguments, got %d",
190: fnc->word, fnc->globalv.fvalue.nparams, npars);
191: }
192:
193: /*
194: * Pauto intializes the automatic variables needed by a bc function
195: * as part of the CALL instruction. It also checks to make sure that
196: * there is room for them on the stack. Pauto returns the value
197: * for tos after the CALL is completed (which is a pointer to the
198: * return state). `fnc' is the function being called, tos is the
199: * old tos and limit is the last available stack entry.
200: */
201:
202: stkent *
203: pauto(fnc, tos, limit)
204: register func *fnc;
205: register stkent *tos;
206: stkent *limit;
207: {
208: register type *tp;
209: int left;
210:
211: left = fnc->nautos;
212: if (tos + left >= limit)
213: bcmerr("Out of runtime stack");
214: ++tos;
215: for (tp = &fnc->types[fnc->nparams]; --left >= 0; ++tp, ++tos)
216: switch (*tp) {
217: case SCALAR:
218: newscalar(&tos->rvalue);
219: break;
220: case ARRAY:
221: tos->alvalue = (array *)mpalc(sizeof (array));
222: newarray(tos->alvalue);
223: break;
224: default:
225: assert(FALSE);
226: }
227: return (tos);
228: }
229:
230: /*
231: * Newframe returns the new value for the frame pointer after
232: * calling the function `fcn'. `tos' is the top of the stack
233: * after the CALL (note, this points to the saved state).
234: */
235:
236: stkent *
237: newframe(fcn, tos)
238: register func *fcn;
239: stkent *tos;
240: {
241: return (tos - (fcn->nparams + fcn->nautos));
242: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.