1' 2' Visual Basic.Net Compiler 3' Copyright (C) 2004 - 2010 Rolf Bjarne Kvinge, RKvinge@novell.com 4' 5' This library is free software; you can redistribute it and/or 6' modify it under the terms of the GNU Lesser General Public 7' License as published by the Free Software Foundation; either 8' version 2.1 of the License, or (at your option) any later version. 9' 10' This library is distributed in the hope that it will be useful, 11' but WITHOUT ANY WARRANTY; without even the implied warranty of 12' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13' Lesser General Public License for more details. 14' 15' You should have received a copy of the GNU Lesser General Public 16' License along with this library; if not, write to the Free Software 17' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18' 19 20Imports System.Reflection.Emit 21Imports System.Reflection 22 23''' <summary> 24''' ConstructorMemberDeclaration ::= 25''' [ Attributes ] [ ConstructorModifier+ ] "Sub" "New" [ "(" [ ParameterList ] ")" ] LineTerminator 26''' [ Block ] 27''' "End" "Sub" StatementTerminator 28''' </summary> 29''' <remarks></remarks> 30Public Class ConstructorDeclaration 31 Inherits MethodBaseDeclaration 32 Implements IConstructorMember 33 34 'Private m_Descriptor As New ConstructorDescriptor(Me) 35 36 Public Const ConstructorName As String = ".ctor" 37 Public Const SharedConstructorName As String = ".cctor" 38 39 'Private m_ConstructorBuilder As ConstructorBuilder 40 41 'Private m_CecilBuilder As Mono.Cecil.MethodDefinition 42 Private m_DefaultBaseConstructorCecil As Mono.Cecil.MethodReference 43 44 ''' <summary> 45 ''' The default base constructor to call if no call is specified in the code. 46 ''' </summary> 47 ''' <remarks></remarks> 48 Private m_DefaultBaseConstructor As Mono.Cecil.MethodReference 49 50 ''' <summary> 51 ''' The base/self constructor call in the code. 52 ''' </summary> 53 ''' <remarks></remarks> 54 Private m_BaseCtorCall As Statement 55 Private m_Added As Boolean 56 57 Sub New(ByVal Parent As TypeDeclaration) 58 MyBase.New(Parent) 59 End Sub 60 61 Shadows Sub Init(ByVal Code As CodeBlock) 62 MyBase.Init(New Modifiers(), New SubSignature(Me, ConstructorName, New ParameterList(Me)), Code) 63 End Sub 64 65 Shadows Sub Init(ByVal Modifiers As Modifiers, ByVal Signature As SubSignature, ByVal Block As CodeBlock) 66 67 'If vbnc.Modifiers.IsNothing(Modifiers) = False AndAlso Modifiers.Is(ModifierMasks.Shared) Then 68 If Modifiers.Is(ModifierMasks.Shared) OrElse FindTypeParent.IsModule Then 69 Signature.Init(New Identifier(Signature, SharedConstructorName, Signature.Location, TypeCharacters.Characters.None), Signature.TypeParameters, Signature.Parameters) 70 Else 71 Signature.Init(New Identifier(Signature, ConstructorName, Signature.Location, TypeCharacters.Characters.None), Signature.TypeParameters, Signature.Parameters) 72 End If 73 74 MyBase.Init(Modifiers, Signature, Block) 75 End Sub 76 77 ReadOnly Property ExplicitCtorCall() As Mono.Cecil.MethodReference 78 Get 79 Dim firststatement As BaseObject 80 Dim cs As CallStatement 81 Dim ie As InvocationOrIndexExpression 82 Dim ctor As Mono.Cecil.MethodReference 83 84 firststatement = Code.FirstStatement 85 If firststatement Is Nothing Then Return Nothing 86 87 cs = TryCast(firststatement, CallStatement) 88 If cs Is Nothing Then Return Nothing 89 90 ie = TryCast(cs.Target, InvocationOrIndexExpression) 91 If ie Is Nothing Then Return Nothing 92 If ie.Expression.Classification.IsMethodGroupClassification = False Then Return Nothing 93 94 ctor = ie.Expression.Classification.AsMethodGroupClassification.ResolvedConstructor 95 If ctor Is Nothing Then Return Nothing 96 97 If Helper.CompareNameOrdinal(ctor.Name, ConstructorDeclaration.ConstructorName) = False Then Return Nothing 98 99 If Helper.CompareType(CecilHelper.FindDefinition(ctor.DeclaringType), CecilHelper.FindDefinition(Me.FindTypeParent.BaseType)) Then 100 Return ctor 101 ElseIf Helper.CompareType(CecilHelper.FindDefinition(ctor.DeclaringType), CecilHelper.FindDefinition(Me.FindTypeParent.CecilType)) Then 102 Return ctor 103 Else 104 Return Nothing 105 End If 106 End Get 107 End Property 108 109 ReadOnly Property HasExplicitCtorCall() As Boolean 110 Get 111 Return ExplicitCtorCall IsNot Nothing 112 End Get 113 End Property 114 115 Overrides Function ResolveCode(ByVal Info As ResolveInfo) As Boolean 116 Dim result As Boolean = True 117 118 result = MyBase.ResolveCode(Info) AndAlso result 119 120 If result = False Then Return result 121 122 If Me.IsShared = False AndAlso Me.HasMethodBody AndAlso Me.HasExplicitCtorCall = False Then 123 CreateDefaultCtorCall() 124 CreateDefaultCtorCallCecil() 125 ElseIf Code IsNot Nothing AndAlso Me.HasExplicitCtorCall Then 126 m_BaseCtorCall = Code.FirstStatement 127 If m_BaseCtorCall IsNot Nothing Then Code.RemoveStatement(m_BaseCtorCall) 128 End If 129 130 If Me.IsShared AndAlso (Me.Modifiers.Mask And Me.Modifiers.AccessibilityMask) <> 0 Then 131 Select Case Me.Modifiers.Mask And Me.Modifiers.AccessibilityMask 132 Case ModifierMasks.Private 133 result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Private") 134 Case ModifierMasks.Protected 135 result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Protected") 136 Case ModifierMasks.Friend 137 result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Friend") 138 Case ModifierMasks.Protected Or ModifierMasks.Friend 139 result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Protected Friend") 140 Case ModifierMasks.Public 141 result = Report.ShowMessage(Messages.VBNC30480, Me.Location, "Public") 142 End Select 143 End If 144 145 Return result 146 End Function 147 148 Public Overrides Function CreateDefinition() As Boolean 149 Dim result As Boolean = True 150 151 result = MyBase.CreateDefinition AndAlso result 152 153 MethodImplAttributes = Mono.Cecil.MethodImplAttributes.IL 154 155 Return result 156 End Function 157 158 Friend Overrides Function GenerateCode(ByVal Info As EmitInfo) As Boolean 159 Dim result As Boolean = True 160 161 If CBool(MethodImplAttributes And Mono.Cecil.MethodImplAttributes.Runtime) Then 162 Return result 163 End If 164 165 Helper.Assert(Info Is Nothing) 166 Dim parent As IType = Me.FindTypeParent 167 Info = New EmitInfo(Me) 168 169#If DEBUG Then 170 Info.ILGen.Emit(Mono.Cecil.Cil.OpCodes.Nop) 171#End If 172 173 Dim ParentType As Mono.Cecil.TypeReference 174 ParentType = parent.CecilType 175 If TypeOf parent Is StructureDeclaration AndAlso Me.IsShared = False Then 176 Emitter.EmitLoadMe(Info, parent.CecilType) 177 Emitter.EmitInitObj(Info, parent.CecilType) 178 ElseIf m_DefaultBaseConstructor IsNot Nothing Then 179 Dim params As Mono.Collections.Generic.Collection(Of ParameterDefinition) = m_DefaultBaseConstructor.Parameters 180 Emitter.EmitLoadMe(Info, CecilHelper.FindDefinition(ParentType).BaseType) 181 For i As Integer = 0 To params.Count - 1 182 Helper.Assert(params(i).IsOptional) 183 Emitter.EmitLoadValue(Info.Clone(Me, True, False, params(i).ParameterType), params(i).Constant) 184 Next 185 186 Emitter.EmitCall(Info, m_DefaultBaseConstructor) 187 ElseIf m_BaseCtorCall IsNot Nothing Then 188 result = m_BaseCtorCall.GenerateCode(Info) 189 Else 190 Helper.Assert(Me.IsShared) 191 End If 192 193 Dim exCtorCall As Mono.Cecil.MethodReference = ExplicitCtorCall 194 If m_BaseCtorCall Is Nothing OrElse (exCtorCall IsNot Nothing AndAlso Helper.CompareType(exCtorCall.DeclaringType, Me.DeclaringType.CecilType) = False) Then 195 result = EmitVariableInitialization(Info) AndAlso result 196 197 If Not IsShared Then 198 For Each arhs As AddOrRemoveHandlerStatement In Me.DeclaringType.AddHandlers 199 result = arhs.GenerateCode(Info) AndAlso result 200 Next 201 End If 202 End If 203 204 If Me.IsShared Then 205 result = EmitConstantInitialization(Info) AndAlso result 206 End If 207 208#If DEBUG Then 209 Info.ILGen.Emit(Mono.Cecil.Cil.OpCodes.Nop) 210#End If 211 212 result = MyBase.GenerateCode(Info) AndAlso result 213 214 Return result 215 End Function 216 217 Private Function EmitVariableInitialization(ByVal Info As EmitInfo) As Boolean 218 Dim variables As Generic.List(Of TypeVariableDeclaration) 219 Dim parent As TypeDeclaration 220 Dim result As Boolean = True 221 222 parent = Me.DeclaringType 223 variables = parent.Members.GetSpecificMembers(Of TypeVariableDeclaration)() 224 225 For Each variable As TypeVariableDeclaration In variables 226 If variable.HasInitializer AndAlso variable.IsShared = Me.IsShared Then 227 result = variable.EmitVariableInitializer(Info) AndAlso result 228 End If 229 Next 230 231 For Each variable As LocalVariableDeclaration In parent.StaticVariables 232 If variable.HasInitializer AndAlso variable.DeclaringMethod.IsShared = Me.IsShared Then 233 If Me.IsShared = False Then Emitter.EmitLoadMe(Info, Me.DeclaringType.CecilType) 234 result = variable.CreateDefinition AndAlso result 235 Emitter.EmitNew(Info, Compiler.TypeCache.MS_VB_CS_StaticLocalInitFlag__ctor) 236 Emitter.EmitStoreField(Info, CecilHelper.GetCorrectMember(variable.StaticInitBuilder, variable.StaticInitBuilder.DeclaringType)) 237 End If 238 Next 239 240 Return result 241 End Function 242 243 Private Function EmitConstantInitialization(ByVal Info As EmitInfo) As Boolean 244 Dim result As Boolean = True 245 Dim parent As TypeDeclaration 246 Dim constant As Object = Nothing 247 248 Parent = Me.DeclaringType 249 250 For Each variable As ConstantDeclaration In parent.Members.GetSpecificMembers(Of ConstantDeclaration)() 251 result = variable.GetConstant(constant, True) AndAlso result 252 If Helper.CompareType(variable.FieldType, Compiler.TypeCache.System_DateTime) Then 253 Emitter.EmitLoadDateValue(Info, DirectCast(constant, Date)) 254 Emitter.EmitStoreField(Info, variable.FieldBuilder) 255 ElseIf Helper.CompareType(variable.FieldType, Compiler.TypeCache.System_Decimal) Then 256 Emitter.EmitLoadDecimalValue(Info, DirectCast(constant, Decimal)) 257 Emitter.EmitStoreField(Info, variable.FieldBuilder) 258 End If 259 Next 260 261 Return result 262 End Function 263 264 Private Sub CreateDefaultCtorCall() 265 Dim type As TypeDeclaration = Me.FindFirstParent(Of TypeDeclaration)() 266 Dim classtype As ClassDeclaration = TryCast(type, ClassDeclaration) 267 Dim defaultctor As Mono.Cecil.MethodReference 268 If classtype IsNot Nothing Then 269 defaultctor = classtype.GetBaseDefaultConstructor() 270 If defaultctor IsNot Nothing AndAlso Helper.IsPrivate(defaultctor) = False Then 271 If Helper.IsPrivate(defaultctor) OrElse (Helper.IsFriend(defaultctor) AndAlso Not Compiler.Assembly.IsDefinedHere(defaultctor.DeclaringType)) Then 272 Helper.AddError(Me, "Base class does not have an accessible default constructor") 273 Else 274 m_DefaultBaseConstructor = defaultctor 275 276#If DEBUG Then 277 Try 278 For Each param As Mono.Cecil.ParameterDefinition In m_DefaultBaseConstructor.Parameters 279 Helper.Assert(param.IsOptional) 280 Next 281 Catch ex As Exception 282 Helper.Assert(False) 283 End Try 284#End If 285 End If 286 End If 287 End If 288 End Sub 289 290 Private Sub CreateDefaultCtorCallCecil() 291 Dim type As TypeDeclaration = Me.FindFirstParent(Of TypeDeclaration)() 292 Dim classtype As ClassDeclaration = TryCast(type, ClassDeclaration) 293 Dim defaultctor As Mono.Cecil.MethodReference 294 If classtype IsNot Nothing Then 295 defaultctor = classtype.GetBaseDefaultConstructorCecil() 296 If defaultctor IsNot Nothing AndAlso Helper.IsPrivate(defaultctor) = False Then 297 If Helper.IsPrivate(defaultctor) OrElse (Helper.IsFamilyOrAssembly(defaultctor) AndAlso defaultctor.DeclaringType.Module.Assembly IsNot Me.Compiler.AssemblyBuilderCecil) Then 298 Helper.AddError(Compiler, Location, "Base class does not have an accessible default constructor") 299 Else 300 m_DefaultBaseConstructorCecil = defaultctor 301 m_DefaultBaseConstructorCecil = Helper.GetMethodOrMethodReference(Compiler, m_DefaultBaseConstructorCecil) 302 303#If DEBUG Then 304 Try 305 For Each param As Mono.Cecil.ParameterDefinition In m_DefaultBaseConstructor.Parameters 306 Helper.Assert(param.IsOptional) 307 Next 308 Catch ex As Exception 309 Helper.Assert(False) 310 End Try 311#End If 312 End If 313 End If 314 End If 315 End Sub 316 317 Shared Function IsMe(ByVal tm As tm) As Boolean 318 Dim i As Integer 319 While tm.PeekToken(i).Equals(ModifierMasks.ConstructorModifiers) 320 i += 1 321 End While 322 If tm.PeekToken(i).Equals(KS.Sub) = False Then Return False 323 Return tm.PeekToken(i + 1).Equals(KS.[New]) 324 End Function 325End Class 326