1#!/usr/local/bin/perl 2 3use Config; 4use File::Basename qw(&basename &dirname); 5use Cwd; 6use subs qw(link); 7 8sub 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; 39chdir dirname($0); 40$file = basename($0, '.PL'); 41$file .= '.com' if $^O eq 'VMS'; 42 43open OUT,">$file" or die "Can't create $file: $!"; 44 45print "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 50print 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 58print OUT <<'!NO!SUBS!'; 59# 60# 61# c2ph (aka pstruct) 62# Tom Christiansen, <tchrist@convex.com> 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 72c2ph, 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 99The following is the old c2ph.doc documentation by Tom Christiansen 100<tchrist@perl.com> 101Date: 25 Jul 91 08:10:21 GMT 102 103Once upon a time, I wrote a program called pstruct. It was a perl 104program that tried to parse out C structures and display their member 105offsets for you. This was especially useful for people looking at 106binary dumps or poking around the kernel. 107 108Pstruct was not a pretty program. Neither was it particularly robust. 109The problem, you see, was that the C compiler was much better at parsing 110C than I could ever hope to be. 111 112So I got smart: I decided to be lazy and let the C compiler parse the C, 113which would spit out debugger stabs for me to read. These were much 114easier to parse. It's still not a pretty program, but at least it's more 115robust. 116 117Pstruct takes any .c or .h files, or preferably .s ones, since that's 118the format it is going to massage them into anyway, and spits out 119listings 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 158etc. 159 160 161Actually, this was generated by a particular set of options. You can control 162the formatting of each column, whether you prefer wide or fat, hex or decimal, 163leading zeroes or whatever. 164 165All you need to be able to use this is a C compiler than generates 166BSD/GCC-style stabs. The B<-g> option on native BSD compilers and GCC 167should get this for you. 168 169To learn more, just type a bogus option, like B<-\?>, and a long usage message 170will be provided. There are a fair number of possibilities. 171 172If you're only a C programmer, than this is the end of the message for you. 173You can quit right now, and if you care to, save off the source and run it 174when you feel like it. Or not. 175 176 177 178But if you're a perl programmer, then for you I have something much more 179wondrous than just a structure offset printer. 180 181You see, if you call pstruct by its other incybernation, c2ph, you have a code 182generator that translates C code into perl code! Well, structure and union 183declarations at least, but that's quite a bit. 184 185Prior to this point, anyone programming in perl who wanted to interact 186with C programs, like the kernel, was forced to guess the layouts of 187the C structures, and then hardwire these into his program. Of course, 188when you took your wonderfully crafted program to a system where the 189sgtty structure was laid out differently, your program broke. Which is 190a shame. 191 192We've had Larry's h2ph translator, which helped, but that only works on 193cpp symbols, not real C, which was also very much needed. What I offer 194you is a symbolic way of getting at all the C structures. I've couched 195them 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 218As you see, the name of the package is the name of the structure. Regular 219fields are just their own names. Plus the following accessor functions are 220provided 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 258The 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 264It's a little tricker with c2ph because you have to get the includes right. 265I can't know this for your system, but it's not usually too terribly difficult. 266 267The code isn't pretty as I mentioned -- I never thought it would be a 1000- 268line program when I started, or I might not have begun. :-) But I would have 269been less cavalier in how the parts of the program communicated with each 270other, etc. It might also have helped if I didn't have to divine the makeup 271of the stabs on the fly, and then account for micro differences between my 272compiler and gcc. 273 274Anyway, 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 283use 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 320&buildscrunchlist; 321delete $intrinsics{'neganull'}; 322delete $intrinsics{'bit'}; 323delete $intrinsics{'null'}; 324 325# use -s to recompute sizes 326%sizeof = ( 327 'char', '1', 328 'unsigned char', '1', 329 'short', '2', 330 'short int', '2', 331 'unsigned short', '2', 332 'unsigned short int', '2', 333 'short unsigned int', '2', 334 'int', '4', 335 'unsigned int', '4', 336 'long', '4', 337 'long int', '4', 338 'unsigned long', '4', 339 'unsigned long int', '4', 340 'long unsigned int', '4', 341 'long long', '8', 342 'long long int', '8', 343 'unsigned long long', '8', 344 'unsigned long long int', '8', 345 'float', '4', 346 'double', '8', 347 'pointer', '4', 348); 349 350($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5); 351 352($offset_fmt, $size_fmt) = ('d', 'd'); 353 354$indent = 2; 355 356$CC = 'cc'; 357!NO!SUBS! 358 359if (($Config{gccversion} || '') =~ /^(\d+)\.(\d+)/ 360 and ($1 > 3 or ($1 == 3 and $2 >= 2))) { 361 print OUT q/$CFLAGS = '-gstabs -S';/; 362} else { 363 print OUT q/$CFLAGS = '-g -S';/; 364} 365 366print OUT <<'!NO!SUBS!'; 367 368$DEFINES = ''; 369 370$perl++ if $0 =~ m#/?c2ph$#; 371 372require 'getopts.pl'; 373 374use File::Temp 'tempdir'; 375 376eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; 377 378&Getopts('aixdpvtnws:') || &usage(0); 379 380$opt_d && $debug++; 381$opt_t && $trace++; 382$opt_p && $perl++; 383$opt_v && $verbose++; 384$opt_n && ($perl = 0); 385 386if ($opt_w) { 387 ($type_width, $member_width, $offset_width) = (45, 35, 8); 388} 389if ($opt_x) { 390 ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 ); 391} 392 393eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; 394 395sub PLUMBER { 396 select(STDERR); 397 print "oops, apperent pager foulup\n"; 398 $isatty++; 399 &usage(1); 400} 401 402sub usage { 403 local($oops) = @_; 404 unless (-t STDOUT) { 405 select(STDERR); 406 } elsif (!$oops) { 407 $isatty++; 408 $| = 1; 409 print "hit <RETURN> for further explanation: "; 410 <STDIN>; 411 open (PIPE, "|". ($ENV{PAGER} || 'more')); 412 $SIG{PIPE} = PLUMBER; 413 select(PIPE); 414 } 415 416 print "usage: $0 [-dpnP] [var=val] [files ...]\n"; 417 418 exit unless $isatty; 419 420 print <<EOF; 421 422Options: 423 424-w wide; short for: type_width=45 member_width=35 offset_width=8 425-x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04 426 427-n do not generate perl code (default when invoked as pstruct) 428-p generate perl code (default when invoked as c2ph) 429-v generate perl code, with C decls as comments 430 431-i do NOT recompute sizes for intrinsic datatypes 432-a dump information on intrinsics also 433 434-t trace execution 435-d spew reams of debugging output 436 437-slist give comma-separated list a structures to dump 438 439 440Var Name Default Value Meaning 441 442EOF 443 444 &defvar('CC', 'which_compiler to call'); 445 &defvar('CFLAGS', 'how to generate *.s files with stabs'); 446 &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U'); 447 448 print "\n"; 449 450 &defvar('type_width', 'width of type field (column 1)'); 451 &defvar('member_width', 'width of member field (column 2)'); 452 &defvar('offset_width', 'width of offset field (column 3)'); 453 &defvar('size_width', 'width of size field (column 4)'); 454 455 print "\n"; 456 457 &defvar('offset_fmt', 'sprintf format type for offset'); 458 &defvar('size_fmt', 'sprintf format type for size'); 459 460 print "\n"; 461 462 &defvar('indent', 'how far to indent each nesting level'); 463 464 print <<'EOF'; 465 466 If any *.[ch] files are given, these will be catted together into 467 a temporary *.c file and sent through: 468 $CC $CFLAGS $DEFINES 469 and the resulting *.s groped for stab information. If no files are 470 supplied, then stdin is read directly with the assumption that it 471 contains stab information. All other liens will be ignored. At 472 most one *.s file should be supplied. 473 474EOF 475 close PIPE; 476 exit 1; 477} 478 479sub defvar { 480 local($var, $msg) = @_; 481 printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg; 482} 483 484sub safedir { 485 $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1) 486 unless (defined($SAFEDIR)); 487} 488 489undef $SAFEDIR; 490 491$recurse = 1; 492 493if (@ARGV) { 494 if (grep(!/\.[csh]$/,@ARGV)) { 495 warn "Only *.[csh] files expected!\n"; 496 &usage; 497 } 498 elsif (grep(/\.s$/,@ARGV)) { 499 if (@ARGV > 1) { 500 warn "Only one *.s file allowed!\n"; 501 &usage; 502 } 503 } 504 elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { 505 local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; 506 $chdir = "cd $dir && " if $dir; 507 &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; 508 $ARGV[0] =~ s/\.c$/.s/; 509 } 510 else { 511 &safedir; 512 $TMP = "$SAFEDIR/c2ph.$$.c"; 513 &system("cat @ARGV > $TMP") && exit 1; 514 &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1; 515 unlink $TMP; 516 $TMP =~ s/\.c$/.s/; 517 @ARGV = ($TMP); 518 } 519} 520 521if ($opt_s) { 522 for (split(/[\s,]+/, $opt_s)) { 523 $interested{$_}++; 524 } 525} 526 527 528$| = 1 if $debug; 529 530main: { 531 532 if ($trace) { 533 if (-t && !@ARGV) { 534 print STDERR "reading from your keyboard: "; 535 } else { 536 print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": "; 537 } 538 } 539 540STAB: while (<>) { 541 if ($trace && !($. % 10)) { 542 $lineno = $..''; 543 print STDERR $lineno, "\b" x length($lineno); 544 } 545 next unless /^\s*\.stabs\s+/; 546 $line = $_; 547 s/^\s*\.stabs\s+//; 548 if (s/\\\\"[d,]+$//) { 549 $saveline .= $line; 550 $savebar = $_; 551 next STAB; 552 } 553 if ($saveline) { 554 s/^"//; 555 $_ = $savebar . $_; 556 $line = $saveline; 557 } 558 &stab; 559 $savebar = $saveline = undef; 560 } 561 print STDERR "$.\n" if $trace; 562 unlink $TMP if $TMP; 563 564 &compute_intrinsics if $perl && !$opt_i; 565 566 print STDERR "resolving types\n" if $trace; 567 568 &resolve_types; 569 &adjust_start_addrs; 570 571 $sum = 2 + $type_width + $member_width; 572 $pmask1 = "%-${type_width}s %-${member_width}s"; 573 $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s"; 574 575 576 577 if ($perl) { 578 # resolve template -- should be in stab define order, but even this isn't enough. 579 print STDERR "\nbuilding type templates: " if $trace; 580 for $i (reverse 0..$#type) { 581 next unless defined($name = $type[$i]); 582 next unless defined $struct{$name}; 583 ($iname = $name) =~ s/\..*//; 584 $build_recursed = 0; 585 &build_template($name) unless defined $template{&psou($name)} || 586 $opt_s && !$interested{$iname}; 587 } 588 print STDERR "\n\n" if $trace; 589 } 590 591 print STDERR "dumping structs: " if $trace; 592 593 local($iam); 594 595 596 597 foreach $name (sort keys %struct) { 598 ($iname = $name) =~ s/\..*//; 599 next if $opt_s && !$interested{$iname}; 600 print STDERR "$name " if $trace; 601 602 undef @sizeof; 603 undef @typedef; 604 undef @offsetof; 605 undef @indices; 606 undef @typeof; 607 undef @fieldnames; 608 609 $mname = &munge($name); 610 611 $fname = &psou($name); 612 613 print "# " if $perl && $verbose; 614 $pcode = ''; 615 print "$fname {\n" if !$perl || $verbose; 616 $template{$fname} = &scrunch($template{$fname}) if $perl; 617 &pstruct($name,$name,0); 618 print "# " if $perl && $verbose; 619 print "}\n" if !$perl || $verbose; 620 print "\n" if $perl && $verbose; 621 622 if ($perl) { 623 print "$pcode"; 624 625 printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name}); 626 627 print <<EOF; 628sub ${mname}'typedef { 629 local(\$${mname}'index) = shift; 630 defined \$${mname}'index 631 ? \$${mname}'typedef[\$${mname}'index] 632 : \$${mname}'typedef; 633} 634EOF 635 636 print <<EOF; 637sub ${mname}'sizeof { 638 local(\$${mname}'index) = shift; 639 defined \$${mname}'index 640 ? \$${mname}'sizeof[\$${mname}'index] 641 : \$${mname}'sizeof; 642} 643EOF 644 645 print <<EOF; 646sub ${mname}'offsetof { 647 local(\$${mname}'index) = shift; 648 defined \$${mname}index 649 ? \$${mname}'offsetof[\$${mname}'index] 650 : \$${mname}'sizeof; 651} 652EOF 653 654 print <<EOF; 655sub ${mname}'typeof { 656 local(\$${mname}'index) = shift; 657 defined \$${mname}index 658 ? \$${mname}'typeof[\$${mname}'index] 659 : '$name'; 660} 661EOF 662 663 print <<EOF; 664sub ${mname}'fieldnames { 665 \@${mname}'fieldnames; 666} 667EOF 668 669 $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u'); 670 671 print <<EOF; 672sub ${mname}'isastruct { 673 '$iam'; 674} 675EOF 676 677 print "\$${mname}'typedef = '" . &scrunch($template{$fname}) 678 . "';\n"; 679 680 print "\$${mname}'sizeof = $sizeof{$name};\n\n"; 681 682 683 print "\@${mname}'indices = (", &squishseq(@indices), ");\n"; 684 685 print "\n"; 686 687 print "\@${mname}'typedef[\@${mname}'indices] = (", 688 join("\n\t", '', @typedef), "\n );\n\n"; 689 print "\@${mname}'sizeof[\@${mname}'indices] = (", 690 join("\n\t", '', @sizeof), "\n );\n\n"; 691 print "\@${mname}'offsetof[\@${mname}'indices] = (", 692 join("\n\t", '', @offsetof), "\n );\n\n"; 693 print "\@${mname}'typeof[\@${mname}'indices] = (", 694 join("\n\t", '', @typeof), "\n );\n\n"; 695 print "\@${mname}'fieldnames[\@${mname}'indices] = (", 696 join("\n\t", '', @fieldnames), "\n );\n\n"; 697 698 $template_printed{$fname}++; 699 $size_printed{$fname}++; 700 } 701 print "\n"; 702 } 703 704 print STDERR "\n" if $trace; 705 706 unless ($perl && $opt_a) { 707 print "\n1;\n" if $perl; 708 exit; 709 } 710 711 712 713 foreach $name (sort bysizevalue keys %intrinsics) { 714 next if $size_printed{$name}; 715 print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n"; 716 } 717 718 print "\n"; 719 720 sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; } 721 722 723 foreach $name (sort keys %intrinsics) { 724 print '$',&munge($name),"'typedef = '", $template{$name}, "';\n"; 725 } 726 727 print "\n1;\n" if $perl; 728 729 exit; 730} 731 732######################################################################################## 733 734 735sub stab { 736 next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun 737 s/"// || next; 738 s/",([x\d]+),([x\d]+),([x\d]+),.*// || next; 739 740 next if /^\s*$/; 741 742 $size = $3 if $3; 743 $_ = $continued . $_ if length($continued); 744 if (s/\\\\$//) { 745 # if last 2 chars of string are '\\' then stab is continued 746 # in next stab entry 747 chop; 748 $continued = $_; 749 next; 750 } 751 $continued = ''; 752 753 754 $line = $_; 755 756 if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) { 757 print "$name is a typedef for some funky pointers: $pdecl\n" if $debug; 758 &pdecl($pdecl); 759 next; 760 } 761 762 763 764 if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) { 765 local($ident) = $2; 766 push(@intrinsics, $ident); 767 $typeno = &typeno($3); 768 $type[$typeno] = $ident; 769 print STDERR "intrinsic $ident in new type $typeno\n" if $debug; 770 next; 771 } 772 773 if (($name, $typeordef, $typeno, $extra, $struct, $_) 774 = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) 775 { 776 $typeno = &typeno($typeno); # sun foolery 777 } 778 elsif (/^[\$\w]+:/) { 779 next; # variable 780 } 781 else { 782 warn "can't grok stab: <$_> in: $line " if $_; 783 next; 784 } 785 786 #warn "got size $size for $name\n"; 787 $sizeof{$name} = $size if $size; 788 789 s/;[-\d]*;[-\d]*;$//; # we don't care about ranges 790 791 $typenos{$name} = $typeno; 792 793 unless (defined $type[$typeno]) { 794 &panic("type 0??") unless $typeno; 795 $type[$typeno] = $name unless defined $type[$typeno]; 796 printf "new type $typeno is $name" if $debug; 797 if ($extra =~ /\*/ && defined $type[$struct]) { 798 print ", a typedef for a pointer to " , $type[$struct] if $debug; 799 } 800 } else { 801 printf "%s is type %d", $name, $typeno if $debug; 802 print ", a typedef for " , $type[$typeno] if $debug; 803 } 804 print "\n" if $debug; 805 #next unless $extra =~ /[su*]/; 806 807 #$type[$struct] = $name; 808 809 if ($extra =~ /[us*]/) { 810 &sou($name, $extra); 811 $_ = &sdecl($name, $_, 0); 812 } 813 elsif (/^=ar/) { 814 print "it's a bare array typedef -- that's pretty sick\n" if $debug; 815 $_ = "$typeno$_"; 816 $scripts = ''; 817 $_ = &adecl($_,1); 818 819 } 820 elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc 821 push(@intrinsics, $2); 822 $typeno = &typeno($3); 823 $type[$typeno] = $2; 824 print STDERR "intrinsic $2 in new type $typeno\n" if $debug; 825 } 826 elsif (s/^=e//) { # blessed be thy compiler; mine won't do this 827 &edecl; 828 } 829 else { 830 warn "Funny remainder for $name on line $_ left in $line " if $_; 831 } 832} 833 834sub typeno { # sun thinks types are (0,27) instead of just 27 835 local($_) = @_; 836 s/\(\d+,(\d+)\)/$1/; 837 $_; 838} 839 840sub pstruct { 841 local($what,$prefix,$base) = @_; 842 local($field, $fieldname, $typeno, $count, $offset, $entry); 843 local($fieldtype); 844 local($type, $tname); 845 local($mytype, $mycount, $entry2); 846 local($struct_count) = 0; 847 local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt); 848 local($bits,$bytes); 849 local($template); 850 851 852 local($mname) = &munge($name); 853 854 sub munge { 855 local($_) = @_; 856 s/[\s\$\.]/_/g; 857 $_; 858 } 859 860 local($sname) = &psou($what); 861 862 $nesting++; 863 864 for $field (split(/;/, $struct{$what})) { 865 $pad = $prepad = 0; 866 $entry = ''; 867 ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); 868 869 $type = $type[$typeno]; 870 871 $type =~ /([^[]*)(\[.*\])?/; 872 $mytype = $1; 873 $count .= $2; 874 $fieldtype = &psou($mytype); 875 876 local($fname) = &psou($name); 877 878 if ($build_templates) { 879 880 $pad = ($offset - ($lastoffset + $lastlength))/8 881 if defined $lastoffset; 882 883 if (! $finished_template{$sname}) { 884 if ($isaunion{$what}) { 885 $template{$sname} .= 'X' x $revpad . ' ' if $revpad; 886 } else { 887 $template{$sname} .= 'x' x $pad . ' ' if $pad; 888 } 889 } 890 891 $template = &fetch_template($type); 892 &repeat_template($template,$count); 893 894 if (! $finished_template{$sname}) { 895 $template{$sname} .= $template; 896 } 897 898 $revpad = $length/8 if $isaunion{$what}; 899 900 ($lastoffset, $lastlength) = ($offset, $length); 901 902 } else { 903 print '# ' if $perl && $verbose; 904 $entry = sprintf($pmask1, 905 ' ' x ($nesting * $indent) . $fieldtype, 906 "$prefix.$fieldname" . $count); 907 908 $entry =~ s/(\*+)( )/$2$1/; 909 910 printf $pmask2, 911 $entry, 912 ($base+$offset)/8, 913 ($bits = ($base+$offset)%8) ? ".$bits" : " ", 914 $length/8, 915 ($bits = $length % 8) ? ".$bits": "" 916 if !$perl || $verbose; 917 918 if ($perl) { 919 $template = &fetch_template($type); 920 &repeat_template($template,$count); 921 } 922 923 if ($perl && $nesting == 1) { 924 925 push(@sizeof, int($length/8) .",\t# $fieldname"); 926 push(@offsetof, int($offset/8) .",\t# $fieldname"); 927 local($little) = &scrunch($template); 928 push(@typedef, "'$little', \t# $fieldname"); 929 $type =~ s/(struct|union) //; 930 push(@typeof, "'$mytype" . ($count ? $count : '') . 931 "',\t# $fieldname"); 932 push(@fieldnames, "'$fieldname',"); 933 } 934 935 print ' ', ' ' x $indent x $nesting, $template 936 if $perl && $verbose; 937 938 print "\n" if !$perl || $verbose; 939 940 } 941 if ($perl) { 942 local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1; 943 $mycount *= &scripts2count($count) if $count; 944 if ($nesting==1 && !$build_templates) { 945 $pcode .= sprintf("sub %-32s { %4d; }\n", 946 "${mname}'${fieldname}", $struct_count); 947 push(@indices, $struct_count); 948 } 949 $struct_count += $mycount; 950 } 951 952 953 &pstruct($type, "$prefix.$fieldname", $base+$offset) 954 if $recurse && defined $struct{$type}; 955 } 956 957 $countof{$what} = $struct_count unless defined $countof{$whati}; 958 959 $template{$sname} .= '$' if $build_templates; 960 $finished_template{$sname}++; 961 962 if ($build_templates && !defined $sizeof{$name}) { 963 local($fmt) = &scrunch($template{$sname}); 964 print STDERR "no size for $name, punting with $fmt..." if $debug; 965 eval '$sizeof{$name} = length(pack($fmt, ()))'; 966 if ($@) { 967 chop $@; 968 warn "couldn't get size for \$name: $@"; 969 } else { 970 print STDERR $sizeof{$name}, "\n" if $debUg; 971 } 972 } 973 974 --$nesting; 975} 976 977 978sub psize { 979 local($me) = @_; 980 local($amstruct) = $struct{$me} ? 'struct ' : ''; 981 982 print '$sizeof{\'', $amstruct, $me, '\'} = '; 983 printf "%d;\n", $sizeof{$me}; 984} 985 986sub pdecl { 987 local($pdecl) = @_; 988 local(@pdecls); 989 local($tname); 990 991 warn "pdecl: $pdecl\n" if $debug; 992 993 $pdecl =~ s/\(\d+,(\d+)\)/$1/g; 994 $pdecl =~ s/\*//g; 995 @pdecls = split(/=/, $pdecl); 996 $typeno = $pdecls[0]; 997 $tname = pop @pdecls; 998 999 if ($tname =~ s/^f//) { $tname = "$tname&"; } 1000 #else { $tname = "$tname*"; } 1001 1002 for (reverse @pdecls) { 1003 $tname .= s/^f// ? "&" : "*"; 1004 #$tname =~ s/^f(.*)/$1&/; 1005 print "type[$_] is $tname\n" if $debug; 1006 $type[$_] = $tname unless defined $type[$_]; 1007 } 1008} 1009 1010 1011 1012sub adecl { 1013 ($arraytype, $unknown, $lower, $upper) = (); 1014 #local($typeno); 1015 # global $typeno, @type 1016 local($_, $typedef) = @_; 1017 1018 while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) { 1019 ($arraytype, $unknown) = ($2, $3); 1020 $arraytype = &typeno($arraytype); 1021 $unknown = &typeno($unknown); 1022 if (s/^(\d+);(\d+);//) { 1023 ($lower, $upper) = ($1, $2); 1024 $scripts .= '[' . ($upper+1) . ']'; 1025 } else { 1026 warn "can't find array bounds: $_"; 1027 } 1028 } 1029 if (s/^([(,)\d*f=]*),(\d+),(\d+);//) { 1030 ($start, $length) = ($2, $3); 1031 $whatis = $1; 1032 if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) { 1033 $typeno = &typeno($1); 1034 &pdecl($whatis); 1035 } else { 1036 $typeno = &typeno($whatis); 1037 } 1038 } elsif (s/^(\d+)(=[*suf]\d*)//) { 1039 local($whatis) = $2; 1040 1041 if ($whatis =~ /[f*]/) { 1042 &pdecl($whatis); 1043 } elsif ($whatis =~ /[su]/) { # 1044 print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" 1045 if $debug; 1046 #$type[$typeno] = $name unless defined $type[$typeno]; 1047 ##printf "new type $typeno is $name" if $debug; 1048 $typeno = $1; 1049 $type[$typeno] = "$prefix.$fieldname"; 1050 local($name) = $type[$typeno]; 1051 &sou($name, $whatis); 1052 $_ = &sdecl($name, $_, $start+$offset); 1053 1; 1054 $start = $start{$name}; 1055 $offset = $sizeof{$name}; 1056 $length = $offset; 1057 } else { 1058 warn "what's this? $whatis in $line "; 1059 } 1060 } elsif (/^\d+$/) { 1061 $typeno = $_; 1062 } else { 1063 warn "bad array stab: $_ in $line "; 1064 next STAB; 1065 } 1066 #local($wasdef) = defined($type[$typeno]) && $debug; 1067 #if ($typedef) { 1068 #print "redefining $type[$typeno] to " if $wasdef; 1069 #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno]; 1070 #print "$type[$typeno]\n" if $wasdef; 1071 #} else { 1072 #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype]; 1073 #} 1074 $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno]; 1075 print "type[$arraytype] is $type[$arraytype]\n" if $debug; 1076 print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug; 1077 $_; 1078} 1079 1080 1081 1082sub sdecl { 1083 local($prefix, $_, $offset) = @_; 1084 1085 local($fieldname, $scripts, $type, $arraytype, $unknown, 1086 $whatis, $pdecl, $upper,$lower, $start,$length) = (); 1087 local($typeno,$sou); 1088 1089 1090SFIELD: 1091 while (/^([^;]+);/) { 1092 $scripts = ''; 1093 warn "sdecl $_\n" if $debug; 1094 if (s/^([\$\w]+)://) { 1095 $fieldname = $1; 1096 } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # 1097 $typeno = &typeno($1); 1098 $type[$typeno] = "$prefix.$fieldname"; 1099 local($name) = "$prefix.$fieldname"; 1100 &sou($name,$2); 1101 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 1102 $start = $start{$name}; 1103 $offset += $sizeof{$name}; 1104 #print "done with anon, start is $start, offset is $offset\n"; 1105 #next SFIELD; 1106 } else { 1107 warn "weird field $_ of $line" if $debug; 1108 next STAB; 1109 #$fieldname = &gensym; 1110 #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 1111 } 1112 1113 if (/^(\d+|\(\d+,\d+\))=ar/) { 1114 $_ = &adecl($_); 1115 } 1116 elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) { 1117 ($start, $length) = ($2, $3); 1118 &panic("no length?") unless $length; 1119 $typeno = &typeno($1) if $1; 1120 } 1121 elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) { 1122 ($start, $length) = ($2, $3); 1123 &panic("no length?") unless $length; 1124 $typeno = &typeno($1) if $1; 1125 } 1126 elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) { 1127 ($pdecl, $start, $length) = ($1,$5,$6); 1128 &pdecl($pdecl); 1129 } 1130 elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct 1131 ($typeno, $sou) = ($1, $2); 1132 $typeno = &typeno($typeno); 1133 if (defined($type[$typeno])) { 1134 warn "now how did we get type $1 in $fieldname of $line?"; 1135 } else { 1136 print "anon type $typeno is $prefix.$fieldname\n" if $debug; 1137 $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno]; 1138 }; 1139 local($name) = "$prefix.$fieldname"; 1140 &sou($name,$sou); 1141 print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug; 1142 $type[$typeno] = "$prefix.$fieldname"; 1143 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); 1144 $start = $start{$name}; 1145 $length = $sizeof{$name}; 1146 } 1147 else { 1148 warn "can't grok stab for $name ($_) in line $line "; 1149 next STAB; 1150 } 1151 1152 &panic("no length for $prefix.$fieldname") unless $length; 1153 $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';'; 1154 } 1155 if (s/;\d*,(\d+),(\d+);//) { 1156 local($start, $size) = ($1, $2); 1157 $sizeof{$prefix} = $size; 1158 print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; 1159 $start{$prefix} = $start; 1160 } 1161 $_; 1162} 1163 1164sub edecl { 1165 s/;$//; 1166 $enum{$name} = $_; 1167 $_ = ''; 1168} 1169 1170sub resolve_types { 1171 local($sou); 1172 for $i (0 .. $#type) { 1173 next unless defined $type[$i]; 1174 $_ = $type[$i]; 1175 unless (/\d/) { 1176 print "type[$i] $type[$i]\n" if $debug; 1177 next; 1178 } 1179 print "type[$i] $_ ==> " if $debug; 1180 s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e; 1181 s/^(\d+)\&/&type($1)/e; 1182 s/^(\d+)/&type($1)/e; 1183 s/(\*+)([^*]+)(\*+)/$1$3$2/; 1184 s/\((\*+)(\w+)(\*+)\)/$3($1$2)/; 1185 s/^(\d+)([\*\[].*)/&type($1).$2/e; 1186 #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge; 1187 $type[$i] = $_; 1188 print "$_\n" if $debug; 1189 } 1190} 1191sub type { &psou($type[$_[0]] || "<UNDEFINED>"); } 1192 1193sub adjust_start_addrs { 1194 for (sort keys %start) { 1195 ($basename = $_) =~ s/\.[^.]+$//; 1196 $start{$_} += $start{$basename}; 1197 print "start: $_ @ $start{$_}\n" if $debug; 1198 } 1199} 1200 1201sub sou { 1202 local($what, $_) = @_; 1203 /u/ && $isaunion{$what}++; 1204 /s/ && $isastruct{$what}++; 1205} 1206 1207sub psou { 1208 local($what) = @_; 1209 local($prefix) = ''; 1210 if ($isaunion{$what}) { 1211 $prefix = 'union '; 1212 } elsif ($isastruct{$what}) { 1213 $prefix = 'struct '; 1214 } 1215 $prefix . $what; 1216} 1217 1218sub scrunch { 1219 local($_) = @_; 1220 1221 return '' if $_ eq ''; 1222 1223 study; 1224 1225 s/\$//g; 1226 s/ / /g; 1227 1 while s/(\w) \1/$1$1/g; 1228 1229 # i wanna say this, but perl resists my efforts: 1230 # s/(\w)(\1+)/$2 . length($1)/ge; 1231 1232 &quick_scrunch; 1233 1234 s/ $//; 1235 1236 $_; 1237} 1238 1239sub buildscrunchlist { 1240 $scrunch_code = "sub quick_scrunch {\n"; 1241 for (values %intrinsics) { 1242 $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n"; 1243 } 1244 $scrunch_code .= "}\n"; 1245 print "$scrunch_code" if $debug; 1246 eval $scrunch_code; 1247 &panic("can't eval scrunch_code $@ \nscrunch_code") if $@; 1248} 1249 1250sub fetch_template { 1251 local($mytype) = @_; 1252 local($fmt); 1253 local($count) = 1; 1254 1255 &panic("why do you care?") unless $perl; 1256 1257 if ($mytype =~ s/(\[\d+\])+$//) { 1258 $count .= $1; 1259 } 1260 1261 if ($mytype =~ /\*/) { 1262 $fmt = $template{'pointer'}; 1263 } 1264 elsif (defined $template{$mytype}) { 1265 $fmt = $template{$mytype}; 1266 } 1267 elsif (defined $struct{$mytype}) { 1268 if (!defined $template{&psou($mytype)}) { 1269 &build_template($mytype) unless $mytype eq $name; 1270 } 1271 elsif ($template{&psou($mytype)} !~ /\$$/) { 1272 #warn "incomplete template for $mytype\n"; 1273 } 1274 $fmt = $template{&psou($mytype)} || '?'; 1275 } 1276 else { 1277 warn "unknown fmt for $mytype\n"; 1278 $fmt = '?'; 1279 } 1280 1281 $fmt x $count . ' '; 1282} 1283 1284sub compute_intrinsics { 1285 &safedir; 1286 local($TMP) = "$SAFEDIR/c2ph-i.$$.c"; 1287 open (TMP, ">$TMP") || die "can't open $TMP: $!"; 1288 select(TMP); 1289 1290 print STDERR "computing intrinsic sizes: " if $trace; 1291 1292 undef %intrinsics; 1293 1294 print <<'EOF'; 1295main() { 1296 char *mask = "%d %s\n"; 1297EOF 1298 1299 for $type (@intrinsics) { 1300 next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff 1301 print <<"EOF"; 1302 printf(mask,sizeof($type), "$type"); 1303EOF 1304 } 1305 1306 print <<'EOF'; 1307 printf(mask,sizeof(char *), "pointer"); 1308 exit(0); 1309} 1310EOF 1311 close TMP; 1312 1313 select(STDOUT); 1314 open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|"); 1315 while (<PIPE>) { 1316 chop; 1317 split(' ',$_,2);; 1318 print "intrinsic $_[1] is size $_[0]\n" if $debug; 1319 $sizeof{$_[1]} = $_[0]; 1320 $intrinsics{$_[1]} = $template{$_[0]}; 1321 } 1322 close(PIPE) || die "couldn't read intrinsics!"; 1323 unlink($TMP, '$SAFEDIR/a.out'); 1324 print STDERR "done\n" if $trace; 1325} 1326 1327sub scripts2count { 1328 local($_) = @_; 1329 1330 s/^\[//; 1331 s/\]$//; 1332 s/\]\[/*/g; 1333 $_ = eval; 1334 &panic("$_: $@") if $@; 1335 $_; 1336} 1337 1338sub system { 1339 print STDERR "@_\n" if $trace; 1340 system @_; 1341} 1342 1343sub build_template { 1344 local($name) = @_; 1345 1346 &panic("already got a template for $name") if defined $template{$name}; 1347 1348 local($build_templates) = 1; 1349 1350 local($lparen) = '(' x $build_recursed; 1351 local($rparen) = ')' x $build_recursed; 1352 1353 print STDERR "$lparen$name$rparen " if $trace; 1354 $build_recursed++; 1355 &pstruct($name,$name,0); 1356 print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug; 1357 --$build_recursed; 1358} 1359 1360 1361sub panic { 1362 1363 select(STDERR); 1364 1365 print "\npanic: @_\n"; 1366 1367 exit 1 if $] <= 4.003; # caller broken 1368 1369 local($i,$_); 1370 local($p,$f,$l,$s,$h,$a,@a,@sub); 1371 for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { 1372 @a = @DB'args; 1373 for (@a) { 1374 if (/^StB\000/ && length($_) == length($_main{'_main'})) { 1375 $_ = sprintf("%s",$_); 1376 } 1377 else { 1378 s/'/\\'/g; 1379 s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; 1380 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; 1381 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; 1382 } 1383 } 1384 $w = $w ? '@ = ' : '$ = '; 1385 $a = $h ? '(' . join(', ', @a) . ')' : ''; 1386 push(@sub, "$w&$s$a from file $f line $l\n"); 1387 last if $signal; 1388 } 1389 for ($i=0; $i <= $#sub; $i++) { 1390 last if $signal; 1391 print $sub[$i]; 1392 } 1393 exit 1; 1394} 1395 1396sub squishseq { 1397 local($num); 1398 local($last) = -1e8; 1399 local($string); 1400 local($seq) = '..'; 1401 1402 while (defined($num = shift)) { 1403 if ($num == ($last + 1)) { 1404 $string .= $seq unless $inseq++; 1405 $last = $num; 1406 next; 1407 } elsif ($inseq) { 1408 $string .= $last unless $last == -1e8; 1409 } 1410 1411 $string .= ',' if defined $string; 1412 $string .= $num; 1413 $last = $num; 1414 $inseq = 0; 1415 } 1416 $string .= $last if $inseq && $last != -e18; 1417 $string; 1418} 1419 1420sub repeat_template { 1421 # local($template, $scripts) = @_; have to change caller's values 1422 1423 if ( $_[1] ) { 1424 local($ncount) = &scripts2count($_[1]); 1425 if ($_[0] =~ /^\s*c\s*$/i) { 1426 $_[0] = "A$ncount "; 1427 $_[1] = ''; 1428 } else { 1429 $_[0] = $template x $ncount; 1430 } 1431 } 1432} 1433!NO!SUBS! 1434 1435close OUT or die "Can't close $file: $!"; 1436chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; 1437unlink 'pstruct'; 1438print "Linking c2ph to pstruct.\n"; 1439if (defined $Config{d_link}) { 1440 link 'c2ph', 'pstruct'; 1441} else { 1442 unshift @INC, '../lib'; 1443 require File::Copy; 1444 File::Copy::syscopy('c2ph', 'pstruct'); 1445} 1446exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; 1447chdir $origdir; 1448