toke.c.orig

   1 /* $RCSfile: toke.c,v $$Revision: 4.0.1.8 $$Date: 92/06/23 12:33:45 $
   2  *
   3  *    Copyright (c) 1991, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  * $Log:        toke.c,v $
   9  * Revision 4.0.1.8  92/06/23  12:33:45  lwall
  10  * patch35: bad interaction between backslash and hyphen in tr///
  11  *
  12  * Revision 4.0.1.7  92/06/11  21:16:30  lwall
  13  * patch34: expectterm incorrectly set to indicate start of program or block
  14  *
  15  * Revision 4.0.1.6  92/06/08  16:03:49  lwall
  16  * patch20: an EXPR may now start with a bareword
  17  * patch20: print $fh EXPR can now expect term rather than operator in EXPR
  18  * patch20: added ... as variant on ..
  19  * patch20: new warning on spurious backslash
  20  * patch20: new warning on missing $ for foreach variable
  21  * patch20: "foo"x1024 now legal without space after x
  22  * patch20: new warning on print accidentally used as function
  23  * patch20: tr/stuff// wasn't working right
  24  * patch20: 2. now eats the dot
  25  * patch20: <@ARGV> now notices @ARGV
  26  * patch20: tr/// now lets you say \-
  27  *
  28  * Revision 4.0.1.5  91/11/11  16:45:51  lwall
  29  * patch19: default arg for shift was wrong after first subroutine definition
  30  *
  31  * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  32  * patch11: \x and \c were subject to double interpretation in regexps
  33  * patch11: prepared for ctype implementations that don't define isascii()
  34  * patch11: nested list operators could miscount parens
  35  * patch11: once-thru blocks didn't display right in the debugger
  36  * patch11: sort eval "whatever" didn't work
  37  * patch11: underscore is now allowed within literal octal and hex numbers
  38  *
  39  * Revision 4.0.1.3  91/06/10  01:32:26  lwall
  40  * patch10: m'$foo' now treats string as single quoted
  41  * patch10: certain pattern optimizations were botched
  42  *
  43  * Revision 4.0.1.2  91/06/07  12:05:56  lwall
  44  * patch4: new copyright notice
  45  * patch4: debugger lost track of lines in eval
  46  * patch4: //o and s///o now optimize themselves fully at runtime
  47  * patch4: added global modifier for pattern matches
  48  *
  49  * Revision 4.0.1.1  91/04/12  09:18:18  lwall
  50  * patch1: perl -de "print" wouldn't stop at the first statement
  51  *
  52  * Revision 4.0  91/03/20  01:42:14  lwall
  53  * 4.0 baseline.
  54  *
  55  */
  56
  57 #include "EXTERN.h"
  58 #include "perl.h"
  59 #include "perly.h"
  60
  61 static void set_csh();
  62
  63 #ifdef I_FCNTL
  64 #include <fcntl.h>
  65 #endif
  66 #ifdef I_SYS_FILE
  67 #include <sys/file.h>
  68 #endif
  69
  70 #ifdef f_next
  71 #undef f_next
  72 #endif
  73
  74 /* which backslash sequences to keep in m// or s// */
  75
  76 static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
  77
  78 char *reparse;          /* if non-null, scanident found ${foo[$bar]} */
  79
  80 void checkcomma();
  81
  82 #ifdef CLINE
  83 #undef CLINE
  84 #endif
  85 #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
  86
  87 #ifdef atarist
  88 #define PERL_META(c) ((c) | 128)
  89 #else
  90 #define META(c) ((c) | 128)
  91 #endif
  92
  93 #define RETURN(retval) return (bufptr = s,(int)retval)
  94 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
  95 #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
  96 #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
  97 #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
  98 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
  99 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
 100 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
 101 #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
 102 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
 103 #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
 104 #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
 105 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
 106 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
 107 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
 108 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
 109 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
 110 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
 111 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
 112 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
 113 #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
 114 #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
 115 #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
 116 #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
 117 #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
 118 #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
 119 #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
 120
 121 static char *last_uni;
 122
 123 /* This bit of chicanery makes a unary function followed by
 124  * a parenthesis into a function with one argument, highest precedence.
 125  */
 126 #define UNI(f) return(yylval.ival = f, \
 127         expectterm = TRUE, \
 128         bufptr = s, \
 129         last_uni = oldbufptr, \
 130         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 131
 132 /* This does similarly for list operators, merely by pretending that the
 133  * paren came before the listop rather than after.
 134  */
 135 #ifdef atarist
 136 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
 137         (*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
 138         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 139 #else
 140 #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
 141         (*s = (char) META('('), bufptr = oldbufptr, '(') : \
 142         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 143 #endif
 144 /* grandfather return to old style */
 145 #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
 146
 147 char *
 148 skipspace(s)
 149 register char *s;
 150 {
 151     while (s < bufend && isSPACE(*s))
 152         s++;
 153     return s;
 154 }
 155
 156 void
 157 check_uni() {
 158     char *s;
 159     char ch;
 160
 161     if (oldoldbufptr != last_uni)
 162         return;
 163     while (isSPACE(*last_uni))
 164         last_uni++;
 165     for (s = last_uni; isALNUM(*s); s++) ;
 166     ch = *s;
 167     *s = '\0';
 168     warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
 169     *s = ch;
 170 }
 171
 172 #ifdef CRIPPLED_CC
 173
 174 #undef UNI
 175 #undef LOP
 176 #define UNI(f) return uni(f,s)
 177 #define LOP(f) return lop(f,s)
 178
 179 int
 180 uni(f,s)
 181 int f;
 182 char *s;
 183 {
 184     yylval.ival = f;
 185     expectterm = TRUE;
 186     bufptr = s;
 187     last_uni = oldbufptr;
 188     if (*s == '(')
 189         return FUNC1;
 190     s = skipspace(s);
 191     if (*s == '(')
 192         return FUNC1;
 193     else
 194         return UNIOP;
 195 }
 196
 197 int
 198 lop(f,s)
 199 int f;
 200 char *s;
 201 {
 202     CLINE;
 203     if (*s != '(')
 204         s = skipspace(s);
 205     if (*s == '(') {
 206 #ifdef atarist
 207         *s = PERL_META('(');
 208 #else
 209         *s = META('(');
 210 #endif
 211         bufptr = oldbufptr;
 212         return '(';
 213     }
 214     else {
 215         yylval.ival=f;
 216         expectterm = TRUE;
 217         bufptr = s;
 218         return LISTOP;
 219     }
 220 }
 221
 222 #endif /* CRIPPLED_CC */
 223
 224 int
 225 yylex()
 226 {
 227     register char *s = bufptr;
 228     register char *d;
 229     register int tmp;
 230     static bool in_format = FALSE;
 231     static bool firstline = TRUE;
 232     extern int yychar;          /* last token */
 233
 234     oldoldbufptr = oldbufptr;
 235     oldbufptr = s;
 236
 237   retry:
 238 #ifdef YYDEBUG
 239     if (debug & 1)
 240         if (index(s,'\n'))
 241             fprintf(stderr,"Tokener at %s",s);
 242         else
 243             fprintf(stderr,"Tokener at %s\n",s);
 244 #endif
 245 #ifdef BADSWITCH
 246     if (*s & 128) {
 247         if ((*s & 127) == '(') {
 248             *s++ = '(';
 249             oldbufptr = s;
 250         }
 251         else if ((*s & 127) == '}') {
 252             *s++ = '}';
 253             RETURN('}');
 254         }
 255         else
 256             warn("Unrecognized character \\%03o ignored", *s++ & 255);
 257         goto retry;
 258     }
 259 #endif
 260     switch (*s) {
 261     default:
 262         if ((*s & 127) == '(') {
 263             *s++ = '(';
 264             oldbufptr = s;
 265         }
 266         else if ((*s & 127) == '}') {
 267             *s++ = '}';
 268             RETURN('}');
 269         }
 270         else
 271             warn("Unrecognized character \\%03o ignored", *s++ & 255);
 272         goto retry;
 273     case 4:
 274     case 26:
 275         goto fake_eof;                  /* emulate EOF on ^D or ^Z */
 276     case 0:
 277         if (!rsfp)
 278             RETURN(0);
 279         if (s++ < bufend)
 280             goto retry;                 /* ignore stray nulls */
 281         last_uni = 0;
 282         if (firstline) {
 283             firstline = FALSE;
 284             if (minus_n || minus_p || perldb) {
 285                 str_set(linestr,"");
 286                 if (perldb) {
 287                     char *getenv();
 288                     char *pdb = getenv("PERLDB");
 289
 290                     str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
 291                     str_cat(linestr, ";");
 292                 }
 293                 if (minus_n || minus_p) {
 294                     str_cat(linestr,"line: while (<>) {");
 295                     if (minus_l)
 296                         str_cat(linestr,"chop;");
 297                     if (minus_a)
 298                         str_cat(linestr,"@F=split(' ');");
 299                 }
 300                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 301                 bufend = linestr->str_ptr + linestr->str_cur;
 302                 goto retry;
 303             }
 304         }
 305         if (in_format) {
 306             bufptr = bufend;
 307             yylval.formval = load_format();
 308             in_format = FALSE;
 309             oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
 310             bufend = linestr->str_ptr + linestr->str_cur;
 311             OPERATOR(FORMLIST);
 312         }
 313         curcmd->c_line++;
 314 #ifdef CRYPTSCRIPT
 315         cryptswitch();
 316 #endif /* CRYPTSCRIPT */
 317         do {
 318             if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
 319               fake_eof:
 320                 if (rsfp) {
 321                     if (preprocess)
 322                         (void)mypclose(rsfp);
 323                     else if ((FILE*)rsfp == stdin)
 324                         clearerr(stdin);
 325                     else
 326                         (void)fclose(rsfp);
 327                     rsfp = Nullfp;
 328                 }
 329                 if (minus_n || minus_p) {
 330                     str_set(linestr,minus_p ? ";}continue{print" : "");
 331                     str_cat(linestr,";}");
 332                     oldoldbufptr = oldbufptr = s = str_get(linestr);
 333                     bufend = linestr->str_ptr + linestr->str_cur;
 334                     minus_n = minus_p = 0;
 335                     goto retry;
 336                 }
 337                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 338                 str_set(linestr,"");
 339                 RETURN(';');    /* not infinite loop because rsfp is NULL now */
 340             }
 341             if (doextract && *linestr->str_ptr == '#')
 342                 doextract = FALSE;
 343         } while (doextract);
 344         oldoldbufptr = oldbufptr = bufptr = s;
 345         if (perldb) {
 346             STR *str = Str_new(85,0);
 347
 348             str_sset(str,linestr);
 349             astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
 350         }
 351 #ifdef DEBUG
 352         if (firstline) {
 353             char *showinput();
 354             s = showinput();
 355         }
 356 #endif
 357         bufend = linestr->str_ptr + linestr->str_cur;
 358         if (curcmd->c_line == 1) {
 359             if (*s == '#' && s[1] == '!') {
 360                 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
 361                     char **newargv;
 362                     char *cmd;
 363
 364                     s += 2;
 365                     if (*s == ' ')
 366                         s++;
 367                     cmd = s;
 368                     while (s < bufend && !isSPACE(*s))
 369                         s++;
 370                     *s++ = '\0';
 371                     while (s < bufend && isSPACE(*s))
 372                         s++;
 373                     if (s < bufend) {
 374                         Newz(899,newargv,origargc+3,char*);
 375                         newargv[1] = s;
 376                         while (s < bufend && !isSPACE(*s))
 377                             s++;
 378                         *s = '\0';
 379                         Copy(origargv+1, newargv+2, origargc+1, char*);
 380                     }
 381                     else
 382                         newargv = origargv;
 383                     newargv[0] = cmd;
 384                     execv(cmd,newargv);
 385                     fatal("Can't exec %s", cmd);
 386                 }
 387             }
 388             else {
 389                 while (s < bufend && isSPACE(*s))
 390                     s++;
 391                 if (*s == ':')  /* for csh's that have to exec sh scripts */
 392                     s++;
 393             }
 394         }
 395         goto retry;
 396     case ' ': case '\t': case '\f': case '\r': case 013:
 397         s++;
 398         goto retry;
 399     case '#':
 400         if (preprocess && s == str_get(linestr) &&
 401                s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
 402             while (*s && !isDIGIT(*s))
 403                 s++;
 404             curcmd->c_line = atoi(s)-1;
 405             while (isDIGIT(*s))
 406                 s++;
 407             d = bufend;
 408             while (s < d && isSPACE(*s)) s++;
 409             s[strlen(s)-1] = '\0';      /* wipe out newline */
 410             if (*s == '"') {
 411                 s++;
 412                 s[strlen(s)-1] = '\0';  /* wipe out trailing quote */
 413             }
 414             if (*s)
 415                 curcmd->c_filestab = fstab(s);
 416             else
 417                 curcmd->c_filestab = fstab(origfilename);
 418             oldoldbufptr = oldbufptr = s = str_get(linestr);
 419         }
 420         /* FALL THROUGH */
 421     case '\n':
 422         if (in_eval && !rsfp) {
 423             d = bufend;
 424             while (s < d && *s != '\n')
 425                 s++;
 426             if (s < d)
 427                 s++;
 428             if (in_format) {
 429                 bufptr = s;
 430                 yylval.formval = load_format();
 431                 in_format = FALSE;
 432                 oldoldbufptr = oldbufptr = s = bufptr + 1;
 433                 TERM(FORMLIST);
 434             }
 435             curcmd->c_line++;
 436         }
 437         else {
 438             *s = '\0';
 439             bufend = s;
 440         }
 441         goto retry;
 442     case '-':
 443         if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
 444             s++;
 445             switch (*s++) {
 446             case 'r': FTST(O_FTEREAD);
 447             case 'w': FTST(O_FTEWRITE);
 448             case 'x': FTST(O_FTEEXEC);
 449             case 'o': FTST(O_FTEOWNED);
 450             case 'R': FTST(O_FTRREAD);
 451             case 'W': FTST(O_FTRWRITE);
 452             case 'X': FTST(O_FTREXEC);
 453             case 'O': FTST(O_FTROWNED);
 454             case 'e': FTST(O_FTIS);
 455             case 'z': FTST(O_FTZERO);
 456             case 's': FTST(O_FTSIZE);
 457             case 'f': FTST(O_FTFILE);
 458             case 'd': FTST(O_FTDIR);
 459             case 'l': FTST(O_FTLINK);
 460             case 'p': FTST(O_FTPIPE);
 461             case 'S': FTST(O_FTSOCK);
 462             case 'u': FTST(O_FTSUID);
 463             case 'g': FTST(O_FTSGID);
 464             case 'k': FTST(O_FTSVTX);
 465             case 'b': FTST(O_FTBLK);
 466             case 'c': FTST(O_FTCHR);
 467             case 't': FTST(O_FTTTY);
 468             case 'T': FTST(O_FTTEXT);
 469             case 'B': FTST(O_FTBINARY);
 470             case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
 471             case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
 472             case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
 473             default:
 474                 s -= 2;
 475                 break;
 476             }
 477         }
 478         tmp = *s++;
 479         if (*s == tmp) {
 480             s++;
 481             RETURN(DEC);
 482         }
 483         if (expectterm) {
 484             if (isSPACE(*s) || !isSPACE(*bufptr))
 485                 check_uni();
 486             OPERATOR('-');
 487         }
 488         else
 489             AOP(O_SUBTRACT);
 490     case '+':
 491         tmp = *s++;
 492         if (*s == tmp) {
 493             s++;
 494             RETURN(INC);
 495         }
 496         if (expectterm) {
 497             if (isSPACE(*s) || !isSPACE(*bufptr))
 498                 check_uni();
 499             OPERATOR('+');
 500         }
 501         else
 502             AOP(O_ADD);
 503
 504     case '*':
 505         if (expectterm) {
 506             check_uni();
 507             s = scanident(s,bufend,tokenbuf);
 508             yylval.stabval = stabent(tokenbuf,TRUE);
 509             TERM(STAR);
 510         }
 511         tmp = *s++;
 512         if (*s == tmp) {
 513             s++;
 514             OPERATOR(POW);
 515         }
 516         MOP(O_MULTIPLY);
 517     case '%':
 518         if (expectterm) {
 519             if (!isALPHA(s[1]))
 520                 check_uni();
 521             s = scanident(s,bufend,tokenbuf);
 522             yylval.stabval = hadd(stabent(tokenbuf,TRUE));
 523             TERM(HSH);
 524         }
 525         s++;
 526         MOP(O_MODULO);
 527
 528     case '^':
 529     case '~':
 530     case '(':
 531     case ',':
 532     case ':':
 533     case '[':
 534         tmp = *s++;
 535         OPERATOR(tmp);
 536     case '{':
 537         tmp = *s++;
 538         yylval.ival = curcmd->c_line;
 539         if (isSPACE(*s) || *s == '#')
 540             cmdline = NOLINE;   /* invalidate current command line number */
 541         expectterm = 2;
 542         RETURN(tmp);
 543     case ';':
 544         if (curcmd->c_line < cmdline)
 545             cmdline = curcmd->c_line;
 546         tmp = *s++;
 547         OPERATOR(tmp);
 548     case ')':
 549     case ']':
 550         tmp = *s++;
 551         TERM(tmp);
 552     case '}':
 553         *s |= 128;
 554         RETURN(';');
 555     case '&':
 556         s++;
 557         tmp = *s++;
 558         if (tmp == '&')
 559             OPERATOR(ANDAND);
 560         s--;
 561         if (expectterm) {
 562             d = bufend;
 563             while (s < d && isSPACE(*s))
 564                 s++;
 565             if (isALPHA(*s) || *s == '_' || *s == '\'')
 566                 *(--s) = '\\';  /* force next ident to WORD */
 567             else
 568                 check_uni();
 569             OPERATOR(AMPER);
 570         }
 571         OPERATOR('&');
 572     case '|':
 573         s++;
 574         tmp = *s++;
 575         if (tmp == '|')
 576             OPERATOR(OROR);
 577         s--;
 578         OPERATOR('|');
 579     case '=':
 580         s++;
 581         tmp = *s++;
 582         if (tmp == '=')
 583             EOP(O_EQ);
 584         if (tmp == '~')
 585             OPERATOR(MATCH);
 586         s--;
 587         OPERATOR('=');
 588     case '!':
 589         s++;
 590         tmp = *s++;
 591         if (tmp == '=')
 592             EOP(O_NE);
 593         if (tmp == '~')
 594             OPERATOR(NMATCH);
 595         s--;
 596         OPERATOR('!');
 597     case '<':
 598         if (expectterm) {
 599             if (s[1] != '<' && !index(s,'>'))
 600                 check_uni();
 601             s = scanstr(s, SCAN_DEF);
 602             TERM(RSTRING);
 603         }
 604         s++;
 605         tmp = *s++;
 606         if (tmp == '<')
 607             OPERATOR(LS);
 608         if (tmp == '=') {
 609             tmp = *s++;
 610             if (tmp == '>')
 611                 EOP(O_NCMP);
 612             s--;
 613             ROP(O_LE);
 614         }
 615         s--;
 616         ROP(O_LT);
 617     case '>':
 618         s++;
 619         tmp = *s++;
 620         if (tmp == '>')
 621             OPERATOR(RS);
 622         if (tmp == '=')
 623             ROP(O_GE);
 624         s--;
 625         ROP(O_GT);
 626
 627 #define SNARFWORD \
 628         d = tokenbuf; \
 629         while (isALNUM(*s) || *s == '\'') \
 630             *d++ = *s++; \
 631         while (d[-1] == '\'') \
 632             d--,s--; \
 633         *d = '\0'; \
 634         d = tokenbuf;
 635
 636     case '$':
 637         if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
 638             s++;
 639             s = scanident(s,bufend,tokenbuf);
 640             yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 641             TERM(ARYLEN);
 642         }
 643         d = s;
 644         s = scanident(s,bufend,tokenbuf);
 645         if (reparse) {          /* turn ${foo[bar]} into ($foo[bar]) */
 646           do_reparse:
 647             s[-1] = ')';
 648             s = d;
 649             s[1] = s[0];
 650             s[0] = '(';
 651             goto retry;
 652         }
 653         yylval.stabval = stabent(tokenbuf,TRUE);
 654         expectterm = FALSE;
 655         if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
 656             s++;
 657             while (isSPACE(*oldoldbufptr))
 658                 oldoldbufptr++;
 659             if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
 660                 if (index("&*<%", *s) && isALPHA(s[1]))
 661                     expectterm = TRUE;          /* e.g. print $fh &sub */
 662                 else if (*s == '.' && isDIGIT(s[1]))
 663                     expectterm = TRUE;          /* e.g. print $fh .3 */
 664                 else if (index("/?-+", *s) && !isSPACE(s[1]))
 665                     expectterm = TRUE;          /* e.g. print $fh -1 */
 666             }
 667         }
 668         RETURN(REG);
 669
 670     case '@':
 671         d = s;
 672         s = scanident(s,bufend,tokenbuf);
 673         if (reparse)
 674             goto do_reparse;
 675         yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 676         TERM(ARY);
 677
 678     case '/':                   /* may either be division or pattern */
 679     case '?':                   /* may either be conditional or pattern */
 680         if (expectterm) {
 681             check_uni();
 682             s = scanpat(s);
 683             TERM(PATTERN);
 684         }
 685         tmp = *s++;
 686         if (tmp == '/')
 687             MOP(O_DIVIDE);
 688         OPERATOR(tmp);
 689
 690     case '.':
 691         if (!expectterm || !isDIGIT(s[1])) {
 692             tmp = *s++;
 693             if (*s == tmp) {
 694                 s++;
 695                 if (*s == tmp) {
 696                     s++;
 697                     yylval.ival = 0;
 698                 }
 699                 else
 700                     yylval.ival = AF_COMMON;
 701                 OPERATOR(DOTDOT);
 702             }
 703             if (expectterm)
 704                 check_uni();
 705             AOP(O_CONCAT);
 706         }
 707         /* FALL THROUGH */
 708     case '0': case '1': case '2': case '3': case '4':
 709     case '5': case '6': case '7': case '8': case '9':
 710     case '\'': case '"': case '`':
 711         s = scanstr(s, SCAN_DEF);
 712         TERM(RSTRING);
 713
 714     case '\\':  /* some magic to force next word to be a WORD */
 715         s++;    /* used by do and sub to force a separate namespace */
 716         if (!isALPHA(*s) && *s != '_' && *s != '\'') {
 717             warn("Spurious backslash ignored");
 718             goto retry;
 719         }
 720         /* FALL THROUGH */
 721     case '_':
 722         SNARFWORD;
 723         if (d[1] == '_') {
 724             if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
 725                 ARG *arg = op_new(1);
 726
 727                 yylval.arg = arg;
 728                 arg->arg_type = O_ITEM;
 729                 if (d[2] == 'L')
 730                     (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
 731                 else
 732                     strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
 733                 arg[1].arg_type = A_SINGLE;
 734                 arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
 735                 TERM(RSTRING);
 736             }
 737             else if (strEQ(d,"__END__")) {
 738                 STAB *stab;
 739                 int fd;
 740
 741                 /*SUPPRESS 560*/
 742                 if (!in_eval && (stab = stabent("DATA",FALSE))) {
 743                     stab->str_pok |= SP_MULTI;
 744                     if (!stab_io(stab))
 745                         stab_io(stab) = stio_new();
 746                     stab_io(stab)->ifp = rsfp;
 747 #if defined(HAS_FCNTL) && defined(F_SETFD)
 748                     fd = fileno(rsfp);
 749                     fcntl(fd,F_SETFD,fd >= 3);
 750 #endif
 751                     if (preprocess)
 752                         stab_io(stab)->type = '|';
 753                     else if ((FILE*)rsfp == stdin)
 754                         stab_io(stab)->type = '-';
 755                     else
 756                         stab_io(stab)->type = '<';
 757                     rsfp = Nullfp;
 758                 }
 759                 goto fake_eof;
 760             }
 761         }
 762         break;
 763     case 'a': case 'A':
 764         SNARFWORD;
 765         if (strEQ(d,"alarm"))
 766             UNI(O_ALARM);
 767         if (strEQ(d,"accept"))
 768             FOP22(O_ACCEPT);
 769         if (strEQ(d,"atan2"))
 770             FUN2(O_ATAN2);
 771         break;
 772     case 'b': case 'B':
 773         SNARFWORD;
 774         if (strEQ(d,"bind"))
 775             FOP2(O_BIND);
 776         if (strEQ(d,"binmode"))
 777             FOP(O_BINMODE);
 778         break;
 779     case 'c': case 'C':
 780         SNARFWORD;
 781         if (strEQ(d,"chop"))
 782             LFUN(O_CHOP);
 783         if (strEQ(d,"continue"))
 784             OPERATOR(CONTINUE);
 785         if (strEQ(d,"chdir")) {
 786             (void)stabent("ENV",TRUE);  /* may use HOME */
 787             UNI(O_CHDIR);
 788         }
 789         if (strEQ(d,"close"))
 790             FOP(O_CLOSE);
 791         if (strEQ(d,"closedir"))
 792             FOP(O_CLOSEDIR);
 793         if (strEQ(d,"cmp"))
 794             EOP(O_SCMP);
 795         if (strEQ(d,"caller"))
 796             UNI(O_CALLER);
 797         if (strEQ(d,"crypt")) {
 798 #ifdef FCRYPT
 799             static int cryptseen = 0;
 800
 801             if (!cryptseen++)
 802                 init_des();
 803 #endif
 804             FUN2(O_CRYPT);
 805         }
 806         if (strEQ(d,"chmod"))
 807             LOP(O_CHMOD);
 808         if (strEQ(d,"chown"))
 809             LOP(O_CHOWN);
 810         if (strEQ(d,"connect"))
 811             FOP2(O_CONNECT);
 812         if (strEQ(d,"cos"))
 813             UNI(O_COS);
 814         if (strEQ(d,"chroot"))
 815             UNI(O_CHROOT);
 816         break;
 817     case 'd': case 'D':
 818         SNARFWORD;
 819         if (strEQ(d,"do")) {
 820             d = bufend;
 821             while (s < d && isSPACE(*s))
 822                 s++;
 823             if (isALPHA(*s) || *s == '_')
 824                 *(--s) = '\\';  /* force next ident to WORD */
 825             OPERATOR(DO);
 826         }
 827         if (strEQ(d,"die"))
 828             LOP(O_DIE);
 829         if (strEQ(d,"defined"))
 830             LFUN(O_DEFINED);
 831         if (strEQ(d,"delete"))
 832             OPERATOR(DELETE);
 833         if (strEQ(d,"dbmopen"))
 834             HFUN3(O_DBMOPEN);
 835         if (strEQ(d,"dbmclose"))
 836             HFUN(O_DBMCLOSE);
 837         if (strEQ(d,"dump"))
 838             LOOPX(O_DUMP);
 839         break;
 840     case 'e': case 'E':
 841         SNARFWORD;
 842         if (strEQ(d,"else"))
 843             OPERATOR(ELSE);
 844         if (strEQ(d,"elsif")) {
 845             yylval.ival = curcmd->c_line;
 846             OPERATOR(ELSIF);
 847         }
 848         if (strEQ(d,"eq") || strEQ(d,"EQ"))
 849             EOP(O_SEQ);
 850         if (strEQ(d,"exit"))
 851             UNI(O_EXIT);
 852         if (strEQ(d,"eval")) {
 853             allstabs = TRUE;            /* must initialize everything since */
 854             UNI(O_EVAL);                /* we don't know what will be used */
 855         }
 856         if (strEQ(d,"eof"))
 857             FOP(O_EOF);
 858         if (strEQ(d,"exp"))
 859             UNI(O_EXP);
 860         if (strEQ(d,"each"))
 861             HFUN(O_EACH);
 862         if (strEQ(d,"exec")) {
 863             set_csh();
 864             LOP(O_EXEC_OP);
 865         }
 866         if (strEQ(d,"endhostent"))
 867             FUN0(O_EHOSTENT);
 868         if (strEQ(d,"endnetent"))
 869             FUN0(O_ENETENT);
 870         if (strEQ(d,"endservent"))
 871             FUN0(O_ESERVENT);
 872         if (strEQ(d,"endprotoent"))
 873             FUN0(O_EPROTOENT);
 874         if (strEQ(d,"endpwent"))
 875             FUN0(O_EPWENT);
 876         if (strEQ(d,"endgrent"))
 877             FUN0(O_EGRENT);
 878         break;
 879     case 'f': case 'F':
 880         SNARFWORD;
 881         if (strEQ(d,"for") || strEQ(d,"foreach")) {
 882             yylval.ival = curcmd->c_line;
 883             while (s < bufend && isSPACE(*s))
 884                 s++;
 885             if (isALPHA(*s))
 886                 fatal("Missing $ on loop variable");
 887             OPERATOR(FOR);
 888         }
 889         if (strEQ(d,"format")) {
 890             d = bufend;
 891             while (s < d && isSPACE(*s))
 892                 s++;
 893             if (isALPHA(*s) || *s == '_')
 894                 *(--s) = '\\';  /* force next ident to WORD */
 895             in_format = TRUE;
 896             allstabs = TRUE;            /* must initialize everything since */
 897             OPERATOR(FORMAT);           /* we don't know what will be used */
 898         }
 899         if (strEQ(d,"fork"))
 900             FUN0(O_FORK);
 901         if (strEQ(d,"fcntl"))
 902             FOP3(O_FCNTL);
 903         if (strEQ(d,"fileno"))
 904             FOP(O_FILENO);
 905         if (strEQ(d,"flock"))
 906             FOP2(O_FLOCK);
 907         break;
 908     case 'g': case 'G':
 909         SNARFWORD;
 910         if (strEQ(d,"gt") || strEQ(d,"GT"))
 911             ROP(O_SGT);
 912         if (strEQ(d,"ge") || strEQ(d,"GE"))
 913             ROP(O_SGE);
 914         if (strEQ(d,"grep"))
 915             FL2(O_GREP);
 916         if (strEQ(d,"goto"))
 917             LOOPX(O_GOTO);
 918         if (strEQ(d,"gmtime"))
 919             UNI(O_GMTIME);
 920         if (strEQ(d,"getc"))
 921             FOP(O_GETC);
 922         if (strnEQ(d,"get",3)) {
 923             d += 3;
 924             if (*d == 'p') {
 925                 if (strEQ(d,"ppid"))
 926                     FUN0(O_GETPPID);
 927                 if (strEQ(d,"pgrp"))
 928                     UNI(O_GETPGRP);
 929                 if (strEQ(d,"priority"))
 930                     FUN2(O_GETPRIORITY);
 931                 if (strEQ(d,"protobyname"))
 932                     UNI(O_GPBYNAME);
 933                 if (strEQ(d,"protobynumber"))
 934                     FUN1(O_GPBYNUMBER);
 935                 if (strEQ(d,"protoent"))
 936                     FUN0(O_GPROTOENT);
 937                 if (strEQ(d,"pwent"))
 938                     FUN0(O_GPWENT);
 939                 if (strEQ(d,"pwnam"))
 940                     FUN1(O_GPWNAM);
 941                 if (strEQ(d,"pwuid"))
 942                     FUN1(O_GPWUID);
 943                 if (strEQ(d,"peername"))
 944                     FOP(O_GETPEERNAME);
 945             }
 946             else if (*d == 'h') {
 947                 if (strEQ(d,"hostbyname"))
 948                     UNI(O_GHBYNAME);
 949                 if (strEQ(d,"hostbyaddr"))
 950                     FUN2(O_GHBYADDR);
 951                 if (strEQ(d,"hostent"))
 952                     FUN0(O_GHOSTENT);
 953             }
 954             else if (*d == 'n') {
 955                 if (strEQ(d,"netbyname"))
 956                     UNI(O_GNBYNAME);
 957                 if (strEQ(d,"netbyaddr"))
 958                     FUN2(O_GNBYADDR);
 959                 if (strEQ(d,"netent"))
 960                     FUN0(O_GNETENT);
 961             }
 962             else if (*d == 's') {
 963                 if (strEQ(d,"servbyname"))
 964                     FUN2(O_GSBYNAME);
 965                 if (strEQ(d,"servbyport"))
 966                     FUN2(O_GSBYPORT);
 967                 if (strEQ(d,"servent"))
 968                     FUN0(O_GSERVENT);
 969                 if (strEQ(d,"sockname"))
 970                     FOP(O_GETSOCKNAME);
 971                 if (strEQ(d,"sockopt"))
 972                     FOP3(O_GSOCKOPT);
 973             }
 974             else if (*d == 'g') {
 975                 if (strEQ(d,"grent"))
 976                     FUN0(O_GGRENT);
 977                 if (strEQ(d,"grnam"))
 978                     FUN1(O_GGRNAM);
 979                 if (strEQ(d,"grgid"))
 980                     FUN1(O_GGRGID);
 981             }
 982             else if (*d == 'l') {
 983                 if (strEQ(d,"login"))
 984                     FUN0(O_GETLOGIN);
 985             }
 986             d -= 3;
 987         }
 988         break;
 989     case 'h': case 'H':
 990         SNARFWORD;
 991         if (strEQ(d,"hex"))
 992             UNI(O_HEX);
 993         break;
 994     case 'i': case 'I':
 995         SNARFWORD;
 996         if (strEQ(d,"if")) {
 997             yylval.ival = curcmd->c_line;
 998             OPERATOR(IF);
 999         }
1000         if (strEQ(d,"index"))
1001             FUN2x(O_INDEX);
1002         if (strEQ(d,"int"))
1003             UNI(O_INT);
1004         if (strEQ(d,"ioctl"))
1005             FOP3(O_IOCTL);
1006         break;
1007     case 'j': case 'J':
1008         SNARFWORD;
1009         if (strEQ(d,"join"))
1010             FL2(O_JOIN);
1011         break;
1012     case 'k': case 'K':
1013         SNARFWORD;
1014         if (strEQ(d,"keys"))
1015             HFUN(O_KEYS);
1016         if (strEQ(d,"kill"))
1017             LOP(O_KILL);
1018         break;
1019     case 'l': case 'L':
1020         SNARFWORD;
1021         if (strEQ(d,"last"))
1022             LOOPX(O_LAST);
1023         if (strEQ(d,"local"))
1024             OPERATOR(LOCAL);
1025         if (strEQ(d,"length"))
1026             UNI(O_LENGTH);
1027         if (strEQ(d,"lt") || strEQ(d,"LT"))
1028             ROP(O_SLT);
1029         if (strEQ(d,"le") || strEQ(d,"LE"))
1030             ROP(O_SLE);
1031         if (strEQ(d,"localtime"))
1032             UNI(O_LOCALTIME);
1033         if (strEQ(d,"log"))
1034             UNI(O_LOG);
1035         if (strEQ(d,"link"))
1036             FUN2(O_LINK);
1037         if (strEQ(d,"listen"))
1038             FOP2(O_LISTEN);
1039         if (strEQ(d,"lstat"))
1040             FOP(O_LSTAT);
1041         break;
1042     case 'm': case 'M':
1043         if (s[1] == '\'') {
1044             d = "m";
1045             s++;
1046         }
1047         else {
1048             SNARFWORD;
1049         }
1050         if (strEQ(d,"m")) {
1051             s = scanpat(s-1);
1052             if (yylval.arg)
1053                 TERM(PATTERN);
1054             else
1055                 RETURN(1);      /* force error */
1056         }
1057         switch (d[1]) {
1058         case 'k':
1059             if (strEQ(d,"mkdir"))
1060                 FUN2(O_MKDIR);
1061             break;
1062         case 's':
1063             if (strEQ(d,"msgctl"))
1064                 FUN3(O_MSGCTL);
1065             if (strEQ(d,"msgget"))
1066                 FUN2(O_MSGGET);
1067             if (strEQ(d,"msgrcv"))
1068                 FUN5(O_MSGRCV);
1069             if (strEQ(d,"msgsnd"))
1070                 FUN3(O_MSGSND);
1071             break;
1072         }
1073         break;
1074     case 'n': case 'N':
1075         SNARFWORD;
1076         if (strEQ(d,"next"))
1077             LOOPX(O_NEXT);
1078         if (strEQ(d,"ne") || strEQ(d,"NE"))
1079             EOP(O_SNE);
1080         break;
1081     case 'o': case 'O':
1082         SNARFWORD;
1083         if (strEQ(d,"open"))
1084             OPERATOR(OPEN);
1085         if (strEQ(d,"ord"))
1086             UNI(O_ORD);
1087         if (strEQ(d,"oct"))
1088             UNI(O_OCT);
1089         if (strEQ(d,"opendir"))
1090             FOP2(O_OPEN_DIR);
1091         break;
1092     case 'p': case 'P':
1093         SNARFWORD;
1094         if (strEQ(d,"print")) {
1095             checkcomma(s,d,"filehandle");
1096             LOP(O_PRINT);
1097         }
1098         if (strEQ(d,"printf")) {
1099             checkcomma(s,d,"filehandle");
1100             LOP(O_PRTF);
1101         }
1102         if (strEQ(d,"push")) {
1103             yylval.ival = O_PUSH;
1104             OPERATOR(PUSH);
1105         }
1106         if (strEQ(d,"pop"))
1107             OPERATOR(POP);
1108         if (strEQ(d,"pack"))
1109             FL2(O_PACK);
1110         if (strEQ(d,"package"))
1111             OPERATOR(PACKAGE);
1112         if (strEQ(d,"pipe"))
1113             FOP22(O_PIPE_OP);
1114         break;
1115     case 'q': case 'Q':
1116         SNARFWORD;
1117         if (strEQ(d,"q")) {
1118             s = scanstr(s-1, SCAN_DEF);
1119             TERM(RSTRING);
1120         }
1121         if (strEQ(d,"qq")) {
1122             s = scanstr(s-2, SCAN_DEF);
1123             TERM(RSTRING);
1124         }
1125         if (strEQ(d,"qx")) {
1126             s = scanstr(s-2, SCAN_DEF);
1127             TERM(RSTRING);
1128         }
1129         break;
1130     case 'r': case 'R':
1131         SNARFWORD;
1132         if (strEQ(d,"return"))
1133             OLDLOP(O_RETURN);
1134         if (strEQ(d,"require")) {
1135             allstabs = TRUE;            /* must initialize everything since */
1136             UNI(O_REQUIRE);             /* we don't know what will be used */
1137         }
1138         if (strEQ(d,"reset"))
1139             UNI(O_RESET);
1140         if (strEQ(d,"redo"))
1141             LOOPX(O_REDO);
1142         if (strEQ(d,"rename"))
1143             FUN2(O_RENAME);
1144         if (strEQ(d,"rand"))
1145             UNI(O_RAND);
1146         if (strEQ(d,"rmdir"))
1147             UNI(O_RMDIR);
1148         if (strEQ(d,"rindex"))
1149             FUN2x(O_RINDEX);
1150         if (strEQ(d,"read"))
1151             FOP3(O_READ);
1152         if (strEQ(d,"readdir"))
1153             FOP(O_READDIR);
1154         if (strEQ(d,"rewinddir"))
1155             FOP(O_REWINDDIR);
1156         if (strEQ(d,"recv"))
1157             FOP4(O_RECV);
1158         if (strEQ(d,"reverse"))
1159             LOP(O_REVERSE);
1160         if (strEQ(d,"readlink"))
1161             UNI(O_READLINK);
1162         break;
1163     case 's': case 'S':
1164         if (s[1] == '\'') {
1165             d = "s";
1166             s++;
1167         }
1168         else {
1169             SNARFWORD;
1170         }
1171         if (strEQ(d,"s")) {
1172             s = scansubst(s);
1173             if (yylval.arg)
1174                 TERM(SUBST);
1175             else
1176                 RETURN(1);      /* force error */
1177         }
1178         switch (d[1]) {
1179         case 'a':
1180         case 'b':
1181             break;
1182         case 'c':
1183             if (strEQ(d,"scalar"))
1184                 UNI(O_SCALAR);
1185             break;
1186         case 'd':
1187             break;
1188         case 'e':
1189             if (strEQ(d,"select"))
1190                 OPERATOR(SSELECT);
1191             if (strEQ(d,"seek"))
1192                 FOP3(O_SEEK);
1193             if (strEQ(d,"semctl"))
1194                 FUN4(O_SEMCTL);
1195             if (strEQ(d,"semget"))
1196                 FUN3(O_SEMGET);
1197             if (strEQ(d,"semop"))
1198                 FUN2(O_SEMOP);
1199             if (strEQ(d,"send"))
1200                 FOP3(O_SEND);
1201             if (strEQ(d,"setpgrp"))
1202                 FUN2(O_SETPGRP);
1203             if (strEQ(d,"setpriority"))
1204                 FUN3(O_SETPRIORITY);
1205             if (strEQ(d,"sethostent"))
1206                 FUN1(O_SHOSTENT);
1207             if (strEQ(d,"setnetent"))
1208                 FUN1(O_SNETENT);
1209             if (strEQ(d,"setservent"))
1210                 FUN1(O_SSERVENT);
1211             if (strEQ(d,"setprotoent"))
1212                 FUN1(O_SPROTOENT);
1213             if (strEQ(d,"setpwent"))
1214                 FUN0(O_SPWENT);
1215             if (strEQ(d,"setgrent"))
1216                 FUN0(O_SGRENT);
1217             if (strEQ(d,"seekdir"))
1218                 FOP2(O_SEEKDIR);
1219             if (strEQ(d,"setsockopt"))
1220                 FOP4(O_SSOCKOPT);
1221             break;
1222         case 'f':
1223         case 'g':
1224             break;
1225         case 'h':
1226             if (strEQ(d,"shift"))
1227                 TERM(SHIFT);
1228             if (strEQ(d,"shmctl"))
1229                 FUN3(O_SHMCTL);
1230             if (strEQ(d,"shmget"))
1231                 FUN3(O_SHMGET);
1232             if (strEQ(d,"shmread"))
1233                 FUN4(O_SHMREAD);
1234             if (strEQ(d,"shmwrite"))
1235                 FUN4(O_SHMWRITE);
1236             if (strEQ(d,"shutdown"))
1237                 FOP2(O_SHUTDOWN);
1238             break;
1239         case 'i':
1240             if (strEQ(d,"sin"))
1241                 UNI(O_SIN);
1242             break;
1243         case 'j':
1244         case 'k':
1245             break;
1246         case 'l':
1247             if (strEQ(d,"sleep"))
1248                 UNI(O_SLEEP);
1249             break;
1250         case 'm':
1251         case 'n':
1252             break;
1253         case 'o':
1254             if (strEQ(d,"socket"))
1255                 FOP4(O_SOCKET);
1256             if (strEQ(d,"socketpair"))
1257                 FOP25(O_SOCKPAIR);
1258             if (strEQ(d,"sort")) {
1259                 checkcomma(s,d,"subroutine name");
1260                 d = bufend;
1261                 while (s < d && isSPACE(*s)) s++;
1262                 if (*s == ';' || *s == ')')             /* probably a close */
1263                     fatal("sort is now a reserved word");
1264                 if (isALPHA(*s) || *s == '_') {
1265                     /*SUPPRESS 530*/
1266                     for (d = s; isALNUM(*d); d++) ;
1267                     strncpy(tokenbuf,s,d-s);
1268                     tokenbuf[d-s] = '\0';
1269                     if (strNE(tokenbuf,"keys") &&
1270                         strNE(tokenbuf,"values") &&
1271                         strNE(tokenbuf,"split") &&
1272                         strNE(tokenbuf,"grep") &&
1273                         strNE(tokenbuf,"readdir") &&
1274                         strNE(tokenbuf,"unpack") &&
1275                         strNE(tokenbuf,"do") &&
1276                         strNE(tokenbuf,"eval") &&
1277                         (d >= bufend || isSPACE(*d)) )
1278                         *(--s) = '\\';  /* force next ident to WORD */
1279                 }
1280                 LOP(O_SORT);
1281             }
1282             break;
1283         case 'p':
1284             if (strEQ(d,"split"))
1285                 TERM(SPLIT);
1286             if (strEQ(d,"sprintf"))
1287                 FL(O_SPRINTF);
1288             if (strEQ(d,"splice")) {
1289                 yylval.ival = O_SPLICE;
1290                 OPERATOR(PUSH);
1291             }
1292             break;
1293         case 'q':
1294             if (strEQ(d,"sqrt"))
1295                 UNI(O_SQRT);
1296             break;
1297         case 'r':
1298             if (strEQ(d,"srand"))
1299                 UNI(O_SRAND);
1300             break;
1301         case 's':
1302             break;
1303         case 't':
1304             if (strEQ(d,"stat"))
1305                 FOP(O_STAT);
1306             if (strEQ(d,"study")) {
1307                 sawstudy++;
1308                 LFUN(O_STUDY);
1309             }
1310             break;
1311         case 'u':
1312             if (strEQ(d,"substr"))
1313                 FUN2x(O_SUBSTR);
1314             if (strEQ(d,"sub")) {
1315                 yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
1316                 savelong(&subline);
1317                 saveitem(subname);
1318
1319                 subline = curcmd->c_line;
1320                 d = bufend;
1321                 while (s < d && isSPACE(*s))
1322                     s++;
1323                 if (isALPHA(*s) || *s == '_' || *s == '\'') {
1324                     str_sset(subname,curstname);
1325                     str_ncat(subname,"'",1);
1326                     for (d = s+1; isALNUM(*d) || *d == '\''; d++)
1327                         /*SUPPRESS 530*/
1328                         ;
1329                     if (d[-1] == '\'')
1330                         d--;
1331                     str_ncat(subname,s,d-s);
1332                     *(--s) = '\\';      /* force next ident to WORD */
1333                 }
1334                 else
1335                     str_set(subname,"?");
1336                 OPERATOR(SUB);
1337             }
1338             break;
1339         case 'v':
1340         case 'w':
1341         case 'x':
1342             break;
1343         case 'y':
1344             if (strEQ(d,"system")) {
1345                 set_csh();
1346                 LOP(O_SYSTEM);
1347             }
1348             if (strEQ(d,"symlink"))
1349                 FUN2(O_SYMLINK);
1350             if (strEQ(d,"syscall"))
1351                 LOP(O_SYSCALL);
1352             if (strEQ(d,"sysread"))
1353                 FOP3(O_SYSREAD);
1354             if (strEQ(d,"syswrite"))
1355                 FOP3(O_SYSWRITE);
1356             break;
1357         case 'z':
1358             break;
1359         }
1360         break;
1361     case 't': case 'T':
1362         SNARFWORD;
1363         if (strEQ(d,"tr")) {
1364             s = scantrans(s);
1365             if (yylval.arg)
1366                 TERM(TRANS);
1367             else
1368                 RETURN(1);      /* force error */
1369         }
1370         if (strEQ(d,"tell"))
1371             FOP(O_TELL);
1372         if (strEQ(d,"telldir"))
1373             FOP(O_TELLDIR);
1374         if (strEQ(d,"time"))
1375             FUN0(O_TIME);
1376         if (strEQ(d,"times"))
1377             FUN0(O_TMS);
1378         if (strEQ(d,"truncate"))
1379             FOP2(O_TRUNCATE);
1380         break;
1381     case 'u': case 'U':
1382         SNARFWORD;
1383         if (strEQ(d,"using"))
1384             OPERATOR(USING);
1385         if (strEQ(d,"until")) {
1386             yylval.ival = curcmd->c_line;
1387             OPERATOR(UNTIL);
1388         }
1389         if (strEQ(d,"unless")) {
1390             yylval.ival = curcmd->c_line;
1391             OPERATOR(UNLESS);
1392         }
1393         if (strEQ(d,"unlink"))
1394             LOP(O_UNLINK);
1395         if (strEQ(d,"undef"))
1396             LFUN(O_UNDEF);
1397         if (strEQ(d,"unpack"))
1398             FUN2(O_UNPACK);
1399         if (strEQ(d,"utime"))
1400             LOP(O_UTIME);
1401         if (strEQ(d,"umask"))
1402             UNI(O_UMASK);
1403         if (strEQ(d,"unshift")) {
1404             yylval.ival = O_UNSHIFT;
1405             OPERATOR(PUSH);
1406         }
1407         break;
1408     case 'v': case 'V':
1409         SNARFWORD;
1410         if (strEQ(d,"values"))
1411             HFUN(O_VALUES);
1412         if (strEQ(d,"vec")) {
1413             sawvec = TRUE;
1414             FUN3(O_VEC);
1415         }
1416         break;
1417     case 'w': case 'W':
1418         SNARFWORD;
1419         if (strEQ(d,"while")) {
1420             yylval.ival = curcmd->c_line;
1421             OPERATOR(WHILE);
1422         }
1423         if (strEQ(d,"warn"))
1424             LOP(O_WARN);
1425         if (strEQ(d,"wait"))
1426             FUN0(O_WAIT);
1427         if (strEQ(d,"waitpid"))
1428             FUN2(O_WAITPID);
1429         if (strEQ(d,"wantarray")) {
1430             yylval.arg = op_new(1);
1431             yylval.arg->arg_type = O_ITEM;
1432             yylval.arg[1].arg_type = A_WANTARRAY;
1433             TERM(RSTRING);
1434         }
1435         if (strEQ(d,"write"))
1436             FOP(O_WRITE);
1437         break;
1438     case 'x': case 'X':
1439         if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
1440             s++;
1441             MOP(O_REPEAT);
1442         }
1443         SNARFWORD;
1444         if (strEQ(d,"x")) {
1445             if (!expectterm)
1446                 MOP(O_REPEAT);
1447             check_uni();
1448         }
1449         break;
1450     case 'y': case 'Y':
1451         if (s[1] == '\'') {
1452             d = "y";
1453             s++;
1454         }
1455         else {
1456             SNARFWORD;
1457         }
1458         if (strEQ(d,"y")) {
1459             s = scantrans(s);
1460             TERM(TRANS);
1461         }
1462         break;
1463     case 'z': case 'Z':
1464         SNARFWORD;
1465         break;
1466     }
1467     yylval.cval = savestr(d);
1468     if (expectterm == 2) {              /* special case: start of statement */
1469         while (isSPACE(*s)) s++;
1470         if (*s == ':') {
1471             s++;
1472             CLINE;
1473             OPERATOR(LABEL);
1474         }
1475         TERM(WORD);
1476     }
1477     expectterm = FALSE;
1478     if (oldoldbufptr && oldoldbufptr < bufptr) {
1479         while (isSPACE(*oldoldbufptr))
1480             oldoldbufptr++;
1481         if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1482             expectterm = TRUE;
1483         else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1484             expectterm = TRUE;
1485     }
1486     return (CLINE, bufptr = s, (int)WORD);
1487 }
1488
1489 void
1490 checkcomma(s,name,what)
1491 register char *s;
1492 char *name;
1493 char *what;
1494 {
1495     char *w;
1496
1497     if (dowarn && *s == ' ' && s[1] == '(') {
1498         w = index(s,')');
1499         if (w)
1500             for (w++; *w && isSPACE(*w); w++) ;
1501         if (!w || !*w || !index(";|}", *w))     /* an advisory hack only... */
1502             warn("%s (...) interpreted as function",name);
1503     }
1504     while (s < bufend && isSPACE(*s))
1505         s++;
1506     if (*s == '(')
1507         s++;
1508     while (s < bufend && isSPACE(*s))
1509         s++;
1510     if (isALPHA(*s) || *s == '_') {
1511         w = s++;
1512         while (isALNUM(*s))
1513             s++;
1514         while (s < bufend && isSPACE(*s))
1515             s++;
1516         if (*s == ',') {
1517             *s = '\0';
1518             w = instr(
1519               "tell eof times getlogin wait length shift umask getppid \
1520               cos exp int log rand sin sqrt ord wantarray",
1521               w);
1522             *s = ',';
1523             if (w)
1524                 return;
1525             fatal("No comma allowed after %s", what);
1526         }
1527     }
1528 }
1529
1530 char *
1531 scanident(s,send,dest)
1532 register char *s;
1533 register char *send;
1534 char *dest;
1535 {
1536     register char *d;
1537     int brackets = 0;
1538
1539     reparse = Nullch;
1540     s++;
1541     d = dest;
1542     if (isDIGIT(*s)) {
1543         while (isDIGIT(*s))
1544             *d++ = *s++;
1545     }
1546     else {
1547         while (isALNUM(*s) || *s == '\'')
1548             *d++ = *s++;
1549     }
1550     while (d > dest+1 && d[-1] == '\'')
1551         d--,s--;
1552     *d = '\0';
1553     d = dest;
1554     if (!*d) {
1555         *d = *s++;
1556         if (*d == '{' /* } */ ) {
1557             d = dest;
1558             brackets++;
1559             while (s < send && brackets) {
1560                 if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
1561                     *d++ = *s++;
1562                     continue;
1563                 }
1564                 else if (!reparse)
1565                     reparse = s;
1566                 switch (*s++) {
1567                 /* { */
1568                 case '}':
1569                     brackets--;
1570                     if (reparse && reparse == s - 1)
1571                         reparse = Nullch;
1572                     break;
1573                 case '{':   /* } */
1574                     brackets++;
1575                     break;
1576                 }
1577             }
1578             *d = '\0';
1579             d = dest;
1580         }
1581         else
1582             d[1] = '\0';
1583     }
1584     if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
1585 #ifdef DEBUGGING
1586         if (*s == 'D')
1587             debug |= 32768;
1588 #endif
1589         *d = *s++ ^ 64;
1590     }
1591     return s;
1592 }
1593
1594 void
1595 scanconst(spat,string,len)
1596 SPAT *spat;
1597 char *string;
1598 int len;
1599 {
1600     register STR *tmpstr;
1601     register char *t;
1602     register char *d;
1603     register char *e;
1604     char *origstring = string;
1605     static char *vert = "|";
1606
1607     if (ninstr(string, string+len, vert, vert+1))
1608         return;
1609     if (*string == '^')
1610         string++, len--;
1611     tmpstr = Str_new(86,len);
1612     str_nset(tmpstr,string,len);
1613     t = str_get(tmpstr);
1614     e = t + len;
1615     tmpstr->str_u.str_useful = 100;
1616     for (d=t; d < e; ) {
1617         switch (*d) {
1618         case '{':
1619             if (isDIGIT(d[1]))
1620                 e = d;
1621             else
1622                 goto defchar;
1623             break;
1624         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
1625         case '^':
1626             e = d;
1627             break;
1628         case '\\':
1629             if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
1630                 e = d;
1631                 break;
1632             }
1633             Move(d+1,d,e-d,char);
1634             e--;
1635             switch(*d) {
1636             case 'n':
1637                 *d = '\n';
1638                 break;
1639             case 't':
1640                 *d = '\t';
1641                 break;
1642             case 'f':
1643                 *d = '\f';
1644                 break;
1645             case 'r':
1646                 *d = '\r';
1647                 break;
1648             case 'e':
1649                 *d = '\033';
1650                 break;
1651             case 'a':
1652                 *d = '\007';
1653                 break;
1654             }
1655             /* FALL THROUGH */
1656         default:
1657           defchar:
1658             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1659                 e = d;
1660                 break;
1661             }
1662             d++;
1663         }
1664     }
1665     if (d == t) {
1666         str_free(tmpstr);
1667         return;
1668     }
1669     *d = '\0';
1670     tmpstr->str_cur = d - t;
1671     if (d == t+len)
1672         spat->spat_flags |= SPAT_ALL;
1673     if (*origstring != '^')
1674         spat->spat_flags |= SPAT_SCANFIRST;
1675     spat->spat_short = tmpstr;
1676     spat->spat_slen = d - t;
1677 }
1678
1679 char *
1680 scanpat(s)
1681 register char *s;
1682 {
1683     register SPAT *spat;
1684     register char *d;
1685     register char *e;
1686     int len;
1687     SPAT savespat;
1688     STR *str = Str_new(93,0);
1689     char delim;
1690
1691     Newz(801,spat,1,SPAT);
1692     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1693     curstash->tbl_spatroot = spat;
1694
1695     switch (*s++) {
1696     case 'm':
1697         s++;
1698         break;
1699     case '/':
1700         break;
1701     case '?':
1702         spat->spat_flags |= SPAT_ONCE;
1703         break;
1704     default:
1705         fatal("panic: scanpat");
1706     }
1707     s = str_append_till(str,s,bufend,s[-1],patleave);
1708     if (s >= bufend) {
1709         str_free(str);
1710         yyerror("Search pattern not terminated");
1711         yylval.arg = Nullarg;
1712         return s;
1713     }
1714     delim = *s++;
1715     while (*s == 'i' || *s == 'o' || *s == 'g') {
1716         if (*s == 'i') {
1717             s++;
1718             sawi = TRUE;
1719             spat->spat_flags |= SPAT_FOLD;
1720         }
1721         if (*s == 'o') {
1722             s++;
1723             spat->spat_flags |= SPAT_KEEP;
1724         }
1725         if (*s == 'g') {
1726             s++;
1727             spat->spat_flags |= SPAT_GLOBAL;
1728         }
1729     }
1730     len = str->str_cur;
1731     e = str->str_ptr + len;
1732     if (delim == '\'')
1733         d = e;
1734     else
1735         d = str->str_ptr;
1736     for (; d < e; d++) {
1737         if (*d == '\\')
1738             d++;
1739         else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
1740                  (*d == '@')) {
1741             register ARG *arg;
1742
1743             spat->spat_runtime = arg = op_new(1);
1744             arg->arg_type = O_ITEM;
1745             arg[1].arg_type = A_DOUBLE;
1746             arg[1].arg_ptr.arg_str = str_smake(str);
1747             d = scanident(d,bufend,buf);
1748             (void)stabent(buf,TRUE);            /* make sure it's created */
1749             for (; d < e; d++) {
1750                 if (*d == '\\')
1751                     d++;
1752                 else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
1753                     d = scanident(d,bufend,buf);
1754                     (void)stabent(buf,TRUE);
1755                 }
1756                 else if (*d == '@') {
1757                     d = scanident(d,bufend,buf);
1758                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1759                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1760                         (void)stabent(buf,TRUE);
1761                 }
1762             }
1763             goto got_pat;               /* skip compiling for now */
1764         }
1765     }
1766     if (spat->spat_flags & SPAT_FOLD)
1767         StructCopy(spat, &savespat, SPAT);
1768     scanconst(spat,str->str_ptr,len);
1769     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1770         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1771         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1772             spat->spat_flags & SPAT_FOLD);
1773                 /* Note that this regexp can still be used if someone says
1774                  * something like /a/ && s//b/;  so we can't delete it.
1775                  */
1776     }
1777     else {
1778         if (spat->spat_flags & SPAT_FOLD)
1779         StructCopy(&savespat, spat, SPAT);
1780         if (spat->spat_short)
1781             fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1782         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1783             spat->spat_flags & SPAT_FOLD);
1784         hoistmust(spat);
1785     }
1786   got_pat:
1787     str_free(str);
1788     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1789     return s;
1790 }
1791
1792 char *
1793 scansubst(start)
1794 char *start;
1795 {
1796     register char *s = start;
1797     register SPAT *spat;
1798     register char *d;
1799     register char *e;
1800     int len;
1801     STR *str = Str_new(93,0);
1802     char term = *s;
1803
1804     if (term && (d = index("([{< )]}> )]}>",term)))
1805         term = d[5];
1806
1807     Newz(802,spat,1,SPAT);
1808     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1809     curstash->tbl_spatroot = spat;
1810
1811     s = str_append_till(str,s+1,bufend,term,patleave);
1812     if (s >= bufend) {
1813         str_free(str);
1814         yyerror("Substitution pattern not terminated");
1815         yylval.arg = Nullarg;
1816         return s;
1817     }
1818     len = str->str_cur;
1819     e = str->str_ptr + len;
1820     for (d = str->str_ptr; d < e; d++) {
1821         if (*d == '\\')
1822             d++;
1823         else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
1824             *d == '@' ) {
1825             register ARG *arg;
1826
1827             spat->spat_runtime = arg = op_new(1);
1828             arg->arg_type = O_ITEM;
1829             arg[1].arg_type = A_DOUBLE;
1830             arg[1].arg_ptr.arg_str = str_smake(str);
1831             d = scanident(d,e,buf);
1832             (void)stabent(buf,TRUE);            /* make sure it's created */
1833             for (; *d; d++) {
1834                 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1835                     d = scanident(d,e,buf);
1836                     (void)stabent(buf,TRUE);
1837                 }
1838                 else if (*d == '@' && d[-1] != '\\') {
1839                     d = scanident(d,e,buf);
1840                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1841                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1842                         (void)stabent(buf,TRUE);
1843                 }
1844             }
1845             goto get_repl;              /* skip compiling for now */
1846         }
1847     }
1848     scanconst(spat,str->str_ptr,len);
1849 get_repl:
1850     if (term != *start)
1851         s++;
1852     s = scanstr(s, SCAN_REPL);
1853     if (s >= bufend) {
1854         str_free(str);
1855         yyerror("Substitution replacement not terminated");
1856         yylval.arg = Nullarg;
1857         return s;
1858     }
1859     spat->spat_repl = yylval.arg;
1860     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1861         spat->spat_flags |= SPAT_CONST;
1862     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1863         STR *tmpstr;
1864         register char *t;
1865
1866         spat->spat_flags |= SPAT_CONST;
1867         tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1868         e = tmpstr->str_ptr + tmpstr->str_cur;
1869         for (t = tmpstr->str_ptr; t < e; t++) {
1870             if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
1871               (t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
1872                 spat->spat_flags &= ~SPAT_CONST;
1873         }
1874     }
1875     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
1876         int es = 0;
1877
1878         if (*s == 'e') {
1879             s++;
1880             es++;
1881             if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1882                 spat->spat_repl[1].arg_type = A_SINGLE;
1883             spat->spat_repl = make_op(
1884                 (!es && spat->spat_repl[1].arg_type == A_SINGLE
1885                         ? O_EVALONCE
1886                         : O_EVAL),
1887                 2,
1888                 spat->spat_repl,
1889                 Nullarg,
1890                 Nullarg);
1891             spat->spat_flags &= ~SPAT_CONST;
1892         }
1893         if (*s == 'g') {
1894             s++;
1895             spat->spat_flags |= SPAT_GLOBAL;
1896         }
1897         if (*s == 'i') {
1898             s++;
1899             sawi = TRUE;
1900             spat->spat_flags |= SPAT_FOLD;
1901             if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1902                 str_free(spat->spat_short);     /* anchored opt doesn't do */
1903                 spat->spat_short = Nullstr;     /* case insensitive match */
1904                 spat->spat_slen = 0;
1905             }
1906         }
1907         if (*s == 'o') {
1908             s++;
1909             spat->spat_flags |= SPAT_KEEP;
1910         }
1911     }
1912     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1913         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1914     if (!spat->spat_runtime) {
1915         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1916           spat->spat_flags & SPAT_FOLD);
1917         hoistmust(spat);
1918     }
1919     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
1920     str_free(str);
1921     return s;
1922 }
1923
1924 void
1925 hoistmust(spat)
1926 register SPAT *spat;
1927 {
1928     if (!spat->spat_short && spat->spat_regexp->regstart &&
1929         (!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
1930        ) {
1931         if (!(spat->spat_regexp->reganch & ROPT_ANCH))
1932             spat->spat_flags |= SPAT_SCANFIRST;
1933         else if (spat->spat_flags & SPAT_FOLD)
1934             return;
1935         spat->spat_short = str_smake(spat->spat_regexp->regstart);
1936     }
1937     else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
1938         if (spat->spat_short &&
1939           str_eq(spat->spat_short,spat->spat_regexp->regmust))
1940         {
1941             if (spat->spat_flags & SPAT_SCANFIRST) {
1942                 str_free(spat->spat_short);
1943                 spat->spat_short = Nullstr;
1944             }
1945             else {
1946                 str_free(spat->spat_regexp->regmust);
1947                 spat->spat_regexp->regmust = Nullstr;
1948                 return;
1949             }
1950         }
1951         if (!spat->spat_short ||        /* promote the better string */
1952           ((spat->spat_flags & SPAT_SCANFIRST) &&
1953            (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1954             str_free(spat->spat_short);         /* ok if null */
1955             spat->spat_short = spat->spat_regexp->regmust;
1956             spat->spat_regexp->regmust = Nullstr;
1957             spat->spat_flags |= SPAT_SCANFIRST;
1958         }
1959     }
1960 }
1961
1962 char *
1963 scantrans(start)
1964 char *start;
1965 {
1966     register char *s = start;
1967     ARG *arg =
1968         l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
1969     STR *tstr;
1970     STR *rstr;
1971     register char *t;
1972     register char *r;
1973     register short *tbl;
1974     register int i;
1975     register int j;
1976     int tlen, rlen;
1977     int squash;
1978     int delete;
1979     int complement;
1980
1981     New(803,tbl,256,short);
1982     arg[2].arg_type = A_NULL;
1983     arg[2].arg_ptr.arg_cval = (char*) tbl;
1984
1985     s = scanstr(s, SCAN_TR);
1986     if (s >= bufend) {
1987         yyerror("Translation pattern not terminated");
1988         yylval.arg = Nullarg;
1989         return s;
1990     }
1991     tstr = yylval.arg[1].arg_ptr.arg_str;
1992     yylval.arg[1].arg_ptr.arg_str = Nullstr;
1993     arg_free(yylval.arg);
1994     t = tstr->str_ptr;
1995     tlen = tstr->str_cur;
1996
1997     if (s[-1] == *start)
1998         s--;
1999
2000     s = scanstr(s, SCAN_TR|SCAN_REPL);
2001     if (s >= bufend) {
2002         yyerror("Translation replacement not terminated");
2003         yylval.arg = Nullarg;
2004         return s;
2005     }
2006     rstr = yylval.arg[1].arg_ptr.arg_str;
2007     yylval.arg[1].arg_ptr.arg_str = Nullstr;
2008     arg_free(yylval.arg);
2009     r = rstr->str_ptr;
2010     rlen = rstr->str_cur;
2011
2012     complement = delete = squash = 0;
2013     while (*s == 'c' || *s == 'd' || *s == 's') {
2014         if (*s == 'c')
2015             complement = 1;
2016         else if (*s == 'd')
2017             delete = 2;
2018         else
2019             squash = 1;
2020         s++;
2021     }
2022     arg[2].arg_len = delete|squash;
2023     yylval.arg = arg;
2024     if (complement) {
2025         Zero(tbl, 256, short);
2026         for (i = 0; i < tlen; i++)
2027             tbl[t[i] & 0377] = -1;
2028         for (i = 0, j = 0; i < 256; i++) {
2029             if (!tbl[i]) {
2030                 if (j >= rlen) {
2031                     if (delete)
2032                         tbl[i] = -2;
2033                     else if (rlen)
2034                         tbl[i] = r[j-1] & 0377;
2035                     else
2036                         tbl[i] = i;
2037                 }
2038                 else
2039                     tbl[i] = r[j++] & 0377;
2040             }
2041         }
2042     }
2043     else {
2044         if (!rlen && !delete) {
2045             r = t; rlen = tlen;
2046         }
2047         for (i = 0; i < 256; i++)
2048             tbl[i] = -1;
2049         for (i = 0, j = 0; i < tlen; i++,j++) {
2050             if (j >= rlen) {
2051                 if (delete) {
2052                     if (tbl[t[i] & 0377] == -1)
2053                         tbl[t[i] & 0377] = -2;
2054                     continue;
2055                 }
2056                 --j;
2057             }
2058             if (tbl[t[i] & 0377] == -1)
2059                 tbl[t[i] & 0377] = r[j] & 0377;
2060         }
2061     }
2062     str_free(tstr);
2063     str_free(rstr);
2064     return s;
2065 }
2066
2067 char *
2068 scanstr(start, in_what)
2069 char *start;
2070 int in_what;
2071 {
2072     register char *s = start;
2073     register char term;
2074     register char *d;
2075     register ARG *arg;
2076     register char *send;
2077     register bool makesingle = FALSE;
2078     register STAB *stab;
2079     bool alwaysdollar = FALSE;
2080     bool hereis = FALSE;
2081     STR *herewas;
2082     STR *str;
2083     /* which backslash sequences to keep */
2084     char *leave = (in_what & SCAN_TR)
2085         ? "\\$@nrtfbeacx0123456789-"
2086         : "\\$@nrtfbeacx0123456789[{]}lLuUE";
2087     int len;
2088
2089     arg = op_new(1);
2090     yylval.arg = arg;
2091     arg->arg_type = O_ITEM;
2092
2093     switch (*s) {
2094     default:                    /* a substitution replacement */
2095         arg[1].arg_type = A_DOUBLE;
2096         makesingle = TRUE;      /* maybe disable runtime scanning */
2097         term = *s;
2098         if (term == '\'')
2099             leave = Nullch;
2100         goto snarf_it;
2101     case '0':
2102         {
2103             unsigned long i;
2104             int shift;
2105
2106             arg[1].arg_type = A_SINGLE;
2107             if (s[1] == 'x') {
2108                 shift = 4;
2109                 s += 2;
2110             }
2111             else if (s[1] == '.')
2112                 goto decimal;
2113             else
2114                 shift = 3;
2115             i = 0;
2116             for (;;) {
2117                 switch (*s) {
2118                 default:
2119                     goto out;
2120                 case '_':
2121                     s++;
2122                     break;
2123                 case '8': case '9':
2124                     if (shift != 4)
2125                         yyerror("Illegal octal digit");
2126                     /* FALL THROUGH */
2127                 case '0': case '1': case '2': case '3': case '4':
2128                 case '5': case '6': case '7':
2129                     i <<= shift;
2130                     i += *s++ & 15;
2131                     break;
2132                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
2133                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
2134                     if (shift != 4)
2135                         goto out;
2136                     i <<= 4;
2137                     i += (*s++ & 7) + 9;
2138                     break;
2139                 }
2140             }
2141           out:
2142             str = Str_new(92,0);
2143             str_numset(str,(double)i);
2144             if (str->str_ptr) {
2145                 Safefree(str->str_ptr);
2146                 str->str_ptr = Nullch;
2147                 str->str_len = str->str_cur = 0;
2148             }
2149             arg[1].arg_ptr.arg_str = str;
2150         }
2151         break;
2152     case '1': case '2': case '3': case '4': case '5':
2153     case '6': case '7': case '8': case '9': case '.':
2154       decimal:
2155         arg[1].arg_type = A_SINGLE;
2156         d = tokenbuf;
2157         while (isDIGIT(*s) || *s == '_') {
2158             if (*s == '_')
2159                 s++;
2160             else
2161                 *d++ = *s++;
2162         }
2163         if (*s == '.' && s[1] != '.') {
2164             *d++ = *s++;
2165             while (isDIGIT(*s) || *s == '_') {
2166                 if (*s == '_')
2167                     s++;
2168                 else
2169                     *d++ = *s++;
2170             }
2171         }
2172         if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
2173             *d++ = *s++;
2174             if (*s == '+' || *s == '-')
2175                 *d++ = *s++;
2176             while (isDIGIT(*s))
2177                 *d++ = *s++;
2178         }
2179         *d = '\0';
2180         str = Str_new(92,0);
2181         str_numset(str,atof(tokenbuf));
2182         if (str->str_ptr) {
2183             Safefree(str->str_ptr);
2184             str->str_ptr = Nullch;
2185             str->str_len = str->str_cur = 0;
2186         }
2187         arg[1].arg_ptr.arg_str = str;
2188         break;
2189     case '<':
2190         if (in_what & (SCAN_REPL|SCAN_TR))
2191             goto do_double;
2192         if (*++s == '<') {
2193             hereis = TRUE;
2194             d = tokenbuf;
2195             if (!rsfp)
2196                 *d++ = '\n';
2197             if (*++s && index("`'\"",*s)) {
2198                 term = *s++;
2199                 s = cpytill(d,s,bufend,term,&len);
2200                 if (s < bufend)
2201                     s++;
2202                 d += len;
2203             }
2204             else {
2205                 if (*s == '\\')
2206                     s++, term = '\'';
2207                 else
2208                     term = '"';
2209                 while (isALNUM(*s))
2210                     *d++ = *s++;
2211             }                           /* assuming tokenbuf won't clobber */
2212             *d++ = '\n';
2213             *d = '\0';
2214             len = d - tokenbuf;
2215             d = "\n";
2216             if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
2217                 herewas = str_make(s,bufend-s);
2218             else
2219                 s--, herewas = str_make(s,d-s);
2220             s += herewas->str_cur;
2221             if (term == '\'')
2222                 goto do_single;
2223             if (term == '`')
2224                 goto do_back;
2225             goto do_double;
2226         }
2227         d = tokenbuf;
2228         s = cpytill(d,s,bufend,'>',&len);
2229         if (s < bufend)
2230             s++;
2231         else
2232             fatal("Unterminated <> operator");
2233
2234         if (*d == '$') d++;
2235         while (*d && (isALNUM(*d) || *d == '\''))
2236             d++;
2237         if (d - tokenbuf != len) {
2238             s = start;
2239             term = *s;
2240             arg[1].arg_type = A_GLOB;
2241             set_csh();
2242             alwaysdollar = TRUE;        /* treat $) and $| as variables */
2243             goto snarf_it;
2244         }
2245         else {
2246             d = tokenbuf;
2247             if (!len)
2248                 (void)strcpy(d,"ARGV");
2249             if (*d == '$') {
2250                 arg[1].arg_type = A_INDREAD;
2251                 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
2252             }
2253             else {
2254                 arg[1].arg_type = A_READ;
2255                 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
2256                 if (!stab_io(arg[1].arg_ptr.arg_stab))
2257                     stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
2258                 if (strEQ(d,"ARGV")) {
2259                     (void)aadd(arg[1].arg_ptr.arg_stab);
2260                     stab_io(arg[1].arg_ptr.arg_stab)->flags |=
2261                       IOF_ARGV|IOF_START;
2262                 }
2263             }
2264         }
2265         break;
2266
2267     case 'q':
2268         s++;
2269         if (*s == 'q') {
2270             s++;
2271             goto do_double;
2272         }
2273         if (*s == 'x') {
2274             s++;
2275             goto do_back;
2276         }
2277         /* FALL THROUGH */
2278     case '\'':
2279       do_single:
2280         term = *s;
2281         arg[1].arg_type = A_SINGLE;
2282         leave = Nullch;
2283         goto snarf_it;
2284
2285     case '"':
2286       do_double:
2287         term = *s;
2288         arg[1].arg_type = A_DOUBLE;
2289         makesingle = TRUE;      /* maybe disable runtime scanning */
2290         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2291         goto snarf_it;
2292     case '`':
2293       do_back:
2294         term = *s;
2295         arg[1].arg_type = A_BACKTICK;
2296         set_csh();
2297         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2298       snarf_it:
2299         {
2300             STR *tmpstr;
2301             STR *tmpstr2 = Nullstr;
2302             char *tmps;
2303             bool dorange = FALSE;
2304
2305             CLINE;
2306             multi_start = curcmd->c_line;
2307             if (hereis)
2308                 multi_open = multi_close = '<';
2309             else {
2310                 multi_open = term;
2311                 if (term && (tmps = index("([{< )]}> )]}>",term)))
2312                     term = tmps[5];
2313                 multi_close = term;
2314             }
2315             tmpstr = Str_new(87,80);
2316             if (hereis) {
2317                 term = *tokenbuf;
2318                 if (!rsfp) {
2319                     d = s;
2320                     while (s < bufend &&
2321                       (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
2322                         if (*s++ == '\n')
2323                             curcmd->c_line++;
2324                     }
2325                     if (s >= bufend) {
2326                         curcmd->c_line = multi_start;
2327                         fatal("EOF in string");
2328                     }
2329                     str_nset(tmpstr,d+1,s-d);
2330                     s += len - 1;
2331                     str_ncat(herewas,s,bufend-s);
2332                     str_replace(linestr,herewas);
2333                     oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
2334                     bufend = linestr->str_ptr + linestr->str_cur;
2335                     hereis = FALSE;
2336                 }
2337                 else
2338                     str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
2339             }
2340             else
2341                 s = str_append_till(tmpstr,s+1,bufend,term,leave);
2342             while (s >= bufend) {       /* multiple line string? */
2343                 if (!rsfp ||
2344                  !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
2345                     curcmd->c_line = multi_start;
2346                     fatal("EOF in string");
2347                 }
2348                 curcmd->c_line++;
2349                 if (perldb) {
2350                     STR *str = Str_new(88,0);
2351
2352                     str_sset(str,linestr);
2353                     astore(stab_xarray(curcmd->c_filestab),
2354                       (int)curcmd->c_line,str);
2355                 }
2356                 bufend = linestr->str_ptr + linestr->str_cur;
2357                 if (hereis) {
2358                     if (*s == term && bcmp(s,tokenbuf,len) == 0) {
2359                         s = bufend - 1;
2360                         *s = ' ';
2361                         str_scat(linestr,herewas);
2362                         bufend = linestr->str_ptr + linestr->str_cur;
2363                     }
2364                     else {
2365                         s = bufend;
2366                         str_scat(tmpstr,linestr);
2367                     }
2368                 }
2369                 else
2370                     s = str_append_till(tmpstr,s,bufend,term,leave);
2371             }
2372             multi_end = curcmd->c_line;
2373             s++;
2374             if (tmpstr->str_cur + 5 < tmpstr->str_len) {
2375                 tmpstr->str_len = tmpstr->str_cur + 1;
2376                 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
2377             }
2378             if (arg[1].arg_type == A_SINGLE) {
2379                 arg[1].arg_ptr.arg_str = tmpstr;
2380                 break;
2381             }
2382             tmps = s;
2383             s = tmpstr->str_ptr;
2384             send = s + tmpstr->str_cur;
2385             while (s < send) {          /* see if we can make SINGLE */
2386                 if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
2387                   !alwaysdollar && s[1] != '0')
2388                     *s = '$';           /* grandfather \digit in subst */
2389                 if ((*s == '$' || *s == '@') && s+1 < send &&
2390                   (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
2391                     makesingle = FALSE; /* force interpretation */
2392                 }
2393                 else if (*s == '\\' && s+1 < send) {
2394                     if (index("lLuUE",s[1]))
2395                         makesingle = FALSE;
2396                     s++;
2397                 }
2398                 s++;
2399             }
2400             s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
2401             while (s < send || dorange) {
2402                 if (in_what & SCAN_TR) {
2403                     if (dorange) {
2404                         int i;
2405                         int max;
2406                         if (!tmpstr2) { /* oops, have to grow */
2407                             tmpstr2 = str_smake(tmpstr);
2408                             s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
2409                             send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
2410                         }
2411                         i = d - tmpstr->str_ptr;
2412                         STR_GROW(tmpstr, tmpstr->str_len + 256);
2413                         d = tmpstr->str_ptr + i;
2414                         d -= 2;
2415                         max = d[1] & 0377;
2416                         for (i = (*d & 0377); i <= max; i++)
2417                             *d++ = i;
2418                         dorange = FALSE;
2419                         continue;
2420                     }
2421                     else if (*s == '-' && s+1 < send  && d != tmpstr->str_ptr) {
2422                         dorange = TRUE;
2423                         s++;
2424                     }
2425                 }
2426                 else {
2427                     if ((*s == '$' && s+1 < send &&
2428                         (alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
2429                         (*s == '@' && s+1 < send) ) {
2430                         if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
2431                             *d++ = *s++;
2432                         len = scanident(s,send,tokenbuf) - s;
2433                         if (*s == '$' || strEQ(tokenbuf,"ARGV")
2434                           || strEQ(tokenbuf,"ENV")
2435                           || strEQ(tokenbuf,"SIG")
2436                           || strEQ(tokenbuf,"INC") )
2437                             (void)stabent(tokenbuf,TRUE); /* add symbol */
2438                         while (len--)
2439                             *d++ = *s++;
2440                         continue;
2441                     }
2442                 }
2443                 if (*s == '\\' && s+1 < send) {
2444                     s++;
2445                     switch (*s) {
2446                     case '-':
2447                         if (in_what & SCAN_TR) {
2448                             *d++ = *s++;
2449                             continue;
2450                         }
2451                         /* FALL THROUGH */
2452                     default:
2453                         if (!makesingle && (!leave || (*s && index(leave,*s))))
2454                             *d++ = '\\';
2455                         *d++ = *s++;
2456                         continue;
2457                     case '0': case '1': case '2': case '3':
2458                     case '4': case '5': case '6': case '7':
2459                         *d++ = scanoct(s, 3, &len);
2460                         s += len;
2461                         continue;
2462                     case 'x':
2463                         *d++ = scanhex(++s, 2, &len);
2464                         s += len;
2465                         continue;
2466                     case 'c':
2467                         s++;
2468                         *d = *s++;
2469                         if (isLOWER(*d))
2470                             *d = toupper(*d);
2471                         *d++ ^= 64;
2472                         continue;
2473                     case 'b':
2474                         *d++ = '\b';
2475                         break;
2476                     case 'n':
2477                         *d++ = '\n';
2478                         break;
2479                     case 'r':
2480                         *d++ = '\r';
2481                         break;
2482                     case 'f':
2483                         *d++ = '\f';
2484                         break;
2485                     case 't':
2486                         *d++ = '\t';
2487                         break;
2488                     case 'e':
2489                         *d++ = '\033';
2490                         break;
2491                     case 'a':
2492                         *d++ = '\007';
2493                         break;
2494                     }
2495                     s++;
2496                     continue;
2497                 }
2498                 *d++ = *s++;
2499             }
2500             *d = '\0';
2501
2502             if (arg[1].arg_type == A_DOUBLE && makesingle)
2503                 arg[1].arg_type = A_SINGLE;     /* now we can optimize on it */
2504
2505             tmpstr->str_cur = d - tmpstr->str_ptr;
2506             if (arg[1].arg_type == A_GLOB) {
2507                 arg[1].arg_ptr.arg_stab = stab = genstab();
2508                 stab_io(stab) = stio_new();
2509                 str_sset(stab_val(stab), tmpstr);
2510             }
2511             else
2512                 arg[1].arg_ptr.arg_str = tmpstr;
2513             s = tmps;
2514             if (tmpstr2)
2515                 str_free(tmpstr2);
2516             break;
2517         }
2518     }
2519     if (hereis)
2520         str_free(herewas);
2521     return s;
2522 }
2523
2524 FCMD *
2525 load_format()
2526 {
2527     FCMD froot;
2528     FCMD *flinebeg;
2529     char *eol;
2530     register FCMD *fprev = &froot;
2531     register FCMD *fcmd;
2532     register char *s;
2533     register char *t;
2534     register STR *str;
2535     bool noblank;
2536     bool repeater;
2537
2538     Zero(&froot, 1, FCMD);
2539     s = bufptr;
2540     while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
2541         curcmd->c_line++;
2542         if (in_eval && !rsfp) {
2543             eol = index(s,'\n');
2544             if (!eol++)
2545                 eol = bufend;
2546         }
2547         else
2548             eol = bufend = linestr->str_ptr + linestr->str_cur;
2549         if (perldb) {
2550             STR *tmpstr = Str_new(89,0);
2551
2552             str_nset(tmpstr, s, eol-s);
2553             astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
2554         }
2555         if (*s == '.') {
2556             /*SUPPRESS 530*/
2557             for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
2558             if (*t == '\n') {
2559                 bufptr = s;
2560                 return froot.f_next;
2561             }
2562         }
2563         if (*s == '#') {
2564             s = eol;
2565             continue;
2566         }
2567         flinebeg = Nullfcmd;
2568         noblank = FALSE;
2569         repeater = FALSE;
2570         while (s < eol) {
2571             Newz(804,fcmd,1,FCMD);
2572             fprev->f_next = fcmd;
2573             fprev = fcmd;
2574             for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
2575                 if (*t == '~') {
2576                     noblank = TRUE;
2577                     *t = ' ';
2578                     if (t[1] == '~') {
2579                         repeater = TRUE;
2580                         t[1] = ' ';
2581                     }
2582                 }
2583             }
2584             fcmd->f_pre = nsavestr(s, t-s);
2585             fcmd->f_presize = t-s;
2586             s = t;
2587             if (s >= eol) {
2588                 if (noblank)
2589                     fcmd->f_flags |= FC_NOBLANK;
2590                 if (repeater)
2591                     fcmd->f_flags |= FC_REPEAT;
2592                 break;
2593             }
2594             if (!flinebeg)
2595                 flinebeg = fcmd;                /* start values here */
2596             if (*s++ == '^')
2597                 fcmd->f_flags |= FC_CHOP;       /* for doing text filling */
2598             switch (*s) {
2599             case '*':
2600                 fcmd->f_type = F_LINES;
2601                 *s = '\0';
2602                 break;
2603             case '<':
2604                 fcmd->f_type = F_LEFT;
2605                 while (*s == '<')
2606                     s++;
2607                 break;
2608             case '>':
2609                 fcmd->f_type = F_RIGHT;
2610                 while (*s == '>')
2611                     s++;
2612                 break;
2613             case '|':
2614                 fcmd->f_type = F_CENTER;
2615                 while (*s == '|')
2616                     s++;
2617                 break;
2618             case '#':
2619             case '.':
2620                 /* Catch the special case @... and handle it as a string
2621                    field. */
2622                 if (*s == '.' && s[1] == '.') {
2623                     goto default_format;
2624                 }
2625                 fcmd->f_type = F_DECIMAL;
2626                 {
2627                     char *p;
2628
2629                     /* Read a format in the form @####.####, where either group
2630                        of ### may be empty, or the final .### may be missing. */
2631                     while (*s == '#')
2632                         s++;
2633                     if (*s == '.') {
2634                         s++;
2635                         p = s;
2636                         while (*s == '#')
2637                             s++;
2638                         fcmd->f_decimals = s-p;
2639                         fcmd->f_flags |= FC_DP;
2640                     } else {
2641                         fcmd->f_decimals = 0;
2642                     }
2643                 }
2644                 break;
2645             default:
2646             default_format:
2647                 fcmd->f_type = F_LEFT;
2648                 break;
2649             }
2650             if (fcmd->f_flags & FC_CHOP && *s == '.') {
2651                 fcmd->f_flags |= FC_MORE;
2652                 while (*s == '.')
2653                     s++;
2654             }
2655             fcmd->f_size = s-t;
2656         }
2657         if (flinebeg) {
2658           again:
2659             if (s >= bufend &&
2660               (!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
2661                 goto badform;
2662             curcmd->c_line++;
2663             if (in_eval && !rsfp) {
2664                 eol = index(s,'\n');
2665                 if (!eol++)
2666                     eol = bufend;
2667             }
2668             else
2669                 eol = bufend = linestr->str_ptr + linestr->str_cur;
2670             if (perldb) {
2671                 STR *tmpstr = Str_new(90,0);
2672
2673                 str_nset(tmpstr, s, eol-s);
2674                 astore(stab_xarray(curcmd->c_filestab),
2675                     (int)curcmd->c_line,tmpstr);
2676             }
2677             if (strnEQ(s,".\n",2)) {
2678                 bufptr = s;
2679                 yyerror("Missing values line");
2680                 return froot.f_next;
2681             }
2682             if (*s == '#') {
2683                 s = eol;
2684                 goto again;
2685             }
2686             str = flinebeg->f_unparsed = Str_new(91,eol - s);
2687             str->str_u.str_hash = curstash;
2688             str_nset(str,"(",1);
2689             flinebeg->f_line = curcmd->c_line;
2690             eol[-1] = '\0';
2691             if (!flinebeg->f_next->f_type || index(s, ',')) {
2692                 eol[-1] = '\n';
2693                 str_ncat(str, s, eol - s - 1);
2694                 str_ncat(str,",$$);",5);
2695                 s = eol;
2696             }
2697             else {
2698                 eol[-1] = '\n';
2699                 while (s < eol && isSPACE(*s))
2700                     s++;
2701                 t = s;
2702                 while (s < eol) {
2703                     switch (*s) {
2704                     case ' ': case '\t': case '\n': case ';':
2705                         str_ncat(str, t, s - t);
2706                         str_ncat(str, "," ,1);
2707                         while (s < eol && (isSPACE(*s) || *s == ';'))
2708                             s++;
2709                         t = s;
2710                         break;
2711                     case '$':
2712                         str_ncat(str, t, s - t);
2713                         t = s;
2714                         s = scanident(s,eol,tokenbuf);
2715                         str_ncat(str, t, s - t);
2716                         t = s;
2717                         if (s < eol && *s && index("$'\"",*s))
2718                             str_ncat(str, ",", 1);
2719                         break;
2720                     case '"': case '\'':
2721                         str_ncat(str, t, s - t);
2722                         t = s;
2723                         s++;
2724                         while (s < eol && (*s != *t || s[-1] == '\\'))
2725                             s++;
2726                         if (s < eol)
2727                             s++;
2728                         str_ncat(str, t, s - t);
2729                         t = s;
2730                         if (s < eol && *s && index("$'\"",*s))
2731                             str_ncat(str, ",", 1);
2732                         break;
2733                     default:
2734                         yyerror("Please use commas to separate fields");
2735                     }
2736                 }
2737                 str_ncat(str,"$$);",4);
2738             }
2739         }
2740     }
2741   badform:
2742     bufptr = str_get(linestr);
2743     yyerror("Format not terminated");
2744     return froot.f_next;
2745 }
2746
2747 static void
2748 set_csh()
2749 {
2750 #ifdef CSH
2751     if (!cshlen)
2752         cshlen = strlen(cshname);
2753 #endif
2754 }