thiscall calling convention (-gen gcc only)

changelog.txt

@@ -46,6 +46,7 @@ Version 1.08.0
 - only write debug line information for statements and don't write comments / empty lines / directives for top level source code in assembly debug ouput
 - optimize byref 'm += s' string concatenations to fb_StrConcatByref() which will check for same string descriptor at run-time which can't be determined at compile time for byref parameters.
 - github #298: allow command line options passed to as, gcc, ld  to be longer than 128 characters by using string types internally
+- sf.net #923: implicitly emit the deleting destrutor for extern "c++" mangling for better g++ ABI compatibility
 
 [added]
 - extern "rtlib": respects the parent namespace, uses default fb calling convention and C style name mangling
@@ -66,6 +67,7 @@ Version 1.08.0
 - '-w suffix' or '-w pedantic' command line option enabled 'Suffix ignored' warning for built-in in string functions
 - __FB_UNIQUEID_PUSH__(), __FB_UNIQUEID__(), __FB_UNIQUEID_POP__(), __FB_ARG_LEFTOF__(), __FB_ARG_RIGHTOF__(), __FB_JOIN__() builtin macros
 - __FB_ARG_COUNT__() builtin macro
+- __thiscall keyword to specify the 'thiscall' calling convention (-gen gcc only)
 - __FB_QUOTE__(), __FB_UNQUOTE__(), __FB_EVAL__() builtin macros
 - rtlib: REDIM [PRESERVE] will generate run time error if attempting to resize static (fixed length) arrays.
 - gas64 emitter for x86_64 (SARG), added '-gen gas64' command line option to select

src/compiler/ast-helper.bas

@@ -153,7 +153,7 @@ function astBuildVarDtorCall overload _
 			'' UDT var with dtor?
 			if( symbHasDtor( s ) ) then
 				if( check_access ) then
-					if( symbCheckAccess( symbGetCompDtor( symbGetSubtype( s ) ) ) = FALSE ) then
+					if( symbCheckAccess( symbGetCompDtor1( symbGetSubtype( s ) ) ) = FALSE ) then
 						errReport( FB_ERRMSG_NOACCESSTODTOR )
 					end if
 				end if
@@ -543,7 +543,7 @@ function astBuildDtorCall _
 	dim as ASTNODE ptr callexpr = any
 
 	'' Can be virtual
-	dtor = symbGetCompDtor( sym )
+	dtor = symbGetCompDtor1( sym )
 	if( ignore_virtual ) then
 		callexpr = astNewCALL( dtor )
 	else

src/compiler/ast-node-call.bas

@@ -204,6 +204,7 @@ function astLoadCALL( byval n as ASTNODE ptr ) as IRVREG ptr
 
 		'' cdecl: pushed arguments must be popped by caller
 		'' pascal/stdcall: callee does it instead
+		'' thiscall: could be either depending on target !!! TODO !!!
 		argbytes = symbCalcArgLen( l->dtype, l->subtype, arg->arg.mode )
 		if( symbGetProcMode( proc ) = FB_FUNCMODE_CDECL ) then
 			bytestopop += argbytes
@@ -230,7 +231,7 @@ function astLoadCALL( byval n as ASTNODE ptr ) as IRVREG ptr
 	if( symbProcReturnsOnStack( proc ) ) then
 		'' Pop hidden ptr if cdecl and target doesn't want the callee
 		'' to do it, despite it being cdecl.
-		if( (symbGetProcMode( proc ) = FB_FUNCMODE_CDECL) and _
+		if( ((symbGetProcMode( proc ) = FB_FUNCMODE_CDECL) or (symbGetProcMode( proc ) = FB_FUNCMODE_THISCALL)) and _
 		    ((env.target.options and FB_TARGETOPT_CALLEEPOPSHIDDENPTR) = 0) ) then
 			bytestopop += env.pointersize
 		end if

src/compiler/ast-node-proc.bas

@@ -33,6 +33,7 @@ declare function hInitVptr _
 	) as ASTNODE ptr
 declare sub hCallCtors( byval n as ASTNODE ptr, byval sym as FBSYMBOL ptr )
 declare sub hCallDtors( byval proc as FBSYMBOL ptr )
+declare sub hCallDeleteDtor( byval proc as FBSYMBOL ptr )
 declare sub hGenStaticInstancesDtors( byval proc as FBSYMBOL ptr )
 declare sub hGenGlobalInstancesCtor( )
 
@@ -500,7 +501,7 @@ sub astProcBegin( byval sym as FBSYMBOL ptr, byval ismain as integer )
 			astNewVAR( symbGetParamVar( argv ) ) )
 
 	'' Destructor?
-	elseif( symbIsDestructor( sym ) and enable_implicit_code ) then
+	elseif( (symbIsDestructor0( sym ) or symbIsDestructor1( sym )) and enable_implicit_code ) then
 		''
 		'' If the UDT has a vptr, reset it at the top of destructors,
 		'' such that the vptr always matches the type of object that
@@ -672,13 +673,18 @@ function astProcEnd( byval callrtexit as integer ) as integer
 	res = (symbCheckLabels(symbGetProcSymbTbHead(parser.currproc)) = 0)
 
 	if( res ) then
-		'' Destructor?
-		if( symbIsDestructor( sym ) and enable_implicit_code ) then
+		'' Complete Destructor?
+		if( symbIsDestructor1( sym ) and enable_implicit_code ) then
 			'' Call destructors, behind the exit label, so they'll
 			'' always be called, even with early returns.
 			hCallDtors( sym )
 		end if
 
+		'' Deleting Destructor?
+		if( symbIsDestructor0( sym ) and enable_implicit_code ) then
+			hCallDeleteDtor( sym )
+		end if
+
 		'' update proc's breaks list, adding calls to destructors when needed
 		if( n->block.breaklist.head <> NULL ) then
 			res = astScopeUpdBreakList( n )
@@ -1272,6 +1278,26 @@ private sub hCallFieldDtors _
 
 end sub
 
+private sub hCallDeleteDtor _
+	( _
+		byval proc as FBSYMBOL ptr _
+	)
+
+	dim as FBSYMBOL ptr parent = any, dtor1 = any, this_ = any
+	dim as ASTNODE ptr thisptr = any, tree = any
+
+	parent = symbGetNamespace( proc )
+	dtor1 = symbGetCompDtor1( parent )
+	if( dtor1 = NULL ) then
+		exit sub
+	end if
+	this_ = symbGetParamVar( symbGetProcHeadParam( proc ) )
+	thisptr = astNewADDROF( astBuildVarField( this_ ) )
+	tree = astBuildDeleteOp( AST_OP_DEL, thisptr )
+	astAdd( tree )
+
+end sub
+
 private sub hCallBaseDtor _
 	( _
 		byval parent as FBSYMBOL ptr, _
@@ -1296,7 +1322,7 @@ private sub hCallBaseDtor _
 	'' Just like derived classes are not responsible for initializing their
 	'' base class, they shouldn't be made responsible for cleaning it up.
 
-	dtor = symbGetCompDtor( symbGetSubtype( base_ ) )
+	dtor = symbGetCompDtor1( symbGetSubtype( base_ ) )
 	if( dtor = NULL ) then
 		exit sub
 	end if

src/compiler/error.bas

@@ -878,7 +878,7 @@ private function hMakeParamDesc _
 				pname = strptr( s )
 			'' method?
 			elseif( (proc->pattrib and (FB_PROCATTRIB_CONSTRUCTOR or _
-							FB_PROCATTRIB_DESTRUCTOR or _
+							FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0 or _
 							FB_PROCATTRIB_OPERATOR)) <> 0 ) then
 				s = symbMethodToStr( proc )
 				pname = strptr( s )

src/compiler/fb.bas

@@ -623,6 +623,8 @@ sub fbSetOption( byval opt as integer, byval value as integer )
 		env.clopt.gosubsetjmp = value
 	case FB_COMPOPT_VALISTASPTR
 		env.clopt.valistasptr = value
+	case FB_COMPOPT_NOTHISCALL
+		env.clopt.nothiscall = value
 	case FB_COMPOPT_EXPORT
 		env.clopt.export = value
 	case FB_COMPOPT_MSBITFIELDS
@@ -719,6 +721,8 @@ function fbGetOption( byval opt as integer ) as integer
 		function = env.clopt.gosubsetjmp
 	case FB_COMPOPT_VALISTASPTR
 		function = env.clopt.valistasptr
+	case FB_COMPOPT_NOTHISCALL
+		function = env.clopt.valistasptr
 	case FB_COMPOPT_EXPORT
 		function = env.clopt.export
 	case FB_COMPOPT_MSBITFIELDS

src/compiler/fb.bi

@@ -96,6 +96,7 @@ enum FB_COMPOPT
 	'' the rest
 	FB_COMPOPT_GOSUBSETJMP          '' boolean: implement GOSUB using setjmp/longjump?
 	FB_COMPOPT_VALISTASPTR          '' boolean: implement CVA_* using pointer expressions only?
+	FB_COMPOPT_NOTHISCALL           '' boolean: don't use 'thiscall' calling convention?
 	FB_COMPOPT_EXPORT               '' boolean: export all symbols declared as EXPORT?
 	FB_COMPOPT_MSBITFIELDS          '' boolean: use M$'s bitfields packing?
 	FB_COMPOPT_MULTITHREADED        '' boolean: -mt
@@ -289,6 +290,7 @@ type FBCMMLINEOPT
 	'' the rest
 	gosubsetjmp     as integer              '' implement GOSUB using setjmp/longjump? (default = false)
 	valistasptr     as integer              '' implement CVA_* using pointer expressions only?
+	nothiscall      as integer              '' do not use thiscall calling convention (default = false)
 	export          as integer              '' export all symbols declared as EXPORT (default = true)
 	msbitfields     as integer              '' use M$'s bitfields packing
 	multithreaded   as integer              '' link against thread-safe runtime library (default = false)

src/compiler/fbc.bas

@@ -2035,6 +2035,8 @@ private sub handleOpt(byval optid as integer, byref arg as string)
 			fbSetOption( FB_COMPOPT_GOSUBSETJMP, TRUE )
 		case "valist-as-ptr"
 			fbSetOption( FB_COMPOPT_VALISTASPTR, TRUE )
+		case "no-thiscall"
+			fbSetOption( FB_COMPOPT_NOTHISCALL, TRUE )
 		case else
 			hFatalInvalidOption( arg )
 		end select

src/compiler/fbint.bi

@@ -346,6 +346,7 @@ enum FB_TOKEN
 	FB_TK_PASCAL
 	FB_TK_CDECL
 	FB_TK_STDCALL
+	FB_TK_THISCALL
 	FB_TK_ALIAS
 	FB_TK_LIB
 	FB_TK_OVERLOAD

src/compiler/ir-hlc.bas

@@ -555,6 +555,13 @@ private function hEmitProcHeader _
 				'' Linux GCC only accepts this
 				ln += " __attribute__((stdcall))"
 			end select
+		case FB_FUNCMODE_THISCALL
+			select case( env.clopt.target )
+			case FB_COMPTARGET_WIN32, FB_COMPTARGET_XBOX
+				ln += " __thiscall"
+			case else
+				ln += " __attribute__((thiscall))"
+			end select
 		end select
 	end if
 

src/compiler/ir-llvm.bas

@@ -367,6 +367,8 @@ private function hEmitProcCallConv( byval proc as FBSYMBOL ptr ) as string
 	select case as const( symbGetProcMode( proc ) )
 	case FB_FUNCMODE_STDCALL, FB_FUNCMODE_STDCALL_MS, FB_FUNCMODE_PASCAL
 		function = "x86_stdcallcc "
+	case FB_FUNCMODE_THISCALL
+		function = "x86_thiscall "
 	end select
 end function
 

src/compiler/parser-compound.bas

@@ -317,7 +317,7 @@ sub cExitStatement( )
 			if( symbGetType( parser.currproc ) = FB_DATATYPE_VOID ) then
 				if( (parser.currproc->pattrib and _
 					 (FB_PROCATTRIB_PROPERTY or FB_PROCATTRIB_OPERATOR or _
-					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR)) <> 0 ) then
+					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0)) <> 0 ) then
 					errnum = FB_ERRMSG_ILLEGALOUTSIDEASUB
 				end if
 			else
@@ -328,7 +328,7 @@ sub cExitStatement( )
 			if( symbGetType( parser.currproc ) <> FB_DATATYPE_VOID ) then
 				if( (parser.currproc->pattrib and _
 					 (FB_PROCATTRIB_PROPERTY or FB_PROCATTRIB_OPERATOR or _
-					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR)) <> 0 ) then
+					  FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_DESTRUCTOR1 or FB_PROCATTRIB_DESTRUCTOR0)) <> 0 ) then
 					errnum = FB_ERRMSG_ILLEGALOUTSIDEAFUNCTION
 				else
 					errnum = hCheckForCtorResult( )
@@ -357,7 +357,7 @@ sub cExitStatement( )
 			end if
 
 		case FB_TK_DESTRUCTOR
-			if( symbIsDestructor( parser.currproc ) = FALSE ) then
+			if( symbIsDestructor1( parser.currproc ) = FALSE ) then
 				errnum = FB_ERRMSG_ILLEGALOUTSIDEADTOR
 			end if
 

src/compiler/parser-decl-struct.bas

@@ -183,7 +183,7 @@ private sub hFieldInit _
 				end if
 
 				'' Does it have a destructor?
-				defctor = symbGetCompDtor( subtype )
+				defctor = symbGetCompDtor1( subtype )
 				if( defctor ) then
 					'' Check whether we have access
 					if( symbCheckAccess( defctor ) = FALSE ) then

src/compiler/parser-decl-var.bas

@@ -1189,7 +1189,7 @@ private function hFlushInitializer _
 	'' object?
 	if( has_dtor and (not symbIsRef( sym )) ) then
 		'' check visibility
-		if( symbCheckAccess( symbGetCompDtor( symbGetSubtype( sym ) ) ) = FALSE ) then
+		if( symbCheckAccess( symbGetCompDtor1( symbGetSubtype( sym ) ) ) = FALSE ) then
 			errReport( FB_ERRMSG_NOACCESSTODTOR )
 		end if
 	end if

src/compiler/parser-expr-variable.bas

@@ -246,7 +246,7 @@ private function hMemberId( byval parent as FBSYMBOL ptr ) as FBSYMBOL ptr
 	case FB_TK_CONSTRUCTOR
 		res = symbGetCompCtorHead( parent )
 	case FB_TK_DESTRUCTOR
-		res = symbGetCompDtor( parent )
+		res = symbGetCompDtor1( parent )
 	end select
 
 	if( res ) then

src/compiler/parser-proc.bas

@@ -509,7 +509,7 @@ function cProcCallingConv( byval default as FB_FUNCMODE ) as FB_FUNCMODE
         default = env.target.fbcall
     end if
 
-	'' (CDECL|STDCALL|PASCAL)?
+	'' (CDECL|STDCALL|PASCAL|THISCALL)?
 	select case as const lexGetToken( )
 	case FB_TK_CDECL
 		function = FB_FUNCMODE_CDECL
@@ -525,6 +525,13 @@ function cProcCallingConv( byval default as FB_FUNCMODE ) as FB_FUNCMODE
 		function = FB_FUNCMODE_PASCAL
 		lexSkipToken( LEXCHECK_POST_SUFFIX )
 
+	case FB_TK_THISCALL
+		'' ignore thiscall if '-z no-thiscall' was given
+		if( env.clopt.nothiscall = FALSE ) then
+			function = FB_FUNCMODE_THISCALL
+		end if
+		lexSkipToken( )
+
 	case else
 		select case as const parser.mangling
 		case FB_MANGLING_BASIC, FB_MANGLING_RTLIB
@@ -1056,7 +1063,9 @@ function cProcHeader _
 		if( tk = FB_TK_CONSTRUCTOR ) then
 			pattrib or= FB_PROCATTRIB_CONSTRUCTOR or FB_PROCATTRIB_OVERLOADED
 		else
-			pattrib or= FB_PROCATTRIB_DESTRUCTOR
+			'' destructor defined by user source is always the complete dtor
+			'' the deleting dtor is implicitly defined later
+			pattrib or= FB_PROCATTRIB_DESTRUCTOR1
 		end if
 
 	case FB_TK_OPERATOR
@@ -1464,6 +1473,21 @@ function cProcHeader _
 			cOverrideAttribute( proc )
 		end if
 
+		'' destructor? maybe implicitly declare the deleting destructor too
+		if( tk = FB_TK_DESTRUCTOR ) then
+			'' fbc won't generate any code that calls the deleting destructor
+			'' so don't create the deleting destructor unless we're binding to c++
+			if( symbGetMangling( parent ) = FB_MANGLING_CPP ) then
+				'' - inherit all the attribs from the declared destructor
+				''   except for the destructor type
+				dim dtor0 as FBSYMBOL ptr = symbPreAddProc( NULL )
+				symbAddProcInstanceParam( parent, dtor0 )
+				pattrib and= not FB_PROCATTRIB_DESTRUCTOR1
+				pattrib or= FB_PROCATTRIB_DESTRUCTOR0
+				dtor0 = symbAddCtor( dtor0, NULL, attrib, pattrib, mode )
+			end if
+		end if
+
 		if( tk = FB_TK_PROPERTY ) then
 			hSetUdtPropertyFlags( parent, is_indexed, is_get )
 		end if
@@ -1554,7 +1578,7 @@ function cProcHeader _
 	case FB_TK_CONSTRUCTOR
 		head_proc = symbGetCompCtorHead( parent )
 	case FB_TK_DESTRUCTOR
-		head_proc = symbGetCompDtor( parent )
+		head_proc = symbGetCompDtor1( parent )
 	case FB_TK_OPERATOR
 		head_proc = symbGetCompOpOvlHead( parent, op )
 	end select
@@ -1762,7 +1786,9 @@ sub cProcStmtBegin( byval attrib as FB_SYMBATTRIB, byval pattrib as FB_PROCATTRI
 		if( fbLangOptIsSet( FB_LANG_OPT_CLASS ) = FALSE ) then
 			errReportNotAllowed( FB_LANG_OPT_CLASS )
 		else
-			pattrib or= FB_PROCATTRIB_DESTRUCTOR
+			'' destructor defined by user source is always the complete dtor
+			'' the deleting dtor is implicitly defined later
+			pattrib or= FB_PROCATTRIB_DESTRUCTOR1
 		end if
 
 		hDisallowStaticAttrib( attrib, pattrib )

src/compiler/parser-quirk-mem.bas

@@ -260,7 +260,7 @@ sub cOperatorDelete( )
 
 	'' check visibility
 	if( typeHasDtor( typeDeref( dtype ), subtype ) ) then
-		if( symbCheckAccess( symbGetCompDtor( subtype ) ) = FALSE ) then
+		if( symbCheckAccess( symbGetCompDtor1( subtype ) ) = FALSE ) then
 			errReport( FB_ERRMSG_NOACCESSTODTOR )
 		end if
 	end if

src/compiler/rtl-array.bas

@@ -331,7 +331,7 @@ private sub hCheckDtor _
 
 	if( dtor = NULL ) then exit sub
 
-	assert( symbIsDestructor( dtor ) )
+	assert( symbIsDestructor1( dtor ) )
 
 	if( check_access ) then
 		if( symbCheckAccess( dtor ) = FALSE ) then
@@ -370,7 +370,7 @@ function rtlArrayClear( byval arrayexpr as ASTNODE ptr ) as ASTNODE ptr
 	if( dtype = FB_DATATYPE_STRUCT ) then
 		subtype = astGetSubtype( arrayexpr )
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' No default ctor, but others? Then the rtlib cannot just clear
 		'' that array of objects.
@@ -453,7 +453,7 @@ function rtlArrayErase _
 	if( dtype = FB_DATATYPE_STRUCT ) then
 		subtype = astGetSubtype( arrayexpr )
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' No default ctor, but others? Then the rtlib cannot just clear
 		'' that array of objects.
@@ -534,7 +534,7 @@ private sub hGetCtorDtorForRedim _
 
 	if( typeGetDtAndPtrOnly( dtype ) = FB_DATATYPE_STRUCT ) then
 		ctor = symbGetCompDefCtor( subtype )
-		dtor = symbGetCompDtor( subtype )
+		dtor = symbGetCompDtor1( subtype )
 
 		'' Assuming there aren't any other ctors if there is no default one,
 		'' because if it were possible to declare such a dynamic array,