com-1.1: include/HDirect.h
/* --------------------------------------------------------------------------
* GreenCard / HaskellDirect include file.
*
* Hugs 98 is Copyright (c) Mark P Jones, Alastair Reid and the Yale
* Haskell Group 1994-99, and is distributed as Open Source software
* under the Artistic License; see the file "Artistic" that is included
* in the distribution for details.
*
* sof 4/99 - changed to make it useable with HaskellDirect.
*
* $RCSfile: HDirect.h,v $
* $Revision: 1.1 $
* $Date: 2007-08-16 22:01:07 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
*
* WARNING
*
* Most of the code in this file must exactly match corresponding definitions
* in the Hugs source code.
*
* We have chosen to copy this code over to avoid the need to #include huge
* chunks of the Hugs internal definitions (which sometimes conflict with
* Xlib, Win32 or other libraries which we might also have to #include).
*
*
* sof 4/99 - removed #include of config.h and options.h, since its only use
* appeared to be to pick up whether the host C compiler supported
* prototypes or not. Most do nowadays.
* ------------------------------------------------------------------------*/
#ifndef __HDIRECT_H__
#define __HDIRECT_H__
#if 1 /* PROTOTYPES */ /* To enable use of prototypes whenever possible */
#define Args(x) x
#else
#define Args(x) ()
#endif
typedef unsigned char hugs_uint8_t;
typedef unsigned short hugs_uint16_t;
typedef unsigned int hugs_uint32_t;
typedef signed char hugs_int8_t;
typedef signed short hugs_int16_t;
typedef signed int hugs_int32_t;
# ifdef _MSC_VER
typedef unsigned __int64 hugs_uint64_t;
typedef __int64 hugs_int64_t;
# else
typedef unsigned long long hugs_uint64_t;
typedef signed long long hugs_int64_t;
# endif
typedef int HsInt;
typedef hugs_int8_t HsInt8;
typedef hugs_int16_t HsInt16;
typedef hugs_int32_t HsInt32;
typedef unsigned int HsWord;
typedef hugs_uint8_t HsWord8;
typedef hugs_uint16_t HsWord16;
typedef hugs_uint32_t HsWord32;
/*
* Here we deviate from the FFI specification:
* If we make them both float, then there's no way to pass a double
* to C which means we can't call common C functions like sin.
*/
typedef float HsFloat;
typedef double HsDouble;
typedef hugs_int64_t HsInt64;
typedef hugs_uint64_t HsWord64;
typedef char HsChar;
typedef int HsBool;
typedef void* HsAddr;
typedef void* HsPtr;
typedef void (*HsFunPtr)(void);
typedef void* HsForeignPtr;
typedef void* HsStablePtr;
typedef int HugsStackPtr;
typedef int HugsStablePtr;
typedef void* HugsForeign;
#define primFun(name) static void name(HugsStackPtr hugs_root)
#define hugs_returnIO(n) hugs->returnIO(hugs_root,n)
#define hugs_returnId(n) hugs->returnId(hugs_root,n)
/* These declarations must exactly match those in storage.h */
typedef void (*Prim) Args((HugsStackPtr)); /* primitive function */
extern struct hugs_primitive { /* table of primitives */
char* ref; /* primitive reference string */
int arity; /* primitive function arity */
Prim imp; /* primitive implementation */
} primitives[];
struct hugs_primInfo {
void (*controlFun) Args((int));
struct hugs_primitive *primFuns;
struct hugs_primInfo *nextPrimInfo;
};
/* This is an exact copy of the declaration found in storage.h */
typedef struct {
/* evaluate next argument */
HsInt (*getInt) (void);
HsWord (*getWord) (void);
HsAddr (*getAddr) (void);
HsFloat (*getFloat) (void);
HsDouble (*getDouble) (void);
HsChar (*getChar) (void);
HugsForeign (*getForeign) (void);
HugsStablePtr (*getStablePtr) (void); /* deprecated */
/* push part of result */
void (*putInt) (HsInt);
void (*putWord) (HsWord);
void (*putAddr) (HsAddr);
void (*putFloat) (HsFloat);
void (*putDouble) (HsDouble);
void (*putChar) (HsChar);
void (*putForeign) (HugsForeign, void (*)(HugsForeign));
void (*putStablePtr) (HugsStablePtr); /* deprecated */
/* return n values in IO monad or Id monad */
void (*returnIO) (HugsStackPtr, int);
void (*returnId) (HugsStackPtr, int);
int (*runIO) (int);
/* free a stable pointer */
void (*freeStablePtr) (HugsStablePtr); /* deprecated */
/* register the prim table */
void (*registerPrims) (struct hugs_primInfo*);
/* garbage collect */
void (*garbageCollect) (void);
/* API3 additions follow */
HugsStablePtr (*lookupName) (char*, char*);
void (*ap) (int);
void (*getUnit) (void);
void* (*mkThunk) (HsFunPtr, HugsStablePtr);
void (*freeThunk) (void*);
HsBool (*getBool) (void);
void (*putBool) (HsBool);
/* API4 additions follow */
HsInt8 (*getInt8) (void);
HsInt16 (*getInt16) (void);
HsInt32 (*getInt32) (void);
HsInt64 (*getInt64) (void);
HsWord8 (*getWord8) (void);
HsWord16 (*getWord16) (void);
HsWord32 (*getWord32) (void);
HsWord64 (*getWord64) (void);
HsPtr (*getPtr) (void);
HsFunPtr (*getFunPtr) (void);
HsForeignPtr (*getForeignPtr) (void);
void (*putInt8) (HsInt8);
void (*putInt16) (HsInt16);
void (*putInt32) (HsInt32);
void (*putInt64) (HsInt64);
void (*putWord8) (HsWord8);
void (*putWord16) (HsWord16);
void (*putWord32) (HsWord32);
void (*putWord64) (HsWord64);
void (*putPtr) (HsPtr);
void (*putFunPtr) (HsFunPtr);
void (*putForeignPtr) (HsForeignPtr);
HugsStablePtr (*makeStablePtr4) (void);
void (*derefStablePtr4)(HugsStablePtr);
void (*putStablePtr4) (HsStablePtr);
HsStablePtr (*getStablePtr4) (void);
void (*freeStablePtr4) (HsStablePtr);
int (*runId) (int);
} HugsAPI4;
HugsAPI4 *hugs; /* pointer to virtual function table */
/*
copyBytes() is needed when dealing with
functions that return structs
Note: we're (intentionally!) relying on memcpy() to handle
malloc() failure for us.
*/
#define copyBytes(len,struct_ptr) \
memcpy((char*)malloc(len*sizeof(char)),(char*)(struct_ptr), len)
/* Copied verbatim from prelude.h */
#ifdef _MSC_VER /* Microsoft Visual C++ */
#define DLLIMPORT(rty) __declspec(dllimport) rty
#define DLLEXPORT(rty) __declspec(dllexport) rty
#elif defined __BORLANDC__
#define DLLIMPORT(rty) rty far _import
#define DLLEXPORT(rty) rty far _export
#else
#define DLLIMPORT(rty) rty
#define DLLEXPORT(rty) rty
#endif /* Don't need to declare DLL exports */
#endif /* __HDIRECT_H__ */