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