toke.c

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