view release on metacpan or  search on metacpan

hugs98-Nov2003/src/dotnet/HugsServ.cpp  view on Meta::CPAN

//
// Managed C++ wrapper class around the Hugs server API.
//
#using <mscorlib.dll>
extern "C" {
#include "prelude.h"
#include "storage.h"
#include "machdep.h"
#include "connect.h"
};
#include "prim.h"
#include "HugsServ.h"

#define ToCharString(str) \
  static_cast<char*>(System::Runtime::InteropServices::Marshal::StringToHGlobalAnsi(str).ToPointer())
#define FreeCharString(pstr) System::Runtime::InteropServices::Marshal::FreeHGlobal(pstr)

extern "C" {
extern char* lastError;
extern char* ClearError();
extern Void  setError  (char*);
extern Bool  safeEval  (Cell c);
extern Void  startEval (Void);
};

/* All server entry points set CStackBase for the benefit of the (conservative)
 * GC and do error catching.  Any calls to Hugs functions should be "protected"
 * by being placed inside this macro.
 *
 *   void entryPoint(arg1, arg2, result)
 *   T1 arg1;
 *   T2 arg2;
 *   T3 *result;
 *   {
 *       protect(doNothing(),
 *           ...
 *       );
 *   }
 *
 * Macro decomposed into BEGIN_PROTECT and END_PROTECT pieces so that i
 * can be used on some compilers (Mac?) that have limits on the size of
 * macro arguments.
 */
#define BEGIN_PROTECT \
  if (NULL == lastError) { \
      Cell dummy; \
      CStackBase = &dummy;              /* Save stack base for use in gc  */ \
      consGC = TRUE;                    /* conservative GC is the default */ \
      if (1) {
#define END_PROTECT \
      } else { \
	setError("Error occurred"); \
	normalTerminal(); \
      }	\
  }
#define protect(s)	BEGIN_PROTECT s; END_PROTECT

static Void    MkObject    Args((System::Object*));
static Object* EvalObject  Args((Void));
static Int     DoIO_Object Args((Object* __gc&));

/* Push an Object/DotNetPtr onto the stack */
static Void MkObject(Object* a) 
{
#ifndef NO_DYNAMIC_TYPES
    Cell d = getTypeableDict(type);
    if (isNull(d)) {
      setError("MkObject: can't create Typeable instance");
      return 0;
    }
    protect(push(ap(ap(nameToDynamic,d),mkDotNetPtr(a,freeNetPtr))));
#else
    protect(push(mkDotNetPtr(a,freeNetPtr)));
#endif
}

static Object* EvalObject()          /* Evaluate a cell (:: Object)    */
{
    Cell d;
    BEGIN_PROTECT
	startEval();
#ifndef NO_DYNAMIC_TYPES
	d = getTypeableDict(type);
	if (isNull(d)) {
	    setError("EvalObject: can't create Typeable instance");
	    return 0;
	}
	safeEval(ap(ap(nameToDynamic,d),pop()));
#else
	safeEval(pop());
#endif
	normalTerminal();
	return getNP(whnfHead);
    END_PROTECT
    return 0;
}

/* 
 * Evaluate a cell (:: IO DotNetPtr) return exit status
 */