diff options
Diffstat (limited to 'ramap.c')
-rw-r--r-- | ramap.c | 27 |
1 files changed, 17 insertions, 10 deletions
@@ -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\ "); |