From 69c62649cc9735b7fb49047de94a7bfafe0a9151 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Tue, 7 Oct 2008 02:46:56 -0400 Subject: [PATCH] - defined RTLD_LOCAL for cygwin (possibly incorrect) - added a missing save to a callee-save register (%edi) when entering/reentering to Scheme which caused Ikarus not to run properly depending on whether or not gcc places the pcb in %edi or not during Scheme execution. - updated lab/test-ffi.ss to use the new names for foreign types, etc. --- lab/test-ffi.ss | 33 ++++++++++++++++++--------------- scheme/last-revision | 2 +- src/ikarus-enter.S | 9 ++++++--- src/ikarus-pointers.c | 4 ++++ 4 files changed, 29 insertions(+), 19 deletions(-) diff --git a/lab/test-ffi.ss b/lab/test-ffi.ss index 91f81aa..7d4684c 100644 --- a/lab/test-ffi.ss +++ b/lab/test-ffi.ss @@ -16,26 +16,26 @@ (printf "=========================================================\n")) -(define self (dlopen #f)) +(define self (dlopen)) (define hosym (dlsym self "ho")) (define ho - ((make-ffi 'sint32 '(pointer sint32)) hosym)) + ((make-callout 'signed-int '(pointer signed-int)) hosym)) (define traced-foradd1 - ((make-callback 'sint32 '(sint32)) + ((make-callback 'signed-int '(signed-int)) (trace-lambda add1 (n) (collect) (add1 n)))) (define foradd1 - ((make-callback 'sint32 '(sint32)) + ((make-callback 'signed-int '(signed-int)) (lambda (n) (collect) (add1 n)))) (define foradd1-by-foreign-call - ((make-callback 'sint32 '(sint32)) + ((make-callback 'signed-int '(signed-int)) (trace-lambda foradd1-by-foreign-call (n) (/ (ho traced-foradd1 n) 2)))) @@ -46,11 +46,11 @@ (define test_I_I - ((make-ffi 'sint32 '(pointer sint32)) (dlsym self "test_I_I"))) + ((make-callout 'signed-int '(pointer signed-int)) (dlsym self "test_I_I"))) (define test_I_II - ((make-ffi 'sint32 '(pointer sint32 sint32)) (dlsym self "test_I_II"))) + ((make-callout 'signed-int '(pointer signed-int signed-int)) (dlsym self "test_I_II"))) (define test_I_III - ((make-ffi 'sint32 '(pointer sint32 sint32 sint32)) (dlsym self "test_I_III"))) + ((make-callout 'signed-int '(pointer signed-int signed-int signed-int)) (dlsym self "test_I_III"))) (define C_add_I_I (dlsym self "add_I_I")) (define C_add_I_II (dlsym self "add_I_II")) @@ -60,9 +60,12 @@ (check = (test_I_II C_add_I_II 12 13) (+ 12 13)) (check = (test_I_III C_add_I_III 12 13 14) (+ 12 13 14)) -(define S_add_I_I ((make-callback 'sint32 '(sint32)) +)) -(define S_add_I_II ((make-callback 'sint32 '(sint32 sint32)) +)) -(define S_add_I_III ((make-callback 'sint32 '(sint32 sint32 sint32)) +)) +(define S_add_I_I ((make-callback 'signed-int '(signed-int)) +)) +(define S_add_I_II ((make-callback 'signed-int '(signed-int + signed-int)) +)) +(define S_add_I_III ((make-callback 'signed-int '(signed-int + signed-int + signed-int)) +)) (check = (test_I_I S_add_I_I 12) (+ 12)) (check = (test_I_II S_add_I_II 12 13) (+ 12 13)) @@ -70,11 +73,11 @@ (define test_D_D - ((make-ffi 'double '(pointer double)) (dlsym self "test_D_D"))) + ((make-callout 'double '(pointer double)) (dlsym self "test_D_D"))) (define test_D_DD - ((make-ffi 'double '(pointer double double)) (dlsym self "test_D_DD"))) + ((make-callout 'double '(pointer double double)) (dlsym self "test_D_DD"))) (define test_D_DDD - ((make-ffi 'double '(pointer double double double)) (dlsym self "test_D_DDD"))) + ((make-callout 'double '(pointer double double double)) (dlsym self "test_D_DDD"))) (define C_add_D_D (dlsym self "add_D_D")) (define C_add_D_DD (dlsym self "add_D_DD")) @@ -94,7 +97,7 @@ (define RectArea - ((make-ffi 'float '(#(#(float float) #(float float)))) + ((make-callout 'float '(#(#(float float) #(float float)))) (dlsym self "test_area_F_R"))) (check = (RectArea '#(#(0.0 0.0) #(10.0 10.0))) 100.0) diff --git a/scheme/last-revision b/scheme/last-revision index c772079..ff0ba09 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1620 +1621 diff --git a/src/ikarus-enter.S b/src/ikarus-enter.S index d01a025..22f0537 100644 --- a/src/ikarus-enter.S +++ b/src/ikarus-enter.S @@ -217,10 +217,11 @@ _ik_asm_enter: movl 16(%esp), %edi # closure pointer movl %esi, -4(%esp) # preserve movl %ebp, -8(%esp) # preserve + movl %edi, -12(%esp) # preserve movl 4(%esp), %esi movl 0(%esi), %ebp # allocation pointer is at 0(pcb) movl %esp, %ecx - subl $16, %esp # 24 for alignment + subl $16, %esp # 16 for alignment movl %esp, 24(%esi) # save esp in pcb->system_stack movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter jmp L_call @@ -242,6 +243,7 @@ L_do_underflow: addl $16, %esp # 24 for alignment (>= 16) movl -4(%esp), %esi # restore callee-save registers movl -8(%esp), %ebp # + movl -12(%esp), %edi # ret # back to C, which handled the underflow L_multivalue_underflow: addl $4, %esp @@ -257,8 +259,9 @@ _ik_asm_reenter: # return point is at 0(%esp) movl 12(%esp), %eax movl 8(%esp), %ebx - movl %esi, -4(%esp) - movl %ebp, -8(%esp) + movl %esi, -4(%esp) # preserve + movl %ebp, -8(%esp) # preserve + movl %edi, -12(%esp) # preserve movl 4(%esp), %esi movl 0(%esi), %ebp # allocation pointer is at 0(pcb) subl $16, %esp # 24 for alignment diff --git a/src/ikarus-pointers.c b/src/ikarus-pointers.c index adf1bd1..d9798cb 100644 --- a/src/ikarus-pointers.c +++ b/src/ikarus-pointers.c @@ -92,6 +92,10 @@ ikrt_dlerror(ikpcb* pcb) { return bv+bytevector_tag; } +#ifndef RTLD_LOCAL +#define RTLD_LOCAL 0 /* for cygwin, possibly incorrect */ +#endif + ikptr ikrt_dlopen(ikptr x, ikptr load_lazy, ikptr load_global, ikpcb* pcb) { int flags =