suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix memory functions argument parsing, fix foreign tests

Browse Source 
svn: r5711
This commit is contained in:
Eli Barzilay 2007-03-01 06:38:30 +00:00
parent 1a43eb5a89
commit 1e0f84d937
3 changed files with 77 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/mzscheme/foreign-test.ss
View File

@ -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 #x00001212 ptr-ref p _int)
(test #x12120005 ptr-ref p _int))
(test (if (system-big-endian?) #x00001212 #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)

63
src/foreign/foreign.c
View File

@ -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;
int i = 0, j, ch = 0;
long soff = 0, doff = 0, count, v, mult = 0;
int i, j, ch = 0, argc1 = argc;
/* do the optional last ctype multiplier first, to use it later */
if (SCHEME_CTYPEP(argv[argc-1])) {
mult = ctype_sizeof(argv[argc-1]);
/* arg parsing: last optional ctype, then count, then fill byte for memset,
* then the first and second pointer+offset pair. */
/* 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 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;
else soff += v * mult;
if (mult) 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) {

63
src/foreign/foreign.ssc
View File

@ -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;
int i = 0, j, ch = 0;
long soff = 0, doff = 0, count, v, mult = 0;
int i, j, ch = 0, argc1 = argc;
/* do the optional last ctype multiplier first, to use it later */
if (SCHEME_CTYPEP(argv[argc-1])) {
mult = ctype_sizeof(argv[argc-1]);
/* arg parsing: last optional ctype, then count, then fill byte for memset,
* then the first and second pointer+offset pair. */
/* 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 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;
else soff += v * mult;
if (mult) 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) {