toke.c

   1 /* $Header: toke.c,v 3.0.1.3 89/11/17 15:43:15 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        toke.c,v $
   9  * Revision 3.0.1.3  89/11/17  15:43:15  lwall
  10  * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros
  11  * patch5: } misadjusted expection of subsequent term or operator
  12  * patch5: y/abcde// didn't work
  13  *
  14  * Revision 3.0.1.2  89/11/11  05:04:42  lwall
  15  * patch2: fixed a CLINE macro conflict
  16  *
  17  * Revision 3.0.1.1  89/10/26  23:26:21  lwall
  18  * patch1: disambiguated word after "sort" better
  19  *
  20  * Revision 3.0  89/10/18  15:32:33  lwall
  21  * 3.0 baseline
  22  *
  23  */
  24
  25 #include "EXTERN.h"
  26 #include "perl.h"
  27 #include "perly.h"
  28
  29 char *reparse;          /* if non-null, scanreg found ${foo[$bar]} */
  30
  31 #ifdef CLINE
  32 #undef CLINE
  33 #endif
  34 #define CLINE (cmdline = (line < cmdline ? line : cmdline))
  35
  36 #define META(c) ((c) | 128)
  37
  38 #define RETURN(retval) return (bufptr = s,(int)retval)
  39 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
  40 #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
  41 #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
  42 #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
  43 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
  44 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
  45 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
  46 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
  47 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
  48 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
  49 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
  50 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
  51 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
  52 #define LFUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)LFUNC4)
  53 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
  54 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
  55 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
  56 #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
  57 #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
  58 #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
  59 #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
  60 #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
  61 #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
  62 #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
  63
  64 /* This bit of chicanery makes a unary function followed by
  65  * a parenthesis into a function with one argument, highest precedence.
  66  */
  67 #define UNI(f) return(yylval.ival = f,expectterm = TRUE,bufptr = s, \
  68         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
  69
  70 /* This does similarly for list operators, merely by pretending that the
  71  * paren came before the listop rather than after.
  72  */
  73 #define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
  74         (*s = META('('), bufptr = oldbufptr, '(') : \
  75         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
  76
  77 char *
  78 skipspace(s)
  79 register char *s;
  80 {
  81     while (s < bufend && isascii(*s) && isspace(*s))
  82         s++;
  83     return s;
  84 }
  85
  86 #ifdef CRIPPLED_CC
  87
  88 #undef UNI
  89 #undef LOP
  90 #define UNI(f) return uni(f,s)
  91 #define LOP(f) return lop(f,s)
  92
  93 int
  94 uni(f,s)
  95 int f;
  96 char *s;
  97 {
  98     yylval.ival = f;
  99     expectterm = TRUE;
 100     bufptr = s;
 101     if (*s == '(')
 102         return FUNC1;
 103     s = skipspace(s);
 104     if (*s == '(')
 105         return FUNC1;
 106     else
 107         return UNIOP;
 108 }
 109
 110 int
 111 lop(f,s)
 112 int f;
 113 char *s;
 114 {
 115     if (*s != '(')
 116         s = skipspace(s);
 117     if (*s == '(') {
 118         *s = META('(');
 119         bufptr = oldbufptr;
 120         return '(';
 121     }
 122     else {
 123         yylval.ival=f;
 124         expectterm = TRUE;
 125         bufptr = s;
 126         return LISTOP;
 127     }
 128 }
 129
 130 #endif /* CRIPPLED_CC */
 131
 132 yylex()
 133 {
 134     register char *s = bufptr;
 135     register char *d;
 136     register int tmp;
 137     static bool in_format = FALSE;
 138     static bool firstline = TRUE;
 139     extern int yychar;          /* last token */
 140
 141     oldoldbufptr = oldbufptr;
 142     oldbufptr = s;
 143
 144   retry:
 145 #ifdef YYDEBUG
 146     if (debug & 1)
 147         if (index(s,'\n'))
 148             fprintf(stderr,"Tokener at %s",s);
 149         else
 150             fprintf(stderr,"Tokener at %s\n",s);
 151 #endif
 152     switch (*s) {
 153     default:
 154         if ((*s & 127) == '(')
 155             *s++ = '(';
 156         else
 157             warn("Unrecognized character \\%03o ignored", *s++);
 158         goto retry;
 159     case 0:
 160         if (!rsfp)
 161             RETURN(0);
 162         if (s++ < bufend)
 163             goto retry;                 /* ignore stray nulls */
 164         if (firstline) {
 165             firstline = FALSE;
 166             if (minus_n || minus_p || perldb) {
 167                 str_set(linestr,"");
 168                 if (perldb)
 169                     str_cat(linestr,"do 'perldb.pl'; print $@;");
 170                 if (minus_n || minus_p) {
 171                     str_cat(linestr,"line: while (<>) {");
 172                     if (minus_a)
 173                         str_cat(linestr,"@F=split(' ');");
 174                 }
 175                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 176                 bufend = linestr->str_ptr + linestr->str_cur;
 177                 goto retry;
 178             }
 179         }
 180         if (in_format) {
 181             yylval.formval = load_format();
 182             in_format = FALSE;
 183             oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
 184             bufend = linestr->str_ptr + linestr->str_cur;
 185             TERM(FORMLIST);
 186         }
 187         line++;
 188         if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
 189             if (preprocess)
 190                 (void)mypclose(rsfp);
 191             else if (rsfp != stdin)
 192                 (void)fclose(rsfp);
 193             rsfp = Nullfp;
 194             if (minus_n || minus_p) {
 195                 str_set(linestr,minus_p ? "}continue{print;" : "");
 196                 str_cat(linestr,"}");
 197                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 198                 bufend = linestr->str_ptr + linestr->str_cur;
 199                 goto retry;
 200             }
 201             oldoldbufptr = oldbufptr = s = str_get(linestr);
 202             str_set(linestr,"");
 203             RETURN(0);
 204         }
 205         oldoldbufptr = oldbufptr = bufptr = s;
 206         if (perldb) {
 207             STR *str = Str_new(85,0);
 208
 209             str_sset(str,linestr);
 210             astore(lineary,(int)line,str);
 211         }
 212 #ifdef DEBUG
 213         if (firstline) {
 214             char *showinput();
 215             s = showinput();
 216         }
 217 #endif
 218         bufend = linestr->str_ptr + linestr->str_cur;
 219         if (firstline) {
 220             while (s < bufend && isspace(*s))
 221                 s++;
 222             if (*s == ':')      /* for csh's that have to exec sh scripts */
 223                 s++;
 224             firstline = FALSE;
 225         }
 226         goto retry;
 227     case ' ': case '\t': case '\f':
 228         s++;
 229         goto retry;
 230     case '\n':
 231     case '#':
 232         if (preprocess && s == str_get(linestr) &&
 233                s[1] == ' ' && isdigit(s[2])) {
 234             line = atoi(s+2)-1;
 235             for (s += 2; isdigit(*s); s++) ;
 236             d = bufend;
 237             while (s < d && isspace(*s)) s++;
 238             if (filename)
 239                 Safefree(filename);
 240             s[strlen(s)-1] = '\0';      /* wipe out newline */
 241             if (*s == '"') {
 242                 s++;
 243                 s[strlen(s)-1] = '\0';  /* wipe out trailing quote */
 244             }
 245             if (*s)
 246                 filename = savestr(s);
 247             else
 248                 filename = savestr(origfilename);
 249             oldoldbufptr = oldbufptr = s = str_get(linestr);
 250         }
 251         if (in_eval && !rsfp) {
 252             d = bufend;
 253             while (s < d && *s != '\n')
 254                 s++;
 255             if (s < d) {
 256                 s++;
 257                 line++;
 258             }
 259         }
 260         else {
 261             *s = '\0';
 262             bufend = s;
 263         }
 264         goto retry;
 265     case '-':
 266         if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
 267             s++;
 268             switch (*s++) {
 269             case 'r': FTST(O_FTEREAD);
 270             case 'w': FTST(O_FTEWRITE);
 271             case 'x': FTST(O_FTEEXEC);
 272             case 'o': FTST(O_FTEOWNED);
 273             case 'R': FTST(O_FTRREAD);
 274             case 'W': FTST(O_FTRWRITE);
 275             case 'X': FTST(O_FTREXEC);
 276             case 'O': FTST(O_FTROWNED);
 277             case 'e': FTST(O_FTIS);
 278             case 'z': FTST(O_FTZERO);
 279             case 's': FTST(O_FTSIZE);
 280             case 'f': FTST(O_FTFILE);
 281             case 'd': FTST(O_FTDIR);
 282             case 'l': FTST(O_FTLINK);
 283             case 'p': FTST(O_FTPIPE);
 284             case 'S': FTST(O_FTSOCK);
 285             case 'u': FTST(O_FTSUID);
 286             case 'g': FTST(O_FTSGID);
 287             case 'k': FTST(O_FTSVTX);
 288             case 'b': FTST(O_FTBLK);
 289             case 'c': FTST(O_FTCHR);
 290             case 't': FTST(O_FTTTY);
 291             case 'T': FTST(O_FTTEXT);
 292             case 'B': FTST(O_FTBINARY);
 293             default:
 294                 s -= 2;
 295                 break;
 296             }
 297         }
 298         tmp = *s++;
 299         if (*s == tmp) {
 300             s++;
 301             RETURN(DEC);
 302         }
 303         if (expectterm)
 304             OPERATOR('-');
 305         else
 306             AOP(O_SUBTRACT);
 307     case '+':
 308         tmp = *s++;
 309         if (*s == tmp) {
 310             s++;
 311             RETURN(INC);
 312         }
 313         if (expectterm)
 314             OPERATOR('+');
 315         else
 316             AOP(O_ADD);
 317
 318     case '*':
 319         if (expectterm) {
 320             s = scanreg(s,bufend,tokenbuf);
 321             yylval.stabval = stabent(tokenbuf,TRUE);
 322             TERM(STAR);
 323         }
 324         tmp = *s++;
 325         if (*s == tmp) {
 326             s++;
 327             OPERATOR(POW);
 328         }
 329         MOP(O_MULTIPLY);
 330     case '%':
 331         if (expectterm) {
 332             s = scanreg(s,bufend,tokenbuf);
 333             yylval.stabval = stabent(tokenbuf,TRUE);
 334             TERM(HSH);
 335         }
 336         s++;
 337         MOP(O_MODULO);
 338
 339     case '^':
 340     case '~':
 341     case '(':
 342     case ',':
 343     case ':':
 344     case '[':
 345         tmp = *s++;
 346         OPERATOR(tmp);
 347     case '{':
 348         tmp = *s++;
 349         if (isspace(*s) || *s == '#')
 350             cmdline = NOLINE;   /* invalidate current command line number */
 351         OPERATOR(tmp);
 352     case ';':
 353         if (line < cmdline)
 354             cmdline = line;
 355         tmp = *s++;
 356         OPERATOR(tmp);
 357     case ')':
 358     case ']':
 359         tmp = *s++;
 360         TERM(tmp);
 361     case '}':
 362         tmp = *s++;
 363         RETURN(tmp);
 364     case '&':
 365         s++;
 366         tmp = *s++;
 367         if (tmp == '&')
 368             OPERATOR(ANDAND);
 369         s--;
 370         if (expectterm) {
 371             d = bufend;
 372             while (s < d && isspace(*s))
 373                 s++;
 374             if (isalpha(*s) || *s == '_' || *s == '\'')
 375                 *(--s) = '\\';  /* force next ident to WORD */
 376             OPERATOR(AMPER);
 377         }
 378         OPERATOR('&');
 379     case '|':
 380         s++;
 381         tmp = *s++;
 382         if (tmp == '|')
 383             OPERATOR(OROR);
 384         s--;
 385         OPERATOR('|');
 386     case '=':
 387         s++;
 388         tmp = *s++;
 389         if (tmp == '=')
 390             EOP(O_EQ);
 391         if (tmp == '~')
 392             OPERATOR(MATCH);
 393         s--;
 394         OPERATOR('=');
 395     case '!':
 396         s++;
 397         tmp = *s++;
 398         if (tmp == '=')
 399             EOP(O_NE);
 400         if (tmp == '~')
 401             OPERATOR(NMATCH);
 402         s--;
 403         OPERATOR('!');
 404     case '<':
 405         if (expectterm) {
 406             s = scanstr(s);
 407             TERM(RSTRING);
 408         }
 409         s++;
 410         tmp = *s++;
 411         if (tmp == '<')
 412             OPERATOR(LS);
 413         if (tmp == '=')
 414             ROP(O_LE);
 415         s--;
 416         ROP(O_LT);
 417     case '>':
 418         s++;
 419         tmp = *s++;
 420         if (tmp == '>')
 421             OPERATOR(RS);
 422         if (tmp == '=')
 423             ROP(O_GE);
 424         s--;
 425         ROP(O_GT);
 426
 427 #define SNARFWORD \
 428         d = tokenbuf; \
 429         while (isascii(*s) && \
 430           (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
 431             *d++ = *s++; \
 432         if (d[-1] == '\'') \
 433             d--,s--; \
 434         *d = '\0'; \
 435         d = tokenbuf;
 436
 437     case '$':
 438         if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
 439             s++;
 440             s = scanreg(s,bufend,tokenbuf);
 441             yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 442             TERM(ARYLEN);
 443         }
 444         d = s;
 445         s = scanreg(s,bufend,tokenbuf);
 446         if (reparse) {          /* turn ${foo[bar]} into ($foo[bar]) */
 447           do_reparse:
 448             s[-1] = ')';
 449             s = d;
 450             s[1] = s[0];
 451             s[0] = '(';
 452             goto retry;
 453         }
 454         yylval.stabval = stabent(tokenbuf,TRUE);
 455         TERM(REG);
 456
 457     case '@':
 458         d = s;
 459         s = scanreg(s,bufend,tokenbuf);
 460         if (reparse)
 461             goto do_reparse;
 462         yylval.stabval = stabent(tokenbuf,TRUE);
 463         TERM(ARY);
 464
 465     case '/':                   /* may either be division or pattern */
 466     case '?':                   /* may either be conditional or pattern */
 467         if (expectterm) {
 468             s = scanpat(s);
 469             TERM(PATTERN);
 470         }
 471         tmp = *s++;
 472         if (tmp == '/')
 473             MOP(O_DIVIDE);
 474         OPERATOR(tmp);
 475
 476     case '.':
 477         if (!expectterm || !isdigit(s[1])) {
 478             tmp = *s++;
 479             if (*s == tmp) {
 480                 s++;
 481                 OPERATOR(DOTDOT);
 482             }
 483             AOP(O_CONCAT);
 484         }
 485         /* FALL THROUGH */
 486     case '0': case '1': case '2': case '3': case '4':
 487     case '5': case '6': case '7': case '8': case '9':
 488     case '\'': case '"': case '`':
 489         s = scanstr(s);
 490         TERM(RSTRING);
 491
 492     case '\\':  /* some magic to force next word to be a WORD */
 493         s++;    /* used by do and sub to force a separate namespace */
 494         /* FALL THROUGH */
 495     case '_':
 496         SNARFWORD;
 497         break;
 498     case 'a': case 'A':
 499         SNARFWORD;
 500         if (strEQ(d,"accept"))
 501             FOP22(O_ACCEPT);
 502         if (strEQ(d,"atan2"))
 503             FUN2(O_ATAN2);
 504         break;
 505     case 'b': case 'B':
 506         SNARFWORD;
 507         if (strEQ(d,"bind"))
 508             FOP2(O_BIND);
 509         break;
 510     case 'c': case 'C':
 511         SNARFWORD;
 512         if (strEQ(d,"chop"))
 513             LFUN(O_CHOP);
 514         if (strEQ(d,"continue"))
 515             OPERATOR(CONTINUE);
 516         if (strEQ(d,"chdir"))
 517             UNI(O_CHDIR);
 518         if (strEQ(d,"close"))
 519             FOP(O_CLOSE);
 520         if (strEQ(d,"closedir"))
 521             FOP(O_CLOSEDIR);
 522         if (strEQ(d,"crypt")) {
 523 #ifdef FCRYPT
 524             init_des();
 525 #endif
 526             FUN2(O_CRYPT);
 527         }
 528         if (strEQ(d,"chmod"))
 529             LOP(O_CHMOD);
 530         if (strEQ(d,"chown"))
 531             LOP(O_CHOWN);
 532         if (strEQ(d,"connect"))
 533             FOP2(O_CONNECT);
 534         if (strEQ(d,"cos"))
 535             UNI(O_COS);
 536         if (strEQ(d,"chroot"))
 537             UNI(O_CHROOT);
 538         break;
 539     case 'd': case 'D':
 540         SNARFWORD;
 541         if (strEQ(d,"do")) {
 542             d = bufend;
 543             while (s < d && isspace(*s))
 544                 s++;
 545             if (isalpha(*s) || *s == '_')
 546                 *(--s) = '\\';  /* force next ident to WORD */
 547             OPERATOR(DO);
 548         }
 549         if (strEQ(d,"die"))
 550             LOP(O_DIE);
 551         if (strEQ(d,"defined"))
 552             LFUN(O_DEFINED);
 553         if (strEQ(d,"delete"))
 554             OPERATOR(DELETE);
 555         if (strEQ(d,"dbmopen"))
 556             HFUN3(O_DBMOPEN);
 557         if (strEQ(d,"dbmclose"))
 558             HFUN(O_DBMCLOSE);
 559         if (strEQ(d,"dump"))
 560             LOOPX(O_DUMP);
 561         break;
 562     case 'e': case 'E':
 563         SNARFWORD;
 564         if (strEQ(d,"else"))
 565             OPERATOR(ELSE);
 566         if (strEQ(d,"elsif")) {
 567             yylval.ival = line;
 568             OPERATOR(ELSIF);
 569         }
 570         if (strEQ(d,"eq") || strEQ(d,"EQ"))
 571             EOP(O_SEQ);
 572         if (strEQ(d,"exit"))
 573             UNI(O_EXIT);
 574         if (strEQ(d,"eval")) {
 575             allstabs = TRUE;            /* must initialize everything since */
 576             UNI(O_EVAL);                /* we don't know what will be used */
 577         }
 578         if (strEQ(d,"eof"))
 579             FOP(O_EOF);
 580         if (strEQ(d,"exp"))
 581             UNI(O_EXP);
 582         if (strEQ(d,"each"))
 583             HFUN(O_EACH);
 584         if (strEQ(d,"exec")) {
 585             set_csh();
 586             LOP(O_EXEC);
 587         }
 588         if (strEQ(d,"endhostent"))
 589             FUN0(O_EHOSTENT);
 590         if (strEQ(d,"endnetent"))
 591             FUN0(O_ENETENT);
 592         if (strEQ(d,"endservent"))
 593             FUN0(O_ESERVENT);
 594         if (strEQ(d,"endprotoent"))
 595             FUN0(O_EPROTOENT);
 596         if (strEQ(d,"endpwent"))
 597             FUN0(O_EPWENT);
 598         if (strEQ(d,"endgrent"))
 599             FUN0(O_EGRENT);
 600         break;
 601     case 'f': case 'F':
 602         SNARFWORD;
 603         if (strEQ(d,"for"))
 604             OPERATOR(FOR);
 605         if (strEQ(d,"foreach"))
 606             OPERATOR(FOR);
 607         if (strEQ(d,"format")) {
 608             d = bufend;
 609             while (s < d && isspace(*s))
 610                 s++;
 611             if (isalpha(*s) || *s == '_')
 612                 *(--s) = '\\';  /* force next ident to WORD */
 613             in_format = TRUE;
 614             allstabs = TRUE;            /* must initialize everything since */
 615             OPERATOR(FORMAT);           /* we don't know what will be used */
 616         }
 617         if (strEQ(d,"fork"))
 618             FUN0(O_FORK);
 619         if (strEQ(d,"fcntl"))
 620             FOP3(O_FCNTL);
 621         if (strEQ(d,"fileno"))
 622             FOP(O_FILENO);
 623         if (strEQ(d,"flock"))
 624             FOP2(O_FLOCK);
 625         break;
 626     case 'g': case 'G':
 627         SNARFWORD;
 628         if (strEQ(d,"gt") || strEQ(d,"GT"))
 629             ROP(O_SGT);
 630         if (strEQ(d,"ge") || strEQ(d,"GE"))
 631             ROP(O_SGE);
 632         if (strEQ(d,"grep"))
 633             FL2(O_GREP);
 634         if (strEQ(d,"goto"))
 635             LOOPX(O_GOTO);
 636         if (strEQ(d,"gmtime"))
 637             UNI(O_GMTIME);
 638         if (strEQ(d,"getc"))
 639             FOP(O_GETC);
 640         if (strnEQ(d,"get",3)) {
 641             d += 3;
 642             if (*d == 'p') {
 643                 if (strEQ(d,"ppid"))
 644                     FUN0(O_GETPPID);
 645                 if (strEQ(d,"pgrp"))
 646                     UNI(O_GETPGRP);
 647                 if (strEQ(d,"priority"))
 648                     FUN2(O_GETPRIORITY);
 649                 if (strEQ(d,"protobyname"))
 650                     UNI(O_GPBYNAME);
 651                 if (strEQ(d,"protobynumber"))
 652                     FUN1(O_GPBYNUMBER);
 653                 if (strEQ(d,"protoent"))
 654                     FUN0(O_GPROTOENT);
 655                 if (strEQ(d,"pwent"))
 656                     FUN0(O_GPWENT);
 657                 if (strEQ(d,"pwnam"))
 658                     FUN1(O_GPWNAM);
 659                 if (strEQ(d,"pwuid"))
 660                     FUN1(O_GPWUID);
 661                 if (strEQ(d,"peername"))
 662                     FOP(O_GETPEERNAME);
 663             }
 664             else if (*d == 'h') {
 665                 if (strEQ(d,"hostbyname"))
 666                     UNI(O_GHBYNAME);
 667                 if (strEQ(d,"hostbyaddr"))
 668                     FUN2(O_GHBYADDR);
 669                 if (strEQ(d,"hostent"))
 670                     FUN0(O_GHOSTENT);
 671             }
 672             else if (*d == 'n') {
 673                 if (strEQ(d,"netbyname"))
 674                     UNI(O_GNBYNAME);
 675                 if (strEQ(d,"netbyaddr"))
 676                     FUN2(O_GNBYADDR);
 677                 if (strEQ(d,"netent"))
 678                     FUN0(O_GNETENT);
 679             }
 680             else if (*d == 's') {
 681                 if (strEQ(d,"servbyname"))
 682                     FUN2(O_GSBYNAME);
 683                 if (strEQ(d,"servbyport"))
 684                     FUN2(O_GSBYPORT);
 685                 if (strEQ(d,"servent"))
 686                     FUN0(O_GSERVENT);
 687                 if (strEQ(d,"sockname"))
 688                     FOP(O_GETSOCKNAME);
 689                 if (strEQ(d,"sockopt"))
 690                     FOP3(O_GSOCKOPT);
 691             }
 692             else if (*d == 'g') {
 693                 if (strEQ(d,"grent"))
 694                     FUN0(O_GGRENT);
 695                 if (strEQ(d,"grnam"))
 696                     FUN1(O_GGRNAM);
 697                 if (strEQ(d,"grgid"))
 698                     FUN1(O_GGRGID);
 699             }
 700             else if (*d == 'l') {
 701                 if (strEQ(d,"login"))
 702                     FUN0(O_GETLOGIN);
 703             }
 704             d -= 3;
 705         }
 706         break;
 707     case 'h': case 'H':
 708         SNARFWORD;
 709         if (strEQ(d,"hex"))
 710             UNI(O_HEX);
 711         break;
 712     case 'i': case 'I':
 713         SNARFWORD;
 714         if (strEQ(d,"if")) {
 715             yylval.ival = line;
 716             OPERATOR(IF);
 717         }
 718         if (strEQ(d,"index"))
 719             FUN2(O_INDEX);
 720         if (strEQ(d,"int"))
 721             UNI(O_INT);
 722         if (strEQ(d,"ioctl"))
 723             FOP3(O_IOCTL);
 724         break;
 725     case 'j': case 'J':
 726         SNARFWORD;
 727         if (strEQ(d,"join"))
 728             FL2(O_JOIN);
 729         break;
 730     case 'k': case 'K':
 731         SNARFWORD;
 732         if (strEQ(d,"keys"))
 733             HFUN(O_KEYS);
 734         if (strEQ(d,"kill"))
 735             LOP(O_KILL);
 736         break;
 737     case 'l': case 'L':
 738         SNARFWORD;
 739         if (strEQ(d,"last"))
 740             LOOPX(O_LAST);
 741         if (strEQ(d,"local"))
 742             OPERATOR(LOCAL);
 743         if (strEQ(d,"length"))
 744             UNI(O_LENGTH);
 745         if (strEQ(d,"lt") || strEQ(d,"LT"))
 746             ROP(O_SLT);
 747         if (strEQ(d,"le") || strEQ(d,"LE"))
 748             ROP(O_SLE);
 749         if (strEQ(d,"localtime"))
 750             UNI(O_LOCALTIME);
 751         if (strEQ(d,"log"))
 752             UNI(O_LOG);
 753         if (strEQ(d,"link"))
 754             FUN2(O_LINK);
 755         if (strEQ(d,"listen"))
 756             FOP2(O_LISTEN);
 757         if (strEQ(d,"lstat"))
 758             FOP(O_LSTAT);
 759         break;
 760     case 'm': case 'M':
 761         SNARFWORD;
 762         if (strEQ(d,"m")) {
 763             s = scanpat(s-1);
 764             if (yylval.arg)
 765                 TERM(PATTERN);
 766             else
 767                 RETURN(1);      /* force error */
 768         }
 769         if (strEQ(d,"mkdir"))
 770             FUN2(O_MKDIR);
 771         break;
 772     case 'n': case 'N':
 773         SNARFWORD;
 774         if (strEQ(d,"next"))
 775             LOOPX(O_NEXT);
 776         if (strEQ(d,"ne") || strEQ(d,"NE"))
 777             EOP(O_SNE);
 778         break;
 779     case 'o': case 'O':
 780         SNARFWORD;
 781         if (strEQ(d,"open"))
 782             OPERATOR(OPEN);
 783         if (strEQ(d,"ord"))
 784             UNI(O_ORD);
 785         if (strEQ(d,"oct"))
 786             UNI(O_OCT);
 787         if (strEQ(d,"opendir"))
 788             FOP2(O_OPENDIR);
 789         break;
 790     case 'p': case 'P':
 791         SNARFWORD;
 792         if (strEQ(d,"print")) {
 793             checkcomma(s,"filehandle");
 794             LOP(O_PRINT);
 795         }
 796         if (strEQ(d,"printf")) {
 797             checkcomma(s,"filehandle");
 798             LOP(O_PRTF);
 799         }
 800         if (strEQ(d,"push")) {
 801             yylval.ival = O_PUSH;
 802             OPERATOR(PUSH);
 803         }
 804         if (strEQ(d,"pop"))
 805             OPERATOR(POP);
 806         if (strEQ(d,"pack"))
 807             FL2(O_PACK);
 808         if (strEQ(d,"package"))
 809             OPERATOR(PACKAGE);
 810         break;
 811     case 'q': case 'Q':
 812         SNARFWORD;
 813         if (strEQ(d,"q")) {
 814             s = scanstr(s-1);
 815             TERM(RSTRING);
 816         }
 817         if (strEQ(d,"qq")) {
 818             s = scanstr(s-2);
 819             TERM(RSTRING);
 820         }
 821         break;
 822     case 'r': case 'R':
 823         SNARFWORD;
 824         if (strEQ(d,"return"))
 825             LOP(O_RETURN);
 826         if (strEQ(d,"reset"))
 827             UNI(O_RESET);
 828         if (strEQ(d,"redo"))
 829             LOOPX(O_REDO);
 830         if (strEQ(d,"rename"))
 831             FUN2(O_RENAME);
 832         if (strEQ(d,"rand"))
 833             UNI(O_RAND);
 834         if (strEQ(d,"rmdir"))
 835             UNI(O_RMDIR);
 836         if (strEQ(d,"rindex"))
 837             FUN2(O_RINDEX);
 838         if (strEQ(d,"read"))
 839             FOP3(O_READ);
 840         if (strEQ(d,"readdir"))
 841             FOP(O_READDIR);
 842         if (strEQ(d,"rewinddir"))
 843             FOP(O_REWINDDIR);
 844         if (strEQ(d,"recv"))
 845             FOP4(O_RECV);
 846         if (strEQ(d,"reverse"))
 847             LOP(O_REVERSE);
 848         if (strEQ(d,"readlink"))
 849             UNI(O_READLINK);
 850         break;
 851     case 's': case 'S':
 852         SNARFWORD;
 853         if (strEQ(d,"s")) {
 854             s = scansubst(s);
 855             if (yylval.arg)
 856                 TERM(SUBST);
 857             else
 858                 RETURN(1);      /* force error */
 859         }
 860         switch (d[1]) {
 861         case 'a':
 862         case 'b':
 863         case 'c':
 864         case 'd':
 865             break;
 866         case 'e':
 867             if (strEQ(d,"select"))
 868                 OPERATOR(SELECT);
 869             if (strEQ(d,"seek"))
 870                 FOP3(O_SEEK);
 871             if (strEQ(d,"send"))
 872                 FOP3(O_SEND);
 873             if (strEQ(d,"setpgrp"))
 874                 FUN2(O_SETPGRP);
 875             if (strEQ(d,"setpriority"))
 876                 FUN3(O_SETPRIORITY);
 877             if (strEQ(d,"sethostent"))
 878                 FUN1(O_SHOSTENT);
 879             if (strEQ(d,"setnetent"))
 880                 FUN1(O_SNETENT);
 881             if (strEQ(d,"setservent"))
 882                 FUN1(O_SSERVENT);
 883             if (strEQ(d,"setprotoent"))
 884                 FUN1(O_SPROTOENT);
 885             if (strEQ(d,"setpwent"))
 886                 FUN0(O_SPWENT);
 887             if (strEQ(d,"setgrent"))
 888                 FUN0(O_SGRENT);
 889             if (strEQ(d,"seekdir"))
 890                 FOP2(O_SEEKDIR);
 891             if (strEQ(d,"setsockopt"))
 892                 FOP4(O_SSOCKOPT);
 893             break;
 894         case 'f':
 895         case 'g':
 896             break;
 897         case 'h':
 898             if (strEQ(d,"shift"))
 899                 TERM(SHIFT);
 900             if (strEQ(d,"shutdown"))
 901                 FOP2(O_SHUTDOWN);
 902             break;
 903         case 'i':
 904             if (strEQ(d,"sin"))
 905                 UNI(O_SIN);
 906             break;
 907         case 'j':
 908         case 'k':
 909             break;
 910         case 'l':
 911             if (strEQ(d,"sleep"))
 912                 UNI(O_SLEEP);
 913             break;
 914         case 'm':
 915         case 'n':
 916             break;
 917         case 'o':
 918             if (strEQ(d,"socket"))
 919                 FOP4(O_SOCKET);
 920             if (strEQ(d,"socketpair"))
 921                 FOP25(O_SOCKETPAIR);
 922             if (strEQ(d,"sort")) {
 923                 checkcomma(s,"subroutine name");
 924                 d = bufend;
 925                 while (s < d && isascii(*s) && isspace(*s)) s++;
 926                 if (*s == ';' || *s == ')')             /* probably a close */
 927                     fatal("sort is now a reserved word");
 928                 if (isascii(*s) && (isalpha(*s) || *s == '_')) {
 929                     for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
 930                     strncpy(tokenbuf,s,d-s);
 931                     if (strNE(tokenbuf,"keys") &&
 932                         strNE(tokenbuf,"values") &&
 933                         strNE(tokenbuf,"split") &&
 934                         strNE(tokenbuf,"grep") &&
 935                         strNE(tokenbuf,"readdir") &&
 936                         strNE(tokenbuf,"unpack") &&
 937                         strNE(tokenbuf,"do") &&
 938                         (d >= bufend || isspace(*d)) )
 939                         *(--s) = '\\';  /* force next ident to WORD */
 940                 }
 941                 LOP(O_SORT);
 942             }
 943             break;
 944         case 'p':
 945             if (strEQ(d,"split"))
 946                 TERM(SPLIT);
 947             if (strEQ(d,"sprintf"))
 948                 FL(O_SPRINTF);
 949             break;
 950         case 'q':
 951             if (strEQ(d,"sqrt"))
 952                 UNI(O_SQRT);
 953             break;
 954         case 'r':
 955             if (strEQ(d,"srand"))
 956                 UNI(O_SRAND);
 957             break;
 958         case 's':
 959             break;
 960         case 't':
 961             if (strEQ(d,"stat"))
 962                 FOP(O_STAT);
 963             if (strEQ(d,"study")) {
 964                 sawstudy++;
 965                 LFUN(O_STUDY);
 966             }
 967             break;
 968         case 'u':
 969             if (strEQ(d,"substr"))
 970                 FUN3(O_SUBSTR);
 971             if (strEQ(d,"sub")) {
 972                 subline = line;
 973                 d = bufend;
 974                 while (s < d && isspace(*s))
 975                     s++;
 976                 if (isalpha(*s) || *s == '_' || *s == '\'') {
 977                     if (perldb) {
 978                         str_sset(subname,curstname);
 979                         str_ncat(subname,"'",1);
 980                         for (d = s+1;
 981                           isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
 982                           d++);
 983                         if (d[-1] == '\'')
 984                             d--;
 985                         str_ncat(subname,s,d-s);
 986                     }
 987                     *(--s) = '\\';      /* force next ident to WORD */
 988                 }
 989                 else if (perldb)
 990                     str_set(subname,"?");
 991                 OPERATOR(SUB);
 992             }
 993             break;
 994         case 'v':
 995         case 'w':
 996         case 'x':
 997             break;
 998         case 'y':
 999             if (strEQ(d,"system")) {
1000                 set_csh();
1001                 LOP(O_SYSTEM);
1002             }
1003             if (strEQ(d,"symlink"))
1004                 FUN2(O_SYMLINK);
1005             if (strEQ(d,"syscall"))
1006                 LOP(O_SYSCALL);
1007             break;
1008         case 'z':
1009             break;
1010         }
1011         break;
1012     case 't': case 'T':
1013         SNARFWORD;
1014         if (strEQ(d,"tr")) {
1015             s = scantrans(s);
1016             if (yylval.arg)
1017                 TERM(TRANS);
1018             else
1019                 RETURN(1);      /* force error */
1020         }
1021         if (strEQ(d,"tell"))
1022             FOP(O_TELL);
1023         if (strEQ(d,"telldir"))
1024             FOP(O_TELLDIR);
1025         if (strEQ(d,"time"))
1026             FUN0(O_TIME);
1027         if (strEQ(d,"times"))
1028             FUN0(O_TMS);
1029         break;
1030     case 'u': case 'U':
1031         SNARFWORD;
1032         if (strEQ(d,"using"))
1033             OPERATOR(USING);
1034         if (strEQ(d,"until")) {
1035             yylval.ival = line;
1036             OPERATOR(UNTIL);
1037         }
1038         if (strEQ(d,"unless")) {
1039             yylval.ival = line;
1040             OPERATOR(UNLESS);
1041         }
1042         if (strEQ(d,"unlink"))
1043             LOP(O_UNLINK);
1044         if (strEQ(d,"undef"))
1045             LFUN(O_UNDEF);
1046         if (strEQ(d,"unpack"))
1047             FUN2(O_UNPACK);
1048         if (strEQ(d,"utime"))
1049             LOP(O_UTIME);
1050         if (strEQ(d,"umask"))
1051             UNI(O_UMASK);
1052         if (strEQ(d,"unshift")) {
1053             yylval.ival = O_UNSHIFT;
1054             OPERATOR(PUSH);
1055         }
1056         break;
1057     case 'v': case 'V':
1058         SNARFWORD;
1059         if (strEQ(d,"values"))
1060             HFUN(O_VALUES);
1061         if (strEQ(d,"vec")) {
1062             sawvec = TRUE;
1063             FUN3(O_VEC);
1064         }
1065         break;
1066     case 'w': case 'W':
1067         SNARFWORD;
1068         if (strEQ(d,"while")) {
1069             yylval.ival = line;
1070             OPERATOR(WHILE);
1071         }
1072         if (strEQ(d,"warn"))
1073             LOP(O_WARN);
1074         if (strEQ(d,"wait"))
1075             FUN0(O_WAIT);
1076         if (strEQ(d,"wantarray")) {
1077             yylval.arg = op_new(1);
1078             yylval.arg->arg_type = O_ITEM;
1079             yylval.arg[1].arg_type = A_WANTARRAY;
1080             TERM(RSTRING);
1081         }
1082         if (strEQ(d,"write"))
1083             FOP(O_WRITE);
1084         break;
1085     case 'x': case 'X':
1086         SNARFWORD;
1087         if (!expectterm && strEQ(d,"x"))
1088             MOP(O_REPEAT);
1089         break;
1090     case 'y': case 'Y':
1091         SNARFWORD;
1092         if (strEQ(d,"y")) {
1093             s = scantrans(s);
1094             TERM(TRANS);
1095         }
1096         break;
1097     case 'z': case 'Z':
1098         SNARFWORD;
1099         break;
1100     }
1101     yylval.cval = savestr(d);
1102     expectterm = FALSE;
1103     if (oldoldbufptr && oldoldbufptr < bufptr) {
1104         while (isspace(*oldoldbufptr))
1105             oldoldbufptr++;
1106         if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1107             expectterm = TRUE;
1108         else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1109             expectterm = TRUE;
1110     }
1111     return (CLINE, bufptr = s, (int)WORD);
1112 }
1113
1114 int
1115 checkcomma(s,what)
1116 register char *s;
1117 char *what;
1118 {
1119     if (*s == '(')
1120         s++;
1121     while (s < bufend && isascii(*s) && isspace(*s))
1122         s++;
1123     if (isascii(*s) && (isalpha(*s) || *s == '_')) {
1124         s++;
1125         while (isalpha(*s) || isdigit(*s) || *s == '_')
1126             s++;
1127         while (s < bufend && isspace(*s))
1128             s++;
1129         if (*s == ',')
1130             fatal("No comma allowed after %s", what);
1131     }
1132 }
1133
1134 char *
1135 scanreg(s,send,dest)
1136 register char *s;
1137 register char *send;
1138 char *dest;
1139 {
1140     register char *d;
1141     int brackets = 0;
1142
1143     reparse = Nullch;
1144     s++;
1145     d = dest;
1146     if (isdigit(*s)) {
1147         while (isdigit(*s))
1148             *d++ = *s++;
1149     }
1150     else {
1151         while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
1152             *d++ = *s++;
1153     }
1154     if (d > dest+1 && d[-1] == '\'')
1155         d--,s--;
1156     *d = '\0';
1157     d = dest;
1158     if (!*d) {
1159         *d = *s++;
1160         if (*d == '{' /* } */ ) {
1161             d = dest;
1162             brackets++;
1163             while (s < send && brackets) {
1164                 if (!reparse && (d == dest || (*s && isascii(*s) &&
1165                   (isalpha(*s) || isdigit(*s) || *s == '_') ))) {
1166                     *d++ = *s++;
1167                     continue;
1168                 }
1169                 else if (!reparse)
1170                     reparse = s;
1171                 switch (*s++) {
1172                 /* { */
1173                 case '}':
1174                     brackets--;
1175                     if (reparse && reparse == s - 1)
1176                         reparse = Nullch;
1177                     break;
1178                 case '{':   /* } */
1179                     brackets++;
1180                     break;
1181                 }
1182             }
1183             *d = '\0';
1184             d = dest;
1185         }
1186         else
1187             d[1] = '\0';
1188     }
1189     if (*d == '^' && !isspace(*s))
1190         *d = *s++ & 31;
1191     return s;
1192 }
1193
1194 STR *
1195 scanconst(string,len)
1196 char *string;
1197 int len;
1198 {
1199     register STR *retstr;
1200     register char *t;
1201     register char *d;
1202     register char *e;
1203
1204     if (index(string,'|')) {
1205         return Nullstr;
1206     }
1207     retstr = Str_new(86,len);
1208     str_nset(retstr,string,len);
1209     t = str_get(retstr);
1210     e = t + len;
1211     retstr->str_u.str_useful = 100;
1212     for (d=t; d < e; ) {
1213         switch (*d) {
1214         case '{':
1215             if (isdigit(d[1]))
1216                 e = d;
1217             else
1218                 goto defchar;
1219             break;
1220         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
1221             e = d;
1222             break;
1223         case '\\':
1224             if (d[1] && index("wWbB0123456789sSdD",d[1])) {
1225                 e = d;
1226                 break;
1227             }
1228             (void)bcopy(d+1,d,e-d);
1229             e--;
1230             switch(*d) {
1231             case 'n':
1232                 *d = '\n';
1233                 break;
1234             case 't':
1235                 *d = '\t';
1236                 break;
1237             case 'f':
1238                 *d = '\f';
1239                 break;
1240             case 'r':
1241                 *d = '\r';
1242                 break;
1243             }
1244             /* FALL THROUGH */
1245         default:
1246           defchar:
1247             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1248                 e = d;
1249                 break;
1250             }
1251             d++;
1252         }
1253     }
1254     if (d == t) {
1255         str_free(retstr);
1256         return Nullstr;
1257     }
1258     *d = '\0';
1259     retstr->str_cur = d - t;
1260     return retstr;
1261 }
1262
1263 char *
1264 scanpat(s)
1265 register char *s;
1266 {
1267     register SPAT *spat;
1268     register char *d;
1269     register char *e;
1270     int len;
1271     SPAT savespat;
1272
1273     Newz(801,spat,1,SPAT);
1274     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1275     curstash->tbl_spatroot = spat;
1276
1277     switch (*s++) {
1278     case 'm':
1279         s++;
1280         break;
1281     case '/':
1282         break;
1283     case '?':
1284         spat->spat_flags |= SPAT_ONCE;
1285         break;
1286     default:
1287         fatal("panic: scanpat");
1288     }
1289     s = cpytill(tokenbuf,s,bufend,s[-1],&len);
1290     if (s >= bufend) {
1291         yyerror("Search pattern not terminated");
1292         yylval.arg = Nullarg;
1293         return s;
1294     }
1295     s++;
1296     while (*s == 'i' || *s == 'o') {
1297         if (*s == 'i') {
1298             s++;
1299             sawi = TRUE;
1300             spat->spat_flags |= SPAT_FOLD;
1301         }
1302         if (*s == 'o') {
1303             s++;
1304             spat->spat_flags |= SPAT_KEEP;
1305         }
1306     }
1307     e = tokenbuf + len;
1308     for (d=tokenbuf; d < e; d++) {
1309         if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
1310             (*d == '@' && d[-1] != '\\')) {
1311             register ARG *arg;
1312
1313             spat->spat_runtime = arg = op_new(1);
1314             arg->arg_type = O_ITEM;
1315             arg[1].arg_type = A_DOUBLE;
1316             arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
1317             arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
1318             d = scanreg(d,bufend,buf);
1319             (void)stabent(buf,TRUE);            /* make sure it's created */
1320             for (; d < e; d++) {
1321                 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1322                     d = scanreg(d,bufend,buf);
1323                     (void)stabent(buf,TRUE);
1324                 }
1325                 else if (*d == '@' && d[-1] != '\\') {
1326                     d = scanreg(d,bufend,buf);
1327                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1328                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1329                         (void)stabent(buf,TRUE);
1330                 }
1331             }
1332             goto got_pat;               /* skip compiling for now */
1333         }
1334     }
1335     if (spat->spat_flags & SPAT_FOLD)
1336 #ifdef STRUCTCOPY
1337         savespat = *spat;
1338 #else
1339         (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
1340 #endif
1341     if (*tokenbuf == '^') {
1342         spat->spat_short = scanconst(tokenbuf+1,len-1);
1343         if (spat->spat_short) {
1344             spat->spat_slen = spat->spat_short->str_cur;
1345             if (spat->spat_slen == len - 1)
1346                 spat->spat_flags |= SPAT_ALL;
1347         }
1348     }
1349     else {
1350         spat->spat_flags |= SPAT_SCANFIRST;
1351         spat->spat_short = scanconst(tokenbuf,len);
1352         if (spat->spat_short) {
1353             spat->spat_slen = spat->spat_short->str_cur;
1354             if (spat->spat_slen == len)
1355                 spat->spat_flags |= SPAT_ALL;
1356         }
1357     }
1358     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1359         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1360         spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
1361             spat->spat_flags & SPAT_FOLD,1);
1362                 /* Note that this regexp can still be used if someone says
1363                  * something like /a/ && s//b/;  so we can't delete it.
1364                  */
1365     }
1366     else {
1367         if (spat->spat_flags & SPAT_FOLD)
1368 #ifdef STRUCTCOPY
1369             *spat = savespat;
1370 #else
1371             (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
1372 #endif
1373         if (spat->spat_short)
1374             fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1375         spat->spat_regexp = regcomp(tokenbuf,tokenbuf+len,
1376             spat->spat_flags & SPAT_FOLD,1);
1377         hoistmust(spat);
1378     }
1379   got_pat:
1380     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1381     return s;
1382 }
1383
1384 char *
1385 scansubst(s)
1386 register char *s;
1387 {
1388     register SPAT *spat;
1389     register char *d;
1390     register char *e;
1391     int len;
1392
1393     Newz(802,spat,1,SPAT);
1394     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1395     curstash->tbl_spatroot = spat;
1396
1397     s = cpytill(tokenbuf,s+1,bufend,*s,&len);
1398     if (s >= bufend) {
1399         yyerror("Substitution pattern not terminated");
1400         yylval.arg = Nullarg;
1401         return s;
1402     }
1403     e = tokenbuf + len;
1404     for (d=tokenbuf; d < e; d++) {
1405         if ((*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') ||
1406             (*d == '@' && d[-1] != '\\')) {
1407             register ARG *arg;
1408
1409             spat->spat_runtime = arg = op_new(1);
1410             arg->arg_type = O_ITEM;
1411             arg[1].arg_type = A_DOUBLE;
1412             arg[1].arg_ptr.arg_str = str_make(tokenbuf,len);
1413             arg[1].arg_ptr.arg_str->str_u.str_hash = curstash;
1414             d = scanreg(d,bufend,buf);
1415             (void)stabent(buf,TRUE);            /* make sure it's created */
1416             for (; *d; d++) {
1417                 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1418                     d = scanreg(d,bufend,buf);
1419                     (void)stabent(buf,TRUE);
1420                 }
1421                 else if (*d == '@' && d[-1] != '\\') {
1422                     d = scanreg(d,bufend,buf);
1423                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1424                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1425                         (void)stabent(buf,TRUE);
1426                 }
1427             }
1428             goto get_repl;              /* skip compiling for now */
1429         }
1430     }
1431     if (*tokenbuf == '^') {
1432         spat->spat_short = scanconst(tokenbuf+1,len-1);
1433         if (spat->spat_short)
1434             spat->spat_slen = spat->spat_short->str_cur;
1435     }
1436     else {
1437         spat->spat_flags |= SPAT_SCANFIRST;
1438         spat->spat_short = scanconst(tokenbuf,len);
1439         if (spat->spat_short)
1440             spat->spat_slen = spat->spat_short->str_cur;
1441     }
1442     d = nsavestr(tokenbuf,len);
1443 get_repl:
1444     s = scanstr(s);
1445     if (s >= bufend) {
1446         yyerror("Substitution replacement not terminated");
1447         yylval.arg = Nullarg;
1448         return s;
1449     }
1450     spat->spat_repl = yylval.arg;
1451     spat->spat_flags |= SPAT_ONCE;
1452     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1453         spat->spat_flags |= SPAT_CONST;
1454     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1455         STR *tmpstr;
1456         register char *t;
1457
1458         spat->spat_flags |= SPAT_CONST;
1459         tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1460         e = tmpstr->str_ptr + tmpstr->str_cur;
1461         for (t = tmpstr->str_ptr; t < e; t++) {
1462             if (*t == '$' && t[1] && index("`'&+0123456789",t[1]))
1463                 spat->spat_flags &= ~SPAT_CONST;
1464         }
1465     }
1466     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
1467         if (*s == 'e') {
1468             s++;
1469             if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1470                 spat->spat_repl[1].arg_type = A_SINGLE;
1471             spat->spat_repl = fixeval(make_op(O_EVAL,2,
1472                 spat->spat_repl,
1473                 Nullarg,
1474                 Nullarg));
1475             spat->spat_flags &= ~SPAT_CONST;
1476         }
1477         if (*s == 'g') {
1478             s++;
1479             spat->spat_flags &= ~SPAT_ONCE;
1480         }
1481         if (*s == 'i') {
1482             s++;
1483             sawi = TRUE;
1484             spat->spat_flags |= SPAT_FOLD;
1485             if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1486                 str_free(spat->spat_short);     /* anchored opt doesn't do */
1487                 spat->spat_short = Nullstr;     /* case insensitive match */
1488                 spat->spat_slen = 0;
1489             }
1490         }
1491         if (*s == 'o') {
1492             s++;
1493             spat->spat_flags |= SPAT_KEEP;
1494         }
1495     }
1496     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1497         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1498     if (!spat->spat_runtime) {
1499         spat->spat_regexp = regcomp(d,d+len,spat->spat_flags & SPAT_FOLD,1);
1500         hoistmust(spat);
1501         Safefree(d);
1502     }
1503     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
1504     return s;
1505 }
1506
1507 hoistmust(spat)
1508 register SPAT *spat;
1509 {
1510     if (spat->spat_regexp->regmust) {   /* is there a better short-circuit? */
1511         if (spat->spat_short &&
1512           str_eq(spat->spat_short,spat->spat_regexp->regmust))
1513         {
1514             if (spat->spat_flags & SPAT_SCANFIRST) {
1515                 str_free(spat->spat_short);
1516                 spat->spat_short = Nullstr;
1517             }
1518             else {
1519                 str_free(spat->spat_regexp->regmust);
1520                 spat->spat_regexp->regmust = Nullstr;
1521                 return;
1522             }
1523         }
1524         if (!spat->spat_short ||        /* promote the better string */
1525           ((spat->spat_flags & SPAT_SCANFIRST) &&
1526            (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1527             str_free(spat->spat_short);         /* ok if null */
1528             spat->spat_short = spat->spat_regexp->regmust;
1529             spat->spat_regexp->regmust = Nullstr;
1530             spat->spat_flags |= SPAT_SCANFIRST;
1531         }
1532     }
1533 }
1534
1535 char *
1536 expand_charset(s,len,retlen)
1537 register char *s;
1538 int len;
1539 int *retlen;
1540 {
1541     char t[512];
1542     register char *d = t;
1543     register int i;
1544     register char *send = s + len;
1545
1546     while (s < send) {
1547         if (s[1] == '-' && s+2 < send) {
1548             for (i = s[0]; i <= s[2]; i++)
1549                 *d++ = i;
1550             s += 3;
1551         }
1552         else
1553             *d++ = *s++;
1554     }
1555     *d = '\0';
1556     *retlen = d - t;
1557     return nsavestr(t,d-t);
1558 }
1559
1560 char *
1561 scantrans(s)
1562 register char *s;
1563 {
1564     ARG *arg =
1565         l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
1566     register char *t;
1567     register char *r;
1568     register char *tbl;
1569     register int i;
1570     register int j;
1571     int tlen, rlen;
1572
1573     Newz(803,tbl,256,char);
1574     arg[2].arg_type = A_NULL;
1575     arg[2].arg_ptr.arg_cval = tbl;
1576     s = scanstr(s);
1577     if (s >= bufend) {
1578         yyerror("Translation pattern not terminated");
1579         yylval.arg = Nullarg;
1580         return s;
1581     }
1582     t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
1583         yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
1584     free_arg(yylval.arg);
1585     s = scanstr(s-1);
1586     if (s >= bufend) {
1587         yyerror("Translation replacement not terminated");
1588         yylval.arg = Nullarg;
1589         return s;
1590     }
1591     r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
1592         yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
1593     free_arg(yylval.arg);
1594     yylval.arg = arg;
1595     if (!*r) {
1596         Safefree(r);
1597         r = t; rlen = tlen;
1598     }
1599     for (i = 0, j = 0; i < tlen; i++,j++) {
1600         if (j >= rlen)
1601             --j;
1602         tbl[t[i] & 0377] = r[j];
1603     }
1604     if (r != t)
1605         Safefree(r);
1606     Safefree(t);
1607     return s;
1608 }
1609
1610 char *
1611 scanstr(s)
1612 register char *s;
1613 {
1614     register char term;
1615     register char *d;
1616     register ARG *arg;
1617     register char *send;
1618     register bool makesingle = FALSE;
1619     register STAB *stab;
1620     bool alwaysdollar = FALSE;
1621     bool hereis = FALSE;
1622     STR *herewas;
1623     char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */
1624     int len;
1625
1626     arg = op_new(1);
1627     yylval.arg = arg;
1628     arg->arg_type = O_ITEM;
1629
1630     switch (*s) {
1631     default:                    /* a substitution replacement */
1632         arg[1].arg_type = A_DOUBLE;
1633         makesingle = TRUE;      /* maybe disable runtime scanning */
1634         term = *s;
1635         if (term == '\'')
1636             leave = Nullch;
1637         goto snarf_it;
1638     case '0':
1639         {
1640             long i;
1641             int shift;
1642
1643             arg[1].arg_type = A_SINGLE;
1644             if (s[1] == 'x') {
1645                 shift = 4;
1646                 s += 2;
1647             }
1648             else if (s[1] == '.')
1649                 goto decimal;
1650             else
1651                 shift = 3;
1652             i = 0;
1653             for (;;) {
1654                 switch (*s) {
1655                 default:
1656                     goto out;
1657                 case '8': case '9':
1658                     if (shift != 4)
1659                         yyerror("Illegal octal digit");
1660                     /* FALL THROUGH */
1661                 case '0': case '1': case '2': case '3': case '4':
1662                 case '5': case '6': case '7':
1663                     i <<= shift;
1664                     i += *s++ & 15;
1665                     break;
1666                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1667                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1668                     if (shift != 4)
1669                         goto out;
1670                     i <<= 4;
1671                     i += (*s++ & 7) + 9;
1672                     break;
1673                 }
1674             }
1675           out:
1676             (void)sprintf(tokenbuf,"%ld",i);
1677             arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
1678             (void)str_2num(arg[1].arg_ptr.arg_str);
1679         }
1680         break;
1681     case '1': case '2': case '3': case '4': case '5':
1682     case '6': case '7': case '8': case '9': case '.':
1683       decimal:
1684         arg[1].arg_type = A_SINGLE;
1685         d = tokenbuf;
1686         while (isdigit(*s) || *s == '_') {
1687             if (*s == '_')
1688                 s++;
1689             else
1690                 *d++ = *s++;
1691         }
1692         if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
1693             *d++ = *s++;
1694             while (isdigit(*s) || *s == '_') {
1695                 if (*s == '_')
1696                     s++;
1697                 else
1698                     *d++ = *s++;
1699             }
1700         }
1701         if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
1702             *d++ = *s++;
1703             if (*s == '+' || *s == '-')
1704                 *d++ = *s++;
1705             while (isdigit(*s))
1706                 *d++ = *s++;
1707         }
1708         *d = '\0';
1709         arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf);
1710         (void)str_2num(arg[1].arg_ptr.arg_str);
1711         break;
1712     case '<':
1713         if (*++s == '<') {
1714             hereis = TRUE;
1715             d = tokenbuf;
1716             if (!rsfp)
1717                 *d++ = '\n';
1718             if (*++s && index("`'\"",*s)) {
1719                 term = *s++;
1720                 s = cpytill(d,s,bufend,term,&len);
1721                 if (s < bufend)
1722                     s++;
1723                 d += len;
1724             }
1725             else {
1726                 if (*s == '\\')
1727                     s++, term = '\'';
1728                 else
1729                     term = '"';
1730                 while (isascii(*s) && (isalpha(*s) || isdigit(*s) || *s == '_'))
1731                     *d++ = *s++;
1732             }                           /* assuming tokenbuf won't clobber */
1733             *d++ = '\n';
1734             *d = '\0';
1735             len = d - tokenbuf;
1736             d = "\n";
1737             if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
1738                 herewas = str_make(s,bufend-s);
1739             else
1740                 s--, herewas = str_make(s,d-s);
1741             s += herewas->str_cur;
1742             if (term == '\'')
1743                 goto do_single;
1744             if (term == '`')
1745                 goto do_back;
1746             goto do_double;
1747         }
1748         d = tokenbuf;
1749         s = cpytill(d,s,bufend,'>',&len);
1750         if (s < bufend)
1751             s++;
1752         if (*d == '$') d++;
1753         while (*d &&
1754           (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
1755             d++;
1756         if (d - tokenbuf != len) {
1757             d = tokenbuf;
1758             arg[1].arg_type = A_GLOB;
1759             d = nsavestr(d,len);
1760             arg[1].arg_ptr.arg_stab = stab = genstab();
1761             stab_io(stab) = stio_new();
1762             stab_val(stab) = str_make(d,len);
1763             stab_val(stab)->str_u.str_hash = curstash;
1764             Safefree(d);
1765             set_csh();
1766         }
1767         else {
1768             d = tokenbuf;
1769             if (!len)
1770                 (void)strcpy(d,"ARGV");
1771             if (*d == '$') {
1772                 arg[1].arg_type = A_INDREAD;
1773                 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
1774             }
1775             else {
1776                 arg[1].arg_type = A_READ;
1777                 if (rsfp == stdin && (strEQ(d,"stdin") || strEQ(d,"STDIN")))
1778                     yyerror("Can't get both program and data from <STDIN>");
1779                 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
1780                 if (!stab_io(arg[1].arg_ptr.arg_stab))
1781                     stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
1782                 if (strEQ(d,"ARGV")) {
1783                     (void)aadd(arg[1].arg_ptr.arg_stab);
1784                     stab_io(arg[1].arg_ptr.arg_stab)->flags |=
1785                       IOF_ARGV|IOF_START;
1786                 }
1787             }
1788         }
1789         break;
1790
1791     case 'q':
1792         s++;
1793         if (*s == 'q') {
1794             s++;
1795             goto do_double;
1796         }
1797         /* FALL THROUGH */
1798     case '\'':
1799       do_single:
1800         term = *s;
1801         arg[1].arg_type = A_SINGLE;
1802         leave = Nullch;
1803         goto snarf_it;
1804
1805     case '"':
1806       do_double:
1807         term = *s;
1808         arg[1].arg_type = A_DOUBLE;
1809         makesingle = TRUE;      /* maybe disable runtime scanning */
1810         alwaysdollar = TRUE;    /* treat $) and $| as variables */
1811         goto snarf_it;
1812     case '`':
1813       do_back:
1814         term = *s;
1815         arg[1].arg_type = A_BACKTICK;
1816         set_csh();
1817         alwaysdollar = TRUE;    /* treat $) and $| as variables */
1818       snarf_it:
1819         {
1820             STR *tmpstr;
1821             char *tmps;
1822
1823             multi_start = line;
1824             if (hereis)
1825                 multi_open = multi_close = '<';
1826             else {
1827                 multi_open = term;
1828                 if (tmps = index("([{< )]}> )]}>",term))
1829                     term = tmps[5];
1830                 multi_close = term;
1831             }
1832             tmpstr = Str_new(87,0);
1833             if (hereis) {
1834                 term = *tokenbuf;
1835                 if (!rsfp) {
1836                     d = s;
1837                     while (s < bufend &&
1838                       (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
1839                         if (*s++ == '\n')
1840                             line++;
1841                     }
1842                     if (s >= bufend) {
1843                         line = multi_start;
1844                         fatal("EOF in string");
1845                     }
1846                     str_nset(tmpstr,d+1,s-d);
1847                     s += len - 1;
1848                     str_ncat(herewas,s,bufend-s);
1849                     str_replace(linestr,herewas);
1850                     oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
1851                     bufend = linestr->str_ptr + linestr->str_cur;
1852                     hereis = FALSE;
1853                 }
1854             }
1855             else
1856                 s = str_append_till(tmpstr,s+1,bufend,term,leave);
1857             while (s >= bufend) {       /* multiple line string? */
1858                 if (!rsfp ||
1859                  !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
1860                     line = multi_start;
1861                     fatal("EOF in string");
1862                 }
1863                 line++;
1864                 if (perldb) {
1865                     STR *str = Str_new(88,0);
1866
1867                     str_sset(str,linestr);
1868                     astore(lineary,(int)line,str);
1869                 }
1870                 bufend = linestr->str_ptr + linestr->str_cur;
1871                 if (hereis) {
1872                     if (*s == term && bcmp(s,tokenbuf,len) == 0) {
1873                         s = bufend - 1;
1874                         *s = ' ';
1875                         str_scat(linestr,herewas);
1876                         bufend = linestr->str_ptr + linestr->str_cur;
1877                     }
1878                     else {
1879                         s = bufend;
1880                         str_scat(tmpstr,linestr);
1881                     }
1882                 }
1883                 else
1884                     s = str_append_till(tmpstr,s,bufend,term,leave);
1885             }
1886             multi_end = line;
1887             s++;
1888             if (tmpstr->str_cur + 5 < tmpstr->str_len) {
1889                 tmpstr->str_len = tmpstr->str_cur + 1;
1890                 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
1891             }
1892             if ((arg[1].arg_type & A_MASK) == A_SINGLE) {
1893                 arg[1].arg_ptr.arg_str = tmpstr;
1894                 break;
1895             }
1896             tmps = s;
1897             s = tmpstr->str_ptr;
1898             send = s + tmpstr->str_cur;
1899             while (s < send) {          /* see if we can make SINGLE */
1900                 if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
1901                   !alwaysdollar )
1902                     *s = '$';           /* grandfather \digit in subst */
1903                 if ((*s == '$' || *s == '@') && s+1 < send &&
1904                   (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
1905                     makesingle = FALSE; /* force interpretation */
1906                 }
1907                 else if (*s == '\\' && s+1 < send) {
1908                     s++;
1909                 }
1910                 s++;
1911             }
1912             s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
1913             while (s < send) {
1914                 if ((*s == '$' && s+1 < send &&
1915                     (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
1916                     (*s == '@' && s+1 < send) ) {
1917                     len = scanreg(s,bufend,tokenbuf) - s;
1918                     if (*s == '$' || strEQ(tokenbuf,"ARGV")
1919                       || strEQ(tokenbuf,"ENV")
1920                       || strEQ(tokenbuf,"SIG")
1921                       || strEQ(tokenbuf,"INC") )
1922                         (void)stabent(tokenbuf,TRUE); /* make sure it exists */
1923                     while (len--)
1924                         *d++ = *s++;
1925                     continue;
1926                 }
1927                 else if (*s == '\\' && s+1 < send) {
1928                     s++;
1929                     switch (*s) {
1930                     default:
1931                         if (!makesingle && (!leave || (*s && index(leave,*s))))
1932                             *d++ = '\\';
1933                         *d++ = *s++;
1934                         continue;
1935                     case '0': case '1': case '2': case '3':
1936                     case '4': case '5': case '6': case '7':
1937                         *d = *s++ - '0';
1938                         if (s < send && *s && index("01234567",*s)) {
1939                             *d <<= 3;
1940                             *d += *s++ - '0';
1941                         }
1942                         if (s < send && *s && index("01234567",*s)) {
1943                             *d <<= 3;
1944                             *d += *s++ - '0';
1945                         }
1946                         d++;
1947                         continue;
1948                     case 'b':
1949                         *d++ = '\b';
1950                         break;
1951                     case 'n':
1952                         *d++ = '\n';
1953                         break;
1954                     case 'r':
1955                         *d++ = '\r';
1956                         break;
1957                     case 'f':
1958                         *d++ = '\f';
1959                         break;
1960                     case 't':
1961                         *d++ = '\t';
1962                         break;
1963                     }
1964                     s++;
1965                     continue;
1966                 }
1967                 *d++ = *s++;
1968             }
1969             *d = '\0';
1970
1971             if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
1972                     arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
1973
1974             tmpstr->str_u.str_hash = curstash;  /* so interp knows package */
1975
1976             tmpstr->str_cur = d - tmpstr->str_ptr;
1977             arg[1].arg_ptr.arg_str = tmpstr;
1978             s = tmps;
1979             break;
1980         }
1981     }
1982     if (hereis)
1983         str_free(herewas);
1984     return s;
1985 }
1986
1987 FCMD *
1988 load_format()
1989 {
1990     FCMD froot;
1991     FCMD *flinebeg;
1992     register FCMD *fprev = &froot;
1993     register FCMD *fcmd;
1994     register char *s;
1995     register char *t;
1996     register STR *str;
1997     bool noblank;
1998     bool repeater;
1999
2000     Zero(&froot, 1, FCMD);
2001     while ((s = str_gets(linestr,rsfp, 0)) != Nullch) {
2002         line++;
2003         if (perldb) {
2004             STR *tmpstr = Str_new(89,0);
2005
2006             str_sset(tmpstr,linestr);
2007             astore(lineary,(int)line,tmpstr);
2008         }
2009         bufend = linestr->str_ptr + linestr->str_cur;
2010         if (strEQ(s,".\n")) {
2011             bufptr = s;
2012             return froot.f_next;
2013         }
2014         if (*s == '#')
2015             continue;
2016         flinebeg = Nullfcmd;
2017         noblank = FALSE;
2018         repeater = FALSE;
2019         while (s < bufend) {
2020             Newz(804,fcmd,1,FCMD);
2021             fprev->f_next = fcmd;
2022             fprev = fcmd;
2023             for (t=s; t < bufend && *t != '@' && *t != '^'; t++) {
2024                 if (*t == '~') {
2025                     noblank = TRUE;
2026                     *t = ' ';
2027                     if (t[1] == '~') {
2028                         repeater = TRUE;
2029                         t[1] = ' ';
2030                     }
2031                 }
2032             }
2033             fcmd->f_pre = nsavestr(s, t-s);
2034             fcmd->f_presize = t-s;
2035             s = t;
2036             if (s >= bufend) {
2037                 if (noblank)
2038                     fcmd->f_flags |= FC_NOBLANK;
2039                 if (repeater)
2040                     fcmd->f_flags |= FC_REPEAT;
2041                 break;
2042             }
2043             if (!flinebeg)
2044                 flinebeg = fcmd;                /* start values here */
2045             if (*s++ == '^')
2046                 fcmd->f_flags |= FC_CHOP;       /* for doing text filling */
2047             switch (*s) {
2048             case '*':
2049                 fcmd->f_type = F_LINES;
2050                 *s = '\0';
2051                 break;
2052             case '<':
2053                 fcmd->f_type = F_LEFT;
2054                 while (*s == '<')
2055                     s++;
2056                 break;
2057             case '>':
2058                 fcmd->f_type = F_RIGHT;
2059                 while (*s == '>')
2060                     s++;
2061                 break;
2062             case '|':
2063                 fcmd->f_type = F_CENTER;
2064                 while (*s == '|')
2065                     s++;
2066                 break;
2067             default:
2068                 fcmd->f_type = F_LEFT;
2069                 break;
2070             }
2071             if (fcmd->f_flags & FC_CHOP && *s == '.') {
2072                 fcmd->f_flags |= FC_MORE;
2073                 while (*s == '.')
2074                     s++;
2075             }
2076             fcmd->f_size = s-t;
2077         }
2078         if (flinebeg) {
2079           again:
2080             if ((s = str_gets(linestr, rsfp, 0)) == Nullch)
2081                 goto badform;
2082             line++;
2083             if (perldb) {
2084                 STR *tmpstr = Str_new(90,0);
2085
2086                 str_sset(tmpstr,linestr);
2087                 astore(lineary,(int)line,tmpstr);
2088             }
2089             if (strEQ(s,".\n")) {
2090                 bufptr = s;
2091                 yyerror("Missing values line");
2092                 return froot.f_next;
2093             }
2094             if (*s == '#')
2095                 goto again;
2096             bufend = linestr->str_ptr + linestr->str_cur;
2097             str = flinebeg->f_unparsed = Str_new(91,bufend - bufptr);
2098             str->str_u.str_hash = curstash;
2099             str_nset(str,"(",1);
2100             flinebeg->f_line = line;
2101             if (!flinebeg->f_next->f_type || index(linestr->str_ptr, ',')) {
2102                 str_scat(str,linestr);
2103                 str_ncat(str,",$$);",5);
2104             }
2105             else {
2106                 while (s < bufend && isspace(*s))
2107                     s++;
2108                 t = s;
2109                 while (s < bufend) {
2110                     switch (*s) {
2111                     case ' ': case '\t': case '\n': case ';':
2112                         str_ncat(str, t, s - t);
2113                         str_ncat(str, "," ,1);
2114                         while (s < bufend && (isspace(*s) || *s == ';'))
2115                             s++;
2116                         t = s;
2117                         break;
2118                     case '$':
2119                         str_ncat(str, t, s - t);
2120                         t = s;
2121                         s = scanreg(s,bufend,tokenbuf);
2122                         str_ncat(str, t, s - t);
2123                         t = s;
2124                         if (s < bufend && *s && index("$'\"",*s))
2125                             str_ncat(str, ",", 1);
2126                         break;
2127                     case '"': case '\'':
2128                         str_ncat(str, t, s - t);
2129                         t = s;
2130                         s++;
2131                         while (s < bufend && (*s != *t || s[-1] == '\\'))
2132                             s++;
2133                         if (s < bufend)
2134                             s++;
2135                         str_ncat(str, t, s - t);
2136                         t = s;
2137                         if (s < bufend && *s && index("$'\"",*s))
2138                             str_ncat(str, ",", 1);
2139                         break;
2140                     default:
2141                         yyerror("Please use commas to separate fields");
2142                     }
2143                 }
2144                 str_ncat(str,"$$);",4);
2145             }
2146         }
2147     }
2148   badform:
2149     bufptr = str_get(linestr);
2150     yyerror("Format not terminated");
2151     return froot.f_next;
2152 }
2153
2154 set_csh()
2155 {
2156 #ifdef CSH
2157     if (!cshlen)
2158         cshlen = strlen(cshname);
2159 #endif
2160 }