binaries/src/ViennaRNA/interfaces/ptr2array.i

   1 //
   2 // SWIG pointer conversion and utility library
   3 //
   4 // Dave Beazley
   5 // April 19, 1997
   6 //
   7 // Perl5 specific implementation.   This file is included
   8 // by the file ../pointer.i
   9
  10 %{
  11
  12 #ifdef WIN32
  13 #undef isspace
  14 #define isspace(c) (c == ' ')
  15 #endif
  16
  17
  18
  19 /*------------------------------------------------------------------
  20   ptr2array(ptr,index,len,type = 0)
  21
  22   Attempts to dereference a pointer value, just like ptrvalue(), but
  23   returns a reference to a list containing len values.  If type is given,
  24   it will try to use that type.  Otherwise, this function will attempt to
  25   "guess" the proper datatype by checking against all of the builtin C
  26   datatypes.
  27   ------------------------------------------------------------------ */
  28
  29 #ifdef PERL_OBJECT
  30 static AV *_ptr2array(CPerlObj *pPerl,SV *_PTRVALUE, int index, int len, char *type) {
  31 #define ptr2array(a,b,c,d) _ptr2array(pPerl,a,b,c,d)
  32 #else
  33 static AV *_ptr2array(SV *_PTRVALUE, int index, int len, char *type) {
  34 #define ptr2array(a,b,c,d) _ptr2array(a,b,c,d)
  35 #endif
  36
  37   void     *ptr;
  38   SV *obj;
  39   SV      **svs = 0;
  40   AV        *av = 0;
  41
  42   int i;
  43
  44   svs = (SV **) malloc(len*sizeof(SV *));
  45   for (i=0; i<len; i++)
  46     svs[i] = sv_newmortal();
  47
  48   if (SWIG_ConvertPtr(_PTRVALUE,&ptr,0,0)) {
  49     croak("Type error in ptr2array. Argument is not a valid pointer value.");
  50   } else {
  51     /* If no datatype was passed, try a few common datatypes first */
  52     if (!type) {
  53
  54       /* No datatype was passed.   Type to figure out if it's a common one */
  55
  56       if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_int_p,0) >= 0) {
  57         type = "int";
  58       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_double_p,0) >= 0) {
  59         type = "double";
  60       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_short_p,0) >= 0) {
  61         type = "short";
  62       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_long_p,0) >= 0) {
  63         type = "long";
  64       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_float_p,0) >= 0) {
  65         type = "float";
  66       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_p,0) >= 0) {
  67         type = "char";
  68       } else if (SWIG_ConvertPtr(_PTRVALUE,&ptr,SWIG_POINTER_char_pp,0) >= 0) {
  69         type = "char *";
  70       } else {
  71         type = "unknown";
  72       }
  73     }
  74
  75     if (!ptr) {
  76       croak("Unable to dereference NULL pointer.");
  77       return 0;
  78     }
  79
  80     /* Now we have a datatype.  Try to figure out what to do about it */
  81     if (strcmp(type,"int") == 0) {
  82       for (i = 0; i < len; ++i)
  83         sv_setiv(svs[i], (IV) *(((int *) ptr) + index+i));
  84     } else if (strcmp(type,"double") == 0) {
  85       for (i = 0; i < len; ++i)
  86         sv_setnv(svs[i], (double) *(((double *) ptr) + index+i));
  87     } else if (strcmp(type,"short") == 0) {
  88       for (i = 0; i < len; ++i)
  89         sv_setiv(svs[i],(IV) *(((short *) ptr) + index+i));
  90     } else if (strcmp(type,"long") == 0) {
  91       for (i = 0; i < len; ++i)
  92         sv_setiv(svs[i],(IV) *(((long *) ptr) + index+i));
  93     } else if (strcmp(type,"float") == 0) {
  94       for (i = 0; i < len; ++i)
  95         sv_setnv(svs[i],(double) *(((float *) ptr)+index+i));
  96     } else if (strcmp(type,"char") == 0) {
  97       for (i = 0; i < len; ++i)
  98         sv_setpv(svs[i],((char *) ptr)+index+i);
  99     } else if (strcmp(type,"char *") == 0) {
 100       for (i = 0; i < len; ++i) {
 101         char *c = *(((char **) ptr)+index+i);
 102         if (c)
 103           sv_setpv(svs[i],c);
 104         else
 105           sv_setpv(svs[i],"NULL");
 106       }
 107     } else {
 108       croak("Unable to dereference unsupported datatype.");
 109       len = 0;
 110     }
 111   }
 112
 113   av = av_make(len,svs);
 114   free(svs);
 115   return av;
 116 }
 117
 118 %}
 119
 120 %typemap(perl5, out) AV *ptr2array
 121 {
 122   $result = newRV_noinc((SV*) $1);
 123   sv_2mortal($result);
 124   argvi++;
 125 }
 126
 127  AV *ptr2array(SV *ptr, int index = 0, int len = 1, char *type = 0);
 128