Skip to content

Commit f5b4c83

Browse files
jayrmjayrm
authored
Merge pull request #427 from skyfish4tb/master
Supports optimizing purely abstract types, and only preserve used pure abstract types.
2 parents ddfa43d + e2c2151 commit f5b4c83

File tree

14 files changed

+34443
-58
lines changed

14 files changed

+34443
-58
lines changed

‎examples/OptimizePureAbstractTypes/OptimizePureAbstractTypes.bas‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
#cmdline "-strip -R -z optabstract"
2+
3+
#Include "inc\EXCEL.bi"
4+
using Excel
5+
dim shared as ILine ptr pILine
6+
dim shared as Application Ptr RHS
7+
8+
if pILine then
9+
pILine->Get_Application(@RHS)
10+
end if

‎examples/OptimizePureAbstractTypes/PureAbstractTypes.bas‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,10 @@
1+
#cmdline "-strip -R"
2+
3+
#Include "inc\EXCEL.bi"
4+
using Excel
5+
dim shared as ILine ptr pILine
6+
dim shared as Application Ptr RHS
7+
8+
if pILine then
9+
pILine->Get_Application(@RHS)
10+
end if

‎examples/OptimizePureAbstractTypes/TestPureAbstractTypes.PNG‎

21.5 KB
Loading

‎examples/OptimizePureAbstractTypes/inc/EXCEL.bi‎

Lines changed: 25368 additions & 0 deletions
Large diffs are not rendered by default.

‎examples/OptimizePureAbstractTypes/inc/FBCom.bi‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
#Pragma Once
2+
#Include Once "Windows.bi"
3+
#include Once "crt/string.bi"
4+
#Include Once "win/olectl.bi"
5+
6+
Type CAIUnknown Extends Object
7+
Declare Abstract Function QueryInterface (ByVal riid As REFIID, ByVal ppvObject As LPVOID Ptr) As HRESULT
8+
Declare Abstract Function AddRef () As ULong
9+
Declare Abstract Function Release () As ULong
10+
End Type
11+
12+
Type CAIDispatch Extends CAIUnknown
13+
Declare Abstract Function GetTypeInfoCount(ByVal pctinfo As UINT Ptr) As HRESULT
14+
Declare Abstract Function GetTypeInfo (ByVal iTInfo As UINT, ByVal lcid As LCID, ByVal ppTInfo As ITypeInfo Ptr Ptr) As HRESULT
15+
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
16+
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
17+
End Type

‎examples/OptimizePureAbstractTypes/inc/MSO.bi‎

Lines changed: 8132 additions & 0 deletions
Large diffs are not rendered by default.

‎examples/OptimizePureAbstractTypes/inc/VBE6EXT.bi‎

Lines changed: 552 additions & 0 deletions
Large diffs are not rendered by default.

‎examples/OptimizePureAbstractTypes/inc/stdole2.bi‎

Lines changed: 181 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
'=============================================Type library===========================================
2+
' Name : stdole
3+
' Description: OLE Automation
4+
' Path : C:\Windows\SysWOW64\stdole2.tlb
5+
'====================================================================================================
6+
7+
#pragma Once
8+
#Include Once "FBCom.bi"
9+
10+
Namespace stdole
11+
12+
'Class identifier (CLSID)
13+
Const CLSID_StdFont = "{0BE35203-8F91-11CE-9DE3-00AA004BB851}"
14+
Const CLSID_StdPicture = "{0BE35204-8F91-11CE-9DE3-00AA004BB851}"
15+
16+
'Interface identifier (IID)
17+
Const IID_Font = "{BEF6E003-A874-101A-8BBA-00AA00300CAB}"
18+
Const IID_Picture = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
19+
Const IID_FontEvents = "{4EF6100A-AF88-11D0-9846-00C04FC29993}"
20+
21+
Type OLE_COLOR As ULong
22+
Type OLE_XPOS_PIXELS As Long
23+
Type OLE_YPOS_PIXELS As Long
24+
Type OLE_XSIZE_PIXELS As Long
25+
Type OLE_YSIZE_PIXELS As Long
26+
Type OLE_XPOS_HIMETRIC As Long
27+
Type OLE_YPOS_HIMETRIC As Long
28+
Type OLE_XSIZE_HIMETRIC As Long
29+
Type OLE_YSIZE_HIMETRIC As Long
30+
Type OLE_XPOS_CONTAINER As Single
31+
Type OLE_YPOS_CONTAINER As Single
32+
Type OLE_XSIZE_CONTAINER As Single
33+
Type OLE_YSIZE_CONTAINER As Single
34+
Type OLE_HANDLE As Long
35+
Type OLE_OPTEXCLUSIVE As VARIANT_BOOL
36+
Type OLE_CANCELBOOL As VARIANT_BOOL
37+
Type OLE_ENABLEDEFAULTBOOL As VARIANT_BOOL
38+
Type FONTNAME As BSTR
39+
Type FONTSIZE As CY
40+
Type FONTBOLD As VARIANT_BOOL
41+
Type FONTITALIC As VARIANT_BOOL
42+
Type FONTUNDERSCORE As VARIANT_BOOL
43+
Type FONTSTRIKETHROUGH As VARIANT_BOOL
44+
Type IFontDisp As Font
45+
Type IPictureDisp As Picture
46+
Type IFontEventsDisp As FontEvents
47+
48+
Enum OLE_TRISTATE
49+
Unchecked = 0
50+
Checked = 1
51+
Gray = 2
52+
End Enum
53+
54+
Enum LoadPictureConstants
55+
Default = 0
56+
Monochrome = 1
57+
VgaColor = 2
58+
Color = 4
59+
End Enum
60+
61+
'Module StdFunctions
62+
'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
63+
'Declare Function SavePicture Alias "OleSavePictureFile" (Byval Picture As Picture Ptr, Byval filename As BSTR) As HRESULT
64+
65+
Type GUID
66+
Data1 As ULong
67+
Data2 As UShort
68+
Data3 As UShort
69+
Data4(0 To 6) As UByte
70+
End Type
71+
72+
Type DISPPARAMS
73+
rgvarg As Variant Ptr Ptr
74+
rgdispidNamedArgs As Long Ptr
75+
cArgs As ULong
76+
cNamedArgs As ULong
77+
End Type
78+
79+
Type EXCEPINFO
80+
wCode As UShort
81+
wReserved As UShort
82+
bstrSource As BSTR
83+
bstrDescription As BSTR
84+
bstrHelpFile As BSTR
85+
dwHelpContext As ULong
86+
pvReserved As Any Ptr
87+
pfnDeferredFillIn As Any Ptr
88+
scode As Long
89+
End Type
90+
91+
' Interface pre declaration.
92+
Type IUnknown As CAIUnknown
93+
Type IDispatch As CAIDispatch
94+
Type IEnumVARIANT As IEnumVARIANT_
95+
Type IFont As IFont_
96+
Type IPicture As IPicture_
97+
98+
' Default interface pre declaration for component classes.
99+
Type StdFont As Font
100+
Type StdPicture As Picture
101+
102+
' Dual interface pre declaration.
103+
Type Font As Font_
104+
Type Picture As Picture_
105+
Type FontEvents As FontEvents_
106+
107+
Type IEnumVARIANT_ Extends CAIUnknown
108+
Declare Abstract Function Next_ (Byval celt As ULong, Byval rgvar As Variant Ptr Ptr, Byval pceltFetched As ULong Ptr) As HRESULT
109+
Declare Abstract Function Skip (Byval celt As ULong) As HRESULT
110+
Declare Abstract Function Reset () As HRESULT
111+
Declare Abstract Function Clone (Byval ppenum As IEnumVARIANT Ptr Ptr) As HRESULT
112+
End Type 'IEnumVARIANT_
113+
114+
Type IFont_ Extends CAIUnknown
115+
Declare Abstract Function Get_Name (Byval pname As BSTR Ptr) As HRESULT
116+
Declare Abstract Function Let_Name (Byval pname As BSTR) As HRESULT
117+
Declare Abstract Function Get_Size (Byval psize As CY Ptr) As HRESULT
118+
Declare Abstract Function Let_Size (Byval psize As CY) As HRESULT
119+
Declare Abstract Function Get_Bold (Byval pbold As VARIANT_BOOL Ptr) As HRESULT
120+
Declare Abstract Function Let_Bold (Byval pbold As VARIANT_BOOL) As HRESULT
121+
Declare Abstract Function Get_Italic (Byval pitalic As VARIANT_BOOL Ptr) As HRESULT
122+
Declare Abstract Function Let_Italic (Byval pitalic As VARIANT_BOOL) As HRESULT
123+
Declare Abstract Function Get_Underline (Byval punderline As VARIANT_BOOL Ptr) As HRESULT
124+
Declare Abstract Function Let_Underline (Byval punderline As VARIANT_BOOL) As HRESULT
125+
Declare Abstract Function Get_Strikethrough (Byval pstrikethrough As VARIANT_BOOL Ptr) As HRESULT
126+
Declare Abstract Function Let_Strikethrough (Byval pstrikethrough As VARIANT_BOOL) As HRESULT
127+
Declare Abstract Function Get_Weight (Byval pweight As Short Ptr) As HRESULT
128+
Declare Abstract Function Let_Weight (Byval pweight As Short) As HRESULT
129+
Declare Abstract Function Get_Charset (Byval pcharset As Short Ptr) As HRESULT
130+
Declare Abstract Function Let_Charset (Byval pcharset As Short) As HRESULT
131+
Declare Abstract Function Get_hFont (Byval phfont As Long Ptr) As HRESULT
132+
Declare Abstract Function Clone (Byval ppfont As IFont Ptr Ptr) As HRESULT
133+
Declare Abstract Function IsEqual (Byval pfontOther As IFont Ptr) As HRESULT
134+
Declare Abstract Function SetRatio (Byval cyLogical As Long, Byval cyHimetric As Long) As HRESULT
135+
Declare Abstract Function AddRefHfont (Byval hFont As Long) As HRESULT
136+
Declare Abstract Function ReleaseHfont (Byval hFont As Long) As HRESULT
137+
End Type 'IFont_
138+
139+
Type IPicture_ Extends CAIUnknown
140+
Declare Abstract Function Get_Handle (Byval phandle As Long Ptr) As HRESULT
141+
Declare Abstract Function Get_hPal (Byval phpal As Long Ptr) As HRESULT
142+
Declare Abstract Function Get_Type (Byval ptype As Short Ptr) As HRESULT
143+
Declare Abstract Function Get_Width (Byval pwidth As Long Ptr) As HRESULT
144+
Declare Abstract Function Get_Height (Byval pheight As Long Ptr) As HRESULT
145+
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
146+
Declare Abstract Function Let_hPal (Byval phpal As Long) As HRESULT
147+
Declare Abstract Function Get_CurDC (Byval phdcOut As Long Ptr) As HRESULT
148+
Declare Abstract Function SelectPicture (Byval hdcIn As Long, Byval phdcOut As Long Ptr, Byval phbmpOut As Long Ptr) As HRESULT
149+
Declare Abstract Function Get_KeepOriginalFormat (Byval pfkeep As VARIANT_BOOL Ptr) As HRESULT
150+
Declare Abstract Function Let_KeepOriginalFormat (Byval pfkeep As VARIANT_BOOL) As HRESULT
151+
Declare Abstract Function PictureChanged () As HRESULT
152+
Declare Abstract Function SaveAsFile (Byval pstm As Any Ptr, Byval fSaveMemCopy As VARIANT_BOOL, Byval pcbSize As Long Ptr) As HRESULT
153+
Declare Abstract Function Get_Attributes (Byval pdwAttr As Long Ptr) As HRESULT
154+
Declare Abstract Function SetHdc (Byval hdc As Long) As HRESULT
155+
End Type 'IPicture_
156+
157+
Type Font_ Extends CAIDispatch ' Dispinterface only supports post binding!
158+
' Declare Abstract UnKnown Name unknowcal () As BSTR
159+
' Declare Abstract UnKnown Size unknowcal () As CY
160+
' Declare Abstract UnKnown Bold unknowcal () As VARIANT_BOOL
161+
' Declare Abstract UnKnown Italic unknowcal () As VARIANT_BOOL
162+
' Declare Abstract UnKnown Underline unknowcal () As VARIANT_BOOL
163+
' Declare Abstract UnKnown Strikethrough unknowcal () As VARIANT_BOOL
164+
' Declare Abstract UnKnown Weight unknowcal () As Short
165+
' Declare Abstract UnKnown Charset unknowcal () As Short
166+
End Type 'Font_
167+
168+
Type Picture_ Extends CAIDispatch ' Dispinterface only supports post binding!
169+
' Declare Abstract UnKnown Handle unknowcal () As Long
170+
' Declare Abstract UnKnown hPal unknowcal () As Long
171+
' Declare Abstract UnKnown Type_ unknowcal () As Short
172+
' Declare Abstract UnKnown Width unknowcal () As Long
173+
' Declare Abstract UnKnown Height unknowcal () As Long
174+
' 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
175+
End Type 'Picture_
176+
177+
Type FontEvents_ Extends CAIDispatch ' Dispinterface only supports post binding!
178+
' Declare Abstract Function FontChanged (Byval PropertyName As BSTR) As HRESULT
179+
End Type 'FontEvents_
180+
181+
End Namespace

‎src/compiler/fb.bas‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -605,6 +605,7 @@ sub fbGlobalInit()
605605
env.clopt.nocmdline = FALSE
606606
env.clopt.returninflts = FALSE
607607
env.clopt.nobuiltins = FALSE
608+
env.clopt.optabstract = FALSE
608609

609610
env.restart_request = FB_RESTART_NONE
610611
env.restart_action = FB_RESTART_NONE
@@ -744,6 +745,8 @@ sub fbSetOption( byval opt as integer, byval value as integer )
744745
hUpdateTargetOptions( )
745746
case FB_COMPOPT_NOBUILTINS
746747
env.clopt.nobuiltins = value
748+
case FB_COMPOPT_OPTABSTRACT
749+
env.clopt.optabstract = value
747750
end select
748751
end sub
749752

@@ -846,6 +849,8 @@ function fbGetOption( byval opt as integer ) as integer
846849
function = env.clopt.returninflts
847850
case FB_COMPOPT_NOBUILTINS
848851
function = env.clopt.nobuiltins
852+
case FB_COMPOPT_OPTABSTRACT
853+
function = env.clopt.optabstract
849854

850855
case else
851856
function = 0

‎src/compiler/fb.bi‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,7 @@ enum FB_COMPOPT
120120
FB_COMPOPT_NOCMDLINE '' boolean: -z nocmdline, disable #cmdline directives
121121
FB_COMPOPT_RETURNINFLTS '' boolean: -z retinflts, enable returning some structs in floating point registers
122122
FB_COMPOPT_NOBUILTINS '' boolean: -z nobuiltins, disable all non-required builtin procedure definitions
123+
FB_COMPOPT_OPTABSTRACT '' boolean: -z optabstract, only supports optimizing purely abstract types
123124

124125
FB_COMPOPTIONS
125126
end enum
@@ -337,6 +338,7 @@ type FBCMMLINEOPT
337338
nocmdline as integer '' dissallow #cmdline directive? (default = false)
338339
returninflts as integer '' enable returning some structs in floating point registers
339340
nobuiltins as integer '' disable all non-required builtin procedure definitions
341+
optabstract as integer '' only supports optimizing purely abstract types
340342
end type
341343

342344
enum FB_PROFILE_OPT

0 commit comments

Comments
 (0)