![[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 [CSRG BSD Unix] / 3BSD / cmd / f77|
Return to misc.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / f77 |
1.1 root 1: #include "defs"
2:
3:
4:
5: cpn(n, a, b)
6: register int n;
7: register char *a, *b;
8: {
9: while(--n >= 0)
10: *b++ = *a++;
11: }
12:
13:
14:
15: eqn(n, a, b)
16: register int n;
17: register char *a, *b;
18: {
19: while(--n >= 0)
20: if(*a++ != *b++)
21: return(NO);
22: return(YES);
23: }
24:
25:
26:
27:
28:
29:
30:
31: cmpstr(a, b, la, lb) /* compare two strings */
32: register char *a, *b;
33: ftnint la, lb;
34: {
35: register char *aend, *bend;
36: aend = a + la;
37: bend = b + lb;
38:
39:
40: if(la <= lb)
41: {
42: while(a < aend)
43: if(*a != *b)
44: return( *a - *b );
45: else
46: { ++a; ++b; }
47:
48: while(b < bend)
49: if(*b != ' ')
50: return(' ' - *b);
51: else
52: ++b;
53: }
54:
55: else
56: {
57: while(b < bend)
58: if(*a != *b)
59: return( *a - *b );
60: else
61: { ++a; ++b; }
62: while(a < aend)
63: if(*a != ' ')
64: return(*a - ' ');
65: else
66: ++a;
67: }
68: return(0);
69: }
70:
71:
72:
73:
74:
75: chainp hookup(x,y)
76: register chainp x, y;
77: {
78: register chainp p;
79:
80: if(x == NULL)
81: return(y);
82:
83: for(p = x ; p->nextp ; p = p->nextp)
84: ;
85: p->nextp = y;
86: return(x);
87: }
88:
89:
90:
91: struct Listblock *mklist(p)
92: chainp p;
93: {
94: register struct Listblock *q;
95:
96: q = ALLOC(Listblock);
97: q->tag = TLIST;
98: q->listp = p;
99: return(q);
100: }
101:
102:
103: chainp mkchain(p,q)
104: register int p, q;
105: {
106: register chainp r;
107:
108: if(chains)
109: {
110: r = chains;
111: chains = chains->nextp;
112: }
113: else
114: r = ALLOC(Chain);
115:
116: r->datap = p;
117: r->nextp = q;
118: return(r);
119: }
120:
121:
122:
123: char * varstr(n, s)
124: register int n;
125: register char *s;
126: {
127: register int i;
128: static char name[XL+1];
129:
130: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++i)
131: name[i] = *s++;
132:
133: name[i] = '\0';
134:
135: return( name );
136: }
137:
138:
139:
140:
141: char * varunder(n, s)
142: register int n;
143: register char *s;
144: {
145: register int i;
146: static char name[XL+1];
147:
148: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++i)
149: name[i] = *s++;
150:
151: #if TARGET != GCOS
152: name[i++] = '_';
153: #endif
154:
155: name[i] = '\0';
156:
157: return( name );
158: }
159:
160:
161:
162:
163:
164: char * nounder(n, s)
165: register int n;
166: register char *s;
167: {
168: register int i;
169: static char name[XL+1];
170:
171: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++s)
172: if(*s != '_')
173: name[i++] = *s;
174:
175: name[i] = '\0';
176:
177: return( name );
178: }
179:
180:
181:
182: char *copyn(n, s)
183: register int n;
184: register char *s;
185: {
186: register char *p, *q;
187:
188: p = q = ckalloc(n);
189: while(--n >= 0)
190: *q++ = *s++;
191: return(p);
192: }
193:
194:
195:
196: char *copys(s)
197: char *s;
198: {
199: return( copyn( strlen(s)+1 , s) );
200: }
201:
202:
203:
204: ftnint convci(n, s)
205: register int n;
206: register char *s;
207: {
208: ftnint sum;
209: sum = 0;
210: while(n-- > 0)
211: sum = 10*sum + (*s++ - '0');
212: return(sum);
213: }
214:
215: char *convic(n)
216: ftnint n;
217: {
218: static char s[20];
219: register char *t;
220:
221: s[19] = '\0';
222: t = s+19;
223:
224: do {
225: *--t = '0' + n%10;
226: n /= 10;
227: } while(n > 0);
228:
229: return(t);
230: }
231:
232:
233:
234: double convcd(n, s)
235: int n;
236: register char *s;
237: {
238: double atof();
239: char v[100];
240: register char *t;
241: if(n > 90)
242: {
243: err("too many digits in floating constant");
244: n = 90;
245: }
246: for(t = v ; n-- > 0 ; s++)
247: *t++ = (*s=='d' ? 'e' : *s);
248: *t = '\0';
249: return( atof(v) );
250: }
251:
252:
253:
254: struct Nameblock *mkname(l, s)
255: int l;
256: register char *s;
257: {
258: struct Hashentry *hp;
259: int hash;
260: register struct Nameblock *q;
261: register int i;
262: char n[VL];
263:
264: hash = 0;
265: for(i = 0 ; i<l && *s!='\0' ; ++i)
266: {
267: hash += *s;
268: n[i] = *s++;
269: }
270: hash %= MAXHASH;
271: while( i < VL )
272: n[i++] = ' ';
273:
274: hp = hashtab + hash;
275: while(q = hp->varp)
276: if( hash==hp->hashval && eqn(VL,n,q->varname) )
277: return(q);
278: else if(++hp >= lasthash)
279: hp = hashtab;
280:
281: if(++nintnames >= MAXHASH-1)
282: many("names", 'n');
283: hp->varp = q = ALLOC(Nameblock);
284: hp->hashval = hash;
285: q->tag = TNAME;
286: cpn(VL, n, q->varname);
287: return(q);
288: }
289:
290:
291:
292: struct Labelblock *mklabel(l)
293: ftnint l;
294: {
295: register struct Labelblock *lp;
296:
297: if(l <= 0)
298: return(NULL);
299:
300: for(lp = labeltab ; lp < highlabtab ; ++lp)
301: if(lp->stateno == l)
302: return(lp);
303:
304: if(++highlabtab > labtabend)
305: many("statement numbers", 's');
306:
307: lp->stateno = l;
308: lp->labelno = newlabel();
309: lp->blklevel = 0;
310: lp->labused = NO;
311: lp->labdefined = NO;
312: lp->labinacc = NO;
313: lp->labtype = LABUNKNOWN;
314: return(lp);
315: }
316:
317:
318: newlabel()
319: {
320: return( ++lastlabno );
321: }
322:
323:
324: /* find or put a name in the external symbol table */
325:
326: struct Extsym *mkext(s)
327: char *s;
328: {
329: int i;
330: register char *t;
331: char n[XL];
332: struct Extsym *p;
333:
334: i = 0;
335: t = n;
336: while(i<XL && *s)
337: *t++ = *s++;
338: while(t < n+XL)
339: *t++ = ' ';
340:
341: for(p = extsymtab ; p<nextext ; ++p)
342: if(eqn(XL, n, p->extname))
343: return( p );
344:
345: if(nextext >= lastext)
346: many("external symbols", 'x');
347:
348: cpn(XL, n, nextext->extname);
349: nextext->extstg = STGUNKNOWN;
350: nextext->extsave = NO;
351: nextext->extp = 0;
352: nextext->extleng = 0;
353: nextext->maxleng = 0;
354: nextext->extinit = NO;
355: return( nextext++ );
356: }
357:
358:
359:
360:
361:
362:
363:
364:
365: struct Addrblock *builtin(t, s)
366: int t;
367: char *s;
368: {
369: register struct Extsym *p;
370: register struct Addrblock *q;
371:
372: p = mkext(s);
373: if(p->extstg == STGUNKNOWN)
374: p->extstg = STGEXT;
375: else if(p->extstg != STGEXT)
376: {
377: errstr("improper use of builtin %s", s);
378: return(0);
379: }
380:
381: q = ALLOC(Addrblock);
382: q->tag = TADDR;
383: q->vtype = t;
384: q->vclass = CLPROC;
385: q->vstg = STGEXT;
386: q->memno = p - extsymtab;
387: return(q);
388: }
389:
390:
391:
392: frchain(p)
393: register chainp *p;
394: {
395: register chainp q;
396:
397: if(p==0 || *p==0)
398: return;
399:
400: for(q = *p; q->nextp ; q = q->nextp)
401: ;
402: q->nextp = chains;
403: chains = *p;
404: *p = 0;
405: }
406:
407:
408: ptr cpblock(n,p)
409: register int n;
410: register char * p;
411: {
412: register char *q;
413: ptr q0;
414:
415: q = q0 = ckalloc(n);
416: while(n-- > 0)
417: *q++ = *p++;
418: return(q0);
419: }
420:
421:
422:
423: max(a,b)
424: int a,b;
425: {
426: return( a>b ? a : b);
427: }
428:
429:
430: ftnint lmax(a, b)
431: ftnint a, b;
432: {
433: return( a>b ? a : b);
434: }
435:
436: ftnint lmin(a, b)
437: ftnint a, b;
438: {
439: return(a < b ? a : b);
440: }
441:
442:
443:
444:
445: maxtype(t1, t2)
446: int t1, t2;
447: {
448: int t;
449:
450: t = max(t1, t2);
451: if(t==TYCOMPLEX && (t1==TYDREAL || t2==TYDREAL) )
452: t = TYDCOMPLEX;
453: return(t);
454: }
455:
456:
457:
458: /* return log base 2 of n if n a power of 2; otherwise -1 */
459: #if FAMILY == PCC
460: log2(n)
461: ftnint n;
462: {
463: int k;
464:
465: /* trick based on binary representation */
466:
467: if(n<=0 || (n & (n-1))!=0)
468: return(-1);
469:
470: for(k = 0 ; n >>= 1 ; ++k)
471: ;
472: return(k);
473: }
474: #endif
475:
476:
477:
478: frrpl()
479: {
480: struct Rplblock *rp;
481:
482: while(rpllist)
483: {
484: rp = rpllist->nextp;
485: free(rpllist);
486: rpllist = rp;
487: }
488: }
489:
490:
491: popstack(p)
492: register chainp *p;
493: {
494: register chainp q;
495:
496: if(p==NULL || *p==NULL)
497: fatal("popstack: stack empty");
498: q = (*p)->nextp;
499: free(*p);
500: *p = q;
501: }
502:
503:
504:
505: struct Exprblock *callk(type, name, args)
506: int type;
507: char *name;
508: chainp args;
509: {
510: register struct Exprblock *p;
511:
512: p = mkexpr(OPCALL, builtin(type,name), args);
513: p->vtype = type;
514: return(p);
515: }
516:
517:
518:
519: struct Exprblock *call4(type, name, arg1, arg2, arg3, arg4)
520: int type;
521: char *name;
522: expptr arg1, arg2, arg3, arg4;
523: {
524: struct Listblock *args;
525: args = mklist( mkchain(arg1, mkchain(arg2, mkchain(arg3, mkchain(arg4, NULL)) ) ) );
526: return( callk(type, name, args) );
527: }
528:
529:
530:
531:
532: struct Exprblock *call3(type, name, arg1, arg2, arg3)
533: int type;
534: char *name;
535: expptr arg1, arg2, arg3;
536: {
537: struct Listblock *args;
538: args = mklist( mkchain(arg1, mkchain(arg2, mkchain(arg3, NULL) ) ) );
539: return( callk(type, name, args) );
540: }
541:
542:
543:
544:
545:
546: struct Exprblock *call2(type, name, arg1, arg2)
547: int type;
548: char *name;
549: expptr arg1, arg2;
550: {
551: struct Listblock *args;
552:
553: args = mklist( mkchain(arg1, mkchain(arg2, NULL) ) );
554: return( callk(type,name, args) );
555: }
556:
557:
558:
559:
560: struct Exprblock *call1(type, name, arg)
561: int type;
562: char *name;
563: expptr arg;
564: {
565: return( callk(type,name, mklist(mkchain(arg,0)) ));
566: }
567:
568:
569: struct Exprblock *call0(type, name)
570: int type;
571: char *name;
572: {
573: return( callk(type, name, NULL) );
574: }
575:
576:
577:
578: struct Impldoblock *mkiodo(dospec, list)
579: chainp dospec, list;
580: {
581: register struct Impldoblock *q;
582:
583: q = ALLOC(Impldoblock);
584: q->tag = TIMPLDO;
585: q->varnp = dospec;
586: q->datalist = list;
587: return(q);
588: }
589:
590:
591:
592:
593: ptr ckalloc(n)
594: register int n;
595: {
596: register ptr p;
597: ptr calloc();
598:
599: if( p = calloc(1, (unsigned) n) )
600: return(p);
601:
602: fatal("out of memory");
603: /* NOTREACHED */
604: }
605:
606:
607:
608:
609:
610: isaddr(p)
611: register expptr p;
612: {
613: if(p->headblock.tag == TADDR)
614: return(YES);
615: if(p->headblock.tag == TEXPR)
616: switch(p->exprblock.opcode)
617: {
618: case OPCOMMA:
619: return( isaddr(p->exprblock.rightp) );
620:
621: case OPASSIGN:
622: case OPPLUSEQ:
623: return( isaddr(p->exprblock.leftp) );
624: }
625: return(NO);
626: }
627:
628:
629:
630:
631:
632: addressable(p)
633: register expptr p;
634: {
635: switch(p->headblock.tag)
636: {
637: case TCONST:
638: return(YES);
639:
640: case TADDR:
641: return( addressable(p->addrblock.memoffset) );
642:
643: default:
644: return(NO);
645: }
646: }
647:
648:
649:
650: hextoi(c)
651: register int c;
652: {
653: register char *p;
654: static char p0[17] = "0123456789abcdef";
655:
656: for(p = p0 ; *p ; ++p)
657: if(*p == c)
658: return( p-p0 );
659: return(16);
660: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.