2.11BSD#431 - /usr/src/new/OLD/apl/src/lex.c

   1: static char lex_c_Sccsid[] = "lex.c @(#)lex.c	1.3	10/5/82 Berkeley ";
   2: #define lv yylval
   3: #define v yyval
   4: 
   5: int xxpeek[2] = {0,0};
   6: 
   7: yylex()
   8: {
   9:     register c, rval;
  10:     register struct tab *tp;
  11: 
  12:     if(nlexsym != -1) { /* first token is lexical context */
  13:         c = nlexsym;
  14:         nlexsym = -1;
  15:         return(c);
  16:     }
  17:     while(litflag > 0) {    /* comment */
  18:         c = *iline++;
  19:         if(c == '\n') {
  20:             nlexsym = 0;
  21:             return(eol);
  22:         }
  23:     }
  24:     if(xxpeek[0] != 0){
  25:         lv.charval = xxpeek[0];     /* may want charptr here */
  26:         xxpeek[0] = 0;
  27:         return(xxpeek[1]);
  28:     }
  29:     do
  30:         c = *iline++;
  31:     while(c == ' ');
  32:     if(c == '\n') {
  33:         nlexsym = 0;
  34:         return(eol);
  35:     }
  36:     if(alpha(c))
  37:         return(getnam(c));
  38:     if(digit(c) || c == '`' ||  /* '`' was '"' */
  39:             (c=='.' && digit(*iline)))
  40:             return(getnum(c));
  41:         c &= 0377;
  42:     rval = unk;
  43:     for(tp = tab; tp->input; tp++)
  44:         if(tp->input == c) {
  45:             lv.charval = tp->lexval;
  46:             rval = tp->retval;
  47:             break;
  48:         }
  49:     if(lv.charval == QUAD)
  50:         return(getquad());
  51:     if(lv.charval == ISP){
  52:         lv.charval = ISP2;
  53:         xxpeek[0] = ISP1;
  54:         xxpeek[1] = m;
  55:         return(d);
  56:     }
  57:     if(lv.charval == PSI){
  58:         lv.charval = PSI2;
  59:         xxpeek[0] = PSI1;
  60:         xxpeek[1] = m;
  61:         return(d);
  62:     }
  63:     return(rval);
  64: }
  65: 
  66: getquad()
  67: {
  68:     register char c, *p1;
  69:     register struct qtab *p2;
  70:     char qbuf[10];
  71: 
  72:     p1 = qbuf;
  73:     while(alpha(*iline))
  74:         if (p1 < qbuf + sizeof qbuf)
  75:             *p1++ = *iline++;
  76:         else
  77:             iline++;
  78:     *p1++ = 0;
  79:     if(*qbuf == 0)
  80:         return(Quad);       /* ordinary quad */
  81:     for(p2 = qtab; p2->qname; p2++){
  82:         if(equal(p2->qname, qbuf)){
  83:             lv.charval = p2->qtype;
  84:             return(p2->rtype);
  85:         }
  86:     }
  87:     return(unk);
  88: }
  89: 
  90: getnam(ic)
  91: {
  92:     char name[NAMS];
  93:     register c;
  94:     register char *cp;
  95:     register struct nlist *np;
  96: 
  97:     c = ic;
  98:     cp = name;
  99:     do {
 100:         if(cp >= &name[NAMS])
 101:             error("var name D");
 102:         *cp++ = c;
 103:         c = *iline++;
 104:     } while(alpha(c) || digit(c));
 105:     *cp++ = 0;
 106:     iline--;
 107:     if(litflag == -1) { /* commands */
 108:         litflag = -2;
 109:         for(c=0; comtab[c].ct_name; c++)
 110:             if(equal(name, comtab[c].ct_name))
 111:                 break;
 112:         immedcmd = lv.charval = comtab[c].ct_ylval;
 113:         return(comtab[c].ct_ytype);
 114:     }
 115:     for(np=nlist; np->namep; np++)
 116:     if(equal(np->namep, name)) {
 117:         lv.charptr = (char *)np;
 118:         switch(np->use) {
 119: 
 120:         case NF:
 121:             if (context == lex2) sichk(np);
 122:             return(nfun);
 123: 
 124:         case MF:
 125:             if (context == lex2) sichk(np);
 126:             return(mfun);
 127: 
 128:         case DF:
 129:             if (context == lex2) sichk(np);
 130:             return(dfun);
 131:         }
 132:         return(nam);
 133:     }
 134:     np->namep = alloc(cp-name);
 135:     copy(CH, name, np->namep, cp-name);
 136:     np->type = LV;
 137:     lv.charptr = (char *)np;
 138:     return(nam);
 139: }
 140: 
 141: getnum(ic)
 142: {
 143:     double d1, d2;
 144:     register c, n, n1;
 145:     int s, s1;
 146: 
 147:     s = 0;
 148:     n = 0;
 149:     d1 = 0.;
 150:     c = ic;
 151:     if(c == '`') {  /* '`' was '"' */
 152:         s++;
 153:         c = *iline++;
 154:     }
 155:     while(digit(c)) {
 156:         d1 = d1*10. + c - '0';
 157:         c = *iline++;
 158:     }
 159:     if(c == '.') {
 160:         c = *iline++;
 161:         while(digit(c)) {
 162:             d1 = d1*10. + c - '0';
 163:             c = *iline++;
 164:             n--;
 165:         }
 166:     }
 167:     if(c == 'e') {
 168:         s1 = 0;
 169:         n1 = 0;
 170:         c = *iline++;
 171:         if(c == '`') {  /* '`' was '"' */
 172:             s1++;
 173:             c = *iline++;
 174:         }
 175:         while(digit(c)) {
 176:             n1 = n1*10 + c - '0';
 177:             c = *iline++;
 178:         }
 179:         if(s1)
 180:             n -= n1; else
 181:             n += n1;
 182:     }
 183:     n1 = n;
 184:     if(n1 < 0)
 185:         n1 = -n1;
 186:     d2 = 1.;
 187:     while(n1--)
 188:         d2 *= 10.;
 189:     if(n < 0)
 190:         d1 /= d2; else
 191:         d1 *= d2;
 192:     if(s)
 193:         d1 = -d1;
 194:     iline--;
 195:     datum = d1;
 196:     return(numb);
 197: }
 198: 
 199: alpha(s)
 200: {
 201:     register c;
 202: 
 203:     c = s & 0377;
 204:     return(
 205:         (c >= 'a' && c <= 'z')
 206:         || (c == 'F')
 207:         || (c >= 0243)
 208:         || (litflag == -2 && (
 209:                c == '/'
 210:             || c == '.'
 211:            ))
 212:     );
 213: }
 214: 
 215: digit(s)
 216: {
 217:     register c;
 218: 
 219:     c = s;
 220:     if(c >='0' && c <= '9')
 221:         return(1);
 222:     return(0);
 223: }
 224: 
 225: /*
 226:  * s is statement
 227:  * f is execution flag:
 228:  *	0 compile immediate
 229:  *	1 compile L
 230:  *	2 function definition
 231:  *	3 function prolog
 232:  *	4 function epilog
 233:  *	5 function body
 234:  */
 235: int     ilex[] =
 236: {
 237:     lex0, lex1, lex2, lex3, lex4, lex5, lex6
 238: };
 239: 
 240: char *
 241: compile(s, f)
 242: char *s;
 243: {
 244:     register char *p, *q;
 245:     char oline[OBJS];
 246: 
 247:     iline = s;
 248:     ccharp = oline;
 249:     litflag = 0;
 250:     nlexsym = ilex[f];
 251:     context = nlexsym;
 252:     if(yyparse()) {
 253:         pline(s, iline-s);
 254:         if(iline-s > 1)
 255:             printf("syntax error\n");
 256:         return(0);
 257:     }
 258:     *ccharp++ = EOF;
 259:     p = alloc(ccharp-oline);
 260:     iline = p;
 261:     for(q=oline; q<ccharp;)
 262:         *p++ = *q++;
 263:     return(iline);
 264: }
 265: 
 266: yyerror()
 267: {
 268: }
 269: 
 270: char *
 271: name(np, c)
 272: {
 273:     register char *p, *npp;
 274: 
 275:     p = ccharp;
 276:     npp = (char *)&np;
 277:     *ccharp++ = c;
 278:     *ccharp++ = *npp++;
 279: #ifdef vax
 280:     *ccharp++ = *npp++;
 281:     *ccharp++ = *npp++;
 282: #endif
 283:     *ccharp++ = *npp;
 284:     return(p);
 285: }
 286: 
 287: equal(a, b)
 288: char *a, *b;
 289: {
 290:     register char *c1, *c2;
 291: 
 292:     c1 = a;
 293:     c2 = b;
 294:     while(*c1++ == *c2)
 295:         if(*c2++ == 0)
 296:             return(1);
 297:     return(0);
 298: }
 299: 
 300: invert(a, b)
 301: {
 302: 
 303:     flop(a, b);
 304:     flop(b, ccharp);
 305:     flop(a, ccharp);
 306: }
 307: 
 308: flop(a, b)
 309: char *a, *b;
 310: {
 311:     register char *a1, *a2;
 312:     register c;
 313: 
 314:     a1 = a;
 315:     a2 = b;
 316:     while(a1 < a2) {
 317:         c = *a1;
 318:         *a1++ = *--a2;
 319:         *a2 = c;
 320:     }
 321: }
 322: 
 323: /*
 324:  * genlab -- generates label code onto label stacks.
 325:  *
 326:  * prologue:	AUTO-lab, CONST-linenum, NAME-lab LABEL
 327:  *
 328:  * epilog:	REST-lab
 329:  */
 330: genlab(np)
 331: struct nlist *np;
 332: {
 333: 
 334:     /* label prologue */
 335: 
 336:     *labcpp++ = AUTO;
 337:     labcpp += copy(IN, &np, labcpp, 1);
 338:     *labcpp++ = CONST;
 339:     *labcpp++ = 1;
 340:     labcpp += copy(DA, &lnumb, labcpp, 1);
 341:     *labcpp++ = NAME;
 342:     labcpp += copy(IN, &np, labcpp, 1);
 343:     *labcpp++ = LABEL;
 344:     *labcpp = EOF;
 345: 
 346:     /* label epilog */
 347: 
 348:     *labcpe++ = REST;
 349:     labcpe += copy(IN, &np, labcpe, 1);
 350:     *labcpe = EOF;
 351: }

Defined functions

Defined variables

Defined macros

Usage of this include