|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.