| OLD | NEW |
| 1 /* Specific implementation of the UNPACK intrinsic | 1 /* Specific implementation of the UNPACK intrinsic |
| 2 Copyright 2008, 2009 Free Software Foundation, Inc. | 2 Copyright 2008, 2009 Free Software Foundation, Inc. |
| 3 Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>, based on | 3 Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>, based on |
| 4 unpack_generic.c by Paul Brook <paul@nowt.org>. | 4 unpack_generic.c by Paul Brook <paul@nowt.org>. |
| 5 | 5 |
| 6 This file is part of the GNU Fortran 95 runtime library (libgfortran). | 6 This file is part of the GNU Fortran 95 runtime library (libgfortran). |
| 7 | 7 |
| 8 Libgfortran is free software; you can redistribute it and/or | 8 Libgfortran is free software; you can redistribute it and/or |
| 9 modify it under the terms of the GNU General Public | 9 modify it under the terms of the GNU General Public |
| 10 License as published by the Free Software Foundation; either | 10 License as published by the Free Software Foundation; either |
| (...skipping 72 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 83 | 83 |
| 84 if (ret->data == NULL) | 84 if (ret->data == NULL) |
| 85 { | 85 { |
| 86 /* The front end has signalled that we need to populate the | 86 /* The front end has signalled that we need to populate the |
| 87 return array descriptor. */ | 87 return array descriptor. */ |
| 88 dim = GFC_DESCRIPTOR_RANK (mask); | 88 dim = GFC_DESCRIPTOR_RANK (mask); |
| 89 rs = 1; | 89 rs = 1; |
| 90 for (n = 0; n < dim; n++) | 90 for (n = 0; n < dim; n++) |
| 91 { | 91 { |
| 92 count[n] = 0; | 92 count[n] = 0; |
| 93 » ret->dim[n].stride = rs; | 93 » GFC_DIMENSION_SET(ret->dim[n], 0, |
| 94 » ret->dim[n].lbound = 0; | 94 » » » GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); |
| 95 » ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; | 95 » extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); |
| 96 » extent[n] = ret->dim[n].ubound + 1; | |
| 97 empty = empty || extent[n] <= 0; | 96 empty = empty || extent[n] <= 0; |
| 98 » rstride[n] = ret->dim[n].stride; | 97 » rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); |
| 99 » mstride[n] = mask->dim[n].stride * mask_kind; | 98 » mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); |
| 100 rs *= extent[n]; | 99 rs *= extent[n]; |
| 101 } | 100 } |
| 102 ret->offset = 0; | 101 ret->offset = 0; |
| 103 ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); | 102 ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); |
| 104 } | 103 } |
| 105 else | 104 else |
| 106 { | 105 { |
| 107 dim = GFC_DESCRIPTOR_RANK (ret); | 106 dim = GFC_DESCRIPTOR_RANK (ret); |
| 108 for (n = 0; n < dim; n++) | 107 for (n = 0; n < dim; n++) |
| 109 { | 108 { |
| 110 count[n] = 0; | 109 count[n] = 0; |
| 111 » extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; | 110 » extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); |
| 112 empty = empty || extent[n] <= 0; | 111 empty = empty || extent[n] <= 0; |
| 113 » rstride[n] = ret->dim[n].stride; | 112 » rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); |
| 114 » mstride[n] = mask->dim[n].stride * mask_kind; | 113 » mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); |
| 115 } | 114 } |
| 116 if (rstride[0] == 0) | 115 if (rstride[0] == 0) |
| 117 rstride[0] = 1; | 116 rstride[0] = 1; |
| 118 } | 117 } |
| 119 | 118 |
| 120 if (empty) | 119 if (empty) |
| 121 return; | 120 return; |
| 122 | 121 |
| 123 if (mstride[0] == 0) | 122 if (mstride[0] == 0) |
| 124 mstride[0] = 1; | 123 mstride[0] = 1; |
| 125 | 124 |
| 126 vstride0 = vector->dim[0].stride; | 125 vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); |
| 127 if (vstride0 == 0) | 126 if (vstride0 == 0) |
| 128 vstride0 = 1; | 127 vstride0 = 1; |
| 129 rstride0 = rstride[0]; | 128 rstride0 = rstride[0]; |
| 130 mstride0 = mstride[0]; | 129 mstride0 = mstride[0]; |
| 131 rptr = ret->data; | 130 rptr = ret->data; |
| 132 vptr = vector->data; | 131 vptr = vector->data; |
| 133 | 132 |
| 134 while (rptr) | 133 while (rptr) |
| 135 { | 134 { |
| 136 if (*mptr) | 135 if (*mptr) |
| (...skipping 91 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 228 | 227 |
| 229 if (ret->data == NULL) | 228 if (ret->data == NULL) |
| 230 { | 229 { |
| 231 /* The front end has signalled that we need to populate the | 230 /* The front end has signalled that we need to populate the |
| 232 return array descriptor. */ | 231 return array descriptor. */ |
| 233 dim = GFC_DESCRIPTOR_RANK (mask); | 232 dim = GFC_DESCRIPTOR_RANK (mask); |
| 234 rs = 1; | 233 rs = 1; |
| 235 for (n = 0; n < dim; n++) | 234 for (n = 0; n < dim; n++) |
| 236 { | 235 { |
| 237 count[n] = 0; | 236 count[n] = 0; |
| 238 » ret->dim[n].stride = rs; | 237 » GFC_DIMENSION_SET(ret->dim[n], 0, |
| 239 » ret->dim[n].lbound = 0; | 238 » » » GFC_DESCRIPTOR_EXTENT(mask,n) - 1, rs); |
| 240 » ret->dim[n].ubound = mask->dim[n].ubound - mask->dim[n].lbound; | 239 » extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); |
| 241 » extent[n] = ret->dim[n].ubound + 1; | |
| 242 empty = empty || extent[n] <= 0; | 240 empty = empty || extent[n] <= 0; |
| 243 » rstride[n] = ret->dim[n].stride; | 241 » rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); |
| 244 » fstride[n] = field->dim[n].stride; | 242 » fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); |
| 245 » mstride[n] = mask->dim[n].stride * mask_kind; | 243 » mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); |
| 246 rs *= extent[n]; | 244 rs *= extent[n]; |
| 247 } | 245 } |
| 248 ret->offset = 0; | 246 ret->offset = 0; |
| 249 ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); | 247 ret->data = internal_malloc_size (rs * sizeof (GFC_INTEGER_1)); |
| 250 } | 248 } |
| 251 else | 249 else |
| 252 { | 250 { |
| 253 dim = GFC_DESCRIPTOR_RANK (ret); | 251 dim = GFC_DESCRIPTOR_RANK (ret); |
| 254 for (n = 0; n < dim; n++) | 252 for (n = 0; n < dim; n++) |
| 255 { | 253 { |
| 256 count[n] = 0; | 254 count[n] = 0; |
| 257 » extent[n] = ret->dim[n].ubound + 1 - ret->dim[n].lbound; | 255 » extent[n] = GFC_DESCRIPTOR_EXTENT(ret,n); |
| 258 empty = empty || extent[n] <= 0; | 256 empty = empty || extent[n] <= 0; |
| 259 » rstride[n] = ret->dim[n].stride; | 257 » rstride[n] = GFC_DESCRIPTOR_STRIDE(ret,n); |
| 260 » fstride[n] = field->dim[n].stride; | 258 » fstride[n] = GFC_DESCRIPTOR_STRIDE(field,n); |
| 261 » mstride[n] = mask->dim[n].stride * mask_kind; | 259 » mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n); |
| 262 } | 260 } |
| 263 if (rstride[0] == 0) | 261 if (rstride[0] == 0) |
| 264 rstride[0] = 1; | 262 rstride[0] = 1; |
| 265 } | 263 } |
| 266 | 264 |
| 267 if (empty) | 265 if (empty) |
| 268 return; | 266 return; |
| 269 | 267 |
| 270 if (fstride[0] == 0) | 268 if (fstride[0] == 0) |
| 271 fstride[0] = 1; | 269 fstride[0] = 1; |
| 272 if (mstride[0] == 0) | 270 if (mstride[0] == 0) |
| 273 mstride[0] = 1; | 271 mstride[0] = 1; |
| 274 | 272 |
| 275 vstride0 = vector->dim[0].stride; | 273 vstride0 = GFC_DESCRIPTOR_STRIDE(vector,0); |
| 276 if (vstride0 == 0) | 274 if (vstride0 == 0) |
| 277 vstride0 = 1; | 275 vstride0 = 1; |
| 278 rstride0 = rstride[0]; | 276 rstride0 = rstride[0]; |
| 279 fstride0 = fstride[0]; | 277 fstride0 = fstride[0]; |
| 280 mstride0 = mstride[0]; | 278 mstride0 = mstride[0]; |
| 281 rptr = ret->data; | 279 rptr = ret->data; |
| 282 fptr = field->data; | 280 fptr = field->data; |
| 283 vptr = vector->data; | 281 vptr = vector->data; |
| 284 | 282 |
| 285 while (rptr) | 283 while (rptr) |
| (...skipping 38 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
| 324 rptr += rstride[n]; | 322 rptr += rstride[n]; |
| 325 fptr += fstride[n]; | 323 fptr += fstride[n]; |
| 326 mptr += mstride[n]; | 324 mptr += mstride[n]; |
| 327 } | 325 } |
| 328 } | 326 } |
| 329 } | 327 } |
| 330 } | 328 } |
| 331 | 329 |
| 332 #endif | 330 #endif |
| 333 | 331 |
| OLD | NEW |