#!/usr/bin/tclsh
# Part of MCU 8051 IDE ( http://https://sourceforge.net/projects/mcu8051ide/ )

############################################################################
#    Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera     #
#    martin.osmera@gmail.com                                               #
#                                                                          #
#    Copyright (C) 2014 by Moravia Microsystems, s.r.o.                    #
#    martin.osmera@gmail.com                                #
#                                                                          #
#    This program is free software; you can redistribute it and#or modify  #
#    it under the terms of the GNU General Public License as published by  #
#    the Free Software Foundation; either version 2 of the License, or     #
#    (at your option) any later version.                                   #
#                                                                          #
#    This program is distributed in the hope that it will be useful,       #
#    but WITHOUT ANY WARRANTY; without even the implied warranty of        #
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         #
#    GNU General Public License for more details.                          #
#                                                                          #
#    You should have received a copy of the GNU General Public License     #
#    along with this program; if not, write to the                         #
#    Free Software Foundation, Inc.,                                       #
#    59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.             #
############################################################################

# >>> File inclusion guard
if { ! [ info exists _ASSEMBLER_TCL ] } {
set _ASSEMBLER_TCL _
# <<< File inclusion guard

# --------------------------------------------------------------------------
# DESCRIPTION
# Coverts precompiled source code to IHEX 8 format.
#
# This code is part of compiler (see compiler.tcl), precompiled code is
# generated by precompiler (see precomiler.tcl).
#
# --------------------------------------------------------------------------
# OUTPUT FORMATS:
#	- Intel® HEX 8
#	- Binary string
#	- MCU 8051 IDE Simulator data file
#
# --------------------------------------------------------------------------
# FORMAT DETAILS:
#	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#	MCU 8051 IDE Assembler debug file
#		hash file [hash file [hash file ...]] # comment
#		filenum line address code [code [code ...]] # another comment
#		...
#			hash	- Hexadecimal MD5 hash of source code
#			file	- Filename of source code
#			filenum	- File number (beginning from 0)
#			line	- Number of line in source code
#			address	- Code address
#			code	- Processor code
#
#	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#	Intel HEX 8
#		:LLAAAATTDD->CC
#		...
#		...
#		:00000001FF
#			LL	- 8-bit length of data field (for instance '11' means 17 bytes)
#			AAAA	- 16-bit address
#			TT	- 8-bit type:
#					00 - data
#					01 - EOF (End Of File), ussualy ':00000001FF'
#			DD->	- X x 8-bit data
#			CC	- checksum:
#					0x100 - LL - AA(h) - AA(l) - TT - DD ...
# --------------------------------------------------------------------------

namespace eval assembler {

	## PUBLIC
	variable hex		;# Output IHEX8 data
	variable adf		;# Output simulator data
	variable bin		;# Output binary data
	variable error_count	;# Errors count

	## PRIVATE
	variable fileNumber	;# File number
	variable lineNumber	;# Number of line currently beeing parsed
	variable offset		;# Current address
	variable data_len	;# Data length (for creating IHEX records)
	variable data_field	;# Data field (for creating IHEX records)
	variable address	;# Address of beginning of IHEX data field
	variable operands	;# List of operand codes
	variable opcode		;# OP code of the current instruction
	variable bin_len	;# Lenght of binary data
	variable opr_types	;# List of operand types
	variable included_files	;# List: Unique unsorted list of included files
	variable working_dir	;# String: Project working directory


	# ----------------------------------------------------------------
	# GENERAL PURPOSE PROCEDURES
	# ----------------------------------------------------------------

	## Compile the given code
	 # @parm String md5		- Source code MD5 (hexadecimal hash)
	 # @parm String date		- Current date
	 # @parm String project_dir	- Project directory
	 # @parm String name		- Name of source file
	 # @parm List files		- List of included files (1st one is primary source file)
	 # @parm List code		- Precompiled source code (code generated by preprocessor)
	 # @return Bool - result (1 == success; 0 == fail)
	proc compile {md5 date project_dir name files code} {
		variable working_dir	$project_dir	;# String: Project working directory
		variable included_files	$files	;# List: Unique unsorted list of included files
		variable fileNumber	0	;# File number
		variable lineNumber	0	;# Number of line currently beeing parsed
		variable opcode			;# OP code of the current instruction
		variable operands		;# List of operand codes
		variable address		;# Address of beginning of IHEX data field
		variable opr_types		;# List of operand types
		variable offset		0	;# Current address
		variable data_len	0	;# Data length (for creating IHEX records)
		variable data_field	{}	;# Data field (for creating IHEX records)
		variable hex		{}	;# Output IHEX8 data
		variable adf		{}	;# Output simulator data
		variable bin		{}	;# Output binary data
		variable error_count	0	;# Errors count
		variable bin_len	0	;# Lenght of binary data

		# Local variables
		set idx		-1	;# Current line in precompiled code
		set nolist	0	;# Bool: Do not crete record in code listing for the current line
		set pointer	0	;# Expected address

		# Create header of simulator data
		if {${::Compiler::Settings::CREATE_SIM_FILE}} {
			set filename [file join $project_dir $name]
			set project_dir_len [string length [file normalize $project_dir]]
			if {[string first $project_dir $name] != -1} {
				set filename [string replace $filename 0 $project_dir_len]
			}

			set adf "# Assembler debug file for ${::APPNAME}\n"
			append adf "# Used assembler: MCU 8051 IDE\n"
			append adf "# Date: $date\n"
			set project_dir_len [string length $project_dir]
			foreach filename $included_files {
				if {[catch {
					append adf [::md5::md5 -hex -file $filename]
				} result]} then {
					append adf 0
					CompilationError [mc "File access error:\n%s" $result]
				}
				if {![string first $project_dir $filename]} {
					set filename [string replace $filename 0 $project_dir_len]
				}
				append adf { "} $filename {" }
			}
		}

		# Iterate over precompiled code
		foreach line $code {

			# Update GUI after each 25 iterations
			if {[expr {$idx % 25}] == 0} {
				${::Compiler::Settings::UPDATE_COMMAND}
			}
			if {${::Compiler::Settings::ABORT_VARIABLE}} {
				${::Compiler::Settings::TEXT_OUPUT_COMMAND} [::Compiler::msgc {EN}][mc "Aborted"]
				free_resources
				return
			}

			incr idx
			set nolist 0

			# Parse line
			set lineNumber	[lindex $line 0]	;# Line in source code (dec)
			set fileNumber	[lindex $line 1]	;# Number of file
			set address	[lindex $line 2]	;# Address (dec)
			set instruction	[lindex $line 3]	;# Instruction name (or directive)
			set operands	[lindex $line 4]	;# List of operands
			set opr_types	[lindex $line 5]	;# List of operand types

			# Directive 'DB'
			if {$instruction == {db}} {
				set len		1
				set opcode	[lindex $operands 0]
				set mask	0
				set operands	{}
				if {$opcode == { }} {
					set opcode 32
				}

				set opcode [format %X $opcode]
				set digits [string length $opcode]
				if {$digits < 2} {
					set opcode "0$opcode"
				} elseif {$digits > 2} {
					CompilationError [mc "Unknown error %s" 100]
					continue
				}

				set nolist 1
			} else {
				# Check for instruction existence
				if {[notAnInstruction $instruction]} {continue}

				# Find matching operand set
				set definition [find_instruction_definition $instruction]
				if {$definition == {}} {continue}
				set len		[lindex $definition 1]
				set opcode	[lindex $definition 2]
				set mask	[lindex $definition 3]
			}

			# First line
			if {$pointer == 0} {
				set offset $address
			}

			# If data length overlaps 255 or address is too high -> flush data buffer
			if {($pointer < $address) || (($data_len + $len) > ${::Compiler::Settings::max_ihex_rec_length})} {
				write_bin
				write_hex
				set data_len 0
				set offset $address
				set pointer $address

			# Unexpected address
			} elseif {$pointer > $address} {
				CompilationError [mc "Invalid address at %s" 0x[format %X $address]]
				set pointer $address
				continue
			}

			incr pointer $len	;# Expected address
			incr data_len $len	;# Data length

			#
			## Calculate processor code
			#

			# Translate operands to 16|12|8-bit hex
			set operands [oprs2hex]

			# Adjust instruction OP code according to the OP code mask and operands
			if {$mask != 0} {
				# Determinate length of the first operand
				set mask_bin [hex2binlist $mask]
				set opr_len 8
				foreach bit $mask_bin {
					if {$bit} {incr opr_len}
				}

				# Translate OP code to list of booleans
				set opcode [hex2binlist $opcode]
				# Determinate the 1st operand
				set operand0 [NumSystem::hex2bin [lindex $operands 0]]

				# Adjust operand
				set true_opr_len [string length $operand0]
				if {$opr_len > $true_opr_len} {
					set operand0 "[string repeat 0 [expr {$opr_len - $true_opr_len}]]$operand0"
				} elseif {$opr_len < $true_opr_len} {
					CompilationError [mc "Unknown error %s" 101]
					continue
				}
				incr opr_len -9
				set opcode_opr [string range $operand0 0 $opr_len]
				incr opr_len
				set operand0 [string range $operand0 $opr_len end]

				# Adjust OP code
				set op_idx 0
				foreach mask_bit $mask_bin {
					if {$mask_bit} {
						set opcode [lreplace $opcode $op_idx $op_idx [lindex $opcode_opr $op_idx]]
					}
					incr op_idx
				}

				# Finalize
				set opcode [NumSystem::bin2hex [join $opcode {}]]
				if {[string length $opcode] == 1} {
					set opcode "0$opcode"
				}
				set operand0 [NumSystem::bin2hex $operand0]
				if {[string length $operand0] == 1} {
					set operand0 "0$operand0"
				}
				set operands [lreplace $operands 0 0 $operand0]
			}

			# Write simulator data line
			write_adf

			# Append processor code to data_field
			set opcode [string toupper $opcode]

			# Exception for instruction MOV addr, addr (Reverse order of operands)
			if {$opcode == {85}} {
				append opcode [lindex $operands 1]
				append opcode [lindex $operands 0]
			# Other instructions
			} else {
				foreach opr $operands {
					append opcode $opr
				}
			}
			append data_field $opcode

			# Write line to code listing
			if {!$nolist} {
				CodeListing::set_opcode $idx $opcode
			}
		}

		# Finalize
		write_bin
		write_hex
		if {${::Compiler::Settings::OBJECT}} {
			append hex {:00000001FF}
			append hex "\n"
		}

		# Return result
		if {$error_count} {
			return 0
		} else {
			return 1
		}
	}

	## Free resoureces (should be called after each compilation)
	 # @return void
	proc free_resources {} {
		foreach var {
			hex		adf		bin
			lineNumber	offset		data_len
			data_field	address		operands
			opcode		bin_len  	error_count
			fileNumber
		} \
		{
			set ::assembler::$var {}
		}
	}


	# ----------------------------------------------------------------
	# INTERNAL AUXILIARY PROCEDURES
	# ----------------------------------------------------------------

	## Convert the given hexadecimal value to list of booleans
	 # @parm String value - Hexadecimal number to convert
	 # @return List - Resulting list of booleans (eg. {0 1 0 1 1 1 0 1})
	proc hex2binlist {value} {
		set value [NumSystem::hex2bin $value]
		set len [string length $value]
		if {$len != 8} {
			set value "[string repeat 0 [expr {8 - $len}]]$value"
		}
		return [split $value {}]
	}

	## Write line to simulator data string
	 # @return void
	proc write_adf {} {
		variable adf		;# Output simulator data
		variable fileNumber	;# File number
		variable lineNumber	;# Number of line currently beeing parsed
		variable address	;# Address of beginning of IHEX data field
		variable opcode		;# OP code of the current instruction
		variable operands	;# List of operand codes

		if {!${::Compiler::Settings::CREATE_SIM_FILE}} {return}

		# Convert operands to decimal
		set new_code {}
		lappend new_code [expr "0x$opcode"]

		# Exception for instruction MOV addr, addr (Reverse order of operands)
		if {$opcode == {85} && [llength $operands] == 2} {
			lappend new_code [expr "0x[lindex $operands 1]"]
			lappend new_code [expr "0x[lindex $operands 0]"]
		# Other instructions
		} else {
			foreach hex $operands {
				if {[string length $hex] == 4} {
					lappend new_code [expr "0x[string range $hex 0 1]"]
					lappend new_code [expr "0x[string range $hex 2 3]"]
				} else {
					lappend new_code [expr "0x$hex"]
				}
			}
		}

		# Append new value
		append adf "\n" $fileNumber { } $lineNumber { } $address { } $new_code
	}

	## Write data field as binary string
	 # @return void
	proc write_bin {} {
		variable offset		;# Current address
		variable data_field	;# Data field (for creating IHEX records)
		variable data_len	;# Data length (for creating IHEX records)
		variable bin		;# Output binary data
		variable bin_len	;# Lenght of binary data

		if {!${::Compiler::Settings::CREATE_BIN_FILE}} {return}

		# Create padding
		if {$offset > $bin_len} {
			set diff [expr {$offset - $bin_len}]
			append bin [string repeat "\x00" $diff]
			incr bin_len $diff

		} elseif {$offset < $bin_len} {
			CompilationError [mc "Unknown error %s" 102]
		}

		# Write binary data
		for {set i 0; set j 1} {$i < $data_len} {incr i 2; incr j 2} {
			set hex [string range $data_field $i $j]
			append bin [subst -nocommands "\\x$hex"]
			incr bin_len
		}
	}

	## Write data field as IHEX record
	 # @return
	proc write_hex {} {
		variable data_len	;# Data length (for creating IHEX records)
		variable offset		;# Current address
		variable data_field	;# Data field (for creating IHEX records)
		variable hex		;# Output IHEX8 data

		if {!${::Compiler::Settings::OBJECT}} {return}

		# Create fields length and address
		set len_field	[dec2hex $data_len 2]
		set addr_field	[dec2hex $offset 4]

		# Create IHEX8 record
		set line ${len_field}
		append line ${addr_field} {00} ${data_field}
		set check_field [::IHexTools::getCheckSum $line]
		append line $check_field

		# Append created record to resulting string
		append hex {:}
		append hex $line
		append hex "\n"

		# Reset data field
		set data_field {}
	}

	## Convert decimal value to hexadecimal string
	 # @parm Int value	- Number to convert
	 # @parm Int length	- Length of resuting hexadecimal string
	 # @return String - result
	proc dec2hex {value length} {

		# Convert and determinate length
		set value [format %X $value]
		set true_length [string length $value]

		# Adjuts length
		if {$true_length < $length} {
			return "[string repeat 0 [expr {$length - $true_length}]]$value"
		} elseif {$true_length > $length} {
			incr length -1
			return [string range $value "end-$length" end]
		} else {
			return $value
		}
	}

	## Translate current operands to list of hexadecimal strings
	 # @return List - result (list of two digits pairs)
	proc oprs2hex {} {
		variable operands	;# List of operand codes
		variable opr_types	;# List of operand types

		# Initialize result
		set new_operands {}

		# Iterate over given operands
		foreach opr $operands type $opr_types {
			# Check for variable operand type
			if {[lsearch ${::CompilerConsts::FixedOperands} [string tolower $opr]] != -1} {continue}

			# Check for validity of the given operand
			set opr [string trimleft $opr {#@/}]
			if {![string is digit -strict $opr]} {
				CompilationError [mc "Invalid operand: '%s'" $opr]
				break
			}

			# Convert to hexadecimal string
			set opr [string trimleft $opr 0]
			if {$opr == {}} {
				set opr 0
			} else {
				set opr [format %X $opr]
			}

			# Adjust length
			set opr_len [string length $opr]
			if {($type == {imm16}) || ($type == {code16})} {
				if {$opr_len < 4} {
					set opr "[string repeat 0 [expr {4 - $opr_len}]]$opr"

				} elseif {$opr_len > 4} {
					CompilationError [mc "Invalid value"]
				}

			} elseif {$type == {code11}} {
				if {$opr_len < 3} {
					set opr "[string repeat 0 [expr {3 - $opr_len}]]$opr"

				} elseif {$opr_len > 3} {
					CompilationError [mc "Invalid value"]
				}

			} elseif {$opr_len == 1} {
				set opr "0$opr"
			}

			# Append operand to the resulting list
			lappend new_operands $opr
		}

		# Return result
		return $new_operands
	}

	## Search for operands definition list of the given instruction (instruction must be valid)
	 # @parm String instruction - Name of instruction to find
	 # @return List - Found operands definition list
	proc find_instruction_definition {instruction} {
		variable opr_types	;# List of operand types

		# Iterate over operands definitions
		foreach definition [lindex $::CompilerConsts::InstructionDefinition($instruction) 1] {

			# Determinate operand types
			set opr_list [lindex $definition 0]

			# Compare the given operand types with definition
			set match 1
			foreach given_type $opr_types possible_type $opr_list {
				if {[lsearch $given_type $possible_type] == -1} {
					set match 0
					break
				}
			}

			# Return result
			if {$match} {
				return $definition
			}
		}

		# Nothing found
		if {!$match} {
			CompilationError [mc "Invalid operand"]
			return {}
		}
	}

	## Verify validity of the given instruction (Invokes CompilationError of fail)
	 # @parm String instruction - Instruction to verify
	 # @return Bool - result
	proc notAnInstruction {instruction} {
		if {[lsearch ${::CompilerConsts::AllInstructions} $instruction] == -1} {
			CompilationError [mc "Unknown instruction: %s" $instruction]
			return 1
		}
		return 0
	}

	## Compilation error
	 # @parm String errorInfo - Error string
	 # @return void
	proc CompilationError {errorInfo} {
		variable working_dir	;# String: Project working directory
		variable included_files	;# List: Unique unsorted list of included files
		variable error_count	;# Errors count
		variable fileNumber	;# File number
		variable lineNumber	;# Number of line currently beeing parsed

		incr error_count
		set filename [lindex $included_files $fileNumber]
		if {![string first $working_dir $filename]} {
			set filename [string replace $filename 0 [string length $working_dir]]
		}
		if {[regexp {\s} $filename]} {
			set filename "\"$filename\""
		}
		set filename [mc " in %s" $filename]
		if {${::Compiler::Settings::WARNING_LEVEL} < 3} {
			if {${::Compiler::Settings::NOCOLOR}} {
				${::Compiler::Settings::TEXT_OUPUT_COMMAND}	\
					[::Compiler::msgc {EL}][mc "Compilation error at %s: %s" "${lineNumber}${filename}" $errorInfo]
			} else {
				${::Compiler::Settings::TEXT_OUPUT_COMMAND}	\
					[mc "\033\[31;1mCompilation error at \033\[31;1;4m%s\033\[m%s: %s" $lineNumber $filename $errorInfo]
			}
		}
	}
}

# >>> File inclusion guard
}
# <<< File inclusion guard