(UFRN) SIC Assembler

sica.pl

#!/usr/bin/perl
# SIC Assembler
#
# Iuri Gomes Diniz	20022688-2
# Paulo Guto Oliveira 	20022700-5
# Filipe Gustavo Dias  	20022679-3
# 
# MAILTO: [email protected]
# 
# Gera sic.out no diretorio atual (caso tenha conseguido montar).
# 
use strict;
#use warnings;

my $debug = 1;

sub usage() {

	print STDOUT "USO:\n$0 file.sic\n";


}

sub is_char($) { 

	my $char = shift;
	return $char =~ /^C'(.*)'$/;
	
}

sub is_hex($) {
	my $hex = shift;
	return $hex =~ /^X'([a-fA-F0-9]{2})+'$/;
}

sub converter($) {
	my $tipo = shift;

	if (is_char($tipo)) {
		$tipo =~ /^C'(.*)'$/;
		# eu preciso aprender a usar pack e unpack :-(
		# gera um lista com os valores ascii de cada letra 
		#  em $1 (capturado da expressao regular)
		my @l = unpack("c*", $1);
		my $s = "";
		foreach(@l) {
			$s .= sprintf("%02x", $_);
		}
		return $s;
	} elsif (is_hex($tipo)) {
		$tipo =~ /^X'(.*)'$/;
		return $1;
	}

	# nunca deveria chegar aqui.
	return " "x6
	
}
sub tamanho_de($) {
	my $tipo = shift;
	if (is_char($tipo)) {
		$tipo =~ /^C'(.*)'$/;
		return length($1);
	} elsif (is_hex($tipo)) {
		$tipo =~ /^X'(.*)'$/;
		return length($1)/2;
	}
	return -1;
}
sub is_num($) {
	my $num = shift;
	return $num =~ /^[0-9]+$/;
}

# Simbolos do MIC
my %optab= (
   # INSTRUCAO => [ COD_OPERACAO, NUM_ARGUMENTOS ]
   'ADD'   => [ 0x18, 1 ], # ADD m
   'AND'   => [ 0x40, 1 ], # AND m
   'COMP'  => [ 0x28, 1 ], # COMP m
   'DIV'   => [ 0x24, 1 ], # DIV m
   'J'     => [ 0x3C, 1 ], # J m
   'JEQ'   => [ 0x30, 1 ], # JEQ m
   'JGT'   => [ 0x34, 1 ], # JGT m 
   'JLT'   => [ 0x38, 1 ], # JLT m
   'JSUB'  => [ 0x48, 1 ], # JSUB m
   'LDA'   => [ 0x00, 1 ], # LDA m
   'LDCH'  => [ 0x50, 1 ], # LDCH m
   'LDL'   => [ 0x08, 1 ], # LDL m
   'LDX'   => [ 0x04, 1 ], # LDX m
   'MUL'   => [ 0x20, 1 ], # MUL m
   'OR'    => [ 0x44, 1 ], # OR m
   'RD'    => [ 0xD8, 1 ], # RD m
   'RSUB'  => [ 0x4C, 0 ], # RSUB --LIXO--
   'STA'   => [ 0x0C, 1 ], # STA m
   'STCH'  => [ 0x54, 1 ], # STCH m
   'STL'   => [ 0x14, 1 ], # STL m
   'STSW'  => [ 0xE8, 1 ], # STSW m
   'STX'   => [ 0x10, 1 ], # STX m
   'SUB'   => [ 0x1C, 1 ], # SUB m
   'TD'    => [ 0xE0, 1 ], # TD m
   'TIX'   => [ 0x2C, 1 ], # TIX m
   'WD'    => [ 0xDC, 1 ], # WD m
);

my %asmtab = (
	'BYTE'  => undef,
	'RESB'  => undef,
	'RESW'  => undef,
	'END'   => undef,
	'START' => undef,
	'WORD'  => undef,
);

# tamanho da palavra
my $sic_word_size = 3; # 3 bytes

# caracter de comentario;
my $comment_char = '\.';

# existe arquivo a montar?
my $nome_arquivo;
if (defined ($ARGV[0])) {

	$nome_arquivo = $ARGV[0];
	if (not -r $nome_arquivo) {
		print STDERR "nao pude ler '$nome_arquivo'\n";
		exit(1);
	}
} else {
	usage();
	exit(7);
}

# tabela de simbolos gerada do arquivo na 1 passagem
my %symtab;

# guarda as mensagens de erro;
my @mensagens_erro;

# Enderecos
my $locctr;

open(ARQ, '<', $nome_arquivo);
my @linhas;
my @relevantes;
@linhas = <ARQ>;
close(ARQ);

my $nome_programa=" " x 6;
my $endereco_inicial=0;
my $endereco_executavel=0;

my $i = 0;

my $tamanho_programa;
# primeira passagem
foreach my $linha (@linhas) {
	
	$i++;
	my $idx = $locctr;

	chomp($linha);
	
	next if $linha =~ /^\s*$comment_char/;
	next if $linha =~ /^\s*$/;
	
	# remova espacos em branco antes e depois
	$linha =~ s/^\s+//;
	$linha =~ s/\s+$//;


	# separar as laranjas :-)
	my (@parts) = split (/\s+/, $linha);
	
	my ($simbolo, $operacao, $endereco);
	
	if (@parts == 3) {
		($simbolo, $operacao, $endereco) = @parts;
	} elsif (@parts == 1) {
		if (exists($optab{$parts[0]})) {
			$operacao = $parts[0];
		} else {
			$simbolo = $parts[0];
		}
	} elsif (@parts == 2) {
		if (exists($optab{$parts[0]}) or exists($asmtab{$parts[0]})) {
			($operacao, $endereco) = @parts;
		} else {
			($simbolo, $operacao)  = @parts;
		}
	# parts > 3?
	} else {
		push(@mensagens_erro, "ERRO: Formato de linha incorreto\n  linha $i: $linha\n");
		($simbolo, $operacao, $endereco) = @parts[1..3];
		
	}

	# START
	if ( not defined $locctr and defined $operacao and $operacao eq 'START' ) {
		if (defined $simbolo) {
			if ( (my $tam = length $simbolo) <= 6) {
				$nome_programa = $simbolo . " " x (6-$tam);
			} else {
				# truncar
				$nome_programa = substr($simbolo, 0, 6);
			}
		}
		if (defined $endereco and is_num($endereco)) { 
			eval("\$locctr = 0x$endereco");
			#$locctr = int($endereco);
			$endereco_inicial = $locctr;
			next;
		} else  {
			push(@mensagens_erro, "ERRO: 'START' incorreto\n  linha $i: $linha\n");
		}
	} elsif (not defined $locctr) {
		$locctr = 0;
	}
	die "ASSERT" if length($nome_programa) != 6;
	
	# ha um label?
	if (defined $simbolo) {
		
		# simbolo eh valido?
		if (exists($optab{$simbolo}) or exists($asmtab{$simbolo}) ) {
			push(@mensagens_erro, "ERRO: Simbolo '$simbolo' eh uma palavra reservada\n  linha $i: $linha\n");
		}
		if ($simbolo !~ /^[a-zA-Z_][a-zA-Z0-9_]*$/) {
			push (@mensagens_erro, "ERRO: Simbolo '$simbolo' invalido\n  linha $i: $linha\n");
		}
		# label duplicado?
		if (exists($symtab{$simbolo})) {
			push(@mensagens_erro, "ERRO: Simbolo '$simbolo' ja declarado\n  linha $i: $linha\n");
		} else {
			$symtab{$simbolo} = $locctr;
		}
		next if not defined $operacao;
	}

	# eh uma operacao valida do SIC?
	if (exists($optab{$operacao})) {
	
		# precisa de argumento e nao foi especificado
		if ( $optab{$operacao}[1] == 1 and not defined $endereco) {
			push(@mensagens_erro, "ERRO: espera-se um argumento para '$operacao'\n  linha $i: $linha\n");
		# nao precisa de argumento e este foi especificado.
		} elsif ($optab{$operacao}[1] == 0 and defined $endereco) {
			push(@mensagens_erro, "ERRO: instrucao '$operacao' nao precisa de argumento\n  linha $i: $linha\n");
			
		} else {
			$locctr += $sic_word_size; 
		}
		
	# eh uma das diretivas do assembler
	} elsif ($operacao eq 'WORD') { 
		if (defined $endereco and is_num($endereco)) {
			if ($endereco > 2 ** (8 * $sic_word_size)) {
				push(@mensagens_erro, "ERRO: Overflow para WORD\n  linha $i: $linha");
			} else {
				$locctr += $sic_word_size;
			}
		} else {
			push(@mensagens_erro, "ERRO: Esperado um numero para WORD\n  linha $i: $linha");
		}
	} elsif ($operacao eq 'BYTE') {
		# verificar tamanho da constante
		if ( (my $tamanho = tamanho_de($endereco)) != -1 ) {
			$locctr += $tamanho;
		} else {
			push(@mensagens_erro, "ERRO: tipo invalido para BYTE\n  linha $i: $linha");
		}
	} elsif ($operacao eq 'RESW') {
		if (defined $endereco and is_num($endereco)) {
			$locctr += $sic_word_size * $endereco;
		} else {
			push(@mensagens_erro, "ERRO: Esperado um numero para RESW\n  linha $i: $linha\n");
		}
	} elsif ($operacao eq 'RESB') {
		if (defined $endereco and is_num($endereco)) {
			$locctr += $endereco;
		} else {
			push(@mensagens_erro, "ERRO: Esperado um numero para RESB\n  linha $i: $linha\n");
		}
	} elsif ($operacao eq 'END') {
		if (defined $endereco) {
			if (is_num($endereco)) {
				$endereco_executavel = $endereco;
			} else {
				if (exists($symtab{$endereco})) {
					$endereco_executavel = $symtab{$endereco};
				} else {
					push(@mensagens_erro, "ERRO: Endereco final '$endereco' invalido\n  linha $i: $linha\n");
				}
			}
			
		}
		$tamanho_programa = $locctr - $endereco_inicial;

		last;
	} else {
		push(@mensagens_erro, "ERRO: Instrucao '$operacao' invalida\n  linha $i: $linha\n");
	}
	if (not defined $endereco) {
		$endereco = 0x00;
	}
	if (defined $operacao and defined $endereco and defined $idx) {
		push(@relevantes, "$idx $operacao $endereco");
	}
}

if (@mensagens_erro) {
	print foreach(@mensagens_erro);
	exit(1);
}
#%%%
#
# DEBUG
# 
#%%%
if ($debug) {
	print ".\n. SYMTAB\n.\n";
	foreach (sort { $symtab{$a} <=> $symtab{$b} } keys(%symtab)) {
		printf "%04x: %s\n", $symtab{$_}, $_;
	}
	print ".\n. ENDERECOS INSTRUCOES\n.\n";
	foreach(@relevantes) {
		printf ("%06x\t%s\t\t%s\n", split );
	}
}
# fim da primeira passagem


# segunda passagem
open (CODOBJ, ">", "sic.out");

print ".\n. GERANDO CODIGO OBJETO\n.\n";


# qual o tamanho?
#my $tamanho = 0;
printf CODOBJ ("H%s%06x%06x\n", $nome_programa, $endereco_inicial, $tamanho_programa);

my $need_flush = 0;
my $tamanho_seg = 0;
my $buffer = "";

foreach my $linha (@relevantes) {
	my ($idx, $operacao, $endereco) = split(" ", $linha);
	
	my $indexado = 0;
	if ($endereco =~ /^(.+),X$/) {
		$endereco = $1;
		$indexado = 1;
	}
	if (exists($optab{$operacao})) {
		if (not is_num($endereco)) {
			if (exists ($symtab{$endereco}) ) {
				$endereco = $symtab{$endereco};	
			} else {
				push(@mensagens_erro, "WARNING: simbolo '$endereco' ainda nao definido, usando 0x0000\n");
				$endereco = 0;
			}
		}
		if ($indexado) {
			# ligar bit X 
			$endereco = ($endereco | 0x8000);
		}
		#printf ("%s (%02x) -- %06x -- x=$indexado\n", $operacao, $optab{$operacao}[0], ($optab{$operacao}[0] << 16) + $endereco);
		$operacao = ($optab{$operacao}[0] << 16) + $endereco ;
		
		if ($tamanho_seg == 0) {
			# comeco de um novo segmento de texto (houve flush)
			$buffer = sprintf("T%06xZZ", $idx);
			$need_flush = 0;
		} 
		$tamanho_seg += $sic_word_size;
		$buffer .= sprintf("%06x", $operacao);
		
	} else {
		if( $tamanho_seg == 0 and ($operacao eq 'WORD' or $operacao eq 'BYTE') ) {
			# comeco de um novo segmento de texto (houve flush)
			$buffer = sprintf("T%06xZZ", $idx);
			$need_flush = 0;
		}
		
		if ($operacao eq 'WORD') {
			# endereco ja eh numero
			$tamanho_seg += $sic_word_size;
			$buffer .= sprintf("%06x", $endereco);
		} elsif ($operacao eq 'BYTE') {
			$tamanho_seg += tamanho_de($endereco);
			# converter X'xxxx' -> hexa, C'ccccc' -> hexa
			$buffer .= sprintf("%s", converter($endereco));
		} else {
			$need_flush = 1;
		}

	}
	if ($tamanho_seg >= 0x1E) {
		$need_flush = 1;
	}
	
	if ($need_flush and $tamanho_seg > 0) {
		# atualizar tamanho
		$buffer =~ s/ZZ/sprintf("%02x", $tamanho_seg)/e;
		$buffer .= "\n";
		# despejar arquivo
		print CODOBJ $buffer;
		# limpar buffer
		$buffer = "";
		$tamanho_seg = 0;
		$need_flush = 0;
	}
	
}

if ($tamanho_seg >= 0 ) {
	# need flush
	$buffer =~ s/ZZ/sprintf("%02x", $tamanho_seg)/e;
	$buffer .= "\n";
	print CODOBJ $buffer;
} 

printf CODOBJ ("E%06x\n", $endereco_executavel);

close (CODOBJ);

if (@mensagens_erro) {
	print foreach(@mensagens_erro);
}
print ".\n. MONTADO COM SUCESSO -- FIM DO SIC\n.\n";