[education/rkward] rkward/rbackend: Designate all R API calls as such, and list them in a namespace
Thomas Friedrichsmeier
null at kde.org
Fri May 10 17:04:24 BST 2024
Git commit 3f3c28fed116aa3fb4cdaac15dbc6f2cdaa07fe7 by Thomas Friedrichsmeier.
Committed on 04/05/2024 at 21:10.
Pushed by tfry into branch 'master'.
Designate all R API calls as such, and list them in a namespace
(Phew, these were more than I had imagined)
M +205 -3 rkward/rbackend/rkrapi.h
M +124 -142 rkward/rbackend/rkrbackend.cpp
M +10 -16 rkward/rbackend/rkreventloop.cpp
M +124 -124 rkward/rbackend/rkrsupport.cpp
M +9 -0 rkward/rbackend/rkrsupport.h
M +97 -97 rkward/rbackend/rkstructuregetter.cpp
M +2 -3 rkward/rbackend/rkstructuregetter.h
M +7 -7 rkward/rbackend/rkwarddevice/rkgraphicsdevice_protocol_shared.h
M +20 -19 rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
M +98 -104 rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
https://invent.kde.org/education/rkward/-/commit/3f3c28fed116aa3fb4cdaac15dbc6f2cdaa07fe7
diff --git a/rkward/rbackend/rkrapi.h b/rkward/rbackend/rkrapi.h
index 73e86fbc6..cb6a69176 100644
--- a/rkward/rbackend/rkrapi.h
+++ b/rkward/rbackend/rkrapi.h
@@ -11,6 +11,13 @@ Encapsulate R API calls for abstraction over dl_open. WIP
*/
+#ifndef RKRAPI_H
+#define RKRAPI_H
+
+#if defined(_WIN32) || defined(_MSC_VER) || defined(Win32) // Note: no easy access to Q_OS_WIN at this point
+#define Win32 // R assumes this on Windows
+#endif
+
#define R_INTERFACE_PTRS 1
// for R_CStackStart/Limit
#define CSTACK_DEFNS 1
@@ -20,8 +27,8 @@ Encapsulate R API calls for abstraction over dl_open. WIP
#define uintptr_t uintptr_t
// needed to detect CHARSXP encoding
-#define IS_UTF8(x) (Rf_getCharCE(x) == CE_UTF8)
-#define IS_LATIN1(x) (Rf_getCharCE(x) == CE_LATIN1)
+#define IS_UTF8(x) (RFn::Rf_getCharCE(x) == CE_UTF8)
+#define IS_LATIN1(x) (RFn::Rf_getCharCE(x) == CE_LATIN1)
#ifdef TRUE
# undef TRUE
#endif
@@ -48,12 +55,207 @@ Encapsulate R API calls for abstraction over dl_open. WIP
#endif
// The following needed only on Windows
-#if defined(_WIN32) || defined(_MSC_VER) || defined(Win32) // Note: no easy access to Q_OS_WIN at this point
+#if defined(Win32)
# include <R_ext/RStartup.h>
# include <R_ext/Utils.h>
# include <R_ext/libextern.h>
+extern "C" {
+ // why oh why isn't Rinterface.h available on Windows?
+ LibExtern void* R_GlobalContext;
+ LibExtern uintptr_t R_CStackLimit;
+ LibExtern void R_SaveGlobalEnvToFile(char*);
+}
#else
// The following needed only outside of Windows, and Rinterface.h is not even available on Windows
# include <Rinterface.h>
# include <R_ext/eventloop.h>
#endif
+
+// some functions we need that are not declared
+extern "C" void run_Rmainloop(void);
+
+#define RK_DLOPEN_LIBRSO
+#ifdef RK_DLOPEN_LIBRSO
+
+//#define IMPORT_R_API(X) static constexpr decltype(::X) &X = ::X
+#define IMPORT_R_API(X) static constexpr decltype(::X) &X =::X
+#define ROb(X) (RFn::X)
+struct RFn {
+IMPORT_R_API(CDR);
+IMPORT_R_API(CDDR);
+IMPORT_R_API(CAR);
+IMPORT_R_API(SETCAR);
+IMPORT_R_API(GEaddDevice2);
+IMPORT_R_API(GEcreateDevDesc);
+IMPORT_R_API(GEgetDevice);
+IMPORT_R_API(GEplayDisplayList);
+IMPORT_R_API(R_CHAR);
+IMPORT_R_API(FORMALS);
+IMPORT_R_API(INTEGER);
+IMPORT_R_API(LOGICAL);
+IMPORT_R_API(LENGTH);
+IMPORT_R_API(PRCODE);
+IMPORT_R_API(PRENV);
+IMPORT_R_API(PRINTNAME);
+IMPORT_R_API(PRVALUE);
+IMPORT_R_API(REAL);
+IMPORT_R_API(R_CheckDeviceAvailable);
+IMPORT_R_API(R_CheckStack);
+IMPORT_R_API(R_CheckUserInterrupt);
+IMPORT_R_API(R_CleanTempDir);
+IMPORT_R_API(R_ClearExternalPtr);
+IMPORT_R_API(R_ExternalPtrTag);
+IMPORT_R_API(R_ExternalPtrAddr);
+IMPORT_R_API(R_GE_getVersion);
+IMPORT_R_API(R_GE_linearGradientColour);
+IMPORT_R_API(R_GE_linearGradientExtend);
+IMPORT_R_API(R_GE_linearGradientNumStops);
+IMPORT_R_API(R_GE_linearGradientStop);
+IMPORT_R_API(R_GE_linearGradientX1);
+IMPORT_R_API(R_GE_linearGradientX2);
+IMPORT_R_API(R_GE_linearGradientY1);
+IMPORT_R_API(R_GE_linearGradientY2);
+IMPORT_R_API(R_GE_patternType);
+IMPORT_R_API(R_GE_radialGradientColour);
+IMPORT_R_API(R_GE_radialGradientCX1);
+IMPORT_R_API(R_GE_radialGradientCX2);
+IMPORT_R_API(R_GE_radialGradientCY1);
+IMPORT_R_API(R_GE_radialGradientCY2);
+IMPORT_R_API(R_GE_radialGradientExtend);
+IMPORT_R_API(R_GE_radialGradientNumStops);
+IMPORT_R_API(R_GE_radialGradientR1);
+IMPORT_R_API(R_GE_radialGradientR2);
+IMPORT_R_API(R_GE_radialGradientStop);
+IMPORT_R_API(R_GE_str2col);
+IMPORT_R_API(R_GE_tilingPatternExtend);
+IMPORT_R_API(R_GE_tilingPatternFunction);
+IMPORT_R_API(R_GE_tilingPatternHeight);
+IMPORT_R_API(R_GE_tilingPatternWidth);
+IMPORT_R_API(R_GE_tilingPatternX);
+IMPORT_R_API(R_GE_tilingPatternY);
+IMPORT_R_API(R_InputHandlers);
+IMPORT_R_API(R_MakeExternalPtr);
+IMPORT_R_API(R_ParseVector);
+IMPORT_R_API(R_PolledEvents);
+IMPORT_R_API(R_RunExitFinalizers);
+IMPORT_R_API(R_SaveGlobalEnvToFile);
+IMPORT_R_API(R_ToplevelExec);
+IMPORT_R_API(R_checkActivityEx);
+IMPORT_R_API(R_chk_calloc);
+IMPORT_R_API(R_chk_free);
+IMPORT_R_API(R_dot_Last);
+IMPORT_R_API(R_getEmbeddingDllInfo);
+IMPORT_R_API(R_lsInternal3);
+IMPORT_R_API(R_registerRoutines);
+IMPORT_R_API(R_removeVarFromFrame);
+IMPORT_R_API(R_runHandlers);
+IMPORT_R_API(R_tryEval);
+IMPORT_R_API(R_wait_usec);
+IMPORT_R_API(Rf_GetOption);
+IMPORT_R_API(Rf_GetOption1);
+IMPORT_R_API(Rf_KillAllDevices);
+IMPORT_R_API(Rf_ScalarInteger);
+IMPORT_R_API(Rf_addTaskCallback);
+IMPORT_R_API(Rf_allocList);
+IMPORT_R_API(Rf_allocVector);
+IMPORT_R_API(Rf_asChar);
+IMPORT_R_API(Rf_asInteger);
+IMPORT_R_API(Rf_asLogical);
+IMPORT_R_API(Rf_asReal);
+IMPORT_R_API(Rf_coerceVector);
+IMPORT_R_API(Rf_curDevice);
+IMPORT_R_API(Rf_defineVar);
+IMPORT_R_API(Rf_doesIdle);
+IMPORT_R_API(Rf_doIdle);
+IMPORT_R_API(Rf_doKeybd);
+IMPORT_R_API(Rf_doMouseEvent);
+IMPORT_R_API(Rf_error);
+IMPORT_R_API(Rf_eval);
+IMPORT_R_API(Rf_findFun);
+IMPORT_R_API(Rf_findVar);
+IMPORT_R_API(Rf_findVarInFrame);
+IMPORT_R_API(Rf_getAttrib);
+IMPORT_R_API(Rf_getCharCE);
+IMPORT_R_API(Rf_initialize_R);
+IMPORT_R_API(Rf_install);
+IMPORT_R_API(Rf_installChar);
+IMPORT_R_API(Rf_isEnvironment);
+IMPORT_R_API(Rf_isList);
+IMPORT_R_API(R_IsNA);
+IMPORT_R_API(R_IsNaN);
+IMPORT_R_API(Rf_isNewList);
+IMPORT_R_API(Rf_isNull);
+IMPORT_R_API(Rf_isNumeric);
+IMPORT_R_API(Rf_isPairList);
+IMPORT_R_API(Rf_isPrimitive);
+IMPORT_R_API(Rf_isS4);
+IMPORT_R_API(Rf_isString);
+IMPORT_R_API(Rf_isVectorList);
+IMPORT_R_API(Rf_lang1);
+IMPORT_R_API(Rf_length);
+IMPORT_R_API(Rf_list3);
+IMPORT_R_API(Rf_mkChar);
+IMPORT_R_API(Rf_mkCharCE);
+IMPORT_R_API(Rf_onintr);
+IMPORT_R_API(Rf_protect);
+IMPORT_R_API(R_Reprotect);
+IMPORT_R_API(R_ProtectWithIndex);
+IMPORT_R_API(Rf_setAttrib);
+IMPORT_R_API(Rf_unprotect);
+IMPORT_R_API(Rf_warning);
+IMPORT_R_API(Riconv);
+IMPORT_R_API(Riconv_close);
+IMPORT_R_API(Riconv_open);
+IMPORT_R_API(SET_TAG);
+IMPORT_R_API(SET_TYPEOF);
+IMPORT_R_API(STRING_ELT);
+IMPORT_R_API(SET_STRING_ELT);
+IMPORT_R_API(SET_PRENV);
+IMPORT_R_API(SET_PRVALUE);
+IMPORT_R_API(TYPEOF);
+IMPORT_R_API(VECTOR_ELT);
+IMPORT_R_API(addInputHandler);
+IMPORT_R_API(run_Rmainloop);
+IMPORT_R_API(setup_Rmainloop);
+
+// NOTE / TODO: Some of these are essentially const, should be treated as such
+IMPORT_R_API(R_BaseEnv);
+IMPORT_R_API(R_ClassSymbol);
+IMPORT_R_API(R_CStackLimit);
+IMPORT_R_API(R_CStackStart);
+IMPORT_R_API(R_DimSymbol);
+IMPORT_R_API(R_DirtyImage);
+IMPORT_R_API(R_EmptyEnv);
+IMPORT_R_API(R_GlobalContext);
+IMPORT_R_API(R_GlobalEnv);
+IMPORT_R_API(R_Interactive);
+IMPORT_R_API(R_NaInt);
+IMPORT_R_API(R_NaReal);
+IMPORT_R_API(R_NaString);
+IMPORT_R_API(R_NamesSymbol);
+IMPORT_R_API(R_NilValue);
+IMPORT_R_API(R_interrupts_pending);
+IMPORT_R_API(R_interrupts_suspended);
+IMPORT_R_API(R_Consolefile);
+IMPORT_R_API(R_Outputfile);
+IMPORT_R_API(R_UnboundValue);
+
+#ifndef Win32
+IMPORT_R_API(ptr_R_Busy);
+IMPORT_R_API(ptr_R_ChooseFile);
+IMPORT_R_API(ptr_R_CleanUp);
+IMPORT_R_API(ptr_R_ClearerrConsole);
+IMPORT_R_API(ptr_R_EditFile);
+IMPORT_R_API(ptr_R_FlushConsole);
+IMPORT_R_API(ptr_R_ReadConsole);
+IMPORT_R_API(ptr_R_ResetConsole);
+IMPORT_R_API(ptr_R_ShowFiles);
+IMPORT_R_API(ptr_R_ShowMessage);
+IMPORT_R_API(ptr_R_Suicide);
+IMPORT_R_API(ptr_R_WriteConsole);
+IMPORT_R_API(ptr_R_WriteConsoleEx);
+#endif
+};
+#endif
+
+#endif
diff --git a/rkward/rbackend/rkrbackend.cpp b/rkward/rbackend/rkrbackend.cpp
index bd358206c..a7a5c07c6 100644
--- a/rkward/rbackend/rkrbackend.cpp
+++ b/rkward/rbackend/rkrbackend.cpp
@@ -46,13 +46,6 @@ void* RKRBackend::default_global_context = nullptr;
#ifdef Q_OS_WIN
structRstart RK_R_Params;
-
- extern "C" {
- // why oh why isn't Rinterface.h available on Windows?
- LibExtern void* R_GlobalContext;
- LibExtern uintptr_t R_CStackLimit;
- LibExtern void R_SaveGlobalEnvToFile(char*);
- }
#endif
#ifndef Q_OS_WIN
@@ -86,7 +79,7 @@ void RK_scheduleIntr () {
void RK_doIntr () {
RK_scheduleIntr ();
- R_CheckUserInterrupt ();
+ RFn::R_CheckUserInterrupt ();
}
void RKRBackend::scheduleInterrupt () {
@@ -126,21 +119,15 @@ void RKRBackend::interruptCommand (int command_id) {
}
void clearPendingInterrupt_Worker (void *) {
- R_CheckUserInterrupt ();
+ RFn::R_CheckUserInterrupt ();
}
void RKRBackend::clearPendingInterrupt () {
RK_TRACE (RBACKEND);
- bool passed = R_ToplevelExec(clearPendingInterrupt_Worker, nullptr);
+ bool passed = RFn::R_ToplevelExec(clearPendingInterrupt_Worker, nullptr);
if (!passed) RK_DEBUG (RBACKEND, DL_DEBUG, "pending interrupt cleared");
}
-// some functions we need that are not declared
-#if R_VERSION < R_Version(2,13,0)
-LibExtern void Rf_PrintWarnings (void);
-#endif
-extern "C" void run_Rmainloop (void);
-
#include "rdata.h"
extern SEXP RKWard_RData_Tag;
@@ -174,7 +161,7 @@ void RKInsertToplevelStatementFinishedCallback (void *) {
if (RKRBackend::this_pointer->r_running) {
int pos;
- Rf_addTaskCallback(&RKToplevelStatementFinishedCallback, nullptr, &RKInsertToplevelStatementFinishedCallback, "_rkward_main_callback", &pos);
+ RFn::Rf_addTaskCallback(&RKToplevelStatementFinishedCallback, nullptr, &RKInsertToplevelStatementFinishedCallback, "_rkward_main_callback", &pos);
}
}
@@ -228,7 +215,7 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
RK_ASSERT (RKRBackend::repl_status.eval_depth >= 0);
if (RKRBackend::repl_status.browser_context) { // previously we were in a browser context. Check, whether we've left that.
- if (RKRBackend::default_global_context == R_GlobalContext) {
+ if (RKRBackend::default_global_context == ROb(R_GlobalContext)) {
RKRBackend::repl_status.browser_context = RKRBackend::RKReplStatus::NotInBrowserContext;
RKRBackend::this_pointer->handlePlainGenericRequest (QStringList ("endBrowserContext"), false);
}
@@ -261,7 +248,7 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
Problems to deal with:
- R_ReadConsole serves a lot of different functions, including reading in code, but also handling user input for readline() or browser(). This makes it necessary to carefully track the current status using "repl_status". You will find repl_status to be modified at a couple of different functions.
- One difficulty lies in finding out, just when a command has finished (successfully or with an error). RKToplevelStatementFinishCallback(), and doError() handle the respective cases.
- NOTE; in R 2.12.0 and above, Rf_countContexts() might help to find out when we are back to square 1!
+ NOTE; in R 2.12.0 and above, RFn::Rf_countContexts() might help to find out when we are back to square 1!
*/
RKRBackend::repl_status.user_command_transmitted_up_to = 0;
RKRBackend::repl_status.user_command_completely_transmitted = false;
@@ -277,13 +264,13 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
// fully transmitted, but R is still asking for more? This looks like an incomplete statement.
// HOWEVER: It may also have been an empty statement such as " ", so let's check whether the prompt looks like a "continue" prompt
bool incomplete = false;
- if (RKTextCodec::fromNative(prompt) == RKRSupport::SEXPToString(Rf_GetOption(Rf_install("continue"), R_BaseEnv))) {
+ if (RKTextCodec::fromNative(prompt) == RKRSupport::SEXPToString(RFn::Rf_GetOption(RFn::Rf_install("continue"), ROb(R_BaseEnv)))) {
incomplete = true;
}
if (incomplete) RKRBackend::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorIncomplete;
RKRBackend::repl_status.user_command_status = RKRBackend::RKReplStatus::ReplIterationKilled;
if (RKRBackend::repl_status.user_command_parsed_up_to <= 0) RKRBackend::this_pointer->startOutputCapture (); // HACK: No capture active, but commandFinished() will try to end one
- Rf_error (""); // to discard the buffer
+ RFn::Rf_error(""); // to discard the buffer
} else {
RKTransmitNextUserCommandChunk (buf, buflen);
return 1;
@@ -299,7 +286,7 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
// 2) User called browser ()
// 3) R jumped us back to toplevel behind our backs.
// Let's find out, which one it is.
- if (hist && (RKRBackend::default_global_context != R_GlobalContext)) {
+ if (hist && (RKRBackend::default_global_context != ROb(R_GlobalContext))) {
break; // this looks like a call to browser(). Will be handled below.
}
@@ -309,13 +296,13 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
n_frames = dummy->intVector ().at (0);
}
// What the ??? Why does this simple version always return 0?
- //int n_frames = RKRSupport::SEXPToInt (RKRSupport::callSimpleFun0 (Rf_install ("sys.nframe"), R_GlobalEnv));
+ //int n_frames = RKRSupport::SEXPToInt (RKRSupport::callSimpleFun0 (RFn::Rf_install ("sys.nframe"), ROb(R_GlobalEnv)));
if (n_frames < 1) {
// No active frames? This can't be a call to readline(), then, so probably R jumped us back to toplevel, behind our backs.
// For safety, let's reset and start over.
RKRBackend::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorOther;
RKRBackend::repl_status.user_command_status = RKRBackend::RKReplStatus::ReplIterationKilled;
- Rf_error(""); // to discard the buffer
+ RFn::Rf_error(""); // to discard the buffer
} else {
// A call to readline(). Will be handled below
break;
@@ -340,7 +327,7 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
params["cancelled"] = QVariant (false);
// add info for browser requests
- if (hist && (RKRBackend::default_global_context != R_GlobalContext)) {
+ if (hist && (RKRBackend::default_global_context != ROb(R_GlobalContext))) {
if (RKRBackend::repl_status.browser_context == RKRBackend::RKReplStatus::InBrowserContextPreventRecursion) {
qstrncpy ((char *) buf, "n\n", buflen); // skip this, by feeding the browser() a continue
return 1;
@@ -372,7 +359,7 @@ int RReadConsole (const char* prompt, unsigned char* buf, int buflen, int hist)
RKRBackend::this_pointer->handleRequest (&request);
if (request.params["cancelled"].toBool ()) {
if (RKRBackend::this_pointer->current_command) RKRBackend::this_pointer->current_command->status |= RCommand::Canceled;
- Rf_error ("cancelled");
+ RFn::Rf_error("cancelled");
RK_ASSERT (false); // should not reach this point.
}
@@ -509,17 +496,17 @@ void RCleanUp (SA_TYPE saveact, int status, int RunLast) {
if (RKRBackend::this_pointer->killed == RKRBackend::AlreadyDead) return; // Nothing to clean up
if (!RKRBackend::this_pointer->r_running) return; // prevent recursion (if an error occurs, here, we get jumped to the console repl, again!)
- R_CheckUserInterrupt (); // if there are any user interrupts pending, we want them handled *NOW*
+ RFn::R_CheckUserInterrupt(); // if there are any user interrupts pending, we want them handled *NOW*
RKRBackend::this_pointer->r_running = false;
// we could be in a signal handler, and the stack base may have changed.
- uintptr_t old_lim = R_CStackLimit;
- R_CStackLimit = (uintptr_t)-1;
+ uintptr_t old_lim = ROb(R_CStackLimit);
+ ROb(R_CStackLimit) = (uintptr_t)-1;
if ((status != 0) && (RKRBackend::this_pointer->killed != RKRBackend::ExitNow)) RKRBackend::this_pointer->killed = RKRBackend::EmergencySaveThenExit;
if (RKRBackend::this_pointer->killed == RKRBackend::EmergencySaveThenExit) {
- if (R_DirtyImage) {
+ if (ROb(R_DirtyImage)) {
QString filename;
QDir dir (RKRBackendProtocolBackend::dataDir ());
int i=0;
@@ -530,7 +517,7 @@ void RCleanUp (SA_TYPE saveact, int status, int RunLast) {
}
filename = dir.absoluteFilePath (filename);
- R_SaveGlobalEnvToFile (filename.toLocal8Bit ().data ());
+ RFn::R_SaveGlobalEnvToFile(filename.toLocal8Bit().data());
RK_DEBUG(RBACKEND, DL_WARNING, "Created emergency save file in %s", qPrintable(filename));
} else {
RK_DEBUG(RBACKEND, DL_WARNING, "Image not dirty while crashing. No emergency save created.");
@@ -544,14 +531,14 @@ void RCleanUp (SA_TYPE saveact, int status, int RunLast) {
RKRBackend::this_pointer->handleRequest (&request);
}
RK_DEBUG(RBACKEND, DL_DEBUG, "Cleaning up");
- R_RunExitFinalizers ();
- Rf_KillAllDevices ();
- R_CleanTempDir ();
+ RFn::R_RunExitFinalizers ();
+ RFn::Rf_KillAllDevices ();
+ RFn::R_CleanTempDir ();
}
RKRBackend::this_pointer->killed = RKRBackend::AlreadyDead; // just in case
- R_CStackLimit = old_lim; // well, it should not matter any longer, but...
+ ROb(R_CStackLimit) = old_lim; // well, it should not matter any longer, but...
RK_DEBUG(RBACKEND, DL_DEBUG, "Cleanup finished");
RKRBackendProtocolBackend::doExit();
}
@@ -577,13 +564,13 @@ void RKRBackend::tryToDoEmergencySave () {
// If we are in the correct thread, things are easy:
RKRBackend::this_pointer->killed = RKRBackend::EmergencySaveThenExit;
RCleanUp (SA_SUICIDE, 1, 0);
- RK_doIntr (); // to jump out of the loop, if needed
+ RK_doIntr(); // to jump out of the loop, if needed
} else {
// If we are in the wrong thread, things are a lot more tricky. We need to cause the R thread to exit, and wait for it to finish saving.
// Fortunately, if we are in the wrong thread, that probably means, the R thread did *not* crash, and will thus still be functional
this_pointer->killed = EmergencySaveThenExit;
return;
- RK_scheduleIntr ();
+ RK_scheduleIntr();
for (int i = 0; i < 100; ++i) { // give it up to ten seconds to interrupt and exit the loop
if (!this_pointer->r_running) break;
RKRBackendProtocolBackend::msleep (100);
@@ -665,11 +652,11 @@ SEXP doShowEditFiles (SEXP files, SEXP titles, SEXP wtitle, SEXP del, SEXP promp
REditFilesHelper (file_strings, title_strings, wtitle_string, edit, del_files, do_prompt);
- return (R_NilValue);
+ return (ROb(R_NilValue));
}
SEXP doEditFiles (SEXP files, SEXP titles, SEXP wtitle, SEXP prompt) {
- return (doShowEditFiles (files, titles, wtitle, R_NilValue, prompt, RBackendRequest::EditFiles));
+ return (doShowEditFiles (files, titles, wtitle, ROb(R_NilValue), prompt, RBackendRequest::EditFiles));
}
int REditFile (const char *buf) {
@@ -723,8 +710,8 @@ SEXP doDialog (SEXP caption, SEXP message, SEXP button_yes, SEXP button_no, SEXP
int result = doDialogHelper (RKRSupport::SEXPToString (caption), RKRSupport::SEXPToString (message), RKRSupport::SEXPToString (button_yes), RKRSupport::SEXPToString (button_no), RKRSupport::SEXPToString (button_cancel), RKRSupport::SEXPToString (default_button), RKRSupport::SEXPToInt (wait));
- SEXP ret = Rf_allocVector(INTSXP, 1);
- INTEGER (ret)[0] = result;
+ SEXP ret = RFn::Rf_allocVector(INTSXP, 1);
+ RFn::INTEGER(ret)[0] = result;
return ret;
}
@@ -785,8 +772,8 @@ RKRBackend::RKRBackend() : stdout_stderr_mutex() {
void RKRBackend::setupCallbacks () {
RK_TRACE (RBACKEND);
- R_setStartTime();
- R_DefParams(&RK_R_Params);
+ RFn::R_setStartTime();
+ RFn::R_DefParams(&RK_R_Params);
// IMPORTANT: see also the #ifndef QS_WS_WIN-portion!
RK_R_Params.rhome = get_R_HOME ();
@@ -814,7 +801,7 @@ void RKRBackend::setupCallbacks () {
void RKRBackend::connectCallbacks () {
RK_TRACE (RBACKEND);
- R_SetParams(&RK_R_Params);
+ RFn::R_SetParams(&RK_R_Params);
}
#else
void RKRBackend::setupCallbacks () {
@@ -823,7 +810,7 @@ void RKRBackend::setupCallbacks () {
/*
SEXP dummyselectlist (SEXP, SEXP, SEXP, SEXP) {
qDebug ("got it");
- return R_NilValue;
+ return ROb(R_NilValue);
}*/
void RKRBackend::connectCallbacks () {
@@ -831,29 +818,29 @@ void RKRBackend::connectCallbacks () {
// IMPORTANT: see also the #ifdef QS_WS_WIN-portion!
// connect R standard callback to our own functions. Important: Don't do so, before our own versions are ready to be used!
- R_Outputfile = NULL;
- R_Consolefile = NULL;
- ptr_R_Suicide = RSuicide;
- ptr_R_ShowMessage = RShowMessage; // rarely used in R on unix
- ptr_R_ReadConsole = RReadConsole;
- ptr_R_WriteConsoleEx = RWriteConsoleEx;
- ptr_R_WriteConsole = nullptr;
- ptr_R_ResetConsole = RDoNothing;
- ptr_R_FlushConsole = RDoNothing;
- ptr_R_ClearerrConsole = RDoNothing;
- ptr_R_Busy = RBusy;
- ptr_R_CleanUp = RCleanUp; // unfortunately, it seems, we can't safely cancel quitting anymore, here!
- ptr_R_ShowFiles = RShowFiles;
- ptr_R_ChooseFile = RChooseFile;
+ ROb(R_Outputfile) = NULL;
+ ROb(R_Consolefile) = NULL;
+ ROb(ptr_R_Suicide) = RSuicide;
+ ROb(ptr_R_ShowMessage) = RShowMessage; // rarely used in R on unix
+ ROb(ptr_R_ReadConsole) = RReadConsole;
+ ROb(ptr_R_WriteConsoleEx) = RWriteConsoleEx;
+ ROb(ptr_R_WriteConsole) = nullptr;
+ ROb(ptr_R_ResetConsole) = RDoNothing;
+ ROb(ptr_R_FlushConsole) = RDoNothing;
+ ROb(ptr_R_ClearerrConsole) = RDoNothing;
+ ROb(ptr_R_Busy) = RBusy;
+ ROb(ptr_R_CleanUp) = RCleanUp; // unfortunately, it seems, we can't safely cancel quitting anymore, here!
+ ROb(ptr_R_ShowFiles) = RShowFiles;
+ ROb(ptr_R_ChooseFile) = RChooseFile;
// TODO: R devels disabled this for some reason. We set it anyway...
- ptr_R_EditFile = REditFile;
-// ptr_R_EditFiles = REditFiles; // undefined reference
-/* ptr_do_selectlist = dummyselectlist;
- ptr_do_dataviewer = dummyselectlist;*/
+ ROb(ptr_R_EditFile) = REditFile;
+// ROb(ptr_R_EditFiles) = REditFiles; // undefined reference
+/* ROb(ptr_do_selectlist) = dummyselectlist;
+ ROb(ptr_do_dataviewer) = dummyselectlist;*/
// these two, we won't override
-// ptr_R_loadhistory = ... // we keep our own history
-// ptr_R_savehistory = ... // we keep our own history
+// ROb(ptr_R_loadhistory) = ... // we keep our own history
+// ROb(ptr_R_savehistory) = ... // we keep our own history
}
#endif
@@ -861,11 +848,6 @@ RKRBackend::~RKRBackend () {
RK_TRACE (RBACKEND);
}
-#ifdef _MSC_VER
-extern "C" int R_interrupts_pending;
-#else
-LibExtern int R_interrupts_pending;
-#endif
void doError (const QString &callstring) {
RK_TRACE (RBACKEND);
@@ -873,12 +855,12 @@ void doError (const QString &callstring) {
RKRBackend::repl_status.user_command_status = RKRBackend::RKReplStatus::UserCommandFailed;
}
if (RKRBackend::repl_status.interrupted) {
- // it is unlikely, but possible, that an interrupt signal was received, but the current command failed for some other reason, before processing was actually interrupted. In this case, R_interrupts_pending if not yet cleared.
+ // it is unlikely, but possible, that an interrupt signal was received, but the current command failed for some other reason, before processing was actually interrupted. In this case, R_interrupts_pending is not yet cleared.
// NOTE: if R_interrupts_pending stops being exported one day, we might be able to use R_CheckUserInterrupt() inside an R_ToplevelExec() to find out, whether an interrupt was still pending.
#ifdef Q_OS_WIN
- if (!UserBreak) {
+ if (!ROb(UserBreak)) {
#else
- if (!R_interrupts_pending) {
+ if (!ROb(R_interrupts_pending)) {
#endif
RKRBackend::repl_status.interrupted = false;
if (RKRBackend::repl_status.user_command_status != RKRBackend::RKReplStatus::ReplIterationKilled) { // was interrupted only to step out of the repl iteration
@@ -896,7 +878,7 @@ void doError (const QString &callstring) {
SEXP doSubstackCall (SEXP _call, SEXP _args) {
RK_TRACE (RBACKEND);
- R_CheckUserInterrupt ();
+ RFn::R_CheckUserInterrupt ();
QString call = RKRSupport::SEXPToStringList(_call).value(0);
/* // this is a useful place to sneak in test code for profiling
@@ -904,13 +886,13 @@ SEXP doSubstackCall (SEXP _call, SEXP _args) {
for (int i = 10000; i >= 1; --i) {
setWarnOption (i);
}
- return R_NilValue;
+ return ROb(R_NilValue);
} */
// For now, for simplicity, assume args are always strings, although possibly nested in lists
auto ret = RKRBackend::this_pointer->handleRequestWithSubcommands(call, RKRSupport::SEXPToNestedStrings(_args));
- if (!ret.warning.isEmpty()) Rf_warning(RKTextCodec::toNative(ret.warning).constData()); // print warnings, first, as errors will cause a stop
- if (!ret.error.isEmpty()) Rf_error(RKTextCodec::toNative(ret.error).constData());
+ if (!ret.warning.isEmpty()) RFn::Rf_warning(RKTextCodec::toNative(ret.warning).constData()); // print warnings, first, as errors will cause a stop
+ if (!ret.error.isEmpty()) RFn::Rf_error(RKTextCodec::toNative(ret.error).constData());
return RKRSupport::QVariantToSEXP(ret.ret);
}
@@ -918,11 +900,11 @@ SEXP doSubstackCall (SEXP _call, SEXP _args) {
SEXP doPlainGenericRequest (SEXP call, SEXP synchronous) {
RK_TRACE (RBACKEND);
- R_CheckUserInterrupt ();
+ RFn::R_CheckUserInterrupt ();
auto ret = RKRBackend::this_pointer->handlePlainGenericRequest(RKRSupport::SEXPToStringList(call), RKRSupport::SEXPToInt(synchronous));
- if (!ret.warning.isEmpty()) Rf_warning(RKTextCodec::toNative(ret.warning).constData()); // print warnings, first, as errors will cause a stop
- if (!ret.error.isEmpty()) Rf_error(RKTextCodec::toNative(ret.error).constData());
+ if (!ret.warning.isEmpty()) RFn::Rf_warning(RKTextCodec::toNative(ret.warning).constData()); // print warnings, first, as errors will cause a stop
+ if (!ret.error.isEmpty()) RFn::Rf_error(RKTextCodec::toNative(ret.error).constData());
return RKRSupport::QVariantToSEXP(ret.ret);
}
@@ -953,17 +935,17 @@ SEXP doSimpleBackendCall (SEXP _call) {
}
} else if (call == QStringLiteral ("error")) { // capture error message
doError (list.value (1));
- return R_NilValue;
+ return ROb(R_NilValue);
} else if (call == QStringLiteral ("tempdir")) {
return (RKRSupport::StringListToSEXP (QStringList (RKRBackendProtocolBackend::dataDir ())));
}
RK_ASSERT (false); // Unhandled call.
- return R_NilValue;
+ return ROb(R_NilValue);
}
void R_CheckStackWrapper (void *) {
- R_CheckStack ();
+ RFn::R_CheckStack ();
}
SEXP doUpdateLocale() {
@@ -972,7 +954,7 @@ SEXP doUpdateLocale() {
RK_DEBUG(RBACKEND, DL_WARNING, "Changing locale");
RKTextCodec::reinit();
- return R_NilValue;
+ return ROb(R_NilValue);
}
SEXP doGetStructure (SEXP toplevel, SEXP name, SEXP envlevel, SEXP namespacename) {
@@ -980,25 +962,25 @@ SEXP doGetStructure (SEXP toplevel, SEXP name, SEXP envlevel, SEXP namespacename
RKStructureGetter getter (false);
RData *ret = getter.getStructure (toplevel, name, envlevel, namespacename);
- return R_MakeExternalPtr (ret, RKWard_RData_Tag, R_NilValue);
+ return RFn::R_MakeExternalPtr(ret, RKWard_RData_Tag, ROb(R_NilValue));
}
SEXP doGetGlobalEnvStructure (SEXP name, SEXP envlevel, SEXP namespacename) {
RK_TRACE (RBACKEND);
- return doGetStructure (Rf_findVar (Rf_install (CHAR (STRING_ELT (name, 0))), R_GlobalEnv), name, envlevel, namespacename);
+ return doGetStructure(RFn::Rf_findVar(RFn::Rf_installChar(RFn::STRING_ELT(name, 0)), ROb(R_GlobalEnv)), name, envlevel, namespacename);
}
/** copy a symbol without touching it (esp. not forcing any promises) */
SEXP doCopyNoEval (SEXP fromname, SEXP fromenv, SEXP toname, SEXP toenv) {
RK_TRACE (RBACKEND);
- if(!Rf_isString (fromname) || Rf_length (fromname) != 1) Rf_error ("fromname is not a single string");
- if(!Rf_isString (toname) || Rf_length (toname) != 1) Rf_error ("toname is not a single string");
- if(!Rf_isEnvironment (fromenv)) Rf_error ("fromenv is not an environment");
- if(!Rf_isEnvironment (toenv)) Rf_error ("toenv is not an environment");
- Rf_defineVar (Rf_install (CHAR (STRING_ELT (toname, 0))), Rf_findVar (Rf_install (CHAR (STRING_ELT (fromname, 0))), fromenv), toenv);
- return (R_NilValue);
+ if(!RFn::Rf_isString(fromname) || RFn::Rf_length(fromname) != 1) RFn::Rf_error ("fromname is not a single string");
+ if(!RFn::Rf_isString(toname) || RFn::Rf_length(toname) != 1) RFn::Rf_error ("toname is not a single string");
+ if(!RFn::Rf_isEnvironment(fromenv)) RFn::Rf_error("fromenv is not an environment");
+ if(!RFn::Rf_isEnvironment(toenv)) RFn::Rf_error("toenv is not an environment");
+ RFn::Rf_defineVar(RFn::Rf_installChar(RFn::STRING_ELT(toname, 0)), RFn::Rf_findVar(RFn::Rf_installChar(RFn::STRING_ELT(fromname, 0)), fromenv), toenv);
+ return (ROb(R_NilValue));
}
SEXP doCaptureOutput (SEXP mode, SEXP capture_messages, SEXP capture_output, SEXP suppress_messages, SEXP suppress_output, SEXP allow_nesting) {
@@ -1012,7 +994,7 @@ SEXP doCaptureOutput (SEXP mode, SEXP capture_messages, SEXP capture_output, SEX
if (RKRSupport::SEXPToInt (suppress_output)) cm |= RKROutputBuffer::SuppressOutput;
if (!RKRSupport::SEXPToInt (allow_nesting)) cm |= RKROutputBuffer::NoNesting;
RKRBackend::this_pointer->pushOutputCapture (cm);
- return (R_NilValue);
+ return (ROb(R_NilValue));
} else {
return RKRSupport::StringListToSEXP (QStringList (RKRBackend::this_pointer->popOutputCapture (RKRSupport::SEXPToInt (mode) == 2)));
}
@@ -1024,7 +1006,7 @@ void doPendingPriorityCommands ();
SEXP checkEnv(SEXP a) {
auto res = RKRShadowEnvironment::diffAndUpdate(a);
- return Rf_list3(RKRSupport::StringListToSEXP(res.added), RKRSupport::StringListToSEXP(res.removed), RKRSupport::StringListToSEXP(res.changed));
+ return RFn::Rf_list3(RKRSupport::StringListToSEXP(res.added), RKRSupport::StringListToSEXP(res.removed), RKRSupport::StringListToSEXP(res.changed));
}
bool RKRBackend::startR () {
@@ -1038,10 +1020,10 @@ bool RKRBackend::startR () {
r_running = true;
int argc = 3;
char* argv[3] = { qstrdup ("--slave"), qstrdup ("--no-save"), qstrdup ("--no-restore") };
- Rf_initialize_R (argc, argv);
+ RFn::Rf_initialize_R(argc, argv);
#ifdef Q_OS_WIN
- R_set_command_line_arguments(argc, argv);
+ RFn::R_set_command_line_arguments(argc, argv);
FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
#endif
@@ -1059,21 +1041,21 @@ bool RKRBackend::startR () {
#ifndef Q_OS_WIN
// It is important to set this *early*, so R does not bail out, if there is an error in .Rprofile.
// On windows, set in connectCallbacks() for technical reasons, and that seems sufficient.
- R_Interactive = (Rboolean) TRUE;
+ ROb(R_Interactive) = Rboolean::TRUE;
#endif
- setup_Rmainloop ();
+ RFn::setup_Rmainloop();
#ifndef Q_OS_WIN
// safety check: If we are beyond the stack boundaries already, we better disable stack checking
// this has to come *after* the first setup_Rmainloop ()!
- Rboolean stack_ok = R_ToplevelExec (R_CheckStackWrapper, (void *) 0);
+ Rboolean stack_ok = RFn::R_ToplevelExec(R_CheckStackWrapper, (void *) 0);
if (!stack_ok) {
RK_DEBUG (RBACKEND, DL_WARNING, "R_CheckStack() failed during initialization. Will disable stack checking and try to re-initialize.");
RK_DEBUG (RBACKEND, DL_WARNING, "Whether or not things work after this, *please* submit a bug report.");
- R_CStackStart = (uintptr_t) -1;
- R_CStackLimit = (uintptr_t) -1;
- setup_Rmainloop ();
+ ROb(R_CStackStart) = (uintptr_t) -1;
+ ROb(R_CStackLimit) = (uintptr_t) -1;
+ RFn::setup_Rmainloop();
}
#endif
@@ -1082,17 +1064,17 @@ bool RKRBackend::startR () {
// But historically, it was placed here (after setup_Rmainloop(), and conceivably there
// was a reason to that (might have been reset in setup_Rmainloop() in earlier versions
// of R.
- R_Interactive = (Rboolean) TRUE;
+ ROb(R_Interactive) = Rboolean::TRUE;
#endif
setlocale (LC_NUMERIC, "C"); // Under some conditions something appears to mess with the locale. R will not work correctly without LC_NUMERIC=C
RBackendRequest req (false, RBackendRequest::SetParamsFromBackend);
- req.params["na_real"] = NA_REAL; // may not be initialized before setup_Rmainloop!
- req.params["na_int"] = NA_INTEGER;
+ req.params["na_real"] = ROb(R_NaReal); // may not be initialized before setup_Rmainloop!
+ req.params["na_int"] = ROb(R_NaInt);
handleRequest (&req);
- RKWard_RData_Tag = Rf_install ("RKWard_RData_Tag");
+ RKWard_RData_Tag = RFn::Rf_install ("RKWard_RData_Tag");
RKSignalSupport::installSignalProxies (); // for the crash signals
RKSignalSupport::installSigIntAndUsrHandlers (RK_scheduleIntr);
@@ -1116,12 +1098,12 @@ bool RKRBackend::startR () {
{ "rk.graphics.device.resize", (DL_FUNC) (void*) &RKD_AdjustSize, 2},
{ nullptr, nullptr, 0 }
};
- R_registerRoutines (R_getEmbeddingDllInfo(), NULL, callMethods, NULL, NULL);
+ RFn::R_registerRoutines(RFn::R_getEmbeddingDllInfo(), NULL, callMethods, NULL, NULL);
connectCallbacks();
RKInsertToplevelStatementFinishedCallback(nullptr);
- RKREventLoop::setRKEventHandler (doPendingPriorityCommands);
- default_global_context = R_GlobalContext;
+ RKREventLoop::setRKEventHandler(doPendingPriorityCommands);
+ default_global_context = ROb(R_GlobalContext);
#ifdef Q_OS_WIN
// See the corresponding note in RWriteConsoleEx(). For auto-detecting UTF8 markers in console output.
win_do_detect_winutf8markers = true;
@@ -1192,8 +1174,8 @@ void RKRBackend::enterEventLoop () {
pthread_atfork (prepareFork, completeForkMaster, completeForkChild);
#endif
- run_Rmainloop ();
- // NOTE: Do NOT run Rf_endEmbeddedR(). It does more that we want. We rely on RCleanup, instead.
+ RFn::run_Rmainloop();
+ // NOTE: Do NOT run RFn::Rf_endEmbeddedR(). It does more that we want. We rely on RCleanup, instead.
// NOTE: never reached with R since ?? at least 4.3: RCleanUp is expected to exit the process
RK_DEBUG(RBACKEND, DL_DEBUG, "R loop finished");
}
@@ -1208,7 +1190,7 @@ void safeParseVector (void *data) {
SafeParseWrap *wrap = static_cast<SafeParseWrap*> (data);
wrap->pr = nullptr;
// TODO: Maybe we can use R_ParseGeneral instead. Then we could find the exact character, where parsing fails. Nope: not exported API
- wrap->pr = R_ParseVector (wrap->cv, -1, &(wrap->status), R_NilValue);
+ wrap->pr = RFn::R_ParseVector(wrap->cv, -1, &(wrap->status), ROb(R_NilValue));
}
SEXP parseCommand (const QString &command_qstring, RKRBackend::RKWardRError *error) {
@@ -1220,16 +1202,16 @@ SEXP parseCommand (const QString &command_qstring, RKRBackend::RKWardRError *err
QByteArray localc = RKTextCodec::toNative(command_qstring); // needed so the string below does not go out of scope
const char *command = localc.data ();
- PROTECT(wrap.cv=Rf_allocVector(STRSXP, 1));
- SET_STRING_ELT(wrap.cv, 0, Rf_mkChar(command));
+ RFn::Rf_protect(wrap.cv=RFn::Rf_allocVector(STRSXP, 1));
+ RFn::SET_STRING_ELT(wrap.cv, 0, RFn::Rf_mkChar(command));
// Yes, if there is an error in the parse, R does jump back to toplevel!
// trying to parse list(""=1) is an example in R 3.1.1
- R_ToplevelExec (safeParseVector, &wrap);
+ RFn::R_ToplevelExec(safeParseVector, &wrap);
SEXP pr = wrap.pr;
- UNPROTECT(1);
+ RFn::Rf_unprotect(1);
- if ((!pr) || (TYPEOF (pr) == NILSXP)) {
+ if ((!pr) || (RFn::TYPEOF (pr) == NILSXP)) {
// got a null SEXP. This means parse was *not* ok, even if R_ParseVector told us otherwise
if (wrap.status == PARSE_OK) {
wrap.status = PARSE_ERROR;
@@ -1242,12 +1224,12 @@ SEXP parseCommand (const QString &command_qstring, RKRBackend::RKWardRError *err
*error = RKRBackend::Incomplete;
} else if (wrap.status == PARSE_ERROR) {
//extern SEXP parseError (SEXP call, int linenum);
- //parseError (R_NilValue, 0);
+ //parseError (ROb(R_NilValue), 0);
*error = RKRBackend::SyntaxError;
} else { // PARSE_NULL
*error = RKRBackend::OtherError;
}
- pr = R_NilValue;
+ pr = ROb(R_NilValue);
}
return pr;
@@ -1259,20 +1241,20 @@ SEXP runCommandInternalBase (SEXP pr, RKRBackend::RKWardRError *error) {
SEXP exp;
int r_error = 0;
- exp=R_NilValue;
+ exp=ROb(R_NilValue);
- if (TYPEOF(pr)==EXPRSXP && LENGTH(pr)>0) {
+ if (RFn::TYPEOF(pr)==EXPRSXP && RFn::LENGTH(pr)>0) {
int bi=0;
- while (bi<LENGTH(pr)) {
- SEXP pxp=VECTOR_ELT(pr, bi);
- exp=R_tryEval(pxp, R_GlobalEnv, &r_error);
+ while (bi<RFn::LENGTH(pr)) {
+ SEXP pxp=RFn::VECTOR_ELT(pr, bi);
+ exp=RFn::R_tryEval(pxp, ROb(R_GlobalEnv), &r_error);
bi++;
if (r_error) {
break;
}
}
} else {
- exp=R_tryEval(pr, R_GlobalEnv, &r_error);
+ exp=RFn::R_tryEval(pr, ROb(R_GlobalEnv), &r_error);
}
if (r_error) {
@@ -1285,15 +1267,15 @@ SEXP runCommandInternalBase (SEXP pr, RKRBackend::RKWardRError *error) {
// see the corresponding #if in runCommand
#if R_VERSION < R_Version(2,13,0)
// for safety, let's protect exp for the two print calls below.
- // TODO: this is not good. It causes an additional PROTECT and UPROTECT. Need to (re-)move printing
- PROTECT (exp);
+ // TODO: this is not good. It causes an additional RFn::Rf_protect and URFn::Rf_protect. Need to (re-)move printing
+ RFn::Rf_protect (exp);
/* Do NOT ask me why, but the line below is needed for warnings to be printed, while otherwise they would not be shown.
Apparently we need to print at least something in order to achieve this. Whatever really happens in Rprintf () to have such an effect, I did not bother to find out. */
- Rprintf ((char *) "");
+ RFn::Rprintf((char *) "");
- Rf_PrintWarnings ();
+ RFn::Rf_PrintWarnings();
- UNPROTECT (1); // exp; We unprotect this, as most of the time the caller is not really interested in the result
+ RFn::Rf_unprotect (1); // exp; We unprotect this, as most of the time the caller is not really interested in the result
#endif
return exp;
}
@@ -1317,15 +1299,15 @@ RCommandProxy *RKRBackend::runDirectCommand (const QString &command, RCommand::C
void setWarnOption (int level) {
SEXP s, t;
- PROTECT (t = s = Rf_allocList (2));
- SET_TYPEOF (s, LANGSXP);
- SETCAR (t, Rf_install ("options")); t = CDR (t);
- SETCAR (t, Rf_ScalarInteger (level));
- SET_TAG (t, Rf_install ("warn"));
+ RFn::Rf_protect (t = s = RFn::Rf_allocList(2));
+ RFn::SET_TYPEOF (s, LANGSXP);
+ RFn::SETCAR(t, RFn::Rf_install("options")); t = RFn::CDR (t);
+ RFn::SETCAR(t, RFn::Rf_ScalarInteger(level));
+ RFn::SET_TAG(t, RFn::Rf_install("warn"));
// The above is rougly equivalent to parseCommand ("options(warn=" + QString::number (level) + ")", &error), but ~100 times faster
RKRBackend::RKWardRError error;
runCommandInternalBase (s, &error);
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
}
void RKRBackend::runCommand (RCommandProxy *command) {
@@ -1343,7 +1325,7 @@ void RKRBackend::runCommand (RCommandProxy *command) {
if (ctype & RCommand::CCOutput) startOutputCapture ();
if (ctype & RCommand::QuitCommand) {
- R_dot_Last (); // should run while communication with frontend is still possible
+ RFn::R_dot_Last (); // should run while communication with frontend is still possible
RBackendRequest req (true, RBackendRequest::BackendExit);
req.params["regular"] = QVariant (true);
handleRequest (&req);
@@ -1352,13 +1334,13 @@ void RKRBackend::runCommand (RCommandProxy *command) {
repl_status.eval_depth++;
SEXP parsed = parseCommand (command->command, &error);
if (error == NoError) {
- PROTECT (parsed);
+ RFn::Rf_protect (parsed);
SEXP exp;
#if R_VERSION >= R_Version(2,13,0)
- int warn_level = RKRSupport::SEXPToInt (Rf_GetOption1 (Rf_install ("warn")), 0);
+ int warn_level = RKRSupport::SEXPToInt (RFn::Rf_GetOption1(RFn::Rf_install("warn")), 0);
if (warn_level != 1) setWarnOption (1);
#endif
- PROTECT (exp = runCommandInternalBase (parsed, &error));
+ RFn::Rf_protect (exp = runCommandInternalBase (parsed, &error));
#if R_VERSION >= R_Version(2,13,0)
if (warn_level != 1) setWarnOption (warn_level);
#endif
@@ -1375,7 +1357,7 @@ void RKRBackend::runCommand (RCommandProxy *command) {
delete dummy;
}
}
- UNPROTECT (2); // exp, parsed
+ RFn::Rf_unprotect (2); // exp, parsed
}
repl_status.eval_depth--;
}
@@ -1724,7 +1706,7 @@ void RKRBackend::checkObjectUpdatesNeeded (bool check_list) {
}
}
- auto changes = RKRShadowEnvironment::diffAndUpdate(R_GlobalEnv);
+ auto changes = RKRShadowEnvironment::diffAndUpdate(ROb(R_GlobalEnv));
if (!changes.isEmpty()) {
QVariantList args;
args.append(changes.added);
diff --git a/rkward/rbackend/rkreventloop.cpp b/rkward/rbackend/rkreventloop.cpp
index ed63be9f6..7583d2d1b 100644
--- a/rkward/rbackend/rkreventloop.cpp
+++ b/rkward/rbackend/rkreventloop.cpp
@@ -1,6 +1,6 @@
/*
rkreventloop - This file is part of RKWard (https://rkward.kde.org). Created: Tue Apr 23 2013
-SPDX-FileCopyrightText: 2013 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
+SPDX-FileCopyrightText: 2013-2024 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
SPDX-FileContributor: The RKWard Team <rkward-devel at kde.org>
SPDX-License-Identifier: GPL-2.0-or-later
*/
@@ -8,13 +8,7 @@ SPDX-License-Identifier: GPL-2.0-or-later
#include "rkreventloop.h"
#include "rkrbackend.h"
-#ifdef Q_OS_WIN
-# define Win32
-# include <R.h>
-#else
-# include <R_ext/eventloop.h>
-#endif
-#include <Rinternals.h>
+#include "rkrapi.h"
#include "../debug.h"
@@ -25,16 +19,16 @@ static void processX11EventsWorker (void *) {
#ifndef Q_OS_WIN
for (;;) {
fd_set *what;
- what = R_checkActivityEx(R_wait_usec > 0 ? R_wait_usec : 50, 1, RK_doIntr);
- R_runHandlers(R_InputHandlers, what);
+ what = RFn::R_checkActivityEx(ROb(R_wait_usec) > 0 ? ROb(R_wait_usec) : 50, 1, RK_doIntr);
+ RFn::R_runHandlers(ROb(R_InputHandlers), what);
if (what == NULL) break;
}
/* This seems to be needed to make Rcmdr react to events. Has this always been the case? It was commented out for a long time, without anybody noticing. */
- R_PolledEvents ();
+ (*ROb(R_PolledEvents))();
#else
// TODO: correct?
// NOTE: We essentially process events while waiting. Perhaps we should simply use the equivalent of "try(sleep(0.01))", instead.
- R_ProcessEvents();
+ RFn::R_ProcessEvents();
#endif
#if 0
@@ -59,7 +53,7 @@ void RKREventLoop::processX11Events() {
RKRBackend::repl_status.eval_depth++;
// In case an error (or user interrupt) is caught inside processX11EventsWorker, we don't want to long-jump out.
- R_ToplevelExec(processX11EventsWorker, nullptr);
+ RFn::R_ToplevelExec(processX11EventsWorker, nullptr);
RKRBackend::repl_status.eval_depth--;
}
@@ -105,14 +99,14 @@ void RKREventLoop::setRKEventHandler (void (* handler) ()) {
if (!pipe (fds)) {
ifd = fds[0];
ofd = fds[1];
- addInputHandler (R_InputHandlers, ifd, RK_eventHandlerWrapper, 32);
+ RFn::addInputHandler(ROb(R_InputHandlers), ifd, RK_eventHandlerWrapper, 32);
ok = true;
}
if (ok) return;
// if pipe method did not work, fall back to R_PolledEvents
- RK_old_R_PolledEvents = R_PolledEvents;
- R_PolledEvents = RK_eventHandlerChain;
+ RK_old_R_PolledEvents = ROb(R_PolledEvents);
+ ROb(R_PolledEvents) = RK_eventHandlerChain;
#endif
}
diff --git a/rkward/rbackend/rkrsupport.cpp b/rkward/rbackend/rkrsupport.cpp
index 282528550..765b90632 100644
--- a/rkward/rbackend/rkrsupport.cpp
+++ b/rkward/rbackend/rkrsupport.cpp
@@ -14,49 +14,49 @@ SPDX-License-Identifier: GPL-2.0-or-later
SEXP RKWard_RData_Tag;
SEXP RKRSupport::callSimpleFun0 (SEXP fun, SEXP env) {
- SEXP call = Rf_allocVector (LANGSXP, 1);
- PROTECT (call);
- SETCAR (call, fun);
+ SEXP call = RFn::Rf_allocVector (LANGSXP, 1);
+ RFn::Rf_protect(call);
+ RFn::SETCAR(call, fun);
- SEXP ret = Rf_eval (call, env);
+ SEXP ret = RFn::Rf_eval(call, env);
- UNPROTECT (1); /* call */
+ RFn::Rf_unprotect (1); /* call */
return ret;
}
SEXP RKRSupport::callSimpleFun (SEXP fun, SEXP arg, SEXP env) {
- SEXP call = Rf_allocVector (LANGSXP, 2);
- PROTECT (call);
- SETCAR (call, fun);
- SETCAR (CDR (call), arg);
+ SEXP call = RFn::Rf_allocVector (LANGSXP, 2);
+ RFn::Rf_protect(call);
+ RFn::SETCAR(call, fun);
+ RFn::SETCAR(RFn::CDR(call), arg);
- SEXP ret = Rf_eval (call, env);
+ SEXP ret = RFn::Rf_eval(call, env);
- UNPROTECT (1); /* call */
+ RFn::Rf_unprotect (1); /* call */
return ret;
}
SEXP RKRSupport::callSimpleFun2 (SEXP fun, SEXP arg1, SEXP arg2, SEXP env) {
- SEXP call = Rf_allocVector (LANGSXP, 3);
- PROTECT (call);
- SETCAR (call, fun);
- SETCAR (CDR (call), arg1);
- SETCAR (CDDR (call), arg2);
+ SEXP call = RFn::Rf_allocVector (LANGSXP, 3);
+ RFn::Rf_protect(call);
+ RFn::SETCAR(call, fun);
+ RFn::SETCAR(RFn::CDR(call), arg1);
+ RFn::SETCAR(RFn::CDDR(call), arg2);
- SEXP ret = Rf_eval (call, env);
+ SEXP ret = RFn::Rf_eval(call, env);
- UNPROTECT (1); /* call */
+ RFn::Rf_unprotect(1); /* call */
return ret;
}
bool RKRSupport::callSimpleBool (SEXP fun, SEXP arg, SEXP env) {
SEXP res = callSimpleFun (fun, arg, env);
- if ((Rf_length (res) < 1) || (TYPEOF (res) != LGLSXP)) {
- RK_ASSERT (TYPEOF (res) == LGLSXP);
- RK_ASSERT (Rf_length (res) >= 1);
+ if ((RFn::Rf_length (res) < 1) || (RFn::TYPEOF (res) != LGLSXP)) {
+ RK_ASSERT (RFn::TYPEOF (res) == LGLSXP);
+ RK_ASSERT (RFn::Rf_length (res) >= 1);
return false;
}
- return ((bool) LOGICAL (res)[0]);
+ return ((bool) RFn::LOGICAL (res)[0]);
}
/** converts SEXP to strings, and returns the first string (or QString(), if SEXP contains no strings) */
@@ -73,33 +73,33 @@ QStringList RKRSupport::SEXPToStringList (SEXP from_exp) {
RK_TRACE (RBACKEND);
// bad format? coerce the vector first
- if (TYPEOF (from_exp) != STRSXP) {
+ if (RFn::TYPEOF (from_exp) != STRSXP) {
SEXP strexp;
- PROTECT (strexp = Rf_coerceVector (from_exp, STRSXP));
+ RFn::Rf_protect (strexp = RFn::Rf_coerceVector (from_exp, STRSXP));
QStringList list = SEXPToStringList (strexp);
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
return list;
}
// format already good? Avoid coercion (and associated copying)
- int count = Rf_length (from_exp);
+ int count = RFn::Rf_length (from_exp);
QStringList list;
list.reserve (count);
for (int i = 0; i < count; ++i) {
- SEXP dummy = STRING_ELT (from_exp, i);
+ SEXP dummy = RFn::STRING_ELT (from_exp, i);
- if (TYPEOF (dummy) != CHARSXP) {
+ if (RFn::TYPEOF (dummy) != CHARSXP) {
list.append (QString ("not defined")); // can this ever happen?
} else {
- if (dummy == NA_STRING) {
+ if (dummy == ROb(R_NaString)) {
list.append (QString ());
} else {
if (IS_UTF8 (dummy)) {
- list.append (QString::fromUtf8 (CHAR (dummy)));
+ list.append (QString::fromUtf8 (RFn::R_CHAR(dummy)));
} else if (IS_LATIN1 (dummy)) {
- list.append (QString::fromLatin1 (CHAR (dummy)));
+ list.append (QString::fromLatin1 (RFn::R_CHAR(dummy)));
} else {
- list.append(RKTextCodec::fromNative(CHAR(dummy)));
+ list.append(RKTextCodec::fromNative(RFn::R_CHAR(dummy)));
}
}
}
@@ -111,9 +111,9 @@ QStringList RKRSupport::SEXPToStringList (SEXP from_exp) {
SEXP RKRSupport::StringListToSEXP (const QStringList& list) {
RK_TRACE (RBACKEND);
- SEXP ret = Rf_allocVector (STRSXP, list.size ());
+ SEXP ret = RFn::Rf_allocVector (STRSXP, list.size ());
for (int i = 0; i < list.size (); ++i) {
- SET_STRING_ELT(ret, i, Rf_mkCharCE(list[i].toUtf8().constData(), CE_UTF8));
+ RFn::SET_STRING_ELT(ret, i, RFn::Rf_mkCharCE(list[i].toUtf8().constData(), CE_UTF8));
}
return ret;
}
@@ -121,25 +121,25 @@ SEXP RKRSupport::StringListToSEXP (const QStringList& list) {
SEXP RKRSupport::QVariantToSEXP(const QVariant& var) {
RK_TRACE (RBACKEND);
- if (var.isNull()) return R_NilValue;
+ if (var.isNull()) return ROb(R_NilValue);
QMetaType t = var.metaType();
if (t == QMetaType(QMetaType::Bool)) {
- SEXP ret = Rf_allocVector(LGLSXP, 1);
- LOGICAL(ret)[0] = var.toBool();
+ SEXP ret = RFn::Rf_allocVector(LGLSXP, 1);
+ RFn::LOGICAL(ret)[0] = var.toBool();
return ret;
} else if (t == QMetaType(QMetaType::Int)) {
- SEXP ret = Rf_allocVector(INTSXP, 1);
- INTEGER(ret)[0] = var.toInt();
+ SEXP ret = RFn::Rf_allocVector(INTSXP, 1);
+ RFn::INTEGER(ret)[0] = var.toInt();
return ret;
} else if (t != QMetaType(QMetaType::QString) && t != QMetaType(QMetaType::QStringList)) {
- Rf_warning("unsupported QVariant type in QVariantToSEXP");
+ RFn::Rf_warning("unsupported QVariant type in QVariantToSEXP");
}
QStringList list = var.toStringList();
- SEXP ret = Rf_allocVector (STRSXP, list.size ());
+ SEXP ret = RFn::Rf_allocVector (STRSXP, list.size ());
for (int i = 0; i < list.size (); ++i) {
- SET_STRING_ELT(ret, i, Rf_mkCharCE(list[i].toUtf8().constData(), CE_UTF8));
+ RFn::SET_STRING_ELT(ret, i, RFn::Rf_mkCharCE(list[i].toUtf8().constData(), CE_UTF8));
}
return ret;
}
@@ -147,17 +147,17 @@ SEXP RKRSupport::QVariantToSEXP(const QVariant& var) {
QVariant RKRSupport::SEXPToNestedStrings(SEXP from_exp) {
RK_TRACE (RBACKEND);
- if (Rf_isVectorList(from_exp)) { // NOTE: list() in R is a vectorlist in the C API...
+ if (RFn::Rf_isVectorList(from_exp)) { // NOTE: list() in R is a vectorlist in the C API...
QVariantList ret;
- for(int i = 0; i < Rf_length(from_exp); ++i) {
- SEXP el = VECTOR_ELT(from_exp, i);
+ for(int i = 0; i < RFn::Rf_length(from_exp); ++i) {
+ SEXP el = RFn::VECTOR_ELT(from_exp, i);
ret.append(SEXPToNestedStrings(el));
}
return ret;
- } else if (Rf_isPairList(from_exp)) {
+ } else if (RFn::Rf_isPairList(from_exp)) {
QVariantList ret;
- for(SEXP cons = from_exp; cons != R_NilValue; cons = CDR(cons)) {
- ret.append(SEXPToNestedStrings(CAR(cons)));
+ for(SEXP cons = from_exp; cons != ROb(R_NilValue); cons = RFn::CDR(cons)) {
+ ret.append(SEXPToNestedStrings(RFn::CAR(cons)));
}
return ret;
}
@@ -170,19 +170,19 @@ RData::IntStorage RKRSupport::SEXPToIntArray (SEXP from_exp) {
RData::IntStorage integers;
// bad format? coerce the vector first
- if (TYPEOF (from_exp) != INTSXP) {
+ if (RFn::TYPEOF (from_exp) != INTSXP) {
SEXP intexp;
- PROTECT (intexp = Rf_coerceVector (from_exp, INTSXP));
+ RFn::Rf_protect (intexp = RFn::Rf_coerceVector (from_exp, INTSXP));
integers = SEXPToIntArray (intexp);
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
return integers;
}
// format already good? Avoid coercion (and associated copying)
- unsigned int count = Rf_length (from_exp);
+ unsigned int count = RFn::Rf_length (from_exp);
integers.reserve (count);
for (unsigned int i = 0; i < count; ++i) {
- integers.append (INTEGER (from_exp)[i]);
+ integers.append (RFn::INTEGER(from_exp)[i]);
}
return integers;
}
@@ -202,20 +202,20 @@ RData::RealStorage RKRSupport::SEXPToRealArray (SEXP from_exp) {
RData::RealStorage reals;
// bad format? coerce the vector first
- if (TYPEOF (from_exp) != REALSXP) {
+ if (RFn::TYPEOF (from_exp) != REALSXP) {
SEXP realexp;
- PROTECT (realexp = Rf_coerceVector (from_exp, REALSXP));
+ RFn::Rf_protect (realexp = RFn::Rf_coerceVector (from_exp, REALSXP));
reals = SEXPToRealArray (realexp);
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
return reals;
}
// format already good? Avoid coercion (and associated copying)
- unsigned int count = Rf_length (from_exp);
+ unsigned int count = RFn::Rf_length (from_exp);
reals.reserve (count);
for (unsigned int i = 0; i < count; ++i) {
- reals.append (REAL (from_exp)[i]);
- if (R_IsNaN (reals[i]) || R_IsNA (reals[i])) reals[i] = NA_REAL; // for our purposes, treat all non-numbers as missing
+ reals.append (RFn::REAL (from_exp)[i]);
+ if (RFn::R_IsNaN(reals[i]) || RFn::R_IsNA(reals[i])) reals[i] = ROb(R_NaReal); // for our purposes, treat all non-numbers as missing
}
return reals;
}
@@ -225,7 +225,7 @@ RData *RKRSupport::SEXPToRData (SEXP from_exp) {
RData *data = new RData;
- int type = TYPEOF (from_exp);
+ int type = RFn::TYPEOF (from_exp);
switch (type) {
case LGLSXP:
case INTSXP:
@@ -236,14 +236,14 @@ RData *RKRSupport::SEXPToRData (SEXP from_exp) {
break;
case VECSXP:
{
- unsigned int count = Rf_length (from_exp);
+ unsigned int count = RFn::Rf_length (from_exp);
RData::RDataStorage structure_array;
structure_array.reserve (count);
for (unsigned int i=0; i < count; ++i) {
- SEXP subexp = VECTOR_ELT (from_exp, i);
- //PROTECT (subexp); // should already be protected as part of the parent from_exp
+ SEXP subexp = RFn::VECTOR_ELT(from_exp, i);
+ //RFn::Rf_protect (subexp); // should already be protected as part of the parent from_exp
structure_array.append (SEXPToRData (subexp));
- //UNPROTECT (1);
+ //RFn::Rf_unprotect (1);
}
data->setData (structure_array);
}
@@ -254,10 +254,10 @@ RData *RKRSupport::SEXPToRData (SEXP from_exp) {
count = 0;
break; */
case EXTPTRSXP:
- if (R_ExternalPtrTag (from_exp) == RKWard_RData_Tag) { // our very own data
+ if (RFn::R_ExternalPtrTag(from_exp) == RKWard_RData_Tag) { // our very own data
delete data;
- data = (RData*) R_ExternalPtrAddr (from_exp);
- R_ClearExternalPtr (from_exp);
+ data = (RData*) RFn::R_ExternalPtrAddr(from_exp);
+ RFn::R_ClearExternalPtr(from_exp);
break;
}
#if (QT_VERSION >= QT_VERSION_CHECK(5,8,0))
@@ -275,26 +275,26 @@ SEXP RKRShadowEnvironment::shadowenvbase = nullptr;
QHash<SEXP, RKRShadowEnvironment*> RKRShadowEnvironment::environments;
RKRShadowEnvironment* RKRShadowEnvironment::environmentFor(SEXP baseenvir) {
RK_TRACE(RBACKEND);
- // TODO: probably R_GlobalEnv should be special-cased, as this is what we'll check most often (or exclusively?)
+ // TODO: probably ROb(R_GlobalEnv) should be special-cased, as this is what we'll check most often (or exclusively?)
if (!environments.contains(baseenvir)) {
RK_DEBUG(RBACKEND, DL_DEBUG, "creating new shadow environment for %p\n", baseenvir);
if (!shadowenvbase) {
- SEXP rkn = Rf_allocVector(STRSXP, 1);
- SET_STRING_ELT(rkn, 0, Rf_mkChar("package:rkward"));
- SEXP rkwardenv = RKRSupport::callSimpleFun(Rf_install("as.environment"), rkn, R_GlobalEnv);
- RK_ASSERT(Rf_isEnvironment(rkwardenv));
- SEXP rkwardvars = Rf_eval(Rf_findVar(Rf_install(".rk.variables"), rkwardenv), R_BaseEnv); // NOTE: Rf_eval to resolve promise
- RK_ASSERT(Rf_isEnvironment(rkwardvars));
- shadowenvbase = Rf_findVar(Rf_install(".rk.shadow.envs"), rkwardvars);
- RK_ASSERT(Rf_isEnvironment(shadowenvbase));
+ SEXP rkn = RFn::Rf_allocVector(STRSXP, 1);
+ RFn::SET_STRING_ELT(rkn, 0, RFn::Rf_mkChar("package:rkward"));
+ SEXP rkwardenv = RKRSupport::callSimpleFun(RFn::Rf_install("as.environment"), rkn, ROb(R_GlobalEnv));
+ RK_ASSERT(RFn::Rf_isEnvironment(rkwardenv));
+ SEXP rkwardvars = RFn::Rf_eval(RFn::Rf_findVar(RFn::Rf_install(".rk.variables"), rkwardenv), ROb(R_BaseEnv)); // NOTE: RFn::Rf_eval to resolve promise
+ RK_ASSERT(RFn::Rf_isEnvironment(rkwardvars));
+ shadowenvbase = RFn::Rf_findVar(RFn::Rf_install(".rk.shadow.envs"), rkwardvars);
+ RK_ASSERT(RFn::Rf_isEnvironment(shadowenvbase));
}
char name[sizeof(void*)*2+3];
sprintf(name, "%p", (void*) baseenvir);
- SEXP tr = Rf_allocVector(LGLSXP, 1);
- LOGICAL(tr)[0] = true;
- Rf_defineVar(Rf_install(name), RKRSupport::callSimpleFun2(Rf_install("new.env"), tr, R_EmptyEnv, R_GlobalEnv), shadowenvbase);
- SEXP shadowenvir = Rf_findVar(Rf_install(name), shadowenvbase);
+ SEXP tr = RFn::Rf_allocVector(LGLSXP, 1);
+ RFn::LOGICAL(tr)[0] = true;
+ RFn::Rf_defineVar(RFn::Rf_install(name), RKRSupport::callSimpleFun2(RFn::Rf_install("new.env"), tr, ROb(R_EmptyEnv), ROb(R_GlobalEnv)), shadowenvbase);
+ SEXP shadowenvir = RFn::Rf_findVar(RFn::Rf_install(name), shadowenvbase);
environments.insert(baseenvir, new RKRShadowEnvironment(baseenvir, shadowenvir));
}
return environments[baseenvir];
@@ -302,34 +302,34 @@ RKRShadowEnvironment* RKRShadowEnvironment::environmentFor(SEXP baseenvir) {
void RKRShadowEnvironment::updateCacheForGlobalenvSymbol(const QString& name) {
RK_DEBUG(RBACKEND, DL_DEBUG, "updating cached value for symbol %s", qPrintable(name));
- environmentFor(R_GlobalEnv)->updateSymbolCache(name);
+ environmentFor(ROb(R_GlobalEnv))->updateSymbolCache(name);
}
static void unbindSymbolWrapper(SEXP name, SEXP env) {
#if R_VERSION >= R_Version(4, 0, 0)
- R_removeVarFromFrame(name, env);
+ RFn::R_removeVarFromFrame(name, env);
#else
- SEXP call = PROTECT(Rf_allocVector(LANGSXP, 3));
- SETCAR(call, Rf_install("rm"));
- SEXP s = CDR(call);
- SETCAR(s, name);
- s = CDR(s);
- SETCAR(s, env);
- SET_TAG(s, Rf_install("pos"));
- Rf_eval(call, R_BaseEnv);
- UNPROTECT(1);
+ SEXP call = RFn::Rf_protect(RFn::Rf_allocVector(LANGSXP, 3));
+ RFn::SETRFn::CAR(call, RFn::Rf_install("rm"));
+ SEXP s = RFn::CDR(call);
+ RFn::SETRFn::CAR(s, name);
+ s = RFn::CDR(s);
+ RFn::SETRFn::CAR(s, env);
+ SET_TAG(s, RFn::Rf_install("pos"));
+ RFn::Rf_eval(call, ROb(R_BaseEnv));
+ RFn::Rf_unprotect(1);
#endif
}
void RKRShadowEnvironment::updateSymbolCache(const QString& name) {
RK_TRACE(RBACKEND);
- SEXP rname = Rf_installChar(Rf_mkCharCE(name.toUtf8().constData(), CE_UTF8));
- PROTECT(rname);
- SEXP symbol_g = Rf_findVar(rname, R_GlobalEnv);
- PROTECT(symbol_g);
- if (symbol_g == R_UnboundValue) unbindSymbolWrapper(rname, shadowenvir);
- else Rf_defineVar(rname, symbol_g, shadowenvir);
- UNPROTECT(2);
+ SEXP rname = RFn::Rf_installChar(RFn::Rf_mkCharCE(name.toUtf8().constData(), CE_UTF8));
+ RFn::Rf_protect(rname);
+ SEXP symbol_g = RFn::Rf_findVar(rname, ROb(R_GlobalEnv));
+ RFn::Rf_protect(symbol_g);
+ if (symbol_g == ROb(R_UnboundValue)) unbindSymbolWrapper(rname, shadowenvir);
+ else RFn::Rf_defineVar(rname, symbol_g, shadowenvir);
+ RFn::Rf_unprotect(2);
}
RKRShadowEnvironment::Result RKRShadowEnvironment::diffAndUpdate() {
@@ -337,46 +337,46 @@ RKRShadowEnvironment::Result RKRShadowEnvironment::diffAndUpdate() {
Result res;
// find the changed symbols, and copy them to the shadow environment
- SEXP symbols = R_lsInternal3(baseenvir, TRUE, FALSE); // envir, all.names, sorted
- PROTECT(symbols);
- int count = Rf_length(symbols);
+ SEXP symbols = RFn::R_lsInternal3(baseenvir, TRUE, FALSE); // envir, all.names, sorted
+ RFn::Rf_protect(symbols);
+ int count = RFn::Rf_length(symbols);
for (int i = 0; i < count; ++i) {
- SEXP name = Rf_installChar(STRING_ELT(symbols, i));
- PROTECT(name);
- SEXP main = Rf_findVarInFrame(baseenvir, name);
- SEXP cached = Rf_findVarInFrame(shadowenvir, name);
+ SEXP name = RFn::Rf_installChar(RFn::STRING_ELT(symbols, i));
+ RFn::Rf_protect(name);
+ SEXP main = RFn::Rf_findVarInFrame(baseenvir, name);
+ SEXP cached = RFn::Rf_findVarInFrame(shadowenvir, name);
if (main != cached) {
- Rf_defineVar(name, main, shadowenvir);
- if (cached == R_UnboundValue) {
+ RFn::Rf_defineVar(name, main, shadowenvir);
+ if (cached == ROb(R_UnboundValue)) {
res.added.append(RKRSupport::SEXPToString(name));
} else {
res.changed.append(RKRSupport::SEXPToString(name));
}
}
- UNPROTECT(1);
+ RFn::Rf_unprotect(1);
}
- UNPROTECT(1); // symbols
+ RFn::Rf_unprotect(1); // symbols
// find the symbols only in the shadow environment (those that were removed in the base)
- SEXP symbols2 = R_lsInternal3(shadowenvir, TRUE, FALSE);
- PROTECT(symbols2);
- int count2 = Rf_length(symbols2);
+ SEXP symbols2 = RFn::R_lsInternal3(shadowenvir, TRUE, FALSE);
+ RFn::Rf_protect(symbols2);
+ int count2 = RFn::Rf_length(symbols2);
if (count != count2) { // most of the time, no symbols have been removed, so we can skip the expensive check
for (int i = 0; i < count2; ++i) {
- SEXP name = Rf_installChar(STRING_ELT(symbols2, i));
- PROTECT(name);
+ SEXP name = RFn::Rf_installChar(RFn::STRING_ELT(symbols2, i));
+ RFn::Rf_protect(name);
// NOTE: R_findVar(), here, is enormously faster than searching the result of ls() for the name, at least when there is a large number of symbols.
// Importantly, environments provided hash-based lookup, by default.
- SEXP main = Rf_findVarInFrame(baseenvir, name);
- if (main == R_UnboundValue) {
+ SEXP main = RFn::Rf_findVarInFrame(baseenvir, name);
+ if (main == ROb(R_UnboundValue)) {
res.removed.append(RKRSupport::SEXPToString(name));
unbindSymbolWrapper(name, shadowenvir);
if (++count >= count2) i = count2; // end loop
}
- UNPROTECT(1);
+ RFn::Rf_unprotect(1);
}
}
- UNPROTECT(1); // symbols2
+ RFn::Rf_unprotect(1); // symbols2
RK_DEBUG(RBACKEND, DL_DEBUG, "added %s\n", qPrintable(res.added.join(", ")));
RK_DEBUG(RBACKEND, DL_DEBUG, "changed %s\n", qPrintable(res.changed.join(", ")));
@@ -393,9 +393,9 @@ QByteArray RKTextCodec::doConv(void *cd, const QByteArray &inp) {
while (inbytesleft) {
char *outbufpos = outbuf;
size_t outbytesleft = 8192;
- Riconv(cd, nullptr, nullptr, &outbufpos, &outbytesleft); // init
+ RFn::Riconv(cd, nullptr, nullptr, &outbufpos, &outbytesleft); // init
- Riconv(cd, &inbufpos, &inbytesleft, &outbufpos, &outbytesleft);
+ RFn::Riconv(cd, &inbufpos, &inbytesleft, &outbufpos, &outbytesleft);
ret += QByteArray(outbuf, 8192-outbytesleft);
// Do we need 0 termination?
if (!inbytesleft) return ret; // done
@@ -416,9 +416,9 @@ void *RKTextCodec::to_native = nullptr;
void RKTextCodec::reinit() {
// TODO: Detect if running in a UTF-8 locale, in which case all conversion can be omitted
if (from_native) {
- Riconv_close(from_native);
- Riconv_close(to_native);
+ RFn::Riconv_close(from_native);
+ RFn::Riconv_close(to_native);
}
- from_native = Riconv_open("UTF-8", "");
- to_native = Riconv_open("", "UTF-8");
+ from_native = RFn::Riconv_open("UTF-8", "");
+ to_native = RFn::Riconv_open("", "UTF-8");
}
diff --git a/rkward/rbackend/rkrsupport.h b/rkward/rbackend/rkrsupport.h
index dcfbc23d9..dda898f00 100644
--- a/rkward/rbackend/rkrsupport.h
+++ b/rkward/rbackend/rkrsupport.h
@@ -33,6 +33,15 @@ namespace RKRSupport {
int SEXPToInt (SEXP from_exp, int def_value = INT_MIN);
RData::RealStorage SEXPToRealArray (SEXP from_exp);
RData* SEXPToRData (SEXP from_exp);
+
+ /** Replacement for BEGIN_SUSPEND_INTERRUPTS-macro that we cannot easily use */
+ class InterruptSuspension {
+ public:
+ InterruptSuspension() { old_susp = ROb(R_interrupts_suspended); }
+ ~InterruptSuspension() { ROb(R_interrupts_suspended) = old_susp; if(ROb(R_interrupts_pending)) RFn::Rf_onintr(); }
+ private:
+ Rboolean old_susp;
+ };
};
class RKRShadowEnvironment {
diff --git a/rkward/rbackend/rkstructuregetter.cpp b/rkward/rbackend/rkstructuregetter.cpp
index 525cdd90d..22fa717a2 100644
--- a/rkward/rbackend/rkstructuregetter.cpp
+++ b/rkward/rbackend/rkstructuregetter.cpp
@@ -23,14 +23,14 @@ RKStructureGetter::RKStructureGetter (bool keep_evalled_promises) {
RKStructureGetter::keep_evalled_promises = keep_evalled_promises;
num_prefetched_funs = 0;
- meta_attrib = Rf_install (".rk.meta");
- PROTECT (meta_attrib);
- RK_ASSERT (!Rf_isNull (meta_attrib));
+ meta_attrib = RFn::Rf_install (".rk.meta");
+ RFn::Rf_protect (meta_attrib);
+ RK_ASSERT (!RFn::Rf_isNull (meta_attrib));
class_fun = prefetch_fun ("class");
get_meta_fun = prefetch_fun (".rk.get.meta", false);
-// Why do we need all these? Because the is.xxx functions may do an internal dispatch, that we do not want to miss, but don't easily get by e.g. calling Rf_isFunction() directly.
+// Why do we need all these? Because the is.xxx functions may do an internal dispatch, that we do not want to miss, but don't easily get by e.g. calling RFn::Rf_isFunction() directly.
is_matrix_fun = prefetch_fun ("is.matrix");
is_array_fun = prefetch_fun ("is.array");
is_list_fun = prefetch_fun ("is.list");
@@ -52,20 +52,20 @@ RKStructureGetter::RKStructureGetter (bool keep_evalled_promises) {
RKStructureGetter::~RKStructureGetter () {
RK_TRACE (RBACKEND);
- UNPROTECT (num_prefetched_funs + 1); /* all the pre-resolved functions and the meta attribute */
+ RFn::Rf_unprotect (num_prefetched_funs + 1); /* all the pre-resolved functions and the meta attribute */
}
SEXP RKStructureGetter::prefetch_fun (const char *name, bool from_base) {
SEXP ret;
if (from_base) {
- ret = Rf_install (name);
+ ret = RFn::Rf_install (name);
} else {
- ret = Rf_findFun (Rf_install (name), R_GlobalEnv);
+ ret = RFn::Rf_findFun (RFn::Rf_install (name), ROb(R_GlobalEnv));
}
- PROTECT (ret);
- RK_ASSERT (!Rf_isNull (ret));
+ RFn::Rf_protect (ret);
+ RK_ASSERT (!RFn::Rf_isNull (ret));
++num_prefetched_funs;
return (ret);
@@ -77,26 +77,26 @@ RData *RKStructureGetter::getStructure (SEXP toplevel, SEXP name, SEXP envlevel,
QString name_string = RKRSupport::SEXPToString (name);
// resolve namespace, if needed
- if (Rf_isNull (namespacename)) {
+ if (RFn::Rf_isNull (namespacename)) {
with_namespace = false;
} else {
- SEXP as_ns_fun = Rf_findFun (Rf_install (".rk.try.get.namespace"), R_GlobalEnv);
- PROTECT (as_ns_fun);
- RK_ASSERT (!Rf_isNull (as_ns_fun));
+ SEXP as_ns_fun = RFn::Rf_findFun (RFn::Rf_install (".rk.try.get.namespace"), ROb(R_GlobalEnv));
+ RFn::Rf_protect (as_ns_fun);
+ RK_ASSERT (!RFn::Rf_isNull (as_ns_fun));
- namespace_envir = RKRSupport::callSimpleFun (as_ns_fun, namespacename, R_GlobalEnv);
- with_namespace = !Rf_isNull (namespace_envir);
- UNPROTECT (1); /* as_ns_fun */
+ namespace_envir = RKRSupport::callSimpleFun (as_ns_fun, namespacename, ROb(R_GlobalEnv));
+ with_namespace = !RFn::Rf_isNull (namespace_envir);
+ RFn::Rf_unprotect (1); /* as_ns_fun */
}
- if (with_namespace) PROTECT (namespace_envir);
+ if (with_namespace) RFn::Rf_protect (namespace_envir);
RData *ret = new RData;
toplevel_value = toplevel;
- getStructureSafe (toplevel, name_string, 0, ret, INTEGER (envlevel)[0]);
+ getStructureSafe (toplevel, name_string, 0, ret, RFn::INTEGER(envlevel)[0]);
- if (with_namespace) UNPROTECT (1); /* namespace_envir */
+ if (with_namespace) RFn::Rf_unprotect (1); /* namespace_envir */
return ret;
}
@@ -112,12 +112,12 @@ void RKStructureGetter::getStructureSafe (SEXP value, const QString &name, int a
args.getter = this;
args.nesting_depth = nesting_depth;
- Rboolean ok = R_ToplevelExec ((void (*)(void*)) getStructureWrapper, &args);
+ Rboolean ok = RFn::R_ToplevelExec((void (*)(void*)) getStructureWrapper, &args);
if (ok != TRUE) {
storage->discardData();
- Rf_warning ("failure to get object %s", name.toLatin1().data ());
- getStructureWorker (R_NilValue, name, add_type_flags, storage, nesting_depth);
+ RFn::Rf_warning("failure to get object %s", name.toLatin1().data ());
+ getStructureWorker(ROb(R_NilValue), name, add_type_flags, storage, nesting_depth);
}
}
@@ -136,23 +136,23 @@ SEXP RKStructureGetter::resolvePromise (SEXP from) {
RK_TRACE (RBACKEND);
SEXP ret = from;
- if (TYPEOF (from) == PROMSXP) {
- ret = PRVALUE(from);
- if (ret == R_UnboundValue) {
+ if (RFn::TYPEOF (from) == PROMSXP) {
+ ret = RFn::PRVALUE(from);
+ if (ret == ROb(R_UnboundValue)) {
RK_DEBUG (RBACKEND, DL_DEBUG, "temporarily resolving unbound promise");
- PROTECT (from);
+ RFn::Rf_protect (from);
//SET_PRSEEN(from, 1); // NOTE: SET_PRSEEN was removed from Rinternals.h in R 4.2.0. Its only use is to prevent recursion, however.
// Not setting it from here, only means, any recursion will be detected one level later.
- ret = Rf_eval(PRCODE(from), PRENV(from));
+ ret = RFn::Rf_eval(RFn::PRCODE(from), RFn::PRENV(from));
//SET_PRSEEN(from, 0);
if (keep_evalled_promises) {
- SET_PRVALUE(from, ret);
- SET_PRENV(from, R_NilValue);
+ RFn::SET_PRVALUE(from, ret);
+ RFn::SET_PRENV(from, ROb(R_NilValue));
}
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
- RK_DEBUG (RBACKEND, DL_DEBUG, "resolved type is %d", TYPEOF (ret));
+ RK_DEBUG (RBACKEND, DL_DEBUG, "resolved type is %d", RFn::TYPEOF (ret));
}
}
@@ -170,17 +170,17 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
bool no_recurse = (nesting_depth >= 2); // TODO: should be configurable
unsigned int type = 0;
- RK_DEBUG (RBACKEND, DL_DEBUG, "fetching '%s': %p, s-type %d", name.toLatin1().data(), val, TYPEOF (val));
+ RK_DEBUG (RBACKEND, DL_DEBUG, "fetching '%s': %p, s-type %d", name.toLatin1().data(), val, RFn::TYPEOF (val));
SEXP value = val;
PROTECT_INDEX value_index;
- PROTECT_WITH_INDEX (value, &value_index);
+ RFn::R_ProtectWithIndex (value, &value_index);
// manually resolve any promises
- REPROTECT (value = resolvePromise (value), value_index);
+ RFn::R_Reprotect (value = resolvePromise (value), value_index);
- bool is_s4 = Rf_isS4 (value);
- SEXP baseenv = R_BaseEnv;
- if (is_s4) baseenv = R_GlobalEnv;
+ bool is_s4 = RFn::Rf_isS4 (value);
+ SEXP baseenv = ROb(R_BaseEnv);
+ if (is_s4) baseenv = ROb(R_GlobalEnv);
// first field: get name
RData *namedata = new RData;
@@ -190,32 +190,32 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
SEXP classes_s;
QStringList classes;
- if ((TYPEOF (value) == LANGSXP) || (TYPEOF (value) == SYMSXP) || (TYPEOF (value) == BCODESXP)) { // if it's a call, we should NEVER send it through eval
+ if ((RFn::TYPEOF (value) == LANGSXP) || (RFn::TYPEOF (value) == SYMSXP) || (RFn::TYPEOF (value) == BCODESXP)) { // if it's a call, we should NEVER send it through eval
// stripped down and adjusted from R_data_class
- PROTECT (classes_s = Rf_getAttrib (value, R_ClassSymbol));
- if (Rf_length (classes_s)) classes = RKRSupport::SEXPToStringList(classes_s);
- UNPROTECT (1);
+ RFn::Rf_protect(classes_s = RFn::Rf_getAttrib(value, ROb(R_ClassSymbol)));
+ if (RFn::Rf_length(classes_s)) classes = RKRSupport::SEXPToStringList(classes_s);
+ RFn::Rf_unprotect(1);
if (classes.isEmpty ()) {
- if (TYPEOF (value) == LANGSXP) {
- SEXP symb = PROTECT (CAR (value));
+ if (RFn::TYPEOF (value) == LANGSXP) {
+ SEXP symb = RFn::Rf_protect (RFn::CAR (value));
QString cl;
- if (TYPEOF (symb) == SYMSXP) cl = CHAR (PRINTNAME (symb));
- UNPROTECT (1);
+ if (RFn::TYPEOF (symb) == SYMSXP) cl = RFn::R_CHAR(RFn::PRINTNAME (symb));
+ RFn::Rf_unprotect (1);
if ((cl != "if") && (cl != "while") && (cl != "for") && (cl != "=") && (cl != "<-") && (cl != "(") && (cl != "{")) cl = "call";
classes = QStringList (cl);
- } else if (TYPEOF (value) == BCODESXP) {
- value = R_NilValue; // This is a bit lame, but bytecode cannot be cast to expression, below, and no idea what else to do with it (or what info to extract, anyway)
+ } else if (RFn::TYPEOF (value) == BCODESXP) {
+ value = ROb(R_NilValue); // This is a bit lame, but bytecode cannot be cast to expression, below, and no idea what else to do with it (or what info to extract, anyway)
classes = QStringList("bytecode");
} else {
classes = QStringList ("name");
}
}
- REPROTECT (value = Rf_coerceVector (value, EXPRSXP), value_index); // make sure the object is safe for everything to come
+ RFn::R_Reprotect (value = RFn::Rf_coerceVector (value, EXPRSXP), value_index); // make sure the object is safe for everything to come
} else {
- PROTECT (classes_s = RKRSupport::callSimpleFun (class_fun, value, baseenv));
+ RFn::Rf_protect (classes_s = RKRSupport::callSimpleFun (class_fun, value, baseenv));
classes = RKRSupport::SEXPToStringList (classes_s);
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
}
// store classes
@@ -265,11 +265,11 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
// get meta data, if any
RData *metadata = new RData;
- if (!Rf_isNull (Rf_getAttrib (value, meta_attrib))) {
- SEXP meta_s = RKRSupport::callSimpleFun (get_meta_fun, value, R_GlobalEnv);
- PROTECT (meta_s);
+ if (!RFn::Rf_isNull (RFn::Rf_getAttrib (value, meta_attrib))) {
+ SEXP meta_s = RKRSupport::callSimpleFun (get_meta_fun, value, ROb(R_GlobalEnv));
+ RFn::Rf_protect (meta_s);
metadata->setData (RKRSupport::SEXPToStringList (meta_s));
- UNPROTECT (1); /* meta_s */
+ RFn::Rf_unprotect (1); /* meta_s */
} else {
metadata->setData (QStringList ());
}
@@ -277,19 +277,19 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
// get dims
RData::IntStorage dims;
SEXP dims_s = RKRSupport::callSimpleFun (dims_fun, value, baseenv);
- if (Rf_isNumeric (dims_s)) {
+ if (RFn::Rf_isNumeric (dims_s)) {
dims = RKRSupport::SEXPToIntArray (dims_s);
} else {
- unsigned int len = Rf_length (value);
+ unsigned int len = RFn::Rf_length (value);
if ((len < 2) && (!is_function)) { // suspicious. Maybe some kind of list
SEXP len_s = RKRSupport::callSimpleFun (length_fun, value, baseenv);
- PROTECT (len_s);
- if (Rf_isNull (len_s)) {
+ RFn::Rf_protect (len_s);
+ if (RFn::Rf_isNull (len_s)) {
dims.append (len);
} else {
dims = RKRSupport::SEXPToIntArray (len_s);
}
- UNPROTECT (1); /* len_s */
+ RFn::Rf_unprotect (1); /* len_s */
} else {
dims.append (len);
}
@@ -310,10 +310,10 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
RData::RDataStorage dummy(1, nullptr);
dummy[0] = new RData ();
- SEXP slots_pseudo_object = RKRSupport::callSimpleFun (rk_get_slots_fun, value, R_GlobalEnv);
- PROTECT (slots_pseudo_object);
+ SEXP slots_pseudo_object = RKRSupport::callSimpleFun (rk_get_slots_fun, value, ROb(R_GlobalEnv));
+ RFn::Rf_protect (slots_pseudo_object);
getStructureSafe (slots_pseudo_object, "SLOTS", RObject::PseudoObject, dummy[0], nesting_depth); // do not increase depth for this pseudo-object
- UNPROTECT (1);
+ RFn::Rf_unprotect (1);
slotsdata->setData (dummy);
}
@@ -346,13 +346,13 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
// fetch list of child names
SEXP childnames_s;
if (do_env) {
- childnames_s = R_lsInternal3(value, TRUE, FALSE);
+ childnames_s = RFn::R_lsInternal3(value, TRUE, FALSE);
} else if (do_cont) {
childnames_s = RKRSupport::callSimpleFun (names_fun, value, baseenv);
} else {
- childnames_s = R_NilValue; // dummy
+ childnames_s = ROb(R_NilValue); // dummy
}
- PROTECT (childnames_s);
+ RFn::Rf_protect (childnames_s);
QStringList childnames = RKRSupport::SEXPToStringList (childnames_s);
int childcount = childnames.size ();
if (childcount > NAMED_CHILDREN_LIMIT) {
@@ -367,56 +367,56 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
if (do_env) {
RK_DEBUG (RBACKEND, DL_DEBUG, "recurse into environment %s", name.toLatin1().data ());
- if (!Rf_isEnvironment (value)) {
+ if (!RFn::Rf_isEnvironment (value)) {
// some classes (ReferenceClasses) are identified as environments by is.environment(), but are not internally ENVSXPs.
- // For these, Rf_findVar would fail.
- REPROTECT (value = RKRSupport::callSimpleFun (as_environment_fun, value, R_GlobalEnv), value_index);
+ // For these, RFn::Rf_findVar would fail.
+ RFn::R_Reprotect (value = RKRSupport::callSimpleFun (as_environment_fun, value, ROb(R_GlobalEnv)), value_index);
}
for (int i = 0; i < childcount; ++i) {
- SEXP current_childname = Rf_install(CHAR(STRING_ELT(childnames_s, i))); // ??? Why does simply using STRING_ELT(childnames_i, i) crash?
- PROTECT (current_childname);
- SEXP child = Rf_findVar (current_childname, value);
- PROTECT (child);
+ SEXP current_childname = RFn::Rf_install(RFn::R_CHAR(RFn::STRING_ELT(childnames_s, i))); // ??? Why does simply using RFn::STRING_ELT(childnames_i, i) crash?
+ RFn::Rf_protect (current_childname);
+ SEXP child = RFn::Rf_findVar (current_childname, value);
+ RFn::Rf_protect (child);
bool child_misplaced = false;
if (at_toplevel && with_namespace && (!RKRBackend::this_pointer->RRuntimeIsVersion (2, 14, 0))) {
- if (!Rf_isNull (namespace_envir)) {
- SEXP dummy = Rf_findVarInFrame (namespace_envir, current_childname);
- if (Rf_isNull (dummy) || (dummy == R_UnboundValue)) child_misplaced = true;
+ if (!RFn::Rf_isNull (namespace_envir)) {
+ SEXP dummy = RFn::Rf_findVarInFrame(namespace_envir, current_childname);
+ if (RFn::Rf_isNull (dummy) || (dummy == ROb(R_UnboundValue))) child_misplaced = true;
}
}
getStructureSafe (child, childnames[i], child_misplaced ? RObject::Misplaced : 0, children[i], nesting_depth + 1);
- UNPROTECT (2); /* current_childname, child */
+ RFn::Rf_unprotect (2); /* current_childname, child */
}
} else if (do_cont) {
RK_DEBUG (RBACKEND, DL_DEBUG, "recurse into list %s", name.toLatin1().data ());
// fewer elements than names() can happen, although I doubt it is supposed to happen.
// see http://sourceforge.net/p/rkward/bugs/67/
- bool may_be_special = Rf_length (value) < childcount;
- if (Rf_isList (value) && (!may_be_special)) { // old style list
+ bool may_be_special = RFn::Rf_length (value) < childcount;
+ if (RFn::Rf_isList (value) && (!may_be_special)) { // old style list
for (int i = 0; i < childcount; ++i) {
- SEXP child = CAR (value);
+ SEXP child = RFn::CAR (value);
getStructureSafe (child, childnames[i], 0, children[i], nesting_depth + 1);
- CDR (value);
+ RFn::CDR (value);
}
- } else if (Rf_isNewList (value) && (!may_be_special)) { // new style list
+ } else if (RFn::Rf_isNewList (value) && (!may_be_special)) { // new style list
for (int i = 0; i < childcount; ++i) {
- SEXP child = VECTOR_ELT(value, i);
+ SEXP child = RFn::VECTOR_ELT(value, i);
getStructureSafe (child, childnames[i], 0, children[i], nesting_depth + 1);
}
} else { // probably an S4 object disguised as a list
- SEXP index = Rf_allocVector(INTSXP, 1);
- PROTECT (index);
+ SEXP index = RFn::Rf_allocVector(INTSXP, 1);
+ RFn::Rf_protect (index);
for (int i = 0; i < childcount; ++i) {
- INTEGER (index)[0] = (i + 1);
+ RFn::INTEGER(index)[0] = (i + 1);
SEXP child = RKRSupport::callSimpleFun2 (double_brackets_fun, value, index, baseenv);
getStructureSafe (child, childnames[i], 0, children[i], nesting_depth + 1);
}
- UNPROTECT (1); /* index */
+ RFn::Rf_unprotect (1); /* index */
}
}
- UNPROTECT (1); /* childnames_s */
+ RFn::Rf_unprotect (1); /* childnames_s */
RData *childdata = new RData;
childdata->setData (children);
@@ -442,36 +442,36 @@ void RKStructureGetter::getStructureWorker (SEXP val, const QString &name, int a
} else if (is_function) {
// TODO: getting the formals is still a bit of a bottleneck, but no idea, how to improve on this, any further
SEXP formals_s;
- if (Rf_isPrimitive (value)) formals_s = FORMALS (RKRSupport::callSimpleFun (args_fun, value, baseenv)); // primitives don't have formals, internally
- else formals_s = FORMALS (value);
- PROTECT (formals_s);
+ if (RFn::Rf_isPrimitive (value)) formals_s = RFn::FORMALS (RKRSupport::callSimpleFun (args_fun, value, baseenv)); // primitives don't have formals, internally
+ else formals_s = RFn::FORMALS (value);
+ RFn::Rf_protect (formals_s);
// get the default values
QStringList formals = RKRSupport::SEXPToStringList (formals_s);
// for the most part, the implicit as.character in SEXPToStringList does a good on the formals (and it's the fastest of many options that I have tried).
// Only for naked strings (as in 'function (a="something")'), we're missing the quotes. So we add quotes, after conversion, as needed:
SEXP dummy = formals_s;
- const int formals_len = Rf_length (formals_s);
+ const int formals_len = RFn::Rf_length (formals_s);
for (int i = 0; i < formals_len; ++i) {
- if (TYPEOF (CAR (dummy)) == STRSXP) formals[i] = RKRSharedFunctionality::quote (formals[i]);
- dummy = CDR (dummy);
+ if (RFn::TYPEOF (RFn::CAR (dummy)) == STRSXP) formals[i] = RKRSharedFunctionality::quote (formals[i]);
+ dummy = RFn::CDR (dummy);
}
RData *funargvaluesdata = new RData;
funargvaluesdata->setData (formals);
// the argument names
- SEXP names_s = Rf_getAttrib (formals_s, R_NamesSymbol);
- PROTECT (names_s);
+ SEXP names_s = RFn::Rf_getAttrib (formals_s, ROb(R_NamesSymbol));
+ RFn::Rf_protect (names_s);
RData *funargsdata = new RData;
funargsdata->setData (RKRSupport::SEXPToStringList (names_s));
- UNPROTECT (2); /* names_s, formals_s */
+ RFn::Rf_unprotect (2); /* names_s, formals_s */
res[RObject::StoragePositionFunArgs] = funargsdata;
res[RObject::StoragePositionFunValues] = funargvaluesdata;
}
- UNPROTECT (1); /* value */
+ RFn::Rf_unprotect (1); /* value */
RK_ASSERT (!res.contains (nullptr));
storage->setData (res);
diff --git a/rkward/rbackend/rkstructuregetter.h b/rkward/rbackend/rkstructuregetter.h
index 42cf4f0fd..f1c92c2e3 100644
--- a/rkward/rbackend/rkstructuregetter.h
+++ b/rkward/rbackend/rkstructuregetter.h
@@ -1,6 +1,6 @@
/*
rkstructuregetter - This file is part of the RKWard project. Created: Wed Apr 11 2007
-SPDX-FileCopyrightText: 2007-2011 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
+SPDX-FileCopyrightText: 2007-2024 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
SPDX-FileContributor: The RKWard Team <rkward-devel at kde.org>
SPDX-License-Identifier: GPL-2.0-or-later
*/
@@ -10,8 +10,7 @@ SPDX-License-Identifier: GPL-2.0-or-later
#include <QString>
-#define R_NO_REMAP 1
-#include <Rinternals.h>
+#include "rkrapi.h"
class RData;
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_protocol_shared.h b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_protocol_shared.h
index e8f82ed6d..171867a42 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_protocol_shared.h
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_protocol_shared.h
@@ -156,9 +156,9 @@ enum RKDEventCodes {
static inline quint8 mapLineEndStyle(quint8 from) {
if (RKD_IN_FRONTEND) return from;
switch(from) {
- MapEnum(GE_BUTT_CAP, 0x00, Qt::FlatCap);
- MapEnum(GE_SQUARE_CAP, 0x10, Qt::SquareCap);
- MapEnum(GE_ROUND_CAP, 0x20, Qt::RoundCap);
+ MapEnum(R_GE_lineend::GE_BUTT_CAP, 0x00, Qt::FlatCap);
+ MapEnum(R_GE_lineend::GE_SQUARE_CAP, 0x10, Qt::SquareCap);
+ MapEnum(R_GE_lineend::GE_ROUND_CAP, 0x20, Qt::RoundCap);
}
MapDefault({}, 0x00, Qt::FlatCap);
}
@@ -166,9 +166,9 @@ static inline quint8 mapLineEndStyle(quint8 from) {
static inline quint8 mapLineJoinStyle(quint8 from) {
if (RKD_IN_FRONTEND) return from;
switch(from) {
- MapEnum(GE_MITRE_JOIN, 0x00, Qt::MiterJoin);
- MapEnum(GE_BEVEL_JOIN, 0x40, Qt::BevelJoin);
- MapEnum(GE_ROUND_JOIN, 0x80, Qt::RoundJoin);
+ MapEnum(R_GE_linejoin::GE_MITRE_JOIN, 0x00, Qt::MiterJoin);
+ MapEnum(R_GE_linejoin::GE_BEVEL_JOIN, 0x40, Qt::BevelJoin);
+ MapEnum(R_GE_linejoin::GE_ROUND_JOIN, 0x80, Qt::RoundJoin);
//MapEnum(GE_ROUND_JOIN, 0x100, Qt::SvgMiterJoin); // not available in R, and wouldn't fit in quint8
}
MapDefault({}, 0x00, Qt::MiterJoin);
@@ -205,7 +205,7 @@ static inline int mapCompositionModeEnum(int from) {
// Unsupported in Qt:
// MapEnum(R_GE_compositeSaturate, xx, yy)
}
- MapDefault(Rf_warning("Unsupported enumeration value %d", from), 0, QPainter::CompositionMode_SourceOver);
+ MapDefault(RFn::Rf_warning("Unsupported enumeration value %d", from), 0, QPainter::CompositionMode_SourceOver);
}
static inline quint8 mapFillRule(quint8 from) {
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
index ad3bbedd0..40506598d 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_setup.cpp
@@ -1,6 +1,6 @@
/*
rkgraphicsdevice_setup - This file is part of RKWard (https://rkward.kde.org). Created: Mon Mar 18 2013
-SPDX-FileCopyrightText: 2013-2021 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
+SPDX-FileCopyrightText: 2013-2024 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
SPDX-FileContributor: The RKWard Team <rkward-devel at kde.org>
SPDX-License-Identifier: GPL-2.0-or-later
*/
@@ -42,25 +42,26 @@ struct RKGraphicsDeviceDesc {
void RKStartGraphicsDevice (double width, double height, double pointsize, const QStringList &family, rcolor bg, const char* title, bool antialias) {
static quint32 id = 0;
if (width <= 0 || height <= 0) {
- Rf_error ("Invalid width or height: (%g, %g)", width, height);
+ RFn::Rf_error("Invalid width or height: (%g, %g)", width, height);
}
RKGraphicsDeviceDesc *desc = new RKGraphicsDeviceDesc;
desc->width = width;
desc->height = height;
- if (R_GE_getVersion() != R_GE_version) {
- RKRBackend::this_pointer->graphicsEngineMismatchMessage(R_GE_version, R_GE_getVersion());
- Rf_error("Graphics version mismatch");
+ if (RFn::R_GE_getVersion() != R_GE_version) {
+ RKRBackend::this_pointer->graphicsEngineMismatchMessage(R_GE_version, RFn::R_GE_getVersion());
+ RFn::Rf_error("Graphics version mismatch");
}
- R_CheckDeviceAvailable ();
+ RFn::R_CheckDeviceAvailable();
pDevDesc dev;
- BEGIN_SUSPEND_INTERRUPTS {
+ {
+ RKRSupport::InterruptSuspension susp;
/* Allocate and initialize the device driver data */
- dev = (pDevDesc) R_Calloc(1, DevDesc);
+ dev = (pDevDesc) RFn::R_chk_calloc(1, sizeof(DevDesc));
// NOTE: The call to RKGraphicsDeviceBackendTransmitter::instance(), here is important beyond error checking. It might *create* the instance and connection, if this is the first use.
if (!(dev && RKGraphicsDeviceBackendTransmitter::instance () && desc->init (dev, pointsize, family, bg))) {
- R_Free (dev);
- delete (desc);
+ RFn::R_chk_free(dev);
+ delete(desc);
desc = nullptr;
} else {
desc->devnum = 0; // graphics engine will send an Activate-event, before we were even
@@ -68,23 +69,23 @@ void RKStartGraphicsDevice (double width, double height, double pointsize, const
// devnum to 0, so as not to confuse the frontend
desc->id = id++; // extra identifier to make sure, R and the frontend are really talking about the same device
// in case of potentially out-of-sync operations (notably RKDAdjustSize)
- pGEDevDesc gdd = GEcreateDevDesc(dev);
- gdd->displayList = R_NilValue;
- GEaddDevice2(gdd, "RKGraphicsDevice");
+ pGEDevDesc gdd = RFn::GEcreateDevDesc(dev);
+ gdd->displayList = ROb(R_NilValue);
+ RFn::GEaddDevice2(gdd, "RKGraphicsDevice");
}
- } END_SUSPEND_INTERRUPTS;
+ };
if (desc) {
- desc->devnum = curDevice ();
- RKD_Create (desc->width, desc->height, dev, title, antialias, desc->id);
+ desc->devnum = RFn::Rf_curDevice();
+ RKD_Create(desc->width, desc->height, dev, title, antialias, desc->id);
} else {
- Rf_error("unable to start device");
+ RFn::Rf_error("unable to start device");
}
}
SEXP RKStartGraphicsDevice (SEXP width, SEXP height, SEXP pointsize, SEXP family, SEXP bg, SEXP title, SEXP antialias) {
- RKStartGraphicsDevice (Rf_asReal (width), Rf_asReal (height), Rf_asReal (pointsize), RKRSupport::SEXPToStringList (family), R_GE_str2col (CHAR(Rf_asChar(bg))), CHAR(Rf_asChar(title)), Rf_asLogical (antialias));
- return R_NilValue;
+ RKStartGraphicsDevice(RFn::Rf_asReal(width), RFn::Rf_asReal(height), RFn::Rf_asReal(pointsize), RKRSupport::SEXPToStringList(family), RFn::R_GE_str2col(RFn::R_CHAR(RFn::Rf_asChar(bg))), RFn::R_CHAR(RFn::Rf_asChar(title)), RFn::Rf_asLogical(antialias));
+ return ROb(R_NilValue);
}
bool RKGraphicsDeviceDesc::init (pDevDesc dev, double pointsize, const QStringList &family, rcolor bg) {
diff --git a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
index 88966271a..fef678bd6 100644
--- a/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
+++ b/rkward/rbackend/rkwarddevice/rkgraphicsdevice_stubs.cpp
@@ -1,6 +1,6 @@
/*
rkgraphicsdevice_stubs - This file is part of RKWard (https://rkward.kde.org). Created: Mon Mar 18 2013
-SPDX-FileCopyrightText: 2013-2022 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
+SPDX-FileCopyrightText: 2013-2024 by Thomas Friedrichsmeier <thomas.friedrichsmeier at kdemail.net>
SPDX-FileContributor: The RKWard Team <rkward-devel at kde.org>
SPDX-License-Identifier: GPL-2.0-or-later
*/
@@ -43,7 +43,7 @@ static int rkd_suppress_on_exit = 0;
/** This class is essentially like QMutexLocker. In addition, the constructor waits until the next chunk of the transmission is ready (and does event processing).
*
- * @note: Never ever call Rf_error(), or any R function that might fail during the lifetime of an RKGraphicsDataStreamReadGuard or
+ * @note: Never ever call RFn::Rf_error(), or any R function that might fail during the lifetime of an RKGraphicsDataStreamReadGuard or
* RKGraphicsDataStreamWriteGuard. If R decides to long-jump out, the d'tor will not be called, the mutex will be left locked, and
* the next graphics operation will hang, with no way to interrupt.
*
@@ -57,7 +57,8 @@ public:
have_lock = true;
rkd_waiting_for_reply = true;
QIODevice* connection = RKGraphicsDeviceBackendTransmitter::connection;
- BEGIN_SUSPEND_INTERRUPTS {
+ {
+ RKRSupport::InterruptSuspension susp;
while (connection->bytesToWrite ()) {
if (!connection->waitForBytesWritten (10)) {
checkHandleError ();
@@ -71,14 +72,14 @@ public:
checkHandleError ();
}
}
- if (R_interrupts_pending) {
+ if (ROb(R_interrupts_pending)) {
if (have_lock) {
RKGraphicsDeviceBackendTransmitter::mutex.unlock ();
have_lock = false; // Will d'tor still be called? We don't rely on it.
}
rkd_waiting_for_reply = false;
}
- } END_SUSPEND_INTERRUPTS;
+ };
}
~RKGraphicsDataStreamReadGuard () {
@@ -90,7 +91,7 @@ private:
bool checkHandleInterrupt (QIODevice *connection) {
// NOTE: It would be possible, but not exactly easier to rely on GEonExit() rather than R_interrupts_pending
// Might be an option, if R_interrupts_pending gets hidden one day, though
- if (!R_interrupts_pending) return false;
+ if (!ROb(R_interrupts_pending)) return false;
// Tell the frontend to finish whatever it was doing ASAP. Don't process any other events until that has happened
RKGraphicsDeviceBackendTransmitter::streamer.outstream << (quint8) RKDCancel << (quint8) 0;
@@ -116,7 +117,7 @@ private:
if (!RKGraphicsDeviceBackendTransmitter::connectionAlive ()) { // Don't go into endless loop, if e.g. frontend has crashed
if (have_lock) RKGraphicsDeviceBackendTransmitter::mutex.unlock ();
have_lock = false; // Will d'tor still be called? We don't rely on it.
- Rf_error ("RKWard Graphics connection has shut down");
+ RFn::Rf_error("RKWard Graphics connection has shut down");
}
}
bool have_lock;
@@ -139,7 +140,7 @@ public:
// Well, essentially, during rkd_waiting_for_reply, nothing should attempt to obtain a lock. The transmitter thread can simply pause
// during that time.
rkd_suppress_on_exit++;
- Rf_error ("Nested graphics operations are not supported by this device (did you try to resize the device during locator()?)");
+ RFn::Rf_error("Nested graphics operations are not supported by this device (did you try to resize the device during locator()?)");
}
RKGraphicsDeviceBackendTransmitter::mutex.lock ();
}
@@ -169,7 +170,7 @@ public:
RKD_OUT_STREAM << (quint8) mapLineEndStyle(gc->lend) << (quint8) mapLineJoinStyle(gc->ljoin) << gc->lmitre
#if R_VERSION >= R_Version(4, 1, 0)
# define WRITE_FILL() \
- if (gc->patternFill != R_NilValue) RKD_OUT_STREAM << (qint8) PatternFill << (qint16) (INTEGER(gc->patternFill)[0]); \
+ if (gc->patternFill != ROb(R_NilValue)) RKD_OUT_STREAM << (qint8) PatternFill << (qint16) (RFn::INTEGER(gc->patternFill)[0]); \
else { \
RKD_OUT_STREAM << (qint8) ColorFill; WRITE_COLOR_BYTES (gc->fill); \
}
@@ -239,15 +240,15 @@ static void RKD_Deactivate (pDevDesc dev) {
SEXP RKD_AdjustSize(SEXP _devnum, SEXP _id) {
RK_TRACE(GRAPHICS_DEVICE);
- int devnum = Rf_asInteger(_devnum);
- quint32 id = Rf_asInteger(_id);
- pGEDevDesc gdev = GEgetDevice(devnum);
- if (!gdev) Rf_error("No such device %d", devnum);
+ int devnum = RFn::Rf_asInteger(_devnum);
+ quint32 id = RFn::Rf_asInteger(_id);
+ pGEDevDesc gdev = RFn::GEgetDevice(devnum);
+ if (!gdev) RFn::Rf_error("No such device %d", devnum);
pDevDesc dev = gdev->dev;
// This is called from rkward:::RK.resize(), which in turn may be out of sync with R's device list. Before doing anything,
// double check that this is really the device we think it is.
- if (dev->activate != RKD_Activate) Rf_error("Not an RKWard device", devnum);
- if (static_cast<RKGraphicsDeviceDesc*>(dev->deviceSpecific)->id != id) Rf_error("Graphics device mismatch", devnum);
+ if (dev->activate != RKD_Activate) RFn::Rf_error("Not an RKWard device", devnum);
+ if (static_cast<RKGraphicsDeviceDesc*>(dev->deviceSpecific)->id != id) RFn::Rf_error("Graphics device mismatch", devnum);
{
RKGraphicsDataStreamWriteGuard wguard;
@@ -258,14 +259,14 @@ SEXP RKD_AdjustSize(SEXP _devnum, SEXP _id) {
RKGraphicsDataStreamReadGuard rguard;
RKD_IN_STREAM >> size;
}
- if (size.isNull()) Rf_error("Could not determine current size of device %d. Device closed?", devnum);
+ if (size.isNull()) RFn::Rf_error("Could not determine current size of device %d. Device closed?", devnum);
dev->left = dev->top = 0;
dev->right = size.width();
dev->bottom = size.height();
RKD_SetSize(dev); // This adjusts the rendering area in the frontend
- if(gdev->dirty) GEplayDisplayList(gdev);
- return R_NilValue;
+ if(gdev->dirty) RFn::GEplayDisplayList(gdev);
+ return ROb(R_NilValue);
}
static void RKD_Circle (double x, double y, double r, R_GE_gcontext *gc, pDevDesc dev) {
@@ -478,18 +479,18 @@ static SEXP RKD_Capture(pDevDesc dev) {
}
}
SEXP ret, dim;
- PROTECT(ret = Rf_allocVector(INTSXP, size));
+ RFn::Rf_protect(ret = RFn::Rf_allocVector(INTSXP, size));
for (quint32 i = 0; i < size; ++i) {
- INTEGER(ret)[i] = buffer[i];
+ RFn::INTEGER(ret)[i] = buffer[i];
}
// Documentation does not mention it, but cap expects dim information to be returned
- PROTECT(dim = Rf_allocVector(INTSXP, 2));
- INTEGER(dim)[0] = w;
- INTEGER(dim)[1] = h;
- Rf_setAttrib(ret, R_DimSymbol, dim);
+ RFn::Rf_protect(dim = RFn::Rf_allocVector(INTSXP, 2));
+ RFn::INTEGER(dim)[0] = w;
+ RFn::INTEGER(dim)[1] = h;
+ RFn::Rf_setAttrib(ret, ROb(R_DimSymbol), dim);
- UNPROTECT(2);
+ RFn::Rf_unprotect(2);
return ret;
}
@@ -519,8 +520,8 @@ static Rboolean RKD_NewFrameConfirm (pDevDesc dev) {
RKGraphicsDataStreamReadGuard rguard;
RKD_IN_STREAM >> ok;
}
- if (!ok) Rf_error ("Aborted by user");
- return (Rboolean) TRUE;
+ if (!ok) RFn::Rf_error("Aborted by user");
+ return Rboolean::TRUE;
// Return value FALSE: Let R ask, instead
}
@@ -530,9 +531,9 @@ void RKD_EventHelper (pDevDesc dev, int code) {
RKGraphicsDataStreamWriteGuard wguard;
if (code == 1) {
QString prompt;
- if (Rf_isEnvironment (dev->eventEnv)) {
- SEXP sprompt = Rf_findVar (Rf_install ("prompt"), dev->eventEnv);
- if (Rf_length (sprompt) == 1) prompt = QString::fromUtf8 (CHAR (Rf_asChar (sprompt)));
+ if (RFn::Rf_isEnvironment(dev->eventEnv)) {
+ SEXP sprompt = RFn::Rf_findVar(RFn::Rf_install("prompt"), dev->eventEnv);
+ if (RFn::Rf_length(sprompt) == 1) prompt = QString::fromUtf8(RFn::R_CHAR(RFn::Rf_asChar(sprompt)));
}
WRITE_HEADER (RKDStartGettingEvents, dev);
RKD_OUT_STREAM << prompt;
@@ -567,11 +568,11 @@ void RKD_EventHelper (pDevDesc dev, int code) {
}
if (event_code == RKDFrontendCancel) {
- Rf_error ("Interrupted by user");
+ RFn::Rf_error ("Interrupted by user");
return; // not reached
}
if (event_code == RKDNothing) {
- if (Rf_doesIdle(dev)) Rf_doIdle(dev);
+ if (RFn::Rf_doesIdle(dev)) RFn::Rf_doIdle(dev);
return;
} else if (event_code == RKDKeyPress) {
if (modifiers - (modifiers & Qt::ShiftModifier)) { // any other modifier than Shift, alone. NOTE: devX11.c and devWindows.c handle Ctrl, only as of R 3.0.0
@@ -583,22 +584,22 @@ void RKD_EventHelper (pDevDesc dev, int code) {
text = mod_text + text.toUpper ();
}
- R_KeyName r_key_name = knUNKNOWN;
- if (keycode == Qt::Key_Left) r_key_name = knLEFT;
- else if (keycode == Qt::Key_Right) r_key_name = knRIGHT;
- else if (keycode == Qt::Key_Up) r_key_name = knUP;
- else if (keycode == Qt::Key_Down) r_key_name = knDOWN;
- else if ((keycode >= Qt::Key_F1) && (keycode <= Qt::Key_F12)) r_key_name = (R_KeyName) (knF1 + (keycode - Qt::Key_F1));
- else if (keycode == Qt::Key_PageUp) r_key_name = knPGUP;
- else if (keycode == Qt::Key_PageDown) r_key_name = knPGDN;
- else if (keycode == Qt::Key_End) r_key_name = knEND;
- else if (keycode == Qt::Key_Home) r_key_name = knHOME;
- else if (keycode == Qt::Key_Insert) r_key_name = knINS;
- else if (keycode == Qt::Key_Delete) r_key_name = knDEL;
-
- Rf_doKeybd (dev, r_key_name, text.toUtf8 ().data());
+ R_KeyName r_key_name = R_KeyName::knUNKNOWN;
+ if (keycode == Qt::Key_Left) r_key_name = R_KeyName::knLEFT;
+ else if (keycode == Qt::Key_Right) r_key_name = R_KeyName::knRIGHT;
+ else if (keycode == Qt::Key_Up) r_key_name = R_KeyName::knUP;
+ else if (keycode == Qt::Key_Down) r_key_name = R_KeyName::knDOWN;
+ else if ((keycode >= Qt::Key_F1) && (keycode <= Qt::Key_F12)) r_key_name = (R_KeyName) (R_KeyName::knF1 + (keycode - Qt::Key_F1));
+ else if (keycode == Qt::Key_PageUp) r_key_name = R_KeyName::knPGUP;
+ else if (keycode == Qt::Key_PageDown) r_key_name = R_KeyName::knPGDN;
+ else if (keycode == Qt::Key_End) r_key_name = R_KeyName::knEND;
+ else if (keycode == Qt::Key_Home) r_key_name = R_KeyName::knHOME;
+ else if (keycode == Qt::Key_Insert) r_key_name = R_KeyName::knINS;
+ else if (keycode == Qt::Key_Delete) r_key_name = R_KeyName::knDEL;
+
+ RFn::Rf_doKeybd(dev, r_key_name, text.toUtf8 ().data());
} else { // all others are mouse events
- Rf_doMouseEvent (dev, event_code == RKDMouseDown ? meMouseDown : (event_code == RKDMouseUp ? meMouseUp : meMouseMove), buttons, x, y);
+ RFn::Rf_doMouseEvent(dev, event_code == RKDMouseDown ? R_MouseEvent::meMouseDown : (event_code == RKDMouseUp ? R_MouseEvent::meMouseUp : R_MouseEvent::meMouseMove), buttons, x, y);
}
}
@@ -631,60 +632,67 @@ qint8 getGradientExtend(int Rextent) {
SEXP makeInt(int val) {
SEXP ret;
- PROTECT(ret = Rf_allocVector(INTSXP, 1));
- INTEGER(ret)[0] = val;
- UNPROTECT(1);
+ RFn::Rf_protect(ret = RFn::Rf_allocVector(INTSXP, 1));
+ RFn::INTEGER(ret)[0] = val;
+ RFn::Rf_unprotect(1);
return ret;
}
+static void RK_tryCall(SEXP func) {
+ int error;
+ SEXP call = RFn::Rf_protect(RFn::Rf_lang1(func));
+ RFn::R_tryEval(call, ROb(R_GlobalEnv), &error);
+ RFn::Rf_unprotect(1);
+}
+
SEXP RKD_SetPattern (SEXP pattern, pDevDesc dev) {
RK_TRACE(GRAPHICS_DEVICE);
- auto ptype = R_GE_patternType(pattern);
+ auto ptype = RFn::R_GE_patternType(pattern);
if ((ptype == R_GE_linearGradientPattern) || (ptype == R_GE_radialGradientPattern)) {
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDSetPattern, dev);
if (ptype == R_GE_linearGradientPattern) {
RKD_OUT_STREAM << (qint8) RKDPatternType::LinearPattern;
- RKD_OUT_STREAM << (double) R_GE_linearGradientX1(pattern) << (double) R_GE_linearGradientX2(pattern) << (double) R_GE_linearGradientY1(pattern) << (double) R_GE_linearGradientY2(pattern);
- qint16 nstops = R_GE_linearGradientNumStops(pattern);
+ RKD_OUT_STREAM << (double) RFn::R_GE_linearGradientX1(pattern) << (double) RFn::R_GE_linearGradientX2(pattern) << (double) RFn::R_GE_linearGradientY1(pattern) << (double) RFn::R_GE_linearGradientY2(pattern);
+ qint16 nstops = RFn::R_GE_linearGradientNumStops(pattern);
RKD_OUT_STREAM << nstops;
for (int i = 0; i < nstops; ++i) {
- WRITE_COLOR_BYTES(R_GE_linearGradientColour(pattern, i));
- RKD_OUT_STREAM << (double) R_GE_linearGradientStop(pattern, i);
+ WRITE_COLOR_BYTES(RFn::R_GE_linearGradientColour(pattern, i));
+ RKD_OUT_STREAM << (double) RFn::R_GE_linearGradientStop(pattern, i);
}
- RKD_OUT_STREAM << getGradientExtend(R_GE_linearGradientExtend(pattern));
+ RKD_OUT_STREAM << getGradientExtend(RFn::R_GE_linearGradientExtend(pattern));
} else if (ptype == R_GE_radialGradientPattern) {
RKD_OUT_STREAM << (qint8) RKDPatternType::RadialPattern;
- RKD_OUT_STREAM << (double) R_GE_radialGradientCX1(pattern) << (double) R_GE_radialGradientCY1(pattern) << (double) R_GE_radialGradientR1(pattern);
- RKD_OUT_STREAM << (double) R_GE_radialGradientCX2(pattern) << (double) R_GE_radialGradientCY2(pattern) << (double) R_GE_radialGradientR2(pattern);
- qint16 nstops = R_GE_radialGradientNumStops(pattern);
+ RKD_OUT_STREAM << (double) RFn::R_GE_radialGradientCX1(pattern) << (double) RFn::R_GE_radialGradientCY1(pattern) << (double) RFn::R_GE_radialGradientR1(pattern);
+ RKD_OUT_STREAM << (double) RFn::R_GE_radialGradientCX2(pattern) << (double) RFn::R_GE_radialGradientCY2(pattern) << (double) RFn::R_GE_radialGradientR2(pattern);
+ qint16 nstops = RFn::R_GE_radialGradientNumStops(pattern);
RKD_OUT_STREAM << nstops;
for (int i = 0; i < nstops; ++i) {
- WRITE_COLOR_BYTES(R_GE_radialGradientColour(pattern, i));
- RKD_OUT_STREAM << (double) R_GE_radialGradientStop(pattern, i);
+ WRITE_COLOR_BYTES(RFn::R_GE_radialGradientColour(pattern, i));
+ RKD_OUT_STREAM << (double) RFn::R_GE_radialGradientStop(pattern, i);
}
- RKD_OUT_STREAM << getGradientExtend(R_GE_radialGradientExtend(pattern));
+ RKD_OUT_STREAM << getGradientExtend(RFn::R_GE_radialGradientExtend(pattern));
}
} else if (ptype == R_GE_tilingPattern) {
{
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDStartRecordTilingPattern, dev);
- RKD_OUT_STREAM << (double) R_GE_tilingPatternWidth(pattern) << (double) R_GE_tilingPatternHeight(pattern);
- RKD_OUT_STREAM << (double) R_GE_tilingPatternX(pattern) << (double) R_GE_tilingPatternY(pattern);
+ RKD_OUT_STREAM << (double) RFn::R_GE_tilingPatternWidth(pattern) << (double) RFn::R_GE_tilingPatternHeight(pattern);
+ RKD_OUT_STREAM << (double) RFn::R_GE_tilingPatternX(pattern) << (double) RFn::R_GE_tilingPatternY(pattern);
}
// Play the pattern generator function. Contrary to cairo device, we use tryEval, here, to avoid getting into a
// bad device state in case of errors
int error;
- SEXP pattern_func = PROTECT(Rf_lang1(R_GE_tilingPatternFunction(pattern)));
- R_tryEval(pattern_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ SEXP pattern_func = RFn::Rf_protect(RFn::Rf_lang1(RFn::R_GE_tilingPatternFunction(pattern)));
+ RFn::R_tryEval(pattern_func, ROb(R_GlobalEnv), &error);
+ RFn::Rf_unprotect(1);
{
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDEndRecordTilingPattern, dev);
- RKD_OUT_STREAM << getGradientExtend(R_GE_tilingPatternExtend(pattern));
+ RKD_OUT_STREAM << getGradientExtend(RFn::R_GE_tilingPatternExtend(pattern));
}
} else {
- Rf_warning("Pattern type not (yet) supported");
+ RFn::Rf_warning("Pattern type not (yet) supported");
return makeInt(-1);
}
@@ -695,7 +703,7 @@ SEXP RKD_SetPattern (SEXP pattern, pDevDesc dev) {
}
// NOTE: we are free to chose a return value of our liking. It is used as an identifier for this pattern.
- if (index < 0) Rf_warning("Pattern type not (yet) supported");
+ if (index < 0) RFn::Rf_warning("Pattern type not (yet) supported");
return makeInt(index);
}
@@ -705,13 +713,13 @@ void releaseCachedResource(RKDCachedResourceType type, SEXP ref, pDevDesc dev) {
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDReleaseCachedResource, dev);
RKD_OUT_STREAM << (quint8) type;
- if (Rf_isNull(ref)) {
+ if (RFn::Rf_isNull(ref)) {
RKD_OUT_STREAM << (qint32) 1 << (qint32) -1; // means: destroy all objects of that type
} else {
- qint32 len = LENGTH(ref);
+ qint32 len = RFn::Rf_length(ref);
RKD_OUT_STREAM << len;
for (int i = 0; i < len; ++i) {
- RKD_OUT_STREAM << (qint32) INTEGER(ref)[i];
+ RKD_OUT_STREAM << (qint32) RFn::INTEGER(ref)[i];
}
}
}
@@ -725,7 +733,7 @@ void RKD_ReleasePattern (SEXP ref, pDevDesc dev) {
SEXP RKD_SetClipPath (SEXP path, SEXP ref, pDevDesc dev) {
RK_TRACE(GRAPHICS_DEVICE);
qint32 index = -1;
- if (!Rf_isNull(ref)) index = INTEGER(ref)[0];
+ if (!RFn::Rf_isNull(ref)) index = RFn::INTEGER(ref)[0];
// NOTE: just because we have a reference, doesn't mean, it's also valid, according to R sources
if (index >= 0) {
{
@@ -737,8 +745,8 @@ SEXP RKD_SetClipPath (SEXP path, SEXP ref, pDevDesc dev) {
RKGraphicsDataStreamReadGuard rguard;
qint8 ok;
RKD_IN_STREAM >> ok;
- if (!ok) Rf_warning("Invalid reference to clipping path");
- else return R_NilValue;
+ if (!ok) RFn::Rf_warning("Invalid reference to clipping path");
+ else return ROb(R_NilValue);
}
}
@@ -748,15 +756,12 @@ SEXP RKD_SetClipPath (SEXP path, SEXP ref, pDevDesc dev) {
WRITE_HEADER(RKDStartRecordClipPath, dev);
}
// Play generator function
- int error;
- SEXP path_func = PROTECT(Rf_lang1(path));
- R_tryEval(path_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ RK_tryCall(path);
{
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDEndRecordClipPath, dev);
#if R_VERSION >= R_Version(4, 2, 0)
- RKD_OUT_STREAM << (qint8) mapFillRule(R_GE_clipPathFillRule(path));
+ RKD_OUT_STREAM << (qint8) mapFillRule(RFn::R_GE_clipPathFillRule(path));
#else
RKD_OUT_STREAM << (qint8) 0; // NOTE: 0 == Qt::OddEvenFill
#endif
@@ -778,8 +783,8 @@ SEXP RKD_SetMask (SEXP mask, SEXP ref, pDevDesc dev) {
// Same logic as RKD_SetClipPath
qint32 index = 0;
- if (!Rf_isNull(ref)) index = INTEGER(ref)[0]; // ref==NULL means the mask is not yet registered, will be recorded, below
- if (index > 0 || Rf_isNull(mask)) { // mask==NULL means to unset the current mask. signalled to the frontend as index=0
+ if (!RFn::Rf_isNull(ref)) index = RFn::INTEGER(ref)[0]; // ref==NULL means the mask is not yet registered, will be recorded, below
+ if (index > 0 || RFn::Rf_isNull(mask)) { // mask==NULL means to unset the current mask. signalled to the frontend as index=0
{
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDSetMask, dev);
@@ -789,8 +794,8 @@ SEXP RKD_SetMask (SEXP mask, SEXP ref, pDevDesc dev) {
RKGraphicsDataStreamReadGuard rguard;
qint8 ok;
RKD_IN_STREAM >> ok;
- if (!ok) Rf_warning("Invalid reference to mask");
- else return R_NilValue;
+ if (!ok) RFn::Rf_warning("Invalid reference to mask");
+ else return ROb(R_NilValue);
}
}
@@ -800,15 +805,12 @@ SEXP RKD_SetMask (SEXP mask, SEXP ref, pDevDesc dev) {
WRITE_HEADER(RKDStartRecordMask, dev);
}
// Play generator function
- int error;
- SEXP mask_func = PROTECT(Rf_lang1(mask));
- R_tryEval(mask_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ RK_tryCall(mask);
{
RKGraphicsDataStreamWriteGuard wguard;
WRITE_HEADER(RKDEndRecordMask, dev);
#if R_VERSION >= R_Version(4,2,0)
- RKD_OUT_STREAM << (qint8) (R_GE_maskType(mask) == R_GE_luminanceMask ? 1 : 0);
+ RKD_OUT_STREAM << (qint8) (RFn::R_GE_maskType(mask) == R_GE_luminanceMask ? 1 : 0);
#else
RKD_OUT_STREAM << (qint8) 0;
#endif
@@ -836,11 +838,8 @@ SEXP RKD_DefineGroup(SEXP source, int op, SEXP destination, pDevDesc dev) {
}
// Play generator function for destination
- int error;
- if (destination != R_NilValue) {
- SEXP dest_func = PROTECT(Rf_lang1(destination));
- R_tryEval(dest_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ if (destination != ROb(R_NilValue)) {
+ RK_tryCall(destination);
}
{
@@ -850,9 +849,7 @@ SEXP RKD_DefineGroup(SEXP source, int op, SEXP destination, pDevDesc dev) {
}
// Play generator function for source
- SEXP src_func = PROTECT(Rf_lang1(source));
- R_tryEval(src_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ RK_tryCall(source);
{
RKGraphicsDataStreamWriteGuard wguard;
@@ -871,8 +868,8 @@ void RKD_UseGroup(SEXP ref, SEXP trans, pDevDesc dev) {
// NOTE: chaching parameters before starting the write, in case they are ill-formed and produce errors
qint32 index = 0;
- if (!Rf_isNull(ref)) index = INTEGER(ref)[0];
- bool have_trans = (trans != R_NilValue);
+ if (!Rfn::RFn::Rf_isNull(ref)) index = RFn::INTEGER(ref)[0];
+ bool have_trans = (trans != ROb(R_NilValue));
double matrix[6];
if (have_trans) {
for (int i = 0; i < 6; ++i) matrix[i] = REAL(trans)[i]; // order in cairo terms: xx, xy, x0, yx, yy, y0
@@ -904,10 +901,7 @@ void doFillAndOrStroke(SEXP path, const pGEcontext gc, pDevDesc dev, bool fill,
}
// record the actual path
- int error;
- SEXP path_func = PROTECT(Rf_lang1(path));
- R_tryEval(path_func, R_GlobalEnv, &error);
- UNPROTECT(1);
+ RK_tryCall(path);
{
RKGraphicsDataStreamWriteGuard wguard;
More information about the rkward-tracker
mailing list