[Rd] R.DLL mapping by P/Invoke
box at dupuislogiciels.com
box at dupuislogiciels.com
Mon Nov 27 19:22:41 CET 2006
After a long processing, I was able to create a version of a small C# class
that was able to emulate the rproxy by P/Invoke. This is mostly to find a
workaround a performance problem of the StatConnector.
It's almost work but ... I have strange memory exception when I call the
print function. The variable seems to not survive from one call to the
other.
As there is no debug symbol for the R.DLL (and I don't want to spend my
youth on the disassembly window of VS), I put there the result of my search.
If some of you can find the reason of the crash, I will be extremely happy!
Here is a sample program.cs to invoke the DLL (and crash) :
using System;
using System.Collections;
using System.Text;
namespace SharpR
{
class Program
{
static void Main(string[] args)
{
RWrapper.EvaluateNoReturn("print(\"Boom!\")");
}
}
}
-------------- next part --------------
#define SUPERCONSOLE
using System;
using System.Collections;
using System.Runtime.InteropServices;
using System.Text;
using Microsoft.Win32;
namespace SharpR
{
/// <summary>
/// Class for interp with the R.DLL. All is static as R is mono-threaded.
/// </summary>
class RWrapper
{
#region <R.DLL interop signatures>
//- DLL Management/Information
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string getDLLVersion();
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string get_R_HOME();
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string getRUser();
//- R Start Up
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_setStartTime();
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_DefParams(ref RStartStruct @params);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_SetParams(ref RStartStruct @params);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_set_command_line_arguments(int argc, string[] args);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern int GA_initapp(int argc, string[] args);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void readconsolecfg();
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void setup_Rmainloop();
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_ReplDLLinit();
//- R SEXP management
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_mkString(string toConvert);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_protect(IntPtr ptr);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_unprotect(int l);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_unprotect_ptr(IntPtr ptr);
//- R Parser/Eval
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr R_ParseVector(IntPtr str, int x, out RParseStatus result);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr R_tryEval(IntPtr exp, IntPtr env, out int evalError);
//- R Symbols
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_install(string name);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_findVar(IntPtr symbol, IntPtr env);
[DllImport("R.DLL", /*CallingConvention = CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_setVar(IntPtr symbol, IntPtr value, IntPtr env);
#endregion
#region <R.DLL interop types>
enum RParseStatus
{
PARSE_NULL,
PARSE_OK,
PARSE_INCOMPLETE,
PARSE_ERROR,
PARSE_EOF
};
enum SaType
{
SA_NORESTORE = 0,/* = 0 */
SA_RESTORE,
SA_DEFAULT,/* was === SA_RESTORE */
SA_NOSAVE,
SA_SAVE,
SA_SAVEASK,
SA_SUICIDE
};
enum RBool
{
RFalse = 0,
RTrue
};
enum RYesNoCancel
{
Yes = 1,
No = -1,
Cancel = 0
};
enum RUIMode
{
RGui = 0, RTerm, LinkDLL
};
[StructLayout(LayoutKind.Sequential)]
struct RStartStruct
{
public RBool R_Quiet;
public RBool R_Slave;
public RBool R_Interactive;
public RBool R_Verbose;
public RBool LoadSiteFile;
public RBool LoadInitFile;
public RBool DebugInitFile;
public SaType RestoreAction;
public SaType SaveAction;
public uint vsize;
public uint nsize;
public uint max_vsize;
public uint max_nsize;
public uint ppsize;
public int NoRenviron;
//!! Warning - R will keep theses pointers. See gnuwin32\system.c (line 638)
public IntPtr home;
public IntPtr rhome;
//!!
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgReadConsole readConsole;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgWriteConsole writeConsole;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgCallback callback;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgShowMessage showMessage;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgYesNoCancel yesNoCancel;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgBusy busy;
public RUIMode characterMode;
};
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate int dgReadConsole(
[MarshalAs(UnmanagedType.LPStr)]string prompt,
IntPtr buf, int len,
int addtohistory
);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgWriteConsole(
[MarshalAs(UnmanagedType.LPStr,SizeParamIndex = 1)]
string buf, int len);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgCallback();
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgShowMessage(string msg);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
[return: MarshalAs(UnmanagedType.I4)]
delegate RYesNoCancel dgYesNoCancel(string msg);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgBusy(int which);
#endregion
#region <BDX Interops frm RPROXY.DLL>
/* const string strBdxGetObject = "BDX_get_vtbl at 8";
/// <summary>
/// PInvoke with automatic marshal on GetProcAddress to return dgScProxyGetObject function
/// </summary>
/// <param name="hModule">HMODULE of the RPROXY.DLL</param>
/// <param name="procName">*MUST* be strScProxyGetObject</param>
/// <returns></returns>
[DllImport("kernel32.dll", CharSet = CharSet.Ansi, EntryPoint = "GetProcAddress")]
[return: MarshalAs(UnmanagedType.FunctionPtr)]
static extern dgBdxGetObject GetPABdxGetObject(IntPtr hModule, string procName);
delegate int dgBdxGetObject(out IntPtr vtable, uint value);
delegate void BdxFree(IntPtr bdx);
delegate void BdxTrace(IntPtr bdx);
delegate int BdxVariant2BDX([MarshalAs(UnmanagedType.Struct)]object var, out IntPtr bdx);
delegate int BdxBDX2Variant(IntPtr bdx, [MarshalAs(UnmanagedType.Struct)]out object var);
[StructLayout(LayoutKind.Sequential)]
struct RBdxVtable
{
public BdxFree free;
public BdxTrace trace;
public BdxVariant2BDX v2bdx;
public BdxBDX2Variant bdx2v;
} */
[DllImport("Rproxy.DLL", CallingConvention = CallingConvention.Cdecl)]
static extern int BDX2SEXP(IntPtr pBDXData, out IntPtr pSEXPData);
[DllImport("Rproxy.dll", CallingConvention = CallingConvention.Cdecl)]
static extern int SEXP2BDX(IntPtr pSexp, out IntPtr ppBDXData);
[DllImport("Rproxy.dll", EntryPoint = "Variant2BDX at 20")]
static extern int Variant2BDX([MarshalAs(UnmanagedType.Struct)]object var, out IntPtr bdx);
[DllImport("Rproxy.dll", EntryPoint = "BDX2Variant at 8")]
static extern int BDX2Variant(IntPtr bdx,[MarshalAs(UnmanagedType.Struct)]out object var);
[DllImport("Rproxy.dll", EntryPoint = "bdx_free at 4")]
static extern void bdx_free(IntPtr bdx);
#endregion
#region <Win32 interop signatures>
[DllImport("kernel32.dll")]
static extern IntPtr LoadLibrary(string lpFileName);
[DllImport("kernel32.dll", CharSet = CharSet.Ansi, ExactSpelling = true)]
public static extern IntPtr GetProcAddress(IntPtr hModule, string procName);
#endregion
static string sg_dllVersion,sg_RHome,sg_RUsersHome;
static IntPtr sg_hModR;
static IntPtr sg_hModRProxy;
static StringBuilder sg_ConsoleOutput;
static IntPtr sg_rDll_R_GlobalEnvPtr, sg_rDll_R_UserBreakPtr;
static IntPtr sg_rDll_R_UnboundValue;
static GCHandle[] sg_lockDelegates;
static RWrapper()
{
try {
//- Get the active DLL path from the registry
string dllPath = Convert.ToString(
Registry.LocalMachine.OpenSubKey("Software\\R-core\\R", false).GetValue("InstallPath")
);
//- Fix the process PATH
Environment.SetEnvironmentVariable("PATH",
dllPath + "\\bin;" + Environment.GetEnvironmentVariable("PATH"),
EnvironmentVariableTarget.Process
);
//- Load the R.DLL module into the process
sg_hModR = LoadLibrary(dllPath + "\\bin\\R.dll");
if (sg_hModR == IntPtr.Zero) throw new Exception("Unable to load R.DLL");
//- Load the Rproxy.DLL module into the process
sg_hModRProxy = LoadLibrary(dllPath + "\\bin\\Rproxy.dll");
if (sg_hModRProxy == IntPtr.Zero) throw new Exception("Unable to load R.DLL");
//- Read the DLL version by Interop
sg_dllVersion = getDLLVersion();
//- Get important R global variable pointers from GetProcAddress
sg_rDll_R_GlobalEnvPtr = GetProcAddress(sg_hModR, "R_GlobalEnv");
sg_rDll_R_UserBreakPtr = GetProcAddress(sg_hModR, "UserBreak");
sg_rDll_R_UnboundValue = GetProcAddress(sg_hModR, "R_UnboundValue");
//- Output DLL
sg_ConsoleOutput = new StringBuilder();
//- Let's start R
RStartStruct start = new RStartStruct();
//- Get Defaults
R_setStartTime();
R_DefParams(ref start);
sg_RHome = get_R_HOME();
sg_RUsersHome = getRUser();
//- Inject R Home
start.home = Marshal.StringToHGlobalAnsi(sg_RHome);
start.rhome = Marshal.StringToHGlobalAnsi(sg_RUsersHome);
//- Setup R in embedded/batch mode
start.characterMode = RUIMode.LinkDLL;
start.R_Quiet = RBool.RTrue;
start.R_Interactive = RBool.RTrue;
start.RestoreAction = SaType.SA_RESTORE;
start.SaveAction = SaType.SA_NOSAVE;
//- Setup the callbacks
start.readConsole = new dgReadConsole(cbReadConsole);
start.writeConsole = new dgWriteConsole(cbWriteConsole);
start.busy = new dgBusy(cbBusy);
start.callback = new dgCallback(cbCallback);
start.showMessage = new dgShowMessage(cbShowMessage);
start.yesNoCancel = new dgYesNoCancel(cbYesNoCancel);
sg_lockDelegates = new GCHandle[7];
sg_lockDelegates[0] = GCHandle.Alloc(start.readConsole);
sg_lockDelegates[1] = GCHandle.Alloc(start.writeConsole);
sg_lockDelegates[2] = GCHandle.Alloc(start.busy);
sg_lockDelegates[3] = GCHandle.Alloc(start.callback);
sg_lockDelegates[4] = GCHandle.Alloc(start.showMessage);
sg_lockDelegates[5] = GCHandle.Alloc(start.yesNoCancel);
sg_lockDelegates[6] = GCHandle.Alloc(start);
//- Gentleman start your engines !
R_SetParams(ref start);
R_set_command_line_arguments(0, new string[] { });
GA_initapp(0, new string[] { });
readconsolecfg();
setup_Rmainloop();
R_ReplDLLinit();
} catch(Exception e)
{
throw;
}
}
private RWrapper() {}
static int UserBreak
{
get
{
return Marshal.ReadInt32(sg_rDll_R_UserBreakPtr);
}
set
{
Marshal.WriteInt32(sg_rDll_R_UserBreakPtr,value);
}
}
static public string RDllVersion { get { return sg_dllVersion; } }
static public string RHome { get { return sg_RHome; } }
static public string RUsersHome { get { return sg_RUsersHome; } }
#region <R Callbacks>
static int cbReadConsole(string prompt, IntPtr buf, int len, int addtohistory)
{
//- We don't use the console to interact with R. The function returns 0
// to force R exiting any event loop.
return 0;
}
static void cbWriteConsole(string buf, int len)
{
sg_ConsoleOutput.Append(buf);
#if SUPERCONSOLE
ConsoleColor c = Console.ForegroundColor;
Console.ForegroundColor = ConsoleColor.Green;
Console.Write(buf);
Console.ForegroundColor = c;
#endif
}
static void cbCallback() { /*NoOp*/ }
static void cbBusy(int which)
{
#if SUPERCONSOLE
int top = Console.CursorTop, left = Console.CursorLeft;
Console.CursorTop = Console.CursorLeft = 0;
Console.Write("Busy : {0}", which);
Console.CursorTop = top; Console.CursorLeft = left;
#endif
}
static void cbShowMessage(string msg)
{
Console.WriteLine("Message : " + msg);
}
static RYesNoCancel cbYesNoCancel(string msg)
{
Console.WriteLine("YesNoCancel : " + msg);
return RYesNoCancel.Cancel;
}
#endregion
static IntPtr GetCurrentEnv()
{
IntPtr ret = Marshal.ReadIntPtr(sg_rDll_R_GlobalEnvPtr);
return ret;
}
static bool IsUnbound(IntPtr Sexp)
{
IntPtr unbound = Marshal.ReadIntPtr(sg_rDll_R_UnboundValue);
return Sexp == unbound;
}
static public void EvaluateNoReturn(string statement)
{
//- Parse the expresion
RParseStatus status;
IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1, out status);
if(status!=RParseStatus.PARSE_OK)
{
throw new Exception("R Parse Error : " + status.ToString());
}
Rf_protect(lSexpVect);
// lSexpVect is a vector of lSexp. We need to read the memory directly to get
// the lSexp
int evalError;
IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
R_tryEval(lSexp, IntPtr.Zero, out evalError);
Rf_unprotect(1);
if (evalError != 0) throw new Exception("R Eval Error : " + evalError.ToString());
}
static public object Evaluate(string statement)
{
//- Parse the expresion
RParseStatus status;
IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1, out status);
if (status != RParseStatus.PARSE_OK)
{
throw new Exception("R Parse Error : " + status.ToString());
}
Rf_protect(lSexpVect);
// lSexpVect is a vector of lSexp. We need to read the memory directly to get
// the lSexp
int evalError;
IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
Rf_protect(lSexp);
IntPtr lresult = R_tryEval(lSexp, GetCurrentEnv(), out evalError);
Rf_unprotect(1);
if (evalError != 0) throw new Exception("R Eval Error : " + evalError.ToString());
IntPtr bdxResult;
object result;
evalError = SEXP2BDX(lresult, out bdxResult);
evalError = BDX2Variant(bdxResult, out result);
bdx_free(bdxResult);
return result;
}
static public object GetSymbol(string name)
{
IntPtr lsValue = Rf_findVar(Rf_install(name), GetCurrentEnv());
if (IsUnbound(lsValue))
{
throw new Exception(name + " is an unbound value");
}
IntPtr bdxResult;
object result;
int evalError = SEXP2BDX(lsValue, out bdxResult);
evalError = BDX2Variant(bdxResult, out result);
bdx_free(bdxResult);
return result;
}
static public void SetSymbol(string name,object value)
{
IntPtr bdxData, sexpData;
int evalError = Variant2BDX(value, out bdxData);
evalError = BDX2SEXP(bdxData, out sexpData);
bdx_free(bdxData);
IntPtr lsSymbol = Rf_install(name);
Rf_setVar(lsSymbol, sexpData, GetCurrentEnv());
}
static public string CollectConsole()
{
string ret = sg_ConsoleOutput.ToString();
sg_ConsoleOutput = new StringBuilder();
return ret;
}
}
}
More information about the R-devel
mailing list