[Sumover-dev] [svn commit] r4630 - vic/branches/mpeg4

[sumover-dev at cs.ucl.ac.uk]

Author: douglask
Date: Sat Feb 20 02:16:13 2010
New Revision: 4630

Modified:
   vic/branches/mpeg4/Tcl.cpp

Log:
Startup performance boost by providing a cutdown tclInit procedure which doesn't look through all parent folders of vic.exe to find the Tcl files.

Modified: vic/branches/mpeg4/Tcl.cpp
==============================================================================
--- vic/branches/mpeg4/Tcl.cpp	(original)
+++ vic/branches/mpeg4/Tcl.cpp	Sat Feb 20 02:16:13 2010
@@ -44,6 +44,9 @@
 #include <sys/types.h>
 #ifdef USE_ZVFS
 #include "zvfs.h"
+extern "C" {
+	char *TclSetPreInitScript(char *string);
+}
 #endif
 
 Tcl Tcl::instance_;
@@ -74,6 +77,25 @@
 
 	Tcl_SetVar(tcl, "auto_path", "/zvfs/tcl /zvfs/tk /zvfs/vic", TCL_GLOBAL_ONLY);
 	Tcl_SetVar(tcl, "tcl_libPath", "/zvfs/tcl /zvfs/tk /zvfs/vic", TCL_GLOBAL_ONLY);
+	TclSetPreInitScript("\n"
+"proc tclInit {} {\n"
+"  global tcl_libPath tcl_library env\n"
+"  rename tclInit {}\n"
+"  set tcl_library [set env(TCL_LIBRARY)]\n"
+"  set tclfile [file join $tcl_library init.tcl]\n"
+"  if {[file exists $tclfile]} {\n"
+"    set errors {}\n"
+"    if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"
+"      append errors \"$tclfile: $msg\n\"\n"
+"      append errors \"[dict get $opts -errorinfo]\n\"\n"
+"      set msg \"Can't find a usable init.tcl in the following location: \n\"\n"
+"      append msg \"$errors\n\n\"\n"
+"      append msg \"This probably means that VIC wasn't built properly.\n\"\n"
+"      error $msg\n"
+"    }\n"
+"  }\n"
+"}\n"
+"tclInit");
 #endif
 	//Tk_InitConsoleChannels(tcl);
 	Tcl_Init(tcl);