运算符 PROCPTR（过程指针和虚表索引）

• 来源: https://www.freebasic.net/wiki/wikka.php?wakka=KeyPgOpProcptr
• 最后更新: 2024-03-02

---

返回任意过程的地址，以及虚函数/抽象成员过程在虚表中的索引。

语法

declare operator Procptr ( byref identifier as proctype [, any|user_proctype ] ) as internal_proctype ptr
declare operator Procptr ( byref identifier as proctype, virtual [ any|user_proctype ] ) as integer

用法

` result = Procptr ( identifier [, [virtual] [any|user_proctype] ] )

`

参数

identifier

过程标识符。

user_proctype

任意用户类型的过程（sub/function、static/member、normal/virtual）。

（internal_proctype 仅对 UDT udt_name 的成员过程具有一个附加的第一个参数 byref as udt_name）

返回值

返回任意过程的地址（第一种语法），或虚函数/抽象成员过程在虚表中的索引（带有附加限定符 virtual 的第二种语法）。

（any，即任意过程签名，不会引起任何特定的选择（与不使用时相比），只是允许始终用 2 个参数来书写 Procptr）

描述

第一种语法：

• 该运算符返回 Sub 或 Function 静态/成员过程或成员运算符的地址。

• 返回值的类型对应过程的内部签名（用户签名，加上成员过程的附加第一个参数 byref as udt_name）。

第二种语法（带限定符 virtual）：

• 该运算符返回虚函数/抽象成员过程或成员运算符在虚表中的从零开始的索引。

• 在重写成员过程（多态性）的情况下，虚表索引允许从所使用实例的虚表中访问最派生的重写成员过程的地址。

使用 user_proctype 参数时，Procptr 语法允许基于参数类型（包括 sub/function 类型以及返回类型（如有））获取过程指针或虚表索引。

这使得可以显式指定正确的过程以解决过程重载，或对非重载过程的参数类型（包括 sub/function 类型以及返回类型（如有））进行检查。

Operator @ (Address of) 在与过程一起使用时，行为与不带第二个参数的第一种 Procptr 语法相同。

注意：

• 如果成员过程是抽象的，则 Procptr ( identifier [, any|user_proctype ] ) 返回成员过程调用签名（internal_proctype）的空过程指针。

• 如果没有虚表条目（或根本没有虚表），则 Procptr ( identifier , virtual [any|user_proctype] ) 返回特殊值 -1。

示例

start GeSHi

' This example uses ProcPtr to demonstrate function pointers
Declare Function Subtract( x As Integer, y As Integer) As Integer
Declare Function Add( x As Integer, y As Integer) As Integer
Dim myFunction As Function( x As Integer, y As Integer) As Integer

' myFunction will now be assigned to Add
myFunction = ProcPtr( Add )
Print myFunction(2, 3)

' myFunction will now be assigned to Subtract.  Notice the different output.
myFunction = ProcPtr( Subtract )
Print myFunction(2, 3)

Function Add( x As Integer, y As Integer) As Integer
    Return x + y
End Function

Function Subtract( x As Integer, y As Integer) As Integer
    Return x - y
End Function

end GeSHi

start GeSHi

Sub s Overload()
End Sub

Sub s( ByVal i As Integer )
End Sub

'----- since fbc 1.09.0, ProcPtr supports a second parameter (optional):
Var s1 = ProcPtr( s, Sub() )
Var s2 = ProcPtr( s, Sub( ByVal i As Integer ) )

'----- before fbc 1.09.0, it was only possible with:
'Dim s1 As Sub()
's1 = ProcPtr( s )
'Dim s2 As Sub( Byval i As Integer)
's2 = ProcPtr( s )

end GeSHi

start GeSHi

' Since fbc 1.10.0, ProcPtr supports the member procedures/operators with various syntaxes

Type UDT Extends Object
    Dim As String s1
    Dim As String s2
    Declare Virtual Sub test()
    Declare Virtual Operator Cast() As String
End Type

Sub UDT.test()
    Print This.s1
End Sub

Operator UDT.Cast() As String
    Return This.s2
End Operator

Var testPtr1 = ProcPtr(UDT.test)
Var testPtr2 = ProcPtr(UDT.test, Any)
Var testPtr3 = ProcPtr(UDT.test, Sub())

Dim As Function(ByRef As UDT) As String castPtr1 = ProcPtr(UDT.Cast)
Dim As Function(ByRef As UDT) As String castPtr2 = ProcPtr(UDT.Cast, Any)
Dim As Function(ByRef As UDT) As String castPtr3 =  ProcPtr(UDT.Cast, Function() As String)

Var testIndex1 = ProcPtr(UDT.test, Virtual)
Var testIndex2 = ProcPtr(UDT.test, Virtual Any)
Var testIndex3 = ProcPtr(UDT.test, Virtual Sub())

Dim As Integer castIndex1 = ProcPtr(UDT.Cast, Virtual)
Dim As Integer castIndex2 = ProcPtr(UDT.Cast, Virtual Any)
Dim As Integer castIndex3 = ProcPtr(UDT.Cast, Virtual Function() As String)

Print testPtr1  '' absolue address value of UDT.test pointer
Print testPtr2  '' absolue address value of UDT.test pointer
Print testPtr3  '' absolue address value of UDT.test pointer
Print

Print castPtr1  '' absolue address value of UDT.Cast pointer
Print castPtr2  '' absolue address value of UDT.Cast pointer
Print castPtr3  '' absolue address value of UDT.Cast pointer
Print

Print testIndex1  '' vtable index of UDT.test
Print testIndex2  '' vtable index of UDT.test
Print testIndex3  '' vtable index of UDT.test
Print

Print castIndex1  '' vtable index of UDT.Cast
Print castIndex2  '' vtable index of UDT.Cast
Print castIndex3  '' vtable index of UDT.Cast
Print

Dim As UDT u
u.s1 = "Virtual Sub test()"
u.s2 = "Virtual Operator Cast() As String"

testPtr1(u)  '' execute u.test() through its procedure pointer
testPtr2(u)  '' execute u.test() through its procedure pointer
testPtr3(u)  '' execute u.test() through its procedure pointer
Print

Print castPtr1(u)  '' execute Cast(UDT, u) through its procedure pointer
Print castPtr2(u)  '' execute Cast(UDT, u) through its procedure pointer
Print castPtr3(u)  '' execute Cast(UDT, u) through its procedure pointer
Print

CPtr(Sub(ByRef As UDT), CPtr(Any Ptr Ptr Ptr, @u)[0][testIndex1])(u)  '' execute u.test() through its vtable index
CPtr(Sub(ByRef As UDT), CPtr(Any Ptr Ptr Ptr, @u)[0][testIndex2])(u)  '' execute u.test() through its vtable index
CPtr(Sub(ByRef As UDT), CPtr(Any Ptr Ptr Ptr, @u)[0][testIndex3])(u)  '' execute u.test() through its vtable index
Print

Print CPtr(Function(ByRef As UDT) As String, CPtr(Any Ptr Ptr Ptr, @u)[0][castIndex1])(u)  '' execute Cast(UDT, u) through its vtable index
Print CPtr(Function(ByRef As UDT) As String, CPtr(Any Ptr Ptr Ptr, @u)[0][castIndex2])(u)  '' execute Cast(UDT, u) through its vtable index
Print CPtr(Function(ByRef As UDT) As String, CPtr(Any Ptr Ptr Ptr, @u)[0][castIndex3])(u)  '' execute Cast(UDT, u) through its vtable index
Print

Sleep

end GeSHi

start GeSHi

' Since fbc 1.10.0, ProcPtr also allows to access the vtable index of a virtual/abstract member procedure/operator

Type Parent Extends Object
    Declare Abstract Sub VirtualTest()
    Declare Virtual Operator Cast() As String
    Declare Sub NormalTest()
End Type

Operator Parent.Cast() As String
    Return "Parent.Cast() As String"
End Operator

Sub Parent.NormalTest()
    Print "Parent.NormalTest()"
End Sub

Type Child Extends Parent
    Declare Virtual Sub VirtualTest()          '' or Declare Sub test()
    Declare Virtual Operator Cast() As String  '' or Declare Operator Cast() As String
    Declare Sub NormalTest()
End Type

Sub Child.VirtualTest()
    Print "Child.VirtualTest"
End Sub

Operator Child.Cast() As String
    Return "Child.Cast() As String"
End Operator

Sub Child.NormalTest()
    Print "Child.NormalTest()"
End Sub

Dim As Parent Ptr p = New Child

(*p).VirtualTest()      '' or p->VirtualTest()
Print Cast(Parent, *p)  '' or Print *p
(*p).NormalTest()       '' or p->NormalTest()
Print

#define RuntimeProcPtr(instance, procedure, signature...) _   '' pointer to procedure
    __FB_IIF__(ProcPtr(procedure, Virtual signature) >= 0, _  '' (the most derived override if exists)
               CPtr(TypeOf(ProcPtr(procedure, signature)), _
                    CPtr(Any Ptr Ptr Ptr, @(instance)) _
                    [0][ProcPtr(procedure, Virtual signature)]), _
               ProcPtr(procedure, signature))

'' Here, providing the procedure signature to the macro is useless
'' (because there are no procedure overloads to solve in this case)
RuntimeProcPtr(*p, Parent.VirtualTest)(*p)  '' execute (*p).VirtualTest() through its vtable index
Print RuntimeProcPtr(*p, Parent.Cast)(*p)   '' execute Cast(Parent, *p) through its vtable index
RuntimeProcPtr(*p, Parent.NormalTest)(*p)   '' execute (*p).NormalTest() through its compile address
Print

Delete p
Sleep

end GeSHi

版本

• fbc 1.10.0 之前，不支持成员过程/运算符。
• fbc 1.09.0 之前，不支持第二个参数（可选参数）。

方言差异

• 在 -lang qb 方言中不可用，除非通过别名 __Procptr 引用（但不支持限定符 virtual）。

与 QB 的差异

• FreeBASIC 新增

参见

• Sub
• Varptr
• Strptr
• Any
• Virtual
• 指针

返回 目录