Small addition to BRL Reflection: Get Function ptr

BlitzMax Forums/BlitzMax Module Tweaks/Small addition to BRL Reflection: Get Function ptr

BORNtobeNAMELESS

(Posted 2009) [#1]

Could be easily build into the Module, but this way the module does not need to be modified:

Type TFunction
	Field name:String
	Field fptr:Byte Ptr
	Field params:String
EndType

Function RefrGetFunctions:TFunction[](tt:TTypeId)
	If Not tt._class Return Null

	Local debug:Int=(Int Ptr tt._class)[2]
	Local p:Int Ptr=(Int Ptr debug)+2
	Local ret:TFunction[0]
	
	While p[0]
		Local id:String=String.FromCString( Byte Ptr p[1] )
		Local ty:String=String.FromCString( Byte Ptr p[2] )
		
		Local meta:String
		Local i:Int=ty.Find( "{" )
		If i<>-1
			meta=ty[i+1..ty.length-1]
			ty=ty[..i]
		EndIf

		Select p[0]
			Case 7
				ret = ret[..ret.length+1]
				Local n:TFunction = New TFunction
				n.name = id
				n.params = ty
				n.fptr = Byte Ptr(Int Ptr(tt._class + p[3])[0])
				ret[ret.length-1] = n
		End Select
		p:+4
	Wend

	Return ret
EndFunction

Function RefrGetFuncPtr:Byte Ptr(tt:TTypeId, name:String)
	If Not tt._class Return Null
	name = name.toLower()

	Local debug:Int=(Int Ptr tt._class)[2]
	Local p:Int Ptr=(Int Ptr debug)+2
	
	While p[0]
		Local id:String=String.FromCString( Byte Ptr p[1] )
		Local ty:String=String.FromCString( Byte Ptr p[2] )
		
		Local meta:String
		Local i:Int=ty.Find( "{" )
		If i<>-1
			meta=ty[i+1..ty.length-1]
			ty=ty[..i]
		EndIf

		Select p[0]
			Case 7
				If id.ToLower() = name Then
					Return Byte Ptr(Int Ptr(tt._class + p[3])[0])
				EndIf
		End Select
		p:+4
	Wend

	Return Null
EndFunction

A Small example how to use it:

Type TTestType
	Function DoSomething(n:String)
		Print n
	EndFunction

	Function DoSomethingOther:Int(a:Int, b:Int)
		Return a+b
	EndFunction
EndType

Global t:TTypeId = TTypeId.ForName("TTestType")

For Local f:TFunction = EachIn RefrGetFunctions(t)
	Print f.name
	Print f.params
Next

Global f1(n:String) = RefrGetFuncPtr(t, "DoSomething")
Global f2:Int(a:Int, b:Int) = RefrGetFuncPtr(t, "DoSomethingOther")

f1("Hello You!")
Print f2(2,3)

End

I needed this to automaticaly export Types as a Python-Module, maybe someone might find this usefull, too.

Azathoth

(Posted 2009) [#2]

Can it be used to get method pointers?

BORNtobeNAMELESS

(Posted 2009) [#3]

Method pointers are not possible as Methods allways need an Object to be called. Internaly BRL.Reflection gets a method pointer whenever it invokes a method internaly, but puts the Self-Object on the stack before it calls the method.
See TMethod.Invoke and the private _Call function in BRL.Reflection if you want to know more about it.

Htbaa

(Posted 2009) [#4]

It would be cool if the reflection module would support full function and type function support.

grable

(Posted 2009) [#5]

Nice addition :)

Can it be used to get method pointers?

Not true method pointers, but it works. (code ripped shamelessly from BRL.Reflection)

Function GetMethodFuncPtr:Byte Ptr( this:Object, name:String)
	If this And name Then	
		Local typ:TTypeId = TTypeId.ForObject(this)
		Local meth:TMethod = typ.FindMethod(name)	
		If meth Then
			If meth._index < 65536 Then Return bbRefMethodPtr( this, meth._index)
			Return Byte Ptr meth._index
		EndIf
	EndIf
	Return Null
EndFunction

Example usage:

Local stream:TStream = WriteFile("test")
Local StreamWriteLine( this:TStream, s:String) = GetMethodFuncPtr( stream, "WriteLine")
StreamWriteLine( stream, "hello")
StreamWriteLine( stream, "world")
stream.Close()

I have an implementation of working method pointers though, using GNU Lightning.. it even plays nicely with the old GC, keeping the object alive until the methodptr is released.
But since the language doesnt support them natively, they have to be created and released manually :(

Its usage looks something like this:

Local stream:TStream = WriteFile("c:\test")
Local StreamWriteLine( s:String) = GetMethodPtr( stream, "WriteLine", 1)
StreamWriteLine("hello")
StreamWriteLine("world")
stream.Close()
ReleaseMethodPtr(StreamWriteLine)

EDIT:
If you want to see how it works, download grb.lightning.mod.x86.rar and run this source:

SuperStrict

Import BRL.Reflection
Import GRB.lightning

Private
Extern "C"
	Function bbRefMethodPtr:Byte Ptr( this:Object, index:Int)
	Function bbGCRetain( this:Int)
	Function bbGCRelease( this:Int)
EndExtern
Public

' returns pointer to method function (this pointer must be first param of prototype)
'
' prototype example: TStream.WriteLine( s:String) => StreamWriteLine( this:TStream, s:String)
'
Function GetMethodFuncPtr:Byte Ptr( this:Object, name:String)
	If this And name Then	
		Local typ:TTypeId = TTypeId.ForObject(this)
		Local meth:TMethod = typ.FindMethod(name)	
		If meth Then
			If meth._index < 65536 Then Return bbRefMethodPtr( this, meth._index)
			Return Byte Ptr meth._index
		EndIf
	EndIf
	Return Null
EndFunction

' returns pointer to trampoline function with embedded this pointer (this not needed in prototype)
' the returned function keeps the object alive until ReleaseMethodPtr() is called.
'
' prototype example: TStream.WriteLine( s:String) => StreamWriteLine( s:String)
'
Function GetMethodPtr:Byte Ptr( this:Object, name:String, numparams:Int)
	If this And name Then
		Local typ:TTypeId = TTypeId.ForObject(this)
		Local meth:TMethod = typ.FindMethod(name)
		If meth Then
			Local code:Byte Ptr = MemAlloc(256)
			Local param:Int[numparams]
			
			' retain this pointer
			Local thisp:Int Ptr = Int Ptr code
			thisp[0] = (Int Byte Ptr this) - 8
			bbGCRetain(thisp[0])
			' skip it
			code :+ 4
			
			' setup prolog & parameters
			JIT_set_ip(code)
			JIT_prolog(numparams)
			For Local i:Int = 0 Until numparams
				param[i] = JIT_arg_i()
			Next
			
			' setup call to method
			JIT_prepare(numparams + 1)
			' push parameters
			For Local i:Int = numparams-1 To 0 Step -1
				JIT_getarg_i(JIT_R0, param[i])
				JIT_pusharg_p(JIT_R0)
			Next
			' push self
			JIT_movi_i(JIT_R0, thisp[0])
			JIT_pusharg_p(JIT_R0)
			
			' call actual method 
			Local mp:Byte Ptr
			If meth._index < 65536 Then 
				mp = bbRefMethodPtr( this, meth._index)
			Else
				mp = Byte Ptr meth._index
			EndIf
			JIT_finish(mp)
			
			JIT_ret_bs()
			
			JIT_flush_code( code, JIT_get_ip())
			Return code
		EndIf
	EndIf
	Return Null
EndFunction

' releases the object from the method pointer, and frees the method pointer itself
Function ReleaseMethodPtr( p:Byte Ptr)
	Local thisp:Int Ptr = Int Ptr(p - 4)
	bbGCRelease( thisp[0])
	MemFree thisp
EndFunction

'
' TEST
'
Type TTest
	Field F:Int
	
	Method Set:TTest( value:Int)
		F = value
		Return Self
	EndMethod
	
	Method test:Int( a:Int, b:Int)
		Print a + " -- " + b + " -- " + F
		Return -1
	EndMethod
EndType

Local t:TTest = New TTest.Set(10)
Local mp1:Int( a:Int, b:Int) = GetMethodPtr( t, "test", 2)
Local mp2:Int( a:Int, b:Int) = GetMethodPtr( New TTest.Set(20), "test", 2)

t = Null; GCCollect()
Print mp1( 1, 2)
Print mp2( 1, 2)

ReleaseMethodPtr(mp1)
ReleaseMethodPtr(mp2)

Brucey

(Posted 2009) [#6]

@grable

bbGCRetain and bbGCRelease have been deprecated, I believe.

N	(Posted 2009) [#7]

This is very possible. You can also very easily replace methods.

grable

(Posted 2009) [#8]

bbGCRetain and bbGCRelease have been deprecated, I believe.

Yeah, i havent taken the plunge to 1.32 yet ;) but isnt the old GC still in use when not using threading?

N	(Posted 2009) [#9]

Yeah, i havent taken the plunge to 1.32 yet ;) but isnt the old GC still in use when not using threading?

Yes.

spacerat

(Posted 2009) [#10]

I've been trying to integrate function support into brl.reflection so that it behaves exactly the same as the support for methods, and I've managed to get everything working apart from Invoke(args:Object[]). The code for the whole thing is here http://pastebin.com/f453e43b9 but if you just want to see invoke take a look here.

        Method Invoke:Object(args:Object[] = Null)
                Local q[10], sp:Byte Ptr = q
                sp:+4
                If typeId() = LongTypeId sp:+8
        '       If args <> Null
                        For Local i = 0 Until args.length
                                If Int Ptr(sp)>=Int Ptr(q)+8 Throw "ERROR"
                                sp = _Push(sp, argTypes()[i], args[i])
                        Next
        '       EndIf
                If Int Ptr(sp)>Int Ptr(q)+8 Throw "ERROR"
                       
                Select typeId()
                        Case ByteTypeId, ShortTypeId, IntTypeId
                                Local f:Int(p0, p1, p2, p3, p4, p5, p6, p7) = _fptr
                                Return String.FromInt(f(q[0], q[1], q[2], q[3], q[4], q[5], q[6], q[7]))
                        Case LongTypeId
                                Throw "TODO"
                        Case FloatTypeId
                                Local f:Float(p0, p1, p2, p3, p4, p5, p6, p7) = _fptr
                                Return String.FromFloat(f(q[0], q[1], q[2], q[3], q[4], q[5], q[6], q[7]))
                        Case DoubleTypeId
                                Local f:Double(p0, p1, p2, p3, p4, p5, p6, p7) = _fptr
                                Return String.FromDouble(f(q[0], q[1], q[2], q[3], q[4], q[5], q[6], q[7]))
                        Default
                                Local f:Object(p0, p1, p2, p3, p4, p5, p6, p7) = _fptr
                                Return f(q[0], q[1], q[2], q[3], q[4], q[5], q[6], q[7])
                End Select     
        End Method
       
        Field _selfTypeId:TTypeId, _argTypes:TTypeId[]
        Field _fptr:Byte Ptr

Basically, Invoke only seems to work when the function takes no arguments, otherwise the program crashes (no debug information, it just fails). I think if we can fix this, we might have a worthy modification to the official brl.reflection.

EDIT: Fixed it myself. Pastebin for the whole working thing is here http://pastebin.com/f5aa00efa .