diff options
author | Thomas Bushnell <tb@debian.org> | 2007-12-28 15:56:00 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:38 -0800 |
commit | 967ca9f9b4c42630fb0feb1e5b9186266fa4d854 (patch) | |
tree | 8bbb64f76bd25bf5dc59c856167f46f67cfca2e9 /ramap.c | |
parent | 25fbaa7f8700665d5aea046956175a35035f7fd5 (diff) | |
parent | 710a97992705d67c3ded0d4b270c5978ce29b11f (diff) | |
download | scm-967ca9f9b4c42630fb0feb1e5b9186266fa4d854.tar.gz scm-967ca9f9b4c42630fb0feb1e5b9186266fa4d854.zip |
Import Debian changes 5e4-1debian/5e4-1
scm (5e4-1) unstable; urgency=low
* New upstream release.
* debian/control: Require at least version 3a5 of slib.
* debian/postrm: New file to remove /usr/lib/scm/implcat and
/usr/lib/scm/slibcat upon purge. (Closes: #455124). Thanks to Kumar
Appaiah for the fix.
* debian/control (Architecture): Add armel and armeb. (Closes: #408792).
* debian/rules (install): Don't use -s when installing. dh_strip should
be sufficient, and this should make the nostrip build option work.
(Closes: #438004).
* continue.h: Repeat change from 5e1-2.
* xgen.scm: Repeat change from 5e2-4.
* scm.1: Repeat change from 5e2-4.
* build.scm: Repeat change from 5e3-5.
Diffstat (limited to 'ramap.c')
-rw-r--r-- | ramap.c | 76 |
1 files changed, 74 insertions, 2 deletions
@@ -1,4 +1,4 @@ -/* Copyright (C) 1994, 1995 Free Software Foundation, Inc. +/* Copyright (C) 1994, 1995, 2006 Free Software Foundation, Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -1546,6 +1546,77 @@ SCM array_for_each(proc, ra0, lra) } } +static char s_array_index_for_each[] = "array-index-for-each"; +SCM scm_array_index_for_each(ra, proc) + SCM ra, proc; +{ + SCM hp_av, hp_indv, auto_av[5]; + SCM *av = &auto_av[0]; + long auto_indv[5]; + long *indv = &auto_indv[0]; + sizet i; + ASRTER(NIMP(ra), ra, ARG1, s_array_index_for_each); + i = INUM(array_rank(ra)); +#ifndef RECKLESS + scm_arity_check(proc, i+0L, s_array_index_for_each); +#endif + if (i >= 5) { + scm_protect_temp(&hp_av); + scm_protect_temp(&hp_indv); + hp_av = make_vector(MAKINUM(i), BOOL_F); + av = VELTS(hp_av); + hp_indv = make_uve(i+0L, MAKINUM(-32L)); + indv = (long *)VELTS(hp_indv); + } + switch TYP7(ra) { + default: badarg: wta(ra, (char *)ARG1, s_array_index_for_each); + case tc7_vector: { + for (i = 0; i < LENGTH(ra); i++) { + av[0] = MAKINUM(i); + scm_cvapply(proc, 1L, av); + } + return UNSPECIFIED; + } + case tcs_uves: + for (i = 0; i < LENGTH(ra); i++) { + av[0] = MAKINUM(i); + scm_cvapply(proc, 1L, auto_av); + } + return UNSPECIFIED; + case tc7_smob: ASRTGO(ARRAYP(ra), badarg); + { + int j, k, kmax = ARRAY_NDIM(ra) - 1; + if (kmax < 0) + return apply(proc, EOL, EOL); + for (k = 0; k <= kmax; k++) + indv[k] = ARRAY_DIMS(ra)[k].lbnd; + k = kmax; + do { + if (k==kmax) { + indv[k] = ARRAY_DIMS(ra)[k].lbnd; + i = cind(ra, indv); + for (; indv[k] <= ARRAY_DIMS(ra)[k].ubnd; indv[k]++) { + for (j = kmax+1; j--;) + av[j] = MAKINUM(indv[j]); + scm_cvapply(proc, kmax+1L, av); + i += ARRAY_DIMS(ra)[k].inc; + } + k--; + continue; + } + if (indv[k] < ARRAY_DIMS(ra)[k].ubnd) { + indv[k]++; + k++; + continue; + } + indv[k] = ARRAY_DIMS(ra)[k].lbnd - 1; + k--; + } while (k >= 0); + return UNSPECIFIED; + } + } +} + static char s_array_imap[] = "array-index-map!"; SCM array_imap(ra, proc) SCM ra, proc; @@ -1788,12 +1859,13 @@ static iproc lsubr2s[] = { {s_sarray_map, array_map}, {s_array_for_each, array_for_each}, {s_array_imap, array_imap}, + {s_array_index_for_each, scm_array_index_for_each}, {0, 0}}; static void init_raprocs(subra) ra_iproc *subra; { - for(; subra->name; subra++) + for (; subra->name; subra++) subra->sproc = CDR(sysintern(subra->name, UNDEFINED)); } |