C++ Tcl_DeleteInterp函数代码示例

void
weechat_tcl_unload (struct t_plugin_script *script)
{
    Tcl_Interp* interp;
    int *rc;

    if ((weechat_tcl_plugin->debug >= 1) || !tcl_quiet)
    {
        weechat_printf (NULL,
                        weechat_gettext ("%s: unloading script \"%s\""),
                        TCL_PLUGIN_NAME, script->name);
    }

    if (script->shutdown_func && script->shutdown_func[0])
    {
        rc = (int *)weechat_tcl_exec (script,
                                      WEECHAT_SCRIPT_EXEC_INT,
                                      script->shutdown_func,
                                      NULL, NULL);
        if (rc)
            free (rc);
    }

    interp = (Tcl_Interp*)script->interpreter;

    if (tcl_current_script == script)
        tcl_current_script = (tcl_current_script->prev_script) ?
            tcl_current_script->prev_script : tcl_current_script->next_script;

    script_remove (weechat_tcl_plugin, &tcl_scripts, &last_tcl_script, script);

    Tcl_DeleteInterp(interp);
}

int
exit_tk()
{
  int code;

  if (Tk_GetNumMainWindows() > 0) {
    sprintf(tcl_command_buffer, "done_calculation");
    code = Tcl_Eval(interp, tcl_command_buffer);
    if (code != TCL_OK) {
      fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
      return code;
    }
  }

  while (Tk_GetNumMainWindows() > 0) {
    sprintf(tcl_command_buffer, "tkwait variable window_changed");
    code = Tcl_Eval(interp, tcl_command_buffer);
    if (code != TCL_OK) {
      fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
      return code;
    }
    draw_graph(maxstep);
  }

  sprintf(tcl_command_buffer, "exit");
  Tcl_Eval(interp, tcl_command_buffer);
  Tcl_DeleteInterp(interp);
}

void free_tpm(void)
{
    if(PlutoInterp) {
	Tcl_DeleteInterp(PlutoInterp);
    }
    PlutoInterp=NULL;
}

/* Cleans up after our scripting system. */
void CleanupScripting(void)
{
    if (interp != NULL) {
	Tcl_DeleteInterp(interp);
    }

}

static void tk_stop(void)
{
  if (interp) {
    Tcl_DeleteInterp(interp);
    interp = NULL;
  }
}

turbine_code turbine_run_string(MPI_Comm comm, const char* script,
                                int argc, const char** argv, char* output,
                                Tcl_Interp* interp)
{
  bool created_interp = false;
  if (interp == NULL)
  {
    // Create Tcl interpreter:
    interp = Tcl_CreateInterp();
    Tcl_Init(interp);
    created_interp = true;
  }
  
  if (comm != MPI_COMM_NULL)
  {
    // Store communicator pointer in Tcl variable for turbine::init
    MPI_Comm* comm_ptr = &comm;
    Tcl_Obj* TURBINE_ADLB_COMM =
        Tcl_NewStringObj("TURBINE_ADLB_COMM", -1);
    Tcl_Obj* adlb_comm_ptr = Tcl_NewLongObj((long) comm_ptr);
    Tcl_ObjSetVar2(interp, TURBINE_ADLB_COMM, NULL, adlb_comm_ptr, 0);
  }

  // Render argc/argv for Tcl
  turbine_tcl_set_integer(interp, "argc", argc);
  Tcl_Obj* argv_obj     = Tcl_NewStringObj("argv", -1);
  Tcl_Obj* argv_val_obj;
  if (argc > 0)
    argv_val_obj = turbine_tcl_list_new(argc, argv);
  else
    argv_val_obj = Tcl_NewStringObj("", 0);
  Tcl_ObjSetVar2(interp, argv_obj, NULL, argv_val_obj, 0);

  if (output != NULL)
    turbine_tcl_set_wideint(interp, "turbine_run_output",
                            (ptrdiff_t) output);

  // Run the user script
  int rc = Tcl_Eval(interp, script);

  // Check for errors
  if (rc != TCL_OK)
  {
    Tcl_Obj* error_dict = Tcl_GetReturnOptions(interp, rc);
    Tcl_Obj* error_info = Tcl_NewStringObj("-errorinfo", -1);
    Tcl_Obj* error_msg;
    Tcl_DictObjGet(interp, error_dict, error_info, &error_msg);
    char* msg_string = Tcl_GetString(error_msg);
    printf("turbine_run(): Tcl error: %s\n", msg_string);
    return TURBINE_ERROR_UNKNOWN;
  }

  if (created_interp)
  {
    // Clean up
    Tcl_DeleteInterp(interp);
  }

  return TURBINE_SUCCESS;
}

static AP_Result tcl_delete(AP_World *w, AP_Obj interp_name)
{
	Tcl_HashEntry *entry;
	Tcl_Interp *interp;

	if (AP_ObjType(w, interp_name) != AP_ATOM) {
		return AP_SetStandardError(w, AP_TYPE_ERROR,
					AP_NewSymbolFromStr(w, "atom"), interp_name);
	}
	
	entry = Tcl_FindHashEntry(&tcl_interp_name_table, AP_GetAtomStr(w, interp_name));
	
	if (!entry) {
		return AP_SetStandardError(w, AP_DOMAIN_ERROR,
					AP_NewSymbolFromStr(w, "tcl_interpreter"), interp_name);
	}
	
	interp = Tcl_GetHashValue(entry);
	
	Tcl_DeleteInterp(interp);
	
	Tcl_DeleteHashEntry(entry);
	
	return AP_SUCCESS;
}

void ScriptTcl::run() {
#else
void ScriptTcl::run(char *scriptFile) {

  if ( NULL == scriptFile || NULL == (config = new ConfigList(scriptFile)) ) {
    NAMD_die("Simulation config file is empty.");
  }
#endif

  if (initWasCalled == 0) {
    initcheck();
    SimParameters *simParams = Node::Object()->simParameters;
    if ( simParams->minimizeCGOn ) runController(SCRIPT_MINIMIZE);
    else runController(SCRIPT_RUN);
    runWasCalled = 1;
  }

#if CMK_HAS_PARTITION
  replica_barrier();
#endif
  runController(SCRIPT_END);

}

ScriptTcl::~ScriptTcl() {
  DebugM(3,"Destructing ScriptTcl\n");
#ifdef NAMD_TCL
  if ( interp ) Tcl_DeleteInterp(interp);
  delete [] callbackname;
#endif

  molfile_dcdplugin_fini();
}

/*
 *----------------------------------------------------------------------
 *
 * MainEx -- Main program for Tk-based applications.
 *
 *----------------------------------------------------------------------
 */
void
MainEx( int argc, char** argv, Tcl_AppInitProc *appInitProc,
        Tcl_Interp *pintrp, char *fileName )
{
    int code;

    (*appInitProc)(pintrp);

    if ( Commands_Init(pintrp) != TCL_OK) 
        Panic (pintrp,"Can't initialise commands!");

    char set_path[1000];
    strcat( strcat( strcpy( set_path, "set ::image_path \"" ), module_path ), "\"" );
    code = Tcl_Eval( pintrp, set_path );
    
    if (fileName != NULL) 
    {
        char  script[1000];
        strcat( strcat( strcpy( script, module_path ), "" ), fileName );
        code = Tcl_EvalFile(pintrp, script);
        if (code != TCL_OK)
            Panic (pintrp,"Evaluate file error!");
    }
    else Tcl_SourceRCFile(pintrp);

    Tcl_ResetResult(pintrp);

    Tk_MainLoop();
    
    Tcl_DeleteInterp(pintrp);
    return;
}

void task_tcl (void *arg)
{
	unsigned char *cmd;
	unsigned char result, got_partial, quit_flag;
	Tcl_Interp *interp;
	Tcl_CmdBuf buffer;

	configure_ram ();
	mem_init (&pool, (size_t) RAM_START, (size_t) RAM_END);
again:
	debug_printf ("\nEmbedded TCL\n\n");

	interp = Tcl_CreateInterp (&pool);
	Tcl_CreateCommand (interp, (unsigned char*) "loop", loop_cmd, 0, 0);
	Tcl_CreateCommand (interp, (unsigned char*) "echo", echo_cmd, 0, 0);

	buffer = Tcl_CreateCmdBuf (&pool);
	got_partial = 0;
	quit_flag = 0;
	while (! quit_flag) {
/*		clearerr (stdin);*/
		if (! got_partial) {
			debug_puts ("% ");
		}
		if (! debug_gets (line, sizeof (line))) {
			if (! got_partial)
				break;

			line[0] = 0;
		}
		cmd = Tcl_AssembleCmd (buffer, line);
		if (! cmd) {
			got_partial = 1;
			continue;
		}

		got_partial = 0;
		result = Tcl_Eval (interp, cmd, 0, 0);

		if (result != TCL_OK) {
			debug_puts ("Error");

			if (result != TCL_ERROR)
				debug_printf (" %d", result);

			if (*interp->result != 0)
				debug_printf (": %s", interp->result);

			debug_putchar (0, '\n');
			continue;
		}

		if (*interp->result != 0)
			debug_printf ("%s\n", interp->result);
	}

	Tcl_DeleteInterp (interp);
	Tcl_DeleteCmdBuf (buffer);
	goto again;
}

static void
DeleteConsoleInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;

    Tcl_DeleteInterp(interp);
}

void
TclInterp::initialize()
{
    if (interp != NULL)
	Tcl_DeleteInterp(interp);

    interp = Tcl_CreateInterp();
    runCallbacks("tcl");
}

commandsManager::~commandsManager()
{
	 TclCallBack<commandsManager>::unregisterAll();
	 if (interp && createdInterp)
	 {
			//Delete the Tcl interpreter
			Tcl_DeleteInterp(interp);
			interp = NULL;
	 }
}

TclTextInterp::~TclTextInterp() {
  // Set callback variable, giving a chance for Tcl to do some clean-ups
  // (for example, if external jobs have been run and need to be halted...)
  setString("vmd_quit", "1");
  
  // DeleteInterp must precede Finalize!
  Tcl_DeleteInterp(interp);
  interp = NULL; // prevent use by Python if Tcl_Finalize() invokes
                 // shutdown scripts
}

kit::~kit()
{
	deleted++;
	if(deleted == created)	// last interpreter?
	{
		for(map<int, binding *, less<int> >::iterator i = fd_table.begin(); i != fd_table.end(); i++)
			unbind((*i).first);
		Tcl_DeleteInterp(interp);
	}
}