From 302e3218b7d487539ec305bf23881a6ee7d5be99 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:29 -0800
Subject: Import Upstream version 5e1

---
 ramap.c | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

(limited to 'ramap.c')

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\
 ");
-- 
cgit v1.2.3