Skip to content

Commit 99a2926

Browse files
jayrmjayrm
committed
fbc: add PROCPTR( UDT.member [VIRTUAL] [,signature] )
- allow getting the offset in the virtual table (in bytes) of the virtual member procedure - if the member procedure is not virtual or abstract then return special offset of -(2147483648u) to indicate there is no virtual table entry and do not throw a a compile error. Because this is a low-level bit of information, user will need to deal with it in their source anyway - The combination of member procedure and/or virtual table offset should allow for rudimentary albeit somewhat restricted low level delegate like operations implemented in user code Example: type B extends object declare abstract sub proc1() declare abstract sub proc2() end type type D extends B declare virtual sub proc2() declare virtual sub proc1() end type sub D.proc1() print "D.proc1" end sub sub D.proc2() print "D.proc2" end sub var fptr = procptr( B.proc2 ) '' address = NULL, because abstract var ofst = procptr( B.proc2, virtual ) '' offset >= 0 because it's in the virtual table var inst = new D '' create an instance '' have offset in virtual table? Do a virtual table look-up if( ofst >= 0 ) then fptr = cptr( typeof(fptr), (*cast( any ptr ptr ptr, inst ))[ofst\sizeof(any ptr)] ) end if '' call the procedure fptr( *inst ) '' OUTPUT: D.proc2
1 parent 3b461f0 commit 99a2926

File tree

4 files changed

+341
-8
lines changed

4 files changed

+341
-8
lines changed

‎changelog.txt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -68,6 +68,7 @@ Version 1.10.0
6868
- fbc: allow typename.member symbol checks for #ifdef / #ifndef / defined() where member can be a data field, static data field, nested type, constructor, destructor, property, operator (self-assignment, new, new[], delete, delete[], let, cast, for, step, next), or member procedure.
6969
- rtlib: dos: add "__fb_dos_no_dpmi_yield" variable to control calling "__dpmi_yield()" and prevent a crash under some dos extenders in dosbox
7070
- fbc: PROCPTR( UDT.member [, SUB|FUNCTION ...] ) to get a procedure pointer for type member procedures. If the member is abstract, then return 0 (null function pointer of the member procedure's call signature)
71+
- fbc: PROCPTR( UDT.member VIRTUAL [, SUB|FUNCTION ...] ) to get the offset (in bytes) in to the virtual table. If there is no virtual table entry (or no virtual table at all) then return the special value of -2147483648
7172

7273
[fixed]
7374
- gas64: missing restoring of use of one virtual register on sqr for float (SARG)

‎src/compiler/parser-expr-unary.bas‎

Lines changed: 32 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -491,7 +491,8 @@ private function hProcPtrBody _
491491
( _
492492
byval base_parent as FBSYMBOL ptr, _
493493
byval proc as FBSYMBOL ptr, _
494-
byval check_exact as boolean _
494+
byval check_exact as boolean, _
495+
byval is_vtable_offset as integer _
495496
) as ASTNODE ptr
496497

497498
assert( proc <> NULL )
@@ -524,19 +525,35 @@ private function hProcPtrBody _
524525
callback( proc )
525526
end if
526527

528+
if( is_vtable_offset ) then
529+
'' if not virtual or abstract then procedure doesn't exist in
530+
'' the virtual table. Don't throw an error, just return an
531+
'' invalid vtable offset. vtable offsets are something that
532+
'' the user will have to deal with anyway
533+
dim as integer vtableoffset = -2147483648u
534+
535+
if( symbIsAbstract( proc ) or symbIsVirtual( proc ) ) then
536+
vtableoffset = ( symbProcGetVtableIndex( proc ) - 2 ) * env.pointersize
537+
endif
538+
539+
var expr = astNewCONSTi( vtableoffset )
540+
return expr
541+
end if
542+
527543
if( symbIsAbstract( proc ) )then
528544
'' member is abstract and is not something we can get the address of
529545
'' until a virtual lookup at runtime ...
530546
'' return a null pointer of the function pointer instead
531547

532-
var expr = astNewCONSTi( 0, FB_DATATYPE_INTEGER, NULL )
548+
var expr = astNewCONSTi( 0 )
533549
expr = astNewCONV( typeAddrOf( FB_DATATYPE_FUNCTION ), symbAddProcPtrFromFunction( proc ), expr )
534550
return expr
535551
end if
536552

537553
return astBuildProcAddrof( proc )
538554
end function
539555

556+
'' PROCPTR '(' Proc ('('')')? VIRTUAL? ( ',' signature )? ')'
540557
function cProcPtrBody _
541558
( _
542559
byval dtype as integer, _
@@ -546,6 +563,7 @@ function cProcPtrBody _
546563
dim as FBSYMCHAIN ptr chain_ = any
547564
dim as FBSYMBOL ptr sym = any, base_parent = any
548565
dim as ASTNODE ptr expr = any
566+
dim as integer is_vtable_offset = FALSE
549567

550568
if( dtype = FB_DATATYPE_STRUCT ) then
551569
base_parent = subtype
@@ -579,10 +597,16 @@ function cProcPtrBody _
579597

580598
'' ','?
581599
if( hMatch( CHAR_COMMA ) ) then
582-
dim as integer dtype = any
583-
dim as FBSYMBOL ptr subtype = any
600+
dim as integer dtype = FB_DATATYPE_VOID
601+
dim as FBSYMBOL ptr subtype = NULL
584602
dim as integer is_exact = FALSE
585603

604+
'' VIRTUAL?
605+
if( lexGetToken( ) = FB_TK_VIRTUAL ) then
606+
is_vtable_offset = TRUE
607+
lexSkipToken( LEXCHECK_POST_SUFFIX )
608+
end if
609+
586610
'' only if anything but ')' follows...
587611
if( lexGetToken( ) <> CHAR_RPRNT ) then
588612
if( cSymbolType( dtype, subtype ) = FALSE ) then
@@ -610,13 +634,13 @@ function cProcPtrBody _
610634
parser.ctxsym = subtype
611635
parser.ctx_dtype = dtype
612636

613-
expr = hProcPtrBody( base_parent, sym, is_exact )
637+
expr = hProcPtrBody( base_parent, sym, is_exact, is_vtable_offset )
614638

615639
parser.ctxsym = oldsym
616640
parser.ctx_dtype = old_dtype
617641

618642
else
619-
expr = hProcPtrBody( base_parent, sym, FALSE )
643+
expr = hProcPtrBody( base_parent, sym, FALSE, is_vtable_offset )
620644
end if
621645

622646
return expr
@@ -723,7 +747,7 @@ function cAddrOfExpression( ) as ASTNODE ptr
723747
if( sym <> NULL ) then
724748
lexSkipToken( LEXCHECK_POST_LANG_SUFFIX )
725749
hCheckEmptyProcParens()
726-
return hProcPtrBody( base_parent, sym, FALSE )
750+
return hProcPtrBody( base_parent, sym, FALSE, FALSE )
727751
end if
728752

729753
'' anything else
@@ -752,7 +776,7 @@ function cAddrOfExpression( ) as ASTNODE ptr
752776
hSkipUntil( CHAR_RPRNT, TRUE )
753777
end if
754778

755-
'' PROCPTR '(' Proc ('('')')? ( ',' signature )? ')'
779+
'' PROCPTR '(' Proc ('('')')? VIRTUAL? ( ',' signature )? ')'
756780
case FB_TK_PROCPTR
757781
lexSkipToken( LEXCHECK_POST_SUFFIX )
758782

‎tests/pointers/procptr-low-level-delegate.bas‎

Lines changed: 278 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,278 @@
1+
#include "fbcunit.bi"
2+
3+
SUITE( fbc_tests.pointers.procptr_low_level_delegate )
4+
5+
dim shared id as string
6+
7+
#macro decl_delegate( delegateName, typeName, procName, signature... )
8+
type delegateName
9+
#if __FB_ARG_COUNT__( signature ) = 0
10+
proc as typeof( procptr( typeName.procName ) )
11+
#else
12+
proc as typeof( procptr( typeName.procName, signature ) )
13+
#endif
14+
ofst as integer
15+
inst as typeName ptr
16+
end type
17+
#endmacro
18+
19+
#macro init_delegate( delegate, instance, typeName, procName, signature... )
20+
#if __FB_ARG_COUNT__( signature ) = 0
21+
delegate.proc = procptr( typeName.procName )
22+
delegate.ofst = procptr( typeName.procName, virtual )
23+
#else
24+
delegate.proc = procptr( typeName.procName, signature )
25+
delegate.ofst = procptr( typeName.procName, virtual signature )
26+
#endif
27+
delegate.inst = instance
28+
#endmacro
29+
30+
#macro call_delegate( delegate, args... )
31+
__FB_IIF__( _
32+
__FB_ARG_COUNT__( args ) = 0, _
33+
iif( _
34+
delegate.ofst >= 0, _
35+
cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.ofst\sizeof(any ptr)] ), _
36+
delegate.proc _
37+
)( *(delegate.inst) ), _
38+
iif( _
39+
delegate.ofst >= 0, _
40+
cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.ofst\sizeof(any ptr)] ), _
41+
delegate.proc _
42+
)( *(delegate.inst), args ) _
43+
)
44+
#endmacro
45+
46+
type T
47+
__ as integer
48+
declare sub proc1()
49+
declare sub proc2()
50+
end type
51+
52+
sub T.proc1()
53+
id = "T.proc1"
54+
end sub
55+
56+
sub T.proc2()
57+
id = "T.proc2"
58+
end sub
59+
60+
type B extends object
61+
declare abstract sub proc1()
62+
declare virtual sub proc2()
63+
declare sub proc3()
64+
end type
65+
66+
sub B.proc2()
67+
id = "B.proc2"
68+
end sub
69+
70+
sub B.proc3()
71+
id = "B.proc3"
72+
end sub
73+
74+
type D1 extends B
75+
declare abstract sub proc1()
76+
declare abstract sub proc2()
77+
declare abstract sub proc3()
78+
end type
79+
80+
type D2 extends B
81+
declare virtual sub proc1()
82+
declare virtual sub proc2()
83+
declare virtual sub proc3()
84+
end type
85+
86+
sub D2.proc1()
87+
id = "D2.proc1"
88+
end sub
89+
90+
sub D2.proc2()
91+
id = "D2.proc2"
92+
end sub
93+
94+
sub D2.proc3()
95+
id = "D2.proc3"
96+
end sub
97+
98+
type D3 extends B
99+
declare sub proc1()
100+
declare sub proc2()
101+
declare sub proc3()
102+
end type
103+
104+
sub D3.proc1()
105+
id = "D3.proc1"
106+
end sub
107+
108+
sub D3.proc2()
109+
id = "D3.proc2"
110+
end sub
111+
112+
sub D3.proc3()
113+
id = "D3.proc3"
114+
end sub
115+
116+
'' call member proc of non-virtual
117+
TEST( non_virtual_1 )
118+
decl_delegate( Delegate_T_proc1, T, proc1 )
119+
dim d as Delegate_T_proc1 = any
120+
121+
dim x as T
122+
init_delegate( d, @x, T, proc1 )
123+
124+
call_delegate( d )
125+
CU_ASSERT_EQUAL( id, "T.proc1" )
126+
END_TEST
127+
128+
'' call member proc of non-virtual
129+
TEST( non_virtual_2 )
130+
decl_delegate( Delegate_T_proc2, T, proc2 )
131+
dim d as Delegate_T_proc2 = any
132+
133+
dim x as T
134+
init_delegate( d, @x, T, proc2 )
135+
136+
call_delegate( d )
137+
CU_ASSERT_EQUAL( id, "T.proc2" )
138+
END_TEST
139+
140+
/' not allowed
141+
'' call member proc of base.abstract / derived.abstract
142+
scope
143+
decl_delegate( Delegate_B_proc1, B, proc1 )
144+
dim d as Delegate_B_proc1 = any
145+
146+
dim x as D1
147+
init_delegate( d, @x, D1, proc1 )
148+
149+
call_delegate( d )
150+
CU_ASSERT_EQUAL( id, "D1.proc1" )
151+
end scope
152+
'/
153+
154+
/' not allowed
155+
'' call member proc of base.virtual / derived.abstract
156+
scope
157+
decl_delegate( Delegate_B_proc2, B, proc2 )
158+
dim d as Delegate_B_proc2 = any
159+
160+
dim x as D1
161+
init_delegate( d, @x, D1, proc2 )
162+
163+
call_delegate( d )
164+
CU_ASSERT_EQUAL( id, "D1.proc2" )
165+
end scope
166+
'/
167+
168+
/' not allowed
169+
'' call member proc of base.non-virtual / derived.abstract
170+
scope
171+
decl_delegate( Delegate_B_proc3, B, proc3 )
172+
dim d as Delegate_B_proc3 = any
173+
174+
dim x as D1
175+
init_delegate( d, @x, B, proc3 )
176+
177+
call_delegate( d )
178+
CU_ASSERT_EQUAL( id, "D1.proc3" )
179+
end scope
180+
'/
181+
182+
'' call member proc of base.abstract / derived.virtual
183+
TEST( abstract_virtual_1 )
184+
decl_delegate( Delegate_B_proc1, B, proc1 )
185+
dim d as Delegate_B_proc1 = any
186+
187+
dim x as D2
188+
init_delegate( d, @x, B, proc1 )
189+
190+
call_delegate( d )
191+
CU_ASSERT_EQUAL( id, "D2.proc1" )
192+
END_TEST
193+
194+
'' call member proc of base.virtual / derived.virtual
195+
TEST( virtual_virtual )
196+
decl_delegate( Delegate_B_proc2, B, proc2 )
197+
dim d as Delegate_B_proc2 = any
198+
199+
dim x as D2
200+
init_delegate( d, @x, B, proc2 )
201+
202+
call_delegate( d )
203+
CU_ASSERT_EQUAL( id, "D2.proc2" )
204+
END_TEST
205+
206+
'' call member proc of base.non-virtual / derived.virtual
207+
TEST( non_virtual_virtual )
208+
decl_delegate( Delegate_D2_proc3, D2, proc3 )
209+
dim d as Delegate_D2_proc3 = any
210+
211+
dim x as D2
212+
init_delegate( d, @x, D2, proc3 )
213+
214+
call_delegate( d )
215+
CU_ASSERT_EQUAL( id, "D2.proc3" )
216+
END_TEST
217+
218+
'' call member proc of base.abstract / derived.virtual
219+
TEST( abstract_virtual )
220+
decl_delegate( Delegate_B_proc1, B, proc1 )
221+
dim d as Delegate_B_proc1 = any
222+
223+
dim x as D3
224+
init_delegate( d, @x, B, proc1 )
225+
226+
call_delegate( d )
227+
CU_ASSERT_EQUAL( id, "D3.proc1" )
228+
END_TEST
229+
230+
'' call member proc of base.virtual / derived.non-virtual
231+
TEST( virtual_non_virtual )
232+
decl_delegate( Delegate_B_proc2, B, proc2 )
233+
dim d as Delegate_B_proc2 = any
234+
235+
dim x as D3
236+
init_delegate( d, @x, B, proc2 )
237+
238+
call_delegate( d )
239+
CU_ASSERT_EQUAL( id, "D3.proc2" )
240+
END_TEST
241+
242+
'' call member proc of base.non-virtual / derived.non-virtual
243+
TEST( non_virtual_non_virtual1 )
244+
decl_delegate( Delegate_B_proc3, B, proc3 )
245+
dim d as Delegate_B_proc3 = any
246+
247+
dim x as D3
248+
init_delegate( d, @x, B, proc3 )
249+
250+
call_delegate( d )
251+
CU_ASSERT_EQUAL( id, "B.proc3" )
252+
END_TEST
253+
254+
'' call member proc of base.non-virtual / derived.non-virtual
255+
TEST( non_virtual_non_virtual2 )
256+
decl_delegate( Delegate_D3_proc3, D3, proc3 )
257+
dim d as Delegate_D3_proc3 = any
258+
259+
dim x as D3
260+
init_delegate( d, @x, D3, proc3 )
261+
262+
call_delegate( d )
263+
CU_ASSERT_EQUAL( id, "D3.proc3" )
264+
END_TEST
265+
266+
'' call member proc of base.non-virtual / derived.non-virtual
267+
TEST( non_virtual_non_virtual3 )
268+
decl_delegate( Delegate_D3_proc3, D3, proc3 )
269+
dim d as Delegate_D3_proc3 = any
270+
271+
dim x as D3
272+
init_delegate( d, @x, D3, proc3 )
273+
274+
call_delegate( d )
275+
CU_ASSERT_EQUAL( id, "D3.proc3" )
276+
END_TEST
277+
278+
END_SUITE

0 commit comments

Comments
 (0)