tinyasm

gistfile1.pl

#!/usr/bin/perl -W

# Improvements :
# - Number formats
# - ORG directive
# - Remove empty lines
# - RETI 7xxx
# - Overlapping memory space
# - Hash for immediate values
# - Missing operands
# - Faulty operands (e.g. pushi A)
# - END directive
# - Error and warnings report

%MCODE = (HALT=>0x0000,
         PUSHI=>0x1000,
         PUSH=>0x2000,
         POP=>0x3000,
         JMP=>0x4000,
         JZ=>0x5000,
         JNZ=>0x6000,
         IN=>0xD000,
         OUT=>0xE000,
         ADD=>0xF000,
         SUB=>0xF001,
         MUL=>0xF002,
         SHL=>0xF003,
         SHR=>0xF004,
         BAND=>0xF005,
         BOR=>0xF006,
         BXOR=>0xF007,
         AND=>0xF008,
         OR=>0xF009,
         EQ=>0xF00A,
         NE=>0xF00B,
         GE=>0xF00c,
         LE=>0xF00D,
         GT=>0xF00E,
         LT=>0xF00F,
         NEG=>0xF010,
         BNOT=>0xF011,
         NOT=>0xF012,
         SADD=>0xF013,
         RETI=>0x7000
         );

$addr=0;

while(<>){
    push(@source,$_);
    # Check for ORGs
    if(/ORG\s+(-?\d+)h/) {
        $addr = hex($1)-1;
    } 
    elsif(/ORG\s+(-?\d+)/) {
        $addr = $1-1;
    }
    if(/END\s+(-?\d+)/) {
        # break loop
    } 
    if(/(\w+):/){
       $label{$1}=$addr;
       s/\w+://;
    }
    if(/-?\d+|[A-Z]+/){
       $addr++;
    }
}

# Remove empty lines
@source = grep(/\S/, @source);
@source = grep { $_ ne '' } @source;

print "*** LABEL LIST ***\n";
foreach $l (sort(keys(%label))){
    printf "%-8s%03X\n",$l,$label{$l};
}

$addr = 0;
$Nline = 0;
$Nerrors = 0;
$Nwarnings = 0;
print "\n*** MACHINE PROGRAM ***\n";
foreach (@source){
    $Nline++;
    $line = $_;
    if(/ORG\s+(-?\d+)h/) {
        $addr = hex $1;
        if($1<0) {
            printWarning("Negative memory adress");
        }
    } 
    elsif(/ORG\s+(-?\d+)/) {
        $addr = hex $1;
        if($1<0) {
            printWarning("Negative memory adress");
        }
    } 
    elsif(/END\s?/) {
        push(@writtenAddr,$addr);
        printf "%03X:%04X\t$line",$addr++,$MCODE{HALT}; 
    }
    # Check for PUSHI instructions with immediate value
    elsif(/PUSHI\s+(-?([#])\s?(\d+)h)/){
        push(@writtenAddr,$addr);
        printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI}+(hex $3&0xfff);
    }     
    elsif(/PUSHI\s+(-?([#])\s?(\d+))/){
        push(@writtenAddr,$addr);
        printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI}+($3&0xfff);
    } 
    elsif(/PUSHI\s+(-?([#])\s?(\w+))/){
        push(@writtenAddr,$addr);
        if(defined($label{$3})) {
            printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI}+$label{$3};
        }
        else {
         printError("Invalid argument (use immediate)");
         printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI},($3);           
        }
        
    } 
    elsif(/PUSHI\s+(-?\d+)/){
        printError("Invalid argument (use immediate)");
        printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI}+($1&0xfff);
    }  
    elsif(/PUSHI\s+(-?\w+)/){
        printError("Invalid argument (use immediate)");
        printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI},($1);
    }  
    # PUSHI instruction without operand
    elsif(/PUSHI\s+/){
        printError("Missing operand");
        printf "%03X:%04X\t$line",$addr++,$MCODE{PUSHI};
    } 
    # Normal case, instruction using labeled value
    elsif(/(PUSH|POP|JMP|JZ|JNZ)\s+(\w+)/) {
        # If label is defined, ok!
        if (defined($label{$2})) {
            push(@writtenAddr,$addr);
            printf "%03X:%04X\t$line",$addr++,$MCODE{$1}+$label{$2};
        }
        # Else, give error
        else {
            printError("Undefined label");
            printf "%03X:%04X\t$line",$addr++,$MCODE{$1};
        }
    }
    # Using instruction with given value, OK!
    elsif(/(PUSH|POP|JMP|JZ|JNZ)\s+(\d+)/) {
        push(@writtenAddr,$addr);
        printf "%03X:%04X\t$line",$addr++,$MCODE{$1}+($2&0xfff);
    }
    # Trying to use immediate for adressed operation
    elsif(/(PUSH|POP|JMP|JZ|JNZ)\s+(-?([#])\s?(\d+))/) {
        printError("Invalid argument (cannot use immediate)");
        printf "%03X:%04X\t$line",$addr++,$MCODE{$1};
    }
    elsif(/(PUSH|POP|JMP|JZ|JNZ)\s+(-?([#])\s?(\w+))/) {
        printError("Invalid argument (cannot use immediate)");
        printf "%03X:%04X\t$line",$addr++,$MCODE{$1};
    }
    # Instruction is missing an operand
    elsif(/(PUSH|POP|JMP|JZ|JNZ)\s+/) {
        printError("Missing operand");
        printf "%03X:%04X\t$line",$addr++,$MCODE{$1};
    }
    elsif(/(-?\d+)/){
        $foundLabel = 0;
        foreach $l (sort(keys(%label))){
            if($addr == $label{$l}) {
                $foundLabel = 1;
            }
        }
        if($foundLabel == 1) {
            push(@writtenAddr,$addr);
            printf "%03X:%04X\t$line",$addr++,$1&0xffff;
        }
        else {
            printError("Undefined label");
            print "\t\t$line";
        }
    }
    elsif(/(\w+):/) {
        print "\t\t$line";
    } 
    elsif(/((\w+)+)/){
        if(defined($MCODE{$1})) {
            push(@writtenAddr,$addr);
            printf "%03X:%04X\t$line",$addr++,$MCODE{$1};
        }
        else {
            printError("Unknown instruction");
            printf "%03X:????\t$line",$addr++;   
        }
       }
    else {
        printError("Undecodable line");
        print "\t\t$line";
    }
}

my %dupHash = ();
@dup = map { 1 == $dupHash{$_}++ ? $_ : () } @writtenAddr;

foreach(@dup) {
   warning("Overlapping writes", $_);
}

if($Nerrors == 0 and $Nwarnings == 0) {
    print "\n*** Assembly completed successfully ***\n";
} 
else {
    printf "\n*** Assembly failed with %X errors and %X warnings: ***\n", $Nerrors, $Nwarnings;
    foreach (@errorArray) {
        print $_;
    }
    foreach (@warningArray) {
        print $_;
    }        
}

print("\n");

sub printError {
    $errorStr = "";
    $errorStr .= "Error: ";
    $errorStr .= $_[0];
    $errorStr .= " at line ";
    $errorStr .= $Nline;
    $errorStr .= "\n";
    print $errorStr;
    push(@errorArray, $errorStr);
    $Nerrors++;
}

sub warning {
    $warningStr = "";
    $warningStr .= "Warning: ";
    $warningStr .= $_[0];
    $warningStr .= " to memory space ";
    $decAdr = pack "c", $_[1];
    $hexAdr = unpack "H2", $decAdr;
    $warningStr .= $hexAdr ;
    $warningStr .= "h";
    $warningStr .= "\n";
    push(@warningArray, $warningStr);
    $Nwarnings++;    
}