| [3181] | 1 | #!/usr/local/bin/perl
|
|---|
| 2 |
|
|---|
| 3 | use Config;
|
|---|
| 4 | use File::Basename qw(&basename &dirname);
|
|---|
| 5 | use Cwd;
|
|---|
| 6 | use subs qw(link);
|
|---|
| 7 |
|
|---|
| 8 | sub link { # This is a cut-down version of installperl:link().
|
|---|
| 9 | my($from,$to) = @_;
|
|---|
| 10 | my($success) = 0;
|
|---|
| 11 |
|
|---|
| 12 | eval {
|
|---|
| 13 | CORE::link($from, $to)
|
|---|
| 14 | ? $success++
|
|---|
| 15 | : ($from =~ m#^/afs/# || $to =~ m#^/afs/#)
|
|---|
| 16 | ? die "AFS" # okay inside eval {}
|
|---|
| 17 | : die "Couldn't link $from to $to: $!\n";
|
|---|
| 18 | };
|
|---|
| 19 | if ($@) {
|
|---|
| 20 | warn $@;
|
|---|
| 21 | require File::Copy;
|
|---|
| 22 | File::Copy::copy($from, $to)
|
|---|
| 23 | ? $success++
|
|---|
| 24 | : warn "Couldn't copy $from to $to: $!\n";
|
|---|
| 25 | }
|
|---|
| 26 | $success;
|
|---|
| 27 | }
|
|---|
| 28 |
|
|---|
| 29 | # List explicitly here the variables you want Configure to
|
|---|
| 30 | # generate. Metaconfig only looks for shell variables, so you
|
|---|
| 31 | # have to mention them as if they were shell variables, not
|
|---|
| 32 | # %Config entries. Thus you write
|
|---|
| 33 | # $startperl
|
|---|
| 34 | # to ensure Configure will look for $Config{startperl}.
|
|---|
| 35 |
|
|---|
| 36 | # This forces PL files to create target in same directory as PL file.
|
|---|
| 37 | # This is so that make depend always knows where to find PL derivatives.
|
|---|
| 38 | $origdir = cwd;
|
|---|
| 39 | chdir dirname($0);
|
|---|
| 40 | $file = basename($0, '.PL');
|
|---|
| 41 | $file .= '.com' if $^O eq 'VMS';
|
|---|
| 42 |
|
|---|
| 43 | open OUT,">$file" or die "Can't create $file: $!";
|
|---|
| 44 |
|
|---|
| 45 | print "Extracting $file (with variable substitutions)\n";
|
|---|
| 46 |
|
|---|
| 47 | # In this section, perl variables will be expanded during extraction.
|
|---|
| 48 | # You can use $Config{...} to use Configure variables.
|
|---|
| 49 |
|
|---|
| 50 | print OUT <<"!GROK!THIS!";
|
|---|
| 51 | $Config{startperl}
|
|---|
| 52 | eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
|
|---|
| 53 | if \$running_under_some_shell;
|
|---|
| 54 | !GROK!THIS!
|
|---|
| 55 |
|
|---|
| 56 | # In the following, perl variables are not expanded during extraction.
|
|---|
| 57 |
|
|---|
| 58 | print OUT <<'!NO!SUBS!';
|
|---|
| 59 | #
|
|---|
| 60 | #
|
|---|
| 61 | # c2ph (aka pstruct)
|
|---|
| 62 | # Tom Christiansen, <[email protected]>
|
|---|
| 63 | #
|
|---|
| 64 | # As pstruct, dump C structures as generated from 'cc -g -S' stabs.
|
|---|
| 65 | # As c2ph, do this PLUS generate perl code for getting at the structures.
|
|---|
| 66 | #
|
|---|
| 67 | # See the usage message for more. If this isn't enough, read the code.
|
|---|
| 68 | #
|
|---|
| 69 |
|
|---|
| 70 | =head1 NAME
|
|---|
| 71 |
|
|---|
| 72 | c2ph, pstruct - Dump C structures as generated from C<cc -g -S> stabs
|
|---|
| 73 |
|
|---|
| 74 | =head1 SYNOPSIS
|
|---|
| 75 |
|
|---|
| 76 | c2ph [-dpnP] [var=val] [files ...]
|
|---|
| 77 |
|
|---|
| 78 | =head2 OPTIONS
|
|---|
| 79 |
|
|---|
| 80 | Options:
|
|---|
| 81 |
|
|---|
| 82 | -w wide; short for: type_width=45 member_width=35 offset_width=8
|
|---|
| 83 | -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04
|
|---|
| 84 |
|
|---|
| 85 | -n do not generate perl code (default when invoked as pstruct)
|
|---|
| 86 | -p generate perl code (default when invoked as c2ph)
|
|---|
| 87 | -v generate perl code, with C decls as comments
|
|---|
| 88 |
|
|---|
| 89 | -i do NOT recompute sizes for intrinsic datatypes
|
|---|
| 90 | -a dump information on intrinsics also
|
|---|
| 91 |
|
|---|
| 92 | -t trace execution
|
|---|
| 93 | -d spew reams of debugging output
|
|---|
| 94 |
|
|---|
| 95 | -slist give comma-separated list a structures to dump
|
|---|
| 96 |
|
|---|
| 97 | =head1 DESCRIPTION
|
|---|
| 98 |
|
|---|
| 99 | The following is the old c2ph.doc documentation by Tom Christiansen
|
|---|
| 100 | <[email protected]>
|
|---|
| 101 | Date: 25 Jul 91 08:10:21 GMT
|
|---|
| 102 |
|
|---|
| 103 | Once upon a time, I wrote a program called pstruct. It was a perl
|
|---|
| 104 | program that tried to parse out C structures and display their member
|
|---|
| 105 | offsets for you. This was especially useful for people looking at
|
|---|
| 106 | binary dumps or poking around the kernel.
|
|---|
| 107 |
|
|---|
| 108 | Pstruct was not a pretty program. Neither was it particularly robust.
|
|---|
| 109 | The problem, you see, was that the C compiler was much better at parsing
|
|---|
| 110 | C than I could ever hope to be.
|
|---|
| 111 |
|
|---|
| 112 | So I got smart: I decided to be lazy and let the C compiler parse the C,
|
|---|
| 113 | which would spit out debugger stabs for me to read. These were much
|
|---|
| 114 | easier to parse. It's still not a pretty program, but at least it's more
|
|---|
| 115 | robust.
|
|---|
| 116 |
|
|---|
| 117 | Pstruct takes any .c or .h files, or preferably .s ones, since that's
|
|---|
| 118 | the format it is going to massage them into anyway, and spits out
|
|---|
| 119 | listings like this:
|
|---|
| 120 |
|
|---|
| 121 | struct tty {
|
|---|
| 122 | int tty.t_locker 000 4
|
|---|
| 123 | int tty.t_mutex_index 004 4
|
|---|
| 124 | struct tty * tty.t_tp_virt 008 4
|
|---|
| 125 | struct clist tty.t_rawq 00c 20
|
|---|
| 126 | int tty.t_rawq.c_cc 00c 4
|
|---|
| 127 | int tty.t_rawq.c_cmax 010 4
|
|---|
| 128 | int tty.t_rawq.c_cfx 014 4
|
|---|
| 129 | int tty.t_rawq.c_clx 018 4
|
|---|
| 130 | struct tty * tty.t_rawq.c_tp_cpu 01c 4
|
|---|
| 131 | struct tty * tty.t_rawq.c_tp_iop 020 4
|
|---|
| 132 | unsigned char * tty.t_rawq.c_buf_cpu 024 4
|
|---|
| 133 | unsigned char * tty.t_rawq.c_buf_iop 028 4
|
|---|
| 134 | struct clist tty.t_canq 02c 20
|
|---|
| 135 | int tty.t_canq.c_cc 02c 4
|
|---|
| 136 | int tty.t_canq.c_cmax 030 4
|
|---|
| 137 | int tty.t_canq.c_cfx 034 4
|
|---|
| 138 | int tty.t_canq.c_clx 038 4
|
|---|
| 139 | struct tty * tty.t_canq.c_tp_cpu 03c 4
|
|---|
| 140 | struct tty * tty.t_canq.c_tp_iop 040 4
|
|---|
| 141 | unsigned char * tty.t_canq.c_buf_cpu 044 4
|
|---|
| 142 | unsigned char * tty.t_canq.c_buf_iop 048 4
|
|---|
| 143 | struct clist tty.t_outq 04c 20
|
|---|
| 144 | int tty.t_outq.c_cc 04c 4
|
|---|
| 145 | int tty.t_outq.c_cmax 050 4
|
|---|
| 146 | int tty.t_outq.c_cfx 054 4
|
|---|
| 147 | int tty.t_outq.c_clx 058 4
|
|---|
| 148 | struct tty * tty.t_outq.c_tp_cpu 05c 4
|
|---|
| 149 | struct tty * tty.t_outq.c_tp_iop 060 4
|
|---|
| 150 | unsigned char * tty.t_outq.c_buf_cpu 064 4
|
|---|
| 151 | unsigned char * tty.t_outq.c_buf_iop 068 4
|
|---|
| 152 | (*int)() tty.t_oproc_cpu 06c 4
|
|---|
| 153 | (*int)() tty.t_oproc_iop 070 4
|
|---|
| 154 | (*int)() tty.t_stopproc_cpu 074 4
|
|---|
| 155 | (*int)() tty.t_stopproc_iop 078 4
|
|---|
| 156 | struct thread * tty.t_rsel 07c 4
|
|---|
| 157 |
|
|---|
| 158 | etc.
|
|---|
| 159 |
|
|---|
| 160 |
|
|---|
| 161 | Actually, this was generated by a particular set of options. You can control
|
|---|
| 162 | the formatting of each column, whether you prefer wide or fat, hex or decimal,
|
|---|
| 163 | leading zeroes or whatever.
|
|---|
| 164 |
|
|---|
| 165 | All you need to be able to use this is a C compiler than generates
|
|---|
| 166 | BSD/GCC-style stabs. The B<-g> option on native BSD compilers and GCC
|
|---|
| 167 | should get this for you.
|
|---|
| 168 |
|
|---|
| 169 | To learn more, just type a bogus option, like B<-\?>, and a long usage message
|
|---|
| 170 | will be provided. There are a fair number of possibilities.
|
|---|
| 171 |
|
|---|
| 172 | If you're only a C programmer, than this is the end of the message for you.
|
|---|
| 173 | You can quit right now, and if you care to, save off the source and run it
|
|---|
| 174 | when you feel like it. Or not.
|
|---|
| 175 |
|
|---|
| 176 |
|
|---|
| 177 |
|
|---|
| 178 | But if you're a perl programmer, then for you I have something much more
|
|---|
| 179 | wondrous than just a structure offset printer.
|
|---|
| 180 |
|
|---|
| 181 | You see, if you call pstruct by its other incybernation, c2ph, you have a code
|
|---|
| 182 | generator that translates C code into perl code! Well, structure and union
|
|---|
| 183 | declarations at least, but that's quite a bit.
|
|---|
| 184 |
|
|---|
| 185 | Prior to this point, anyone programming in perl who wanted to interact
|
|---|
| 186 | with C programs, like the kernel, was forced to guess the layouts of
|
|---|
| 187 | the C structures, and then hardwire these into his program. Of course,
|
|---|
| 188 | when you took your wonderfully crafted program to a system where the
|
|---|
| 189 | sgtty structure was laid out differently, your program broke. Which is
|
|---|
| 190 | a shame.
|
|---|
| 191 |
|
|---|
| 192 | We've had Larry's h2ph translator, which helped, but that only works on
|
|---|
| 193 | cpp symbols, not real C, which was also very much needed. What I offer
|
|---|
| 194 | you is a symbolic way of getting at all the C structures. I've couched
|
|---|
| 195 | them in terms of packages and functions. Consider the following program:
|
|---|
| 196 |
|
|---|
| 197 | #!/usr/local/bin/perl
|
|---|
| 198 |
|
|---|
| 199 | require 'syscall.ph';
|
|---|
| 200 | require 'sys/time.ph';
|
|---|
| 201 | require 'sys/resource.ph';
|
|---|
| 202 |
|
|---|
| 203 | $ru = "\0" x &rusage'sizeof();
|
|---|
| 204 |
|
|---|
| 205 | syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!";
|
|---|
| 206 |
|
|---|
| 207 | @ru = unpack($t = &rusage'typedef(), $ru);
|
|---|
| 208 |
|
|---|
| 209 | $utime = $ru[ &rusage'ru_utime + &timeval'tv_sec ]
|
|---|
| 210 | + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6;
|
|---|
| 211 |
|
|---|
| 212 | $stime = $ru[ &rusage'ru_stime + &timeval'tv_sec ]
|
|---|
| 213 | + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6;
|
|---|
| 214 |
|
|---|
| 215 | printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime;
|
|---|
| 216 |
|
|---|
| 217 |
|
|---|
| 218 | As you see, the name of the package is the name of the structure. Regular
|
|---|
| 219 | fields are just their own names. Plus the following accessor functions are
|
|---|
| 220 | provided for your convenience:
|
|---|
| 221 |
|
|---|
| 222 | struct This takes no arguments, and is merely the number of first-level
|
|---|
| 223 | elements in the structure. You would use this for indexing
|
|---|
| 224 | into arrays of structures, perhaps like this
|
|---|
| 225 |
|
|---|
| 226 |
|
|---|
| 227 | $usec = $u[ &user'u_utimer
|
|---|
| 228 | + (&ITIMER_VIRTUAL * &itimerval'struct)
|
|---|
| 229 | + &itimerval'it_value
|
|---|
| 230 | + &timeval'tv_usec
|
|---|
| 231 | ];
|
|---|
| 232 |
|
|---|
| 233 | sizeof Returns the bytes in the structure, or the member if
|
|---|
| 234 | you pass it an argument, such as
|
|---|
| 235 |
|
|---|
| 236 | &rusage'sizeof(&rusage'ru_utime)
|
|---|
| 237 |
|
|---|
| 238 | typedef This is the perl format definition for passing to pack and
|
|---|
| 239 | unpack. If you ask for the typedef of a nothing, you get
|
|---|
| 240 | the whole structure, otherwise you get that of the member
|
|---|
| 241 | you ask for. Padding is taken care of, as is the magic to
|
|---|
| 242 | guarantee that a union is unpacked into all its aliases.
|
|---|
| 243 | Bitfields are not quite yet supported however.
|
|---|
| 244 |
|
|---|
| 245 | offsetof This function is the byte offset into the array of that
|
|---|
| 246 | member. You may wish to use this for indexing directly
|
|---|
| 247 | into the packed structure with vec() if you're too lazy
|
|---|
| 248 | to unpack it.
|
|---|
| 249 |
|
|---|
| 250 | typeof Not to be confused with the typedef accessor function, this
|
|---|
| 251 | one returns the C type of that field. This would allow
|
|---|
| 252 | you to print out a nice structured pretty print of some
|
|---|
| 253 | structure without knoning anything about it beforehand.
|
|---|
| 254 | No args to this one is a noop. Someday I'll post such
|
|---|
| 255 | a thing to dump out your u structure for you.
|
|---|
| 256 |
|
|---|
| 257 |
|
|---|
| 258 | The way I see this being used is like basically this:
|
|---|
| 259 |
|
|---|
| 260 | % h2ph <some_include_file.h > /usr/lib/perl/tmp.ph
|
|---|
| 261 | % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph
|
|---|
| 262 | % install
|
|---|
| 263 |
|
|---|
| 264 | It's a little tricker with c2ph because you have to get the includes right.
|
|---|
| 265 | I can't know this for your system, but it's not usually too terribly difficult.
|
|---|
| 266 |
|
|---|
| 267 | The code isn't pretty as I mentioned -- I never thought it would be a 1000-
|
|---|
| 268 | line program when I started, or I might not have begun. :-) But I would have
|
|---|
| 269 | been less cavalier in how the parts of the program communicated with each
|
|---|
| 270 | other, etc. It might also have helped if I didn't have to divine the makeup
|
|---|
| 271 | of the stabs on the fly, and then account for micro differences between my
|
|---|
| 272 | compiler and gcc.
|
|---|
| 273 |
|
|---|
| 274 | Anyway, here it is. Should run on perl v4 or greater. Maybe less.
|
|---|
| 275 |
|
|---|
| 276 |
|
|---|
| 277 | --tom
|
|---|
| 278 |
|
|---|
| 279 | =cut
|
|---|
| 280 |
|
|---|
| 281 | $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
|
|---|
| 282 |
|
|---|
| 283 | use File::Temp;
|
|---|
| 284 |
|
|---|
| 285 | ######################################################################
|
|---|
| 286 |
|
|---|
| 287 | # some handy data definitions. many of these can be reset later.
|
|---|
| 288 |
|
|---|
| 289 | $bitorder = 'b'; # ascending; set to B for descending bit fields
|
|---|
| 290 |
|
|---|
| 291 | %intrinsics =
|
|---|
| 292 | %template = (
|
|---|
| 293 | 'char', 'c',
|
|---|
| 294 | 'unsigned char', 'C',
|
|---|
| 295 | 'short', 's',
|
|---|
| 296 | 'short int', 's',
|
|---|
| 297 | 'unsigned short', 'S',
|
|---|
| 298 | 'unsigned short int', 'S',
|
|---|
| 299 | 'short unsigned int', 'S',
|
|---|
| 300 | 'int', 'i',
|
|---|
| 301 | 'unsigned int', 'I',
|
|---|
| 302 | 'long', 'l',
|
|---|
| 303 | 'long int', 'l',
|
|---|
| 304 | 'unsigned long', 'L',
|
|---|
| 305 | 'unsigned long', 'L',
|
|---|
| 306 | 'long unsigned int', 'L',
|
|---|
| 307 | 'unsigned long int', 'L',
|
|---|
| 308 | 'long long', 'q',
|
|---|
| 309 | 'long long int', 'q',
|
|---|
| 310 | 'unsigned long long', 'Q',
|
|---|
| 311 | 'unsigned long long int', 'Q',
|
|---|
| 312 | 'float', 'f',
|
|---|
| 313 | 'double', 'd',
|
|---|
| 314 | 'pointer', 'p',
|
|---|
| 315 | 'null', 'x',
|
|---|
| 316 | 'neganull', 'X',
|
|---|
| 317 | 'bit', $bitorder,
|
|---|
| 318 | );
|
|---|
| 319 |
|
|---|
| |
|---|
