Merge branch 'datatype'

datatype.scm

@@ -334,18 +334,16 @@ END
 (define MPI:make-type-struct 
     (foreign-primitive scheme-object ((int fieldcount)
                                       (scheme-object blocklens)
-                                      (scheme-object displs)
                                       (scheme-object fieldtys))
 #<<EOF
-  int i, status;
+  int i, status, fldtysize;
   int *array_of_blocklens;
   MPI_Aint *array_of_displs;
   MPI_Datatype *array_of_types, newtype;
   chicken_MPI_datatype_t newdatatype;
   C_word result, x, tail;
 
   C_i_check_list (blocklens);
-  C_i_check_list (displs);
   C_i_check_list (fieldtys);
 
   if (!(fieldcount > 0))
@@ -364,30 +362,32 @@ END
      tail = C_u_i_cdr (tail);
      array_of_blocklens[i] = C_num_to_int(x);
   }
-  tail = displs;
-  for (i=0; i<fieldcount; i++)
-  {
-     x = C_u_i_car (tail);
-     tail = C_u_i_cdr (tail);
-     array_of_displs[i] = C_num_to_int(x);
-  }
   tail = fieldtys;
   for (i=0; i<fieldcount; i++)
   {
      x = C_u_i_car (tail);
      tail = C_u_i_cdr (tail);
      array_of_types[i] = Datatype_val(x);
   }
+  array_of_displs[0] = 0;
+  for (i=1; i<fieldcount; i++)
+  {
+     status = MPI_Type_size(array_of_types[i-1], &fldtysize);
+
+     if (status != MPI_SUCCESS) 
+     {
+        chicken_MPI_exception (MPI_ERR_TYPE, 20, "invalid MPI datatype");
+     }
+
+     array_of_displs[i] = array_of_displs[i-1] + fldtysize * array_of_blocklens[i-1];
+  }
 
   status = MPI_Type_create_struct(fieldcount, 
                                   array_of_blocklens,
                                   array_of_displs,
                                   array_of_types,
                                   &newtype);
 
-  free(array_of_blocklens);
-  free(array_of_displs);
-  free(array_of_types);
 
   if (status != MPI_SUCCESS) 
   {
@@ -405,6 +405,10 @@ END
   newdatatype.datatype_data = (void *)newtype;
   result = (C_word)&newdatatype;
 
+  free(array_of_blocklens);
+  free(array_of_displs);
+  free(array_of_types);
+
   C_return(result);
 EOF
 ))

tests/datatest.scm

@@ -8,7 +8,8 @@
 (define (blob-concatenate data extent)
   (let ((buf (make-blob (* extent (length data)))))
     (fold
-     (lambda (b i) (move-memory! b buf (blob-size b) 0 (* i extent)) (+ i 1))
+     (lambda (b i) 
+       (move-memory! b buf (blob-size b) 0 (* i extent)) (+ i 1))
      0 data)
     buf))
 
@@ -22,7 +23,6 @@
 
 (define nflds 3)
 (define blocklens '(10 1 1))
-(define displs '(0 10 14))
 (define fieldtys `(,MPI:type-char ,MPI:type-u32 ,MPI:type-f64))
 
 (if (zero? myrank) 
@@ -31,7 +31,7 @@
       (print "extent of MPI char type is " (MPI:type-extent MPI:type-char))
       ))
 
-(define newty (MPI:make-type-struct nflds blocklens displs fieldtys))
+(define newty (MPI:make-type-struct nflds blocklens fieldtys))
 (define tysize (MPI:type-size newty))
 
 (if (zero? myrank)