summaryrefslogtreecommitdiffstats
path: root/ramap.c
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit302e3218b7d487539ec305bf23881a6ee7d5be99 (patch)
treebf1adafe552a17b3b78522048bb7c24787696dd3 /ramap.c
parentc7d035ae1a729232579a0fe41ed5affa131d3623 (diff)
downloadscm-302e3218b7d487539ec305bf23881a6ee7d5be99.tar.gz
scm-302e3218b7d487539ec305bf23881a6ee7d5be99.zip
Import Upstream version 5e1upstream/5e1
Diffstat (limited to 'ramap.c')
-rw-r--r--ramap.c27
1 files changed, 17 insertions, 10 deletions
diff --git a/ramap.c b/ramap.c
index 42181ee..1ebafce 100644
--- a/ramap.c
+++ b/ramap.c
@@ -287,8 +287,8 @@ SCM array_fill(ra, fill)
return UNSPECIFIED;
}
-static char s_sarray_copy[] = "serial-array-copy!";
-# define s_array_copy (s_sarray_copy + 7)
+static char s_sarray_copy[] = "serial-array:copy!";
+static char s_array_copy[] = "array:copy!";
static int racp(src, dst)
SCM dst, src;
{
@@ -439,9 +439,9 @@ static int racp(src, dst)
}
return 1;
}
-SCM array_copy(src, dst)
- SCM src;
+SCM array_copy(dst, src)
SCM dst;
+ SCM src;
{
#ifndef RECKLESS
if (INUM0==array_rank(dst))
@@ -480,7 +480,7 @@ SCM ra2contig(ra, copy)
}
CAR(ret) |= ARRAY_CONTIGUOUS;
ARRAY_V(ret) = make_uve(inc+0L, array_prot(ra));
- if (copy) array_copy(ra, ret);
+ if (copy) array_copy(ret, ra);
return ret;
}
@@ -492,7 +492,7 @@ SCM ura_read(ra, port)
if (NIMP(ra) && ARRAYP(ra)) {
cra = ra2contig(ra, 0);
ret = uve_read(cra, port);
- if (cra != ra) array_copy(cra, ra);
+ if (cra != ra) array_copy(ra, cra);
return ret;
}
else return uve_read(ra, port);
@@ -1377,7 +1377,7 @@ static int rafe(ra0, proc, ras)
SCM heap_ve, auto_rav[5], auto_argv[5];
SCM *rav = &auto_rav[0], *argv = &auto_argv[0];
long argc = ilength(ras) + 1;
- long i, k, inc, n, base;
+ long i, k, n;
scm_protect_temp(&heap_ve);
if (argc >= 5) {
heap_ve = make_vector(MAKINUM(2*argc), BOOL_F);
@@ -1642,11 +1642,15 @@ static iproc subr2os[] = {
{s_ura_wr, ura_write},
{0, 0}};
+/* MinGW complains during a dll build that the string members are not
+ constants, since they are defined in another dll. These functions
+ individually initialized below.
static iproc subr2s[] = {
{s_array_fill, array_fill},
{s_array_copy, array_copy},
{s_sarray_copy, array_copy},
{0, 0}};
+*/
static iproc lsubr2s[] = {
{s_sc2array, sc2array},
@@ -1670,18 +1674,21 @@ void init_ramap()
init_raprocs(ra_rpsubrs);
init_raprocs(ra_asubrs);
init_iprocs(subr2os, tc7_subr_2o);
- init_iprocs(subr2s, tc7_subr_2);
+ /* init_iprocs(subr2s, tc7_subr_2); */
init_iprocs(lsubr2s, tc7_lsubr_2);
+ make_subr(s_array_fill, tc7_subr_2, array_fill);
+ make_subr(s_array_copy, tc7_subr_2, array_copy);
+ make_subr(s_sarray_copy, tc7_subr_2, array_copy);
make_subr(s_array_equalp, tc7_rpsubr, array_equal);
smobs[0x0ff & (tc16_array>>8)].equalp = raequal;
add_feature(s_array_for_each);
scm_ldstr("\n\
(define (array-indexes ra)\n\
- (let ((ra0 (apply create-array '#() (array-shape ra))))\n\
+ (let ((ra0 (apply make-array '#() (array-shape ra))))\n\
(array-index-map! ra0 list)\n\
ra0))\n\
(define (array-map prototype proc ra1 . ras)\n\
- (define nra (apply create-array prototype (array-shape ra1)))\n\
+ (define nra (apply make-array prototype (array-shape ra1)))\n\
(apply array-map! nra proc ra1 ras)\n\
nra)\n\
");