Re: [PATCH RFC] Convert function definitions to prototyped form

[Kevin Buettner <kevinb at cygnus dot com>]

On Jul 16,  2:32pm, Kevin Buettner wrote:

> ... was generated with the perl script ``fix-decls'' and
> checked for correctness with ``check-decls''.  The latter script
> generates a C program from the ``diff -u'' output below.  If compiling
> this C program with ``gcc -c -Wall'' generates no errors or warnings,
> it is assumed that the translation process faithfully preserved the
> order of arguments and types between the original declaration and the
> converted one.  I will post current versions of fix-decls and
> check-decls as a reply to this message.

The scripts are below.  Here's an example of how to use them.

ocotillo:decls$ cp -a orig fixed
ocotillo:decls$ fix-decls fixed
ocotillo:decls$ diff -ur orig fixed > diff-000716 
ocotillo:decls$ check-decls <diff-000716 >check-000716.c
ocotillo:decls$ gcc -c -Wall check-000716.c 

--- fix-decls ---
#!/usr/bin/perl -w

use File::Find;
use FileHandle;
use IPC::Open3;
use English;

my ($root) = @ARGV;

if (!defined($root)) {
    die "Usage: $0 root\n";
}

@ARGV = ();

find(
    sub { 
	if ($_ eq 'testsuite' || (-d && /-share$/)) {
	    $File::Find::prune = 1;
	} elsif (-f && -T && /\.c$/ && $_ ne "gnu-regex.c") {
	    push @ARGV, $File::Find::name;
	}
    },
    $root
);

$INPLACE_EDIT = '';
undef $/;			# slurp entire files

while (<>) {
    s/
	^			# line start
	( 
	  \w+			# function name
	)
	(
	  \s*			# spaces
	  \(			# left paren
	  \s*			# spaces
	)
	(
	  (?:\w+\s*,\s*)*	# 1 thru N-1 parameter names
	  \w+			# last parameter name
	)
	(
	  \s*			# spaces
	  \)			# right paren
	)
	(
	  (?:
	    [^;{}()]+;		# trad C parameter decl
	  )*
	)
	(
	  \s*			# spaces
	)
	(?=^{)			# lookahead to make sure we see a
				# right curly brace at the beginning
				# of the line
    /
	fix_decl($1, $2, $3, $4, $5, $6);
    /smgex;

    s/
	^			# line start
	( 
	  \w+			# function name
	)
	\s*			# spaces
	\(			# left paren
	\s*			# spaces
	\)			# right paren
	(?=\s*^{)		# lookahead to make sure we see a
				# right curly brace at the beginning
				# of the line
     /$1 (void)/smgx;

    print;
}

sub fix_decl {
    my ($funcname, $lparen, $params, $rparen, $decls, $spaces) = @_;
    my %h = ();
    my ($param, $decl);

    # Define $bailstr to be the original function declaration.  We
    # return it when we see something which doesn't make sense.
    my $bailstr = $funcname . $lparen . $params . $rparen . $decls . $spaces;

    if ($funcname =~ /^(do|while|if)$/) {
	# 'if', 'do', and 'while' are not function names
	# find_overload_match() in valops.c contains an if statement
	# which is confused as a function if we don't have this test.
	return $bailstr;
    }

    foreach $param (split /\s*,\s*/, $params) {
	if (defined $h{$param} || $param eq 'void') {
	    # Bail; either param has already been encountered or
	    # it's void in which case the decl in question is already
	    # ISO C.
	    return $bailstr;
	}
	$h{$param} = "int $param";	# Default
    }

    $decls =~ s/\s*;\Z//;		# remove final semicolon
    			
    foreach $decl (split /\s*;\s*/, $decls) {
	my ($type, $dparams) = 
	    $decl =~ /^				# beginning of string
	              (.*?)			# type
	              (				# dparams...
		        (?:
			  \**			#  stars
			  \s*			#  spaces
			  \w+			#  identifier
			  \s*			#  spaces
			  ,			#  comma
			  \s*			#  spaces
			)*			# any number of the above
			\**			#  stars
			\s*			#  spaces
			\w+			#  identifier
		      )
		      $				# end of string
		     /sx;
	return $bailstr			if !defined $type || !defined $dparams;
	$type =~ s/\A\s+//;		# nuke leading spaces
	$type =~ s/\s+\Z//;		# nuke trailing spaces
	return $bailstr			if $type eq '';
					# Bail if no type
	foreach $param (split /\s*,\s*/, $dparams) {

	    my ($stars, $stripped_param) = 
		$param =~ /(\**)\s*(\w+)/;

	    if (!defined($stripped_param) || !defined $h{$stripped_param}) {
		# Either we couldn't find the parameter or else
		# the parameter wasn't found in the parameter list
		return $bailstr;
	    }
	    $h{$stripped_param} = "$type $param";
	}
    }

    my $newparams = join(', ', map { $h{$_} } split(/\s*,\s*/, $params));

    my $newdecl = reindent("$funcname ($newparams)\n{\n}\n");
    $newdecl =~ s/{\n}//;
    return $newdecl;
}


sub reindent {
    my ($decl, $line_length) = @_;
    $line_length = 80		unless defined $line_length;
    my ($rfh, $wfh, $efh) = (FileHandle->new, FileHandle->new,
					      FileHandle->new);
    my $pid = open3($wfh, $rfh, $efh, "indent -l$line_length $indentoptions");
    $rfh->input_record_separator(undef);
    $efh->input_record_separator(undef);
    $wfh->print($decl);
    $wfh->close();
    my $replacement = <$rfh>;
    $rfh->close();
    my $errstr = <$efh>;
    $efh->close();
    waitpid $pid, 0;
    $replacement =~ s#\n$##;
    if ($errstr ne "") {
	print STDERR "Check $ARGV...\n$errstr\nInput:$decl\nOutput:$replacement\n\n"
    }
    $replacement;
}

BEGIN {
    @typelist = qw(ADDR32 B_TYPE COMMON_ENTRY_PTR CORE_ADDR CPUSpace
	DCACHE DIE_REF DOUBLEST EXTR EventRecord FDR FILE HWND
	INSN_WORD INT32 LONG LONGEST LPARAM LRESULT PDR PTR
	PTRACE_ARG3_TYPE PXDB_header_ptr Point Ptrace_return RDB_EVENT
	REGISTER_TYPE RgnHandle Rptrace SAVED_BF_PTR
	SAVED_F77_COMMON_PTR SAVED_FUNCTION SYMR TTRACE_ARG_TYPE UINT
	ULONGEST WAITTYPE WPARAM WindowPtr XDR YYSTYPE
	alpha_extra_func_info_t arg_array arg_one arg_type arg_value
	argsin asection attach_continue_t bfd bfd_arch_info_type
	bfd_byte bfd_signed_vma bfd_vma bool_t boolean boolean_t
	bpstat branch_type catch_errors_ftype catch_fork_kind
	cma__t_int_tcb disassemble_info dld_cache_t dnttpointer
	dst_rec_ptr_t dst_sec dst_sect_ref_t dst_type_t file_ptr
	fltset_t fpregset_t func_call gdb_client_data gdb_fpregset_t
	gdb_gregset_t gdb_thread_t gdb_threadref gregset_t
	host_callback insertion_state_t insn_type kern_return_t
	lwpid_t mach_msg_header_t mach_msg_id_t mach_msg_type_name_t
	mach_port_mscount_t mach_port_t memory_page_t memxferfunc
	mips_extra_func_info_t namespace_enum off_t pid_t port_chain_t
	process_state_t procinfo quick_file_entry quick_module_entry
	quick_procedure_entry return_mask rmt_thread_action sec_ptr
	serial_t serial_ttystate sigset_t size_t sltpointer
	stepping_mode_t sysset_t t_inst task_t td_err_e td_thr_state_e
	td_thr_type_e td_thragent_t td_thrhandle_t thread_array_t
	thread_info thread_t threadinfo threadref time_t tree
	ttevents_t ttreq_t ttstate_t ttwopt_t u_long
	ui_file_delete_ftype ui_file_flush_ftype ui_file_fputs_ftype
	ui_file_isatty_ftype ui_file_put_ftype ui_file_rewind_ftype
	va_list value_ptr xdrproc_t);
    $indentoptions = '-T ' . join(' -T ', @typelist);
}
--- end fix-decls ---

--- check-decls ---
#!/usr/bin/perl -w

# Feed this script a unidiff after running fix-decls and it generates
# (on stdout) a program which may be used to test the validity of the
# conversion.  Just run the result through gcc -Wall and if it
# generates any warnings, there's a problem...

undef $/;		# slurp mode
my $diff = <>;		# read entire diff in $diff;

my $decls = '';
my $defns = '';

my %userstructs = ();
my %userenums = ();
my %usertypes = ();
my %funcnames = ();
my $funcname_gensym = 0;		# for names that clash
my @needuse;

while ($diff =~
	/ (
	    ^ 				# beginning of line
	    [^\n]+			# everything til the end of line
	  )
	  \n				# newline
	  (
	    (?:
	      ^				#   beginning of line
	      -				#   minus sign
	      (?: \n			#   either just a newline
		|			#     -- or -- 
	          [^-\n]		#   any character but minus and newline
	          [^\n]*		#   the rest of the line
	          \n    		#   including the newline
	      )
	    )+				# one or more of the above
	  )
	  (
	    (?:
	      ^				#   beginning of line
	      \+			#   plus sign
	      [^+]			#   any character but plus
	      [^\n]*			#   the rest of the line
	      \n			#   including the newline
	    )+				# one or more of the above
	  )
	                                                           /mgx) {
    my ($rettype, $traddecl, $isodecl) = ($1, $2, $3);

    # Remove leading diff character from the lines extracted
    foreach ($rettype, $traddecl, $isodecl) {
	s/^.//mg;
    }

    # Find type names in parameter list
    my $parmdecls = $traddecl;
    $parmdecls =~ s/^\w+\s*\([^)]*\)//;
    foreach my $parm (split /\s*;\s*/, $parmdecls) {
	$parm =~ s/\s*\**\w+(,|$).*$//;
	analyze_type($parm);
    }

    # Resolve collisions between function name (either due to statics
    # or due to the names being in different branches of an ifdef)
    my ($funcname) = $traddecl =~ /^(\w+)/;
    if (defined $funcnames{$funcname}) {
	foreach ($traddecl, $isodecl) {
	    s/\b$funcname\b/${funcname}___$funcname_gensym/;
	}
	$funcname .= "___$funcname_gensym";
	$funcname_gensym++;
    }
    $funcnames{$funcname} = $funcname;

    # Nuke comments in the return type
    $rettype =~ s#/\*.*?\*/##g;

    # Nuke partial comment in return type
    $rettype =~ s#^.*?\*/##;

    # Eliminate ``CALLBACK'' from return type
    $rettype =~ s/\bCALLBACK\b//;

    # Eliminate ``extern'' from return type
    $rettype =~ s/\bextern\b//;

    # Eliminate leading and trailing spaces from return type
    $rettype =~ s/^\s*//;
    $rettype =~ s/\s*$//;

    if (($rettype =~ /^#/) || ($rettype eq '')) {
	# preprocessor line or empty string
	$rettype = 'int';
    } elsif ($rettype eq "static") {
	$rettype = 'static int';
    } elsif ($rettype eq "private") {
	$rettype = 'static int';
    } else {
	analyze_type($rettype);
    }

    $isodecl =~ s/\n\Z/;\n/;

    $decls .= "$rettype $isodecl";
    if ($funcname eq "exit") {
	$defns .= "$rettype\n$traddecl\n{\n  for (;;)\n    ;\n}\n\n";
    }
    elsif ($rettype =~ /\bvoid$/) {
	$defns .= "$rettype\n$traddecl\{\n}\n\n";
    } else {
	$defns .= "$rettype\n$traddecl\{\n  $rettype ret;\n"
	       .  "  init___ (&ret);\n  return ret;\n}\n\n";
    }

    if ($rettype =~/\bstatic\b/) {
	push @needuse, $funcname;
    }
}


my $typeidx = 0;

foreach $key (sort keys %usertypes) {
    print "typedef struct t$typeidx { int f$typeidx; } $key;\n";
    $typeidx++;
}

foreach $key (sort keys %userstructs) {
    print "$key { int f$typeidx; };\n";
    $typeidx++;
}

foreach $key (sort keys %userenums) {
    print "$key { e$typeidx };\n";
    $typeidx++;
}

print "#define INLINE\n";
print "#define private\n";
print "#define CONST const\n";
print "#define NORETURN\n";
print "void init___ (void *);\n";

print $decls;
print "\n";
print $defns;

print "void\nuse___ (void)\n{\n";
foreach (@needuse) {
    print "  init___ ($_);\n";
}
print "}\n";

sub analyze_type {
    my ($parm) = @_;
    $parm =~ s/\s*\**\s*$//;
    my $type;
    if ($parm =~ /\b(struct|union)\b/) {
	$parm =~ s/\A.*\b(struct|union)\b/$1/s;
	$parm =~ s/\s*\**\s*\Z//s;
	$userstructs{$parm} = $parm;
    } elsif ($parm =~ /\b(enum)\b/) {
	$parm =~ s/\A.*\b(enum)\b/$1/s;
	$parm =~ s/\s*\**\s*\Z//s;
	$userenums{$parm} = $parm;
    } elsif ((($type) = $parm =~ /(\w+)$/)
	&& ($type !~ /^(int|char|long|short|unsigned|double
			   |register|void|const|static)$/x)) {
	$usertypes{$type} = $type;
    }
}
--- end check-decls ---