another step closer

svn path=/trunk/; revision=16052

2 files changed, 128 insertions, 111 deletions

diff --git a/tools/tpg/tpg.pl b/tools/tpg/tpg.pl
index 77cdf45ded..2ba82e1cc9 100644
--- a/tools/tpg/tpg.pl
+++ b/tools/tpg/tpg.pl
@@ -52,7 +52,7 @@ my $last_token = '';
 
 $parser->YYData->{DATA}=\$linenum;
 
-my $parser_info = $parser->YYParse(yylex => \&next_token, yyerror => \&error_sub); #yydebug => 0x1f
+my $parser_info = $parser->YYParse(yylex => \&next_token, yyerror => \&error_sub);#,yydebug => 0x1f);
 
 die "failed parsing" unless defined $parser_info;
 
@@ -65,6 +65,7 @@ if ($DEBUG > 3) {
 my $proto_name =  ${$parser_info}{proto_name};
 my $upper_name = $proto_name;
 $upper_name =~ tr/a-z/A-Z/;
+my $global_struct = "$proto_name\_tpg_data";
 
 warn "parser_data_type: ${$parser_info}{pdata}\n" if $DEBUG;
 
@@ -72,74 +73,69 @@ my %exports = %{${$parser_info}{export}};
 
 my $field_num = 0;
 
-my $init_function =  "void tpg_$proto_name\_init(void) {\n";
+my $tt_type = ${$parser_info}{pdata};
+
+$tt_type =~ s/\n#line.*?\n//ms;
+$tt_type =~ s@\n/\*eocode\*/\n@@ms;
+
+my $init_function_hfs = "\n/* initialize hfids */\n";
+my $init_function_etts = "\n/* initialize etts */\n"; 
+my $init_function_wanted_decl = "\n/* declare private wanted elements */\n";
+my $init_function_wanted = "\n/* initialize wanted elements  */\n";
+my $callback_definitions = "\n/* callback definitions */\n";
+my $datastruct_ett = "\n/* etts */\n";
+my $datastruct_hf = "\n/* hfis */\n";
+my $datastruct_wanted = "\n/* wanted elems */\n";
+
+my $hfarr = "/* field array */\n#define HF_$upper_name\_PARSER \\\n";
+my $ett_arr = "#define ETT_$upper_name\_PARSER \\\n";
 
 for my $fieldname (keys %{${$parser_info}{fields}}) {
     my $f = ${${$parser_info}{fields}}{$fieldname};
     
     my $vs = defined ${$f}{vs} ? 'VALS(' . ${$f}{vs}. ')' : "NULL" ;
            
-    ${$f}{vname} = "$proto_name\_hfis.${$f}{name}" unless defined ${$f}{vname};
+    ${$f}{vname} = "$global_struct.hf_${$f}{name}" unless defined ${$f}{vname};
     ${$f}{base} = 'BASE_NONE' unless defined ${$f}{base};
     ${$f}{desc} = '""' unless defined ${$f}{desc};
-    ${$f}{structname} .= "\tint ${$f}{name};\n";
-    $init_function .= "\t${$f}{vname} = -1;\n";
-    ${$f}{hfi} .= "{ &${$f}{vname}, { ${$f}{pname}, ${$f}{abbr}, ${$f}{type}, ${$f}{base}, $vs, 0x0, ${$f}{desc}, HFILL }},";
+    $datastruct_hf .= "\tint hf_${$f}{name};\n";
+    $init_function_hfs .= "\t${$f}{vname} = -1;\n";
+    $hfarr .= "{ &${$f}{vname}, { ${$f}{pname}, ${$f}{abbr}, ${$f}{type}, ${$f}{base}, $vs, 0x0, ${$f}{desc}, HFILL }},\\\n";
                                                
 # warn "\nFIELD:$fieldname " . V2P::var2perl($f);
 
 }
 
-my $tt_type = ${$parser_info}{pdata};
+$hfarr =~ s/,\\\n$/\n/msi;
 
-$tt_type =~ s/\n#line.*?\n//ms;
-$tt_type =~ s@\n/\*eocode\*/\n@@ms;
 
-my $ett_arr = "#define ETT_$upper_name\_PARSER \\\n";
-my $ett_decl = '';
-my $ett_init = '';
 for my $rulename ( keys %{${$parser_info}{rules}} ) {
     my $r = ${${$parser_info}{rules}}{$rulename};
 
+# warn "\nRULE BEFORE:$rulename " . V2P::var2perl($r);
+
     make_rule($r,0);
-    
-# warn "\nRULE:$rulename " . V2P::var2perl($r);
-}
 
-$ett_arr =~ s/,\\\n$//ms;
+# warn "\nRULE AFTER:$rulename " . V2P::var2perl($r);
 
-my $hfarr = "/* field array */\n#define HF_$upper_name\_PARSER \\\n";
-my $hfstruct = "struct _$proto_name\_hfis_t {\n";
-for my $fieldname (sort keys %{${$parser_info}{fields}}) {
-    my $f = ${${$parser_info}{fields}}{$fieldname};
-    $hfarr .=  ${$f}{hfi} . "\\\n";
-    $hfstruct .= ${$f}{structname} ;
 }
-$hfstruct .= $ett_decl . "};";
-$hfarr =~ s/,\\\n$/\n/msi;
 
-my $c_file = '';
-my $h_file = '';
+$ett_arr =~ s/,\\\n$//ms;
 
-$c_file .= <<"__C_HEAD";
-/*
-    $proto_name-parser.c
-    automagically generated by $0 from $ARGV
-    DO NOT MODIFY.
-*/
+for my $rulename (sort keys %{${$parser_info}{rules}} ) {
+    my $r = ${${$parser_info}{rules}}{$rulename};
+    
+    
+    $callback_definitions .= "\n\n/* callback definitions for rule $rulename */\n";
+    $callback_definitions .= ${$r}{before_cb_code} . "\n";
+    $callback_definitions .= ${$r}{after_cb_def} . "\n";
+    $init_function_wanted .= ${$r}{definition_code} . "\n\n";
+}
 
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
 
-#include "$proto_name-parser.h" 
 
-/* begin %head */
-${$parser_info}{head}
-/* end %head */
-__C_HEAD
 
-$h_file .= <<"__H_HEAD";
+my $h_file = <<"__H_HEAD";
 /*
  $proto_name-parser.h
  automagically generated by $0 from $ARGV
@@ -155,62 +151,64 @@ $h_file .= <<"__H_HEAD";
 ${$parser_info}{header_head}
 /* end %header_head */
 
-extern void tpg_$proto_name\_init(void);
+extern void tpg_${proto_name}_init(void);
 
-__H_HEAD
+struct _${proto_name}_tpg_data_t {
+$datastruct_ett
+$datastruct_hf
+$datastruct_wanted
+};
 
 
-$h_file .= "\n/* hfids export container */\n$hfstruct\n";
-$h_file .= "\n/* hfids container */\nextern struct _$proto_name\_hfis_t  $proto_name\_hfis;\n\n";
-$h_file .= $hfarr . "\n\n" . $ett_arr ."\n\n";
+extern struct _${global_struct}_t  $global_struct;
 
-$c_file .= "\n/* hfids container */\nstruct _$proto_name\_hfis_t  $proto_name\_hfis;\n\n";
-$h_file .= "/* parser declarations */\n";
-$c_file .= "/* parser declarations */\n";
+$hfarr
 
-for my $rulename (sort keys %{${$parser_info}{rules}} ) {
-    my $r = ${${$parser_info}{rules}}{$rulename};
-    
-    if (exists $exports{$rulename}) {
-        $h_file .= ${$r}{declaration_code};
-    } else {
-        $c_file .= ${$r}{declaration_code};
-    }
-}
 
-$c_file .= "\n\n/* parser definitions */\n";
+$ett_arr
 
-for my $rulename (sort keys %{${$parser_info}{rules}} ) {
-    my $r = ${${$parser_info}{rules}}{$rulename};
-        
-    
-        $c_file .= "\n\n/* definitions for rule $rulename */\n";
-        $c_file .= ${$r}{before_cb_code} . "\n";
-        $c_file .= ${$r}{after_cb_def} . "\n";
-        $c_file .= ${$r}{definition_code} . "\n\n";
-}
 
+#endif
+__H_HEAD
 
-$h_file .= <<"__H_TAIL";
 
-/* begin %header_tail */
-${$parser_info}{header_tail}
-/* end %header_tail */
+my $c_file = <<"__C_FILE";
+/*
+ $proto_name-parser.c
+ automagically generated by $0 from $ARGV
+ DO NOT MODIFY.
+ */
 
-#endif /* _H_$upper_name\_PARSER */
-__H_TAIL
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
 
-$c_file .= <<"__C_TAIL";
+#include "$proto_name-parser.h" 
 
-$init_function
-$ett_init
+/* begin %head */
+${$parser_info}{head}
+/* end %head */
+
+/* hfids container */
+
+struct _${proto_name}_tpg_data_t  $global_struct;
+
+
+$callback_definitions
+/* end callback definitions */
+
+void tpg_$proto_name\_init(void) {
+    $init_function_wanted_decl
+    $init_function_hfs
+    $init_function_etts 
+    $init_function_wanted
 }
 
 /* begin %tail */
 ${$parser_info}{tail}
 /* end %tail */
 
-__C_TAIL
+__C_FILE
 
 my $c_buf = '';
 my $c_line = 3;
@@ -275,17 +273,16 @@ sub make_rule {
     
     if ($dd == 0) {
         my %VARS = ();
-
-        if (exists $exports{${$r}{name}}) {
-            ${$r}{definition_code} = 'extern ';
-            ${$r}{declaration_code} = '' ;
-        } else { 
-            ${$r}{definition_code} = 'static ';
-            ${$r}{declaration_code} = 'static ';
-        }
     
-        ${$code} .= "tvbparse_wanted_t* wanted_$proto_name\_${$r}{name}(void) {\n\treturn ";
-        ${$r}{declaration_code} .= "tvbparse_wanted_t* wanted_$proto_name\_${$r}{name}(void);\n";
+        if ( exists $exports{${$r}{name}}) {
+            ${$code} = "\t$global_struct.";
+            $datastruct_wanted .= "\ttvbparse_wanted_t* wanted_$proto_name\_${$r}{name};\n"
+        } else {
+            ${$code} = "\t";
+            $init_function_wanted_decl .=  "\tstatic tvbparse_wanted_t* wanted_$proto_name\_${$r}{name};\n"
+        }
+        
+        ${$code} .= "wanted_$proto_name\_${$r}{name} = ";
         
         $VARS{"TT_DATA"} = "TPG_DATA(tpg,$tt_type)" if defined $tt_type;
             
@@ -364,9 +361,11 @@ sub make_rule {
             ${$code} .= $indent . "tvbparse_casestring($rule_id,$control,$wd_data,$before_fn,$after_fn)";
             
         } elsif (${$r}{type} eq 'named') {
-            
-            ${$code} .= $indent . "wanted_$proto_name\_$control()";
-            
+            if(exists $exports{$control}) {
+                ${$code} .= $indent . "tvbparse_handle(&$global_struct.wanted_$proto_name\_$control)";
+            } else {
+                ${$code} .= $indent . "tvbparse_handle(&wanted_$proto_name\_$control)";                
+            }
         } elsif (${$r}{type} eq 'seq') {
             
             ${$code} .= $indent . "tvbparse_set_seq($rule_id,$wd_data,$before_fn,$after_fn,\n";
@@ -392,9 +391,12 @@ sub make_rule {
             ${$code} .= $indent . " NULL)"
                 
         } elsif (${$r}{type} eq 'until') {
+            
+            ${$r}{inc_mode} =  'TP_UNTIL_SPEND' unless defined ${$r}{inc_mode};
+            
             ${$code} .= $indent ."tvbparse_until(0,$wd_data,$before_fn,$after_fn,\n";
             $dd++;
-            ${$code} .= $indent_more . make_rule(${$r}{subrule},$dd) . ", FALSE)";
+            ${$code} .= $indent_more . make_rule(${$r}{subrule},$dd) . ", ${$r}{inc_mode})";
             $dd--;
         }
         
@@ -404,7 +406,7 @@ sub make_rule {
     }
 
     if ($dd == 0) {
-        ${$code} .= ";\n}\n";
+        ${$code} .= ";\n";
 #        warn "RULE::${$r}{name} " . V2P::var2perl($r);
     }
 
@@ -456,10 +458,10 @@ sub make_tree_code {
             $root_var = "root_$fieldname";
             ${$head} .= "\tproto_item* $root_var;\n\n";
             ${$body} .= "\t$root_var = ";
-            $ett_arr .= "\t&$proto_name\_hfis.ett_$fieldname,\\\n";
-            $ett_decl .= "\tguint ett_$fieldname; \n";
-            $ett_init .= "\t$proto_name\_hfis.ett_$fieldname = -1;\n";
-            ${$r}{ett} = "$proto_name\_hfis.ett_$fieldname";
+            $ett_arr .= "\t&$global_struct.ett_$fieldname,\\\n";
+            $datastruct_ett .= "\tguint ett_$fieldname; \n";
+            $init_function_etts .= "\t$global_struct.ett_$fieldname = -1;\n";
+            ${$r}{ett} = "$global_struct.ett_$fieldname";
         } else {
             ${$body} .= "\t";
         }
@@ -534,7 +536,7 @@ sub tokenizer {
         [ '\[\^((\\\\\\]|[^\\]])*)\]', sub { [ 'NOTCHARS', $_[0] ] }], 
         [ '\[((\\\\\\]|[^\\]])*)\]', sub { [ 'CHARS', $_[0] ] }], 
         [ '"((\\\\"|[^"])*)"', sub { [ 'DQUOTED', $_[0] ] }], 
-        [ '(\%[a-z_]+|\%[A-Z][A-Z-]*|\=|\.\.\.|\.|\:|\;|\(|\)|\{|\}|\+|\*|\?|\<|\>|\|)', sub { [  $_[0], $_[0] ] }], 
+        [ '(\%[a-z_]+|\%[A-Z][A-Z-]*|\&|\=|\.\.\.|\.|\:|\;|\(|\)|\{|\}|\+|\*|\?|\<|\>|\|)', sub { [  $_[0], $_[0] ] }], 
     ]
 }
 
diff --git a/tools/tpg/tpg.yp b/tools/tpg/tpg.yp
index d9282e9208..384b5a0e17 100644
--- a/tools/tpg/tpg.yp
+++ b/tools/tpg/tpg.yp
@@ -116,8 +116,18 @@ statement:
     ;
 
 rule_statement:
-'%rule' LOWERCASE '=' rule '.' rule_body {
-        my $r = hj($_[4],$_[6]);
+    '%sequence' LOWERCASE '=' sequence_rule '.' qualification rule_body {
+        my $r = hj($_[4],hj($_[6],$_[7]));
+        ${$r}{name} = $_[2];
+        $r;
+    }
+    | '%choice' LOWERCASE '=' choice_rule '.' qualification rule_body {
+        my $r = hj($_[4],hj($_[6],$_[7]));
+        ${$r}{name} = $_[2];
+        $r;
+    }
+    | '%rule' LOWERCASE '=' complete_rule '.' rule_body {
+        my $r = hj($_[4],hj($_[6],$_[6]));
         ${$r}{name} = $_[2];
         $r;
     }
@@ -155,18 +165,12 @@ tree:
     | '%root' LOWERCASE {$_[2]}
     ;
 
-rule:
-    complete_rule
-    | sequence {{subrules=>$_[1],type=>'seq'}};
-
 
 complete_rule:
     base_rule cardinality qualification {hj($_[1],hj($_[2],$_[3]))}
     ;
 
 base_rule:
-    '(' sequence ')' { {subrules=>$_[2],type=>'seq'}}
-    | '(' choice ')' {{subrules=>$_[2],type=>'choice'}}
     | until_rule
     | CHARS {{control=>chars_control($_[1]),type=>'chars'}}
     | NOTCHARS {{control=>chars_control($_[1]),type=>'not_chars'}}
@@ -176,17 +180,28 @@ base_rule:
     ;
 
 until_rule:
-    '...' qualification '{' rule '}'  { @{$_[2]}{'type','subrule'} = ('until',$_[4]); $_[2] }
+    '...' qualification '(' base_rule include_mode ')'  { @{$_[2]}{'type','subrule','inc_mode'} = ('until',$_[4],$_[5]); $_[2] }
+    ;
+
+include_mode:
+    #empty { 'TP_UNTIL_SPEND' }
+    | '%spend' { 'TP_UNTIL_SPEND' }
+    | '%include' { 'TP_UNTIL_INCLUDE' }
+    | '%leave' { 'TP_UNTIL_LEAVE' }
     ;
 
+choice_rule: choice {{subrules=>$_[1],type=>'choice'}} ;
+
 choice:
     complete_rule '|' complete_rule { [$_[1],$_[3]] }
     | choice '|' complete_rule { push @{$_[1]}, $_[3]; $_[1] }
     ;
 
+sequence_rule: sequence { {subrules=>$_[1],type=>'seq'}} ;
+
 sequence:
-    complete_rule complete_rule { [$_[1],$_[2]] }
-    | sequence complete_rule { push @{$_[1]}, $_[2]; $_[1] }
+    complete_rule { [$_[1]] }
+    | sequence '&' complete_rule { push @{$_[1]}, $_[3]; $_[1] }
     ;
 
 cardinality:
@@ -249,8 +264,8 @@ export_statement:
     ;
 
 exports:
-    exports LOWERCASE { ${$_[1]}{$_[2]} = undef; $_[1] }
-    | LOWERCASE { my $e = {}; ${$e}{$_[1]} = undef; $e }
+    exports LOWERCASE { ${$_[1]}{$_[2]} = 1; $_[1] }
+    | LOWERCASE { my $e = {}; ${$e}{$_[1]} = 1; $e }
     ;
 
 value_string_statement: