27 static std::vector<std::pair<uintptr_t, BaseSetting*>> traces;
28 static uintptr_t traceCount = 0;
31 static int dummyClose(ClientData , Tcl_Interp* )
35 static int dummyInput(ClientData ,
char* ,
40 static void dummyWatch(ClientData ,
int )
43 static int dummyGetHandle(ClientData ,
int ,
48 Tcl_ChannelType Interpreter::channelType = {
49 const_cast<char*
>(
"openMSX console"),
53 Interpreter::outputProc,
70 Tcl_FindExecutable(programName);
75 interp = Tcl_CreateInterp();
91 Tcl_Channel channel = Tcl_CreateChannel(&channelType,
92 "openMSX console",
this, TCL_WRITABLE);
94 Tcl_SetChannelOption(interp, channel,
"-translation",
"binary");
95 Tcl_SetChannelOption(interp, channel,
"-buffering",
"line");
96 Tcl_SetChannelOption(interp, channel,
"-encoding",
"utf-8");
98 Tcl_SetStdChannel(channel, TCL_STDOUT);
111 if (!Tcl_InterpDeleted(interp)) {
112 Tcl_DeleteInterp(interp);
123 static bool scheduled =
false;
126 atexit(Tcl_Finalize);
130 int Interpreter::outputProc(ClientData clientData,
const char* buf,
134 auto* output =
static_cast<Interpreter*
>(clientData)->output;
135 std::string_view text(buf, toWrite);
136 if (!text.empty() && output) {
149 return Tcl_FindCommand(interp, name.
c_str(),
nullptr, 0);
154 auto token = Tcl_CreateObjCommand(
155 interp, name.
c_str(), commandProc,
156 static_cast<ClientData
>(&command),
nullptr);
162 Tcl_DeleteCommandFromToken(interp,
static_cast<Tcl_Command
>(command.
getToken()));
165 int Interpreter::commandProc(ClientData clientData, Tcl_Interp* interp,
166 int objc, Tcl_Obj*
const objv[])
169 auto& command = *
static_cast<Command*
>(clientData);
171 reinterpret_cast<TclObject*
>(
const_cast<Tcl_Obj**
>(objv)),
176 if (!command.isAllowedInEmptyMachine()) {
177 if (
auto* controller =
179 &command.getCommandController())) {
180 if (!controller->getMSXMotherBoard().getMachineConfig()) {
182 "Can't execute command in empty machine");
186 command.execute(tokens, result);
187 }
catch (MSXException& e) {
188 result = e.getMessage();
205 return execute(
"openmsx::all_command_names");
210 return Tcl_CommandComplete(command.
c_str()) != 0;
215 int success = Tcl_Eval(interp, command.
c_str());
216 if (success != TCL_OK) {
219 return TclObject(Tcl_GetObjResult(interp));
224 int success = Tcl_EvalFile(interp,
filename.c_str());
225 if (success != TCL_OK) {
228 return TclObject(Tcl_GetObjResult(interp));
235 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)) {
237 std::cerr << Tcl_GetStringResult(interp) <<
'\n';
240 static Tcl_Obj* getVar(Tcl_Interp* interp,
const TclObject& name)
242 return Tcl_ObjGetVar2(interp, name.getTclObjectNonConst(),
nullptr,
250 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)) {
257 Tcl_UnsetVar(interp, name, TCL_GLOBAL_ONLY);
270 if (Tcl_Obj* tclVarValue = getVar(interp, name)) {
312 uintptr_t traceID = traceCount++;
313 traces.emplace_back(traceID, &variable);
315 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
316 traceProc,
reinterpret_cast<ClientData
>(traceID));
322 uintptr_t traceID = it->first;
326 Tcl_UntraceVar(interp, name,
327 TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
328 traceProc,
reinterpret_cast<ClientData
>(traceID));
332 static BaseSetting* getTraceSetting(uintptr_t traceID)
335 return ((it !=
end(traces)) && (it->first == traceID))
336 ? it->second :
nullptr;
340 static std::string_view removeColonColon(std::string_view s)
347 char* Interpreter::traceProc(ClientData clientData, Tcl_Interp* interp,
348 const char* part1,
const char* ,
int flags)
381 auto traceID =
reinterpret_cast<uintptr_t
>(clientData);
382 auto* variable = getTraceSetting(traceID);
383 if (!variable)
return nullptr;
385 const TclObject& part1Obj = variable->getFullNameObj();
386 assert(removeColonColon(part1) == removeColonColon(part1Obj.getString()));
388 static string static_string;
389 if (flags & TCL_TRACE_READS) {
391 setVar(interp, part1Obj, variable->getValue());
392 }
catch (MSXException& e) {
393 static_string = std::move(e).getMessage();
394 return const_cast<char*
>(static_string.c_str());
397 if (flags & TCL_TRACE_WRITES) {
399 Tcl_Obj* v = getVar(interp, part1Obj);
400 TclObject newValue(v ? v : Tcl_NewObj());
401 variable->setValueDirect(newValue);
402 const TclObject& newValue2 = variable->getValue();
403 if (newValue != newValue2) {
404 setVar(interp, part1Obj, newValue2);
406 }
catch (MSXException& e) {
407 setVar(interp, part1Obj, getSafeValue(*variable));
408 static_string = std::move(e).getMessage();
409 return const_cast<char*
>(static_string.c_str());
412 if (flags & TCL_TRACE_UNSETS) {
418 variable->getRestoreValue()));
419 }
catch (MSXException&) {
425 setVar(interp, part1Obj, getSafeValue(*variable));
426 Tcl_TraceVar(interp, part1, TCL_TRACE_READS |
427 TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
429 reinterpret_cast<ClientData
>(traceID));
450 Tcl_DoOneEvent(TCL_DONT_WAIT);
460 assert(argc <= tokens.
size());
461 Tcl_WrongNumArgs(interp, argc,
reinterpret_cast<Tcl_Obj* const*
>(tokens.
data()), message);