![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to misc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / efl|
Return to misc.c CVS log | Up to [Research Unix] / researchv10no / cmd / efl |
1.1 root 1: #include <ctype.h>
2: #include "defs"
3:
4: char * copys(s)
5: register char *s;
6: {
7: register char *t;
8: char *k;
9: ptr calloc();
10:
11: for(t=s; *t++ ; );
12: if( (k = (char *)calloc( t-s , sizeof(char))) == NULL)
13: fatal("Cannot allocate memory");
14:
15: for(t=k ; *t++ = *s++ ; );
16: return(k);
17: }
18:
19:
20:
21: equals(a,b)
22: register char *a,*b;
23: {
24: if(a==b) return(YES);
25:
26: while(*a == *b)
27: if(*a == '\0') return(YES);
28: else {++a; ++b;}
29:
30: return(NO);
31: }
32:
33:
34: char *concat(a,b,c) /* c = concatenation of a and b */
35: register char *a,*b;
36: char *c;
37: {
38: register char *t;
39: t = c;
40:
41: while(*t = *a++) t++;
42: while(*t++ = *b++);
43: return(c);
44: }
45:
46:
47:
48:
49:
50: ptr conrep(a,b)
51: char *a, *b;
52: {
53: char *s;
54:
55: s = (char *)intalloc( strlen(a)+strlen(b)+1 );
56: concat(a,b,s);
57: cfree(a);
58: return((int *)s);
59: }
60:
61:
62: eqcon(p,q)
63: register ptr p, q;
64: {
65: int pt, qt;
66:
67: if(p==q) return(YES);
68: if(p==NULL || q==NULL) return(NO);
69: pt = p->tag;
70: qt = q->tag;
71: if(pt==TNEGOP && qt==TNEGOP)
72: return( eqcon(p->leftp, q->leftp) );
73: if(pt==TCONST && qt==TNEGOP)
74: return(NO);
75: if(pt==TNEGOP && qt==TCONST)
76: return(NO);
77: if(p->tag==TCONST && q->tag==TCONST)
78: return( equals(p->leftp,q->leftp) );
79:
80: fatal("eqcon: nonconstant argument");
81: /* NOTREACHED */ return 0;
82: }
83:
84:
85:
86: char *convic(n)
87: register int n;
88: {
89: static char s[20];
90: register char *t;
91:
92: s[19] = '\0';
93: t = s+19;
94:
95: do {
96: *--t = '0' + n%10;
97: n /= 10;
98: } while(n > 0);
99:
100: return(t);
101: }
102:
103:
104:
105: conval(p)
106: register ptr p;
107: {
108: int val;
109: if(isicon(p, &val))
110: return(val);
111: fatal("bad conval");
112: return 0;
113: }
114:
115:
116:
117: isicon(p, valp)
118: ptr p;
119: int *valp;
120: {
121: int val1;
122:
123: if(p)
124: switch(p->tag)
125: {
126: case TNEGOP:
127: if(isicon(p->leftp, &val1))
128: {
129: *valp = - val1;
130: return(1);
131: }
132: break;
133:
134: case TCONST:
135: if(p->vtype == TYINT)
136: {
137: *valp = convci(p->leftp);
138: return(YES);
139: }
140: default:
141: break;
142: }
143: return(NO);
144: }
145:
146:
147:
148: isconst(p)
149: ptr p;
150: {
151: return(p->tag==TCONST || (p->tag==TNEGOP && isconst(p->leftp)) );
152: }
153:
154:
155:
156: iszero(s)
157: register char *s;
158: {
159: if(s == NULL)
160: return(YES);
161: while( *s=='+' || *s=='-' || *s==' ' )
162: ++s;
163: while( *s=='0' || *s=='.' )
164: ++s;
165: switch( *s )
166: {
167: case 'd':
168: case 'e':
169: case 'D':
170: case 'E':
171: case ' ':
172: case '\0':
173: return(YES);
174: default:
175: return(NO);
176: }
177: }
178:
179:
180:
181:
182: convci(p)
183: register char *p;
184: {
185: register int n;
186: register int sgn;
187:
188: n = 0;
189: sgn = 1;
190: for( ; *p ; ++p)
191: if(*p == '-')
192: sgn = -1;
193: else if( isdigit(*p) )
194: n = 10*n + (*p - '0');
195:
196: return(sgn * n);
197: }
198:
199:
200:
201: chainp hookup(x,y)
202: register chainp x, y;
203: {
204: register chainp p;
205:
206: if(x == NULL)
207: return(y);
208: for(p=x ; p->nextp ; p = (chainp)p->nextp)
209: ;
210:
211: p->nextp = (int *)y;
212: return(x);
213: }
214:
215:
216: ptr cpexpr(p)
217: register ptr p;
218: {
219: register ptr e;
220: ptr q, q1;
221:
222: if(p == NULL)
223: return(NULL);
224:
225: e = allexpblock();
226: cpblock(p, e, sizeof(struct exprblock));
227:
228: switch(p->tag)
229: {
230: case TAROP:
231: case TRELOP:
232: case TLOGOP:
233: case TASGNOP:
234: case TCALL:
235: e->rightp = cpexpr(p->rightp);
236:
237: case TNOTOP:
238: case TNEGOP:
239: e->leftp = cpexpr(p->leftp);
240: break;
241:
242: case TCONST:
243: e->leftp = (int *)copys(p->leftp);
244: if(p->rightp)
245: e->rightp = (int *)copys(p->rightp);
246: if(p->vtype == TYCHAR)
247: e->vtypep = cpexpr(p->vtypep);
248: break;
249:
250: case TLIST:
251: q1 = (int *)&(e->leftp);
252: for(q = p->leftp ; q ; q = q->nextp)
253: q1 = q1->nextp = (int *)mkchain( cpexpr(q->datap), CHNULL);
254: break;
255:
256: case TTEMP:
257: case TNAME:
258: case TFTNBLOCK:
259: if(p->vsubs)
260: e->vsubs = cpexpr(p->vsubs);
261: if(p->voffset)
262: e->voffset = cpexpr(p->voffset);
263: break;
264:
265: case TERROR:
266: break;
267:
268: default:
269: badtag("cpexpr", p->tag);
270: }
271: return(e);
272: }
273:
274:
275: mvexpr(p,q)
276: char *p, *q;
277: {
278: cpblock(p,q, sizeof(struct exprblock) );
279: frexpblock(p);
280: }
281:
282:
283: cpblock(p,q,n)
284: register char *p, *q;
285: int n;
286: {
287: register int i;
288:
289: for(i=0; i<n; ++i)
290: *q++ = *p++;
291: }
292:
293:
294:
295: strlen(s)
296: register char *s;
297: {
298: register char *t;
299: for(t=s ; *t ; t++ ) ;
300: return(t-s);
301: }
302:
303:
304: char *procnm() /* name of the current procedure */
305: {
306: return( procname ? ((struct stentry *)procname->sthead)->namep : "" );
307: }
308:
309:
310:
311:
312:
313: ptr arg1(a) /* make an argument list of one value */
314: ptr a;
315: {
316: return( mknode(TLIST,0, mkchain(a,CHNULL), PNULL) );
317: }
318:
319:
320:
321: ptr arg2(a,b) /* make an argumentlist (a,b) */
322: ptr a,b;
323: {
324: register ptr p;
325:
326: p = (int *)mkchain(a, mkchain(b,CHNULL) );
327: return( mknode(TLIST,0, p,0) );
328: }
329:
330:
331:
332:
333: ptr arg4(a,b) /* make an argument list of (a,len(a), b,len(b)) */
334: ptr a,b;
335: {
336: register ptr p;
337: p = (int *)mkchain(b, mkchain(cpexpr(b->vtypep), CHNULL));
338: p = (int *)mkchain(a, mkchain(cpexpr(a->vtypep), p));
339: return( mknode(TLIST,0,p,PNULL));
340: }
341:
342:
343:
344: ptr builtin(type,s)
345: int type;
346: char *s;
347: {
348: register ptr p, q = 0;
349: ptr mkvar(), mkname();
350:
351: if(p = (int *)name(s,1))
352: {
353: if(p->blklevel>1 || (p->tag!=TNAME && p->tag!=TKEYWORD)
354: || (q=p->varp)==0 || q->vext
355: || (q->vtype!=type && q->vtype!=TYUNDEFINED) )
356: {
357: exprerr("error involving builtin %s", s);
358: return(errnode());
359: }
360: if(q && q->vtype != TYUNDEFINED)
361: return( cpexpr(q) );
362: }
363: else {
364: q = mkvar( mkname(s) );
365: if(blklevel > 1)
366: {
367: q->blklevel = 1;
368: ((struct headbits *)q->sthead)->blklevel = 1;
369: --ndecl[blklevel];
370: ++ndecl[1];
371: }
372: }
373:
374: q->vtype = type;
375: q->vdclstart = 1;
376: mkftnp(q);
377: return( cpexpr(q) );
378: }
379:
380:
381:
382: ptr errnode()
383: {
384: register struct exprblock * p;
385:
386: p = (struct exprblock *)allexpblock();
387: p->tag = TERROR;
388: p->vtype = TYINT;
389: return((int *)p);
390: }
391:
392:
393:
394: min(a,b)
395: int a,b;
396: {
397: return( a<b ? a : b);
398: }
399:
400:
401:
402: setvproc(p, v)
403: register ptr p;
404: register int v;
405: {
406: ptr q;
407: register int k;
408:
409: q = ((struct stentry *)p->sthead)->varp;
410: k = q->vproc;
411: /*debug printf("setvproc(%s ,%d)\n", ((struct stentry *)q->sthead)->namep, v); */
412: if(p != q)
413: p->vproc = k;
414: if(k == v)
415: return;
416:
417: if(k==PROCUNKNOWN || (k==PROCYES && v==PROCINTRINSIC) )
418: p->vproc = q->vproc = v;
419: else if( !(k==PROCINTRINSIC && v==PROCYES) && ((struct stentry *)p->sthead)->varp!=procname)
420: execerr("attempt to use %s as variable and procedure",
421: ((struct stentry *)p->sthead)->namep);
422: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.