[rkward-cvs] SF.net SVN: rkward:[3145] branches/2010_10_18_backend_restructuring_branch/ rkward/rbackend

tfry at users.sourceforge.net tfry at users.sourceforge.net
Mon Oct 25 15:11:54 UTC 2010


Revision: 3145
          http://rkward.svn.sourceforge.net/rkward/?rev=3145&view=rev
Author:   tfry
Date:     2010-10-25 15:11:54 +0000 (Mon, 25 Oct 2010)

Log Message:
-----------
More work on the gory details of the new event loop. Appears to work, now, but more testing is definitely needed.

Modified Paths:
--------------
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/CMakeLists.txt
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rthread.cpp

Added Paths:
-----------
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.cpp
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.h

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/CMakeLists.txt
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/CMakeLists.txt	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/CMakeLists.txt	2010-10-25 15:11:54 UTC (rev 3145)
@@ -22,6 +22,7 @@
 	rkpthreadsupport.cpp
 	rksignalsupport.cpp
 	rklocalesupport.cpp
+	rkrsupport.cpp
 )
 
 

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp	2010-10-25 15:11:54 UTC (rev 3145)
@@ -102,6 +102,7 @@
 #include <R_ext/eventloop.h>
 }
 
+#include "rkrsupport.h"
 #include "../rkglobals.h"
 #include "rdata.h"
 
@@ -135,18 +136,14 @@
 		RK_ASSERT (RThread::repl_status.user_command_status = RThread::RKReplStatus::UserCommandRunning);
 		if (succeeded) {
 			RThread::repl_status.user_command_successful_up_to = RThread::repl_status.user_command_parsed_up_to;
-			if (RThread::repl_status.user_command_completely_transmitted) RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
-			else RThread::repl_status.user_command_status = RThread::RKReplStatus::UserCommandTransmitted;
+			if (RThread::repl_status.user_command_completely_transmitted) {
+				RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
+				RThread::this_pointer->commandFinished ();
+			} else RThread::repl_status.user_command_status = RThread::RKReplStatus::UserCommandTransmitted;
 		} else {
-			// skip remainder of command
-			RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
+			// well, this point of code is never reached with R up to 2.12.0. Instead failed user commands are handled in doError().
+			RThread::repl_status.user_command_status = RThread::RKReplStatus::UserCommandFailed;
 		}
-		if (RThread::repl_status.user_command_status == RThread::RKReplStatus::NoUserCommand) {
-			MUTEX_LOCK;
-			if (!succeeded) RThread::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorOther;
-			MUTEX_UNLOCK;
-			RThread::this_pointer->commandFinished ();
-		}
 	}
 	
 	return (Rboolean) true;
@@ -215,6 +212,8 @@
 
 					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!
 					*/
 					RThread::repl_status.user_command_transmitted_up_to = 0;
 					RThread::repl_status.user_command_completely_transmitted = false;
@@ -228,12 +227,16 @@
 				}
 			} else if (RThread::repl_status.user_command_status == RThread::RKReplStatus::UserCommandTransmitted) {
 				if (RThread::repl_status.user_command_completely_transmitted) {
-					// fully transmitted, but R is still asking for more? -> Incomplete statement
+					// 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 (RThread::this_pointer->current_locale_codec->toUnicode (prompt) == SEXPToString (Rf_GetOption (Rf_install ("continue"), R_BaseEnv))) {
+						incomplete = true;
+					}
 					MUTEX_LOCK;
-					RThread::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorIncomplete;
-					RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
+					if (incomplete) RThread::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorIncomplete;
+					RThread::repl_status.user_command_status = RThread::RKReplStatus::ReplIterationKilled;
 					MUTEX_UNLOCK;
-					RThread::this_pointer->commandFinished ();
 					RK_doIntr ();	// to discard the buffer
 				} else {
 					RKTransmitNextUserCommandChunk (buf, buflen);
@@ -246,11 +249,28 @@
 				MUTEX_UNLOCK;
 				RThread::this_pointer->commandFinished ();
 			} else if (RThread::repl_status.user_command_status == RThread::RKReplStatus::UserCommandRunning) {
-				// it appears, the user command triggered a call to readline. Will be handled, below.
-				// NOT returning
-				break;
+				// it appears, the user command triggered a call to readline.
+				int n_frames = SEXPToInt (RKRSupport::callSimpleFun0 (Rf_findFun (Rf_install ("sys.nframe"), R_BaseEnv), R_GlobalEnv));
+				if (n_frames < 1) {
+					// No active frames? This is either a browser() call at toplevel, or R jumped us back to toplevel, behind our backs.
+					// For safety, let's reset and start over.
+					MUTEX_LOCK;
+					RThread::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorOther;
+					RThread::repl_status.user_command_status = RThread::RKReplStatus::ReplIterationKilled;
+					MUTEX_UNLOCK;
+					RK_doIntr ();	// to discard the buffer
+				} else {
+					// Handled below
+					break;
+				}
+			} else if (RThread::repl_status.user_command_status == RThread::RKReplStatus::UserCommandFailed) {
+				MUTEX_LOCK;
+				RThread::this_pointer->current_command->status |= RCommand::Failed | RCommand::ErrorOther;
+				RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
+				MUTEX_UNLOCK;
+				RThread::this_pointer->commandFinished ();
 			} else {
-				RK_ASSERT (false);
+				RK_ASSERT (RThread::repl_status.user_command_status == RThread::RKReplStatus::ReplIterationKilled);
 				RThread::repl_status.user_command_status = RThread::RKReplStatus::NoUserCommand;
 				RThread::this_pointer->commandFinished ();
 			}
@@ -296,6 +316,9 @@
 	if (RThread::repl_status.eval_depth == 0) {
 		if (RThread::repl_status.user_command_status == RThread::RKReplStatus::UserCommandTransmitted) {
 			RThread::repl_status.user_command_status = RThread::RKReplStatus::UserCommandSyntaxError;
+		} else if (RThread::repl_status.user_command_status == RThread::RKReplStatus::ReplIterationKilled) {
+			// purge superflous newlines
+			if (QString ("\n") == buf) return;
 		} else {
 			RK_ASSERT (RThread::repl_status.user_command_status != RThread::RKReplStatus::NoUserCommand);
 		}
@@ -313,10 +336,12 @@
 	RK_TRACE (RBACKEND);
 
 	if (saveact != SA_SUICIDE) {
-		RCallbackArgs args;
-		args.type = RCallbackArgs::RBackendExit;
-		args.params["message"] = QVariant (i18n ("The R engine has shut down with status: %1").arg (status));
-		RThread::this_pointer->handleStandardCallback (&args);
+		if (!RThread::this_pointer->isKilled ()) {
+			RCallbackArgs args;
+			args.type = RCallbackArgs::RBackendExit;
+			args.params["message"] = QVariant (i18n ("The R engine has shut down with status: %1").arg (status));
+			RThread::this_pointer->handleStandardCallback (&args);
+		}
 
 		if(saveact == SA_DEFAULT) saveact = SA_SAVE;
 		if (saveact == SA_SAVE) {
@@ -833,6 +858,9 @@
 SEXP doError (SEXP call) {
 	RK_TRACE (RBACKEND);
 
+	if (RThread::this_pointer->repl_status.eval_depth == 0) {
+		RThread::this_pointer->repl_status.user_command_status = RThread::RKReplStatus::UserCommandFailed;
+	}
 	unsigned int count;
 	QString *strings = SEXPToStringList (call, &count);
 	RThread::this_pointer->handleError (strings, count);
@@ -840,14 +868,6 @@
 	return R_NilValue;
 }
 
-/*
-SEXP doCondition (SEXP call) {
-	int count;
-	char **strings = extractStrings (call, &count);
-	RThread::this_pointer->handleCondition (strings, count);
-	return R_NilValue;
-} */
-
 SEXP doSubstackCall (SEXP call) {
 	RK_TRACE (RBACKEND);
 
@@ -1097,38 +1117,6 @@
 	return exp;
 }
 
-#if 0
-// This is currently unused, but might come in handy, again.
-/* Basically a safe version of Rf_PrintValue, as yes, Rf_PrintValue may lead to an error and long_jump->crash!
-For example in help (function, htmlhelp=TRUE), when no HTML-help is installed!
-SEXP exp should be PROTECTed prior to calling this function.
-//TODO: I don't think it's meant to be this way. Maybe nag the R-devels about it one day. 
-//TODO: this is not entirely correct. See PrintValueEnv (), which is what Repl_Console uses (but is hidden)
-*/
-void tryPrintValue (SEXP exp, RThread::RKWardRError *error) {
-	RK_TRACE (RBACKEND);
-
-	int ierror = 0;
-	SEXP tryprint, e;
-
-// Basically, we call 'print (expression)' (but inside a tryEval)
-	tryprint = Rf_findFun (Rf_install ("print"),  R_GlobalEnv);
-	PROTECT (tryprint);
-	e = allocVector (LANGSXP, 2);
-	PROTECT (e);
-	SETCAR (e, tryprint);
-	SETCAR (CDR (e), exp);
-	R_tryEval (e, R_GlobalEnv, &ierror);
-	UNPROTECT (2);	/* e, tryprint */
-
-	if (ierror) {
-		*error = RThread::OtherError;
-	} else {
-		*error = RThread::NoError;
-	}
-}
-#endif
-
 bool RThread::runDirectCommand (const QString &command) {
 	RK_TRACE (RBACKEND);
 

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h	2010-10-25 15:11:54 UTC (rev 3145)
@@ -261,7 +261,9 @@
 			NoUserCommand,
 			UserCommandTransmitted,
 			UserCommandSyntaxError,
-			UserCommandRunning
+			UserCommandRunning,
+			UserCommandFailed,
+			ReplIterationKilled
 		} user_command_status;
 		int eval_depth;		// Number (depth) of non-user commands currently running. User commands can only run at depth 0
 	};
@@ -269,7 +271,7 @@
 
 	// fetch next command (and do event processing while waiting)
 	RCommand *fetchNextCommand (RCommandStack *stack);
-	void commandFinished ();
+	void commandFinished (bool check_object_updates_needed=true);
 protected:
 /** thread is locked. No new commands will be executed. @see LockType @see lock @see unlock */
 	int locked;

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h	2010-10-25 15:11:54 UTC (rev 3145)
@@ -24,7 +24,7 @@
 
 #include "rcommand.h"
 
-//#define DEBUG_MUTEX
+#define DEBUG_MUTEX
 #ifdef DEBUG_MUTEX
 #define MUTEX_LOCK RInterface::mutex.lock (); qDebug ("mutex locks: %d, locked in %s, %s, %d", ++RInterface::mutex_counter, __FILE__, __FUNCTION__, __LINE__); 
 #define MUTEX_UNLOCK qDebug ("mutex locks: %d, unlocked in %s, %s, %d", --RInterface::mutex_counter, __FILE__, __FUNCTION__, __LINE__); RInterface::mutex.unlock ();

Added: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.cpp	                        (rev 0)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.cpp	2010-10-25 15:11:54 UTC (rev 3145)
@@ -0,0 +1,64 @@
+/***************************************************************************
+                          rkrsupport  -  description
+                             -------------------
+    begin                : Mon Oct 25 2010
+    copyright            : (C) 2010 by Thomas Friedrichsmeier
+    email                : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+
+#include "rkrsupport.h"
+
+#include <QString>
+
+#include "../debug.h"
+
+SEXP RKRSupport::callSimpleFun0 (SEXP fun, SEXP env) {
+	SEXP call = Rf_allocVector (LANGSXP, 1);
+	PROTECT (call);
+	SETCAR (call, fun);
+
+	SEXP ret = Rf_eval (call, env);
+
+	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 ret = Rf_eval (call, env);
+
+	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 ret = Rf_eval (call, env);
+
+	UNPROTECT (1); /* call */
+	return ret;
+}
+
+bool RKRSupport::callSimpleBool (SEXP fun, SEXP arg, SEXP env) {
+	SEXP res = callSimpleFun (fun, arg, env);
+	RK_ASSERT (TYPEOF (res) == LGLSXP);
+	return ((bool) LOGICAL (res)[0]);
+}

Added: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.h	                        (rev 0)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkrsupport.h	2010-10-25 15:11:54 UTC (rev 3145)
@@ -0,0 +1,33 @@
+/***************************************************************************
+                          rkrsupport  -  description
+                             -------------------
+    begin                : Mon Oct 25 2010
+    copyright            : (C) 2010 by Thomas Friedrichsmeier
+    email                : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+
+#ifndef RKRSUPPORT_H
+#define RKRSUPPORT_H
+
+#include <QString>
+
+#include <Rdefines.h>
+
+/** Convenience functions for working with R. */
+namespace RKRSupport {
+	SEXP callSimpleFun0 (SEXP fun, SEXP env);
+	SEXP callSimpleFun (SEXP fun, SEXP arg, SEXP env);
+	SEXP callSimpleFun2 (SEXP fun, SEXP arg1, SEXP arg2, SEXP env);
+	bool callSimpleBool (SEXP fun, SEXP arg, SEXP env);
+};
+
+#endif
\ No newline at end of file

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp	2010-10-25 15:11:54 UTC (rev 3145)
@@ -71,37 +71,6 @@
 	return (ret);
 }
 
-SEXP RKStructureGetter::callSimpleFun (SEXP fun, SEXP arg, SEXP env) {
-	SEXP call = Rf_allocVector (LANGSXP, 2);
-	PROTECT (call);
-	SETCAR (call, fun);
-	SETCAR (CDR (call), arg);
-
-	SEXP ret = Rf_eval (call, env);
-
-	UNPROTECT (1); /* call */
-	return ret;
-}
-
-SEXP RKStructureGetter::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 ret = Rf_eval (call, env);
-
-	UNPROTECT (1); /* call */
-	return ret;
-}
-
-bool RKStructureGetter::callSimpleBool (SEXP fun, SEXP arg, SEXP env) {
-	SEXP res = callSimpleFun (fun, arg, env);
-	RK_ASSERT (TYPEOF (res) == LGLSXP);
-	return ((bool) LOGICAL (res)[0]);
-}
-
 RData *RKStructureGetter::getStructure (SEXP toplevel, SEXP name, SEXP envlevel, SEXP namespacename) {
 	RK_TRACE (RBACKEND);
 
@@ -124,7 +93,7 @@
 		PROTECT (as_ns_fun);
 		RK_ASSERT (!Rf_isNull (as_ns_fun));
 
-		namespace_envir = callSimpleFun (as_ns_fun, namespacename, R_GlobalEnv);
+		namespace_envir = RKRSupport::callSimpleFun (as_ns_fun, namespacename, R_GlobalEnv);
 		UNPROTECT (1);	/* as_ns_fun */
 
 		PROTECT (namespace_envir);
@@ -229,7 +198,7 @@
 
 		PROTECT (classes_s);
 	} else {
-		classes_s = callSimpleFun (class_fun, value, R_BaseEnv);
+		classes_s = RKRSupport::callSimpleFun (class_fun, value, R_BaseEnv);
 		PROTECT (classes_s);
 	}
 
@@ -249,27 +218,27 @@
 		if (classes[i] == "data.frame") type |= RObject::DataFrame;
 	}
 
-	if (callSimpleBool (is_matrix_fun, value, R_BaseEnv)) type |= RObject::Matrix;
-	if (callSimpleBool (is_array_fun, value, R_BaseEnv)) type |= RObject::Array;
-	if (callSimpleBool (is_list_fun, value, R_BaseEnv)) type |= RObject::List;
+	if (RKRSupport::callSimpleBool (is_matrix_fun, value, R_BaseEnv)) type |= RObject::Matrix;
+	if (RKRSupport::callSimpleBool (is_array_fun, value, R_BaseEnv)) type |= RObject::Array;
+	if (RKRSupport::callSimpleBool (is_list_fun, value, R_BaseEnv)) type |= RObject::List;
 
 	if (type != 0) {
 		is_container = true;
 		type |= RObject::Container;
 	} else {
-		if (callSimpleBool (is_function_fun, value, R_BaseEnv)) {
+		if (RKRSupport::callSimpleBool (is_function_fun, value, R_BaseEnv)) {
 			is_function = true;
 			type |= RObject::Function;
-		} else if (callSimpleBool (is_environment_fun, value, R_BaseEnv)) {
+		} else if (RKRSupport::callSimpleBool (is_environment_fun, value, R_BaseEnv)) {
 			is_container = true;
 			type |= RObject::Environment;
 			is_environment = true;
 		} else {
 			type |= RObject::Variable;
-			if (callSimpleBool (is_factor_fun, value, R_BaseEnv)) type |= RObject::Factor;
-			else if (callSimpleBool (is_numeric_fun, value, R_BaseEnv)) type |= RObject::Numeric;
-			else if (callSimpleBool (is_character_fun, value, R_BaseEnv)) type |= RObject::Character;
-			else if (callSimpleBool (is_logical_fun, value, R_BaseEnv)) type |= RObject::Logical;
+			if (RKRSupport::callSimpleBool (is_factor_fun, value, R_BaseEnv)) type |= RObject::Factor;
+			else if (RKRSupport::callSimpleBool (is_numeric_fun, value, R_BaseEnv)) type |= RObject::Numeric;
+			else if (RKRSupport::callSimpleBool (is_character_fun, value, R_BaseEnv)) type |= RObject::Character;
+			else if (RKRSupport::callSimpleBool (is_logical_fun, value, R_BaseEnv)) type |= RObject::Logical;
 		}
 	}
 	if (misplaced) type |= RObject::Misplaced;
@@ -280,7 +249,7 @@
 	if (!Rf_isNull (Rf_getAttrib (value, meta_attrib))) {
 		type |= RObject::HasMetaObject;
 
-		SEXP meta_s = callSimpleFun (get_meta_fun, value, R_GlobalEnv);
+		SEXP meta_s = RKRSupport::callSimpleFun (get_meta_fun, value, R_GlobalEnv);
 		PROTECT (meta_s);
 		metadata->data = SEXPToStringList (meta_s, &count);
 		metadata->length = count;
@@ -303,7 +272,7 @@
 	// get dims
 	int *dims;
 	unsigned int num_dims;
-	SEXP dims_s = callSimpleFun (dims_fun, value, R_BaseEnv);
+	SEXP dims_s = RKRSupport::callSimpleFun (dims_fun, value, R_BaseEnv);
 	if (!Rf_isNull (dims_s)) {
 		dims = SEXPToIntArray (dims_s, &num_dims);
 	} else {
@@ -311,7 +280,7 @@
 
 		unsigned int len = Rf_length (value);
 		if ((len < 2) && (!is_function)) {		// suspicious. Maybe some kind of list
-			SEXP len_s = callSimpleFun (length_fun, value, R_BaseEnv);
+			SEXP len_s = RKRSupport::callSimpleFun (length_fun, value, R_BaseEnv);
 			PROTECT (len_s);
 			if (Rf_isNull (len_s)) {
 				dims = new int[1];
@@ -366,7 +335,7 @@
 		if (do_env) {
 			childnames_s = R_lsInternal (value, (Rboolean) 1);
 		} else if (do_cont) {
-			childnames_s = callSimpleFun (names_fun, value, R_BaseEnv);
+			childnames_s = RKRSupport::callSimpleFun (names_fun, value, R_BaseEnv);
 		} else {
 			childnames_s = R_NilValue; // dummy
 		}
@@ -389,7 +358,7 @@
 			if (!Rf_isEnvironment (value)) {
 				// some classes (ReferenceClasses) are identified as envionments by is.environment(), but are not internally ENVSXPs.
 				// For these, Rf_findVar would fail.
-				REPROTECT (value = callSimpleFun (as_environment_fun, value, R_GlobalEnv), value_index);
+				REPROTECT (value = RKRSupport::callSimpleFun (as_environment_fun, value, R_GlobalEnv), value_index);
 			}
 			for (unsigned int i = 0; i < childcount; ++i) {
 				SEXP current_childname = Rf_install(CHAR(STRING_ELT(childnames_s, i)));
@@ -429,7 +398,7 @@
 				PROTECT (index);
 				for (unsigned int i = 0; i < childcount; ++i) {
 					INTEGER (index)[0] = (i + 1);
-					SEXP child = callSimpleFun2 (double_brackets_fun, value, index, R_BaseEnv);
+					SEXP child = RKRSupport::callSimpleFun2 (double_brackets_fun, value, index, R_BaseEnv);
 					getStructureSafe (child, childnames[i], false, children[i]);
 				}
 				UNPROTECT (1); /* index */
@@ -451,7 +420,7 @@
 		res[6] = funargvaluesdata;
 
 // TODO: this is still the major bottleneck, but no idea, how to improve on this
-		SEXP formals_s = callSimpleFun (get_formals_fun, value, R_GlobalEnv);
+		SEXP formals_s = RKRSupport::callSimpleFun (get_formals_fun, value, R_GlobalEnv);
 		PROTECT (formals_s);
 		// the default values
 		funargvaluesdata->data = SEXPToStringList (formals_s, &(funargvaluesdata->length));

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h	2010-10-25 15:11:54 UTC (rev 3145)
@@ -47,10 +47,6 @@
 	bool with_namespace;
 	SEXP namespace_envir;
 
-	static SEXP callSimpleFun (SEXP fun, SEXP arg, SEXP env);
-	static SEXP callSimpleFun2 (SEXP fun, SEXP arg1, SEXP arg2, SEXP env);
-	static bool callSimpleBool (SEXP fun, SEXP arg, SEXP env);
-
 	SEXP class_fun;
 	SEXP dims_fun;
 	SEXP meta_attrib;

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rthread.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rthread.cpp	2010-10-25 11:53:09 UTC (rev 3144)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rthread.cpp	2010-10-25 15:11:54 UTC (rev 3145)
@@ -83,7 +83,7 @@
 	enterEventLoop ();
 }
 
-void RThread::commandFinished () {
+void RThread::commandFinished (bool check_object_updates_needed) {
 	RK_TRACE (RBACKEND);
 
 	RK_DO (qDebug ("done running command"), RBACKEND, DL_DEBUG);
@@ -92,7 +92,9 @@
 	current_command->status |= RCommand::WasTried;
 	RCommandStackModel::getModel ()->itemChange (current_command);
 
-	checkObjectUpdatesNeeded (current_command->type () & (RCommand::User | RCommand::ObjectListUpdate));
+	if (check_object_updates_needed || (current_command->type () & RCommand::ObjectListUpdate)) {
+		checkObjectUpdatesNeeded (current_command->type () & (RCommand::User | RCommand::ObjectListUpdate));
+	}
 	RCommandStack::currentStack ()->pop ();
 	notifyCommandDone (current_command);	// command may be deleted after this
 
@@ -324,7 +326,7 @@
 		MUTEX_LOCK;
 		runCommand (c);
 		MUTEX_UNLOCK;
-		commandFinished ();
+		commandFinished (false);
 	}
 
 	MUTEX_LOCK;


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the rkward-tracker mailing list