source -> include resolves #202

commit a315d38995baf1d72652253732f3a57a2d7de78d
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sun Mar 30 15:23:22 2025 -0700

    rel 2.6.1

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

commit 601835018251b178742524759aab67ddbceedaa1
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sun Mar 30 10:04:32 2025 -0700

    ctclreadline init

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

commit f664563ee2428a4945599bc2c99a164c5dbeb364
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sat Mar 29 17:05:14 2025 -0700

    include doc

    Signed-off-by: James Cherry <cherry@parallaxsw.com>
    Acked-by: James Cherry <cherry@parallaxsw.com>

commit 780fe69237af280f1766a57888256d5cacf459a3
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sat Mar 29 16:50:40 2025 -0700

    include_file error

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

commit 6ed0c879191085574ff51e12f006e9a13f80d202
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sat Mar 29 16:38:44 2025 -0700

    sdc_filename sdc_file_line

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

commit 0c9a626d04cff5df000f50a2aab6111f1ed0d959
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sat Mar 29 14:40:35 2025 -0700

    sta_error/warn lineno

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

commit a10aba9b52d9a40b8bb56a337d169b9156e73017
Author: James Cherry <cherry@parallaxsw.com>
Date:   Sat Mar 29 08:48:52 2025 -0700

    source -> include

    Signed-off-by: James Cherry <cherry@parallaxsw.com>

Signed-off-by: James Cherry <cherry@parallaxsw.com>
This commit is contained in:
James Cherry 2025-03-30 15:24:10 -07:00
parent cee37e537f
commit a25d72c7be
6 changed files with 151 additions and 149 deletions

View File

@ -98,10 +98,10 @@ sourceTclFile(const char *filename,
Tcl_Interp *interp)
{
string cmd;
stringPrint(cmd, "source %s%s%s",
echo ? "-echo " : "",
verbose ? "-verbose " : "",
filename);
stringPrint(cmd, "sta::include_file %s %s %s",
filename,
echo ? "1" : "0",
verbose ? "1" : "0");
int code = Tcl_Eval(interp, cmd.c_str());
const char *result = Tcl_GetStringResult(interp);
if (result[0] != '\0')

View File

@ -3,6 +3,19 @@ OpenSTA Timing Analyzer Release Notes
This file summarizes user visible changes for each release.
Realase 2.6.1 2025/03/30
-------------------------
The Tcl "source" command is no longer redefined to support "-echo" and
"-verbose" arguments and redirecton. Use the "include" command instead.
include [-echo] [-verbose] filename [> filename] [>> filename]
-echo echos commands as they are read
-verbose prints command results as they are evaluated
Unlike the Tcl source command, "include" expands filenames with tilda '~'
and respects sta_continue_on_error.
Release 2.6.0 2024/07/22
-------------------------

Binary file not shown.

Binary file not shown.

View File

@ -43,131 +43,7 @@ proc_redirect read_sdc {
set echo [info exists flags(-echo)]
set filename [file nativename [lindex $args 0]]
set prev_filename [info script]
try {
info script $filename
source_ $filename $echo 0
} finally {
info script $prev_filename
}
}
################################################################
# The builtin Tcl "source" command is redefined by sta.
# This rename provides a mechanism to refer to the original TCL
# command.
# Protected so this file can be reloaded without blowing up.
if { ![info exists renamed_source] } {
rename source builtin_source
set renamed_source 1
}
set ::sta_continue_on_error 0
define_cmd_args "source" \
{[-echo] [-verbose] filename [> filename] [>> filename]}
# Override source to support -echo and return codes.
proc_redirect source {
parse_key_args "source" args keys {-encoding} flags {-echo -verbose}
if { [llength $args] != 1 } {
cmd_usage_error "source"
}
set echo [info exists flags(-echo)]
set verbose [info exists flags(-verbose)]
set filename [file nativename [lindex $args 0]]
set prev_filename [info script]
try {
info script $filename
source_ $filename $echo $verbose
} finally {
info script $prev_filename
}
}
proc source_ { filename echo verbose } {
global sta_continue_on_error
variable sdc_file
variable sdc_line
if [catch {open $filename r} stream] {
sta_error 340 "cannot open '$filename'."
} else {
if { [file extension $filename] == ".gz" } {
if { [info commands zlib] == "" } {
sta_error 339 "tcl version > 8.6 required for zlib support."
}
zlib push gunzip $stream
}
# Save file and line in recursive call to source.
if { [info exists sdc_file] } {
set sdc_file_save $sdc_file
set sdc_line_save $sdc_line
}
set sdc_file $filename
set sdc_line 1
set cmd ""
set error {}
while {![eof $stream]} {
gets $stream line
if { $line != "" } {
if {$echo} {
report_line $line
}
}
append cmd $line "\n"
if { [string index $line end] != "\\" \
&& [info complete $cmd] } {
set error {}
set error_code [catch {uplevel \#0 $cmd} result]
# cmd consumed
set cmd ""
# Flush results printed outside tcl to stdout/stderr.
fflush
switch $error_code {
0 { if { $verbose && $result != "" } { report_line $result } }
1 { set error $result }
2 { set error {invoked "return" outside of a proc.} }
3 { set error {invoked "break" outside of a loop.} }
4 { set error {invoked "continue" outside of a loop.} }
}
if { $error != {} } {
if { $sta_continue_on_error } {
# Only prepend error message with file/line once.
if { [string first "Error" $error] == 0 } {
report_line $error
} else {
report_line "Error: [file tail $sdc_file], $sdc_line $error"
}
set error {}
} else {
break
}
}
}
incr sdc_line
}
close $stream
if { $cmd != {} } {
sta_error 341 "incomplete command at end of file."
}
set error_sdc_file $sdc_file
set error_sdc_line $sdc_line
if { [info exists sdc_file_save] } {
set sdc_file $sdc_file_save
set sdc_line $sdc_line_save
} else {
unset sdc_file
unset sdc_line
}
if { $error != {} } {
# Only prepend error message with file/line once.
if { [string first "Error" $error] == 0 } {
error $error
} else {
error "Error: [file tail $error_sdc_file], $error_sdc_line $error"
}
}
}
include_file $filename $echo 0
}
################################################################
@ -1355,15 +1231,8 @@ proc group_path { args } {
}
proc check_exception_pins { from to } {
variable sdc_file
variable sdc_line
if { [info exists sdc_file] } {
set file $sdc_file
set line $sdc_line
} else {
set file ""
set line 0
}
set file [sdc_filename]
set line [sdc_file_line]
check_exception_from_pins $from $file $line
check_exception_to_pins $to $file $line
}

View File

@ -188,28 +188,42 @@ proc define_hidden_cmd_args { cmd arglist } {
################################################################
proc sta_warn { msg_id msg } {
variable sdc_file
variable sdc_line
if { [info exists sdc_file] } {
report_file_warn $msg_id [file tail $sdc_file] $sdc_line $msg
if { [sdc_filename] != "" } {
report_file_warn $msg_id [file tail [sdc_filename]] [sdc_file_line] $msg
} else {
report_warn $msg_id $msg
}
}
proc sta_error { msg_id msg } {
variable sdc_file
variable sdc_line
if { ! [is_suppressed $msg_id] } {
if { [info exists sdc_file] } {
error "Error: [file tail $sdc_file] line $sdc_line, $msg"
if { [sdc_filename] != "" } {
error "Error: [file tail [sdc_filename]] line [sdc_file_line], $msg"
} else {
error "Error: $msg"
}
}
}
proc sdc_filename {} {
return [info script]
}
proc sdc_file_line { } {
variable include_line
for { set fr [info frame] } { $fr >= 0 } { incr fr -1 } {
set type [dict get [info frame $fr] type]
if { $type == "source" } {
return [dict get [info frame $fr] line]
}
if { $type == "proc" \
&& [lindex [dict get [info frame $fr] cmd] 0] == "include_file" } {
return $include_line
}
}
return 1
}
proc sta_warn_error { msg_id warn_error msg } {
if { $warn_error == "warn" } {
sta_warn $msg_id $msg
@ -347,6 +361,112 @@ proc check_percent { cmd_arg arg } {
}
}
################################################################
set ::sta_continue_on_error 0
define_cmd_args "include" \
{[-echo] filename [> filename] [>> filename]}
# Tcl "source" command analog to support -echo and -verbose return values.
proc_redirect include {
parse_key_args "include" args keys {-encoding} flags {-echo -verbose}
if { [llength $args] != 1 } {
cmd_usage_error "include"
}
set echo [info exists flags(-echo)]
set verbose [info exists flags(-verbose)]
set filename [file nativename [lindex $args 0]]
include_file $filename $echo $verbose
}
proc include_file { filename echo verbose } {
global sta_continue_on_error
variable include_line
set prev_filename [info script]
if { [info exists include_line] } {
set prev_line $include_line
}
try {
# set filename/line for sta_warn/error
info script $filename
set include_line 1
if [catch {open $filename r} stream] {
sta_error 340 "cannot open '$filename'."
} else {
if { [file extension $filename] == ".gz" } {
if { [info commands zlib] == "" } {
sta_error 339 "tcl version > 8.6 required for zlib support."
}
zlib push gunzip $stream
}
set cmd ""
set error {}
while {![eof $stream]} {
gets $stream line
if { $line != "" } {
if {$echo} {
report_line $line
}
}
append cmd $line "\n"
if { [string index $line end] != "\\" \
&& [info complete $cmd] } {
set error {}
set error_code [catch {uplevel \#0 $cmd} result]
# cmd consumed
set cmd ""
# Flush results printed outside tcl to stdout/stderr.
fflush
switch $error_code {
0 { if { $verbose && $result != "" } { report_line $result } }
1 { set error $result }
2 { set error {invoked "return" outside of a proc.} }
3 { set error {invoked "break" outside of a loop.} }
4 { set error {invoked "continue" outside of a loop.} }
}
if { $error != {} } {
if { $sta_continue_on_error } {
# Only prepend error message with file/line once.
if { [string first "Error" $error] == 0 } {
report_line $error
} else {
report_line "Error: [file tail $filename], $include_line $error"
}
set error {}
} else {
break
}
}
}
incr include_line
}
close $stream
if { $cmd != {} } {
sta_error 341 "incomplete command at end of file."
}
if { $error != {} } {
# Only prepend error message with file/line once.
if { [string first "Error" $error] == 0 } {
error $error
} else {
error "Error: [file tail $filename], $include_line $error"
}
}
}
} finally {
if { $prev_filename != "" } {
info script $prev_filename
}
if { [info exists prev_line] } {
set include_line $prev_line
} else {
unset include_line
}
}
}
# sta namespace end
}
@ -362,7 +482,7 @@ proc sta_unknown { args } {
if { [llength $args] == 1 && [is_bus_subscript $args] } {
return "\[$args\]"
}
# Command name abbreviation support.
set ret [catch {set cmds [info commands $name*]} msg]
if {[string equal $name "::"]} {
@ -371,7 +491,7 @@ proc sta_unknown { args } {
if { $ret != 0 } {
return -code $ret -errorcode $errorCode \
"Error in unknown while checking if \"$name\" is a unique command abbreviation: $msg."
}
}
if { [llength $cmds] == 1 } {
return [uplevel 1 [lreplace $args 0 0 $cmds]]
}