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

support 1-byte numbers in integer->integer-bytes and integer-bytes->integer

Browse Source
This commit is contained in:
rain 2017-07-21 18:30:52 +00:00 committed by Matthew Flatt
parent 2cf38ecad7
commit 8ee5d18107
2 changed files with 58 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-test-core/tests/racket/number.rktl
View File

@ -2931,6 +2931,11 @@
(test (integer-bytes->integer #"\1\2" #f) integer-bytes->integer #"\1\2" #f (system-big-endian?))
(define (test-integer-bytes->integer integer-bytes->integer)
(test #x22 integer-bytes->integer (bytes #x22) #t)
(test #x22 integer-bytes->integer (bytes #x22) #f)
(test #xFE integer-bytes->integer (bytes #xFE) #f)
(test (- #x7E) integer-bytes->integer (bytes #x82) #t)
(test 0 integer-bytes->integer #"\0\0" #t)
(test -1 integer-bytes->integer #"\377\377" #t)
(test 65535 integer-bytes->integer #"\377\377" #f)
@ -3002,7 +3007,6 @@
(arity-test integer-bytes->integer 2 5)
(err/rt-test (integer-bytes->integer 'ok #t))
(err/rt-test (integer-bytes->integer #"" #t))
(err/rt-test (integer-bytes->integer #"a" #t))
(err/rt-test (integer-bytes->integer #"abc" #t))
(err/rt-test (integer-bytes->integer #"abcdefghi" #t))
(err/rt-test (integer-bytes->integer #"abcdefghi" #t #f 0 3))
@ -3013,6 +3017,11 @@
(test (integer->integer-bytes 42 2 #f) integer->integer-bytes 42 2 #f (system-big-endian?))
(define (test-integer->integer-bytes integer->integer-bytes)
(test (bytes #x22) integer->integer-bytes #x22 1 #f)
(test (bytes #x22) integer->integer-bytes #x22 1 #t)
(test (bytes #xFE) integer->integer-bytes #xFE 1 #f)
(test (bytes #x82) integer->integer-bytes (- #x7E) 1 #t)
(test #"\0\0" integer->integer-bytes 0 2 #t)
(test #"\377\377" integer->integer-bytes -1 2 #t)
(test #"\377\377" integer->integer-bytes 65535 2 #f)

61
racket/src/racket/src/numstr.c
View File

@ -2145,6 +2145,19 @@ int scheme_check_long_double(const char *where, long_double d, const char *dest)
Scheme_Object *scheme_bytes_to_integer(char *str, int slen, int sgned, int rshft, int mask)
{
switch(slen) {
case 1:
if (sgned) {
char val;
memcpy(&val, str, sizeof(char));
return scheme_make_integer(val);
} else {
unsigned char val;
memcpy(&val, str, sizeof(unsigned char));
val >>= rshft;
if (mask < 8) { val &= (((unsigned char)1 << mask) - 1); }
return scheme_make_integer(val);
}
break;
case 2:
if (sgned) {
short val;
@ -2298,9 +2311,9 @@ static Scheme_Object *bytes_to_integer (int argc, Scheme_Object *argv[])
slen = strlen;
}
if ((slen != 2) && (slen != 4) && (slen != 8)) {
if ((slen != 1) && (slen != 2) && (slen != 4) && (slen != 8)) {
scheme_contract_error("integer-bytes->integer",
"length is not 2, 4, or 8 bytes",
"length is not 1, 2, 4, or 8 bytes",
"length", 1, scheme_make_integer(slen),
NULL);
return NULL;
@ -2342,8 +2355,8 @@ static Scheme_Object *integer_to_bytes(int argc, Scheme_Object *argv[])
size = SCHEME_INT_VAL(argv[1]);
else
size = 0;
if ((size != 2) && (size != 4) && (size != 8))
scheme_wrong_contract("integer->integer-bytes", "(or/c 2 4 8)", 1, argc, argv);
if ((size != 1) && (size != 2) && (size != 4) && (size != 8))
scheme_wrong_contract("integer->integer-bytes", "(or/c 1 2 4 8)", 1, argc, argv);
sgned = SCHEME_TRUEP(argv[2]);
if (argc > 3)
@ -2379,7 +2392,18 @@ static Scheme_Object *integer_to_bytes(int argc, Scheme_Object *argv[])
}
/* Check for mismatch: number doesn't fit */
if (size == 2) {
if (size == 1) {
if (SCHEME_BIGNUMP(n))
bad = 1;
else {
val = SCHEME_INT_VAL(n);
if (sgned) {
bad = ((val < -128) || (val > 127));
} else {
bad = ((val < 0) || (val > 255));
}
}
} else if (size == 2) {
if (SCHEME_BIGNUMP(n))
bad = 1;
else {
@ -2390,7 +2414,7 @@ static Scheme_Object *integer_to_bytes(int argc, Scheme_Object *argv[])
bad = ((val < 0) || (val > 65535));
}
}
} else if (size ==4) {
} else if (size == 4) {
if (sgned)
bad = !scheme_get_int_val(n, &val);
else
@ -2442,24 +2466,35 @@ static Scheme_Object *integer_to_bytes(int argc, Scheme_Object *argv[])
/* Finally, do the work */
str = (char *)buf;
switch (size) {
case 1:
{
if (sgned) {
char value = val;
memcpy(str, &value, sizeof(char));
} else {
unsigned char value = val;
memcpy(str, &value, sizeof(unsigned char));
}
}
break;
case 2:
{
if (sgned) {
unsigned short value = val;
memcpy(str, &value, sizeof(unsigned short));
} else {
short value = val;
memcpy(str, &value, sizeof(short));
} else {
unsigned short value = val;
memcpy(str, &value, sizeof(unsigned short));
}
}
break;
case 4:
if (sgned) {
unsigned int value = val;
memcpy(str, &value, sizeof(unsigned int));
int value = val;
memcpy(str, &value, sizeof(int));
} else {
int value = val;
memcpy(str, &value, sizeof(int));
unsigned int value = val;
memcpy(str, &value, sizeof(unsigned int));
}
break;
default: