![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to grmact.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 grmact.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: * Gerror is used by the various grammar actions when a
8: * semantic error is discoverd. It simply prints out a
9: * message and sets allok to FALSE.
10: * It is also called by yyerror to report syntax errors.
11: * It is also called by lexerror to report lexical errors.
12: * Allok, errors, and any partially defined function or statement
13: * will be cleared at the end of the line, except for the
14: * too much code error which clears at the end of the function
15: * or statement which has grown too large.
16: */
17:
18: gerror(str)
19: char *str;
20: {
21: if (allok == TRUE) {
22: if (infnam != NULL)
23: fprintf(stderr, "%s: ", infnam);
24: if (inline != 0)
25: fprintf(stderr, "%d: ", inline);
26: fprintf(stderr, "%r\n", &str);
27: allok = FALSE;
28: }
29: }
30:
31: /*
32: * Chktype verifies that the type of `var' will work in sload, aeload,
33: * or arload. Otherwise it emits an error and returns zero so the
34: * grammar action can abort the parse.
35: */
36: chktype(var, type)
37: register dicent *var;
38: register int type;
39: {
40: if (var->localt == type)
41: return 1;
42: else if (var->localt == UNDEFINED)
43: if (var->globalt == type || var->globalt == UNDEFINED)
44: return 1;
45: else
46: gerror("'%s' is wrong global type", var->word);
47: else
48: gerror("'%s' is wrong local type", var->word);
49: return 0;
50: }
51:
52: /*
53: * Sload emits the code to load the scalar with dictionary entry
54: * var.
55: */
56:
57: sload(var)
58: register dicent *var;
59: {
60: switch (var->localt) {
61: case SCALAR:
62: emitop(PLOSC);
63: emitcnt(var->localv);
64: break;
65: case UNDEFINED:
66: switch (var->globalt) {
67: case UNDEFINED:
68: var->globalt = SCALAR;
69: newscalar(&var->globalv.rvalue);
70: /* fall thru */
71: case SCALAR:
72: emitop(PGLSC);
73: emitnum(&var->globalv.rvalue);
74: break;
75: }
76: }
77: }
78:
79:
80: /*
81: * Aeload emits the code to load the array element with dictionary
82: * entry var.
83: */
84:
85: aeload(var)
86: register dicent *var;
87: {
88: switch (var->localt) {
89: case ARRAY:
90: emitop(PLOAE);
91: emitcnt(var->localv);
92: break;
93: case UNDEFINED:
94: switch (var->globalt) {
95: case UNDEFINED:
96: var->globalt = ARRAY;
97: newarray(&var->globalv.arvalue);
98: /* fall thru */
99: case ARRAY:
100: emitop(PGLAE);
101: emitarry(&var->globalv.arvalue);
102: break;
103: }
104: }
105: }
106:
107:
108: /*
109: * Arload emits the code to load the whole array with dictionary
110: * entry var.
111: */
112:
113: arload(var)
114: register dicent *var;
115: {
116: switch (var->localt) {
117: case ARRAY:
118: emitop(PLOAR);
119: emitcnt(var->localv);
120: break;
121: case UNDEFINED:
122: switch (var->globalt) {
123: case UNDEFINED:
124: var->globalt = ARRAY;
125: newarray(&var->globalv.arvalue);
126: /* fall thru */
127: case ARRAY:
128: emitop(PGLAR);
129: emitarry(&var->globalv.arvalue);
130: break;
131: }
132: }
133: }
134:
135:
136: /*
137: * If there is room for another code item, incloc advances loc
138: * and returns the old loc. If not then incloc calls gerror.
139: * Note that both the value returned by incloc and loc itself
140: * always point to a location in cstream.
141: */
142:
143: code *
144: incloc()
145: {
146: register code *res;
147:
148: res = loc++;
149: if (res >= &cstream[MAXCODE - 1]) {
150: loc = res;
151: gerror("Too much code");
152: }
153: return (res);
154: }
155:
156:
157: /*
158: * Negate returns the opcode which branches on the opposite
159: * condition of when `op' branches.
160: */
161:
162: opcode
163: negate(op)
164: opcode op;
165: {
166: switch (op) {
167: case BRALW:
168: return (BRNEV);
169: case BRNEV:
170: return (BRALW);
171: case BRLT:
172: return (BRGE);
173: case BRLE:
174: return (BRGT);
175: case BREQ:
176: return (BRNE);
177: case BRGE:
178: return (BRLT);
179: case BRGT:
180: return (BRLE);
181: case BRNE:
182: return (BREQ);
183: }
184: assert(FALSE);
185: }
186:
187:
188: /*
189: * Locaddr sets the local addresses (ie frame pointer offsets) for
190: * all local variables and parameters. `vec' is an array of `len'
191: * pointers to dictionary entries and `base' is the frame offset
192: * of the first entry.
193: * Note that locaddr assumes that it is never called with len zero.
194: */
195:
196: locaddr(vec, len, base)
197: register dicent *vec[];
198: register int len,
199: base;
200: {
201: do {
202: (*vec++)->localv = base++;
203: } while (--len > 0);
204: }
205:
206:
207: /*
208: * Chkfunc checks to make sure that the identifier with dictionary
209: * entry pointed to by `dicp' can be used as a function. If it
210: * is not already a function, then the body and types fields of the
211: * func value are set to NULL.
212: */
213:
214: chkfunc(dicp)
215: register dicent *dicp;
216: {
217: if (dicp->globalt == FUNCTION)
218: return 1;
219: if (dicp->globalt == UNDEFINED) {
220: dicp->globalt = FUNCTION;
221: dicp->globalv.fvalue.fcsize = 0;
222: dicp->globalv.fvalue.body = dicp->globalv.fvalue.types = NULL;
223: return 1;
224: }
225: gerror("'%s' is not a function", dicp->word);
226: return 0;
227: }
228:
229: /*
230: * Install installs the definition of the function `fnc'.
231: * `pvec' and `lpvec' (`avec' and `lavec') are the vector
232: * of formal parameters (respectively automatic variables)
233: * and its length.
234: */
235:
236: install(fnc, pvec, lpvec, avec, lavec)
237: register func *fnc;
238: dicent **pvec,
239: **avec;
240: int lpvec,
241: lavec;
242: {
243: int csize;
244:
245: litfree(fnc->body, fnc->body+fnc->fcsize);
246: mpfree(fnc->body);
247: mpfree(fnc->types);
248: fnc->nparams = lpvec;
249: fnc->nautos = lavec;
250: if (lpvec + lavec == 0)
251: fnc->types = NULL;
252: else {
253: fnc->types = (type *)mpalc((lpvec + lavec) * sizeof (type));
254: copylty(pvec, fnc->types, lpvec);
255: copylty(avec, &fnc->types[lpvec], lavec);
256: }
257: fnc->fcsize = loc - cstream;
258: csize = fnc->fcsize * sizeof (code);
259: fnc->body = (code *)mpalc(csize);
260: copy((char *)cstream, (char *)fnc->body, csize);
261: remloc(pvec, lpvec);
262: remloc(avec, lavec);
263: }
264:
265: /*
266: * Copylty copyies the local types from the dictionary vector
267: * `dvec' to the type vector `tvec'. `len' is the number of
268: * entries to copy.
269: */
270:
271: copylty(dvec, tvec, len)
272: register dicent *dvec[];
273: register type tvec[];
274: register int len;
275: {
276: while (--len >= 0)
277: *tvec++ = (*dvec++)->localt;
278: }
279:
280:
281: /*
282: * Copy copyies the block of bytes at `from' to that at `to'.
283: * `len' is the number of bytes to copy. Note that these
284: * blocks should not overlap.
285: */
286:
287: copy(from, to, len)
288: register char *from,
289: *to;
290: register int len;
291: {
292: while (--len >= 0)
293: *to++ = *from++;
294: }
295:
296: /*
297: * Remloc is used to remove the local types from the dictionary
298: * vector `dvec'. `len' is the length of the vector.
299: */
300:
301: remloc(dvec, len)
302: register dicent **dvec;
303: register int len;
304: {
305: while (--len >= 0)
306: (*dvec++)->localt = UNDEFINED;
307: }
308:
309: /*
310: * Litfree recovers literal and string storage from bp to ep.
311: * Called after interp() on cstream to loc,
312: * after function definition abort on cstream to loc,
313: * during function redefinition on the old body.
314: */
315: litfree(pc, end) register code *pc, *end;
316: {
317: register int op;
318: while (pc < end) {
319: op = pc++->opcode;
320: if (pc >= end)
321: break;
322: switch (op) {
323: case BRNEV: /* Why by two? */
324: printf("BRNEV in litfree\n");
325: case CALL:
326: ++pc;
327: case PGLSC:
328: case PLOSC:
329: case PGLAE:
330: case PLOAE:
331: case PGLAR:
332: case PLOAR:
333: case RETURN:
334: case BRALW:
335: case BRLT:
336: case BRLE:
337: case BREQ:
338: case BRGE:
339: case BRGT:
340: case BRNE:
341: ++pc;
342: case LOAD:
343: case LIBASE:
344: case LOBASE:
345: case LSCALE:
346: case STORE:
347: case SIBASE:
348: case SOBASE:
349: case SSCALE:
350: case POP:
351: case PRVAL:
352: case STOP:
353: case INC:
354: case DEC:
355: case PRNUM:
356: case PRNL:
357: case LENGTH:
358: case SCALE:
359: case SQRT:
360: case ADD:
361: case SUB:
362: case MUL:
363: case DIV:
364: case REM:
365: case EXP:
366: case NEG:
367: case EXIT:
368: break;
369: case PLISC:
370: mvfree(&pc->lvalue->mantissa);
371: mpfree(pc++->lvalue);
372: break;
373: case PRSTR:
374: mpfree(pc++->svalue);
375: break;
376: default:
377: fprintf(stderr, "Mixup in litfree\n");
378: exit(1);
379: }
380: }
381: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.