4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/misc.c

   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: }

Defined functions

Defined variables