From 5b8466f7fae0e071c0f4eda13051c93313910028 Mon Sep 17 00:00:00 2001 From: Andrej Shadura Date: Tue, 8 May 2018 15:59:29 +0200 Subject: Import Upstream version 1.3.7 --- lib/compiler/codelisting.tcl | 1169 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1169 insertions(+) create mode 100755 lib/compiler/codelisting.tcl (limited to 'lib/compiler/codelisting.tcl') diff --git a/lib/compiler/codelisting.tcl b/lib/compiler/codelisting.tcl new file mode 100755 index 0000000..1940dc3 --- /dev/null +++ b/lib/compiler/codelisting.tcl @@ -0,0 +1,1169 @@ +#!/usr/bin/tclsh +# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) + +############################################################################ +# Copyright (C) 2007-2009 by Martin Ošmera # +# 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. # +############################################################################ + +# -------------------------------------------------------------------------- +# DESCRIPTION +# Hepler namespace to generate code listing. +# This code is part of compiler (see 'compiler.tcl' and 'assembler.tcl'). +# -------------------------------------------------------------------------- + + +namespace eval CodeListing { + + ## Resulting LST code + # format: {lineNum address opcode value includeLevel macroLevel {lineContent}} + variable lst {} + variable Enabled 1 ;# Bool: LIST/NOLIST flag + variable pageNum ;# Page number + variable pageLines ;# Number of lines at the current page + variable header {} ;# Title string + variable errors_count 0 ;# Number of errors + variable warnings_count 0 ;# Number of warnings + variable symbol_table {} ;# Table of symbolic names + variable error_summary {} ;# Error summmary string + variable new_sync_map {} ;# Tempotary Map of lines in code listing + variable sync_map {} ;# Map of lines in code listing + variable tmp_lst {} ;# Tempotary LST code + + + # ---------------------------------------------------------------- + # GENERAL PURPOSE PROCEDURES + # ---------------------------------------------------------------- + + ## Format resulting code listing + # @access public + # @return String - code listing + proc getListing {} { + variable lst ;# Resulting LST code + variable error_summary ;# Error summmary string + variable errors_count ;# Number of errors + variable warnings_count ;# Number of warnings + variable symbol_table ;# Table of symbolic names + variable header ;# Title string + variable pageNum ;# Page number + variable pageLines ;# Number of lines at the current page + + # Initialize NS variables + set pageNum 1 + set pageLines 0 + + # Validate compiler settings + if {${Compiler::Settings::PAGELENGTH} < 5} { + set Compiler::Settings::PAGELENGTH 5 + } elseif {${Compiler::Settings::PAGELENGTH} == 0} { + set Compiler::Settings::PAGING 0 + } + if {${Compiler::Settings::PAGEWIDTH} < 68} { + set Compiler::Settings::PAGEWIDTH 68 + } elseif {${Compiler::Settings::PAGEWIDTH} == 0} { + set Compiler::Settings::PAGEWIDTH 116 + } + + # Create page header + set header ${Compiler::Settings::INPUT_FILE_NAME} + set len [string length ${Compiler::Settings::INPUT_FILE_NAME}] + if {$len < 15} { + append header [string repeat { } [expr {15 - $len}]] + } + append header { } ${Compiler::Settings::TITLE} + + set len [string length $header] + incr len 23 + + # Adjust page header width + if {$len > ${Compiler::Settings::PAGEWIDTH}} { + set header [string range $header 0 [expr {${Compiler::Settings::PAGEWIDTH} - 24}]] + append header {... } + + } elseif {$len < ${Compiler::Settings::PAGEWIDTH}} { + set len [expr {${Compiler::Settings::PAGEWIDTH} - $len}] + append header [string repeat { } $len] + } + + # Create date + set len [string length ${Compiler::Settings::DATE}] + if {$len > 10} { + set Compiler::Settings::DATE [string range 0 7 ${Compiler::Settings::DATE}] + append Compiler::Settings::DATE {...} + + } elseif {$len < 10} { + set len [expr {10 - $len}] + append Compiler::Settings::DATE [string repeat { } $len] + } + + append header ${Compiler::Settings::DATE} { PAGE} + + # Create error summary and symbol table + create_error_summary + if {${Compiler::Settings::SYMBOLS}} { + create_symbol_table + } + + # Create code listing text + format_listing + + append lst "\nASSEMBLY COMPLETE" + + # Append final result + if {$errors_count == 1} { + append lst ", 1 ERROR FOUND" + } elseif {$errors_count > 1} { + append lst ", $errors_count ERRORS FOUND" + } { + append lst ", NO ERRORS FOUND" + } + + if {$warnings_count == 1} { + append lst ", 1 WARNING" + } elseif {$warnings_count > 1} { + append lst ", $warnings_count WARNINGS" + } { + append lst ", NO WARNINGS" + } + + # Create final result + append lst "\n" + + # Error summary + if {($errors_count != 0) || ($warnings_count != 0)} { + append lst "\n\n" + append lst $error_summary + } + + # Symbol table + if {${Compiler::Settings::SYMBOLS}} { + append lst "\n\n" + append lst $symbol_table + } + + # restore special characters + regsub -all {\\\\} $lst "\\" lst + regsub -all {\\\{} $lst "\{" lst + regsub -all {\\\}} $lst "\}" lst + regsub -all {\\\"} $lst "\"" lst + + # Return result + return $lst + } + + ## Directive LIST + # @access public + # @parm Int idx - index where the directive occured + # @return void + proc directive_list {idx} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + if {${Compiler::Settings::_list} != 0} {return} + + # Adjust code listing + set idx [getIdx $idx] + increment_sync_map $idx 1 + set lst [linsert $lst $idx {LIST}] + } + + ## Directive NOLIST + # @access public + # @parm Int idx - index where the directive occured + # @return void + proc directive_nolist {idx} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + if {${Compiler::Settings::_list} != 0} {return} + + # Adjust code listing + set idx [getIdx $idx] + incr idx + increment_sync_map $idx 1 + set lst [linsert $lst $idx {NOLIST}] + } + + ## Debuging procedure + # Write current content of the code listing to stdout (max. 501 lines) + # @access public + # @return void + proc write_lst {} { + variable lst ;# Resulting LST code + variable sync_map ;# Map of lines in code listing + + set idx 0 + foreach line $lst { + puts "$idx:\t$line" + incr idx + if {$idx > 500} {break} + } + } + + ## Initialize code listing + # Should be called on preprocessor start up + # @access public + # @parm String data - input source code + # @return void + proc create_listing {data} { + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + variable lst ;# Resulting LST code + variable sync_map ;# Map of lines in code listing + variable error_summary ;# Error summmary string + variable symbol_table ;# Table of symbolic names + variable Enabled ;# Bool: LIST/NOLIST flag + + # Reset NS variables + set lst {} + set Enabled 1 + set sync_map {} + set symbol_table {} + set error_summary {} + + # Initialize code listing list + set idx -1 + foreach line $data { + incr idx + lappend lst [list {} {} {} 0 0 [lindex $line 2]] + lappend sync_map $idx + } + } + + ## Import table of symbolic names from preprocessor + # @access public + # @return void + proc import_symbolic_names {} { + variable symbol_table ;# Table of symbolic names + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + if {!${Compiler::Settings::SYMBOLS}} {return} + + # Iterate over definition ists and write them to the table + foreach def_list { + defined_BIT defined_CODE defined_DATA defined_IDATA + defined_XDATA defined_LABEL defined_EQU defined_EQU_SPEC + } val_array { + const_BIT const_CODE const_DATA const_IDATA + const_XDATA labels const_EQU const_EQU_SPEC + } type { + ADDR ADDR ADDR ADDR + ADDR ADDR NUMB SPEC + } char { + B C D I + X C N S + } { + + # Get list of defined names + set def_list [subst "\$PreProcessor::$def_list"] + + # Write defined names to the table + foreach var $def_list { + set value [subst "\$PreProcessor::${val_array}($var)"] + + # Handle special constants + if {$char == {S}} { + lappend symbol_table [list \ + [string toupper $var] \ + $char \ + $type \ + [string toupper $value] \ + 1 0] + + # Other constants ... + } { + lappend symbol_table [list \ + [string toupper $var] \ + $char \ + $type \ + [get_4hex $value] \ + 1 0] + } + } + } + + # Write defined variables (directive "SET") + foreach var ${PreProcessor::defined_SET} { + set value [lindex $PreProcessor::const_SET($var) {end 1}] + lappend symbol_table [list [string toupper $var] { } NUMB [get_4hex $value] 1 1] + } + + # Write defined special variables (directive "SET") + foreach var ${PreProcessor::defined_SET_SPEC} { + set value [lindex $PreProcessor::const_SET_SPEC($var) {end 1}] + lappend symbol_table [list [string toupper $var] {S} SPEC [string toupper $value] 1 1] + } + + # Sort table of symbols by names + set symbol_table [lsort -index 0 $symbol_table] + } + + ## Set flag used to 1 for symbol writen in table of symbols + # @access public + # @parm String symbolic_name - Symbol name + # @parm String type - Symbol type + # @return Bool - result + proc symbol_used {symbolic_name type} { + variable symbol_table ;# Table of symbolic names + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + if {!${Compiler::Settings::SYMBOLS}} {return} + + # Find the specified symbol in the table + set symbolic_name [string toupper $symbolic_name] + set idx -1 + foreach var $symbol_table { + incr idx + + # Symbol found -> set flag used + if {[lindex $var 0] == $symbolic_name} { + lset symbol_table [list $idx 4] 0 + return 1 + } + } + + # Symbol not found -> failed + return 0 + } + + ## Write error message to the code listing + # @access public + # @parm Int idx - Index where the error occured + # @parm String info - Error message + # @return void + proc Error {idx info} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust index + set idx [getIdx $idx] + if {$idx == {}} { + puts stderr "Compiler internal failure 0 -- code listing will not be complete" + return + } + incr idx + increment_sync_map $idx 1 + + # Write the message + set lst [linsert $lst $idx [list {****} "ERROR: $info"]] + } + + ## Write warning message to the code listing + # @access public + # @parm Int idx - Index where the warning occured + # @parm String info - Warning message + # @return void + proc Warning {idx info} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust index + set idx [getIdx $idx] + if {$idx == {}} { + puts stderr "Compiler internal failure 4 -- code listing will not be complete" + return + } + incr idx + increment_sync_map $idx 1 + + # Write the message + set lst [linsert $lst $idx [list {****} "WARNING: $info"]] + } + + ## Directive "$EJECT" + # @access public + # @parm Int idx - Source index + # @return void + proc directive_eject {idx} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust index + set idx [getIdx $idx] + if {$idx == {}} { + puts stderr "Compiler internal failure 5 -- code listing will not be complete" + return + } + incr idx 2 + increment_sync_map $idx 1 + + # Write the message + set lst [linsert $lst $idx EJECT] + } + + ## Directive "DB" + # @access public + # @parm Int idx - Source index + # @parm List values - Hexadecimal values (eg. '{FA 4 5 2D C'}) + # @return void + proc db {idx values} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Determinate original values + set sub_idx [getIdx $idx] + if {$sub_idx != {}} { + set new_values [lindex $lst [list $sub_idx 1]] + } { + set new_values {} + } + + # Adjust list of values + foreach val $values { + if {![string is digit -strict $val]} { + continue + } + set val [string trimleft $val 0] + if {$val == {}} { + set val {00} + } else { + set val [format %X $val] + if {[string length $val] == 1} { + set val "0$val" + } + } + append new_values $val + } + + # Set OP code for the current line + set_opcode $idx $new_values + } + + ## Expansion of macro instruction + # @access public + # @parm Int idx - Source index + # @parm String macro_code - Code of the macro instruction + # @return void + proc macro {idx macro_code} { + variable sync_map ;# Map of lines in code listing + variable tmp_lst ;# Tempotary LST code + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Create empty space in code listing + insert_lines $idx [llength $macro_code] + + # Determinate target index + set idx [getIdx $idx] + # Initialize auxiliary code listing list + set tmp_lst {} + + # Adjust Macro expansion level and Inclusion level + set IncLevel [lindex $lst "$idx 3"] + set MacLevel [lindex $lst "$idx 4"] + if {![regexp {^\d+$} $MacLevel]} { + puts stderr "Compiler internal failure 1 -- code listing will not be complete" + return + } + incr MacLevel + + # Adjust code of macro instruction + foreach line $macro_code { + lappend tmp_lst [list {} {} {} $IncLevel $MacLevel "\t\t$line"] + } + + # Set macro expansion level + lset lst "$idx 4" $MacLevel + + # Insert code of macro to the current code listing + incr idx + append tmp_lst { } + append tmp_lst [lrange $lst $idx end] + set lst [lreplace $lst $idx end] + + append lst { } + append lst $tmp_lst + set tmp_lst {} + } + + ## Adjust current code listing to the fiven code organization + # @access public + # @parm List organization - new organization (see Preprocessor) + # @return void + proc org {organization} { + variable sync_map ;# Map of lines in code listing + variable new_sync_map ;# Tempotary Map of lines in code listing + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Reformat synchronization map + set new_sync_map {} + foreach org $organization { + # Local variables + set start [lindex $org 0] ;# Start line + set end [lindex $org 1] ;# End line + + append new_sync_map { } + append new_sync_map [lrange $sync_map $start $end] + set sync_map [lreplace $sync_map $start $end] + } + if {$sync_map != {}} { + append new_sync_map { } + append new_sync_map $sync_map + } + + set sync_map $new_sync_map + } + + ## Set instruction OP code + # @access public + # @parm Int idx - Source index + # @parm String opcode - Haxadecimal OP code + # @return void + proc set_opcode {idx opcode} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust code listing + set idx [getIdx $idx] + + if {$idx == {}} {return} + if {[catch { + lset lst [list $idx 1] $opcode + }]} then { + puts stderr "Compiler internal failure 2 -- code listing will not be complete" + return + } + } + + ## Set instruction address + # @access public + # @parm Int idx - Source index + # @parm Int addr - Instruction address + # @return void + proc set_addr {idx addr} { + variable lst ;# Resulting LST code + variable sync_map ;# Map of lines in code listing + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust code listing + set idx [getIdx $idx] + if {$idx == {}} {return} + if {[catch { + lset lst "$idx 0" [get_4hex $addr] + }]} then { + puts stderr "Compiler internal failure 3 -- code listing will not be complete" + return + } + } + + ## Directive "END" + # @access public + # @parm Int idx - Source index + # @return void + proc end_directive {idx} { + variable sync_map ;# Map of lines in code listing + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Determinate target index + set lst_idx [getIdx $idx] + incr lst_idx + if {$lst_idx == {}} {return} + if {$lst_idx > ([llength $lst] - 1)} {return} + + # Adjust code listing and synchronization map + set lst [lreplace $lst $lst_idx end] + set sync_map [lreplace $sync_map $idx end] + } + + ## Set value for symbol definition + # @access public + # @parm Int idx - Source index + # @parm Int value - Symbol value + # @return void + proc set_value {idx value} { + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Determinate target index + set idx [getIdx $idx] + if {$idx == {}} {return} + + # Adjust code listing + lset lst "$idx 2" [get_4hex $value] + } + + ## Set value for special symbol definition + # @access public + # @parm Int idx - Source index + # @parm Int value - Symbol value + # @return void + proc set_spec_value {idx value} { + # This procedure does nothing and that's what is should do ... + } + + ## Directive "INCLUDE" + # @access public + # @parm Int idx - Source index + # @parm String data - Included source code + # @return void + proc include {idx data} { + variable tmp_lst ;# Tempotary LST code + variable lst ;# Resulting LST code + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Insert empty lines for the included code + insert_lines $idx [expr {[llength $data] - 1}] + + # Determinate target index + set idx [getIdx $idx] + + # Adjust macro expansion level and inclusion level + set IncLevel [lindex $lst "$idx 3"] + set MacLevel [lindex $lst "$idx 4"] + incr IncLevel + + # Adjust the given source code + set tmp_lst {} + foreach line $data { + lappend tmp_lst [list {} {} {} $IncLevel $MacLevel [lindex $line 2]] + } + + # Reformat code listing + incr idx + append tmp_lst { } + append tmp_lst [lrange $lst $idx end] + incr idx -1 + set lst [lreplace $lst $idx end] + append lst { } + append lst $tmp_lst + set tmp_lst {} + + } + + ## Line removed -- adjust synchronization map + # @access public + # @parm Int idx - source index + # @return void + proc delete_line {idx} { + variable sync_map ;# Map of lines in code listing + + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + # Adjust synchronization map + if {[catch { + set sync_map [lreplace $sync_map $idx $idx] + }]} { + puts stderr "Still unresolved compiler bug. I am sorry for that, code listing will not be complete. (As far as I know there is only one bug of that kind)" + } + } + + ## Adjust synchronization map to create spece which cannot contain anything + # @access public + # @parm Int dest_idx - Target index + # @parm Int len - Number of lines + # @return void + proc insert_empty_lines {dest_idx len} { + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + + variable sync_map ;# Map of lines in code listing + variable new_sync_map ;# Tempotary Map of lines in code listing + + # Abort if there s nothing to insert + if {$len == 0} {return} + + # Create $len empty items in sync map at index $dest_idx + set new_sync_map {} + set idx -1 + foreach item $sync_map { + incr idx + + lappend new_sync_map $item + if {$idx == $dest_idx} { + for {set i 0} {$i < $len} {incr i} { + lappend new_sync_map {} + } + } + } + + set sync_map $new_sync_map + } + + ## Free reserved resources + # @access public + # @return void + proc free_resources {} { + variable lst ;# Resulting LST code + set lst {} + } + + + # ---------------------------------------------------------------- + # INTERNAL AUXILIARY PROCEDURES + # ---------------------------------------------------------------- + + ## Reformat internal listing to human readable text + # @access private + # @return void + proc format_listing {} { + variable header ;# Title string + variable pageNum ;# Page number + variable pageLines ;# Number of lines at the current page + variable lst ;# Resulting LST code + variable Enabled ;# Bool: LIST/NOLIST flag + + # Write page header + set result $header + append result { } $pageNum "\n" + + # Initialize variables + set pageLines 0 + set lineNum 0 + + # Reformat code + foreach line $lst { + incr lineNum + + # Take case of directives "LIST" and "NOLIST" + if {$line == {NOLIST}} { + set Enabled 0 + incr lineNum -1 + continue + } elseif {$line == {LIST}} { + set Enabled 1 + incr lineNum -1 + continue + } + + # Skip line if listing is disabled + if {!$Enabled} { + continue + } + + # Create new page if paging is enabled + if {${Compiler::Settings::PAGING}} { + incr pageLines + if {$pageLines > ${Compiler::Settings::PAGELENGTH}} { + incr pageNum + set pageLines 1 + append result "\n\f" $header { } $pageNum "\n\n" + } + } + + + # Directive "$EJECT" + if {[lindex $line 0] == {EJECT}} { + incr pageNum + set pageLines 1 + append result "\n\f" $header { } $pageNum "\n\n" + incr lineNum -1 + + # Line containing an error message + } elseif {[lindex $line 0] == {****}} { + append result "****" [lindex $line 1] "\n" + incr lineNum -1 + + # Normal line + } { + # Local variables + set addr [lindex $line 0] ;# Address field + set opcode [lindex $line 1] ;# Instruction OP code + set value [lindex $line 2] ;# Value of defined constant + set IncLevel [lindex $line 3] ;# Inclusion level + set MacLevel [lindex $line 4] ;# Macro expansion level + set code [lindex $line 5] ;# Source code + + # Adjust inclusion level + if {$IncLevel == 0} { + set IncLevel { } + } { + set IncLevel "=$IncLevel" + if {[string length $IncLevel] == 2} { + append IncLevel { } + } + } + + # Adjust macro expansion level + if {$MacLevel == 0} { + set MacLevel { } + } { + set MacLevel "+$MacLevel" + if {[string length $MacLevel] == 2} { + append MacLevel { } + } + } + + # Adjust line number + set line_number $lineNum + set len [string length $line_number] + if {$len < 5} { + set line_number "[string repeat { } [expr {5 - $len}]]$line_number" + } + + ## Create filed 0 (address + OP code // constant value) + set field0 {} + + # Adjust opcode length (for continuation on the next line) + set opcode_len [string length $opcode] + if {$opcode_len > 10} { + set opcode_continue [string replace $opcode 0 9] + set opcode [string range $opcode 0 9] + } + + # Only constant value + if {$value != {}} { + append field0 { } $value { } + # Address + OP code + } elseif {($opcode != {}) && ($addr != {})} { + if {$opcode_len < 10} { + append opcode [string repeat { } [expr {10 - $opcode_len}]] + } + append field0 $addr { } $opcode { } + # Empty + } else { + set field0 [string repeat { } 16] + } + + # Composite final line + set line {} + append line $field0 { } $IncLevel { } $line_number + append line { } $MacLevel { } [tabs2spaces $code] + append result [string range $line 0 [expr ${Compiler::Settings::PAGEWIDTH} - 1]] "\n" + + # Continue in unfinished opcode + if {$opcode_len > 10} { + incr opcode_len -10 + for {set i 0; set j 9} {$i < $opcode_len} {incr i 10; incr j 10} { + append result { } [string range $opcode_continue $i $j] "\n" + } + } + } + } + + # Restore characters '{' and '}' + regsub -all {\a} $result "\{" result + regsub -all {\b} $result "\}" result + # Remove redutant white space + set lst [regsub -all -line {\s+$} $result {}] + } + + ## Convert tabulators to spaces + # @access private + # @parm String data - input data + # @return String - output data + proc tabs2spaces {data} { + set tmp {} ;# Auxiliary variable + while 1 { + # Search for 1st tabulator + set idx [string first "\t" $data] + + # Tabulator not found -> return result + if {$idx == -1} { + return $data + # 1st char + } elseif {$idx == 0} { + regsub {\t} $data { } data + # Somewhere else + } else { + # Determinate string before tabulator + incr idx -1 + set tmp [string range $data 0 $idx] + # Determinate string after tabulator + incr idx 2 + set data [string range $data $idx end] + # Determinate number of spaces + set len [string length $tmp] + set len [expr {8 - ($len % 8)}] + # Recomposite source string + append tmp [string repeat { } $len] + append tmp $data + set data $tmp + } + } + } + + ## Create string containing error summary + # Modifies content of variables: + # - error_summary + # - errors_count + # - warnings_count + # @access private + # @return void + proc create_error_summary {} { + variable lst ;# Resulting LST code + variable error_summary ;# Error summmary string + variable errors_count ;# Number of errors + variable warnings_count ;# Number of warnings + variable header ;# Title string + variable pageNum ;# Page number + variable pageLines ;# Number of lines at the current page + + # Reset error counters + set errors_count 0 + set warnings_count 0 + # Initialize resulting string + set error_summary {} + + # Create new page + if {${Compiler::Settings::PAGING}} { + incr pageNum + set pageLines 0 + append error_summary "\n\f" $header { } $pageNum "\n\n" + } + + append error_summary {ERROR SUMMARY:} + + # Search code for errors and warnings + set lineNum -1 + foreach line $lst { + incr lineNum + + # Create new page if nessesary + if {${Compiler::Settings::PAGING}} { + incr pageLines + + if {$pageLines > ${Compiler::Settings::PAGEWIDTH}} { + incr pageNum + set pageLines 1 + append error_summary "\n\f" $header { } $pageNum "\n\n" + } + } + + # Error/Warning found + if {[lindex $line 0] == {****}} { + + if {[lindex $line {1 0}] == {ERROR:}} { + incr errors_count + } { + incr warnings_count + } + + # Append error/warning information + append error_summary "\n" Line { } $lineNum {, } [lindex $line 1] + } + } + } + + ## Create table of symbolic names + # Result is stored in variable symbol_table + # @access private + # @return void + proc create_symbol_table {} { + variable symbol_table ;# Table of symbolic names + variable header ;# Title string + variable pageNum ;# Page number + variable pageLines ;# Number of lines at the current page + + # Initialize resulting string + set result {} + + # Create new page + if {${Compiler::Settings::PAGING}} { + incr pageNum + set pageLines 0 + append result "\n\f" $header { } $pageNum "\n\n" + } + append result {SYMBOL TABLE:} + + # Create string for paddings + set padding [string repeat { .} 18] + + # Convert current table to human readable string + foreach var $symbol_table { + + # Create new page if nessesary + if {${Compiler::Settings::PAGING}} { + incr pageLines + + if {$pageLines > ${Compiler::Settings::PAGEWIDTH}} { + incr pageNum + set pageLines 1 + append result "\n\f" $header { } $pageNum "\n\n" + } + } + + # Local variables + set rd [lindex $var 5] ;# Bool: redefinable + set nu [lindex $var 4] ;# Bool: not used + set val [lindex $var 3] ;# Value + set name [lindex $var 0] ;# Symbolic name + ## Type + # NUMB == number + # ADDR == address + # SPEC == special value + set type [lindex $var 2] + ## Character + # C == code + # D == data + # B == bit + # X == external + # S == special value + set char [lindex $var 1] + + # Adjust rd + if {$rd == 1} { + set rd {REDEFINABLE} + } { + set rd {} + } + + # Adjust nu + if {$nu == 1} { + set nu {NOT USED} + } { + set nu { } + } + + # Adjuts symbolic name + set len [string length $name] + incr len -1 + set name [string replace $padding 0 $len $name] + + # Composite final line + if {$char != {S}} { + set h {H} + } { + set nu { } + set h [string repeat { } [expr {5 - [string length $val]}]] + } + append result "\n" $name { } $char { } $type { } $val $h { } $nu { } $rd + } + append result "\n" + + # Remove all redutant white space + regsub -all -line {\s+$} $result {} symbol_table + } + + ## Increment values in synchronization map + # @access private + # @parm Int idx - Index where incrementation begins + # @parm Int value - Value to increment by + # @return void + proc increment_sync_map {idx value} { + variable sync_map ;# Map of lines in code listing + variable new_sync_map ;# Tempotary Map of lines in code listing + + set new_sync_map {} + foreach item $sync_map { + if {$item >= $idx} { + if {$item != {}} { + incr item $value + } + } + lappend new_sync_map $item + } + set sync_map $new_sync_map + } + + ## Convert decimal value to four digit hexadecimal value + # @access private + # @parm Int number - number to convert + # @return String - result + proc get_4hex {number} { + # Convert value + set number [format %X $number] + # Adjust length + set len [string length $number] + if {$len < 4} { + set number "[string repeat 0 [expr {4 - $len}]]$number" + } + # Return result + return $number + } + + ## Translate source index to target index acording to synchronization map + # @access private + # @parm Int idx - Source index + # @return Int - target index + proc getIdx {idx} { + variable sync_map ;# Map of lines in code listing + + set result [lindex $sync_map $idx] + if {$result == {}} { + set result 0 + } + return $result + } + + ## Adjust synchronization map to create empty space to insert something + # @access private + # @parm Int dest_idx - Target index + # @parm Int len - Number of lines + # @return void + proc insert_lines {dest_idx len} { + # Check if code listing is enabled + if {!${Compiler::Settings::PRINT}} {return} + if {$len == 0} {return} + + variable sync_map ;# Map of lines in code listing + variable new_sync_map ;# Tempotary Map of lines in code listing + + # Adjust synchronization map + set dest_item [lindex $sync_map $dest_idx] + if {$dest_item == {}} { + set dest_item 0 + } + set new_sync_map {} + set idx -1 + foreach item $sync_map { + incr idx + + # Taget index + if {$idx == $dest_idx} { + if {$item == {}} { + continue + } + set tmp [expr {$len + $item}] + while {$item <= $tmp} { + lappend new_sync_map $item + incr item + } + + # Empty index or too low index to be changed + } elseif {$item == {} || $item < $dest_item} { + lappend new_sync_map $item + + # Index somewhere in the affected area + } else { + incr item $len + lappend new_sync_map $item + } + } + + set sync_map $new_sync_map + } +} -- cgit v1.2.3