3 if test ! -f config.sh; then
5 ln ../../config.sh . || \
6 ln ../../../config.sh . || \
7 (echo "Can't find config.sh."; exit 1)
12 : This forces SH files to create target in same directory as SH file.
13 : This is so that make depend always knows where to find SH derivatives.
15 */*) cd `expr X$0 : 'X\(.*\)/'` ;;
17 echo "Extracting c2ph (with variable substitutions)"
18 : This section of the file will have variable substitutions done on it.
19 : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
20 : Protect any dollar signs and backticks that you do not want interpreted
21 : by putting a backslash in front. You may delete these comments.
23 $spitshell >c2ph <<!GROK!THIS!
28 : In the following dollars and backticks do not need the extra backslash.
29 $spitshell >>c2ph <<'!NO!SUBS!'
32 # Tom Christiansen, <tchrist@convex.com>
34 # As pstruct, dump C structures as generated from 'cc -g -S' stabs.
35 # As c2ph, do this PLUS generate perl code for getting at the structures.
37 # See the usage message for more. If this isn't enough, read the code.
40 $RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 11:56:08 $';
43 ######################################################################
45 # some handy data definitions. many of these can be reset later.
47 $bitorder = 'b'; # ascending; set to B for descending bit fields
55 'unsigned short', 'S',
56 'unsigned short int', 'S',
57 'short unsigned int', 'S',
64 'long unsigned int', 'L',
65 'unsigned long int', 'L',
68 'unsigned long long', 'Q',
69 'unsigned long long int', 'Q',
79 delete $intrinsics{'neganull'};
80 delete $intrinsics{'bit'};
81 delete $intrinsics{'null'};
83 # use -s to recompute sizes
89 'unsigned short', '2',
90 'unsigned short int', '2',
91 'short unsigned int', '2',
97 'unsigned long int', '4',
98 'long unsigned int', '4',
100 'long long int', '8',
101 'unsigned long long', '8',
102 'unsigned long long int', '8',
108 ($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
110 ($offset_fmt, $size_fmt) = ('d', 'd');
118 $perl++ if $0 =~ m#/?c2ph$#;
120 require 'getopts.pl';
122 eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
124 &Getopts('aixdpvtnws:') || &usage(0);
129 $opt_v && $verbose++;
130 $opt_n && ($perl = 0);
133 ($type_width, $member_width, $offset_width) = (45, 35, 8);
136 ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
139 eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
143 print "oops, apperent pager foulup\n";
155 print "hit <RETURN> for further explanation: ";
157 open (PIPE, "|". ($ENV{PAGER} || 'more'));
158 $SIG{PIPE} = PLUMBER;
162 print "usage: $0 [-dpnP] [var=val] [files ...]\n";
170 -w wide; short for: type_width=45 member_width=35 offset_width=8
171 -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x size_width=04
173 -n do not generate perl code (default when invoked as pstruct)
174 -p generate perl code (default when invoked as c2ph)
175 -v generate perl code, with C decls as comments
177 -i do NOT recompute sizes for intrinsic datatypes
178 -a dump information on intrinsics also
181 -d spew reams of debugging output
183 -slist give comma-separated list a structures to dump
186 Var Name Default Value Meaning
190 &defvar('CC', 'which_compiler to call');
191 &defvar('CFLAGS', 'how to generate *.s files with stabs');
192 &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
196 &defvar('type_width', 'width of type field (column 1)');
197 &defvar('member_width', 'width of member field (column 2)');
198 &defvar('offset_width', 'width of offset field (column 3)');
199 &defvar('size_width', 'width of size field (column 4)');
203 &defvar('offset_fmt', 'sprintf format type for offset');
204 &defvar('size_fmt', 'sprintf format type for size');
208 &defvar('indent', 'how far to indent each nesting level');
212 If any *.[ch] files are given, these will be catted together into
213 a temporary *.c file and sent through:
215 and the resulting *.s groped for stab information. If no files are
216 supplied, then stdin is read directly with the assumption that it
217 contains stab information. All other liens will be ignored. At
218 most one *.s file should be supplied.
226 local($var, $msg) = @_;
227 printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg;
233 if (grep(!/\.[csh]$/,@ARGV)) {
234 warn "Only *.[csh] files expected!\n";
237 elsif (grep(/\.s$/,@ARGV)) {
239 warn "Only one *.s file allowed!\n";
243 elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
244 local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
245 $chdir = "cd $dir; " if $dir;
246 &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
247 $ARGV[0] =~ s/\.c$/.s/;
250 $TMP = "/tmp/c2ph.$$.c";
251 &system("cat @ARGV > $TMP") && exit 1;
252 &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1;
260 for (split(/[\s,]+/, $opt_s)) {
272 print STDERR "reading from your keyboard: ";
274 print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
279 if ($trace && !($. % 10)) {
281 print STDERR $lineno, "\b" x length($lineno);
283 next unless /^\s*\.stabs\s+/;
288 print STDERR "$.\n" if $trace;
291 &compute_intrinsics if $perl && !$opt_i;
293 print STDERR "resolving types\n" if $trace;
298 $sum = 2 + $type_width + $member_width;
299 $pmask1 = "%-${type_width}s %-${member_width}s";
300 $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
303 # resolve template -- should be in stab define order, but even this isn't enough.
304 print STDERR "\nbuilding type templates: " if $trace;
305 for $i (reverse 0..$#type) {
306 next unless defined($name = $type[$i]);
307 next unless defined $struct{$name};
309 &build_template($name) unless defined $template{&psou($name)} ||
310 $opt_s && !$interested{$name};
312 print STDERR "\n\n" if $trace;
315 print STDERR "dumping structs: " if $trace;
318 foreach $name (sort keys %struct) {
319 next if $opt_s && !$interested{$name};
320 print STDERR "$name " if $trace;
328 $mname = &munge($name);
330 $fname = &psou($name);
332 print "# " if $perl && $verbose;
334 print "$fname {\n" if !$perl || $verbose;
335 $template{$fname} = &scrunch($template{$fname}) if $perl;
336 &pstruct($name,$name,0);
337 print "# " if $perl && $verbose;
338 print "}\n" if !$perl || $verbose;
339 print "\n" if $perl && $verbose;
344 printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
347 sub ${mname}'typedef {
348 local(\$${mname}'index) = shift;
349 defined \$${mname}'index
350 ? \$${mname}'typedef[\$${mname}'index]
351 : \$${mname}'typedef;
356 sub ${mname}'sizeof {
357 local(\$${mname}'index) = shift;
358 defined \$${mname}'index
359 ? \$${mname}'sizeof[\$${mname}'index]
365 sub ${mname}'offsetof {
366 local(\$${mname}'index) = shift;
367 defined \$${mname}index
368 ? \$${mname}'offsetof[\$${mname}'index]
374 sub ${mname}'typeof {
375 local(\$${mname}'index) = shift;
376 defined \$${mname}index
377 ? \$${mname}'typeof[\$${mname}'index]
383 print "\$${mname}'typedef = '" . &scrunch($template{$fname})
386 print "\$${mname}'sizeof = $sizeof{$name};\n\n";
389 print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
393 print "\@${mname}'typedef[\@${mname}'indices] = (",
394 join("\n\t", '', @typedef), "\n );\n\n";
395 print "\@${mname}'sizeof[\@${mname}'indices] = (",
396 join("\n\t", '', @sizeof), "\n );\n\n";
397 print "\@${mname}'offsetof[\@${mname}'indices] = (",
398 join("\n\t", '', @offsetof), "\n );\n\n";
399 print "\@${mname}'typeof[\@${mname}'indices] = (",
400 join("\n\t", '', @typeof), "\n );\n\n";
402 $template_printed{$fname}++;
403 $size_printed{$fname}++;
408 print STDERR "\n" if $trace;
410 unless ($perl && $opt_a) {
417 foreach $name (sort bysizevalue keys %intrinsics) {
418 next if $size_printed{$name};
419 print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
424 sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
427 foreach $name (sort keys %intrinsics) {
428 print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
436 ########################################################################################
440 next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun
442 s/",([x\d]+),([x\d]+),([x\d]+),.*// || next;
451 if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
452 print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
459 if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {
461 push(@intrinsics, $ident);
462 $typeno = &typeno($3);
463 $type[$typeno] = $ident;
464 print STDERR "intrinsic $ident in new type $typeno\n" if $debug;
468 if (($name, $typeordef, $typeno, $extra, $struct, $_)
469 = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/)
471 $typeno = &typeno($typeno); # sun foolery
473 elsif (/^[\$\w]+:/) {
477 warn "can't grok stab: <$_> in: $line " if $_;
481 #warn "got size $size for $name\n";
482 $sizeof{$name} = $size if $size;
484 s/;[-\d]*;[-\d]*;$//; # we don't care about ranges
486 $typenos{$name} = $typeno;
488 unless (defined $type[$typeno]) {
489 &panic("type 0??") unless $typeno;
490 $type[$typeno] = $name unless defined $type[$typeno];
491 printf "new type $typeno is $name" if $debug;
492 if ($extra =~ /\*/ && defined $type[$struct]) {
493 print ", a typedef for a pointer to " , $type[$struct] if $debug;
496 printf "%s is type %d", $name, $typeno if $debug;
497 print ", a typedef for " , $type[$typeno] if $debug;
499 print "\n" if $debug;
500 #next unless $extra =~ /[su*]/;
502 #$type[$struct] = $name;
504 if ($extra =~ /[us*]/) {
506 $_ = &sdecl($name, $_, 0);
509 print "it's a bare array typedef -- that's pretty sick\n" if $debug;
515 elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc
516 push(@intrinsics, $2);
517 $typeno = &typeno($3);
519 print STDERR "intrinsic $2 in new type $typeno\n" if $debug;
521 elsif (s/^=e//) { # blessed by thy compiler; mine won't do this
525 warn "Funny remainder for $name on line $_ left in $line " if $_;
529 sub typeno { # sun thinks types are (0,27) instead of just 27
536 local($what,$prefix,$base) = @_;
537 local($field, $fieldname, $typeno, $count, $offset, $entry);
539 local($type, $tname);
540 local($mytype, $mycount, $entry2);
541 local($struct_count) = 0;
542 local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
547 local($mname) = &munge($name);
555 local($sname) = &psou($what);
559 for $field (split(/;/, $struct{$what})) {
562 ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field);
564 $type = $type[$typeno];
566 $type =~ /([^[]*)(\[.*\])?/;
569 $fieldtype = &psou($mytype);
571 local($fname) = &psou($name);
573 if ($build_templates) {
575 $pad = ($offset - ($lastoffset + $lastlength))/8
576 if defined $lastoffset;
578 if (! $finished_template{$sname}) {
579 if ($isaunion{$what}) {
580 $template{$sname} .= 'X' x $revpad . ' ' if $revpad;
582 $template{$sname} .= 'x' x $pad . ' ' if $pad;
586 $template = &fetch_template($type) x
587 ($count ? &scripts2count($count) : 1);
589 if (! $finished_template{$sname}) {
590 $template{$sname} .= $template;
593 $revpad = $length/8 if $isaunion{$what};
595 ($lastoffset, $lastlength) = ($offset, $length);
598 print '# ' if $perl && $verbose;
599 $entry = sprintf($pmask1,
600 ' ' x ($nesting * $indent) . $fieldtype,
601 "$prefix.$fieldname" . $count);
603 $entry =~ s/(\*+)( )/$2$1/;
608 ($bits = ($base+$offset)%8) ? ".$bits" : " ",
610 ($bits = $length % 8) ? ".$bits": ""
611 if !$perl || $verbose;
614 if ($perl && $nesting == 1) {
615 $template = &scrunch(&fetch_template($type) x
616 ($count ? &scripts2count($count) : 1));
617 push(@sizeof, int($length/8) .",\t# $fieldname");
618 push(@offsetof, int($offset/8) .",\t# $fieldname");
619 push(@typedef, "'$template', \t# $fieldname");
620 $type =~ s/(struct|union) //;
621 push(@typeof, "'$type" . ($count ? $count : '') .
625 print ' ', ' ' x $indent x $nesting, $template
626 if $perl && $verbose;
628 print "\n" if !$perl || $verbose;
632 local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
633 $mycount *= &scripts2count($count) if $count;
634 if ($nesting==1 && !$build_templates) {
635 $pcode .= sprintf("sub %-32s { %4d; }\n",
636 "${mname}'${fieldname}", $struct_count);
637 push(@indices, $struct_count);
639 $struct_count += $mycount;
643 &pstruct($type, "$prefix.$fieldname", $base+$offset)
644 if $recurse && defined $struct{$type};
647 $countof{$what} = $struct_count unless defined $countof{$whati};
649 $template{$sname} .= '$' if $build_templates;
650 $finished_template{$sname}++;
652 if ($build_templates && !defined $sizeof{$name}) {
653 local($fmt) = &scrunch($template{$sname});
654 print STDERR "no size for $name, punting with $fmt..." if $debug;
655 eval '$sizeof{$name} = length(pack($fmt, ()))';
658 warn "couldn't get size for \$name: $@";
660 print STDERR $sizeof{$name}, "\n" if $debUg;
670 local($amstruct) = $struct{$me} ? 'struct ' : '';
672 print '$sizeof{\'', $amstruct, $me, '\'} = ';
673 printf "%d;\n", $sizeof{$me};
681 warn "pdecl: $pdecl\n" if $debug;
683 $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
685 @pdecls = split(/=/, $pdecl);
686 $typeno = $pdecls[0];
687 $tname = pop @pdecls;
689 if ($tname =~ s/^f//) { $tname = "$tname&"; }
690 #else { $tname = "$tname*"; }
692 for (reverse @pdecls) {
693 $tname .= s/^f// ? "&" : "*";
694 #$tname =~ s/^f(.*)/$1&/;
695 print "type[$_] is $tname\n" if $debug;
696 $type[$_] = $tname unless defined $type[$_];
703 ($arraytype, $unknown, $lower, $upper) = ();
705 # global $typeno, @type
706 local($_, $typedef) = @_;
708 while (s/^((\d+)=)?ar(\d+);//) {
709 ($arraytype, $unknown) = ($2, $3);
710 if (s/^(\d+);(\d+);//) {
711 ($lower, $upper) = ($1, $2);
712 $scripts .= '[' . ($upper+1) . ']';
714 warn "can't find array bounds: $_";
717 if (s/^([\d*f=]*),(\d+),(\d+);//) {
718 ($start, $length) = ($2, $3);
720 if ($whatis =~ /^(\d+)=/) {
726 } elsif (s/^(\d+)(=[*suf]\d*)//) {
729 if ($whatis =~ /[f*]/) {
731 } elsif ($whatis =~ /[su]/) { #
732 print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n"
734 #$type[$typeno] = $name unless defined $type[$typeno];
735 ##printf "new type $typeno is $name" if $debug;
737 $type[$typeno] = "$prefix.$fieldname";
738 local($name) = $type[$typeno];
739 &sou($name, $whatis);
740 $_ = &sdecl($name, $_, $start+$offset);
742 $start = $start{$name};
743 $offset = $sizeof{$name};
746 warn "what's this? $whatis in $line ";
751 warn "bad array stab: $_ in $line ";
754 #local($wasdef) = defined($type[$typeno]) && $debug;
756 #print "redefining $type[$typeno] to " if $wasdef;
757 #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
758 #print "$type[$typeno]\n" if $wasdef;
760 #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
762 $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
763 print "type[$arraytype] is $type[$arraytype]\n" if $debug;
764 print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
771 local($prefix, $_, $offset) = @_;
773 local($fieldname, $scripts, $type, $arraytype, $unknown,
774 $whatis, $pdecl, $upper,$lower, $start,$length) = ();
779 while (/^([^;]+);/) {
781 warn "sdecl $_\n" if $debug;
782 if (s/^([\$\w]+)://) {
784 } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { #
785 $typeno = &typeno($1);
786 $type[$typeno] = "$prefix.$fieldname";
787 local($name) = "$prefix.$fieldname";
789 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
790 $start = $start{$name};
791 $offset += $sizeof{$name};
792 #print "done with anon, start is $start, offset is $offset\n";
795 warn "weird field $_ of $line" if $debug;
797 #$fieldname = &gensym;
798 #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
804 elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
805 ($start, $length) = ($2, $3);
806 &panic("no length?") unless $length;
807 $typeno = &typeno($1) if $1;
809 elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
810 ($pdecl, $start, $length) = ($1,$5,$6);
813 elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
814 ($typeno, $sou) = ($1, $2);
815 $typeno = &typeno($typeno);
816 if (defined($type[$typeno])) {
817 warn "now how did we get type $1 in $fieldname of $line?";
819 print "anon type $typeno is $prefix.$fieldname\n" if $debug;
820 $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
822 local($name) = "$prefix.$fieldname";
824 print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
825 $type[$typeno] = "$prefix.$fieldname";
826 $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
827 $start = $start{$name};
828 $length = $sizeof{$name};
831 warn "can't grok stab for $name ($_) in line $line ";
835 &panic("no length for $prefix.$fieldname") unless $length;
836 $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
838 if (s/;\d*,(\d+),(\d+);//) {
839 local($start, $size) = ($1, $2);
840 $sizeof{$prefix} = $size;
841 print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug;
842 $start{$prefix} = $start;
855 for $i (0 .. $#type) {
856 next unless defined $type[$i];
859 print "type[$i] $type[$i]\n" if $debug;
862 print "type[$i] $_ ==> " if $debug;
863 s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
864 s/^(\d+)\&/&type($1)/e;
865 s/^(\d+)/&type($1)/e;
866 s/(\*+)([^*]+)(\*+)/$1$3$2/;
867 s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
868 s/^(\d+)([\*\[].*)/&type($1).$2/e;
869 #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
871 print "$_\n" if $debug;
874 sub type { &psou($type[$_[0]] || "<UNDEFINED>"); }
876 sub adjust_start_addrs {
877 for (sort keys %start) {
878 ($basename = $_) =~ s/\.[^.]+$//;
879 $start{$_} += $start{$basename};
880 print "start: $_ @ $start{$_}\n" if $debug;
885 local($what, $_) = @_;
886 /u/ && $isaunion{$what}++;
887 /s/ && $isastruct{$what}++;
893 if ($isaunion{$what}) {
895 } elsif ($isastruct{$what}) {
908 1 while s/(\w) \1/$1$1/g;
910 # i wanna say this, but perl resists my efforts:
911 # s/(\w)(\1+)/$2 . length($1)/ge;
920 sub buildscrunchlist {
921 $scrunch_code = "sub quick_scrunch {\n";
922 for (values %intrinsics) {
923 $scrunch_code .= "\ts/($_{2,})/'$_' . length(\$1)/ge;\n";
925 $scrunch_code .= "}\n";
926 print "$scrunch_code" if $debug;
928 &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
936 &panic("why do you care?") unless $perl;
938 if ($mytype =~ s/(\[\d+\])+$//) {
942 if ($mytype =~ /\*/) {
943 $fmt = $template{'pointer'};
945 elsif (defined $template{$mytype}) {
946 $fmt = $template{$mytype};
948 elsif (defined $struct{$mytype}) {
949 if (!defined $template{&psou($mytype)}) {
950 &build_template($mytype) unless $mytype eq $name;
952 elsif ($template{&psou($mytype)} !~ /\$$/) {
953 #warn "incomplete template for $mytype\n";
955 $fmt = $template{&psou($mytype)} || '?';
958 warn "unknown fmt for $mytype\n";
965 sub compute_intrinsics {
966 local($TMP) = "/tmp/c2ph-i.$$.c";
967 open (TMP, ">$TMP") || die "can't open $TMP: $!";
970 print STDERR "computing intrinsic sizes: " if $trace;
976 char *mask = "%d %s\n";
979 for $type (@intrinsics) {
980 next if $type eq 'void';
982 printf(mask,sizeof($type), "$type");
987 printf(mask,sizeof(char *), "pointer");
994 open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|");
998 print "intrinsic $_[1] is size $_[0]\n" if $debug;
999 $sizeof{$_[1]} = $_[0];
1000 $intrinsics{$_[1]} = $template{$_[0]};
1002 close(PIPE) || die "couldn't read intrinsics!";
1003 unlink($TMP, '/tmp/a.out');
1004 print STDERR "done\n" if $trace;
1014 &panic("$_: $@") if $@;
1019 print STDERR "@_\n" if $trace;
1023 sub build_template {
1026 &panic("already got a template for $name") if defined $template{$name};
1028 local($build_templates) = 1;
1030 local($lparen) = '(' x $build_recursed;
1031 local($rparen) = ')' x $build_recursed;
1033 print STDERR "$lparen$name$rparen " if $trace;
1035 &pstruct($name,$name,0);
1036 print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
1045 print "\npanic: @_\n";
1047 exit 1 if $] <= 4.003; # caller broken
1050 local($p,$f,$l,$s,$h,$a,@a,@sub);
1051 for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
1054 if (/^StB\000/ && length($_) == length($_main{'_main'})) {
1055 $_ = sprintf("%s",$_);
1059 s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
1060 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
1061 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
1064 $w = $w ? '@ = ' : '$ = ';
1065 $a = $h ? '(' . join(', ', @a) . ')' : '';
1066 push(@sub, "$w&$s$a from file $f line $l\n");
1069 for ($i=0; $i <= $#sub; $i++) {
1078 local($last) = -1e8;
1082 while (defined($num = shift)) {
1083 if ($num == ($last + 1)) {
1084 $string .= $seq unless $inseq++;
1088 $string .= $last unless $last == -1e8;
1091 $string .= ',' if defined $string;
1096 $string .= $last if $inseq && $last != -e18;