1: #include <ctype.h>
   2: #include "defs"
   3: 
   4: char * copys(s)
   5: register char *s;
   6: {
   7: register char *t;
   8: char *k;
   9: ptr calloc();
  10: 
  11: for(t=s; *t++ ; );
  12: if( (k = calloc( t-s , sizeof(char))) == NULL)
  13:     fatal("Cannot allocate memory");
  14: 
  15: for(t=k ; *t++ = *s++ ; );
  16: return(k);
  17: }
  18: 
  19: 
  20: 
  21: equals(a,b)
  22: register char *a,*b;
  23: {
  24: if(a==b) return(YES);
  25: 
  26: while(*a == *b)
  27:     if(*a == '\0') return(YES);
  28:     else {++a; ++b;}
  29: 
  30: return(NO);
  31: }
  32: 
  33: 
  34: char *concat(a,b,c)   /* c = concatenation of a and b */
  35: register char *a,*b;
  36: char *c;
  37: {
  38: register char *t;
  39: t = c;
  40: 
  41: while(*t = *a++) t++;
  42: while(*t++ = *b++);
  43: return(c);
  44: }
  45: 
  46: 
  47: 
  48: 
  49: 
  50: ptr conrep(a,b)
  51: char *a, *b;
  52: {
  53: char *s;
  54: 
  55: s = intalloc( strlen(a)+strlen(b)+1 );
  56: concat(a,b,s);
  57: cfree(a);
  58: return(s);
  59: }
  60: 
  61: 
  62: eqcon(p,q)
  63: register ptr p, q;
  64: {
  65: int pt, qt;
  66: 
  67: if(p==q) return(YES);
  68: if(p==NULL || q==NULL) return(NO);
  69: pt = p->tag;
  70: qt = q->tag;
  71: if(pt==TNEGOP && qt==TNEGOP)
  72:     return( eqcon(p->leftp, q->leftp) );
  73: if(pt==TCONST && qt==TNEGOP)
  74:     return(NO);
  75: if(pt==TNEGOP && qt==TCONST)
  76:     return(NO);
  77: if(p->tag==TCONST && q->tag==TCONST)
  78:     return( equals(p->leftp,q->leftp) );
  79: 
  80: fatal("eqcon: nonconstant argument");
  81: /* NOTREACHED */
  82: }
  83: 
  84: 
  85: 
  86: char *convic(n)
  87: register int n;
  88: {
  89: static char s[20];
  90: register char *t;
  91: 
  92: s[19] = '\0';
  93: t = s+19;
  94: 
  95: do  {
  96:     *--t = '0' + n%10;
  97:     n /= 10;
  98:     } while(n > 0);
  99: 
 100: return(t);
 101: }
 102: 
 103: 
 104: 
 105: conval(p)
 106: register ptr p;
 107: {
 108: int val;
 109: if(isicon(p, &val))
 110:     return(val);
 111: fatal("bad conval");
 112: }
 113: 
 114: 
 115: 
 116: isicon(p, valp)
 117: ptr p;
 118: int *valp;
 119: {
 120: int val1;
 121: 
 122: if(p)
 123:     switch(p->tag)
 124:     {
 125:     case TNEGOP:
 126:         if(isicon(p->leftp, &val1))
 127:             {
 128:             *valp = - val1;
 129:             return(1);
 130:             }
 131:         break;
 132: 
 133:     case TCONST:
 134:         if(p->vtype == TYINT)
 135:             {
 136:             *valp = convci(p->leftp);
 137:             return(YES);
 138:             }
 139:     default:
 140:         break;
 141:     }
 142: return(NO);
 143: }
 144: 
 145: 
 146: 
 147: isconst(p)
 148: ptr p;
 149: {
 150: return(p->tag==TCONST  ||  (p->tag==TNEGOP && isconst(p->leftp)) );
 151: }
 152: 
 153: 
 154: 
 155: iszero(s)
 156: register char *s;
 157: {
 158: if(s == NULL)
 159:     return(YES);
 160: while( *s=='+' || *s=='-' || *s==' ' )
 161:     ++s;
 162: while( *s=='0' || *s=='.' )
 163:     ++s;
 164: switch( *s )
 165:     {
 166:     case 'd':
 167:     case 'e':
 168:     case 'D':
 169:     case 'E':
 170:     case ' ':
 171:     case '\0':
 172:         return(YES);
 173:     default:
 174:         return(NO);
 175:     }
 176: }
 177: 
 178: 
 179: 
 180: 
 181: convci(p)
 182: register char *p;
 183: {
 184: register int n;
 185: register int sgn;
 186: 
 187: n = 0;
 188: sgn = 1;
 189: for( ; *p ; ++p)
 190:     if(*p == '-')
 191:         sgn = -1;
 192:     else if( isdigit(*p) )
 193:         n = 10*n + (*p - '0');
 194: 
 195: return(sgn * n);
 196: }
 197: 
 198: 
 199: 
 200: chainp hookup(x,y)
 201: register chainp x, y;
 202: {
 203: register chainp p;
 204: 
 205: if(x == NULL)
 206:     return(y);
 207: for(p=x ; p->nextp ; p = p->nextp)
 208:     ;
 209: 
 210: p->nextp = y;
 211: return(x);
 212: }
 213: 
 214: 
 215: ptr cpexpr(p)
 216: register ptr p;
 217: {
 218: register ptr e;
 219: ptr q, q1;
 220: 
 221: if(p == NULL)
 222:     return(NULL);
 223: 
 224: e = allexpblock();
 225: cpblock(p, e, sizeof(struct exprblock));
 226: 
 227: switch(p->tag)
 228:     {
 229:     case TAROP:
 230:     case TRELOP:
 231:     case TLOGOP:
 232:     case TASGNOP:
 233:     case TCALL:
 234:         e->rightp = cpexpr(p->rightp);
 235: 
 236:     case TNOTOP:
 237:     case TNEGOP:
 238:         e->leftp = cpexpr(p->leftp);
 239:         break;
 240: 
 241:     case TCONST:
 242:         e->leftp = copys(p->leftp);
 243:         if(p->rightp)
 244:             e->rightp = copys(p->rightp);
 245:         if(p->vtype == TYCHAR)
 246:             e->vtypep = cpexpr(p->vtypep);
 247:         break;
 248: 
 249:     case TLIST:
 250:         q1 = &(e->leftp);
 251:         for(q = p->leftp ; q ; q = q->nextp)
 252:             q1 = q1->nextp = mkchain( cpexpr(q->datap), CHNULL);
 253:         break;
 254: 
 255:     case TTEMP:
 256:     case TNAME:
 257:     case TFTNBLOCK:
 258:         if(p->vsubs)
 259:             e->vsubs = cpexpr(p->vsubs);
 260:         if(p->voffset)
 261:             e->voffset = cpexpr(p->voffset);
 262:         break;
 263: 
 264:     case TERROR:
 265:         break;
 266: 
 267:     default:
 268:         badtag("cpexpr", p->tag);
 269:     }
 270: return(e);
 271: }
 272: 
 273: 
 274: mvexpr(p,q)
 275: char *p, *q;
 276: {
 277: cpblock(p,q, sizeof(struct exprblock) );
 278: frexpblock(p);
 279: }
 280: 
 281: 
 282: cpblock(p,q,n)
 283: register char *p, *q;
 284: int n;
 285: {
 286: register int i;
 287: 
 288: for(i=0; i<n; ++i)
 289:     *q++ = *p++;
 290: }
 291: 
 292: 
 293: 
 294: strlen(s)
 295: register char *s;
 296: {
 297: register char *t;
 298: for(t=s ; *t ; t++ ) ;
 299: return(t-s);
 300: }
 301: 
 302: 
 303: char *procnm()  /* name of the current procedure */
 304: {
 305: return( procname ? procname->sthead->namep : "" );
 306: }
 307: 
 308: 
 309: 
 310: 
 311: 
 312: ptr arg1(a)     /* make an argument list of one value */
 313: ptr a;
 314: {
 315: return( mknode(TLIST,0, mkchain(a,CHNULL), PNULL) );
 316: }
 317: 
 318: 
 319: 
 320: ptr arg2(a,b)   /* make an argumentlist (a,b) */
 321: ptr a,b;
 322: {
 323: register ptr p;
 324: 
 325: p = mkchain(a, mkchain(b,CHNULL) );
 326: return( mknode(TLIST,0, p,0) );
 327: }
 328: 
 329: 
 330: 
 331: 
 332: ptr arg4(a,b)   /* make an argument list of  (a,len(a), b,len(b)) */
 333: ptr a,b;
 334: {
 335: register ptr p;
 336: p = mkchain(b, mkchain(cpexpr(b->vtypep), CHNULL));
 337: p = mkchain(a, mkchain(cpexpr(a->vtypep), p));
 338: return( mknode(TLIST,0,p,PNULL));
 339: }
 340: 
 341: 
 342: 
 343: ptr builtin(type,s)
 344: int type;
 345: char *s;
 346: {
 347: register ptr p, q;
 348: ptr mkvar(), mkname();
 349: 
 350: if(p = name(s,1))
 351:     {
 352:     if(p->blklevel>1 || (p->tag!=TNAME && p->tag!=TKEYWORD)
 353:         || (q=p->varp)==0 || q->vext
 354:         || (q->vtype!=type && q->vtype!=TYUNDEFINED) )
 355:         {
 356:         exprerr("error involving builtin %s", s);
 357:         return(errnode());
 358:         }
 359:     if(q->vtype!= TYUNDEFINED)
 360:         return( cpexpr(q) );
 361:     }
 362: else    {
 363:     q = mkvar( mkname(s) );
 364:     if(blklevel > 1)
 365:         {
 366:         q->blklevel = 1;
 367:         q->sthead->blklevel = 1;
 368:         --ndecl[blklevel];
 369:         ++ndecl[1];
 370:         }
 371:     }
 372: 
 373: q->vtype = type;
 374: q->vdclstart = 1;
 375: mkftnp(q);
 376: return( cpexpr(q) );
 377: }
 378: 
 379: 
 380: 
 381: ptr errnode()
 382: {
 383: register struct exprblock * p;
 384: 
 385: p = allexpblock();
 386: p->tag = TERROR;
 387: p->vtype = TYINT;
 388: return(p);
 389: }
 390: 
 391: 
 392: 
 393: min(a,b)
 394: int a,b;
 395: {
 396: return( a<b ? a : b);
 397: }
 398: 
 399: 
 400: 
 401: setvproc(p, v)
 402: register ptr p;
 403: register int v;
 404: {
 405: ptr q;
 406: register int k;
 407: 
 408: q = p->sthead->varp;
 409: k = q->vproc;
 410: /*debug printf("setvproc(%s ,%d)\n", q->sthead->namep, v); */
 411: if(p != q)
 412:     p->vproc = k;
 413: if(k == v)
 414:     return;
 415: 
 416: if(k==PROCUNKNOWN || (k==PROCYES && v==PROCINTRINSIC) )
 417:     p->vproc = q->vproc = v;
 418: else if( !(k==PROCINTRINSIC && v==PROCYES)  && p->sthead->varp!=procname)
 419:     execerr("attempt to use %s as variable and procedure",
 420:         p->sthead->namep);
 421: }

Defined functions

arg1 defined in line 312; used 5 times
arg4 defined in line 332; used 2 times
concat defined in line 34; used 3 times
conrep defined in line 50; used 4 times
cpblock defined in line 282; used 5 times
eqcon defined in line 62; used 2 times
hookup defined in line 200; used 2 times
isconst defined in line 147; used 5 times
iszero defined in line 155; never used
min defined in line 393; used 1 times
mvexpr defined in line 274; used 2 times
procnm defined in line 303; used 2 times

Defined variables

ptr defined in line 312; used 23 times
Last modified: 1982-06-09
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1429
Valid CSS Valid XHTML 1.0 Strict