OpenEuphoria

Callbacks in Eu.ex

• Posted by Matt Lewis <matthewwalkerlewis at yahoo.com> Dec 16, 2004
• 545 views

This seems to work with call backs.  In execute.e, replace all the callback 
suff with:

--function general_callback(sequence routine, sequence args)
-- call the user's function from an external source
function general_callback( atom cbx, atom ptr )
	sequence args, routine
	routine = call_backs[cbx]
	args = peek4u( ptr & call_backs[cbx][C_NUM_ARGS] )
	
    val[t_id] = routine[C_USER_ROUTINE]
    val[t_arglist] = args
    
    -- create a stack frame
    call_stack = call_stack & {length(call_stack), pc, call_back_routine} 

    Code = call_back_code 
    pc = 1 
     
    do_exec()

    -- remove the stack frame
    pc = call_stack[$-1]
    call_stack = call_stack[1..$-3]
    
    -- restore
    Code = SymTab[call_stack[$]][S_CODE]
 
    return val[t_return_val]
end function

forward_general_callback = routine_id("general_callback")

call_backs = {}
constant cb_std = {
    #89,#E0,                --    0: mov eax, esp
    #83,#C0,#04,            --    2: add eax, 4
    #50,                    --    5: push eax
    #68,#00,#00,#00,#00,    --    6: push dword rid (7)
    #FF,#15,#00,#00,#00,#00,--    B: call near dword ptr [pfunc] (13)
    #C2,#00,#00,            --   11: ret bytes (18)
    #00,#00,#00,#00},       --   14: function pointer (20)

cb_cdecl= {
    #89,#E0,                --    0: mov eax, esp
    #83,#C0,#04,            --    2: add eax, 4
    #50,                    --    5: push eax
    #68,#00,#00,#00,#00,    --    6: push dword rid (7)
    #FF,#15,#00,#00,#00,#00,--    B: call near dword ptr [pfunc] (13)
    #83, #C4, #08,          --   11: sub esp, 8
    #C3,#00,#00,            --   14: ret bytes 
    #00,#00,#00,#00}        --   17: function pointer (23)
procedure do_callback(integer b)
-- handle callback()
    symtab_index r
    integer id, convention
    atom asm
    sequence cb
    object x

    -- val[b] is:  routine id or {'+', routine_id}
    x = val[b]
    if atom(x) then
		id = x
		convention = 0
    else
		convention = x[1]
		id = x[2]
    end if
    
    if id < 1 or id > length(e_routine) then
		RTFatal("Invalid routine id")
    end if	

    r = e_routine[id]

    if platform() = WIN32 and not convention then
    	-- stdcall
	    asm = allocate( length(cb_std) )
	    poke( asm, cb_std )	
	    poke4( asm + 7, length(call_backs) + 1 )
	    poke4( asm + 13, asm + 20 )
	    poke( asm + 18, SymTab[r][S_NUM_ARGS] * 4 )
	    poke4( asm + 20, call_back( forward_general_callback ) )
    	
    else
    	-- cdecl
	    asm = allocate( length(cb_cdecl) )	
	    poke( asm, cb_cdecl )
	    poke4( asm + 7, length(call_backs) + 1 )
	    poke4( asm + 13, asm + 23 )
    	poke4( asm + 23, call_back( '+' & forward_general_callback ) )
    end if

    val[target] = asm
    call_backs = append( call_backs, { r, id, SymTab[r][S_NUM_ARGS] })
    
end procedure