toke.c

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