| | 4 | |
| | 5 | The 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 | |
| | 58 | typedef 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 */ |
| | 73 | int 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 | |
| | 88 | int 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 | |
| | 120 | f_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 | |
| | 146 | f_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 | |
| | 165 | f_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 | |
| | 182 | void *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 | |
| | 188 | void 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 === |
| 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 | | } |
| | 355 | void 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 | |
| | 372 | void 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 | |