conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Added [un]signed-long-long types as valid parameter types to 

callouts and callbacks (in both 32 and 64 bit modes). (UNTESTED)
This commit is contained in:
Abdulaziz Ghuloum 2009-04-11 02:16:00 +03:00
parent a44a00b405
commit 6bab4af5b4
4 changed files with 48 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
scheme/ikarus.pointers.ss
View File

@ -186,17 +186,19 @@
(f (+ i 1))))))))))] (f (+ i 1))))))))))]
[else [else
(case t (case t
[(unsigned-char) int?] [(unsigned-char) int?]
[(signed-char) int?] [(signed-char) int?]
[(unsigned-short) int?] [(unsigned-short) int?]
[(signed-short) int?] [(signed-short) int?]
[(unsigned-int) int?] [(unsigned-int) int?]
[(signed-int) int?] [(signed-int) int?]
[(unsigned-long) int?] [(unsigned-long) int?]
[(signed-long) int?] [(signed-long) int?]
[(float) flonum?] [(unsigned-long-long) int?]
[(double) flonum?] [(signed-long-long) int?]
[(pointer) pointer?] [(float) flonum?]
[(double) flonum?]
[(pointer) pointer?]
[else (die who "invalid type" t)])])) [else (die who "invalid type" t)])]))
checker) checker)
@ -209,18 +211,20 @@
[(vector? x) (vector-map convert x)] [(vector? x) (vector-map convert x)]
[else [else
(case x (case x
[(void) 1] [(void) 1]
[(unsigned-char) 2] [(unsigned-char) 2]
[(signed-char) 3] [(signed-char) 3]
[(unsigned-short) 4] [(unsigned-short) 4]
[(signed-short) 5] [(signed-short) 5]
[(unsigned-int) 6] [(unsigned-int) 6]
[(signed-int) 7] [(signed-int) 7]
[(unsigned-long) 8] [(unsigned-long) 8]
[(signed-long) 9] [(signed-long) 9]
[(float) 10] [(unsigned-long-long) 10]
[(double) 11] [(signed-long-long) 11]
[(pointer) 12] [(float) 12]
[(double) 13]
[(pointer) 14]
[else (die who "invalid type" x)])])) [else (die who "invalid type" x)])]))
(unless (list? argtypes) (unless (list? argtypes)
(die who "arg types is not a list" argtypes)) (die who "arg types is not a list" argtypes))

2
scheme/last-revision
View File

@ -1 +1 @@
1763 1764

28
src/ikarus-ffi.c
View File

@ -60,9 +60,11 @@ scheme_to_ffi_type_cast(ikptr nptr){
case 7: return &ffi_type_sint32; case 7: return &ffi_type_sint32;
case 8: return (sizeof(long)==4)?&ffi_type_uint32:&ffi_type_uint64; case 8: return (sizeof(long)==4)?&ffi_type_uint32:&ffi_type_uint64;
case 9: return (sizeof(long)==4)?&ffi_type_sint32:&ffi_type_sint64; case 9: return (sizeof(long)==4)?&ffi_type_sint32:&ffi_type_sint64;
case 10: return &ffi_type_float; case 10: return &ffi_type_uint64;
case 11: return &ffi_type_double; case 11: return &ffi_type_sint64;
case 12: return &ffi_type_pointer; case 12: return &ffi_type_float;
case 13: return &ffi_type_double;
case 14: return &ffi_type_pointer;
default: default:
fprintf(stderr, "INVALID ARG %ld", n); fprintf(stderr, "INVALID ARG %ld", n);
exit(-1); exit(-1);
@ -79,6 +81,9 @@ alloc_room_for_type(ffi_type* t){
} }
extern long extract_num(ikptr x); extern long extract_num(ikptr x);
extern long long extract_num_longlong(ikptr x);
extern ikptr sll_to_number(signed long long n, ikpcb* pcb);
extern ikptr ull_to_number(unsigned long long n, ikpcb* pcb);
static void scheme_to_ffi_value_cast(ffi_type*, ikptr, ikptr, void*); static void scheme_to_ffi_value_cast(ffi_type*, ikptr, ikptr, void*);
@ -122,11 +127,14 @@ scheme_to_ffi_value_cast(ffi_type* t, ikptr nptr, ikptr p, void* r) {
case 8: // ffi_type_uint64; case 8: // ffi_type_uint64;
case 9: case 9:
{ *((long*)r) = extract_num(p); return; } { *((long*)r) = extract_num(p); return; }
case 10: //return &ffi_type_float; case 10:
case 11:
{ *((long long*)r) = extract_num_longlong(p); return; }
case 12: //return &ffi_type_float;
{ *((float*)r) = flonum_data(p); return; } { *((float*)r) = flonum_data(p); return; }
case 11: //return &ffi_type_double; case 13: //return &ffi_type_double;
{ *((double*)r) = flonum_data(p); return; } { *((double*)r) = flonum_data(p); return; }
case 12: //return &ffi_type_pointer; case 14: //return &ffi_type_pointer;
{ *((void**)r) = (void*)ref(p, off_pointer_data); return; } { *((void**)r) = (void*)ref(p, off_pointer_data); return; }
default: default:
fprintf(stderr, "INVALID ARG %ld", n); fprintf(stderr, "INVALID ARG %ld", n);
@ -151,9 +159,11 @@ ffi_to_scheme_value_cast(int n, void* p, ikpcb* pcb) {
case 7: return s_to_number(*((signed int*)p), pcb); case 7: return s_to_number(*((signed int*)p), pcb);
case 8: return u_to_number(*((unsigned long*)p), pcb); case 8: return u_to_number(*((unsigned long*)p), pcb);
case 9: return s_to_number(*((signed long*)p), pcb); case 9: return s_to_number(*((signed long*)p), pcb);
case 10: return d_to_number(*((float*)p), pcb); case 10: return ull_to_number(*((unsigned long long*)p), pcb);
case 11: return d_to_number(*((double*)p), pcb); case 11: return sll_to_number(*((signed long long*)p), pcb);
case 12: return make_pointer((long)*((void**)p), pcb); case 12: return d_to_number(*((float*)p), pcb);
case 13: return d_to_number(*((double*)p), pcb);
case 14: return make_pointer((long)*((void**)p), pcb);
default: default:
fprintf(stderr, "INVALID ARG %d", n); fprintf(stderr, "INVALID ARG %d", n);
exit(-1); exit(-1);

2
src/ikarus-pointers.c
View File

@ -251,7 +251,7 @@ s_to_number(signed long n, ikpcb* pcb) {
return bn+vector_tag; return bn+vector_tag;
} }
static ikptr ikptr
sll_to_number(signed long long n, ikpcb* pcb) { sll_to_number(signed long long n, ikpcb* pcb) {
if (((signed long long)(signed long) n) == n) { if (((signed long long)(signed long) n) == n) {
return s_to_number(n, pcb); return s_to_number(n, pcb);