bin/pstruct

   1 #!/usr/bin/perl
   2     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
   3         if $running_under_some_shell;
   4 #
   5 #
   6 #   c2ph (aka pstruct)
   7 #   Tom Christiansen, <tchrist@convex.com>
   8 #
   9 #   As pstruct, dump C structures as generated from 'cc -g -S' stabs.
  10 #   As c2ph, do this PLUS generate perl code for getting at the structures.
  11 #
  12 #   See the usage message for more.  If this isn't enough, read the code.
  13 #
  14
  15 =head1 NAME
  16
  17 c2ph, pstruct - Dump C structures as generated from C<cc -g -S> stabs
  18
  19 =head1 SYNOPSIS
  20
  21     c2ph [-dpnP] [var=val] [files ...]
  22
  23 =head2 OPTIONS
  24
  25     Options:
  26
  27     -w  wide; short for: type_width=45 member_width=35 offset_width=8
  28     -x  hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
  29
  30     -n  do not generate perl code  (default when invoked as pstruct)
  31     -p  generate perl code         (default when invoked as c2ph)
  32     -v  generate perl code, with C decls as comments
  33
  34     -i  do NOT recompute sizes for intrinsic datatypes
  35     -a  dump information on intrinsics also
  36
  37     -t  trace execution
  38     -d  spew reams of debugging output
  39
  40     -slist  give comma-separated list a structures to dump
  41
  42 =head1 DESCRIPTION
  43
  44 The following is the old c2ph.doc documentation by Tom Christiansen
  45 <tchrist@perl.com>
  46 Date: 25 Jul 91 08:10:21 GMT
  47
  48 Once upon a time, I wrote a program called pstruct.  It was a perl
  49 program that tried to parse out C structures and display their member
  50 offsets for you.  This was especially useful for people looking at
  51 binary dumps or poking around the kernel.
  52
  53 Pstruct was not a pretty program.  Neither was it particularly robust.
  54 The problem, you see, was that the C compiler was much better at parsing
  55 C than I could ever hope to be.
  56
  57 So I got smart:  I decided to be lazy and let the C compiler parse the C,
  58 which would spit out debugger stabs for me to read.  These were much
  59 easier to parse.  It's still not a pretty program, but at least it's more
  60 robust.
  61
  62 Pstruct takes any .c or .h files, or preferably .s ones, since that's
  63 the format it is going to massage them into anyway, and spits out
  64 listings like this:
  65
  66  struct tty {
  67    int                          tty.t_locker                         000      4
  68    int                          tty.t_mutex_index                    004      4
  69    struct tty *                 tty.t_tp_virt                        008      4
  70    struct clist                 tty.t_rawq                           00c     20
  71      int                        tty.t_rawq.c_cc                      00c      4
  72      int                        tty.t_rawq.c_cmax                    010      4
  73      int                        tty.t_rawq.c_cfx                     014      4
  74      int                        tty.t_rawq.c_clx                     018      4
  75      struct tty *               tty.t_rawq.c_tp_cpu                  01c      4
  76      struct tty *               tty.t_rawq.c_tp_iop                  020      4
  77      unsigned char *            tty.t_rawq.c_buf_cpu                 024      4
  78      unsigned char *            tty.t_rawq.c_buf_iop                 028      4
  79    struct clist                 tty.t_canq                           02c     20
  80      int                        tty.t_canq.c_cc                      02c      4
  81      int                        tty.t_canq.c_cmax                    030      4
  82      int                        tty.t_canq.c_cfx                     034      4
  83      int                        tty.t_canq.c_clx                     038      4
  84      struct tty *               tty.t_canq.c_tp_cpu                  03c      4
  85      struct tty *               tty.t_canq.c_tp_iop                  040      4
  86      unsigned char *            tty.t_canq.c_buf_cpu                 044      4
  87      unsigned char *            tty.t_canq.c_buf_iop                 048      4
  88    struct clist                 tty.t_outq                           04c     20
  89      int                        tty.t_outq.c_cc                      04c      4
  90      int                        tty.t_outq.c_cmax                    050      4
  91      int                        tty.t_outq.c_cfx                     054      4
  92      int                        tty.t_outq.c_clx                     058      4
  93      struct tty *               tty.t_outq.c_tp_cpu                  05c      4
  94      struct tty *               tty.t_outq.c_tp_iop                  060      4
  95      unsigned char *            tty.t_outq.c_buf_cpu                 064      4
  96      unsigned char *            tty.t_outq.c_buf_iop                 068      4
  97    (*int)()                     tty.t_oproc_cpu                      06c      4
  98    (*int)()                     tty.t_oproc_iop                      070      4
  99    (*int)()                     tty.t_stopproc_cpu                   074      4
 100    (*int)()                     tty.t_stopproc_iop                   078      4
 101    struct thread *              tty.t_rsel                           07c      4
 102
 103 etc.
 104
 105
 106 Actually, this was generated by a particular set of options.  You can control
 107 the formatting of each column, whether you prefer wide or fat, hex or decimal,
 108 leading zeroes or whatever.
 109
 110 All you need to be able to use this is a C compiler than generates
 111 BSD/GCC-style stabs.  The B<-g> option on native BSD compilers and GCC
 112 should get this for you.
 113
 114 To learn more, just type a bogus option, like B<-\?>, and a long usage message
 115 will be provided.  There are a fair number of possibilities.
 116
 117 If you're only a C programmer, than this is the end of the message for you.
 118 You can quit right now, and if you care to, save off the source and run it
 119 when you feel like it.  Or not.
 120
 121
 122
 123 But if you're a perl programmer, then for you I have something much more
 124 wondrous than just a structure offset printer.
 125
 126 You see, if you call pstruct by its other incybernation, c2ph, you have a code
 127 generator that translates C code into perl code!  Well, structure and union
 128 declarations at least, but that's quite a bit.
 129
 130 Prior to this point, anyone programming in perl who wanted to interact
 131 with C programs, like the kernel, was forced to guess the layouts of
 132 the C structures, and then hardwire these into his program.  Of course,
 133 when you took your wonderfully crafted program to a system where the
 134 sgtty structure was laid out differently, your program broke.  Which is
 135 a shame.
 136
 137 We've had Larry's h2ph translator, which helped, but that only works on
 138 cpp symbols, not real C, which was also very much needed.  What I offer
 139 you is a symbolic way of getting at all the C structures.  I've couched
 140 them in terms of packages and functions.  Consider the following program:
 141
 142     #!/usr/local/bin/perl
 143
 144     require 'syscall.ph';
 145     require 'sys/time.ph';
 146     require 'sys/resource.ph';
 147
 148     $ru = "\0" x &rusage'sizeof();
 149
 150     syscall(&SYS_getrusage, &RUSAGE_SELF, $ru)      && die "getrusage: $!";
 151
 152     @ru = unpack($t = &rusage'typedef(), $ru);
 153
 154     $utime =  $ru[ &rusage'ru_utime + &timeval'tv_sec  ]
 155            + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6;
 156
 157     $stime =  $ru[ &rusage'ru_stime + &timeval'tv_sec  ]
 158            + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6;
 159
 160     printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime;
 161
 162
 163 As you see, the name of the package is the name of the structure.  Regular
 164 fields are just their own names.  Plus the following accessor functions are
 165 provided for your convenience:
 166
 167     struct      This takes no arguments, and is merely the number of first-level
 168                 elements in the structure.  You would use this for indexing
 169                 into arrays of structures, perhaps like this
 170
 171
 172                     $usec = $u[ &user'u_utimer
 173                                 + (&ITIMER_VIRTUAL * &itimerval'struct)
 174                                 + &itimerval'it_value
 175                                 + &timeval'tv_usec
 176                               ];
 177
 178     sizeof      Returns the bytes in the structure, or the member if
 179                 you pass it an argument, such as
 180
 181                         &rusage'sizeof(&rusage'ru_utime)
 182
 183     typedef     This is the perl format definition for passing to pack and
 184                 unpack.  If you ask for the typedef of a nothing, you get
 185                 the whole structure, otherwise you get that of the member
 186                 you ask for.  Padding is taken care of, as is the magic to
 187                 guarantee that a union is unpacked into all its aliases.
 188                 Bitfields are not quite yet supported however.
 189
 190     offsetof    This function is the byte offset into the array of that
 191                 member.  You may wish to use this for indexing directly
 192                 into the packed structure with vec() if you're too lazy
 193                 to unpack it.
 194
 195     typeof      Not to be confused with the typedef accessor function, this
 196                 one returns the C type of that field.  This would allow
 197                 you to print out a nice structured pretty print of some
 198                 structure without knoning anything about it beforehand.
 199                 No args to this one is a noop.  Someday I'll post such
 200                 a thing to dump out your u structure for you.
 201
 202
 203 The way I see this being used is like basically this:
 204
 205         % h2ph <some_include_file.h  >  /usr/lib/perl/tmp.ph
 206         % c2ph  some_include_file.h  >> /usr/lib/perl/tmp.ph
 207         % install
 208
 209 It's a little tricker with c2ph because you have to get the includes right.
 210 I can't know this for your system, but it's not usually too terribly difficult.
 211
 212 The code isn't pretty as I mentioned  -- I never thought it would be a 1000-
 213 line program when I started, or I might not have begun. :-)  But I would have
 214 been less cavalier in how the parts of the program communicated with each
 215 other, etc.  It might also have helped if I didn't have to divine the makeup
 216 of the stabs on the fly, and then account for micro differences between my
 217 compiler and gcc.
 218
 219 Anyway, here it is.  Should run on perl v4 or greater.  Maybe less.
 220
 221
 222  --tom
 223
 224 =cut
 225
 226 $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
 227
 228 use File::Temp;
 229
 230 ######################################################################
 231
 232 # some handy data definitions.   many of these can be reset later.
 233
 234 $bitorder = 'b';  # ascending; set to B for descending bit fields
 235
 236 %intrinsics =
 237 %template = (
 238     'char',                     'c',
 239     'unsigned char',            'C',
 240     'short',                    's',
 241     'short int',                's',
 242     'unsigned short',           'S',
 243     'unsigned short int',       'S',
 244     'short unsigned int',       'S',
 245     'int',                      'i',
 246     'unsigned int',             'I',
 247     'long',                     'l',
 248     'long int',                 'l',
 249     'unsigned long',            'L',
 250     'unsigned long',            'L',
 251     'long unsigned int',        'L',
 252     'unsigned long int',        'L',
 253     'long long',                'q',
 254     'long long int',            'q',
 255     'unsigned long long',       'Q',
 256     'unsigned long long int',   'Q',
 257     'float',                    'f',
 258     'double',                   'd',
 259     'pointer',                  'p',
 260     'null',                     'x',
 261     'neganull',                 'X',
 262     'bit',                      $bitorder,
 263 );
 264
 265 &buildscrunchlist;
 266 delete $intrinsics{'neganull'};
 267 delete $intrinsics{'bit'};
 268 delete $intrinsics{'null'};
 269
 270 # use -s to recompute sizes
 271 %sizeof = (
 272     'char',                     '1',
 273     'unsigned char',            '1',
 274     'short',                    '2',
 275     'short int',                '2',
 276     'unsigned short',           '2',
 277     'unsigned short int',       '2',
 278     'short unsigned int',       '2',
 279     'int',                      '4',
 280     'unsigned int',             '4',
 281     'long',                     '4',
 282     'long int',                 '4',
 283     'unsigned long',            '4',
 284     'unsigned long int',        '4',
 285     'long unsigned int',        '4',
 286     'long long',                '8',
 287     'long long int',            '8',
 288     'unsigned long long',       '8',
 289     'unsigned long long int',   '8',
 290     'float',                    '4',
 291     'double',                   '8',
 292     'pointer',                  '4',
 293 );
 294
 295 ($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5);
 296
 297 ($offset_fmt, $size_fmt) = ('d', 'd');
 298
 299 $indent = 2;
 300
 301 $CC = 'cc';
 302 $CFLAGS = '-g -S';
 303 $DEFINES = '';
 304
 305 $perl++ if $0 =~ m#/?c2ph$#;
 306
 307 require 'getopts.pl';
 308
 309 use File::Temp 'tempdir';
 310
 311 eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
 312
 313 &Getopts('aixdpvtnws:') || &usage(0);
 314
 315 $opt_d && $debug++;
 316 $opt_t && $trace++;
 317 $opt_p && $perl++;
 318 $opt_v && $verbose++;
 319 $opt_n && ($perl = 0);
 320
 321 if ($opt_w) {
 322     ($type_width, $member_width, $offset_width) = (45, 35, 8);
 323 }
 324 if ($opt_x) {
 325     ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 );
 326 }
 327
 328 eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift;
 329
 330 sub PLUMBER {
 331     select(STDERR);
 332     print "oops, apperent pager foulup\n";
 333     $isatty++;
 334     &usage(1);
 335 }
 336
 337 sub usage {
 338     local($oops) = @_;
 339     unless (-t STDOUT) {
 340         select(STDERR);
 341     } elsif (!$oops) {
 342         $isatty++;
 343         $| = 1;
 344         print "hit <RETURN> for further explanation: ";
 345         <STDIN>;
 346         open (PIPE, "|". ($ENV{PAGER} || 'more'));
 347         $SIG{PIPE} = PLUMBER;
 348         select(PIPE);
 349     }
 350
 351     print "usage: $0 [-dpnP] [var=val] [files ...]\n";
 352
 353     exit unless $isatty;
 354
 355     print <<EOF;
 356
 357 Options:
 358
 359 -w      wide; short for: type_width=45 member_width=35 offset_width=8
 360 -x      hex; short for:  offset_fmt=x offset_width=08 size_fmt=x size_width=04
 361
 362 -n      do not generate perl code  (default when invoked as pstruct)
 363 -p      generate perl code         (default when invoked as c2ph)
 364 -v      generate perl code, with C decls as comments
 365
 366 -i      do NOT recompute sizes for intrinsic datatypes
 367 -a      dump information on intrinsics also
 368
 369 -t      trace execution
 370 -d      spew reams of debugging output
 371
 372 -slist  give comma-separated list a structures to dump
 373
 374
 375 Var Name        Default Value    Meaning
 376
 377 EOF
 378
 379     &defvar('CC', 'which_compiler to call');
 380     &defvar('CFLAGS', 'how to generate *.s files with stabs');
 381     &defvar('DEFINES','any extra cflags or cpp defines, like -I, -D, -U');
 382
 383     print "\n";
 384
 385     &defvar('type_width', 'width of type field   (column 1)');
 386     &defvar('member_width', 'width of member field (column 2)');
 387     &defvar('offset_width', 'width of offset field (column 3)');
 388     &defvar('size_width', 'width of size field   (column 4)');
 389
 390     print "\n";
 391
 392     &defvar('offset_fmt', 'sprintf format type for offset');
 393     &defvar('size_fmt', 'sprintf format type for size');
 394
 395     print "\n";
 396
 397     &defvar('indent', 'how far to indent each nesting level');
 398
 399    print <<'EOF';
 400
 401     If any *.[ch] files are given, these will be catted together into
 402     a temporary *.c file and sent through:
 403             $CC $CFLAGS $DEFINES
 404     and the resulting *.s groped for stab information.  If no files are
 405     supplied, then stdin is read directly with the assumption that it
 406     contains stab information.  All other lines will be ignored.  At
 407     most one *.s file should be supplied.
 408
 409 EOF
 410     close PIPE;
 411     exit 1;
 412 }
 413
 414 sub defvar {
 415     local($var, $msg) = @_;
 416     printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
 417 }
 418
 419 sub safedir {
 420     $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1)
 421       unless (defined($SAFEDIR));
 422 }
 423
 424 undef $SAFEDIR;
 425
 426 $recurse = 1;
 427
 428 if (@ARGV) {
 429     if (grep(!/\.[csh]$/,@ARGV)) {
 430         warn "Only *.[csh] files expected!\n";
 431         &usage;
 432     }
 433     elsif (grep(/\.s$/,@ARGV)) {
 434         if (@ARGV > 1) {
 435             warn "Only one *.s file allowed!\n";
 436             &usage;
 437         }
 438     }
 439     elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
 440         local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
 441         $chdir = "cd $dir && " if $dir;
 442         &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
 443         $ARGV[0] =~ s/\.c$/.s/;
 444     }
 445     else {
 446         &safedir;
 447         $TMP = "$SAFEDIR/c2ph.$$.c";
 448         &system("cat @ARGV > $TMP") && exit 1;
 449         &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1;
 450         unlink $TMP;
 451         $TMP =~ s/\.c$/.s/;
 452         @ARGV = ($TMP);
 453     }
 454 }
 455
 456 if ($opt_s) {
 457     for (split(/[\s,]+/, $opt_s)) {
 458         $interested{$_}++;
 459     }
 460 }
 461
 462
 463 $| = 1 if $debug;
 464
 465 main: {
 466
 467     if ($trace) {
 468         if (-t && !@ARGV) {
 469             print STDERR "reading from your keyboard: ";
 470         } else {
 471             print STDERR "reading from " . (@ARGV ? "@ARGV" : "<STDIN>").": ";
 472         }
 473     }
 474
 475 STAB: while (<>) {
 476         if ($trace && !($. % 10)) {
 477             $lineno = $..'';
 478             print STDERR $lineno, "\b" x length($lineno);
 479         }
 480         next unless /^\s*\.stabs\s+/;
 481         $line = $_;
 482         s/^\s*\.stabs\s+//;
 483         if (s/\\\\"[d,]+$//) {
 484             $saveline .= $line;
 485             $savebar  = $_;
 486             next STAB;
 487         }
 488         if ($saveline) {
 489             s/^"//;
 490             $_ = $savebar . $_;
 491             $line = $saveline;
 492         }
 493         &stab;
 494         $savebar = $saveline = undef;
 495     }
 496     print STDERR "$.\n" if $trace;
 497     unlink $TMP if $TMP;
 498
 499     &compute_intrinsics if $perl && !$opt_i;
 500
 501     print STDERR "resolving types\n" if $trace;
 502
 503     &resolve_types;
 504     &adjust_start_addrs;
 505
 506     $sum = 2 + $type_width + $member_width;
 507     $pmask1 = "%-${type_width}s %-${member_width}s";
 508     $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s";
 509
 510
 511
 512     if ($perl) {
 513         # resolve template -- should be in stab define order, but even this isn't enough.
 514         print STDERR "\nbuilding type templates: " if $trace;
 515         for $i (reverse 0..$#type) {
 516             next unless defined($name = $type[$i]);
 517             next unless defined $struct{$name};
 518             ($iname = $name) =~ s/\..*//;
 519             $build_recursed = 0;
 520             &build_template($name) unless defined $template{&psou($name)} ||
 521                                         $opt_s && !$interested{$iname};
 522         }
 523         print STDERR "\n\n" if $trace;
 524     }
 525
 526     print STDERR "dumping structs: " if $trace;
 527
 528     local($iam);
 529
 530
 531
 532     foreach $name (sort keys %struct) {
 533         ($iname = $name) =~ s/\..*//;
 534         next if $opt_s && !$interested{$iname};
 535         print STDERR "$name " if $trace;
 536
 537         undef @sizeof;
 538         undef @typedef;
 539         undef @offsetof;
 540         undef @indices;
 541         undef @typeof;
 542         undef @fieldnames;
 543
 544         $mname = &munge($name);
 545
 546         $fname = &psou($name);
 547
 548         print "# " if $perl && $verbose;
 549         $pcode = '';
 550         print "$fname {\n" if !$perl || $verbose;
 551         $template{$fname} = &scrunch($template{$fname}) if $perl;
 552         &pstruct($name,$name,0);
 553         print "# " if $perl && $verbose;
 554         print "}\n" if !$perl || $verbose;
 555         print "\n" if $perl && $verbose;
 556
 557         if ($perl) {
 558             print "$pcode";
 559
 560             printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name});
 561
 562             print <<EOF;
 563 sub ${mname}'typedef {
 564     local(\$${mname}'index) = shift;
 565     defined \$${mname}'index
 566         ? \$${mname}'typedef[\$${mname}'index]
 567         : \$${mname}'typedef;
 568 }
 569 EOF
 570
 571             print <<EOF;
 572 sub ${mname}'sizeof {
 573     local(\$${mname}'index) = shift;
 574     defined \$${mname}'index
 575         ? \$${mname}'sizeof[\$${mname}'index]
 576         : \$${mname}'sizeof;
 577 }
 578 EOF
 579
 580             print <<EOF;
 581 sub ${mname}'offsetof {
 582     local(\$${mname}'index) = shift;
 583     defined \$${mname}index
 584         ? \$${mname}'offsetof[\$${mname}'index]
 585         : \$${mname}'sizeof;
 586 }
 587 EOF
 588
 589             print <<EOF;
 590 sub ${mname}'typeof {
 591     local(\$${mname}'index) = shift;
 592     defined \$${mname}index
 593         ? \$${mname}'typeof[\$${mname}'index]
 594         : '$name';
 595 }
 596 EOF
 597
 598             print <<EOF;
 599 sub ${mname}'fieldnames {
 600     \@${mname}'fieldnames;
 601 }
 602 EOF
 603
 604         $iam = ($isastruct{$name} && 's') || ($isaunion{$name} && 'u');
 605
 606             print <<EOF;
 607 sub ${mname}'isastruct {
 608     '$iam';
 609 }
 610 EOF
 611
 612             print "\$${mname}'typedef = '" . &scrunch($template{$fname})
 613                 . "';\n";
 614
 615             print "\$${mname}'sizeof = $sizeof{$name};\n\n";
 616
 617
 618             print "\@${mname}'indices = (", &squishseq(@indices), ");\n";
 619
 620             print "\n";
 621
 622             print "\@${mname}'typedef[\@${mname}'indices] = (",
 623                         join("\n\t", '', @typedef), "\n    );\n\n";
 624             print "\@${mname}'sizeof[\@${mname}'indices] = (",
 625                         join("\n\t", '', @sizeof), "\n    );\n\n";
 626             print "\@${mname}'offsetof[\@${mname}'indices] = (",
 627                         join("\n\t", '', @offsetof), "\n    );\n\n";
 628             print "\@${mname}'typeof[\@${mname}'indices] = (",
 629                         join("\n\t", '', @typeof), "\n    );\n\n";
 630             print "\@${mname}'fieldnames[\@${mname}'indices] = (",
 631                         join("\n\t", '', @fieldnames), "\n    );\n\n";
 632
 633             $template_printed{$fname}++;
 634             $size_printed{$fname}++;
 635         }
 636         print "\n";
 637     }
 638
 639     print STDERR "\n" if $trace;
 640
 641     unless ($perl && $opt_a) {
 642         print "\n1;\n" if $perl;
 643         exit;
 644     }
 645
 646
 647
 648     foreach $name (sort bysizevalue keys %intrinsics) {
 649         next if $size_printed{$name};
 650         print '$',&munge($name),"'sizeof = ", $sizeof{$name}, ";\n";
 651     }
 652
 653     print "\n";
 654
 655     sub bysizevalue { $sizeof{$a} <=> $sizeof{$b}; }
 656
 657
 658     foreach $name (sort keys %intrinsics) {
 659         print '$',&munge($name),"'typedef = '", $template{$name}, "';\n";
 660     }
 661
 662     print "\n1;\n" if $perl;
 663
 664     exit;
 665 }
 666
 667 ########################################################################################
 668
 669
 670 sub stab {
 671     next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/;  # (\d+,\d+) is for sun
 672     s/"//                                               || next;
 673     s/",([x\d]+),([x\d]+),([x\d]+),.*//                 || next;
 674
 675     next if /^\s*$/;
 676
 677     $size = $3 if $3;
 678     $_ = $continued . $_ if length($continued);
 679     if (s/\\\\$//) {
 680       # if last 2 chars of string are '\\' then stab is continued
 681       # in next stab entry
 682       chop;
 683       $continued = $_;
 684       next;
 685     }
 686     $continued = '';
 687
 688
 689     $line = $_;
 690
 691     if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) {
 692         print "$name is a typedef for some funky pointers: $pdecl\n" if $debug;
 693         &pdecl($pdecl);
 694         next;
 695     }
 696
 697
 698
 699     if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) {
 700         local($ident) = $2;
 701         push(@intrinsics, $ident);
 702         $typeno = &typeno($3);
 703         $type[$typeno] = $ident;
 704         print STDERR "intrinsic $ident in new type $typeno\n" if $debug;
 705         next;
 706     }
 707
 708     if (($name, $typeordef, $typeno, $extra, $struct, $_)
 709         = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/)
 710     {
 711         $typeno = &typeno($typeno);  # sun foolery
 712     }
 713     elsif (/^[\$\w]+:/) {
 714         next; # variable
 715     }
 716     else {
 717         warn "can't grok stab: <$_> in: $line " if $_;
 718         next;
 719     }
 720
 721     #warn "got size $size for $name\n";
 722     $sizeof{$name} = $size if $size;
 723
 724     s/;[-\d]*;[-\d]*;$//;  # we don't care about ranges
 725
 726     $typenos{$name} = $typeno;
 727
 728     unless (defined $type[$typeno]) {
 729         &panic("type 0??") unless $typeno;
 730         $type[$typeno] = $name unless defined $type[$typeno];
 731         printf "new type $typeno is $name" if $debug;
 732         if ($extra =~ /\*/ && defined $type[$struct]) {
 733             print ", a typedef for a pointer to " , $type[$struct] if $debug;
 734         }
 735     } else {
 736         printf "%s is type %d", $name, $typeno if $debug;
 737         print ", a typedef for " , $type[$typeno] if $debug;
 738     }
 739     print "\n" if $debug;
 740     #next unless $extra =~ /[su*]/;
 741
 742     #$type[$struct] = $name;
 743
 744     if ($extra =~ /[us*]/) {
 745         &sou($name, $extra);
 746         $_ = &sdecl($name, $_, 0);
 747     }
 748     elsif (/^=ar/) {
 749         print "it's a bare array typedef -- that's pretty sick\n" if $debug;
 750         $_ = "$typeno$_";
 751         $scripts = '';
 752         $_ = &adecl($_,1);
 753
 754     }
 755     elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) {  # the ?'s are for gcc
 756         push(@intrinsics, $2);
 757         $typeno = &typeno($3);
 758         $type[$typeno] = $2;
 759         print STDERR "intrinsic $2 in new type $typeno\n" if $debug;
 760     }
 761     elsif (s/^=e//) { # blessed be thy compiler; mine won't do this
 762         &edecl;
 763     }
 764     else {
 765         warn "Funny remainder for $name on line $_ left in $line " if $_;
 766     }
 767 }
 768
 769 sub typeno {  # sun thinks types are (0,27) instead of just 27
 770     local($_) = @_;
 771     s/\(\d+,(\d+)\)/$1/;
 772     $_;
 773 }
 774
 775 sub pstruct {
 776     local($what,$prefix,$base) = @_;
 777     local($field, $fieldname, $typeno, $count, $offset, $entry);
 778     local($fieldtype);
 779     local($type, $tname);
 780     local($mytype, $mycount, $entry2);
 781     local($struct_count) = 0;
 782     local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt);
 783     local($bits,$bytes);
 784     local($template);
 785
 786
 787     local($mname) = &munge($name);
 788
 789     sub munge {
 790         local($_) = @_;
 791         s/[\s\$\.]/_/g;
 792         $_;
 793     }
 794
 795     local($sname) = &psou($what);
 796
 797     $nesting++;
 798
 799     for $field (split(/;/, $struct{$what})) {
 800         $pad = $prepad = 0;
 801         $entry = '';
 802         ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field);
 803
 804         $type = $type[$typeno];
 805
 806         $type =~ /([^[]*)(\[.*\])?/;
 807         $mytype = $1;
 808         $count .= $2;
 809         $fieldtype = &psou($mytype);
 810
 811         local($fname) = &psou($name);
 812
 813         if ($build_templates) {
 814
 815             $pad = ($offset - ($lastoffset + $lastlength))/8
 816                 if defined $lastoffset;
 817
 818             if (! $finished_template{$sname}) {
 819                 if ($isaunion{$what}) {
 820                     $template{$sname} .= 'X' x $revpad . ' '    if $revpad;
 821                 } else {
 822                     $template{$sname} .= 'x' x $pad    . ' '    if $pad;
 823                 }
 824             }
 825
 826             $template = &fetch_template($type);
 827             &repeat_template($template,$count);
 828
 829             if (! $finished_template{$sname}) {
 830                 $template{$sname} .= $template;
 831             }
 832
 833             $revpad = $length/8 if $isaunion{$what};
 834
 835             ($lastoffset, $lastlength) = ($offset, $length);
 836
 837         } else {
 838             print '# ' if $perl && $verbose;
 839             $entry = sprintf($pmask1,
 840                         ' ' x ($nesting * $indent) . $fieldtype,
 841                         "$prefix.$fieldname" . $count);
 842
 843             $entry =~ s/(\*+)( )/$2$1/;
 844
 845             printf $pmask2,
 846                     $entry,
 847                     ($base+$offset)/8,
 848                     ($bits = ($base+$offset)%8) ? ".$bits" : "  ",
 849                     $length/8,
 850                     ($bits = $length % 8) ? ".$bits": ""
 851                         if !$perl || $verbose;
 852
 853             if ($perl) {
 854                 $template = &fetch_template($type);
 855                 &repeat_template($template,$count);
 856             }
 857
 858             if ($perl && $nesting == 1) {
 859
 860                 push(@sizeof, int($length/8) .",\t# $fieldname");
 861                 push(@offsetof, int($offset/8) .",\t# $fieldname");
 862                 local($little) = &scrunch($template);
 863                 push(@typedef, "'$little', \t# $fieldname");
 864                 $type =~ s/(struct|union) //;
 865                 push(@typeof, "'$mytype" . ($count ? $count : '') .
 866                     "',\t# $fieldname");
 867                 push(@fieldnames, "'$fieldname',");
 868             }
 869
 870             print '  ', ' ' x $indent x $nesting, $template
 871                                 if $perl && $verbose;
 872
 873             print "\n" if !$perl || $verbose;
 874
 875         }
 876         if ($perl) {
 877             local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1;
 878             $mycount *= &scripts2count($count) if $count;
 879             if ($nesting==1 && !$build_templates) {
 880                 $pcode .= sprintf("sub %-32s { %4d; }\n",
 881                         "${mname}'${fieldname}", $struct_count);
 882                 push(@indices, $struct_count);
 883             }
 884             $struct_count += $mycount;
 885         }
 886
 887
 888         &pstruct($type, "$prefix.$fieldname", $base+$offset)
 889                 if $recurse && defined $struct{$type};
 890     }
 891
 892     $countof{$what} = $struct_count unless defined $countof{$whati};
 893
 894     $template{$sname} .= '$' if $build_templates;
 895     $finished_template{$sname}++;
 896
 897     if ($build_templates && !defined $sizeof{$name}) {
 898         local($fmt) = &scrunch($template{$sname});
 899         print STDERR "no size for $name, punting with $fmt..." if $debug;
 900         eval '$sizeof{$name} = length(pack($fmt, ()))';
 901         if ($@) {
 902             chop $@;
 903             warn "couldn't get size for \$name: $@";
 904         } else {
 905             print STDERR $sizeof{$name}, "\n" if $debUg;
 906         }
 907     }
 908
 909     --$nesting;
 910 }
 911
 912
 913 sub psize {
 914     local($me) = @_;
 915     local($amstruct) = $struct{$me} ?  'struct ' : '';
 916
 917     print '$sizeof{\'', $amstruct, $me, '\'} = ';
 918     printf "%d;\n", $sizeof{$me};
 919 }
 920
 921 sub pdecl {
 922     local($pdecl) = @_;
 923     local(@pdecls);
 924     local($tname);
 925
 926     warn "pdecl: $pdecl\n" if $debug;
 927
 928     $pdecl =~ s/\(\d+,(\d+)\)/$1/g;
 929     $pdecl =~ s/\*//g;
 930     @pdecls = split(/=/, $pdecl);
 931     $typeno = $pdecls[0];
 932     $tname = pop @pdecls;
 933
 934     if ($tname =~ s/^f//) { $tname = "$tname&"; }
 935     #else { $tname = "$tname*"; }
 936
 937     for (reverse @pdecls) {
 938         $tname  .= s/^f// ? "&" : "*";
 939         #$tname =~ s/^f(.*)/$1&/;
 940         print "type[$_] is $tname\n" if $debug;
 941         $type[$_] = $tname unless defined $type[$_];
 942     }
 943 }
 944
 945
 946
 947 sub adecl {
 948     ($arraytype, $unknown, $lower, $upper) = ();
 949     #local($typeno);
 950     # global $typeno, @type
 951     local($_, $typedef) = @_;
 952
 953     while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) {
 954         ($arraytype, $unknown) = ($2, $3);
 955         $arraytype = &typeno($arraytype);
 956         $unknown = &typeno($unknown);
 957         if (s/^(\d+);(\d+);//) {
 958             ($lower, $upper) = ($1, $2);
 959             $scripts .= '[' .  ($upper+1) . ']';
 960         } else {
 961             warn "can't find array bounds: $_";
 962         }
 963     }
 964     if (s/^([(,)\d*f=]*),(\d+),(\d+);//) {
 965         ($start, $length) = ($2, $3);
 966         $whatis = $1;
 967         if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) {
 968             $typeno = &typeno($1);
 969             &pdecl($whatis);
 970         } else {
 971             $typeno = &typeno($whatis);
 972         }
 973     } elsif (s/^(\d+)(=[*suf]\d*)//) {
 974         local($whatis) = $2;
 975
 976         if ($whatis =~ /[f*]/) {
 977             &pdecl($whatis);
 978         } elsif ($whatis =~ /[su]/) {  #
 979             print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n"
 980                 if $debug;
 981             #$type[$typeno] = $name unless defined $type[$typeno];
 982             ##printf "new type $typeno is $name" if $debug;
 983             $typeno = $1;
 984             $type[$typeno] = "$prefix.$fieldname";
 985             local($name) = $type[$typeno];
 986             &sou($name, $whatis);
 987             $_ = &sdecl($name, $_, $start+$offset);
 988             1;
 989             $start = $start{$name};
 990             $offset = $sizeof{$name};
 991             $length = $offset;
 992         } else {
 993             warn "what's this? $whatis in $line ";
 994         }
 995     } elsif (/^\d+$/) {
 996         $typeno = $_;
 997     } else {
 998         warn "bad array stab: $_ in $line ";
 999         next STAB;
1000     }
1001     #local($wasdef) = defined($type[$typeno]) && $debug;
1002     #if ($typedef) {
1003         #print "redefining $type[$typeno] to " if $wasdef;
1004         #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno];
1005         #print "$type[$typeno]\n" if $wasdef;
1006     #} else {
1007         #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype];
1008     #}
1009     $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno];
1010     print "type[$arraytype] is $type[$arraytype]\n" if $debug;
1011     print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug;
1012     $_;
1013 }
1014
1015
1016
1017 sub sdecl {
1018     local($prefix, $_, $offset) = @_;
1019
1020     local($fieldname, $scripts, $type, $arraytype, $unknown,
1021     $whatis, $pdecl, $upper,$lower, $start,$length) = ();
1022     local($typeno,$sou);
1023
1024
1025 SFIELD:
1026     while (/^([^;]+);/) {
1027         $scripts = '';
1028         warn "sdecl $_\n" if $debug;
1029         if (s/^([\$\w]+)://) {
1030             $fieldname = $1;
1031         } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { #
1032             $typeno = &typeno($1);
1033             $type[$typeno] = "$prefix.$fieldname";
1034             local($name) = "$prefix.$fieldname";
1035             &sou($name,$2);
1036             $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1037             $start = $start{$name};
1038             $offset += $sizeof{$name};
1039             #print "done with anon, start is $start, offset is $offset\n";
1040             #next SFIELD;
1041         } else  {
1042             warn "weird field $_ of $line" if $debug;
1043             next STAB;
1044             #$fieldname = &gensym;
1045             #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1046         }
1047
1048         if (/^(\d+|\(\d+,\d+\))=ar/) {
1049             $_ = &adecl($_);
1050         }
1051         elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) {
1052           ($start, $length) =  ($2, $3);
1053           &panic("no length?") unless $length;
1054           $typeno = &typeno($1) if $1;
1055         }
1056         elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) {
1057             ($start, $length) =  ($2, $3);
1058             &panic("no length?") unless $length;
1059             $typeno = &typeno($1) if $1;
1060         }
1061         elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) {
1062             ($pdecl, $start, $length) =  ($1,$5,$6);
1063             &pdecl($pdecl);
1064         }
1065         elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct
1066             ($typeno, $sou) = ($1, $2);
1067             $typeno = &typeno($typeno);
1068             if (defined($type[$typeno])) {
1069                 warn "now how did we get type $1 in $fieldname of $line?";
1070             } else {
1071                 print "anon type $typeno is $prefix.$fieldname\n" if $debug;
1072                 $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno];
1073             };
1074             local($name) = "$prefix.$fieldname";
1075             &sou($name,$sou);
1076             print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug;
1077             $type[$typeno] = "$prefix.$fieldname";
1078             $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset);
1079             $start = $start{$name};
1080             $length = $sizeof{$name};
1081         }
1082         else {
1083             warn "can't grok stab for $name ($_) in line $line ";
1084             next STAB;
1085         }
1086
1087         &panic("no length for $prefix.$fieldname") unless $length;
1088         $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';';
1089     }
1090     if (s/;\d*,(\d+),(\d+);//) {
1091         local($start, $size) = ($1, $2);
1092         $sizeof{$prefix} = $size;
1093         print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug;
1094         $start{$prefix} = $start;
1095     }
1096     $_;
1097 }
1098
1099 sub edecl {
1100     s/;$//;
1101     $enum{$name} = $_;
1102     $_ = '';
1103 }
1104
1105 sub resolve_types {
1106     local($sou);
1107     for $i (0 .. $#type) {
1108         next unless defined $type[$i];
1109         $_ = $type[$i];
1110         unless (/\d/) {
1111             print "type[$i] $type[$i]\n" if $debug;
1112             next;
1113         }
1114         print "type[$i] $_ ==> " if $debug;
1115         s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e;
1116         s/^(\d+)\&/&type($1)/e;
1117         s/^(\d+)/&type($1)/e;
1118         s/(\*+)([^*]+)(\*+)/$1$3$2/;
1119         s/\((\*+)(\w+)(\*+)\)/$3($1$2)/;
1120         s/^(\d+)([\*\[].*)/&type($1).$2/e;
1121         #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge;
1122         $type[$i] = $_;
1123         print "$_\n" if $debug;
1124     }
1125 }
1126 sub type { &psou($type[$_[0]] || "<UNDEFINED>"); }
1127
1128 sub adjust_start_addrs {
1129     for (sort keys %start) {
1130         ($basename = $_) =~ s/\.[^.]+$//;
1131         $start{$_} += $start{$basename};
1132         print "start: $_ @ $start{$_}\n" if $debug;
1133     }
1134 }
1135
1136 sub sou {
1137     local($what, $_) = @_;
1138     /u/ && $isaunion{$what}++;
1139     /s/ && $isastruct{$what}++;
1140 }
1141
1142 sub psou {
1143     local($what) = @_;
1144     local($prefix) = '';
1145     if ($isaunion{$what})  {
1146         $prefix = 'union ';
1147     } elsif ($isastruct{$what})  {
1148         $prefix = 'struct ';
1149     }
1150     $prefix . $what;
1151 }
1152
1153 sub scrunch {
1154     local($_) = @_;
1155
1156     return '' if $_ eq '';
1157
1158     study;
1159
1160     s/\$//g;
1161     s/  / /g;
1162     1 while s/(\w) \1/$1$1/g;
1163
1164     # i wanna say this, but perl resists my efforts:
1165     #      s/(\w)(\1+)/$2 . length($1)/ge;
1166
1167     &quick_scrunch;
1168
1169     s/ $//;
1170
1171     $_;
1172 }
1173
1174 sub buildscrunchlist {
1175     $scrunch_code = "sub quick_scrunch {\n";
1176     for (values %intrinsics) {
1177         $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n";
1178     }
1179     $scrunch_code .= "}\n";
1180     print "$scrunch_code" if $debug;
1181     eval $scrunch_code;
1182     &panic("can't eval scrunch_code $@ \nscrunch_code") if $@;
1183 }
1184
1185 sub fetch_template {
1186     local($mytype) = @_;
1187     local($fmt);
1188     local($count) = 1;
1189
1190     &panic("why do you care?") unless $perl;
1191
1192     if ($mytype =~ s/(\[\d+\])+$//) {
1193         $count .= $1;
1194     }
1195
1196     if ($mytype =~ /\*/) {
1197         $fmt = $template{'pointer'};
1198     }
1199     elsif (defined $template{$mytype}) {
1200         $fmt = $template{$mytype};
1201     }
1202     elsif (defined $struct{$mytype}) {
1203         if (!defined $template{&psou($mytype)}) {
1204             &build_template($mytype) unless $mytype eq $name;
1205         }
1206         elsif ($template{&psou($mytype)} !~ /\$$/) {
1207             #warn "incomplete template for $mytype\n";
1208         }
1209         $fmt = $template{&psou($mytype)} || '?';
1210     }
1211     else {
1212         warn "unknown fmt for $mytype\n";
1213         $fmt = '?';
1214     }
1215
1216     $fmt x $count . ' ';
1217 }
1218
1219 sub compute_intrinsics {
1220     &safedir;
1221     local($TMP) = "$SAFEDIR/c2ph-i.$$.c";
1222     open (TMP, ">$TMP") || die "can't open $TMP: $!";
1223     select(TMP);
1224
1225     print STDERR "computing intrinsic sizes: " if $trace;
1226
1227     undef %intrinsics;
1228
1229     print <<'EOF';
1230 main() {
1231     char *mask = "%d %s\n";
1232 EOF
1233
1234     for $type (@intrinsics) {
1235         next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff
1236         print <<"EOF";
1237     printf(mask,sizeof($type), "$type");
1238 EOF
1239     }
1240
1241     print <<'EOF';
1242     printf(mask,sizeof(char *), "pointer");
1243     exit(0);
1244 }
1245 EOF
1246     close TMP;
1247
1248     select(STDOUT);
1249     open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|");
1250     while (<PIPE>) {
1251         chop;
1252         split(' ',$_,2);;
1253         print "intrinsic $_[1] is size $_[0]\n" if $debug;
1254         $sizeof{$_[1]} = $_[0];
1255         $intrinsics{$_[1]} = $template{$_[0]};
1256     }
1257     close(PIPE) || die "couldn't read intrinsics!";
1258     unlink($TMP, '$SAFEDIR/a.out');
1259     print STDERR "done\n" if $trace;
1260 }
1261
1262 sub scripts2count {
1263     local($_) = @_;
1264
1265     s/^\[//;
1266     s/\]$//;
1267     s/\]\[/*/g;
1268     $_ = eval;
1269     &panic("$_: $@") if $@;
1270     $_;
1271 }
1272
1273 sub system {
1274     print STDERR "@_\n" if $trace;
1275     system @_;
1276 }
1277
1278 sub build_template {
1279     local($name) = @_;
1280
1281     &panic("already got a template for $name") if defined $template{$name};
1282
1283     local($build_templates) = 1;
1284
1285     local($lparen) = '(' x $build_recursed;
1286     local($rparen) = ')' x $build_recursed;
1287
1288     print STDERR "$lparen$name$rparen " if $trace;
1289     $build_recursed++;
1290     &pstruct($name,$name,0);
1291     print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug;
1292     --$build_recursed;
1293 }
1294
1295
1296 sub panic {
1297
1298     select(STDERR);
1299
1300     print "\npanic: @_\n";
1301
1302     exit 1 if $] <= 4.003;  # caller broken
1303
1304     local($i,$_);
1305     local($p,$f,$l,$s,$h,$a,@a,@sub);
1306     for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
1307         @a = @DB'args;
1308         for (@a) {
1309             if (/^StB\000/ && length($_) == length($_main{'_main'})) {
1310                 $_ = sprintf("%s",$_);
1311             }
1312             else {
1313                 s/'/\\'/g;
1314                 s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
1315                 s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
1316                 s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
1317             }
1318         }
1319         $w = $w ? '@ = ' : '$ = ';
1320         $a = $h ? '(' . join(', ', @a) . ')' : '';
1321         push(@sub, "$w&$s$a from file $f line $l\n");
1322         last if $signal;
1323     }
1324     for ($i=0; $i <= $#sub; $i++) {
1325         last if $signal;
1326         print $sub[$i];
1327     }
1328     exit 1;
1329 }
1330
1331 sub squishseq {
1332     local($num);
1333     local($last) = -1e8;
1334     local($string);
1335     local($seq) = '..';
1336
1337     while (defined($num = shift)) {
1338         if ($num == ($last + 1)) {
1339             $string .= $seq unless $inseq++;
1340             $last = $num;
1341             next;
1342         } elsif ($inseq) {
1343             $string .= $last unless $last == -1e8;
1344         }
1345
1346         $string .= ',' if defined $string;
1347         $string .= $num;
1348         $last = $num;
1349         $inseq = 0;
1350     }
1351     $string .= $last if $inseq && $last != -e18;
1352     $string;
1353 }
1354
1355 sub repeat_template {
1356     #  local($template, $scripts) = @_;  have to change caller's values
1357
1358     if ( $_[1] ) {
1359         local($ncount) = &scripts2count($_[1]);
1360         if ($_[0] =~ /^\s*c\s*$/i) {
1361             $_[0] = "A$ncount ";
1362             $_[1] = '';
1363         } else {
1364             $_[0] = $template x $ncount;
1365         }
1366     }
1367 }