fbc: PROCPTR( UDT.member [, [VIRTUAL] [ANY|signature]] )

- minor corrections after merge of PROCPTR() updates in 0b8098f
- PROCPTR( UDT.member, virtual ... ) returns zero based index in the virtual table
- PROCPTR( UDT.member, virtual ... ) returns -1 special value for non-virtuals

changelog.txt

@@ -67,8 +67,8 @@ Version 1.10.0
 - Add  makefile option DISABLE_STDCXX_PATH to disable usnig gcc to search for some c++ library path
 - 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.
 - rtlib: dos: add "__fb_dos_no_dpmi_yield" variable to control calling "__dpmi_yield()" and prevent a crash under some dos extenders in dosbox
-- 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)
-- 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
+- fbc: PROCPTR( UDT.member [, ANY|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)
+- fbc: PROCPTR( UDT.member [, VIRTUAL ANY|SUB|FUNCTION ...] ) to get the zero based index in the virtual table.  If there is no virtual table entry (or no virtual table at all) then return the special value of -1
 
 [fixed]
 - gas64: missing restoring of use of one virtual register on sqr for float (SARG)

src/compiler/parser-expr-unary.bas

@@ -492,7 +492,7 @@ private function hProcPtrBody _
 		byval base_parent as FBSYMBOL ptr, _
 		byval proc as FBSYMBOL ptr, _
 		byval check_exact as boolean, _
-		byval is_vtable_offset as integer _
+		byval is_vtable_index as integer _
 	) as ASTNODE ptr
 
 	assert( proc <> NULL )
@@ -525,18 +525,18 @@ private function hProcPtrBody _
 		callback( proc )
 	end if
 
-	if( is_vtable_offset ) then
+	if( is_vtable_index ) then
 		'' if not virtual or abstract then procedure doesn't exist in
 		'' the virtual table.  Don't throw an error, just return an
 		'' invalid vtable offset.  vtable offsets are something that
 		'' the user will have to deal with anyway
-		dim as integer vtableoffset = -2147483648u
+		dim as integer vtableindex = -1
 
 		if( symbIsAbstract( proc ) or symbIsVirtual( proc ) ) then
-			vtableoffset = ( symbProcGetVtableIndex( proc ) - 2 ) * env.pointersize
+			vtableindex = ( symbProcGetVtableIndex( proc ) - 2 )
 		endif
 
-		var expr = astNewCONSTi( vtableoffset )
+		var expr = astNewCONSTi( vtableindex )
 		return expr
 	end if
 
@@ -553,7 +553,7 @@ private function hProcPtrBody _
 	return astBuildProcAddrof( proc )
 end function
 
-'' PROCPTR '(' Proc ('('')')? VIRTUAL? ( ',' signature )? ')'
+'' PROCPTR '(' Proc ('('')')? ( ',' VIRTUAL? ( ANY|signature )? )? ')'
 function cProcPtrBody _
 	( _
 		byval dtype as integer, _
@@ -563,7 +563,7 @@ function cProcPtrBody _
 	dim as FBSYMCHAIN ptr chain_ = any
 	dim as FBSYMBOL ptr sym = any, base_parent = any
 	dim as ASTNODE ptr expr = any
-	dim as integer is_vtable_offset = FALSE
+	dim as integer is_vtable_index = FALSE
 
 	if( dtype = FB_DATATYPE_STRUCT ) then
 		base_parent = subtype
@@ -603,7 +603,7 @@ function cProcPtrBody _
 
 		'' VIRTUAL?
 		if( lexGetToken( ) = FB_TK_VIRTUAL ) then
-			is_vtable_offset = TRUE
+			is_vtable_index = TRUE
 			lexSkipToken( LEXCHECK_POST_SUFFIX )
 		end if
 
@@ -634,13 +634,13 @@ function cProcPtrBody _
 		parser.ctxsym = subtype
 		parser.ctx_dtype = dtype
 
-		expr = hProcPtrBody( base_parent, sym, is_exact, is_vtable_offset )
+		expr = hProcPtrBody( base_parent, sym, is_exact, is_vtable_index )
 
 		parser.ctxsym = oldsym
 		parser.ctx_dtype = old_dtype
 
 	else
-		expr = hProcPtrBody( base_parent, sym, FALSE, is_vtable_offset )
+		expr = hProcPtrBody( base_parent, sym, FALSE, is_vtable_index )
 	end if
 
 	return expr
@@ -776,7 +776,7 @@ function cAddrOfExpression( ) as ASTNODE ptr
 			hSkipUntil( CHAR_RPRNT, TRUE )
 		end if
 
-	'' PROCPTR '(' Proc ('('')')? VIRTUAL? ( ',' signature )? ')'
+	'' PROCPTR '(' Proc ('('')')? ( ',' VIRTUAL? ( ANY|signature )? )? ')'
 	case FB_TK_PROCPTR
 		lexSkipToken( LEXCHECK_POST_SUFFIX )
 

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

@@ -6,38 +6,29 @@ SUITE( fbc_tests.pointers.procptr_low_level_delegate )
 
 	#macro decl_delegate( delegateName, typeName, procName, signature... )
 		type delegateName
-			#if __FB_ARG_COUNT__( signature ) = 0
-				proc as typeof( procptr( typeName.procName ) )
-			#else
-				proc as typeof( procptr( typeName.procName, signature ) )
-			#endif
-			ofst as integer
+			proc as typeof( procptr( typeName.procName, signature ) )
+			indx as integer
 			inst as typeName ptr
 		end type
 	#endmacro
 
 	#macro init_delegate( delegate, instance, typeName, procName, signature... )
-		#if __FB_ARG_COUNT__( signature ) = 0
-			delegate.proc = procptr( typeName.procName )
-			delegate.ofst = procptr( typeName.procName, virtual )
-		#else
-			delegate.proc = procptr( typeName.procName, signature )
-			delegate.ofst = procptr( typeName.procName, virtual signature )
-		#endif
+		delegate.proc = procptr( typeName.procName )
+		delegate.indx = procptr( typeName.procName, virtual )
 		delegate.inst = instance
 	#endmacro
 
 	#macro call_delegate( delegate, args... )
 		__FB_IIF__( _
 			__FB_ARG_COUNT__( args ) = 0, _
 			iif( _
-				delegate.ofst >= 0, _
-				cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.ofst\sizeof(any ptr)] ), _
+				delegate.indx >= 0, _
+				cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.indx] ), _
 				delegate.proc _
 			)( *(delegate.inst) ), _
 			iif( _
-				delegate.ofst >= 0, _
-				cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.ofst\sizeof(any ptr)] ), _
+				delegate.indx >= 0, _
+				cptr( typeof(delegate.proc), (*cast( any ptr ptr ptr, delegate.inst ))[delegate.indx] ), _
 				delegate.proc _
 			)( *(delegate.inst), args ) _
 		)

tests/pointers/procptr-virtual.bas

@@ -107,10 +107,10 @@ SUITE( fbc_tests.pointers.procptr_virtual )
 	#endmacro
 
 	TEST( offsets )
-		const INDEX0     = sizeof(any ptr) * 0
-		const INDEX1     = sizeof(any ptr) * 1
-		const INDEX2     = sizeof(any ptr) * 2
-		const INDEX_NONE = -2147483648
+		const INDEX0     = 0
+		const INDEX1     = 1
+		const INDEX2     = 2
+		const INDEX_NONE = -1
 
 		check_virtual_offset( T, proc1, INDEX_NONE )   '' non-virtual
 		check_virtual_offset( T, proc2, INDEX_NONE )   '' non-virtual