Fortran Translation Issues

1. Fortran Array Section Transformation

The pattern of transforming instances with Fortran array type and related operations:

1.1 Fortran Array Declaration (and destruction)

  INTEGER A(L2:H2:S2, L1:H1:S1)

=>

  f_arr A = f_arr_create( // Create an f_arr instance for int array A
              sizeof(int), // 1. The size of each element
              2,           // 2. The number of dimensions
              (int[3][2]){ // 3. Dimension info in col-major order.
                {L2, L1},   // Lower-bounds for each dim.
                {H2, H1},   // Upper-bounds for each dim.
                {S2, S1}.   // The idx-step for each dim.
                }
              );

Each f_arr typed instance requires a destruction:

  f_arr_destroy(A);

1.2 Fortran Array Subscription

  A(J, I) = A(J,I) - 1

=>

  *((int*)f_arr_subscript(A, (int[2]){J, I})) = 
      *((int*)            // Conversion from void* to element type
        f_arr_subscript(  // Access the array elem. A(J, I)
          A,               // 1. The array identifier
          (int[2]){J, I})  // 2. The sequence of indexes in col-major
        ) - 1

1.3 Fortran Array Section

  ...
! A section of array A is passed in.
  CALL UPDATE(A(L2+X:H2-Y:S2*Z, K))
! A full array B is passed in
  CALL UPDATE(B)
  ...

! update all elements in the input array section 
  SUBROUTINE UPDATE(S)
    INTEGER S(L4:H4:S4, L3:H3:S3)
    ... 
      S(J,I) = ...
    ...
  END SUBROUTINE

=>

  ...
    UPDATE(
      f_arr_sect(    // Constructs a wrapper for array section
        A,            // 1. The array identifier
        (int[3][2]){  // 2. Dimension information
          {L2+X, K},   // Lower-bound for each dim.
          {H2-Y, K},   // Upper-bound for each dim.
          {S2*Z, S1}   // Idx. step for each dim
        }
      )              // This instance is freed in subroutine.
    );
    UPDATE(
      f_arr_full(B)  // Constructs a wrapper for full array arg
    );
  ...

  void UPDATE(f_arr _S) {  // Change to _S as an intermediate instance
    f_arr S = f_arr_sect(    // A wrapper reshaped with new idx. sys.
                _S,           // 1. the input array _S
                (int[3][2]){  // 2. new dimension info
                  {L4, L3},    // New lower-bound for each dim.
                  {H4, H3},    // New upper-bound for each dim.
                  {S4, S3}.    // New idx. step for each dim
                }
              ); 
    ...
      *((int*)f_arr_subscript(S, (int[2]){J, I})) = ...
    ...
    // free the outer most wrapper (i.e. S)
    f_arr_destroy(S);   
    // free the intermediate wrapper (i.e. _S), 
    // whose construction is inlined in the calling statement.
    f_arr_destroy(_S);  
  }

1.4 Fortran array reshape w/ diff. dim

In-progress.

1.5 Fortran Array Implementation

fortran-array.cvl

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

typedef struct CIVL_FORTRAN_ARRAY {
  // The number of dimensions
  int num_dims;
  // Dimention Info
  int *lbnds; // Left bounds for each dim.
  int *rbnds; // Right bounds for each dim.
  int *dists; // Distances of two neighbour elements in each dim.   
  // Data Info
  unsigned int size_data;
  void* data;
  // Source CIVL_FORTRAN_ARRAY_TYPE
  struct CIVL_FORTRAN_ARRAY *src_arr;
} * f_arr;

/* Returns the sequential position in a row-major order */
int calc_seq_pos(f_arr arr, int shfts[]) {
  int n_dims = arr->num_dims;
  int *lbnds = arr->lbnds;
  int *rbnds = arr->rbnds;
  int *dists = arr->dists;
  int seq_pos = 0;
  int size_dim = 1;

  for(int i=n_dims-1; i>=0; i--) {
    seq_pos += (shfts[i]) * size_dim;
    size_dim *= (rbnds[i] - lbnds[i]) / dists[i] + 1;
  }
  return seq_pos;
}

int get_seq_pos(f_arr arr, int idxes[]) {
  /* PRE: 'arr' shall NOT be NULL. */
  // EXTRACT: the cur. arr. info.
  int n_dims = arr->num_dims;
  int *lbnds = arr->lbnds;
  int *dists = arr->dists;
  int shfts[n_dims];

  // CALC.: rel. shifts for each dim. in cur. arr.
  for (int i=0; i<n_dims; i++)
    shfts[i] = (idxes[i] - lbnds[i]) / dists[i];

  // FETCH: the src. sec. of the cur. arr. 'arr' 
  f_arr sec = arr->src_arr;

  if (sec == NULL) 
    // the cur. arr. is the original one.
    return calc_seq_pos(arr, shfts);
  //else calc. the abs. indexes in src. arr.
    
  int idxes_src[n_dims];
  
  // EXTRACT: the source section info.
  lbnds = sec->lbnds;
  dists = sec->dists;
  // CALC.: abs. indexes for each dim. in the src. arr.
  for (int i=0; i<n_dims; i++)
    idxes_src[i] = lbnds[i] + shfts[i] * dists[i];
  // TRACE: to the original array entity recursively.
  return get_seq_pos(sec->src_arr, idxes_src);
}

f_arr f_arr_create(unsigned int elem_size, 
		   int dim_num, 
		   int dim_info[3][dim_num]) {
  f_arr arr = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int elem_total = 1;
  int lbnd, rbnd, dist;

  arr->num_dims = dim_num;
  arr->lbnds = (int*)malloc(dim_num * sizeof(int));
  arr->rbnds = (int*)malloc(dim_num * sizeof(int));
  arr->dists = (int*)malloc(dim_num * sizeof(int));
  for (int i=dim_num-1; i>=0; i--) {
    lbnd = dim_info[0][i];
    rbnd = dim_info[1][i];
    dist = dim_info[2][i];
    arr->lbnds[i] = lbnd;
    arr->rbnds[i] = rbnd;
    arr->dists[i] = dist;
    elem_total *= (dim_info[1][i] - dim_info[0][i]) / dim_info[2][i] + 1;
  }
  arr->size_data = elem_size;
  arr->data = malloc(elem_size * elem_total);
  arr->src_arr = NULL;
  return arr;
}

f_arr f_arr_sect(f_arr arr, int sec_info[3][arr->num_dims]) {
  f_arr sec = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int dim_num = arr->num_dims;

  sec->num_dims = dim_num;
  sec->lbnds = (int*)malloc(dim_num * sizeof(int));
  sec->rbnds = (int*)malloc(dim_num * sizeof(int));
  sec->dists = (int*)malloc(dim_num * sizeof(int));
  for (int i=dim_num-1; i>=0; i--) {
    sec->lbnds[i] = sec_info[0][i];
    sec->rbnds[i] = sec_info[1][i];
    sec->dists[i] = sec_info[2][i];
  }
  sec->size_data = arr->size_data;
  sec->data = arr->data;
  sec->src_arr = arr;
  return sec;
}

f_arr f_arr_full(f_arr arr) {
  f_arr img = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
  int dim_num = arr->num_dims;

  img->num_dims = dim_num;
  img->lbnds = (int*)malloc(dim_num * sizeof(int));
  img->rbnds = (int*)malloc(dim_num * sizeof(int));
  img->dists = (int*)malloc(dim_num * sizeof(int));
  memcpy(img->lbnds, arr->lbnds, dim_num*sizeof(int));
  memcpy(img->rbnds, arr->rbnds, dim_num*sizeof(int));
  memcpy(img->dists, arr->dists, dim_num*sizeof(int));
  img->size_data = arr->size_data;
  img->data = arr->data;
  img->src_arr = arr;
  return img;
}

void *f_arr_subscript(f_arr arr, int idxes[]) {
  int seq_pos = get_seq_pos(arr, idxes);

  return (arr->data) + seq_pos*arr->size_data;
}

void f_arr_destroy(f_arr arr){
  free(arr->lbnds);
  free(arr->rbnds);
  free(arr->dists);
  if (arr->src_arr == NULL)
    free(arr->data);
  else
    arr->data = NULL;
  free(arr);
}

1.6 A transformation example

Here is the prototype of handling Fortran array sections:

/* e.g., 
 PROGRAM EXAMPLE
   INTEGER SRC_ARR(1:3:1)      
!  source array   SRC_ARR        := /(1)=x,(2)=y,(3)=z/
!  source section SRC_ARR(1:3:2) := /(1)=x,      (3)=z/
   CALL CUT(2, SRC_ARR(1:3:2)) 
 END   
 SUBROUTINE CUT(N, SRC_SEC)
   INTEGER CUR_ARR(2:4:2)
   CUR_ARR = SRC_SEC 
!  current array  CUR_ARR        := /(2)=x,      (4)=z/
 END
!  note1: the current array and its source section      
!  SAME shift: CUR_ARR and SRC_ARR(1:3:2) have a same 
!              1st elem., which is x.
!  DIFF index: The 1st elem. has an index of 2 in 
!              CUR_ARR, while 1 in SRC_ARR(1:3:2).
!  note2: the source section and its source array 
!  SAME index: SRC_ARR and SRC_ARR(1:3:2) have a same
!              indexing system.
!  DIFF shift: their 2nd element are different.
*/


/****************************************************/

void arr1d_print(f_arr _IARR) {
  // INTEGER IARR(2:4:2)
  f_arr IARR = f_arr_sect(_IARR, (int[3][1]){{2}, {4}, {2}});

  // DO I=2, 4, 2
  // PRINT(IARR(I))
  // END DO
  for (int i=2; i<=4; i+=2)
    printf("%d\n", *((int*)f_arr_subscript(IARR, (int[]){i})));
  f_arr_destroy(IARR);
  f_arr_destroy(_IARR);

}

void _arr1d_print(const int n, f_arr _IARR) {
  // INTEGER IARR(N)
  f_arr IARR = f_arr_sect(_IARR, (int[3][1]){{1}, {n}, {1}});
    
  // DO I=1, N
  // PRINT(IARR(I))
  // END DO
  for (int i=1; i<=n; i+=1) {
    printf("%d\n", *((int*)f_arr_subscript(IARR, (int[]){i})));
  }
  f_arr_destroy(IARR);
  f_arr_destroy(_IARR);
}

void test1 () {
  // INTEGER A(1:3:1);
  f_arr A = f_arr_create(sizeof(int), 1, (int[3][1]){{1}, {3}, {1}});
  // DO I=1, 3
  // A(I) = I*I;
  // END DO
  for(int i=1; i<=3; i++) {
    *((int*)f_arr_subscript(A, (int[]){i})) = i*i;
  }
  // ARR1D_PRINT(A(1:3:2))
  arr1d_print(f_arr_sect(A, (int[3][1]){{1}, {3}, {2}}));
  _arr1d_print(2, f_arr_sect(A, (int[3][1]){{2}, {3}, {1}}));
  f_arr_destroy(A);
}

/************************************************/

void mat_print(const int n,const int m, f_arr _mat) {
  // INTEGER MAT(N, M)
  f_arr mat = f_arr_sect(_mat, (int[3][2]){{1,1}, {m,n}, {1,1}});

  // DO I=1,M
  // DO J=1,N
  // PRINT(MAT(J,I), ", ")
  // END DO
  // PRINT("\n")
  // END DO
 for (int i=1; i<=m; i++) {
    for (int j=1; j<=n; j++)
      printf("%d%s", 
        *((int*)f_arr_subscript(mat, (int[2]){i, j})), ", ");
    printf("%s", "\n");
  }
  f_arr_destroy(mat);
  f_arr_destroy(_mat);
}

void mxm(int n1, f_arr _ia, int n2, f_arr _ib, int n3, f_arr _ic) {
  // INTEGER N1, N2, N3
  // INTEGER IA(N2, N1), IB(N3, N2), IC(N3, N1)
  f_arr ia = f_arr_sect(_ia, (int[3][2]){{1,1}, {n1,n2}, {1,1}});
  f_arr ib = f_arr_sect(_ib, (int[3][2]){{1,1}, {n2,n3}, {1,1}});
  f_arr ic = f_arr_sect(_ic, (int[3][2]){{1,1}, {n1,n3}, {1,1}});

  for (int j=1; j<=n3; j++) 
    for (int i=1; i<=n1; i++)
      for (int k=1; k<=n2; k++)
        *(int*)f_arr_subscript(ic, (int[2]){j, i}) =  
	       *(int*)f_arr_subscript(ic, (int[2]){j, i}) +
	       *(int*)f_arr_subscript(ia, (int[2]){k, i}) *
	       *(int*)f_arr_subscript(ib, (int[2]){j, k});
}

void test_mxm() {
  // INTEGER N1=2, N2=1, N3=3
  int n1=2, n2=1, n3=3;
  // INTEGER IA(N1, N2), IB(N2, N3), IC(N1, N3)
  f_arr ia = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n2, n1}, {1,1}});
  f_arr ib = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n3, n2}, {1,1}});
  f_arr ic = f_arr_create(sizeof(int), 2, 
			  (int[3][2]){{1,1}, {n3, n1}, {1,1}});

  // IA = 2
  // IB = -2
  // IC = 0
  for (int j=1; j<=n2; j++)
    for (int i=1; i<=n1; i++)
      *(int*)f_arr_subscript(ia, (int[2]){j, i}) = 2;
  for (int j=1; j<=n3; j++)
    for (int i=1;i<=n2; i++)
      *(int*)f_arr_subscript(ib, (int[2]){j, i}) = -2;
  for (int j=1; j<=n3; j++) 
    for (int i=1; i<=n1; i++)
      *(int*)f_arr_subscript(ic, (int[2]){j, i}) = 0;

  f_arr arg_ia, arg_ib, arg_ic;
  // MXM(N1, IA, N2, IB, N3, IC)
  arg_ia = f_arr_full(ia);
  arg_ib = f_arr_full(ib);
  arg_ic = f_arr_full(ic);
  mxm(n1, arg_ia, n2, arg_ib, n3, arg_ic);
  f_arr_destroy(arg_ia);
  f_arr_destroy(arg_ib);
  f_arr_destroy(arg_ic);

  // MAT_PRINT(N, M, IC)
  arg_ic = f_arr_full(ic);
  mat_print(n3,n1,arg_ic);
  f_arr_destroy(arg_ic);

  f_arr_destroy(ia);
  f_arr_destroy(ib);
  f_arr_destroy(ic);
}

void test_neg_stride() {
  // INTEGER A(1:21:2);
  f_arr A = f_arr_create(
              sizeof(int), 1, (int[3][1]){{1}, {21}, {2}});

  // DO I=1, 21, 2
  // A(I) = I / 2 + 1;
  // END DO
  for(int i=1; i<=21; i+=2)
    *(int*)f_arr_subscript(A, (int[]){i}) = i/2 + 1;

  // ARR1D_PRINT(6, A(21:1:-4))
  f_arr sec_A_0 = f_arr_sect(A, (int[3][1]){{21}, {1}, {-4}});
  _arr1d_print(6, sec_A_0);
  f_arr_destroy(sec_A_0);
  f_arr_destroy(A);
}

void test_2d_to_1d() {
  // INTEGER M=3, N=4, K=M*N
  int m=3, n=4, k=m*n;
  // INTEGER IA(M, N)
  f_arr ia = f_arr_create(sizeof(int), 2,
                          (int[3][2]){{1,1}, {n, m}, {1,1}});
  for (int j=1; j<=n; j++)
    for (int i=1; i<=m; i++)
      *(int*)f_arr_subscript(ia, (int[2]){j,i}) = (j-1)*m + i;
  
  mat_print(m,n,f_arr_full(ia));
  _arr1d_print(k, f_arr_full(ia));
  f_arr_destroy(ia);
}

int main() {
  //test1();
  //test_mxm();
  //test_neg_stride();
  test_2d_to_1d();
  return 0;
}