kernel-doc

ARM 嵌入式 系统 设计与实例开发 实验教材 二源码

	    print "\t$1 $parameter) ($2);\n";
	} elsif ($type =~ m/^(.*?)\s*(:.*)/) {
	    print "\t$1 $parameter$2;\n";
	} else {
	    print "\t".$type." ".$parameter.";\n";
	}
    }
    print "};\n\n";

    print "Members:\n\n";
    foreach $parameter (@{$args{'parameterlist'}}) {
        ($args{'parameterdescs'}{$parameter} ne $undescribed) || next;
	print "$parameter\n\t";
	print $args{'parameterdescs'}{$parameter}."\n";
    }
    print "\n";
    output_section_text(@_);
}

sub output_intro_text(%) {
    my %args = %{$_[0]};
    my ($parameter, $section);

    foreach $section (@{$args{'sectionlist'}}) {
	print " $section:\n";
	print "    -> ";
	output_highlight($args{'sections'}{$section});
    }
}

##
# generic output function for typedefs
sub output_declaration {
    no strict 'refs';
    my $name = shift;
    my $functype = shift;
    my $func = "output_${functype}_$output_mode";
    if (($function_only==0) || 
	( $function_only == 1 && defined($function_table{$name})) || 
	( $function_only == 2 && !defined($function_table{$name})))
    {
        &$func(@_);
    }
}

##
# generic output function - calls the right one based
# on current output mode.
sub output_intro {
    no strict 'refs';
    my $func = "output_intro_".$output_mode;
    &$func(@_);
}

##
# takes a declaration (struct, union, enum, typedef) and 
# invokes the right handler. NOT called for functions.
sub dump_declaration($$) {
    no strict 'refs';
    my ($prototype, $file) = @_;
    my $func = "dump_".$decl_type;
    &$func(@_);
}

sub dump_union($$) {
    dump_struct(@_);
}

sub dump_struct($$) {
    my $x = shift;
    my $file = shift;

    if ($x =~/(struct|union)\s+(\w+)\s*{(.*)}/) {
        $declaration_name = $2;
        my $members = $3;

	# ignore embedded structs or unions
	$members =~ s/{.*}//g;

	create_parameterlist($members, ';');

	output_declaration($declaration_name,
			   'struct',
			   {'struct' => $declaration_name,
			    'module' => $modulename,
			    'parameterlist' => \@parameterlist,
			    'parameterdescs' => \%parameterdescs,
			    'parametertypes' => \%parametertypes,
			    'sectionlist' => \@sectionlist,
			    'sections' => \%sections,
			    'purpose' => $declaration_purpose,
			    'type' => $decl_type
			   });
    }
    else {
        print STDERR "Cannot parse struct or union!\n";
    }
}

sub dump_enum($$) {
    my $x = shift;
    my $file = shift;

    if ($x =~ /enum\s+(\w+)\s*{(.*)}/) {
        $declaration_name = $1;
        my $members = $2;

	foreach my $arg (split ',', $members) {
	    $arg =~ s/^\s*(\w+).*/$1/;
	    push @parameterlist, $arg;
	    if (!$parameterdescs{$arg}) {
	        $parameterdescs{$arg} = $undescribed;
	        print STDERR "Warning($file:$.): Enum value '$arg' ".
		    "described in enum '$declaration_name'\n";
	    }

	}
	
	output_declaration($declaration_name,
			   'enum',
			   {'enum' => $declaration_name,
			    'module' => $modulename,
			    'parameterlist' => \@parameterlist,
			    'parameterdescs' => \%parameterdescs,
			    'sectionlist' => \@sectionlist,
			    'sections' => \%sections,
			    'purpose' => $declaration_purpose
			   });
    }
    else {
        print STDERR "Cannot parse enum!\n";
    }
}

sub dump_typedef($$) {
    my $x = shift;
    my $file = shift;

    while (($x =~ /\(*.\)\s*;$/) || ($x =~ /\[*.\]\s*;$/)) {
        $x =~ s/\(*.\)\s*;$/;/;
	$x =~ s/\[*.\]\s*;$/;/;
    }

    if ($x =~ /typedef.*\s+(\w+)\s*;/) {
        $declaration_name = $1;

	output_declaration($declaration_name,
			   'typedef',
			   {'typedef' => $declaration_name,
			    'module' => $modulename,
			    'sectionlist' => \@sectionlist,
			    'sections' => \%sections,
			    'purpose' => $declaration_purpose
			   });
    }
    else {
        print STDERR "Cannot parse typedef!\n";
    }
}

sub create_parameterlist($$) {
    my $args = shift;
    my $splitter = shift;
    my $type;
    my $param;

    while ($args =~ /(\([^\),]+),/) {
        $args =~ s/(\([^\),]+),/$1#/g;
    }
    
    foreach my $arg (split($splitter, $args)) {
        # strip leading/trailing spaces
        $arg =~ s/^\s*//;
	$arg =~ s/\s*$//;
	$arg =~ s/\s+/ /;

	if ($arg =~ m/\(/) {
	    # pointer-to-function
	    $arg =~ tr/#/,/;
	    $arg =~ m/[^\(]+\(\*([^\)]+)\)/;
	    $param = $1;
	    $type = $arg;
	    $type =~ s/([^\(]+\(\*)$param/$1/;
	} else {
	    # evil magic to get fixed array parameters to work
	    $arg =~ s/(.+\s+)(.+)\[.*/$1* $2/;
	    my @args = split('\s', $arg);
	
	    $param = pop @args;
	    if ($param =~ m/^(\*+)(.*)/) {
	        $param = $2;
		push @args, $1;
	    } 
	    elsif ($param =~ m/(.*?)\s*:\s*(\d+)/) {
	        $param = $1;
	        push @args, ":$2";
	    }
	    $type = join " ", @args;
	}

	if ($type eq "" && $param eq "...")
	{
	    $type="...";
	    $param="...";
	    $parameterdescs{"..."} = "variable arguments";
	}
	elsif ($type eq "" && ($param eq "" or $param eq "void"))
	{
	    $type="";
	    $param="void";
	    $parameterdescs{void} = "no arguments";
	}
	if (defined $type && $type && !defined $parameterdescs{$param}) {
	    $parameterdescs{$param} = $undescribed;

	    if (($type eq 'function') || ($type eq 'enum')) {
	        print STDERR "Warning($file:$.): Function parameter ".
		    "or member '$param' not " .
		    "described in '$declaration_name'\n";
	    }
	    ++$errors;
        }

	push @parameterlist, $param;
	$parametertypes{$param} = $type;
    }
}

##
# takes a function prototype and the name of the current file being
# processed and spits out all the details stored in the global
# arrays/hashes.
sub dump_function($$) {
    my $prototype = shift;
    my $file = shift;

    $prototype =~ s/^static +//;
    $prototype =~ s/^extern +//;
    $prototype =~ s/^inline +//;
    $prototype =~ s/^__inline__ +//;
    $prototype =~ s/^#define +//; #ak added

    # Yes, this truly is vile.  We are looking for:
    # 1. Return type (may be nothing if we're looking at a macro)
    # 2. Function name
    # 3. Function parameters.
    #
    # All the while we have to watch out for function pointer parameters
    # (which IIRC is what the two sections are for), C types (these
    # regexps don't even start to express all the possibilities), and
    # so on.
    #
    # If you mess with these regexps, it's a good idea to check that
    # the following functions' documentation still comes out right:
    # - parport_register_device (function pointer parameters)
    # - atomic_set (macro)
    # - pci_match_device (long return type)

    if ($prototype =~ m/^()([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s+\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s+\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\(]*)\)/ ||
	$prototype =~ m/^()([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s+\w+)\s+([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/ ||
	$prototype =~ m/^(\w+\s+\w+\s+\w+\s*\*)\s*([a-zA-Z0-9_~:]+)\s*\(([^\{]*)\)/)  {
	$return_type = $1;
	$declaration_name = $2;
	my $args = $3;

	create_parameterlist($args, ',');
    } else {
	print STDERR "Error($.): cannot understand prototype: '$prototype'\n";
	++$errors;
	return;
    }

    output_declaration($declaration_name, 
		       'function',
		       {'function' => $declaration_name,
			'module' => $modulename,
			'functiontype' => $return_type,
			'parameterlist' => \@parameterlist,
			'parameterdescs' => \%parameterdescs,
			'parametertypes' => \%parametertypes,
			'sectionlist' => \@sectionlist,
			'sections' => \%sections,
			'purpose' => $declaration_purpose
		       });
}

sub process_file($);

# Read the file that maps relative names to absolute names for
# separate source and object directories and for shadow trees.
if (open(SOURCE_MAP, "<.tmp_filelist.txt")) {
	my ($relname, $absname);
	while(<SOURCE_MAP>) {
		chop();
		($relname, $absname) = (split())[0..1];
		$relname =~ s:^/+::;
		$source_map{$relname} = $absname;
	}
	close(SOURCE_MAP);
}

if ($filelist) {
	open(FLIST,"<$filelist") or die "Can't open file list $filelist";
	while(<FLIST>) {
		chop;
		process_file($_);
	}
}

foreach (@ARGV) {
    chomp;
    process_file($_);
}

exit($errors);

sub reset_state {
    $function = "";
    %constants = ();
    %parameterdescs = ();
    %parametertypes = ();
    @parameterlist = ();
    %sections = ();
    @sectionlist = ();
    $prototype = "";
    
    $state = 0;
}

sub process_state3_function($) { 
    my $x = shift;

    if ($x =~ m#\s*/\*\s+MACDOC\s*#io) {
	# do nothing
    }
    elsif ($x =~ /([^\{]*)/) {
        $prototype .= $1;
    }
    if (($x =~ /\{/) || ($x =~ /\#/) || ($x =~ /;/)) {
        $prototype =~ s@/\*.*?\*/@@gos;	# strip comments.
	$prototype =~ s@[\r\n]+@ @gos; # strip newlines/cr's.
	$prototype =~ s@^\s+@@gos; # strip leading spaces
	dump_function($prototype,$file);
	reset_state();
    }
}

sub process_state3_type($) { 
    my $x = shift;

    $x =~ s@/\*.*?\*/@@gos;	# strip comments.
    $x =~ s@[\r\n]+@ @gos; # strip newlines/cr's.
    $x =~ s@^\s+@@gos; # strip leading spaces
    $x =~ s@\s+$@@gos; # strip trailing spaces

    while (1) {
        if ( $x =~ /([^{};]*)([{};])(.*)/ ) {
	    $prototype .= $1 . $2;
	    ($2 eq '{') && $brcount++;
	    ($2 eq '}') && $brcount--;
	    if (($2 eq ';') && ($brcount == 0)) {
	        dump_declaration($prototype,$file);
		reset_state();
	        last;
	    }
	    $x = $3;
        } else {
	    $prototype .= $x;
	    last;
	}
    }
}

sub process_file($) {
    my ($file) = @_;
    my $identifier;
    my $func;

    if (defined($source_map{$file})) {
	$file = $source_map{$file};
    }

    if (!open(IN,"<$file")) {
	print STDERR "Error: Cannot open file $file\n";
	++$errors;
	return;
    }

    while (<IN>) {
	if ($state == 0) {
	    if (/$doc_start/o) {
		$state = 1;		# next line is always the function name
	    }
	} elsif ($state == 1) {	# this line is the function name (always)
	    if (/$doc_block/o) {
		$state = 4;
		$contents = "";
		if ( $1 eq "" ) {
			$section = $section_intro;
		} else {
			$section = $1;
		}
            }
	    elsif (/$doc_decl/o) {
		$identifier = $1;
		if (/\s*([\w\s]+?)\s*-/) {
		    $identifier = $1;
		}

		$state = 2;
		if (/-(.*)/) {
		    $declaration_purpose = $1;
		} else {
		    $declaration_purpose = "";
		}
		if ($identifier =~ m/^struct/) {
		    $decl_type = 'struct';
		} elsif ($identifier =~ m/^union/) {
		    $decl_type = 'union';
		} elsif ($identifier =~ m/^enum/) {
		    $decl_type = 'enum';
		} elsif ($identifier =~ m/^typedef/) {
		    $decl_type = 'typedef';
		} else {
		    $decl_type = 'function';
		}

		if ($verbose) {
		    print STDERR "Info($.): Scanning doc for $identifier\n";
		}
	    } else {
		print STDERR "WARN($.): Cannot understand $_ on line $.",
		" - I thought it was a doc line\n";
		++$errors;
		$state = 0;
	    }
	} elsif ($state == 2) {	# look for head: lines, and include content
	    if (/$doc_sect/o) {
		$newsection = $1;
		$newcontents = $2;

		if ($contents ne "") {
		    $contents =~ s/\&/\\\\\\amp;/g;
		    $contents =~ s/\</\\\\\\lt;/g;
		    $contents =~ s/\>/\\\\\\gt;/g;
		    dump_section($section, $contents);
		    $section = $section_default;
		}

		$contents = $newcontents;
		if ($contents ne "") {
		    $contents .= "\n";
		}
		$section = $newsection;
	    } elsif (/$doc_end/) {

		if ($contents ne "") {
		    $contents =~ s/\&/\\\\\\amp;/g;
		    $contents =~ s/\</\\\\\\lt;/g;
		    $contents =~ s/\>/\\\\\\gt;/g;
		    dump_section($section, $contents);
		    $section = $section_default;
		    $contents = "";
		}

		$prototype = "";
		$state = 3;
		$brcount = 0;
#	    print STDERR "end of doc comment, looking for prototype\n";
	    } elsif (/$doc_content/) {
		# miguel-style comment kludge, look for blank lines after
		# @parameter line to signify start of description
		if ($1 eq "" && 
			($section =~ m/^@/ || $section eq $section_context)) {
		    $contents =~ s/\&/\\\\\\amp;/g;
		    $contents =~ s/\</\\\\\\lt;/g;
		    $contents =~ s/\>/\\\\\\gt;/g;
		    dump_section($section, $contents);
		    $section = $section_default;
		    $contents = "";
		} else {
		    $contents .= $1."\n";
		}
	    } else {
		# i dont know - bad line?  ignore.
		print STDERR "WARNING($.): bad line: $_"; 
		++$errors;
	    }
	} elsif ($state == 3) {	# scanning for function { (end of prototype)
	    if ($decl_type eq 'function') {
	        process_state3_function($_);
	    } else {
	        process_state3_type($_);
	    }
	} elsif ($state == 4) {
		# Documentation block
	        if (/$doc_block/) {
			dump_section($section, $contents);
			output_intro({'sectionlist' => \@sectionlist,
				      'sections' => \%sections });
			$contents = "";
			$function = "";
			%constants = ();
			%parameterdescs = ();
			%parametertypes = ();
			@parameterlist = ();
			%sections = ();
			@sectionlist = ();
			$prototype = "";
			if ( $1 eq "" ) {
				$section = $section_intro;
			} else {
				$section = $1;
			}
                }
		elsif (/$doc_end/)
		{
			dump_section($section, $contents);
			output_intro({'sectionlist' => \@sectionlist,
				      'sections' => \%sections });
			$contents = "";
			$function = "";
			%constants = ();
			%parameterdescs = ();
			%parametertypes = ();
			@parameterlist = ();
			%sections = ();
			@sectionlist = ();
			$prototype = "";
			$state = 0;
		}
		elsif (/$doc_content/)
		{
			if ( $1 eq "" )
			{
				$contents .= $blankline;
			}
			else
			{
				$contents .= $1 . "\n";
			}	
        	}
          }
    }
}