ffi callbacks sorta kinda work now.
This commit is contained in:
Abdulaziz Ghuloum
parent
06fd988a17
commit
e07d8f9760
6
c32
6
c32
|
|
@ -1,6 +1,10 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
./configure --prefix=/Users/ikarus/.opt CFLAGS=-m32 LDFLAGS=-m32 \
|
||||
./configure \
|
||||
--enable-libffi \
|
||||
--prefix=/Users/ikarus/.opt \
|
||||
CFLAGS="-m32 -I$HOME/.opt/lib/libffi-3.0.6/include" \
|
||||
LDFLAGS="-m32 -L$HOME/.opt/lib" \
|
||||
&& make clean \
|
||||
&& make
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,37 @@
|
|||
|
||||
(import (ikarus) (ikarus system $foreign))
|
||||
|
||||
(define self (dlopen #f))
|
||||
(define hosym (dlsym self "ho"))
|
||||
|
||||
(define ho
|
||||
((make-ffi 'sint32 '(pointer sint32)) hosym))
|
||||
|
||||
(define foradd1
|
||||
((make-callback 'sint32 '(sint32))
|
||||
(trace-lambda add1 (n)
|
||||
(add1 n))))
|
||||
|
||||
(define foradd1^
|
||||
((make-callback 'sint32 '(sint32))
|
||||
(lambda (n)
|
||||
(add1 n))))
|
||||
|
||||
(define-syntax assert^
|
||||
(syntax-rules ()
|
||||
[(_ expr)
|
||||
(begin
|
||||
(line)
|
||||
(printf "TESTING ~s\n" 'expr)
|
||||
(assert expr)
|
||||
(printf "OK\n"))]))
|
||||
|
||||
(define (line)
|
||||
(printf "=========================================================\n"))
|
||||
|
||||
(assert^ (= (ho (dlsym self "cadd1") 17) (+ 18 18)))
|
||||
(assert^ (= (ho foradd1^ 17) (+ 18 18)))
|
||||
(assert^ (= (ho foradd1 17) (+ 18 18)))
|
||||
|
||||
(line)
|
||||
(printf "Happy Happy Joy Joy\n")
|
||||
|
|
@ -160,7 +160,9 @@
|
|||
(unless (= (vector-length argsvec)
|
||||
(vector-length argtypes-n))
|
||||
(error 'ffi "args mismatch" argtypes args))
|
||||
(foreign-call "ikrt_ffi_call" data argsvec))))))
|
||||
(call/cc
|
||||
(lambda (k)
|
||||
(foreign-call "ikrt_ffi_call" data argsvec))))))))
|
||||
|
||||
(define (make-callback rtype argtypes)
|
||||
(let-values ([(cif argtypes-n rtype-n)
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
1600
|
||||
1601
|
||||
|
|
|
|||
|
|
@ -2354,7 +2354,8 @@
|
|||
[(P)
|
||||
(prm '= (prm 'int+
|
||||
(prm 'mref pcr (K pcb-frame-base))
|
||||
(K (- wordsize))) fpr)])
|
||||
(K (- wordsize)))
|
||||
fpr)])
|
||||
|
||||
(define-primop $current-frame unsafe
|
||||
[(V) (prm 'mref pcr (K pcb-next-continuation))])
|
||||
|
|
|
|||
|
|
@ -174,6 +174,16 @@ typedef struct ikpcb{
|
|||
struct timeval collect_rtime;
|
||||
} ikpcb;
|
||||
|
||||
typedef struct {
|
||||
ikptr tag;
|
||||
ikptr top;
|
||||
long int size;
|
||||
ikptr next;
|
||||
} cont;
|
||||
|
||||
|
||||
|
||||
|
||||
ikpcb* ik_collect(unsigned long int, ikpcb*);
|
||||
void ikarus_usage_short(void);
|
||||
|
||||
|
|
@ -195,7 +205,7 @@ void ik_free_symbol_table(ikpcb* pcb);
|
|||
void ik_fasl_load(ikpcb* pcb, char* filename);
|
||||
void ik_relocate_code(ikptr);
|
||||
|
||||
ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr);
|
||||
ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr, ikptr argcount, ikptr cp);
|
||||
void ik_print(ikptr x);
|
||||
void ik_fprint(FILE*, ikptr x);
|
||||
|
||||
|
|
@ -204,7 +214,7 @@ ikptr ikrt_strings_to_gensym(ikptr, ikptr, ikpcb*);
|
|||
|
||||
ikptr ik_cstring_to_symbol(char*, ikpcb*);
|
||||
|
||||
ikptr ik_asm_enter(ikpcb*, ikptr code_object, ikptr arg);
|
||||
ikptr ik_asm_enter(ikpcb*, ikptr code_object, ikptr arg, ikptr cp);
|
||||
ikptr ik_asm_reenter(ikpcb*, ikptr code_object, ikptr val);
|
||||
ikptr ik_underflow_handler(ikpcb*);
|
||||
ikptr ik_unsafe_alloc(ikpcb* pcb, int size);
|
||||
|
|
|
|||
|
|
@ -47,32 +47,31 @@ _ik_asm_enter:
|
|||
mov %r14, -40(%rsp) # preserve
|
||||
mov %r15, -48(%rsp) # preserve
|
||||
|
||||
# closure pointer is the 4th arg, or %rcx
|
||||
# argcount is the third arg, or %rdx
|
||||
# code is the second arg, or %rsi
|
||||
# pcb is the first arg, or %rdi
|
||||
# return point is at 0(%rsp)
|
||||
|
||||
mov %rsi, %rax # move code pointer to %rax
|
||||
mov %rdx, %rax # set up arg count
|
||||
mov %rsi, %rdx # move code pointer to %rdx
|
||||
mov %rdi, %rsi # move pcb into pcb-register (%rsi)
|
||||
mov %rcx, %rdi # move closure pointer into cpr
|
||||
mov 0(%rsi), %rbp # allocation pointer is at 0(pcb)
|
||||
sub $64, %rsp # 64 for alignment
|
||||
mov %rsp, 48(%rsi) # save esp in pcb->system_stack
|
||||
mov 16(%rsi), %rsp # load scheme stack from pcb->frame_pinter
|
||||
jmp L_call
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.quad 8
|
||||
.quad 0
|
||||
L_multivalue_label: # FIXME
|
||||
.quad L_multivalue_underflow
|
||||
.quad 0
|
||||
L_call:
|
||||
call *%rax # goooooooo
|
||||
call *%rdx # goooooooo
|
||||
# now we're back
|
||||
ik_underflow_handler:
|
||||
_ik_underflow_handler:
|
||||
mov %rax, -16(%rsp) # store the return value
|
||||
mov $-8, %rax # set rvcount = 1
|
||||
L_do_underflow:
|
||||
|
|
@ -209,32 +208,29 @@ L_back:
|
|||
.align 8
|
||||
ik_asm_enter:
|
||||
_ik_asm_enter:
|
||||
# ignored value is the third arg 12(%esp)
|
||||
# closure pointer is the 4th arg, 16(%esp)
|
||||
# argcount is the third arg, or 12(%esp)
|
||||
# code is the second arg 8(%esp)
|
||||
# pcb is the first arg 4(%esp)
|
||||
# return point is at 0(%esp)
|
||||
movl 12(%esp), %eax # arg count
|
||||
movl 16(%esp), %edi # closure pointer
|
||||
movl %esi, -4(%esp) # preserve
|
||||
movl %ebp, -8(%esp) # preserve
|
||||
movl 4(%esp), %esi
|
||||
movl 0(%esi), %ebp # allocation pointer is at 0(pcb)
|
||||
movl %esp, %eax
|
||||
movl %esp, %ecx
|
||||
subl $16, %esp # 24 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
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.byte 0
|
||||
.long 4
|
||||
.long 0
|
||||
.long L_multivalue_underflow
|
||||
.byte 0
|
||||
.byte 0
|
||||
L_call:
|
||||
call *8(%eax) # goooooooo
|
||||
call *8(%ecx) # goooooooo
|
||||
# now we're back
|
||||
ik_underflow_handler:
|
||||
movl %eax, -8(%esp) # store the return value
|
||||
|
|
|
|||
|
|
@ -22,25 +22,24 @@
|
|||
#include <assert.h>
|
||||
#include <string.h>
|
||||
|
||||
typedef struct {
|
||||
ikptr tag;
|
||||
ikptr top;
|
||||
long int size;
|
||||
ikptr next;
|
||||
} cont;
|
||||
|
||||
#undef DEBUG_EXEC
|
||||
|
||||
ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr){
|
||||
ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data,0);
|
||||
ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr, ikptr argcount, ikptr cp){
|
||||
ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data, argcount, cp);
|
||||
ikptr next_k = pcb->next_k;
|
||||
while(next_k){
|
||||
cont* k = (cont*)(long)(next_k - vector_tag);
|
||||
ikptr top = k->top;
|
||||
ikptr rp = ref(top, 0);
|
||||
long int framesize = (long int) ref(rp, disp_frame_size);
|
||||
#ifdef DEBUG_EXEC
|
||||
fprintf(stderr, "exec framesize=0x%016lx ksize=%ld rp=0x%016lx\n",
|
||||
framesize, k->size, rp);
|
||||
#endif
|
||||
if(framesize <= 0){
|
||||
fprintf(stderr, "invalid framesize %ld\n", framesize);
|
||||
exit(-1);
|
||||
exit(-10);
|
||||
}
|
||||
if(framesize < k->size){
|
||||
cont* nk = (cont*)(long)ik_unsafe_alloc(pcb, sizeof(cont));
|
||||
|
|
@ -53,6 +52,14 @@ ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr){
|
|||
/* record side effect */
|
||||
unsigned long int idx = ((unsigned long int)(&k->next)) >> pageshift;
|
||||
((unsigned int*)(long)(pcb->dirty_vector))[idx] = -1;
|
||||
} else if (framesize > k->size) {
|
||||
fprintf(stderr,
|
||||
"ikarus internal error: invalid framesize %ld, expected %ld or less\n",
|
||||
framesize, k->size);
|
||||
long int offset = ref(rp, disp_frame_offset);
|
||||
fprintf(stderr, "rp = 0x%016lx\n", rp);
|
||||
fprintf(stderr, "rp offset = %ld\n", offset);
|
||||
exit(-10);
|
||||
}
|
||||
pcb->next_k = k->next;
|
||||
ikptr fbase = pcb->frame_base - wordsize;
|
||||
|
|
|
|||
|
|
@ -110,7 +110,7 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
|
|||
}
|
||||
close(fd);
|
||||
}
|
||||
ikptr val = ik_exec_code(pcb, v);
|
||||
ikptr val = ik_exec_code(pcb, v, 0, 0);
|
||||
if(val != void_object){
|
||||
ik_print(val);
|
||||
}
|
||||
|
|
|
|||
137
src/ikarus-ffi.c
137
src/ikarus-ffi.c
|
|
@ -7,6 +7,8 @@
|
|||
#include <stdlib.h>
|
||||
#include <strings.h>
|
||||
|
||||
#undef DEBUG_FFI
|
||||
|
||||
static void*
|
||||
alloc(size_t n, int m) {
|
||||
void* x = calloc(n, m);
|
||||
|
|
@ -126,10 +128,103 @@ ikrt_ffi_prep_cif(ikptr rtptr, ikptr argstptr, ikpcb* pcb) {
|
|||
}
|
||||
}
|
||||
|
||||
/* FIXME: handle stack overflow */
|
||||
|
||||
|
||||
|
||||
ikptr
|
||||
ikrt_seal_scheme_stack(ikpcb* pcb) {
|
||||
#if 0
|
||||
| |
|
||||
| |
|
||||
| |
|
||||
| |
|
||||
+--------------+
|
||||
| underflow | <--------- new frame pointer
|
||||
+--------------+
|
||||
| return point | <--------- old frame pointer, new frame base
|
||||
+--------------+
|
||||
| . |
|
||||
| . |
|
||||
| . |
|
||||
| |
|
||||
+--------------+
|
||||
| underflow | <--------- old frame base
|
||||
+--------------+
|
||||
#endif
|
||||
ikptr frame_base = pcb->frame_base;
|
||||
ikptr frame_pointer = pcb->frame_pointer;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "old base=0x%016lx fp=0x%016lx\n", pcb->frame_base,
|
||||
pcb->frame_pointer);
|
||||
#endif
|
||||
if ((frame_base - wordsize) != frame_pointer) {
|
||||
ikptr underflow_handler = ref(frame_base, -wordsize);
|
||||
cont* k = (cont*) pcb->next_k;
|
||||
cont* nk = (cont*) ik_unsafe_alloc(pcb, sizeof(cont));
|
||||
nk->tag = k->tag;
|
||||
nk->next = (ikptr) k;
|
||||
nk->top = frame_pointer;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "rp=0x%016lx\n",
|
||||
ref(frame_pointer, 0));
|
||||
#endif
|
||||
nk->size = frame_base - frame_pointer - wordsize;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "frame size=%ld\n", nk->size);
|
||||
#endif
|
||||
pcb->next_k = vector_tag + (ikptr)nk;
|
||||
pcb->frame_base = frame_pointer;
|
||||
pcb->frame_pointer = frame_pointer - wordsize;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "new base=0x%016lx fp=0x%016lx\n", pcb->frame_base,
|
||||
pcb->frame_pointer);
|
||||
fprintf(stderr, "uf=0x%016lx\n", underflow_handler);
|
||||
#endif
|
||||
ref(pcb->frame_pointer, 0) = underflow_handler;
|
||||
} else {
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "already sealed\n");
|
||||
#endif
|
||||
}
|
||||
return void_object;
|
||||
}
|
||||
|
||||
ikptr
|
||||
ikrt_call_back(ikptr proc, ikpcb* pcb) {
|
||||
ikrt_seal_scheme_stack(pcb);
|
||||
ikptr old_k = pcb->next_k;
|
||||
pcb->next_k = 0;
|
||||
ikptr entry_point = ref(proc, off_closure_code);
|
||||
ikptr system_stack = pcb->system_stack;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "system_stack = 0x%016lx\n", pcb->system_stack);
|
||||
#endif
|
||||
ikptr code_ptr = entry_point - off_code_data;
|
||||
ikptr rv = ik_exec_code(pcb, code_ptr, 0, proc);
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "system_stack = 0x%016lx\n", pcb->system_stack);
|
||||
#endif
|
||||
ikptr rv2 = ref(pcb->frame_pointer, -2*wordsize);
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "rv=0x%016lx 0x%016lx\n", rv, rv2);
|
||||
#endif
|
||||
pcb->next_k = old_k;
|
||||
pcb->frame_pointer = pcb->frame_base - wordsize;
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "rp=0x%016lx\n", ref(pcb->frame_pointer, 0));
|
||||
#endif
|
||||
pcb->system_stack = system_stack;
|
||||
return rv2;
|
||||
}
|
||||
|
||||
|
||||
|
||||
ikptr
|
||||
ikrt_ffi_call(ikptr data, ikptr argsvec, ikpcb* pcb) {
|
||||
|
||||
ikrt_seal_scheme_stack(pcb);
|
||||
|
||||
ikptr cifptr = ref(data, off_vector_data + 0 * wordsize);
|
||||
ikptr funptr = ref(data, off_vector_data + 1 * wordsize);
|
||||
ikptr typevec = ref(data, off_vector_data + 2 * wordsize);
|
||||
|
|
@ -151,6 +246,11 @@ ikrt_ffi_call(ikptr data, ikptr argsvec, ikpcb* pcb) {
|
|||
for(i=0; i<n; i++){
|
||||
free(avalues[i]);
|
||||
}
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "DONE WITH CALL, RV=0x%016lx 0x%016lx\n",
|
||||
(long)val,
|
||||
ref(pcb->frame_pointer, -2*wordsize));
|
||||
#endif
|
||||
free(avalues);
|
||||
free(rvalue);
|
||||
return val;
|
||||
|
|
@ -179,6 +279,7 @@ ffi_status ffi_prep_closure_loc (
|
|||
|
||||
*/
|
||||
|
||||
extern ikpcb* the_pcb;
|
||||
static void
|
||||
generic_callback(ffi_cif *cif, void *ret, void **args, void *user_data){
|
||||
/* convert args according to cif to scheme values */
|
||||
|
|
@ -191,8 +292,28 @@ generic_callback(ffi_cif *cif, void *ret, void **args, void *user_data){
|
|||
ikptr argtypes_conv = ref(data, off_vector_data + 2 * wordsize);
|
||||
ikptr rtype_conv = ref(data, off_vector_data + 3 * wordsize);
|
||||
|
||||
fprintf(stderr, "in generic_callback\n");
|
||||
exit(-1);
|
||||
ikpcb* pcb = the_pcb;
|
||||
ikptr old_system_stack = pcb->system_stack; /* preserve */
|
||||
ikptr old_next_k = pcb->next_k; /* preserve */
|
||||
pcb->next_k = 0;
|
||||
ikptr code_entry = ref(proc, off_closure_code);
|
||||
ikptr code_ptr = code_entry - off_code_data;
|
||||
ikptr frame_pointer = pcb->frame_pointer;
|
||||
ikptr frame_base = pcb->frame_base;
|
||||
if ((frame_base - wordsize) != frame_pointer) {
|
||||
fprintf(stderr, "ikarus internal error: INVALID FRAME LAYOUT 0x%016lx .. 0x%016lx\n",
|
||||
frame_base, frame_pointer);
|
||||
exit(-1);
|
||||
}
|
||||
ref(frame_pointer, -2*wordsize) = fix(*((int*)args[0]));
|
||||
ikptr rv = ik_exec_code(pcb, code_ptr, fix(-1), proc);
|
||||
ikptr rv2 = ref(pcb->frame_pointer, -2*wordsize);
|
||||
#ifdef DEBUG_FFI
|
||||
fprintf(stderr, "and back with rv=0x%016lx 0x%016lx!\n", rv, rv2);
|
||||
#endif
|
||||
pcb->system_stack = old_system_stack;
|
||||
pcb->next_k = old_next_k;
|
||||
*((ikptr*)ret) = unfix(rv2);
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -228,9 +349,9 @@ ikrt_prepare_callback(ikptr data, ikpcb* pcb){
|
|||
}
|
||||
|
||||
int ho (int(*f)(int), int n) {
|
||||
fprintf(stderr, "HO HO 0x%016lx!\n", (long)f);
|
||||
// fprintf(stderr, "HO HO 0x%016lx!\n", (long)f);
|
||||
int n0 = f(n);
|
||||
fprintf(stderr, "GOT N0\n");
|
||||
// fprintf(stderr, "GOT N0\n");
|
||||
return n0 + f(n);
|
||||
}
|
||||
|
||||
|
|
@ -238,9 +359,9 @@ int ho (int(*f)(int), int n) {
|
|||
int ho2 (ikptr fptr, ikptr nptr) {
|
||||
int (*f)(int) = (int(*)(int)) ref(fptr, off_pointer_data);
|
||||
int n = unfix(nptr);
|
||||
fprintf(stderr, "HO2 HO2 0x%016lx!\n", (long)f);
|
||||
// fprintf(stderr, "HO2 HO2 0x%016lx!\n", (long)f);
|
||||
int n0 = f(n);
|
||||
fprintf(stderr, "GOT N0\n");
|
||||
// fprintf(stderr, "GOT N0\n");
|
||||
return n0 + f(n);
|
||||
}
|
||||
|
||||
|
|
@ -260,8 +381,8 @@ void hello_world(int n) {
|
|||
|
||||
#else
|
||||
ikptr ikrt_ffi_prep_cif() { return false_object; }
|
||||
ikrt_ffi_call() { return false_object; }
|
||||
ikrt ikrt_prepare_callback() { return false_object; }
|
||||
ikptr ikrt_ffi_call() { return false_object; }
|
||||
ikptr ikrt_prepare_callback() { return false_object; }
|
||||
#endif
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -34,8 +34,8 @@
|
|||
void register_handlers();
|
||||
void register_alt_stack();
|
||||
|
||||
ikpcb* the_pcb;
|
||||
|
||||
ikpcb* the_pcb;
|
||||
|
||||
int
|
||||
file_exists(char* filename){
|
||||
|
|
|
|||
Loading…
Reference in New Issue