Initial revision

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@392 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Lib/mzscheme/Makefile

@@ -0,0 +1,4 @@
+
+co::
+	co RCS/*.i* RCS/*.swg*
+

Lib/mzscheme/mzscheme.swg

@@ -0,0 +1,289 @@
+#include "escheme.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef SWIG_GLOBAL
+#define SWIGSTATIC
+#endif
+
+#ifndef SWIGSTATIC
+#define SWIGSTATIC static
+#endif
+
+/* SWIG pointer structure */
+
+typedef struct SwigPtrType {
+  char               *name;               /* Datatype name                  */
+  int                 len;                /* Length (used for optimization) */
+  void               *(*cast)(void *);    /* Pointer casting function       */
+  struct SwigPtrType *next;               /* Linked list pointer            */
+} SwigPtrType;
+
+/* Pointer cache structure */
+
+typedef struct {
+  int                 stat;               /* Status (valid) bit             */
+  SwigPtrType        *tp;                 /* Pointer to type structure      */
+  char                name[256];          /* Given datatype name            */
+  char                mapped[256];        /* Equivalent name                */
+} SwigCacheType;
+
+/* Some variables  */
+
+static int SwigPtrMax  = 64;           /* Max entries that can be currently held */
+                                       /* This value may be adjusted dynamically */
+static int SwigPtrN    = 0;            /* Current number of entries              */
+static int SwigPtrSort = 0;            /* Status flag indicating sort            */
+static int SwigStart[256];             /* Starting positions of types            */
+
+/* Pointer table */
+static SwigPtrType *SwigPtrTable = 0;  /* Table containing pointer equivalences  */
+
+/* Cached values */
+
+#define SWIG_CACHESIZE  8
+#define SWIG_CACHEMASK  0x7
+static SwigCacheType SwigCache[SWIG_CACHESIZE];
+static int SwigCacheIndex = 0;
+static int SwigLastCache = 0;
+
+/* Sort comparison function */
+static int swigsort(const void *data1, const void *data2) {
+	SwigPtrType *d1 = (SwigPtrType *) data1;
+	SwigPtrType *d2 = (SwigPtrType *) data2;
+	return strcmp(d1->name,d2->name);
+}
+
+/* Binary Search function */
+static int swigcmp(const void *key, const void *data) {
+  char *k = (char *) key;
+  SwigPtrType *d = (SwigPtrType *) data;
+  return strncmp(k,d->name,d->len);
+}
+
+/* Register a new datatype with the type-checker */
+
+SWIGSTATIC
+void SWIG_RegisterMapping(char *origtype, char *newtype, void *(*cast)(void *)) {
+
+  int i;
+  SwigPtrType *t = 0,*t1;
+
+  /* Allocate the pointer table if necessary */
+
+  if (!SwigPtrTable) {
+    SwigPtrTable = (SwigPtrType *) malloc(SwigPtrMax*sizeof(SwigPtrType));
+    SwigPtrN = 0;
+  }
+  /* Grow the table */
+  if (SwigPtrN >= SwigPtrMax) {
+    SwigPtrMax = 2*SwigPtrMax;
+    SwigPtrTable = (SwigPtrType *) realloc((char *) SwigPtrTable,SwigPtrMax*sizeof(SwigPtrType));
+  }
+  for (i = 0; i < SwigPtrN; i++)
+    if (strcmp(SwigPtrTable[i].name,origtype) == 0) {
+      t = &SwigPtrTable[i];
+      break;
+    }
+  if (!t) {
+    t = &SwigPtrTable[SwigPtrN];
+    t->name = origtype;
+    t->len = strlen(t->name);
+    t->cast = 0;
+    t->next = 0;
+    SwigPtrN++;
+  }
+
+  /* Check for existing entry */
+
+  while (t->next) {
+    if ((strcmp(t->name,newtype) == 0)) {
+      if (cast) t->cast = cast;
+      return;
+    }
+    t = t->next;
+  }
+
+  /* Now place entry (in sorted order) */
+
+  t1 = (SwigPtrType *) malloc(sizeof(SwigPtrType));
+  t1->name = newtype;
+  t1->len = strlen(t1->name);
+  t1->cast = cast;
+  t1->next = 0;
+  t->next = t1;
+  SwigPtrSort = 0;
+}
+
+/* Make a pointer value string */
+
+SWIGSTATIC
+void SWIG_MakePtr(char *_c, const void *_ptr, char *type) {
+  static char _hex[16] =
+  {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
+   'a', 'b', 'c', 'd', 'e', 'f'};
+  unsigned long _p, _s;
+  char _result[20], *_r;    /* Note : a 64-bit hex number = 16 digits */
+  _r = _result;
+  _p = (unsigned long) _ptr;
+  if (_p > 0) {
+    while (_p > 0) {
+      _s = _p & 0xf;
+      *(_r++) = _hex[_s];
+      _p = _p >> 4;
+    }
+    *_r = '_';
+    while (_r >= _result)
+      *(_c++) = *(_r--);
+  } else {
+    strcpy (_c, "NULL");
+  }
+  if (_ptr)
+    strcpy (_c, type);
+}
+
+/* Define for backwards compatibility */
+
+#define _swig_make_hex   SWIG_MakePtr
+
+/* Function for getting a pointer value */
+
+SWIGSTATIC
+char *SWIG_GetPtr(char *_c, void **ptr, char *_t)
+{
+  unsigned long _p;
+  char temp_type[256];
+  char *name;
+  int  i, len;
+  SwigPtrType *sp,*tp;
+  SwigCacheType *cache;
+  int  start, end;
+  _p = 0;
+
+  /* Pointer values must start with leading underscore */
+  if (*_c == '_') {
+      _c++;
+      /* Extract hex value from pointer */
+      while (*_c) {
+	  if ((*_c >= '0') && (*_c <= '9'))
+	    _p = (_p << 4) + (*_c - '0');
+	  else if ((*_c >= 'a') && (*_c <= 'f'))
+	    _p = (_p << 4) + ((*_c - 'a') + 10);
+	  else
+	    break;
+	  _c++;
+      }
+
+      if (_t) {
+	if (strcmp(_t,_c)) {
+	  if (!SwigPtrSort) {
+	    qsort((void *) SwigPtrTable, SwigPtrN, sizeof(SwigPtrType), swigsort);
+	    for (i = 0; i < 256; i++) {
+	      SwigStart[i] = SwigPtrN;
+	    }
+	    for (i = SwigPtrN-1; i >= 0; i--) {
+	      SwigStart[(int) (SwigPtrTable[i].name[1])] = i;
+	    }
+	    for (i = 255; i >= 1; i--) {
+	      if (SwigStart[i-1] > SwigStart[i])
+		SwigStart[i-1] = SwigStart[i];
+	    }
+	    SwigPtrSort = 1;
+	    for (i = 0; i < SWIG_CACHESIZE; i++)
+	      SwigCache[i].stat = 0;
+	  }
+
+	  /* First check cache for matches.  Uses last cache value as starting point */
+	  cache = &SwigCache[SwigLastCache];
+	  for (i = 0; i < SWIG_CACHESIZE; i++) {
+	    if (cache->stat) {
+	      if (strcmp(_t,cache->name) == 0) {
+		if (strcmp(_c,cache->mapped) == 0) {
+		  cache->stat++;
+		  *ptr = (void *) _p;
+		  if (cache->tp->cast) *ptr = (*(cache->tp->cast))(*ptr);
+		  return (char *) 0;
+		}
+	      }
+	    }
+	    SwigLastCache = (SwigLastCache+1) & SWIG_CACHEMASK;
+	    if (!SwigLastCache) cache = SwigCache;
+	    else cache++;
+	  }
+	  /* We have a type mismatch.  Will have to look through our type
+	     mapping table to figure out whether or not we can accept this datatype */
+
+	  start = SwigStart[(int) _t[1]];
+	  end = SwigStart[(int) _t[1]+1];
+	  sp = &SwigPtrTable[start];
+	  while (start < end) {
+	    if (swigcmp(_t,sp) == 0) break;
+	    sp++;
+	    start++;
+	  }
+	  if (start > end) sp = 0;
+	  /* Try to find a match for this */
+	  while (start <= end) {
+	    if (swigcmp(_t,sp) == 0) {
+	      name = sp->name;
+	      len = sp->len;
+	      tp = sp->next;
+	      /* Try to find entry for our given datatype */
+	      while(tp) {
+		if (tp->len >= 255) {
+		  return _c;
+		}
+		strcpy(temp_type,tp->name);
+		strncat(temp_type,_t+len,255-tp->len);
+		if (strcmp(_c,temp_type) == 0) {
+
+		  strcpy(SwigCache[SwigCacheIndex].mapped,_c);
+		  strcpy(SwigCache[SwigCacheIndex].name,_t);
+		  SwigCache[SwigCacheIndex].stat = 1;
+		  SwigCache[SwigCacheIndex].tp = tp;
+		  SwigCacheIndex = SwigCacheIndex & SWIG_CACHEMASK;
+
+		  /* Get pointer value */
+		  *ptr = (void *) _p;
+		  if (tp->cast) *ptr = (*(tp->cast))(*ptr);
+		  return (char *) 0;
+		}
+		tp = tp->next;
+	      }
+	    }
+	    sp++;
+	    start++;
+	  }
+	  /* Didn't find any sort of match for this data.
+	     Get the pointer value and return the received type */
+	  *ptr = (void *) _p;
+	  return _c;
+	} else {
+	  /* Found a match on the first try.  Return pointer value */
+	  *ptr = (void *) _p;
+	  return (char *) 0;
+	}
+      } else {
+	/* No type specified.  Good luck */
+	*ptr = (void *) _p;
+	return (char *) 0;
+      }
+  } else {
+    if (strcmp (_c, "NULL") == 0) {
+	*ptr = (void *) 0;
+	return (char *) 0;
+    }
+    *ptr = (void *) 0;
+    return _c;
+  }
+}
+
+/* Compatibility mode */
+
+#define _swig_get_hex  SWIG_GetPtr
+
+#ifdef __cplusplus
+}
+#endif

Lib/mzscheme/typemaps.i

@@ -0,0 +1,673 @@
+/*
+ --------------------------------------------------
+ argout typemaps
+ convert arguments from C to Scheme
+ --------------------------------------------------
+ */
+
+%{
+#define MAXVALUES 6
+%}
+
+%typemap(mzscheme, argout)
+    int *M_OUTPUT,
+    unsigned int *M_OUTPUT,
+    short *M_OUTPUT,
+    unsigned short *M_OUTPUT
+{
+    Scheme_Object *s;
+    s = scheme_make_integer(*$target);
+    m_output_helper(_values, s, &_lenv);
+}
+
+%typemap(mzscheme, argout)
+    long *M_OUTPUT
+{
+    Scheme_Object *s;
+    s = scheme_make_integer_value(*$target);
+    m_output_helper(_values, s, &_lenv);
+}
+
+
+%typemap(mzscheme, argout)
+    unsigned long *M_OUTPUT
+{
+    Scheme_Object *s;
+    s = scheme_make_integer_value_from_unsigned(*$target);
+    m_output_helper(_values, s, &_lenv);
+}
+
+
+%typemap(mzscheme, argout)
+    char *M_OUTPUT,
+    unsigned char *M_OUTPUT
+{
+    Scheme_Object *s;
+    s = scheme_make_string(*$target);
+    m_output_helper(_values, s, &_lenv);
+}
+
+%typemap(mzscheme, argout)
+float *M_OUTPUT,
+double *M_OUTPUT
+{
+    Scheme_Object *s;
+    s = scheme_make_double(*$target);
+    m_output_helper(_values, s, &_lenv);
+}
+
+%{
+void m_output_helper(Scheme_Object **target, Scheme_Object *s, int *_lenv) {
+    target[*_lenv] = s;
+    (*_lenv)++;
+}
+%}
+
+/*
+ -------------------------------------------------
+ Check the type of the MzScheme arguments and
+ convert function arguments from a MzScheme to a C
+ representation.
+ -------------------------------------------------
+ */
+
+%typemap(mzscheme, in) char {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    $target = SCHEME_CHAR_VAL($source);
+}
+
+%typemap(mzscheme, in) unsigned char {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    $target = SCHEME_CHAR_VAL($source);
+}
+
+%typemap(mzscheme, in) char * {
+    if(!SCHEME_STRINGP($source))
+	scheme_wrong_type("$name", "string ", $argnum, argc, argv);
+    $target = SCHEME_STR_VAL($source);
+}
+
+%typemap(mzscheme, in) char [ANY] {
+    if(!SCHEME_STRINGP($source))
+	scheme_wrong_type("$name", "string ", $argnum, argc, argv);
+    $target = SCHEME_STR_VAL($source);
+}
+
+%typemap(mzscheme, in) int {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, in) long {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &$target);
+}
+
+%typemap(mzscheme, in) short {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, in) unsigned int {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, in) unsigned long {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_unsigned_int_val($source, &$target);
+}
+
+%typemap(mzscheme, in) unsigned short {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+/*
+%typemap(mzscheme, in) long long {
+    if(!SCHEME_INTP($source))
+    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &$target);
+}
+*/
+%typemap(mzscheme, in) float {
+    if(!SCHEME_DBLP($source))
+	scheme_wrong_type("$name", "double", $argnum, argc, argv);
+    $target = SCHEME_DBL_VAL($source);
+}
+
+%typemap(mzscheme, in) double {
+    if(SCHEME_DBLP($source))
+	$target = SCHEME_DBL_VAL($source);
+    else if(SCHEME_REALP($source))
+	$target = scheme_real_to_double($source);
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+/*
+%typemap(mzscheme, in) long double {
+    if(SCHEME_DBLP($source))
+	$target = SCHEME_DBL_VAL($source);
+    else if(SCHEME_REALP($source))
+	$target = scheme_real_to_double($source);
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+*/
+
+/*
+ ------------------------------------
+ in typemaps for pass-by-reference
+ ------------------------------------
+ */
+
+%typemap(mzscheme, in) unsigned char *(unsigned char temp) {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    temp = SCHEME_STR_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, in) int *(int temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (int)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, in) long *(long temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &temp);
+    $target = &temp;
+
+}
+
+%typemap(mzscheme, in) short *(short temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (short)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, in) unsigned int *(unsigned temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (unsigned)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, in) unsigned long *(unsigned long temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_unsigned_int_val($source, &temp);
+    $target = &temp;
+}
+
+%typemap(mzscheme, in) unsigned short *(unsigned short temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (unsigned short)SCHEME_INT_VAL($source);
+    $target = &temp;
+
+}
+/*
+%typemap(mzscheme, in) long long *(long long temp) {
+    if(!SCHEME_INTP($source))
+    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &temp);
+    $target = &temp;
+}
+*/
+%typemap(mzscheme, in) float *(float temp) {
+    if(!SCHEME_DBLP($source))
+	scheme_wrong_type("$name", "double", $argnum, argc, argv);
+    temp = (float)SCHEME_DBL_VAL($source);
+    $target = &temp;
+
+}
+
+%typemap(mzscheme, in) double *(double temp) {
+    if(SCHEME_DBLP($source)) {
+	temp = (double)SCHEME_DBL_VAL($source);
+	$target = &temp;
+    }
+    else if(SCHEME_REALP($source)) {
+	temp = (double)scheme_real_to_double($source);
+	$target = &temp;
+    }
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+/*
+%typemap(mzscheme, in) long double *(long double temp) {
+    if(SCHEME_DBLP($source)) {
+	temp = (long double)SCHEME_DBL_VAL($source);
+	$target = &temp;
+    }
+    else if(SCHEME_REALP($source)) {
+	temp = (long double)scheme_real_to_double($source);
+	$target = &temp;
+    }
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+*/
+
+/*
+ ------------------------------------
+ convert return type from C to Scheme
+ ------------------------------------
+ */
+
+%typemap(mzscheme, out) char {
+    $target = scheme_make_character($source);
+}
+
+%typemap(mzscheme, out) unsigned char {
+    $target = scheme_make_character($source);
+}
+
+%typemap(mzscheme, out) char * {
+    $target = scheme_make_string($source);
+}
+
+%typemap(mzscheme, out) char [ANY] {
+    $target = scheme_make_string($source);
+}
+
+%typemap(mzscheme, out) int {
+    $target = scheme_make_integer_value($source);
+}
+
+%typemap(mzscheme, out) long {
+    $target = scheme_make_integer_value($source);
+}
+
+%typemap(mzscheme, out) short {
+    $target = scheme_make_integer_value($source);
+}
+/*
+%typemap(mzscheme, out) long long {
+    $target = scheme_make_integer_value($source);
+}
+*/
+%typemap(mzscheme, out) unsigned int {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, out) unsigned long {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, out) unsigned short {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, out) float {
+    $target = scheme_make_double($source);
+}
+
+%typemap(mzscheme, out) double {
+    $target = scheme_make_double($source);
+}
+/*
+%typemap(mzscheme, out) long double {
+    $target = scheme_make_double($source);
+}
+*/
+
+/*
+ -----------------------------------
+ convert pointers from C to MzScheme
+ -----------------------------------
+ */
+
+%typemap(mzscheme, out) int * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+%typemap(mzscheme, out) long * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+%typemap(mzscheme, out) short * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+/*
+%typemap(mzscheme, out) long long * {
+    $target = scheme_make_integer_value(*$source);
+}
+*/
+%typemap(mzscheme, out) unsigned int * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, out) unsigned long * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, out) unsigned short * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, out) float * {
+    $target = scheme_make_double(*$source);
+}
+
+%typemap(mzscheme, out) double * {
+    $target = scheme_make_double(*$source);
+}
+/*
+%typemap(mzscheme, out) long double * {
+    $target = scheme_make_double(*$source);
+}
+*/
+
+/*
+ ------------------------------------------------------------
+ Typemaps for accessing a global C variable from MzScheme
+ ------------------------------------------------------------
+ */
+
+%typemap(mzscheme, varin) char {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    $target = SCHEME_CHAR_VAL($source);
+}
+
+%typemap(mzscheme, varin) unsigned char {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    $target = SCHEME_CHAR_VAL($source);
+}
+
+%typemap(mzscheme, varin) char * {
+    if(!SCHEME_STRINGP($source))
+	scheme_wrong_type("$name", "string ", $argnum, argc, argv);
+    $target = SCHEME_STR_VAL($source);
+}
+
+%typemap(mzscheme, varin) char [ANY] {
+    if(!SCHEME_STRINGP($source))
+	scheme_wrong_type("$name", "string ", $argnum, argc, argv);
+    $target = SCHEME_STR_VAL($source);
+}
+
+%typemap(mzscheme, varin) int {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, varin) long {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &$target);
+}
+
+%typemap(mzscheme, varin) short {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, varin) unsigned int {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+
+%typemap(mzscheme, varin) unsigned long {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_unsigned_int_val($source, &$target);
+}
+
+%typemap(mzscheme, varin) unsigned short {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    $target = SCHEME_INT_VAL($source);
+}
+/*
+%typemap(mzscheme, varin) long long {
+    if(!SCHEME_INTP($source))
+    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &$target);
+}
+*/
+%typemap(mzscheme, varin) float {
+    if(!SCHEME_DBLP($source))
+	scheme_wrong_type("$name", "double", $argnum, argc, argv);
+    $target = SCHEME_DBL_VAL($source);
+}
+
+%typemap(mzscheme, varin) double {
+    if(SCHEME_DBLP($source))
+	$target = SCHEME_DBL_VAL($source);
+    else if(SCHEME_REALP($source))
+	$target = scheme_real_to_double($source);
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+/*
+%typemap(mzscheme, varin) long double {
+    if(SCHEME_DBLP($source))
+	$target = SCHEME_DBL_VAL($source);
+    else if(SCHEME_REALP($source))
+	$target = scheme_real_to_double($source);
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+*/
+
+/*
+ ------------------------------------
+ global pointer variable
+ ------------------------------------
+ */
+
+%typemap(mzscheme, varin) unsigned char *(unsigned char temp) {
+    if(!SCHEME_CHARP($source))
+	scheme_wrong_type("$name", "character", $argnum, argc, argv);
+    temp = SCHEME_STR_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, varin) int *(int temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (int)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, varin) long *(long temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &temp);
+    $target = &temp;
+
+}
+
+%typemap(mzscheme, varin) short *(short temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (short)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, varin) unsigned int *(unsigned temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (unsigned)SCHEME_INT_VAL($source);
+    $target = &temp;
+}
+
+%typemap(mzscheme, varin) unsigned long *(unsigned long temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_unsigned_int_val($source, &temp);
+    $target = &temp;
+}
+
+%typemap(mzscheme, varin) unsigned short *(unsigned short temp) {
+    if(!SCHEME_INTP($source))
+	scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    temp = (unsigned short)SCHEME_INT_VAL($source);
+    $target = &temp;
+
+}
+/*
+%typemap(mzscheme, varin) long long *(long long temp) {
+    if(!SCHEME_INTP($source))
+    scheme_wrong_type("$name", "integer", $argnum, argc, argv);
+    scheme_get_int_val($source, &temp);
+    $target = &temp;
+}
+*/
+%typemap(mzscheme, varin) float *(float temp) {
+    if(!SCHEME_DBLP($source))
+	scheme_wrong_type("$name", "double", $argnum, argc, argv);
+    temp = (float)SCHEME_DBL_VAL($source);
+    $target = &temp;
+
+}
+
+%typemap(mzscheme, varin) double *(double temp) {
+    if(SCHEME_DBLP($source)) {
+	temp = (double)SCHEME_DBL_VAL($source);
+	$target = &temp;
+    }
+    else if(SCHEME_REALP($source)) {
+	temp = (double)scheme_real_to_double($source);
+	$target = &temp;
+    }
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+/*
+%typemap(mzscheme, varin) long double *(long double temp) {
+    if(SCHEME_DBLP($source)) {
+	temp = (long double)SCHEME_DBL_VAL($source);
+	$target = &temp;
+    }
+    else if(SCHEME_REALP($source)) {
+	temp = (long double)scheme_real_to_double($source);
+	$target = &temp;
+    }
+    else scheme_wrong_type("$name", "real", $argnum, argc, argv);
+}
+*/
+
+
+/*
+ -----------------------------------
+ convert a variable from C to Scheme
+ -----------------------------------
+ */
+
+%typemap(mzscheme, varout) char {
+    $target = scheme_make_character($source);
+}
+
+%typemap(mzscheme, varout) unsigned char {
+    $target = scheme_make_character($source);
+}
+
+%typemap(mzscheme, varout) char * {
+    $target = scheme_make_string($source);
+}
+
+%typemap(mzscheme, varout) char [ANY] {
+    $target = scheme_make_string($source);
+}
+
+%typemap(mzscheme, varout) int {
+    $target = scheme_make_integer_value($source);
+}
+
+%typemap(mzscheme, varout) long {
+    $target = scheme_make_integer_value($source);
+}
+
+%typemap(mzscheme, varout) short {
+    $target = scheme_make_integer_value($source);
+}
+/*
+%typemap(mzscheme, varout) long long {
+    $target = scheme_make_integer_value($source);
+}
+*/
+%typemap(mzscheme, varout) unsigned int {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, varout) unsigned long {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, varout) unsigned short {
+    $target = scheme_make_integer_value_from_unsigned($source);
+}
+
+%typemap(mzscheme, varout) float {
+    $target = scheme_make_double($source);
+}
+
+%typemap(mzscheme, varout) double {
+    $target = scheme_make_double($source);
+}
+/*
+%typemap(mzscheme, varout) long double {
+    $target = scheme_make_double($source);
+}
+*/
+
+/*
+ -----------------------------------
+ convert a pointer variable from C to MzScheme
+ -----------------------------------
+ */
+
+%typemap(mzscheme, varout) int * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+%typemap(mzscheme, varout) long * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+%typemap(mzscheme, varout) short * {
+    $target = scheme_make_integer_value(*$source);
+}
+
+/*
+%typemap(mzscheme, varout) long long * {
+    $target = scheme_make_integer_value(*$source);
+}
+*/
+%typemap(mzscheme, varout) unsigned int * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, varout) unsigned long * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, varout) unsigned short * {
+    $target = scheme_make_integer_value_from_unsigned(*$source);
+}
+
+%typemap(mzscheme, varout) float * {
+    $target = scheme_make_double(*$source);
+}
+
+%typemap(mzscheme, varout) double * {
+    $target = scheme_make_double(*$source);
+}
+/*
+%typemap(mzscheme, varout) long double * {
+    $target = scheme_make_double(*$source);
+}
+*/