Supports optimizing purely abstract types, and only preserve used pure abstract types.

examples/OptimizePureAbstractTypes/OptimizePureAbstractTypes.bas

@@ -0,0 +1,10 @@
+#cmdline "-strip -R -z optabstract"
+
+#Include "inc\EXCEL.bi"
+using Excel
+dim shared as ILine ptr pILine
+dim shared as Application Ptr RHS
+
+if pILine then
+	pILine->Get_Application(@RHS)
+end if

examples/OptimizePureAbstractTypes/PureAbstractTypes.bas

@@ -0,0 +1,10 @@
+#cmdline "-strip -R"
+
+#Include "inc\EXCEL.bi"
+using Excel
+dim shared as ILine ptr pILine
+dim shared as Application Ptr RHS
+
+if pILine then
+	pILine->Get_Application(@RHS)
+end if

examples/OptimizePureAbstractTypes/inc/FBCom.bi

@@ -0,0 +1,17 @@
+#Pragma Once
+#Include Once "Windows.bi"
+#include Once "crt/string.bi"
+#Include Once "win/olectl.bi"
+
+Type CAIUnknown Extends Object
+	Declare Abstract Function QueryInterface (ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
+	Declare Abstract Function AddRef         () As ULong
+	Declare Abstract Function Release        () As ULong
+End Type
+
+Type CAIDispatch Extends CAIUnknown
+	Declare Abstract Function GetTypeInfoCount(ByVal pctinfo As UINT Ptr) As HRESULT
+	Declare Abstract Function GetTypeInfo     (ByVal iTInfo As UINT, ByVal lcid As LCID, ByVal ppTInfo As ITypeInfo Ptr Ptr) As HRESULT
+	Declare Abstract Function GetIDsOfNames   (ByVal riid As REFIID, ByVal rgszNames As LPOLESTR Ptr, ByVal cNames As UINT, ByVal lcid As LCID, ByVal rgDispId As DISPID Ptr) As HRESULT
+	Declare Abstract Function Invoke          (ByVal dispIdMember As DISPID, ByVal riid As REFIID, ByVal lcid As LCID, ByVal wFlags As WORD, ByVal pDispParams As DISPPARAMS Ptr, ByVal pVarResult As VARIANT Ptr, ByVal pExcepInfo As EXCEPINFO Ptr, ByVal puArgErr As UINT Ptr) As HRESULT
+End Type

examples/OptimizePureAbstractTypes/inc/stdole2.bi

@@ -0,0 +1,181 @@
+'=============================================Type library===========================================
+' Name       : stdole
+' Description: OLE Automation
+' Path       : C:\Windows\SysWOW64\stdole2.tlb
+'====================================================================================================
+
+#pragma Once
+#Include Once "FBCom.bi"
+
+Namespace stdole
+
+	'Class identifier (CLSID)
+	Const CLSID_StdFont = "{0BE35203-8F91-11CE-9DE3-00AA004BB851}"
+	Const CLSID_StdPicture = "{0BE35204-8F91-11CE-9DE3-00AA004BB851}"
+
+	'Interface identifier (IID)
+	Const IID_Font = "{BEF6E003-A874-101A-8BBA-00AA00300CAB}"
+	Const IID_Picture = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
+	Const IID_FontEvents = "{4EF6100A-AF88-11D0-9846-00C04FC29993}"
+
+	Type OLE_COLOR As ULong
+	Type OLE_XPOS_PIXELS As Long
+	Type OLE_YPOS_PIXELS As Long
+	Type OLE_XSIZE_PIXELS As Long
+	Type OLE_YSIZE_PIXELS As Long
+	Type OLE_XPOS_HIMETRIC As Long
+	Type OLE_YPOS_HIMETRIC As Long
+	Type OLE_XSIZE_HIMETRIC As Long
+	Type OLE_YSIZE_HIMETRIC As Long
+	Type OLE_XPOS_CONTAINER As Single
+	Type OLE_YPOS_CONTAINER As Single
+	Type OLE_XSIZE_CONTAINER As Single
+	Type OLE_YSIZE_CONTAINER As Single
+	Type OLE_HANDLE As Long
+	Type OLE_OPTEXCLUSIVE As VARIANT_BOOL
+	Type OLE_CANCELBOOL As VARIANT_BOOL
+	Type OLE_ENABLEDEFAULTBOOL As VARIANT_BOOL
+	Type FONTNAME As BSTR
+	Type FONTSIZE As CY
+	Type FONTBOLD As VARIANT_BOOL
+	Type FONTITALIC As VARIANT_BOOL
+	Type FONTUNDERSCORE As VARIANT_BOOL
+	Type FONTSTRIKETHROUGH As VARIANT_BOOL
+	Type IFontDisp As Font
+	Type IPictureDisp As Picture
+	Type IFontEventsDisp As FontEvents
+
+	Enum OLE_TRISTATE
+		Unchecked = 0
+		Checked = 1
+		Gray = 2
+	End Enum
+
+	Enum LoadPictureConstants
+		Default = 0
+		Monochrome = 1
+		VgaColor = 2
+		Color = 4
+	End Enum
+
+	'Module StdFunctions
+		'Declare Function LoadPicture Alias "OleLoadPictureFileEx" (Byval filename As Variant Ptr, Byval widthDesired As Long, Byval heightDesired As Long, Byval flags As LoadPictureConstants) As Picture Ptr Ptr
+		'Declare Function SavePicture Alias "OleSavePictureFile" (Byval Picture As Picture Ptr, Byval filename As BSTR) As HRESULT
+
+	Type GUID
+		Data1 As ULong
+		Data2 As UShort
+		Data3 As UShort
+		Data4(0 To 6) As UByte
+	End Type
+
+	Type DISPPARAMS
+		rgvarg As Variant Ptr Ptr
+		rgdispidNamedArgs As Long Ptr
+		cArgs As ULong
+		cNamedArgs As ULong
+	End Type
+
+	Type EXCEPINFO
+		wCode As UShort
+		wReserved As UShort
+		bstrSource As BSTR
+		bstrDescription As BSTR
+		bstrHelpFile As BSTR
+		dwHelpContext As ULong
+		pvReserved As Any Ptr
+		pfnDeferredFillIn As Any Ptr
+		scode As Long
+	End Type
+
+	' Interface pre declaration.
+	Type IUnknown As CAIUnknown
+	Type IDispatch As CAIDispatch
+	Type IEnumVARIANT As IEnumVARIANT_
+	Type IFont As IFont_
+	Type IPicture As IPicture_
+
+	' Default interface pre declaration for component classes.
+	Type StdFont As Font
+	Type StdPicture As Picture
+
+	' Dual interface pre declaration.
+	Type Font As Font_
+	Type Picture As Picture_
+	Type FontEvents As FontEvents_
+
+	Type IEnumVARIANT_ Extends CAIUnknown
+		Declare Abstract Function Next_ (Byval celt As ULong, Byval rgvar As Variant Ptr Ptr, Byval pceltFetched As ULong Ptr) As HRESULT
+		Declare Abstract Function Skip (Byval celt As ULong) As HRESULT
+		Declare Abstract Function Reset () As HRESULT
+		Declare Abstract Function Clone (Byval ppenum As IEnumVARIANT Ptr Ptr) As HRESULT
+	End Type 'IEnumVARIANT_
+
+	Type IFont_ Extends CAIUnknown
+		Declare Abstract Function Get_Name (Byval pname As BSTR Ptr) As HRESULT
+		Declare Abstract Function Let_Name (Byval pname As BSTR) As HRESULT
+		Declare Abstract Function Get_Size (Byval psize As CY Ptr) As HRESULT
+		Declare Abstract Function Let_Size (Byval psize As CY) As HRESULT
+		Declare Abstract Function Get_Bold (Byval pbold As VARIANT_BOOL Ptr) As HRESULT
+		Declare Abstract Function Let_Bold (Byval pbold As VARIANT_BOOL) As HRESULT
+		Declare Abstract Function Get_Italic (Byval pitalic As VARIANT_BOOL Ptr) As HRESULT
+		Declare Abstract Function Let_Italic (Byval pitalic As VARIANT_BOOL) As HRESULT
+		Declare Abstract Function Get_Underline (Byval punderline As VARIANT_BOOL Ptr) As HRESULT
+		Declare Abstract Function Let_Underline (Byval punderline As VARIANT_BOOL) As HRESULT
+		Declare Abstract Function Get_Strikethrough (Byval pstrikethrough As VARIANT_BOOL Ptr) As HRESULT
+		Declare Abstract Function Let_Strikethrough (Byval pstrikethrough As VARIANT_BOOL) As HRESULT
+		Declare Abstract Function Get_Weight (Byval pweight As Short Ptr) As HRESULT
+		Declare Abstract Function Let_Weight (Byval pweight As Short) As HRESULT
+		Declare Abstract Function Get_Charset (Byval pcharset As Short Ptr) As HRESULT
+		Declare Abstract Function Let_Charset (Byval pcharset As Short) As HRESULT
+		Declare Abstract Function Get_hFont (Byval phfont As Long Ptr) As HRESULT
+		Declare Abstract Function Clone (Byval ppfont As IFont Ptr Ptr) As HRESULT
+		Declare Abstract Function IsEqual (Byval pfontOther As IFont Ptr) As HRESULT
+		Declare Abstract Function SetRatio (Byval cyLogical As Long, Byval cyHimetric As Long) As HRESULT
+		Declare Abstract Function AddRefHfont (Byval hFont As Long) As HRESULT
+		Declare Abstract Function ReleaseHfont (Byval hFont As Long) As HRESULT
+	End Type 'IFont_
+
+	Type IPicture_ Extends CAIUnknown
+		Declare Abstract Function Get_Handle (Byval phandle As Long Ptr) As HRESULT
+		Declare Abstract Function Get_hPal (Byval phpal As Long Ptr) As HRESULT
+		Declare Abstract Function Get_Type (Byval ptype As Short Ptr) As HRESULT
+		Declare Abstract Function Get_Width (Byval pwidth As Long Ptr) As HRESULT
+		Declare Abstract Function Get_Height (Byval pheight As Long Ptr) As HRESULT
+		Declare Abstract Function Render (Byval hdc As Long, Byval x As Long, Byval y As Long, Byval cx As Long, Byval cy As Long, Byval xSrc As Long, Byval ySrc As Long, Byval cxSrc As Long, Byval cySrc As Long, Byval prcWBounds As Any Ptr) As HRESULT
+		Declare Abstract Function Let_hPal (Byval phpal As Long) As HRESULT
+		Declare Abstract Function Get_CurDC (Byval phdcOut As Long Ptr) As HRESULT
+		Declare Abstract Function SelectPicture (Byval hdcIn As Long, Byval phdcOut As Long Ptr, Byval phbmpOut As Long Ptr) As HRESULT
+		Declare Abstract Function Get_KeepOriginalFormat (Byval pfkeep As VARIANT_BOOL Ptr) As HRESULT
+		Declare Abstract Function Let_KeepOriginalFormat (Byval pfkeep As VARIANT_BOOL) As HRESULT
+		Declare Abstract Function PictureChanged () As HRESULT
+		Declare Abstract Function SaveAsFile (Byval pstm As Any Ptr, Byval fSaveMemCopy As VARIANT_BOOL, Byval pcbSize As Long Ptr) As HRESULT
+		Declare Abstract Function Get_Attributes (Byval pdwAttr As Long Ptr) As HRESULT
+		Declare Abstract Function SetHdc (Byval hdc As Long) As HRESULT
+	End Type 'IPicture_
+
+	Type Font_ Extends CAIDispatch ' Dispinterface only supports post binding!
+		' Declare Abstract UnKnown Name unknowcal () As BSTR
+		' Declare Abstract UnKnown Size unknowcal () As CY
+		' Declare Abstract UnKnown Bold unknowcal () As VARIANT_BOOL
+		' Declare Abstract UnKnown Italic unknowcal () As VARIANT_BOOL
+		' Declare Abstract UnKnown Underline unknowcal () As VARIANT_BOOL
+		' Declare Abstract UnKnown Strikethrough unknowcal () As VARIANT_BOOL
+		' Declare Abstract UnKnown Weight unknowcal () As Short
+		' Declare Abstract UnKnown Charset unknowcal () As Short
+	End Type 'Font_
+
+	Type Picture_ Extends CAIDispatch ' Dispinterface only supports post binding!
+		' Declare Abstract UnKnown Handle unknowcal () As Long
+		' Declare Abstract UnKnown hPal unknowcal () As Long
+		' Declare Abstract UnKnown Type_ unknowcal () As Short
+		' Declare Abstract UnKnown Width unknowcal () As Long
+		' Declare Abstract UnKnown Height unknowcal () As Long
+		' Declare Abstract Function Render (Byval hdc As Long, Byval x As Long, Byval y As Long, Byval cx As Long, Byval cy As Long, Byval xSrc As Long, Byval ySrc As Long, Byval cxSrc As Long, Byval cySrc As Long, Byval prcWBounds As Any Ptr) As HRESULT
+	End Type 'Picture_
+
+	Type FontEvents_ Extends CAIDispatch ' Dispinterface only supports post binding!
+		' Declare Abstract Function FontChanged (Byval PropertyName As BSTR) As HRESULT
+	End Type 'FontEvents_
+
+End Namespace

src/compiler/fb.bas

@@ -605,6 +605,7 @@ sub fbGlobalInit()
 	env.clopt.nocmdline     = FALSE
 	env.clopt.returninflts  = FALSE
 	env.clopt.nobuiltins    = FALSE
+	env.clopt.optabstract   = FALSE
 
 	env.restart_request     = FB_RESTART_NONE
 	env.restart_action      = FB_RESTART_NONE
@@ -744,6 +745,8 @@ sub fbSetOption( byval opt as integer, byval value as integer )
 		hUpdateTargetOptions( )
 	case FB_COMPOPT_NOBUILTINS
 		env.clopt.nobuiltins = value
+	case FB_COMPOPT_OPTABSTRACT
+		env.clopt.optabstract = value
 	end select
 end sub
 
@@ -846,6 +849,8 @@ function fbGetOption( byval opt as integer ) as integer
 		function = env.clopt.returninflts
 	case FB_COMPOPT_NOBUILTINS
 		function = env.clopt.nobuiltins
+	case FB_COMPOPT_OPTABSTRACT
+		function = env.clopt.optabstract
 
 	case else
 		function = 0

src/compiler/fb.bi

@@ -120,6 +120,7 @@ enum FB_COMPOPT
 	FB_COMPOPT_NOCMDLINE            '' boolean: -z nocmdline, disable #cmdline directives
 	FB_COMPOPT_RETURNINFLTS         '' boolean: -z retinflts, enable returning some structs in floating point registers
 	FB_COMPOPT_NOBUILTINS           '' boolean: -z nobuiltins, disable all non-required builtin procedure definitions
+	FB_COMPOPT_OPTABSTRACT          '' boolean: -z optabstract, only supports optimizing purely abstract types
 
 	FB_COMPOPTIONS
 end enum
@@ -337,6 +338,7 @@ type FBCMMLINEOPT
 	nocmdline       as integer              '' dissallow #cmdline directive? (default = false)
 	returninflts    as integer              '' enable returning some structs in floating point registers
 	nobuiltins      as integer              '' disable all non-required builtin procedure definitions
+	optabstract     as integer              '' only supports optimizing purely abstract types
 end type
 
 enum FB_PROFILE_OPT

src/compiler/fbc.bas

@@ -2548,6 +2548,8 @@ private sub handleOpt _
 			fbSetOption( FB_COMPOPT_RETURNINFLTS, TRUE )
 		case "nobuiltins"
 			fbSetOption( FB_COMPOPT_NOBUILTINS, TRUE )
+		case "optabstract"
+			fbSetOption( FB_COMPOPT_OPTABSTRACT, TRUE )
 		case else
 			hFatalInvalidOption( arg, is_source )
 		end select
@@ -4564,6 +4566,7 @@ private sub hPrintOptions( byval verbose as integer )
 	print "  -z no-fastcall   Don't use '__fastcall' calling convention"
 	print "  -z nobuiltins    Disable all non-required builtin procedure definitions"
 	print "  -z nocmdline     Disable #cmdline source directives"
+	print "  -z optabstract   Only supports optimizing purely abstract types"
 	print "  -z retinflts     Enable returning some types in floating point registers"
 	print "  -z valist-as-ptr Use pointer expressions to implement CVA_*() macros"
 	else

src/compiler/ir.bas

@@ -232,7 +232,9 @@ sub irForEachDataStmt( byval callback as sub( byval as FBSYMBOL ptr ) )
 end sub
 
 sub irhlFlushStaticInitializer( byval sym as FBSYMBOL ptr )
-	astLoadStaticInitializer( symbGetTypeIniTree( sym ), sym )
+	if not symbGetIsUnusedVtable( sym ) then
+		astLoadStaticInitializer( symbGetTypeIniTree( sym ), sym )
+	end if
 	symbSetTypeIniTree( sym, NULL )
 end sub