#!/opt/perl5/bin/perl
#
our $version = "1.2";

#
# author: Ugne Tenikaitiene
# e-mail: ugne.tenikaitiene@tut.fi (liepsna@yahoo.com)
#
#
# ATTENTION: Output, Binary/Hexadecimal Outputs, Listing and Temporary files have extensions: 
# 			out
# 			bin
#			lst
#			tmp
# 
# Example: if input file is	   		  				'first.asm', then
# 		   output file will be => 	   				first.out
#		   binary/hex text segment file will be => 	first_ts.bin
#		   binary/hex data segment file will be => 	first_ds.bin
#		   listing file will be =>	   				first.lst
#		   temporary files will be =>   			*.tmp (by default deleted)
#									  
# Error file is always 'error_list' (by default deleted if none errors found)
# Output file is deleted if some errors found (by default -> if -Z isn't used)
# Error messages are in console and in 'error_list' file
#
#
# 31.01.2005
#
# Revisions:
#
# 1. 15.02.2005 - macro bug fixed (and few more small bugs)
# 2. 15.04.2005 - small bug - incorrect relocation entry - fixed
#
# 
# -------------- END OF INFORMATION ---------------------------
# ------------------------------------------------------------------------------

# --------------- PROGRAM -----------------------------
# sub program

# 1st circle
open1();
preface();
close1();

# 2nd circle
open2();
main();
close2();
# -------------- END OF PROGRAM ---------------------------
# ------------------------------------------------------------------------------

# --- POD: SYNOPSIS and DESCRIPTION ---
#sub pod
=pod

=head1 SYNOPSIS

 I<crasm> [input_file] [-Include path|-I path]
  [[-binary | -b] | [-hex | -h]] [-help|-h] [-list|-l]
  [-obj output_file|-o output_file] [-symbols|-s] [-version|-v]
  [-warnoff|-w] [--version|--v] [-Z]
   
B<Meanings of arguments:>
 I<input_file>          Input file name.
 -I<Include path>       Add path to the search list for I<.include> directives.
 -I<binary>             Create separate binary output file
 -I<hex>                Create separate hexadecimal output file
 -I<help>               Prints help (synopsis)
 -I<list>               Turn on listings.
 -I<obj output_file>    Name the object-file from I<crasm> output_file.
 -I<symbols>            No local symbols in symbol table
 -I<warnoff>            Suppress warning messages.
 -I<version>            Print the I<crasm> version.
 --I<version>           Print the I<crasm> version and exit.
 -I<Z>                  Generate an object file even after errors.

B<NOTE:> order of attributes is not matter, but each attribute should be separate by at least one space character.

=head1 DESCRIPTION

 I<crasm> is used for translating COFFEE TM RISC assembly language input file to COFF output file.

=cut
# --- END OF POD: SYNOPSIS and DESCRIPTION ---

# --------------- OPENING FILES, PART 1 -----------------------------
sub open1
{    
    # if none arguments -> check synopsis
    die synopsis() unless ($ARGV[0]);
	
    # variables for whole program:
    # input file
    our $file_in;
	# output file
    our $file_out = "";
	# names for temporary files are set in sub open_tem()

    # list of pathes where to find files for including
    our @path;
    
    # by default:
	# binary output file
	our $b_out = 0;
    # deleting output file if errors found
    our $not_del = 0;
    # warnings are on
    our $w_on = 1;
    # listing is off
    our $list = 0;
	# local symbols are in symbol table
	our $no_sym = 0;
	our $count_local = 0;
    
    # check program call arguments (@ARGV)
    arguments();
    
	# change extension or just add one
	my $file_tmp;
	# only name of input file (without extension)
	($file_tmp = $file_in) =~ s/(\..*?|\s*)$//;
	$file_out = $file_tmp unless ($file_out);
	($file_out_ts = $file_out) .= '_ts.bin';
	($file_out_ds = $file_out) .= '_ds.bin';
	$file_out .= ".out";
	
	# input -> reading
    open(IN, "\<" . $file_in) || die "Unable to open $file_in file: $!";
	# error file -> writing
    open(ER, "\>" . "error_list") || die "Unable to open error_list file: $!";
	
    if ($list)
    {
		# listing file -> writing
		my $file_lst;
		($file_lst = $file_tmp) .= '.lst';
    	open (LST, "\>" . $file_lst) || die "Unable to open $file_lst file: $!";
    	print LST "Labels:\n";
    }
}
# -------------- END OF OPENING FILES, PART 1 ---------------------------

# ------------------------------------------------------------------------------
# ----------------------------- SUBROUTINES FOR WHOLE PROGRAM ------------------
# ------------------------------------------------------------------------------
# --------------- FORMAT FOR ERROR MESSAGES -----------------------------
# IN: 	$_[0] 			: message to be printed out
#     	$lnr = $_[1]	: line where error was found number
# SET: 	$error 			: 1 if error was found
sub error_printing
{
	my $lnr = $_[1];
	print ER "Error on line number $lnr -> $_[0]\n";
	print STDOUT "Error on line number $lnr -> $_[0]\n";
	$error = 1;
}
# --------------- END OF FORMAT FOR ERROR MESSAGES -----------------------------

# --------------- FORMAT FOR WARNING MESSAGES -----------------------------
# IN: 	$_[0] 			: message to be printed out
#		$lnr = $_[1]	: line where warning was found number
# SET: 	$warning 		: 1 if warning was found
sub warning_printing
{
	if ($w_on)
	{
		my $lnr = $_[1];
		print ER "Warning on line number $lnr -> $_[0]\n";
		print STDOUT "Warning on line number $lnr -> $_[0]\n" ;
		$warning = 1;
	}
}
# --------------- END OF FORMAT FOR WARNING MESSAGES ---------------------------
# ------------------------------------------------------------------------------
# ----------------------------- END OF SUBROUTINES FOR WHOLE PROGRAM -----------
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# ----------------------------- SUBROUTINES FOR OPENING FILES ------------------
# ------------------------------------------------------------------------------
# --------------- SYNOPSIS -----------------------------
sub synopsis
{
	print "SYNOPSIS:\n crasm [input_file] [-Include path | -I path]\n";
	print "[[-binary | -b] | [-hex | -h]] [-help | -h] [-list | -l]\n";
	print "[-obj output_file | -o output_file] [-symbols | -s]\n";
	print "[-version | -v] [--version | --v] [-warnoff | -w] [-Z]\n";
}
# --------------- END OF SYNOPSIS -----------------------------

# --------------- MANAGING ARGUMENTS -----------------------------
# IN:	@ARGV
# SET:	$file_out	: name of output file if -o
#		@path		: path for include files if -I
#		$list		: 1 (listing file is needed) if -l
#		$no_sym		: 1 (no local symbols in sym table) if -s
#		$w_on		: 0 (no warnings) if -w
#		$not_del	: 1 (keep output file if errors) if -Z
#		$b_out		: 1 (separate files for text and fata in binary) if -b;
#					  2 (separate files for text and fata in hexadecimal) if -x
#		$file_in	: name of input file (always)
sub arguments
{
	my $argm;
	while (@ARGV)
	{
		# current argument from list
		$argm = shift @ARGV;
		if ($argm =~ m/^--v(ersion)?\b/)
		{
			print "You are using crasm $version\n";
			die "bye-bye";
		}
		elsif ($argm =~ s/^-//)
		{
			if ($argm =~ m/^o(bj)?\b/)
			{
				# name of output file
				$file_out = shift @ARGV;
				if ($file_out =~ m/^-/)
				{
					print "Missing output file name\n";
					die synopsis();
				}
			}
			elsif ($argm =~ m/^h(elp)?\b/)
			{
				synopsis();
			}
			elsif ($argm =~ m/^[Ii](nclude)?\b/)
			{
				my $tmp = shift @ARGV;
				if ($tmp =~ m/^-/)
				{
					print "Missing include file path\n";
					die synopsis();
				}
				# add path to list
				push (@path, $tmp);
			}
			elsif ($argm =~ m/^l(ist)?\b/)
			{
				# possibility to open LST file
				$list = 1;
			}
			elsif ($argm =~ m/^s(ymbols)?\b/)
			{
				# no need to add local symbols
				$no_sym = 1;
			}
			elsif ($argm =~ m/^v(ersion)?\b/)
			{
				print "You are using crasm $version\n";
			}
			elsif ($argm =~ m/^w(arnoff)?\b/)
			{
				# switch off warnings
				$w_on = 0;
			}
			elsif ($argm =~ m/^[Zz]\b/)
			{
				# do not delete output after errors
				$not_del = 1;
			}
			elsif ($argm =~ m/^b(inary)?\b/)
			{
				# produce binary output
				$b_out = 1;
			}
			elsif ($argm =~ m/^(he)?x\b/)
			{
				# produce hexadecimal output
				$b_out = 2;
			}
			else
			{
				print "Sorry, such argument is not allowed <-$argm>\n";
				die synopsis();
			}		
		}
		else
		{
			# gets the name of the input file (no '-' sign before)
			# attention - if it will be more as 1 argument without '-' sign ->
			# last one will be name of input file also NONE error message
			$file_in = $argm;
		}
	}
}
# --------------- END OF MANAGING ARGUMENTS -----------------------------
# ------------------------------------------------------------------------------
# ----------------------------- END OF SUBROUTINES FOR OPENING FILES -----------
# ------------------------------------------------------------------------------

# --------------- PREFACE -----------------------------
sub preface
{
    # location counter
    # start line number is 0
    our $num = 0;
    # by default code starts in 32-bit mode, so every line whit instruction increases counter with 4
    # when mode is changed to 16-bit, $plus gets value 2
    our $plus = 4;
    # it is just start, so no errors were found (yet)
    our $error = 0;
    # line from input file
    our $line = "";
	# line number;
	our $lnr;
	# now we are in 1st circle
	our $second = 0;
	
	our %macro;
	
	# $fh_names[segment][place][subsection_nr]{l_counter, mode, reloc, flag, name, dot, abs_place, line_nr}
	our @fh_names;
	# $names{name}{segment, place, in_sym_t, where_starts, in_string, section_nr}
    our %names;
	
	# filehandler for current writing
	our $fh;
	# how many sections
	our $sec_nr = 0;
	# whole code size
	our $full_size = 0;
	# all relocations
	our $full_reloc = 0;
	# all line numbers
	our $full_line_nr = 0;
	# constant table
	our %const_t = ();
	
	# relocations table 
	# $rel_table{name}{l_counter, section_name, in_sym_t}
	our %rel_table = ();
	
	# label checking call from macro
	our $m_call = 0;
	# by default absolute section isn't defined
	our $absolute = 0;
	# absolute section place
	our $abs_place = 0;
	our $found_reloc;
	our $reloc = 0;
	
	# symbol table - array of array
	# [section_nr]{name, abs_place, label_address}
	our @sym_table;
	
	# size of file header is fixed and always 20 bytes long    
    our $filhsz = 20;
	# size of section header is fixed and always 40 bytes long
	our $scnhsz = 40;
	# size of relocation entry is fixed and always 10 bytes long
	our $relsz = 10;
	# size of line number entry is fixed and always 6 (??) bytes long
	our $linesz = 6;
	# size of symbol table entry is fixed and always 18 bytes long
	#our $symesz = 18;
	# size of auxiliary simblol table entry is fixed and always 18 bytes long
	#our $auxesz = 18;
	
	# how many symbol table entries
	our $full_sym_entries = 0;
	# which entry in symbol table
	our $sym_nr = 0;
	# length of string table min is 4bytes (where is written self length, 0 if nothing)
	our $string_length = 4;
	our $string_entry = "";

	# [adr_in_bytes0-3, which_bit + length + how_many_shifts + mode]
	our %relocations = 
	(
		lli  => [2, "4F00"],
		lli2 => [2, "21F8"],
		lui  => [2, "4F80"],
		lui2 => [2, "2178"],
		ori1 => [1, "67C8"],
		ori2 => [1, "6790"],
		ori3 => [1, "6758"],
		ori4 => [1, "6720"],
		ori5 => [1, "6400"],
		w => [3, "0000"],
		bx32 => [3, "1606"],
		jx32 => [3, "1906"],
		bj16 => [1, "0A05"],
	);
	
	# header for error_list file
    print ER "Line \t Offset \t \t Instruction\n";
    print ER "number \n\n";
    
    # main function for reading input file
	# IN is main asm input file (from 'sub open1()')
    reading_all(*IN);
}
# -------------- END OF PREFACE ---------------------------

# ------------------------------------------------------------------------------
# ------------------------------ SUBROUTINES, PART 1 ---------------------------
# ------------------------------------------------------------------------------
# --------------- READING EVERYTHING -----------------------------
# IN:	IN = @_	: filehandler for current open input file
# global:	$num
#			$plus
#			$line
# main function in 1st circle
# reading line after line from input file
# is needed to get input filehandler as function argument 
sub reading_all
{
	local(*IN) = @_;
	while (defined($line = <IN>))
	{
		# error file = original file
		print ER "$.  \t $num  \t $plus \t $line";

		# deleting comments
		comments();
		
		# if not empty line - process it
		processing() if ($line);
	}
}
# --------------- END OF READING EVERYTHING -----------------------------

# --------------- DELETING COMMENTS -----------------------------
# SET:	$line	: output line is without not needed spaces and comments
# 27.08.2003 - BLOCK COMMENTS AREN'T ALLOWED
# allowed comments:
# 1. one line comment - starting sign '//' till end of line
# 2. one line comment - starting sign ';' till end of line
sub comments
{
	# deleting all empty characters before and after code line and comments
#	$line =~ s/^\s+|\s*($|(\/\/|;).*?$)//g;
	
	# delete comment
	$line =~ s/(\/\/|;).*?$//;
	# delete space from start
	$line =~ s/^\s*//;
	# delete space from end
	$line =~ s/\s*$//;
	# minimize spaces
	$line =~ s/\s+/ /;
}
# --------------- END OF DELETING COMMENTS -----------------------------

# --------------- FINDING LABEL -----------------------------
# IN:	$line	: global; whole line
sub f_l
{
	# try to find labels sign ':' (if it isn't in directive)
	if (($line =~ m/:/) && ($line !~ m/^\./))
	{
		# open .text section in case label is 1st line
		open_tmp("text", 0, "STYP_TEXT") unless (%names);
		# checking label
		label();
	}
}
# -------------- END OF FINDING LABEL ---------------------------

# ------------- LABEL HANDLING ----------------------------
# writing label into table
# principle:
# 1. separate label
# 2. if command in second line - reducing command line number 
# 3. write label and command line number in table
# labels are global for whole code 
# NOTE: if label is before section directive, label is pointing to current 
#	section end, not to the new section
# Anyway - jums between sections will cost errors
# IN:	$line	: global; whole line
# OUT:	$line	: global; line without label
# global:	$m_call		:
#			$l_table	:
#			$e_l_table	:
#			%macro		:
#			$name		:
#			@global		:
#			%rel_table	:
#			$num		:
#			$file		:
#			$sym_nr		:
#			@sym_table	:
#    		$sec_nr		:
#			$count_local:
sub label
{
	my $global_found = 0;
	my $label;
	
	# find ':' and split the line into a label and rest of line
	($label, $line) = split /\s*:\s*/, $line, 2;
	
	# write label and line number in label table
	# hash of hashes
	# according section name ($fh or $file)
	# if label defined twise - error, new value ignored
	
	# forbiden symbols: 
	# a) on start any if not letter
	# b) empty label
	# c) spaces in label
	if ($label =~ m/\s|^$|^[^a-zA-Z]/)
	{
		error_printing("Illegal label syntax or empty label- <$label>", $.);
	}
	elsif ($e_l_table{$label})
	{
		error_printing("Such label <$list[$i]> is defined as external on line <$e_l_table{$list[$i]}>", $.);
	}
	else
	{
		if ($m_call)
		{
			# $file => the same
			$label = $macro{$name}[1] . $label;
		}

		# for relocations
		# check if label is global
		for $i (0..$#global)
		{
			if ($label eq $global[$i])
			{
		    	$global_found = 1;
				last;
			}
		}

		$rel_table{$label} = {l_counter => $num, section_name => $file, in_sym_t => $sym_nr};

				
    	# all label table
    	$l_table{$label} = $num;
		
		unless ($global_found)
		{
    		$sym_table[$sec_nr]{name} = $label;
    		$sym_table[$sec_nr]{label_address} = 1;
    		$sec_nr++;	
			$sym_nr++;
			$count_local++;
		}
	}
	
	# writing position to LST file
	print LST ".$file ", (sprintf "%08lX", $num), " \t $label \n" if ($list);
}
# ------------- END OF LABEL HANDLING ---------------------

# --------------- PROCESSING ONE LINE -----------------------------
# 19.09.2003 - directive checking removed to separate subroutine
sub processing
{
	$found_reloc = 0;
	
	# label checking
	f_l(); 

	# directives checking
	# directive should start on beginning of the line
	# in comments() all empty characters from both sides are deleted
	if ($line =~ s/^\.//)
	{
		change_const() if (%const_t);
		directives();	
	}
	# constant checking and adding to table
	# .equ is already checked in directives()
	# just m// because s/// is in find_const()
	elsif ($line =~ m/=/)
	{
		find_const();			
	}
	# if not directive or constant
	else
	{
		change_const() if (%const_t);
		open_tmp("text", 0, "STYP_TEXT") unless (%names);

		# replacing macros
		find_macro() if (%macro);
		
		warning_printing("Unknown mode (use .codeXX directive)", $.) if ($file_open);
		
				
		# line checking
		# (syntax)
		check_line() if ($line);
		$file_open = 0;
	}
}
# --------------- END OF PROCESSING ONE LINE ---------------------------

# --------------- ABSOLUTE SECTION -----------------------------
sub absolute
{
	# boolean to mark that abs section is defined
	# is impossible to use one variable => absolute section can be places in 0x0
	$absolute = 1;
	# abs section place
	$abs_place = $line;
	error_printing("Wrong defined absolute section", $.) unless ($line =~ m/^\d+$/);
}
# --------------- END OF ABSOLUTE SECTION ---------------------------

# --------------- CHECK IF SECTION DIRECTIVE -----------------------------------
# IN  : 
# OUT : $not_s	: 1 if it was not a section directive
sub check_if_section
{
	my $not_s = 1;
	if ($line =~ s/^text\b\s*//)
	{
		# no need to define flag, because it is fixed and set in open_tmp()
		open_tmp("text", $line, "STYP_TEXT");
		$not_s = 0;
	}
	elsif ($line =~ s/^data\b\s*//)
	{
		# no need to define flag, because it is fixed and set in open_tmp()
		open_tmp("data", $line, "STYP_DATA");
		$not_s = 0;
	}
	elsif ($line =~ s/^rdata\b\s*//)
	{
		# no need to define flag, because it is fixed and set in open_tmp()
		open_tmp("rdata", $line, "STYP_RDATA");
		$not_s = 0;
	}
	elsif ($line =~ s/^bss\b\s*//)
	{
		# no need to define flag, because it is fixed and set in open_tmp()
		open_tmp("bss", $line, "STYP_BSS");
		$not_s = 0;
	}
	elsif ($line =~ s/^section\s+//)
	{
		section_manager();
		$not_s = 0;
	}
	else
	{
		# if none section was defined till now
		open_tmp("text", 0, "STYP_TEXT") unless (%names);
	}
	return $not_s;
}
# --------------- END OF CHECK IF SECTION DIRECTIVE ----------------------------

# --------------- MANAGE .SECTION ----------------------------------------------
# syntax '.section name[, flag, absolute_place]'
# '.section' is already deleted
sub section_manager
{
	my $name = "";
	my $flag = "";
			
	# $line => name & flag
	($name, $flag, $line) = split /\s*,\s*/, $line, 3;
	
	# if flag isn't defined, but an absolute section is in $flag
	# flag is one letter
	# if nothing in $flag => flag is default (text) and none absolute section
	$line = $flag if ($flag && ($flag !~ m/^\w$/));
	
	$name = uc($name);
	
	if ($name eq "TEXT" || $name eq "RDATA" || $name eq "DATA" || $name eq "BSS")
	{
		error_printing("Illegal section name - $name", $.);
	}
	
	open_tmp($name, $line, $flag);
}
# --------------- END OF MANAGE .SECTION ------=--------------------------------

# --------------- OPEN *.TMP FILE ----------------------------------------------
# 14.01.2004 - changed to use 2 tables
# 10.09.2004 - absolute() moved inside opent_tmp()
# @fh_names is table where all sections are separated by segments and ordered
# 	also lenght and mode of section is kept
# %names is table where section name is maped with specific segment and place
# when file is open, he is in %names table
# IN  : $_[0]	: file name
#		$_[1]	: address if sections should be absolute
#		$_[2]	: flag
# OUT : 
sub open_tmp
{
	# capital letters for file name
	our $file = uc($_[0]);
	my $line_nr = $_[1];
	
	our $absolute;
	our $abs_place;
	my $nr;
	
	# if something more in line => defined absolute section
	absolute($line_nr) if ($line_nr);

	error_printing("Illegal section name syntax - <$file>", $.) if ($file =~ m/\s/);
	
	# if not 1st section
	if (%names)
	{
		# saving current line counter, current mode and amount of relocations
		$fh_names[$segment][$place][0]{l_counter} = $num;
		$fh_names[$segment][$place][0]{mode} = $plus;
		$fh_names[$segment][$place][0]{reloc} = $reloc;
		
		# if subsections
		$nr = $#{$fh_names[$segment][$place]};
		if ($nr)
		{
			$num2 = $num - $num2;
			$reloc2 = $reloc - $reloc2;
	
			# previous subsection data (if not 1st)
			$fh_names[$segment][$place][$nr]{l_counter} = $num2;
			$fh_names[$segment][$place][$nr]{reloc} = $reloc2;
		}
	}
	
	# if not oppened yet
	# temporary file -> writing
	open_initial($_[2]) unless ($names{$file});

	# set new section like current
	$fh = $file;
	
	# downloading needed values for new section
	$segment = $names{$file}{segment};
	$place = $names{$file}{place};	
	$num = $fh_names[$segment][$place][0]{l_counter};
	$num2 = $num;

	$plus = $fh_names[$segment][$place][0]{mode};
	$reloc = $fh_names[$segment][$place][0]{reloc};
	
	$file_open = 1 if ($fh_names[$segment][$place][0]{flag} eq "STYP_TEXT");
	# selecting filehandle for writing in
	select $fh;
}
# -------------- END OF OPEN *.TMP FILE ---------------------------

# --------------- OPEN INITIAL FILE -----------------------------
sub open_initial
{
	my $dot = 0;
	my $flag = $_[0];
	
	# is needed to choose proper flag
    # no warnings/errors if flag is badly written - default value will be used
    switch:
    { 
    	if ($flag =~ m/^x/) 
        { 	
            $flag = "STYP_TEXT";
            # text segment
            $segment = 0;
            $place = $#{$fh_names[0]} + 1; 
            last switch;
        }
        if ($flag =~ m/^d/) 
        { 
            $flag = "STYP_DATA";
            # data segment
            $segment = 1;
            $place = $#{$fh_names[1]} + 1;
            last switch;
        }
        if ($flag =~ m/^r/) 
        { 
            $flag = "STYP_RDATA";
            # text segment
            $segment = 0;
            $place = $#{$fh_names[0]} + 1; 
            last switch;
        }
        if ($flag =~ m/^b/) 
        { 	
            $flag = "STYP_BSS";
            # bss segment
            $segment = 2;
            # length of bss segment + 1;
            $place = $#{$fh_names[2]} + 1;
            last switch;
        }
        if ($file eq "TEXT") 
        { 	
            # text segment
            $segment = 0;
            $place = 0;
			$dot = 1; 
            last switch;
        }
        if ($file eq "DATA")
        {
            # data segment
            $segment = 1;
            $place = 0;
			$dot = 1;
            last switch;
        }
        if ($file eq "RDATA") 
        { 
            # text segment
            $segment = 0;
            $place = 1; 
			$dot = 1;
            last switch;
        }
        if ($file eq "BSS")
        {
            # bss segment
            $segment = 2;
            $place = 0;
			$dot = 1;
            last switch;
        }
        # if nothing - text section too
        $flag = "STYP_TEXT";
        # text segment
        $segment = 0;
        $place = $#{$fh_names[0]} + 1; 
        last switch;
   	}
    
	open($file, "\>" . $file . "\.tmp") || die "Unable to open $file.tmp file: $!";
	
	# $sym_nr - entry number in symbol table
	$names{$file} = {segment => $segment, place => $place, in_sym_t => $sym_nr};
	# increasing by 2 because od auxiliary entry
	$sym_nr += 2;
    
	# symbol table details
	# $sec_nr -> sections appearance order in original file
	$sym_table[$sec_nr]{name} = $file;
	
    # initial line counter
    $num = 0;
    # default $plus
    $plus = 4;
    # write into hash to mark file
    $fh_names[$segment][$place][0] = {name => $file, flag => $flag, l_counter => $num, mode => $plus, dot => $dot};
    # if this section is absolute
    if ($absolute)
	{
		$sym_table[$sec_nr]{abs_place} = $abs_place;
		$fh_names[$segment][$place][0]{abs_place} = $abs_place;
	}
	$absolute = 0;
	$sec_nr++;
}
# -------------- END OF OPEN INITIAL FILE ---------------------------

# --------------- CHECKING DIRECTIVES -----------------------------
sub directives
{
	# not section
	# value is changed if some section is defined
	my $not_s = check_if_section();
	
	if ($line =~ s/^align\s+//)
	{
		align_manager();
	}
	elsif ($line =~ s/^ascii\s+//)
	{
		ascii_manager();
	}
	elsif ($line =~ s/^byte\b\s*//)
	{
		byte_manager();
	}
	elsif ($line =~ m/^code\s*\d+/)
	{
		code_manager();
	}
	elsif ($line =~ s/^double\b\s*//)
	{
		double_manager();
	}
	elsif ($line =~ s/^err\b\s*//)
	{
		err_manager();
	}
	elsif ($line =~ s/^extern\s+//)
	{
		# writes symbols into array
		extern_manager();
	}
	elsif ($line =~ m/^equ\s+/)
	{
		find_const();
	}
	elsif ($line =~ s/^fill\s+//)
	{
		fill_manager();
	}
	elsif ($line =~ s/^float\b\s*//)
	{
		# is needed to check
		float_manager();
	}
	elsif ($line =~ s/^global\s+//)
	{
		# writes symbols into array
		global_manager();
	}
	elsif ($line =~ s/^hword\b\s*//)
	{
		hword_manager();
	}
	elsif ($line =~ s/^include\b\s*//)
	{
		include_manager();
	}
	elsif ($line =~ s/^lword\b\s*//)
	{
		lword_manager();
	}
	elsif ($line =~ s/^macro\s+//)
	{
		macro_manager();
	}
	elsif ($line =~ s/^org\s+//)
	{
		org_manager();
	}
	elsif ($line =~ s/^(end)?proc\b//)
	{
		# ignoring
	}
	elsif ($line =~ s/^space\s+//)
	{
		space_manager();
	}
	elsif ($line =~ s/^word\b\s*//)
	{
		word_manager();
	}
	elsif ($line =~ m/^if\b\s*/)
	{
		# not implemented yet
		# conditional assembler ..
		#if_manager();
		error_printing("Conditionally assembling isn't supported", $.);
	}
	
	# some problems
	elsif ($not_s)
	{
		error_printing("Unknown directive (or wrong syntax): .$line", $.);
	}
}
# --------------- END OF CHECKING DIRECTIVES ---------------------------

# --------------- MANAGE .ERR -----------------------------
# syntax '.err "message"'
# '.err' is already deleted
sub err_manager
{
	# $line => "message";
	die "User defined error, stop at line $. - $line";
}
# -------------- END OF MANAGE .ERR ---------------------------

# --------------- MANAGE .EXTERN -----------------------------
# It is used to declare a symbol which is not defined anywhere in the
#	 module being assembled, but is assumed to be defined in some other module
#	 and needs to be referred to by this one.
# syntax '.extern symbol[, symbol2, .., symbolN]'
# '.extern' is already deleted
sub extern_manager
{
	# $line => list of symbols;
	@list = split /\s*,\s*/, $line;
	push @extern, @list;
	for $i (0..$#list)
	{
		if ($l_table{$list[$i]})
		{
			error_printing("Such label <$list[$i]> exists on line <$l_table{$list[$i]}>", $.);
			last;
		}
		# external label table
		$e_l_table{$list[$i]} = $.;
	}
}
# -------------- END OF MANAGE .EXTERN ---------------------------

# --------------- MANAGE .GLOBAL -----------------------------
# The GLOBAL directive applying to a symbol must appear before the definition
#	 of the symbol.
# syntax '.global symbol[, symbol2, .., symbolN]'
# '.global' is already deleted
sub global_manager
{
	# $line => list of symbols;
	@list = split /\s*,\s*/, $line;
	push @global, @list;
	for $i (0..$#list)
	{
		if ($l_table{$list[$i]})
		{
			error_printing("Such label <$list[$i]> exists on line <$l_table{$list[$i]}>", $.);
			last;
		}
		if ($e_l_table{$list[$i]})
		{
			error_printing("Such label <$list[$i]> is defined as external on line <$e_l_table{$list[$i]}>", $.);
			last;
		}
	}
}
# -------------- END OF MANAGE .GLOBAL ---------------------------

# --------------- SEPARATE DATA -----------------------------
# separates data in .byte, .hword, .lword, .float, .double
sub separate_data
{
	my @symbols;
	
	# .align ($div/2) should by done if needed
	unless ($num % $div == 0)
	{
		$x = $div / 2;
		error_printing("Wrong boundary ('.align $x' should by done before)", $.);
	}

	# $line => hwords, separated by ',' or nothing
	if ($line)
	{
		@symbols = split /\s*,\s*/, $line;
		
		# OUTPUT
		for $i (0..$#symbols)
		{
			if ($symbols[$i] =~ s/\'//g)
			{
				print "$.:$num:a:$symbols[$i]\n"
			}
			else
			{
				# if something starts with letter -> name -> relocation is needed
				if ($symbols[$i] =~ m/^([a-z]|[A-Z])/)
				{
					$reloc++;
					# to mark relocation place
					$symbols[$i] = "@" . $symbols[$i];
				}

				print "$.:$num:$id:$symbols[$i]\n";
			}
			# increasing location counter by needed amount of bytes
			$num += $add;
		}
	}
	else
	{
		# 0 to output
		print "$.:$num:$id:0\n";
		$num += $add;
	}
}
# -------------- END OF SEPARATE DATA ---------------------------

# --------------- MANAGE .BYTE -----------------------------
# syntax '.byte [b1,..bn]'
# '.byte' is already deleted
sub byte_manager
{
	$id = 'b';
	$div = $add = 1;
	separate_data();
}

# -------------- END OF MANAGE .BYTE ---------------------------

# --------------- MANAGE .HWORD -----------------------------
# syntax '.hword [n1,..nn]'
# '.hword' is already deleted
sub hword_manager
{
	$id = 'h';
	$div = $add = 2;
	separate_data();
}
# -------------- END OF MANAGE .HWORD ---------------------------

# --------------- MANAGE .WORD -----------------------------
# syntax '.word [n1,..nn]'
# '.word' is already deleted
sub word_manager
{
	my $text;
	# if with '"' -> ASCII text
	if ($line =~ s/\"//g)
	{
		# .align 2 should by done if needed
		unless ($num % 4 == 0)
		{
			error_printing("Not word boundary ('.align 2' should by done before)", $.);
		}
		# each symbol is extented from byte to word with additional zero
		$text = join '000', split //, $line;
		$text = "000" . $text;

		print "$.:$num:a:$text\n";
		# new line number 
		$num += length $text;
	}
	else
	{
		$id = 'w';
		$div = $add = 4;
		separate_data();
	}
}
# -------------- END OF MANAGE .WORD ---------------------------

# --------------- MANAGE .DOUBLE -----------------------------
# syntax '.double [n1,..nn]'
# '.double' is already deleted
sub double_manager
{
	$id = 'd';
	$div = 4; 
	$add = 8;
	separate_data();
}
# -------------- END OF MANAGE .DOUBLE ---------------------------

# --------------- MANAGE .FLOAT -----------------------------
# syntax '.float [n1,..nn]'
# '.float' is already deleted
sub float_manager
{
	$id = 'f';
	$div = $add = 4;
	separate_data();	
}
# -------------- END OF MANAGE .FLOAT ---------------------------

# --------------- MANAGE .LWORD -----------------------------
# 25.09.2003 - copy of sub byte_manager 
# syntax '.lword [n1,..nn]'
# '.lword' is already deleted
sub lword_manager
{
	$id = 'l';
	$div = 4;
	$add = 8;
	separate_data();
}	
# -------------- END OF MANAGE .LWORD ---------------------------

# --------------- MANAGE .FILL -----------------------------
# 29.09.2003 - baigta 
# syntax '.fill repeat, value[, size]'
# '.fill' is already deleted
sub fill_manager
{
	my %fill;
	my $tmp;
	my $repeat;
	my $value;
	my $size;
	my $id;
	
	# allowed $size values
	%fill =
	(
		1 => "b",
		2 => "h",
		4 => "w",
		8 => "l",
	);

	# $line => everything separated by ','
	($repeat, $value, $size) = split /\s*,\s*/, $line, 3;

	# in no $size - 1 byte
	$size = 1 unless ($size);
	# set $id from table
	$id = $fill{$size};
	
	# if fill long word - word boundary
	if ($size == 8)
	{
		$tmp = 4;
	}
	else
	{
		$tmp = $size;
	}
	# is needed to check alignment
	unless ($num % $tmp == 0)
	{
		$x = $tmp / 2;
		error_printing("Wrong boundary ('.align $x' should by done before)", $.);
	}
	
	if ($id)
	{
		for $i (1 .. $repeat)
		{
			print "$.:$num:$id:$value\n";
			$num += $size;
		}	
	}
	# error -> $size isn't (1, 2, 4, 8)
	else
	{
		error_printing("Check syntax of .fill directive (badly set size)", $.);
	}
}
# -------------- END OF MANAGE .FILL ---------------------------

# --------------- MANAGE .ORG -----------------------------
# syntax '.org new_num[, fill_byte]'
# '.org' is already deleted
sub org_manager
{
	my $new_num;
	my $fill;
	
	($new_num, $fill) = split /\s*,\s*/, $line, 2;
	$fill = 0 unless ($fill); 
	
	if ($new_num > $num)
	{
    	for $i ($num .. $new_num - 1)
    	{
    		print "$.:$i:b:$fill\n";
    	}
		$num = $new_num;
	}
	else
	{
		error_printing("Check .org directive - new location counter should by greater than old one", $.);
	}
}
# -------------- END OF MANAGE .ORG ---------------------------

# --------------- MANAGE .SPACE -----------------------------
# 30.09.2003 - ?
# syntax '.space N'
# '.space' is already deleted
sub space_manager
{
	# $line => N (number of bytes)
	# OUTPUT '0 x N'
	if ($line =~ m/^\d+$/)
	{
    	for $i (1..$line)
    	{
    		print "$.:$num:b:0\n";
			$num++;
    	}
	}
	else
	{
		error_printing("Check syntax of .space directive", $.);
	}
}
# -------------- END OF MANAGE .SPACE ---------------------------

# --------------- MANAGE .ASCII -----------------------------
# syntax '.ascii "text"'
# '.ascii' is already deleted
sub ascii_manager
{
	my $new_line = "";
	# $line => "text";
	# error if no '"' on start and end of line
	# in this case some '"' in middle of text will not end whole line
	error_printing("Check syntax of .ascii directive", $.) unless ($line =~ s/^"(.*?)"$/$1/);
	
	# printing line
	print "$.:$num:a:$line\n";
	# real line length is without "\" signs
	($new_line = $line) =~ s/\\([nrt0\\\"])/$1/g; 
	# new line number
	$num += length $new_line;
}
# -------------- END OF MANAGE .ASCII ---------------------------

# --------------- MANAGE .ALIGN -----------------------------
# syntax '.align N'
# '.align' is already deleted
# $line => N
# N = (0, 1, 2)
sub align_manager
{
	my @missing;
	my $insert;
	
	# array is choosen according $line 
	@missing = 
	(
		[0],
		[0, 1],
		[0, 3, 2, 1]
	);

	# N = 0 -> any alignment isn't needed
	if (($line == 1) || ($line == 2))
	{
    	# if 1st line
    	if ($num < ($line * 2))
    	{
    		$position = $num;
    	}
    	else
    	{
			# in wich possition (in 4 bytes line)
    		$position = $num % ($line * 2);
    	}	
		
		$insert = $missing[$line][$position];
		if ($fh_names[$segment][$place][0]{flag} eq "STYP_TEXT")
		{
			while ($insert >= 2)
			{
				print "$.:$num:2:nop\n";
				$num += 2;
				$insert -= 2;
			} 
			warning_printing("Zero inserted to align code ", $.) if ($insert);
		}
		
		# according possition how many bytes are missing to get proper alignment
		for $i (1..$insert)
		{
			print "$.:$num:b:0\n";
			$num++;
		}
	}
	elsif ($line != 0)
	{
		error_printing("Check syntax of .align directive", $.);
	}
}
# -------------- END OF MANAGE .ALIGN ---------------------------

# --------------- MANAGE .INCLUDE -----------------------------
# .include is already deleted
sub include_manager
{
	my $name = $line;
	# if file name is between ""
	$name =~ s/\"//g;
	
	local($file_in) = $name;
	local(*IN);
	$IN = "\<" . $file_in;
			
	# if is impossible to open -> maybe this file is in another dir
	unless (open(IN))
	{
		while (@path)
		{
			$IN = "\<" . (shift @path) . "\\" . $file_in;
			# open and leave -> do not check rest of paths
			open(IN) && last;
		}
		# if all paths has been tried and still is impossible to open file
		unless (open(IN))
		{
			die "Unable to open $file_in file (it wasn't found in any defined directory): $!";
		}
	}
			
	# main reading function to read new file (recursive)
	reading_all(*IN);
}
# -------------- END OF MANAGE .INCLUDE ---------------------------

# --------------- MANAGE .CODE -----------------------------
# '.codeXX' OR '.code XX'
# '.code' isn't deleted
sub code_manager
{
	my $nr = $#{$fh_names[$segment][$place]};
#	our $section_name = $file if ($nr == 0);
	# changing default $plus if needed
	if ($line =~ m/\s*32$/)
	{
		$plus = 4;
	}
	elsif ($line =~ m/\s*16$/)
	{
		$plus = 2;
	}
	else
	{
		error_printing("Check syntax of .codeXX directive", $.);
	}
	
	$reloc2 = $reloc - $reloc2;
	
	# previous subsection data (if not 1st)
	if ($nr && !($file_open))
	{
		$num2 = $num - $num2;
		$fh_names[$segment][$place][$nr]{l_counter} = $num2;
		$fh_names[$segment][$place][$nr]{reloc} = $reloc2;
	}
	$num2 = $num;
	
	# new subsection
	$nr++;
	$fh_names[$segment][$place][$nr] = {name => ($file . $nr), mode => $plus};
	
	# SWM instruction is missing before .code, unless it is first subsection
	warning_printing("Missing SWM XX instruction", $.) unless ($swm_found || $file_open);
	$swm_found = 0;
	$file_open = 0;
}
# -------------- END OF MANAGE .CODE ---------------------------

# --------------- FIND AND ADD MACRO TO TABLE -----------------------------
# syntax '.macro name[(par1, .., paramN)]' till '.endm'
# '.macro' is already deleted
# macro is global for whole code (all sections)
# constants inside macro are global for whole code
# $macro{$name}[0] => parameters
# $macro{$name}[1] => time of use
# $macro{$name}[2] => list of local labels
# $macro{$name}[4..n-1] => instructions (constant definitions ignored)
# $macro{$name}[n] => .endm directive
sub macro_manager
{
	my $param;
	my $name;
	my $count = 0;

	# split by ' ' or '('
	($name, $param) = split /\s*[( ]\s*/, $line, 2;

	# if macro defined twise - error, new ignored
	if ($macro{$name})
	{
		error_printing("Such .macro <$name> exists already", $.);
	}
	else
	{
    	# parameters can be with parenthesis or without
    	$param =~ s/\s*\)//;
    	$macro{$name}[0] = $param;
		# still 0 time used
		$macro{$name}[1] = 0;
		# by default - no local labels
		$macro{$name}[2] = "";
    	
    	# reading macros till '.endm' directive or end of file
    	while ($line !~ m/.endm\b/o)
    	{
    		# if already end of file -> error and exit loop
    		unless (defined($line = <IN>))
    		{
    			error_printing("Wrong syntax of .endm (not found)", $.) && last;
    		}
    		
    		# error file = original file
			print ER "$. \t $num \t $plus \t $line";
    		comments();
			
    		# saving not empty line in macro table
    		if ($line)
    		{
    			# to count macro lines
    			$count++;
				# just in 1st line can by .local definition
				if (($count == 1) && ($line =~ s/.local\s*//))
				{
					$macro{$name}[2] = $line;
				}
    			elsif (($line =~ m/=/) || ($line =~ m/.equ\b/))
    			{
    				# constants inside macro
    				find_const();	
    			}
    			else
    			{
    				change_const() if (%const_t);
    				
    				# saving macro line with changed constants (if some was found)
    				push (@{$macro{$name}}, $line);
    			}
    		}
    		# max 100 line is recommended for macro
    		if ($count > 100)
    		{
    			warning_printing("To big macro (possible .endm directive is missing)", $.);
    		}
    	}
	}
}
# --------------- END OF FIND AND ADD MACRO TO TABLE ---------------------------

# --------------- CHANGE MACRO IN CODE -----------------------------
# if macro call was found - inserting macro
# directives, another macro calls aren't allowed
# local macro labels managing 
# local label name is changed to the same name + time of use
# so label names don't duplicate if macro is used more as 1 time 
sub find_macro
{
	my @new_param;
	my $macro_param;
	
	# going trough macro table (hash)	
	foreach $name (keys(%macro))
	{
		# if macro call is in line
		if ($line =~ s/\b$name\b//)
		{
			# macro is used
			$macro{$name}[1]++;
			# parameters from macro call
			# if with parenthesis
			$line =~ s/\(\s*(.*?)\s*\)\s*$/$1/;
			@new_param = split /\s*,\s*/, $line;
			# parameters used in macro
			@macro_param = split /\s*,\s*/, $macro{$name}[0];
			if ($#new_param != $#macro_param)
			{
				error_printing("Too much/less macro <$name $line> call parameters <$macro{$name}[0]>", $.);
			}
			# list of local labels
			@local_l = split /\s*,\s*/, $macro{$name}[2];
			
			# macro lines printing
			# from [3] -> because in [0-2] are parameters, time of use and local labels
			# to (length-1) -> because last element in array is .endm
			for $i (3..($#{$macro{$name}}-1))
			{
				# line read from macro table
				$line = $macro{$name}[$i];
				for $j (0..$#macro_param)
				{
					# changing originals macro parameters into call parameters
					if ($line =~ m/$macro_param[$j]/)
					{
						#$macro{$name}[$i] =~ s/(\s+|,)\b$macro_param[$j]\b(\s+|,|$)/$1$new_param[$j]$2/g;
						$line =~ s/\b$macro_param[$j]\b/$new_param[$j]/g;
					}
				} 

				# is needed to check it
				# 1. if some local labels are defined ->
				# check for label
				# change label name in instruction
				if (@local_l)
				{
					$m_call = 1;
					f_l();
					foreach $label_name (@local_l)
                    {
                    	$line =~ s/\b$label_name\b/$macro{$name}[1]$label_name/;
                    }
				}
				# 2. rest of work
				check_line();
			}
			# don't print twice MACRO call line
			$line = "";
			# going out from macro
			$m_call = 0;
		}
	}
}
# --------------- CHANGE MACRO IN CODE -----------------------------

# --------------- FIND AND ADD CONSTANT TO TABLE -----------------------------
# 15.10.2003 - both constant syntaxes
sub find_const
{
	my $const;
	my $val;
	# if syntax: $constant = $value
	if ($line =~ s/\s*=\s*/ /)
	{
		($const, $val) = split / /, $line, 2;
		error_printing("Wrong syntax of alias", $.) unless ($const || $var);
		$const_t{$const}= $val;
	}
	# if syntax: .equ $constant, $value
	elsif ($line =~ s/(\.)?equ\s+//)
	{
		($const, $val) = split /\s*,\s*/, $line, 2;
		error_printing("Wrong syntax of .equ directive", $.) unless ($const || $var);
		$const_t{$const}= $val;
	}
}
# --------------- END OF FIND AND ADD CONSTANT TO TABLE ------------------------

# --------------- CHANGE CONSTANT IN CODE LINE -----------------------------
# change $key with needed value from constant table $const_t{$key}
# IN:	$line	: global; whole line (without comments, labels and constant definitions)
# OUT:	$line	: line with changed constants
# global:	%const_t	:
sub change_const
{
	my $stuff = "";
	my @tmp;
	my $stuff;
	my $important;
	my $mnemonic;
	my $rest;
		
	# if conditional execution
	($stuff, $important) = split /\)\s*/, $line, 2;
	$line = "";
	($important) ? ($line = $stuff . ") ") : ($important = $stuff);
	($mnemonic, $rest) = split /\s+/, $important, 2;
	(@tmp) = split /\s*,\s*/, $rest;
		
	$line .= $mnemonic;

	for $i (0 .. $#tmp)
	{
		$tmp[$i] = $const_t{$tmp[$i]} if (defined ($const_t{$tmp[$i]}));
		$line .= "	" . $tmp[$i] . ",";	
	}
	
	# delete last coma
	$line =~ s/,$//;
}
# --------------- END OF CHANGE CONSTANT IN CODE LINE --------------------------

# --------------- CHECK LINE -----------------------------
# none of inserted instructions apears in error file
sub check_line
{
	$plus_u = '';
	
 	# saving old $plus value -> because event SWM should be in old counting mode
	$new_plus = $plus;

	# is needed to check alignment
	if ($num % $plus != 0)
	{
		$x = $plus / 2;
		error_printing("Wrong boundary for instruction ('.align $x' should by done before)", $.);
	}
	
	# finding swm
	if ($line =~ m/\b[sS][wW][mM]\b/)
	{
		# is needed to change $plus, because mode is changed
		swm_manager();
	}
	# finding decb pseudo instruction
	elsif ($line =~ s/^\s*[dD][eE][cC][bB]\b\s*//)
	{
		# insert needed instructions
		decb_incb_manager(" -1");
	}
	# finding dec pseudo instruction
	elsif ($line =~ s/^\s*[dD][eE][cC]\b\s*//)
	{
		# insert needed instructions
		dec_inc_manager(", -1");
	}
	# finding incb pseudo instruction
	elsif ($line =~ s/^\s*[iI][nN][cC][bB]\b\s*//)
	{
		$plus_u = 'u';
		# insert needed instructions
		decb_incb_manager(" 1");
	}
	# finding inc pseudo instruction
	elsif ($line =~ s/^\s*[iI][nN][cC]\b\s*//)
	{
		$plus_u = 'u';
		# insert needed instructions
		dec_inc_manager(", 1");
	}
	# finding ldri pseudo instruction
	elsif ($line =~ s/^\s*[lL][dD][rR][iI]\b\s*//)
	{
		# insert needed instructions
		ldri_manager();
	}
	# finding ldra pseudo instruction
	elsif ($line =~ s/^\s*[lL][dD][rR][aA]\b\s*//)
	{
		# insert needed instructions
		ldra_manager();
	}
	elsif ($line =~ s/^\s*mulsu//i)
	{
		mulsu_manager();
	}
	elsif ($line =~ s/^\s*mulus//i)
	{
		mulus_manager();
	}
	# 16-bit mode
	elsif ($plus == 2)
	{
		my $instr;
		# finding lli 
		if ($line =~ s/^\s*[lL]{2}[iI]\b\s*//)
		{
			# insert needed instructions
			lli_manager();	
		}
		# finding lui in 16-bit mode
    	elsif ($line =~ m/^\s*[lL][uU][iI]\b\s*/)
    	{
    		# insert needed instructions
    		lui_manager();
    	}	
    	# finding conditional execution in 16-bit mode 
    	elsif ($line =~ s/\b[iI][fF]\s*\(\s*(.*?)[cC]0\s*\)(.*?)\b/$1$2/)
    	{
    		# insert needed instructions
    		if_manager();	
    	}
		# finding exbfi
		elsif ($line =~ s/^\s*[eE][xX][bB][fF][iI]\b\s*//)
    	{
    		# insert needed instructions
    		exbfi_manager();
    	}
		# if conb
		elsif ($line =~ s/\bconb\b//i)
		{
			conb_manager();
		}
		# if sub
		elsif ($line =~ m/\bsub\b/i)
		{
			sub_manager();
		}
		# if subu
		elsif ($line =~ m/\bsubu\b/i)
		{
			$plus_u = 'u';
			sub_manager();
		}
		# if long version, 1
		elsif ($line =~ m/\b(add|addu|and|conh|exbf|muls(_16)?|mulu(_16)?|or|sext|sll|sra|srl|sub(u)?|xor)\b/i)
		{
			long_dr_sr1_sr2();
		}
		# if long version, 2
		elsif ($line =~ m/\b(addi|addiu|andi|muli|mulu|ori|slli|srai|srli|sexti)\b/i)
		{
			long_dr_sr1_imm();
		}		
	}
	else
	{
		# find jumps to external labels and mark
		foreach $key (keys(%e_l_table))
		{
			if ($line =~ s/\b($key)\b/@\1/)
			{
				$reloc++;
				last;
			}
		}
	}
		
	if ($line)
	{			
		print "$.:$num:$plus:$line\n";
	
		# offset for next instruction 
		$num += $plus;
		$plus = $new_plus;
	}
}
# -------------- END OF CHECK LINE ---------------------------

# --------------- MANAGE MULSU -----------------------------
# $mnemonic == "" or "_16"
sub mulsu_manager
{
	my $dr;
	my $sr;
	my $err;
	my $rest;
	my $mnemonic;
	
	($mnemonic, $rest) = split /\s+/, $line, 2;
	
	($dr, $sr, $err) = split /\s*,\s*/, $rest, 3;
	error_printing("Too many arguments", $.) if ($err);

	$mnemonic = 'mulus' . $mnemonic;

	$rest .= ", " . $dr if ($plus == 4); 
	$line = $mnemonic . " " . $rest;
}
# -------------- END OF MANAGE MULSU ------------------------

# --------------- MANAGE CONB -----------------------------
# mnemonic deleted
sub conb_manager
{
	my $dr;
	my $sr1;
	my $sr2;
	my $dr_only;
	my $mnemonic;
	
	($dr, $sr1, $sr2) = split /\s*,\s*/, $line, 3;

	# if 3rd argument exists
	if ($sr2)
	{
		# if nor the same register
		if ($dr !~ m/\b$sr2\b/)
		{
			print "$.:$num:$plus:mov $dr, $sr2\n";
			$num += $plus;
		}
		# always return short version
		$line = "conb " . $dr . ", " . $sr1;
	}
	else
	{
		print "$.:$num:$plus:conb $dr, $sr1\n";
		$num += $plus;
		print "$.:$num:$plus:conh $dr, $sr1\n";
		$num += $plus;
		print "$.:$num:$plus:slli $dr, 8\n";
		$num += $plus;
		$line = "srli " . $dr . ", 24";
	}
}
# -------------- END OF MANAGE CONB ------------------------

# --------------- MANAGE SUB & SUBU -----------------------------
sub sub_manager
{
	my $dr;
	my $sr1;
	my $sr2;
	my $dr_only;
	my $mnemonic;
	
	# $dr is with mnemonic
	($dr, $sr1, $sr2) = split /\s*,\s*/, $line, 3;
	# need to get only $dr
	($mnemonic, $dr_only) = split / /, $dr, 2;

	# if 3rd argument exists
	if ($sr2)
	{
		# if nor the same register
		if ($dr !~ m/\b$sr2\b/)
		{
			print "$.:$num:$plus:mov $dr_only, $sr2\n";
			$num += $plus;
		}
		# always return short version
		$line = $dr . ", " . $sr1;
	}
	else
	{
		print "$.:$num:$plus:subu $dr_only, $sr1\n";
		$num += $plus;
		print "$.:$num:$plus:not $dr_only, $dr_only\n";
		$num += $plus;
		$line = "addi" . $plus_u . " " . $dr_only . ", 1";
	}
}
# -------------- END OF MANAGE SUB & SUBU ------------------------


# --------------- MANAGE MULUS -----------------------------
# $mnemonic == "" or "_16"
sub mulus_manager
{
	my $dr;
	my $sr;
	my $err;
	my $rest;
	my $mnemonic;
	
	($mnemonic, $rest) = split /\s+/, $line, 2;
	($dr, $sr1, $sr2) = split /\s*,\s*/, $rest, 3;
	$line = "";
	
	if ($plus == 2)
	{
		if ($sr2)
		{
			# if nor the same register
			if ($dr !~ m/\b$sr2\b/)
    		{
    			print "$.:$num:$plus:mov $dr, $sr2\n";
    			$num += $plus;
    		}
    		$line = "mulus" . $mnemonic . " " . $dr . ", " . $sr1;
		}
		else
		{
			($mnemonic) ? (error_printing("Use <MULSU_16 DR, SR> instead", $.)) : ($line = "mulu " . $rest);
		}
	}
	else
	{
		error_printing("Use <MULSU_16 DR, SR> instead", $.) if ((!$sr2) && $mnemonic);
		$line = "mulus" . $mnemonic . " " . $rest;
	}
}
# -------------- END OF MANAGE MULUS ------------------------

# --------------- MANAGE MANY ARGUMENTS IN FORM 1 -----------------------------
sub long_dr_sr1_sr2
{
	my $dr;
	my $sr1;
	my $sr2;
	my $dr_only;
	my $mnemonic;
	
	# $dr is with mnemonic
	($dr, $sr1, $sr2) = split /\s*,\s*/, $line, 3;
	# if 3rd argument exists
	if ($sr2)
	{
		# if nor the same register
		if ($dr !~ m/\b$sr2\b/)
		{
			# need to get only $dr
			($mnemonic, $dr_only) = split / /, $dr, 2;
			print "$.:$num:$plus:mov $dr_only, $sr2\n";
			$num += $plus;
		}
		# always return short version
		$line = $dr . ", " . $sr1;
	}
	# else - nothing in $sr2 => short form; no need to change anything
}
# -------------- END OF MANAGE MANY ARGUMENTS IN FORM 1 ---------------------------

# --------------- MANAGE MANY ARGUMENTS IN FORM 2 -----------------------------
sub long_dr_sr1_imm
{
	my $dr;
	my $sr1;
	my $imm;
	my $dr_only;
	my $mnemonic;

	# $dr is with mnemonic
	($dr, $sr1, $imm) = split /\s*,\s*/, $line, 3;
	
	# if 3rd argument exists
	if ($imm)
	{
		# if nor the same register
		if ($dr !~ m/\b$sr1\b/)
		{
			# need to get only $dr
			($mnemonic, $dr_only) = split / /, $dr, 2;
			print "$.:$num:$plus:mov $dr_only, $sr1\n";
			$num += $plus;
		}
		# always return short version
		$line = $dr . ", " . $imm;
	}
}
# -------------- END OF MANAGE MANY ARGUMENTS IN FORM 2 ---------------------------

# --------------- MANAGE IF -----------------------------
sub if_manager
{
	my $cond;
	($cond, $line) = split /\s*,\s*/, $line, 2;
	print "$.:$num:$plus:b$cond 4\n";
	$num += $plus;
	print "$.:$num:$plus:nop\n";
	$num += $plus;
}
# -------------- END OF MANAGE IF ---------------------------


# --------------- MANAGE EXBFI -----------------------------
# exbfi dr, imm1, imm2
# exbfi dr, sr1, imm1, imm2
sub exbfi_manager
{
	my $dr;
	my $sr1;
	my $imm1;
	my $imm2;
	my $imm;

	($dr, $sr1, $imm1, $imm2) = split /\s*,\s*/, $line, 4;

	if ($dr !~ m/\b$sr1\b/)
	{
		if ($imm2)
		{
			print "$.:$num:$plus:mov $dr, $sr1\n";
			$num += $plus;		
		}
		else
		{
			(($imm1, $imm2) = ($sr1, $imm1));
		} 
	}

	$imm = 32 - $imm1 - $imm2;
	$imm = 0 if ($imm < 0);
	print "$.:$num:$plus:slli $dr, $imm\n";
	$num += $plus;
	$line = "srli " . $dr . ", " . (32 - $imm1);
}
# -------------- END OF MANAGE EXBFI ---------------------------

# --------------- MANAGE LLI -----------------------------
# 'lli' is deleted
# $line => 'dr, imm'
# subroutine is called just in 16-bit mode
sub lli_manager
{
	if ($line)
	{
		($dr, $imm) = split /\s*\,\s*/, $line, 2;
		if ($imm =~ m/^\s*((0[bB][0-1]+)|(0[cC][0-7]+)|(0[xX][0-9a-fA-F]+)|([0-9]+))\s*$/)
		{ 
			$imm = num2dec($imm);
		}

		print "$.:$num:$plus:xor $dr, $dr\n";
		$num += $plus;
		print "$.:$num:$plus:ori $dr, ", $imm >> 9, "\n";
		$num += $plus;
		print "$.:$num:$plus:slli $dr, 7\n";
		$num += $plus;
		print "$.:$num:$plus:ori $dr, ", ($imm >> 2) & 0x7f, "\n";
		$num += $plus;
		print "$.:$num:$plus:slli $dr, 2\n";
		$num += $plus;
		$line = "ori " . $dr . ", " . ($imm & 0x3);
	}
	else
	{
		error_printing("Wrong syntax of 'lli'", $.);
	}
}
# -------------- END OF MANAGE LLI ---------------------------

# --------------- MANAGE LUI -----------------------------
# 'lui' isn't deleted
# $line => 'lui dr, imm'
# subroutine is called just in 16-bit mode
sub lui_manager
{
	if ($line)
	{
		my $instr = $line;
		print "$.:$num:$plus:swm 32\n";
		$num += $plus;
		print "$.:$num:$plus:nop\n";
		$num += $plus;
		print "$.:$num:$plus:nop\n";
		$num += $plus;
		# .align 2
		if ($num % 4 != 0)
		{
			print "$.:$num:$plus:nop\n";
			$num += $plus;
		}
		
		$swm_found = 1;
		$line = "code 32";
		code_manager();
		
		print "$.:$num:$plus:$instr\n";
		$num += $plus;
		print "$.:$num:$plus:swm 16\n";
		$num += $plus;

		print "$.:$num:$plus:nop\n";
		$num += $plus;
		
		print "$.:$num:$plus:nop\n";
		$num += $plus;
		
		$swm_found = 1;
		$line = "code 16";
		code_manager();

		$line = "";	
		$plus = 2;		
	}
	else
	{
		error_printing("Wrong syntax of 'lui'", $.);
	}
}
# -------------- END OF MANAGE LUI ---------------------------

# --------------- MANAGE DECB & INCB -----------------------------
# 'decb'|'incb' is deleted
# $line => dr
sub decb_incb_manager
{
	if ($line)
	{
		if ($plus == 4)
		{
			# dr, dr
			$line = $line . ", " . $line;
			print "$.:$num:$plus:addi$plus_u $line, $_[0]\n";
			$num += $plus;
			# 0xff == 255
			$line = "andi " . $line . ", 255";
		}
		else
		{
			print "$.:$num:$plus:addi$plus_u $line, $_[0]\n";
			$num += $plus;
			print "$.:$num:$plus:slli $line, 24\n";
			$num += $plus;
			$line = "srli " . $line . ", 24";
		}
	}
	else
	{
		error_printing("Wrong syntax of 'decb' or 'incb'", $.);
	}
}
# -------------- END OF MANAGE DECB & INCB ---------------------------

# --------------- MANAGE DEC & INC -----------------------------
# 'dec'|'inc' is deleted
# $line => dr
sub dec_inc_manager
{
	if ($line)
	{
		if ($plus == 4)
		{
			$line = $line . ", " . $line;
		}
		$line = "addi$plus_u " . $line . $_[0];
	}
	else
	{
		error_printing("Wrong syntax of 'dec' or 'inc'", $.);
	}
}
# -------------- END OF MANAGE DEC & INC ---------------------------

# --------------- MANAGE LDRI -----------------------------
# 'ldri' is deleted
# $line => 'dr, $limm'
# $limm is constant
sub ldri_manager
{
	if ($line)
	{
		($dr, $limm) = split /\s*\,\s*/, $line, 2;
		
		if ($limm =~ m/^\s*((0[bB][0-1]+)|(0[cC][0-7]+)|(0[xX][0-9a-fA-F]+)|([0-9]+))\s*$/)
		{ 
			$limm = num2dec($limm);
		}

		$limm = $limm & 0xffffffff;
		if ($plus == 4)
		{
			$line = "lli " . $dr . ", " . ($limm & 0xffff);
			if ($limm > 65535)
			{
				print "$.:$num:$plus:$line\n";
				$line = "lui " . $dr . ", " . ($limm >> 16);
				$num += $plus;
			}
		}
		else
		{
			print "$.:$num:$plus:xor $dr, $dr\n";
			$num += $plus;
            # imm[31:25]
			if ($limm >> 25 != 0)
            {
            	print "$.:$num:$plus:ori $dr, ", $limm >> 25, "\n";
            	$num += $plus;
            	print "$.:$num:$plus:slli $dr, 7\n";
            	$num += $plus;
            }
            # imm[31:18]
            if ($limm >> 18 != 0)
            {
            	print "$.:$num:$plus:ori $dr, ", ($limm >> 18) & 0x7f, "\n";
            	$num += $plus;
            	print "$.:$num:$plus:slli $dr, 7\n";
            	$num += $plus;
            }
            # imm[31:11]
            if ($limm >> 11 != 0)
            {
            	print "$.:$num:$plus:ori $dr, ", ($limm >> 11) & 0x7f, "\n";
            	$num += $plus;
            	print "$.:$num:$plus:slli $dr, 7\n";
            	$num += $plus;
            }
            # imm[31:4]
            if ($limm >> 4 != 0)
            {
            	print "$.:$num:$plus:ori $dr, ", ($limm >> 4) & 0x7f, "\n";
            	$num += $plus;
            	print "$.:$num:$plus:slli $dr, 4\n";
            	$num += $plus;
            }
			if ($limm != 0)
            {
            	$line = "ori " . $dr . ", " . ($limm & 0xf);
			}
		}
	}
	else
	{
		error_printing("Wrong syntax of 'ldri'", $.);
	}
}
# -------------- END OF MANAGE LDRI ---------------------------

# --------------- MANAGE LDRA -----------------------------
# 'ldra' is deleted
# $line => 'dr, $limm'
# $limm is relocatable address
sub ldra_manager
{
	my $tmp;
	my $rest_add;
	# is needed to identify different type of relocation for ORI
	my $add = 1;
	if ($line)
	{
		($dr, $limm) = split /\s*\,\s*/, $line, 2;
		
		$limm =~ m/(\+|-)/;
		$something = $1;
		$something = "\\" . $something;
		($limm, $rest_add) = split /\s*$something\s*/, $limm, 2;
		
		# mark relocation place
		$tmp = "@" . $limm;
		if ($plus == 4)
		{
			$line = "lli " . $dr . ", " . $tmp;
			print "$.:$num:$plus:$line\n";
			$line = "lui1 " . $dr . ", " . $tmp;
			$reloc += 4;
			$num += $plus;
		}
		else
		{
			print "$.:$num:$plus:xor $dr, $dr\n";
           	$num += $plus;
           	print "$.:$num:$plus:ori$add $dr, ", $tmp, "\n";
       		$add++;
           	$num += $plus;
           	print "$.:$num:$plus:slli $dr, 7\n";
           	$num += $plus;
           	print "$.:$num:$plus:ori$add $dr, ", $tmp, "\n";
           	$num += $plus;
      		$add++;
           	print "$.:$num:$plus:slli $dr, 7\n";
           	$num += $plus;
           	print "$.:$num:$plus:ori$add $dr, ", $tmp, "\n";
          	$num += $plus;
       		$add++;
           	print "$.:$num:$plus:slli $dr, 7\n";
           	$num += $plus;
           	print "$.:$num:$plus:ori$add $dr, ", $tmp, "\n";
           	$num += $plus;
       		$add++;
           	print "$.:$num:$plus:slli $dr, 4\n";
           	$num += $plus;
            $line = "ori$add " . $dr . ", " . $tmp;
			$reloc += 5;
		}
		if ($rest_add)
		{
			print "$.:$num:$plus:$line\n";
           	$num += $plus;
			$line = "addi " . $dr . ", $1$rest_add";
		}
	}
	else
	{
		error_printing("Wrong syntax of 'ldra'", $.);
	}
}
# -------------- END OF MANAGE LDRA ---------------------------

# --------------- MANAGE SWM -----------------------------
# after SWM XX is needed to have 2 16-bit NOP instructions
# I keep old logic - after SWM instruction mode is changed immediately
# SWM 32 is aligned if needed (0 in word length is added)
# after SWM 32 NOP is 32-bit (the same like two 16-bit NOPs)
# after SWM 16 one 16-bit NOP is added to get two 16-bit NOPs
sub swm_manager
{
	error_printing("Check immediate constant of SWM instruction", $.) unless ($line =~ m/\s+(32|16)$/);
	
	$swm_found = 1;
}
# -------------- END OF MANAGE SWM ---------------------------
# ------------------------------------------------------------------------------
# ------------------------------ END OF SUBROUTINES, PART 1 --------------------
# ------------------------------------------------------------------------------

# --------------- CLOSING FILES, PART 1 -----------------------------
# some people are saying that is no need to close files
sub close1
{
    close IN;

	# in second circle this counting have another purpose
	our $sec_nr = 0;
	
	# last section data
	# current line counter -> saved for previous section
	$fh_names[$segment][$place][0]{l_counter} = $num;
	# current $plus -> saved for old section
	$fh_names[$segment][$place][0]{mode} = $plus;

	$fh_names[$segment][$place][0]{reloc} = $reloc;
	
	# if subsections
	my $nr = $#{$fh_names[$segment][$place]};

	if ($nr)
	{
		$num2 = $num - $num2;
		
		$reloc2 = $reloc - $reloc2;
		$fh_names[$segment][$place][$nr]{l_counter} = $num2;
		$fh_names[$segment][$place][$nr]{reloc} = $reloc2;
	}
	
	# in symbol table are directives entries, global values and external values
	$full_sym_entries = $sym_nr + ($#global + 1) + ($#extern + 1);
	
	
	# we have just 3 segments
	for $segment (0..2)
	{
		# everything in segment
		for $place (0..$#{$fh_names[$segment]})
		{	
			my $tmp_name = $fh_names[$segment][$place][0]{name};
			
			my $nr = $#{$fh_names[$segment][$place]};
			
			# to align end of section
    		$num = $fh_names[$segment][$place][0]{l_counter};
    		$line = 2; 
    		select $tmp_name;
    		my $old_num = $num;
			align_manager();
    			
			# main section location counter
    		$fh_names[$segment][$place][0]{l_counter} = $num;
			# subsection location counter
			$fh_names[$segment][$place][$nr]{l_counter} += $num - $old_num;
			
    		$full_size += $num;
    		$full_reloc += $fh_names[$segment][$place][0]{reloc};
    		$full_line_nr += $fh_names[$segment][$place][0]{line_nr};
    		close $tmp_name;
			
			for $i (0..$nr)
			{
				$tmp_name = $fh_names[$segment][$place][$i]{name};
				$sec_nr++;
    			# for later use remember number of current section
				$names{$tmp_name}{section_nr} = $sec_nr;
			}
		}
	}	
	# default output to screen
	select STDOUT;
}
# -------------- END OF CLOSING FILES, PART 1 ---------------------------

# --------------- OPENING FILES, PART 2 -----------------------------
sub open2
{
    # concatenate 'write to the end of the file -> (>>)' or 'overwrite the file -> (>)' with the filename
    # and open the file for writing
	# just bynary code
    (open (OUT2, "\>" . $file_out_ts) || die "Unable to open $file_out_ts file: $!") if $b_out;
	(open (OUT3, "\>" . $file_out_ds) || die "Unable to open $file_out_ds file: $!") if $b_out;
    # concatenate 'write to the end of the file -> (>>)' or 'overwrite the file -> (>)' with the filename
    # and open the file for writing
	# normal object file
    open (OUT, "\>" . $file_out) || die "Unable to open $file_out file: $!";
}
# -------------- END OF OPENING FILES, PART 2 ---------------------------

# --------------- MAIN PART OF CODE -----------------------------
sub main
{
	# reseting relocations counting
	$reloc = 0;
	
	our $two = 0;
    # starting interpreting instruction just if
	# 1. no errors was detected in preface
	# 2. not_delete flag is set
	if (!$error || $not_del)
    {
    	print ER " \n ERROR LIST: \n\n";
    	
    	if ($list)
    	{
			print LST ('-' x 80), "\n";
    		print LST "\n Code: \n";
        	print LST "Address\t Address \nin code\t in section\n"; 
        	print LST ('-' x 80), "\n";
    	}
    
    	# by default it's 32-bit mode ($length)
    	$length = 32;
    	
    	# first instruction ALWAYS is 32-bit long (if not set)
    	$odd = 1;
    	$cop = 0;
    	
		
		# write file header line in hex
		write_filhdr();
		
		# write all sections headers lines in hex
		all_scnhdr();

		our $text_s = 1;
		our $bss_s = 0;
		# opening all tmp files in order by segments
    	for $segment (0..2)
    	{
			$text_s = 0 if ($segment);
			$bss_s = 1 if ($segment == 2);
    		for $place (0..$#{$fh_names[$segment]})
    		{	
				my $tmp_name = $fh_names[$segment][$place][0]{name}; 
				# if something exists with name $fh_names[$segment][$place][0]
				if ($names{$tmp_name})
				{
					$sum = $names{$tmp_name}{where_starts};
					print LST (' ' x 45), "\t\t\t\t .$tmp_name\n" if ($list);
    				open(TEMP, "\<" . $tmp_name . "\.tmp") || die "Unable to open temporary file: $!";
					reading_all_2();
				}
    		}
    	}
		
		# writing relocation table if needed
		write_reloc() if $full_reloc;
		# write symbol table if needed
		write_sym_table() if $full_sym_entries;
		# write string table		
		write_str_table();
    }
}
# -------------- END OF MAIN PART OF CODE ---------------------------

# --------------- CLOSING FILES, PART 2 -----------------------------
sub close2
{
	close TEMP;
    close OUT;
    close OUT2;
    close OUT3;
    close ER;
    close LST;

    foreach $fh_name (keys %names)
	{
		# removing tmp file
		unlink ($fh_name . "\.tmp");
	}
    
    # if some error was found
    if ($error || ($w_on && $warning))
    {
    	# message in screen
    	print STDOUT "Was found a error or/and warning. Look in 'error_list' file \n";
    
    	# delete output if errors are found and deleting is allowed
    	if (!$not_del && $error)
    	{
    	 	unlink ($file_out);
    		unlink ($file_out_ts);
    		unlink ($file_out_ds);
    	}
    }
    # if no error/warning was detected, error file is deleted
	# if -w used, none error message, but error_list isn't deleted
    elsif (!$error && !$warning)
    {
    	# removing error file
    	unlink ("error_list");	
    }
}
# -------------- END OF CLOSING FILES, PART 2 ---------------------------

#--------
# --------------- WRITING FILE HEADER -----------------------------
# COFF: File Header
sub write_filhdr
{
    #-------------------
    # header contains 20 bytes information
    # from arm.h 
    #struct external_filehdr
    #{
    #	char f_magic[2];	/* magic number			*/
    #	char f_nscns[2];	/* number of sections		*/
    #	char f_timdat[4];	/* time & date stamp		*/
    #	char f_symptr[4];	/* file pointer to symtab	*/
    #	char f_nsyms[4];	/* number of symtab entries	*/
    #	char f_opthdr[2];	/* sizeof(optional hdr)		*/
    #	char f_flags[2];	/* flags			*/
    #};
    #-------------------
    
    # F_MAGIC field
    # The magic number specifies the target machine on which
    # 	the object file is executable.
    # COFFEE - my creation - need to check and finish 
    $f_magic = "C0FF";
    
    # F_NSCNS field
	# how many section headers are following (including subsections)
    $f_nscns = sprintf "%04lX", $sec_nr;

    # F_TIMDAT field 
    # f_timdat -> time function
    # Output time in seconds (since 1970 January 1, 00:00:00)
	$f_timdat = sprintf "%08lX", time;
    
    # F_SYMPTR field
	# full expresion, in case is needed to change something later
	# NOTE: here and later in full expresion size of optional header is excluded
	$expresion = $filhsz + $scnhsz * $sec_nr + $full_size + $relsz * $full_reloc + $linesz * $full_line_nr;
    $f_symptr = sprintf "%08lX", $expresion;
	
    # F_NSYMS field -> description after F_FLAGS
    
    # F_OPTHDR field
    # a.out header (optional header) is 28 bytes long
    # f_opthdr - Size of the optional header, which is included for executable files
    #			 but not object files. An object file should have a value of 0 here.
	# for a moment none optional header
    $f_opthdr = "0000";
    
    # F_FLAGS field
    #/* Bits for f_flags:
    # * F_RELFLG	relocation info stripped from file
    # * F_LNNO		line numbers stripped from file
    # * F_LSYMS		local symbols stripped from file
    # */
    # possible flags
    %f_flags = 
    (
    	F_RELFLG => "0001",
    	F_LNNO => "0004",
    	F_LSYMS => "0008",
    );
    
	# no flag
	$f_flag = "0000";
	
	# how to choose flag?
	if (!$full_reloc)
	{
		if ($no_sym || !$count_local)
		{
			$f_flag = $f_flags{F_LSYMS};
			$full_sym_entries -= $count_local;
		}
		else
		{
			$f_flag = $f_flags{F_RELFLG};
		}
	}
	elsif (!$full_line_nr)
	{
		$f_flag = $f_flags{F_LNNO};
		if ($no_sym)
		{
			$no_sym = 0;
			warning_printing("Local symbols aren't excluded", 'X');					
		}
	}
	
    # F_NSYMS field 
    $f_nsyms = sprintf "%08lX", $full_sym_entries;

	
	# $filhdr_str - file header in hex as string
	$filhdr_str = $f_magic . $f_nscns . $f_timdat . $f_symptr . $f_nsyms . $f_opthdr . $f_flag;

	# hexadecimal
	# print OUT "$filhdr_str\n";	
	
	# ascii
	$filhdr_str = pack("H*", $filhdr_str);
	print OUT $filhdr_str;
}
# -------------- END OF WRITING FILE HEADER ---------------------------

# --------------- MANAGING SECTIONS HEADERS -----------------------------
sub all_scnhdr
{
	our $tmp_sec_count = 0;
	# sumary of previous sections sizes
	our $tmp_size_count = 0;
	our $tmp_reloc_count = 0;
	our $tmp_line_nr_count = 0;
	my $tmp_name;
	
	# we have just 3 segments
	for $segment (0..2)
	{
		# everything in segment
		for $place (0..$#{$fh_names[$segment]})
		{	
			$tmp_name = $fh_names[$segment][$place][0]{name};
			# is needed to keep $tmp_size_count for each section
			# that will indicate start of section relative to whole code
			$names{$tmp_name}{where_starts} = $tmp_size_count;
			write_scnhdr($tmp_name, 0);
			$tmp_sec_count++;
			
			# local for subsections
			local $tmp_size_count = 0;
			local $tmp_reloc_count = 0;
			local $tmp_line_nr_count = 0;
			for $i (1..$#{$fh_names[$segment][$place]})
			{
							
			 	$tmp_name = $fh_names[$segment][$place][$i]{name};
				# is needed to keep $tmp_size_count for each section
				# that will indicate start of section relative to whole code
				$names{$tmp_name}{where_starts} = $tmp_size_count;
				write_scnhdr($tmp_name, $i);
				$tmp_sec_count++;
			}
		}
	}
}
# -------------- END OF MANAGING SECTIONS HEADERS ---------------------------

# --------------- WRITING SECTION HEADER -----------------------------
# COFF: Section Header
sub write_scnhdr
{
	my $tmp;
	my $tmp_name = $_[0];
	# which subsection
	my $i = $_[1];
	
    #-------------------
    # header contains 40 bytes information
    # from arm.h 
    #struct external_scnhdr
    #{
    #	char		s_name[8];	/* section name			*/
    #	char		s_paddr[4];	/* physical address, aliased s_nlib */
    #	char		s_vaddr[4];	/* virtual address		*/
    #	char		s_size[4];	/* section size			*/
    #	char		s_scnptr[4];	/* file ptr to raw data for section */
    #	char		s_relptr[4];	/* file ptr to relocation	*/
    #	char		s_lnnoptr[4];	/* file ptr to line numbers	*/
    #	char		s_nreloc[2];	/* number of relocation entries	*/
    #	char		s_nlnno[2];	/* number of line number entries*/
    #	char		s_flags[4];	/* flags			*/
    #};
    #-------------------
    
    # S_NAME field
    # section name 
	# name in lower-case starting with zero
    $s_name_ascii = lc($tmp_name);
	# dot is needed for some sections
	$s_name_ascii = "." . $s_name_ascii if ($fh_names[$segment][$place][0]{dot});
	# name in hexadecimal
	$s_name = unpack "H*", $s_name_ascii;
	
	# if name longer than 8 characters
	if ((length $s_name) > 16)
	{
		# address in symbol table where name will be written
		$names{$tmp_name}{in_string} = $string_length;
		
		$str_hex = sprintf "%lX", $string_length;
		# add needed zeros before address
		$str_hex = ("0" x (14 - (length $str_hex))) . $str_hex;
		# in symbol table name ends with zero
		$s_name .= "00";
		# increase size of symbol table
		$string_length += (length $s_name) / 2;
		# increase string for symbol table
		$string_entry .= $s_name;
		# name to be written into section header
		# address to symbol table starting with slash (/)
		$s_name = "2F" . $str_hex;
	}
	else
	{
 		# pad name with zeros
   		$s_name .= "0" x (16 - (length $s_name)); # . $s_name;
    }
	
    # S_PADDR field
    # This is the address at which the section data should be loaded into memory.
    # For linked executables, this is the absolute address within the program space.
    # For unlinked objects, this address is relative to the object's address space 
    #	(i.e. the first section is always at offset zero). 
	# if section is absolute - $abs_place is in use
	# write absolute address or current temporary counter
	$tmp = $fh_names[$segment][$place][$i]{abs_place} || $tmp_size_count;

    $s_paddr = sprintf "%08lX", $tmp;
    
    # S_VADDR field
    # Base virtual address of a loadable section in the image.
    # This field is set to zero for non-loadable sections such as .comment.
    $s_vaddr = $s_paddr;
    
    # S_SIZE field
    # section size padded to 16-byte boundary
    # Set to zero if there is no raw data for this section.
    # You should always read this many bytes from the file, beginning s_scnptr bytes
    #	from the beginning of the object.
	# size == $num
    $s_size = sprintf "%08lX", $fh_names[$segment][$place][$i]{l_counter};
	
    # S_SCNPTR field
    # File offset to beginning of raw data for the section.
    # For sections with no raw data, such as .bss, this field is set to zero.
	if (!$s_size)
	{
		# when this field is zero too
		$s_scnptr = $s_size;
	}
	else
	{
		# full expresion, in case is needed to change something later
		$expresion = $filhsz + $scnhsz * $sec_nr + $tmp_size_count;
	    $s_scnptr = sprintf "%08lX", $expresion;
		# recounting place where next section data starts
		# NOTE: something wrong if adding hex numbers ... because it is a string?
		$tmp_size_count += $fh_names[$segment][$place][$i]{l_counter};
    }
	
	# S_NRELOC field
    # number of relocation entries
    # 0xffff if number of entries overflows size of this field
    $s_nreloc = sprintf "%04lX", $fh_names[$segment][$place][$i]{reloc};
    
    # S_NLNNO field
    # The number of line number entries for this section.
    # Beware files with more than 65535 entries; this field truncates the value
    #	with no other way to get the "real" value.
    $s_nlnno = sprintf "%04lX", $fh_names[$segment][$place][$i]{line_nr};
	
	# S_RELPTR field
    # File offset to relocations for the section.
    # Set to zero if the section has no relocations.
	if ($s_nreloc eq "0000")
	{
		$s_relptr = "0" x 8;
	}
	else
	{
		# full expresion, in case is needed to change something later
		$expresion = $filhsz + $scnhsz * $sec_nr + $full_size + $relsz * $tmp_reloc_count;
    	$s_relptr = sprintf "%08lX", $expresion;
		$tmp_reloc_count += $fh_names[$segment][$place][$i]{reloc};
	}
    
    # S_LNNOPTR field
    # The file offset of the line number entries for this section.
    if ($s_nlnno eq "0000")
	{
		$s_lnnoptr = "0" x 8;
	}
	else
	{
		# full expresion, in case is needed to change something later
		$expresion = $filhsz + $scnhsz * $sec_nr + $full_size + $relsz * $full_reloc + $linesz * $tmp_line_nr_count;
		$s_lnnoptr = sprintf "%08lX", $expresion;
		$tmp_line_nr_count += $fh_names[$segment][$place][$i]{line_nr};
	}
    
    # S_FLAGS field
    # Section header flags 
	#STYP_TEXT  0x20  Section contains executable text  
   	#STYP_DATA  0x40  Section contains initialized data  
   	#STYP_BSS  0x80  Section contains only uninitialized data  
   	#STYP_RDATA  0x100  Read-only data only 
    # Possible flags
    %s_flag =
    (
    	STYP_TEXT => "00000020",  
    	STYP_DATA => "00000040",  
    	STYP_BSS => "00000080",  
		STYP_RDATA => "00000010",
    );
	$s_flags = $s_flag{$fh_names[$segment][$place][0]{flag}};
	
	if ($i)
	{
		# set mode of subsection
		my $pos = 0;
		$pos = 1 if ($fh_names[$segment][$place][$i]{mode} == 2);
		substr($s_flags, $pos, 1, 1);
	}
	else
	{
		# how many subsections there are
		my $nr = $#{$fh_names[$segment][$place]};
		$nr = sprintf "%04lX", $nr;
		substr($s_flags, 2, 4, $nr);
	}
	
	# $scnhdr_str - section header in hex as string
	# $scnhdr_str is created for each section ($seg_nr times)
    $scnhdr_str = $s_name . $s_paddr . $s_vaddr . $s_size . $s_scnptr . $s_relptr . $s_lnnoptr . $s_nreloc . $s_nlnno . $s_flags;

	# hexadecimal
	# print OUT $scnhdr_str, "\n";	

	# ascii
	$scnhdr_str = pack("H*", $scnhdr_str);
	print OUT $scnhdr_str;
}
# -------------- END OF WRITING SECTION HEADER ---------------------------

# --------------- WRITING RELOCATION TABLE -----------------------------
sub write_reloc
{
	my $i;
	my $reloc_entry;
	my $r_vaddr;
	my $r_symndx;
	my $r_type;
	# all relocation entries
	for $reloc (1..$full_reloc)
	{
		$r_vaddr = sprintf "%08lX", $reloc_table[$reloc][0];
		
		# if external relocation
		if ($reloc_table[$reloc][1] =~ m/[A-z]/)
		{
			$i = 0;
			while ($extern[$i] eq $reloc_table[$reloc][1])
			{
				$i++;
			}
			# pointer to external symbol -> after static and global symbols tables
			$r_symndx = sprintf "%08lX",($sym_nr + $#global + $i);	
		}
		else
		{
			$r_symndx = sprintf "%08lX", $reloc_table[$reloc][1];
		}

		$r_type = $reloc_table[$reloc][2];
		$reloc_entry = $r_vaddr . $r_symndx . $r_type;

		# hexadecimal
		# print OUT "$reloc_entry\n";
		
		# ascii
		$reloc_entry = pack("H*", $reloc_entry);
		print OUT $reloc_entry;
	}
}
# -------------- END OF WRITING RELOCATION TABLE ---------------------------

# --------------- WRITING STATIC SYMBOLS -----------------------------
sub write_static
{
	for $i (0..$#sym_table)
	{
		$none = 0;
		my $tmp_name = $sym_table[$i]{name};
		# if label
		if ($sym_table[$i]{label_address})
		{
			unless ($no_sym)
			{
    			$n_name = unpack "H*", lc($tmp_name);
    
    			# if name longer than 8 characters
            	if ((length $n_name) > 16)
            	{
            		$str_hex = sprintf "%lX", $string_length;
            		# add needed zeros before address
            		$str_hex = ("0" x (16 - (length $str_hex))) . $str_hex;
            		# in symbol table name ends with zero
            		$n_name .= "00";
            		# increase size of symbol table
            		$string_length += (length $n_name) / 2;
            		# increase string for symbol table
            		$string_entry .= $n_name;
            		# name to be written into section header
            		# address to symbol table starting with slash (/)
            		$n_name = $str_hex;
            	}
            	else
            	{
             		# pad name with zeros
               		$n_name .= "0" x (16 - (length $n_name)); # . $s_name;
                }
    
    			$n_value = sprintf "%08lX", $rel_table{$tmp_name}{l_counter};
    			$n_scnum = sprintf "%04lX", $names{$rel_table{$tmp_name}{section_name}}{section_nr};
    			# type is unknown
        		$n_type = "0000";
        		# n_sclass => C_LABEL = 6
        		$n_sclass = "06";
        		# section names always has auxiliary entry
        		$n_numaux = "00";
    			$aux_entry = '';
			}
			else
			{
				$none = 1;
			}
		}
		# if section
		else
		{  
			$n_name_ascii = lc($tmp_name);
			my $segment = $names{$tmp_name}{segment};
			my $place = $names{$tmp_name}{place};
			$n_name_ascii = "." . $n_name_ascii if ($fh_names[$segment][$place][0]{dot});
			$n_name = unpack "H*", $n_name_ascii;
			
			my $address = $names{$tmp_name}{where_starts};
			$n_scnum = sprintf "%04lX", $names{$tmp_name}{section_nr};
			if ($sym_table[$i]{abs_place})
			{
				$address = $sym_table[$i]{abs_place};
				$n_scnum = "FFFF";
			}
    		$n_value = sprintf "%08lX", $address;
    		
    		# type is unknown
    		$n_type = "0000";
    		# n_sclass => C_STAT = 3
    		$n_sclass = "03";
    		# section names always has auxiliary entry
    		$n_numaux = "01";
    		
    		write_aux($tmp_name);
		}
		# if name is in symbol table -> use string address
		if ($names{$tmp_name}{in_string})
		{
			$n_name = sprintf "%016lX", $names{$tmp_name}{in_string};
		}

    	# in case name is not 8 characters - adding to end zeros
    	for $i (1..16 - (length $n_name))
    	{
    		$n_name .= "0"; # . $s_name;
    	}
		
		$sym_entry = $n_name . $n_value . $n_scnum . $n_type . $n_sclass . $n_numaux;

		# hexadecimal
		# print OUT $sym_entry, $aux_entry, "\n" unless ($none);
		
		# ascii		
		$sym_entry = pack("H*", $sym_entry);
		print OUT $sym_entry, $aux_entry unless ($none);
	}
}
# -------------- END OF STATIC SYMBOLS ---------------------------

# --------------- WRITING AUXILIARY ENTRY -----------------------------
sub write_aux
{
	my $tmp_name = $_[0];
	my $segment = $names{$tmp_name}{segment};
	my $place = $names{$tmp_name}{place};
	# for section entry
	# 4 bytes - length of section -> $num
	$x_scnlen = sprintf "%08lX", $fh_names[$segment][$place][0]{l_counter};
	# 2 bytes - number of relocations -> $reloc
	$x_nreloc = sprintf "%04lX", $fh_names[$segment][$place][0]{reloc};
	# 2 bytes - line numbers -> $line_nr
	$x_nlinno = sprintf "%04lX", $fh_names[$segment][$place][0]{line_nr};
	# 9 bytes - empty -> 0
	$empty = sprintf "%020lX", 0;
	
	$aux_entry = $x_scnlen . $x_nreloc . $x_nlinno . $empty;
	
	# ascii
	$aux_entry = pack("H*", $aux_entry);
}
# -------------- END OF AUXILIARY ENTRY ---------------------------

# --------------- WRITING GLOBAL SYMBOLS -----------------------------
sub write_global
{
	for $i (0..$#global)
	{
		# name
		$n_name = unpack "H*", $global[$i];
		
		if ((length $n_name) > 16)
		{
			$address = sprintf "%016lX", $string_length;
			$n_name .= "00";
			$string_length += (length $n_name) / 2;
			$string_entry .= $n_name;
			$n_name = $address;
  		}
	
    	# in case name is not 8 characters - adding to end zeros
    	for $i (1..16 - (length $n_name))
    	{
    		$n_name .= "0"; # . $s_name;
    	} 
		
		# section where label is located number -> 
		# from label table --> section name
		# from %names --> number
		$n_scnum = $names{$rel_table{$global[$i]}{section_name}}{section_nr};
		$n_scnum = sprintf "%04lX", $n_scnum;
		# where it is located -> from label table
		# location regard to whole code counting
		#$n_value = $rel_table{$global[$i]}[0] + $names{$rel_table{$global[$i]}[1]}[4];
		$n_value = sprintf "%08lX", $rel_table{$global[$i]}{l_counter};
				
		# type is unknown
		$n_type = "0000";
		# n_sclass => C_EXT = 2
		$n_sclass = "02";
		# none auxiliary entry
		$n_numaux = "00";
		
		$sym_entry = $n_name . $n_value . $n_scnum  . $n_type . $n_sclass . $n_numaux;

		# hexadecimal
		# print OUT $sym_entry, "\n";		
		
		# ascii
		$sym_entry = pack("H*", $sym_entry);
		print OUT $sym_entry;
	}
}
# -------------- END OF GLOBAL SYMBOLS ---------------------------

# --------------- WRITING EXTERNAL SYMBOLS -----------------------------
sub write_external
{
	for $i (0..$#extern)
	{
		# name
		$n_name = unpack "H*", $extern[$i];
		
		if ((length $n_name) > 16)
		{
			$address = sprintf "%016lX", $string_length;
			$n_name .= "00";
			$string_length += (length $n_name) / 2;
			$string_entry .= $n_name;
			$n_name = $address;
  		}
	
    	# in case name is not 8 characters - adding to end zeros
    	for $i (1..16 - (length $n_name))
    	{
    		$n_name .= "0"; # . $s_name;
    	} 
		# external value is unknown
		$n_value = sprintf "%08lX", 0;
		# none section for external values
		$n_scnum = sprintf "%04lX", 0;
		# type is unknown
		$n_type = "0000";
		# n_sclass => C_EXT = 2
		$n_sclass = "02";
		# none auxiliary entry
		$n_numaux = "00";
		
		$sym_entry = $n_name . $n_value . $n_scnum  . $n_type . $n_sclass . $n_numaux;

		# hexadecimal
		# print OUT $sym_entry, "\n";		
		
		# ascii
		$sym_entry = pack("H*", $sym_entry);
		print OUT $sym_entry;
	}
}
# -------------- END OF EXTERNAL SYMBOLS ---------------------------

# --------------- WRITING SYMBOL TABLE -----------------------------
sub write_sym_table
{
	# static symbols (sections names and labels)
	write_static();
	# defined global symbols (.global)
	write_global();
	# undefined ecternal symbols (.extern)
	write_external()
}
# -------------- END OF WRITING SYMBOL TABLE ---------------------------

# --------------- WRITING STRING TABLE -----------------------------
sub write_str_table
{
	my $str;
	# if lenght is 4, that means none string table is in this file
	# if nothing 4 is changed to 0
	$string_length = 0 if ($string_length == 4);
	$str = sprintf "%08lX", $string_length;
	$str .= $string_entry;

	# hexadecimal
	# print OUT "$str\n";	
	
	# ascii
	$str = pack("H*", $str);
	print OUT $str;
}
# -------------- END OF WRITING STRING TABLE ---------------------------
#--------

# ------------------------------------------------------------------------------
# ------------------------------ SUBROUTINES, PART 2----------------------------
# -----------------------------------------------------------------------------
# --------------- READING ALL LINES FROM TMP -----------------------------
sub reading_all_2
{
   	while (defined($line = <TEMP>))
   	{
		# preparing to convert line with instruction
		initial();
	
		# converting one instruction line into binary output
		convert();
		
		# checking syntax of assembler
		check_line_syn();
	}
}
# ------------- END OF READING ALL LINES FROM TMP ---------------------

# --------------- INITIALIZATION -----------------------------
sub initial
{
	# removing the line termination symbol
    chomp($line);
	
	# separate line parts
	($lnr, $num, $id, $line) = split /:/, $line, 4; 
	
	if ($id == 2)
	{
		$length = 16;
	}
	elsif ($id == 4)
	{
		$length = 32;
	}
	
    # initialising the variables on each round
    # in case if i have forgot something
	our $all = "WRONG implementation";
	our $if_found = 0;
	our $ld = 0;
	our $swap = 0;
	our $simple = 1;
	our $command;
	$d_code = 0;
	$wrong = 0;

   	# copy of original line
	# $command is converted into binary output -> convert()
	# $line is kept for checking logic -> check_line_syn()
   	$command = $line;
}
# ------------- END OF INITIALIZATION ---------------------

# --------------- CONVERTING -----------------------------
sub convert
{
	# IF condition
	cond();
	
	# separate and interpret instruction	
	if (($id == 4) || ($id == 2))
	{
		instr();
	}
	else
	{
		data();
	}

	# for hexadecimal
	if ($ascii)
	{
		$all2 = pack("H*", $all);
		# 1&0 form
		$old_all = hex2bin($all);
		# $all is in hex form
	}
	else
	{
		$all2 = pack("B*", $all);
		
		# 1&0 form
		$old_all = $all;
		# hex form
		$all = bin2hex($all);
	}

	# hexadecimal
	# print OUT $all, "\n";

	# aschii
	print OUT $all2;
	
	# if separate files are needed
	if ($b_out)
	{
    	if ($text_s)
    	{
    		# use binary form if needed
    		$all = $old_all if ($b_out == 1);
    		print OUT2 "$all\n";
    	}
    	else
    	{
   			$all = $old_all if ($b_out == 1);
   			print OUT3 "$all\n";
    	}
	}
		
	# L I S T I N G 
	listing() if ($list);
	$ascii = 0;
}
# ------------- END OF CONVERTING ---------------------

# --------------- HEXADECIMAL TO BINARY -----------------------------
sub hex2bin
{
    my($offset) = 0;
    my($out) = "";
    while ($offset != length($_[0]))
    {
    	# separate hex numbers and convert
    	$out .= to_bin(hex2dec(substr($_[0], $offset, 2)), 8);
    	$offset += 2;
    }
    return $out;
}
# ------------- END OF HEXADECIMAL TO BINARY ---------------------

# --------------- BINARY TO HEXADECIMAL -----------------------------
sub bin2hex
{
	my $num = $_[0];
	my $hex1 = "";
	# if long number (64 bytes)
	if (length $num > 32)
	{
		$num1 = substr($num, 0, 32);
		$out_b = bin2dec($num1);
    	$some_length = (length $num1) / 4;
	    $hex1 = sprintf "%lX", $out_b;
    	$some_length2 = length $hex1;
	    for $i (1..$some_length - $some_length2)
    	{
    		$hex1 = "0" . $hex1;
	    }
		$num = substr($num, 32);
	}
    $out_b = bin2dec($num);
    $some_length = (length $num) / 4;
    $hex = sprintf "%lX", $out_b;
    $some_length2 = length $hex;
    for $i (1..$some_length - $some_length2)
    {
    	$hex = "0" . $hex;
    }
	$hex = $hex1 . $hex;

    return $hex;
}
# ------------- END OF BINARY TO HEXADECIMAL ---------------------

# --------------- ASCII TO HEXADECIMAL -----------------------------
sub translate_ascii
{
	# \\ - represents one '\' character. Needed to escape from escape sequence!
	$command =~ s/\\\\/\\/g;
		
	# \" - represents one '"' character
	$command =~ s/\\"/"/g;

	# convert ASCII to hex	
	$command = unpack "H*", $command;
	# change \n (5c 6e) => 0a
	$command =~ s/5c6e/0A/g;
	# change \0 (5c 30) => 00
	$command =~ s/5c30/00/g;
	# change \r (5c 72) => 0d
	$command =~ s/5c72/0D/g;
	# change \t (5c 74) => 09
	$command =~ s/5c74/09/g;
	
	# if translating from .word, zeros are 303030
	$command =~ s/303030(\w\w)/000000$1/g;
	return $command;
}
# ------------- END OF ASCII TO HEXADECIMAL ---------------------

# --------------- CONVERTING DATA -----------------------------
sub data
{
	$all = "data";

	if ($id eq 'b')
	{
		$long = 8;
		$min = -128;
		$max = 255;
		$all = to_bin(syn_imm($command, $min, $max), $long);
	}
	elsif ($id eq 'w')
	{
		$long = 32;
		$max = 4294967295;
		$min = -2147483648;
		# name of relocation
		$name = "w";
		$all = to_bin(syn_imm($command, $min, $max), $long);
	}
	elsif ($id eq 'h')
	{
		$long = 16;
		$max = 65535;
		$min = -32768;
		$all = to_bin(syn_imm($command, $min, $max), $long);
	}
	elsif ($id eq 'l')
	{
		$long = 64;
		$max = 18446744073709551615;
		$min = -9223372036854775808;
        if (length $line > 32)
		{
			$all = to_bin_div(syn_imm($line, $min, $max));
			$all = ("0" x ($long - length $all)) . $all;
		}
		else
		{
			$all = to_bin(syn_imm($line, $min, $max), $long);
		}
	}
	elsif ($id eq 'a')
	{
		$all = translate_ascii();
		$ascii = 1;
	}
	elsif ($id eq 'f')
	{
		# $length_m = length of mantissa/significand is 23
		# $length_be = length of biased exponent is 8
		# ($_[2] -> $length_m, $_[3] -> $length_be, $_[4] -> $exp_plus) 
		$all = &Floating::floating_point($command, 23, 8, 127);
	}
	elsif ($id eq 'd')
	{
		# $length_m = length of mantissa/significand is 52
		# $length_be = length of biased exponent is 11
		# ($_[2] -> $length_m, $_[3] -> $length_be, $_[4] -> $exp_plus)
		$all = &Floating::floating_point($command, 52, 11, 1023);
	}
}
# ------------- END OF CONVERTING DATA ---------------------


# --------------- LISTING -----------------------------
sub listing
{
	my $nr;
	my $sum_nr;
	
	my $tmp;
	$nr = sprintf "%08lX", $num;
	$sum_nr = sprintf "%08lX", ($sum + $num);
	
	$tmp = length $old_all;
	print LST "$sum_nr \t $nr \t\t";
	
	if ($tmp > 32)
	{
		$tmp2 = 32;
		print LST substr($old_all, 0, 32) ," \t $line \n";
		while ($tmp2 < $tmp)
		{
			print LST (' ' x 12), "\t\t\t\t\t", substr($old_all, $tmp2, 32) ," \n";
			$tmp2 += 32;
		}
	}
	else
	{
		print LST $old_all, (' ' x (32 - $tmp)), " \t $line \n";
	}
}
# ------------- END OF LISTING ---------------------

# --------------- FIND NOP -----------------------------
sub find_nop
{
	# reading next line to check if code is correct
	r_w();	
		
	error_printing("Here must be a NOP instruction", $lnr) if ($line !~ m/nop\b/i);
	
	check_line_syn();
}
# ------------- END OF FIND NOP ---------------------

# --------------- READ - WRITE -----------------------------
# reading new line from TEMP and writing into OUT like all lines
sub r_w
{
	if (defined($line = <TEMP>))
	{
		initial();
		convert();
	}
}
# -------------- END OF READ - WRITE ---------------------------

# --------------- CHECK PREVIOUS LINE -----------------------------
sub check_line_syn
{
	our $was;
	# if previuos instruction was branch
	if ($was)
	{
		if ($line =~ m/\b(retu|reti|scall|swm|bc|begt|belt|beq|bgt|blt|bne|bnc|jalr|jal|jmpr|jmp)\b/i)
		{
			error_printing("This instruction is NOT allow after branch/jump instruction", $lnr);
		}
		elsif ($line !~ m/\bnop\b/i)
		{
			warning_printing("This instruction will be executed BEFORE branch/jump", $lnr);
		}
		$was = 0;
	}

	# after RETU, RETI, SCALL and SWM must be NOP instruction
	if ($line =~ m/\b(retu|reti|scall|swm)\b/i)
	{
		# $line is still original line from TEMP
		$last = $line;
		
		find_nop();
		# 2 NOP's are needed after SWM
		if ($last =~ s/\b(swm)\b//i)
		{
			find_nop();
		}
		# 3 NOP's are needed after RETI
		elsif ($last =~ s/\b(reti)\b//i)
		{
			find_nop();
			find_nop();
		}
	}

	# not allowed instructions after BRANCH instruction
	if ($line =~ m/\b(bc|begt|belt|beq|bgt|blt|bne|bnc|jalr|jal|jmpr|jmp)\b/i)
	{
		$was = 1;
		# $line is still original line from TEMP
		r_w();
		check_line_syn();
	}
}
# -------------- END OF CHECK PREVIOUS LINE ---------------------------

# --------------- CONDITIONAL EXECUTION FINDING -----------------------------
sub cond
{
	# finding if statements
    if ($line =~ m/^\s*if/i)  
	{
		# separate 'if' part and last part of line as '$command'
		if_cond();
		# to remember that 'IF' was found
		$if_found = 1;
	}
   	# if there wasn't condition, condition register and condition codes must be
   	# converted to 3 bit binary strings
   	else
	{
		$cex = 0;
   		$cr = "000";
   		$condition = "000";
   	}
	
	# should be changed in 1st circle
	# in 16-bit mode is not allowed conditional execution
	#err() if ($id == 2);
}
# ------------- END OF CONDITIONAL EXECUTION FINDING ---------------------

# --------------- CONDITIONAL EXECUTION IN ERROR -----------------------------
sub err
{
	error_printing("This instruction can't be executed conditionally", $lnr) if ($if_found);
}
# -------------- END CONDITIONAL EXECUTION IN ERROR ---------------------------

# ------------- DECODING CONDITIONAL EXECUTION ----------------
# 32-bit mode (should work in 16-bit mode too)
# principle:
# 1. separate 'IF' condition part from command line
# 2. split condition part
# 3. convert condition register
# 4. interpret the condition if it correct
#    else - error message
sub if_cond
{
   	# if an 'if' statement is found, the next instruction is
	# executed conditionally
    $cex = 1;
    # find ')' and split the line into a condition and a command
    ($cond, $command) = split /\)\s*/, $line, 2;
    # find ',' and split the line into a condition and 
    # a condition register
    ($cond, $cr) = split /\,/, $cond, 2;
    # convert the conditional register number to a 3 bit binary number
  	$cr = to_bin(syn($cr, 'c'), 3);

	%conditions = qw
	(
		c	000
		eq	011
		egt	001
		gt	100
		elt	010
		lt	101
		ne	110
		nc	111
	);
	
	# deleting 'if(' and empty characters
	$cond =~  s/^.*?\(\s*|\s*$//g;
	# lowercase - to ignore case mode
	$cond = lc($cond);
	# translating to binary code
	$condition = $conditions{$cond};
	# if not declared in %conditions hash 	
	error_printing("Wrong condition syntax - '$cond'", $lnr) unless ($condition);
}
# ------------- END OF DECODING CONDITIONAL EXECUTION -------------


# --------------- DECIMAL TO BINARY USING DIVISION -----------------------------
# translates decimal number into binary one using division by 2 method
# slowly one, but it can translate numbers longer than 32-bit
# IN -  $num = $_[0]	: number to be translated
# OUT - $bin			: binary number
sub to_bin_div
{
	my $bin = "";
	# number in decimal system
	my $num = $_[0];
	my $counter = 0;
	my $end;
	
	while (($num > 1) && ($counter < 255))
	{
		$counter++;
		$end = $num % 2;
		$num = int($num / 2);
		$bin = $end . $bin;
	}
	# most significant 1
	$bin = $num . $bin; 
	return $bin;
}
# ------------- END OF DECIMAL TO BINARY USING DIVISION ---------------------


# ------ INSTRUCTION DECODING ------
# ------------- DECIMAL TO BINARY ----------------------------
# converting decimal number to binary (length is indicated by $sk)
# using shifting to left (dividing by 2)
# to_bin (what, how_big)
# IN:	$num = $_[0]	: number in decimal system
#		$sk = $_[1]		: length of binary number
# OUT:	$bin			: number in binary system
sub to_bin
{
	my $num = $_[0];
	my $sk = $_[1];
	my $bin = "";
		
	while ($sk > 0)
	{
		$sk--;
		
		$bin = ($num&1) . $bin;
		$num = $num >> 1;
	}
	return $bin;
}
# ------------- END OF DECIMAL TO BINARY -------------

# --------------- SUBROUTINE R -----------------------------
# count needed register, because they all are the same format
# IN:	$_[0]	: register
# OUT:	$_[0]	: the same register just in binary
# global:	$id		: 4 if 32-bit mode
#				  	  2 if 16-bit mode
#			$length	: 32 if 32-bit mode
#					  16 if 16-bit mode
#			$cop	: 1 if coprocessor instruction
sub r
{
	if (($id == 4) || ($length == 32) || ($cop))
	{
		$_[0] = to_bin(syn($_[0], 'c?r'), 5);
	}
	else
	{
		$_[0] = to_bin(syn($_[0], 'r'), 3);
	}
	return $_[0];
}
# -------------- END OF SUBROUTINE R ---------------------

# ------------- REGISTER SYNTAX CHECKING ----------------------------
# principle:
# 1. check register identity ($id) and if rest is just numbers
#    if not - error message
#    else - separate register number
# 2. function returns just register number
# IN:	$var = $_[0]	: register to be checked
#		$letter = $_[1]	: register ID (letter in front)
# OUT: 	$var			: register without ID
# global:	$cop		: 1 if coprocessor instruction
#			$lnr		: source file line number
#			$length		: 32 if 32-bit mode
#						  16 if 16-bit mode
sub syn
{
	my $var = $_[0];
	my $letter = $_[1];

	error_printing("Wrong register syntax - <$_[0]>", $lnr) unless ($var =~ s/$letter//i);
	$var =~ s/\s+//;

	# if rest isn't just numbers
	error_printing("Wrong register syntax - <$_[0]>", $lnr) unless ($var =~ m/^\d+$/);

	# checking registers number (not bigger as 31)
	# less as 0 cannot be
	if ($var > 31)
	{
		error_printing("Too big register number <$_[0]> (more than 31)", $lnr);
	}
	# checking if registers numbers are from R24 to R31 (in 16-bit mode)
	# $cop - for coprocessors registers, they can be r0-r7 only
	elsif (($length == 16) && (!$cop) && ($var < 24 ))
	{
		error_printing("Is not allowed in 16-bit mode to use register <$_[0]> (use r24-r31)", $lnr);
	}

	# translating registers number from R24-R31 to R0-R7 ( because in 3 bits max is '111b' -> '7' )
	# is not needed, program is working well without it ;)

	return $var;
}
# ------------- END OF REGISTER SYNTAX CHECKING ---------------------

# ------------- BINARY TO DECIMAL ----------------------------
# thanks to DAN
sub bin2dec
{ 
	my $dec = 0;
  	my $bin = $_[0];
  	$bin =~ s/0b//i;
  	@bin = split("", $bin);
  	for ($i = 0; $i < @bin; $i++)
  	{ 
		$dec <<= 1; 
		$dec += $bin[$i];
  	}
  	return $dec;
}
# ------------- END OF BINARY TO DECIMAL -------------

# ------------- OCTAL TO DECIMAL ----------------------------
# thanks to DAN
sub oct2dec
{ 
	my $dec = 0;
	my $oct = $_[0];
  	$oct =~ s/0c//i;
  	@oct = split("", $oct);
  	for ($i = 0; $i < @oct; $i++)
  	{ 
		$dec <<= 3; 
		$dec += $oct[$i];
  	}
  	return $dec;
}
# ------------- END OF OCTAL TO DECIMAL -------------

# ------------- HEXADECIMAL TO DECIMAL ----------------------------
# thanks to DAN
sub hex2dec
{ 	
	my $dec = 0;
	my $hex = $_[0];
  	$hex =~ s/0x//i;
  	@hex = split("", $hex);
  	for ($i = 0; $i < @hex; $i++)
  	{ 
		$dec <<= 4;
   		switch:
   		{ 
			if ($hex[$i] =~ m/a/i) 
			{ 	
				$dec+=10; 
				last switch;
			}
			if ($hex[$i] =~ m/b/i) 
			{ 
				$dec+=11; 
				last switch;
			}
			if ($hex[$i] =~ m/c/i) 
			{ 
				$dec+=12; 
				last switch;
			}
			if ($hex[$i] =~ m/d/i) 
			{ 	
				$dec+=13; 
				last switch;
			}
			if ($hex[$i] =~ m/e/i) 
			{ 
				$dec+=14; 
				last switch;
			}
			if ($hex[$i] =~ m/f/i) 
			{ 
				$dec+=15; 
				last switch;
			}
			default: $dec += $hex[$i];
    	}
  	}
  	return $dec;
}
# ------------- END OF HEXADECIMAL TO DECIMAL -------------

# ------------- WHICH NUMBER SYSTEM ----------------------------
# thanks to DAN
sub num2dec
{ 
	my $num = $_[0];
	my $dec = 0;
	$num =~ s/[ \t\n\r]//g; 
  	if ($num =~ m/^0b/i)
	{
		$dec = bin2dec($num);
	}
  	elsif ($num =~ m/^0c/i)
	{
		$dec = oct2dec($num);
	}
  	elsif ($num =~ m/^0x/i)
	{
		$dec = hex2dec($num);
	}
  	else
	{
		$dec = 0 + $num;
	}
  	return $dec;
}
# ------------- END OF WHITCH NUMBER SYSTEM ---------------------

# ------------- IMM SYNTAX CHECKING ----------------------------
# thanks to DAN
sub syn_imm
{
	our $f = $_[0];
	# allowed MIN and MAX for immediate constant
	my $min = $_[1]; 
	my $max = $_[2];  
	my $line = "";



	# if address -> @imm
 	if ($f =~ s/^\s*\@//)
	{
		make_reloc();
		# when relocations are needed, imm can be 32-bit long
		$max = 4294967295;
		$min = -2147483648;
	}
	
 	$f =~ s/[ \t\n\r]/ /g;
  	$line = " " . $f . " ";

  	$line =~ s/\(/ \( /g;
  	$line =~ s/\)/ ) /g;
  	$line =~ s/\// \/ /g;
  	$line =~ s/\*/ \* /g;
  	$line =~ s/\-/ - /g;
  	$line =~ s/\+/ + /g;

  	@numbers = split("[()\/*+-]", $f);
  	$errors = 0;
  	for ($j = 0; $j < @numbers; $j++)
  	{ 
		if ($numbers[$j] =~ m/^\s*((0b[0-1]+)|(0c[0-7]+)|(0x[0-9a-f]+)|([0-9]+))\s*$/io)
		{ 
			$encode = num2dec($numbers[$j]);
			$line =~ s/\s*$numbers[$j]\s*/ $encode /;
		}
		elsif($numbers[$j] !~ m/^\s*$/)
		{ 
			error_printing("Wrong immediate constant syntax - '$numbers[$j]'", $lnr);
			$errors++;
		}
	}
  	if (!$errors)
  	{ 
		if (eval("return(\$result=$line);"))
		{
			$result = int($result);
			warning_printing("Number over/underflow", $lnr) if (($result<$min) || ($result>$max));

			return $result;
		}
    	elsif (($result != 0) || ($_[0] eq ""))
		{
			error_printing("Wrong expression in immediate constant", $lnr);
			$error = 1;
		}
	}
}
# ------------- END OF IMM SYNTAX CHEKING ---------------------

# ------------- MAKING RELOCATION ENTRY ----------------------------
# $f -> label name without spaces
# output $f -> address where label is located
# address is absolute in whole code (sections are following each other)
# section starts on $s_scnptr - .....

# current section name -> $fh_names[$segment][$place][0]
# where $name section starts -> $names{$name}[4]
# section name where label was found -> $label_t{$f}[1]
# place where label is located in section -> $label_t{$f}[0]

# in which byte (0-3) relocation starts if $name is name of type -> $relocations{$name}[0]
# where is exact place of relocation -> $relocations{$name}[1]
# if shift is needed -> $relocations{$name}[2]

sub make_reloc
{
	my $ext_found = 0;
	$reloc++;
	$f =~ s/\(|\)//g;

	# where is label in code if segment starts with 0
	$r_symndx = 0;
	
	# if current label - $f is in any section
	if (defined($rel_table{$f}{l_counter}))
	{
		# which entry in symbol table is section of label
		$r_symndx = $rel_table{$f}{in_sym_t};
		
		# if it is global label
		for $i (0..$#global)
		{
			if ($f eq $global[$i])
			{
				$r_symndx = $sym_nr + $i;
				last;
			}
		}
		$ff = $rel_table{$f}{l_counter};

		$ff = $ff >> 16 if ($moving);
		$ff = $ff >> 25 if ($name eq "ori1");
		$ff = $ff >> 18 if ($name eq "ori2");
		$ff = $ff >> 11 if ($name eq "ori3");
		$ff = $ff >> 4 if ($name eq "ori4");
		$ff = $ff & 0xf if ($name eq "ori5");
	}
	else
	{
		for $i (0..$#extern)
		{
			$ext_found = 1 if ($f eq $extern[$i]);
		}
		
		unless ($ext_found)
		{	
			warning_printing("Undeclared external value - $f", $lnr);
			push @extern, $f;
		}
		$r_symndx = $f;
		$ff = 0;
	}
	# to relocation table - 
	# $name - key for relocation entries
	# $relocations{$name}[0] - which byte is needed
	$current_position = $num; # + $names{$fh_names[$segment][$place][0]}[4];
	# where excactly relocation starts
	$r_value = $current_position + $relocations{$name}[0];
	# type choosen by instruction name
	$r_type = $relocations{$name}[1];

	$reloc_table[$reloc] = [$r_value, $r_symndx, $r_type];
	
	# if it is two relocations for one immediately value
	if ($two)
	{
		$reloc++;
		$name .= "2";
		# where excactly relocation starts
		$r_value = $current_position + $relocations{$name}[0];
		# type choosen by instruction name
		$r_type = $relocations{$name}[1];
		$reloc_table[$reloc] = [$r_value, $r_symndx, $r_type];
		$two = 0;
	}
	
	$f = $ff;
}
# ------------- END OF MAKING RELOCATION ENTRY ---------------------

# --------------- SUBROUTINE TOO_MUCH -----------------------------
sub too_much
{
	error_printing("Too many registers in 16-bit mode instruction", $lnr) if ($_[0])
}
# ------------- END OF TOO_MUCH ---------------------

# ------------- FORM_DR_SR ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT: 	$all		: line in binary
# global:	$swap	: 1 if CONH instruction
#			$lnr	: source file line number
sub form_dr_sr
{
	my $dr;
	my $sr1;
	my $sr2;
	
	
	($dr, $sr1, $sr2) = split /\,/, $command, 3;
	# syntax checking and converting to binary form
	r($dr);
	r($sr1);
	
	if ($length == 32)
	{
		if ($sr2)
		{
			r($sr2);
			# for CONH is needed to swap sr1 and sr2
			($sr1, $sr2) = ($sr2, $sr1) if ($swap);
		}
		elsif ($simple)
		{
			$sr2 = $dr;
		}
		else
		{
			($sr1, $sr2) = ($dr, $sr1);
		}
		return "0000" . $sr2 . $sr1 . $dr;
	}
	else
	{
		#too_much($sr2);
		return $sr1 . "0000" . $dr;
	}
}
# ------------- END OF FORM_DR_SR ---------------------

# ------------- FORM_DR_SR1_IMM ----------------------------
# 32-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
#		$_[0]		: min permited value for immediate
#		$_[1]		: max permited value for immediate
# OUT: 	$all		: line in binary
# global:	$ld		: 1 if LD instruction
# 			$cex	: 1 if conditional execution
sub form_dr_sr1_imm
{
	my $dr;
	my $sr1;
	my $imm;

	($dr, $sr1, $imm) = split /\,/, $command, 3;
		
	unless ($imm)
	{
		# zero for LD, for rest shift values
		($ld) ? ($imm = 0) : (($sr1, $imm) = ($dr, $sr1));
	}

	$imm = syn_imm($imm, $_[0], $_[1]);
	# length depends on $cex (conditional execution or not)
	($cex) ? ($imm = to_bin($imm, 9)) : ($imm = to_bin($imm, 15));
	
	return $imm . r($sr1) . r($dr);
}
# ------------- END OF FORM_DR_SR1_SR2 ---------------------

# ------------- FORM_DR_IMM ----------------------------
# 16-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
#		$_[0]		: min permited value for immediate
#		$_[1]		: max permited value for immediate
# OUT:	$all		: line in binary
# global:	$lnr	: source line number
sub form_dr_imm
{
	my $dr;
	my $imm;
	
	($dr, $imm) = split /,/, $command, 3;
		
	$dr = r($dr);
	$imm = to_bin(syn_imm($imm, $_[0], $_[1]), 7);
	
	return $imm . $dr;
}
# ------------- END OF FORM_DR_IMM ---------------------

# ------------- LD INSTRUCTION ----------------------------
# 16-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
#		$_[0]		: min permited value for immediate
#		$_[1]		: max permited value for immediate
# OUT:	$all		: line in binary
sub i_ld
{
	my $dr;
	my $sr1;
	my $imm;
	
	($dr, $sr1, $imm) = split /\,/, $command, 3;
	
	$imm = 0 unless ($imm);
	$imm = to_bin(syn_imm($imm, $_[0], $_[1]), 4);
	
	return r($sr1) . $imm . r($dr);
}
# ------------- END OF LD INSTRUCTION ---------------------

# ------------- LABEL CHECKING ----------------------------
sub check
{
	my $sk = $_[0];
	my $exist = 0;
	my $sign = '';
	my $sk_new;
	
	$sk =~ s/^\s+//;
	$sk_new = $sk;
	$sign = '-' if ($sk_new =~ s/-//);
	
	# if rest id not just numbers -> check for labels
	if ($sk_new !~ m/^(@|((0b|0c|0x)?\d+$))/)
	{
		foreach $key (keys(%l_table))
		{
			# if label found in table
			if ($key =~ m/\b$sk\b/)
			{
				# counting length of jump 
				$sk = ($l_table{$key} - ($num + $plus)) / 2;
				# mark: label found in list
				$exist = 1;
				# do not check rest of labels
				last;
			}
		}
		
		# if label wasn't found in list
		error_printing("Undefined external jump - <$sk_new>", $lnr) unless ($exist);
	}
	return $sk;
}
# ------------- END OF LABEL CHECKING ---------------------

# ------------- CHECK IF JUMP IS EVEN ----------------------------
sub even
{
	error_printing("Jump (immediate value) is not even number", $lnr) if ($_[0] % 2 != 0);
}
# ------------- END OF CHECK IF JUMP IS EVEN ---------------------

# ------------- FORM_BRANCH ----------------------------
# 32-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT:	$all		: line in binary
# SET: 	$cex		: GLOBAL;
sub form_branch
{
	my $cr;
	my $imm;
	
	($cr, $imm) = split /\,/, $command, 2;
	$cex = 1;
	($cr, $imm) = ("c0", $cr) unless ($imm);

	$cr = to_bin(syn($cr, 'c'), 3);
	$imm = check($imm);
	even($imm);
	$imm = to_bin(syn_imm($imm, -2097152, 2097151), 22);

	return $cex . $cr . $imm;
}
# ------------- END OF FORM_BRANCH ---------------------

# ------------- FORM_BRANCH ----------------------------
# 16-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT:	$all		: line in binary
# global:	$lnr	: source file line number
sub form_branch2
{
	my $cr;
	my $imm;
	
	($cr, $imm) = split /\,/, $command, 2;
	
	if ($cr !~ m/[cC]0/)
	{
		($imm) ? (error_printing("Not allowed register <$cr> (use c0)", $lnr)) : ($imm = $cr);
	}

	$imm = check($imm);
	even($imm);
	$imm = to_bin(syn_imm($imm, -512, 511), 10);
	
	return $imm;
}
# ------------- END OF FORM_BRANCH ---------------------

# ------------- BRANCH COMMANDS INTERPRETATION ----------------------------
sub branch
{
	if ($length == 32)
	{
		$name = "bx32";
		$all = $opcode . form_branch();
	}
	else
	{
		$name = "bj16";
		$all = $opcode . form_branch2();
	}
}
# ------------- END OF BRANCH COMMANDS INTERPRETATION ---------------------

# ------------- FORM_SHIFT_1 ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT:	$all		: line in binary
# global:	$length	: 32 if 32-bit mode
#					  16 if 16-bit mode
#			$lnr	: source file line number
sub form_shift_1
{
	my $dr;
	my $sr1;
	my $sr2;

	($dr, $sr1, $sr2) = split /\,/, $command, 3;
	
	if ($length == 32)
	{
		$sr2 = $dr unless ($sr2);
		
		return "1000" . r($sr2) . r($sr1) . r($dr);
	}
	else
	{
		return r($sr1) . "0001" . r($dr);
	}
}
# ------------- END OF FORM_SHIFT_1 ---------------------

# ------------- FORM_SHIFT_2 ----------------------------
# 32-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT:	$all		: line in binary
sub form_shift_2
{
	my $dr;
	my $sr1;
	my $imm;
	
	($dr, $sr1, $imm) = split /\,/, $command, 3;
	
	($sr1, $imm) = ($dr, $sr1) unless ($imm);
	$imm = to_bin(syn_imm($imm, 0, 32), 6);
	
	return "000" . $imm . r($sr1) . r($dr);
}
# ------------- END OF FORM_SHIFT_2 ---------------------

# ------------- FORM_SHIFT_2 ----------------------------
# 16-bit mode
# IN:	$command	: GLOBAL; all argumets without instruction mnemonic
# OUT:	$all		: line in binary
# global:	$lnr	: source file line number
sub form_shift_2b
{
	my $dr;
	my $sr1;
	my $imm;

	($dr, $imm) = split /\,/, $command, 2;
	$imm = to_bin(syn_imm($imm, 0, 32), 6);
	
	return $imm . "0" . r($dr);
}
# ------------- END OF FORM_SHIFT_2 ---------------------

# ------------- SHIFT COMMANDS INTERPRETATION ----------------------------
sub shift_
{
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . form_shift_1();
	}
	else
	{
		$all = $opcode . form_shift_1();
	}
}
# ------------- END OF SHIFT COMMANDS INTERPRETATION ---------------------

# ------------- SHIFT WHIT IMM COMMANDS INTERPRETATION -------------------------
sub shift_imm
{
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . form_shift_2();
	}
	else
	{
		$all = $opcode . form_shift_2b();
	}
}
# ------------- END OF SHIFT WHIT IMM COMMANDS INTERPRETATION ------------------

# ------------- NOT NEEDED ARGUMENTS ----------------------------
sub don_t
{
	# if rest isn't empty line
	error_printing("Not needed argument", $lnr) if ($command !~ m/^\s*$/);
}
# ------------- END NOT NEEDED ARGUMENTS ---------------------

# ------------- SIMPLE INSTRUCTIONS INTERPRETATION ----------------------------
sub simple
{
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . form_dr_sr();
	}
	else
	{
		$all = $opcode . form_dr_sr();
	}
}
# ------------- END OF SIMPLE INSTRUCTIONS INTERPRETATION ---------------------

# ------------- ADVANCED INSTRUCTION TYPE ----------------------------
# order of permited values of imm:
# ($_[0], $_[1]) => 32-bit with condition
# ($_[2], $_[3]) => 32-bit without condition
# ($_[4], $_[5]) => 16-bit
sub advanced
{
	if ($length == 32 || ($id == 4))
	{
		# if was found condition
		if ($if_found)
		{
			$all = $opcode . $cex . $cr . $condition . form_dr_sr1_imm($_[0], $_[1]);
		}
		else
		{
			$all = $opcode . $cex . form_dr_sr1_imm($_[2], $_[3]);
		}
	}
	else
	{
		if ($ld)
		{
			$all = $opcode . i_ld($_[4], $_[5]);
		}
		else
		{
			$all = $opcode . form_dr_imm($_[4], $_[5]);
		}
	}
}
# ------------- END OF ADVANCED INSTRUCTION TYPE ---------------------

# ------------- JUMPS INSTRUCTIONS ----------------------------
sub jumps
{
	# checking if imm is a label
	$jmp = 1;
	$imm = check($command);
	$jmp = 0;
	even();

	if ($length == 32)
	{
		$name = "jx32";
		$imm = to_bin(syn_imm($imm, -16777216, 16777215), 25);
		$all = $opcode . "0" . $imm;
	}
	else
	{
		$name = "bj16";
		$imm = to_bin(syn_imm($imm, -512, 511), 10);
		$all = $opcode . $imm;
	}
}
# ------------- END OF JUMPS INSTRUCTIONS ---------------------

# ------------- ANOTHER JUMPS INSTRUCTIONS TYPE ----------------------------
sub jumps_2
{
	$sr1 = $command;
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "000000000" . r($sr1) . $_[0];
	}
	else
	{
		$all = $opcode . r($sr1) . "0000" . $_[1];
	}
}
# ------------- END OF ANOTHER JUMPS INSTRUCTIONS TYPE ---------------------

# ------------- NOT ALLOWED INSTRUCTIONS ----------------------------
sub not_allowed
{
	error_printing("Not allowed instruction in 16-bit mode", $lnr);
	$wrong = 1;
}
# ------------- END OF NOT ALLOWED INSTRUCTIONS ---------------------

# ------------- LOAD HALF WORD INSTRUCTIONS ----------------------------
# 32-bit mode (16-bit mode is changed with pseudo code in 1 circle)
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$opcode		: opcode for current instruction
#			$two		: 1 if LUI or LLI instruction (two relocation entries)
sub load_half
{
	my $dr;
	my $imm; 
	
	($dr, $imm) = split /\,/, $command, 2;	

	$two = 1;
	$imm = to_bin(syn_imm($imm, -32768, 65535), 16);

	$all = $opcode . "0" . substr($imm, 1, 15) . substr($imm, 0, 1) . "0000" . r($dr);
	$two = 0;
}
# ------------- END OF LOAD HALF WORD INSTRUCTIONS ---------------------

# ------------- ADD SOMETHING TO $ALL ----------------------------
sub add_all
{
	$all .= $_[0] if ($length == 32);
}
# ------------- END OF ADD SOMETHING TO $ALL ---------------------

# ------------- INSTRUCTION CHRS ----------------------------
sub i_chrs
{
	$imm = to_bin(syn_imm($command, 0, 3), 2);
	if ($length == 32)
	{
		$all = $opcode . "00000000000000" . $imm . "0000000000";		
	}
	else
	{
		$all = $opcode . "00000" . $imm . "000";
	}
}
# ------------- END OF INSTRUCTION CHRS ---------------------

# ------------- INSTRUCTION CMPI ----------------------------
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length	: 32 if 32-bit mode
#					  16 if 16-bit mode
#			$opcode	: opcode for current instruction
#			$lnr	: source file line number
sub i_cmpi
{
	my $cr;
	my $sr1;
	my $imm;
	
	($cr, $sr1, $imm) = split /\,/, $command, 3;
	
	if ($length == 32)
	{
		# shift values if needed
		($cr, $sr1, $imm) = ("c0", $cr, $sr1) unless (defined $imm);

		$cr = to_bin(syn($cr, 'c'), 3);
		$imm = to_bin(syn_imm($imm, -65536, 65535), 17);
		$all = $opcode . "0" . $cr . substr($imm, 5, 12) . r($sr1) . substr($imm, 0, 5);
	}
	else
	{
		if ($cr !~ m/[cC]0/)
		{
			($imm) ? (error_printing("Not allowed register <$cr> (use c0)", $lnr)) : (($sr1, $imm) = ($cr, $sr1));
		}
		
		$imm = to_bin(syn_imm($imm, -64, 63), 7);
		$all = $opcode . r($sr1) . $imm;
	}
}
# ------------- END OF INSTRUCTION CMPI ---------------------

# ------------- INSTRUCTION CMP ----------------------------
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length	: 32 if 32-bit mode
#					  16 if 16-bit mode
#			$opcode	: opcode for current instruction
#			$lnr	: source file line number
sub i_cmp
{
	my $cr;
	my $sr1;
	my $sr2;
	
	($cr, $sr1, $sr2) = split /\,/, $command, 3;
	
	if ($length == 32)
	{
		# shift values if needed	
		($cr, $sr1, $sr2) = ("c0", $cr, $sr1) unless ($sr2);

		$cr = to_bin(syn($cr, 'c'), 3);
		$all = $opcode . "0" . $cr . "0000000" . r($sr2) . r($sr1) . "00000";
	}
	else
	{
		if ($cr !~ m/[cC]0/)
		{
			($sr2) ? (error_printing("Not allowed register <$cr> (use c0)", $lnr)) : (($sr1, $sr2) = ($cr, $sr1));
		}
		$all = $opcode . r($sr1) . "0000" . r($sr2);
	}
}
# ------------- END OF INSTRUCTION CMP ---------------------

# ------------- INSTRUCTION RCON ----------------------------
sub i_rcon
{
	$sr1 = $command;
	if ($length == 32)
	{
		$all = $opcode . "0000000000000000" . r($sr1) . "00000";
	}
	else
	{
		$all = $opcode . r($sr1) . "0000000";
	}
}
# ------------- END OF INSTRUCTION RCON ---------------------

# ------------- INSTRUCTION EXBFI ----------------------------
# 32-bit mode (16-bit mode is changed with pseudo code in 1st circle)
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$opcode		: opcode for current instruction
sub i_exbfi
{
	my $dr;
	my $sr1;
	my $imm1;
	my $imm2;
    ($dr, $sr1, $imm, $imm2) = split /\,/, $command, 4;
    
   	($sr1, $imm, $imm2) = ($dr, $sr1, $imm) unless ($imm2);

    $imm = to_bin(syn_imm($imm, 0, 32), 6);
    $imm2 = to_bin(syn_imm($imm2, 0, 31), 5);

    $all = $opcode . "00000" . $imm . $imm2 . r($sr1) . r($dr);
}
# ------------- END OF INSTRUCTION EXBFI ---------------------

# ------------- INSTRUCTION EXB ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length		: 32 if 32-bit mode
#					  	  16 if 16-bit mode
#			$opcode		: opcode for current instruction
#			$cex		: 1 if conditional execution
#			$cr			: conditional register if conditional execution
#			$condition	: condition if conditional execution
sub i_exb
{
	my $dr;
	my $sr1;
	my $imm;
	
	($dr, $sr1, $imm) = split /\,/, $command, 3;
	
	($sr1, $imm) = ($dr, $sr1) unless ($imm);
	$imm = to_bin(syn_imm($imm, 0, 3), 2);
	
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "0000000" . $imm . r($sr1) . r($dr);
	}
	else
	{
		$all = $opcode . r($sr1). "00". $imm . r($dr);
	}
}
# ------------- END OF INSTRUCTION EXB ---------------------

# ------------- INSTRUCTION EXH ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length		: 32 if 32-bit mode
#					  	  16 if 16-bit mode
#			$opcode		: opcode for current instruction
#			$cex		: 1 if conditional execution
#			$cr			: conditional register if conditional execution
#			$condition	: condition if conditional execution
sub i_exh
{
	my $dr;
	my $sr1;
	my $imm;
	
	($dr, $sr1, $imm) = split /\,/, $command, 3;
	
	($sr1, $imm) = ($dr, $sr1) unless ($imm);
	$imm = to_bin(syn_imm($imm, 0, 1), 1);
	
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "00000000" . $imm . r($sr1) . r($dr);
	}
	else
	{
		$all = $opcode . r($sr1) . "000" . $imm . r($dr);
	}
}
# ------------- END OF INSTRUCTION EXH ---------------------

# ------------- INSTRUCTION SWM ----------------------------
sub i_swm
{
	# check immediate value just if it is SWM instruction
	$imm = to_bin(syn_imm($command, 16, 32), 6) if ($d_code == 0);
	
	# in 32-bit mode
	if ($length == 32)
	{
		$all = $opcode . "0000000000" . $imm . "0000000000";
				
		if (($command =~ m/16\s*$/) && ($length == 32))
		{
		   $length = 16;
		}
		else
		{
			warning_printing("You are changing to the same 32-bit mode", $lnr);
		}
	}
	# in 16-bit mode
	else
	{
		$all = $opcode . "0" . $imm . "000";
		if (($command =~ m/32\s*$/) && ($length == 16))
		{
		   $length = 32;
		}
		else
		{
			warning_printing("You are changing to the same 16-bit mode", $lnr);
		}
	}
	
	# if not SWM, but .code -> print normal line
	if ($d_code == 1)
	{
		$all = $command;
		$odd = 1;
	}
}
# ------------- END OF INSTRUCTION SWM ---------------------

# ------------- INSTRUCTION ST ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length		: 32 if 32-bit mode
#					  	  16 if 16-bit mode
#			$opcode		: opcode for current instruction
#			$if_found	: 1 if conditional execution
sub i_st
{
	my $sr1;
	my $sr2;
	my $imm;
	
	($sr2, $sr1, $imm) = split /\,/, $command, 3;
	$imm = 0 unless ($imm);
	
	if ($length == 32)
	{
		if ($if_found)
		{
			$imm = to_bin(syn_imm($imm, -256, 255), 9);
			$all = $opcode . "1" . $cr . $condition . substr($imm, 5, 4) . r($sr2). r($sr1) . substr($imm, 0, 5);
		}
		else
		{
			$imm = to_bin(syn_imm($imm, -16384, 16383), 15);
			$all = $opcode . "0" . substr($imm, 5, 10) . r($sr2). r($sr1) . substr($imm, 0, 5);
		}
	}
	else
	{
		$imm = to_bin(syn_imm($imm, -8, 7), 4);
		$all = $opcode . r($sr1) . $imm . r($sr2);
	}
}
# ------------- END OF INSTRUCTION ST ---------------------

# ------------- INSTRUCTION MOVFC ----------------------------
sub i_movfc
{
	($imm, $dr, $cps) = split /\,/, $command, 3;
	$imm = to_bin(syn_imm($imm, 0, 3), 2);
	$cop = 1;
	$cps = r($cps);
	$cop = 0;
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "00" . $cps . $imm . "00000" . r($dr);
	}
	else
	{
		$all = $opcode . $cps . $imm . r($dr);
	}
}
# ------------- END OF INSTRUCTION MOVFC ---------------------

# ------------- INSTRUCTION MOVTC ----------------------------
sub i_movtc
{
	($imm, $cpd, $sr1) = split /\,/, $command, 3;
	$imm = to_bin(syn_imm($imm, 0, 3), 2);
	$cop = 1;
	$cpd = r($cpd);
	$cop = 0;
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "00" . $cpd . $imm . r($sr1) . "00000" ;
	}
	else
	{
		$all = $opcode . r($sr1) . $cpd . $imm;
	}
}
# ------------- END OF INSTRUCTION MOVTC ---------------------

# ------------- INSTRUCTION SCALL ----------------------------
sub i_scall
{
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "0000000000000011111";
	}
	else
	{
		$all = "1110110000000111";
	}
}
# ------------- END OF INSTRUCTION SCALL ---------------------

# ------------- INSTRUCTION SEXTI ----------------------------
# 16-bit & 32-bit mode
# IN:	$command	: GLOBAL;  all argumets without instruction mnemonic 
# SET: 	$all		: line in binary
# global:	$length		: 32 if 32-bit mode
#					  	  16 if 16-bit mode
#			$opcode		: opcode for current instruction
#			$if_found	: 1 if conditional execution
#			$lnr		: source file line number
sub i_sexti
{
	my $dr;
	my $sr1;
	my $imm;
	
	($dr, $sr1, $imm) = split /\s*\,\s*/, $command, 3;
	
	if ($length == 32)
	{		
		($sr1, $imm) = ($dr, $sr1) unless ($imm);

		$imm = to_bin(syn_imm($imm, 0, 31), 5);
		if ($if_found)		
		{
			$all = $opcode . "1" . $cr . $condition . "0000" . $imm . r($sr1). r($dr);
		}
		else
		{
			$all = $opcode . "00000000000" . $imm . r($sr1). r($dr);
		}
	}
	else
	{
		($dr, $imm) = split /\,/, $command, 2;
		$imm = to_bin(syn_imm($imm, 0, 31), 5);
		$all = $opcode . "00" . $imm . r($dr);
	}
}
# ------------- END OF INSTRUCTION SEXTI ---------------------

# ------------- INSTRUCTION SCON ----------------------------
sub i_scon
{
	$dr = $command; 
	if ($length == 32)
	{
		$all = $opcode . "000000000000000000000" . r($dr);
	}
	else
	{
		$all = $opcode . "0000000" . r($dr);
	}
}
# ------------- END OF INSTRUCTION SCON ---------------------

# ------------- INSTRUCTION MOV ----------------------------
sub i_mov
{
	($dr, $sr1) = split /\,/, $command, 2;
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "000000000" . r($sr1) . r($dr);
	}
	else
	{
		$all = $opcode . r($sr1) . "0000" . r($dr);
	}
}
# ------------- END OF INSTRUCTION MOV ---------------------

# ------------- INSTRUCTION MULHI ----------------------------
sub i_mulhi
{
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "00000000000000" . r($command);
	}
	else
	{
		$all = $opcode . "0000000" . r($command);
	}
}
# ------------- END OF INSTRUCTION MULHI ---------------------

# ------------- INSTRUCTION NOT ----------------------------
sub i_not
{
	if ($length == 32)
	{
		($dr, $sr1) = split /\,/, $command, 2;
		$all = $opcode . $cex . $cr . $condition . "000000000" . r($sr1) . r($dr);
	}
	else
	{
		$all = $opcode . form_dr_sr();
	}
}
# ------------- END OF INSTRUCTION NOT ---------------------

# ------------- INSTRUCTION TRAP ----------------------------
sub i_trap
{
	$imm = to_bin(syn_imm($command, 0, 31), 5);
	if ($length == 32)
	{
		$all = $opcode . $cex . $cr . $condition . "0000" . $imm . "0000000000";
	}
	else
	{
		$all = $opcode . "00" . $imm . "000";
	}
}
# ------------- END OF INSTRUCTION TRAP ---------------------

# ------------- COPROCESSOR INSTRUCTION FORMAT ----------------------------
# all instructions for coprocessor have the same format
# 'name_with_number dr, sr1[, sr2]'
# full name is already deleted and opcode is defined
# but number to identify mashine is still here
sub cop_instr
{
	# instructions are allowed just in 32-bit mode
	if ($length == 32)
	{
		($number, $rest) = split /\s+/, $command, 2;
		($dr, $sr1, $sr2) = split /\,/, $rest, 3;
		$sr2 = 0 unless $sr2;
		$all = $opcode . to_bin($number, 2) . "000" . r($sr2) . r($sr1) . r($dr) . $opc;
	}
	else
	{
		not_allowed();
	}
}
# ------------- END OF COPROCESSOR INSTRUCTION FORMAT ---------------------

# ------ END OF INSTRUCTION DECODING ------

# ------------- FINDING COPROCESSOR INSTRUCTIONS ----------------------------
sub coprocessor_instr
{
	our $opc;
	
	# finding add
	if ($command =~ s/^[aA][dD]{2}//)
	{
		$opc = "000000";
		cop_instr();
	}

	# finding sub
	elsif ($command =~ s/^[sS][uU][bB]//) 
	{
		$opc = "000001";
		cop_instr();
	}
	
	# finding mul
	elsif ($command =~ s/^[mM][uU][lL]//) 
	{
		$opc = "000010";
		cop_instr();
	}
	
	# finding div
	elsif ($command =~ s/^[dD][iI][vV]//) 
	{
		$opc = "000011";
		cop_instr();
	}
	
	# finding sqrt
	elsif ($command =~ s/^[sS][qQ][rR][tT]//) 
	{
		$opc = "000100";
		cop_instr();
	}
	
	# finding abs
	elsif ($command =~ s/^[aA][bB][sS]//) 
	{
		$opc = "000101";
		cop_instr();
	}
	
	# finding mov
	elsif ($command =~ s/^[mM][oO][vV]//) 
	{
		$opc = "000110";
		cop_instr();
	}
	
	# finding neg
	elsif ($command =~ s/^[nN][eE][gG]//) 
	{
		$opc = "000111";
		cop_instr();
	}
	
	# finding nop
	elsif ($command =~ s/^[nN][oO][pP]//) 
	{
		$opc = "001000";
		cop_instr();
	}
	
	# finding cvt.
	elsif ($command =~ s/^[cC][vV][tT]\.//) 
	{
		# finding cvt.s
		if ($command =~ s/^[sS]//)
		{
			$opc = "100000";
		}
		
		# finding cvt.w
		elsif ($command =~ s/^[wW]//)
		{
			$opc = "100100";
		}
		cop_instr();
	}
	
	# finding c.
	elsif ($command =~ s/^[cC]\.//)
	{
		# finding c.f
		if ($command =~ s/^[fF]//)
		{
			$opc = "110000";
		}
		
		# finding c.un
		elsif ($command =~ s/^[uU][nN]//)
		{
			$opc = "110001";
		}
		
		# finding c.eq
		elsif ($command =~ s/^[eE][qQ]//)
		{
			$opc = "110010";
		}
		
		# finding c.ueq
		elsif ($command =~ s/^[uU][eE][qQ]//)
		{
			$opc = "110011";
		}
		
		# finding c.seq
		elsif ($command =~ s/^[sS][eE][qQ]//)
		{
			$opc = "111010";
		}
		
		# finding c.ol
		elsif ($command =~ s/^[oO][lL]//)
		{
			# finding c.olt
			if ($command =~ s/^[tT]//)
			{ 
				$opc = "110100";
			}
			# finding c.ole
			elsif ($command =~ s/^[eE]//)
    		{
    			$opc = "110110";
    		}
		}
		
		# finding c.ul
		elsif ($command =~ s/^[uE][lL]//)
		{
			# finding c.ult
			if ($command =~ s/^[tT]//)
			{
				$opc = "110101";
			}
			# finding c.ule
			elsif ($command =~ s/^[eE]//)
    		{
    			$opc = "110111";
    		}
		}
		
		# finding c.sf
		elsif ($command =~ s/^[sS][fF]//)
		{
			$opc = "111000";
		}
		
		# finding c.ng
		elsif ($command =~ s/^[nN][gG]//)
		{
			# finding c.ngle
			if ($command =~ s/^[lL][eE]//)
			{
				$opc = "111001";
			}
			# finding c.ngl
			elsif ($command =~ s/^[lL]//)
			{
    			$opc = "111011";
			}
			# finding c.nge
			elsif ($command =~ s/^[eE]//)
			{
				$opc = "111101";
			}
			# finding c.ngt
			elsif ($command =~ s/^[tT]//)
			{
				$opc = "111111";
			}
		}
		
		# finding c.lt
		elsif ($command =~ s/^[lL][tT]//)
		{
			$opc = "111100";
		}
		
		# finding c.le 
		elsif ($command =~ s/^[sS][eE][qQ]//)
		{
			$opc = "111110";
		}
		
		cop_instr();
	}
}
# ------------- END OF FINDING COPROCESSOR INSTRUCTIONS ---------------------

# ------------- FINDING INSTRUCTIONS ----------------------------
sub instr
{
	our $opcode;
	our $name;
	our $moving;
	warning_printing("You are writing instruction into .bss section", $lnr) if ($bss_s);

	# finding coprocessor instruction - starting with 'f'
	if ($command =~ s/^[fF]//)
	{
		$opcode = "111100";
		$cop = 1;
		coprocessor_instr();
		$cop = 0;
	}

	# finding add
	elsif ($command =~ s/^[aA][dD]{2}//)
	{
		# finding addi
		if ($command =~ s/^[iI]\b//)
		{
    		$opcode = "101101";
    		# for sub advanced in whole IF
    		# imm order (min, max): 
    		# ($_[0], $_[1]) => 32-bit with condition
    		# ($_[2], $_[3]) => 32-bit without condition
    		# ($_[4], $_[5]) => 16-bit
    		advanced(-256, 255, -16384, 16383, -64, 63);
		}
		# finding addiu
    	elsif ($command =~ s/^[iI][uU]\b//)
    	{
    		$opcode = "101000";
    		advanced(0, 511, 0, 32767, 0, 127);
    	}
    	# finding addu
    	elsif ($command =~ s/^[uU]\b//)
    	{
    		$opcode = "000000";
    		simple();
    	}
		# finding add
		else
		{
			$opcode = "000001";
			simple();
		}
	}

	# finding and
	elsif ($command =~ s/^[aA][nN][dD]//)
	{
		# finding andi
		if ($command =~ s/^[iI]\b//)
		{
    		$opcode = "101001";
    		advanced(0, 511, 0, 32767, 0, 127);
		}
		# finding and
		else
		{
			$opcode = "000010";
			simple();
		}        
	}

	# finding bc
	elsif ($command =~ s/^[bB][cC]\b//)
	{
		$opcode = "100000";
		err();
		branch();
	}

	# finding be
	elsif ($command =~ s/^[bB][eE]//)
	{
		# finding begt
		if ($command =~ s/^[gG][tT]\b//)
		{
			$opcode = "100001";
			err();
			branch();
		}
    	# finding belt
    	elsif ($command =~ s/^[lL][tT]\b//)
    	{
    		$opcode = "100010";
    		err();
    		branch();
    	}
    	# finding beq
    	elsif ($command =~ s/^[qQ]\b//)
    	{
    		$opcode = "100011";
    		err();
    		branch();
    	}
	}

	# finding bgt
	elsif ($command =~ s/^[bB][gG][tT]\b//)
	{
		$opcode = "100100";
		err();
		branch();
	}

	# finding blt
	elsif ($command =~ s/^[bB][lL][tT]\b//)
	{
		$opcode = "100101";
		err();
		branch();
	}

	# finding bn
	elsif ($command =~ s/^[bB][nN]//)
	{
    	# finding bnc
    	if ($command =~ s/^[cC]\b//)
    	{
    		$opcode = "100111";
    		err();
    		branch();
    	}
    	
    	# finding bne
    	elsif ($command =~ s/^[eE]\b//)
    	{
    		$opcode = "100110";
    		err();
    		branch();
    	}
	}

	# finding chrs
	elsif ($command =~ s/^[cC][hH][rR][sS]\b//)
	{
		$opcode = "110011";
		err();
		i_chrs();
	}
	
	# finding cmp
	elsif ($command =~ s/^[cC][mM][pP]//)
	{
    	# finding cmpi
    	if ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "110111";
    		err();
    		i_cmpi();
    	}
		# finding cmp
		else
		{
    		$opcode = "011001";
    		err();
    		i_cmp();
		}
	}
	
	# finding con
	elsif ($command =~ s/^[cC][oO][nN]//)
	{
		# finding conb
		if ($command =~ s/^[bB]\b//)
		{
    		$opcode = "000011";
    		# simple version for 32-bit mode isn't allowed
    		$simple = 0;
    		simple();
		}
    	# finding conh
    	elsif ($command =~ s/^[hH]\b//)
    	{
    		$opcode = "000100";
    		# is needed to swap $sr1 and $sr2
    		$swap = 1;
    		# simple version for 32-bit mode isn't allowed
    		$simple = 0;
    		simple();
    	}
	}
	
	# finding di
	elsif ($command =~ s/^[dD][iI]\b//)
	{
		$opcode = "010101";
		don_t();
		err();
		$all = "0101010000000000";
		add_all("0000000000000000");
	}

	# finding ei
	elsif ($command =~ s/^[eE][iI]\b//)
	{
		$opcode = "010110";
		don_t();
		err();
		$all = "0101100000000000";
		add_all("0000000000000000");
	}
	
	# finding exb
	elsif ($command =~ s/^[eE][xX][bB]//)
	{
    	# finding exbf
    	if ($command =~ s/^[fF]\b//)
    	{
    		$opcode = "011010";
    		simple();
    	}	
    
    	# finding exbfi
    	elsif ($command =~ s/^[fF][iI]\b//)
    	{
    		$opcode = "111101";
    		err();
    		i_exbfi();
    	}
		# finding exb
		else
		{
    		$opcode = "110000";
    		i_exb();
		}
	}

	# finding exh
	elsif ($command =~ s/^[eE][xX][hH]\b//)
	{
		$opcode = "110001";
		i_exh();
	}

	# finding jal
	elsif ($command =~ s/^[jJ][aA][lL]//)
	{
   		# finding jalr
    	if ($command =~ s/^[rR]\b//)
    	{
    		$opcode = "110101";
    		jumps_2("11111", "111");
    	}
		# finding jal
		else
		{
    		$opcode = "111001";
     		err();
    		jumps();
		}
	}

	# finding jmp
	elsif ($command =~ s/^[jJ][mM][pP]//)
	{
	   	# finding jmpr
	  	if ($command =~ s/^[rR]\b//)
    	{
    		$opcode = "011011";
    		jumps_2("00000", "000");
    	}
		# finding jmp
		else
		{
    		$opcode = "111000";
    		err();
    		jumps();
		}
	}

	# finding ld
	elsif ($command =~ s/^[lL][dD]\b//)
	{
		$opcode = "110010";
		$ld = 1;
		advanced(-256, 255, -16384, 16383, -8, 7); 
	}
	
	# finding lli
	elsif ($command =~ s/^[lL]{2}[iI]\b//)
	{
		$name = "lli";
		$opcode = "111110";
		err();
		load_half();
	}

	# finding lui
	elsif ($command =~ s/^[lL][uU][iI]//)
	{
		
		if ($command =~ s/^1//)
		{
			$name = "lui";
			$moving = 1;
		}
		else
		{
			$name = "lli";
		}
		$opcode = "111111";
		err();
		load_half();
		$moving = 0;
	}
	
	# finding mov
	elsif ($command =~ s/^[mM][oO][vV]//)
	{
    	# finding movfc
    	if ($command =~ s/^[fF][cC]\b//)
    	{
    		$opcode = "101100";
    		i_movfc();
    	}
    
    	# finding movtc
    	elsif ($command =~ s/^[tT][cC]\b//)
    	{
    		$opcode = "110110";
    		i_movtc();
    	}
		# finding mov
		else
		{
    		$opcode = "010011";
    		i_mov();
		}
	}

	# finding mul
	elsif ($command =~ s/^[mM][uU][lL]//)
	{
    	# finding mulhi
    	if ($command =~ s/^[hH][iI]\b//)
    	{
    		$opcode = "011101";
    		i_mulhi();
    	}
    	# finding muli
    	elsif ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "101110";
    		advanced(-256, 255, -16384, 16383, -64, 63);
    	}
    	# finding muls
    	elsif ($command =~ s/^[sS]\b//)
    	{
    		$opcode = "000101";
    		simple();
    	}         
    	# finding muls_16
    	elsif ($command =~ s/^[sS]_16\b//)
    	{
    		$opcode = "001000";
    		simple();
    	}
    	# finding mulu
    	elsif ($command =~ s/^[uU]//)
    	{
        	# finding mulu_16
        	if ($command =~ s/^_16\b//)
        	{
        		$opcode = "001001";
        		simple();
        	}
        	# finding mulus
        	elsif ($command =~ s/^[sS]\b//)
        	{
        		$opcode = "000111";
				$simple = 0;
        		simple();
        	}
        	# finding mulus_16
        	elsif ($command =~ s/^[sS]_16\b//)
        	{
        		$opcode = "001010";
        		simple();
        	}
			# finding mulu
			else
			{
    			$opcode = "000110";
    			simple();
			}
    	}
	}

	# finding no
	elsif ($command =~ s/^[nN][oO]//)
	{
		# finding nop
		if ($command =~ s/^[pP]\b//)
		{
    		$opcode = "111010";
    		don_t();
    		err();
    		$all = "1110100000000000";
    		add_all("1110100000000000");
		}
		# finding not
    	elsif ($command =~ s/^[tT]\b//)
    	{
    		$opcode = "010100";
    		i_not();
    	}
	}
	
	# finding or
	elsif ($command =~ s/^[oO][rR]//)
	{
		# finding ori
    	if ($command =~ s/^[iI]//)
    	{
			if ($command =~ m/^\d/)
			{
				# digit identifies type of relocation
				($digit, $command) = split /\s+/, $command, 2;
				$name = "ori" . $digit;
			}
    		$opcode = "101010";
    		advanced(0, 511, 0, 32767, 0, 128);
    	}
		# finding or
		else
		{
			$opcode = "001011";
			simple();
		}
	}

	# finding rcon
	elsif ($command =~ s/^[rR][cC][oO][nN]\b//)
	{
		$opcode = "011110";
		err();
		i_rcon();
	}
	
	# finding ret
	elsif ($command =~ s/^[rR][eE][tT]//)
	{
		# finding reti
		if ($command =~ s/^[iI]\b//)
		{
    		$opcode = "010111";
    		don_t();
    		err();
    		$all = "0101110000000000";
    		add_all("0000000000000000");
		}
    	# finding retu
    	elsif ($command =~ s/^[uU]\b//)
    	{
    		$opcode = "011111";
    		don_t();
    		err();
    		$all = "0111110000000000";
    		add_all("0111101111100000");
    	}
	}
	
	# finding sc
	elsif ($command =~ s/^[sS][cC]//)
	{
    	# finding scall
    	if ($command =~ s/^[aA][lL]{2}\b//)
    	{
    		$opcode = "111011";
    		don_t();
    		i_scall();
    	}
    	# finding scon
    	elsif ($command =~ s/^[oO][nN]\b//)
    	{
    		$opcode = "011100";
    		err();
    		i_scon();
    	}
	}
	
	# finding sext
	elsif ($command =~ s/^[sS][eE][xX][tT]//)
	{
    	# finding sexti
    	if ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "101011";
    		i_sexti();
    	}
		# finding sext
		else 
		{
    		$opcode = "001100";
    		simple();
		}
	}
	
	# finding sll
	elsif ($command =~ s/^[sS][lL]{2}//)
	{
    	# finding slli
    	if ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "001101";
    		shift_imm();
    	}
		# finding sll
		else
		{
			$opcode = "001101";
			shift_();
		}
	}
	
	# finding sra
	elsif ($command =~ s/^[sS][rR][aS]//)
	{
    	# finding srai
    	if ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "001110";
    		shift_imm();
    	}
		# finding sra
		else
		{
			$opcode = "001110";
			shift_();
		}
	}
	
	# finding srl
	elsif ($command =~ s/^[sS][rR][lL]//)
	{
    	# finding srli
    	if ($command =~ s/^[iI]\b//)
    	{
    		$opcode = "001111";
    		shift_imm();
    	}
		# finding srl
		else
		{
			$opcode = "001111";
			shift_();
		}
	}
	
	# finding st
	elsif ($command =~ s/^[sS][tT]\b//)
	{
		$opcode = "110100";
		i_st();
	}
	
	# finding sub
	elsif ($command =~ s/^[sS][uU][bB]//)
	{
    	# finding subu
    	if ($command =~ s/^[uU]\b//)
    	{
    		$opcode = "010001";
			$simple = 0;
    		simple();
    	}
		# finding sub
		else
		{
			$opcode = "010000";
			$simple = 0;
			simple();
		}
	}	

	# finding swm
	elsif ($command =~ s/^[sS][wW][mM]\b//)
	{
		$opcode = "101111";
		err();
		i_swm();
	}

	# finding trap
	elsif ($command =~ s/^[tT][rR][aA][pP]\b//)
	{
		$opcode = "011000";
		i_trap();
	}
	
	# finding xor
	elsif ($command =~ s/^[xX][oO][rR]\b//)
	{
		$opcode = "010010";
		simple();
	}
	
	# if not found - error message
	else
	{
		error_printing("Wrong instruction syntax - '$command'", $lnr);
	}
}
# ------------- END OF FINDING INSTRUCTIONS ---------------------
# ------------------------------------------------------------------------------
# ------------------------------ END OF SUBROUTINES, PART 2 --------------------
# ------------------------------------------------------------------------------

# ------ FLOATING-POINT NUMBERS ------
# converts floating-point numbers form decimal to binary single or
# double precision without any rounding
package Floating;

# --------------- CONVERTING FLOATING-POINT -----------------------------
# main floating-point subroutine 
# IN -  $number = $_[0]		: string to be understood as floating-point constant
#       $length_m = $_[1]	: length of mantissa/significand
#       $length_be = $_[2]	: length of biased exponent
#       $exp_plus = $_[3]	: constant for exponent normalization
# OUT - $floating			: binary floating-point constant
sub floating_point
{
	my $number = $_[0];
	my $length_m = $_[1];
	my $length_be = $_[2];
	my $exp_plus = $_[3];
	my $floating;

	my $sign;
	my $exp;
	my $fraction;
	my $significant;
	my $n_exp;
	my $b_exp;
	
	if ($number)
	{
		($sign, $number, $exp) = string_processing($number);
        
    	# separete fraction from integer part
    	($number, $fraction) = take_fraction($number, $exp);

    	($significant, $n_exp) = normalize($number, $fraction);

		# biased exponent
        $b_exp = $n_exp + $exp_plus;
        # biased exponent in binary form
        $b_exp = &main::to_bin($b_exp, $length_be);
    	
		# whole floating-point number
		$floating = $sign . $b_exp . substr($significant, 0, $length_m);
		# missing zeros on end
		$floating = $floating . ("0" x (($length_m + $length_be + 1) - length $floating));
	}
	# if nothing or 0
	else
	{
		$floating = "0" x ($length_m + $length_be + 1);
	}
	
	return $floating;
}
# ------------- END OF CONVERTING FLOATING POINT ---------------------

# --------------- STRING PROCESSING -----------------------------
# IN -  $number = $_[0]	: string to be processed
# OUT - $sign			: read sign
#       $number			: read number
#       $exp			: read exponent
sub string_processing
{
	my $number = $_[0];
	my $sign;
	my $exp;
	
    # remove 0f|F
    $number =~ s/0[fF]// || &main::error_printing("Bad syntax of floating point number (missing 0F)", $lnr);
    
    # set sign
    if ($number =~ s/^-//)
    {
    	$sign = 1;
    }
    else
    {
    	$number =~ s/^\+//;
    	$sign = 0;
    }
	
    # separate parts
    # $number - whole number (integer)
    # $exp - exponent (N from 10 with index N)
    ($number, $exp) = split /[eE]/, $number, 2;
	
	&main::error_printing("Bad syntax of floating point number (missing exponent)", $lnr) unless $exp; 
	&main::error_printing("Bad syntax of floating point number (missing number)", $lnr) unless $number;
	
	return $sign, $number, $exp;
}
# ------------- END OF STRING PROCESSING ---------------------

# --------------- TAKE FRACTION -----------------------------
# separates fraction and integer part of number
# IN -  $number = $_[0]	: number
#       $exp = $_[1]	: exponent
# OUT - $number			: integer part (what is left from old $number)
#       $fraction		: fraction part
sub take_fraction
{
	my $number = $_[0];
	my $exp = $_[1];
	my $fraction = "";
	
    # taking out fraction if '-'
    if ($exp =~ m/^-/)
    {
    	# fraction is last numbers depending on $exponent
    	# '-' is in use (exponent is negative)
    	$fraction = substr($number, $exp);
    	# if number is realy small and needs more zeros
   		$fraction = ("0" x abs($exp + (length $fraction))) . $fraction;
				
    	# getting integer part from $number
    	# length_of_integer_part => full_length - exponent
    	if (((length $number) + $exp) > 0)
    	{
    		$number = substr ($number, 0, (length $number) + $exp);
    	}
    	# if length is negative -> integer part is zero
    	else
    	{
    		$number = 0;
    	}
    }
    # getting bigger whole number if '+' (nothing is '+' too)
    else
    {
    	$exp =~ s/^\+//;
   		$number .= "0" x $exp;
    }
	return $number, $fraction;
}
# ------------- END OF TAKE FRACTION ---------------------

# --------------- BINARY FRACTION -----------------------------
# how many characters can by in fraction:
# 1. till fraction is 0 
# 2. max => 255
# note: $exp = -(lenght_of_fraction - 1)
# IN -  $fraction = $_[0]	: fraction in decimal
# OUT - $fraction_b			: binary fraction
sub binary_fraction
{
	my $fraction = $_[0];
	my $fraction_b;
	
	my $counter = 0;
	my $add = 0;

	# counting full size or in case some errors exit after 255 times
    while (($fraction > 0) && ($counter < 255))
    {
		$counter++;
    	$fraction *= 2;
    	# separate integer part for adding to $fraction_b (convertint fraction)
		$add = int $fraction;
    	$fraction = $fraction - $add;
    	$fraction_b .= $add;
    }
	return $fraction_b;
}
# ------------- END OF BINARY FRACTION ---------------------

# --------------- NORMALIZE MANTISSA -----------------------------
# does mantissa normalization
# IN -  $number = $_[0]			: integer part of number in decimal
#       $fraction = $_[1]		: real part (fraction) of number in decimal
# OUT - $significant			: significant part (full mantissa = half_mantissa + fraction)
#       $n_exp					: normalization exponent
sub normalize
{
	my $number = $_[0];
	my $fraction = $_[1];
	my $significant;
	my $n_exp;

	my $half_mantissa;
	my $fraction_b;
	my $previous_l;
	
	# converting integer decimal number to binary
   	$half_mantissa = &main::to_bin_div($number); 
	
    # geting 0.xxxxx
    $fraction = "0." . $fraction;
    # main fraction
    $fraction_b = binary_fraction($fraction); 
	
    # if something in integer part
    # to do normalization, point (comma) is moved to left (+)
    if ($half_mantissa)
    {
        # full mantisa - significant part
        # we don't need first '1' (it is hidden) 
        $significant = substr($half_mantissa, 1) . $fraction_b;
        # what is exponent for normalized binary number
        $n_exp = (length $half_mantissa) - 1;
    }
    # if integer part was 0
    # do to normalization, point (comma) is moved to right (-)
    else
    {
    	# previous length of fraction
    	$previous_l = length $fraction_b;
    	# going to first 1
    	$fraction_b =~ s/^0+(?=\d)//;
    	# exponent -> how_many_0_was_deleted - hidden_1 
    	$n_exp = (length $fraction_b) - 1 - $previous_l;
		# significant part - whole long (max 255) or short (min 1) fraction part
    	$significant = substr($fraction_b, 1);
    }
	return $significant, $n_exp;
}
# ------------- END OF NORMALIZE MANTISSA ---------------------
# ------ END OF FLOATIN
