fix memory functions argument parsing, fix foreign tests

svn: r5711

collects/tests/mzscheme/foreign-test.ss

@@ -142,27 +142,26 @@
   (ptr-set! p _int 5)
   (test 5 ptr-ref p _int)
   (test 0 ptr-ref (ptr-add p 3 _int) _int)
-  (memcpy p 3 _int p 0 1 _int)
+  (memcpy p 3 p 0 1 _int)
   (test 5 ptr-ref (ptr-add p 3 _int) _int)
 
   ;; A MzScheme `int' is always 4 bytes.
-  (memset p 1 _int 17 9 _int)
+  (memset p 1 17 9 _int)
   (test 5 ptr-ref p _int)
   (test #x11111111 ptr-ref (ptr-add p 4) _int)
-  (memset p 2 18 9 _int)
+  (memset p 2 18 (* 9 (ctype-sizeof _int)))
   (test #x12121212 ptr-ref (ptr-add p 4) _int)
-  (if (system-big-endian?)
+  (test (if (system-big-endian?) #x00001212 #x12120005)
-      (test #x00001212 ptr-ref p _int)
+        ptr-ref p _int)
-      (test #x12120005 ptr-ref p _int))
 
   (ptr-set! (ptr-add p 4 _int) _int 10)
   (ptr-set! (ptr-add p 5 _int) _int 11)
   (ptr-set! (ptr-add p 6 _int) _int 12)
-  (memmove p 2 _int p 4 _int 3 _int)
+  (memmove p 2 p 4 3 _int)
   (test 10 ptr-ref (ptr-add p 2 _int) _int)
   (test 11 ptr-ref (ptr-add p 3 _int) _int)
   (test 12 ptr-ref (ptr-add p 4 _int) _int)
-  (memmove p 6 _short p 8 _byte 12)
+  (memmove p (* 6 (ctype-sizeof _short)) p 8 12)
   (test 10 ptr-ref (ptr-add p 2 _int) _int)
   (test 10 ptr-ref (ptr-add p 3 _int) _int)
   (test 11 ptr-ref (ptr-add p 4 _int) _int)
@@ -174,7 +173,8 @@
   (test #f ptr-equal? p (ptr-add p 3))
   (test #t ptr-equal? p (ptr-add (ptr-add p 3) -3))
   (test #f ptr-equal? #f (ptr-add #f 8))
-  (test #t ptr-equal? #f (ptr-add (ptr-add #f 8) -8)))
+  (test #t ptr-equal? #f (ptr-add (ptr-add #f 8) -8))
+  )
 
 (report-errs)
 

src/foreign/foreign.c

@@ -1942,20 +1942,39 @@ static Scheme_Object *do_memop(const char *who, int mode,
 /* mode 0=>memset, 1=>memmove, 2=>memcpy */
 {
   void *src = NULL, *dest = NULL;
-  long soff = 0, doff = 0, count, v, mult = 1;
+  long soff = 0, doff = 0, count, v, mult = 0;
-  int i = 0, j, ch = 0;
+  int i, j, ch = 0, argc1 = argc;
 
-  /* do the optional last ctype multiplier first, to use it later */
+  /* arg parsing: last optional ctype, then count, then fill byte for memset,
-  if (SCHEME_CTYPEP(argv[argc-1])) {
+   * then the first and second pointer+offset pair. */
-    mult = ctype_sizeof(argv[argc-1]);
+
+  /* get the optional last ctype multiplier */
+  if (SCHEME_CTYPEP(argv[argc1-1])) {
+    argc1--;
+    mult = ctype_sizeof(argv[argc1]);
     if (mult <= 0)
-      scheme_wrong_type(who, "non-void-C-type", argc-1, argc, argv);
+      scheme_wrong_type(who, "non-void-C-type", argc1, argc, argv);
   }
 
-  /* get the two pointers+offsets */
+  /* get the count argument */
+  argc1--;
+  if ((!scheme_get_int_val(argv[argc1], &count)) || (count < 0))
+    scheme_wrong_type(who, "count as " C_LONG_TYPE_STR, argc1, argc, argv);
+  if (mult) count *= mult;
+
+  /* get the fill byte for memset */
+  if (!mode) {
+    argc1--;
+    ch = SCHEME_INTP(argv[argc1]) ? SCHEME_INT_VAL(argv[argc1]) : -1;
+    if ((ch < 0) || (ch > 255))
+      scheme_wrong_type(who, "byte", argc1, argc, argv);
+  }
+
+  /* get the two pointers + offsets */
+  i = 0;
   for (j=0; j<2; j++) {
     if (!mode && j==1) break; /* memset needs only a dest argument */
-    if (!(i<argc))
+    if (!(i<argc1))
       scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                        "%s: missing a pointer argument for %s",
                        who, (j == 0 ? "destination" : "source"));
@@ -1970,36 +1989,20 @@ static Scheme_Object *do_memop(const char *who, int mode,
             break;
     }
     i++;
-    if ((i<argc) && SCHEME_EXACT_INTEGERP(argv[i])) {
+    if ((i<argc1) && SCHEME_EXACT_INTEGERP(argv[i])) {
       if (!scheme_get_int_val(argv[i], &v))
         scheme_wrong_type(who, C_LONG_TYPE_STR, i, argc, argv);
-      if (j==0) doff += v * mult;
+      if (mult) v *= mult;
-      else      soff += v * mult;
+      switch (j) {
+      case 0: doff += v; break;
+      case 1: soff += v; break;
+      }
       i++;
     }
   }
 
-  /* get the fill byte for memset */
-  if (!mode) {
-    if (!(i<argc))
-      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
-                       "%s: missing the fill-byte argument", who);
-    ch = SCHEME_INTP(argv[i]) ? SCHEME_INT_VAL(argv[i]) : -1;
-    if ((ch < 0) || (ch > 255))
-      scheme_wrong_type(who, "byte", i, argc, argv);
-    i++;
-  }
-
-  /* get the count */
-  if (!(i<argc))
-    scheme_raise_exn(MZEXN_FAIL_CONTRACT, "%s: missing count", who);
-  if (!scheme_get_int_val(argv[i], &count))
-    scheme_wrong_type(who, "count as " C_LONG_TYPE_STR, i, argc, argv);
-  count *= mult;
-  i++;
-
   /* verify that there are no unused leftovers */
-  if (!(i==argc || (i==(argc-1) && SCHEME_CTYPEP(argv[argc-1]))))
+  if (!(i==argc1))
     scheme_arg_mismatch(who, "unexpected extra argument: ", argv[i]);
 
   switch (mode) {

src/foreign/foreign.ssc

@@ -1409,20 +1409,39 @@ static Scheme_Object *do_memop(const char *who, int mode,
 /* mode 0=>memset, 1=>memmove, 2=>memcpy */
 {
   void *src = NULL, *dest = NULL;
-  long soff = 0, doff = 0, count, v, mult = 1;
+  long soff = 0, doff = 0, count, v, mult = 0;
-  int i = 0, j, ch = 0;
+  int i, j, ch = 0, argc1 = argc;
 
-  /* do the optional last ctype multiplier first, to use it later */
+  /* arg parsing: last optional ctype, then count, then fill byte for memset,
-  if (SCHEME_CTYPEP(argv[argc-1])) {
+   * then the first and second pointer+offset pair. */
-    mult = ctype_sizeof(argv[argc-1]);
+
+  /* get the optional last ctype multiplier */
+  if (SCHEME_CTYPEP(argv[argc1-1])) {
+    argc1--;
+    mult = ctype_sizeof(argv[argc1]);
     if (mult <= 0)
-      scheme_wrong_type(who, "non-void-C-type", argc-1, argc, argv);
+      scheme_wrong_type(who, "non-void-C-type", argc1, argc, argv);
   }
 
-  /* get the two pointers+offsets */
+  /* get the count argument */
+  argc1--;
+  if ((!scheme_get_int_val(argv[argc1], &count)) || (count < 0))
+    scheme_wrong_type(who, "count as " C_LONG_TYPE_STR, argc1, argc, argv);
+  if (mult) count *= mult;
+
+  /* get the fill byte for memset */
+  if (!mode) {
+    argc1--;
+    ch = SCHEME_INTP(argv[argc1]) ? SCHEME_INT_VAL(argv[argc1]) : -1;
+    if ((ch < 0) || (ch > 255))
+      scheme_wrong_type(who, "byte", argc1, argc, argv);
+  }
+
+  /* get the two pointers + offsets */
+  i = 0;
   for (j=0; j<2; j++) {
     if (!mode && j==1) break; /* memset needs only a dest argument */
-    if (!(i<argc))
+    if (!(i<argc1))
       scheme_raise_exn(MZEXN_FAIL_CONTRACT,
                        "%s: missing a pointer argument for %s",
                        who, (j == 0 ? "destination" : "source"));
@@ -1437,36 +1456,20 @@ static Scheme_Object *do_memop(const char *who, int mode,
             break;
     }
     i++;
-    if ((i<argc) && SCHEME_EXACT_INTEGERP(argv[i])) {
+    if ((i<argc1) && SCHEME_EXACT_INTEGERP(argv[i])) {
       if (!scheme_get_int_val(argv[i], &v))
         scheme_wrong_type(who, C_LONG_TYPE_STR, i, argc, argv);
-      if (j==0) doff += v * mult;
+      if (mult) v *= mult;
-      else      soff += v * mult;
+      switch (j) {
+      case 0: doff += v; break;
+      case 1: soff += v; break;
+      }
       i++;
     }
   }
 
-  /* get the fill byte for memset */
-  if (!mode) {
-    if (!(i<argc))
-      scheme_raise_exn(MZEXN_FAIL_CONTRACT,
-                       "%s: missing the fill-byte argument", who);
-    ch = SCHEME_INTP(argv[i]) ? SCHEME_INT_VAL(argv[i]) : -1;
-    if ((ch < 0) || (ch > 255))
-      scheme_wrong_type(who, "byte", i, argc, argv);
-    i++;
-  }
-
-  /* get the count */
-  if (!(i<argc))
-    scheme_raise_exn(MZEXN_FAIL_CONTRACT, "%s: missing count", who);
-  if (!scheme_get_int_val(argv[i], &count))
-    scheme_wrong_type(who, "count as " C_LONG_TYPE_STR, i, argc, argv);
-  count *= mult;
-  i++;
-
   /* verify that there are no unused leftovers */
-  if (!(i==argc || (i==(argc-1) && SCHEME_CTYPEP(argv[argc-1]))))
+  if (!(i==argc1))
     scheme_arg_mismatch(who, "unexpected extra argument: ", argv[i]);
 
   switch (mode) {