![[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 [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1|
Return to misc.c CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char sccsid[] = "@(#)misc.c 5.1 (Berkeley) 6/7/85";
9: #endif not lint
10:
11: /*
12: * misc.c
13: *
14: * Miscellaneous routines for the f77 compiler, 4.2 BSD.
15: *
16: * University of Utah CS Dept modification history:
17: *
18: * $Log: misc.c,v $
19: * Revision 1.2 86/02/12 15:28:35 rcs
20: * 4.3 F77. C. Keating.
21: *
22: * Revision 3.1 84/10/13 01:53:26 donn
23: * Installed Jerry Berkman's version; added UofU comment header.
24: *
25: */
26:
27: #include "defs.h"
28:
29:
30:
31: cpn(n, a, b)
32: register int n;
33: register char *a, *b;
34: {
35: while(--n >= 0)
36: *b++ = *a++;
37: }
38:
39:
40:
41: eqn(n, a, b)
42: register int n;
43: register char *a, *b;
44: {
45: while(--n >= 0)
46: if(*a++ != *b++)
47: return(NO);
48: return(YES);
49: }
50:
51:
52:
53:
54:
55:
56:
57: cmpstr(a, b, la, lb) /* compare two strings */
58: register char *a, *b;
59: ftnint la, lb;
60: {
61: register char *aend, *bend;
62: aend = a + la;
63: bend = b + lb;
64:
65:
66: if(la <= lb)
67: {
68: while(a < aend)
69: if(*a != *b)
70: return( *a - *b );
71: else
72: { ++a; ++b; }
73:
74: while(b < bend)
75: if(*b != ' ')
76: return(' ' - *b);
77: else
78: ++b;
79: }
80:
81: else
82: {
83: while(b < bend)
84: if(*a != *b)
85: return( *a - *b );
86: else
87: { ++a; ++b; }
88: while(a < aend)
89: if(*a != ' ')
90: return(*a - ' ');
91: else
92: ++a;
93: }
94: return(0);
95: }
96:
97:
98:
99:
100:
101: chainp hookup(x,y)
102: register chainp x, y;
103: {
104: register chainp p;
105:
106: if(x == NULL)
107: return(y);
108:
109: for(p = x ; p->nextp ; p = p->nextp)
110: ;
111: p->nextp = y;
112: return(x);
113: }
114:
115:
116:
117: struct Listblock *mklist(p)
118: chainp p;
119: {
120: register struct Listblock *q;
121:
122: q = ALLOC(Listblock);
123: q->tag = TLIST;
124: q->listp = p;
125: return(q);
126: }
127:
128:
129: chainp mkchain(p,q)
130: register tagptr p;
131: register chainp q;
132: {
133: register chainp r;
134:
135: if(chains)
136: {
137: r = chains;
138: chains = chains->nextp;
139: }
140: else
141: r = ALLOC(Chain);
142:
143: r->datap = p;
144: r->nextp = q;
145: return(r);
146: }
147:
148:
149:
150: char * varstr(n, s)
151: register int n;
152: register char *s;
153: {
154: register int i;
155: static char name[XL+1];
156:
157: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++i)
158: name[i] = *s++;
159:
160: name[i] = '\0';
161:
162: return( name );
163: }
164:
165:
166:
167:
168: char * varunder(n, s)
169: register int n;
170: register char *s;
171: {
172: register int i;
173: static char name[XL+1];
174:
175: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++i)
176: name[i] = *s++;
177:
178: #if TARGET != GCOS
179: name[i++] = '_';
180: #endif
181:
182: name[i] = '\0';
183:
184: return( name );
185: }
186:
187:
188:
189:
190:
191: char * nounder(n, s)
192: register int n;
193: register char *s;
194: {
195: register int i;
196: static char name[XL+1];
197:
198: for(i=0; i<n && *s!=' ' && *s!='\0' ; ++s)
199: if(*s != '_')
200: name[i++] = *s;
201:
202: name[i] = '\0';
203:
204: return( name );
205: }
206:
207:
208:
209: char *copyn(n, s)
210: register int n;
211: register char *s;
212: {
213: register char *p, *q;
214:
215: p = q = (char *) ckalloc(n);
216: while(--n >= 0)
217: *q++ = *s++;
218: return(p);
219: }
220:
221:
222:
223: char *copys(s)
224: char *s;
225: {
226: return( copyn( strlen(s)+1 , s) );
227: }
228:
229:
230:
231: ftnint convci(n, s)
232: register int n;
233: register char *s;
234: {
235: ftnint sum;
236: ftnint digval;
237: sum = 0;
238: while(n-- > 0)
239: {
240: if (sum > MAXINT/10 ) {
241: err("integer constant too large");
242: return(sum);
243: }
244: sum *= 10;
245: digval = *s++ - '0';
246: #if (TARGET == TAHOE)
247: sum += digval;
248: #endif
249: #if (TARGET == VAX)
250: if ( MAXINT - sum >= digval ) {
251: sum += digval;
252: } else {
253: /* KLUDGE. On VAXs, MININT is (-MAXINT)-1 , i.e., there
254: is one more neg. integer than pos. integer. The
255: following code returns MININT whenever (MAXINT+1)
256: is seen. On VAXs, such statements as: i = MININT
257: work, although this generates garbage for
258: such statements as: i = MPLUS1 where MPLUS1 is MAXINT+1
259: or: i = 5 - 2147483647/2 .
260: The only excuse for this kludge is it keeps all legal
261: programs running and flags most illegal constants, unlike
262: the previous version which flaged nothing outside data stmts!
263: */
264: if ( n == 0 && MAXINT - sum + 1 == digval ) {
265: warn("minimum negative integer compiled - possibly bad code");
266: sum = MININT;
267: } else {
268: err("integer constant too large");
269: return(sum);
270: }
271: }
272: #endif
273: }
274: return(sum);
275: }
276:
277: char *convic(n)
278: ftnint n;
279: {
280: static char s[20];
281: register char *t;
282:
283: s[19] = '\0';
284: t = s+19;
285:
286: do {
287: *--t = '0' + n%10;
288: n /= 10;
289: } while(n > 0);
290:
291: return(t);
292: }
293:
294:
295:
296: double convcd(n, s)
297: int n;
298: register char *s;
299: {
300: double atof();
301: char v[100];
302: register char *t;
303: if(n > 90)
304: {
305: err("too many digits in floating constant");
306: n = 90;
307: }
308: for(t = v ; n-- > 0 ; s++)
309: *t++ = (*s=='d' ? 'e' : *s);
310: *t = '\0';
311: return( atof(v) );
312: }
313:
314:
315:
316: Namep mkname(l, s)
317: int l;
318: register char *s;
319: {
320: struct Hashentry *hp;
321: int hash;
322: register Namep q;
323: register int i;
324: char n[VL];
325:
326: hash = 0;
327: for(i = 0 ; i<l && *s!='\0' ; ++i)
328: {
329: hash += *s;
330: n[i] = *s++;
331: }
332: hash %= maxhash;
333: while( i < VL )
334: n[i++] = ' ';
335:
336: hp = hashtab + hash;
337: while(q = hp->varp)
338: if( hash==hp->hashval && eqn(VL,n,q->varname) )
339: return(q);
340: else if(++hp >= lasthash)
341: hp = hashtab;
342:
343: if(++nintnames >= maxhash-1)
344: many("names", 'n');
345: hp->varp = q = ALLOC(Nameblock);
346: hp->hashval = hash;
347: q->tag = TNAME;
348: cpn(VL, n, q->varname);
349: return(q);
350: }
351:
352:
353:
354: struct Labelblock *mklabel(l)
355: ftnint l;
356: {
357: register struct Labelblock *lp;
358:
359: if(l <= 0 || l > 99999 ) {
360: errstr("illegal label %d", l);
361: return(NULL);
362: }
363:
364: for(lp = labeltab ; lp < highlabtab ; ++lp)
365: if(lp->stateno == l)
366: return(lp);
367:
368: if(++highlabtab > labtabend)
369: many("statement numbers", 's');
370:
371: lp->stateno = l;
372: lp->labelno = newlabel();
373: lp->blklevel = 0;
374: lp->labused = NO;
375: lp->labdefined = NO;
376: lp->labinacc = NO;
377: lp->labtype = LABUNKNOWN;
378: return(lp);
379: }
380:
381:
382: newlabel()
383: {
384: return( ++lastlabno );
385: }
386:
387:
388: /* this label appears in a branch context */
389:
390: struct Labelblock *execlab(stateno)
391: ftnint stateno;
392: {
393: register struct Labelblock *lp;
394:
395: if(lp = mklabel(stateno))
396: {
397: if(lp->labinacc)
398: warn1("illegal branch to inner block, statement %s",
399: convic(stateno) );
400: else if(lp->labdefined == NO)
401: lp->blklevel = blklevel;
402: lp->labused = YES;
403: if(lp->labtype == LABFORMAT)
404: err("may not branch to a format");
405: else
406: lp->labtype = LABEXEC;
407: }
408:
409: return(lp);
410: }
411:
412:
413:
414:
415:
416: /* find or put a name in the external symbol table */
417:
418: struct Extsym *mkext(s)
419: char *s;
420: {
421: int i;
422: register char *t;
423: char n[XL];
424: struct Extsym *p;
425:
426: i = 0;
427: t = n;
428: while(i<XL && *s)
429: *t++ = *s++;
430: while(t < n+XL)
431: *t++ = ' ';
432:
433: for(p = extsymtab ; p<nextext ; ++p)
434: if(eqn(XL, n, p->extname))
435: return( p );
436:
437: if(nextext >= lastext)
438: many("external symbols", 'x');
439:
440: cpn(XL, n, nextext->extname);
441: nextext->extstg = STGUNKNOWN;
442: nextext->extsave = NO;
443: nextext->extp = 0;
444: nextext->extleng = 0;
445: nextext->maxleng = 0;
446: nextext->extinit = NO;
447: return( nextext++ );
448: }
449:
450:
451:
452:
453:
454:
455:
456:
457: Addrp builtin(t, s)
458: int t;
459: char *s;
460: {
461: register struct Extsym *p;
462: register Addrp q;
463:
464: p = mkext(s);
465: if(p->extstg == STGUNKNOWN)
466: p->extstg = STGEXT;
467: else if(p->extstg != STGEXT)
468: {
469: errstr("improper use of builtin %s", s);
470: return(0);
471: }
472:
473: q = ALLOC(Addrblock);
474: q->tag = TADDR;
475: q->vtype = t;
476: q->vclass = CLPROC;
477: q->vstg = STGEXT;
478: q->memno = p - extsymtab;
479: return(q);
480: }
481:
482:
483:
484: frchain(p)
485: register chainp *p;
486: {
487: register chainp q;
488:
489: if(p==0 || *p==0)
490: return;
491:
492: for(q = *p; q->nextp ; q = q->nextp)
493: ;
494: q->nextp = chains;
495: chains = *p;
496: *p = 0;
497: }
498:
499:
500: tagptr cpblock(n,p)
501: register int n;
502: register char * p;
503: {
504: register char *q;
505: ptr q0;
506:
507: q0 = ckalloc(n);
508: q = (char *) q0;
509: while(n-- > 0)
510: *q++ = *p++;
511: return( (tagptr) q0);
512: }
513:
514:
515:
516: max(a,b)
517: int a,b;
518: {
519: return( a>b ? a : b);
520: }
521:
522:
523: ftnint lmax(a, b)
524: ftnint a, b;
525: {
526: return( a>b ? a : b);
527: }
528:
529: ftnint lmin(a, b)
530: ftnint a, b;
531: {
532: return(a < b ? a : b);
533: }
534:
535:
536:
537:
538: maxtype(t1, t2)
539: int t1, t2;
540: {
541: int t;
542:
543: t = max(t1, t2);
544: if(t==TYCOMPLEX && (t1==TYDREAL || t2==TYDREAL) )
545: t = TYDCOMPLEX;
546: return(t);
547: }
548:
549:
550:
551: /* return log base 2 of n if n a power of 2; otherwise -1 */
552: #if FAMILY == PCC
553: log2(n)
554: ftnint n;
555: {
556: int k;
557:
558: /* trick based on binary representation */
559:
560: if(n<=0 || (n & (n-1))!=0)
561: return(-1);
562:
563: for(k = 0 ; n >>= 1 ; ++k)
564: ;
565: return(k);
566: }
567: #endif
568:
569:
570:
571: frrpl()
572: {
573: struct Rplblock *rp;
574:
575: while(rpllist)
576: {
577: rp = rpllist->rplnextp;
578: free( (charptr) rpllist);
579: rpllist = rp;
580: }
581: }
582:
583:
584:
585: expptr callk(type, name, args)
586: int type;
587: char *name;
588: chainp args;
589: {
590: register expptr p;
591:
592: p = mkexpr(OPCALL, builtin(type,name), args);
593: p->exprblock.vtype = type;
594: return(p);
595: }
596:
597:
598:
599: expptr call4(type, name, arg1, arg2, arg3, arg4)
600: int type;
601: char *name;
602: expptr arg1, arg2, arg3, arg4;
603: {
604: struct Listblock *args;
605: args = mklist( mkchain(arg1, mkchain(arg2, mkchain(arg3,
606: mkchain(arg4, CHNULL)) ) ) );
607: return( callk(type, name, args) );
608: }
609:
610:
611:
612:
613: expptr call3(type, name, arg1, arg2, arg3)
614: int type;
615: char *name;
616: expptr arg1, arg2, arg3;
617: {
618: struct Listblock *args;
619: args = mklist( mkchain(arg1, mkchain(arg2, mkchain(arg3, CHNULL) ) ) );
620: return( callk(type, name, args) );
621: }
622:
623:
624:
625:
626:
627: expptr call2(type, name, arg1, arg2)
628: int type;
629: char *name;
630: expptr arg1, arg2;
631: {
632: struct Listblock *args;
633:
634: args = mklist( mkchain(arg1, mkchain(arg2, CHNULL) ) );
635: return( callk(type,name, args) );
636: }
637:
638:
639:
640:
641: expptr call1(type, name, arg)
642: int type;
643: char *name;
644: expptr arg;
645: {
646: return( callk(type,name, mklist(mkchain(arg,CHNULL)) ));
647: }
648:
649:
650: expptr call0(type, name)
651: int type;
652: char *name;
653: {
654: return( callk(type, name, PNULL) );
655: }
656:
657:
658:
659: struct Impldoblock *mkiodo(dospec, list)
660: chainp dospec, list;
661: {
662: register struct Impldoblock *q;
663:
664: q = ALLOC(Impldoblock);
665: q->tag = TIMPLDO;
666: q->impdospec = dospec;
667: q->datalist = list;
668: return(q);
669: }
670:
671:
672:
673:
674: ptr ckalloc(n)
675: register int n;
676: {
677: register ptr p;
678: ptr calloc();
679:
680: if( p = calloc(1, (unsigned) n) )
681: return(p);
682:
683: fatal("out of memory");
684: /* NOTREACHED */
685: }
686:
687:
688:
689:
690:
691: isaddr(p)
692: register expptr p;
693: {
694: if(p->tag == TADDR)
695: return(YES);
696: if(p->tag == TEXPR)
697: switch(p->exprblock.opcode)
698: {
699: case OPCOMMA:
700: return( isaddr(p->exprblock.rightp) );
701:
702: case OPASSIGN:
703: case OPPLUSEQ:
704: return( isaddr(p->exprblock.leftp) );
705: }
706: return(NO);
707: }
708:
709:
710:
711:
712: isstatic(p)
713: register expptr p;
714: {
715: if(p->headblock.vleng && !ISCONST(p->headblock.vleng))
716: return(NO);
717:
718: switch(p->tag)
719: {
720: case TCONST:
721: return(YES);
722:
723: case TADDR:
724: if(ONEOF(p->addrblock.vstg,MSKSTATIC) &&
725: ISCONST(p->addrblock.memoffset))
726: return(YES);
727:
728: default:
729: return(NO);
730: }
731: }
732:
733:
734:
735: addressable(p)
736: register expptr p;
737: {
738: switch(p->tag)
739: {
740: case TCONST:
741: return(YES);
742:
743: case TADDR:
744: return( addressable(p->addrblock.memoffset) );
745:
746: default:
747: return(NO);
748: }
749: }
750:
751:
752:
753: hextoi(c)
754: register int c;
755: {
756: register char *p;
757: static char p0[17] = "0123456789abcdef";
758:
759: for(p = p0 ; *p ; ++p)
760: if(*p == c)
761: return( p-p0 );
762: return(16);
763: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.