-- return_large.e by Christian Cuvier -- Use at your own risk and redistribute freely. -- The author will not accept any liability of any kind which might be linked or related to -- the use of this software product. -- --/info -- This include file provides the get_large_return() function, which wraps a callback -- routine you specify, and presents its return value as a sequence of 2 or 3 atoms, -- less significant first. -- -- Thisdocumentation can be extracted to a separate HTML file using the MakeDoc utility. constant get_large_asm = { 0,0,0,0, -- +0: dd ? ;function address -- hot patch 0,0,0,0, -- +4: dd ? ;stack frame address -- hot patch 0,0,0,0, -- +8: dd ? ;stack frame length in bytes -- hot patch #60, -- +12: pusha #E8,0,0,0,0, -- +13: call near ($ - $$) ;address of next instruction now on top of stack #5B, -- +18: pop ebp #8B,#4D,#F6, -- +19: mov ecx,[ebp+08-012] ;size of stack area to store arguments #29,#CC, -- +22: sub esp,ecx #8B,#FC, -- +24: mov edi,esp #E3,#08, -- +26: jecxz >l0 #8B,#75,#F2, -- +28: mov esi,[ebp+04-012] ;argument buffer address #F3,#A4, -- +31: rep movsb ;copy arg buffer in increasing addresses order #8B,#67,#18, -- +33: mov esi,[edi+018] ;edi = (esp after pusha) -- l0: #8B,#4F,#04, -- +36: mov ecx,[edi+04] ;edi = (esp after pusha) #8B,#7F,#1C, -- +39: mov edi,[edi+01c] #FF,#55,#EE, -- +42: call dword [ebp+0-012] #89,#45,#EE, -- +46: mov [ebp+0-012],eax #89,#55,#F2, -- +49: mov [ebp+04-012],edx #87,#4D,#F6, -- +52: xchg ecx,[ebp+08-012] ;patched (64 bit) if callee leaned up #01,#CC, -- +55: add esp,ecx ;patched (96 bit) if callee leaned up #61, -- +57: popa #C3 -- +58: ret }, get_large_addr = allocate(length(get_large64_asm)), gll_call = get_large_addr+12, in_gll_func_address = get_large_addr+0, in_gll_args_address = get_large_addr+4, in_gll_args_length = get_large_addr+8, out_gll_eax = in_gll_func_address, gll_hotfix_1 = get_large_addr+52, gll_hotfix_2 = get_large_addr+55, gll_hotpatch_1 = #C361 -- popa ret poke(get_large_addr,get_large64_asm) global constant CDECL=0, STDCALL=1, LIKE_C=0, PASCAL=2, RIGHTTOLEFT=LIKE_C, LEFTTORIGHT=PASCAL, UNSIGNED=0, SIGNED=4, RETURN96=8 --/func get_large_return(object callback,sequence args,integer flags) --/desc Wraps a function that returns a 64 or 96 bit value. --/ret (SEQUENCE) {low dword, high dword} or {low dword, middle dword, high dword} of the returned value. -- Some .dll/.so functions return a 64 or 96 bit value (large integer or extended real), -- but these data types do not exist in Euphoria. -- As a consequence, the result is returned as a sequence of atoms, each of which represents 32 bits -- of the returned value, less significant part first. -- -- /i callback specifies the routine you want to call, either as --/li {its RAM addres}, or --/li its routine_id as returned by define_c_func(). The return type you give to define_c_func() is ignored, -- /i args is the sequence of arguments (use {} if none) to be passed, in the order of the function declaration. -- /i flags is the sum of a convention call id: --/li CDECL: call using the cdecl convention --/li STDCALL: call using the stdcall convention -- and of zero or more of the following flags: --/li PASCAL: use Pascal's left-to-right argument pushing order; --/li SIGNED: the returned values are to be peeked as signed integers. --/li RETURN96: return three dwords of data, totalling 96 bits, rather than two. -- -- To emphasize the defaults, you can use the LIKE_C,CDECL and UNSIGNED flag values with -- obvious meanings. LEFTTORIGHT is an alias for PASCAL, and RIGHTTOLEFT to LIKE_C. -- -- /b"NOTE 1:" If you set the SIGNED flag and the highest dword is negative, you must add 1 -- to it, and to the iddle dword if any, before attempting to recompute the returned integer. /n -- /b"NOTE 2:" Remember that an atom can hold at most 53 bits of data, so that recomputing the -- returned value as an atom will likely lose some precision. -- -- You must check the documentation of the called routine in order to find out which calling convention it uses./n -- The difference between the stdcall and cdecl conventions is that, in cdecl, the caller cleans up -- the stack on return, while in stdcall the called function does so. Using the wrong calling convention -- usually results in stack corruption, since arguments are removed zero or two times, instead of just once. /n -- The Pascal/Delphi calling convention passes parameters left to right; C and hence Euphoria pass them -- right to left. So, using the wrong convention will confuse the routine, and crash is likely./n -- The stdcall calling convention is not supported under Linux/FreeBSD./n -- Neither DOS nor Windows support returning 96 bit values directly. global function get_large_return(object callback,sequence args,integer flags) integer stack_len,num_returns atom stack_addr,patch_addr,overwritten if sequence(callback) then callback=callback[1] elsif platform()>2 or and_bits(flags,STDCALL) then callback=call_back(callback) else callback=call_back('+'&callback) end if if platform()>2 then flags-=and_bits(flags,STDCALL) end if stack_len = 4*length(args) patch_addr=0 if and_bits(flags,RETURN96) then num_returns=3 else num_returns=2 end if poke4(in_gll_func_address,callback) poke4(in_gll_args_length,stack_len) if stack_len then stack_addr=allocate(stack_len) if and_bits(flags,PASCAL) then poke4(stack_addr,reverse(args)) else poke4(stack_addr,args) end if poke4(in_gll_args_address,stack_addr) if and_bits(flags,STDCALL+PASCAL) then -- routine cleaned the stack, ret now if num_returns=3 then patch_addr=gll_hotfix_2 else patch_addr=gll_hotfix_1 end if overwritten=peek4u(patch_addr) poke4(patch_addr,gll_hotpatch_1) end if call(gll_call) free(stack_addr) if patch_addr then poke4(patch_addr,overwritten) end if else call(gll_call) end if if and_bits(flags,SIGNED) then return peek4s({out_gll_eax,num_returns}) else return peek4u({out_gll_eax,num_returns}) end if end function