home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume20 / perl / patch08 < prev    next >
Encoding:
Text File  |  1991-06-19  |  49.1 KB  |  2,019 lines
  1. Newsgroups: comp.sources.misc
  2. From: Larry Wall <lwall@netlabs.com>
  3. Subject:  v20i060:  perl - The perl programming language, Patch08
  4. Message-ID: <1991Jun20.030715.8793@sparky.IMD.Sterling.COM>
  5. X-Md4-Signature: ae57846772c5492202517c7c68da4503
  6. Date: Thu, 20 Jun 1991 03:07:15 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: Larry Wall <lwall@netlabs.com>
  10. Posting-number: Volume 20, Issue 60
  11. Archive-name: perl/patch08
  12. Patch-To: perl: Volume 18, Issue 19-54
  13.  
  14. System: perl version 4.0
  15. Patch #: 8
  16. Priority: High
  17. Subject: patch #4, continued
  18.  
  19. Description:
  20.     See patch #4.
  21.  
  22. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your perl source
  23.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  24.     If you don't have the patch program, apply the following by hand,
  25.     or get patch (version 2.0, latest patchlevel).
  26.  
  27.     After patching:
  28.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #09 FIRST ***
  29.  
  30.     If patch indicates that patchlevel is the wrong version, you may need
  31.     to apply one or more previous patches, or the patch may already
  32.     have been applied.  See the patchlevel.h file to find out what has or
  33.     has not been applied.  In any event, don't continue with the patch.
  34.  
  35.     If you are missing previous patches they can be obtained from me:
  36.  
  37.     Larry Wall
  38.     lwall@netlabs.com
  39.  
  40.     If you send a mail message of the following form it will greatly speed
  41.     processing:
  42.  
  43.     Subject: Command
  44.     @SH mailpatch PATH perl 4.0 LIST
  45.            ^ note the c
  46.  
  47.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  48.     or in bang notation from some well-known host, and LIST is the number
  49.     of one or more patches you need, separated by spaces, commas, and/or
  50.     hyphens.  Saying 35- says everything from 35 to the end.
  51.  
  52.  
  53. Index: patchlevel.h
  54. Prereq: 7
  55. 1c1
  56. < #define PATCHLEVEL 7
  57. ---
  58. > #define PATCHLEVEL 8
  59.  
  60. Index: lib/perldb.pl
  61. Prereq: 4.0
  62. *** lib/perldb.pl.old    Fri Jun  7 12:25:19 1991
  63. --- lib/perldb.pl    Fri Jun  7 12:25:20 1991
  64. ***************
  65. *** 1,6 ****
  66.   package DB;
  67.   
  68. ! $header = '$Header: perldb.pl,v 4.0 91/03/20 01:25:50 lwall Locked $';
  69.   #
  70.   # This file is automatically included if you do perl -d.
  71.   # It's probably not useful to include this yourself.
  72. --- 1,6 ----
  73.   package DB;
  74.   
  75. ! $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:17:44 $';
  76.   #
  77.   # This file is automatically included if you do perl -d.
  78.   # It's probably not useful to include this yourself.
  79. ***************
  80. *** 10,15 ****
  81. --- 10,19 ----
  82.   # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
  83.   #
  84.   # $Log:    perldb.pl,v $
  85. + # Revision 4.0.1.1  91/06/07  11:17:44  lwall
  86. + # patch4: added $^P variable to control calling of perldb routines
  87. + # patch4: debugger sometimes listed wrong number of lines for a statement
  88. + # 
  89.   # Revision 4.0  91/03/20  01:25:50  lwall
  90.   # 4.0 baseline.
  91.   # 
  92. ***************
  93. *** 61,66 ****
  94. --- 65,71 ----
  95.       ($package, $filename, $line) = caller;
  96.       $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' .
  97.       "package $package;";        # this won't let them modify, alas
  98. +     local($^P) = 0;            # don't debug our own evals
  99.       local(*dbline) = "_<$filename";
  100.       $max = $#dbline;
  101.       if (($stop,$action) = split(/\0/,$dbline{$line})) {
  102. ***************
  103. *** 76,82 ****
  104.       print OUT "$package'" unless $sub =~ /'/;
  105.       print OUT "$sub($filename:$line):\t",$dbline[$line];
  106.       for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
  107. !         last if $dbline[$i] =~ /^\s*(}|#|\n)/;
  108.           print OUT "$sub($filename:$i):\t",$dbline[$i];
  109.       }
  110.       }
  111. --- 81,87 ----
  112.       print OUT "$package'" unless $sub =~ /'/;
  113.       print OUT "$sub($filename:$line):\t",$dbline[$line];
  114.       for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) {
  115. !         last if $dbline[$i] =~ /^\s*(;|}|#|\n)/;
  116.           print OUT "$sub($filename:$i):\t",$dbline[$i];
  117.       }
  118.       }
  119.  
  120. Index: perly.fixer
  121. *** perly.fixer.old    Fri Jun  7 12:26:21 1991
  122. --- perly.fixer    Fri Jun  7 12:26:21 1991
  123. ***************
  124. *** 2,7 ****
  125. --- 2,10 ----
  126.   
  127.   #  Hacks to make it work with Interactive's SysVr3 Version 2.2
  128.   #   doughera@lafvax.lafayette.edu (Andy Dougherty)   3/23/91
  129. + #
  130. + # Additional information to make the BSD section work with SunOS 4.0.2
  131. + #   tdinger@East.Sun.COM (Tom Dinger)    4/15/1991
  132.   
  133.   input=$1
  134.   output=$2
  135. ***************
  136. *** 10,20 ****
  137.   plan="unknown"
  138.   
  139.   #  Test for BSD 4.3 version.
  140.   egrep 'YYSTYPE[     ]*yyv\[ *YYMAXDEPTH *\];
  141.   short[  ]*yys\[ *YYMAXDEPTH *\] *;
  142.   yyps *= *&yys\[ *-1 *\];
  143.   yypv *= *&yyv\[ *-1 *\];
  144. ! if *\( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
  145.   
  146.   set `wc -l $tmp`
  147.   if test "$1" = "5"; then
  148. --- 13,24 ----
  149.   plan="unknown"
  150.   
  151.   #  Test for BSD 4.3 version.
  152. + #  Also tests for the SunOS 4.0.2 version
  153.   egrep 'YYSTYPE[     ]*yyv\[ *YYMAXDEPTH *\];
  154.   short[  ]*yys\[ *YYMAXDEPTH *\] *;
  155.   yyps *= *&yys\[ *-1 *\];
  156.   yypv *= *&yyv\[ *-1 *\];
  157. ! if *\( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *\)' $input >$tmp
  158.   
  159.   set `wc -l $tmp`
  160.   if test "$1" = "5"; then
  161. ***************
  162. *** 36,42 ****
  163.   fi
  164.   
  165.   case "$plan" in
  166. !     #######################################################
  167.       "bsd43")
  168.       echo "Patching perly.c to allow dynamic yacc stack allocation"
  169.       echo "Assuming bsd4.3 yaccpar"
  170. --- 40,49 ----
  171.   fi
  172.   
  173.   case "$plan" in
  174. !     ##################################################################
  175. !     # The SunOS 4.0.2 version has the comparison fixed already.
  176. !     # Also added are out of memory checks (makes porting the generated
  177. !     # code easier) For most systems, it can't hurt. -- TD
  178.       "bsd43")
  179.       echo "Patching perly.c to allow dynamic yacc stack allocation"
  180.       echo "Assuming bsd4.3 yaccpar"
  181. ***************
  182. *** 55,60 ****
  183. --- 62,71 ----
  184.   \    if (!yyv) {\
  185.   \        yyv = (YYSTYPE*) malloc(yymaxdepth * sizeof(YYSTYPE));\
  186.   \        yys = (short*) malloc(yymaxdepth * sizeof(short));\
  187. + \        if ( !yyv || !yys ) {\
  188. + \        yyerror( "out of memory" );\
  189. + \        return(1);\
  190. + \        }\
  191.   \        maxyyps = &yys[yymaxdepth];\
  192.   \    }\
  193.   \    yyps = &yys[-1];\
  194. ***************
  195. *** 61,67 ****
  196.   \    yypv = &yyv[-1];
  197.   
  198.   
  199. ! /if *( *\+\+yyps *> *&yys\[ *YYMAXDEPTH *\] *)/c\
  200.   \        if( ++yyps >= maxyyps ) {\
  201.   \            int tv = yypv - yyv;\
  202.   \            int ts = yyps - yys;\
  203. --- 72,78 ----
  204.   \    yypv = &yyv[-1];
  205.   
  206.   
  207. ! /if *( *\+\+yyps *>=* *&yys\[ *YYMAXDEPTH *\] *)/c\
  208.   \        if( ++yyps >= maxyyps ) {\
  209.   \            int tv = yypv - yyv;\
  210.   \            int ts = yyps - yys;\
  211. ***************
  212. *** 71,76 ****
  213. --- 82,91 ----
  214.   \              yymaxdepth*sizeof(YYSTYPE));\
  215.   \            yys = (short*)realloc((char*)yys,\
  216.   \              yymaxdepth*sizeof(short));\
  217. + \            if ( !yyv || !yys ) {\
  218. + \            yyerror( "yacc stack overflow" );\
  219. + \            return(1);\
  220. + \            }\
  221.   \            yyps = yys + ts;\
  222.   \            yypv = yyv + tv;\
  223.   \            maxyyps = &yys[yymaxdepth];\
  224.  
  225. Index: perly.y
  226. Prereq: 4.0
  227. *** perly.y.old    Fri Jun  7 12:26:24 1991
  228. --- perly.y    Fri Jun  7 12:26:25 1991
  229. ***************
  230. *** 1,11 ****
  231. ! /* $Header: perly.y,v 4.0 91/03/20 01:38:40 lwall Locked $
  232.    *
  233. !  *    Copyright (c) 1989, Larry Wall
  234.    *
  235. !  *    You may distribute under the terms of the GNU General Public License
  236. !  *    as specified in the README file that comes with the perl 3.0 kit.
  237.    *
  238.    * $Log:    perly.y,v $
  239.    * Revision 4.0  91/03/20  01:38:40  lwall
  240.    * 4.0 baseline.
  241.    * 
  242. --- 1,14 ----
  243. ! /* $RCSfile: perly.y,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:42:34 $
  244.    *
  245. !  *    Copyright (c) 1991, Larry Wall
  246.    *
  247. !  *    You may distribute under the terms of either the GNU General Public
  248. !  *    License or the Artistic License, as specified in the README file.
  249.    *
  250.    * $Log:    perly.y,v $
  251. +  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  252. +  * patch4: new copyright notice
  253. +  * 
  254.    * Revision 4.0  91/03/20  01:38:40  lwall
  255.    * 4.0 baseline.
  256.    * 
  257. ***************
  258. *** 788,792 ****
  259.                     "\"%s\" may clash with future reserved word",
  260.                     $1 );
  261.               }
  262. ! 
  263.   %% /* PROGRAM */
  264. --- 791,795 ----
  265.                     "\"%s\" may clash with future reserved word",
  266.                     $1 );
  267.               }
  268. !         ;
  269.   %% /* PROGRAM */
  270.  
  271. Index: msdos/popen.c
  272. Prereq: 4.0
  273. *** msdos/popen.c.old    Fri Jun  7 12:25:48 1991
  274. --- msdos/popen.c    Fri Jun  7 12:25:49 1991
  275. ***************
  276. *** 1,11 ****
  277. ! /* $Header: popen.c,v 4.0 91/03/20 01:34:50 lwall Locked $
  278.    *
  279.    *    (C) Copyright 1988, 1990 Diomidis Spinellis.
  280.    *
  281. !  *    You may distribute under the terms of the GNU General Public License
  282. !  *    as specified in the README file that comes with the perl 3.0 kit.
  283.    *
  284.    * $Log:    popen.c,v $
  285.    * Revision 4.0  91/03/20  01:34:50  lwall
  286.    * 4.0 baseline.
  287.    * 
  288. --- 1,14 ----
  289. ! /* $RCSfile: popen.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:22:52 $
  290.    *
  291.    *    (C) Copyright 1988, 1990 Diomidis Spinellis.
  292.    *
  293. !  *    You may distribute under the terms of either the GNU General Public
  294. !  *    License or the Artistic License, as specified in the README file.
  295.    *
  296.    * $Log:    popen.c,v $
  297. +  * Revision 4.0.1.1  91/06/07  11:22:52  lwall
  298. +  * patch4: new copyright notice
  299. +  * 
  300.    * Revision 4.0  91/03/20  01:34:50  lwall
  301.    * 4.0 baseline.
  302.    * 
  303.  
  304. Index: regcomp.c
  305. *** regcomp.c.old    Fri Jun  7 12:26:29 1991
  306. --- regcomp.c    Fri Jun  7 12:26:30 1991
  307. ***************
  308. *** 7,15 ****
  309.    * blame Henry for some of the lack of readability.
  310.    */
  311.   
  312. ! /* $RCSfile: regcomp.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:04:45 $
  313.    *
  314.    * $Log:    regcomp.c,v $
  315.    * Revision 4.0.1.1  91/04/12  09:04:45  lwall
  316.    * patch1: random cleanup in cpp namespace
  317.    * 
  318. --- 7,20 ----
  319.    * blame Henry for some of the lack of readability.
  320.    */
  321.   
  322. ! /* $RCSfile: regcomp.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:48:24 $
  323.    *
  324.    * $Log:    regcomp.c,v $
  325. +  * Revision 4.0.1.2  91/06/07  11:48:24  lwall
  326. +  * patch4: new copyright notice
  327. +  * patch4: /(x+) \1/ incorrectly optimized to not match "xxx xx"
  328. +  * patch4: // wouldn't use previous pattern if it started with a null character
  329. +  * 
  330.    * Revision 4.0.1.1  91/04/12  09:04:45  lwall
  331.    * patch1: random cleanup in cpp namespace
  332.    * 
  333. ***************
  334. *** 41,50 ****
  335.    *
  336.    ****    Alterations to Henry's code are...
  337.    ****
  338. !  ****    Copyright (c) 1989, Larry Wall
  339.    ****
  340. !  ****    You may distribute under the terms of the GNU General Public License
  341. !  ****    as specified in the README file that comes with the perl 3.0 kit.
  342.    *
  343.    * Beware that some of this code is subtly aware of the way operator
  344.    * precedence is structured in regular expressions.  Serious changes in
  345. --- 46,56 ----
  346.    *
  347.    ****    Alterations to Henry's code are...
  348.    ****
  349. !  ****    Copyright (c) 1991, Larry Wall
  350.    ****
  351. !  ****    You may distribute under the terms of either the GNU General Public
  352. !  ****    License or the Artistic License, as specified in the README file.
  353. ! 
  354.    *
  355.    * Beware that some of this code is subtly aware of the way operator
  356.    * precedence is structured in regular expressions.  Serious changes in
  357. ***************
  358. *** 95,100 ****
  359. --- 101,107 ----
  360.   static long regsize;        /* Code size. */
  361.   static int regfold;
  362.   static int regsawbracket;    /* Did we do {d,d} trick? */
  363. + static int regsawback;        /* Did we see \1, ...? */
  364.   
  365.   /*
  366.    * Forward declarations for regcomp()'s friends.
  367. ***************
  368. *** 146,151 ****
  369. --- 153,159 ----
  370.       extern char *safemalloc();
  371.       extern char *savestr();
  372.       int sawplus = 0;
  373. +     int sawopen = 0;
  374.   
  375.       if (exp == NULL)
  376.           fatal("NULL regexp argument");
  377. ***************
  378. *** 156,161 ****
  379. --- 164,170 ----
  380.       regxend = xend;
  381.       regprecomp = nsavestr(exp,xend-exp);
  382.       regsawbracket = 0;
  383. +     regsawback = 0;
  384.       regnpar = 1;
  385.       regsize = 0L;
  386.       regcode = ®dummy;
  387. ***************
  388. *** 178,185 ****
  389.       /* Second pass: emit code. */
  390.       if (regsawbracket)
  391.           bcopy(regprecomp,exp,xend-exp);
  392.       r->precomp = regprecomp;
  393. !     r->subbase = NULL;
  394.       regparse = exp;
  395.       regnpar = 1;
  396.       regcode = r->program;
  397. --- 187,195 ----
  398.       /* Second pass: emit code. */
  399.       if (regsawbracket)
  400.           bcopy(regprecomp,exp,xend-exp);
  401. +     r->prelen = xend-exp;
  402.       r->precomp = regprecomp;
  403. !     r->subbeg = r->subbase = NULL;
  404.       regparse = exp;
  405.       regnpar = 1;
  406.       regcode = r->program;
  407. ***************
  408. *** 198,209 ****
  409.           scan = NEXTOPER(scan);
  410.   
  411.           first = scan;
  412. !         while (OP(first) == OPEN ||
  413.               (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  414.               (OP(first) == PLUS) ||
  415.               (OP(first) == CURLY && ARG1(first) > 0) ) {
  416.               if (OP(first) == PLUS)
  417. !                 sawplus = 2;
  418.               else
  419.                   first += regarglen[OP(first)];
  420.               first = NEXTOPER(first);
  421. --- 208,219 ----
  422.           scan = NEXTOPER(scan);
  423.   
  424.           first = scan;
  425. !         while ((OP(first) == OPEN && (sawopen = 1)) ||
  426.               (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) ||
  427.               (OP(first) == PLUS) ||
  428.               (OP(first) == CURLY && ARG1(first) > 0) ) {
  429.               if (OP(first) == PLUS)
  430. !                 sawplus = 1;
  431.               else
  432.                   first += regarglen[OP(first)];
  433.               first = NEXTOPER(first);
  434. ***************
  435. *** 210,215 ****
  436. --- 220,226 ----
  437.           }
  438.   
  439.           /* Starting-point info. */
  440. +         again:
  441.           if (OP(first) == EXACTLY) {
  442.               r->regstart =
  443.                   str_make(OPERAND(first)+1,*OPERAND(first));
  444. ***************
  445. *** 221,229 ****
  446.           else if (OP(first) == BOUND || OP(first) == NBOUND)
  447.               r->regstclass = first;
  448.           else if (OP(first) == BOL ||
  449. !             (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) )
  450. !             r->reganch = 1;        /* kinda turn .* into ^.* */
  451. !         r->reganch |= sawplus;
  452.   
  453.   #ifdef DEBUGGING
  454.           if (debug & 512)
  455. --- 232,244 ----
  456.           else if (OP(first) == BOUND || OP(first) == NBOUND)
  457.               r->regstclass = first;
  458.           else if (OP(first) == BOL ||
  459. !             (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) {
  460. !             r->reganch = ROPT_ANCH;    /* kinda turn .* into ^.* */
  461. !             first = NEXTOPER(first);
  462. !                 goto again;
  463. !         }
  464. !         if (sawplus && (!sawopen || !regsawback))
  465. !             r->reganch |= ROPT_SKIP;    /* x+ must match 1st of run */
  466.   
  467.   #ifdef DEBUGGING
  468.           if (debug & 512)
  469. ***************
  470. *** 741,746 ****
  471. --- 756,762 ----
  472.                   if (num > 9 && num >= regnpar)
  473.                   goto defchar;
  474.                   else {
  475. +                 regsawback = 1;
  476.                   ret = reganode(REF, num);
  477.                   while (isascii(*regparse) && isdigit(*regparse))
  478.                       regparse++;
  479. ***************
  480. *** 1272,1280 ****
  481.           fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
  482.       if (r->regstclass)
  483.           fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
  484. !     if (r->reganch & 1)
  485.           fprintf(stderr,"anchored ");
  486. !     if (r->reganch & 2)
  487.           fprintf(stderr,"plus ");
  488.       if (r->regmust != NULL)
  489.           fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
  490. --- 1288,1296 ----
  491.           fprintf(stderr,"start `%s' ", r->regstart->str_ptr);
  492.       if (r->regstclass)
  493.           fprintf(stderr,"stclass `%s' ", regprop(r->regstclass));
  494. !     if (r->reganch & ROPT_ANCH)
  495.           fprintf(stderr,"anchored ");
  496. !     if (r->reganch & ROPT_SKIP)
  497.           fprintf(stderr,"plus ");
  498.       if (r->regmust != NULL)
  499.           fprintf(stderr,"must have \"%s\" back %d ", r->regmust->str_ptr,
  500.  
  501. Index: regcomp.h
  502. Prereq: 4.0
  503. *** regcomp.h.old    Fri Jun  7 12:26:33 1991
  504. --- regcomp.h    Fri Jun  7 12:26:34 1991
  505. ***************
  506. *** 1,6 ****
  507. ! /* $Header: regcomp.h,v 4.0 91/03/20 01:39:09 lwall Locked $
  508.    *
  509.    * $Log:    regcomp.h,v $
  510.    * Revision 4.0  91/03/20  01:39:09  lwall
  511.    * 4.0 baseline.
  512.    * 
  513. --- 1,9 ----
  514. ! /* $RCSfile: regcomp.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:49:40 $
  515.    *
  516.    * $Log:    regcomp.h,v $
  517. +  * Revision 4.0.1.1  91/06/07  11:49:40  lwall
  518. +  * patch4: no change
  519. +  * 
  520.    * Revision 4.0  91/03/20  01:39:09  lwall
  521.    * 4.0 baseline.
  522.    * 
  523.  
  524. Index: regexec.c
  525. *** regexec.c.old    Fri Jun  7 12:26:37 1991
  526. --- regexec.c    Fri Jun  7 12:26:38 1991
  527. ***************
  528. *** 7,15 ****
  529.    * blame Henry for some of the lack of readability.
  530.    */
  531.   
  532. ! /* $RCSfile: regexec.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:07:39 $
  533.    *
  534.    * $Log:    regexec.c,v $
  535.    * Revision 4.0.1.1  91/04/12  09:07:39  lwall
  536.    * patch1: regexec only allocated space for 9 subexpresssions
  537.    * 
  538. --- 7,19 ----
  539.    * blame Henry for some of the lack of readability.
  540.    */
  541.   
  542. ! /* $RCSfile: regexec.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:50:33 $
  543.    *
  544.    * $Log:    regexec.c,v $
  545. +  * Revision 4.0.1.2  91/06/07  11:50:33  lwall
  546. +  * patch4: new copyright notice
  547. +  * patch4: // wouldn't use previous pattern if it started with a null character
  548. +  * 
  549.    * Revision 4.0.1.1  91/04/12  09:07:39  lwall
  550.    * patch1: regexec only allocated space for 9 subexpresssions
  551.    * 
  552. ***************
  553. *** 40,49 ****
  554.    *
  555.    ****    Alterations to Henry's code are...
  556.    ****
  557. !  ****    Copyright (c) 1989, Larry Wall
  558.    ****
  559. !  ****    You may distribute under the terms of the GNU General Public License
  560. !  ****    as specified in the README file that comes with the perl 3.0 kit.
  561.    *
  562.    * Beware that some of this code is subtly aware of the way operator
  563.    * precedence is structured in regular expressions.  Serious changes in
  564. --- 44,53 ----
  565.    *
  566.    ****    Alterations to Henry's code are...
  567.    ****
  568. !  ****    Copyright (c) 1991, Larry Wall
  569.    ****
  570. !  ****    You may distribute under the terms of either the GNU General Public
  571. !  ****    License or the Artistic License, as specified in the README file.
  572.    *
  573.    * Beware that some of this code is subtly aware of the way operator
  574.    * precedence is structured in regular expressions.  Serious changes in
  575. ***************
  576. *** 151,157 ****
  577.       /* If there is a "must appear" string, look for it. */
  578.       s = string;
  579.       if (prog->regmust != Nullstr &&
  580. !         (!(prog->reganch & 1) || (multiline && prog->regback >= 0)) ) {
  581.           if (stringarg == strbeg && screamer) {
  582.               if (screamfirst[prog->regmust->str_rare] >= 0)
  583.                   s = screaminstr(screamer,prog->regmust);
  584. --- 155,162 ----
  585.       /* If there is a "must appear" string, look for it. */
  586.       s = string;
  587.       if (prog->regmust != Nullstr &&
  588. !         (!(prog->reganch & ROPT_ANCH)
  589. !          || (multiline && prog->regback >= 0)) ) {
  590.           if (stringarg == strbeg && screamer) {
  591.               if (screamfirst[prog->regmust->str_rare] >= 0)
  592.                   s = screaminstr(screamer,prog->regmust);
  593. ***************
  594. *** 213,219 ****
  595.   
  596.       /* Simplest case:  anchored match need be tried only once. */
  597.       /*  [unless multiline is set] */
  598. !     if (prog->reganch & 1) {
  599.           if (regtry(prog, string))
  600.               goto got_it;
  601.           else if (multiline) {
  602. --- 218,224 ----
  603.   
  604.       /* Simplest case:  anchored match need be tried only once. */
  605.       /*  [unless multiline is set] */
  606. !     if (prog->reganch & ROPT_ANCH) {
  607.           if (regtry(prog, string))
  608.               goto got_it;
  609.           else if (multiline) {
  610. ***************
  611. *** 235,241 ****
  612.   
  613.       /* Messy cases:  unanchored match. */
  614.       if (prog->regstart) {
  615. !         if (prog->reganch & 2) {    /* we have /x+whatever/ */
  616.               /* it must be a one character string */
  617.               i = prog->regstart->str_ptr[0];
  618.               while (s < strend) {
  619. --- 240,246 ----
  620.   
  621.       /* Messy cases:  unanchored match. */
  622.       if (prog->regstart) {
  623. !         if (prog->reganch & ROPT_SKIP) {  /* we have /x+whatever/ */
  624.               /* it must be a one character string */
  625.               i = prog->regstart->str_ptr[0];
  626.               while (s < strend) {
  627. ***************
  628. *** 275,281 ****
  629.           goto phooey;
  630.       }
  631.       if (c = prog->regstclass) {
  632. !         int doevery = (prog->reganch & 2) == 0;
  633.   
  634.           if (minlen)
  635.               dontbother = minlen - 1;
  636. --- 280,286 ----
  637.           goto phooey;
  638.       }
  639.       if (c = prog->regstclass) {
  640. !         int doevery = (prog->reganch & ROPT_SKIP) == 0;
  641.   
  642.           if (minlen)
  643.               dontbother = minlen - 1;
  644. ***************
  645. *** 445,451 ****
  646.               s = nsavestr(strbeg,i);    /* so $digit will work later */
  647.               if (prog->subbase)
  648.                   Safefree(prog->subbase);
  649. !             prog->subbase = s;
  650.               prog->subend = s+i;
  651.           }
  652.           else
  653. --- 450,456 ----
  654.               s = nsavestr(strbeg,i);    /* so $digit will work later */
  655.               if (prog->subbase)
  656.                   Safefree(prog->subbase);
  657. !             prog->subbeg = prog->subbase = s;
  658.               prog->subend = s+i;
  659.           }
  660.           else
  661.  
  662. Index: regexp.h
  663. Prereq: 4.0
  664. *** regexp.h.old    Fri Jun  7 12:26:40 1991
  665. --- regexp.h    Fri Jun  7 12:26:41 1991
  666. ***************
  667. *** 5,13 ****
  668.    * not the System V one.
  669.    */
  670.   
  671. ! /* $Header: regexp.h,v 4.0 91/03/20 01:39:23 lwall Locked $
  672.    *
  673.    * $Log:    regexp.h,v $
  674.    * Revision 4.0  91/03/20  01:39:23  lwall
  675.    * 4.0 baseline.
  676.    * 
  677. --- 5,18 ----
  678.    * not the System V one.
  679.    */
  680.   
  681. ! /* $RCSfile: regexp.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:18 $
  682.    *
  683.    * $Log:    regexp.h,v $
  684. +  * Revision 4.0.1.1  91/06/07  11:51:18  lwall
  685. +  * patch4: new copyright notice
  686. +  * patch4: // wouldn't use previous pattern if it started with a null character
  687. +  * patch4: $` was busted inside s///
  688. +  * 
  689.    * Revision 4.0  91/03/20  01:39:23  lwall
  690.    * 4.0 baseline.
  691.    * 
  692. ***************
  693. *** 20,27 ****
  694. --- 25,34 ----
  695.       char *regstclass;
  696.       STR *regmust;        /* Internal use only. */
  697.       int regback;        /* Can regmust locate first try? */
  698. +     int prelen;        /* length of precomp */
  699.       char *precomp;        /* pre-compilation regular expression */
  700.       char *subbase;        /* saved string so \digit works forever */
  701. +     char *subbeg;        /* same, but not responsible for allocation */
  702.       char *subend;        /* end of subbase */
  703.       char reganch;        /* Internal use only. */
  704.       char do_folding;    /* do case-insensitive match? */
  705. ***************
  706. *** 29,34 ****
  707. --- 36,44 ----
  708.       char nparens;        /* number of parentheses */
  709.       char program[1];    /* Unwarranted chumminess with compiler. */
  710.   } regexp;
  711. + 
  712. + #define ROPT_ANCH 1
  713. + #define ROPT_SKIP 2
  714.   
  715.   regexp *regcomp();
  716.   int regexec();
  717.  
  718. Index: x2p/s2p.SH
  719. Prereq: 4.0
  720. *** x2p/s2p.SH.old    Fri Jun  7 12:28:10 1991
  721. --- x2p/s2p.SH    Fri Jun  7 12:28:11 1991
  722. ***************
  723. *** 29,37 ****
  724.   : In the following dollars and backticks do not need the extra backslash.
  725.   $spitshell >>s2p <<'!NO!SUBS!'
  726.   
  727. ! # $Header: s2p.SH,v 4.0 91/03/20 01:57:59 lwall Locked $
  728.   #
  729.   # $Log:    s2p.SH,v $
  730.   # Revision 4.0  91/03/20  01:57:59  lwall
  731.   # 4.0 baseline.
  732.   # 
  733. --- 29,40 ----
  734.   : In the following dollars and backticks do not need the extra backslash.
  735.   $spitshell >>s2p <<'!NO!SUBS!'
  736.   
  737. ! # $RCSfile: s2p.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:18 $
  738.   #
  739.   # $Log:    s2p.SH,v $
  740. + # Revision 4.0.1.1  91/06/07  12:19:18  lwall
  741. + # patch4: s2p now handles embedded newlines better and optimizes common idioms
  742. + # 
  743.   # Revision 4.0  91/03/20  01:57:59  lwall
  744.   # 4.0 baseline.
  745.   # 
  746. ***************
  747. *** 66,98 ****
  748.   }
  749.   
  750.   if (!$assumen && !$assumep) {
  751. !     print BODY <<'EOT';
  752. ! while ($ARGV[0] =~ /^-/) {
  753. !     $_ = shift;
  754. !   last if /^--/;
  755. !     if (/^-n/) {
  756. !     $nflag++;
  757. !     next;
  758. !     }
  759. !     die "I don't recognize this switch: $_\\n";
  760. ! }
  761. ! 
  762.   EOT
  763.   }
  764.   
  765. ! print BODY <<'EOT';
  766. ! 
  767. ! #ifdef PRINTIT
  768. ! #ifdef ASSUMEP
  769. ! $printit++;
  770. ! #else
  771. ! $printit++ unless $nflag;
  772. ! #endif
  773. ! #endif
  774. ! LINE: while (<>) {
  775.   EOT
  776.   
  777. ! LINE: while (<>) {
  778.   
  779.       # Wipe out surrounding whitespace.
  780.   
  781. --- 69,111 ----
  782.   }
  783.   
  784.   if (!$assumen && !$assumep) {
  785. !     print BODY &q(<<'EOT');
  786. ! :    while ($ARGV[0] =~ /^-/) {
  787. ! :        $_ = shift;
  788. ! :      last if /^--/;
  789. ! :        if (/^-n/) {
  790. ! :        $nflag++;
  791. ! :        next;
  792. ! :        }
  793. ! :        die "I don't recognize this switch: $_\\n";
  794. ! :    }
  795. ! :    
  796.   EOT
  797.   }
  798.   
  799. ! print BODY &q(<<'EOT');
  800. ! :    #ifdef PRINTIT
  801. ! :    #ifdef ASSUMEP
  802. ! :    $printit++;
  803. ! :    #else
  804. ! :    $printit++ unless $nflag;
  805. ! :    #endif
  806. ! :    #endif
  807. ! :    <><>
  808. ! :    $\ = "\n";        # automatically add newline on print
  809. ! :    <><>
  810. ! :    #ifdef TOPLABEL
  811. ! :    LINE:
  812. ! :    while (chop($_ = <>)) {
  813. ! :    #else
  814. ! :    LINE:
  815. ! :    while (<>) {
  816. ! :        chop;
  817. ! :    #endif
  818.   EOT
  819.   
  820. ! LINE:
  821. ! while (<>) {
  822.   
  823.       # Wipe out surrounding whitespace.
  824.   
  825. ***************
  826. *** 105,110 ****
  827. --- 118,127 ----
  828.       $label = &make_label($_);
  829.       if ($. == 1) {
  830.           $toplabel = $label;
  831. +         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  832. +         $_ = <>;
  833. +         redo LINE; # Never referenced, so delete it if not a comment.
  834. +         }
  835.       }
  836.       $_ = "$label:";
  837.       if ($lastlinewaslabel++) {
  838. ***************
  839. *** 127,132 ****
  840. --- 144,150 ----
  841.       $addr2 = '';
  842.       if (s/^([0-9]+)//) {
  843.       $addr1 = "$1";
  844. +     $addr1 = "\$. == $addr1" unless /^,/;
  845.       }
  846.       elsif (s/^\$//) {
  847.       $addr1 = 'eof()';
  848. ***************
  849. *** 213,247 ****
  850.       $indent -= 4;
  851.   }
  852.   
  853. - print BODY "}\n";
  854.   if ($appendseen || $tseen || !$assumen) {
  855.       $printit++ if $dseen || (!$assumen && !$assumep);
  856. !     print BODY <<'EOT';
  857.   
  858. ! continue {
  859. ! #ifdef PRINTIT
  860. ! #ifdef DSEEN
  861. ! #ifdef ASSUMEP
  862. !     print if $printit++;
  863. ! #else
  864. !     if ($printit)
  865. !     { print; }
  866. !     else
  867. !     { $printit++ unless $nflag; }
  868. ! #endif
  869. ! #else
  870. !     print if $printit;
  871. ! #endif
  872. ! #else
  873. !     print;
  874. ! #endif
  875. ! #ifdef TSEEN
  876. !     $tflag = '';
  877. ! #endif
  878. ! #ifdef APPENDSEEN
  879. !     if ($atext) { print $atext; $atext = ''; }
  880. ! #endif
  881. ! }
  882.   EOT
  883.   }
  884.   
  885. --- 231,269 ----
  886.       $indent -= 4;
  887.   }
  888.   
  889.   if ($appendseen || $tseen || !$assumen) {
  890.       $printit++ if $dseen || (!$assumen && !$assumep);
  891. !     print BODY &q(<<'EOT');
  892. ! :    #ifdef SAWNEXT
  893. ! :    }
  894. ! :    continue {
  895. ! :    #endif
  896. ! :    #ifdef PRINTIT
  897. ! :    #ifdef DSEEN
  898. ! :    #ifdef ASSUMEP
  899. ! :        print if $printit++;
  900. ! :    #else
  901. ! :        if ($printit)
  902. ! :        { print; }
  903. ! :        else
  904. ! :        { $printit++ unless $nflag; }
  905. ! :    #endif
  906. ! :    #else
  907. ! :        print if $printit;
  908. ! :    #endif
  909. ! :    #else
  910. ! :        print;
  911. ! :    #endif
  912. ! :    #ifdef TSEEN
  913. ! :        $tflag = 0;
  914. ! :    #endif
  915. ! :    #ifdef APPENDSEEN
  916. ! :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  917. ! :    #endif
  918. ! EOT
  919.   
  920. ! print BODY &q(<<'EOT');
  921. ! :    }
  922.   EOT
  923.   }
  924.   
  925. ***************
  926. *** 250,261 ****
  927.   unless ($debug) {
  928.       open(HEAD,">/tmp/sperl2$$.c")
  929.         || &Die("Can't open temp file 2: $!\n");
  930. !     print HEAD "#define PRINTIT\n" if ($printit);
  931. !     print HEAD "#define APPENDSEEN\n" if ($appendseen);
  932. !     print HEAD "#define TSEEN\n" if ($tseen);
  933. !     print HEAD "#define DSEEN\n" if ($dseen);
  934. !     print HEAD "#define ASSUMEN\n" if ($assumen);
  935. !     print HEAD "#define ASSUMEP\n" if ($assumep);
  936.       if ($opens) {print HEAD "$opens\n";}
  937.       open(BODY,"/tmp/sperl$$")
  938.         || &Die("Can't reopen temp file: $!\n");
  939. --- 272,285 ----
  940.   unless ($debug) {
  941.       open(HEAD,">/tmp/sperl2$$.c")
  942.         || &Die("Can't open temp file 2: $!\n");
  943. !     print HEAD "#define PRINTIT\n"    if $printit;
  944. !     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  945. !     print HEAD "#define TSEEN\n"    if $tseen;
  946. !     print HEAD "#define DSEEN\n"    if $dseen;
  947. !     print HEAD "#define ASSUMEN\n"    if $assumen;
  948. !     print HEAD "#define ASSUMEP\n"    if $assumep;
  949. !     print HEAD "#define TOPLABEL\n"    if $toplabel;
  950. !     print HEAD "#define SAWNEXT\n"    if $sawnext;
  951.       if ($opens) {print HEAD "$opens\n";}
  952.       open(BODY,"/tmp/sperl$$")
  953.         || &Die("Can't reopen temp file: $!\n");
  954. ***************
  955. *** 264,274 ****
  956.       }
  957.       close HEAD;
  958.   
  959. !     print <<"EOT";
  960. ! #!$bin/perl
  961. ! eval 'exec $bin/perl -S \$0 \$*'
  962. !     if \$running_under_some_shell;
  963. ! 
  964.   EOT
  965.       open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  966.       &Die("Can't reopen temp file: $!\n");
  967. --- 288,298 ----
  968.       }
  969.       close HEAD;
  970.   
  971. !     print &q(<<"EOT");
  972. ! :    #!$bin/perl
  973. ! :    eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
  974. ! :        if \$running_under_some_shell;
  975. ! :    
  976.   EOT
  977.       open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  978.       &Die("Can't reopen temp file: $!\n");
  979. ***************
  980. *** 297,311 ****
  981.   sub make_filehandle {
  982.       local($_) = $_[0];
  983.       local($fname) = $_;
  984. !     s/[^a-zA-Z]/_/g;
  985. !     s/^_*//;
  986. !     substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/;
  987. !     if (!$seen{$_}) {
  988. !     $opens .= <<"EOT";
  989. ! open($_,'>$fname') || die "Can't create $fname";
  990.   EOT
  991.       }
  992. !     $seen{$_} = $_;
  993.   }
  994.   
  995.   sub make_label {
  996. --- 321,342 ----
  997.   sub make_filehandle {
  998.       local($_) = $_[0];
  999.       local($fname) = $_;
  1000. !     if (!$seen{$fname}) {
  1001. !     $_ = "FH_" . $_ if /^\d/;
  1002. !     s/[^a-zA-Z0-9]/_/g;
  1003. !     s/^_*//;
  1004. !     $_ = "\U$_";
  1005. !     if ($fhseen{$_}) {
  1006. !         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  1007. !         $_ .= $tmp;
  1008. !     }
  1009. !     $fhseen{$_} = 1;
  1010. !     $opens .= &q(<<"EOT");
  1011. ! :    open($_, '>$fname') || die "Can't create $fname: \$!";
  1012.   EOT
  1013. +     $seen{$fname} = $_;
  1014.       }
  1015. !     $seen{$fname};
  1016.   }
  1017.   
  1018.   sub make_label {
  1019. ***************
  1020. *** 325,364 ****
  1021.       {    # case
  1022.       if (/^d/) {
  1023.           $dseen++;
  1024. !         chop($_ = <<'EOT');
  1025. ! <<--#ifdef PRINTIT
  1026. ! $printit = '';
  1027. ! <<--#endif
  1028. ! next LINE;
  1029.   EOT
  1030.           next;
  1031.       }
  1032.   
  1033.       if (/^n/) {
  1034. !         chop($_ = <<'EOT');
  1035. ! <<--#ifdef PRINTIT
  1036. ! <<--#ifdef DSEEN
  1037. ! <<--#ifdef ASSUMEP
  1038. ! print if $printit++;
  1039. ! <<--#else
  1040. ! if ($printit)
  1041. !     { print; }
  1042. ! else
  1043. !     { $printit++ unless $nflag; }
  1044. ! <<--#endif
  1045. ! <<--#else
  1046. ! print if $printit;
  1047. ! <<--#endif
  1048. ! <<--#else
  1049. ! print;
  1050. ! <<--#endif
  1051. ! <<--#ifdef APPENDSEEN
  1052. ! if ($atext) {print $atext; $atext = '';}
  1053. ! <<--#endif
  1054. ! $_ = <>;
  1055. ! <<--#ifdef TSEEN
  1056. ! $tflag = '';
  1057. ! <<--#endif
  1058.   EOT
  1059.           next;
  1060.       }
  1061. --- 356,397 ----
  1062.       {    # case
  1063.       if (/^d/) {
  1064.           $dseen++;
  1065. !         chop($_ = &q(<<'EOT'));
  1066. ! :    <<--#ifdef PRINTIT
  1067. ! :    $printit = 0;
  1068. ! :    <<--#endif
  1069. ! :    next LINE;
  1070.   EOT
  1071. +         $sawnext++;
  1072.           next;
  1073.       }
  1074.   
  1075.       if (/^n/) {
  1076. !         chop($_ = &q(<<'EOT'));
  1077. ! :    <<--#ifdef PRINTIT
  1078. ! :    <<--#ifdef DSEEN
  1079. ! :    <<--#ifdef ASSUMEP
  1080. ! :    print if $printit++;
  1081. ! :    <<--#else
  1082. ! :    if ($printit)
  1083. ! :        { print; }
  1084. ! :    else
  1085. ! :        { $printit++ unless $nflag; }
  1086. ! :    <<--#endif
  1087. ! :    <<--#else
  1088. ! :    print if $printit;
  1089. ! :    <<--#endif
  1090. ! :    <<--#else
  1091. ! :    print;
  1092. ! :    <<--#endif
  1093. ! :    <<--#ifdef APPENDSEEN
  1094. ! :    if ($atext) {chop $atext; print $atext; $atext = '';}
  1095. ! :    <<--#endif
  1096. ! :    $_ = <>;
  1097. ! :    chop;
  1098. ! :    <<--#ifdef TSEEN
  1099. ! :    $tflag = 0;
  1100. ! :    <<--#endif
  1101.   EOT
  1102.           next;
  1103.       }
  1104. ***************
  1105. *** 365,391 ****
  1106.   
  1107.       if (/^a/) {
  1108.           $appendseen++;
  1109. !         $command = $space . '$atext .=' . "\n<<--'";
  1110.           $lastline = 0;
  1111.           while (<>) {
  1112.           s/^[ \t]*//;
  1113.           s/^[\\]//;
  1114.           unless (s|\\$||) { $lastline = 1;}
  1115. -         s/'/\\'/g;
  1116.           s/^([ \t]*\n)/<><>$1/;
  1117.           $command .= $_;
  1118.           $command .= '<<--';
  1119.           last if $lastline;
  1120.           }
  1121. !         $_ = $command . "';";
  1122.           last;
  1123.       }
  1124.   
  1125.       if (/^[ic]/) {
  1126.           if (/^c/) { $change = 1; }
  1127.           $addr1 = '$iter = (' . $addr1 . ')';
  1128. !         $command = $space . 'if ($iter == 1) { print'
  1129. !           . "\n<<--'";
  1130.           $lastline = 0;
  1131.           while (<>) {
  1132.           s/^[ \t]*//;
  1133. --- 398,424 ----
  1134.   
  1135.       if (/^a/) {
  1136.           $appendseen++;
  1137. !         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  1138.           $lastline = 0;
  1139.           while (<>) {
  1140.           s/^[ \t]*//;
  1141.           s/^[\\]//;
  1142.           unless (s|\\$||) { $lastline = 1;}
  1143.           s/^([ \t]*\n)/<><>$1/;
  1144.           $command .= $_;
  1145.           $command .= '<<--';
  1146.           last if $lastline;
  1147.           }
  1148. !         $_ = $command . "End_Of_Text";
  1149.           last;
  1150.       }
  1151.   
  1152.       if (/^[ic]/) {
  1153.           if (/^c/) { $change = 1; }
  1154. +         $addr1 = 1 if $addr1 eq '';
  1155.           $addr1 = '$iter = (' . $addr1 . ')';
  1156. !         $command = $space .
  1157. !           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  1158.           $lastline = 0;
  1159.           while (<>) {
  1160.           s/^[ \t]*//;
  1161. ***************
  1162. *** 397,412 ****
  1163.           $command .= '<<--';
  1164.           last if $lastline;
  1165.           }
  1166. !         $_ = $command . "';}";
  1167.           if ($change) {
  1168.           $dseen++;
  1169.           $change = "$_\n";
  1170. !         chop($_ = <<"EOT");
  1171. ! <<--#ifdef PRINTIT
  1172. ! $space\$printit = '';
  1173. ! <<--#endif
  1174. ! ${space}next LINE;
  1175.   EOT
  1176.           }
  1177.           last;
  1178.       }
  1179. --- 430,446 ----
  1180.           $command .= '<<--';
  1181.           last if $lastline;
  1182.           }
  1183. !         $_ = $command . "End_Of_Text";
  1184.           if ($change) {
  1185.           $dseen++;
  1186.           $change = "$_\n";
  1187. !         chop($_ = &q(<<"EOT"));
  1188. ! :    <<--#ifdef PRINTIT
  1189. ! :    $space\$printit = 0;
  1190. ! :    <<--#endif
  1191. ! :    ${space}next LINE;
  1192.   EOT
  1193. +         $sawnext++;
  1194.           }
  1195.           last;
  1196.       }
  1197. ***************
  1198. *** 463,468 ****
  1199. --- 497,507 ----
  1200.           elsif ($c eq ']') {
  1201.               $inbracket = 0;
  1202.           }
  1203. +         elsif ($c eq "\t") {
  1204. +             substr($_, $i, 1) = '\\t';
  1205. +             $i++;
  1206. +             $len++;
  1207. +         }
  1208.           elsif (!$repl && index("()+",$c) >= 0) {
  1209.               substr($_, $i, 0) = '\\';
  1210.               $i++;
  1211. ***************
  1212. *** 474,479 ****
  1213. --- 513,519 ----
  1214.           $pat = substr($_, 0, $repl + 1);
  1215.           $repl = substr($_, $repl+1, $end-$repl-1);
  1216.           $end = substr($_, $end + 1, 1000);
  1217. +         &simplify($pat);
  1218.           $dol = '$';
  1219.           $repl =~ s/\$/\\$/;
  1220.           $repl =~ s'&'$&'g;
  1221. ***************
  1222. *** 498,509 ****
  1223.           &Die("Unrecognized substitution command".
  1224.             "($end) at line $.\n");
  1225.           }
  1226. !         chop ($_ = <<"EOT");
  1227. ! <<--#ifdef TSEEN
  1228. ! $subst && \$tflag++$cmd;
  1229. ! <<--#else
  1230. ! $subst$cmd;
  1231. ! <<--#endif
  1232.   EOT
  1233.           next;
  1234.       }
  1235. --- 538,549 ----
  1236.           &Die("Unrecognized substitution command".
  1237.             "($end) at line $.\n");
  1238.           }
  1239. !         chop ($_ = &q(<<"EOT"));
  1240. ! :    <<--#ifdef TSEEN
  1241. ! :    $subst && \$tflag++$cmd;
  1242. ! :    <<--#else
  1243. ! :    $subst$cmd;
  1244. ! :    <<--#endif
  1245.   EOT
  1246.           next;
  1247.       }
  1248. ***************
  1249. *** 529,553 ****
  1250.       }
  1251.   
  1252.       if (/^P/) {
  1253. !         $_ = 'print $1 if /(^.*\n)/;';
  1254.           next;
  1255.       }
  1256.   
  1257.       if (/^D/) {
  1258. !         chop($_ = <<'EOT');
  1259. ! s/^.*\n//;
  1260. ! redo LINE if $_;
  1261. ! next LINE;
  1262.   EOT
  1263.           next;
  1264.       }
  1265.   
  1266.       if (/^N/) {
  1267. !         chop($_ = <<'EOT');
  1268. ! $_ .= <>;
  1269. ! <<--#ifdef TSEEN
  1270. ! $tflag = '';
  1271. ! <<--#endif
  1272.   EOT
  1273.           next;
  1274.       }
  1275. --- 569,597 ----
  1276.       }
  1277.   
  1278.       if (/^P/) {
  1279. !         $_ = 'print $1 if /^(.*)/;';
  1280.           next;
  1281.       }
  1282.   
  1283.       if (/^D/) {
  1284. !         chop($_ = &q(<<'EOT'));
  1285. ! :    s/^.*\n?//;
  1286. ! :    redo LINE if $_;
  1287. ! :    next LINE;
  1288.   EOT
  1289. +         $sawnext++;
  1290.           next;
  1291.       }
  1292.   
  1293.       if (/^N/) {
  1294. !         chop($_ = &q(<<'EOT'));
  1295. ! :    $_ .= "\n";
  1296. ! :    $len1 = length;
  1297. ! :    $_ .= <>;
  1298. ! :    chop if $len1 < length;
  1299. ! :    <<--#ifdef TSEEN
  1300. ! :    $tflag = 0;
  1301. ! :    <<--#endif
  1302.   EOT
  1303.           next;
  1304.       }
  1305. ***************
  1306. *** 558,564 ****
  1307.       }
  1308.   
  1309.       if (/^H/) {
  1310. !         $_ = '$hold .= $_ ? $_ : "\n";';
  1311.           next;
  1312.       }
  1313.   
  1314. --- 602,608 ----
  1315.       }
  1316.   
  1317.       if (/^H/) {
  1318. !         $_ = '$hold .= "\n"; $hold .= $_;';
  1319.           next;
  1320.       }
  1321.   
  1322. ***************
  1323. *** 568,574 ****
  1324.       }
  1325.   
  1326.       if (/^G/) {
  1327. !         $_ = '$_ .= $hold ? $hold : "\n";';
  1328.           next;
  1329.       }
  1330.   
  1331. --- 612,618 ----
  1332.       }
  1333.   
  1334.       if (/^G/) {
  1335. !         $_ = '$_ .= "\n"; $_ .= $hold;';
  1336.           next;
  1337.       }
  1338.   
  1339. ***************
  1340. *** 579,584 ****
  1341. --- 623,629 ----
  1342.   
  1343.       if (/^b$/) {
  1344.           $_ = 'next LINE;';
  1345. +         $sawnext++;
  1346.           next;
  1347.       }
  1348.   
  1349. ***************
  1350. *** 595,600 ****
  1351. --- 640,646 ----
  1352.   
  1353.       if (/^t$/) {
  1354.           $_ = 'next LINE if $tflag;';
  1355. +         $sawnext++;
  1356.           $tseen++;
  1357.           next;
  1358.       }
  1359. ***************
  1360. *** 602,608 ****
  1361.       if (/^t/) {
  1362.           s/^t[ \t]*//;
  1363.           $lab = &make_label($_);
  1364. !         $_ = q/if ($tflag) {$tflag = ''; /;
  1365.           if ($lab eq $toplabel) {
  1366.           $_ .= 'redo LINE;}';
  1367.           } else {
  1368. --- 648,654 ----
  1369.       if (/^t/) {
  1370.           s/^t[ \t]*//;
  1371.           $lab = &make_label($_);
  1372. !         $_ = q/if ($tflag) {$tflag = 0; /;
  1373.           if ($lab eq $toplabel) {
  1374.           $_ .= 'redo LINE;}';
  1375.           } else {
  1376. ***************
  1377. *** 612,628 ****
  1378.           next;
  1379.       }
  1380.   
  1381.       if (/^=/) {
  1382. !         $_ = 'print "$.\n";';
  1383.           next;
  1384.       }
  1385.   
  1386.       if (/^q/) {
  1387. !         chop($_ = <<'EOT');
  1388. ! close(ARGV);
  1389. ! @ARGV = ();
  1390. ! next LINE;
  1391.   EOT
  1392.           next;
  1393.       }
  1394.       } continue {
  1395. --- 658,685 ----
  1396.           next;
  1397.       }
  1398.   
  1399. +     if (/^y/) {
  1400. +         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  1401. +         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  1402. +         s/abcdef/a-f/g;
  1403. +         s/ABCDEF/A-F/g;
  1404. +         s/0123456789/0-9/g;
  1405. +         s/01234567/0-7/g;
  1406. +         $_ .= ';';
  1407. +     }
  1408. + 
  1409.       if (/^=/) {
  1410. !         $_ = 'print $.;';
  1411.           next;
  1412.       }
  1413.   
  1414.       if (/^q/) {
  1415. !         chop($_ = &q(<<'EOT'));
  1416. ! :    close(ARGV);
  1417. ! :    @ARGV = ();
  1418. ! :    next LINE;
  1419.   EOT
  1420. +         $sawnext++;
  1421.           next;
  1422.       }
  1423.       } continue {
  1424. ***************
  1425. *** 670,676 ****
  1426. --- 727,763 ----
  1427.           last DELIM;
  1428.       }
  1429.       }
  1430. +     $addr =~ s/\t/\\t/g;
  1431. +     &simplify($addr);
  1432.       $addr;
  1433. + }
  1434. + 
  1435. + sub q {
  1436. +     local($string) = @_;
  1437. +     local($*) = 1;
  1438. +     $string =~ s/^:\t?//g;
  1439. +     $string;
  1440. + }
  1441. + 
  1442. + sub simplify {
  1443. +     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  1444. +     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  1445. +     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  1446. +     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  1447. +     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  1448. +     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  1449. +     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  1450. +     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  1451. +     $_[0] =~ s/\[\\w\]/\\w/g;
  1452. +     $_[0] =~ s/\[^\\w\]/\\W/g;
  1453. +     $_[0] =~ s/\[0-9\]/\\d/g;
  1454. +     $_[0] =~ s/\[^0-9\]/\\D/g;
  1455. +     $_[0] =~ s/\\d\\d\*/\\d+/g;
  1456. +     $_[0] =~ s/\\D\\D\*/\\D+/g;
  1457. +     $_[0] =~ s/\\w\\w\*/\\w+/g;
  1458. +     $_[0] =~ s/\\t\\t\*/\\t+/g;
  1459. +     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  1460. +     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  1461.   }
  1462.   
  1463.   !NO!SUBS!
  1464.  
  1465. Index: x2p/s2p.man
  1466. Prereq: 4.0
  1467. *** x2p/s2p.man.old    Fri Jun  7 12:28:14 1991
  1468. --- x2p/s2p.man    Fri Jun  7 12:28:14 1991
  1469. ***************
  1470. *** 1,7 ****
  1471.   .rn '' }`
  1472. ! ''' $Header: s2p.man,v 4.0 91/03/20 01:58:07 lwall Locked $
  1473.   ''' 
  1474.   ''' $Log:    s2p.man,v $
  1475.   ''' Revision 4.0  91/03/20  01:58:07  lwall
  1476.   ''' 4.0 baseline.
  1477.   ''' 
  1478. --- 1,10 ----
  1479.   .rn '' }`
  1480. ! ''' $RCSfile: s2p.man,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:57 $
  1481.   ''' 
  1482.   ''' $Log:    s2p.man,v $
  1483. + ''' Revision 4.0.1.1  91/06/07  12:19:57  lwall
  1484. + ''' patch4: s2p now handles embedded newlines better and optimizes common idioms
  1485. + ''' 
  1486.   ''' Revision 4.0  91/03/20  01:58:07  lwall
  1487.   ''' 4.0 baseline.
  1488.   ''' 
  1489. ***************
  1490. *** 86,91 ****
  1491. --- 89,96 ----
  1492.   sed script.
  1493.   If you're only interested in speed you'll just have to try it both ways.
  1494.   Of course, if you want to do something sed doesn't do, you have no choice.
  1495. + It's often possible to speed up the perl script by various methods, such
  1496. + as deleting all references to $\e and chop.
  1497.   .SH ENVIRONMENT
  1498.   S2p uses no environment variables.
  1499.   .SH AUTHOR
  1500.  
  1501. Index: hints/sco_2_3_0.sh
  1502. *** hints/sco_2_3_0.sh.old    Fri Jun  7 12:24:35 1991
  1503. --- hints/sco_2_3_0.sh    Fri Jun  7 12:24:36 1991
  1504. ***************
  1505. *** 1,2 ****
  1506. ! yacc='/usr/bin/yacc -m25000'
  1507.   i_dirent=undef
  1508. --- 1,2 ----
  1509. ! yacc='/usr/bin/yacc -Sm25000'
  1510.   i_dirent=undef
  1511.  
  1512. Index: hints/sco_2_3_1.sh
  1513. *** hints/sco_2_3_1.sh.old    Fri Jun  7 12:24:38 1991
  1514. --- hints/sco_2_3_1.sh    Fri Jun  7 12:24:38 1991
  1515. ***************
  1516. *** 1,2 ****
  1517. ! yacc='/usr/bin/yacc -m25000'
  1518.   i_dirent=undef
  1519. --- 1,2 ----
  1520. ! yacc='/usr/bin/yacc -Sm25000'
  1521.   i_dirent=undef
  1522.  
  1523. Index: hints/sco_2_3_2.sh
  1524. *** hints/sco_2_3_2.sh.old    Fri Jun  7 12:24:40 1991
  1525. --- hints/sco_2_3_2.sh    Fri Jun  7 12:24:41 1991
  1526. ***************
  1527. *** 1,2 ****
  1528. ! yacc='/usr/bin/yacc -m25000'
  1529.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1530. --- 1,2 ----
  1531. ! yacc='/usr/bin/yacc -Sm25000'
  1532.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1533.  
  1534. Index: hints/sco_2_3_3.sh
  1535. *** hints/sco_2_3_3.sh.old    Fri Jun  7 12:24:43 1991
  1536. --- hints/sco_2_3_3.sh    Fri Jun  7 12:24:43 1991
  1537. ***************
  1538. *** 1,2 ****
  1539. ! yacc='/usr/bin/yacc -m25000'
  1540.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1541. --- 1,4 ----
  1542. ! yacc='/usr/bin/yacc -Sm25000'
  1543.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1544. + echo "NOTE: you may have problems due to a spurious semicolon on the strerror()"
  1545. + echo "macro definition in /usr/include/string.h.  If so, delete the semicolon."
  1546.  
  1547. Index: hints/sco_3.sh
  1548. *** hints/sco_3.sh.old    Fri Jun  7 12:24:46 1991
  1549. --- hints/sco_3.sh    Fri Jun  7 12:24:46 1991
  1550. ***************
  1551. *** 1,3 ****
  1552. --- 1,4 ----
  1553.   yacc='/usr/bin/yacc -Sm11000'
  1554.   libswanted=`echo $libswanted | sed 's/ x / /'`
  1555.   i_varargs=undef
  1556. + ccflags="$ccflags -U M_XENIX"
  1557.  
  1558. Index: hints/sgi.sh
  1559. *** hints/sgi.sh.old    Fri Jun  7 12:24:48 1991
  1560. --- hints/sgi.sh    Fri Jun  7 12:24:49 1991
  1561. ***************
  1562. *** 1,7 ****
  1563. ! optimize='-O0'
  1564.   usemymalloc='y'
  1565.   mallocsrc='malloc.c'
  1566.   mallocobj='malloc.o'
  1567. - ccflags="$ccflags -Uf_next"
  1568.   d_voidsig=define
  1569.   d_vfork=undef
  1570. --- 1,6 ----
  1571. ! optimize='-O1'
  1572.   usemymalloc='y'
  1573.   mallocsrc='malloc.c'
  1574.   mallocobj='malloc.o'
  1575.   d_voidsig=define
  1576.   d_vfork=undef
  1577.  
  1578. Index: lib/shellwords.pl
  1579. *** lib/shellwords.pl.old    Fri Jun  7 12:25:22 1991
  1580. --- lib/shellwords.pl    Fri Jun  7 12:25:23 1991
  1581. ***************
  1582. *** 0 ****
  1583. --- 1,42 ----
  1584. + #; shellwords.pl
  1585. + #;
  1586. + #; Usage:
  1587. + #;    require 'shellwords.pl';
  1588. + #;    @words = &shellwords($line);
  1589. + #;    or
  1590. + #;    @words = &shellwords(@lines);
  1591. + #;    or
  1592. + #;    @words = &shellwords;        # defaults to $_ (and clobbers it)
  1593. + 
  1594. + sub shellwords {
  1595. +     package shellwords;
  1596. +     local($_) = join('', @_) if @_;
  1597. +     local(@words,$snippet,$field);
  1598. + 
  1599. +     s/^\s+//;
  1600. +     while ($_ ne '') {
  1601. +     $field = '';
  1602. +     for (;;) {
  1603. +         if (s/^"(([^"\\]+|\\[\\"])*)"//) {
  1604. +         ($snippet = $1) =~ s#\\(.)#$1#g;
  1605. +         }
  1606. +         elsif (s/^'(([^'\\]+|\\[\\'])*)'//) {
  1607. +         ($snippet = $1) =~ s#\\(.)#$1#g;
  1608. +         }
  1609. +         elsif (s/^\\(.)//) {
  1610. +         $snippet = $1;
  1611. +         }
  1612. +         elsif (s/^([^\s\\'"]+)//) {
  1613. +         $snippet = $1;
  1614. +         }
  1615. +         else {
  1616. +         s/^\s+//;
  1617. +         last;
  1618. +         }
  1619. +         $field .= $snippet;
  1620. +     }
  1621. +     push(@words, $field);
  1622. +     }
  1623. +     @words;
  1624. + }
  1625. + 1;
  1626.  
  1627. Index: spat.h
  1628. Prereq: 4.0
  1629. *** spat.h.old    Fri Jun  7 12:26:43 1991
  1630. --- spat.h    Fri Jun  7 12:26:44 1991
  1631. ***************
  1632. *** 1,11 ****
  1633. ! /* $Header: spat.h,v 4.0 91/03/20 01:39:36 lwall Locked $
  1634.    *
  1635. !  *    Copyright (c) 1989, Larry Wall
  1636.    *
  1637. !  *    You may distribute under the terms of the GNU General Public License
  1638. !  *    as specified in the README file that comes with the perl 3.0 kit.
  1639.    *
  1640.    * $Log:    spat.h,v $
  1641.    * Revision 4.0  91/03/20  01:39:36  lwall
  1642.    * 4.0 baseline.
  1643.    * 
  1644. --- 1,15 ----
  1645. ! /* $RCSfile: spat.h,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:51:59 $
  1646.    *
  1647. !  *    Copyright (c) 1991, Larry Wall
  1648.    *
  1649. !  *    You may distribute under the terms of either the GNU General Public
  1650. !  *    License or the Artistic License, as specified in the README file.
  1651.    *
  1652.    * $Log:    spat.h,v $
  1653. +  * Revision 4.0.1.1  91/06/07  11:51:59  lwall
  1654. +  * patch4: new copyright notice
  1655. +  * patch4: added global modifier for pattern matches
  1656. +  * 
  1657.    * Revision 4.0  91/03/20  01:39:36  lwall
  1658.    * 4.0 baseline.
  1659.    * 
  1660. ***************
  1661. *** 17,23 ****
  1662.       ARG        *spat_repl;        /* replacement string for subst */
  1663.       ARG        *spat_runtime;        /* compile pattern at runtime */
  1664.       STR        *spat_short;        /* for a fast bypass of execute() */
  1665. !     bool    spat_flags;
  1666.       char    spat_slen;
  1667.   };
  1668.   
  1669. --- 21,27 ----
  1670.       ARG        *spat_repl;        /* replacement string for subst */
  1671.       ARG        *spat_runtime;        /* compile pattern at runtime */
  1672.       STR        *spat_short;        /* for a fast bypass of execute() */
  1673. !     short    spat_flags;
  1674.       char    spat_slen;
  1675.   };
  1676.   
  1677. ***************
  1678. *** 29,34 ****
  1679. --- 33,39 ----
  1680.   #define SPAT_FOLD 32            /* case insensitivity */
  1681.   #define SPAT_CONST 64            /* subst replacement is constant */
  1682.   #define SPAT_KEEP 128            /* keep 1st runtime pattern forever */
  1683. + #define SPAT_GLOBAL 256            /* pattern had a g modifier */
  1684.   
  1685.   EXT SPAT *curspat;        /* what to do \ interps from */
  1686.   EXT SPAT *lastspat;        /* what to use in place of null pattern */
  1687.  
  1688. Index: stab.c
  1689. *** stab.c.old    Fri Jun  7 12:26:47 1991
  1690. --- stab.c    Fri Jun  7 12:26:47 1991
  1691. ***************
  1692. *** 1,11 ****
  1693. ! /* $RCSfile: stab.c,v $$Revision: 4.0.1.1 $$Date: 91/04/12 09:10:24 $
  1694.    *
  1695. !  *    Copyright (c) 1989, Larry Wall
  1696.    *
  1697. !  *    You may distribute under the terms of the GNU General Public License
  1698. !  *    as specified in the README file that comes with the perl 3.0 kit.
  1699.    *
  1700.    * $Log:    stab.c,v $
  1701.    * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  1702.    * patch1: Configure now differentiates getgroups() type from getgid() type
  1703.    * patch1: you may now use "die" and "caller" in a signal handler
  1704. --- 1,20 ----
  1705. ! /* $RCSfile: stab.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:55:53 $
  1706.    *
  1707. !  *    Copyright (c) 1991, Larry Wall
  1708.    *
  1709. !  *    You may distribute under the terms of either the GNU General Public
  1710. !  *    License or the Artistic License, as specified in the README file.
  1711.    *
  1712.    * $Log:    stab.c,v $
  1713. +  * Revision 4.0.1.2  91/06/07  11:55:53  lwall
  1714. +  * patch4: new copyright notice
  1715. +  * patch4: added $^P variable to control calling of perldb routines
  1716. +  * patch4: added $^F variable to specify maximum system fd, default 2
  1717. +  * patch4: $` was busted inside s///
  1718. +  * patch4: default top-of-form format is now FILEHANDLE_TOP
  1719. +  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  1720. +  * patch4: $^D |= 1024 now does syntax tree dump at run-time
  1721. +  * 
  1722.    * Revision 4.0.1.1  91/04/12  09:10:24  lwall
  1723.    * patch1: Configure now differentiates getgroups() type from getgid() type
  1724.    * patch1: you may now use "die" and "caller" in a signal handler
  1725. ***************
  1726. *** 54,59 ****
  1727. --- 63,71 ----
  1728.       str_numset(stab_val(stab),(double)(debug & 32767));
  1729.   #endif
  1730.       break;
  1731. +     case '\006':        /* ^F */
  1732. +     str_numset(stab_val(stab),(double)maxsysfd);
  1733. +     break;
  1734.       case '\t':            /* ^I */
  1735.       if (inplace)
  1736.           str_set(stab_val(stab), inplace);
  1737. ***************
  1738. *** 60,65 ****
  1739. --- 72,80 ----
  1740.       else
  1741.           str_sset(stab_val(stab),&str_undef);
  1742.       break;
  1743. +     case '\020':        /* ^P */
  1744. +     str_numset(stab_val(stab),(double)perldb);
  1745. +     break;
  1746.       case '\024':        /* ^T */
  1747.       str_numset(stab_val(stab),(double)basetime);
  1748.       break;
  1749. ***************
  1750. *** 93,99 ****
  1751.       case '`':
  1752.       if (curspat) {
  1753.           if (curspat->spat_regexp &&
  1754. !           (s = curspat->spat_regexp->subbase) ) {
  1755.           i = curspat->spat_regexp->startp[0] - s;
  1756.           if (i >= 0)
  1757.               str_nset(stab_val(stab),s,i);
  1758. --- 108,114 ----
  1759.       case '`':
  1760.       if (curspat) {
  1761.           if (curspat->spat_regexp &&
  1762. !           (s = curspat->spat_regexp->subbeg) ) {
  1763.           i = curspat->spat_regexp->startp[0] - s;
  1764.           if (i >= 0)
  1765.               str_nset(stab_val(stab),s,i);
  1766. ***************
  1767. *** 126,135 ****
  1768.       break;
  1769.       case '^':
  1770.       s = stab_io(curoutstab)->top_name;
  1771. !     str_set(stab_val(stab),s);
  1772.       break;
  1773.       case '~':
  1774.       s = stab_io(curoutstab)->fmt_name;
  1775.       str_set(stab_val(stab),s);
  1776.       break;
  1777.   #ifndef lint
  1778. --- 141,157 ----
  1779.       break;
  1780.       case '^':
  1781.       s = stab_io(curoutstab)->top_name;
  1782. !     if (s)
  1783. !         str_set(stab_val(stab),s);
  1784. !     else {
  1785. !         str_set(stab_val(stab),stab_name(curoutstab));
  1786. !         str_cat(stab_val(stab),"_TOP");
  1787. !     }
  1788.       break;
  1789.       case '~':
  1790.       s = stab_io(curoutstab)->fmt_name;
  1791. +     if (!s)
  1792. +         s = stab_name(curoutstab);
  1793.       str_set(stab_val(stab),s);
  1794.       break;
  1795.   #ifndef lint
  1796. ***************
  1797. *** 215,220 ****
  1798. --- 237,312 ----
  1799.       return stab_val(stab);
  1800.   }
  1801.   
  1802. + STRLEN
  1803. + stab_len(str)
  1804. + STR *str;
  1805. + {
  1806. +     STAB *stab = str->str_u.str_stab;
  1807. +     int paren;
  1808. +     int i;
  1809. +     char *s;
  1810. + 
  1811. +     if (str->str_rare)
  1812. +     return stab_val(stab)->str_cur;
  1813. + 
  1814. +     switch (*stab->str_magic->str_ptr) {
  1815. +     case '1': case '2': case '3': case '4':
  1816. +     case '5': case '6': case '7': case '8': case '9': case '&':
  1817. +     if (curspat) {
  1818. +         paren = atoi(stab_name(stab));
  1819. +       getparen:
  1820. +         if (curspat->spat_regexp &&
  1821. +           paren <= curspat->spat_regexp->nparens &&
  1822. +           (s = curspat->spat_regexp->startp[paren]) ) {
  1823. +         i = curspat->spat_regexp->endp[paren] - s;
  1824. +         if (i >= 0)
  1825. +             return i;
  1826. +         else
  1827. +             return 0;
  1828. +         }
  1829. +         else
  1830. +         return 0;
  1831. +     }
  1832. +     break;
  1833. +     case '+':
  1834. +     if (curspat) {
  1835. +         paren = curspat->spat_regexp->lastparen;
  1836. +         goto getparen;
  1837. +     }
  1838. +     break;
  1839. +     case '`':
  1840. +     if (curspat) {
  1841. +         if (curspat->spat_regexp &&
  1842. +           (s = curspat->spat_regexp->subbeg) ) {
  1843. +         i = curspat->spat_regexp->startp[0] - s;
  1844. +         if (i >= 0)
  1845. +             return i;
  1846. +         else
  1847. +             return 0;
  1848. +         }
  1849. +         else
  1850. +         return 0;
  1851. +     }
  1852. +     break;
  1853. +     case '\'':
  1854. +     if (curspat) {
  1855. +         if (curspat->spat_regexp &&
  1856. +           (s = curspat->spat_regexp->endp[0]) ) {
  1857. +         return (STRLEN) (curspat->spat_regexp->subend - s);
  1858. +         }
  1859. +         else
  1860. +         return 0;
  1861. +     }
  1862. +     break;
  1863. +     case ',':
  1864. +     return (STRLEN)ofslen;
  1865. +     case '\\':
  1866. +     return (STRLEN)orslen;
  1867. +     default:
  1868. +     return stab_str(str)->str_cur;
  1869. +     }
  1870. + }
  1871. + 
  1872.   stabset(mstr,str)
  1873.   register STR *mstr;
  1874.   STR *str;
  1875. ***************
  1876. *** 334,341 ****
  1877. --- 426,438 ----
  1878.       case '\004':    /* ^D */
  1879.   #ifdef DEBUGGING
  1880.           debug = (int)(str_gnum(str)) | 32768;
  1881. +         if (debug & 1024)
  1882. +         dump_all();
  1883.   #endif
  1884.           break;
  1885. +     case '\006':    /* ^F */
  1886. +         maxsysfd = (int)str_gnum(str);
  1887. +         break;
  1888.       case '\t':    /* ^I */
  1889.           if (inplace)
  1890.           Safefree(inplace);
  1891. ***************
  1892. *** 344,349 ****
  1893. --- 441,449 ----
  1894.           else
  1895.           inplace = Nullch;
  1896.           break;
  1897. +     case '\020':    /* ^P */
  1898. +         perldb = (int)str_gnum(str);
  1899. +         break;
  1900.       case '\024':    /* ^T */
  1901.           basetime = (long)str_gnum(str);
  1902.           break;
  1903. ***************
  1904. *** 430,441 ****
  1905.           break;
  1906.       case '<':
  1907.           uid = (int)str_gnum(str);
  1908. ! #ifdef HAS_SETREUID
  1909.           if (delaymagic) {
  1910.           delaymagic |= DM_REUID;
  1911.           break;                /* don't do magic till later */
  1912.           }
  1913. ! #endif /* HAS_SETREUID */
  1914.   #ifdef HAS_SETRUID
  1915.           if (setruid((UIDTYPE)uid) < 0)
  1916.           uid = (int)getuid();
  1917. --- 530,541 ----
  1918.           break;
  1919.       case '<':
  1920.           uid = (int)str_gnum(str);
  1921. ! #if defined(HAS_SETREUID) || !defined(HAS_SETRUID)
  1922.           if (delaymagic) {
  1923.           delaymagic |= DM_REUID;
  1924.           break;                /* don't do magic till later */
  1925.           }
  1926. ! #endif /* HAS_SETREUID or not HASSETRUID */
  1927.   #ifdef HAS_SETRUID
  1928.           if (setruid((UIDTYPE)uid) < 0)
  1929.           uid = (int)getuid();
  1930. ***************
  1931. *** 453,464 ****
  1932.           break;
  1933.       case '>':
  1934.           euid = (int)str_gnum(str);
  1935. ! #ifdef HAS_SETREUID
  1936.           if (delaymagic) {
  1937.           delaymagic |= DM_REUID;
  1938.           break;                /* don't do magic till later */
  1939.           }
  1940. ! #endif /* HAS_SETREUID */
  1941.   #ifdef HAS_SETEUID
  1942.           if (seteuid((UIDTYPE)euid) < 0)
  1943.           euid = (int)geteuid();
  1944. --- 553,564 ----
  1945.           break;
  1946.       case '>':
  1947.           euid = (int)str_gnum(str);
  1948. ! #if defined(HAS_SETREUID) || !defined(HAS_SETEUID)
  1949.           if (delaymagic) {
  1950.           delaymagic |= DM_REUID;
  1951.           break;                /* don't do magic till later */
  1952.           }
  1953. ! #endif /* HAS_SETREUID or not HAS_SETEUID */
  1954.   #ifdef HAS_SETEUID
  1955.           if (seteuid((UIDTYPE)euid) < 0)
  1956.           euid = (int)geteuid();
  1957. ***************
  1958. *** 476,487 ****
  1959.           break;
  1960.       case '(':
  1961.           gid = (int)str_gnum(str);
  1962. ! #ifdef HAS_SETREGID
  1963.           if (delaymagic) {
  1964.           delaymagic |= DM_REGID;
  1965.           break;                /* don't do magic till later */
  1966.           }
  1967. ! #endif /* HAS_SETREGID */
  1968.   #ifdef HAS_SETRGID
  1969.           (void)setrgid((GIDTYPE)gid);
  1970.   #else
  1971. --- 576,587 ----
  1972.           break;
  1973.       case '(':
  1974.           gid = (int)str_gnum(str);
  1975. ! #if defined(HAS_SETREGID) || !defined(HAS_SETRGID)
  1976.           if (delaymagic) {
  1977.           delaymagic |= DM_REGID;
  1978.           break;                /* don't do magic till later */
  1979.           }
  1980. ! #endif /* HAS_SETREGID or not HAS_SETRGID */
  1981.   #ifdef HAS_SETRGID
  1982.           (void)setrgid((GIDTYPE)gid);
  1983.   #else
  1984. ***************
  1985. *** 494,505 ****
  1986.           break;
  1987.       case ')':
  1988.           egid = (int)str_gnum(str);
  1989. ! #ifdef HAS_SETREGID
  1990.           if (delaymagic) {
  1991.           delaymagic |= DM_REGID;
  1992.           break;                /* don't do magic till later */
  1993.           }
  1994. ! #endif /* HAS_SETREGID */
  1995.   #ifdef HAS_SETEGID
  1996.           (void)setegid((GIDTYPE)egid);
  1997.   #else
  1998. --- 594,605 ----
  1999.           break;
  2000.       case ')':
  2001.           egid = (int)str_gnum(str);
  2002. ! #if defined(HAS_SETREGID) || !defined(HAS_SETEGID)
  2003.           if (delaymagic) {
  2004.           delaymagic |= DM_REGID;
  2005.           break;                /* don't do magic till later */
  2006.           }
  2007. ! #endif /* HAS_SETREGID or not HAS_SETEGID */
  2008.   #ifdef HAS_SETEGID
  2009.           (void)setegid((GIDTYPE)egid);
  2010.   #else
  2011.  
  2012. *** End of Patch 8 ***
  2013. exit 0 # Just in case...
  2014. -- 
  2015. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  2016. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  2017. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  2018. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  2019.