PageRenderTime 56ms CodeModel.GetById 28ms RepoModel.GetById 0ms app.codeStats 0ms

/libgfortran/generated/minval_i1.c

https://bitbucket.org/Underworld79/toolchain_gcc-4.8
C | 545 lines | 425 code | 75 blank | 45 comment | 94 complexity | 17f182d458c161275a865af5bc7a6076 MD5 | raw file
  1. /* Implementation of the MINVAL intrinsic
  2. Copyright (C) 2002-2013 Free Software Foundation, Inc.
  3. Contributed by Paul Brook <paul@nowt.org>
  4. This file is part of the GNU Fortran runtime library (libgfortran).
  5. Libgfortran is free software; you can redistribute it and/or
  6. modify it under the terms of the GNU General Public
  7. License as published by the Free Software Foundation; either
  8. version 3 of the License, or (at your option) any later version.
  9. Libgfortran is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. Under Section 7 of GPL version 3, you are granted additional
  14. permissions described in the GCC Runtime Library Exception, version
  15. 3.1, as published by the Free Software Foundation.
  16. You should have received a copy of the GNU General Public License and
  17. a copy of the GCC Runtime Library Exception along with this program;
  18. see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
  19. <http://www.gnu.org/licenses/>. */
  20. #include "libgfortran.h"
  21. #include <stdlib.h>
  22. #include <assert.h>
  23. #if defined (HAVE_GFC_INTEGER_1) && defined (HAVE_GFC_INTEGER_1)
  24. extern void minval_i1 (gfc_array_i1 * const restrict,
  25. gfc_array_i1 * const restrict, const index_type * const restrict);
  26. export_proto(minval_i1);
  27. void
  28. minval_i1 (gfc_array_i1 * const restrict retarray,
  29. gfc_array_i1 * const restrict array,
  30. const index_type * const restrict pdim)
  31. {
  32. index_type count[GFC_MAX_DIMENSIONS];
  33. index_type extent[GFC_MAX_DIMENSIONS];
  34. index_type sstride[GFC_MAX_DIMENSIONS];
  35. index_type dstride[GFC_MAX_DIMENSIONS];
  36. const GFC_INTEGER_1 * restrict base;
  37. GFC_INTEGER_1 * restrict dest;
  38. index_type rank;
  39. index_type n;
  40. index_type len;
  41. index_type delta;
  42. index_type dim;
  43. int continue_loop;
  44. /* Make dim zero based to avoid confusion. */
  45. dim = (*pdim) - 1;
  46. rank = GFC_DESCRIPTOR_RANK (array) - 1;
  47. len = GFC_DESCRIPTOR_EXTENT(array,dim);
  48. if (len < 0)
  49. len = 0;
  50. delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  51. for (n = 0; n < dim; n++)
  52. {
  53. sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
  54. extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
  55. if (extent[n] < 0)
  56. extent[n] = 0;
  57. }
  58. for (n = dim; n < rank; n++)
  59. {
  60. sstride[n] = GFC_DESCRIPTOR_STRIDE(array, n + 1);
  61. extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
  62. if (extent[n] < 0)
  63. extent[n] = 0;
  64. }
  65. if (retarray->base_addr == NULL)
  66. {
  67. size_t alloc_size, str;
  68. for (n = 0; n < rank; n++)
  69. {
  70. if (n == 0)
  71. str = 1;
  72. else
  73. str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
  74. GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
  75. }
  76. retarray->offset = 0;
  77. retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
  78. alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
  79. * extent[rank-1];
  80. retarray->base_addr = xmalloc (alloc_size);
  81. if (alloc_size == 0)
  82. {
  83. /* Make sure we have a zero-sized array. */
  84. GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
  85. return;
  86. }
  87. }
  88. else
  89. {
  90. if (rank != GFC_DESCRIPTOR_RANK (retarray))
  91. runtime_error ("rank of return array incorrect in"
  92. " MINVAL intrinsic: is %ld, should be %ld",
  93. (long int) (GFC_DESCRIPTOR_RANK (retarray)),
  94. (long int) rank);
  95. if (unlikely (compile_options.bounds_check))
  96. bounds_ifunction_return ((array_t *) retarray, extent,
  97. "return value", "MINVAL");
  98. }
  99. for (n = 0; n < rank; n++)
  100. {
  101. count[n] = 0;
  102. dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
  103. if (extent[n] <= 0)
  104. return;
  105. }
  106. base = array->base_addr;
  107. dest = retarray->base_addr;
  108. continue_loop = 1;
  109. while (continue_loop)
  110. {
  111. const GFC_INTEGER_1 * restrict src;
  112. GFC_INTEGER_1 result;
  113. src = base;
  114. {
  115. #if defined (GFC_INTEGER_1_INFINITY)
  116. result = GFC_INTEGER_1_INFINITY;
  117. #else
  118. result = GFC_INTEGER_1_HUGE;
  119. #endif
  120. if (len <= 0)
  121. *dest = GFC_INTEGER_1_HUGE;
  122. else
  123. {
  124. for (n = 0; n < len; n++, src += delta)
  125. {
  126. #if defined (GFC_INTEGER_1_QUIET_NAN)
  127. if (*src <= result)
  128. break;
  129. }
  130. if (unlikely (n >= len))
  131. result = GFC_INTEGER_1_QUIET_NAN;
  132. else for (; n < len; n++, src += delta)
  133. {
  134. #endif
  135. if (*src < result)
  136. result = *src;
  137. }
  138. *dest = result;
  139. }
  140. }
  141. /* Advance to the next element. */
  142. count[0]++;
  143. base += sstride[0];
  144. dest += dstride[0];
  145. n = 0;
  146. while (count[n] == extent[n])
  147. {
  148. /* When we get to the end of a dimension, reset it and increment
  149. the next dimension. */
  150. count[n] = 0;
  151. /* We could precalculate these products, but this is a less
  152. frequently used path so probably not worth it. */
  153. base -= sstride[n] * extent[n];
  154. dest -= dstride[n] * extent[n];
  155. n++;
  156. if (n == rank)
  157. {
  158. /* Break out of the look. */
  159. continue_loop = 0;
  160. break;
  161. }
  162. else
  163. {
  164. count[n]++;
  165. base += sstride[n];
  166. dest += dstride[n];
  167. }
  168. }
  169. }
  170. }
  171. extern void mminval_i1 (gfc_array_i1 * const restrict,
  172. gfc_array_i1 * const restrict, const index_type * const restrict,
  173. gfc_array_l1 * const restrict);
  174. export_proto(mminval_i1);
  175. void
  176. mminval_i1 (gfc_array_i1 * const restrict retarray,
  177. gfc_array_i1 * const restrict array,
  178. const index_type * const restrict pdim,
  179. gfc_array_l1 * const restrict mask)
  180. {
  181. index_type count[GFC_MAX_DIMENSIONS];
  182. index_type extent[GFC_MAX_DIMENSIONS];
  183. index_type sstride[GFC_MAX_DIMENSIONS];
  184. index_type dstride[GFC_MAX_DIMENSIONS];
  185. index_type mstride[GFC_MAX_DIMENSIONS];
  186. GFC_INTEGER_1 * restrict dest;
  187. const GFC_INTEGER_1 * restrict base;
  188. const GFC_LOGICAL_1 * restrict mbase;
  189. int rank;
  190. int dim;
  191. index_type n;
  192. index_type len;
  193. index_type delta;
  194. index_type mdelta;
  195. int mask_kind;
  196. dim = (*pdim) - 1;
  197. rank = GFC_DESCRIPTOR_RANK (array) - 1;
  198. len = GFC_DESCRIPTOR_EXTENT(array,dim);
  199. if (len <= 0)
  200. return;
  201. mbase = mask->base_addr;
  202. mask_kind = GFC_DESCRIPTOR_SIZE (mask);
  203. if (mask_kind == 1 || mask_kind == 2 || mask_kind == 4 || mask_kind == 8
  204. #ifdef HAVE_GFC_LOGICAL_16
  205. || mask_kind == 16
  206. #endif
  207. )
  208. mbase = GFOR_POINTER_TO_L1 (mbase, mask_kind);
  209. else
  210. runtime_error ("Funny sized logical array");
  211. delta = GFC_DESCRIPTOR_STRIDE(array,dim);
  212. mdelta = GFC_DESCRIPTOR_STRIDE_BYTES(mask,dim);
  213. for (n = 0; n < dim; n++)
  214. {
  215. sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n);
  216. mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
  217. extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
  218. if (extent[n] < 0)
  219. extent[n] = 0;
  220. }
  221. for (n = dim; n < rank; n++)
  222. {
  223. sstride[n] = GFC_DESCRIPTOR_STRIDE(array,n + 1);
  224. mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask, n + 1);
  225. extent[n] = GFC_DESCRIPTOR_EXTENT(array, n + 1);
  226. if (extent[n] < 0)
  227. extent[n] = 0;
  228. }
  229. if (retarray->base_addr == NULL)
  230. {
  231. size_t alloc_size, str;
  232. for (n = 0; n < rank; n++)
  233. {
  234. if (n == 0)
  235. str = 1;
  236. else
  237. str= GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
  238. GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
  239. }
  240. alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
  241. * extent[rank-1];
  242. retarray->offset = 0;
  243. retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
  244. if (alloc_size == 0)
  245. {
  246. /* Make sure we have a zero-sized array. */
  247. GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
  248. return;
  249. }
  250. else
  251. retarray->base_addr = xmalloc (alloc_size);
  252. }
  253. else
  254. {
  255. if (rank != GFC_DESCRIPTOR_RANK (retarray))
  256. runtime_error ("rank of return array incorrect in MINVAL intrinsic");
  257. if (unlikely (compile_options.bounds_check))
  258. {
  259. bounds_ifunction_return ((array_t *) retarray, extent,
  260. "return value", "MINVAL");
  261. bounds_equal_extents ((array_t *) mask, (array_t *) array,
  262. "MASK argument", "MINVAL");
  263. }
  264. }
  265. for (n = 0; n < rank; n++)
  266. {
  267. count[n] = 0;
  268. dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
  269. if (extent[n] <= 0)
  270. return;
  271. }
  272. dest = retarray->base_addr;
  273. base = array->base_addr;
  274. while (base)
  275. {
  276. const GFC_INTEGER_1 * restrict src;
  277. const GFC_LOGICAL_1 * restrict msrc;
  278. GFC_INTEGER_1 result;
  279. src = base;
  280. msrc = mbase;
  281. {
  282. #if defined (GFC_INTEGER_1_INFINITY)
  283. result = GFC_INTEGER_1_INFINITY;
  284. #else
  285. result = GFC_INTEGER_1_HUGE;
  286. #endif
  287. #if defined (GFC_INTEGER_1_QUIET_NAN)
  288. int non_empty_p = 0;
  289. #endif
  290. for (n = 0; n < len; n++, src += delta, msrc += mdelta)
  291. {
  292. #if defined (GFC_INTEGER_1_INFINITY) || defined (GFC_INTEGER_1_QUIET_NAN)
  293. if (*msrc)
  294. {
  295. #if defined (GFC_INTEGER_1_QUIET_NAN)
  296. non_empty_p = 1;
  297. if (*src <= result)
  298. #endif
  299. break;
  300. }
  301. }
  302. if (unlikely (n >= len))
  303. {
  304. #if defined (GFC_INTEGER_1_QUIET_NAN)
  305. result = non_empty_p ? GFC_INTEGER_1_QUIET_NAN : GFC_INTEGER_1_HUGE;
  306. #else
  307. result = GFC_INTEGER_1_HUGE;
  308. #endif
  309. }
  310. else for (; n < len; n++, src += delta, msrc += mdelta)
  311. {
  312. #endif
  313. if (*msrc && *src < result)
  314. result = *src;
  315. }
  316. *dest = result;
  317. }
  318. /* Advance to the next element. */
  319. count[0]++;
  320. base += sstride[0];
  321. mbase += mstride[0];
  322. dest += dstride[0];
  323. n = 0;
  324. while (count[n] == extent[n])
  325. {
  326. /* When we get to the end of a dimension, reset it and increment
  327. the next dimension. */
  328. count[n] = 0;
  329. /* We could precalculate these products, but this is a less
  330. frequently used path so probably not worth it. */
  331. base -= sstride[n] * extent[n];
  332. mbase -= mstride[n] * extent[n];
  333. dest -= dstride[n] * extent[n];
  334. n++;
  335. if (n == rank)
  336. {
  337. /* Break out of the look. */
  338. base = NULL;
  339. break;
  340. }
  341. else
  342. {
  343. count[n]++;
  344. base += sstride[n];
  345. mbase += mstride[n];
  346. dest += dstride[n];
  347. }
  348. }
  349. }
  350. }
  351. extern void sminval_i1 (gfc_array_i1 * const restrict,
  352. gfc_array_i1 * const restrict, const index_type * const restrict,
  353. GFC_LOGICAL_4 *);
  354. export_proto(sminval_i1);
  355. void
  356. sminval_i1 (gfc_array_i1 * const restrict retarray,
  357. gfc_array_i1 * const restrict array,
  358. const index_type * const restrict pdim,
  359. GFC_LOGICAL_4 * mask)
  360. {
  361. index_type count[GFC_MAX_DIMENSIONS];
  362. index_type extent[GFC_MAX_DIMENSIONS];
  363. index_type dstride[GFC_MAX_DIMENSIONS];
  364. GFC_INTEGER_1 * restrict dest;
  365. index_type rank;
  366. index_type n;
  367. index_type dim;
  368. if (*mask)
  369. {
  370. minval_i1 (retarray, array, pdim);
  371. return;
  372. }
  373. /* Make dim zero based to avoid confusion. */
  374. dim = (*pdim) - 1;
  375. rank = GFC_DESCRIPTOR_RANK (array) - 1;
  376. for (n = 0; n < dim; n++)
  377. {
  378. extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
  379. if (extent[n] <= 0)
  380. extent[n] = 0;
  381. }
  382. for (n = dim; n < rank; n++)
  383. {
  384. extent[n] =
  385. GFC_DESCRIPTOR_EXTENT(array,n + 1);
  386. if (extent[n] <= 0)
  387. extent[n] = 0;
  388. }
  389. if (retarray->base_addr == NULL)
  390. {
  391. size_t alloc_size, str;
  392. for (n = 0; n < rank; n++)
  393. {
  394. if (n == 0)
  395. str = 1;
  396. else
  397. str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
  398. GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
  399. }
  400. retarray->offset = 0;
  401. retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
  402. alloc_size = sizeof (GFC_INTEGER_1) * GFC_DESCRIPTOR_STRIDE(retarray,rank-1)
  403. * extent[rank-1];
  404. if (alloc_size == 0)
  405. {
  406. /* Make sure we have a zero-sized array. */
  407. GFC_DIMENSION_SET(retarray->dim[0], 0, -1, 1);
  408. return;
  409. }
  410. else
  411. retarray->base_addr = xmalloc (alloc_size);
  412. }
  413. else
  414. {
  415. if (rank != GFC_DESCRIPTOR_RANK (retarray))
  416. runtime_error ("rank of return array incorrect in"
  417. " MINVAL intrinsic: is %ld, should be %ld",
  418. (long int) (GFC_DESCRIPTOR_RANK (retarray)),
  419. (long int) rank);
  420. if (unlikely (compile_options.bounds_check))
  421. {
  422. for (n=0; n < rank; n++)
  423. {
  424. index_type ret_extent;
  425. ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
  426. if (extent[n] != ret_extent)
  427. runtime_error ("Incorrect extent in return value of"
  428. " MINVAL intrinsic in dimension %ld:"
  429. " is %ld, should be %ld", (long int) n + 1,
  430. (long int) ret_extent, (long int) extent[n]);
  431. }
  432. }
  433. }
  434. for (n = 0; n < rank; n++)
  435. {
  436. count[n] = 0;
  437. dstride[n] = GFC_DESCRIPTOR_STRIDE(retarray,n);
  438. }
  439. dest = retarray->base_addr;
  440. while(1)
  441. {
  442. *dest = GFC_INTEGER_1_HUGE;
  443. count[0]++;
  444. dest += dstride[0];
  445. n = 0;
  446. while (count[n] == extent[n])
  447. {
  448. /* When we get to the end of a dimension, reset it and increment
  449. the next dimension. */
  450. count[n] = 0;
  451. /* We could precalculate these products, but this is a less
  452. frequently used path so probably not worth it. */
  453. dest -= dstride[n] * extent[n];
  454. n++;
  455. if (n == rank)
  456. return;
  457. else
  458. {
  459. count[n]++;
  460. dest += dstride[n];
  461. }
  462. }
  463. }
  464. }
  465. #endif