doc: script to generate select lists from C code

Added a perl script that tries to generate the list of selects
defined in a C file.
The script works by looking for the first select_row_t array with
an initializer in the .c file. It then tries to generate the list
of all possible selects (but it still has some bugs, especially on
 matching params to a select part).

Note: there is no documentation generated besides the list
(the select format is not auto-documented).

doc/scripts/cdefs2doc/dump_selects.pl

@@ -0,0 +1,392 @@
+#!/usr/bin/perl
+
+#
+# Generate select lists from ser/sip-router select initializations structs.
+# (run on files generated by gcc -fdump-translation-unit -c file.c, 
+#  try -h for help)
+# E.g.: dump_selects.pl --file cfg_core.c  --defs="-DUSE_SCTP ..."
+#
+# History:
+# =======
+#  2009-10-18  initial version (Andrei Pelinescu-Onciul <[email protected]>)
+#
+
+# Note: uses GCC::TranslationUnit (see cpan) with the following patch:
+#@@ -251,6 +251,8 @@
+# 	    $node->{vector}[$key] = $value;
+# 	} elsif($key =~ /^op (\d+)$/) {
+# 	    $node->{operand}[$1] = $value;
+#+	} elsif ($key eq "val") {
+#+		push @{$node->{$key}}, ($value) ;
+# 	} else {
+# 	    $node->{$key} = $value;
+# 	}
+# 
+#
+# Assumptions:
+#  - the first array of type select_row_t  with an initializer is the array
+#    with the select definitions. Only one select_row_t array per file is
+#    supported.
+#
+# Output notes:
+#
+
+use strict;
+use warnings;
+use Getopt::Long;
+use File::Temp qw(:mktemp);
+use File::Basename;
+use lib "/home/andrei/perl/modules/share/perl/5.10.1";
+use GCC::TranslationUnit;
+
+# text printed if we discover that GCC::TranslationUnit is unpatched
+my $patch_required="$0 requires a patched GCC:TranslationUnit, see the " .
+				"comments at the beginning of the file or try --patch\n";
+# gcc name
+my $gcc="gcc";
+# default defines
+my $c_defs="-D__CPU_i386 -D__OS_linux -DSER_VER=2099099 -DPKG_MALLOC -DSHM_MEM  -DSHM_MMAP -DDNS_IP_HACK -DUSE_IPV6 -DUSE_MCAST -DUSE_TCP -DUSE_DNS_CACHE -DUSE_DNS_FAILOVER -DUSE_DST_BLACKLIST -DUSE_NAPTR  -DUSE_TLS -DTLS_HOOKS -DFAST_LOCK   -DCC_GCC_LIKE_ASM -DHAVE_GETHOSTBYNAME2 -DHAVE_UNION_SEMUN -DHAVE_SCHED_YIELD -DHAVE_MSG_NOSIGNAL -DHAVE_MSGHDR_MSG_CONTROL -DHAVE_ALLOCA_H -DHAVE_SCHED_SETSCHEDULER -DHAVE_EPOLL -DUSE_SCTP -DNAME='\"ser\"' -DVERSION='\"2.99.99-pre3\"' -DARCH='\"i386\"' -DOS_QUOTED='\"linux\"' -DSER_MOD_INTERFACE";
+
+# file with gcc syntax tree
+my $file;
+my $tmp_file;
+my $src_fname;
+
+# type to look for
+my $var_type="select_row_t";
+
+my $tu;
+my $node;
+my $i;
+my @sel_exports; # filled with select definitions (select_row_t)
+my ($sel_grp_name, $sel_var_name);
+
+my ($opt_help, $opt_txt, $opt_is_tu, $dbg, $opt_grp_name, $opt_patch);
+my $opt_force_grp_name;
+
+
+
+sub show_patch
+{
+my $patch='
+--- GCC/TranslationUnit.pm.orig	2009-10-16 17:57:51.275963053 +0200
++++ GCC/TranslationUnit.pm	2009-10-16 20:17:28.128455959 +0200
+@@ -251,6 +251,8 @@
+ 	    $node->{vector}[$key] = $value;
+ 	} elsif($key =~ /^op (\d+)$/) {
+ 	    $node->{operand}[$1] = $value;
++	} elsif ($key eq "val") {
++		push @{$node->{$key}}, ($value) ;
+ 	} else {
+ 	    $node->{$key} = $value;
+ 	}
+';
+
+print $patch;
+}
+
+
+sub help
+{
+	$~ = "USAGE";
+	write;
+
+format USAGE =
+Usage @*  -f filename | --file filename  [options...]
+      $0
+Options:
+         -f        filename    - use filename for input (see also -T/--tu).
+         --file    filename    - same as -f.
+         -h | -? | --help      - this help message.
+         -D | --dbg | --debug  - enable debugging messages.
+         -d | --defs           - defines to be passed on gcc's command line
+                                 (e.g. --defs="-DUSE_SCTP -DUSE_TCP").
+         -g | --grp  name
+         --group     name      - select group name used if one cannot be
+                                 autodetected (e.g. no default value 
+                                 intializer present in the file).
+         -G | --force-grp name
+         --force-group    name - force using a select group name, even if one
+                                 is autodetected (see also -g).
+         --gcc     gcc_name    - run gcc_name instead of gcc.
+         -t | --txt            - text mode output.
+         -T | --tu             - the input file is in raw gcc translation
+                                 unit format (as produced by
+                                   gcc -fdump-translation-unit -c ). If not
+                                 present it's assumed that the file contains
+                                 C code.
+         -s | --src | --source - name of the source file, needed only if
+                                 the input file is in "raw" translation
+                                 unit format (--tu) and usefull to restrict
+                                 and speed-up the search.
+         --patch               - show patches needed for the
+                                 GCC::TranslationUnit package.
+.
+
+}
+
+# eliminate casts and expressions.
+# (always go on the first operand)
+# params: node (GCC::Node)
+# result: if node is an expression it will walk on operand(0) until first non
+# expression element is found
+sub expr_op0{
+	my $n=shift;
+	
+	while(($n->isa('GCC::Node::Expression') || $n->isa('GCC::Node::Unary')) &&
+			defined $n->operand(0)) {
+		$n=$n->operand(0);
+	}
+	return $n;
+}
+
+
+
+# generate all select strings starting with a specific "root" function
+sub gen_selects
+{
+	my $root=shift;
+	my @matches;
+	my ($prev, $type, $name, $new_f, $flags);
+	my $m;
+	my @ret=();
+	my @sel;
+	
+	@matches = grep(${$_}[0] eq $root, @sel_exports);
+	for $m (@matches) {
+		($prev, $type, $name, $new_f, $flags)=@$m;
+		if (($flags & (1024|2048|4096)) && $name ne ""){
+			if ($flags & 1024){
+				$name.="[string]";
+			}elsif ($flags & 2048){
+				$name.="[integer]";
+			}else{
+				$name.="[]"
+			}
+		}
+		if ($new_f eq "" ||
+			$new_f eq "0"
+			){
+			push @ret, $name;
+		}else{
+			 if ($name eq ""){
+				@sel=gen_selects($new_f);
+			}else{
+				@sel=map("$name.$_", gen_selects($new_f));
+			}
+			if (@sel > 0) {
+				push(@ret, $name) if (! (($flags & (512|16384)) ||
+										($name eq "")));
+				push @ret, @sel;
+			}else{
+				push @ret, $name;
+			}
+		}
+	}
+	return @ret;
+}
+
+# read command line args
+if ($#ARGV < 0 || ! GetOptions(	'help|h|?' => \$opt_help,
+								'file|f=s' => \$file,
+								'txt|t' => \$opt_txt,
+								'tu|T' => \$opt_is_tu,
+								'source|src|s=s' => \$src_fname,
+								'defs|d=s'=>\$c_defs,
+								'group|grp|g=s'=>\$opt_grp_name,
+								'force-group|force-grp|G=s' =>
+													\$opt_force_grp_name,
+								'dbg|debug|D'=>\$dbg,
+								'gcc=s' => \$gcc,
+								'patch' => \$opt_patch) ||
+		defined $opt_help) {
+	do { show_patch(); exit 0; } if (defined $opt_patch);
+	select(STDERR) if ! defined $opt_help;
+	help();
+	exit((defined $opt_help)?0:1);
+}
+
+do { show_patch(); exit 0; } if (defined $opt_patch);
+do { select(STDERR); help(); exit 1 } if (!defined $file);
+
+if (! defined $opt_is_tu){
+	# file is not a gcc translation-unit dump
+	# => we have to create one
+	$src_fname=basename($file);
+	$tmp_file = "/tmp/" . mktemp ("dump_translation_unit_XXXXXX");
+	system("$gcc -fdump-translation-unit $c_defs -c $file -o $tmp_file && \
+			mv \"$src_fname\".001t.tu  $tmp_file") == 0 or
+		die "$gcc failed to generate a translation unit dump from $file";
+	$tu=GCC::TranslationUnit::Parser->parsefile($tmp_file);
+	print(STDERR "src name $src_fname\n") if $dbg;
+	unlink($tmp_file, "$tmp_file.o");
+}else{
+	$tu=GCC::TranslationUnit::Parser->parsefile($file);
+}
+
+print(STDERR "Parsing file $file...\n") if $dbg;
+#
+# function_decl: name, type, srcp (source), chan?, body?, link (e.g. extern)
+# parm_decl: name, type, scpe, srcp, chan, argt, size, algn, used
+# field_decl: name, type, scpe (scope), srcp, size, algn, bpos (bit pos?)
+#
+# array_type: size, algn, elts (elements?), domn ?
+#
+#
+# name as string $node->name->identifier
+#
+# E.g.: static cfg_def_t tcp_cfg_def[]= {...}
+#                        ^^^^^^^^^^^
+#
+# @7695 var_decl:  name: @7705   type: @7706    srcp: tcp_options.c:51
+#                  chan: @7707    init: @7708    size: @7709
+#                  algn: 256      used: 1
+# 
+# @7705 (var name)  	identifier_node strg: tcp_cfg_def lngt 11
+# @7706 (var type)  	array_type: size:@7709 algn: 32 elts: @2265 domn: @7718
+# @7707 (? next ?  )	function_decl: ....
+# @7708 (intializer)	constructor: lngt: 25
+#                                    idx : @20      val : @7723    [...]
+# @7709             	interget_cst: type: @11 low: 5600
+#
+# @2265 (array type)	record_type: name: @2256    unql: @2255    size: @2002
+#                                    algn: 32       tag : struct   flds: @2263
+# @2256 (type)      	type_decl: name: @2264    type: @2265    srcp: cfg.h:73
+#                                  chan: @2266
+# @2264 (name)     		identifier_node:  strg: cfg_def_t
+
+print(STDERR "Searching...\n") if $dbg;
+$i=0;
+# iterate on the entire nodes array (returned by gcc), but skipping node 0
+SEARCH: for $node (@{$tu}[1..$#{$tu}]) {
+	$i++;
+	while($node) {
+		if (
+			@sel_exports == 0 &&  # parse it only once
+			$node->isa('GCC::Node::var_decl') &&
+			$node->type->isa('GCC::Node::array_type') # &&
+			#(! defined $src_fname || $src_fname eq "" ||
+			#	$node->source=~"$src_fname")
+			){
+			# found a var decl. that it's an array
+			# check if it's a valid array type
+			next if (!(	$node->type->can('elements') &&
+						defined $node->type->elements &&
+						$node->type->elements->can('name') &&
+						defined $node->type->elements->name &&
+						$node->type->elements->name->can('name') &&
+						defined $node->type->elements->name->name)
+					);
+			my $type_name= $node->type->elements->name->name->identifier;
+			if ($type_name eq $var_type) {
+				if ($node->can('initial') && defined $node->initial) {
+					my %c1=%{$node->initial};
+					$sel_var_name=$node->name->identifier;
+					if (defined $c1{val}){
+						my $c1_el;
+						die $patch_required if (ref($c1{val}) ne "ARRAY");
+						# iterate on array elem., level 1( top {} )
+						# each element is a constructor.
+						for $c1_el (@{$c1{val}}) {
+							# finally we are a the lower {} initializer:
+							#    { prev_f, type, name, new_f, flags }
+							my %c2=%{$c1_el};
+							my @el=@{$c2{val}};
+							my ($prev_f_n, $type_n, $name_n, $new_f_n,
+								$flags_n)=@el;
+							my ($prev_f, $type, $name, $new_f, $flags);
+							my $str;
+							if ($prev_f_n->isa('GCC::Node::integer_cst') &&
+								$new_f_n->isa('GCC::Node::integer_cst') &&
+								$prev_f_n->low==0 && $new_f_n->low==0) {
+								last SEARCH;
+							}
+							$prev_f=($prev_f_n->isa('GCC::Node::integer_cst'))?
+									$prev_f_n->low:
+									expr_op0($prev_f_n)->name->identifier;
+							$type=$type_n->low;
+							$str=${${$name_n}{val}}[0];
+							$name=($str->isa('GCC::Node::integer_cst'))?"":
+									expr_op0($str)->string;
+							$new_f=($new_f_n->isa('GCC::Node::integer_cst'))?
+									$new_f_n->low:
+									expr_op0($new_f_n)->name->identifier;
+							$flags=$flags_n->low;
+							
+							push @sel_exports, [$prev_f, $type, $name, $new_f,
+												$flags];
+						}
+					}
+				}
+			}
+		}
+	} continue {
+		if ($node->can('chain')){
+			$node = $node->chain;
+		}else{
+			last;
+		}
+	}
+}
+
+
+
+print(STDERR "Done.\n") if $dbg;
+
+my ($prev, $type, $name, $next, $flags, $desc);
+my $extra_txt;
+
+if (@sel_exports > 0){
+	my $s;
+	$i=0;
+	# dump the configuration in txt mode
+	if (defined $opt_force_grp_name) {
+		$sel_grp_name=$opt_force_grp_name;
+	}elsif (!defined $sel_grp_name && defined $opt_grp_name) {
+		$sel_grp_name=$opt_grp_name;
+	}
+	print(STDERR "Generating select list...\n") if $dbg;
+	my @sels = gen_selects "0";
+	$~ = "HEADER"; write;
+	$~ = "SELLINE" ;
+	for $s (@sels){
+		$extra_txt="";
+		$desc="";
+		$name=$s;
+		$i++;
+		#$extra_txt.="Returns an array." if ($flags & 1 );
+		# generate txt description
+		write;
+	}
+}else{
+	die "no selects found in $file\n";
+}
+
+
+sub valid_grp_name
+{
+	my $name=shift;
+	return defined $name && $name ne "";
+}
+
+
+format HEADER =
+Selects@*
+(valid_grp_name $sel_grp_name) ? " for " . $sel_grp_name : ""
+=======@*
+"=" x length((valid_grp_name $sel_grp_name)?" for " . $sel_grp_name : "")
+
+@||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+"[ this file is autogenerated, do not edit ]"
+
+
+.
+
+format SELLINE =
+@>>. @*
+$i,  $name
+~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+        $desc
+~~      ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+        $extra_txt
+.