33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
+
+
+
+
+
+
|
/*
** Workaround NRE-specific issue in Tcl_EvalObjCmd (SF bug #3399564) by using
** Tcl_EvalObjv instead of invoking the objProc directly.
*/
#define USE_TCL_EVALOBJV 1
#endif
#ifdef _WIN32
# include <windows.h>
#else
# include <dlfcn.h>
#endif
/*
** These macros are designed to reduce the redundant code required to marshal
** arguments from TH1 to Tcl.
*/
#define USE_ARGV_TO_OBJV() \
int objc; \
Tcl_Obj **objv; \
|
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
|
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
|
Th_Interp *interp,
void *pContext
){
struct TclContext *tclContext = (struct TclContext *)pContext;
int argc;
char **argv;
char *argv0 = 0;
#ifdef USE_TCL_STUBS
#ifdef _WIN32
WCHAR lib[] = L"tcl87.dll";
#define minver lib[4]
#define dlopen(a,b) (void *)LoadLibraryW(a);
#define dlsym(a,b) GetProcAddress((HANDLE)(a),b);
#else
#ifdef __CYGWIN__
char lib[] = "libtcl8.7.dll";
#else
char lib[] = "libtcl8.7.so";
#endif
#define minver lib[8]
#endif
void *handle = NULL;
void (*findExecutable)(const char *) = 0;
Tcl_Interp *(*createInterp)() = 0;
#endif /* USE_TCL_STUBS */
Tcl_Interp *tclInterp;
if ( !tclContext ){
Th_ErrorMessage(interp,
"Invalid Tcl context", (const char *)"", 0);
return TH_ERROR;
}
if ( tclContext->interp ){
return TH_OK;
}
argc = tclContext->argc;
argv = tclContext->argv;
if( argc>0 && argv ){
argv0 = argv[0];
}
#ifdef USE_TCL_STUBS
while( --minver>'3' ){
handle = dlopen(lib, RTLD_NOW | RTLD_LOCAL);
if( handle ) {
const char *sym = "_Tcl_FindExecutable";
findExecutable = (void (*)(const char *)) dlsym(handle, sym+1);
if (!findExecutable)
findExecutable = (void (*)(const char *)) dlsym(handle, sym);
sym = "_Tcl_CreateInterp";
createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym+1);
if (!createInterp)
createInterp = (Tcl_Interp * (*)(void)) dlsym(handle, sym);
break;
}
}
if( !handle ){
Th_ErrorMessage(interp,
"Could not create Tcl interpreter", (const char *)"", 0);
return TH_ERROR;
}
# undef Tcl_FindExecutable
# define Tcl_FindExecutable findExecutable
# undef Tcl_CreateInterp
# define Tcl_CreateInterp createInterp
#endif /* USE_TCL_STUBS */
Tcl_FindExecutable(argv0);
tclInterp = tclContext->interp = Tcl_CreateInterp();
if( !tclInterp || Tcl_InterpDeleted(tclInterp) ){
tclInterp = Tcl_CreateInterp();
if( !tclInterp || !Tcl_InitStubs(tclInterp, "8.4", 0)
|| Tcl_InterpDeleted(tclInterp) ){
Th_ErrorMessage(interp,
"Could not create Tcl interpreter", (const char *)"", 0);
return TH_ERROR;
}
tclContext->interp = tclInterp;
if( Tcl_Init(tclInterp)!=TCL_OK ){
Th_ErrorMessage(interp,
"Tcl initialization error:", Tcl_GetStringResult(tclInterp), -1);
Tcl_DeleteInterp(tclInterp);
tclContext->interp = tclInterp = 0;
return TH_ERROR;
}
|