Changes between Version 9 and Version 10 of FortranTranslationIssues


Ignore:
Timestamp:
12/09/19 11:07:20 (6 years ago)
Author:
wuwenhao
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • FortranTranslationIssues

    v9 v10  
    22
    33== 1. Fortran Array Section Transformation ==
     4
     5The pattern of transforming instances with Fortran array type and related operations:
     6
     7=== 1.1 Fortran Array Declaration (and destruction) ===
     8
     9{{{
     10  INTEGER A(L2:H2:S2, L1:H1:S1)
     11}}}
     12
     13  =>
     14
     15{{{
     16  f_arr A = f_arr_create( // Create an f_arr instance for int array A
     17              sizeof(int), // 1. The size of each element
     18              2,           // 2. The number of dimensions
     19              (int[3][2]){ // 3. Dimension info in col-major order.
     20                {L2, L1},   // Lower-bounds for each dim.
     21                {H2, H1},   // Upper-bounds for each dim.
     22                {S2, S1}.   // The idx-step for each dim.
     23                }
     24              );
     25}}}
     26
     27 Each `f_arr` typed instance requires a destruction:
     28
     29{{{
     30  f_arr_destroy(A);
     31}}}
     32
     33=== 1.2 Fortran Array Subscription ===
     34
     35{{{
     36  A(J, I) = A(J,I) - 1
     37}}}
     38
     39  =>
     40
     41{{{
     42  *((int*)f_arr_subscript(A, (int[2]){J, I})) =
     43      *((int*)            // Conversion from void* to element type
     44        f_arr_subscript(  // Access the array elem. A(J, I)
     45          A,               // 1. The array identifier
     46          (int[2]){J, I})  // 2. The sequence of indexes in col-major
     47        ) - 1
     48}}}
     49
     50=== 1.3 Fortran Array Implementation ===
     51
     52`fortran-array.cvl`
     53{{{
     54#include <stdlib.h>
     55#include <stdio.h>
     56#include <string.h>
     57
     58typedef struct CIVL_FORTRAN_ARRAY {
     59  // The number of dimensions
     60  int num_dims;
     61  // Dimention Info
     62  int *lbnds; // Left bounds for each dim.
     63  int *rbnds; // Right bounds for each dim.
     64  int *dists; // Distances of two neighbour elements in each dim.   
     65  // Data Info
     66  unsigned int size_data;
     67  void* data;
     68  // Source CIVL_FORTRAN_ARRAY_TYPE
     69  struct CIVL_FORTRAN_ARRAY *src_arr;
     70} * f_arr;
     71
     72/* Returns the sequential position in a row-major order */
     73int calc_seq_pos(f_arr arr, int shfts[]) {
     74  int n_dims = arr->num_dims;
     75  int *lbnds = arr->lbnds;
     76  int *rbnds = arr->rbnds;
     77  int *dists = arr->dists;
     78  int seq_pos = 0;
     79  int size_dim = 1;
     80
     81  for(int i=n_dims-1; i>=0; i--) {
     82    seq_pos += (shfts[i]) * size_dim;
     83    size_dim *= (rbnds[i] - lbnds[i]) / dists[i] + 1;
     84  }
     85  return seq_pos;
     86}
     87
     88int get_seq_pos(f_arr arr, int idxes[]) {
     89  /* PRE: 'arr' shall NOT be NULL. */
     90  // EXTRACT: the cur. arr. info.
     91  int n_dims = arr->num_dims;
     92  int *lbnds = arr->lbnds;
     93  int *dists = arr->dists;
     94  int shfts[n_dims];
     95
     96  // CALC.: rel. shifts for each dim. in cur. arr.
     97  for (int i=0; i<n_dims; i++)
     98    shfts[i] = (idxes[i] - lbnds[i]) / dists[i];
     99
     100  // FETCH: the src. sec. of the cur. arr. 'arr'
     101  f_arr sec = arr->src_arr;
     102
     103  if (sec == NULL)
     104    // the cur. arr. is the original one.
     105    return calc_seq_pos(arr, shfts);
     106  //else calc. the abs. indexes in src. arr.
     107   
     108  int idxes_src[n_dims];
     109 
     110  // EXTRACT: the source section info.
     111  lbnds = sec->lbnds;
     112  dists = sec->dists;
     113  // CALC.: abs. indexes for each dim. in the src. arr.
     114  for (int i=0; i<n_dims; i++)
     115    idxes_src[i] = lbnds[i] + shfts[i] * dists[i];
     116  // TRACE: to the original array entity recursively.
     117  return get_seq_pos(sec->src_arr, idxes_src);
     118}
     119
     120f_arr f_arr_create(unsigned int elem_size,
     121                   int dim_num,
     122                   int dim_info[3][dim_num]) {
     123  f_arr arr = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
     124  int elem_total = 1;
     125  int lbnd, rbnd, dist;
     126
     127  arr->num_dims = dim_num;
     128  arr->lbnds = (int*)malloc(dim_num * sizeof(int));
     129  arr->rbnds = (int*)malloc(dim_num * sizeof(int));
     130  arr->dists = (int*)malloc(dim_num * sizeof(int));
     131  for (int i=dim_num-1; i>=0; i--) {
     132    lbnd = dim_info[0][i];
     133    rbnd = dim_info[1][i];
     134    dist = dim_info[2][i];
     135    arr->lbnds[i] = lbnd;
     136    arr->rbnds[i] = rbnd;
     137    arr->dists[i] = dist;
     138    elem_total *= (dim_info[1][i] - dim_info[0][i]) / dim_info[2][i] + 1;
     139  }
     140  arr->size_data = elem_size;
     141  arr->data = malloc(elem_size * elem_total);
     142  arr->src_arr = NULL;
     143  return arr;
     144}
     145
     146f_arr f_arr_sect(f_arr arr, int sec_info[3][arr->num_dims]) {
     147  f_arr sec = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
     148  int dim_num = arr->num_dims;
     149
     150  sec->num_dims = dim_num;
     151  sec->lbnds = (int*)malloc(dim_num * sizeof(int));
     152  sec->rbnds = (int*)malloc(dim_num * sizeof(int));
     153  sec->dists = (int*)malloc(dim_num * sizeof(int));
     154  for (int i=dim_num-1; i>=0; i--) {
     155    sec->lbnds[i] = sec_info[0][i];
     156    sec->rbnds[i] = sec_info[1][i];
     157    sec->dists[i] = sec_info[2][i];
     158  }
     159  sec->size_data = arr->size_data;
     160  sec->data = arr->data;
     161  sec->src_arr = arr;
     162  return sec;
     163}
     164
     165f_arr f_arr_full(f_arr arr) {
     166  f_arr img = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
     167  int dim_num = arr->num_dims;
     168
     169  img->num_dims = dim_num;
     170  img->lbnds = (int*)malloc(dim_num * sizeof(int));
     171  img->rbnds = (int*)malloc(dim_num * sizeof(int));
     172  img->dists = (int*)malloc(dim_num * sizeof(int));
     173  memcpy(img->lbnds, arr->lbnds, dim_num*sizeof(int));
     174  memcpy(img->rbnds, arr->rbnds, dim_num*sizeof(int));
     175  memcpy(img->dists, arr->dists, dim_num*sizeof(int));
     176  img->size_data = arr->size_data;
     177  img->data = arr->data;
     178  img->src_arr = arr;
     179  return img;
     180}
     181
     182void *f_arr_subscript(f_arr arr, int idxes[]) {
     183  int seq_pos = get_seq_pos(arr, idxes);
     184
     185  return (arr->data) + seq_pos*arr->size_data;
     186}
     187
     188void f_arr_destroy(f_arr arr){
     189  free(arr->lbnds);
     190  free(arr->rbnds);
     191  free(arr->dists);
     192  if (arr->src_arr == NULL)
     193    free(arr->data);
     194  else
     195    arr->data = NULL;
     196  free(arr);
     197}
     198}}}
     199
     200=== 1.4 A transformation example ===
    4201
    5202Here is the prototype of handling Fortran array sections:
     
    29226*/
    30227
    31 #include <stdlib.h>
    32 #include <stdio.h>
    33 #include <string.h>
    34 
    35 typedef struct CIVL_FORTRAN_ARRAY {
    36   // The number of dimensions
    37   int num_dims;
    38   // Dimention Info
    39   int *lbnds; // Left bounds for each dim.
    40   int *rbnds; // Right bounds for each dim.
    41   int *dists; // Distances of two neighbour elements in each dim.   
    42   // Data Info
    43   unsigned int size_data;
    44   void* data;
    45   // Source CIVL_FORTRAN_ARRAY_TYPE
    46   struct CIVL_FORTRAN_ARRAY *src_arr;
    47 } * f_arr;
    48 
    49 /* Returns the sequential position in a row-major order */
    50 int calc_seq_pos(f_arr arr, int shfts[]) {
    51   int n_dims = arr->num_dims;
    52   int *lbnds = arr->lbnds;
    53   int *rbnds = arr->rbnds;
    54   int *dists = arr->dists;
    55   int seq_pos = 0;
    56   int size_dim = 1;
    57 
    58   for(int i=n_dims-1; i>=0; i--) {
    59     seq_pos += (shfts[i]) * size_dim;
    60     size_dim *= (rbnds[i] - lbnds[i]) / dists[i] + 1;
    61   }
    62   return seq_pos;
    63 }
    64 
    65 int get_seq_pos(f_arr arr, int idxes[]) {
    66   /* PRE: 'arr' shall NOT be NULL. */
    67   // EXTRACT: the cur. arr. info.
    68   int n_dims = arr->num_dims;
    69   int *lbnds = arr->lbnds;
    70   int *dists = arr->dists;
    71   int shfts[n_dims];
    72 
    73   // CALC.: rel. shifts for each dim. in cur. arr.
    74   for (int i=0; i<n_dims; i++)
    75     shfts[i] = (idxes[i] - lbnds[i]) / dists[i];
    76 
    77   // FETCH: the src. sec. of the cur. arr. 'arr'
    78   f_arr sec = arr->src_arr;
    79 
    80   if (sec == NULL)
    81     // the cur. arr. is the original one.
    82     return calc_seq_pos(arr, shfts);
    83   //else calc. the abs. indexes in src. arr.
    84    
    85   int idxes_src[n_dims];
    86  
    87   // EXTRACT: the source section info.
    88   lbnds = sec->lbnds;
    89   dists = sec->dists;
    90   // CALC.: abs. indexes for each dim. in the src. arr.
    91   for (int i=0; i<n_dims; i++)
    92     idxes_src[i] = lbnds[i] + shfts[i] * dists[i];
    93   // TRACE: to the original array entity recursively.
    94   return get_seq_pos(sec->src_arr, idxes_src);
    95 }
    96 
    97 f_arr f_arr_create(unsigned int elem_size,
    98                    int dim_num,
    99                    int dim_info[3][dim_num]) {
    100   f_arr arr = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
    101   int elem_total = 1;
    102   int lbnd, rbnd, dist;
    103 
    104   arr->num_dims = dim_num;
    105   arr->lbnds = (int*)malloc(dim_num * sizeof(int));
    106   arr->rbnds = (int*)malloc(dim_num * sizeof(int));
    107   arr->dists = (int*)malloc(dim_num * sizeof(int));
    108   for (int i=dim_num-1; i>=0; i--) {
    109     lbnd = dim_info[0][i];
    110     rbnd = dim_info[1][i];
    111     dist = dim_info[2][i];
    112     arr->lbnds[i] = lbnd;
    113     arr->rbnds[i] = rbnd;
    114     arr->dists[i] = dist;
    115     elem_total *= (dim_info[1][i] - dim_info[0][i]) / dim_info[2][i] + 1;
    116   }
    117   arr->size_data = elem_size;
    118   arr->data = malloc(elem_size * elem_total);
    119   arr->src_arr = NULL;
    120   return arr;
    121 }
    122 
    123 f_arr f_arr_sect(f_arr arr, int sec_info[3][arr->num_dims]) {
    124   f_arr sec = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
    125   int dim_num = arr->num_dims;
    126 
    127   sec->num_dims = dim_num;
    128   sec->lbnds = (int*)malloc(dim_num * sizeof(int));
    129   sec->rbnds = (int*)malloc(dim_num * sizeof(int));
    130   sec->dists = (int*)malloc(dim_num * sizeof(int));
    131   for (int i=dim_num-1; i>=0; i--) {
    132     sec->lbnds[i] = sec_info[0][i];
    133     sec->rbnds[i] = sec_info[1][i];
    134     sec->dists[i] = sec_info[2][i];
    135   }
    136   sec->size_data = arr->size_data;
    137   sec->data = arr->data;
    138   sec->src_arr = arr;
    139   return sec;
    140 }
    141 
    142 f_arr f_arr_full(f_arr arr) {
    143   f_arr img = (f_arr)malloc(sizeof(struct CIVL_FORTRAN_ARRAY));
    144   int dim_num = arr->num_dims;
    145 
    146   img->num_dims = dim_num;
    147   img->lbnds = (int*)malloc(dim_num * sizeof(int));
    148   img->rbnds = (int*)malloc(dim_num * sizeof(int));
    149   img->dists = (int*)malloc(dim_num * sizeof(int));
    150   memcpy(img->lbnds, arr->lbnds, dim_num*sizeof(int));
    151   memcpy(img->rbnds, arr->rbnds, dim_num*sizeof(int));
    152   memcpy(img->dists, arr->dists, dim_num*sizeof(int));
    153   img->size_data = arr->size_data;
    154   img->data = arr->data;
    155   img->src_arr = arr;
    156   return img;
    157 }
    158 
    159 void *f_arr_read(f_arr arr, int idxes[]) {
    160   int seq_pos = get_seq_pos(arr, idxes);
    161 
    162   return (arr->data) + seq_pos*arr->size_data;
    163 }
    164 
    165 void f_arr_write(f_arr arr, int idxes[], void* val) {
    166   void *elem = f_arr_read(arr, idxes);
    167 
    168   memcpy(elem, val, arr->size_data);
    169 }
    170 
    171 void f_arr_destroy(f_arr arr){
    172   free(arr->lbnds);
    173   free(arr->rbnds);
    174   free(arr->dists);
    175   if (arr->src_arr == NULL)
    176     free(arr->data);
    177   else
    178     arr->data = NULL;
    179   free(arr);
    180 }
    181228
    182229/****************************************************/
     
    189236  // PRINT(IARR(I))
    190237  // END DO
    191   for (int i=2; i<=4; i+=2) {
    192     printf("%d\n", *((int*)f_arr_read(IARR, (int[]){i})));
    193   }
     238  for (int i=2; i<=4; i+=2)
     239    printf("%d\n", *((int*)f_arr_subscript(IARR, (int[]){i})));
    194240  f_arr_destroy(IARR);
     241  f_arr_destroy(_IARR);
     242
    195243}
    196244
     
    203251  // END DO
    204252  for (int i=1; i<=n; i+=1) {
    205     printf("%d\n", *((int*)f_arr_read(IARR, (int[]){i})));
     253    printf("%d\n", *((int*)f_arr_subscript(IARR, (int[]){i})));
    206254  }
    207255  f_arr_destroy(IARR);
    208 }
    209 
    210 void test_arr1d () {
     256  f_arr_destroy(_IARR);
     257}
     258
     259void test1 () {
    211260  // INTEGER A(1:3:1);
    212261  f_arr A = f_arr_create(sizeof(int), 1, (int[3][1]){{1}, {3}, {1}});
     
    215264  // END DO
    216265  for(int i=1; i<=3; i++) {
    217     int val = i*i;
    218 
    219     f_arr_write(A, (int[]){i}, &val);
     266    *((int*)f_arr_subscript(A, (int[]){i})) = i*i;
    220267  }
    221268  // ARR1D_PRINT(A(1:3:2))
    222   f_arr sec_A_0 = f_arr_sect(A, (int[3][1]){{1}, {3}, {2}});
    223   arr1d_print(sec_A_0);
    224   f_arr_destroy(sec_A_0);
    225   f_arr sec_A_1 = f_arr_sect(A, (int[3][1]){{2}, {3}, {1}});
    226   _arr1d_print(2, sec_A_1);
    227   f_arr_destroy(sec_A_1);
     269  arr1d_print(f_arr_sect(A, (int[3][1]){{1}, {3}, {2}}));
     270  _arr1d_print(2, f_arr_sect(A, (int[3][1]){{2}, {3}, {1}}));
    228271  f_arr_destroy(A);
    229272}
     
    243286 for (int i=1; i<=m; i++) {
    244287    for (int j=1; j<=n; j++)
    245       printf("%d%s", *((int*)f_arr_read(mat, (int[2]){i, j})), ", ");
     288      printf("%d%s", *((int*)f_arr_subscript(mat, (int[2]){i, j})), ", ");
    246289    printf("%s", "\n");
    247290  }
     291  f_arr_destroy(mat);
     292  f_arr_destroy(_mat);
    248293}
    249294
     
    257302  for (int j=1; j<=n3; j++)
    258303    for (int i=1; i<=n1; i++)
    259       for (int k=1; k<=n2; k++) {
    260         int val_ic =
    261           *(int*)f_arr_read(ic, (int[2]){j, i}) +
    262           *(int*)f_arr_read(ia, (int[2]){k, i}) *
    263           *(int*)f_arr_read(ib, (int[2]){j, k});
    264         f_arr_write(ic, (int[2]){j, i}, &val_ic);
    265       }
     304      for (int k=1; k<=n2; k++)
     305        *(int*)f_arr_subscript(ic, (int[2]){j, i}) = 
     306               *(int*)f_arr_subscript(ic, (int[2]){j, i}) +
     307               *(int*)f_arr_subscript(ia, (int[2]){k, i}) *
     308               *(int*)f_arr_subscript(ib, (int[2]){j, k});
    266309}
    267310
     
    281324  // IC = 0
    282325  for (int j=1; j<=n2; j++)
    283     for (int i=1; i<=n1; i++) {
    284       int val_ia = 2;
    285       f_arr_write(ia, (int[2]){j,i}, &val_ia);
    286     }
     326    for (int i=1; i<=n1; i++)
     327      *(int*)f_arr_subscript(ia, (int[2]){j, i}) = 2;
    287328  for (int j=1; j<=n3; j++)
    288     for (int i=1;i<=n2; i++) {
    289       int val_ib = -2;
    290       f_arr_write(ib, (int[2]){j,i}, &val_ib);
    291     }
     329    for (int i=1;i<=n2; i++)
     330      *(int*)f_arr_subscript(ib, (int[2]){j, i}) = -2;
    292331  for (int j=1; j<=n3; j++)
    293     for (int i=1; i<=n1; i++){
    294       int val_ic = 0;
    295       f_arr_write(ic, (int[2]){j,i}, &val_ic);
    296     }
     332    for (int i=1; i<=n1; i++)
     333      *(int*)f_arr_subscript(ic, (int[2]){j, i}) = 0;
    297334
    298335  f_arr arg_ia, arg_ib, arg_ic;
     
    316353}
    317354
     355void test_neg_stride() {
     356  // INTEGER A(1:21:2);
     357  f_arr A = f_arr_create(sizeof(int), 1, (int[3][1]){{1}, {21}, {2}});
     358
     359  // DO I=1, 21, 2
     360  // A(I) = I / 2 + 1;
     361  // END DO
     362  for(int i=1; i<=21; i+=2)
     363    *(int*)f_arr_subscript(A, (int[]){i}) = i/2 + 1;
     364
     365  // ARR1D_PRINT(6, A(21:1:-4))
     366  f_arr sec_A_0 = f_arr_sect(A, (int[3][1]){{21}, {1}, {-4}});
     367  _arr1d_print(6, sec_A_0);
     368  f_arr_destroy(sec_A_0);
     369  f_arr_destroy(A);
     370}
     371
     372void test_2d_to_1d() {
     373  // INTEGER M=3, N=4, K=M*N
     374  int m=3, n=4, k=m*n;
     375  // INTEGER IA(M, N)
     376  f_arr ia = f_arr_create(sizeof(int), 2,
     377                          (int[3][2]){{1,1}, {n, m}, {1,1}});
     378  for (int j=1; j<=n; j++)
     379    for (int i=1; i<=m; i++)
     380      *(int*)f_arr_subscript(ia, (int[2]){j,i}) = (j-1)*m + i;
     381 
     382  mat_print(m,n,f_arr_full(ia));
     383  _arr1d_print(k, f_arr_full(ia));
     384  f_arr_destroy(ia);
     385}
     386
    318387int main() {
    319   //test_arr1d();
     388  //test1();
    320389  //test_mxm();
     390  //test_neg_stride();
     391  test_2d_to_1d();
    321392  return 0;
    322393}
    323 
    324 }}}
     394}}}