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