Re: [Rd] R.DLL mapping by P/Invoke

From: box <box_at_dupuislogiciels.com>
Date: Tue 19 Dec 2006 - 07:20:14 GMT

Beileive me, this option was tested extensively. There is a lot of problem there :

Laurent

Duncan Temple Lang wrote:

>-----BEGIN PGP SIGNED MESSAGE-----
>Hash: SHA1
>
>
>I am not certain precisely what the performance problem
>of StatConnector you are referring to is, but did you
>look at RDCOMServer to see if that avoids the problem.
>
>It is at http://www.omegahat.org/RDCOMServer/
>
>I don't know whether it will solve your problem,
>but it seems reasonable to try it before developing
>a lot of code.
>
> D.
>
>
>I wrote:
>
>
>>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!\")");
>> }
>> }
>>}
>>
>>
>>------------------------------------------------------------------------
>>
>>#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@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@20")]
>> static extern int Variant2BDX([MarshalAs(UnmanagedType.Struct)]object var, out IntPtr bdx);
>> [DllImport("Rproxy.dll", EntryPoint = "BDX2Variant@8")]
>> static extern int BDX2Variant(IntPtr bdx,[MarshalAs(UnmanagedType.Struct)]out object var);
>> [DllImport("Rproxy.dll", EntryPoint = "bdx_free@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;
>> }
>>
>> }
>>}
>>
>>
>>------------------------------------------------------------------------
>>
>>______________________________________________
>>R-devel@r-project.org mailing list
>>https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>>
>
>- --
>Duncan Temple Lang duncan@wald.ucdavis.edu
>Department of Statistics work: (530) 752-4782
>4210 Mathematical Sciences Building fax: (530) 752-7099
>One Shields Ave.
>University of California at Davis
>Davis,
>CA 95616,
>USA
>-----BEGIN PGP SIGNATURE-----
>Version: GnuPG v1.4.3 (Darwin)
>
>iD8DBQFFayrE9p/Jzwa2QP4RApdiAJ48r2dkA2p5I6V9Y3vZeh/mQhI+egCdGgZL
>98WT+K9jtfFEL/44P60Y7ro=
>=4qlw
>-----END PGP SIGNATURE-----
>
>

        [[alternative HTML version deleted]]



R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel Received on Tue Dec 19 18:23:52 2006

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.1.8, at Tue 19 Dec 2006 - 10:30:55 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-devel. Please read the posting guide before posting to the list.