Subversion Repositories programming

Rev

Blame | Last modification | View Log | RSS feed 

#!/usr/bin/perl -w

$DEBUG = 0;
$us = ""; # underscore char. gcc linux does not add `_' to names !?!

%directives = (
               title => AddPrefixDot,
               if => AddPrefixDot,
               ifdef => AddPrefixDot,
               ifndef => AddPrefixDot,
               ifnotdef => AddPrefixDot,
               else => AddPrefixDot,
               endif => AddPrefixDot,
               include => HandleInclude,
               ".586" => IgnoreLine,
               ".mmx" => IgnoreLine,
               ".xmm" => IgnoreLine,
               ".model" => IgnoreLine,
               ".code" => SetTextSect,
               ".const" => SetTextSect,
               public => HandlePublic,
               extrn => HandleExtern,
               extern => HandleExtern,
               externdef => HandleExtern,
               option => HandleOption,
               end => IgnoreLine,
               );

%UsedRegTypes = (
                 "eax", "l", "ebx", "l", "ecx", "l", "edx", "l",
                 "esi", "l", "edi", "l", "esp", "l", "ebp", "l",
                 "ax", "w", "bx", "w", "cx", "w", "dx", "w",
                 "si", "w", "di", "w", "sp", "w", "bp", "w",
                 );

%RegisterList = ( %UsedRegTypes, 
                  (
                   "ah", "b", "al", "b", "bh", "b", "bl", "b",
                   "ch", "b", "cl", "b", "dh", "b", "dl", "b",
                   "st", "f",
                   "st(0)", "f", "st(1)", "f", "st(2)", "f", "st(3)", "f",
                   "st(4)", "f", "st(5)", "f", "st(6)", "f", "st(7)", "f",
                   "mm0", "q", "mm1", "q", "mm2", "q", "mm3", "q",
                   "mm4", "q", "mm5", "q", "mm6", "q", "mm7", "q",
                   )
                  );

%MemoryTypes = (
                "byte", "b", "char", "b", "bp", "b",
                "word", "w", "sword", "w", "wp", "w",
                "dword", "l", "sdword", "l", "dwp", "l",
                "qword", "q", "sqword", "q", "qwp", "q",
                "real10", "t", "tbyte", "t",
                );

%IntToFloatType = ( "b", "???", # Not supposed to happen!
                    "w", "???", # Not supposed to happen!
                    "l", "s",
                    "q", "l",
                    "t", "t",
                    );

%MemTypeToDef = (
                 "b", "byte", "w", "short", "l", "long", "q", "long",
                 );

%SegAlignTypes = (
                  "byte", "0",
                  "word", "1",
                  "dword", "2",
                  "para", "4",
                  "page", "8",
                  ); 

%SegCombineTypes = (
                    "private", "",
                    "public", ".globl",
                    "stack", "",
                    "common", "",
                    "memory", "",
                    "at", "",
                    );

%SegUseTypes = (
                "use16", "",
                "use32", "",
                "flat", "",
                );

%DAllocTypes = (
                "byte", ".byte", "db", ".byte",
                "sword", ".short", "word", ".word", "dw", ".word",
                "sdword", ".long", "dword", ".long", "dd", ".long",
                "ptr", ".long",
                "fword", "", "df", "",
                "sqword", ".quad", "qword", ".quad", "dq", ".quad",
                "tbyte", "", "dt", "",
                "real4", ".single",
                "real8", ".double",
                "real10", ".tfloat",
                );

%DAllocAlignTypes = (
                  ".byte", "0",
                  ".word", "1",
                  ".short", "1",
                  ".long", "2",
                  ".quad", "3",
                  ".single", "2",
                  ".double", "3",
                  ".tfloat", "4",
                  ); 

%LabelTypeToInst = (
                    ".byte", "b",
                    ".short", "w", ".word", "w",
                    ".long", "l",
                    ".quad", "q",
                    ".single", "s",
                    ".double", "l",
                    ".tfloat", "t",
                    );

sub PrintHash {
    my ( %h ) = @_;
    while(($key, $value) = each %h) {
        print "#$key: $value\n";
    }
    print "\n";
}

PrintHash( %directives ) if $DEBUG;
PrintHash( %UsedRegTypes ) if $DEBUG;
PrintHash( %RegisterList ) if $DEBUG;
PrintHash( %MemoryTypes ) if $DEBUG;
PrintHash( %MemTypeToDef ) if $DEBUG;

print "\nProgram Results:\n\n" if $DEBUG;

$warn_fixed = 0;
$first = $second = $body = $rest = $indent = "";
$old_prologue = $old_epilogue = $prologue = $epilogue = 1;
$FuncName = $FuncType = "";
@FuncArgs = ();
@FuncArgsRef = ();
@UsedRegs = ();
@LabelTypes = ();
@EquList = ();

unless ( $#ARGV == 1 ) {
    printf STDERR "Usages: $0 <in-asm-file> <out-s-file>\n";
    exit -1;
}

$asmFile = $ARGV[0];
open STDIN, $asmFile
    or die "Cannot open input file `$asmFile': $!\n";

#($asmOutFile) = (lc($asmFile) =~ /^(.*)\.asm$/);
$asmOutFile = $ARGV[1];
open STDOUT, ">$asmOutFile"
    or die "Cannot open output file `$asmOutFile.s': $!\n";

$warn_fixed = 1 if ( defined($ARGV[1]) && ($ARGV[1] eq "-wfixed") );

$asmFile =~ /[^\/]+$/;
print ".file \"$&\"\n";
print "# Auto-converted from Intel's assembly format to AT&T's format\n\n";

# Find all labels & equs in advance:
while( <> ) {
    my ( $ename, $etype, $ltype );

    CanonizeAndComment( $_ );
    next unless defined $first;

    # Handle COMMENTS:
    if ( uc($first) eq "COMMENT" ) {
        while ( ($_ = <>) !~ /\^/ ) {
            ;
        }
        next;
    }

    if ( $first =~ /:$/ ) {
        $LabelTypes{ $` } = "";
        next;
    }

    if ( lc $first eq ".data" ) {
        my ( $dtype );

        while ( ($_ = <>) !~ /^\./ ) {
            CanonizeAndComment();
            $etype = $directives{ lc $first };
            if ( defined($etype) &&
                 (($etype eq "HandleExtern") || ($etype eq "HandlePublic")) ) {
                GetExternOrPublic();
            }
            elsif ( defined($second) && defined($DAllocTypes{ lc $second }) ) {
                $dtype = $LabelTypeToInst{ $DAllocTypes{lc $second} };
                $LabelTypes{ "$us$first" } = $dtype . "C";
            }
        }
        next;
    }

    next unless defined $second;

    if ( lc $second eq "label" ) {
        $ltype = GetLabelType( @arr_line );
        if ( $body =~ /\s+C($|[\s,]+)/ ) {
            $first = "$us$first";
            $ltype = $ltype . "C";
        }
        $LabelTypes{ $first } = $ltype;
        next;
    }

    if ( defined($DAllocTypes{lc($second)}) ) {
        $LabelTypes{ $first } = $LabelTypeToInst{ $DAllocTypes{lc($second)} };
        next;
    }

    $etype = $directives{ lc $first };
    if ( defined($etype) &&
         ( ($etype eq "HandleExtern") || ($etype eq "HandlePublic") ) ) {
        GetExternOrPublic();
        next;
    }

    if ( lc $second eq "equ" ) {
        $EquList{ $first } = Enumerate($arr_line[2]);
        next;
    }

    if ( lc $second eq "proc" ) {
        my ( $fname, $ftype ) = ( "", "" );

        if ( $body =~ /\s+C($|[\s,]+)/ ) {
            $fname = "$us" ;
            $ftype = "C";
        }
        $fname = "$fname$first";
        $LabelTypes{ $fname } = "$ftype";
    }

}

sub GetExternOrPublic {
    my ( $etype, $ename );

    $body =~ /\S+\s*(C?)\s+([^:\s]*)\s*(:?)\s*(\S+)/;
    if ( $3 eq ":" ) {
        $etype = $DAllocTypes{lc($4)} if defined($4);
        $etype = $LabelTypeToInst{ $etype } if defined($etype);
        $ename = $2;
    }
    else {
        $body =~ /(\S+)$/;
        $ename = $1;
        $etype = "l";
    }
    if ( $body =~ /\s+C($|[\s,])/ ) {
        $ename = "$us$ename";
        $etype = $etype . "C";
    }
    $LabelTypes{ $ename } = $etype;
}

PrintHash( %LabelTypes ) if $DEBUG;
PrintHash( %EquList ) if $DEBUG;

seek STDIN, 0, 0;

while( <> ) {
# Any handling that reads more input needs to go back here (COMMENTS & PROC).
restart:
    CanonizeAndComment( $_ );

    # Handle COMMENTS:
    if ( uc($first) eq "COMMENT" ) {
        ($rest) = $rest =~ /\s*\^(.*)/o;
        print "# $rest\n";
        while ( ($_ = <>) !~ /\^/ ) {
            print "# $_";
        }
        $_ =~ /\^/;
        print "$`#";
        $_ = $';
        goto restart;
    }

    goto print_end unless defined $first;

    # Handle known directives
    my $var = $directives{ lc $first };
    if ( (defined $var) && (defined &$var) ) {
        $line = &$var( lc $first, $rest );
        print $line;
        goto print_end;
    }

    # Handle labels:
    if ( $first =~ /:/ ) {
        print "$first";
        print " $rest" if defined $rest;
        $indent = "    ";
        goto print_end;
    }

    # Handle ret (pop regs, restore frame):
    if ( lc $first eq "ret" ) {
        if ( ($FuncName eq "") && ($epilogue) ) {
            print STDERR "Warning: ret on line $.,".
                " outside a function context!\n";
        }
        else {
            HandleRet() if $epilogue;
        }
        print $indent, "$first";
        print " $rest" if defined $rest;
        goto print_end;
    }

    # Handle .directives, and any stuff which isn't an instruction:
    if ( $first eq ".data" ) {
        HandleDataSect( @arr_line );
        goto restart;
    }

    if ( $first eq ".bss" ) {
        HandleBssSect( @arr_line );
        goto restart;
    }

    if ( $first =~ /^\./ ) {
        print "$first";
        print " $rest" if defined $rest;
        goto print_end;
    }

    if ( defined $second ) {
        # Handle segments
        if ( lc $second eq "segment" ) {
            HandleSegment( @arr_line );
            goto print_end;
        }

        # Handle EQU
        if ( lc $second eq "equ" ) {
            $EquList{ $first } = Enumerate($arr_line[2]);
            print ".equ $first, ", Enumerate($arr_line[2]), "\t";
            goto print_end;
        }

        # Handle PROC
        if ( lc $second eq "proc" ) {
            $indent = "    ";
            HandleProc( @arr_line );
            goto restart;
        }

        # Handle ENDP (for indentation, clearing status, etc.):
        if ( lc $second eq "endp" ) {
            HandleENDP( $first );
            $indent = "";
            goto print_end;
        }

        # Handle LABEL
        if ( lc $second eq "label" ) {
            $first = "$us$first" if ( $body =~ /\s+C($|[\s,]+)/ );
            print "$first:";
            $indent = "    ";
            goto print_end;
        }

    }

    # Handle asm instructions:
    HandleAsmInst( $body );

print_end:
    print "$white" if defined $white;
    print "#$comment" if defined $comment;
    print "\n";

}

PrintHash( %FuncArgsRef ) if $DEBUG;

sub CanonizeAndComment {
    my ( $fw );

    # Do canonization:
    $_ =~ s/^(\s*)//o;
    ($fw) = ( $1 );
    $_ =~ s/[\s]*$//o;

    $_ =~ /(\s*);(.*)$/o;
    ($body, $white, $comment) = ($`, $1, $2);

    $white = $fw if ( (defined $body) && ($body eq "") &&
                      (defined $comment) && ($comment ne "") );

    @arr_line = split( /\s+/, $body);
    ($first, $second) = ($arr_line[0], $arr_line[1]);
    ($rest) = ($body =~ /\S+\s+(.*)/o); # rest is all body except for $first
}

sub GetLabelType {
    my ( $arg, $atype, $ltype );

    while( @_ ) {
        $arg = shift @_;
        $atype = $DAllocTypes{ lc($arg) };
        $ltype = $LabelTypeToInst{ $atype } if defined($atype);
        return $ltype if defined($ltype);
    }

    return "l";
}

sub AddPrefixDot {
    my ( $x, $y, $ret ) = @_;

    $ret = "." . $x;
    if ( (defined $y) && ($y ne "") ) {
        $ret = $ret . " " . $y;
    }
    return $ret;
}

sub HandleInclude {
    my ( $x, $y ) = @_;

    PrintHash( %_ );
    ($y) =~ /^\S+/;
    return ".include " . qq( "$&" ) . $';
}

sub IgnoreLine {
    return "";
}

sub SetTextSect {
    return ".text\n.p2align 2";
}

sub HandleDataSect {
    my ( $ret, $dalign ) = ( ".data", "" );

    while ( ($_ = <>) !~ /^\./ ) {
        $ret = "$ret$white" if defined $white;
        $ret = "$ret#$comment" if defined $comment;
        $ret = "$ret\n";
        CanonizeAndComment();
        if ( defined($second) && defined($DAllocTypes{ lc $second }) ) {
            $dtype = $DAllocTypes{ lc $second };
            $dalign = $DAllocAlignTypes{ $dtype };
            $ret = "$ret\n.globl $us$first\n.p2align $dalign\n";
            $ret = "$ret\n$us$first:\n\t$dtype";
            $body =~ s/\s*\S+\s+\S+\s*//;
            $body =~ s/\s//og;
            while ( $body ne "" ) {
                $body =~ s/^([^,]+),?//;
                $ret = "$ret " . Enumerate($1) . ",";
            }
            $ret =~ s/,$//;
        }
        elsif ( defined($first) ) {
            if ( (lc($first) eq "extrn") ||
                 (lc($first) eq "extern") || (lc($first) eq "externdef") ) {
                $ret = $ret . HandleExtern( lc($first), $rest );
            }
        }
    }

    $ret = "$ret$white" if defined $white;
    $ret = "$ret#$comment" if defined $comment;
    $ret = "$ret\n";

    print "$ret"."\n";
}

sub HandleSegment {
    my ( $ret, $FuncComment, $segarg, $align, $def ) = ( "", "" );

    $sname = shift @_; # get section name
    $ret = ".section $sname, \"a\"";
    shift @_; # discard word `section'
    $segarg = shift @_;
    if ( defined($segarg) ) {
        print "segarg3: $segarg\n" if $DEBUG;
        $align = $SegAlignTypes{ lc $segarg };
        if ( defined($align) ) {
            $segarg = shift @_;
            goto sect_arg_end unless defined($segarg);
        }
        else {
            $align = "2" unless defined($align);
        }

        print "segarg4: $segarg\n" if $DEBUG;
        if ( lc($segarg) eq "readonly" ) {
            $ret = "$ret, \"r\"";
            $segarg = shift @_;
            goto sect_arg_end unless defined($segarg);
        }

        print "segarg5: $segarg\n" if $DEBUG;
        $def = $SegCombineTypes{ lc($segarg) };
        if ( defined($def) ) {
            $segarg = shift @_;
            goto sect_arg_end unless defined($segarg);
        }

        print "segarg6: $segarg\n" if $DEBUG;
        if ( defined( $SegUseTypes{ lc($segarg) } ) ) {
            $segarg = shift @_;
            goto sect_arg_end unless defined($segarg);
        }

        print "segarg7: $segarg\n" if $DEBUG;
        if ( lc($segarg) =~ /\'(code|data)\'/ ) {
            if ( $1 eq "code" ) {
                $ret = ".text\n$ret";
            }
            else {
                $ret = ".data\n$ret";
            }
        }
    }

sect_arg_end:
    print "ret=$ret\nalign=$align\ndef=$def\n" if $DEBUG;
    $ret = "$ret\n";

    while ( lc($_ = <>) !~ /ends/ ) {
        $ret = "$ret$white" if defined $white;
        $ret = "$ret#$comment" if defined $comment;
        $ret = "$ret\n";
        CanonizeAndComment();
refind_label:
        if ( (defined($first) && ($first =~ /:$/)) ||
             (defined($second) &&
              ( (lc($second) eq "label") ||
                defined($DAllocTypes{lc($second)}) )) ) {
            $lname = "";
            $addnl = 0;
            if ( defined($first) && ($first =~ /:$/) ) {
                $lname = $`;
                $body = $first = "";
                $ltype = "l";
            }
            elsif ( lc($second) eq "label" ) {
                $ltype = GetLabelType( @arr_line );
                if ( $body =~ /\s+C($|[\s,])/ ) {
                    $lname = "$us";
                    $ltype = $ltype . "C";
                }
                $lname = "$lname$first";
                $body = $first = "";
            }
            else {
                $lname = "$first";
                $ltype = $LabelTypeToInst{ $DAllocTypes{lc($second)} };
                $body =~ s/\s*\S+\s+(\S+)/$1/;
                $first = $1;
                $addnl = 1;
            }
            $LabelTypes{ $lname } = $ltype;

            $ret = "$ret$def $lname\n" if ( defined($def) && ($def ne "") );
            $ret = "$ret.p2align $align\n$lname:";
            $ret = "$ret\n" if $addnl;

            undef $dtype;
            $dtype = $DAllocTypes{ lc $first } if ( defined($first) );
            do {
                if ( defined($dtype) ) {
                    $ret = "$ret$dtype ";
                    $body =~ s/\S+\s+//;
                    $body =~ s/\s//og;
                    while ( ($body =~ s/^([^,]+),?//) ne "" ) {
                        $ret = $ret . Enumerate($1) . ", ";
                    }
                    $ret =~ s/\s*,\s*$//;
                }
                $ret = "$ret$white" if defined $white;
                $ret = "$ret#$comment" if defined $comment;
                $ret = "$ret\n";
                $_ = <>;
                CanonizeAndComment() if defined($_);
                undef $dtype;
                $dtype = $DAllocTypes{ lc $first } if ( defined($first) );
            }
            while ( defined($_) && (($body eq "") || defined($dtype)) );

            last if ( $body =~ /ends/ );
            goto refind_label;
        }
        if ( $body ne "" ) {
            $ret = "$ret$body";
            print STDERR "Warning: not data decl inside section, line $.\n";
        }
    }

    if ( $first ne $sname ) {
        print STDERR "Warning: on line $., sement $sname ends, not $first!\n";
    }

    print "$ret"."\n";
}

sub HandleBssSect {
}

sub HandleExtern {
    my ( $x, $y, $name ) = @_;

    ($y) =~ /\s*([^:\s]*):(\S+)/;
#    $ltype = $DAllocTypes{lc($2)} if defined($2);
#    $ltype = $LabelTypeToInst{ $ltype } if defined($ltype);
    $name = $1;
    if ( $body =~ /\s+C($|[\s,])/ ) {
        $name = "$us$name";
#       $ltype = $ltype . "C" if defined($ltype);
    }
#    $LabelTypes{ $name } = $ltype if defined($ltype);
    return ".extern $name";
}

sub HandlePublic {
    my ( $name );

    $body =~ /\S+\s+(C?)\s+(\S+)/;
    $name = $2;
    if ( $1 eq "C" ) {
        $name = "$us$name";
    }
    return ".globl $name";
}

sub HandleOption {
    my ( $x, $y ) = @_;

    if ( $y eq "PROLOGUE:NONE" ) {
        $prologue = 0;
        print STDERR "Not creating function prologue from input line $.\n"
            if $DEBUG;
    }
    elsif ( $y eq "EPILOGUE:NONE" ) {
        $epilogue = 0;
        print STDERR "Not creating function epilogue from input line $.\n"
            if $DEBUG;
    }

    return "";
}

sub Enumerate {
    my ( $num ) = @_;

    if ( $num =~ /^([+\-]?)([0-9a-fA-F]+)h$/ ) {
        return "$1"."0x$2";
    }

#    if ( $num =~ /^([0-9]+)$/ ) {
        return $num;
#    }
}

sub HandleProc {
    my ( @line ) = @_;
    my ( $found, $FuncComment );

    $FuncComment = "";
    if ( $body =~ /\s+C($|[\s,]+)/ ) {
        print STDERR "C funcion!\n" if $DEBUG;
        $FuncName = "$us" ;
        $FuncType = "C";
    }
    $FuncName = "$FuncName$line[0]";
    $LabelTypes{ $FuncName } = "l$FuncType";

    for ( $i = 0; $i <= $#line; $i++ ) {
        if ( lc $line[$i] eq "uses" ) {
            for ( $i++; $i <= $#line; $i++ ) {
                $found = $line[$i] =~ /e?([abcd]x|[sd]i|[sb]p)/io;
                if ( $found ) {
                     push( @UsedRegs, lc $& );
                }
                else {
                    print STDERR "Warning: unknown or invalid register ";
                    print STDERR "`$line[$i]\' on line $.\n";
                }
            }
        }
    }

    while ( ($_ = <>) =~ /:/ ) {
        if ( (defined $comment) && ($comment ne "") ) {
            $FuncComment = $FuncComment . "\n#$comment";
        }
        CanonizeAndComment();
        push @FuncArgs, ($body =~ /(\S+)\s*:\s*([^,\n]*)/og);
    }
    if ( (defined $comment) && ($comment ne "") ) {
        $FuncComment = $FuncComment . "\n#$comment";
    }

    if ( $FuncType ne "C" ) {
        $old_prologue = $prologue;
        $old_epilogue = $epilogue;
        $prologue = $epilogue = 0;
        while ( $#FuncArgs >= 0 ) { pop @FuncArgs };
        while ( $#UsedRegs >= 0 ) { pop @UsedRegs };
    }

    if ( (! $prologue) && ($#FuncArgs >= 0) ) {
        print STDERR "Warning: Function `$FuncName\' has arguments,\n".
            "         but `OPTION PROLOGUE:NONE\' is set! args ignored.\n";
        while ( $#FuncArgs >= 0 ) { pop @FuncArgs };
    }

    if ( ($#UsedRegs >= 0) && (! ($prologue || $epilogue) ) ) {
        print STDERR "Warning: Function `$FuncName\' declares used ".
            "registers,\n         but no EPILOGUE and no PROLOGUE ",
            "requeted.\n         Regs will not be saved or restored!\n";
        while ( $#UsedRegs >= 0 ) { pop @UsedRegs };
    }

    print $FuncComment, "\n" unless ($FuncComment eq "");

    if ( $prologue ) {
        ProcessPrintFuncArgs() if ($#FuncArgs > -1);
        print ".globl $FuncName\n\n$FuncName:\n";
        PrintFuncFrame( "enter" );
        ProcessUsedRegs( "enter" ) if ($#UsedRegs > -1);
    }
    else {
        print ".globl $FuncName\n\n$FuncName:\n";
    }

}

sub ProcessPrintFuncArgs {
    my ( $offset, $i, $type, $offs_name, $arg_type, $maxlen );

    $offset = 8;
    print "\n";

    $maxlen = 0;
    for ( $i = 0; $i <= $#FuncArgs-1; $i += 2 ) {
        $maxlen = length($FuncArgs[$i]) if ( length($FuncArgs[$i]) > $maxlen );
    }

    for ( $i = 0; $i <= $#FuncArgs-1; $i += 2 ) {
        $offs_name = "PRM_" . uc $FuncArgs[$i];
        $arg_type = $FuncArgs[$i+1];
        if ( lc($arg_type) =~ /^ptr\s*/ ) {
            ($type) = ($' =~ /\s*(\S*)\s*/);
#           print STDERR "Warning: Function `$FuncName\'s argument ".
#               "`$FuncArgs[$i]\'s size is not 4!\n";
        }
        else {
            $type = $arg_type;
        }
        print ".equ $offs_name, $offset";
        printf "%*s", $maxlen - length($offs_name) + 8 - length($offset), "";
        print "# ", uc $type, "\t$FuncArgs[$i]";
        if ( lc($arg_type) =~ /^ptr\s*/ ) {
            printf "%*spointer", $maxlen - length($offs_name) + 5;
        }
        print "\n";
        $offset += 4;
        $FuncArgsRef{ $FuncArgs[$i] } = "$offs_name(%ebp)";
    }

    print "\n";

#    PrintHash( %FuncArgsRef ) if $DEBUG;
}

sub PrintFuncFrame {

    print "\n";
    if ( $_[0] eq "enter" ) {
        print $indent, "pushl   %ebp\n";
        print $indent, "movl    %esp, %ebp\n";
    }
    else {
        print $indent, "movl    %ebp, %esp\n";
        print $indent, "popl    %ebp\n";
    }
}

sub ProcessUsedRegs {
    my ( $i, $type );

    print "\n";
    if ( $_[0] eq "enter" ) {
        for ( $i = 0; $i <= $#UsedRegs; $i++ ) {
            $type = $UsedRegTypes{ $UsedRegs[$i] };
            if ( $type eq "w" ) {
                print STDERR "Warning: function `$FuncName\' saves a 16-bit ".
                    "register ($UsedRegs[$i]).\n";
            }
            print "$indent", "push$type\t%$UsedRegs[$i]\n";
        }
    }
    else {
        for ( $i = $#UsedRegs; $i >= 0 ; $i-- ) {
            $type = $UsedRegTypes{ $UsedRegs[$i] };
            print "$indent", "pop$type\t%$UsedRegs[$i]\n";
        }
    }
}

sub HandleRet {

    ProcessUsedRegs( "leave" ) if ($#UsedRegs > -1);
    PrintFuncFrame( "leave" );
    print "\n";
}

sub HandleENDP {
    my ( $fname ) = @_;

    $fname = "$us$fname" if ( $FuncType eq "C" );
    unless ( $fname eq $FuncName ) {
        print STDERR "Warning: on line $. `$fname\' ends, inside $FuncName!\n";
    }

    if ( $FuncType ne "C" ) {
        $prologue = $old_prologue;
        $epilogue = $old_epilogue;
    }
    $FuncName = $FuncType = "";

    while ( $#FuncArgs >= 0 ) { pop @FuncArgs };
    while ( $#FuncArgsRef >= 0 ) { pop @FuncArgsRef };
    while ( $#UsedRegs >= 0 ) { pop @UsedRegs };

    print "\n# $fname ends here.\n\n";

    if ( $prologue ^ $epilogue ) {
        print STDERR "Warning: only one of PROLUGE and EPILOGUE is defined.\n".
            "         Make sure prologue and epilogue are consistent!\n";
    }
}

sub ParseIndexRef {
    my ( $ireg, $idx ) = @_;

    if ( defined $RegisterList{ $ireg } ) {
        $ireg = "%".$ireg;
    }
    else {
        print STDERR "Error: in instruction on line $.: ".
            "register `$ireg' unknown!\n";
        exit -1;
    }

    print ",$ireg,$idx)\n" if $DEBUG;

    return ( $ireg, $idx );
}

sub ParseMemRef {
    my ( $ref ) = @_;
    my ( $dsign, $disp, $base_reg, $index_reg, $index ) =
        ( "", "", "", "", "1" );

    $ref =~ s/\s*//og;
    print "$ref\n" if $DEBUG;

    $found = $ref =~ /([+\-]?)([01248])\*([^+\-*]+)/;
    if ( $found && defined($RegisterList{$3}) ) {
        print "found 1: $3\n" if $DEBUG;
        if ( defined($1) && ($1 eq "-") ) {
            print STDERR "Error: negative register indexing on line $.!\n";
            exit -3;
        }
        ($index_reg, $index) = ParseIndexRef( lc $3, $2 ) unless( $2 eq "0");
        $ref =~ s/([+\-]?)([01248])\*([^+\-*]+)//;
    }
    else {
        $found = $ref =~ s/([+\-]?)([^+\-*]+)\*([01248])//;
        if ( $found ) {
            if ( defined($RegisterList{$2}) ) {
                print "found 2: $2\n" if $DEBUG;
                if ( defined($1) && ($1 eq "-") ) {
                    print STDERR "Error: negative register indexing".
                        " on line $.!\n";
                    exit -3;
                }
                ($index_reg, $index) =
                    ParseIndexRef(lc $2, $3) unless( $3 eq "0");
            }
            else {
                $disp = $1 if defined($1);
                $disp = $disp . Enumerate($2) . "*" . Enumerate($3);
            }
        }
    }

    $fn = 2;
    while ( $ref =~ s/([+\-]?)([^+\-*]+)\*([^+\-*]+)// ) {
#       print STDERR "Error: in instruction on line $.: too many `*'!\n";
#       exit -3;
        $fn++;
        print STDERR "found $fn"."*: $2*$3\n" if $DEBUG;
        $disp = "$disp$1" if defined($1);
        $disp = $disp . Enumerate($2) . "*" . Enumerate($3);
        print STDERR "$disp(\n" if $DEBUG;
    }

    while ( $ref =~ s/((^|[+\-])[0-9][0-9a-fA-F]*h?)// ) {
        $fn++;
        print STDERR "found $fn"."i: $1\n" if $DEBUG;
        $disp = $disp . Enumerate($1);
        print STDERR "$disp(\n" if $DEBUG;
    }

    while ( $ref =~ /[^+\-]/ ) {
        $fn++;
        $found = $ref =~ s/^([+\-]?)([^+\-]+)//;
        if ( $found ) {
            print STDERR "found $fn"."g: $1$2\n" if $DEBUG;
            if ( defined $RegisterList{ lc $2 } ) {
                if ( defined($1) && ($1 eq "-") ) {
                    print STDERR "negative register reference on line $.!\n";
                    exit -4;
                }
                if ( $base_reg ne "" ) {
                    if ( $index_reg ne "" ) {
                        print STDERR "Error: in instruction on line $.: ".
                            "base_reg & index_reg already defined!\n";
                        exit -4;
                    }
                    ($index_reg, $index) = ParseIndexRef( lc $2, "1" );
                }
                else {
                    $base_reg = "%".lc($2);
                    print STDERR "($base_reg,\n" if $DEBUG;
                }
            }
            else {
                $cdisp = $2;
                $cdisp = "$1$cdisp" if defined($1);
                my( $lbt );
                if ( defined($lbt = $LabelTypes{ "$us$cdisp" }) &&
                     $lbt =~ /C$/ ) {
                    $cdisp = "$us$cdisp";
                }
                $dsign = "+" if ( ($disp ne "") && ($disp !~ /^[+\-]/ ) );
                $disp = "$cdisp$dsign$disp";
                print STDERR "$disp(\n" if $DEBUG;
            }
        }
    }

    if ( $ref ne "" ) {
        print STDERR "Error: Not all memory reference parsed! (Rest=$ref)\n";
        exit -6;
    }

    $memref = "$disp($base_reg,$index_reg,$index)";
    print "$memref\n" if $DEBUG;
    $memref =~ s/\(([^,]+),,1\)/($1)/;
    print "$memref\n" if $DEBUG;
    $memref =~ s/,,/,/;
    print "$memref\n" if $DEBUG;
    $memref =~ s/\(,1\)//;
    print "$memref\n" if $DEBUG;
    $memref =~ s/^\+//;
    print "$memref\n" if $DEBUG;
    return $memref;
}

sub HandleSrcDstType {
    my ( $sd, $ref_type, $mem_ref, $sd_type, $lbt, $num, $tmp, $s, $m ) = @_;

    if ( defined $sd ) {
        $sd_type = $RegisterList{ $sd };
        unless ( defined $sd_type ) {
            ($ref_type, $mem_ref) = ($sd =~ /([^\[]*)\[([^\]\n\r]+)\]$/);
            if ( !defined($mem_ref) ) { # maybe [] was missing:
                ($ref_type, $mem_ref)= ($sd =~ /(\S*\s*[pP][tT][rR])\s*(.+)$/);
            }
            if ( defined $mem_ref ) {
                ($sd_type) = (lc($ref_type) =~ /^(\S+)/);
                $sd_type = "dword" if ( ! defined($sd_type) );
                ($sd_type) = $MemoryTypes{ $sd_type };
                print "mem ref: [$mem_ref] ($sd_type)\n" if $DEBUG;
                if ( defined $FuncArgsRef{ $mem_ref } ) {
                    $sd = $FuncArgsRef{ $mem_ref };
                    print "matched in arg-list: $sd\n" if $DEBUG;
                }
                else {
                    $sd = ParseMemRef( $mem_ref );
                }
            }
            else {
                print "constant: $sd " if $DEBUG;
                if ( defined $FuncArgsRef{ $sd } ) {
                    $sd = $FuncArgsRef{ $sd };
                    print "matched in arg-list: $sd\n" if $DEBUG;
                }
                else {
                    $tmp = $sd;
                    $sd = "";
                    while( $tmp ne "" ) {
                        $tmp =~ s/^\s*([+\-]?[^\s+\-]+)\s*([+\-]?)/$2/;
                        print "const=$tmp,match=$1" if $DEBUG;
                        $1 =~ /[^+\-]+/;
                        $s = $`;
                        $m = $&;
                        print ",net=$m\n" if $DEBUG;
                        if ( ( defined($lbt = $LabelTypes{ "$us$m" }) &&
                               $lbt =~ s/C$// ) ||
                             defined($lbt = $LabelTypes{ $m }) ) {
                            if ( defined( $sd_type ) ) {
                                print STDERR "Warning: 2 labels on line $.!\n";
                            }
                            $m = "$us$m" if ( $& eq "C" );
                            $sd = "$sd$s$m";
                            $sd_type = $lbt;
                            print"#label `($s)$m',type `$sd_type'\n" if $DEBUG;
                        }
                        elsif ( defined($EquList{ $m }) ) {
                            $sd = "$sd$s$m";
                            print "found equ `($s)$m'\n" if $DEBUG;
                        }
                        else {
                            $sd = "$sd$s" . Enumerate( $m );
                            print "found const `$s$m'\n" if $DEBUG;
                        }
                    }
                    $sd =~ s/^\+//;
                    $sd = "\$$sd" unless ( defined($sd_type ) );
                }
                print "($sd_type)" if ( $DEBUG && defined($sd_type) );
                print "\n" if $DEBUG;
            }
        }
        else {
            print "reg ref: $sd ($sd_type)\n" if $DEBUG;
            $sd = "%" . $sd;
        }
    }

    return ( $sd, $sd_type );
}

sub HandleAsmInst {
    my ( $inst ) = @_;
    my ( $opcode, $dst, $src, $extra, $src_type, $dst_type, $mem_ref );

    ($opcode) = ($inst =~ /^(\S+)\s*/);
    $opcode = lc $opcode;
    ($dst) = ($' =~ /^([^,\n\r]+)\s*,?\s*/);
    ($src) = ($' =~ /^([^,\n\r]+)\s*,?\s*/) if defined $dst;
    ($extra) = ($' =~ /^([^,\n\r]+)\s*,?\s*/) if defined $src;

    ($src, $src_type) = HandleSrcDstType( $src ) if defined $src;
    ($dst, $dst_type) = HandleSrcDstType( $dst ) if defined $dst;

    $print_adj = 0;
    if ( $opcode =~ /^f(.)/ ) { # Handle float commands:
        if ( $1 ne "i" ) { # Handle commands without integer:
            $src_type = $IntToFloatType{ $src_type } if defined($src_type);
            $dst_type = $IntToFloatType{ $dst_type } if defined($dst_type);
        }
        else { # Handle commands with integer: put `' instead of `w'.
#           $src_type = "" if ( defined($src_type) && ($src_type eq "w") );
#           $dst_type = "" if ( defined($dst_type) && ($dst_type eq "w") );
        }
    }
    else {
        # Adjust mmx-instructions:
        if ( #($opcode eq "movd") &&
             ( (defined $src_type) && (defined $dst_type) ) &&
             ( (($src_type eq "l") && ($dst_type eq "q")) ||
               (($src_type eq "q") && ($dst_type eq "l")) ) ) {
            $print_adj = 1 if $warn_fixed;
            $dst_type = $src_type = "q";
        }
        # if src or dst_type is `q' (for mmx), no need to put it
        $dst_type = "" if ( defined($dst_type) && ($dst_type eq "q") );
        $src_type = "" if ( defined($src_type) && ($src_type eq "q") );
    }

    if ( (defined $src_type) && (defined $dst_type) &&
         ($src_type ne $dst_type) ) {
        print STDERR "Warning: instruction on line $. has different ".
            "SRC ($src_type) and DST ($dst_type) types!\n";
    }
    $dst_type = $src_type if ( defined($src_type) && (!defined($dst_type)) );

    $cmd = $indent . "$opcode";
    $cmd = $cmd . $dst_type if defined($dst_type);
    $cmd = $cmd . "  ";
    $cmd = $cmd . "\t" if defined $dst;
    $cmd = $cmd . $src . ", " if defined $src;
    $cmd = $cmd . "$dst" if defined $dst;
    $cmd = $cmd . ", $extra" if defined $extra;

    print $cmd;

    $cmd =~ s/^\s*//;
    print STDERR "Fixed types for `$cmd' (this is OK).\n" if $print_adj;

}