ruby-dcl 1.6.2

data/dcl_obj2cary.c

@@ -0,0 +1,512 @@
+/*
+ * dcl_obj2cary.c
+ *   $Id: dcl_obj2cary.c,v 1.1.1.1 2011-02-23 07:21:26 horinout Exp $
+ */
+
+#include <math.h>
+#include "ruby.h"
+#include "libtinyf2c.h"
+#include "narray.h"
+
+/* for compatibility with ruby 1.6 */
+#ifndef RFLOAT_VALUE
+#define RFLOAT_VALUE(x) ((real)(RFLOAT(x)->value))
+#endif
+#ifndef RARRAY_PTR
+#define RARRAY_PTR(a) (RARRAY(a)->ptr)
+#endif
+#ifndef RARRAY_LEN
+#define RARRAY_LEN(a) (RARRAY(a)->len)
+#endif
+#ifndef StringValuePtr
+#define StringValuePtr(s) STR2CSTR(s)
+#endif
+
+extern VALUE mDCL;
+
+/*  functions  */
+char    *obj2ccharary(VALUE, int, int);
+integer *obj2cintegerary(VALUE);
+real    *obj2crealary(VALUE);
+complex *obj2ccomplexary(VALUE);
+logical *obj2clogicalary(VALUE);
+
+void dcl_freeccharary(char *);
+void dcl_freecintegerary(integer *);
+void dcl_freecrealary(real *);
+void dcl_freeccomplexary(complex *);
+void dcl_freeclogicalary(logical *);
+
+static char    *ary2ccharary(VALUE, int, int);
+static integer *ary2cintegerary(VALUE);
+static real    *ary2crealary(VALUE);
+static logical *ary2clogicalary(VALUE);
+/* not implemented
+static complex *ary2ccomplexary(VALUE);
+*/
+
+static real    *na2crealary(VALUE);
+static logical *na2clogicalary(VALUE);
+static integer *na2cintegerary(VALUE);
+/* not implemented
+static complex *na2ccomplexary(VALUE);
+*/
+
+/*  defines  */
+#define BE_INTEGER(x) ((integer)(NUM2INT(rb_Integer(x))))
+#define BE_REAL(x)    ((real)(RFLOAT_VALUE(rb_Float(x))))
+#define BE_LOGICAL(x) (((x == Qnil) || (x == Qfalse)) ? FALSE_ : TRUE_ )
+/* not implemented 
+#define BE_COMPLEX(x) ...
+*/
+
+
+/*
+ * dcl_obj2cxxxary() : convert ruby object to c xxx type array
+ *   dcl_obj2ccharary()
+ *   dcl_obj2cintegerary()
+ *   dcl_obj2crealary()
+ *   dcl_obj2ccomplexary() : not implemented
+ *   dcl_obj2clogicalary()
+ */
+char *
+dcl_obj2ccharary(src, size, len)
+    VALUE src;
+    int size;
+    int len;
+{
+    VALUE chk;
+    char *rtn;
+
+    switch (TYPE(src)){
+    case T_ARRAY:
+        rtn = ary2ccharary(src, size, len);
+        break;
+    default:
+        rb_raise(rb_eTypeError, "expect integer array");
+        break;
+    }
+    return rtn;
+}
+
+integer *
+dcl_obj2cintegerary(src)
+    VALUE src;
+{
+    VALUE chk;
+    integer *rtn;
+
+    switch (TYPE(src)){
+    case T_DATA:
+        chk = rb_obj_is_kind_of(src, cNArray);
+        if (chk == Qfalse) {
+            rb_raise(rb_eTypeError, "expect integer array");
+        }
+        rtn = na2cintegerary(src);
+        break;
+    case T_ARRAY:
+        rtn = ary2cintegerary(src);
+        break;
+    default:
+        rb_raise(rb_eTypeError, "expect integer array");
+        break;
+    }
+
+    return rtn;
+}
+
+real *
+dcl_obj2crealary(src)
+    VALUE src;
+{
+    VALUE chk;
+    real *rtn;
+    char *klass;
+    VALUE klass_tmp;
+    VALUE rmiss;
+
+    switch (TYPE(src)){
+    case T_OBJECT:
+	klass_tmp = rb_funcall(rb_funcall(src, rb_intern("class"),0),
+				     rb_intern("to_s"),0);
+	klass = StringValuePtr(klass_tmp);
+	if (strncmp(klass,"NArrayMiss",10) != 0) {
+	    rb_raise(rb_eTypeError, "a numeric array expected");
+	}
+	rmiss = rb_funcall(mDCL,rb_intern("glrget"),1,rb_str_new2("rmiss"));
+	src = rb_funcall( src, rb_intern("to_na"), 1, rmiss );
+    case T_DATA:
+        chk = rb_obj_is_kind_of(src, cNArray);
+        rtn = na2crealary(src);
+        break;
+    case T_ARRAY:
+        rtn = ary2crealary(src);
+        break;
+    default:
+        rb_raise(rb_eTypeError, "expect real array");
+        break;
+    }
+
+    return rtn;
+}
+
+/* not implemented
+complex *
+dcl_obj2ccomplexary(src)
+    VALUE src;
+{
+    VALUE chk;
+    complex *rtn;
+
+    switch (TYPE(src)){
+    case T_DATA:
+        chk = rb_obj_is_kind_of(src, cNArray);
+        if (chk == Qfalse) {
+            rb_raise(rb_eTypeError, "expect complex array");
+        }
+        rtn = na2ccomplexary(src);
+        break;
+    case T_ARRAY:
+        rtn = ary2ccomplexary(src);
+        break;
+    default:
+        rb_raise(rb_eTypeError, "expect complex array");
+        break;
+    }
+    
+    return rtn;
+}
+*/
+
+logical *
+dcl_obj2clogicalary(src)
+    VALUE src;
+{
+    VALUE chk;
+    logical *rtn;
+
+    switch (TYPE(src)){
+    case T_DATA:
+	chk = rb_obj_is_kind_of(src, cNArray);
+        if (chk == Qfalse) {
+            rb_raise(rb_eTypeError, "expect logical array");
+        }
+        rtn = na2clogicalary(src);
+        break;
+    case T_ARRAY:
+        rtn = ary2clogicalary(src);
+        break;
+    default:
+        rb_raise(rb_eTypeError, "expect logical array");
+        break;
+    }
+
+    return rtn;
+}
+
+/*
+ * dcl_freecxxxary() : free c xxx type array
+ *                     allocated by ary2cxxxary() or na2cxxxary()
+ *   dcl_freeccharary()
+ *   dcl_freecintegerary()
+ *   dcl_freecrealary()
+ *   dcl_freeccomplexary() : not implemented
+ *   dcl_freeclogicalary()
+ */
+void
+dcl_freeccharary(cary)
+    char *cary;
+{
+    if ( cary != NULL ) {
+	free(cary);
+    }
+    return;
+}
+
+void
+dcl_freecintegerary(cary)
+    integer *cary;
+{
+    if ( cary != NULL ) {
+	free(cary);
+    }
+    return;
+}
+
+void
+dcl_freecrealary(cary)
+    real *cary;
+{
+    if ( cary != NULL ) {
+	free(cary);
+    }
+    return;
+}
+
+/* not implemented
+void
+dcl_freeccomplexary(cary)
+    complex *cary;
+{
+    if ( cary != NULL ) {
+	free(cary);
+    }
+    return;
+}
+*/
+
+void
+dcl_freeclogicalary(cary)
+    logical *cary;
+{
+    if ( cary != NULL ) {
+	free(cary);
+    }
+    return;
+}
+
+
+/*
+ *  ary2cxxxary() : convert Array object to c xxx type array
+ *                  called by obj2cxxxary()
+ *   ary2ccharary()
+ *   ary2cintegerary()
+ *   ary2crealary()
+ *   ary2ccomplexary() : not implemented
+ *   ary2clogicalary()
+ */
+static char *
+ary2ccharary(src, size, charlen)
+    VALUE src;
+    int size;
+    int charlen;
+{
+    VALUE *ptr;
+    long len, i, j;
+#ifdef StringValue
+    // Ruby version 1.8 or later
+    long rlen;
+#else
+    // Ruby version 1.7 or before
+    int rlen;
+#endif
+    char *rtn, *wk, *rwk;
+
+    Check_Type(src, T_ARRAY);
+
+    len = RARRAY_LEN(src);
+    ptr = RARRAY_PTR(src);
+
+    rtn = ALLOC_N(char, size);
+    memset(rtn, '\0', size);
+    wk = rtn;
+    for (i = 0; i < len; i++) {
+#ifdef StringValue
+        // Ruby version 1.8 or later
+        StringValue(ptr[i]);
+        rwk = RSTRING_PTR(ptr[i]);
+        rlen = RSTRING_LEN(ptr[i]);
+#else
+        // Ruby version 1.7 or before
+        rwk = rb_str2cstr(ptr[i], &rlen);
+#endif
+        j = rlen;
+        strncpy(wk, rwk, charlen);
+        while (j < charlen) {
+            wk[j++] = ' ';
+        }
+        wk += charlen;
+    }
+    return rtn;
+}
+
+static integer *
+ary2cintegerary(src)
+    VALUE src;
+{
+    VALUE *ptr;
+    int len, i;
+    integer *rtn;
+
+    Check_Type(src, T_ARRAY);
+
+    len = RARRAY_LEN(src);
+    ptr = RARRAY_PTR(src);
+
+    rtn = ALLOC_N(integer, len);
+
+    for (i = 0; i < len; i++) {
+        rtn[i] = BE_INTEGER(ptr[i]);
+    }
+
+    return rtn;
+}
+
+static real *
+ary2crealary(src)
+    VALUE src;
+{
+    VALUE *ptr;
+    int len, i;
+    real *rtn;
+
+    Check_Type(src, T_ARRAY);
+
+    len = RARRAY_LEN(src);
+    ptr = RARRAY_PTR(src);
+
+    rtn = ALLOC_N(real, len);
+
+    for (i = 0; i < len; i++) {
+	rtn[i] = BE_REAL(ptr[i]);
+    }
+
+    return rtn;
+}
+
+/* not implemented
+static complex *
+ary2ccomplexary(src)
+     VALUE src;
+{
+    VALUE *ptr;
+    int len, i;
+    complex *rtn;
+
+    Check_Type(src, T_ARRAY);
+
+    len = RARRAY_LEN(src);
+    ptr = RARRAY_PTR(src);
+
+    rtn = ALLOC_N(complex, len);
+
+    for (i = 0; i < len; i++) {
+      rtn[i] = BE_COMPLEX(src...);
+    }
+
+    return rtn;
+}
+*/
+
+static logical *
+ary2clogicalary(src)
+    VALUE src;
+{
+    VALUE *ptr;
+    int len, i;
+    logical *rtn;
+
+    Check_Type(src, T_ARRAY);
+
+    len = RARRAY_LEN(src);
+    ptr = RARRAY_PTR(src);
+
+    rtn = ALLOC_N(logical, len);
+
+    for (i = 0; i < len; i++) {
+        rtn[i] = BE_LOGICAL(ptr[i]);
+    }
+
+    return rtn;
+}
+
+
+#define NA2PTR(obj) ((NA*)DATA_PTR(obj))->bna->ptr
+#define NA2LEN(obj) ((NA*)DATA_PTR(obj))->bna->len
+
+/*
+ *  na2cxxxary() : convert NArray object to c xxx type array
+ *                 called by obj2cxxxary()
+ *   na2cintegerary() : not implemented
+ *   na2crealary()
+ *   na2ccomplexary() : not implemented
+ *   na2clogicalary()
+ */
+static real *
+na2crealary(src)
+    VALUE src;
+{
+    VALUE chk;
+    int len, i;
+    real *rtn;
+    float *ptr;
+    struct NARRAY *na;
+
+    chk = rb_obj_is_kind_of(src, cNArray);
+    if (chk == Qfalse) {
+        rb_raise(rb_eTypeError, "expect NArray");
+    }
+
+    src = na_cast_object(src, NA_SFLOAT);
+    GetNArray(src, na);
+    len = na->total;
+    ptr = (float *)NA_PTR(na, 0);
+
+    rtn = ALLOC_N(real, len);
+
+    for (i = 0; i < len; i++) {
+	rtn[i] = (real)ptr[i];
+    }
+    
+    return rtn;
+}
+static integer *
+na2cintegerary(src)
+    VALUE src;
+{
+    VALUE chk;
+    int len, i;
+    integer *rtn;
+    int32_t *ptr;
+    struct NARRAY *na;
+
+    chk = rb_obj_is_kind_of(src, cNArray);
+    if (chk == Qfalse) {
+        rb_raise(rb_eTypeError, "expect NArray");
+    }
+
+    src = na_cast_object(src, NA_LINT);
+    GetNArray(src, na);
+    len = na->total;
+    ptr = (int32_t *)NA_PTR(na, 0);
+
+    rtn = ALLOC_N(integer, len);
+
+    for (i = 0; i < len; i++) {
+	rtn[i] = (integer)ptr[i];
+    }
+    
+    return rtn;
+}
+
+static logical *
+na2clogicalary(src)
+    VALUE src;
+{
+    VALUE chk;
+    struct NARRAY *na;
+    int len, i;
+    logical *rtn;
+    unsigned char *ptr;
+
+    chk = rb_obj_is_kind_of(src, cNArray);
+    if (chk == Qfalse) {
+        rb_raise(rb_eTypeError, "expect NArray");
+    }
+
+    src = na_cast_object(src, NA_BYTE);
+    GetNArray(src, na);
+    len = na->total;
+    ptr = (unsigned char *)NA_PTR(na, 0);
+
+    rtn = ALLOC_N(logical, len);
+
+    for (i = 0; i < len; i++) {
+	rtn[i] = (logical)ptr[i];
+    }
+    
+    return rtn;
+}
+
+
+