[Rd] R.DLL mapping by P/Invoke

From: <box_at_dupuislogiciels.com>
Date: Mon 27 Nov 2006 - 18:22:41 GMT


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 Received on Tue Nov 28 04:38:58 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 Mon 27 Nov 2006 - 19:31:41 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.