This is the mail archive of the
gdb-patches@sources.redhat.com
mailing list for the GDB project.
Re: [PATCH RFC] Convert function definitions to prototyped form
- To: gdb-patches at sourceware dot cygnus dot com
- Subject: Re: [PATCH RFC] Convert function definitions to prototyped form
- From: Kevin Buettner <kevinb at cygnus dot com>
- Date: Sun, 16 Jul 2000 14:42:46 -0700
- References: <1000716213203.ZM31823@ocotillo.lan>
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 ---