diff options
| author | Andrej Shadura <andrewsh@debian.org> | 2018-05-08 15:59:31 +0200 |
|---|---|---|
| committer | Andrej Shadura <andrewsh@debian.org> | 2018-05-08 15:59:31 +0200 |
| commit | 47aa8b00b2b11df13a100489e0f904a4947177ef (patch) | |
| tree | b35c9acc778ea2f761f3c549f7bee2f4491b3144 /lib/compiler/preprocessor.tcl | |
| parent | 5b8466f7fae0e071c0f4eda13051c93313910028 (diff) | |
Import Upstream version 1.4.7
Diffstat (limited to 'lib/compiler/preprocessor.tcl')
| -rw-r--r--[-rwxr-xr-x] | lib/compiler/preprocessor.tcl | 1564 |
1 files changed, 910 insertions, 654 deletions
diff --git a/lib/compiler/preprocessor.tcl b/lib/compiler/preprocessor.tcl index 4fca542..d4429ea 100755..100644 --- a/lib/compiler/preprocessor.tcl +++ b/lib/compiler/preprocessor.tcl @@ -2,7 +2,7 @@ # Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) ############################################################################ -# Copyright (C) 2007-2009 by Martin Ošmera # +# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # This program is free software; you can redistribute it and#or modify # @@ -21,6 +21,11 @@ # 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # ############################################################################ +# >>> File inclusion guard +if { ! [ info exists _PREPROCESSOR_TCL ] } { +set _PREPROCESSOR_TCL _ +# <<< File inclusion guard + # -------------------------------------------------------------------------- # DESCRIPTION # 8051 Assembly language compiler preprocessor. This code is part of Compiler @@ -34,11 +39,11 @@ # # Basic principle of operation: # 1) Remove comments and include files -# 2) Process controll sequences ($SOMETHING) +# 2) Process control sequences ($SOMETHING) # 3) Define as much constants/variables as possible (with cross references) # 4) Conditional compilation and directive USING # 5) Define macro instructions -# 6) Recomposite code acording to ORG directives +# 6) Recomposite code according to ORG directives # 7) Expand macro instructions (recursive with cross references) # 8) Final stage # @@ -52,29 +57,30 @@ namespace eval PreProcessor { ## General - variable asm {} ;# Resulting precompiled code - variable tmp_asm {} ;# Tempotary auxiliary precompiled code + variable asm {} ;# Resulting pre-compiled code + variable tmp_asm {} ;# Temporary auxiliary pre-compiled code variable lineNum 0 ;# Number of the current line variable fileNum 0 ;# Number of the current file variable program_memory ;# String of booleans: Map of program memory usage variable idx 0 ;# Current position in asm list - variable optims 0 ;# Number of performed optimalizations + variable optims 0 ;# Number of performed optimizations variable macros_first 1 ;# Bool: Define and expand macro instruction before conditional ;#+ assembly and constants expansions ## Errors and warnings - variable ErrorAtLine 0 ;# Bool: Error occured on the current line - variable Error 0 ;# Bool: An error occured during precompilation - variable error_count 0 ;# Number of errors occured - variable warning_count 0 ;# Number of warnings occured + variable ErrorAtLine 0 ;# Bool: Error occurred on the current line + variable Error 0 ;# Bool: An error occurred during precompilation + variable error_count 0 ;# Number of errors occurred + variable warning_count 0 ;# Number of warnings occurred ## Conditional compilation variable Enable 1 ;# Bool: Compilation enabled (conditional compilation) variable IfElse_map ;# Array: Conditional compilation map ($IfElse_map($level) == $bool) + variable IfElse_pcam ;# Array: Conditional compilation -- Positive condition already met ($IfElse_pcam($level) == $bool) variable IfElse_level 0 ;# Current level of conditional compilation evaluation ## Memory reservation - variable selected_segment cseg ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) + variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) variable memory_reservation_map ;# Array: memory reservation map (see code) variable segment_pointer ;# Current memory segment pointer @@ -112,12 +118,13 @@ namespace eval PreProcessor { ## Macro expansion variable macro ;# Array: Code of defined macro instructions variable defined_MACRO {} ;# List of defined macro instructions + variable local_M_labels ;# Array of lists: Local labels in macros $local_M_labels($macro_name) == {integer label0 ... labelN} variable macro_name_to_append ;# Name of currently defined macro instruction ## Special variables variable original_expression ;# Auxiliary variable (see proc. 'ComputeExpr') variable tmp ;# General purpose tempotary variable - variable DB_asm {} ;# Tempotary asm code for creating code memory tables + variable DB_asm {} ;# Temporary asm code for creating code memory tables variable included_files {} ;# List: Unique unsorted list of included files variable working_dir {} ;# String: Current working directory variable origin_d_addr {} ;# List: Addresses of static program blocks @@ -126,7 +133,7 @@ namespace eval PreProcessor { variable max_include_level 8 ;# Maximum inclusion level variable max_macro_level 8 ;# Maximum macro expansion level variable check_sfr_usage 0 ;# Bool: Check for legal usage of SFR and SFB - variable avaliable_SFR {} ;# List: Avaliable SFR and SFB on the target MCU + variable available_SFR {} ;# List: Available SFR and SFB on the target MCU # ---------------------------------------------------------------- @@ -143,13 +150,13 @@ namespace eval PreProcessor { ;#+ assembly and constants expansions variable memory_reservation_map ;# Array: memory reservation map (see code) variable working_dir ;# String: Current working directory - variable asm ;# Resulting precompiled code + variable asm ;# Resulting pre-compiled code variable segment_pointer ;# Current memory segment pointer - variable error_count ;# Number of errors occured - variable warning_count ;# Number of warnings occured + variable error_count ;# Number of errors occurred + variable warning_count ;# Number of warnings occurred variable max_include_level ;# Maximum inclusion level variable max_macro_level ;# Maximum macro expansion level - variable optims ;# Number of performed optimalizations + variable optims ;# Number of performed optimizations variable included_files ;# List: Unique unsorted list of included files variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) variable const_EQU ;# Array: Constants defined by directive 'EQU' @@ -169,11 +176,11 @@ namespace eval PreProcessor { set memory_reservation_map(xseg) [ string repeat 0 65536] # Set constants "??MCU_8051_IDE" and "??VERSION" - lappend defined_EQU {??MCU_8051_IDE} {??VERSION} - set const_EQU(??MCU_8051_IDE) 32849 + lappend defined_EQU {??mcu_8051_ide} {??version} + set const_EQU(??mcu_8051_ide) 32849 ;# 8051h scan $::VERSION "%d.%d.%d" i j k set i [expr {($i << 8) + ($j << 4) + $k}] - set const_EQU(??VERSION) $i + set const_EQU(??version) $i # Reset counters of errors and warnings set error_count 0 @@ -183,11 +190,7 @@ namespace eval PreProcessor { set working_dir $current_dir set included_files [list [file normalize [file join $current_dir $filename]]] - # Message "formating code ..." set asm $data - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tPreformating code ..."] - } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -201,10 +204,6 @@ namespace eval PreProcessor { # } line_numbers - # Message "include ..." - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tPutting program pieces together ..."] - } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -213,7 +212,7 @@ namespace eval PreProcessor { # Import code pieces (INCLUDE file.asm // $INCLUDE('file.inc')) set counter 0 - while 1 { + while {1} { if {![include_directive $current_dir]} {break} incr counter if {$counter > $max_include_level} { @@ -225,10 +224,6 @@ namespace eval PreProcessor { # Remove code after END directive end_of_code - # Message "encapsulating code ..." - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tEncapsulating code ..."] - } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -261,11 +256,6 @@ namespace eval PreProcessor { define_basic_symbolic_names } - # Message "Parsing constants, macros etc." - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tParsing constants, macros, etc. ..."] - } - if {$macros_first} { # Define macro instructions define_macro_instructions @@ -277,7 +267,7 @@ namespace eval PreProcessor { # Expand macro instructions set counter 0 - while 1 { + while {1} { if {![expand_macro_instructions]} {break} incr counter if {$counter > $max_macro_level} { @@ -299,21 +289,20 @@ namespace eval PreProcessor { # - Data memory segment selection (BSEG, DSEG, ISEG, XSEG) (group 3) # - Constant definitions (SET, EQU, BIT, DATA, IDATA, XDATA) (group 4) # - Date memory reservation (DS, DBIT) (group 5) - while 1 { + while {1} { if {![parse_Consts_and_ConditionalCompilation {0 0 1 1 1 1} 1]} { break } } - parse_Consts_and_ConditionalCompilation {1 1 1 1 1 1} 1 - set selected_segment cseg + parse_Consts_and_ConditionalCompilation {1 1 1 1 1 1} 1 if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources return } - # Parse code memory segmentation (CSEG DB DW) + # Process code memory related directives (CSEG DB DW) code_segment 1 if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] @@ -331,7 +320,7 @@ namespace eval PreProcessor { } } - # Reassemble code acording to ORG directives + # Reassemble code according to ORG directives origin_directive if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] @@ -339,15 +328,10 @@ namespace eval PreProcessor { return } - # Message "Expanding macros" - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tExpanding macros ..."] - } - if {!$macros_first} { # Expand macro instructions set counter 0 - while 1 { + while {1} { if {![expand_macro_instructions]} {break} incr counter if {$counter > $max_macro_level} { @@ -362,11 +346,6 @@ namespace eval PreProcessor { } } - # Message "Final stage" - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tFinal stage ..."] - } - ## Do three things: # * Convert code to this format: # { @@ -379,18 +358,14 @@ namespace eval PreProcessor { # * Create map of program memory usage (bitmap) parse_instructions - # Perform code optimalizations + # Perform code optimizations set optims 0 if {${::Compiler::Settings::optim_ena}} { - # Message "Optimalizations" - if {!${::Compiler::Settings::QUIET}} { - ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "\tOptimalizations ..."] - } - optimalization + optimization } # Final constants expansion - while 1 { + while {1} { if {![parse_Consts_and_ConditionalCompilation {0 0 1 1 1 1} 0]} { break } @@ -434,6 +409,7 @@ namespace eval PreProcessor { variable const_SET ;# Array: Constants defined by directive 'CODE' variable const_EQU ;# Array: Constants defined by directive 'EQU' variable macro ;# Array: Code of defined macro instructions + variable local_M_labels ;# Array of lists: Local labels in macros $local_M_labels($macro_name) == {integer label0 ... labelN} variable program_memory ;# String of booleans: Map of program memory usage variable labels ;# Array: Values of defined labels ($labels($label) == $address) variable defined_BIT {} ;# List of defined bits (directove 'BIT') @@ -449,6 +425,7 @@ namespace eval PreProcessor { variable defined_MACRO {} ;# List of defined macro instructions catch {unset macro} + catch {unset local_M_labels} catch {unset memory_reservation_map} catch {unset segment_pointer} catch {unset const_BIT} @@ -469,7 +446,7 @@ namespace eval PreProcessor { # INTERNAL AUXILIARY PROCEDURES # ---------------------------------------------------------------- - ## Define basic symbolic names acording to MapOfSFRArea, MapOfSFRBitArea and progVectors + ## Define basic symbolic names according to MapOfSFRArea, MapOfSFRBitArea and progVectors # @return void proc define_basic_symbolic_names {} { variable const_BIT ;# Array: Bit values -- ($const_BIT($bit_name) == $value) @@ -480,7 +457,7 @@ namespace eval PreProcessor { variable defined_CODE ;# List of constants defined by 'CODE' # Define bits - foreach def ${CompilerConsts::MapOfSFRBitArea} { + foreach def ${::CompilerConsts::MapOfSFRBitArea} { set var [lindex $def 0] ;# Name set val [lindex $def 1] ;# Address # Adjust name @@ -491,7 +468,7 @@ namespace eval PreProcessor { } # Define registers - foreach def ${CompilerConsts::MapOfSFRArea} { + foreach def ${::CompilerConsts::MapOfSFRArea} { set var [lindex $def 0] ;# Name set val [lindex $def 1] ;# Address # Adjust name @@ -502,7 +479,7 @@ namespace eval PreProcessor { } # Define Program vectors - foreach def ${CompilerConsts::progVectors} { + foreach def ${::CompilerConsts::progVectors} { set var [lindex $def 0] ;# Name set val [lindex $def 1] ;# Address # Adjust name @@ -528,7 +505,7 @@ namespace eval PreProcessor { if {[regexp {^\w+} $data control]} { regsub {^\w+} $data {} data set control [string tolower $control] - } { + } else { set control {} } @@ -548,12 +525,12 @@ namespace eval PreProcessor { if {[string index $argument 0] == {'}} { if {[string index $argument end] != {'}} { SyntaxError $lineNum $fileNum [mc "Invalid argument: %s" $argument] - } { + } else { set argument [string trimleft $argument {'}] set argument [string trimright $argument {'}] } } - } { + } else { set argument {} } @@ -572,20 +549,20 @@ namespace eval PreProcessor { # @parm String setting - Target configuration variable # @parm String value - New configuration value # @return Bool - One if setting was accepted, zero if setting was dismissed - proc AssemlerContol {condition setting value} { + proc AssemblerContol {condition setting value} { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file # Determinate condition value - set condition [subst "\${::Compiler::Settings::$condition}"] + set condition [subst -nocommands "\${::Compiler::Settings::$condition}"] # Accept if {$condition == 0} { set Compiler::Settings::$setting $value return 1 # Dismiss - } { - Notice $lineNum $fileNum [mc "Control %s has been overrriden (by compiler settings)" $setting] + } else { + Notice $lineNum $fileNum [mc "Control %s has been overridden (by compiler settings)" $setting] return 0 } } @@ -594,7 +571,7 @@ namespace eval PreProcessor { # @parm String control - Control sequence (name only) # @parm String argument - Argument (without parantesis and quotes) # @return Bool - result (1 == success; 0 == error message) - proc AssemlerContol_expect_one_argument {control argument} { + proc AssemblerContol_expect_one_argument {control argument} { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file @@ -610,7 +587,7 @@ namespace eval PreProcessor { # @parm String control - Control sequence (name only) # @parm String argument - Argument (without parantesis and quotes) # @return Bool - result (1 == success; 0 == error message) - proc AssemlerContol_expect_no_argument {control argument} { + proc AssemblerContol_expect_no_argument {control argument} { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file @@ -624,8 +601,8 @@ namespace eval PreProcessor { ## Evaluate and remove control sequences # @return void proc parse_controls {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -642,7 +619,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -669,178 +648,178 @@ namespace eval PreProcessor { set control [lindex $ctrl 0] ;# Name set argument [lindex $ctrl 1] ;# Argument - # Adjust compiler settings acording to the control sequence + # Adjust compiler settings according to the control sequence switch -- $control { {nomacrosfirst} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { set macros_first 0 } } {eject} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_eject $idx } } {ej} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_eject $idx } } {nolist} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_nolist $idx } } {noli} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_nolist $idx } } {list} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_list $idx } } {li} { - if {[AssemlerContol_expect_no_argument $control $argument]} { + if {[AssemblerContol_expect_no_argument $control $argument]} { CodeListing::directive_list $idx } } {nomod} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _nomod NOMOD 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _nomod NOMOD 1 } } {nomod51} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _nomod NOMOD 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _nomod NOMOD 1 } } {nomo} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _nomod NOMOD 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _nomod NOMOD 1 } } {paging} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _paging PAGING 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _paging PAGING 1 } } {pi} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _paging PAGING 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _paging PAGING 1 } } {nopaging} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _paging PAGING 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _paging PAGING 0 } } {nopi} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _paging PAGING 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _paging PAGING 0 } } {pagewidth} { - if {[AssemlerContol_expect_one_argument $control $argument]} { + if {[AssemblerContol_expect_one_argument $control $argument]} { if {[regexp {^\d+$} $argument]} { - AssemlerContol _pagewidth PAGEWIDTH $argument - } { + AssemblerContol _pagewidth PAGEWIDTH $argument + } else { SyntaxError $lineNum $fileNum \ [mc "Invalid argument (must be integer): %s" $argument] } } } {pw} { - if {[AssemlerContol_expect_one_argument $control $argument]} { + if {[AssemblerContol_expect_one_argument $control $argument]} { if {[regexp {^\d+$} $argument]} { - AssemlerContol _pagewidth PAGEWIDTH $argument - } { + AssemblerContol _pagewidth PAGEWIDTH $argument + } else { SyntaxError $lineNum $fileNum \ [mc "Invalid argument (must be integer): %s" $argument] } } } {pagelength} { - if {[AssemlerContol_expect_one_argument $control $argument]} { + if {[AssemblerContol_expect_one_argument $control $argument]} { if {[regexp {^\d+$} $argument]} { - AssemlerContol _pagelength PAGELENGTH $argument - } { + AssemblerContol _pagelength PAGELENGTH $argument + } else { SyntaxError $lineNum $fileNum \ [mc "Invalid argument (must be integer): %s" $argument] } } } {pl} { - if {[AssemlerContol_expect_one_argument $control $argument]} { + if {[AssemblerContol_expect_one_argument $control $argument]} { if {[regexp {^\d+$} $argument]} { - AssemlerContol _pagelength PAGELENGTH $argument - } { + AssemblerContol _pagelength PAGELENGTH $argument + } else { SyntaxError $lineNum $fileNum \ [mc "Invalid argument (must be integer): %s" $argument] } } } {title} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _title TITLE $argument + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _title TITLE $argument } } {tt} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _title TITLE $argument + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _title TITLE $argument } } {date} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _date DATE $argument + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _date DATE $argument } } {da} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _date DATE $argument + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _date DATE $argument } } {object} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _object OBJECT_FILE $argument - AssemlerContol _object OBJECT 1 + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _object OBJECT_FILE $argument + AssemblerContol _object OBJECT 1 } } {noobject} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _object OBJECT 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _object OBJECT 0 } } {nosb} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _symbols SYMBOLS 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _symbols SYMBOLS 0 } } {nosymbols} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _symbols SYMBOLS 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _symbols SYMBOLS 0 } } {noprint} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _print PRINT 0 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _print PRINT 0 } } {symbols} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _symbols SYMBOLS 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _symbols SYMBOLS 1 } } {sb} { - if {[AssemlerContol_expect_no_argument $control $argument]} { - AssemlerContol _symbols SYMBOLS 1 + if {[AssemblerContol_expect_no_argument $control $argument]} { + AssemblerContol _symbols SYMBOLS 1 } } {print} { - if {[AssemlerContol_expect_one_argument $control $argument]} { - AssemlerContol _print PRINT_FILE $argument - AssemlerContol _print PRINT 1 + if {[AssemblerContol_expect_one_argument $control $argument]} { + AssemblerContol _print PRINT_FILE $argument + AssemblerContol _print PRINT 1 } } default { @@ -858,20 +837,19 @@ namespace eval PreProcessor { # @parm Bool ignore_undefined - Ignore undefined symbolic names # @return void proc code_segment {ignore_undefined} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) variable segment_pointer ;# Current memory segment pointer - variable DB_asm ;# Tempotary asm code for creating code memory tables variable idx ;# Current position in asm list # Reset NS variables - set DB_asm {} - set value {} set tmp_asm {} set segment_pointer(cseg) {} + + set value {} set idx -1 # Iterate over the code @@ -879,7 +857,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -909,32 +889,41 @@ namespace eval PreProcessor { # Directive 'CSEG' - code segment selection } elseif {$directive == {cseg}} { + set discontinue 0 - # Check if there is no label + # Check if there is a label if {[lindex $cmd 0] != {}} { SyntaxError $lineNum $fileNum [mc "CSEG cannot take any label: %s" [lindex $cmd 0]] - continue + set discontinue 1 } - # Select code segment - set selected_segment {cseg} + if {!$discontinue} { + # Set the code segment + set selected_segment {cseg} - # Remove this line from the code listing - CodeListing::delete_line $idx + # Check for presence of an address expression + set expr [lindex $cmd 2] + if {$expr == {}} { + set segment_pointer(cseg) {} + set discontinue 1 + } - # Check for presence of address expression - set expr [lindex $cmd 2] - if {$expr == {}} { - set segment_pointer(cseg) {} - continue + if {!$discontinue} { + # Check for presence of 'AT' operator (CSEG AT addr) + if {[string tolower [lindex $expr 0]] != {at}} { + SyntaxError $lineNum $fileNum [mc "Missing `AT' operator"] + set discontinue 1 + } + set expr [lreplace $expr 0 0] + } } - # Check for presence of 'AT' operator (CSEG AT addr) - if {[string tolower [lindex $expr 0]] != {at}} { - SyntaxError $lineNum $fileNum [mc "Missing `AT' operator"] + # Remove this line from the code listing + if {$discontinue} { + CodeListing::delete_line $idx + incr idx -1 continue } - set expr [lreplace $expr 0 0] # Determinate, set and validate segment pointer set value [ComputeExpr $expr] @@ -947,9 +936,11 @@ namespace eval PreProcessor { # Set pointer set segment_pointer(cseg) $value # Adjust code - lappend DB_asm [list $lineNum [list {ORG} $value]] - } { + lappend tmp_asm [list $lineNum $fileNum [list {ORG} $value]] + } else { SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $expr] + CodeListing::delete_line $idx + incr idx -1 } # Line does not contain any of {CSEG DB DW} @@ -960,13 +951,12 @@ namespace eval PreProcessor { # Finalize code adjustment append tmp_asm { } - append tmp_asm $DB_asm set asm $tmp_asm } ## Reserve code memory (byte or word) -- directives 'DB' 'DW' # -- auxiliary procedure for proc. 'code_segment' - # This procedure writes result to NS variable 'DB_asm' or 'tmp_asm' + # This procedure writes result to NS variable 'tmp_asm' # @parm String cmd - Line of source code adjusted by proc. 'split_line' # @parm String directive - Directive name (one of {DB DW}) # @parm String idx - Source index (precompiled code list) @@ -977,8 +967,7 @@ namespace eval PreProcessor { variable fileNum ;# Number of the current file variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) variable segment_pointer ;# Current memory segment pointer - variable DB_asm ;# Tempotary asm code for creating code memory tables - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code # Determinate maximum value if {$directive == {db}} { @@ -987,7 +976,7 @@ namespace eval PreProcessor { } elseif {$directive == {dw}} { set directive_db 0 set max 65535 - } { + } else { CompilationError $lineNum $fileNum "Unknown error 7" return } @@ -1023,9 +1012,11 @@ namespace eval PreProcessor { # Iterate over directive operands set first_time 1 set undefined 0 + set total_len 0 foreach opr $operands { set undefined 0 set len -1 + # Operand is a string if {![isExpression $opr] && ([string index $opr 0] == {'}) && ([string index $opr end] == {'})} { # Adjust operand @@ -1052,33 +1043,27 @@ namespace eval PreProcessor { continue # Valid value - } { + } else { if {$first_time} { set line [list [list $lineNum $fileNum "${label}DB $value"]] - } { + } else { set line [list [list $lineNum $fileNum [list DB $value]]] } set first_time 0 lappend values $value } - # Adjust precompiled code - if {$segment_pointer(cseg) != {}} { - append DB_asm { } - append DB_asm $line - } { - append tmp_asm { } - append tmp_asm $line - } incr len + + # Adjust precompiled code + append tmp_asm { } + append tmp_asm $line } # Adjust code listing CodeListing::db $idx $values CodeListing::insert_empty_lines $idx $len - incr idx $len - # Operand is a direct numerical value, expression, constant, label or variable } else { @@ -1093,7 +1078,7 @@ namespace eval PreProcessor { set value $opr # Invalid value - } { + } else { CompilationError $lineNum $fileNum [mc "Invalid expression `%s'" $opr] continue } @@ -1116,20 +1101,23 @@ namespace eval PreProcessor { if {$directive_db} { if {$first_time} { set line [list [list $lineNum $fileNum "${label}DB $value"]] - } { + } else { set line [list [list $lineNum $fileNum [list DB $value]]] } - CodeListing::db $idx $value + incr len set first_time 0 + # Adjust code listing + CodeListing::db $idx $value + # Two bytes (directive DW) - } { + } else { # Spilt value into high- and low-order bytes if {$undefined} { set H_value "(($value) / 256)" set L_value "(($value) % 256)" - } { + } else { set H_value [expr {$value / 256}] set L_value [expr {$value % 256}] } @@ -1138,35 +1126,34 @@ namespace eval PreProcessor { [list $lineNum $fileNum "${label}DB {$H_value}"]\ [list $lineNum $fileNum [list {DB} $L_value]] \ ] - } { + } else { set line [list \ [list $lineNum $fileNum [list {DB} $H_value]] \ [list $lineNum $fileNum [list {DB} $L_value]] \ ] } + + incr len 2 set first_time 0 # Adjust code listing CodeListing::db $idx [list $H_value $L_value] CodeListing::insert_empty_lines $idx 1 - - incr len 2 - incr idx $len } # Adjust precompiled code - if {$segment_pointer(cseg) != {}} { - append DB_asm { } - append DB_asm $line - } { - append tmp_asm { } - append tmp_asm $line - } + append tmp_asm { } + append tmp_asm $line } + + incr len + incr total_len $len } CodeListing::insert_empty_lines $idx [expr {[llength $operands] - 1}] - return $len + + incr total_len -1 + return $total_len } ## Split the given line of code into label, command and argumet(s) @@ -1176,7 +1163,7 @@ namespace eval PreProcessor { # Determinate label if {[regexp {^\w+:} $line label]} { regsub {^\w+:\s*} $line {} line - } { + } else { set label {} } # If line contains only label -> return only label @@ -1187,7 +1174,7 @@ namespace eval PreProcessor { # Determinate command and argumet(s) if {![regexp {^\s*\.?\w+} $line command]} { set command {} - } { + } else { set command [string tolower [string trim $command]] } set argument [regsub {^[^\s]+\s*} $line {}] @@ -1212,7 +1199,7 @@ namespace eval PreProcessor { if {$instruction == {db}} { set new_operands $operands set operands {} - } { + } else { set new_operands {} } @@ -1221,6 +1208,7 @@ namespace eval PreProcessor { # Fixed value (eg. 'A') if {[isFixed $opr]} { + set char {} set opr_val $opr # Regular value @@ -1229,14 +1217,14 @@ namespace eval PreProcessor { set char [string index $opr 0] if {$char == {#} || $char == {@} || $char == {/}} { set opr [string replace $opr 0 0] - } { + } else { set char {} } - set opr_val $char + set opr_val {} # Value is an expression if {[isExpression $opr]} { - append opr_val [ComputeExpr $opr {} $address] + append opr_val [ComputeExpr $opr $ignore_undefined $address] # Value is bit addres represented by dot notation } elseif {[regexp {^\w+\.\w+$} $opr]} { @@ -1245,7 +1233,7 @@ namespace eval PreProcessor { if {!$ignore_undefined} { SyntaxError $lineNum $fileNum [mc "Expected bit address: %s" $opr] } - } { + } else { set bitAddr [getBitAddr $opr $ignore_undefined] if {$bitAddr == {}} {set bitAddr 0} append opr_val $bitAddr @@ -1282,33 +1270,44 @@ namespace eval PreProcessor { } # Adjust relative offset - if {[string is digit -strict $opr_val] && $type == {code8}} { - incr opr_val -$address - incr opr_val -$instr_lenght - if {($opr_val > 127) || ($opr_val < -128)} { - incr opr_val -0x10000 + if {[string is digit -strict $opr_val]} { + if {$type == {code8}} { + incr opr_val -$address + incr opr_val -$instr_lenght if {($opr_val > 127) || ($opr_val < -128)} { + incr opr_val -0x10000 + if {($opr_val > 127) || ($opr_val < -128)} { + if {!$ignore_undefined} { + SyntaxError $lineNum $fileNum \ + [mc "Label is too far for 8-bit relative addressing.\nTry to disable peephole optimizations if they are on."] + } + set opr_val 0 + } + } + if {$opr_val < 0} { + incr opr_val 0x100 + } + } elseif {$type == {code11}} { + if {($opr_val & 0x0f800) != (($address + $instr_lenght) & 0x0f800)} { if {!$ignore_undefined} { - SyntaxError $lineNum $fileNum \ - [mc "Label is too far for 8-bit relative addressing.\nTry to disable peephole optimalizations if they are on."] + SyntaxError $lineNum $fileNum [mc "Operand value out of range: `%s' (`%s')" $opr $opr_val] } set opr_val 0 + } else { + set opr_val [expr {$opr_val & 0x007ff}] } } - if {$opr_val < 0} { - incr opr_val 0x100 - } } } # Adjust list of operands - lappend new_operands $opr_val + lappend new_operands "${char}${opr_val}" # Check for valid value range if {$opr_val != {} && ![checkRange $opr_val $type]} { if {!$ignore_undefined && [string is digit -strict $opr_val]} { SyntaxError $lineNum $fileNum [mc "Operand value out of range: `%s' (`%s')" $opr $opr_val] - } { + } else { return {} } } @@ -1321,8 +1320,8 @@ namespace eval PreProcessor { ## Finaly precompiled encapsulate code to the resulting form # @return void proc final_stage {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -1337,7 +1336,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -1367,11 +1368,11 @@ namespace eval PreProcessor { } # Check for instruction validity - } elseif {[lsearch -exact -ascii ${CompilerConsts::AllInstructions} $instruction] == -1} { + } elseif {[lsearch -exact -ascii ${::CompilerConsts::AllInstructions} $instruction] == -1} { if {[string index $address end] == {:}} { - SyntaxError $lineNum $fileNum [mc "Invalid label declaration: `%s'\n\tLabels can contain alfanumeric characters only and must not begin with a digit" $address] - } { - SyntaxError $lineNum $fileNum [mc "Unknown keyword: `%s'\n\t`%s' is neighter macro nor instruction nor directive" [lindex $address 0] [lindex $address 0]] + SyntaxError $lineNum $fileNum [mc "Invalid label declaration: `%s'\n\tLabels can contain alphanumeric characters only and must not begin with a digit" $address] + } else { + SyntaxError $lineNum $fileNum [mc "Unknown keyword: `%s'\n\t`%s' is neither macro nor instruction nor directive" [lindex $address 0] [lindex $address 0]] } continue } @@ -1416,7 +1417,7 @@ namespace eval PreProcessor { $ignore_undefined \ ] # Register is regular number - } { + } else { set regAddr [COprToDec $opr0] } @@ -1427,7 +1428,7 @@ namespace eval PreProcessor { $ignore_undefined \ ] # Bit is regular number - } { + } else { set bitNum [COprToDec $opr1] } @@ -1439,7 +1440,7 @@ namespace eval PreProcessor { # Register is in high bit addressable area if {$regAddr > 31 && $regAddr < 48} { - return [expr {$regAddr - 32 + $bitNum}] + return [expr {($regAddr - 32) * 8 + $bitNum}] # Register bit addressable SFR } elseif {[lsearch -exact -ascii {128 136 144 152 160 168 176 184 208 224 240} $regAddr] != -1} { return [expr {$regAddr + $bitNum}] @@ -1458,7 +1459,7 @@ namespace eval PreProcessor { variable fileNum ;# Number of the current file # If the given operand is fixed string -> return it unchanged - if {[lsearch -exact -ascii ${CompilerConsts::FixedOperands} [string tolower $operand]] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::FixedOperands} [string tolower $operand]] != -1} { return $operand } @@ -1466,10 +1467,23 @@ namespace eval PreProcessor { set char [string index $operand 0] if {$char == {#} || $char == {@} || $char == {/}} { set operand [string replace $operand 0 0] - } { + } else { set char {} } + # Handle prefix notation for hexadecimal numbers, like 0xfa + if { + [string index $operand 0] == {0} + && + ([string index $operand 1] == {x} || [string index $operand 1] == {X}) + } then { + set operand [string replace $operand 0 1] + if {![string is digit [string index $operand 0]]} { + set operand "0${operand}" + } + append operand {h} + } + # Determinate numeric base and adjust operand string set base [string index $operand end] set operand [string range $operand 0 {end-1}] @@ -1481,17 +1495,17 @@ namespace eval PreProcessor { # Convert and return if {[NumSystem::isdec $operand]} { return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${char}${operand}"] } - # Value is charater + # Value is a charater } elseif {$base == {'}} { # Remove leading quote if {[string index $operand 0] != {'}} { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${char}${operand}"] return {} - } { + } else { set operand [string range $operand 1 end] } } @@ -1503,7 +1517,7 @@ namespace eval PreProcessor { if {[NumSystem::ishex $operand]} { set operand [expr "0x$operand"] return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${operand}${base}"] return {} } @@ -1512,7 +1526,7 @@ namespace eval PreProcessor { if {[NumSystem::isbin $operand]} { set operand [NumSystem::bin2dec $operand] return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${operand}${base}"] return {} } @@ -1521,7 +1535,7 @@ namespace eval PreProcessor { if {[NumSystem::isoct $operand]} { set operand [NumSystem::oct2dec $operand] return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${operand}${base}"] return {} } @@ -1530,7 +1544,7 @@ namespace eval PreProcessor { if {[NumSystem::isoct $operand]} { set operand [NumSystem::oct2dec $operand] return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${operand}${base}"] return {} } @@ -1538,7 +1552,7 @@ namespace eval PreProcessor { {'} { ;# From character if {[string length $operand] != 0} { set operand $char[character2number [subst -nocommands -novariables $operand]] - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" $operand] return {} } @@ -1546,7 +1560,7 @@ namespace eval PreProcessor { {d} { ;# From decimal (no conversion) if {[NumSystem::isdec $operand]} { return "$char$operand" - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s'" "${operand}${base}"] return {} } @@ -1571,10 +1585,10 @@ namespace eval PreProcessor { set operand [string tolower $operand] # Fixed operand - if {[lsearch -exact -ascii ${CompilerConsts::FixedOperands} $operand] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::FixedOperands} $operand] != -1} { if {$operand == $type} { return 1 - } { + } else { return 0 } } @@ -1583,7 +1597,7 @@ namespace eval PreProcessor { set char [string index $operand 0] if {$char == {#} || $char == {@} || $char == {/}} { set operand [string trimleft $operand {#@/}] - } { + } else { set char {} } @@ -1607,7 +1621,11 @@ namespace eval PreProcessor { } # Check for allowed range - if {$operand > $max || $operand < 0} {return 0} {return 1} + if {$operand > $max || $operand < 0} { + return 0 + } else { + return 1 + } } ## Determinate whether the given string is an expression @@ -1621,9 +1639,9 @@ namespace eval PreProcessor { set expression [string trimleft $expression "\t "] set expression [string trimright $expression "\t "] - if {[regexp {[ \+\-\=<>\(\)\*/%]} $expression]} { + if {[regexp {[ \?\+\-\=<>\(\)\*/%]} $expression]} { return 1 - } { + } else { return 0 } } @@ -1633,9 +1651,9 @@ namespace eval PreProcessor { # @return Bool - result (1 == is fixed; 0 == is not fixed) proc isFixed {operand} { set operand [string tolower $operand] - if {[lsearch -exact -ascii ${CompilerConsts::FixedOperands} $operand] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::FixedOperands} $operand] != -1} { return 1 - } { + } else { return 0 } } @@ -1653,7 +1671,7 @@ namespace eval PreProcessor { # Check if the string starts with a digit or quote if {[regexp {^(\d|')} $symbolic_name]} { return 0 - } { + } else { return 1 } } @@ -1668,7 +1686,7 @@ namespace eval PreProcessor { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable check_sfr_usage;# Bool: Check for legal usage of SFR and SFB - variable avaliable_SFR ;# List: Avaliable SFR and SFB on the target MCU + variable available_SFR ;# List: Available SFR and SFB on the target MCU variable const_BIT ;# Array: Bit values -- ($const_BIT($bit_name) == $value) variable const_CODE ;# Array: Constants defined by directive 'CODE' @@ -1699,13 +1717,13 @@ namespace eval PreProcessor { if { ([lsearch -exact -ascii $defined_LABEL $symbolic_name] == -1) && ($symbolic_name != "\$") - } { + } then { continue } if {$symbolic_name == "\$"} { set value $address - } { + } else { set value $labels($symbolic_name) } CodeListing::symbol_used $symbolic_name {label} @@ -1737,9 +1755,9 @@ namespace eval PreProcessor { if { [lsearch -ascii -exact $::CompilerConsts::defined_SFR $symbolic_name] != -1 && - [lsearch -ascii -exact $avaliable_SFR $symbolic_name] == -1 - } { - Warning $lineNum $fileNum [mc "Special function register \"%s\" is not avaliable on the target MCU" [string toupper $symbolic_name]] + [lsearch -ascii -exact $available_SFR $symbolic_name] == -1 + } then { + Warning $lineNum $fileNum [mc "Special function register \"%s\" is not available on the target MCU" [string toupper $symbolic_name]] } } @@ -1754,9 +1772,9 @@ namespace eval PreProcessor { if { [lsearch -ascii -exact $::CompilerConsts::defined_SFRBitArea $symbolic_name] != -1 && - [lsearch -ascii -exact $avaliable_SFR $symbolic_name] == -1 - } { - Warning $lineNum $fileNum [mc "Special function bit \"%s\" is not avaliable on the target MCU" [string toupper $symbolic_name]] + [lsearch -ascii -exact $available_SFR $symbolic_name] == -1 + } then { + Warning $lineNum $fileNum [mc "Special function bit \"%s\" is not available on the target MCU" [string toupper $symbolic_name]] } } @@ -1771,7 +1789,7 @@ namespace eval PreProcessor { set val [const_value $symbolic_name $lineNum] if {$val == {}} { break - } { + } else { CodeListing::symbol_used $symbolic_name {equset} return $val } @@ -1789,19 +1807,19 @@ namespace eval PreProcessor { return {} } - ## Perform peerhole optimalization + ## Perform peerhole optimization # This function must be called between "parse_instructions" and "final_stage" # @return void - proc optimalization {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + proc optimization {} { + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list variable labels ;# Array: Values of defined labels ($labels($label) == $address) variable defined_LABEL ;# List of defined labels variable program_memory ;# String of booleans: Map of program memory usage - variable optims ;# Number of performed optimalizations + variable optims ;# Number of performed optimizations variable origin_d_addr ;# List: Addresses of static program blocks # Iterate over the code @@ -1810,7 +1828,9 @@ namespace eval PreProcessor { for {set idx 0} {$idx < $asm_len} {incr idx} { # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -1876,7 +1896,7 @@ namespace eval PreProcessor { } elseif { [lindex $operand_types 0] != {code8} && [lindex $operand_types 0] != {code11} && - [lindex $operands_abs 0] < 2048 + ($address & 0x0f800) == ([lindex $operands_abs 0] & 0x0f800) } then { set instruction {ajmp} set operand_types {code11} @@ -1888,7 +1908,7 @@ namespace eval PreProcessor { ## A) if {[string is digit -strict [lindex $operands_abs 0]]} { set diff [expr {$address - [lindex $operands_abs 0]}] - } { + } else { set diff 200 ;# Some value out of range [-126; 129] } if {$diff >= -126 && $diff <= 129} { @@ -1906,7 +1926,7 @@ namespace eval PreProcessor { {ajmp} { ;# AJMP code8 --> SJMP code8 if {[string is digit -strict [lindex $operands_abs 0]]} { set diff [expr {$address - [lindex $operands_abs 0]}] - } { + } else { set diff 200 ;# Some value out of range [-126; 129] } if {$diff >= -126 && $diff <= 129} { @@ -1915,7 +1935,11 @@ namespace eval PreProcessor { } } {call} { ;# CALL code11 --> ACALL code11 - if {[lindex $operand_types 0] != {code11} && [lindex $operands_abs 0] < 2048} { + if { + [lindex $operand_types 0] != {code11} + && + ($address & 0x0f800) == ([lindex $operands_abs 0] & 0x0f800) + } then { set instruction {acall} set operand_types {code11} set bytes_saved 1 @@ -1935,7 +1959,7 @@ namespace eval PreProcessor { [lindex $operands_abs 0] == 224 && [lindex $operand_types 0] == {data} - } { + } then { if {[lindex $operands_abs 1] != {A}} { lset operands 0 A lset operand_types 0 a @@ -1946,7 +1970,7 @@ namespace eval PreProcessor { [lindex $operands_abs 1] == 224 && [lindex $operand_types 1] == {data} - } { + } then { lset operands 1 A lset operand_types 1 a set bytes_saved 1 @@ -1955,7 +1979,7 @@ namespace eval PreProcessor { } if {$bytes_saved} { - # Increment number of performed optimalizations + # Increment number of performed optimizations incr optims # Shift code @@ -1995,8 +2019,8 @@ namespace eval PreProcessor { ## Evaluate and remove instructions # @return void proc parse_instructions {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -2027,7 +2051,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -2042,7 +2068,7 @@ namespace eval PreProcessor { ## Conditionaly change program pointer if {![regexp {^\s*\w+} $line first_field]} { set first_field {} - } { + } else { set first_field [string trim $first_field] } if {$first_field == {ORG}} { @@ -2055,15 +2081,27 @@ namespace eval PreProcessor { ## Determinate label if {[regexp {^\w+:} $line label]} { # Check for label validity + set lbl [string trimright $label {:}] if {[regexp {^\w*:$} $label] && ![regexp {^\d} $label]} { - - set label [string trimright $label {:}] - if {[isReservedKeyword $label]} { - Warning $lineNum $fileNum [mc "Reserved keyword used as label"] + if { + [lsearch -exact -ascii ${::CompilerConsts::defined_SFR} $lbl] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::defined_progVectors} $lbl] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::defined_SFRBitArea} $lbl] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::FixedOperands} $lbl] != -1 + } then { + SyntaxError $lineNum $fileNum [mc "Unable redefine constant: %s" $lbl] + } else { + set label $lbl + if {[isReservedKeyword $label]} { + Warning $lineNum $fileNum [mc "Reserved keyword used as label"] + } + lappend local_labels $label } - lappend local_labels $label - } { - SyntaxError $lineNum $fileNum [mc "Invalid label: `%s' \n\t(labels can contain only alfanumeric characters and must not begin with a digit)" $label] + } else { + SyntaxError $lineNum $fileNum [mc "Invalid label: `%s' \n\t(labels can contain only alphanumeric characters and must not begin with a digit)" $label] } # Remove label from the line @@ -2080,7 +2118,7 @@ namespace eval PreProcessor { ## Determinate instruction if {![regexp {^\s*\.?\w+} $line instruction]} { set instruction {} - } { + } else { set instruction [string tolower [string trim $instruction]] } @@ -2090,7 +2128,7 @@ namespace eval PreProcessor { if {$skip == {}} { set instruction_len 0 SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" [regsub {^\s*\.?\w+\s*} $line {}]] - } { + } else { set instruction_len $skip } @@ -2105,7 +2143,7 @@ namespace eval PreProcessor { # Regular instruction } else { # Check for instruction validity - if {[lsearch -exact -ascii ${CompilerConsts::AllInstructions} $instruction] == -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::AllInstructions} $instruction] == -1} { lappend tmp_asm [list $lineNum $fileNum {C} $line] continue } @@ -2181,19 +2219,31 @@ namespace eval PreProcessor { } ## Determinate whether the given string is reserved keyword - # @parm String string - string to evaluate + # @parm String string - String to evaluate + # @parm Bool symbols_too - Consider also special register names # @return Bool - result (1 == is reserved; 0 == is not reserved) - proc isReservedKeyword {string} { + proc isReservedKeyword {string {symbols_too 0}} { set string [string tolower $string] if { - [lsearch -exact -ascii ${CompilerConsts::AllInstructions} $string] != -1 + [lsearch -exact -ascii ${::CompilerConsts::AllInstructions} $string] != -1 || - [lsearch -exact -ascii ${CompilerConsts::AllDirectives} $string] != -1 - } { + [lsearch -exact -ascii ${::CompilerConsts::AllDirectives} $string] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::FixedOperands} $string] != -1 + } then { return 1 - } { + } elseif {$symbols_too && ( + [lsearch -exact -ascii ${::CompilerConsts::defined_SFR} $string] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::defined_progVectors} $string] != -1 + || + [lsearch -exact -ascii ${::CompilerConsts::defined_SFRBitArea} $string] != -1 + ) + } then { + return 1 + } else { return 0 } } @@ -2215,8 +2265,8 @@ namespace eval PreProcessor { set list_of_labels [string tolower $list_of_labels] foreach label $list_of_labels { if {[lsearch -exact -ascii $defined_LABEL $label] != -1} { - SyntaxError $lineNum $fileNum [mc "Label is already defined: `%s'" $label] - } { + SyntaxError $lineNum $fileNum [mc "Label was already defined: `%s'" $label] + } else { lappend defined_LABEL $label set labels($label) $address } @@ -2241,7 +2291,7 @@ namespace eval PreProcessor { set l [llength $operands] for {set i 0} {$i < $l} {incr i} { set o [lindex $operands $i] - if {[lsearch -exact -ascii ${CompilerConsts::FixedOperands} [string tolower $o]] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::FixedOperands} [string tolower $o]] != -1} { set operands [lreplace $operands $i $i [string toupper $o]] } } @@ -2262,7 +2312,7 @@ namespace eval PreProcessor { set n [const_value $o $lineNum 1] set operands [lreplace $operands $i $i $n] - Notice $lineNum $fileNum [mc "Overwriting `%s' with `%s' (acording to your previous definition!)" [string toupper $o] [string toupper $n]] + Notice $lineNum $fileNum [mc "Overwriting `%s' with `%s' (according to your previous definition!)" [string toupper $o] [string toupper $n]] } } @@ -2273,19 +2323,19 @@ namespace eval PreProcessor { } # Find instruction set for given instruction - if {[lsearch -exact -ascii ${CompilerConsts::AllInstructions} $instruction] == -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::AllInstructions} $instruction] == -1} { CompilationError $lineNum $fileNum "Unknown error 3" return {} } - set ins_def $CompilerConsts::InstructionDefinition($instruction) + set ins_def $::CompilerConsts::InstructionDefinition($instruction) # Check for valid operands count set max_oprs [lindex $ins_def 0] if {[llength $operands] > $max_oprs} { - SyntaxError $lineNum $fileNum [mc "Too many operands, %s can take only %s operand[expr {$max_oprs ? {} : {s}}]" $instruction $max_oprs] + SyntaxError $lineNum $fileNum [mc "Too many operands, %s can take only %s operand[expr {$max_oprs == 1 ? {} : {s}}]" $instruction $max_oprs] return {} } elseif {[llength $operands] < $max_oprs} { - SyntaxError $lineNum $fileNum [mc "Too few operands, %s must take exactly %s operand[expr {$max_oprs ? {} : {s}}]" $instruction $max_oprs] + SyntaxError $lineNum $fileNum [mc "Too few operands, %s must take exactly %s operand[expr {$max_oprs == 1 ? {} : {s}}]" $instruction $max_oprs] return {} } @@ -2330,7 +2380,7 @@ namespace eval PreProcessor { $operands_i != {C} && $operands_i != {/C} - } { + } then { incr i continue } @@ -2361,7 +2411,7 @@ namespace eval PreProcessor { # No matching operand set found -> error if {!$match} { - SyntaxError $lineNum $fileNum [mc "Invalid operand set: %s %s" $instruction [join $operands {,}]] + SyntaxError $lineNum $fileNum [mc "Invalid set of operands: %s %s" $instruction [join $operands {,}]] return {} } @@ -2391,7 +2441,7 @@ namespace eval PreProcessor { set operand [string tolower $operand] # Fixed value - if {[lsearch -exact -ascii ${CompilerConsts::FixedOperands} $operand] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::FixedOperands} $operand] != -1} { return [string toupper $operand] } @@ -2401,6 +2451,13 @@ namespace eval PreProcessor { {^#.*$} { return {imm8 imm16} } } + # determinate whether the instruction can changed content of PC + if {[lsearch {} $instruction] == -1} { + set no_branch 1 + } else { + set no_branch 0 + } + # Variable length operand (pseudo-instructions: "CALL <code>" and "JMP <code>") if {$instruction == {jmp} || $instruction == {call}} { # Value is an expression @@ -2425,7 +2482,7 @@ namespace eval PreProcessor { return {code16} } elseif {(abs($address - $operand) > 126) || $instruction == {call}} { return {code11} - } { + } else { return {code8} } @@ -2437,7 +2494,7 @@ namespace eval PreProcessor { } elseif {[lsearch ${::CompilerConsts::defined_SFRBitArea} $operand] != -1} { return {bit /bit} - # Interrupt vector + # Address in program memory } elseif {[lsearch ${::CompilerConsts::defined_progVectors} $operand] != -1} { return {code16 code11 code8} @@ -2450,11 +2507,12 @@ namespace eval PreProcessor { ## Expand macro instructions # @return Bool - macro expanded proc expand_macro_instructions {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable macro ;# Array: Code of defined macro instructions + variable local_M_labels ;# Array of lists: Local labels in macros $local_M_labels($macro_name) == {integer label0 ... labelN} variable defined_MACRO ;# List of defined macro instructions variable idx ;# Current position in asm list @@ -2478,7 +2536,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -2499,7 +2559,7 @@ namespace eval PreProcessor { } if {![regexp {^\s*\.?\w+} $line instruction]} { set instruction {} - } { + } else { set instruction [string tolower [string trim $instruction]] } regsub {^\.?\w+\s*} $line {} operands @@ -2513,14 +2573,14 @@ namespace eval PreProcessor { set repeat 1 # Get code of the macro - set macro_code [getMacro $instruction [getOperands $operands 0]] + set macro_code [getMacro $instruction [getOperands $operands 1]] if {$macro_code == {}} {continue} # Adjust the precompiled code and code listing if {$label != {}} { lappend tmp_asm [list $lineNum $fileNum $label] set del_line 0 - } { + } else { set del_line 1 } @@ -2541,11 +2601,11 @@ namespace eval PreProcessor { return $repeat } - ## Debuging procedure + ## Debugging procedure # Write current content of the precompiled code to stdout # @return void proc write_asm {} { - variable asm ;# Resulting precompiled code + variable asm ;# Resulting pre-compiled code puts "" set idx -1 foreach line $asm { @@ -2554,11 +2614,11 @@ namespace eval PreProcessor { } } - ## Debuging procedure + ## Debugging procedure # Write current content of the tempotary precompiled code to stdout # @return void proc write_tmp_asm {} { - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code puts "" set idx -1 foreach line $tmp_asm { @@ -2573,11 +2633,12 @@ namespace eval PreProcessor { # @return List - code of the macro proc getMacro {macro_name args} { variable macro ;# Array: Code of defined macro instructions + variable local_M_labels ;# Array of lists: Local labels in macros $local_M_labels($macro_name) == {integer label0 ... labelN} variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file - # Adjust list of armuments - set args [join $args] + # Adjust list of arguments + set args [lindex $args 0] # Local variables set new_operands {} ;# Instruction operands @@ -2585,34 +2646,57 @@ namespace eval PreProcessor { # Determinate code of the macro and its operands set macro_code $macro($macro_name) - set m_args [lindex $macro_code 0] + set m_pars [lindex $macro_code 0] set macro_code [lindex $macro_code 1] # Check for valid number of arguments - set arg_len_diff [expr {[llength $args] - [llength $m_args]}] + set arg_len_diff [expr {[llength $args] - [llength $m_pars]}] if {$arg_len_diff < 0} { set arg_len_diff [expr {$arg_len_diff * -1}] - SyntaxError $lineNum $fileNum [mc "Too few arguments, %s argument(s) missing: %s ..." $arg_len_diff $macro_name] + SyntaxError $lineNum $fileNum [mc "Too few arguments, %d argument(s) missing for %s ..." $arg_len_diff $macro_name] return {} } elseif {$arg_len_diff > 0} { - SyntaxError $lineNum $fileNum [mc "Too many arguments, $s extra argument(s)" $arg_len_diff] + SyntaxError $lineNum $fileNum [mc "Too many arguments, %d extra argument(s)" $arg_len_diff] return {} } - # Substitute macro arguments + # Increment counter of expansions of this macro + lset local_M_labels($macro_name) 0 [expr {1 + [lindex $local_M_labels($macro_name) 0]}] + + # Substitute macro parametrs foreach line $macro_code { set new_operands {} + # Determinate label + if {![regexp {^(\?\?)?[A-Za-z_][^\s:]*:\s*} $line label]} { + set label {} + } else { + regsub {^(\?\?)?[A-Za-z_][^\s:]:*\s*} $line {} line + regsub -all {\s+} $label {} label + set label [string trimright $label {:}] + if {[lsearch -ascii -exact $local_M_labels($macro_name) $label] != -1} { + set label "${macro_name}_[lindex $local_M_labels($macro_name) 0]__${label}" + } + } + # Determinate instruction and operands if {![regexp {^\.?\w+\s*} $line instruction]} { set instruction {} + } else { + regsub -all {\s+} $instruction {} instruction } regsub {^\.?\w+\s*} $line {} operands if {$operands == {}} { lappend result $instruction continue } - set operands [getOperands $operands 0] + + if {[lsearch -ascii -exact {if ifn ifdef ifndef elseif elseifn elseifdef elseifndef} [string tolower $instruction]] == -1} { + set operands [getOperands $operands 0] + set if_statement 0 + } else { + set if_statement 1 + } # Perform substitution foreach opr $operands { @@ -2623,25 +2707,43 @@ namespace eval PreProcessor { ($char == {/}) || ($char == {#}) || ($char == {@}) - } { + } then { set opr [string range $opr 1 end] - } { + } else { set char {} } - # Find operand in macro armunets - set idx [lsearch -exact -ascii $m_args $opr] - if {$idx != -1} { - set opr [lindex $args $idx] + # Find operand in macro parameters + set new_opr [list] + regsub -all {[\(\)]} $opr { & } opr + foreach o $opr { + set idx [lsearch -exact -ascii $m_pars $o] + if {$idx != -1} { + set o [lindex $args $idx] + + if {[isReservedKeyword [lindex $m_pars $idx] 1]} { + Warning $lineNum $fileNum [mc "Reserved keyword substituted with macro argument: %s --> %s" [lindex $m_pars $idx] [lindex $args $idx]] + } + } + + append new_opr $o { } } - lappend new_operands "$char$opr" + lappend new_operands "$char$new_opr" } # Recomposite line of macro instruction code - set operands [join $new_operands {, }] + if {$if_statement} { + set operands [join $new_operands { }] + } else { + set operands [join $new_operands {, }] + } append instruction "\t" append instruction $operands + + if {$label != {}} { + set instruction "${label}:\t${instruction}" + } lappend result $instruction } @@ -2660,16 +2762,16 @@ namespace eval PreProcessor { set simple_operands $operands ;# Original string without strings and chars set result {} ;# Resulting list - # Convert strings and quoted charaters to underscores - while 1 { + # Convert strings and quoted characters to underscores + while {1} { if {![regexp {'[^']*'} $simple_operands str]} {break} set padding [string repeat {_} [string length $str]] regsub {'[^']*'} $simple_operands $padding simple_operands } - # Determinate oprands - while 1 { + # Determinate operands + while {1} { set idx [string first {,} $simple_operands] if {$idx == -1} {break} @@ -2688,7 +2790,7 @@ namespace eval PreProcessor { lappend result $operands if {$keep_case} { return $result - } { + } else { return [string tolower $result] } } @@ -2696,11 +2798,12 @@ namespace eval PreProcessor { ## Parse and remove definitions of macro instructions # @return void proc define_macro_instructions {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable macro ;# Array: Code of defined macro instructions + variable local_M_labels ;# Array of lists: Local labels in macros $local_M_labels($macro_name) == {integer label0 ... labelN} variable defined_MACRO ;# List of defined macro instructions variable idx ;# Current position in asm list variable macro_name_to_append ;# Name of currently defined macro instruction @@ -2710,20 +2813,21 @@ namespace eval PreProcessor { set idx -1 # Local variables - set Macro 0 ;# Bool: definition opened - set Exitm 0 ;# Bool: Definition terminated by directive 'EXITM' - set NoMacro 0 ;# Definition failed - set del_line 1 ;# Bool: remove this line - set macro_name {} ;# Name of the macro - set macro_args {} ;# List of arguments for the macro - set rept_macro 0 ;# Bool: repeat macro starts + set Macro 0 ;# Bool: definition opened + set NoMacro 0 ;# Definition failed + set del_line 1 ;# Bool: remove this line + set macro_name {} ;# Name of the macro + set macro_params {} ;# List of the macro parameters + set rept_macro 0 ;# Bool: repeat macro starts # Iterate over the code foreach line $asm { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -2740,12 +2844,12 @@ namespace eval PreProcessor { # Spilt line into first 2 separate fields if {![regexp {^\s*\.?\w+} $line field0]} { set field0 {} - } { + } else { set field0 [string trim $field0] } if {![regexp {^\s*\.?\w+:?\s+\.?\w+} $line field1]} { set field1 {} - } { + } else { regexp {\.?\w+$} $field1 field1 } set field0_l [regsub {^\.} [string tolower $field0] {}] @@ -2755,17 +2859,17 @@ namespace eval PreProcessor { if {$field0_l == {rept} || $field0_l == {times}} { if {$Macro} { SyntaxError $lineNum $fileNum \ - [mc "Cannot define macro inside anoner one -- macro processing failed"] - } { - regsub {^\s*\.?\w+\s*} $line {} macro_args - set macro_args [ComputeExpr $macro_args] - if {$macro_args == {}} { - SyntaxError $lineNum $fileNum [mc "Missign number of repeats"] + [mc "Cannot define macro inside another one -- macro processing failed"] + } else { + regsub {^\s*\.?\w+\s*} $line {} macro_params + set macro_params [ComputeExpr $macro_params] + if {$macro_params == {}} { + SyntaxError $lineNum $fileNum [mc "Missing number of repeats"] set NoMacro 1 - } elseif {$macro_args < 0} { + } elseif {$macro_params < 0} { Warning $lineNum $fileNum [mc "Number of repeats is lower than zero"] set NoMacro 1 - } elseif {$macro_args == 0} { + } elseif {$macro_params == 0} { Notice $lineNum $fileNum [mc "Zero number of repeats"] set NoMacro 1 } @@ -2781,69 +2885,66 @@ namespace eval PreProcessor { } elseif {$field1_l == {macro}} { if {$Macro} { SyntaxError $lineNum $fileNum \ - [mc "Cannot define macro inside anoner one -- macro processing failed"] - } { - # Determinate name and arguments - regsub {^\w+\s+\.?\w+\s*} $line {} macro_args - set macro_args [getOperands $macro_args 0] + [mc "Cannot define macro inside another one -- macro processing failed"] + } else { + # Determinate name and parameters + regsub {^\w+\s+\.?\w+\s*} $line {} macro_params + set macro_params [getOperands $macro_params 0] set macro_name $field0_l + foreach parm $macro_params { + if {[isReservedKeyword $parm 1]} { + Warning $lineNum $fileNum [mc "Reserved keyword used as macro parameter: %s in macro %s" $parm $macro_name] + } + } + # Check for validity of the name - if { - ([lsearch -exact -ascii ${CompilerConsts::AllInstructions} $macro_name] != -1) - || - ([lsearch -exact -ascii ${CompilerConsts::AllDirectives} $macro_name] != -1) - } { + if {[isReservedKeyword $macro_name]} { # Invalid name SyntaxError $lineNum $fileNum [mc "Macro name is reserved keyword: %s" $macro_name] set NoMacro 1 - } { + } else { + # Check for validity of the name (again, but invoke only warning this time) + if {[isReservedKeyword $macro_name 1]} { + # Invalid name + Warning $lineNum $fileNum [mc "Macro name is reserved keyword: %s" $macro_name] + set NoMacro 1 + } # Valid name if {[lsearch -exact -ascii $defined_MACRO $macro_name] != -1} { SyntaxError $lineNum $fileNum [mc "Macro `%s' is already defined" $macro_name] set NoMacro 1 - } { + } else { set macro_name_to_append $macro_name - set macro($macro_name) {} + set macro($macro_name) [list] + set local_M_labels($macro_name) [list 0] } set Macro 1 } } - # Exit macro definition - } elseif {$field0_l == {exitm}} { - if {!$Macro} { - Warning $lineNum $fileNum [mc "Unable to exit macro, no macro is opened"] - } - set Exitm 1 - set rept_macro 0 - - # Directive takes no arguments - if {[string length $field1_l]} { - Warning $lineNum $fileNum [mc "Directive %s takes no arguments" [string toupper $field0_l]] - } - # Close macro definition } elseif {$field0_l == {endm}} { # No macro was opened if {!$Macro} { SyntaxError $lineNum $fileNum [mc "Unable to close macro, no macro is opened"] # Close macro - } { + } else { if {$rept_macro} { set line $macro($macro_name) set macro($macro_name) [list] - for {set i 0} {$i < $macro_args} {incr i} { + set local_M_labels($macro_name) [list 0] + for {set i 0} {$i < $macro_params} {incr i} { set macro($macro_name) [concat $macro($macro_name) $line] } - set macro_args {} + set macro_params {} set del_line 0 lappend tmp_asm [list $lineNum $fileNum $macro_name] } - if {!($Exitm || $NoMacro)} { - set macro($macro_name) [list $macro_args $macro($macro_name)] + if {!$NoMacro} { + set macro($macro_name) [list $macro_params $macro($macro_name)] regsub -all {\s+} $macro($macro_name) { } macro($macro_name) regsub -all "\\\{ " $macro($macro_name) "\{" macro($macro_name) @@ -2853,7 +2954,6 @@ namespace eval PreProcessor { # Reset some local variables set Macro 0 - set Exitm 0 set NoMacro 0 set rept_macro 0 @@ -2866,20 +2966,26 @@ namespace eval PreProcessor { } else { # Part of macro definition if {$Macro} { - if {[regexp {^\w+:} $line]} { - Warning $lineNum $fileNum [mc "Bad layout: Macros cannot contain labels -- label deleted"] - regsub {^\w+:\s*} $line {} line - } - if {!($Exitm || $NoMacro)} { - lappend macro($macro_name) $line + # Register local label in the macro + if {$field0_l == {local}} { + if {[regexp {^\w+$} $field1_l]} { + lappend local_M_labels($macro_name) $field1_l + } else { + SyntaxError $lineNum $fileNum [mc "Invalid label specification: ``%s''" $field0_l] + } + # Append the line to the currenly opened macro + } else { + if {!$NoMacro} { + lappend macro($macro_name) $line + } } # Common line - } { + } else { if {$field0_l == {macro}} { SyntaxError $lineNum $fileNum [mc "Missing name of macro"] - } elseif {[regexp {^\s*\w+:} $line] && ($field1_l == {endm} || $field1_l == {exitm})} { - SyntaxError $lineNum $fileNum [mc "Labels are not allowed before directives ENDM and EXITM"] - } { + } elseif {[regexp {^\s*\w+:} $line] && ($field1_l == {endm})} { + SyntaxError $lineNum $fileNum [mc "Labels are not allowed before directives ENDM"] + } else { lappend tmp_asm [list $lineNum $fileNum $line] } set del_line 0 @@ -2902,8 +3008,8 @@ namespace eval PreProcessor { # @return Bool - code included proc include_directive {dir} { variable included_files ;# List: Unique unsorted list of included files - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -2921,7 +3027,9 @@ namespace eval PreProcessor { set line_org $line # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -2941,14 +3049,14 @@ namespace eval PreProcessor { regsub {^\s*\w+:\s*} $line {} line set label [string trimleft $label " \t"] set label [string trimright $label " \t"] - } { + } else { set label {} } # Determinate directive if {![regexp {^\s*\.?\w+} $line directive]} { set directive {} - } { + } else { set directive [string trim $directive] } set directive_l [string tolower $directive] @@ -2958,7 +3066,7 @@ namespace eval PreProcessor { regsub {^\s*\.?\w+} $line {} file_name regsub {^\s+} $file_name {} file_name if {![string length $file_name]} { - SyntaxError $lineNum $fileNum [mc "Missing filename"] + SyntaxError $lineNum $fileNum [mc "Missing file name"] } set asm [lreplace $asm $idx $idx [list $lineNum $fileNum $label]] @@ -2967,7 +3075,7 @@ namespace eval PreProcessor { set file_name [regsub -nocase -- {^[\s ]*\$include[\s ]*} $file_name {}] set file_name [string range $file_name 1 end-1] if {![string length $file_name]} { - SyntaxError $lineNum $fileNum [mc "Missing filename"] + SyntaxError $lineNum $fileNum [mc "Missing file name"] } set asm [lreplace $asm $idx $idx [list $lineNum $fileNum $label]] @@ -2984,7 +3092,7 @@ namespace eval PreProcessor { ([string index $file_name 0] == "\"" && [string index $file_name end] == "\"") || ([string index $file_name 0] == {'} && [string index $file_name end] == {'}) - } { + } then { set file_name [string range $file_name 1 end-1] } set file_name [string trim $file_name] @@ -3036,7 +3144,7 @@ namespace eval PreProcessor { proc getFile {dir file file_number} { variable fileNum ;# Number of the current file variable lineNum ;# Number of the current line - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code set tmp_asm {} @@ -3044,13 +3152,13 @@ namespace eval PreProcessor { if {[string index $file 0] == {'}} { if {[string index $file end] != {'}} { SyntaxError $lineNum $fileNum [mc "Invalid expression: `%s'" $file] - } { + } else { set file [string range $file 1 {end-1}] } } elseif {[string index $file 0] == "\""} { if {[string index $file end] != "\""} { SyntaxError $lineNum $fileNum [mc "Invalid expression: `%s'" $file] - } { + } else { set file [string range $file 1 {end-1}] } } @@ -3061,10 +3169,10 @@ namespace eval PreProcessor { set file [open $file r] set data [read $file] close $file - }]} { + }]} then { CompilationError $lineNum $fileNum [mc "Unable to open file: %s" $file] return {} - } { + } else { # Any EOL to LF regsub -all {\r\n?} $data "\n" data @@ -3078,7 +3186,7 @@ namespace eval PreProcessor { return $tmp_asm } # File does not exist - } { + } else { CompilationError $lineNum $fileNum [mc "File not found: %s" $file] return {} } @@ -3087,7 +3195,7 @@ namespace eval PreProcessor { ## Parse and remove directive(s) 'END' # @return void proc end_of_code {} { - variable asm ;# Resulting precompiled code + variable asm ;# Resulting pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -3104,7 +3212,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -3117,20 +3227,23 @@ namespace eval PreProcessor { set line [lindex $line 2] # Skip lines without word 'END' - if {![regexp -nocase {\.?end} $line]} { + if {![regexp -nocase {end} $line]} { continue } + regsub {\s*;.*$} $line {} line + regsub -all {:} $line {: } line + # Determinate 1st and 2nd field of the line - if {![regexp {^\s*\.?\w+} $line field0]} { + if {![regexp {^\s*[^\s]+} $line field0]} { set field0 {} - } { + } else { set field0 [string trim $field0] } - if {![regexp {^\s*\.?\w+\s+\.?\w+} $line field1]} { + if {![regexp {^\s*[^\s]+\s+[^\s]+} $line field1]} { set field1 {} - } { - regexp {\.?\w+$} $field1 field1 + } else { + regexp {[^\s]+$} $field1 field1 } set field0 [string tolower [regsub {^\.} $field0 {}]] set field1 [string tolower [regsub {^\.} $field1 {}]] @@ -3145,14 +3258,14 @@ namespace eval PreProcessor { [regexp {^\w+:$} $field0] && ($field1 == {end}) - } { + } then { # Determinate content of the last line of the code (that label) if {![regexp {^\w+:$} $field0 last_line]} { set last_line {} } # Check if the line does not contain anything except the label and 'END' - regsub {^\w+:\s*} $line {} line + regsub {^\s*\w+:\s*} $line {} line set line [string tolower $line] if {$line != {end}} { SyntaxError $lineNum $fileNum [mc "Extra symbols after `END' directive"] @@ -3166,13 +3279,15 @@ namespace eval PreProcessor { # Directive 'end' detected -> adjust the code if {$end} { set asm [lreplace $asm $idx end] + set preserve_current_line 0 if {$last_line != {}} { lappend asm [list $lineNum $fileNum $last_line] + set preserve_current_line 1 } - CodeListing::end_directive $idx - incr idx + CodeListing::end_directive $idx $preserve_current_line + # Directive 'end' not found -> invoke warning - } { + } else { Warning 0 0 [mc "Missing `END' directive"] } } @@ -3180,14 +3295,14 @@ namespace eval PreProcessor { ## Parse and remove directive(s) 'ORG' and reorganize the current code # @return void proc origin_directive {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list variable defined_LABEL ;# List of defined labels variable labels ;# Array: Values of defined labels ($labels($label) == $address) - variable ErrorAtLine ;# Bool: Error occured on the current line + variable ErrorAtLine ;# Bool: Error occurred on the current line variable origin_d_addr ;# List: Addresses of static program blocks # Reset NS variables @@ -3209,7 +3324,9 @@ namespace eval PreProcessor { set ErrorAtLine 0 # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -3239,7 +3356,7 @@ namespace eval PreProcessor { # Directive ORG detected if {![regexp {^\s*\.?\w+} $line field0]} { set field0 {} - } { + } else { set field0 [string trim $field0] } if {[regsub {^\.} $field0 {}] == {org}} { @@ -3250,7 +3367,7 @@ namespace eval PreProcessor { if {$line == {}} { SyntaxError $lineNum $fileNum [mc "Missing address"] set error 1 - } { + } else { set value [ComputeExpr $line] } @@ -3262,7 +3379,7 @@ namespace eval PreProcessor { SyntaxError $lineNum $fileNum [mc "Label already defined: `%s'" $label] set error 1 } - } { + } else { SyntaxError $lineNum $fileNum [mc "Invalid label: `%s'" $label] set error 1 } @@ -3292,7 +3409,7 @@ namespace eval PreProcessor { set last_value $value # Directive ORG wasn't detected - } { + } else { lappend tmp_asm [list $lineNum $fileNum $line] } } @@ -3313,6 +3430,7 @@ namespace eval PreProcessor { set organization [lsort -index 0 -integer $organization] set last_line {} ;# Last line number + set last_file {} ;# Last file number set last_addr {} ;# Last address or origin set new_organization {} ;# New organization map @@ -3368,7 +3486,7 @@ namespace eval PreProcessor { # @parm Bool first - match the first # @return Int - list index proc lineNum2idx {line_number file_number first} { - variable asm ;# Resulting precompiled code + variable asm ;# Resulting pre-compiled code set idx -1 set ln 0 @@ -3387,7 +3505,7 @@ namespace eval PreProcessor { } if {$idx < 0} { return 0 - } { + } else { return $idx } } @@ -3400,8 +3518,8 @@ namespace eval PreProcessor { ## Convert the current code into numbered list (see proc. 'compile') # @return void proc line_numbers {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file @@ -3422,7 +3540,9 @@ namespace eval PreProcessor { incr idx incr lineNum # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -3440,7 +3560,7 @@ namespace eval PreProcessor { } ## Evaluate and remove directives related to: - # - Donditional compilation (IF, ELSE, ENDIF) (group 0) + # - Conditional compilation (IF, ELSE, ENDIF) (group 0) # - Code listing enable/disable (LIST, NOLIST) (group 1) # - Active bank selection (USING) (group 2) # - Data memory segment selection (BSEG, DSEG, ISEG, XSEG) (group 3) @@ -3450,9 +3570,9 @@ namespace eval PreProcessor { # @parm Bool ignore_undefined - Ignore undefined symbolic names # @return Bool - Anything expanded proc parse_Consts_and_ConditionalCompilation {groups ignore_undefined} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code - variable ErrorAtLine ;# Bool: Error occured on the current line + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code + variable ErrorAtLine ;# Bool: Error occurred on the current line variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -3460,6 +3580,8 @@ namespace eval PreProcessor { variable memory_reservation_map ;# Array: memory reservation map (see code) variable defined_SET ;# List of variables defined by 'SET' variable const_SET ;# Array: Constants defined by directive 'CODE' + variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) + variable segment_pointer ;# Current memory segment pointer # Reset NS variables set idx -1 @@ -3482,7 +3604,9 @@ namespace eval PreProcessor { } # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -3497,7 +3621,7 @@ namespace eval PreProcessor { set line [lindex $line 2] regsub -nocase -- {if\(} $line {if (} line ;# Make construction "IF(something)" valid # Final level pass - } { + } else { set line [lindex $line 3] } @@ -3507,7 +3631,7 @@ namespace eval PreProcessor { # Determinate 1st field of the line if {![regexp {^\s*\.?\w+:?} $line line_first_field]} { set line_first_field {} - } { + } else { set line_first_field [string trim $line_first_field] } set directive0 [string tolower $line_first_field] @@ -3516,7 +3640,7 @@ namespace eval PreProcessor { # Determinate 2nd field of the line if {![regexp {^\s*\.?\w+:?\s*\.?\w+} $line directive1]} { set directive1 {} - } { + } else { regsub {^\s*\.?\w+:?\s*} $directive1 {} directive1 set directive1 [string trim $directive1] } @@ -3527,67 +3651,67 @@ namespace eval PreProcessor { # Constant definition (SET EQU BIT ...) without constant to define (syntax error) if { - [lindex $groups 4] && $Enable && - ([lsearch -exact -ascii ${CompilerConsts::ConstDefinitionDirectives} $directive0] != -1) - } { - if {[regexp {^\s*\.?\w+\s+\w+\s*\,\s*.+$} $line]} { - Warning $lineNum $fileNum [mc "This formulation is deprecated, consider usage of \"<Const> <Directive> <Value>\" instead"] - - set line_expr {} - regsub {^\s*\.?\w+\s+\w+\s*\,\s*} $line {} line_expr - set line_aux $directive1 - append line_aux { } $directive0 { } $line_expr - - set loc_result [define_const $directive0 $line_aux $idx $ignore_undefined] - if {$loc_result == 2} { - lappend tmp_asm [list $lineNum $fileNum $line] - set deleteLine 0 - } elseif {$loc_result == 0} { - set fin_result 1 - } - } { - SyntaxError $lineNum $fileNum [mc "Missing name of constant to define"] - } + [lindex $groups 4] && $Enable && + ([lsearch -exact -ascii ${::CompilerConsts::ConstDefinitionDirectives} $directive0] != -1) + } then { + if {[regexp {^\s*\.?\w+\s+\w+\s*\,\s*.+$} $line]} { + Warning $lineNum $fileNum [mc "This formulation is deprecated, consider usage of \"<Const> <Directive> <Value>\" instead"] - # Constant definition (SET EQU BIT ...) - } elseif { - [lindex $groups 4] && $Enable && - ([lsearch -exact -ascii ${CompilerConsts::ConstDefinitionDirectives} $directive1] != -1) - } { - set loc_result [define_const $directive1 $line $idx $ignore_undefined] + set line_expr {} + regsub {^\s*\.?\w+\s+\w+\s*\,\s*} $line {} line_expr + set line_aux $directive1 + append line_aux { } $directive0 { } $line_expr + + set loc_result [define_const $directive0 $line_aux $idx $ignore_undefined] if {$loc_result == 2} { lappend tmp_asm [list $lineNum $fileNum $line] set deleteLine 0 } elseif {$loc_result == 0} { set fin_result 1 } + } else { + SyntaxError $lineNum $fileNum [mc "Missing name of constant to define"] + } + + # Constant definition (SET EQU BIT ...) + } elseif { + [lindex $groups 4] && $Enable && + ([lsearch -exact -ascii ${::CompilerConsts::ConstDefinitionDirectives} $directive1] != -1) + } then { + set loc_result [define_const $directive1 $line $idx $ignore_undefined] + if {$loc_result == 2} { + lappend tmp_asm [list $lineNum $fileNum $line] + set deleteLine 0 + } elseif {$loc_result == 0} { + set fin_result 1 + } # Listing control (LIST, NOLIST) } elseif { - [lindex $groups 1] && ( - ($directive0 == {list}) || - ($directive0 == {nolist}) || - ($directive1 == {list} && [regexp {^\w+:$} $directive0 label]) || - ($directive1 == {nolist} && [regexp {^\w+:$} $directive0 label]) - ) - } { - # Warning messages - if {($directive0 == {list} || $directive0 == {nolist}) && [string length $directive1]} { - Warning $lineNum $fileNum [mc "Directive %s takes no arguments" [string toupper $directive0]] - } elseif {($directive1 == {list} || $directive1 == {nolist}) && [string length [regsub {^\s*\.?\w+:?\s+\.?\w+} $line {}]]} { - Warning $lineNum $fileNum [mc "Directive %s takes no arguments" [string toupper $directive1]] - } + [lindex $groups 1] && ( + ($directive0 == {list}) || + ($directive0 == {nolist}) || + ($directive1 == {list} && [regexp {^\w+:$} $directive0 label]) || + ($directive1 == {nolist} && [regexp {^\w+:$} $directive0 label]) + ) + } then { + # Warning messages + if {($directive0 == {list} || $directive0 == {nolist}) && [string length $directive1]} { + Warning $lineNum $fileNum [mc "Directive %s takes no arguments" [string toupper $directive0]] + } elseif {($directive1 == {list} || $directive1 == {nolist}) && [string length [regsub {^\s*\.?\w+:?\s+\.?\w+} $line {}]]} { + Warning $lineNum $fileNum [mc "Directive %s takes no arguments" [string toupper $directive1]] + } - if {($directive0 == {nolist}) || ($directive1 == {nolist})} { - CodeListing::directive_nolist $idx - } { - CodeListing::directive_list $idx - } + if {($directive0 == {nolist}) || ($directive1 == {nolist})} { + CodeListing::directive_nolist $idx + } else { + CodeListing::directive_list $idx + } - if {($label != {}) && $Enable} { - lappend tmp_asm [list $lineNum $fileNum $label] - set deleteLine 0 - } + if {($label != {}) && $Enable} { + lappend tmp_asm [list $lineNum $fileNum $label] + set deleteLine 0 + } # Active bank selection directive -- in 1st field (USING) } elseif {[lindex $groups 2] && $Enable && ($directive0 == {using})} { @@ -3603,28 +3727,28 @@ namespace eval PreProcessor { # Active bank selection directive -- in 2nd field (USING) } elseif { - [lindex $groups 2] && ($directive1 == {using}) && $Enable - && - ([regexp {^\w+:$} $directive0 label]) - } { - set loc_result [define_active_bank \ - [regsub {^\w+:\s*\.?\w+\s*} $line {}] $ignore_undefined \ - ] - set deleteLine 0 - if {$loc_result == 2} { - lappend tmp_asm [list $lineNum $fileNum $line] - } elseif {$loc_result == 0} { - lappend tmp_asm [list $lineNum $fileNum $label] - set fin_result 1 - } else { - lappend tmp_asm [list $lineNum $fileNum $label] - } + [lindex $groups 2] && ($directive1 == {using}) && $Enable + && + ([regexp {^\w+:$} $directive0 label]) + } then { + set loc_result [define_active_bank \ + [regsub {^\w+:\s*\.?\w+\s*} $line {}] $ignore_undefined \ + ] + set deleteLine 0 + if {$loc_result == 2} { + lappend tmp_asm [list $lineNum $fileNum $line] + } elseif {$loc_result == 0} { + lappend tmp_asm [list $lineNum $fileNum $label] + set fin_result 1 + } else { + lappend tmp_asm [list $lineNum $fileNum $label] + } # Data segment selection (XSEG DSEG ...) } elseif { [lindex $groups 3] && $Enable && - ([lsearch -exact -ascii ${CompilerConsts::ConstDataSegmentSelectionDirectives} $directive0] != -1) - } { + ([lsearch -exact -ascii ${::CompilerConsts::ConstDataSegmentSelectionDirectives} $directive0] != -1) + } then { set loc_result [data_segment_selection \ $directive0 $directive1 $line $idx $ignore_undefined \ ] @@ -3635,11 +3759,32 @@ namespace eval PreProcessor { set fin_result 1 } + # ORG in other than CODE segment + } elseif { + $directive0 == {org} || $directive1 == {org} + } then { + if {$selected_segment != {cseg}} { + regsub {org} $line "$selected_segment at" line + + set address {} + if {$directive0 == {org}} { + set address [ComputeExpr $directive1] + } elseif {$directive1 == {org}} { + set address [ComputeExpr [regsub {^\w+:\s*\.?\w+\s*} $line {}]] + } + if {$address != {}} { + set segment_pointer($selected_segment) $address + } + } + + lappend tmp_asm [list $lineNum $fileNum $line] + set deleteLine 0 + # Data memory reservation -- without label (DBIT 125) } elseif { [lindex $groups 5] && $Enable && - ([lsearch -exact -ascii ${CompilerConsts::ConstDataMemoryReservationDirectives} $directive0] != -1) - } { + ([lsearch -exact -ascii ${::CompilerConsts::ConstDataMemoryReservationDirectives} $directive0] != -1) + } then { regsub {^\.?\w+\s*} $line {} value set loc_result [data_memory_reservation {} $directive0 $value $idx $ignore_undefined] if {$loc_result == 2} { @@ -3653,8 +3798,8 @@ namespace eval PreProcessor { } elseif { [lindex $groups 5] && [regexp {^\w+:$} $line_first_field] && $Enable && - ([lsearch -exact -ascii ${CompilerConsts::ConstDataMemoryReservationDirectives} $directive1] != -1) - } { + ([lsearch -exact -ascii ${::CompilerConsts::ConstDataMemoryReservationDirectives} $directive1] != -1) + } then { regsub {^\s*\w+:\s*\.?\w+\s*} $line {} value set loc_result [data_memory_reservation \ $line_first_field $directive1 $value $idx $ignore_undefined \ @@ -3666,14 +3811,14 @@ namespace eval PreProcessor { set fin_result 1 } - # Conditional compilation statement -- in 2nd field (IF ELSE ENDIF IFNDEF IFDEF IFN) + # Conditional compilation statement -- in 2nd field (IF ELSE ENDIF IFNDEF IFDEF IFN ELSEIF ELSEIFN ELSEIFDEF ELSEIFNDEF) } elseif { [lindex $groups 0] && ( - [lsearch -ascii -exact {if else endif ifndef ifdef ifn} $directive1] != -1 + [lsearch -ascii -exact {if else endif ifndef ifdef ifn elseif elseifn elseifdef elseifndef} $directive1] != -1 ) && ( [regexp {^\w+:$} $line_first_field label] ) - } { + } then { # Is compilation enabled ? if {$Enable} { lappend tmp_asm [list $lineNum $fileNum $label] @@ -3689,12 +3834,12 @@ namespace eval PreProcessor { } } else { - # Conditional compilation statement -- in 1st field (IF ELSE ENDIF IFNDEF IFDEF IFN) + # Conditional compilation statement -- in 1st field (IF ELSE ENDIF IFNDEF IFDEF IFN ELSEIFN ELSEIFDEF ELSEIFNDEF) if { [lindex $groups 0] && ( - [lsearch -ascii -exact {if else endif ifndef ifdef ifn} $directive0] != -1 + [lsearch -ascii -exact {if else endif ifndef ifdef ifn elseif elseifn elseifdef elseifndef} $directive0] != -1 ) - } { + } then { regsub {^\.?\w+\s*} $line {} value @@ -3704,11 +3849,15 @@ namespace eval PreProcessor { } If_Else_Endif $directive0 $value - } { + } else { # Is compilation enabled ? if {$Enable} { lappend tmp_asm [list $lineNum $fileNum $line] set deleteLine 0 + + if {$directive0 == {cseg} || $directive1 == {cseg}} { + set selected_segment {cseg} + } } } } @@ -3787,7 +3936,7 @@ namespace eval PreProcessor { if {![string length $expr]} { SyntaxError $lineNum $fileNum [mc "Missing size"] set value 1 - } { + } else { set value [ComputeExpr $expr $ignore_undefined] } @@ -3823,10 +3972,10 @@ namespace eval PreProcessor { ($selected_segment != {dseg}) && ($selected_segment != {iseg}) && ($selected_segment != {xseg}) - } { + } then { Warning $lineNum $fileNum [mc "Using `%s' directive, but currently active segment is `%s'" [string toupper $directive] [string toupper $selected_segment]] set seg {dseg} - } { + } else { set seg $selected_segment } @@ -3834,7 +3983,7 @@ namespace eval PreProcessor { return [reserve_memory $label $seg $value $idx] # Unknown request -> compilation error - } { + } else { CompilationError $lineNum $fileNum "Unknown error 4" return 1 } @@ -3907,7 +4056,7 @@ namespace eval PreProcessor { } } - # Check if there is enought free space in the segment + # Check if there is enough free space in the segment set end [expr {$segment_pointer($segment) + $value}] if {$end > $max} { Warning $lineNum $fileNum [mc "Exceeding %s segment boundary by %s $unit." $segment_name [expr {$max - $end}]] @@ -3957,10 +4106,10 @@ namespace eval PreProcessor { set const [string trimright $label {:}] # Assing block pointer to symbolic name specified by label - if {[lsearch -exact -ascii [subst "\$defined_$const_type"] $const] != -1} { + if {[lsearch -exact -ascii [subst -nocommands "\$defined_$const_type"] $const] != -1} { SyntaxError $lineNum $fileNum [mc "Unable redefine constant: %s" $const] return 1 - } { + } else { # Check if this symbol is not already defined if {[isConstAlreadyDefined $const]} { Warning $lineNum $fileNum [mc "Ambiguous symbol definition: %s" $const] @@ -3997,11 +4146,17 @@ namespace eval PreProcessor { set const_name [string tolower $const_name] # Search all lists of symbolic names - if {[lsearch -exact -ascii [concat \ - $defined_BIT $defined_CODE $defined_DATA \ - $defined_IDATA $defined_XDATA $defined_SET \ - $defined_EQU $defined_MACRO $defined_SET_SPEC \ - $defined_EQU_SPEC] $const_name] != -1} { + if { + [lsearch -exact -ascii [concat \ + $defined_BIT $defined_CODE $defined_DATA \ + $defined_IDATA $defined_XDATA $defined_SET \ + $defined_EQU $defined_MACRO $defined_SET_SPEC \ + $defined_EQU_SPEC \ + ${::CompilerConsts::defined_progVectors} \ + ${::CompilerConsts::defined_SFRBitArea} \ + ${::CompilerConsts::defined_SFR} \ + ] $const_name] != -1 + } then { return 1 } return 0 @@ -4021,7 +4176,7 @@ namespace eval PreProcessor { variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) variable segment_pointer ;# Current memory segment pointer - # Change memory segment + # Change memory segment set selected_segment $directive if {[regsub {^\.} [string tolower $line] {}] == $directive} { return 0 @@ -4064,12 +4219,17 @@ namespace eval PreProcessor { } else { set segment_pointer($selected_segment) $value CodeListing::set_addr $idx $value - return 0 + + if {$ignore_undefined} { + return 2 + } else { + return 0 + } } return 1 } - ## Take care of conditional compilation control directives (IF, ELSE, ENDIF) + ## Take care of conditional compilation control directives (IF, ELSE, ENDIF, IFN, IFDEF, IFNDEF, ELSEIF ELSEIFN ELSEIFDEF ELSEIFNDEF) # --auxiliary procedure for 'parse_Consts_and_ConditionalCompilation' # @parm String directive - Directive # @parm String cond - Expression of the condition @@ -4078,9 +4238,11 @@ namespace eval PreProcessor { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable IfElse_map ;# Array: Conditional compilation map ($IfElse_map($level) == $bool) + variable IfElse_pcam ;# Array: Conditional compilation -- Positive condition already met ($IfElse_pcam($level) == $bool) variable IfElse_level ;# Current level of conditional compilation evaluation variable Enable ;# Bool: Compilation enabled (conditional compilation) + set cond_orig $cond switch -- $directive { {if} { # Missing condition expression @@ -4090,10 +4252,14 @@ namespace eval PreProcessor { } # Evaluate the condition expression - set cond [ComputeExpr $cond] - if {$cond == {}} { - SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $cond] - set cond 1 + if {$Enable} { + set cond [ComputeExpr $cond] + if {$cond == {}} { + SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $cond_orig] + set cond 1 + } + } else { + set cond 0 } # Increment counter of nested block level @@ -4101,6 +4267,7 @@ namespace eval PreProcessor { # Adjust map of conditional compilation map and flag "Enable" set IfElse_map($IfElse_level) $cond + set IfElse_pcam($IfElse_level) $cond if {!$Enable || !$cond} { set Enable 0 } @@ -4113,9 +4280,13 @@ namespace eval PreProcessor { } # Evaluate the condition expression - set cond [ComputeExpr $cond] - if {$cond == {}} { - SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $cond] + if {$Enable} { + set cond [ComputeExpr $cond] + if {$cond == {}} { + SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $cond_orig] + set cond 1 + } + } else { set cond 1 } @@ -4127,6 +4298,7 @@ namespace eval PreProcessor { # Adjust map of conditional compilation map and flag "Enable" set IfElse_map($IfElse_level) $cond + set IfElse_pcam($IfElse_level) $cond if {!$Enable || !$cond} { set Enable 0 } @@ -4142,13 +4314,14 @@ namespace eval PreProcessor { } # Evaluate the condition expression - set cond [isConstAlreadyDefined $cond] + set cond [expr {$Enable && [isConstAlreadyDefined $cond]}] # Increment counter of nested block level incr IfElse_level # Adjust map of conditional compilation map and flag "Enable" set IfElse_map($IfElse_level) $cond + set IfElse_pcam($IfElse_level) $cond if {!$Enable || !$cond} { set Enable 0 } @@ -4164,13 +4337,14 @@ namespace eval PreProcessor { } # Evaluate the condition expression - set cond [expr {![isConstAlreadyDefined $cond]}] + set cond [expr {$Enable && ![isConstAlreadyDefined $cond]}] # Increment counter of nested block level incr IfElse_level # Adjust map of conditional compilation map and flag "Enable" set IfElse_map($IfElse_level) $cond + set IfElse_pcam($IfElse_level) $cond if {!$Enable || !$cond} { set Enable 0 } @@ -4178,8 +4352,62 @@ namespace eval PreProcessor { {else} { if {[llength [array names IfElse_map $IfElse_level]] == 0} { SyntaxError $lineNum $fileNum [mc "Unexpected `ELSE'"] - } { - set IfElse_map($IfElse_level) [expr {!$IfElse_map($IfElse_level)}] + } else { + set IfElse_map($IfElse_level) [expr {!$IfElse_pcam($IfElse_level)}] + set Enable 1 + for {set i 1} {$i <= $IfElse_level} {incr i} { + set Enable [expr {$IfElse_map($i) && $Enable}] + } + } + } + {elseifn} - + {elseifdef} - + {elseifndef} - + {elseif} { + if {[llength [array names IfElse_map $IfElse_level]] == 0} { + SyntaxError $lineNum $fileNum [mc "Unexpected `ELSEIF'"] + } else { + # Missing condition expression + if {![string length $cond]} { + SyntaxError $lineNum $fileNum [mc "Missing condition"] + set cond 1 + } + + # Evaluate the condition expression + if { + !$IfElse_pcam($IfElse_level) + && + ($IfElse_level == 1 || $IfElse_map([expr {$IfElse_level - 1}])) + } then { + switch -- $directive { + {elseif} { + set cond [ComputeExpr $cond] + } + {elseifn} { + set cond [ComputeExpr $cond] + if {$cond != {}} { + set cond [expr {!$cond}] + } + } + {elseifdef} { + set cond [isConstAlreadyDefined $cond] + } + {elseifndef} { + set cond [expr {![isConstAlreadyDefined $cond]}] + } + } + if {$cond == {}} { + SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $cond_orig] + set cond 1 + } + } else { + set cond 0 + } + + if {$cond} { + set IfElse_pcam($IfElse_level) 1 + } + set IfElse_map($IfElse_level) $cond set Enable 1 for {set i 1} {$i <= $IfElse_level} {incr i} { set Enable [expr {$IfElse_map($i) && $Enable}] @@ -4197,13 +4425,13 @@ namespace eval PreProcessor { } # Invalid directive usage - } { + } else { incr IfElse_level SyntaxError $lineNum $fileNum [mc "Unexpected `ENDIF'"] } } default { - CompilationError $lineNum $fileNum "`$directive' is not a if/else/endif directive (procedure: If_Else_Endif)" + CompilationError $lineNum $fileNum "`$directive' is not a if/else/endif/ifn/ifdef/ifndef/elseif directive (procedure: If_Else_Endif)" } } } @@ -4239,7 +4467,7 @@ namespace eval PreProcessor { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file - variable ErrorAtLine ;# Bool: Error occured on the current line + variable ErrorAtLine ;# Bool: Error occurred on the current line # Handle directive "FLAG", which has the same meaning as "BIT" if {$directive == {flag}} { @@ -4249,7 +4477,7 @@ namespace eval PreProcessor { # Detrminate 1st field and the last (3rd) field if {![regexp {^\s*\w+} $line const]} { set const {} ;# symbolic name - } { + } else { set const [string tolower [string trim $const]] ;# symbolic name } if {![regsub {^\w+\s+\.?\w+\s+} $line {} value]} { @@ -4266,14 +4494,14 @@ namespace eval PreProcessor { # Does value field contain comma ? if {[string first {,} $value] != -1} { # Is const field an instruction ? - if {[lsearch -exact -ascii ${CompilerConsts::AllInstructions} $const] != -1} { + if {[lsearch -exact -ascii ${::CompilerConsts::AllInstructions} $const] != -1} { # yes -> skip this line if {$ignore_undefined} { return 2 - } { + } else { return 1 } - } { + } else { # no -> remove line & report syntax error SyntaxError $lineNum $fileNum [mc "Invalid expression: `%s'" $value] return 1 @@ -4306,6 +4534,7 @@ namespace eval PreProcessor { Notice $lineNum $fileNum [mc "Special value (with no numerical representation) assigned to constant: %s <- %s" [string toupper $const] [string toupper $value]] set special_value 1 } else { + set value_orig $value set value [ComputeExpr $value $ignore_undefined] } @@ -4314,14 +4543,14 @@ namespace eval PreProcessor { if {$ignore_undefined} { return 2 } - SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $value] + SyntaxError $lineNum $fileNum [mc "Invalid expression `%s'" $value_orig] return 1 } # Adjust code listing if {$special_value} { CodeListing::set_spec_value $idx $value - } { + } else { CodeListing::set_value $idx $value } # Define symbolic name @@ -4360,12 +4589,12 @@ namespace eval PreProcessor { } {data} { if { - ([lsearch -exact -ascii $defined_IDATA $const] != -1) - || - ([lsearch -exact -ascii $defined_DATA $const] != -1) - } { - SyntaxError $lineNum $fileNum [mc "Trying to overwrite constant: %s" $const] - return 1 + ([lsearch -exact -ascii $defined_IDATA $const] != -1) + || + ([lsearch -exact -ascii $defined_DATA $const] != -1) + } then { + SyntaxError $lineNum $fileNum [mc "Trying to overwrite constant: %s" $const] + return 1 } if {$value > 0xFF} { SyntaxError $lineNum $fileNum [mc "Expression out of range"] @@ -4381,12 +4610,12 @@ namespace eval PreProcessor { } {idata} { if { - ([lsearch -exact -ascii $defined_IDATA $const] != -1) - || - ([lsearch -exact -ascii $defined_DATA $const] != -1) - } { - SyntaxError $lineNum $fileNum [mc "Trying to overwrite constant: %s" $const] - return 1 + ([lsearch -exact -ascii $defined_IDATA $const] != -1) + || + ([lsearch -exact -ascii $defined_DATA $const] != -1) + } then { + SyntaxError $lineNum $fileNum [mc "Trying to overwrite constant: %s" $const] + return 1 } if {$value > 0xFF} { SyntaxError $lineNum $fileNum [mc "Expression out of range"] @@ -4426,7 +4655,7 @@ namespace eval PreProcessor { set idx [lsearch -exact -ascii $defined_SET $const] if {$idx != -1} { set defined_SET [lreplace $defined_SET $idx $idx] - } { + } else { set idx [lsearch -exact -ascii $defined_SET_SPEC $const] if {$idx != -1} { set defined_SET_SPEC [lreplace $defined_SET_SPEC $idx $idx] @@ -4440,7 +4669,7 @@ namespace eval PreProcessor { if {$special_value} { set const_EQU_SPEC($const) [string tolower $value] lappend defined_EQU_SPEC $const - } { + } else { set const_EQU($const) $value lappend defined_EQU $const } @@ -4483,19 +4712,19 @@ namespace eval PreProcessor { # Set (new) variable value if {[lsearch -exact -ascii $defined_SET $const] != -1} { Notice $lineNum $fileNum [mc "Setting new variable value: %s <- %s" $const $value] - } { + } else { if {[isConstAlreadyDefined $const]} { Warning $lineNum $fileNum [mc "Ambiguous symbol definition: %s" $const] } if {$special_value} { lappend defined_SET_SPEC $const - } { + } else { lappend defined_SET $const } } if {$special_value} { lappend const_SET_SPEC($const) [list $lineNum $value] - } { + } else { lappend const_SET($const) [list $lineNum $value] } return 0 @@ -4511,18 +4740,19 @@ namespace eval PreProcessor { if { ([lsearch -exact -ascii $defined_SET $const] != -1) || ([lsearch -exact -ascii $defined_EQU $const] != -1) - } { + } then { return 1 - } { + } else { return 0 } } ## Get constant/variable value - # @parm list args - {const_name [lineNumber]} - # @parm Bool special_value = 0 - Allow special values like (A, AB, R0, etc.) + # @parm String const - const_name + # @parm Int line={} -lineNumber + # @parm Bool special_value=0 - Allow special values like (A, AB, R0, etc.) # @return mixed - value or emty string if nothing found - proc const_value args { + proc const_value {const {line {}} {special_value 0}} { variable defined_SET ;# List of variables defined by 'SET' variable defined_EQU ;# List of constants defined by 'EQU' variable const_SET ;# Array: Constants defined by directive 'CODE' @@ -4533,16 +4763,6 @@ namespace eval PreProcessor { variable defined_SET_SPEC ;# List of special variables defined by 'SET' variable defined_EQU_SPEC ;# List of special constants defined by 'EQU' - - # Determinate name of the constant and line number - set const [lindex $args 0] - set line [lindex $args 1] - - set special_value [lindex $args 2] - if {$special_value != 1} { - set special_value 0 - } - # Constants defined by directive 'EQU' if {[lsearch -exact -ascii $defined_EQU $const] != -1} { return $const_EQU($const) @@ -4585,18 +4805,18 @@ namespace eval PreProcessor { } ## Compute value of the given expression - # @parm String - Expression to evaluate - # @parm Bool = 0 - Ignore undefined symbolic names - # @parm Int = {} - Current instruction address (for `$' expansion) + # @parm String expression - Expression to evaluate + # @parm Bool ignore_undefined=0 - Ignore undefined symbolic names + # @parm Int address={} - Current instruction address (for `$' expansion) # @return Int - result or {} - proc ComputeExpr args { + proc ComputeExpr {expression {ignore_undefined 0} {address {}}} { variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable original_expression ;# Auxiliary variable (see proc. 'ComputeExpr') variable tmp ;# General purpose tempotary variable - variable ErrorAtLine ;# Bool: Error occured on the current line + variable ErrorAtLine ;# Bool: Error occurred on the current line variable check_sfr_usage ;# Bool: Check for legal usage of SFR and SFB - variable avaliable_SFR ;# List: Avaliable SFR and SFB on the target MCU + variable available_SFR ;# List: available SFR and SFB on the target MCU variable const_BIT ;# Array: Bit values -- ($const_BIT($bit_name) == $value) variable const_CODE ;# Array: Constants defined by directive 'CODE' @@ -4617,15 +4837,11 @@ namespace eval PreProcessor { variable labels ;# Array: Values of defined labels ($labels($label) == $address) variable defined_LABEL ;# List of defined labels + variable selected_segment ;# Current memory segment (one of {cseg bseg dseg iseg xseg}) + variable segment_pointer ;# Current memory segment pointer + set ErrorAtLine 0 - # Parse arguments - set expression [lindex $args 0] - set ignore_undefined [lindex $args 1] - set address [lindex $args 2] - if {$ignore_undefined == {}} { - set ignore_undefined 0 - } # Make backup copy of the original expression set original_expression $expression @@ -4639,7 +4855,7 @@ namespace eval PreProcessor { if {[regexp {[\(\)]} $expression]} { set left_p 0 set idx 0 - while 1 { + while {1} { set idx [string first {(} $expression $idx] if {$idx == -1} {break} incr idx @@ -4647,7 +4863,7 @@ namespace eval PreProcessor { } set right_p 0 set idx 0 - while 1 { + while {1} { set idx [string first {)} $expression $idx] if {$idx == -1} {break} incr idx @@ -4655,7 +4871,7 @@ namespace eval PreProcessor { } if {$right_p != $left_p} { - SyntaxError $lineNum $fileNum [mc "Invalid expression - paranthesis are not balanced: `%s'" $original_expression] + SyntaxError $lineNum $fileNum [mc "Invalid expression - parentheses are not balanced: `%s'" $original_expression] } } @@ -4678,12 +4894,12 @@ namespace eval PreProcessor { ([string first {low} [string tolower $expression]] != -1) || ([string first {high} [string tolower $expression]] != -1) - } { - foreach operator {low high} \ - before {0xFF&int( int(} \ + } then { + foreach operator {low high} \ + before {0xFF&int( int(} \ after {) )/0x100} \ { - while 1 { + while {1} { if {![regexp -nocase -- "\\s$operator\\s+((\\w+)|(\\(\[^\\(\\)\]+\\)))" $expression str]} { break } @@ -4709,6 +4925,21 @@ namespace eval PreProcessor { foreach word [replace_in_strings $expression { } "\a"] { if {$word == {}} {continue} + # Handle prefix notation for hexadecimal numbers, like 0xfa + if { + [string index $word 0] == {0} + && + ([string index $word 1] == {x} || [string index $word 1] == {X}) + && + [string is xdigit [string index $word 2]] + } then { + set word [string replace $word 0 1] + if {![string is digit [string index $word 0]]} { + set word "0${word}" + } + append word {h} + } + if {[regexp {^\d\w+$} $word] && ![regexp {^\d+$} $word]} { set base [string index $word end] set word [string range $word 0 {end-1}] @@ -4722,37 +4953,37 @@ namespace eval PreProcessor { {h} { if {![NumSystem::ishex $word]} { SyntaxError $lineNum $fileNum [mc "Invalid numeric value: %s (should be hexadecimal number)" "${word}h"] - } { + } else { set word [expr "0x$word"] } } {b} { if {![NumSystem::isbin $word]} { SyntaxError $lineNum $fileNum [mc "Invalid numeric value: %s (should be binary number)" "${word}b"] - } { + } else { set word [NumSystem::bin2dec $word] } } {o} { if {![NumSystem::isoct $word]} { SyntaxError $lineNum $fileNum [mc "Invalid numeric value: %s (should be octal number)" "${word}o"] - } { + } else { set word [NumSystem::oct2dec $word] } } {q} { if {![NumSystem::isoct $word]} { SyntaxError $lineNum $fileNum [mc "Invalid numeric value: %s (should be octal number)" "${word}q"] - } { + } else { set word [NumSystem::oct2dec $word] } } } - } { + } else { if {[string index $word end] == {'}} { if {[string index $word 0] != {'}} { SyntaxError $lineNum $fileNum [mc "Invalid value: `%s' (should be char)" $word] - } { + } else { set word [string range $word 1 end-1] regsub -all "\a" $word { } word set word [character2number [subst -nocommands -novariables $word]] @@ -4767,15 +4998,29 @@ namespace eval PreProcessor { # Expand possible constants and variables foreach word $expression { if {$word == {}} {continue} - # Current instruction address `$' - if {$address != {} && $word == {$}} { - set word $address + # Dollar sign (`$') + if {$word == {$}} { + # Current instruction address + if {$address != {}} { + set word $address + # Address pointer in the selected memory segment + } elseif {$selected_segment != {cseg}} { + set word $segment_pointer($selected_segment) + } elseif {!$ignore_undefined} { + SyntaxError $lineNum $fileNum [mc "Value of `\$' is unknown at this point" $word] + set ErrorAtLine 1 + } + lappend tmp $word continue } # Normal symbolic name - if {![regexp {^[A-Za-z_].*$} $word]} { + if {![regexp {^(\?\?)?[A-Za-z_].*$} $word]} { + set word [string trimleft $word 0] + if {$word == {}} { + set word 0 + } lappend tmp $word continue } @@ -4792,9 +5037,9 @@ namespace eval PreProcessor { if { [lsearch -ascii -exact $::CompilerConsts::defined_SFR $word] != -1 && - [lsearch -ascii -exact $avaliable_SFR $word] == -1 - } { - Warning $lineNum $fileNum [mc "Special function register \"%s\" is not avaliable on the target MCU" [string toupper $word]] + [lsearch -ascii -exact $available_SFR $word] == -1 + } then { + Warning $lineNum $fileNum [mc "Special function register \"%s\" is not available on the target MCU" [string toupper $word]] } } set word $const_DATA($word) @@ -4820,9 +5065,9 @@ namespace eval PreProcessor { if { [lsearch -ascii -exact $::CompilerConsts::defined_SFRBitArea $word] != -1 && - [lsearch -ascii -exact $avaliable_SFR $word] == -1 - } { - Warning $lineNum $fileNum [mc "Special function bit \"%s\" is not avaliable on the target MCU" [string toupper $word]] + [lsearch -ascii -exact $available_SFR $word] == -1 + } then { + Warning $lineNum $fileNum [mc "Special function bit \"%s\" is not available on the target MCU" [string toupper $word]] } } CodeListing::symbol_used $word {bit} @@ -4839,6 +5084,7 @@ namespace eval PreProcessor { return {} } SyntaxError $lineNum $fileNum [mc "Undefined symbol name: %s" $word] + set ErrorAtLine 1 set word 1 } @@ -4853,11 +5099,15 @@ namespace eval PreProcessor { # Compute expression and return possible result if {[catch { set expression [expr "$expression"] - }]} { + }]} then { return {} } - set tmp [expr {int($expression)}] + if {[catch { + set tmp [expr {int($expression)}] + }]} then { + return {} + } if {($tmp - $expression) != 0} { Notice $lineNum $fileNum [mc "Floating point value converted to integer value `%s' -> `%s'" $expression $tmp] } @@ -4880,8 +5130,8 @@ namespace eval PreProcessor { ## Remove comments and redutant white space # @return void proc trim_code {} { - variable asm ;# Resulting precompiled code - variable tmp_asm ;# Tempotary auxiliary precompiled code + variable asm ;# Resulting pre-compiled code + variable tmp_asm ;# Temporary auxiliary pre-compiled code variable lineNum ;# Number of the current line variable fileNum ;# Number of the current file variable idx ;# Current position in asm list @@ -4896,7 +5146,9 @@ namespace eval PreProcessor { incr idx # Update after each 25 iterations - if {[expr {$idx % 25}] == 0} ${::Compiler::Settings::UPDATE_COMMAND} + if {[expr {$idx % 25}] == 0} { + ${::Compiler::Settings::UPDATE_COMMAND} + } if {${::Compiler::Settings::ABORT_VARIABLE}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} [mc "Aborted"] free_resources @@ -4917,10 +5169,10 @@ namespace eval PreProcessor { # Remove comment set tmp_line $line - while 1 { + while {1} { if {[regexp {'[^']*'} $tmp_line str]} { regsub {'[^']*'} $tmp_line [string repeat {_} [string length $str]] tmp_line - } { + } else { break } } @@ -4954,7 +5206,7 @@ namespace eval PreProcessor { # @return String - result proc replace_in_strings {string search replacement} { set idx 0 - while 1 { + while {1} { if {![regexp -start $idx -- {'[^']*'} $string str]} { break } @@ -4980,7 +5232,7 @@ namespace eval PreProcessor { if {[string length $value] == 1} { binary scan $value c value return $value - } { + } else { if {[string index $value 0] == "\\"} { set value [string range $value 1 end] switch -- $value { @@ -5016,7 +5268,7 @@ namespace eval PreProcessor { return {} } } - } { + } else { SyntaxError $lineNum $fileNum [mc "Cannot to use string `%s' as value" $value] return {} } @@ -5024,15 +5276,15 @@ namespace eval PreProcessor { } ## Report error message -- compilation error (bug in compiler ?) - # @parm Int LineNumber - Number of line where the error occured - # @parm Int FileNumber - Number of file where the error occured, {} == unknown + # @parm Int LineNumber - Number of line where the error occurred + # @parm Int FileNumber - Number of file where the error occurred, {} == unknown # @parm String ErrorInfo - Error string # @return void proc CompilationError {LineNumber FileNumber ErrorInfo} { variable included_files ;# List: Unique unsorted list of included files variable working_dir ;# String: Current working directory variable idx ;# Current position in asm list - variable error_count ;# Number of errors occured + variable error_count ;# Number of errors occurred # Increment error counter incr error_count @@ -5050,14 +5302,14 @@ namespace eval PreProcessor { set filename "\"$filename\"" } set filename [mc " in %s" $filename] - } { + } else { set 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\033\[m at \033\[31;1;4m%s\033\[m%s: %s" $LineNumber $filename $ErrorInfo] } @@ -5065,8 +5317,8 @@ namespace eval PreProcessor { } ## Report notice - # @parm Int LineNumber - Number of line where it occured - # @parm Int FileNumber - Number of file where the error occured, {} == unknown + # @parm Int LineNumber - Number of line where it occurred + # @parm Int FileNumber - Number of file where the error occurred, {} == unknown # @parm String ErrorInfo - Text of the notice # @return void proc Notice {LineNumber FileNumber ErrorInfo} { @@ -5082,14 +5334,14 @@ namespace eval PreProcessor { set filename "\"$filename\"" } set filename [mc " in %s" $filename] - } { + } else { set filename {} } if {${::Compiler::Settings::WARNING_LEVEL} < 1} { if {${::Compiler::Settings::NOCOLOR}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [::Compiler::msgc {WL}][mc "Notice at %s: %s" "$LineNumber$filename" $ErrorInfo] - } { + } else { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [mc "\033\[33;1mNotice\033\[m at \033\[33;1;4m%s\033\[m%s: %s" $LineNumber $filename $ErrorInfo] } @@ -5097,15 +5349,15 @@ namespace eval PreProcessor { } ## Report warning message - # @parm Int LineNumber - Number of line where it occured - # @parm Int FileNumber - Number of file where the error occured, {} == unknown + # @parm Int LineNumber - Number of line where it occurred + # @parm Int FileNumber - Number of file where the error occurred, {} == unknown # @parm String ErrorInfo - Text of the warning # @return void proc Warning {LineNumber FileNumber ErrorInfo} { variable working_dir ;# String: Current working directory variable included_files ;# List: Unique unsorted list of included files variable idx ;# Current position in asm list - variable warning_count ;# Number of warnings occured + variable warning_count ;# Number of warnings occurred # Increment warning counter incr warning_count @@ -5123,32 +5375,32 @@ namespace eval PreProcessor { set filename "\"$filename\"" } set filename [mc " in %s" $filename] - } { + } else { set filename {} } if {${::Compiler::Settings::WARNING_LEVEL} < 2} { if {${::Compiler::Settings::NOCOLOR}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [::Compiler::msgc {WL}][mc "Warning at %s: %s" "$LineNumber$filename" $ErrorInfo] - } { + } else { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [mc "\033\[33mWarning\033\[m at \033\[33;4m%s\033\[m%s: %s" $LineNumber $filename $ErrorInfo] } } } - ## Report error message -- syntax error (badly formated input code) - # @parm Int LineNumber - Number of line where the error occured - # @parm Int FileNumber - Number of file where the error occured, {} == unknown + ## Report error message -- syntax error (badly formatted input code) + # @parm Int LineNumber - Number of line where the error occurred + # @parm Int FileNumber - Number of file where the error occurred, {} == unknown # @parm String ErrorInfo - Error string # @return void proc SyntaxError {LineNumber FileNumber ErrorInfo} { variable working_dir ;# String: Current working directory variable included_files ;# List: Unique unsorted list of included files variable idx ;# Current position in asm list - variable error_count ;# Number of errors occured - variable ErrorAtLine ;# Bool: Error occured on the current line - variable Error ;# Bool: An error occured during precompilation + variable error_count ;# Number of errors occurred + variable ErrorAtLine ;# Bool: Error occurred on the current line + variable Error ;# Bool: An error occurred during precompilation # Adjust NS variable incr error_count @@ -5168,17 +5420,21 @@ namespace eval PreProcessor { set filename "\"$filename\"" } set filename [mc " in %s" $filename] - } { + } else { set filename {} } if {${::Compiler::Settings::WARNING_LEVEL} < 3} { if {${::Compiler::Settings::NOCOLOR}} { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [::Compiler::msgc {EL}][mc "Syntax error at %s: %s" "$LineNumber$filename" $ErrorInfo] - } { + } else { ${::Compiler::Settings::TEXT_OUPUT_COMMAND} \ [mc "\033\[31;1mSyntax error\033\[m at \033\[31;1;4m%s\033\[m%s: %s" $LineNumber $filename $ErrorInfo] } } } } + +# >>> File inclusion guard +} +# <<< File inclusion guard |