cvs commit: parrot/languages/regex regex.pl

[Steve Fink]

cvsuser     04/09/17 19:53:36

  Modified:    languages/regex regex.pl
  Log:
  Various changes and enhancements so that this can be called by an
  embedded compiler.
  
  Revision  Changes    Path
  1.11      +54 -4     parrot/languages/regex/regex.pl
  
  Index: regex.pl
  ===================================================================
  RCS file: /cvs/public/parrot/languages/regex/regex.pl,v
  retrieving revision 1.10
  retrieving revision 1.11
  diff -u -w -r1.10 -r1.11
  --- regex.pl  27 Feb 2004 13:13:46 -0000      1.10
  +++ regex.pl  18 Sep 2004 02:53:36 -0000      1.11
  @@ -1,4 +1,4 @@
  -#! perl -w
  +#!/usr/bin/perl -w
   
   use lib 'lib';
   use Regex;
  @@ -9,7 +9,10 @@
   my $tree_opt = 1;
   my $list_opt = 1;
   my $debug = 0;
  -foreach (@ARGV) {
  +my $output;
  +my $subname;
  +while (@ARGV) {
  +    $_ = shift;
       if (/--no(-?)optimize/) {
           $tree_opt = 0;
           $list_opt = 0;
  @@ -19,6 +22,12 @@
           $list_opt = ($opts =~ /l/i);
       } elsif (/--debug/ || $_ eq '-d') {
           $debug = 1;
  +    } elsif (/--output-file=(.*)/) {
  +        $output = $1;
  +    } elsif (/--sub-name=(.*)/) {
  +        $subname = $1;
  +    } elsif ($_ eq '-o') {
  +        $output = shift;
       } elsif (! defined $expr) {
           $expr = $_;
       } elsif (! defined $operation) {
  @@ -46,8 +55,49 @@
       exit;
   }
   
  -my $code = Regex::tree_to_list($tree, %options);
  +my $ctx = { };
  +my $code = Regex::tree_to_list($tree, $ctx, 'regex_done', 'regex_done',
  +                               %options);
   
   my @asm = Regex::list_to_pasm($code, %options);
   
  -print join("\n", @asm), "\n";
  +local *OUTPUT;
  +if (! defined $output || $output eq '-') {
  +    open(OUTPUT, ">&STDOUT");
  +} else {
  +    open(OUTPUT, ">$output") or die "create $output: $!";
  +}
  +
  +if ($subname) {
  +    print OUTPUT <<"END";
  +.sub $subname
  +  .param string rx_input
  +  .local pmc rx_match
  +  .local pmc rx_ptmp
  +  .local int rx_tmp
  +  .local int rx_len
  +  .local pmc rx_stack
  +  .local int rx_pos
  +  new rx_stack, .PerlArray
  +  rx_pos = 0
  +END
  +}
  +print OUTPUT join("\n", @asm), "\n";
  +if ($subname) {
  +    print OUTPUT <<"END";
  +  regex_done:
  +#    P5 = rx_match
  +#    end
  +#    P1 = find_global "_do_end_op"
  +    .pcc_begin_return
  +    .return rx_match
  +    .pcc_end_return
  +.end
  +
  +.sub _do_end_op
  +  print "Ending, dude!\\n"
  +  end
  +.end
  +
  +END
  +}