toke.c

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