home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / perl / patches6-10 / patch8 < prev    next >
Encoding:
Text File  |  1988-01-30  |  35.0 KB  |  1,448 lines
  1. Path: bbn.com!bbn!uwmcsd1!ig!agate!pasteur!ames!elroy!devvax!lroot
  2. From: lroot@devvax.JPL.NASA.GOV (The Superuser)
  3. Newsgroups: comp.sources.bugs
  4. Subject: perl 1.0 patch #8
  5. Summary: This is an official patch for perl 1.0.  Please apply it.
  6. Message-ID: <1174@devvax.JPL.NASA.GOV>
  7. Date: 28 Jan 88 19:44:05 GMT
  8. Organization: Jet Propulsion Laboratory, Pasadena, CA
  9. Lines: 1437
  10.  
  11. System: perl version 1.0
  12. Patch #: 8
  13. Priority: ENHANCEMENT
  14. Subject: perl needed an eval operator and a symbolic debugger
  15. From: lwall@jpl-devvax.jpl.nasa.gov (Larry Wall)
  16.  
  17. Description:
  18.     I didn't add an eval operator to the original perl because
  19.     I hadn't thought of any good uses for it.  Recently I thought
  20.     of some.  Along with creating the eval operator, this patch
  21.     introduces a symbolic debugger for perl scripts, which makes
  22.     use of eval to interpret some debugging commands.  Having eval
  23.     also lets me emulate awk's FOO=bar command line behavior with
  24.     a line such as the one a2p now inserts at the beginning of
  25.     translated scripts.
  26.  
  27. Fix:    From rn, say "| patch -p0 -d DIR", where DIR is your perl source
  28.                   ^^^
  29.     directory.  Outside of rn, say "cd DIR; patch -p0 <thisarticle".
  30.     If you don't have the patch program, apply the following by hand,
  31.     or get patch.
  32.  
  33. >>>>    YOU MUST USE THE -p0 SWITCH ABOVE OR PATCH WON'T WORK RIGHT.   <<<<
  34.  
  35.     If patch indicates that patchlevel is the wrong version, you may need
  36.     to apply one or more previous patches, or the patch may already
  37.     have been applied.  See the patchlevel.h file to find out what has or
  38.     has not been applied.  In any event, don't continue with the patch.
  39.  
  40.     If you are missing previous patches they can be obtained from me:
  41.  
  42.     Larry Wall
  43.     lwall@jpl-devvax.jpl.nasa.gov
  44.  
  45.     If you send a mail message of the following form it will greatly speed
  46.     processing:
  47.  
  48.     Subject: Command
  49.     @SH mailpatch PATH perl 1.0 LIST
  50.            ^ note the c
  51.  
  52.     where PATH is a return path FROM ME TO YOU in Internet notation, and
  53.     LIST is the number of one or more patches you need, separated by spaces,
  54.     commas, and/or hyphens.  Saying 35- says everything from 35 to the end.
  55.  
  56.     You can also get the patches via anonymous FTP from
  57.     jpl-devvax.jpl.nasa.gov (128.149.8.43).
  58.  
  59. Index: patchlevel.h
  60. Prereq: 7
  61. 1c1
  62. < #define PATCHLEVEL 7
  63. ---
  64. > #define PATCHLEVEL 8
  65.  
  66. Index: Makefile.SH
  67. Prereq: 1.0.1.3
  68. *** Makefile.SH.old    Thu Jan 28 11:08:32 1988
  69. --- Makefile.SH    Thu Jan 28 11:08:33 1988
  70. ***************
  71. *** 14,22 ****
  72.   esac
  73.   echo "Extracting Makefile (with variable substitutions)"
  74.   cat >Makefile <<!GROK!THIS!
  75. ! # $Header: Makefile.SH,v 1.0.1.3 88/01/26 14:14:52 root Exp $
  76.   #
  77.   # $Log:    Makefile.SH,v $
  78.   # Revision 1.0.1.3  88/01/26  14:14:52  root
  79.   # Added mallocsrc stuff.
  80.   # 
  81. --- 14,25 ----
  82.   esac
  83.   echo "Extracting Makefile (with variable substitutions)"
  84.   cat >Makefile <<!GROK!THIS!
  85. ! # $Header: Makefile.SH,v 1.0.1.4 88/01/28 10:17:59 root Exp $
  86.   #
  87.   # $Log:    Makefile.SH,v $
  88. + # Revision 1.0.1.4  88/01/28  10:17:59  root
  89. + # patch8: added perldb.man
  90. + # 
  91.   # Revision 1.0.1.3  88/01/26  14:14:52  root
  92.   # Added mallocsrc stuff.
  93.   # 
  94. ***************
  95. *** 47,57 ****
  96.   
  97.   cat >>Makefile <<'!NO!SUBS!'
  98.   
  99. ! public = perl
  100.   
  101.   private = 
  102.   
  103. ! manpages = perl.man
  104.   
  105.   util =
  106.   
  107. --- 50,60 ----
  108.   
  109.   cat >>Makefile <<'!NO!SUBS!'
  110.   
  111. ! public = perl perldb
  112.   
  113.   private = 
  114.   
  115. ! manpages = perl.man perldb.man
  116.   
  117.   util =
  118.   
  119. If you are sitting there wondering why patch didn't find x2p/a2py.c, perhaps
  120. it is because you didn't say -p0 to patch.  If so, abort patch now and run
  121. it again as you did, but add the following switches: -p0 -N
  122.  
  123. Index: x2p/a2py.c
  124. Prereq: 1.0
  125. *** x2p/a2py.c.old    Thu Jan 28 11:18:17 1988
  126. --- x2p/a2py.c    Thu Jan 28 11:18:18 1988
  127. ***************
  128. *** 1,6 ****
  129. ! /* $Header: a2py.c,v 1.0 87/12/18 17:50:33 root Exp $
  130.    *
  131.    * $Log:    a2py.c,v $
  132.    * Revision 1.0  87/12/18  17:50:33  root
  133.    * Initial revision
  134.    * 
  135. --- 1,9 ----
  136. ! /* $Header: a2py.c,v 1.0.1.1 88/01/28 11:07:08 root Exp $
  137.    *
  138.    * $Log:    a2py.c,v $
  139. +  * Revision 1.0.1.1  88/01/28  11:07:08  root
  140. +  * patch8: added support for FOO=bar switches using eval.
  141. +  * 
  142.    * Revision 1.0  87/12/18  17:50:33  root
  143.    * Initial revision
  144.    * 
  145. ***************
  146. *** 114,119 ****
  147. --- 117,126 ----
  148.   
  149.       tmpstr = walk(0,0,root,&i);
  150.       str = str_make("#!/bin/perl\n\n");
  151. +     str_cat(str,
  152. +       "eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;\n");
  153. +     str_cat(str,
  154. +       "            # process any FOO=bar switches\n\n");
  155.       if (do_opens && opens) {
  156.       str_scat(str,opens);
  157.       str_free(opens);
  158.  
  159. Index: arg.c
  160. Prereq: 1.0.1.3
  161. *** arg.c.old    Thu Jan 28 11:08:43 1988
  162. --- arg.c    Thu Jan 28 11:08:46 1988
  163. ***************
  164. *** 1,8 ****
  165. ! /* $Header: arg.c,v 1.0.1.3 88/01/26 12:30:33 root Exp $
  166.    *
  167.    * $Log:    arg.c,v $
  168. !  * Revision 1.0.1.3  88/01/26  12:30:33  root
  169. !  * patch 6: sprintf didn't finish processing format string when out of args.
  170.    * 
  171.    * Revision 1.0.1.2  88/01/24  03:52:34  root
  172.    * patch 2: added STATBLKS dependencies.
  173. --- 1,8 ----
  174. ! /* $Header: arg.c,v 1.0.1.4 88/01/28 10:22:06 root Exp $
  175.    *
  176.    * $Log:    arg.c,v $
  177. !  * Revision 1.0.1.4  88/01/28  10:22:06  root
  178. !  * patch8: added eval operator.
  179.    * 
  180.    * Revision 1.0.1.2  88/01/24  03:52:34  root
  181.    * patch 2: added STATBLKS dependencies.
  182. ***************
  183. *** 1190,1195 ****
  184. --- 1190,1196 ----
  185.       opargs[O_UNSHIFT] =        A(1,0,0);
  186.       opargs[O_LINK] =        A(1,1,0);
  187.       opargs[O_REPEAT] =        A(1,1,0);
  188. +     opargs[O_EVAL] =        A(1,0,0);
  189.   }
  190.   
  191.   #ifdef VOIDSIG
  192. ***************
  193. *** 2091,2096 ****
  194. --- 2092,2102 ----
  195.           astore(ary,0,str);
  196.       }
  197.       value = (double)(ary->ary_fill + 1);
  198. +     break;
  199. +     case O_EVAL:
  200. +     str_sset(str,
  201. +         do_eval(arg[1].arg_type != A_NULL ? sarg[1] : defstab->stab_val) );
  202. +     STABSET(str);
  203.       break;
  204.       }
  205.   #ifdef DEBUGGING
  206.  
  207. Index: arg.h
  208. Prereq: 1.0
  209. *** arg.h.old    Thu Jan 28 11:08:59 1988
  210. --- arg.h    Thu Jan 28 11:09:00 1988
  211. ***************
  212. *** 1,6 ****
  213. ! /* $Header: arg.h,v 1.0 87/12/18 13:04:39 root Exp $
  214.    *
  215.    * $Log:    arg.h,v $
  216.    * Revision 1.0  87/12/18  13:04:39  root
  217.    * Initial revision
  218.    * 
  219. --- 1,9 ----
  220. ! /* $Header: arg.h,v 1.0.1.1 88/01/28 10:22:40 root Exp $
  221.    *
  222.    * $Log:    arg.h,v $
  223. +  * Revision 1.0.1.1  88/01/28  10:22:40  root
  224. +  * patch8: added eval operator.
  225. +  * 
  226.    * Revision 1.0  87/12/18  13:04:39  root
  227.    * Initial revision
  228.    * 
  229. ***************
  230. *** 111,117 ****
  231.   #define O_UNSHIFT 102
  232.   #define O_LINK 103
  233.   #define O_REPEAT 104
  234. ! #define MAXO 105
  235.   
  236.   #ifndef DOINIT
  237.   extern char *opname[];
  238. --- 114,121 ----
  239.   #define O_UNSHIFT 102
  240.   #define O_LINK 103
  241.   #define O_REPEAT 104
  242. ! #define O_EVAL 105
  243. ! #define MAXO 106
  244.   
  245.   #ifndef DOINIT
  246.   extern char *opname[];
  247. ***************
  248. *** 222,228 ****
  249.       "UNSHIFT",
  250.       "LINK",
  251.       "REPEAT",
  252. !     "105"
  253.   };
  254.   #endif
  255.   
  256. --- 226,233 ----
  257.       "UNSHIFT",
  258.       "LINK",
  259.       "REPEAT",
  260. !     "EVAL",
  261. !     "106"
  262.   };
  263.   #endif
  264.   
  265.  
  266. Index: t/base.lex
  267. Prereq: 1.0
  268. *** t/base.lex.old    Thu Jan 28 11:17:55 1988
  269. --- t/base.lex    Thu Jan 28 11:17:56 1988
  270. ***************
  271. *** 1,8 ****
  272.   #!./perl
  273.   
  274. ! # $Header: base.lex,v 1.0 87/12/18 13:11:51 root Exp $
  275.   
  276. ! print "1..4\n";
  277.   
  278.   $ # this is the register <space>
  279.   = 'x';
  280. --- 1,8 ----
  281.   #!./perl
  282.   
  283. ! # $Header: base.lex,v 1.0.1.1 88/01/28 10:37:00 root Exp $
  284.   
  285. ! print "1..6\n";
  286.   
  287.   $ # this is the register <space>
  288.   = 'x';
  289. ***************
  290. *** 21,23 ****
  291. --- 21,32 ----
  292.   $x = '\\'; # ';
  293.   
  294.   if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
  295. + 
  296. + eval 'while (0) {
  297. +     print "foo\n";
  298. + }
  299. + /^/ && (print "ok 5\n");
  300. + ';
  301. + 
  302. + eval '$foo{1} / 1;';
  303. + if (!$@) {print "ok 6\n";} else {print "not ok 6\n";}
  304.  
  305. Index: cmd.h
  306. Prereq: 1.0
  307. *** cmd.h.old    Thu Jan 28 11:09:05 1988
  308. --- cmd.h    Thu Jan 28 11:09:06 1988
  309. ***************
  310. *** 1,6 ****
  311. ! /* $Header: cmd.h,v 1.0 87/12/18 13:04:59 root Exp $
  312.    *
  313.    * $Log:    cmd.h,v $
  314.    * Revision 1.0  87/12/18  13:04:59  root
  315.    * Initial revision
  316.    * 
  317. --- 1,9 ----
  318. ! /* $Header: cmd.h,v 1.0.1.1 88/01/28 10:23:07 root Exp $
  319.    *
  320.    * $Log:    cmd.h,v $
  321. +  * Revision 1.0.1.1  88/01/28  10:23:07  root
  322. +  * patch8: added eval_root for eval operator.
  323. +  * 
  324.    * Revision 1.0  87/12/18  13:04:59  root
  325.    * Initial revision
  326.    * 
  327. ***************
  328. *** 106,111 ****
  329. --- 109,115 ----
  330.   #define Nullcmd Null(CMD*)
  331.   
  332.   EXT CMD *main_root INIT(Nullcmd);
  333. + EXT CMD *eval_root INIT(Nullcmd);
  334.   
  335.   EXT struct compcmd {
  336.       CMD *comp_true;
  337.  
  338. Index: t/op.eval
  339. *** t/op.eval.old    Thu Jan 28 11:18:04 1988
  340. --- t/op.eval    Thu Jan 28 11:18:04 1988
  341. ***************
  342. *** 0 ****
  343. --- 1,20 ----
  344. + #!./perl
  345. + 
  346. + print "1..6\n";
  347. + 
  348. + eval 'print "ok 1\n";';
  349. + 
  350. + if ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";}
  351. + 
  352. + eval "\$foo\n    = # this is a comment\n'ok 3';";
  353. + print $foo,"\n";
  354. + 
  355. + eval "\$foo\n    = # this is a comment\n'ok 4\n';";
  356. + print $foo;
  357. + 
  358. + eval '
  359. + $foo =';        # this tests for a call through yyerror()
  360. + if ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
  361. + 
  362. + eval '$foo = /';    # this tests for a call through fatal()
  363. + if ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
  364.  
  365. Index: perl.h
  366. Prereq: 1.0.1.2
  367. *** perl.h.old    Thu Jan 28 11:09:13 1988
  368. --- perl.h    Thu Jan 28 11:09:14 1988
  369. ***************
  370. *** 1,6 ****
  371. ! /* $Header: perl.h,v 1.0.1.2 88/01/24 03:53:47 root Exp $
  372.    *
  373.    * $Log:    perl.h,v $
  374.    * Revision 1.0.1.2  88/01/24  03:53:47  root
  375.    * patch 2: hid str_peek() in #ifdef DEBUGGING.
  376.    * 
  377. --- 1,9 ----
  378. ! /* $Header: perl.h,v 1.0.1.3 88/01/28 10:24:17 root Exp $
  379.    *
  380.    * $Log:    perl.h,v $
  381. +  * Revision 1.0.1.3  88/01/28  10:24:17  root
  382. +  * patch8: added eval operator.
  383. +  * 
  384.    * Revision 1.0.1.2  88/01/24  03:53:47  root
  385.    * patch 2: hid str_peek() in #ifdef DEBUGGING.
  386.    * 
  387. ***************
  388. *** 103,109 ****
  389.   STR *arg_to_str();
  390.   STR *str_new();
  391.   STR *stab_str();
  392. ! STR *eval();
  393.   
  394.   FCMD *load_format();
  395.   
  396. --- 106,113 ----
  397.   STR *arg_to_str();
  398.   STR *str_new();
  399.   STR *stab_str();
  400. ! STR *eval();        /* this evaluates expressions */
  401. ! STR *do_eval();        /* this evaluates eval operator */
  402.   
  403.   FCMD *load_format();
  404.   
  405. ***************
  406. *** 164,169 ****
  407. --- 168,174 ----
  408.   EXT char tokenbuf[256];
  409.   EXT int expectterm INIT(TRUE);
  410.   EXT int lex_newlines INIT(FALSE);
  411. + EXT int in_eval INIT(FALSE);
  412.   
  413.   FILE *popen();
  414.   /* char *str_get(); */
  415. ***************
  416. *** 196,201 ****
  417. --- 201,207 ----
  418.   EXT int loop_ptr INIT(-1);
  419.   
  420.   EXT jmp_buf top_env;
  421. + EXT jmp_buf eval_env;
  422.   
  423.   EXT char *goto_targ INIT(Nullch);    /* cmd_exec gets strange when set */
  424.   
  425.  
  426. Index: perl.y
  427. Prereq: 1.0
  428. *** perl.y.old    Thu Jan 28 11:09:22 1988
  429. --- perl.y    Thu Jan 28 11:09:24 1988
  430. ***************
  431. *** 1,6 ****
  432. ! /* $Header: perl.y,v 1.0 87/12/18 15:48:59 root Exp $
  433.    *
  434.    * $Log:    perl.y,v $
  435.    * Revision 1.0  87/12/18  15:48:59  root
  436.    * Initial revision
  437.    * 
  438. --- 1,9 ----
  439. ! /* $Header: perl.y,v 1.0.1.1 88/01/28 10:25:31 root Exp $
  440.    *
  441.    * $Log:    perl.y,v $
  442. +  * Revision 1.0.1.1  88/01/28  10:25:31  root
  443. +  * patch8: added eval operator.
  444. +  * 
  445.    * Revision 1.0  87/12/18  15:48:59  root
  446.    * Initial revision
  447.    * 
  448. ***************
  449. *** 97,103 ****
  450.   %% /* RULES */
  451.   
  452.   prog    :    lineseq
  453. !             { main_root = block_head($1); }
  454.       ;
  455.   
  456.   compblock:    block CONTINUE block
  457. --- 100,109 ----
  458.   %% /* RULES */
  459.   
  460.   prog    :    lineseq
  461. !             { if (in_eval)
  462. !                 eval_root = block_head($1);
  463. !                 else
  464. !                 main_root = block_head($1); }
  465.       ;
  466.   
  467.   compblock:    block CONTINUE block
  468.  
  469. Index: perldb
  470. *** perldb.old    Thu Jan 28 11:17:03 1988
  471. --- perldb    Thu Jan 28 11:17:04 1988
  472. ***************
  473. *** 0 ****
  474. --- 1,296 ----
  475. + #!/bin/perl
  476. + 
  477. + # $Header: perldb,v 1.0.1.1 88/01/28 10:27:16 root Exp $
  478. + #
  479. + # $Log:    perldb,v $
  480. + # Revision 1.0.1.1  88/01/28  10:27:16  root
  481. + # patch8: created this file.
  482. + # 
  483. + #
  484. + 
  485. + $tmp = "/tmp/pdb$$";        # default temporary file, -o overrides.
  486. + 
  487. + # parse any switches
  488. + 
  489. + while ($ARGV[0] =~ /^-/) {
  490. +     $_ = shift;
  491. +     /^-o$/ && ($tmp = shift,next);
  492. +     die "Unrecognized switch: $_";
  493. + }
  494. + 
  495. + $filename = shift;
  496. + die "Usage: perldb [-o output] scriptname arguments" unless $filename;
  497. + 
  498. + open(script,$filename) || die "Can't find $filename";
  499. + 
  500. + open(tmp, ">$tmp") || die "Can't make temp script";
  501. + 
  502. + $perl = '/bin/perl';
  503. + $init = 1;
  504. + $state = 'statement';
  505. + 
  506. + # now translate script to contain DB calls at the appropriate places
  507. + 
  508. + while (<script>) {
  509. +     chop;
  510. +     if ($. == 1) {
  511. +     if (/^#! *([^ \t]*) (-[^ \t]*)/) {
  512. +         $perl = $1;
  513. +         $switch = $2;
  514. +     }
  515. +     elsif (/^#! *([^ \t]*)/) {
  516. +         $perl = $1;
  517. +     }
  518. +     }
  519. +     s/ *$//;
  520. +     push(@script,$_);        # remember line for DBinit
  521. +     $line = $_;
  522. +     next if /^$/;        # blank lines are uninteresting
  523. +     next if /^[ \t]*#/;        # likewise comment lines
  524. +     if ($init) {
  525. +     print tmp "do DBinit($.);"; $init = '';
  526. +     }
  527. +     if ($inform) {        # skip formats
  528. +     if (/^\.$/) {
  529. +         $inform = '';
  530. +         $state = 'statement';
  531. +     }
  532. +     next;
  533. +     }
  534. +     if (/^[ \t]*format /) {
  535. +     $inform++;
  536. +     next;
  537. +     }
  538. +     if ($state eq 'statement' && !/^[ \t]*}/) {
  539. +     if (s/^([ \t]*[A-Za-z_0-9]+:)//) {
  540. +         $label = $1;
  541. +     }
  542. +     else {
  543. +         $label = '';
  544. +     }
  545. +     $line = $label . "do DB($.); " . $_;    # all that work for this line
  546. +     }
  547. +     else {
  548. +     $script[$#script - 1] .= ' ';    # mark line as having continuation
  549. +     }
  550. +     do parse();                # set $state to correct eol value
  551. + }
  552. + continue {
  553. +     print tmp $line,"\n";
  554. + }
  555. + 
  556. + # now put out our debugging subroutines.  First the one that's called all over.
  557. + 
  558. + print tmp '
  559. + sub DB {
  560. +     push(@DB,$. ,$@, $!, $[, $,, $/, $\ );
  561. +     $[ = 0; $, = ""; $/ = "\n"; $\ = "";
  562. +     $DBline=pop(@_);
  563. +     if ($DBsingle || $DBstop[$DBline] || $DBtrace) {
  564. +     print "$DBline:\t",$DBline[$DBline],"\n";
  565. +     for ($DBi = $DBline; $DBline[$DBi++] =~ / $/; ) {
  566. +         print "$DBi:\t",$DBline[$DBi],"\n";
  567. +     }
  568. +     }
  569. +     if ($DBaction[$DBline]) {
  570. +     eval $DBaction[$DBline];  print $@;
  571. +     }
  572. +     if ($DBstop[$DBline] || $DBsingle) {
  573. +     for (;;) {
  574. +         print "perldb> ";
  575. +         $DBcmd = <stdin>;
  576. +         last if $DBcmd =~ /^$/;
  577. +         if ($DBcmd =~ /^q$/) {
  578. +         exit 0;
  579. +         }
  580. +         if ($DBcmd =~ /^h$/) {
  581. +         print "
  582. + s        Single step.
  583. + c        Continue.
  584. + <CR>        Repeat last s or c.
  585. + l min-max    List lines.
  586. + l line        List line.
  587. + l        List the whole program.
  588. + L        List breakpoints.
  589. + t        Toggle trace mode.
  590. + b line        Set breakpoint.
  591. + d line        Delete breakpoint.
  592. + d        Delete breakpoint at this line.
  593. + a line command    Set an action for this line.
  594. + q        Quit.
  595. + command        Execute as a perl statement.
  596. + 
  597. + ";
  598. +         next;
  599. +         }
  600. +         if ($DBcmd =~ /^t$/) {
  601. +         $DBtrace = !$DBtrace;
  602. +         print "Trace = $DBtrace\n";
  603. +         next;
  604. +         }
  605. +         if ($DBcmd =~ /^l (.*)[-,](.*)/) {
  606. +         for ($DBi = $1; $DBi <= $2; $DBi++) {
  607. +             print "$DBi:\t", $DBline[$DBi], "\n";
  608. +         }
  609. +         next;
  610. +         }
  611. +         if ($DBcmd =~ /^l (.*)/) {
  612. +         print "$1:\t", $DBline[$1], "\n";
  613. +         next;
  614. +         }
  615. +         if ($DBcmd =~ /^l$/) {
  616. +         for ($DBi = 1; $DBi <= $DBmax ; $DBi++) {
  617. +             print "$DBi:\t", $DBline[$DBi], "\n";
  618. +         }
  619. +         next;
  620. +         }
  621. +         if ($DBcmd =~ /^L$/) {
  622. +         for ($DBi = 1; $DBi <= $DBmax ; $DBi++) {
  623. +             print "$DBi:\t", $DBline[$DBi], "\n" if $DBstop[$DBi];
  624. +         }
  625. +         next;
  626. +         }
  627. +         if ($DBcmd =~ /^b (.*)/) {
  628. +         $DBi = $1;
  629. +         if ($DBline[$DBi-1] =~ / $/) {
  630. +             print "Line $DBi not breakable.\n";
  631. +         }
  632. +         else {
  633. +             $DBstop[$DBi] = 1;
  634. +         }
  635. +         next;
  636. +         }
  637. +         if ($DBcmd =~ /^d (.*)/) {
  638. +         $DBstop[$1] = 0;
  639. +         next;
  640. +         }
  641. +         if ($DBcmd =~ /^d$/) {
  642. +         $DBstop[$DBline] = 0;
  643. +         next;
  644. +         }
  645. +         if ($DBcmd =~ /^a ([0-9]+)[ \t]+(.*)/) {
  646. +         $DBi = $1;
  647. +         $DBaction = $2;
  648. +         $DBaction .= ";" unless $DBaction =~ /[;}]$/;
  649. +         $DBaction[$DBi] = $DBaction;
  650. +         next;
  651. +         }
  652. +         if ($DBcmd =~ /^s$/) {
  653. +         $DBsingle = 1;
  654. +         last;
  655. +         }
  656. +         if ($DBcmd =~ /^c$/) {
  657. +         $DBsingle = 0;
  658. +         last;
  659. +         }
  660. +         chop($DBcmd);
  661. +         $DBcmd .= ";" unless $DBcmd =~ /[;}]$/;
  662. +         eval $DBcmd;
  663. +         print $@,"\n";
  664. +     }
  665. +     }
  666. +     $\ = pop(@DB);
  667. +     $/ = pop(@DB);
  668. +     $, = pop(@DB);
  669. +     $[ = pop(@DB);
  670. +     $! = pop(@DB);
  671. +     $@ = pop(@DB);
  672. +     $. = pop(@DB);
  673. + }
  674. + 
  675. + sub DBinit {
  676. +     $DBstop[$_[0]] = 1;
  677. + ';
  678. + print tmp "    \$0 = '$script';\n";
  679. + print tmp "    \$DBmax = $.;\n";
  680. + print tmp "    unlink '/tmp/pdb$$';\n";        # expected to fail on -o.
  681. + for ($i = 1; $#script >= 0; $i++) {
  682. +     $_ = shift(@script);
  683. +     s/'/\\'/g;
  684. +     print tmp "    \$DBline[$i] = '$_';\n";
  685. + }
  686. + print tmp '}
  687. + ';
  688. + 
  689. + close tmp;
  690. + 
  691. + # prepare to run the new script
  692. + 
  693. + unshift(@ARGV,$tmp);
  694. + unshift(@ARGV,$switch) if $switch;
  695. + unshift(@ARGV,$perl);
  696. + exec @ARGV;
  697. + 
  698. + # This routine tokenizes one perl line good enough to tell what state we are
  699. + # in by the end of the line, so we can tell if the next line should contain
  700. + # a call to DB or not.
  701. + 
  702. + sub parse {
  703. +     until ($_ eq '') {
  704. +     $ord = ord($_);
  705. +     if ($quoting) {
  706. +         if ($quote == $ord) {
  707. +         $quoting--;
  708. +         }
  709. +         s/^.//            if /^[\\]/;
  710. +         s/^.//;
  711. +         last if $_ eq "\n";
  712. +         $state = 'term'        unless $quoting;
  713. +         next;
  714. +     }
  715. +     if ($ord > 64) {
  716. +         do quote(ord($1),1), next    if s/^m\b(.)//;
  717. +         do quote(ord($1),2), next    if s/^s\b(.)//;
  718. +         do quote(ord($1),2), next    if s/^y\b(.)//;
  719. +         do quote(ord($1),2), next    if s/^tr\b(.)//;
  720. +         next            if s/^[A-Za-z_][A-Za-z_0-9]*://;
  721. +         $state = 'term', next    if s/^eof\b//;
  722. +         $state = 'term', next    if s/^shift\b//;
  723. +         $state = 'term', next    if s/^split\b//;
  724. +         $state = 'term', next    if s/^tell\b//;
  725. +         $state = 'term', next    if s/^write\b//;
  726. +         $state = 'operator', next    if s/^[A-Za-z_][A-Za-z_0-9]*//;
  727. +         $state = 'operator', next    if s/^[~^|]+//;
  728. +         $state = 'statement', next    if s/^{//;
  729. +         $state = 'statement', next    if s/^}[ \t]*$//;
  730. +         $state = 'statement', next    if s/^}[ \t]*#/#/;
  731. +         $state = 'term', next    if s/^}//;
  732. +         $state = 'operator', next    if s/^\[//;
  733. +         $state = 'term', next    if s/^]//;
  734. +         die "Illegal character $_";
  735. +     }
  736. +     elsif ($ord < 33) {
  737. +         next if s/[ \t\n]+//;
  738. +         die "Illegal character $_";
  739. +     }
  740. +     else {
  741. +         $state = 'statement', next    if s/^;//;
  742. +         $state = 'term', next    if s/^\.[0-9eE]+//;
  743. +         $state = 'term', next    if s/^[0-9][0-9xaAbBcCddeEfF.]*//;
  744. +         $state = 'term', next    if s/^\$[A-Za-z_][A-Za-z_0-9]*//;
  745. +         $state = 'term', next    if s/^\$.//;
  746. +         $state = 'term', next    if s/^@[A-Za-z_][A-Za-z_0-9]*//;
  747. +         $state = 'term', next    if s/^@.//;
  748. +         $state = 'term', next    if s/^<[A-Za-z_0-9]*>//;
  749. +         next            if s/^\+\+//;
  750. +         next            if s/^--//;
  751. +         $state = 'operator', next    if s/^[(!%&*-=+:,.<>]//;
  752. +         $state = 'term', next    if s/^\)+//;
  753. +         do quote($ord,1), next    if s/^'//;
  754. +         do quote($ord,1), next    if s/^"//;
  755. +         if (s|^[/?]||) {
  756. +         if ($state =~ /stat|oper/) {
  757. +             $state = 'term';
  758. +             do quote($ord,1), next;
  759. +         }
  760. +         $state = 'operator', next;
  761. +         }
  762. +         next            if s/^#.*//;
  763. +     }
  764. +     }
  765. + }
  766. + 
  767. + sub quote {
  768. +     ($quote,$quoting) = @_;
  769. +     $state = 'quote';
  770. + }
  771.  
  772. Index: perldb.man
  773. *** perldb.man.old    Thu Jan 28 11:17:11 1988
  774. --- perldb.man    Thu Jan 28 11:17:12 1988
  775. ***************
  776. *** 0 ****
  777. --- 1,119 ----
  778. + .rn '' }`
  779. + ''' $Header: perldb.man,v 1.0.1.1 88/01/28 10:28:19 root Exp $
  780. + ''' 
  781. + ''' $Log:    perldb.man,v $
  782. + ''' Revision 1.0.1.1  88/01/28  10:28:19  root
  783. + ''' patch8: created this file.
  784. + ''' 
  785. + ''' 
  786. + .de Sh
  787. + .br
  788. + .ne 5
  789. + .PP
  790. + \fB\\$1\fR
  791. + .PP
  792. + ..
  793. + .de Sp
  794. + .if t .sp .5v
  795. + .if n .sp
  796. + ..
  797. + .de Ip
  798. + .br
  799. + .ie \\n.$>=3 .ne \\$3
  800. + .el .ne 3
  801. + .IP "\\$1" \\$2
  802. + ..
  803. + '''
  804. + '''     Set up \*(-- to give an unbreakable dash;
  805. + '''     string Tr holds user defined translation string.
  806. + '''     Bell System Logo is used as a dummy character.
  807. + '''
  808. + .tr \(bs-|\(bv\*(Tr
  809. + .ie n \{\
  810. + .ds -- \(bs-
  811. + .if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch
  812. + .if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch
  813. + .ds L" ""
  814. + .ds R" ""
  815. + .ds L' '
  816. + .ds R' '
  817. + 'br\}
  818. + .el\{\
  819. + .ds -- \(em\|
  820. + .tr \*(Tr
  821. + .ds L" ``
  822. + .ds R" ''
  823. + .ds L' `
  824. + .ds R' '
  825. + 'br\}
  826. + .TH PERLDB 1 LOCAL
  827. + .SH NAME
  828. + perldb - Perl Debugger
  829. + .SH SYNOPSIS
  830. + .B perldb [-o output] perlscript arguments
  831. + .SH DESCRIPTION
  832. + .I Perldb
  833. + is a symbolic debugger for
  834. + .I perl
  835. + scripts.
  836. + Run your script just as you normally would, only prepend \*(L"perldb\*(R" to
  837. + the command.
  838. + (On systems where #! doesn't work, put any perl switches into the #! line
  839. + anyway\*(--perldb will pass them off to perl when it runs the script.)
  840. + Perldb copies your script to a temporary file, instrumenting it in the process
  841. + and adding a debugging monitor.
  842. + It then executes the instrumented script for
  843. + you and stops at the first statement so you can set any breakpoints or actions
  844. + you desire.
  845. + .PP
  846. + There is only one switch: \-o, which tells perldb to put its temporary file
  847. + in the filename you specify, and to refrain from deleting the file.
  848. + Use this switch if you intend to rerun the instrumented script, or want to
  849. + look at it for some reason.
  850. + .PP
  851. + These are the debugging commands:
  852. + .Ip s 8
  853. + Single step.
  854. + Subsequent carriage returns will single step.
  855. + .Ip c 8
  856. + Continue.
  857. + Turns off single step mode and runs till the next break point.
  858. + Subsequent carriage returns will continue.
  859. + .Ip <CR> 8
  860. + Repeat last s or c.
  861. + .Ip "l min-max" 8
  862. + List lines in the indicated range.
  863. + .Ip "l line" 8
  864. + List indicated line.
  865. + .Ip l 8
  866. + List the whole program.
  867. + .Ip L 8
  868. + List breakpoints.
  869. + .Ip t 8
  870. + Toggle trace mode.
  871. + .Ip "b line" 8
  872. + Set breakpoint at indicated line.
  873. + .Ip "d line" 8
  874. + Delete breakpoint at indicated line.
  875. + .Ip d 8
  876. + Delete breakpoint at this line.
  877. + .Ip "a line command" 8
  878. + Set an action for indicated line.
  879. + The command must be a valid perl command, except that a missing trailing ;
  880. + will be supplied.
  881. + .Ip q 8
  882. + Quit.
  883. + .Ip command 8
  884. + Execute command as a perl statement.
  885. + A missing trailing ; will be supplied if necessary.
  886. + .SH ENVIRONMENT
  887. + No environment variables are used by perldb.
  888. + .SH AUTHOR
  889. + Larry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
  890. + .SH FILES
  891. + /tmp/pdb$$    temporary file for instrumented script
  892. + .SH SEE ALSO
  893. + perl    
  894. + .SH DIAGNOSTICS
  895. + .SH BUGS
  896. + .rn }` ''
  897.  
  898. Index: perly.c
  899. Prereq: 1.0.1.2
  900. *** perly.c.old    Thu Jan 28 11:17:22 1988
  901. --- perly.c    Thu Jan 28 11:17:25 1988
  902. ***************
  903. *** 1,6 ****
  904. ! char rcsid[] = "$Header: perly.c,v 1.0.1.2 88/01/24 00:06:03 root Exp $";
  905.   /*
  906.    * $Log:    perly.c,v $
  907.    * Revision 1.0.1.2  88/01/24  00:06:03  root
  908.    * patch 2: s/(abc)/\1/ grandfathering didn't work right.
  909.    * 
  910. --- 1,9 ----
  911. ! char rcsid[] = "$Header: perly.c,v 1.0.1.3 88/01/28 10:28:31 root Exp $";
  912.   /*
  913.    * $Log:    perly.c,v $
  914. +  * Revision 1.0.1.3  88/01/28  10:28:31  root
  915. +  * patch8: added eval operator.  Also fixed expectterm following right curly.
  916. +  * 
  917.    * Revision 1.0.1.2  88/01/24  00:06:03  root
  918.    * patch 2: s/(abc)/\1/ grandfathering didn't work right.
  919.    * 
  920. ***************
  921. *** 16,21 ****
  922. --- 19,25 ----
  923.   bool assume_n = FALSE;
  924.   bool assume_p = FALSE;
  925.   bool doswitches = FALSE;
  926. + bool allstabs = FALSE;        /* init all customary symbols in symbol table?*/
  927.   char *filename;
  928.   char *e_tmpname = "/tmp/perl-eXXXXXX";
  929.   FILE *e_fp = Nullfp;
  930. ***************
  931. *** 161,172 ****
  932.           str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
  933.       }
  934.       }
  935. !     if (argvstab = stabent("ARGV",FALSE)) {
  936.       for (; argc > 0; argc--,argv++) {
  937.           apush(argvstab->stab_array,str_make(argv[0]));
  938.       }
  939.       }
  940. !     if (envstab = stabent("ENV",FALSE)) {
  941.       for (; *env; env++) {
  942.           if (!(s = index(*env,'=')))
  943.           continue;
  944. --- 165,176 ----
  945.           str_numset(stabent(argv[0]+1,TRUE)->stab_val,(double)1.0);
  946.       }
  947.       }
  948. !     if (argvstab = stabent("ARGV",allstabs)) {
  949.       for (; argc > 0; argc--,argv++) {
  950.           apush(argvstab->stab_array,str_make(argv[0]));
  951.       }
  952.       }
  953. !     if (envstab = stabent("ENV",allstabs)) {
  954.       for (; *env; env++) {
  955.           if (!(s = index(*env,'=')))
  956.           continue;
  957. ***************
  958. *** 177,188 ****
  959.           *--s = '=';
  960.       }
  961.       }
  962. !     sigstab = stabent("SIG",FALSE);
  963.   
  964.       magicalize("!#?^~=-%0123456789.+&*(),\\/[|");
  965.   
  966. !     (tmpstab = stabent("0",FALSE)) && str_set(STAB_STR(tmpstab),filename);
  967. !     (tmpstab = stabent("$",FALSE)) &&
  968.       str_numset(STAB_STR(tmpstab),(double)getpid());
  969.   
  970.       tmpstab = stabent("stdin",TRUE);
  971. --- 181,192 ----
  972.           *--s = '=';
  973.       }
  974.       }
  975. !     sigstab = stabent("SIG",allstabs);
  976.   
  977.       magicalize("!#?^~=-%0123456789.+&*(),\\/[|");
  978.   
  979. !     (tmpstab = stabent("0",allstabs)) && str_set(STAB_STR(tmpstab),filename);
  980. !     (tmpstab = stabent("$",allstabs)) &&
  981.       str_numset(STAB_STR(tmpstab),(double)getpid());
  982.   
  983.       tmpstab = stabent("stdin",TRUE);
  984. ***************
  985. *** 198,203 ****
  986. --- 202,209 ----
  987.       tmpstab = stabent("stderr",TRUE);
  988.       tmpstab->stab_io = stio_new();
  989.       tmpstab->stab_io->fp = stderr;
  990. +     safefree(filename);
  991. +     filename = "(eval)";
  992.   
  993.       setjmp(top_env);    /* sets goto_targ on longjump */
  994.   
  995. ***************
  996. *** 225,231 ****
  997.   
  998.       sym[1] = '\0';
  999.       while (*sym = *list++) {
  1000. !     if (stab = stabent(sym,FALSE)) {
  1001.           stab->stab_flags = SF_VMAGIC;
  1002.           stab->stab_val->str_link.str_magic = stab;
  1003.       }
  1004. --- 231,237 ----
  1005.   
  1006.       sym[1] = '\0';
  1007.       while (*sym = *list++) {
  1008. !     if (stab = stabent(sym,allstabs)) {
  1009.           stab->stab_flags = SF_VMAGIC;
  1010.           stab->stab_val->str_link.str_magic = stab;
  1011.       }
  1012. ***************
  1013. *** 322,328 ****
  1014.           filename = savestr(s);
  1015.           s = str_get(linestr);
  1016.       }
  1017. !     *s = '\0';
  1018.       if (lex_newlines)
  1019.           RETURN('\n');
  1020.       goto retry;
  1021. --- 328,342 ----
  1022.           filename = savestr(s);
  1023.           s = str_get(linestr);
  1024.       }
  1025. !     if (in_eval) {
  1026. !         while (*s && *s != '\n')
  1027. !         s++;
  1028. !         if (*s)
  1029. !         s++;
  1030. !         line++;
  1031. !     }
  1032. !     else
  1033. !         *s = '\0';
  1034.       if (lex_newlines)
  1035.           RETURN('\n');
  1036.       goto retry;
  1037. ***************
  1038. *** 350,358 ****
  1039.       OPERATOR(tmp);
  1040.       case ')':
  1041.       case ']':
  1042. -     case '}':
  1043.       tmp = *s++;
  1044.       TERM(tmp);
  1045.       case '&':
  1046.       s++;
  1047.       tmp = *s++;
  1048. --- 364,378 ----
  1049.       OPERATOR(tmp);
  1050.       case ')':
  1051.       case ']':
  1052.       tmp = *s++;
  1053.       TERM(tmp);
  1054. +     case '}':
  1055. +     tmp = *s++;
  1056. +     for (d = s; *d == ' ' || *d == '\t'; d++) ;
  1057. +     if (*d == '\n' || *d == '#')
  1058. +         OPERATOR(tmp);        /* block end */
  1059. +     else
  1060. +         TERM(tmp);            /* associative array end */
  1061.       case '&':
  1062.       s++;
  1063.       tmp = *s++;
  1064. ***************
  1065. *** 508,513 ****
  1066. --- 528,537 ----
  1067.           OPERATOR(SEQ);
  1068.       if (strEQ(d,"exit"))
  1069.           UNI(O_EXIT);
  1070. +     if (strEQ(d,"eval")) {
  1071. +         allstabs = TRUE;        /* must initialize everything since */
  1072. +         UNI(O_EVAL);        /* we don't know what will be used */
  1073. +     }
  1074.       if (strEQ(d,"eof"))
  1075.           TERM(FEOF);
  1076.       if (strEQ(d,"exp"))
  1077. ***************
  1078. *** 1480,1487 ****
  1079.       strcpy(tname,"^?");
  1080.       else
  1081.       sprintf(tname,"%c",yychar);
  1082. !     printf("%s in file %s at line %d, next token \"%s\"\n",
  1083.         s,filename,line,tname);
  1084.   }
  1085.   
  1086.   char *
  1087. --- 1504,1515 ----
  1088.       strcpy(tname,"^?");
  1089.       else
  1090.       sprintf(tname,"%c",yychar);
  1091. !     sprintf(tokenbuf, "%s in file %s at line %d, next token \"%s\"\n",
  1092.         s,filename,line,tname);
  1093. +     if (in_eval)
  1094. +     str_set(stabent("@",TRUE)->stab_val,tokenbuf);
  1095. +     else
  1096. +     fputs(tokenbuf,stderr);
  1097.   }
  1098.   
  1099.   char *
  1100. ***************
  1101. *** 1964,1970 ****
  1102.           str_numset(str, (double)str_len(s1));
  1103.           break;
  1104.       case O_SUBSTR:
  1105. !         if (arg[3].arg_type != A_SINGLE || stabent("[",FALSE)) {
  1106.           str_free(str);        /* making the fallacious assumption */
  1107.           str = Nullstr;        /* that any $[ occurs before substr()*/
  1108.           }
  1109. --- 1992,1998 ----
  1110.           str_numset(str, (double)str_len(s1));
  1111.           break;
  1112.       case O_SUBSTR:
  1113. !         if (arg[3].arg_type != A_SINGLE || stabent("[",allstabs)) {
  1114.           str_free(str);        /* making the fallacious assumption */
  1115.           str = Nullstr;        /* that any $[ occurs before substr()*/
  1116.           }
  1117. ***************
  1118. *** 2463,2466 ****
  1119. --- 2491,2619 ----
  1120.       bufptr = str_get(linestr);
  1121.       yyerror("Format not terminated");
  1122.       return froot.f_next;
  1123. + }
  1124. + 
  1125. + STR *
  1126. + do_eval(str)
  1127. + STR *str;
  1128. + {
  1129. +     int retval;
  1130. +     CMD *myroot;
  1131. + 
  1132. +     in_eval++;
  1133. +     str_set(stabent("@",TRUE)->stab_val,"");
  1134. +     line = 1;
  1135. +     str_sset(linestr,str);
  1136. +     bufptr = str_get(linestr);
  1137. +     if (setjmp(eval_env))
  1138. +     retval = 1;
  1139. +     else
  1140. +     retval = yyparse();
  1141. +     myroot = eval_root;        /* in case cmd_exec does another eval! */
  1142. +     if (retval)
  1143. +     str = &str_no;
  1144. +     else {
  1145. +     str = cmd_exec(eval_root);
  1146. +     cmd_free(myroot);    /* can't free on error, for some reason */
  1147. +     }
  1148. +     in_eval--;
  1149. +     return str;
  1150. + }
  1151. + 
  1152. + cmd_free(cmd)
  1153. + register CMD *cmd;
  1154. + {
  1155. +     register CMD *tofree;
  1156. +     register CMD *head = cmd;
  1157. + 
  1158. +     while (cmd) {
  1159. +     if (cmd->c_label)
  1160. +         safefree(cmd->c_label);
  1161. +     if (cmd->c_first)
  1162. +         str_free(cmd->c_first);
  1163. +     if (cmd->c_spat)
  1164. +         spat_free(cmd->c_spat);
  1165. +     if (cmd->c_expr)
  1166. +         arg_free(cmd->c_expr);
  1167. +     switch (cmd->c_type) {
  1168. +     case C_WHILE:
  1169. +     case C_BLOCK:
  1170. +     case C_IF:
  1171. +         if (cmd->ucmd.ccmd.cc_true)
  1172. +         cmd_free(cmd->ucmd.ccmd.cc_true);
  1173. +         if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt)
  1174. +         cmd_free(cmd->ucmd.ccmd.cc_alt,Nullcmd);
  1175. +         break;
  1176. +     case C_EXPR:
  1177. +         if (cmd->ucmd.acmd.ac_stab)
  1178. +         arg_free(cmd->ucmd.acmd.ac_stab);
  1179. +         if (cmd->ucmd.acmd.ac_expr)
  1180. +         arg_free(cmd->ucmd.acmd.ac_expr);
  1181. +         break;
  1182. +     }
  1183. +     tofree = cmd;
  1184. +     cmd = cmd->c_next;
  1185. +     safefree((char*)tofree);
  1186. +     if (cmd && cmd == head)        /* reached end of while loop */
  1187. +         break;
  1188. +     }
  1189. + }
  1190. + 
  1191. + arg_free(arg)
  1192. + register ARG *arg;
  1193. + {
  1194. +     register int i;
  1195. + 
  1196. +     for (i = 1; i <= arg->arg_len; i++) {
  1197. +     switch (arg[i].arg_type) {
  1198. +     case A_NULL:
  1199. +         break;
  1200. +     case A_LEXPR:
  1201. +     case A_EXPR:
  1202. +         arg_free(arg[i].arg_ptr.arg_arg);
  1203. +         break;
  1204. +     case A_CMD:
  1205. +         cmd_free(arg[i].arg_ptr.arg_cmd);
  1206. +         break;
  1207. +     case A_STAB:
  1208. +     case A_LVAL:
  1209. +     case A_READ:
  1210. +     case A_ARYLEN:
  1211. +         break;
  1212. +     case A_SINGLE:
  1213. +     case A_DOUBLE:
  1214. +     case A_BACKTICK:
  1215. +         str_free(arg[i].arg_ptr.arg_str);
  1216. +         break;
  1217. +     case A_SPAT:
  1218. +         spat_free(arg[i].arg_ptr.arg_spat);
  1219. +         break;
  1220. +     case A_NUMBER:
  1221. +         break;
  1222. +     }
  1223. +     }
  1224. +     free_arg(arg);
  1225. + }
  1226. + 
  1227. + spat_free(spat)
  1228. + register SPAT *spat;
  1229. + {
  1230. +     register SPAT *sp;
  1231. + 
  1232. +     if (spat->spat_runtime)
  1233. +     arg_free(spat->spat_runtime);
  1234. +     if (spat->spat_repl) {
  1235. +     arg_free(spat->spat_repl);
  1236. +     }
  1237. +     free_compex(&spat->spat_compex);
  1238. + 
  1239. +     /* now unlink from spat list */
  1240. +     if (spat_root == spat)
  1241. +     spat_root = spat->spat_next;
  1242. +     else {
  1243. +     for (sp = spat_root; sp->spat_next != spat; sp = sp->spat_next) ;
  1244. +     sp->spat_next = spat->spat_next;
  1245. +     }
  1246. + 
  1247. +     safefree((char*)spat);
  1248.   }
  1249.  
  1250. Index: search.c
  1251. Prereq: 1.0.1.1
  1252. *** search.c.old    Thu Jan 28 11:17:36 1988
  1253. --- search.c    Thu Jan 28 11:17:37 1988
  1254. ***************
  1255. *** 1,6 ****
  1256. ! /* $Header: search.c,v 1.0.1.1 88/01/24 03:55:05 root Exp $
  1257.    *
  1258.    * $Log:    search.c,v $
  1259.    * Revision 1.0.1.1  88/01/24  03:55:05  root
  1260.    * patch 2: made depend on perl.h.
  1261.    * 
  1262. --- 1,9 ----
  1263. ! /* $Header: search.c,v 1.0.1.2 88/01/28 10:30:46 root Exp $
  1264.    *
  1265.    * $Log:    search.c,v $
  1266. +  * Revision 1.0.1.2  88/01/28  10:30:46  root
  1267. +  * patch8: uncommented free_compex for use with eval operator.
  1268. +  * 
  1269.    * Revision 1.0.1.1  88/01/24  03:55:05  root
  1270.    * patch 2: made depend on perl.h.
  1271.    * 
  1272. ***************
  1273. *** 107,113 ****
  1274.       compex->subbase = Nullch;
  1275.   }
  1276.   
  1277. - #ifdef NOTUSED
  1278.   void
  1279.   free_compex(compex)
  1280.   register COMPEX *compex;
  1281. --- 110,115 ----
  1282. ***************
  1283. *** 121,127 ****
  1284.       compex->subbase = Nullch;
  1285.       }
  1286.   }
  1287. - #endif
  1288.   
  1289.   static char *gbr_str = Nullch;
  1290.   static int gbr_siz = 0;
  1291. --- 123,128 ----
  1292.  
  1293. Index: stab.c
  1294. Prereq: 1.0
  1295. *** stab.c.old    Thu Jan 28 11:17:44 1988
  1296. --- stab.c    Thu Jan 28 11:17:45 1988
  1297. ***************
  1298. *** 1,6 ****
  1299. ! /* $Header: stab.c,v 1.0 87/12/18 13:06:14 root Exp $
  1300.    *
  1301.    * $Log:    stab.c,v $
  1302.    * Revision 1.0  87/12/18  13:06:14  root
  1303.    * Initial revision
  1304.    * 
  1305. --- 1,9 ----
  1306. ! /* $Header: stab.c,v 1.0.1.1 88/01/28 10:35:17 root Exp $
  1307.    *
  1308.    * $Log:    stab.c,v $
  1309. +  * Revision 1.0.1.1  88/01/28  10:35:17  root
  1310. +  * patch8: changed some stabents to support eval operator.
  1311. +  * 
  1312.    * Revision 1.0  87/12/18  13:06:14  root
  1313.    * Initial revision
  1314.    * 
  1315. ***************
  1316. *** 169,180 ****
  1317.       case '^':
  1318.           safefree(curoutstab->stab_io->top_name);
  1319.           curoutstab->stab_io->top_name = str_get(str);
  1320. !         curoutstab->stab_io->top_stab = stabent(str_get(str),FALSE);
  1321.           break;
  1322.       case '~':
  1323.           safefree(curoutstab->stab_io->fmt_name);
  1324.           curoutstab->stab_io->fmt_name = str_get(str);
  1325. !         curoutstab->stab_io->fmt_stab = stabent(str_get(str),FALSE);
  1326.           break;
  1327.       case '=':
  1328.           curoutstab->stab_io->page_len = (long)str_gnum(str);
  1329. --- 172,183 ----
  1330.       case '^':
  1331.           safefree(curoutstab->stab_io->top_name);
  1332.           curoutstab->stab_io->top_name = str_get(str);
  1333. !         curoutstab->stab_io->top_stab = stabent(str_get(str),TRUE);
  1334.           break;
  1335.       case '~':
  1336.           safefree(curoutstab->stab_io->fmt_name);
  1337.           curoutstab->stab_io->fmt_name = str_get(str);
  1338. !         curoutstab->stab_io->fmt_stab = stabent(str_get(str),TRUE);
  1339.           break;
  1340.       case '=':
  1341.           curoutstab->stab_io->page_len = (long)str_gnum(str);
  1342. ***************
  1343. *** 274,280 ****
  1344.       ARRAY *savearray;
  1345.       STR *str;
  1346.   
  1347. !     stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),FALSE);
  1348.       savearray = defstab->stab_array;
  1349.       defstab->stab_array = anew();
  1350.       str = str_new(0);
  1351. --- 277,283 ----
  1352.       ARRAY *savearray;
  1353.       STR *str;
  1354.   
  1355. !     stab = stabent(str_get(hfetch(sigstab->stab_hash,sig_name[sig])),TRUE);
  1356.       savearray = defstab->stab_array;
  1357.       defstab->stab_array = anew();
  1358.       str = str_new(0);
  1359.  
  1360. Index: util.c
  1361. Prereq: 1.0
  1362. *** util.c.old    Thu Jan 28 11:18:10 1988
  1363. --- util.c    Thu Jan 28 11:18:10 1988
  1364. ***************
  1365. *** 1,6 ****
  1366. ! /* $Header: util.c,v 1.0 87/12/18 13:06:30 root Exp $
  1367.    *
  1368.    * $Log:    util.c,v $
  1369.    * Revision 1.0  87/12/18  13:06:30  root
  1370.    * Initial revision
  1371.    * 
  1372. --- 1,9 ----
  1373. ! /* $Header: util.c,v 1.0.1.1 88/01/28 11:06:35 root Exp $
  1374.    *
  1375.    * $Log:    util.c,v $
  1376. +  * Revision 1.0.1.1  88/01/28  11:06:35  root
  1377. +  * patch8: changed fatal() to support eval operator with exiting.
  1378. +  * 
  1379.    * Revision 1.0  87/12/18  13:06:30  root
  1380.    * Initial revision
  1381.    * 
  1382. ***************
  1383. *** 205,210 ****
  1384. --- 208,218 ----
  1385.       extern FILE *e_fp;
  1386.       extern char *e_tmpname;
  1387.   
  1388. +     if (in_eval) {
  1389. +     sprintf(tokenbuf,pat,a1,a2,a3,a4);
  1390. +     str_set(stabent("@",TRUE)->stab_val,tokenbuf);
  1391. +     longjmp(eval_env,1);
  1392. +     }
  1393.       fprintf(stderr,pat,a1,a2,a3,a4);
  1394.       if (e_fp)
  1395.       UNLINK(e_tmpname);
  1396.  
  1397. Index: x2p/walk.c
  1398. Prereq: 1.0
  1399. *** x2p/walk.c.old    Thu Jan 28 11:18:25 1988
  1400. --- x2p/walk.c    Thu Jan 28 11:18:26 1988
  1401. ***************
  1402. *** 1,6 ****
  1403. ! /* $Header: walk.c,v 1.0 87/12/18 13:07:40 root Exp $
  1404.    *
  1405.    * $Log:    walk.c,v $
  1406.    * Revision 1.0  87/12/18  13:07:40  root
  1407.    * Initial revision
  1408.    * 
  1409. --- 1,9 ----
  1410. ! /* $Header: walk.c,v 1.0.1.1 88/01/28 11:07:56 root Exp $
  1411.    *
  1412.    * $Log:    walk.c,v $
  1413. +  * Revision 1.0.1.1  88/01/28  11:07:56  root
  1414. +  * patch8: changed some misleading comments.
  1415. +  * 
  1416.    * Revision 1.0  87/12/18  13:07:40  root
  1417.    * Initial revision
  1418.    * 
  1419. ***************
  1420. *** 68,80 ****
  1421.           str_cat(str,"';\t\t# field separator from -F switch\n");
  1422.       }
  1423.       else if (saw_FS && !const_FS) {
  1424. !         str_cat(str,"$FS = '[ \\t\\n]+';\t\t# default field separator\n");
  1425.       }
  1426.       if (saw_OFS) {
  1427. !         str_cat(str,"$, = ' ';\t\t# default output field separator\n");
  1428.       }
  1429.       if (saw_ORS) {
  1430. !         str_cat(str,"$\\ = \"\\n\";\t\t# default output record separator\n");
  1431.       }
  1432.       if (str->str_cur > 20)
  1433.           str_cat(str,"\n");
  1434. --- 71,83 ----
  1435.           str_cat(str,"';\t\t# field separator from -F switch\n");
  1436.       }
  1437.       else if (saw_FS && !const_FS) {
  1438. !         str_cat(str,"$FS = '[ \\t\\n]+';\t\t# set field separator\n");
  1439.       }
  1440.       if (saw_OFS) {
  1441. !         str_cat(str,"$, = ' ';\t\t# set output field separator\n");
  1442.       }
  1443.       if (saw_ORS) {
  1444. !         str_cat(str,"$\\ = \"\\n\";\t\t# set output record separator\n");
  1445.       }
  1446.       if (str->str_cur > 20)
  1447.           str_cat(str,"\n");
  1448.