luke
/
OpenSTA
mirror of https://github.com/The-OpenROAD-Project/OpenSTA.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Tcl 9 compatibility changes (#414) 

* Provide close2proc function to prevent tcl9 from crashing.

Tcl 9 does not test if the close2Proc function pointer is non-null,
but calls it unconditionally:
https://github.com/tcltk/tcl/blob/core-9-0-3/generic/tclIO.c#L384

So we need to provide a non-null function pointer for our code
to not crash with Tcl9.

Use the same implementation as the previous close channel
had.

Signed-off-by: Henner Zeller <h.zeller@acm.org>

* Use non-deprecated trace add variable syntax.

In modern tcl, `trace variable` is now i`trace add variable`,
and `"rw"` should be spelled out as `{read write}`
There were backwards compatible forms in Tcl 8.x but now loudly
complains in Tcl 9

Signed-off-by: Henner Zeller <h.zeller@acm.org>

* Use `Tcl_Size` for all tcl functions returning sizes.

This is the type the Tcl-API provides in its prototypes and
starting from Tcl9 this typedef actually changes from `int` to `long`,
so will no longer compile when passing an `int*`.

So whenever we get a return value of this type, use the
correct typedef to declare the variable. This makes it forward and
backward compatible.

Signed-off-by: Henner Zeller <h.zeller@acm.org>

* Address review comments: compare with `read`/`write` not `r`, `w`

Signed-off-by: Henner Zeller <h.zeller@acm.org>

---------

Signed-off-by: Henner Zeller <h.zeller@acm.org>
This commit is contained in:
Henner Zeller 2026-04-03 20:02:25 +02:00 committed by GitHub
parent 4180288868
commit e8218f2db1
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 80 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
tcl/StaTclTypes.i
View File

@ -280,7 +280,7 @@ using namespace sta;
}
%typemap(in) std::string_view {
int length;
Tcl_Size length;
const char *str = Tcl_GetStringFromObj($input, &length);
$1 = std::string_view(str, length);
}
@ -415,7 +415,7 @@ using namespace sta;
}
%typemap(in) Transition* {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
Transition *tr = Transition::find(std::string_view(arg, length));
if (tr == nullptr) {
@ -433,7 +433,7 @@ using namespace sta;
}
%typemap(in) RiseFall* {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
const RiseFall *rf = RiseFall::find(std::string_view(arg, length));
if (rf == nullptr) {
@ -451,7 +451,7 @@ using namespace sta;
}
%typemap(in) RiseFallBoth* {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
const RiseFallBoth *rf = RiseFallBoth::find(std::string_view(arg, length));
if (rf == nullptr) {
@ -469,7 +469,7 @@ using namespace sta;
}
%typemap(in) PortDirection* {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
PortDirection *dir = PortDirection::find(arg);
if (dir == nullptr) {
@ -481,7 +481,7 @@ using namespace sta;
}
%typemap(in) TimingRole* {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
const TimingRole *role = TimingRole::find(arg);
if (role)
@ -498,7 +498,7 @@ using namespace sta;
}
%typemap(in) LogicValue {
int length;
Tcl_Size length;
std::string arg = Tcl_GetStringFromObj($input, &length);
if (arg == "0" || stringEqual(arg, "zero"))
$1 = LogicValue::zero;
@ -517,7 +517,7 @@ using namespace sta;
}
%typemap(in) AnalysisType {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "single"))
$1 = AnalysisType::single;
@ -831,7 +831,7 @@ using namespace sta;
}
%typemap(in) MinMax* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
MinMax *min_max = const_cast<MinMax*>(MinMax::find(arg));
@ -852,7 +852,7 @@ using namespace sta;
}
%typemap(in) MinMaxAll* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
MinMaxAll *min_max = const_cast<MinMaxAll*>(MinMaxAll::find(arg));
@ -865,7 +865,7 @@ using namespace sta;
}
%typemap(in) MinMaxAllNull* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "NULL"))
$1 = nullptr;
@ -887,7 +887,7 @@ using namespace sta;
// SetupHold is typedef'd to MinMax.
%typemap(in) const SetupHold* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
if (stringEqual(arg, "hold")
@ -904,7 +904,7 @@ using namespace sta;
// SetupHoldAll is typedef'd to MinMaxAll.
%typemap(in) const SetupHoldAll* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
if (stringEqual(arg, "hold")
@ -925,7 +925,7 @@ using namespace sta;
// EarlyLate is typedef'd to MinMax.
%typemap(in) const EarlyLate* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
EarlyLate *early_late = const_cast<EarlyLate*>(EarlyLate::find(arg));
@ -939,7 +939,7 @@ using namespace sta;
// EarlyLateAll is typedef'd to MinMaxAll.
%typemap(in) const EarlyLateAll* {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
// Swig is retarded and drops const on args.
EarlyLateAll *early_late = const_cast<EarlyLateAll*>(EarlyLateAll::find(arg));
@ -952,7 +952,7 @@ using namespace sta;
}
%typemap(in) TimingDerateType {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "net_delay"))
$1 = TimingDerateType::net_delay;
@ -967,7 +967,7 @@ using namespace sta;
}
%typemap(in) TimingDerateCellType {
int length;
Tcl_Size length;
char *arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "cell_delay"))
$1 = TimingDerateCellType::cell_delay;
@ -980,7 +980,7 @@ using namespace sta;
}
%typemap(in) PathClkOrData {
int length;
Tcl_Size length;
std::string arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "clk"))
$1 = PathClkOrData::clk;
@ -993,7 +993,7 @@ using namespace sta;
}
%typemap(in) ReportSortBy {
int length;
Tcl_Size length;
std::string arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "group"))
$1 = sort_by_group;
@ -1006,7 +1006,7 @@ using namespace sta;
}
%typemap(in) ReportPathFormat {
int length;
Tcl_Size length;
std::string arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "full"))
$1 = ReportPathFormat::full;
@ -1188,7 +1188,7 @@ using namespace sta;
if (Tcl_ListObjGetElements(interp, $input, &argc, &argv) == TCL_OK
&& argc > 0) {
for (int i = 0; i < argc; i++) {
int length;
Tcl_Size length;
const char *mode_name = Tcl_GetStringFromObj(argv[i], &length);
Mode *mode = sta->findMode(mode_name);
if (mode)
@ -1215,7 +1215,7 @@ using namespace sta;
%typemap(in) Scene* {
sta::Sta *sta = Sta::sta();
int length;
Tcl_Size length;
std::string scene_name = Tcl_GetStringFromObj($input, &length);
// parse_scene_or_all support depreated 11/21/2025
if (scene_name == "NULL")
@ -1248,7 +1248,7 @@ using namespace sta;
if (Tcl_ListObjGetElements(interp, $input, &argc, &argv) == TCL_OK
&& argc > 0) {
for (int i = 0; i < argc; i++) {
int length;
Tcl_Size length;
const char *scene_name = Tcl_GetStringFromObj(argv[i], &length);
Scene *scene = sta->findScene(scene_name);
if (scene)
@ -1274,7 +1274,7 @@ using namespace sta;
}
%typemap(in) PropertyValue {
int length;
Tcl_Size length;
const char *arg = Tcl_GetStringFromObj($input, &length);
$1 = PropertyValue(arg);
}
@ -1411,7 +1411,7 @@ using namespace sta;
}
%typemap(in) CircuitSim {
int length;
Tcl_Size length;
std::string arg = Tcl_GetStringFromObj($input, &length);
if (stringEqual(arg, "hspice"))
$1 = CircuitSim::hspice;

10
tcl/TclTypeHelpers.cc
View File

@ -40,7 +40,7 @@ tclListStringSeq(Tcl_Obj *const source,
StringSeq seq;
if (Tcl_ListObjGetElements(interp, source, &argc, &argv) == TCL_OK) {
for (int i = 0; i < argc; i++) {
int length;
Tcl_Size length;
const char *str = Tcl_GetStringFromObj(argv[i], &length);
seq.push_back(str);
}
@ -58,7 +58,7 @@ tclListStringSeqPtr(Tcl_Obj *const source,
if (Tcl_ListObjGetElements(interp, source, &argc, &argv) == TCL_OK) {
StringSeq *seq = new StringSeq;
for (int i = 0; i < argc; i++) {
int length;
Tcl_Size length;
const char *str = Tcl_GetStringFromObj(argv[i], &length);
seq->push_back(str);
}
@ -78,7 +78,7 @@ tclListStringSet(Tcl_Obj *const source,
if (Tcl_ListObjGetElements(interp, source, &argc, &argv) == TCL_OK) {
StringSet *set = new StringSet;
for (int i = 0; i < argc; i++) {
int length;
Tcl_Size length;
const char *str = Tcl_GetStringFromObj(argv[i], &length);
set->insert(str);
}
@ -183,11 +183,11 @@ arcDcalcArgTcl(Tcl_Obj *obj,
{
Sta *sta = Sta::sta();
sta->ensureGraph();
int list_argc;
Tcl_Size list_argc;
Tcl_Obj **list_argv;
if (Tcl_ListObjGetElements(interp, obj, &list_argc, &list_argv) == TCL_OK) {
const char *input_delay = "0.0";
int length;
Tcl_Size length;
if (list_argc == 6)
input_delay = Tcl_GetStringFromObj(list_argv[5], &length);
if (list_argc == 5 || list_argc == 6) {

48
tcl/Variables.tcl
View File

@ -33,13 +33,13 @@ namespace eval sta {
# Default digits to print after decimal point for reporting commands.
set ::sta_report_default_digits 2
trace variable ::sta_report_default_digits "rw" \
trace add variable ::sta_report_default_digits {read write} \
sta::trace_report_default_digits
proc trace_report_default_digits { name1 name2 op } {
global sta_report_default_digits
if { $op == "w" } {
if { $op == "write" } {
if { !([string is integer $sta_report_default_digits] \
&& $sta_report_default_digits >= 0) } {
sta_error 590 "sta_report_default_digits must be a positive integer."
@ -47,7 +47,7 @@ proc trace_report_default_digits { name1 name2 op } {
}
}
trace variable ::sta_crpr_enabled "rw" \
trace add variable ::sta_crpr_enabled {read write} \
sta::trace_crpr_enabled
proc trace_crpr_enabled { name1 name2 op } {
@ -55,15 +55,15 @@ proc trace_crpr_enabled { name1 name2 op } {
crpr_enabled set_crpr_enabled
}
trace variable ::sta_crpr_mode "rw" \
trace add variable ::sta_crpr_mode {read write} \
sta::trace_crpr_mode
proc trace_crpr_mode { name1 name2 op } {
global sta_crpr_mode
if { $op == "r" } {
if { $op == "read" } {
set sta_crpr_mode [crpr_mode]
} elseif { $op == "w" } {
} elseif { $op == "write" } {
if { $sta_crpr_mode == "same_pin" || $sta_crpr_mode == "same_transition" } {
set_crpr_mode $sta_crpr_mode
} else {
@ -72,7 +72,7 @@ proc trace_crpr_mode { name1 name2 op } {
}
}
trace variable ::sta_cond_default_arcs_enabled "rw" \
trace add variable ::sta_cond_default_arcs_enabled {read write} \
sta::trace_cond_default_arcs_enabled
proc trace_cond_default_arcs_enabled { name1 name2 op } {
@ -80,7 +80,7 @@ proc trace_cond_default_arcs_enabled { name1 name2 op } {
cond_default_arcs_enabled set_cond_default_arcs_enabled
}
trace variable ::sta_gated_clock_checks_enabled "rw" \
trace add variable ::sta_gated_clock_checks_enabled {read write} \
sta::trace_gated_clk_checks_enabled
proc trace_gated_clk_checks_enabled { name1 name2 op } {
@ -88,7 +88,7 @@ proc trace_gated_clk_checks_enabled { name1 name2 op } {
gated_clk_checks_enabled set_gated_clk_checks_enabled
}
trace variable ::sta_internal_bidirect_instance_paths_enabled "rw" \
trace add variable ::sta_internal_bidirect_instance_paths_enabled {read write} \
sta::trace_internal_bidirect_instance_paths_enabled
proc trace_internal_bidirect_instance_paths_enabled { name1 name2 op } {
@ -96,7 +96,7 @@ proc trace_internal_bidirect_instance_paths_enabled { name1 name2 op } {
bidirect_inst_paths_enabled set_bidirect_inst_paths_enabled
}
trace variable ::sta_clock_through_tristate_enabled "rw" \
trace add variable ::sta_clock_through_tristate_enabled {read write} \
sta::trace_clock_through_tristate_enabled
proc trace_clock_through_tristate_enabled { name1 name2 op } {
@ -104,7 +104,7 @@ proc trace_clock_through_tristate_enabled { name1 name2 op } {
clk_thru_tristate_enabled set_clk_thru_tristate_enabled
}
trace variable ::sta_preset_clear_arcs_enabled "rw" \
trace add variable ::sta_preset_clear_arcs_enabled {read write} \
sta::trace_preset_clr_arcs_enabled
proc trace_preset_clr_arcs_enabled { name1 name2 op } {
@ -112,7 +112,7 @@ proc trace_preset_clr_arcs_enabled { name1 name2 op } {
preset_clr_arcs_enabled set_preset_clr_arcs_enabled
}
trace variable ::sta_recovery_removal_checks_enabled "rw" \
trace add variable ::sta_recovery_removal_checks_enabled {read write} \
sta::trace_recovery_removal_checks_enabled
proc trace_recovery_removal_checks_enabled { name1 name2 op } {
@ -120,7 +120,7 @@ proc trace_recovery_removal_checks_enabled { name1 name2 op } {
recovery_removal_checks_enabled set_recovery_removal_checks_enabled
}
trace variable ::sta_dynamic_loop_breaking "rw" \
trace add variable ::sta_dynamic_loop_breaking {read write} \
sta::trace_dynamic_loop_breaking
proc trace_dynamic_loop_breaking { name1 name2 op } {
@ -128,7 +128,7 @@ proc trace_dynamic_loop_breaking { name1 name2 op } {
dynamic_loop_breaking set_dynamic_loop_breaking
}
trace variable ::sta_input_port_default_clock "rw" \
trace add variable ::sta_input_port_default_clock {read write} \
sta::trace_input_port_default_clock
proc trace_input_port_default_clock { name1 name2 op } {
@ -136,7 +136,7 @@ proc trace_input_port_default_clock { name1 name2 op } {
use_default_arrival_clock set_use_default_arrival_clock
}
trace variable ::sta_propagate_all_clocks "rw" \
trace add variable ::sta_propagate_all_clocks {read write} \
sta::trace_propagate_all_clocks
proc trace_propagate_all_clocks { name1 name2 op } {
@ -144,7 +144,7 @@ proc trace_propagate_all_clocks { name1 name2 op } {
propagate_all_clocks set_propagate_all_clocks
}
trace variable ::sta_propagate_gated_clock_enable "rw" \
trace add variable ::sta_propagate_gated_clock_enable {read write} \
sta::trace_propagate_gated_clock_enable
proc trace_propagate_gated_clock_enable { name1 name2 op } {
@ -152,15 +152,15 @@ proc trace_propagate_gated_clock_enable { name1 name2 op } {
propagate_gated_clock_enable set_propagate_gated_clock_enable
}
trace variable ::sta_pocv_mode "rw" \
trace add variable ::sta_pocv_mode {read write} \
sta::trace_pocv_mode
proc trace_pocv_mode { name1 name2 op } {
global sta_pocv_mode
if { $op == "r" } {
if { $op == "read" } {
set sta_pocv_mode [pocv_mode]
} elseif { $op == "w" } {
} elseif { $op == "write" } {
if { $sta_pocv_mode == "scalar" \
|| $sta_pocv_mode == "normal" \
|| $sta_pocv_mode == "skew_normal" } {
@ -171,15 +171,15 @@ proc trace_pocv_mode { name1 name2 op } {
}
}
trace variable ::sta_pocv_quantile "rw" \
trace add variable ::sta_pocv_quantile {read write} \
sta::trace_pocv_quantile
proc trace_pocv_quantile { name1 name2 op } {
global sta_pocv_quantile
if { $op == "r" } {
if { $op == "read" } {
set sta_pocv_quantile [pocv_quantile]
} elseif { $op == "w" } {
} elseif { $op == "write" } {
if { [string is double $sta_pocv_quantile] \
&& $sta_pocv_quantile >= 0.0 } {
set_pocv_quantile $sta_pocv_quantile
@ -194,9 +194,9 @@ proc trace_pocv_quantile { name1 name2 op } {
proc trace_boolean_var { op var_name get_proc set_proc } {
upvar 1 $var_name var
if { $op == "r" } {
if { $op == "read" } {
set var [$get_proc]
} elseif { $op == "w" } {
} elseif { $op == "write" } {
if { $var == 0 } {
$set_proc 0
} elseif { $var == 1 } {

33
util/ReportTcl.cc
View File

@ -72,6 +72,11 @@ encapGetHandleProc(ClientData instanceData,
static int
encapBlockModeProc(ClientData instanceData, int mode);
static int
encapClose2Proc(ClientData instanceData,
Tcl_Interp *interp,
int flags);
#if TCL_MAJOR_VERSION < 9
static int
encapCloseProc(ClientData instanceData, Tcl_Interp *interp);
@ -97,13 +102,13 @@ Tcl_ChannelType tcl_encap_type_stdout = {
#if TCL_MAJOR_VERSION < 9
encapSeekProc,
#else
nullptr, // close2Proc
nullptr, // seekProc unused
#endif
encapSetOptionProc,
encapGetOptionProc,
encapWatchProc,
encapGetHandleProc,
nullptr, // close2Proc
encapClose2Proc,
encapBlockModeProc,
nullptr, // flushProc
nullptr, // handlerProc
@ -290,17 +295,31 @@ encapBlockModeProc(ClientData,
return 0;
}
// Close channel implementing CloseProc() or Close2Proc()
static int
closeChannel(ReportTcl *report)
{
report->logEnd();
report->redirectFileEnd();
report->redirectStringEnd();
return 0;
}
static int
encapClose2Proc(ClientData instanceData,
Tcl_Interp *,
int)
{
return closeChannel(reinterpret_cast<ReportTcl *>(instanceData));
}
#if TCL_MAJOR_VERSION < 9
static int
encapCloseProc(ClientData instanceData,
Tcl_Interp *)
{
ReportTcl *report = reinterpret_cast<ReportTcl *>(instanceData);
report->logEnd();
report->redirectFileEnd();
report->redirectStringEnd();
return 0;
return closeChannel(reinterpret_cast<ReportTcl *>(instanceData));
}
static int