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