Celestin Apprentice 2/Apprentice-Release2.iso/Tools/MPW/SpiderWEB/FixupMPWSymbols

Text File | 1993-03-20 | 5.1 KB | 218 lines | [TEXT/MPS ]

Perl -s -Sx "{0}" {"Parameters"}
Exit

#!/usr/local/bin/perl

@RecordSizes = (
        1,    "Pad",
        4,    "First",
        2,    "Last",
        0,    "Comment",
        0,    "Dictionary",
        6,    "Module",
        8,    "Entry Point",
        6,    "Size",
        0,    "Contents",
        0,    "Reference",
        0,    "Computed Reference",
        8,    "Filename",
        0,    "Source Statement",
        0,    "Module Begin",
        8,    "Module End",
        0,    "Block Begin",
      12,    "Block End",
       0,    "LocalID",
        0,    "Local Label",
        0,    "Local Type"
);

$* = 1;

push(ARGV, "-") if ($#ARGV == -1);

while ($file = shift @ARGV) {
    (($basename,$extension) = ($file =~ /^(.+)\.([^:]+)\.o$/))
        || die "Failed to parse filename \"$file\"";

    print STDERR "Processing $basename.web -> $basename.$extension -> $file\n"
        if ($debug);

    @web2offs = (0);
    @webline  = ("");
    $pos = 0;

    open(INPUT, "<$basename.web")
        || die "Couldn't open \"$basename.web\" for reading.";

    while (<INPUT>)  {
        push(@web2offs, $pos);
        push(@webline, $_);
        $pos += length($_);
    }

    close(INPUT);

    open(INPUT, "<$basename.$extension")
        || die "Couldn't open \"$basename.$extension\" for reading.";

    @src2web = ();
    $pos = 0;
    @source = ();
    while (<INPUT>) {
        if (/^#line\s+(\d+)/) {
            push(@src2web, $pos, $1);
        }
        $pos += length($_);
    }

    seek(INPUT,0,0);
    while (read(INPUT,$source,1024)) {
        push(@source, $source);
    }

    close(INPUT);

    die "No #line directives for \"$file\"." if ($#src2web == -1);

    open(INPUT, "<$file")
        || die "Couldn't open \"$file\" for reading.";
    open(OUTPUT,">$basename.fix.o")
        || die "Couldn't open \"$basename.fix.o\" for writing.";

    $pos = 0;
    $curchunk = -1;
    until (eof(INPUT)) {
        read(INPUT, $tag, 1);
        if (ord($tag) == 12)    {    # Source statement record
            print STDERR "   Processing source record:\n" if ($debug);

            read(INPUT, $flags, 1);
            read(INPUT, $size, 2);
            read(INPUT, $junk, 4);
            read(INPUT, $fileoffset, (ord($flags) & 128) ? 2 : 4);
            read(INPUT, $codeoffset, (ord($flags) &  64) ? 2 : 4);

            ($size)        = unpack("S", $size);
            $fileoffset    = unpack((ord($flags) & 128) ? "S" : "L", $fileoffset);
            $codeoffset    = unpack((ord($flags) &  64) ? "S" : "L", $codeoffset);
            $size            = $size    - 8
                                        - ((ord($flags) & 128) ? 2 : 4)
                                        - ((ord($flags) &  64) ? 2 : 4);

            @offsets = ();

            until (eof(INPUT)) {
                $pos += 2 while ($pos+2 <= $#src2web && $fileoffset >= $src2web[$pos+2]);
                $pos -= 2 while ($pos-2 >= 0         && $fileoffset < $src2web[$pos]);

                if ($curchunk != $src2web[$pos+1]) {
                    $curchunk = $src2web[$pos+1];
                    $curline  = $curchunk;
                }

                ($blk,$off) = (($fileoffset-1) >> 10, ($fileoffset-1) & 1023);
                $source = substr($source[$blk] . $source[$blk+1], $off, 50);
                ($blk,$source) = $source =~ /^(.|\n)(.*)/;

                MATCH:
                    foreach $matchlen (10, 5, 2) {
                        next if (length($source) < $matchlen && $matchlen > 2);
                        $match = substr($source, 0, $matchlen);

                        print STDERR "Trying to match: $match\n" if ($debug && $try);

                        foreach $matchline (0, 1, -1, 2, 3, -2, 4, 5) {
                            $off = index($webline[$curline+$matchline],$match);

                            next if ($off == -1);
                            next if ($blk eq "\n"
                                && substr($webline[$curline+$matchline], 0, $off) !~ /^\s*$/);

                            $curline += $matchline;
                            last MATCH;
                        }
                    }

                if ($debug) {
                    printf STDERR "      %06d: %06d -> %06d\n",
                        $codeoffset,
                        $fileoffset,
                        $web2offs[$curline];

                    if ($src) {
                        print STDERR "         Src: $source\n";
                        print STDERR "         Web: ", $webline[$curline];
                    }
                }

                push(@offsets, $web2offs[$curline++], $codeoffset);

                last unless ($size > 0);

                $size -= 2;

                read(INPUT, $off, 2);
                ($blk,$off) = unpack("CC", $off);
                $fileoffset += $blk;
                $codeoffset += $off;
            }

            while ($#offsets > 0) {
                $fileoffset = shift @offsets;
                $codeoffset = shift @offsets;

                $out = $junk.pack("LL", $fileoffset+0, $codeoffset+0);
                DELTA:
                    while (1) {
                        ($lfo,$lco) = ($fileoffset,$codeoffset);
                        last unless ($fileoffset = shift @offsets);
                        last unless ($codeoffset = shift @offsets);

                        if ($fileoffset < $lfo || $fileoffset-$lfo > 255
                         || $codeoffset < $lco || $codeoffset-$lco > 255
                        ) {
                            unshift(@offsets, $fileoffset, $codeoffset);

                            last DELTA;
                        }

                        next if ($fileoffset == $lfo);

                        $out .= pack("CC", $fileoffset-$lfo, $codeoffset-$lco);
                    }

                print OUTPUT $tag, pack("CS", 0, length($out)+4), $out;
            }
        } else {
            printf STDERR "   Processing %20s Size", $RecordSizes[2*ord($tag)+1]
                if ($debug && $all);

            if ($size = $RecordSizes[2*ord($tag)]) {
                print STDERR $size, "\n"
                    if ($debug && $all);

                print OUTPUT $tag;
                --$size;
            } else {
                print OUTPUT $tag;
                read(INPUT, $junk, 3);
                print OUTPUT $junk;
                ($size) = unpack("xS", $junk);

                print STDERR $size, "\n"
                    if ($debug && $all);

                $size -= 4;
            }
            if ($size) {
                read(INPUT, $junk, $size);
                print OUTPUT $junk;
            }
        }
    }

    close(INPUT);
    close(OUTPUT);

    &fsetfileinfo("MPS ", "OBJ ", "$basename.fix.o");
}