add Util.tcl to Tcl built-in by add it to utl swig scripts

src/cmake/swig_lib.cmake

@@ -87,7 +87,7 @@ function(swig_lib)
   # These includes are always needed.
   target_include_directories(${ARG_NAME}
     PRIVATE
-      ${OPENROAD_HOME}/include
+      ${MINIEDA_HOME}/include
   )
 
   if (${ARG_LANGUAGE} STREQUAL tcl)
@@ -132,7 +132,7 @@ function(swig_lib)
     add_custom_command(OUTPUT ${LANG_INIT}
       COMMAND ${MINIEDA_HOME}/src/cmake/etc/TclEncode.tcl  ${LANG_INIT} ${ARG_NAME}_${ARG_LANGUAGE}_inits ${ARG_SCRIPTS} 
       WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
-      DEPENDS ${ARG_SCRIPTS}
+      DEPENDS ${ARG_SCRIPTS} ${MINIEDA_HOME}/src/cmake/etc/TclEncode.tcl
     )
 
     target_sources(${ARG_NAME}

src/main/CMakeLists.txt

@@ -25,6 +25,8 @@ target_link_libraries(minieda_swig
     odb
 )
 
+# swig_lib(NAME util_swig)
+
 add_executable(minieda
   ${MINIEDA_SOURCE}
 )

src/main/CMakeLists.txt.backup

+# include cmake functions defined in the path
+set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${PROJECT_SOURCE_DIR}/src/cmake")
+
+include("swig_lib")
+
+# paths for submodule
+set(odb_HOME ${PROJECT_SOURCE_DIR}/src/odb)
+
+# main program source
+set(MINIEDA_SOURCE
+  MiniEda.cc
+  Main.cc
+  )
+
+# Swig Config
+# swig_lib(NAME      minieda_swig
+#          NAMESPACE eda
+#          I_FILE    MiniEda.i
+#          SCRIPTS   MiniEda.tcl
+# )
+
+set_source_files_properties(MiniEda.i PROPERTIES CPLUSPLUS ON)
+set(LANGUAGE_OPTIONS -namespace -prefix eda)
+set_property(SOURCE MiniEda.i
+             PROPERTY COMPILE_OPTIONS ${LANGUAGE_OPTIONS}
+                                      -Werror
+                                      -w317,325,378,401,402,467,472,503,509)
+set_property(SOURCE ${ARG_I_FILE}
+             PROPERTY SWIG_MODULE_NAME ${ARG_NAME})
+set_property(SOURCE ${ARG_I_FILE}
+             PROPERTY USE_SWIG_DEPENDENCIES TRUE)
+swig_add_library(minieda_swig
+  LANGUAGE tcl
+  TYPE STATIC
+  SOURCES MiniEda.i
+)
+get_target_property(GEN_SRCS minieda_swig SOURCES)
+
+foreach(GEN_SRC ${GEN_SRCS})
+  set_source_files_properties(${GEN_SRC}
+    PROPERTIES
+      COMPILE_OPTIONS "-Wno-cast-qual;-Wno-missing-braces"
+  )
+endforeach()
+
+target_include_directories(minieda_swig
+  PRIVATE
+    ${MINIEDA_HOME}/include
+    ${TCL_INCLUDE_PATH}
+)
+
+
+
+set(MINIEDA_INIT ${CMAKE_CURRENT_BINARY_DIR}/minieda_swig-tclInitVar.cc)
+set(MINIEDA_TCL_FILES MiniEda.tcl Util.tcl)
+add_custom_command(OUTPUT ${MINIEDA_INIT}
+  COMMAND ${MINIEDA_HOME}/src/cmake/etc/TclEncode.tcl ${MINIEDA_INIT} minieda_swig_tcl_inits ${MINIEDA_TCL_FILES}
+  WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
+  DEPENDS ${MINIEDA_TCL_FILES} ${MINIEDA_HOME}/src/cmake/etc/TclEncode.tcl
+)
+target_sources(minieda_swig
+  PRIVATE
+    ${MINIEDA_INIT}
+)
+
+target_link_libraries(minieda_swig
+  PRIVATE
+    utl
+    odb
+)
+
+add_executable(minieda
+  ${MINIEDA_SOURCE}
+)
+
+target_compile_options(minieda
+  PRIVATE
+    -Wextra -pedantic -Wcast-qual
+)
+
+set_target_properties(minieda PROPERTIES
+  # Disable compiler specific extensions like gnu++11.
+  CXX_EXTENSIONS OFF
+  # Export symbols for stack trace printing
+  ENABLE_EXPORTS ON
+)
+target_compile_features(minieda PUBLIC cxx_std_17)
+
+target_include_directories(minieda
+  PUBLIC
+    ${MINIEDA_HOME}/include
+    ${MINIEDA_HOME}/pkgs/include
+    ${MINIEDA_HOME}/pkgs/boost_1_78_0
+)
+
+# Link Libraries
+target_link_libraries(minieda
+  minieda_swig
+  utl
+  odb
+  ${CMAKE_THREAD_LIBS_INIT}
+  ${TCL_LIBRARY}
+)
+
+# tclReadline
+if (TCL_READLINE_LIBRARY AND TCL_READLINE_H)
+  target_compile_definitions(minieda PRIVATE ENABLE_READLINE)
+  target_link_libraries(minieda ${TCL_READLINE_LIBRARY})
+  target_include_directories(minieda PRIVATE ${TCL_READLINE_H})
+  message(STATUS "TCL readline enabled")
+else()
+  message(STATUS "TCL readline disabled")
+endif()
+
+if (BUILD_TCLX AND TCLX_LIBRARY AND TCLX_H)
+  target_compile_definitions(minieda PRIVATE ENABLE_TCLX)
+  target_link_libraries(minieda ${TCLX_LIBRARY})
+  target_include_directories(minieda PRIVATE ${TCLX_H})
+  message(STATUS "Tcl Extended enabled")
+else()
+  message(STATUS "Tcl Extended disabled")
+endif()
+
+if (ZLIB_FOUND)
+  target_link_libraries(minieda ${ZLIB_LIBRARIES})
+endif()
+
+install(TARGETS minieda DESTINATION bin)
+
+add_custom_target(minieda_tags etags -o TAGS
+  ${MINIEDA_SOURCE}
+  ${MINIEDA_HOME}/include/eda/*.hh
+  WORKING_DIRECTORY ${MINIEDA_HOME}/src
+  DEPENDS ${MINIEDA_SOURCE} ${MINIEDA_HEADERS} ${MINIEDA_TCL_FILES}
+)

src/main/MiniEda.cc

@@ -6,7 +6,7 @@
 #include "utl/tcl_utl.h"
 
 namespace eda {
-extern const char *minieda_swig_tcl_inits[];
+extern const char* minieda_swig_tcl_inits[];
 }
 
 // Swig uses C linkage for init functions.
@@ -22,6 +22,7 @@ extern const char* metrics_filename;
 namespace eda {
 
 using utl::evalTclInit;
+using utl::initTclUtil;
 
 MiniEda::MiniEda()
   : tcl_interp_(nullptr),
@@ -67,6 +68,7 @@ void MiniEda::init(Tcl_Interp* interp)
   // Init components.
   Minieda_swig_Init(interp);
   // Import TCL scripts
+  initTclUtil(interp);
   evalTclInit(interp, eda::minieda_swig_tcl_inits);
 
   // defined in MakeModuleXX.h

src/main/MiniEda.tcl

 proc logger_echo { usr_input } {
   eda::logger_echo $usr_input
 }
+
+define_cmd_args "simple_test" {[-tmp tmp]}
+
+proc simple_test {args} {
+  parse_key_args "simple_test" args keys {-tmp}
+  logger_echo $keys(-tmp)
+}

src/utl/CMakeLists.txt

@@ -18,6 +18,7 @@ include("swig_lib")
 swig_lib(NAME      utl
          NAMESPACE utl
          I_FILE    src/Logger.i
+         SCRIPTS   Util.tcl
 )
 
 target_sources(utl

src/utl/Util.tcl

+# OpenSTA, Static Timing Analyzer
+# Copyright (c) 2022, Parallax Software, Inc.
+# 
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+# The sta namespace is used for all commands defined by the sta.
+# Use define_cmd_args to define command arguments for the help
+# command, and export the command name to the global namespace.
+# Global variables must be defined as
+#  set global_var init_value
+# File local variables must be defined as
+#  variable sta_var init_value
+
+# namespace eval sta {
+
+# Parse arg_var for keyword/values pairs and flags.
+# $key_var(key) -> key_value
+# $flag_var(flag) -> 1 if the flag is present
+# Keys and flags are removed from arg_var in the caller.
+proc parse_key_args { cmd arg_var key_var keys {flag_var ""} {flags {}} \
+			{unknown_key_is_error 1} } {
+  upvar 1 $arg_var args
+  upvar 1 $key_var key_value
+  upvar 1 $flag_var flag_present
+  set args_rtn {}
+  while { $args != "" } {
+    set arg [lindex $args 0]
+    if { [is_keyword_arg $arg] } {
+      set key_index [lsearch -exact $keys $arg]
+      if { $key_index >= 0 } {
+	set key $arg
+	if { [llength $args] == 1 } {
+	  sta_error 400 "$cmd $key missing value."
+	}
+	set key_value($key) [lindex $args 1]
+	set args [lrange $args 1 end]
+      } else {
+	set flag_index [lsearch -exact $flags $arg]
+	if { $flag_index >= 0 } {
+	  set flag_present($arg) 1
+	} else {
+	  # No exact keyword/flag match found.
+	  # Try finding a keyword/flag that begins with
+	  # the same substring.
+	  set wild_arg "${arg}*"
+	  set key_index [lsearch -glob $keys $wild_arg]
+	  if { $key_index >= 0 } {
+	    set key [lindex $keys $key_index]
+	    if { [llength $args] == 1 } {
+	      sta_error 401 "$cmd $key missing value."
+	    }
+	    set key_value($key) [lindex $args 1]
+	    set args [lrange $args 1 end]
+	  } else {
+	    set flag_index [lsearch -glob $flags $wild_arg]
+	    if { $flag_index >= 0 } {
+	      set flag [lindex $flags $flag_index]
+	      set flag_present($flag) 1
+	    } elseif { $unknown_key_is_error } {
+	      sta_error 402 "$cmd $arg is not a known keyword or flag."
+	    } else {
+	      lappend args_rtn $arg
+	    }
+	  }
+	}
+      }
+    } else {
+      lappend args_rtn $arg
+    }
+    set args [lrange $args 1 end]
+  }
+  set args $args_rtn
+}
+
+# Check for keyword args in arg_var.
+proc check_for_key_args { cmd arg_var } {
+  upvar 1 $arg_var args
+  set args_rtn {}
+  while { $args != "" } {
+    set arg [lindex $args 0]
+    if { [is_keyword_arg $arg] } {
+      sta_error 403 "$cmd $arg is not a known keyword or flag."
+    } else {
+      lappend args_rtn $arg
+    }
+    set args [lrange $args 1 end]
+  }
+  set args $args_rtn
+}
+
+proc is_keyword_arg { arg } {
+  if { [string length $arg] >= 2 \
+	 && [string index $arg 0] == "-" \
+	 && [string is alpha [string index $arg 1]] } {
+    return 1
+  } else {
+    return 0
+  }
+}
+
+################################################################
+
+# Define a procedure that checks the args for redirection using unix
+# shell redirection syntax.
+# The value of the last expression in the body is returned.
+proc proc_redirect { proc_name body } {
+  set proc_body [concat "proc $proc_name { args } {" \
+		   "global errorCode errorInfo;" \
+		   "set redirect \[parse_redirect_args args\];" \
+		   "set code \[catch {" $body "} ret \];" \
+		   "if {\$redirect} { redirect_file_end };" \
+		   "if {\$code == 1} {return -code \$code -errorcode \$errorCode -errorinfo \$errorInfo \$ret} else {return \$ret} }" ]
+  eval $proc_body
+}
+
+proc parse_redirect_args { arg_var } {
+  upvar 1 $arg_var args
+  set argc [llength $args]
+  if { $argc >= 1 } {
+    set last_arg [lindex $args [expr $argc - 1]]
+    # arg >>filename
+    if { [string range $last_arg 0 1] == ">>" } {
+      set redirect_file [file nativename [string range $last_arg 2 end]]
+      set args [lrange $args 0 [expr $argc - 2]]
+      redirect_file_append_begin $redirect_file
+      return 1
+    # arg >filename
+    } elseif { [string range $last_arg 0 0] == ">" } {
+      set redirect_file [file nativename [string range $last_arg 1 end]]
+      set args [lrange $args 0 [expr $argc - 2]]
+      redirect_file_begin $redirect_file
+      return 1
+    }
+  }
+  if { $argc >= 2 } {
+    set next_last_arg [lindex $args [expr $argc - 2]]
+    # arg > filename
+    if { $next_last_arg == ">" } {
+      set redirect_file [file nativename [lindex $args end]]
+      set args [lrange $args 0 [expr $argc - 3]]
+      redirect_file_begin $redirect_file
+      return 1
+    # arg >> filename
+    } elseif { $next_last_arg == ">>" } {
+      set redirect_file [file nativename [lindex $args end]]
+      set args [lrange $args 0 [expr $argc - 3]]
+      redirect_file_append_begin $redirect_file
+      return 1
+    }
+  }
+  return 0
+}
+
+################################################################
+
+proc define_cmd_args { cmd arglist } {
+  variable cmd_args
+
+  set cmd_args($cmd) $arglist
+  namespace export $cmd
+}
+
+# Hidden commands are exported to the global namespace but are not
+# shown by the "help" command.
+proc define_hidden_cmd_args { cmd arglist } {
+  namespace export $cmd
+}
+
+# This is used in lieu of command completion to make sdc commands
+# like get_ports be abbreviated get_port.
+proc define_cmd_alias { alias cmd } {
+  eval "proc $alias { args } { eval [concat $cmd \$args] }"
+  namespace export $alias
+}
+
+proc cmd_usage_error { cmd } {
+  variable cmd_args
+
+  if [info exists cmd_args($cmd)] {
+    sta_error 404 "Usage: $cmd $cmd_args($cmd)"
+  } else {
+    sta_error 405 "Usage: $cmd argument error"
+  }
+}
+
+################################################################
+
+define_cmd_args "help" {[pattern]}
+
+proc_redirect help {
+  variable cmd_args
+
+  set arg_count [llength $args]
+  if { $arg_count == 0 } {
+    set pattern "*"
+  } elseif { $arg_count == 1 } {
+    set pattern [lindex $args 0]
+  } else {
+    cmd_usage_error "help"
+  }
+  set matches [array names cmd_args $pattern]
+  if { $matches != {} } {
+    foreach cmd [lsort $matches] {
+      show_cmd_args $cmd
+    }
+  } else {
+    sta_warn 300 "no commands match '$pattern'."
+  }
+}
+
+proc show_cmd_args { cmd } {
+  variable cmd_args
+
+  set max_col 80
+  set indent 2
+  set indent_str "  "
+  set line $cmd
+  set col [string length $cmd]
+  set arglist $cmd_args($cmd)
+  # Break the arglist up into max_col length lines.
+  while {1} {
+    if {[regexp {(^[\n ]*)([a-zA-Z0-9_\\\|\-]+|\[[^\[]+\])(.*)} \
+	   $arglist ignore space arg rest]} {
+      set arg_length [string length $arg]
+      if { $col + $arg_length < $max_col } {
+	set line "$line $arg"
+	set col [expr $col + $arg_length + 1]
+      } else {
+        report_line $line
+	set line "$indent_str $arg"
+	set col [expr $indent + $arg_length + 1]
+      }
+      set arglist $rest
+    } else {
+      report_line $line
+      break
+    }
+  }
+}
+
+################################################################
+
+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
+  } else {
+    report_warn $msg_id $msg
+  }
+}
+
+proc sta_error { msg_id msg } {
+  variable sdc_file
+  variable sdc_line
+  if { [info exists sdc_file] } {
+    error "Error: [file tail $sdc_file] line $sdc_line, $msg"
+  } else {
+    error "Error: $msg"
+  }
+}
+
+proc sta_warn_error { msg_id warn_error msg } {
+  if { $warn_error == "warn" } {
+    sta_warn $msg_id $msg
+  } else {
+    sta_error $msg_id $msg
+  }
+}
+
+# Defined by StaTcl.i
+define_cmd_args "elapsed_run_time" {}
+define_cmd_args "user_run_time" {}
+
+# Write run time statistics to filename.
+proc write_stats { filename } {
+  if { ![catch {open $filename w} stream] } {
+    puts $stream "[elapsed_run_time] [user_run_time] [memory_usage]"
+    close $stream
+  }
+}
+
+################################################################
+
+# Begin/end logging all output to a file.
+define_cmd_args "log_begin" { filename }
+
+proc log_begin { filename } {
+  log_begin_cmd [file nativename $filename]
+}
+
+# Defined by StaTcl.i
+define_cmd_args "log_end" {}
+
+# set_debug is NOT in the global namespace
+# because it isn't intended for nosy users.
+
+################################################################
+
+proc check_argc_eq0 { cmd arglist } {
+  if { $arglist != {} } {
+    sta_error 406 "$cmd positional arguments not supported."
+  }
+}
+
+proc check_argc_eq1 { cmd arglist } {
+  if { [llength $arglist] != 1 } {
+    sta_error 407 "$cmd requires one positional argument."
+  }
+}
+
+proc check_argc_eq0or1 { cmd arglist } {
+  set argc [llength $arglist]
+  if { $argc != 0 && $argc != 1 } {
+    sta_error 408 "$cmd requires zero or one positional arguments."
+  }
+}
+
+proc check_argc_eq2 { cmd arglist } {
+  if { [llength $arglist] != 2 } {
+    sta_error 409 "$cmd requires two positional arguments."
+  }
+}
+
+proc check_argc_eq1or2 { cmd arglist } {
+  set argc [llength $arglist]
+  if { $argc != 1 && $argc != 2 } {
+    sta_error 410 "$cmd requires one or two positional arguments."
+  }
+}
+
+proc check_argc_eq3 { cmd arglist } {
+  if { [llength $arglist] != 3 } {
+    sta_error 411 "$cmd requires three positional arguments."
+  }
+}
+
+proc check_argc_eq4 { cmd arglist } {
+  if { [llength $arglist] != 4 } {
+    sta_error 412 "$cmd requires four positional arguments."
+  }
+}
+
+################################################################
+
+proc check_float { cmd_arg arg } {
+  if {![string is double $arg]} {
+    sta_error 413 "$cmd_arg '$arg' is not a float."
+  }
+}
+
+proc check_positive_float { cmd_arg arg } {
+  if {!([string is double $arg] && $arg >= 0.0)} {
+    sta_error 414 "$cmd_arg '$arg' is not a positive float."
+  }
+}
+
+proc check_integer { cmd_arg arg } {
+  if {!([string is integer $arg])} {
+    sta_error 415 "$cmd_arg '$arg' is not an integer."
+  }
+}
+
+proc check_positive_integer { cmd_arg arg } {
+  if {!([string is integer $arg] && $arg >= 0)} {
+    sta_error 416 "$cmd_arg '$arg' is not a positive integer."
+  }
+}
+
+proc check_cardinal { cmd_arg arg } {
+  if {!([string is integer $arg] && $arg >= 1)} {
+    sta_error 417 "$cmd_arg '$arg' is not an integer greater than or equal to one."
+  }
+}
+
+proc check_percent { cmd_arg arg } {
+  if {!([string is double $arg] && $arg >= 0.0 && $arg <= 100.0)} {
+    sta_error 418 "$cmd_arg '$arg' is not between 0 and 100."
+  }
+}
+
+# sta namespace end
+# }
+

src/utl/include/utl/tcl_utl.h

@@ -11,5 +11,6 @@ namespace utl {
 // separate files that have to be located and loaded at run time.
 void evalTclInit(Tcl_Interp *interp, const char *inits[]);
 char* unencode(const char *inits[]);
+void initTclUtil(Tcl_Interp* interp);
 
 } // namespace utl

src/utl/src/tcl_utl.cpp

@@ -4,6 +4,10 @@
 
 #include "utl/tcl_utl.h"
 
+namespace eda {
+extern const char* utl_tcl_inits[];
+}
+
 namespace utl {
 
 void evalTclInit(Tcl_Interp *interp,
@@ -43,5 +47,10 @@ char* unencode(const char *inits[])
   return unencoded;
 }
 
+void initTclUtil(Tcl_Interp* interp)
+{
+  evalTclInit(interp, eda::utl_tcl_inits);
+}
+
 } // namespace utl