Fossil

Check-in [b523bf0b]
Login
☰Home Timeline Docs ForumDownload

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Enhance Tcl integration subsystem to check for the FOSSIL_TCL_PATH environment variable. It present, it will be used as a directory or file name where a Tcl 8.x library might be located.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b523bf0be0602c5a4a12fd3cfb0c5d3e43b56107
User & Date: mistachkin 2015-06-10 21:42:28
Context
2015-06-10
22:18
Coding style adjustments to the Tcl integration subsystem. check-in: fec856f4 user: mistachkin tags: trunk
21:42
Enhance Tcl integration subsystem to check for the FOSSIL_TCL_PATH environment variable. It present, it will be used as a directory or file name where a Tcl 8.x library might be located. check-in: b523bf0b user: mistachkin tags: trunk
2015-06-05
18:07
Add a quote from Linus Torvalds to the "On The Usability of Git" section of the quotes.wiki page. check-in: e2411525 user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/file.c. 

55
56
57
58
59
60
61






62
63
64
65
66
67
68
...
368
369
370
371
372
373
374

375
376
377
378
379
380















381
382
383
384
385
386
387
...
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833

#if defined(_WIN32) && (defined(__MSVCRT__) || defined(_MSC_VER))
struct fossilStat {
    i64 st_size;
    i64 st_mtime;
    int st_mode;
};
#endif







#endif /* INTERFACE */

#if !defined(_WIN32) || !(defined(__MSVCRT__) || defined(_MSC_VER))
# define fossilStat stat
#endif

................................................................................

/*
** Return the tail of a file pathname.  The tail is the last component
** of the path.  For example, the tail of "/a/b/c.d" is "c.d".
*/
const char *file_tail(const char *z){
  const char *zTail = z;

  while( z[0] ){
    if( z[0]=='/' ) zTail = &z[1];
    z++;
  }
  return zTail;
}
















/*
** Copy the content of a file from one place to another.
*/
void file_copy(const char *zFrom, const char *zTo){
  FILE *in, *out;
  int got;
................................................................................
}

/*
** Return true if zPath is an absolute pathname.  Return false
** if it is relative.
*/
int file_is_absolute_path(const char *zPath){
  if( zPath[0]=='/'
#if defined(_WIN32) || defined(__CYGWIN__)
      || zPath[0]=='\\'
      || (fossil_isalpha(zPath[0]) && zPath[1]==':'
           && (zPath[2]=='\\' || zPath[2]=='/' || zPath[2]=='\0'))
#endif
  ){
    return 1;
  }else{
    return 0;
  }
}








>
>
>
>
>
>







 







>

|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|

<

|








55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
...
837
838
839
840
841
842
843
844
845

846
847
848
849
850
851
852
853
854

#if defined(_WIN32) && (defined(__MSVCRT__) || defined(_MSC_VER))
struct fossilStat {
    i64 st_size;
    i64 st_mtime;
    int st_mode;
};
#endif

#if defined(_WIN32) || defined(__CYGWIN__)
# define fossil_isdirsep(a)    (((a) == '/') || ((a) == '\\'))
#else
# define fossil_isdirsep(a)    ((a) == '/')
#endif

#endif /* INTERFACE */

#if !defined(_WIN32) || !(defined(__MSVCRT__) || defined(_MSC_VER))
# define fossilStat stat
#endif

................................................................................

/*
** Return the tail of a file pathname.  The tail is the last component
** of the path.  For example, the tail of "/a/b/c.d" is "c.d".
*/
const char *file_tail(const char *z){
  const char *zTail = z;
  if( !zTail ) return 0;
  while( z[0] ){
    if( fossil_isdirsep(z[0]) ) zTail = &z[1];
    z++;
  }
  return zTail;
}

/*
** Return the directory of a file path name.  The directory is all components
** except the last one.  For example, the directory of "/a/b/c.d" is "/a/b".
** If there is no directory, NULL is returned; otherwise, the returned memory
** should be freed via fossil_free().
*/
char *file_dirname(const char *z){
  const char *zTail = file_tail(z);
  if( zTail && zTail!=z ){
    return mprintf("%.*s", (int)(zTail-z-1), z);
  }else{
    return 0;
  }
}

/*
** Copy the content of a file from one place to another.
*/
void file_copy(const char *zFrom, const char *zTo){
  FILE *in, *out;
  int got;
................................................................................
}

/*
** Return true if zPath is an absolute pathname.  Return false
** if it is relative.
*/
int file_is_absolute_path(const char *zPath){
  if( fossil_isdirsep(zPath[0])
#if defined(_WIN32) || defined(__CYGWIN__)

      || (fossil_isalpha(zPath[0]) && zPath[1]==':'
           && (fossil_isdirsep(zPath[2]) || zPath[2]=='\0'))
#endif
  ){
    return 1;
  }else{
    return 0;
  }
}

Changes to src/th_tcl.c. 

59
60
61
62
63
64
65









66
67
68
69
70
71

72




73



74
75
76
77
78
79
80
..
84
85
86
87
88
89
90



91
92
93
94
95
96
97
...
121
122
123
124
125
126
127













128
129
130
131
132
133
134
...
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
...
684
685
686
687
688
689
690





691
692
693
694
695
696
697
698
699

700
701
702
703
704
705
706
707
708
709
710


























711




712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
...
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
...
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
....
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043

/*
** Fetch the (logically boolean) value from the specified void pointer that
** indicates whether or not we can/should use direct objProc calls.
*/
#define GET_CTX_TCL_USEOBJPROC(ctx) \
  ((struct TclContext *)(ctx))->useObjProc










/*
** Define the Tcl shared library name, some exported function names, and some
** cross-platform macros for use with the Tcl stubs mechanism, when enabled.
*/
#if defined(USE_TCL_STUBS)
#  if defined(_WIN32)

#    define WIN32_LEAN_AND_MEAN




#    include <windows.h>



#    ifndef TCL_LIBRARY_NAME
#      define TCL_LIBRARY_NAME "tcl86.dll\0"
#    endif
#    ifndef TCL_MINOR_OFFSET
#      define TCL_MINOR_OFFSET (4)
#    endif
#    ifndef dlopen
................................................................................
#      define dlsym(a,b) GetProcAddress((HANDLE)(a),(b))
#    endif
#    ifndef dlclose
#      define dlclose(a) FreeLibrary((HANDLE)(a))
#    endif
#  else
#    include <dlfcn.h>



#    if defined(__CYGWIN__)
#      ifndef TCL_LIBRARY_NAME
#        define TCL_LIBRARY_NAME "libtcl8.6.dll\0"
#      endif
#      ifndef TCL_MINOR_OFFSET
#        define TCL_MINOR_OFFSET (8)
#      endif
................................................................................
#    define TCL_DELETEINTERP_NAME "_Tcl_DeleteInterp\0"
#  endif
#  ifndef TCL_FINALIZE_NAME
#    define TCL_FINALIZE_NAME "_Tcl_Finalize\0"
#  endif
#endif /* defined(USE_TCL_STUBS) */














/*
** The function types for Tcl_FindExecutable and Tcl_CreateInterp are needed
** when the Tcl library is being loaded dynamically by a stubs-enabled
** application (i.e. the inverse of using a stubs-enabled package).  These are
** the only Tcl API functions that MUST be called prior to being able to call
** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).  For complete
** cleanup if the Tcl stubs initialization fails somehow, the Tcl_DeleteInterp
................................................................................
/*
** Tcl context information used by TH1.  This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
  int argc;           /* Number of original arguments. */
  char **argv;        /* Full copy of the original arguments. */
  void *library;      /* The Tcl library module handle. */
  tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
  tcl_CreateInterpProc *xCreateInterp;     /* Tcl_CreateInterp() pointer. */
  tcl_DeleteInterpProc *xDeleteInterp;     /* Tcl_DeleteInterp() pointer. */
  tcl_FinalizeProc *xFinalize;             /* Tcl_Finalize() pointer. */
  Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
  int useObjProc;     /* Non-zero if an objProc can be called directly. */
  char *setup;        /* The optional Tcl setup script. */
................................................................................
/*
** When Tcl stubs support is enabled, attempts to dynamically load the Tcl
** shared library and fetch the function pointers necessary to create an
** interpreter and initialize the stubs mechanism; otherwise, simply setup
** the function pointers provided by the caller with the statically linked
** functions.
*/





static int loadTcl(
  Th_Interp *interp,
  void **pLibrary,
  tcl_FindExecutableProc **pxFindExecutable,
  tcl_CreateInterpProc **pxCreateInterp,
  tcl_DeleteInterpProc **pxDeleteInterp,
  tcl_FinalizeProc **pxFinalize
){
#if defined(USE_TCL_STUBS)

  char fileName[] = TCL_LIBRARY_NAME;
#endif /* defined(USE_TCL_STUBS) */

  if( !pLibrary || !pxFindExecutable || !pxCreateInterp ||
      !pxDeleteInterp || !pxFinalize ){
    Th_ErrorMessage(interp,
        "invalid Tcl loader argument(s)", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
  do {


























    void *library = dlopen(fileName, RTLD_NOW | RTLD_GLOBAL);




    if( library ){
      tcl_FindExecutableProc *xFindExecutable;
      tcl_CreateInterpProc *xCreateInterp;
      tcl_DeleteInterpProc *xDeleteInterp;
      tcl_FinalizeProc *xFinalize;
      const char *procName = TCL_FINDEXECUTABLE_NAME;
      xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName + 1);
      if( !xFindExecutable ){
        xFindExecutable = (tcl_FindExecutableProc *)dlsym(library, procName);
      }
      if( !xFindExecutable ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_FindExecutable", (const char *)"", 0);
        dlclose(library);
        return TH_ERROR;
      }
      procName = TCL_CREATEINTERP_NAME;
      xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName + 1);
      if( !xCreateInterp ){
        xCreateInterp = (tcl_CreateInterpProc *)dlsym(library, procName);
      }
      if( !xCreateInterp ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_CreateInterp", (const char *)"", 0);
        dlclose(library);
        return TH_ERROR;
      }
      procName = TCL_DELETEINTERP_NAME;
      xDeleteInterp = (tcl_DeleteInterpProc *)dlsym(library, procName + 1);
      if( !xDeleteInterp ){
        xDeleteInterp = (tcl_DeleteInterpProc *)dlsym(library, procName);
      }
      if( !xDeleteInterp ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_DeleteInterp", (const char *)"", 0);
        dlclose(library);
        return TH_ERROR;
      }
      procName = TCL_FINALIZE_NAME;
      xFinalize = (tcl_FinalizeProc *)dlsym(library, procName + 1);
      if( !xFinalize ){
        xFinalize = (tcl_FinalizeProc *)dlsym(library, procName);
      }
      if( !xFinalize ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_Finalize", (const char *)"", 0);
        dlclose(library);
        return TH_ERROR;
      }
      *pLibrary = library;
      *pxFindExecutable = xFindExecutable;
      *pxCreateInterp = xCreateInterp;
      *pxDeleteInterp = xDeleteInterp;
      *pxFinalize = xFinalize;
      return TH_OK;
    }
  } while( --fileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
  fileName[TCL_MINOR_OFFSET] = 'x';
  Th_ErrorMessage(interp,
      "could not load any supported Tcl 8.6, 8.5, or 8.4 shared library \"",
      fileName, -1);
  return TH_ERROR;
#else
  *pLibrary = 0;
  *pxFindExecutable = Tcl_FindExecutable;
  *pxCreateInterp = Tcl_CreateInterp;
  *pxDeleteInterp = Tcl_DeleteInterp;
  *pxFinalize = Tcl_Finalize;
  return TH_OK;
#endif /* defined(USE_TCL_STUBS) */
}
................................................................................
    Th_ErrorMessage(interp,
        "invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
  if( tclContext->interp ){
    return TH_OK;
  }
  if( loadTcl(interp, &tclContext->library, &tclContext->xFindExecutable,
              &tclContext->xCreateInterp, &tclContext->xDeleteInterp,
              &tclContext->xFinalize)!=TH_OK ){
    return TH_ERROR;
  }
  argc = tclContext->argc;
  argv = tclContext->argv;
  if( argc>0 && argv ){
................................................................................
  Th_Interp *interp,
  void *pContext
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  Tcl_Interp *tclInterp;
  tcl_FinalizeProc *xFinalize;
#if defined(USE_TCL_STUBS)
  void *library;
#endif /* defined(USE_TCL_STUBS) */

  if( !tclContext ){
    Th_ErrorMessage(interp,
        "invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
................................................................................
  ** a bug in MinGW, see:
  **
  **     http://comments.gmane.org/gmane.comp.gnu.mingw.user/41724
  **
  ** The workaround is to manually unload the loaded Tcl library prior to
  ** exiting the process.
  */
  library = tclContext->library;
  if( library ){
    dlclose(library);
    tclContext->library = library = 0;
  }
#endif /* defined(USE_TCL_STUBS) */
  return TH_OK;
}

/*
** Register the Tcl language commands with interpreter interp.








>
>
>
>
>
>
>
>
>






>
|
>
>
>
>

>
>
>







 







>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







>
>
>
>
>


|






>
|


|







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|





|

|




|



|

|




|



|

|




|



|

|




|


|






|
|


|


|







 







|







 







|







 







|
|
|
|








59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
...
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
...
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
...
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
....
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
....
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112

/*
** Fetch the (logically boolean) value from the specified void pointer that
** indicates whether or not we can/should use direct objProc calls.
*/
#define GET_CTX_TCL_USEOBJPROC(ctx) \
  ((struct TclContext *)(ctx))->useObjProc

/*
** This is the name of an environment variable that may refer to a Tcl library
** directory or file name.  If this environment variable is set [to anything],
** its value will be used when searching for a Tcl library to load.
*/
#ifndef TCL_PATH_ENV_VAR_NAME
#  define TCL_PATH_ENV_VAR_NAME  "FOSSIL_TCL_PATH"
#endif

/*
** Define the Tcl shared library name, some exported function names, and some
** cross-platform macros for use with the Tcl stubs mechanism, when enabled.
*/
#if defined(USE_TCL_STUBS)
#  if defined(_WIN32)
#    if !defined(WIN32_LEAN_AND_MEAN)
#      define WIN32_LEAN_AND_MEAN
#    endif
#    if !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0502)
#      define _WIN32_WINNT 0x0502 /* SetDllDirectory, Windows XP SP2 */
#    endif
#    include <windows.h>
#    ifndef TCL_DIRECTORY_SEP
#      define TCL_DIRECTORY_SEP '\\'
#    endif
#    ifndef TCL_LIBRARY_NAME
#      define TCL_LIBRARY_NAME "tcl86.dll\0"
#    endif
#    ifndef TCL_MINOR_OFFSET
#      define TCL_MINOR_OFFSET (4)
#    endif
#    ifndef dlopen
................................................................................
#      define dlsym(a,b) GetProcAddress((HANDLE)(a),(b))
#    endif
#    ifndef dlclose
#      define dlclose(a) FreeLibrary((HANDLE)(a))
#    endif
#  else
#    include <dlfcn.h>
#    ifndef TCL_DIRECTORY_SEP
#      define TCL_DIRECTORY_SEP '/'
#    endif
#    if defined(__CYGWIN__)
#      ifndef TCL_LIBRARY_NAME
#        define TCL_LIBRARY_NAME "libtcl8.6.dll\0"
#      endif
#      ifndef TCL_MINOR_OFFSET
#        define TCL_MINOR_OFFSET (8)
#      endif
................................................................................
#    define TCL_DELETEINTERP_NAME "_Tcl_DeleteInterp\0"
#  endif
#  ifndef TCL_FINALIZE_NAME
#    define TCL_FINALIZE_NAME "_Tcl_Finalize\0"
#  endif
#endif /* defined(USE_TCL_STUBS) */

/*
** If this constant is defined to non-zero, the Win32 SetDllDirectory function
** will be used during the Tcl library loading process if the path environment
** variable for Tcl was set.
*/
#ifndef TCL_USE_SET_DLL_DIRECTORY
#  if defined(_WIN32) && defined(_WIN32_WINNT) && (_WIN32_WINNT >= 0x0502)
#    define TCL_USE_SET_DLL_DIRECTORY (1)
#  else
#    define TCL_USE_SET_DLL_DIRECTORY (0)
#  endif
#endif /* TCL_USE_SET_DLL_DIRECTORY */

/*
** The function types for Tcl_FindExecutable and Tcl_CreateInterp are needed
** when the Tcl library is being loaded dynamically by a stubs-enabled
** application (i.e. the inverse of using a stubs-enabled package).  These are
** the only Tcl API functions that MUST be called prior to being able to call
** Tcl_InitStubs (i.e. because it requires a Tcl interpreter).  For complete
** cleanup if the Tcl stubs initialization fails somehow, the Tcl_DeleteInterp
................................................................................
/*
** Tcl context information used by TH1.  This structure definition has been
** copied from and should be kept in sync with the one in "main.c".
*/
struct TclContext {
  int argc;           /* Number of original arguments. */
  char **argv;        /* Full copy of the original arguments. */
  void *hLibrary;     /* The Tcl library module handle. */
  tcl_FindExecutableProc *xFindExecutable; /* Tcl_FindExecutable() pointer. */
  tcl_CreateInterpProc *xCreateInterp;     /* Tcl_CreateInterp() pointer. */
  tcl_DeleteInterpProc *xDeleteInterp;     /* Tcl_DeleteInterp() pointer. */
  tcl_FinalizeProc *xFinalize;             /* Tcl_Finalize() pointer. */
  Tcl_Interp *interp; /* The on-demand created Tcl interpreter. */
  int useObjProc;     /* Non-zero if an objProc can be called directly. */
  char *setup;        /* The optional Tcl setup script. */
................................................................................
/*
** When Tcl stubs support is enabled, attempts to dynamically load the Tcl
** shared library and fetch the function pointers necessary to create an
** interpreter and initialize the stubs mechanism; otherwise, simply setup
** the function pointers provided by the caller with the statically linked
** functions.
*/
char *fossil_getenv(const char *zName); /* file.h */
int file_isdir(const char *zPath);      /* file.h */
char *file_dirname(const char *zPath);  /* file.h */
void fossil_free(void *p);              /* util.h */

static int loadTcl(
  Th_Interp *interp,
  void **phLibrary,
  tcl_FindExecutableProc **pxFindExecutable,
  tcl_CreateInterpProc **pxCreateInterp,
  tcl_DeleteInterpProc **pxDeleteInterp,
  tcl_FinalizeProc **pxFinalize
){
#if defined(USE_TCL_STUBS)
  const char *zEnvPath = fossil_getenv(TCL_PATH_ENV_VAR_NAME);
  char aFileName[] = TCL_LIBRARY_NAME;
#endif /* defined(USE_TCL_STUBS) */

  if( !phLibrary || !pxFindExecutable || !pxCreateInterp ||
      !pxDeleteInterp || !pxFinalize ){
    Th_ErrorMessage(interp,
        "invalid Tcl loader argument(s)", (const char *)"", 0);
    return TH_ERROR;
  }
#if defined(USE_TCL_STUBS)
  do {
    char *zFileName;
    void *hLibrary;
    if( !zEnvPath ){
      zFileName = aFileName; /* NOTE: Assume present in PATH. */
    }else if( file_isdir(zEnvPath)==1 ){
#if TCL_USE_SET_DLL_DIRECTORY
      SetDllDirectory(zEnvPath); /* NOTE: Maybe needed for "zlib1.dll". */
#endif /* TCL_USE_SET_DLL_DIRECTORY */
      /* NOTE: The environment variable contains a directory name. */
      zFileName = sqlite3_mprintf("%s%c%s%c", zEnvPath, TCL_DIRECTORY_SEP,
                                  aFileName, '\0');
    }else{
#if TCL_USE_SET_DLL_DIRECTORY
      char *zDirName = file_dirname(zEnvPath);
      if( zDirName ){
        SetDllDirectory(zDirName); /* NOTE: Maybe needed for "zlib1.dll". */
      }
#endif /* TCL_USE_SET_DLL_DIRECTORY */
      /* NOTE: The environment variable might contain a file name. */
      zFileName = sqlite3_mprintf("%s%c", zEnvPath, '\0');
#if TCL_USE_SET_DLL_DIRECTORY
      if( zDirName ){
        fossil_free(zDirName); zDirName = 0;
      }
#endif /* TCL_USE_SET_DLL_DIRECTORY */
    }
    hLibrary = dlopen(zFileName, RTLD_NOW | RTLD_GLOBAL);
    /* NOTE: If the file name was allocated, free it now. */
    if( zFileName!=aFileName ){
      sqlite3_free(zFileName); zFileName = 0;
    }
    if( hLibrary ){
      tcl_FindExecutableProc *xFindExecutable;
      tcl_CreateInterpProc *xCreateInterp;
      tcl_DeleteInterpProc *xDeleteInterp;
      tcl_FinalizeProc *xFinalize;
      const char *procName = TCL_FINDEXECUTABLE_NAME;
      xFindExecutable = (tcl_FindExecutableProc *)dlsym(hLibrary, procName+1);
      if( !xFindExecutable ){
        xFindExecutable = (tcl_FindExecutableProc *)dlsym(hLibrary, procName);
      }
      if( !xFindExecutable ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_FindExecutable", (const char *)"", 0);
        dlclose(hLibrary);
        return TH_ERROR;
      }
      procName = TCL_CREATEINTERP_NAME;
      xCreateInterp = (tcl_CreateInterpProc *)dlsym(hLibrary, procName+1);
      if( !xCreateInterp ){
        xCreateInterp = (tcl_CreateInterpProc *)dlsym(hLibrary, procName);
      }
      if( !xCreateInterp ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_CreateInterp", (const char *)"", 0);
        dlclose(hLibrary);
        return TH_ERROR;
      }
      procName = TCL_DELETEINTERP_NAME;
      xDeleteInterp = (tcl_DeleteInterpProc *)dlsym(hLibrary, procName+1);
      if( !xDeleteInterp ){
        xDeleteInterp = (tcl_DeleteInterpProc *)dlsym(hLibrary, procName);
      }
      if( !xDeleteInterp ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_DeleteInterp", (const char *)"", 0);
        dlclose(hLibrary);
        return TH_ERROR;
      }
      procName = TCL_FINALIZE_NAME;
      xFinalize = (tcl_FinalizeProc *)dlsym(hLibrary, procName+1);
      if( !xFinalize ){
        xFinalize = (tcl_FinalizeProc *)dlsym(hLibrary, procName);
      }
      if( !xFinalize ){
        Th_ErrorMessage(interp,
            "could not locate Tcl_Finalize", (const char *)"", 0);
        dlclose(hLibrary);
        return TH_ERROR;
      }
      *phLibrary = hLibrary;
      *pxFindExecutable = xFindExecutable;
      *pxCreateInterp = xCreateInterp;
      *pxDeleteInterp = xDeleteInterp;
      *pxFinalize = xFinalize;
      return TH_OK;
    }
  } while( --aFileName[TCL_MINOR_OFFSET]>'3' ); /* Tcl 8.4+ */
  aFileName[TCL_MINOR_OFFSET] = 'x';
  Th_ErrorMessage(interp,
      "could not load any supported Tcl 8.6, 8.5, or 8.4 shared library \"",
      aFileName, -1);
  return TH_ERROR;
#else
  *phLibrary = 0;
  *pxFindExecutable = Tcl_FindExecutable;
  *pxCreateInterp = Tcl_CreateInterp;
  *pxDeleteInterp = Tcl_DeleteInterp;
  *pxFinalize = Tcl_Finalize;
  return TH_OK;
#endif /* defined(USE_TCL_STUBS) */
}
................................................................................
    Th_ErrorMessage(interp,
        "invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
  if( tclContext->interp ){
    return TH_OK;
  }
  if( loadTcl(interp, &tclContext->hLibrary, &tclContext->xFindExecutable,
              &tclContext->xCreateInterp, &tclContext->xDeleteInterp,
              &tclContext->xFinalize)!=TH_OK ){
    return TH_ERROR;
  }
  argc = tclContext->argc;
  argv = tclContext->argv;
  if( argc>0 && argv ){
................................................................................
  Th_Interp *interp,
  void *pContext
){
  struct TclContext *tclContext = (struct TclContext *)pContext;
  Tcl_Interp *tclInterp;
  tcl_FinalizeProc *xFinalize;
#if defined(USE_TCL_STUBS)
  void *hLibrary;
#endif /* defined(USE_TCL_STUBS) */

  if( !tclContext ){
    Th_ErrorMessage(interp,
        "invalid Tcl context", (const char *)"", 0);
    return TH_ERROR;
  }
................................................................................
  ** a bug in MinGW, see:
  **
  **     http://comments.gmane.org/gmane.comp.gnu.mingw.user/41724
  **
  ** The workaround is to manually unload the loaded Tcl library prior to
  ** exiting the process.
  */
  hLibrary = tclContext->hLibrary;
  if( hLibrary ){
    dlclose(hLibrary);
    tclContext->hLibrary = hLibrary = 0;
  }
#endif /* defined(USE_TCL_STUBS) */
  return TH_OK;
}

/*
** Register the Tcl language commands with interpreter interp.

This page was generated in about 0.008s by Fossil 2.11 [eee161e823] 2020-01-22 19:08:54