#!/usr/bin/perl
#
# Assemble dlx code into machine code.  This program only works for a single
# file, and generates binary code that can be loaded into a simulator and on the fpga.
#
# Copyright (C) 1999 by Ethan L. Miller,
#
# new version: (c) 2001 by Carsten Meyer, carsten@wjpserver.cs.uni-sb.de
#
# The main data structure is the symbol table that tracks the symbols defined
# in the code.  They're defined in the first pass and used in the second
# pass.
#
# $Id: dlxasm,v 1.6 2003/05/09 14:42:06 mah Exp $
#

use Getopt::Long;

# Parse options.  These include the file to assemble, output file, and
# start locations for text (code) & data.
$pn = $0;
$pn =~ s?.*\/??g;
$debug = 0;
$asmfile = "";
$symfile = "";
$listfile = "";
$startlabel="_main";

sub printusageandexit {
die ("Unrecognized option.  Correct usage is $pn <srcfile> with options:\n" .
     "\t-output <dstfile> : specify output file\n" .
     "\t-init <startsymbol> : initial location to start exeuction\n" .
     "\t-sym <symfile> : file to print a symbol table in\n" .
     "\t-list <listfile> : file to print a listing in\n" .
     "\t-debug : turn on debugging\n" .
     "NOTE: options may be specified with just the first letter if desired.\n");
};

&GetOptions (
	     "debug" => \$debug,
	     "output=s" => \$asmfile,
	     "sym=s" => \$symfile,
	     "list=s" => \$listfile,
	     "init=s" => \$startlabel,
	     "help" => \&printusageandexit,
	     );

&printusageandexit if ($#ARGV != 0);

$srcfile = pop @ARGV;
$asmfile = $srcfile . ".obj" if $asmfile eq "";

# these are the new vamp-operations and their special codes

%instTbl = (
# Register-register instructions
#
# op RD RS1 RS2          [5:0]

	    "sll"  => "r,0x04",
	    "srl"  => "r,0x06",
	    "sra"  => "r,0x07",
	    "addo" => "r,0x20",
	    "add"  => "r,0x21",
	    "subo" => "r,0x22",
	    "sub"  => "r,0x23",
	    "and"  => "r,0x24",
	    "or"   => "r,0x25",
	    "xor"  => "r,0x26",
	    "seq"  => "r,0x2a",
	    "sne"  => "r,0x2d",
	    "slt"  => "r,0x2c",
	    "sgt"  => "r,0x29",
	    "sle"  => "r,0x2e",
	    "sge"  => "r,0x2b",

# special register operations
#
# op SA RS1                 [5:0]
	    "movi2s" => "r2,0x11",

# special register operation
#
# op RD SA                  [5:0]
	    "movs2i" => "r3,0x10",

# special float data transfer
#
# op FD FS1                  [5:0]
	    "fmovs" =>  "f2s,0x8",   
	    "fmovd" =>  "f2d,0x8",
# op RS FS1                   [8:0]    
	    "mf2i" =>   "fsp1,0x09",
# op FD RS                    [8:0]
	    "mi2f" =>   "fsp2,0x0a",
  
# Floating-point instructions, s and double are the same
#
# op FD FS1 FS2             [0:8]  
	    "fadds"  => "fs,0x00", 
	    "fsubs"  => "fs,0x01", 
	    "fmuls"  => "fs,0x02",
	    "fdivs"  => "fs,0x03",
	    "faddd"  => "fd,0x00",
	    "fsubd"  => "fd,0x01",
	    "fmuld"  => "fd,0x02",
	    "fdivd"  => "fd,0x03",

# Floating-point conversion
#
# op FD FS1                  [8:0]
	    "cvtsd"  => "fcb,0x20",
	    "cvtsi"  => "fcc,0x20",
	    "cvtds"  => "fca,0x21",
	    "cvtdi"  => "fcc,0x21",
	    "cvtis"  => "fca,0x24",
	    "cvtid"  => "fcb,0x24",
	
# Float-compare
#
# FCC FS1 FS2                 [5:0]
	    "fceqs"   => "fcs,0x32",
	    "fcnes"   => "fcs,0x3d",
	    "fclts"   => "fcs,0x34",                 #>????????????????
	    "fcgts"   => "fcs,0x38",
	    "fcles"   => "fcs,0x36",
	    "fcges"   => "fcs,0x3a",
	    "fceqd"   => "fcd,0x32",
	    "fcned"   => "fcd,0x3d",
	    "fcltd"   => "fcd,0x34",
	    "fcgtd"   => "fcd,0x38",
	    "fcled"   => "fcd,0x36",
	    "fcged"   => "fcd,0x3a",
            
# Float-neg
#
# op FD FS1                   [8:0]
            "fnegs"   => "f2s,0x04",
            "fnegd"   => "f2d,0x04",

# General instructions
# 
# jump     j-type        [31:26]
	    "j"    => "j,0x02",
	    "jal"  => "j,0x03",
# branch   i-type  bzw. fi-type
# op RS1                 [31:26]
	    "beqz" => "b,0x04",
	    "bnez" => "b,0x05",
# op                       [31:26]
	    "fbeqz" => "b0,0x06",
	    "fbnez" => "b0,0x07",

# immediate ops
#
# op RD RS1 imm           [31:26]
	    "addio" => "i,0x08",
	    "addi"  => "i,0x09",
	    "subio" => "i,0x0a",
	    "subi"  => "i,0x0b",
	    "andi"  => "i,0x0c",
	    "ori"   => "i,0x0d",
	    "xori"  => "i,0x0e",
	    "seqi"  => "i,0x1a",
	    "snei"  => "i,0x1d",
	    "slti"  => "i,0x1c",
	    "sgti"  => "i,0x19",
	    "slei"  => "i,0x1e",
	    "sgei"  => "i,0x1b",
# op RD imm
	    "lhi"   => "i1,0x0f",
# op                     [31:26]
	    "rfe"  => "n,0x3f",
            "nop"  => "n,0x09",
# op imm                 [31:26]
	    "trap" => "t,0x3e",
# control operations
#
# op RS1                  [31:26]
	    "jr"   => "jr,0x16",
	    "jalr" => "jr,0x17",
# shift immediate
#
# op RD RS1 sa             [5:0]
	    "slli" => "shi,0x00",
	    "srli" => "shi,0x02",
	    "srai" => "shi,0x03",
# load instructions
#
# op RD imm(RS1)           [31:26]                  >???????????
	    "lb"      => "l,0x20",
	    "lh"      => "l,0x21",
	    "lw"      => "l,0x23",
	    "lbu"     => "l,0x24",
	    "lhu"     => "l,0x25",
	    "loads"   => "l,0x31",
	    "loadd"   => "l,0x35",
# store insructions
#
# op imm(RS1) RD           [31:26]
	    "sb"      => "s,0x28",
	    "sh"      => "s,0x29",
	    "sw"      => "s,0x2b",
	    "stores"  => "s,0x39",
	    "stored"  => "s,0x3d",
	    );
#%specialreg = ("pc" => 0,
#	       "ir31" => 2,
#	       "isr" => 3,
#	       "iar" => 4,
#	       "status" => 5,
#	       "cause" => 6,
#	       "intrvec" => 8,
#	       "fault" => 9,
#	       "ptbase" => 12,
#	       "ptsize" => 13,
#	       "ptbits" => 14,
#	   );

# Do pass one.  In this pass, we just figure out label values.  To allow
# for relocation as late as possible, both text and data labels are
# computed as offsets from start of text or data.


$section = "t";
$start{"t"} = $start{"d"} = -1;
open (SRC, $srcfile) or die "Couldn't open $srcfile for assembly.";

for ($pass = 1; $pass <= 2; $pass++) {
    if ($pass != 1) {
	$maxdaddr = $addr{"d"};
	$maxtaddr = $addr{"t"};
    }
    $addr{"d"} = 0;
    $addr{"t"} = 0;
    if ($pass != 1) {
	open (ASM, ">$asmfile") or die "Couldn't open $asmfile for output.";
	if (defined $val{$startlabel}) {
	    $startloc = $val{$startlabel};
	} else {
	    $startloc = $textstart;
	}
	printf ASM "start:%08x %08x ", $startloc, (($maxtaddr > $maxdaddr) ?
						    $maxtaddr : $maxdaddr);
	printf (ASM "%08x %08x %08x %08x\n", $start{"t"},
		$maxtaddr-$start{"t"}, $start{"d"}, $maxdaddr-$start{"d"});
	if ($listfile ne "") {
	    open (LISTING, ">$listfile") or
		die "Couldn't open $listfile for output.";
	    printf LISTING "%5s  %8s\t%8s\n", "line", "address", "contents";
	}
    }
    seek (SRC, 0, 0);
    print "Starting pass $pass.\n";
    $lineno = 0;
line:
    while (<SRC>) {
	$lineno++;
	$curaddr = $addr{$section};
	$out = "";
	# remove leading whitespace
	s/^\s+//;
	$curline = $_;
	chomp $curline;
	# skip comments
	if (/^\;/) {
	    if (($pass == 2) and ($listfile ne "")) {
		printf LISTING "%5d  %20s%s\n", $lineno, "", $curline;
	    }
	    next line;
	}
	# Do an operation based on the first word on the line
	/^([a-zA-Z0-9:_.]+)/;
	if ($1 eq "") {
	    next line;
	}
	$op = $1;
	print STDERR "Op is '$op'\n" if ($debug);
	if ($op =~ /^([a-zA-Z0-9_]+)\:$/) {
	    if ($pass == 1) {
		# set label value
## here procname in label einbauen falls not global
		$val{$1} = $addr{$section};
	    }
	} elsif (/^[a-zA-Z]+/) {
	    if ($pass == 1) {
		if ($section eq "d") {
		    warn "Instructions not allowed in data segment " .
			"(at line $lineno)\n";
		    $error = 1;
		}
	    } else {
		# Handle instructions for second pass.  This means outputting
		# the correct code.
		$out = pack ("N", &forminstr ($_));
	    }
	    $addr{$section} += 4;
	} elsif (/^\.(text|data)/) {
	    s/\;.*$//;
	    $tmp = "";
	    ($section, $tmp) = split (/\s+/, $_, 3);
	    $section = substr($section, 1, 1);
	    if ($tmp ne "") {
		if ($tmp =~ /^0/) {
		    $addr{$section} = oct ($tmp);
		} else {
		    $addr{$section} = $tmp;
		}
		if ($start{$section} == -1) {
		    $start{$section} = $addr{$section};
		}
	    }
	    print "Section $section now at $addr{$section}.\n" if ($debug);
	} elsif (/^\.(proc|endproc|global)/) {

	    # Ignore directives - we don't need them yet
	} elsif (/^\.space/) {
	    # .space simply adds to the address pointer
	    ($op, $n, $rest) = split (/\s+/, $_, 3);
	    print "SPACE: line is '$_' op = $op, n = $n, rest = $rest\n" if ($debug);
 
            $out="";
            for($count=0;$count< $n;$count++){    
		$out = $out . "\000";}


	    if ($section eq "t") {
		warn ".space can't be used in the text segment " .
		    "(at line $lineno)!\n";
		$error = 1;
	    }
	    $addr{$section} += $n;
	} elsif (/^\.ascii(z?)/) {

	    $out = &getascii ($_, ($1 eq "z"));

            # pad out to multiple of 4 bytes
            if (length($out) % 4 != 0)
              {$out=$out . "\000";}
            if (length($out)%4 != 0)
              {$out=$out . "\000";}
            if (length($out)%4 != 0)
              {$out=$out . "\000";}

	    $addr{$section} += length ($out);


            
            for ($count=0;$count< length ($out);$count++){
                $asciiarray[$count]= substr($out , $count,1);
              # print "$asciiarray[$count] . $count" . "\n"; 
               }

            for ($count=0;$count< length ($out);$count +=4){
                for ($count2=0;$count2 <4;$count2++){
                    $temp[$count+$count2]=0;
                    if ($count+3-$count2 < length($out))
                      {$temp[$count+$count2]=$asciiarray[$count+3-$count2];}}

                for ($count2=0;$count2 <4;$count2++){
                    $asciiarray[$count+$count2]=$temp[$count+$count2]}
            }
            $tmpstr="";
            for ($count=0;$count<length ($out);$count++){
            $tmpstr=$tmpstr.$asciiarray[$count];}
            $out=$tmpstr;



	} elsif (/^\.(byte|word|float|double|half)/) {
	    # Add one byte for each entry.  The first "entry" is the word
	    # itself, so pop it off.
	    my $tp = $1;
	    s /\;.*$//;
	    my @args = split (/\s*,\s*/);
	    $args[0] =~ s/\.[a-z]+\s+//;
	    if ($tp =~ /byte|word|half/) {
		for ($i = 0; $i <= $#args; $i++) {
		    $args[$i] = &getimm ($args[$i]);
		}
	    }
            $out = pack ("n*", @args) if ($tp eq "half");
	    $out = pack ("C*", @args) if ($tp eq "byte");
	    $out = pack ("N*", @args) if ($tp eq "word"); # changed N to V for little endian
	    $out = pack ("f*", @args) if ($tp eq "float");
	    $out = pack ("d*", @args) if ($tp eq "double");
	    $addr{$section} += length ($out);
	} elsif (/^\.align/) {
	    # Align so that the lowest n bits are all 0's.
	    ($op, $n, $rest) = split (/\s+/, $_, 3);
	    my $mask = (1 << $n) - 1;
	    # This will leave things alone if the address is already
	    # correctly aligned, and align to the next possible point if
	    # it's not aligned.
	    if (($addr{$section} & $mask) != 0) {
		$addr{$section} += $mask;
		$addr{$section} &= ~$mask;
		# Force the output of the address if it's not yet aligned
		$prevaddr = $addr{$section};
	    }
	}
         else { printf (" unknown directive : $1\n ");}
       
        
	if ($pass == 2) {
	    if ($out ne "") {
		# Output the current value
		if ($curaddr != ($prevaddr + 4)) {
		    printf (ASM "%08x", $curaddr);
		}
		my $data = unpack ("H*", $out);
		my $j;
		for ($j = 0; $j < length ($data); $j += 8) {
		    print ASM ":" . substr ($data,$j,8) . "\n";
		}
		$prevaddr = $curaddr;
	    }
	    if ($listfile ne "") {
		# Generate the list of numbers to output
		my $data = unpack ("H*", $out);
		my $i = $curaddr;
		my $j;
		$data = " " if ($data eq "");
		for ($j = 0; $j < length ($data); $j += 8) {
		    printf (LISTING "%5d  %08x  %-8s\t%s\n", $lineno,
			    $i, substr ($data, $j, 8), $curline);
		    $i += 4;
		    $curline = "";
		}
	    }
	}
    }
    if ($error == 1) {
	die "Errors occurred during assembly.  Exiting....\n";
    }
    if (($pass == 1) && ($symfile ne "")) {
	open (SYM, ">$symfile") or die "Couldn't open symbol file $symfile.";
	foreach $sym (sort keys %val) {
	    printf SYM "%-20s %08x\n", $sym, $val{$sym};
### here evtl.
	}
	close SYM;
    }
}

printf ("Last text address: 0x%x\n", $addr{'t'});
printf ("Last data address: 0x%x\n", $addr{'d'});

close ASM;

exit;

sub getreg {
    my $r = lc (@_[0]);
    my $rnum = -1;
    if ($r =~ /^[frs]([0-9]+)/) {
	$rnum = $1;
    }
   # elsif (defined $specialreg{$r}) {
   #	$rnum = $specialreg{$r};
   #   }
    if ($rnum == -1) {
	warn "Illegal register number ($r) at line $lineno.\n";
	$rnum = 0;
    }
    return ($rnum);
}

sub getimm {
    my $imm = @_[0];
    $imm =~ s/#//g;
    my @p = split (/\b/, $imm);
    my ($ival, $i);
    for ($i = 0; $i <= $#p; $i++) {
	if ($p[$i] =~ /^[_a-zA-Z]/) {
	    # Look up value in symbol table, and replace it
            ### here, if not global, use procname.label
	    if (! defined ($val{$p[$i]})) {
		if ($pass != 1) {
		    warn "Undefined symbol: $p[$i]\n";
		}
		$p[$i] = 0;
	    } else {
            ### here
		$p[$i] = $val{$p[$i]};
	    }
	}
    }
    $ival = eval (join ("", @p));
    return ($ival);
}



sub forminstr {
    my $fmt;    # new, for the floatingpoint coding
    my ($itype, $op);
    my ($src1, $src2, $dst, $out);
    my @a;
    chomp @_[0];
    @_[0] =~ s/\;.*$//;
    @a = split (/[\s,]+/, @_[0]);
    ($itype,$op) = split (/,/, $instTbl{$a[0]});
    $itype = lc ($itype);
    if ($itype eq "") {
	warn "Illegal instruction ($a[0]) at line $lineno\n";
    }
    $op = hex ($op);


    if ($itype =~ /^r/) {
  
	if ($itype eq "r") {
            $src1 = &getreg ($a[2]);
	    $src2 = &getreg ($a[3]);
            $dst  = &getreg ($a[1]);
	    $out = 0x00000000 | ($src1 << 21) | ($src2 << 16) | ($dst << 11) | $op;
	}
        elsif ($itype eq "r2") {
	    $src1 = &getreg ($a[2]);
            $dst  = &getreg ($a[1]);
            $out = 0x00000000 | ($src1 << 21) | ($dst << 6) | $op;
	}
        else {
            $src1 = &getreg ($a[2]);
	    $dst = &getreg ($a[1]);
            $out = 0x00000000 | ($src1 << 6) | ($dst << 11) | $op;
        }

    } elsif ($itype eq "i") {
	$src1 = &getreg ($a[2]);
	$dst = &getreg ($a[1]);
	$src2 = &getimm ($a[3]);
	$out = ($op <<26)| ($src1 << 21) | ($dst << 16) | ($src2 & 0xffff);

    } elsif ($itype eq "shi") {
	$src1 = &getreg ($a[2]);
	$dst = &getreg ($a[1]);
	$src2 = &getimm ($a[3]);
	$out = 0x00000000 | ($src1 << 21) | ($dst << 11) | (($src2 & 0xff)<<6) |$op;
    } elsif ($itype eq "i1") {
        # Immediates with a single operand
        $dst = &getreg ($a[1]);
        $src2 = &getimm ($a[2]);
        $out = ($op << 26) | ($dst << 16) | ($src2 & 0xffff);
    } elsif ($itype eq "n") {
        # Instructions with no operands
        $out = ($op << 26);
    } elsif (($itype eq "s") || ($itype eq "l")) {
        # load and store operations
        if ($itype eq "s") {
            $src1 = $a[1];
            $dst = &getreg ($a[2]);
        } else {
            $src1 = $a[2];
            $dst = &getreg($a[1]);
        }
        $src1 =~ /(.*)\((r[0-9]+)\)$/;
        if ($1 ne "") {
            $src2 = &getimm ($1);
        } else {
            $src2 = 0;
        }
        $src1 = &getreg ($2);
        $out = ($op << 26) | ($src1 << 21) | ($dst << 16) | ($src2 & 0xffff);
      } elsif ($itype =~ /^f/) {
      # floating point operations
      if ($itype eq "fs") {
          $fmt = 0x0;
            $dst = &getreg ($a[1]);
	    $src1 = &getreg ($a[2]);
            $src2 = &getreg ($a[3]);
          }
        elsif ($itype eq "fsp1") {
            $fmt = 0x0;
            $src1 = &getreg ($a[2]);
            $src2 = 0x0;
            $dst = &getreg ($a[1]);

           #$fmt = 0x0;             Änderungen nach fp-bug Kommentar nach Müller Paul
           #$src1 = &getreg ($a[2]);
           #$src2 = &getreg ($a[1]); # dst= RS which is the same as FS2 = $src2
           #$dst = 0x0;
          }
        elsif ($itype eq "fsp2") {
            $fmt = 0x0;
            $dst = &getreg ($a[1]);
            $src1 = 0x0;     
            $src2 = &getreg ($a[2]);
          } 
        elsif ($itype eq "fd") {
            $fmt = 0x1;
            $dst = &getreg ($a[1]);
            $src1 = &getreg ($a[2]);
            $src2 = &getreg ($a[3]);  
          } 
        elsif ($itype eq "f2s") {
            $fmt = 0x0;
	    $src1 = &getreg ($a[2]);
	    $src2 = 0;
	    $dst =  &getreg ($a[1]);
            
          } elsif ($itype eq "f2d") {
          $fmt = 0x1;
            $dst = &getreg ($a[1]);
            $src1 = &getreg ($a[2]);
            $src2 = 0;
            
          } elsif ($itype eq "fca") { 
          $fmt =0x0;
            $dst = &getreg ($a[1]);
	    $src1 = &getreg ($a[2]);
            $src2 = 0;
          } elsif ($itype eq "fcb") { 
          $fmt =0x1;
            $dst = &getreg ($a[1]);
            $src1 = &getreg ($a[2]);
            $src2 = 0;
          } elsif ($itype eq "fcc") { 
          $fmt =0x4;
            $dst = &getreg ($a[1]);
            $src1 = &getreg ($a[2]);
            $src2 = 0;
          }
        elsif ($itype eq "fcs") {
            $fmt = 0x0;
            $dst = 0x0;
            $src1 = &getreg ($a[1]);
            $src2 = &getreg ($a[2]);
            
          }
        elsif ($itype eq "fcd") {
            $fmt = 0x1;
            $dst = 0x0;
            $src1 = &getreg ($a[1]);
            $src2 = &getreg ($a[2]);
         } 	
         $out = 0x44000000 | ($src1 << 21) | ($src2 << 16) | ($dst << 11) | ($fmt << 6)| $op;

    } elsif ($itype =~ /^b/) {
	if ($itype eq "b") {
	    $src1 = &getreg ($a[1]);
	    $dst = &getimm ($a[2]);
	} else {	# b0 - branches w/o operands
	    $src1 = 0;
	    $dst = &getimm ($a[1]);
	}
	$dst -= $addr{t} + 4;
	$out = ($op << 26) | ($src1 << 21) | ($dst & 0xffff);
    } elsif ($itype eq "j") {
	$dst = &getimm ($a[1]);
	$dst -= $addr{t} + 4;
	$out = ($op << 26) | ($dst & 0x3ffffff);
    } elsif ($itype eq "jr") {
	$dst = &getreg ($a[1]);
	$out = ($op << 26) | ($dst << 21);
    } elsif ($itype eq "t") {
	$dst = &getimm ($a[1]);
	$out = ($op << 26) | ($dst & 0x3ffffff);
    }
    return ($out);
}

sub getascii {
    local $val,$val2;
    local $str = @_[0];
    local $zpad = @_[1];
    $str =~ s/^\.ascii(z?)\s+//;
    $str = "\$val = " . $str;
    eval ($str);
    local $pstr = "a*";
    $pstr = "a*x" if ($zpad);
    $val2 = pack ($pstr, $val);
#    print "_$val2 _ \n";
    return ($val2);
}