[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 23/24: Remove commented stack version of scm_array_for_e
From: |
Daniel Llorens |
Subject: |
[Guile-commits] 23/24: Remove commented stack version of scm_array_for_each_cell() |
Date: |
Thu, 23 Jun 2016 10:22:16 +0000 (UTC) |
lloda pushed a commit to branch lloda-array-support
in repository guile.
commit 9aa5f6fedcf38cbcfb053954e23e4f511ee05063
Author: Daniel Llorens <address@hidden>
Date: Wed Jun 22 14:55:27 2016 +0200
Remove commented stack version of scm_array_for_each_cell()
* libguile/array-map.c: Ditto.
---
libguile/array-map.c | 214 --------------------------------------------------
1 file changed, 214 deletions(-)
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 5271765..543c784 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -886,220 +886,6 @@ SCM_DEFINE (scm_array_for_each_cell,
"array-for-each-cell", 2, 0, 1,
}
#undef FUNC_NAME
-/*
-SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
- (SCM frame_rank, SCM op, SCM args),
- "Apply @var{op} to each of the cells of rank
rank(@var{arg})address@hidden"
- "of the arrays @var{args}, in unspecified order. The first\n"
- "@var{frame_rank} dimensions of each @var{arg} must match.\n"
- "Rank-0 cells are passed as rank-0 arrays.\n\n"
- "The value returned is unspecified.\n\n"
- "For example:\n"
- "@lisp\n"
- ";; Sort the rows of rank-2 array A.\n\n"
- "(array-for-each-cell 1 (lambda (x) (sort! x <)) a)\n"
- "\n"
- ";; Compute the arguments of the (x y) vectors in the rows of
rank-2\n"
- ";; array XYS and store them in rank-1 array ANGLES. Inside OP,\n"
- ";; XY is a rank-1 (2-1) array, and ANGLE is a rank-0 (1-1)
array.\n\n"
- "(array-for-each-cell 1 \n"
- " (lambda (xy angle)\n"
- " (array-set! angle (atan (array-ref xy 1) (array-ref xy
0))))\n"
- " xys angles)\n"
- "@end lisp")
-#define FUNC_NAME s_scm_array_for_each_cell
-{
- // FIXME replace stack by scm_gc_malloc_pointerless()
- int const N = scm_ilength (args);
- int const frank = scm_to_int (frame_rank);
- SCM dargs_ = SCM_EOL;
-
- scm_t_array_handle ah[N];
- SCM args_[N];
- scm_t_array_dim * as[N];
- int rank[N];
-
- ssize_t s[frank];
- SCM ai[N];
- SCM * dargs[N];
- ssize_t i[frank];
-
- int order[frank];
- size_t base[N];
-
- for (int n=0; scm_is_pair(args); args=scm_cdr(args), ++n)
- {
- args_[n] = scm_car(args);
- scm_array_get_handle(args_[n], ah+n);
- as[n] = scm_array_handle_dims(ah+n);
- rank[n] = scm_array_handle_rank(ah+n);
- }
- // checks.
- char const * msg = NULL;
- if (frank<0)
- {
- msg = "bad frame rank";
- }
- else
- {
- for (int n=0; n!=N; ++n)
- {
- if (rank[n]<frank)
- {
- msg = "frame too large for arguments";
- goto check_msg;
- }
- for (int k=0; k!=frank; ++k)
- {
- if (as[n][k].lbnd!=0)
- {
- msg = "non-zero base index is not supported";
- goto check_msg;
- }
- if (as[0][k].ubnd!=as[n][k].ubnd)
- {
- msg = "mismatched frames";
- goto check_msg;
- }
- s[k] = as[n][k].ubnd + 1;
-
- // this check is needed if the array cannot be entirely
- // unrolled, because the unrolled subloop will be run before
- // checking the dimensions of the frame.
- if (s[k]==0)
- {
- goto end;
- }
- }
- }
- }
- check_msg: ;
- if (msg!=NULL)
- {
- for (int n=0; n!=N; ++n)
- {
- scm_array_handle_release(ah+n);
- }
- scm_misc_error("array-for-each-cell", msg, scm_cons_star(frame_rank,
args));
- }
- // prepare moving cells.
- for (int n=0; n!=N; ++n)
- {
- ai[n] = scm_i_make_array(rank[n]-frank);
- SCM_I_ARRAY_SET_V (ai[n], scm_shared_array_root(args_[n]));
- // FIXME scm_array_handle_base (ah+n) should be in Guile
- SCM_I_ARRAY_SET_BASE (ai[n], ah[n].base);
- scm_t_array_dim * ais = SCM_I_ARRAY_DIMS(ai[n]);
- for (int k=frank; k!=rank[n]; ++k)
- {
- ais[k-frank] = as[n][k];
- }
- }
- // prepare rest list for callee.
- {
- SCM *p = &dargs_;
- for (int n=0; n<N; ++n)
- {
- *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
- dargs[n] = SCM_CARLOC (*p);
- p = SCM_CDRLOC (*p);
- }
- }
- // special case for rank 0.
- if (frank==0)
- {
- for (int n=0; n<N; ++n)
- {
- *dargs[n] = ai[n];
- }
- scm_apply_0(op, dargs_);
- for (int n=0; n<N; ++n)
- {
- scm_array_handle_release(ah+n);
- }
- return SCM_UNSPECIFIED;
- }
- // FIXME determine best looping order.
- for (int k=0; k!=frank; ++k)
- {
- i[k] = 0;
- order[k] = frank-1-k;
- }
- // find outermost compact dim.
- ssize_t step = s[order[0]];
- int ocd = 1;
- for (; ocd<frank; step *= s[order[ocd]], ++ocd)
- {
- for (int n=0; n!=N; ++n)
- {
- if (step*as[n][order[0]].inc!=as[n][order[ocd]].inc)
- {
- goto ocd_reached;
- }
- }
- }
- ocd_reached: ;
- // rank loop.
- for (int n=0; n!=N; ++n)
- {
- base[n] = SCM_I_ARRAY_BASE(ai[n]);
- }
- for (;;)
- {
- // unrolled loop.
- for (ssize_t z=0; z!=step; ++z)
- {
- // we are forced to create fresh array descriptors for each
- // call since we don't know whether the callee will keep them,
- // and Guile offers no way to copy the descriptor (since
- // descriptors are immutable). Yet another reason why this
- // should be in Scheme.
- for (int n=0; n<N; ++n)
- {
- *dargs[n] = scm_i_array_rebase(ai[n], base[n]);
- base[n] += as[n][order[0]].inc;
- }
- scm_apply_0(op, dargs_);
- }
- for (int n=0; n<N; ++n)
- {
- base[n] -= step*as[n][order[0]].inc;
- }
- for (int k=ocd; ; ++k)
- {
- if (k==frank)
- {
- goto end;
- }
- else if (i[order[k]]<s[order[k]]-1)
- {
- ++i[order[k]];
- for (int n=0; n<N; ++n)
- {
- base[n] += as[n][order[k]].inc;
- }
- break;
- }
- else
- {
- i[order[k]] = 0;
- for (int n=0; n<N; ++n)
- {
- base[n] += as[n][order[k]].inc*(1-s[order[k]]);
- }
- }
- }
- }
- end:;
- for (int n=0; n<N; ++n)
- {
- scm_array_handle_release(ah+n);
- }
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-*/
-
SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order",
2, 0, 1,
(SCM frank, SCM op, SCM a),
"Same as array-for-each-cell, but visit the cells sequentially\n"
- [Guile-commits] 10/24: Fix compilation of rank 0 typed array literals, (continued)
- [Guile-commits] 10/24: Fix compilation of rank 0 typed array literals, Daniel Llorens, 2016/06/23
- [Guile-commits] 04/24: Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle, Daniel Llorens, 2016/06/23
- [Guile-commits] 05/24: Compile in C99 mode, Daniel Llorens, 2016/06/23
- [Guile-commits] 17/24: New export (array-for-each-cell-in-order), Daniel Llorens, 2016/06/23
- [Guile-commits] 13/24: Remove deprecated and unused generalized-vector functions, Daniel Llorens, 2016/06/23
- [Guile-commits] 19/24: Avoid variable stack use in scm_array_for_each_cell(), Daniel Llorens, 2016/06/23
- [Guile-commits] 15/24: Draft of (array-for-each-cell), Daniel Llorens, 2016/06/23
- [Guile-commits] 11/24: Remove deprecated array functions, Daniel Llorens, 2016/06/23
- [Guile-commits] 21/24: Fix a corner case with empty arrays in (array-for-each-cell), Daniel Llorens, 2016/06/23
- [Guile-commits] 24/24: Remove uniform-array-read!, uniform-array-write from the manual, Daniel Llorens, 2016/06/23
- [Guile-commits] 23/24: Remove commented stack version of scm_array_for_each_cell(),
Daniel Llorens <=
- [Guile-commits] 06/24: New functions array-from, array-from*, array-set-from!, Daniel Llorens, 2016/06/23
- [Guile-commits] 02/24: Remove scm_from_contiguous_array, Daniel Llorens, 2016/06/23
- [Guile-commits] 18/24: Special case for array-map! with three arguments, Daniel Llorens, 2016/06/23
- [Guile-commits] 14/24: Do not use array handles in scm_vector, Daniel Llorens, 2016/06/23
- [Guile-commits] 22/24: Fix pool version of scm_array_for_each_cell by aligning pointers, Daniel Llorens, 2016/06/23
- [Guile-commits] 08/24: Rename array-set-from!, scm_array_set_from_x to array-amend!, scm_array_amend_x, Daniel Llorens, 2016/06/23
- [Guile-commits] 03/24: Unuse array 'contiguous' flag, Daniel Llorens, 2016/06/23
- [Guile-commits] 12/24: Speed up for multi-arg cases of scm_ramap functions, Daniel Llorens, 2016/06/23
- [Guile-commits] 09/24: Don't use array handles in scm_c_array_rank, Daniel Llorens, 2016/06/23
- [Guile-commits] 07/24: Tests & doc for array-from, array-from*, array-set-from!, Daniel Llorens, 2016/06/23