- 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.
This commit is contained in:
Abdulaziz Ghuloum 2008-10-07 02:46:56 -04:00
parent 1e5e516b08
commit 69c62649cc
4 changed files with 29 additions and 19 deletions

View File

@ -16,26 +16,26 @@
(printf "=========================================================\n")) (printf "=========================================================\n"))
(define self (dlopen #f)) (define self (dlopen))
(define hosym (dlsym self "ho")) (define hosym (dlsym self "ho"))
(define ho (define ho
((make-ffi 'sint32 '(pointer sint32)) hosym)) ((make-callout 'signed-int '(pointer signed-int)) hosym))
(define traced-foradd1 (define traced-foradd1
((make-callback 'sint32 '(sint32)) ((make-callback 'signed-int '(signed-int))
(trace-lambda add1 (n) (trace-lambda add1 (n)
(collect) (collect)
(add1 n)))) (add1 n))))
(define foradd1 (define foradd1
((make-callback 'sint32 '(sint32)) ((make-callback 'signed-int '(signed-int))
(lambda (n) (lambda (n)
(collect) (collect)
(add1 n)))) (add1 n))))
(define foradd1-by-foreign-call (define foradd1-by-foreign-call
((make-callback 'sint32 '(sint32)) ((make-callback 'signed-int '(signed-int))
(trace-lambda foradd1-by-foreign-call (n) (trace-lambda foradd1-by-foreign-call (n)
(/ (ho traced-foradd1 n) 2)))) (/ (ho traced-foradd1 n) 2))))
@ -46,11 +46,11 @@
(define test_I_I (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 (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 (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_I (dlsym self "add_I_I"))
(define C_add_I_II (dlsym self "add_I_II")) (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_II C_add_I_II 12 13) (+ 12 13))
(check = (test_I_III C_add_I_III 12 13 14) (+ 12 13 14)) (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_I ((make-callback 'signed-int '(signed-int)) +))
(define S_add_I_II ((make-callback 'sint32 '(sint32 sint32)) +)) (define S_add_I_II ((make-callback 'signed-int '(signed-int
(define S_add_I_III ((make-callback 'sint32 '(sint32 sint32 sint32)) +)) 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_I S_add_I_I 12) (+ 12))
(check = (test_I_II S_add_I_II 12 13) (+ 12 13)) (check = (test_I_II S_add_I_II 12 13) (+ 12 13))
@ -70,11 +73,11 @@
(define test_D_D (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 (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 (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_D (dlsym self "add_D_D"))
(define C_add_D_DD (dlsym self "add_D_DD")) (define C_add_D_DD (dlsym self "add_D_DD"))
@ -94,7 +97,7 @@
(define RectArea (define RectArea
((make-ffi 'float '(#(#(float float) #(float float)))) ((make-callout 'float '(#(#(float float) #(float float))))
(dlsym self "test_area_F_R"))) (dlsym self "test_area_F_R")))
(check = (RectArea '#(#(0.0 0.0) #(10.0 10.0))) 100.0) (check = (RectArea '#(#(0.0 0.0) #(10.0 10.0))) 100.0)

View File

@ -1 +1 @@
1620 1621

View File

@ -217,10 +217,11 @@ _ik_asm_enter:
movl 16(%esp), %edi # closure pointer movl 16(%esp), %edi # closure pointer
movl %esi, -4(%esp) # preserve movl %esi, -4(%esp) # preserve
movl %ebp, -8(%esp) # preserve movl %ebp, -8(%esp) # preserve
movl %edi, -12(%esp) # preserve
movl 4(%esp), %esi movl 4(%esp), %esi
movl 0(%esi), %ebp # allocation pointer is at 0(pcb) movl 0(%esi), %ebp # allocation pointer is at 0(pcb)
movl %esp, %ecx 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 %esp, 24(%esi) # save esp in pcb->system_stack
movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter
jmp L_call jmp L_call
@ -242,6 +243,7 @@ L_do_underflow:
addl $16, %esp # 24 for alignment (>= 16) addl $16, %esp # 24 for alignment (>= 16)
movl -4(%esp), %esi # restore callee-save registers movl -4(%esp), %esi # restore callee-save registers
movl -8(%esp), %ebp # movl -8(%esp), %ebp #
movl -12(%esp), %edi #
ret # back to C, which handled the underflow ret # back to C, which handled the underflow
L_multivalue_underflow: L_multivalue_underflow:
addl $4, %esp addl $4, %esp
@ -257,8 +259,9 @@ _ik_asm_reenter:
# return point is at 0(%esp) # return point is at 0(%esp)
movl 12(%esp), %eax movl 12(%esp), %eax
movl 8(%esp), %ebx movl 8(%esp), %ebx
movl %esi, -4(%esp) movl %esi, -4(%esp) # preserve
movl %ebp, -8(%esp) movl %ebp, -8(%esp) # preserve
movl %edi, -12(%esp) # preserve
movl 4(%esp), %esi movl 4(%esp), %esi
movl 0(%esi), %ebp # allocation pointer is at 0(pcb) movl 0(%esi), %ebp # allocation pointer is at 0(pcb)
subl $16, %esp # 24 for alignment subl $16, %esp # 24 for alignment

View File

@ -92,6 +92,10 @@ ikrt_dlerror(ikpcb* pcb) {
return bv+bytevector_tag; return bv+bytevector_tag;
} }
#ifndef RTLD_LOCAL
#define RTLD_LOCAL 0 /* for cygwin, possibly incorrect */
#endif
ikptr ikptr
ikrt_dlopen(ikptr x, ikptr load_lazy, ikptr load_global, ikpcb* pcb) { ikrt_dlopen(ikptr x, ikptr load_lazy, ikptr load_global, ikpcb* pcb) {
int flags = int flags =