summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 62331d4)
raw | patch | inline | side by side (parent: 62331d4)
| author | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sun, 27 Sep 2015 19:02:05 +0000 (22:02 +0300) | ||
| committer | DeaDDooMER <deaddoomer@deadsoftware.ru> | |
| Sun, 27 Sep 2015 19:02:05 +0000 (22:02 +0300) |
13 files changed:
| BuildProcessTemplates/DefaultTemplate.11.1.xaml | [deleted file] | patch | blob | history |
| BuildProcessTemplates/LabDefaultTemplate.11.xaml | [deleted file] | patch | blob | history |
| BuildProcessTemplates/UpgradeTemplate.xaml | [deleted file] | patch | blob | history |
| J2CPS/Makefile | [new file with mode: 0644] | patch | blob |
| Makefile | [new file with mode: 0644] | patch | blob |
| gpcp/Makefile | [new file with mode: 0644] | patch | blob |
| gpcp/PeUtil.cp | [deleted file] | patch | blob | history |
| gpcp/PeUtilForNET.cp | patch | blob | history | |
| libs/cpascal/JvmMakeAll.bat | [deleted file] | patch | blob | history |
| libs/cpascal/MakeAll.bat | [deleted file] | patch | blob | history |
| libs/cpascal/Makefile | [new file with mode: 0644] | patch | blob |
| libs/java/MakeAll.bat | [deleted file] | patch | blob | history |
| libs/java/Makefile | [new file with mode: 0644] | patch | blob |
diff --git a/BuildProcessTemplates/DefaultTemplate.11.1.xaml b/BuildProcessTemplates/DefaultTemplate.11.1.xaml
+++ /dev/null
@@ -1,543 +0,0 @@
-<Activity mc:Ignorable="sad" x:Class="TfsBuild.Process" xmlns="http://schemas.microsoft.com/netfx/2009/xaml/activities" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mt="clr-namespace:Microsoft.TeamFoundation;assembly=Microsoft.TeamFoundation.Common" xmlns:mtbc="clr-namespace:Microsoft.TeamFoundation.Build.Client;assembly=Microsoft.TeamFoundation.Build.Client" xmlns:mtbw="clr-namespace:Microsoft.TeamFoundation.Build.Workflow;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbwa="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Activities;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbwt="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Tracking;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mttbb="clr-namespace:Microsoft.TeamFoundation.TestImpact.BuildIntegration.BuildActivities;assembly=Microsoft.TeamFoundation.TestImpact.BuildIntegration" xmlns:mtvc="clr-namespace:Microsoft.TeamFoundation.VersionControl.Client;assembly=Microsoft.TeamFoundation.VersionControl.Client" xmlns:mtvco="clr-namespace:Microsoft.TeamFoundation.VersionControl.Common;assembly=Microsoft.TeamFoundation.VersionControl.Common" xmlns:mva="clr-namespace:Microsoft.VisualBasic.Activities;assembly=System.Activities" xmlns:s="clr-namespace:System;assembly=mscorlib" xmlns:sad="http://schemas.microsoft.com/netfx/2009/xaml/activities/presentation" xmlns:sad1="clr-namespace:System.Activities.Debugger;assembly=System.Activities" xmlns:scg="clr-namespace:System.Collections.Generic;assembly=mscorlib" xmlns:sl="clr-namespace:System.Linq;assembly=System.Core" xmlns:this="clr-namespace:TfsBuild;" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml">\r
- <x:Members>\r
- <x:Property Name="BuildSettings" Type="InArgument(mtbwa:BuildSettings)" />\r
- <x:Property Name="TestSpecs" Type="InArgument(mtbwa:TestSpecList)" />\r
- <x:Property Name="BuildNumberFormat" Type="InArgument(x:String)" />\r
- <x:Property Name="SolutionSpecificBuildOutputs" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="CleanWorkspace" Type="InArgument(mtbwa:CleanWorkspaceOption)" />\r
- <x:Property Name="RunCodeAnalysis" Type="InArgument(mtbwa:CodeAnalysisOption)" />\r
- <x:Property Name="SourceAndSymbolServerSettings" Type="InArgument(mtbwa:SourceAndSymbolServerSettings)" />\r
- <x:Property Name="AgentSettings" Type="InArgument(mtbwa:AgentSettings)" />\r
- <x:Property Name="AssociateChangesetsAndWorkItems" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="CreateWorkItem" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="MSBuildArguments" Type="InArgument(x:String)" />\r
- <x:Property Name="MSBuildPlatform" Type="InArgument(mtbwa:ToolPlatform)" />\r
- <x:Property Name="MSBuildMultiProc" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="PerformTestImpactAnalysis" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="CreateLabel" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="DisableTests" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="GetVersion" Type="InArgument(x:String)" />\r
- <x:Property Name="PrivateDropLocation" Type="InArgument(x:String)" />\r
- <x:Property Name="Verbosity" Type="InArgument(mtbw:BuildVerbosity)" />\r
- <x:Property Name="Metadata" Type="mtbw:ProcessParameterMetadataCollection" />\r
- <x:Property Name="SupportedReasons" Type="mtbc:BuildReason" />\r
- <x:Property Name="BuildProcessVersion" Type="x:String" />\r
- </x:Members>\r
- <this:Process.BuildSettings>[New Microsoft.TeamFoundation.Build.Workflow.Activities.BuildSettings()]</this:Process.BuildSettings>\r
- <this:Process.DisableTests>[False]</this:Process.DisableTests>\r
- <this:Process.TestSpecs>[New Microsoft.TeamFoundation.Build.Workflow.Activities.TestSpecList(New Microsoft.TeamFoundation.Build.Workflow.Activities.AgileTestPlatformSpec("**\*test*.dll"))]</this:Process.TestSpecs>\r
- <this:Process.BuildNumberFormat>["$(BuildDefinitionName)_$(Date:yyyyMMdd)$(Rev:.r)"]</this:Process.BuildNumberFormat>\r
- <this:Process.SolutionSpecificBuildOutputs>[False]</this:Process.SolutionSpecificBuildOutputs>\r
- <this:Process.AssociateChangesetsAndWorkItems>[True]</this:Process.AssociateChangesetsAndWorkItems>\r
- <this:Process.CreateWorkItem>[True]</this:Process.CreateWorkItem>\r
- <this:Process.CleanWorkspace>[Microsoft.TeamFoundation.Build.Workflow.Activities.CleanWorkspaceOption.All]</this:Process.CleanWorkspace>\r
- <this:Process.MSBuildArguments>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.MSBuildArguments>\r
- <this:Process.RunCodeAnalysis>[Microsoft.TeamFoundation.Build.Workflow.Activities.CodeAnalysisOption.AsConfigured]</this:Process.RunCodeAnalysis>\r
- <this:Process.MSBuildMultiProc>[True]</this:Process.MSBuildMultiProc>\r
- <this:Process.MSBuildPlatform>[Microsoft.TeamFoundation.Build.Workflow.Activities.ToolPlatform.Auto]</this:Process.MSBuildPlatform>\r
- <this:Process.PerformTestImpactAnalysis>[True]</this:Process.PerformTestImpactAnalysis>\r
- <this:Process.SourceAndSymbolServerSettings>[New Microsoft.TeamFoundation.Build.Workflow.Activities.SourceAndSymbolServerSettings(True, Nothing)]</this:Process.SourceAndSymbolServerSettings>\r
- <this:Process.CreateLabel>[True]</this:Process.CreateLabel>\r
- <this:Process.GetVersion>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.GetVersion>\r
- <this:Process.AgentSettings>[New Microsoft.TeamFoundation.Build.Workflow.Activities.AgentSettings() With {.MaxWaitTime = New System.TimeSpan(4, 0, 0), .MaxExecutionTime = New System.TimeSpan(0, 0, 0), .TagComparison = Microsoft.TeamFoundation.Build.Workflow.Activities.TagComparison.MatchExactly }]</this:Process.AgentSettings>\r
- <this:Process.Verbosity>[Microsoft.TeamFoundation.Build.Workflow.BuildVerbosity.Normal]</this:Process.Verbosity>\r
- <this:Process.Metadata>\r
- <mtbw:ProcessParameterMetadataCollection>\r
- <mtbw:ProcessParameterMetadata BrowsableWhen="EditingDefinition" Category="#300 Advanced" DisplayName="MSBuild Multi-Proc" Description="Enable MSBuid Multi-proc to build your solutions' projects in parallel, when possible, using all available processors on the build server." ParameterName="MSBuildMultiProc" />\r
- <mtbw:ProcessParameterMetadata BrowsableWhen="EditingDefinition" Category="#300 Advanced" DisplayName="Solution Specific Build Outputs" Description="True will put build outputs into folders based on the solution name. False will put all build outputs into the same folder." ParameterName="SolutionSpecificBuildOutputs" />\r
- </mtbw:ProcessParameterMetadataCollection>\r
- </this:Process.Metadata>\r
- <this:Process.SupportedReasons>All</this:Process.SupportedReasons>\r
- <this:Process.BuildProcessVersion>11.0</this:Process.BuildProcessVersion> \r
- <mva:VisualBasic.Settings>Assembly references and imported namespaces serialized as XML namespaces</mva:VisualBasic.Settings>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbc:IBuildDetail" Name="BuildDetail" />\r
- <Variable x:TypeArguments="x:String" Name="DropLocation" />\r
- </Sequence.Variables>\r
- <mtbwa:GetBuildDetail DisplayName="Get the Build" Result="[BuildDetail]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Sequence DisplayName="Update Drop Location" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:InvokeForReason DisplayName="Update Build Number for Triggered Builds" Reason="Triggered">\r
- <mtbwa:UpdateBuildNumber BuildNumberFormat="[BuildNumberFormat]" DisplayName="Update Build Number" />\r
- </mtbwa:InvokeForReason>\r
- <If Condition="[(Not String.IsNullOrEmpty(BuildDetail.DropLocationRoot)) AndAlso (BuildDetail.Reason And Microsoft.TeamFoundation.Build.Client.BuildReason.Triggered) = BuildDetail.Reason]" DisplayName="If Build Reason is Triggered" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <Assign x:TypeArguments="x:String" mtbwt:BuildTrackingParticipant.Importance="None" Value="[BuildDropProvider.CombinePaths(BuildDetail.DropLocationRoot, BuildDetail.BuildDefinition.Name, BuildDetail.BuildNumber)]" To="[DropLocation]" />\r
- <mtbwa:SetBuildProperties DisplayName="Set Drop Location" DropLocation="[DropLocation]" PropertiesToSet="DropLocation" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <If Condition="[(Not String.IsNullOrEmpty(PrivateDropLocation)) AndAlso BuildDetail.Reason = Microsoft.TeamFoundation.Build.Client.BuildReason.ValidateShelveset]" DisplayName="If Build Reason is ValidateShelveset" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <Assign x:TypeArguments="x:String" Value="[BuildDropProvider.CombinePaths(PrivateDropLocation, BuildDetail.BuildDefinition.Name, BuildDetail.BuildNumber)]" To="[DropLocation]" mtbwt:BuildTrackingParticipant.Importance="None" />\r
- <mtbwa:SetBuildProperties DisplayName="Set Drop Location for Private Build" DropLocation="[DropLocation]" PropertiesToSet="DropLocation" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- <mtbwa:AgentScope DisplayName="Run On Agent" MaxExecutionTime="[AgentSettings.MaxExecutionTime]" MaxWaitTime="[AgentSettings.MaxWaitTime]" ReservationSpec="[AgentSettings.GetAgentReservationSpec()]">\r
- <mtbwa:AgentScope.Variables>\r
- <Variable x:TypeArguments="mtbc:IBuildAgent" Name="BuildAgent" />\r
- <Variable x:TypeArguments="mtvc:Workspace" Name="Workspace" />\r
- <Variable x:TypeArguments="x:String" Name="BuildDirectory" />\r
- <Variable x:TypeArguments="x:String" Default="[BuildDetail.BuildNumber]" Name="LabelName" />\r
- <Variable x:TypeArguments="x:String" Name="WorkspaceName" />\r
- <Variable x:TypeArguments="x:String" Name="SourcesDirectory" />\r
- <Variable x:TypeArguments="x:String" Name="BinariesDirectory" />\r
- <Variable x:TypeArguments="x:String" Name="TestResultsDirectory" />\r
- </mtbwa:AgentScope.Variables>\r
- <Sequence DisplayName="Initialize Variables" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:GetBuildAgent DisplayName="Get the Agent" Result="[BuildAgent]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:GetBuildDirectory DisplayName="Get the Build Directory" Result="[BuildDirectory]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Assign x:TypeArguments="x:String" DisplayName="Initialize Workspace Name" To="[WorkspaceName]" Value="[String.Format("{0}_{1}_{2}", BuildDetail.BuildDefinition.Id, Microsoft.TeamFoundation.LinkingUtilities.DecodeUri(BuildAgent.Uri.AbsoluteUri).ToolSpecificId, BuildAgent.ServiceHost.Name)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Assign x:TypeArguments="x:String" DisplayName="Initialize Sources Directory" To="[SourcesDirectory]" Value="[String.Format("{0}\Sources", BuildDirectory)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Assign x:TypeArguments="x:String" DisplayName="Initialize Binaries Directory" To="[BinariesDirectory]" Value="[String.Format("{0}\Binaries", BuildDirectory)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Assign x:TypeArguments="x:String" DisplayName="Initialize TestResults Directory" To="[TestResultsDirectory]" Value="[String.Format("{0}\TestResults", BuildDirectory)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[Not BuildSettings.HasPlatformConfigurations]" DisplayName="If Not BuildSettings.HasPlatformConfigurations" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <AddToCollection x:TypeArguments="mtbwa:PlatformConfiguration" DisplayName="Use Default Platform Configuration" Collection="[BuildSettings.PlatformConfigurations]" Item="[Microsoft.TeamFoundation.Build.Workflow.Activities.PlatformConfiguration.Default]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[WorkspaceName.Length > Microsoft.TeamFoundation.VersionControl.Common.RepositoryConstants.MaxWorkspaceNameSize]" DisplayName="If WorkspaceName > MaxSize" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <mtbwa:WriteBuildWarning DisplayName="Write Workspace Size Warning" Message="[String.Format("The workspace name '{0}' exceeds the maximum allowed limit of '{1}' characters. Truncating it to match the maximum limit.", WorkspaceName, Microsoft.TeamFoundation.VersionControl.Common.RepositoryConstants.MaxWorkspaceNameSize)]" />\r
- <Assign x:TypeArguments="x:String" DisplayName="Truncate WorkspaceName to MaxSize" To="[WorkspaceName]" Value="[WorkspaceName.Substring(0, Microsoft.TeamFoundation.VersionControl.Common.RepositoryConstants.MaxWorkspaceNameSize).TrimEnd()]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- <Sequence DisplayName="Initialize Workspace" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:DeleteDirectory Directory="[TestResultsDirectory]" DisplayName="Delete Test Results Directory" Recursive="[True]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[Not CleanWorkspace = Microsoft.TeamFoundation.Build.Workflow.Activities.CleanWorkspaceOption.None]" DisplayName="If Not CleanWorkspace = CleanWorkspaceOption.None" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:DeleteDirectory Directory="[BinariesDirectory]" DisplayName="Delete Binaries Directory" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[CleanWorkspace = Microsoft.TeamFoundation.Build.Workflow.Activities.CleanWorkspaceOption.All]" DisplayName="If CleanWorkspace = CleanWorkspaceOption.All" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Delete Workspace and Sources Directory" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:DeleteWorkspace DeleteLocalItems="[True]" DisplayName="Delete Workspace" Name="[WorkspaceName]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:DeleteDirectory Directory="[SourcesDirectory]" DisplayName="Delete Sources Directory" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <mtbwa:CreateWorkspace BuildDirectory="[BuildDirectory]" Comment="["Workspace Created by Team Build"]" DisplayName="Create Workspace" Name="[WorkspaceName]" Result="[Workspace]" SourcesDirectory="[SourcesDirectory]" />\r
- <If Condition="[CleanWorkspace = Microsoft.TeamFoundation.Build.Workflow.Activities.CleanWorkspaceOption.Outputs]" DisplayName="If CleanWorkspace = CleanWorkspaceOption.Outputs" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <ForEach x:TypeArguments="mtbwa:PlatformConfiguration" DisplayName="For Each Configuration in BuildSettings.PlatformConfigurations" Values="[BuildSettings.PlatformConfigurations]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <ActivityAction x:TypeArguments="mtbwa:PlatformConfiguration">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="mtbwa:PlatformConfiguration" Name="platformConfiguration" />\r
- </ActivityAction.Argument>\r
- <Sequence DisplayName="Clean Configuration">\r
- <If Condition="[BuildSettings.HasProjectsToBuild]" DisplayName="If BuildSettings.HasProjectsToBuild" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <ForEach x:TypeArguments="x:String" DisplayName="For Each Project in BuildSettings.ProjectsToBuild" Values="[BuildSettings.ProjectsToBuild]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <ActivityAction x:TypeArguments="x:String">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="x:String" Name="serverBuildProjectItem" />\r
- </ActivityAction.Argument>\r
- <Sequence DisplayName="Clean Project" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:String" Name="localBuildProjectItem" />\r
- </Sequence.Variables>\r
- <mtbwa:ConvertWorkspaceItem DisplayName="Convert Server Paths to Local Paths" Input="[serverBuildProjectItem]" Result="[localBuildProjectItem]" Workspace="[Workspace]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[System.IO.File.Exists(localBuildProjectItem)]" DisplayName="If File.Exists(Project)" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:MSBuild CommandLineArguments="[String.Format("/p:SkipInvalidConfigurations=true {0}", MSBuildArguments)]" Configuration="[platformConfiguration.Configuration]" DisplayName="Run MSBuild for Project" GenerateVSPropsFile="[True]" MaxProcesses="[If (MSBuildMultiProc, 0, 1)]" OutDir="[BinariesDirectory]" Platform="[platformConfiguration.Platform]" Project="[localBuildProjectItem]" Targets="[New String() { "Clean" }]" TargetsNotLogged="[New String() {"GetNativeManifest", "GetCopyToOutputDirectoryItems", "GetTargetPath"}]" ToolPlatform="[MSBuildPlatform]" Verbosity="[Verbosity]" />\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </ActivityAction>\r
- </ForEach>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </ActivityAction>\r
- </ForEach>\r
- </If.Then>\r
- </If>\r
- <mtbwa:SyncWorkspace DisplayName="Get Workspace" VersionOverride="[GetVersion]" Workspace="[Workspace]">\r
- <mtbwa:SyncWorkspace.RequestsFailed>\r
- <ActivityAction x:TypeArguments="scg:ICollection(mtbc:IQueuedBuild)">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="scg:ICollection(mtbc:IQueuedBuild)" Name="failedRequests" />\r
- </ActivityAction.Argument>\r
- <mtbwa:RetryRequests Behavior="[Microsoft.TeamFoundation.Build.Workflow.Activities.RetryBehavior.DoNotBatch]" DisplayName="Mark Requests for Retry" Requests="[failedRequests]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </ActivityAction>\r
- </mtbwa:SyncWorkspace.RequestsFailed>\r
- </mtbwa:SyncWorkspace>\r
- </Sequence>\r
- <If Condition="[CreateLabel]" DisplayName="If CreateLabel" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:InvokeForReason DisplayName="Create and Set Label for non-Shelveset Builds" Reason="Manual, IndividualCI, BatchedCI, Schedule, ScheduleForced, UserCreated">\r
- <mtbwa:LabelWorkspace Comment="["Label Created by Team Build"]" DisplayName="Create Label" Name="[LabelName]" Scope="[String.Format("$/{0}", BuildDetail.BuildDefinition.TeamProject)]" Workspace="[Workspace]" />\r
- <mtbwa:SetBuildProperties DisplayName="Set Label on BuildDetail" LabelName="[String.Format("{0}@$/{1}", LabelName, BuildDetail.BuildDefinition.TeamProject)]" PropertiesToSet="LabelName" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </mtbwa:InvokeForReason>\r
- </If.Then>\r
- <If.Else>\r
- <mtbwa:WriteBuildMessage DisplayName="Write Message" Message="Not Labeling sources" Importance="[Microsoft.TeamFoundation.Build.Client.BuildMessageImportance.High]" />\r
- </If.Else>\r
- </If>\r
- <TryCatch DisplayName="Try Compile, Test, and Associate Changesets and Work Items" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Finally>\r
- <Sequence DisplayName="Revert Workspace and Copy Files to Drop Location" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:InvokeForReason DisplayName="Revert Workspace for Shelveset Builds" Reason="CheckInShelveset, ValidateShelveset">\r
- <mtbwa:RevertWorkspace DisplayName="Revert Workspace" Workspace="[Workspace]" />\r
- </mtbwa:InvokeForReason>\r
- <If Condition="[Not String.IsNullOrEmpty(DropLocation)]" DisplayName="If DropLocation is Set" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:CopyDirectory DisplayName="Drop Files to Drop Location" Source="[BinariesDirectory]" Destination="[DropLocation]" />\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </TryCatch.Finally>\r
- <TryCatch.Try>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="s:Exception" Name="compilationException" />\r
- <Variable x:TypeArguments="scg:IList(mtvc:Changeset)" Name="associatedChangesets" />\r
- <Variable x:TypeArguments="s:Boolean" Name="treatTestFailureAsBuildFailure" />\r
- </Sequence.Variables>\r
- <Parallel DisplayName="Compile, Test, and Associate Changesets and Work Items">\r
- <TryCatch DisplayName="Try Compile and Test" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Try>\r
- <Sequence DisplayName="Compile and Test">\r
- <ForEach x:TypeArguments="mtbwa:PlatformConfiguration" DisplayName="For Each Configuration in BuildSettings.PlatformConfigurations" Values="[BuildSettings.PlatformConfigurations]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <ActivityAction x:TypeArguments="mtbwa:PlatformConfiguration">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="mtbwa:PlatformConfiguration" Name="platformConfiguration" />\r
- </ActivityAction.Argument>\r
- <Sequence DisplayName="Compile and Test for Configuration" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:String" Name="outputDirectory" />\r
- <Variable x:TypeArguments="x:String" Name="logFileDropLocation" />\r
- </Sequence.Variables>\r
- <Sequence DisplayName="Initialize Variables" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Assign x:TypeArguments="x:String" DisplayName="Create OutputDirectory Per Platform and Configuration" To="[outputDirectory]" Value="[If (platformConfiguration.IsEmpty Or BuildSettings.PlatformConfigurations.Count = 1, BinariesDirectory, If (platformConfiguration.IsPlatformEmptyOrAnyCpu, BinariesDirectory + "\" + platformConfiguration.Configuration, BinariesDirectory + "\" + platformConfiguration.Platform + "\" + platformConfiguration.Configuration))]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[Not String.IsNullOrEmpty(DropLocation)]" DisplayName="If DropLocation is Set" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Assign x:TypeArguments="x:String" DisplayName="Initialize LogFile Drop Location" To="[logFileDropLocation]" Value="[If (platformConfiguration.IsEmpty Or BuildSettings.PlatformConfigurations.Count = 1, BuildDropProvider.CombinePaths(DropLocation, "logs"), If (platformConfiguration.IsPlatformEmptyOrAnyCpu, BuildDropProvider.CombinePaths(DropLocation, "logs", platformConfiguration.Configuration), BuildDropProvider.CombinePaths(DropLocation, "logs", platformConfiguration.Platform, platformConfiguration.Configuration)))]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- <If Condition="[BuildSettings.HasProjectsToBuild]" DisplayName="If BuildSettings.HasProjectsToBuild" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <ForEach x:TypeArguments="x:String" DisplayName="For Each Project in BuildSettings.ProjectsToBuild" Values="[BuildSettings.ProjectsToBuild]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <ActivityAction x:TypeArguments="x:String">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="x:String" Name="serverBuildProjectItem" />\r
- </ActivityAction.Argument>\r
- <TryCatch DisplayName="Try to Compile the Project" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Try>\r
- <Sequence DisplayName="Compile the Project" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:String" Name="localProject" />\r
- <Variable x:TypeArguments="x:String" Name="outputDirectoryPerProject" Default="[outputDirectory]" />\r
- </Sequence.Variables>\r
- <mtbwa:ConvertWorkspaceItem DisplayName="Convert Server Path to Local Path" Input="[serverBuildProjectItem]" Result="[localProject]" Workspace="[Workspace]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[SolutionSpecificBuildOutputs]" DisplayName="If Build Outputs are Solution-Specific" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Update Output Directory" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Assign x:TypeArguments="x:String" DisplayName="Set Solution-Specific Output Directory" To="[outputDirectoryPerProject]" Value="[System.IO.Path.Combine(outputDirectory, System.IO.Path.GetFileNameWithoutExtension(localProject))]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If DisplayName="If Output Directory Exists" Condition="[System.IO.Directory.Exists(outputDirectoryPerProject)]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:WriteBuildWarning DisplayName="Write Duplicate Project Names Warning" Message="[String.Format("{0} conflicts with another solution/project. Build outputs for solutions/projects with the same name will be copied to the same directory. To separate the build outputs, change the name of one of the solutions/projects.", System.IO.Path.GetFileNameWithoutExtension(localProject))]" />\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <mtbwa:MSBuild CommandLineArguments="[String.Format("/p:SkipInvalidConfigurations=true {0}", MSBuildArguments)]" Configuration="[platformConfiguration.Configuration]" DisplayName="Run MSBuild for Project" GenerateVSPropsFile="[True]" LogFileDropLocation="[logFileDropLocation]" MaxProcesses="[If (MSBuildMultiProc, 0, 1)]" OutDir="[outputDirectoryPerProject]" Platform="[platformConfiguration.Platform]" Project="[localProject]" RunCodeAnalysis="[RunCodeAnalysis]" TargetsNotLogged="[New String() {"GetNativeManifest", "GetCopyToOutputDirectoryItems", "GetTargetPath"}]" ToolPlatform="[MSBuildPlatform]" Verbosity="[Verbosity]" />\r
- </Sequence>\r
- </TryCatch.Try>\r
- <TryCatch.Catches>\r
- <Catch x:TypeArguments="s:Exception">\r
- <ActivityAction x:TypeArguments="s:Exception">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="s:Exception" Name="ex" />\r
- </ActivityAction.Argument>\r
- <Sequence DisplayName="Handle Exception">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="scg:ICollection(mtbc:IQueuedBuild)" Name="failedRequests" />\r
- </Sequence.Variables>\r
- <mtbwa:SetBuildProperties CompilationStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Failed]" DisplayName="Set CompilationStatus to Failed" PropertiesToSet="CompilationStatus" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[CreateWorkItem]" DisplayName="If CreateWorkItem" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:InvokeForReason DisplayName="Create Work Item for non-Shelveset Builds" Reason="Manual, IndividualCI, BatchedCI, Schedule, ScheduleForced, UserCreated">\r
- <mtbwa:OpenWorkItem AssignedTo="[BuildDetail.RequestedFor]" Comment="["This work item was created by TFS Build on a build failure."]" CustomFields="[New Dictionary(Of String, String) From { {"System.Reason", "Build Failure"}, {"Microsoft.VSTS.TCM.ReproSteps", "Start the build using TFS Build"}, {"Priority", "1"}, {"Severity", "1 - Critical"} }]" DisplayName="Create Work Item" Title="[String.Format("Build Failure in Build: {0}", BuildDetail.BuildNumber)]" Type="["Bug"]" />\r
- </mtbwa:InvokeForReason>\r
- </If.Then>\r
- </If>\r
- <mtbwa:GetApprovedRequests DisplayName="Get Requests Approved for Check In" Result="[failedRequests]" mtbwt:BuildTrackingParticipant.Importance="None" />\r
- <mtbwa:RetryRequests Behavior="[Microsoft.TeamFoundation.Build.Workflow.Activities.RetryBehavior.DoNotBatch]" DisplayName="Mark Requests for Retry" Requests="[failedRequests]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <Rethrow DisplayName="Rethrow the exception so the build will stop" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </ActivityAction>\r
- </Catch>\r
- </TryCatch.Catches>\r
- </TryCatch>\r
- </ActivityAction>\r
- </ForEach>\r
- </If.Then>\r
- </If>\r
- <If Condition="[Not DisableTests]" DisplayName="If Not DisableTests" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Run Tests" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If Condition="[Not TestSpecs Is Nothing]" DisplayName="If Not TestSpecs Is Nothing" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <ForEach x:TypeArguments="mtbwa:TestSpec" DisplayName="For Each TestSpec in TestSpecs" Values="[TestSpecs]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <ActivityAction x:TypeArguments="mtbwa:TestSpec">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="mtbwa:TestSpec" Name="spec" />\r
- </ActivityAction.Argument>\r
- <TryCatch DisplayName="Try Run Tests" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Try>\r
- <If Condition="[TypeOf spec Is Microsoft.TeamFoundation.Build.Workflow.Activities.AgileTestPlatformSpec]" DisplayName="If spec Is AgileTestPlatformSpec" mtbwt:BuildTrackingParticipant.Importance="None">\r
- <If.Then>\r
- <Sequence DisplayName="Run Visual Studio Test Runner for Test Sources" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbwa:AgileTestPlatformSpec" Name="agileTestPlatformAssembly" />\r
- <Variable x:TypeArguments="scg:IEnumerable(x:String)" Name="agileTestPlatformAssemblies" />\r
- </Sequence.Variables>\r
- <Assign x:TypeArguments="mtbwa:AgileTestPlatformSpec" DisplayName="Assign spec to agileTestPlatformAssembly" To="[agileTestPlatformAssembly]" Value="[DirectCast(spec, Microsoft.TeamFoundation.Build.Workflow.Activities.AgileTestPlatformSpec)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:FindMatchingFiles DisplayName="Find Visual Studio Test Platform Test Assemblies" MatchPattern="[String.Format("{0}\{1}", outputDirectory, agileTestPlatformAssembly.AssemblyFileSpec)]" Result="[agileTestPlatformAssemblies]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[agileTestPlatformAssemblies.Count() > 0]" DisplayName="If Visual Studio Test Platform Test Assemblies Found" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <If Condition="[agileTestPlatformAssembly.HasRunSettingsFile]" DisplayName="If agileTestPlatformAssembly.HasRunSettingsFile" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Find Run Settings File And Run Visual Studio Test Runner" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:String" Name="localRunSettings" />\r
- </Sequence.Variables>\r
- <mtbwa:GenerateRunSettings DisplayName="Generate Run Settings File" RunSettingsForTestRun="[agileTestPlatformAssembly.RunSettingsForTestRun]" Result="[localRunSettings]" Workspace="[Workspace]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:RunTests DisplayName="Run Visual Studio Test Runner for Test Sources" RunName="[agileTestPlatformAssembly.RunName]" Flavor="[platformConfiguration.Configuration]" Platform="[platformConfiguration.Platform]" TestSources="[agileTestPlatformAssemblies]" RunSettings="[localRunSettings]" TestCaseFilter="[agileTestPlatformAssembly.TestCaseFilter]" ExecutionPlatform="[agileTestPlatformAssembly.ExecutionPlatform]" />\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <mtbwa:RunTests DisplayName="Run Visual Studio Test Runner for Test Sources" RunName="[agileTestPlatformAssembly.RunName]" Flavor="[platformConfiguration.Configuration]" Platform="[platformConfiguration.Platform]" TestSources="[agileTestPlatformAssemblies]" TestCaseFilter="[agileTestPlatformAssembly.TestCaseFilter]" ExecutionPlatform="[agileTestPlatformAssembly.ExecutionPlatform]" />\r
- </If.Else>\r
- </If>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <If Condition="[TypeOf spec Is Microsoft.TeamFoundation.Build.Workflow.Activities.TestMetadataFileSpec]" DisplayName="If spec Is TestMetadataFileSpec" mtbwt:BuildTrackingParticipant.Importance="None">\r
- <If.Then>\r
- <Sequence DisplayName="Run MSTest for Metadata File">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbwa:TestMetadataFileSpec" Name="testMetadataFile" />\r
- <Variable x:TypeArguments="x:String" Name="localTestMetadata" />\r
- </Sequence.Variables>\r
- <Assign x:TypeArguments="mtbwa:TestMetadataFileSpec" DisplayName="Assign spec to testMetadataFile" To="[testMetadataFile]" Value="[DirectCast(spec, Microsoft.TeamFoundation.Build.Workflow.Activities.TestMetadataFileSpec)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:ConvertWorkspaceItem DisplayName="Convert Server Path to Local Path" Input="[testMetadataFile.MetadataFileName]" Result="[localTestMetadata]" Workspace="[Workspace]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:MSTest RunTitle="[testMetadataFile.RunName]" Category="[testMetadataFile.CategoryFilter]" DisplayName="Run MSTest for Metadata File" Flavor="[platformConfiguration.Configuration]" MaxPriority="[testMetadataFile.MaximumPriority]" MinPriority="[testMetadataFile.MinimumPriority]" PathToResultsFilesRoot="[TestResultsDirectory]" Platform="[platformConfiguration.Platform]" SearchPathRoot="[outputDirectory]" TestLists="[testMetadataFile.TestLists]" TestMetadata="[localTestMetadata]" TestSettings="[String.Empty]" CommandLineArguments="[testMetadataFile.MSTestCommandLineArgs]" />\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <Sequence DisplayName="Run MSTest for Test Assemblies" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbwa:TestAssemblySpec" Name="testAssembly" />\r
- <Variable x:TypeArguments="scg:IEnumerable(x:String)" Name="testAssemblies" />\r
- <Variable x:TypeArguments="x:String" Default="[String.Empty]" Name="testFlavor" />\r
- <Variable x:TypeArguments="x:String" Default="[String.Empty]" Name="testPlatform" />\r
- </Sequence.Variables>\r
- <Assign x:TypeArguments="mtbwa:TestAssemblySpec" DisplayName="Assign spec to testAssembly" To="[testAssembly]" Value="[DirectCast(spec, Microsoft.TeamFoundation.Build.Workflow.Activities.TestAssemblySpec)]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:FindMatchingFiles DisplayName="Find Test Assemblies" MatchPattern="[String.Format("{0}\{1}", outputDirectory, testAssembly.AssemblyFileSpec)]" Result="[testAssemblies]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[testAssemblies.Count() > 0]" DisplayName="If Test Assemblies Found" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <If Condition="[testAssembly.HasTestSettingsFile]" DisplayName="If testAssembly.HasTestSettingsFile" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Find Test Settings File And Run MSTest" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:String" Name="localTestSettings" />\r
- </Sequence.Variables>\r
- <mtbwa:ConvertWorkspaceItem DisplayName="Convert Server Path to Local Path" Input="[testAssembly.TestSettingsFileName]" Result="[localTestSettings]" Workspace="[Workspace]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mtbwa:MSTest RunTitle="[testAssembly.RunName]" Category="[testAssembly.CategoryFilter]" DisplayName="Run MSTest for Test Assemblies" Flavor="[platformConfiguration.Configuration]" MaxPriority="[testAssembly.MaximumPriority]" MinPriority="[testAssembly.MinimumPriority]" PathToResultsFilesRoot="[TestResultsDirectory]" Platform="[platformConfiguration.Platform]" SearchPathRoot="[outputDirectory]" TestContainers="[testAssemblies]" TestSettings="[localTestSettings]" CommandLineArguments="[testAssembly.MSTestCommandLineArgs]" />\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <mtbwa:MSTest RunTitle="[testAssembly.RunName]" Category="[testAssembly.CategoryFilter]" DisplayName="Run MSTest for Test Assemblies" Flavor="[platformConfiguration.Configuration]" MaxPriority="[testAssembly.MaximumPriority]" MinPriority="[testAssembly.MinimumPriority]" PathToResultsFilesRoot="[TestResultsDirectory]" Platform="[platformConfiguration.Platform]" SearchPathRoot="[outputDirectory]" TestContainers="[testAssemblies]" CommandLineArguments="[testAssembly.MSTestCommandLineArgs]" />\r
- </If.Else>\r
- </If>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </If.Else>\r
- </If>\r
- </If.Else>\r
- </If>\r
- </TryCatch.Try>\r
- <TryCatch.Catches>\r
- <Catch x:TypeArguments="s:Exception">\r
- <ActivityAction x:TypeArguments="s:Exception">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="s:Exception" Name="testException" />\r
- </ActivityAction.Argument>\r
- <Sequence DisplayName="Handle Test Run Exception">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="scg:ICollection(mtbc:IQueuedBuild)" Name="failedRequests" />\r
- </Sequence.Variables>\r
- <If Condition="[Not (TypeOf testException Is Microsoft.TeamFoundation.Build.Workflow.Activities.TestFailureException)]" DisplayName="If testException is NOT TestFailureException" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:WriteBuildError DisplayName="Write Test Failure Message" Message="[testException.Message]" />\r
- </If.Then>\r
- </If>\r
- <mtbwa:SetBuildProperties DisplayName="Set TestStatus to Failed" PropertiesToSet="TestStatus" TestStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Failed]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[spec.FailBuildOnFailure]" DisplayName="If spec.FailBuildOnFailure" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Assign x:TypeArguments="s:Boolean" DisplayName="Set treatTestFailureAsBuildFailure to True" To="[treatTestFailureAsBuildFailure]" Value="[True]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <mtbwa:GetApprovedRequests DisplayName="Get Requests Approved for Check In" Result="[failedRequests]" mtbwt:BuildTrackingParticipant.Importance="None" />\r
- <mtbwa:RetryRequests Behavior="[Microsoft.TeamFoundation.Build.Workflow.Activities.RetryBehavior.DoNotBatch]" DisplayName="Mark Requests for Retry" Requests="[failedRequests]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </Sequence>\r
- </ActivityAction>\r
- </Catch>\r
- </TryCatch.Catches>\r
- </TryCatch>\r
- </ActivityAction>\r
- </ForEach>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <If Condition="[(Not TestSpecs Is Nothing) And (TestSpecs.Count > 0)]" DisplayName="If TestSpecs Is Not Nothing or Empty" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:WriteBuildWarning DisplayName="Write Warning" Message="No automated tests will be run for this build because tests have been disabled for this build definition. To enable these tests, edit this build definition and set the Disable Tests process parameter to false." />\r
- </If.Then>\r
- </If>\r
- </If.Else>\r
- </If>\r
- </Sequence>\r
- </ActivityAction>\r
- </ForEach>\r
- <If Condition="[BuildDetail.CompilationStatus = Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Unknown]" DisplayName="If CompilationStatus = Unknown" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:SetBuildProperties CompilationStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Succeeded]" DisplayName="Set CompilationStatus to Succeeded" PropertiesToSet="CompilationStatus" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[BuildDetail.TestStatus = Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Unknown]" DisplayName="If TestStatus = Unknown" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:SetBuildProperties DisplayName="Set TestStatus to Succeeded" PropertiesToSet="TestStatus" TestStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Succeeded]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[treatTestFailureAsBuildFailure And (BuildDetail.TestStatus = Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Failed)]" DisplayName="If TreatTestFailureAsBuildFailure And (TestStatus = Failed)" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:SetBuildProperties DisplayName="Set Status to Failed" PropertiesToSet="Status" Status="[Microsoft.TeamFoundation.Build.Client.BuildStatus.Failed]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </TryCatch.Try>\r
- <TryCatch.Catches>\r
- <Catch x:TypeArguments="s:Exception">\r
- <ActivityAction x:TypeArguments="s:Exception">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="s:Exception" Name="compilationExceptionArgument" />\r
- </ActivityAction.Argument>\r
- <Assign x:TypeArguments="s:Exception" DisplayName="Save the Compilation Exception" To="[compilationException]" Value="[compilationExceptionArgument]" mtbwt:BuildTrackingParticipant.Importance="None" />\r
- </ActivityAction>\r
- </Catch>\r
- </TryCatch.Catches>\r
- </TryCatch>\r
- <If Condition="[AssociateChangesetsAndWorkItems]" DisplayName="If AssociateChangesetsAndWorkItems" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <If Condition="[CreateLabel]" DisplayName="If CreateLabel and AssociateChangesetsAndWorkItems" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:InvokeForReason DisplayName="Associate Changesets and Work Items for non-Shelveset Builds" Reason="Manual, IndividualCI, BatchedCI, Schedule, ScheduleForced, UserCreated">\r
- <mtbwa:AssociateChangesetsAndWorkItems DisplayName="Associate Changesets and Work Items" Result="[associatedChangesets]" />\r
- </mtbwa:InvokeForReason>\r
- </If.Then>\r
- <If.Else>\r
- <mtbwa:WriteBuildWarning DisplayName="Write Associate Changesets and Work Items Warning" Message="Cannot Associate Changesets and Work Items because the Label Sources option is set to False." />\r
- </If.Else>\r
- </If>\r
- </If.Then>\r
- </If>\r
- </Parallel>\r
- <If Condition="[Not compilationException Is Nothing]" DisplayName="If a Compilation Exception Occurred" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Throw DisplayName="Rethrow Compilation Exception" Exception="[compilationException]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- </If.Then>\r
- </If>\r
- <Parallel DisplayName="Get Impacted Tests, Index Sources and Publish Symbols">\r
- <If Condition="[PerformTestImpactAnalysis]" DisplayName="If PerformTestImpactAnalysis" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <Sequence DisplayName="Get Impacted Tests" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="scg:IEnumerable(x:String)" Name="assemblies" />\r
- </Sequence.Variables>\r
- <mtbwa:FindMatchingFiles DisplayName="Find Build Outputs" MatchPattern="[String.Format("{0}\**\*.dll;{0}\**\*.exe", BinariesDirectory)]" Result="[assemblies]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <mttbb:GetImpactedTests Assemblies="[assemblies]" AssociatedChangesets="[associatedChangesets]" BinariesRoot="[BinariesDirectory]" Build="[BuildDetail]" CodeChanges="{x:Null}" DisplayName="Get Impacted Tests" ImpactedTests="{x:Null}" Workspace="[Workspace]" />\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <If Condition="[SourceAndSymbolServerSettings.IndexSources Or SourceAndSymbolServerSettings.HasSymbolStorePath]" DisplayName="If SourceAndSymbolServerSettings.IndexSources Or SourceAndSymbolServerSettings.HasSymbolStorePath" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <mtbwa:InvokeForReason DisplayName="Index Sources and Publish Symbols for Triggered Builds" Reason="Triggered">\r
- <mtbwa:InvokeForReason.Variables>\r
- <Variable x:TypeArguments="scg:IEnumerable(x:String)" Name="symbolFiles" />\r
- </mtbwa:InvokeForReason.Variables>\r
- <mtbwa:FindMatchingFiles DisplayName="Find Symbol Files" MatchPattern="[String.Format("{0}\**\*.pdb", BinariesDirectory)]" Result="[symbolFiles]" mtbwt:BuildTrackingParticipant.Importance="Low" />\r
- <If Condition="[SourceAndSymbolServerSettings.IndexSources]" DisplayName="If SourceAndSymbolServerSettings.IndexSources" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <TryCatch DisplayName="Try Index Sources" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Try>\r
- <mtbwa:IndexSources DisplayName="Index Sources" FileList="[symbolFiles]" />\r
- </TryCatch.Try>\r
- <TryCatch.Catches>\r
- <Catch x:TypeArguments="s:Exception">\r
- <ActivityAction x:TypeArguments="s:Exception">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="s:Exception" Name="exception" />\r
- </ActivityAction.Argument>\r
- <mtbwa:WriteBuildError DisplayName="Write Indexing Sources Error" Message="[exception.Message]" />\r
- </ActivityAction>\r
- </Catch>\r
- </TryCatch.Catches>\r
- </TryCatch>\r
- </If.Then>\r
- </If>\r
- <If Condition="[SourceAndSymbolServerSettings.HasSymbolStorePath]" DisplayName="If SourceAndSymbolServerSettings.HasSymbolStorePath" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <If.Then>\r
- <TryCatch DisplayName="Try Publish Symbols" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <TryCatch.Try>\r
- <mtbwa:SharedResourceScope DisplayName="Synchronize Access to Symbol Store" MaxExecutionTime="[TimeSpan.Zero]" MaxWaitTime="[New TimeSpan(1, 0, 0)]" ResourceName="[SourceAndSymbolServerSettings.SymbolStorePath]" mtbwt:BuildTrackingParticipant.Importance="Low">\r
- <mtbwa:PublishSymbols DisplayName="Publish Symbols" FileList="[symbolFiles]" ProductName="[BuildDetail.BuildDefinition.Name]" StorePath="[SourceAndSymbolServerSettings.SymbolStorePath]" Version="[BuildDetail.BuildNumber]" />\r
- </mtbwa:SharedResourceScope>\r
- </TryCatch.Try>\r
- <TryCatch.Catches>\r
- <Catch x:TypeArguments="s:Exception">\r
- <ActivityAction x:TypeArguments="s:Exception">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="s:Exception" Name="exception" />\r
- </ActivityAction.Argument>\r
- <mtbwa:WriteBuildError DisplayName="Write Publishing Symbols Error" Message="[exception.Message]" />\r
- </ActivityAction>\r
- </Catch>\r
- </TryCatch.Catches>\r
- </TryCatch>\r
- </If.Then>\r
- </If>\r
- </mtbwa:InvokeForReason>\r
- </If.Then>\r
- </If>\r
- </Parallel>\r
- </Sequence>\r
- </TryCatch.Try>\r
- </TryCatch>\r
- </mtbwa:AgentScope>\r
- <mtbwa:InvokeForReason DisplayName="Check In Gated Changes for CheckInShelveset Builds" Reason="CheckInShelveset">\r
- <mtbwa:CheckInGatedChanges DisplayName="Check In Gated Changes" />\r
- </mtbwa:InvokeForReason>\r
- </Sequence>\r
-</Activity>\r
diff --git a/BuildProcessTemplates/LabDefaultTemplate.11.xaml b/BuildProcessTemplates/LabDefaultTemplate.11.xaml
+++ /dev/null
@@ -1,208 +0,0 @@
-<Activity mc:Ignorable="sads sap" x:Class="TfsBuild.Process" this:Process.LabWorkflowParameters="[New Microsoft.TeamFoundation.Lab.Workflow.Activities.LabWorkflowDetails()]" this:Process.Verbosity="[Microsoft.TeamFoundation.Build.Workflow.BuildVerbosity.Normal]" this:Process.BuildNumberFormat="["$(BuildDefinitionName)_$(Date:yyyyMMdd)$(Rev:.r)"]" this:Process.SupportedReasons="Manual, BatchedCI, Schedule, ScheduleForced" this:Process.TimeoutForDeploymentScriptInMinutes="30" xmlns="http://schemas.microsoft.com/netfx/2009/xaml/activities" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mt="clr-namespace:Microsoft.TeamFoundation;assembly=Microsoft.TeamFoundation.Common" xmlns:mtbc="clr-namespace:Microsoft.TeamFoundation.Build.Client;assembly=Microsoft.TeamFoundation.Build.Client" xmlns:mtbc1="clr-namespace:Microsoft.TeamFoundation.Build.Common;assembly=Microsoft.TeamFoundation.Build.Common" xmlns:mtbp="clr-namespace:Microsoft.TeamFoundation.Build.ProcessComponents;assembly=Microsoft.TeamFoundation.Build.ProcessComponents" xmlns:mtbw="clr-namespace:Microsoft.TeamFoundation.Build.Workflow;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbwa="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Activities;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbws="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Services;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtlc="clr-namespace:Microsoft.TeamFoundation.Lab.Client;assembly=Microsoft.TeamFoundation.Lab.Client" xmlns:mtltc="clr-namespace:Microsoft.TeamFoundation.Lab.TestIntegration.Client;assembly=Microsoft.TeamFoundation.Lab.TestIntegration.Client" xmlns:mtlwa="clr-namespace:Microsoft.TeamFoundation.Lab.Workflow.Activities;assembly=Microsoft.TeamFoundation.Lab.Workflow.Activities" xmlns:mtlwc="clr-namespace:Microsoft.TeamFoundation.Lab.WorkflowIntegration.Client;assembly=Microsoft.TeamFoundation.Lab.WorkflowIntegration.Client" xmlns:mttbb="clr-namespace:Microsoft.TeamFoundation.TestImpact.BuildIntegration.BuildActivities;assembly=Microsoft.TeamFoundation.TestImpact.BuildIntegration" xmlns:mttc="clr-namespace:Microsoft.TeamFoundation.TestManagement.Client;assembly=Microsoft.TeamFoundation.TestManagement.Client" xmlns:mtvc="clr-namespace:Microsoft.TeamFoundation.VersionControl.Client;assembly=Microsoft.TeamFoundation.VersionControl.Client" xmlns:mva="clr-namespace:Microsoft.VisualBasic.Activities;assembly=System.Activities" xmlns:s="clr-namespace:System;assembly=mscorlib" xmlns:s1="clr-namespace:System;assembly=System" xmlns:s2="clr-namespace:System;assembly=System.Core" xmlns:s3="clr-namespace:System;assembly=System.ServiceModel" xmlns:s4="clr-namespace:System;assembly=System.ComponentModel.Composition" xmlns:sa="clr-namespace:System.Activities;assembly=System.Activities" xmlns:sad="clr-namespace:System.Activities.Debugger;assembly=System.Activities" xmlns:sads="http://schemas.microsoft.com/netfx/2010/xaml/activities/debugger" xmlns:sap="http://schemas.microsoft.com/netfx/2009/xaml/activities/presentation" xmlns:scg="clr-namespace:System.Collections.Generic;assembly=mscorlib" xmlns:sl="clr-namespace:System.Linq;assembly=System.Core" xmlns:this="clr-namespace:TfsBuild" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml">\r
- <x:Members>\r
- <x:Property Name="BuildProcessVersion" Type="x:String" />\r
- <x:Property Name="Metadata" Type="mtbw:ProcessParameterMetadataCollection" />\r
- <x:Property Name="LabWorkflowParameters" Type="InArgument(mtlwa:LabWorkflowDetails)" />\r
- <x:Property Name="Verbosity" Type="InArgument(mtbw:BuildVerbosity)" />\r
- <x:Property Name="BuildNumberFormat" Type="InArgument(x:String)" />\r
- <x:Property Name="SupportedReasons" Type="mtbc:BuildReason" />\r
- <x:Property Name="TimeoutForDeploymentScriptInMinutes" Type="InArgument(x:Int32)">\r
- <x:Property.Attributes>\r
- <RequiredArgumentAttribute />\r
- </x:Property.Attributes>\r
- </x:Property>\r
- </x:Members>\r
- <this:Process.BuildProcessVersion>11.0</this:Process.BuildProcessVersion>\r
- <this:Process.Metadata>\r
- <mtbw:ProcessParameterMetadataCollection>\r
- <mtbw:ProcessParameterMetadata BrowsableWhen="Always" Category="Misc" DisplayName="Timeout For Each Deployment Script (in Minutes)" ParameterName="TimeoutForDeploymentScriptInMinutes" />\r
- </mtbw:ProcessParameterMetadataCollection>\r
- </this:Process.Metadata>\r
- <sap:VirtualizedContainerService.HintSize>920,3702</sap:VirtualizedContainerService.HintSize>\r
- <mva:VisualBasic.Settings>Assembly references and imported namespaces serialized as XML namespaces</mva:VisualBasic.Settings>\r
- <Sequence DisplayName="Application Deployment Workflow" sad:XamlDebuggerXmlReader.FileName="D:\VSTLM\src\vset\LabManager\LabCustomActivities\Templates\LabDefaultTemplate.xaml" sap:VirtualizedContainerService.HintSize="880,3662" mva:VisualBasic.Settings="Assembly references and imported namespaces serialized as XML namespaces">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbc:IBuildDetail" Name="BuildDetail" />\r
- <Variable x:TypeArguments="x:String" Name="LabEnvironmentUri" />\r
- <Variable x:TypeArguments="x:String" Name="BuildLocation" />\r
- <Variable x:TypeArguments="x:Int64" Name="SnapshotId" />\r
- <Variable x:TypeArguments="x:Int32" Name="QueueBuildId" />\r
- <Variable x:TypeArguments="mtbc:BuildStatus" Default="[Microsoft.TeamFoundation.Build.Client.BuildStatus.Succeeded]" Name="BuildStatus" />\r
- <Variable x:TypeArguments="mtbc:IBuildDetail" Name="ChildBuildDetail" />\r
- <Variable x:TypeArguments="mtbc:IBuildDetail" Name="SelectedBuildDetail" />\r
- <Variable x:TypeArguments="x:String" Name="BuildNumber" />\r
- <Variable x:TypeArguments="mtlc:LabEnvironment" Name="LabEnvironment" />\r
- </Sequence.Variables> \r
- <mtbwa:UpdateBuildNumber BuildNumberFormat="[BuildNumberFormat]" DisplayName="Update Build Number" sap:VirtualizedContainerService.HintSize="858,22" />\r
- <mtbwa:GetBuildDetail DisplayName="Get Build Details" sap:VirtualizedContainerService.HintSize="858,22" Result="[BuildDetail]" />\r
- <If Condition="[LabWorkflowParameters.BuildDetails.IsTeamSystemBuild = True AndAlso LabWorkflowParameters.BuildDetails.QueueNewBuild = True]" DisplayName="If Build is needed" sap:VirtualizedContainerService.HintSize="858,416">\r
- <If.Then>\r
- <Sequence DisplayName="Do Build" sap:VirtualizedContainerService.HintSize="301,308">\r
- <sap:WorkflowViewStateService.ViewState>\r
- <scg:Dictionary x:TypeArguments="x:String, x:Object">\r
- <x:Boolean x:Key="IsExpanded">True</x:Boolean>\r
- </scg:Dictionary>\r
- </sap:WorkflowViewStateService.ViewState>\r
- <mtlwa:RunWorkflow BuildController="{x:Null}" LabEnvironmentUri="{x:Null}" BuildDefinition="[LabWorkflowParameters.BuildDetails.BuildDefinitionName]" DisplayName="Start Build Workflow" sap:VirtualizedContainerService.HintSize="242,22" ProjectName="[BuildDetail.TeamProject]" Result="[QueueBuildId]" />\r
- <mtlwa:WaitForWorkflow AllowPartiallySucceededBuild="True" BuildDetails="[ChildBuildDetail]" DisplayName="Wait For Build To Complete" sap:VirtualizedContainerService.HintSize="242,22" LabWorkflowType="[Microsoft.TeamFoundation.Lab.Workflow.Activities.WorkflowType.Build]" MaxConsecutiveFailuresToIgnoreDuringWaitForCompletion="[3]" MaxWaitTime="[TimeSpan.Zero]" QueueBuildId="[QueueBuildId]" RefreshInterval="[System.TimeSpan.FromMinutes(1)]" Result="[BuildStatus]" ThrowOnError="True" />\r
- <Assign DisplayName="Set Build Location" sap:VirtualizedContainerService.HintSize="242,60">\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="x:Uri">[LabWorkflowParameters.BuildDetails.BuildUri]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="x:Uri">[ChildBuildDetail.Uri]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <mtlwa:WriteDeploymentInformation Url="{x:Null}" DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.Deploy]" DisplayName="Update Deployment Summary" sap:VirtualizedContainerService.HintSize="858,22" Message="[String.Format("Lab environment: {0}", LabWorkflowParameters.EnvironmentDetails.LabEnvironmentName)]" />\r
- <mtlwa:GetBuildLocationAndBuildNumber BuildDetails="[LabWorkflowParameters.BuildDetails]" BuildNumber="[BuildNumber]" DisplayName="Get Build Location And Build Number" sap:VirtualizedContainerService.HintSize="858,22" Result="[BuildLocation]" SelectedBuild="[SelectedBuildDetail]" />\r
- <If Condition="[LabWorkflowParameters.BuildDetails.IsTeamSystemBuild = True]" DisplayName="Compute build location needed" sap:VirtualizedContainerService.HintSize="858,208">\r
- <If.Then>\r
- <Assign DisplayName="Compute build path" sap:VirtualizedContainerService.HintSize="291,100">\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="x:String">[BuildLocation]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="x:String">[If(LabWorkflowParameters.BuildDetails.Configuration Is Nothing, BuildLocation, If(LabWorkflowParameters.BuildDetails.Configuration.IsEmpty Or (SelectedBuildDetail.Information.GetNodesByType(Microsoft.TeamFoundation.Build.Common.InformationTypes.ConfigurationSummary, True)).Count = 1, BuildLocation, If(LabWorkflowParameters.BuildDetails.Configuration.IsPlatformEmptyOrAnyCpu, BuildLocation + "\" + LabWorkflowParameters.BuildDetails.Configuration.Configuration, BuildLocation + "\" + LabWorkflowParameters.BuildDetails.Configuration.Platform + "\" + LabWorkflowParameters.BuildDetails.Configuration.Configuration)))]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- </If.Then>\r
- </If>\r
- <If Condition="[LabWorkflowParameters.EnvironmentDetails.Disposition = Microsoft.TeamFoundation.Lab.Client.LabEnvironmentDisposition.Stored]" DisplayName="If user selected stored environment" sap:VirtualizedContainerService.HintSize="858,208">\r
- <If.Then>\r
- <Throw DisplayName="Indicate error" Exception="[New System.Exception("You have selected an environment that is stored in the library. Select an environment that is deployed on a team project host group.")]" sap:VirtualizedContainerService.HintSize="269,100" />\r
- </If.Then>\r
- </If>\r
- <Assign DisplayName="Get Lab Environment Uri" sap:VirtualizedContainerService.HintSize="858,22" >\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="x:String">[LabEnvironmentUri]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="x:String">[LabWorkflowParameters.EnvironmentDetails.LabEnvironmentUri.ToString()]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- <mtlwa:GetLabEnvironment DisplayName="Get Lab Environment" LabEnvironmentUri="[LabEnvironmentUri]" Result="[LabEnvironment]" />\r
- <If Condition="[LabWorkflowParameters.EnvironmentDetails.RevertToSnapshot = True]" DisplayName=" If Restore Snapshot" sap:VirtualizedContainerService.HintSize="858,316">\r
- <If.Then>\r
- <Sequence DisplayName="Restore Snapshot" sap:VirtualizedContainerService.HintSize="231,208">\r
- <mtlwa:GetLabEnvironmentSnapshotId DisplayName="Get Snapshot Details" sap:VirtualizedContainerService.HintSize="200,22" LabEnvironmentUri="[LabEnvironmentUri]" Result="[SnapshotId]" SnapshotName="[LabWorkflowParameters.EnvironmentDetails.SnapshotName]" />\r
- <mtlwa:RestoreLabEnvironment DisplayName="Restore Lab Environment to Snapshot" sap:VirtualizedContainerService.HintSize="200,22" LabEnvironmentUri="[LabEnvironmentUri]" SnapshotId="[SnapshotId]" />\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <Sequence DisplayName="No Clean Snapshot" >\r
- <If Condition="[Not String.Equals(Microsoft.TeamFoundation.Lab.Client.LabEnvironment.UnmanagedProvider, labEnvironment.LabProvider)]" DisplayName= "If Virtual Environment">\r
- <If.Then>\r
- <mtlwa:WriteDeploymentInformation Url="{x:Null}" DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.Deploy]" DisplayName="Clean snapshot not specified " sap:VirtualizedContainerService.HintSize="208,208" Message="Build definition did not specify a clean snapshot. It is a best practice to use clean snapshot when running the lab workflow." />\r
- </If.Then>\r
- </If>\r
- </Sequence> \r
- </If.Else>\r
- </If>\r
- <If Condition="[LabWorkflowParameters.DeploymentDetails.DeploymentNeeded = True or LabWorkflowParameters.TestParameters.RunTest = True]" DisplayName="If deployment or test needed" sap:VirtualizedContainerService.HintSize="858,1214">\r
- <If.Then>\r
- <mtlwa:WaitForEnvironmentReady DisplayName="Wait For Environment To Be Ready" sap:VirtualizedContainerService.HintSize="711,22" LabEnvironmentUri="[LabEnvironmentUri]" MaxWaitTime="[System.TimeSpan.FromMinutes(10)]" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[LabWorkflowParameters.DeploymentDetails.DeploymentNeeded = True]" DisplayName="If deployment needed" sap:VirtualizedContainerService.HintSize="858,1214">\r
- <If.Then>\r
- <Sequence DisplayName="Do deployment" sap:VirtualizedContainerService.HintSize="733,1106"> \r
- <mtlwa:ReserveEnvironmentForDeployment DisplayName="Reserve Environment For Deployment" sap:VirtualizedContainerService.HintSize="711,22" LabEnvironmentUri="[LabEnvironmentUri]" />\r
- <TryCatch DisplayName="Deploy Build on Environment">\r
- <TryCatch.Try>\r
- <Sequence DisplayName="Deploying Build">\r
- <ForEach x:TypeArguments="x:String" DisplayName="Run Deployment scripts" sap:VirtualizedContainerService.HintSize="711,254" Values="[LabWorkflowParameters.DeploymentDetails.Scripts]">\r
- <ActivityAction x:TypeArguments="x:String">\r
- <ActivityAction.Argument>\r
- <DelegateInArgument x:TypeArguments="x:String" Name="deploymentConfigurationPair" />\r
- </ActivityAction.Argument>\r
- <mtlwa:RunDeploymentTask BuildLocation="[BuildLocation]" DeploymentScriptDetails="[deploymentConfigurationPair]" DisplayName="Run Deployment Task" sap:VirtualizedContainerService.HintSize="200,22" LabEnvironmentUri="[LabEnvironmentUri]" MaxWaitTime="[TimeSpan.FromMinutes(TimeoutForDeploymentScriptInMinutes)]" ThrowOnError="True" UseRoleForDeployment="[LabWorkflowParameters.DeploymentDetails.UseRoleForDeployment]" />\r
- </ActivityAction>\r
- </ForEach>\r
- </Sequence>\r
- </TryCatch.Try>\r
- <TryCatch.Finally>\r
- <mtlwa:ReleaseEnvironmentFromDeployment DisplayName="Release Environment From Deployment" sap:VirtualizedContainerService.HintSize="711,22" LabEnvironmentUri="[LabEnvironmentUri]" />\r
- </TryCatch.Finally>\r
- </TryCatch>\r
- <mtlwa:WriteDeploymentInformation DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.Deploy]" DisplayName="Application Deployment Succeeded" sap:VirtualizedContainerService.HintSize="711,22" Message="[String.Format("The application was deployed successfully from the following build location:")]" Url="[BuildLocation]" />\r
- <If Condition="[LabWorkflowParameters.DeploymentDetails.TakePostDeploymentSnapshot = True]" DisplayName="Post Deployment Snapshot" sap:VirtualizedContainerService.HintSize="711,626">\r
- <If.Then>\r
- <Sequence DisplayName="Take Post deployment Snapshot " sap:VirtualizedContainerService.HintSize="486,518">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="x:Int64" Name="PostDeploymentSnapshotChainId" />\r
- <Variable x:TypeArguments="x:String" Default="[String.Format("{0}_{1}", BuildDetail.BuildDefinition.Name, BuildDetail.BuildNumber)]" Name="PostDeploymentSnapshotName" />\r
- </Sequence.Variables>\r
- <If Condition="[String.IsNullOrEmpty(LabWorkflowParameters.DeploymentDetails.PostDeploymentSnapshotName) = False]" DisplayName="Check snapshot name" sap:VirtualizedContainerService.HintSize="464,208">\r
- <If.Then>\r
- <Assign sap:VirtualizedContainerService.HintSize="291,100">\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="x:String">[PostDeploymentSnapshotName]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="x:String">[If(LabWorkflowParameters.BuildDetails.IsTeamSystemBuild = True,String.Format("{0}_{1}_{2}", LabWorkflowParameters.DeploymentDetails.PostDeploymentSnapshotName, BuildNumber,BuildDetail.BuildNumber),String.Format("{0}_{1}", LabWorkflowParameters.DeploymentDetails.PostDeploymentSnapshotName, BuildDetail.BuildNumber))]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- </If.Then>\r
- </If>\r
- <mtlwa:SnapshotLabEnvironment DisplayName="Taking Post Deployment snapshot" sap:VirtualizedContainerService.HintSize="464,22" LabEnvironmentUri="[LabEnvironmentUri]" SnapshotChainId="[PostDeploymentSnapshotChainId]" SnapshotName="[PostDeploymentSnapshotName]" />\r
- <mtlwa:WriteDeploymentInformation Url="{x:Null}" DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.Deploy]" DisplayName="Taking Snapshot succeeded" sap:VirtualizedContainerService.HintSize="464,22" Message="[String.Format("The following snapshot was taken after the deployment was finished: {0}", PostDeploymentSnapshotName)]" />\r
- <mtlwa:WriteDeploymentInformation DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.ConnectToSnapshot]" DisplayName="Added connection link to the Snapshot" sap:VirtualizedContainerService.HintSize="464,22" Message="[PostDeploymentSnapshotName]" Url="[PostDeploymentSnapshotChainId.ToString()]" />\r
- </Sequence>\r
- </If.Then>\r
- <If.Else>\r
- <Sequence DisplayName = "No Post Deployment Snapshot"> \r
- <If Condition="[Not String.Equals(Microsoft.TeamFoundation.Lab.Client.LabEnvironment.UnmanagedProvider, labEnvironment.LabProvider)]" DisplayName= "If Virtual Environment">\r
- <If.Then>\r
- <mtlwa:WriteDeploymentInformation Url="{x:Null}" DeploymentInformationType="[Microsoft.TeamFoundation.Build.Common.DeploymentInformationTypes.Deploy]" DisplayName="Post deployment snapshot not specified" sap:VirtualizedContainerService.HintSize="200,518" Message="Build definition did not specify a post deployment snapshot. It is a best practice to take post deployment snapshot when running the lab workflow." />\r
- </If.Then>\r
- </If>\r
- </Sequence> \r
- </If.Else>\r
- </If>\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <If Condition="[LabWorkflowParameters.TestParameters.RunTest = True]" DisplayName="Run Tests on Environment" sap:VirtualizedContainerService.HintSize="858,604">\r
- <If.Then>\r
- <Sequence DisplayName="Run Tests" sap:VirtualizedContainerService.HintSize="656,498">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtltc:TestingCapabilityInformation" Name="TestCapabilityInfo" />\r
- <Variable x:TypeArguments="x:String" Name="variable1" />\r
- <Variable x:TypeArguments="mtlwa:TestRunStatistics" Default="[New Microsoft.TeamFoundation.Lab.Workflow.Activities.TestRunStatistics()]" Name="TestResults" />\r
- </Sequence.Variables>\r
- <mtlwa:ExecuteRemoteTestRun2 MaxWaitTime="{x:Null}" TestEnvironment="{x:Null}" BuildNumber="[BuildNumber]" BuildDefinitionName="[LabWorkflowParameters.BuildDetails.BuildDefinitionName]" DisplayName="Running Tests" sap:VirtualizedContainerService.HintSize="634,22" LabEnvironmentUri="[LabEnvironmentUri]" MaxConsecutiveFailuresToIgnoreDuringWaitForCompletion="[3]" RefreshInterval="[System.TimeSpan.FromMinutes(1)]" Result="[TestResults]" TestDirectory="[BuildLocation]" TestParameters="[LabWorkflowParameters.TestParameters]" Title="[String.Format("{0}", BuildDetail.BuildNumber)]" />\r
- <If Condition="[TestResults.PassedTests <> TestResults.TotalTests Or TestResults.TestRunStatus <> TestManagement.Client.TestRunState.Completed]" DisplayName="If all tests have not passed" sap:VirtualizedContainerService.HintSize="634,312">\r
- <If.Then>\r
- <If Condition="[(LabWorkflowParameters.BuildDetails.IsTeamSystemBuild = True AndAlso LabWorkflowParameters.BuildDetails.QueueNewBuild = True) Or (LabWorkflowParameters.DeploymentDetails.DeploymentNeeded = True)]" DisplayName="Set build status" sap:VirtualizedContainerService.HintSize="509,206">\r
- <If.Then>\r
- <Assign DisplayName="Partially succeeded" sap:VirtualizedContainerService.HintSize="242,100">\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="mtbc:BuildStatus">[BuildStatus]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="mtbc:BuildStatus">[Microsoft.TeamFoundation.Build.Client.BuildStatus.PartiallySucceeded]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- </If.Then>\r
- <If.Else>\r
- <Assign DisplayName="Failed" sap:VirtualizedContainerService.HintSize="242,100">\r
- <Assign.To>\r
- <OutArgument x:TypeArguments="mtbc:BuildStatus">[BuildStatus]</OutArgument>\r
- </Assign.To>\r
- <Assign.Value>\r
- <InArgument x:TypeArguments="mtbc:BuildStatus">[Microsoft.TeamFoundation.Build.Client.BuildStatus.Failed]</InArgument>\r
- </Assign.Value>\r
- </Assign>\r
- </If.Else>\r
- </If>\r
- </If.Then>\r
- </If>\r
- </Sequence>\r
- </If.Then>\r
- </If>\r
- <mtbwa:SetBuildProperties DisplayName="Set build status" sap:VirtualizedContainerService.HintSize="858,22" PropertiesToSet="Status" Status="[BuildStatus]" />\r
- </Sequence>\r
-</Activity>
\ No newline at end of file
diff --git a/BuildProcessTemplates/UpgradeTemplate.xaml b/BuildProcessTemplates/UpgradeTemplate.xaml
+++ /dev/null
@@ -1,76 +0,0 @@
-<Activity mc:Ignorable="sad" x:Class="TfsBuild.Process" xmlns="http://schemas.microsoft.com/netfx/2009/xaml/activities" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" xmlns:mtbc="clr-namespace:Microsoft.TeamFoundation.Build.Client;assembly=Microsoft.TeamFoundation.Build.Client" xmlns:mtbw="clr-namespace:Microsoft.TeamFoundation.Build.Workflow;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbwa="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Activities;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtbwt="clr-namespace:Microsoft.TeamFoundation.Build.Workflow.Tracking;assembly=Microsoft.TeamFoundation.Build.Workflow" xmlns:mtvc="clr-namespace:Microsoft.TeamFoundation.VersionControl.Client;assembly=Microsoft.TeamFoundation.VersionControl.Client" xmlns:mva="clr-namespace:Microsoft.VisualBasic.Activities;assembly=System.Activities" xmlns:s="clr-namespace:System;assembly=mscorlib" xmlns:sad="http://schemas.microsoft.com/netfx/2009/xaml/activities/presentation" xmlns:sad1="clr-namespace:System.Activities.Debugger;assembly=System.Activities" xmlns:scg="clr-namespace:System.Collections.Generic;assembly=mscorlib" xmlns:this="clr-namespace:TfsBuild;" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml">\r
- <x:Members>\r
- <x:Property Name="ConfigurationFolderPath" Type="InArgument(x:String)" />\r
- <x:Property Name="AgentSettings" Type="InArgument(mtbwa:AgentSettings)" />\r
- <x:Property Name="MSBuildArguments" Type="InArgument(x:String)" />\r
- <x:Property Name="MSBuildPlatform" Type="InArgument(mtbwa:ToolPlatform)" />\r
- <x:Property Name="DoNotDownloadBuildType" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="LogFilePerProject" Type="InArgument(x:Boolean)" />\r
- <x:Property Name="SourcesSubdirectory" Type="InArgument(x:String)" />\r
- <x:Property Name="BinariesSubdirectory" Type="InArgument(x:String)" />\r
- <x:Property Name="TestResultsSubdirectory" Type="InArgument(x:String)" />\r
- <x:Property Name="RecursionType" Type="InArgument(mtvc:RecursionType)" />\r
- <x:Property Name="Verbosity" Type="InArgument(mtbw:BuildVerbosity)" />\r
- <x:Property Name="Metadata" Type="mtbw:ProcessParameterMetadataCollection" />\r
- <x:Property Name="SupportedReasons" Type="mtbc:BuildReason" />\r
- </x:Members>\r
- <this:Process.ConfigurationFolderPath>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.ConfigurationFolderPath>\r
- <this:Process.AgentSettings>[New Microsoft.TeamFoundation.Build.Workflow.Activities.AgentSettings() With {.MaxWaitTime = New System.TimeSpan(4, 0, 0), .MaxExecutionTime = New System.TimeSpan(0, 0, 0), .TagComparison = Microsoft.TeamFoundation.Build.Workflow.Activities.TagComparison.MatchExactly }]</this:Process.AgentSettings>\r
- <this:Process.MSBuildArguments>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.MSBuildArguments>\r
- <this:Process.MSBuildPlatform>[Microsoft.TeamFoundation.Build.Workflow.Activities.ToolPlatform.Auto]</this:Process.MSBuildPlatform>\r
- <this:Process.DoNotDownloadBuildType>[False]</this:Process.DoNotDownloadBuildType>\r
- <this:Process.LogFilePerProject>[False]</this:Process.LogFilePerProject>\r
- <this:Process.SourcesSubdirectory>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.SourcesSubdirectory>\r
- <this:Process.BinariesSubdirectory>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.BinariesSubdirectory>\r
- <this:Process.TestResultsSubdirectory>\r
- <InArgument x:TypeArguments="x:String" />\r
- </this:Process.TestResultsSubdirectory>\r
- <this:Process.RecursionType>[Microsoft.TeamFoundation.VersionControl.Client.RecursionType.OneLevel]</this:Process.RecursionType>\r
- <this:Process.Verbosity>[Microsoft.TeamFoundation.Build.Workflow.BuildVerbosity.Normal]</this:Process.Verbosity>\r
- <this:Process.Metadata>\r
- <mtbw:ProcessParameterMetadataCollection />\r
- </this:Process.Metadata>\r
- <this:Process.SupportedReasons>All</this:Process.SupportedReasons>\r
- <mva:VisualBasic.Settings>Assembly references and imported namespaces serialized as XML namespaces</mva:VisualBasic.Settings>\r
- <Sequence mtbwt:BuildTrackingParticipant.Importance="None">\r
- <Sequence.Variables>\r
- <Variable x:TypeArguments="mtbc:IBuildDetail" Name="BuildDetail" />\r
- </Sequence.Variables>\r
- <mtbwa:GetBuildDetail DisplayName="Get the Build" Result="[BuildDetail]" />\r
- <mtbwa:InvokeForReason DisplayName="Update Build Number for Triggered Builds" Reason="Triggered">\r
- <mtbwa:UpdateBuildNumber BuildNumberFormat="["$(BuildDefinitionName)_$(Date:yyyyMMdd)$(Rev:.r)"]" DisplayName="Update Build Number" />\r
- </mtbwa:InvokeForReason>\r
- <mtbwa:AgentScope DisplayName="Run On Agent" MaxExecutionTime="[AgentSettings.MaxExecutionTime]" MaxWaitTime="[AgentSettings.MaxWaitTime]" ReservationSpec="[AgentSettings.GetAgentReservationSpec()]">\r
- <mtbwa:AgentScope.Variables>\r
- <Variable x:TypeArguments="x:String" Name="buildDirectory" />\r
- </mtbwa:AgentScope.Variables>\r
- <mtbwa:GetBuildDirectory DisplayName="Get the Build Directory" Result="[buildDirectory]" />\r
- <If Condition="[Not String.IsNullOrEmpty(ConfigurationFolderPath)]" DisplayName="If Not String.IsNullOrEmpty(ConfigurationFolderPath)">\r
- <If.Then>\r
- <mtbwa:TfsBuild BinariesSubdirectory="[BinariesSubdirectory]" BuildDirectory="[buildDirectory]" CommandLineArguments="[MSBuildArguments]" ConfigurationFolderPath="[ConfigurationFolderPath]" DisplayName="Run TfsBuild for Configuration Folder" DoNotDownloadBuildType="[DoNotDownloadBuildType]" LogFilePerProject="[LogFilePerProject]" RecursionType="[RecursionType]" SourcesSubdirectory="[SourcesSubdirectory]" TargetsNotLogged="[New String() {"GetNativeManifest", "GetCopyToOutputDirectoryItems", "GetTargetPath"}]" TestResultsSubdirectory="[TestResultsSubdirectory]" ToolPlatform="[MSBuildPlatform]" Verbosity="[Verbosity]" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[BuildDetail.CompilationStatus = Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Unknown]" DisplayName="If CompilationStatus = Unknown">\r
- <If.Then>\r
- <mtbwa:SetBuildProperties CompilationStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Succeeded]" DisplayName="Set CompilationStatus to Succeeded" PropertiesToSet="CompilationStatus" />\r
- </If.Then>\r
- </If>\r
- <If Condition="[BuildDetail.TestStatus = Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Unknown]" DisplayName="If TestStatus = Unknown">\r
- <If.Then>\r
- <mtbwa:SetBuildProperties DisplayName="Set TestStatus to Succeeded" PropertiesToSet="TestStatus" TestStatus="[Microsoft.TeamFoundation.Build.Client.BuildPhaseStatus.Succeeded]" />\r
- </If.Then>\r
- </If>\r
- </mtbwa:AgentScope>\r
- <mtbwa:InvokeForReason Reason="CheckInShelveset">\r
- <mtbwa:CheckInGatedChanges DisplayName="Check In Gated Changes" />\r
- </mtbwa:InvokeForReason>\r
- </Sequence>\r
-</Activity>
\ No newline at end of file
diff --git a/J2CPS/Makefile b/J2CPS/Makefile
--- /dev/null
+++ b/J2CPS/Makefile
@@ -0,0 +1,5 @@
+all:
+ javac -d . *.java
+
+clean:
+ rm -rf J2CPS
\ No newline at end of file
diff --git a/Makefile b/Makefile
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,22 @@
+OUT = out
+
+jvm: prepare
+ make -C libs/java all
+ make -C libs/cpascal jvm
+ make -C gpcp jvm
+ make -C J2CPS all
+ cp -rf gpcp/CP $(OUT)
+ cp -rf libs/cpascal/CP $(OUT)
+ cp -rf libs/cpascal/*.cps $(OUT)/libs
+ cp -rf libs/java/CP $(OUT)
+ cp -rf J2CPS/J2CPS $(OUT)
+
+prepare: clean
+ mkdir -p $(OUT)/CP $(OUT)/libs
+
+clean:
+ make -C gpcp clean
+ make -C J2CPS clean
+ make -C libs/cpascal clean
+ make -C libs/java clean
+ rm -rf $(OUT)
\ No newline at end of file
diff --git a/gpcp/Makefile b/gpcp/Makefile
--- /dev/null
+++ b/gpcp/Makefile
@@ -0,0 +1,8 @@
+jvm:
+ ln -sf PeUtilForJVM.cp PeUtil.cp
+ javac -d . java/*.java
+ cprun CPMake -all -target=jvm gpcp.cp
+ cprun CPMake -all -target=jvm Browse.cp
+
+clean:
+ rm -rf CP PeUtil.cp *.cps *.lst
\ No newline at end of file
diff --git a/gpcp/PeUtil.cp b/gpcp/PeUtil.cp
--- a/gpcp/PeUtil.cp
+++ /dev/null
@@ -1,2544 +0,0 @@
-(* ============================================================ *)\r
-(* PeUtil is the module which writes PE files using the *)\r
-(* managed interface. *)\r
-(* Copyright (c) John Gough 1999, 2002. *)\r
-(* Copyright (c) Queensland University of Technology 2002-2006 *)\r
-(* This is the PERWAPI-based prototype, March 2005 *)\r
-(* previous versions used the PE-file <writer> PEAPI. *)\r
-(* ============================================================ *)\r
-\r
-MODULE PeUtil;\r
-\r
- IMPORT \r
- GPCPcopyright,\r
- RTS, ASCII,\r
- Console,\r
- GPText,\r
- GPBinFiles,\r
- GPTextFiles,\r
- FileNames,\r
- ClassMaker,\r
- MsilBase,\r
- NameHash,\r
- Mu := MsilUtil,\r
- Lv := LitValue,\r
- Sy := Symbols,\r
- Bi := Builtin,\r
- Id := IdDesc,\r
- Ty := TypeDesc,\r
- Api := "[QUT.PERWAPI]QUT.PERWAPI",\r
- Scn := CPascalS,\r
- Asm := IlasmCodes,\r
- CSt := CompState,\r
- Sys := "[mscorlib]System";\r
-\r
-(* ============================================================ *)\r
-\r
-(*\r
- * CONST\r
- * (* various ILASM-specific runtime name strings *)\r
- * initPrefix = "instance void ";\r
- * initSuffix = ".ctor() ";\r
- * managedStr = "il managed";\r
- * specialStr = "public specialname rtspecialname ";\r
- * cctorStr = "static void .cctor() ";\r
- * objectInit = "instance void $o::.ctor() ";\r
- *\r
- * CONST\r
- * catchStr = " catch [mscorlib]System.Exception";\r
- *)\r
-\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-\r
- TYPE PeFile* = POINTER TO RECORD (Mu.MsilFile)\r
- (* Fields inherited from MsilFile *\r
- * srcS* : LitValue.CharOpen; (* source file name *)\r
- * outN* : LitValue.CharOpen; (* output file name *)\r
- * proc* : ProcInfo;\r
- *)\r
- peFl : Api.PEFile; (* Includes AssemblyDef *)\r
- clsS : Api.ClassDef; (* Dummy static ClassDef *)\r
- clsD : Api.ClassDef; (* The current ClassDef *)\r
- pePI : PProcInfo;\r
- nmSp : RTS.NativeString;\r
- (*\r
- * Friendly access for system classes.\r
- *)\r
- rts : Api.AssemblyRef; (* "[RTS]" *)\r
- cprts : Api.ClassRef; (* "[RTS]CP_rts" *)\r
- progArgs : Api.ClassRef; (* "[RTS]ProgArgs" *)\r
- END;\r
-\r
-(* ============================================================ *)\r
-\r
- TYPE PProcInfo = POINTER TO RECORD \r
- mthD : Api.MethodDef;\r
- code : Api.CILInstructions;\r
- tryB : Api.TryBlock;\r
- END;\r
-\r
-(* ============================================================ *)\r
-\r
- TYPE PeLab = POINTER TO RECORD (Mu.Label)\r
- labl : Api.CILLabel;\r
- END;\r
-\r
- TYPE TypArr = POINTER TO ARRAY OF Api.Type;\r
-\r
-(* ============================================================ *)\r
-\r
- VAR cln2, (* "::" *) \r
- evtAdd,\r
- evtRem,\r
- boxedObj : Lv.CharOpen;\r
-\r
-(* ============================================================ *)\r
-\r
- VAR ctAtt, (* public + special + RTspecial *)\r
- psAtt, (* public + static *)\r
- rmAtt, (* runtime managed *)\r
- ilAtt : INTEGER; (* cil managed *)\r
-\r
- VAR xhrCl : Api.ClassRef; (* the [RTS]XHR class reference *)\r
- voidD : Api.Type; (* Api.PrimitiveType.Void *)\r
- objtD : Api.Type; (* Api.PrimitiveType.Object *)\r
- strgD : Api.Type; (* Api.PrimitiveType.String *)\r
- charD : Api.Type; (* Api.PrimitiveType.Char *)\r
- charA : Api.Type; (* Api.PrimitiveType.Char[] *)\r
- int4D : Api.Type; (* Api.PrimitiveType.Int32 *)\r
- int8D : Api.Type; (* Api.PrimitiveType.Int64 *)\r
- flt4D : Api.Type; (* Api.PrimitiveType.Float32 *)\r
- flt8D : Api.Type; (* Api.PrimitiveType.Float64 *)\r
- nIntD : Api.Type; (* Api.PrimitiveType.NativeInt *)\r
-\r
- VAR vfldS : RTS.NativeString; (* "v$" *)\r
- copyS : RTS.NativeString; (* "copy" *)\r
- ctorS : RTS.NativeString; (* ".ctor" *)\r
- invkS : RTS.NativeString; (* Invoke *)\r
- \r
- VAR defSrc : Api.SourceFile;\r
-\r
- VAR rHelper : ARRAY Mu.rtsLen OF Api.MethodRef;\r
- mathCls : Api.ClassRef;\r
- envrCls : Api.ClassRef;\r
- excpCls : Api.ClassRef;\r
- rtTpHdl : Api.ClassRef;\r
- loadTyp : Api.MethodRef;\r
- newObjt : Api.MethodRef;\r
- multiCD : Api.ClassRef; (* System.MulticastDelegate *)\r
- delegat : Api.ClassRef; (* System.Delegate *)\r
- combine : Api.MethodRef; (* System.Delegate::Combine *)\r
- remove : Api.MethodRef; (* System.Delegate::Remove *)\r
- corlib : Api.AssemblyRef; (* [mscorlib] *)\r
- \r
-(* ============================================================ *)\r
-(* Data Structure for tgXtn field of BlkId descriptors *)\r
-(* ============================================================ *)\r
-\r
- TYPE BlkXtn = POINTER TO RECORD\r
- asmD : Api.AssemblyRef; (* This AssemblyRef *)\r
- dscD : Api.Class; (* Dummy Static Class *)\r
- END;\r
-\r
-(* ============================================================ *)\r
-(* Data Structure for Switch Statement Encoding *)\r
-(* ============================================================ *)\r
-\r
- TYPE Switch = RECORD\r
- list : POINTER TO ARRAY OF Api.CILLabel;\r
- next : INTEGER;\r
- END;\r
-\r
- VAR switch : Switch;\r
-\r
-(* ============================================================ *)\r
-(* Data Structure for tgXtn field of procedure types *)\r
-(* ============================================================ *)\r
-\r
- TYPE DelXtn = POINTER TO RECORD\r
- clsD : Api.Class; (* Implementing class *)\r
- newD : Api.Method; (* Constructor method *)\r
- invD : Api.Method; (* The Invoke method *)\r
- END;\r
-\r
-(* ============================================================ *)\r
-(* Data Structure for tgXtn field of event variables *)\r
-(* ============================================================ *)\r
-\r
- TYPE EvtXtn = POINTER TO RECORD\r
- fldD : Api.Field; (* Field descriptor *)\r
- addD : Api.Method; (* add_<field> method *)\r
- remD : Api.Method; (* rem_<field> method *)\r
- END;\r
-\r
-(* ============================================================ *)\r
-(* Data Structure for tgXtn field of Record types *)\r
-(* ============================================================ *)\r
-\r
- TYPE RecXtn = POINTER TO RECORD\r
- clsD : Api.Class;\r
- boxD : Api.Class;\r
- newD : Api.Method;\r
- cpyD : Api.Method;\r
- vDlr : Api.Field;\r
- END;\r
-\r
-(* ============================================================ *)\r
-(* Constructor Method *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE newPeFile*(IN nam : ARRAY OF CHAR; isDll : BOOLEAN) : PeFile;\r
- VAR f : PeFile;\r
- ver : INTEGER;\r
- (* ------------------------------------------------------- *)\r
- PROCEDURE file(IN f,a : ARRAY OF CHAR; d : BOOLEAN) : Api.PEFile;\r
- VAR pef : Api.PEFile;\r
- BEGIN \r
- pef := Api.PEFile.init(MKSTR(f), MKSTR(a));\r
- pef.SetIsDLL(d);\r
- IF CSt.binDir # "" THEN\r
- pef.SetOutputDirectory(MKSTR(CSt.binDir));\r
- END;\r
- RETURN pef;\r
- RESCUE (x) \r
- RETURN NIL;\r
- END file;\r
- (* ------------------------------------------------------- *)\r
- BEGIN\r
- NEW(f);\r
-(*\r
- * f.peFl := file(nam, isDll);\r
- *)\r
- IF isDll THEN\r
- f.outN := BOX(nam + ".DLL");\r
- ELSE\r
- f.outN := BOX(nam + ".EXE");\r
- END;\r
-(* -- start replacement -- *)\r
- f.peFl := file(f.outN, nam, isDll);\r
-(* --- end replacement --- *)\r
- (*\r
- * Initialize local variables holding common attributes.\r
- *)\r
- ctAtt := Api.MethAttr.Public + Api.MethAttr.SpecialRTSpecialName;\r
- psAtt := Api.MethAttr.Public + Api.MethAttr.Static;\r
- ilAtt := Api.ImplAttr.IL;\r
- rmAtt := Api.ImplAttr.Runtime;\r
- (*\r
- * Initialize local variables holding primitive type-enums.\r
- *)\r
- voidD := Api.PrimitiveType.Void;\r
- objtD := Api.PrimitiveType.Object;\r
- strgD := Api.PrimitiveType.String;\r
- int4D := Api.PrimitiveType.Int32;\r
- int8D := Api.PrimitiveType.Int64;\r
- flt4D := Api.PrimitiveType.Float32;\r
- flt8D := Api.PrimitiveType.Float64;\r
- charD := Api.PrimitiveType.Char;\r
- charA := Api.ZeroBasedArray.init(Api.PrimitiveType.Char);\r
- nIntD := Api.PrimitiveType.IntPtr;\r
-\r
- f.peFl.SetNetVersion(Api.NetVersion.Version2);\r
-\r
- (*ver := f.peFl.GetNetVersion();*)\r
-\r
- RETURN f;\r
- END newPeFile;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (t : PeFile)fileOk*() : BOOLEAN;\r
- BEGIN\r
- RETURN t.peFl # NIL;\r
- END fileOk;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkNewProcInfo*(proc : Sy.Scope);\r
- VAR p : PProcInfo;\r
- BEGIN\r
- NEW(os.proc);\r
- NEW(os.pePI);\r
- Mu.InitProcInfo(os.proc, proc);\r
- END MkNewProcInfo;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)newLabel*() : Mu.Label;\r
- VAR label : PeLab;\r
- BEGIN\r
- NEW(label); \r
- label.labl := os.pePI.code.NewLabel();\r
- RETURN label;\r
- END newLabel;\r
-\r
-(* ============================================================ *)\r
-(* Various utilities *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE^ (os : PeFile)CallCombine(typ : Sy.Type; add : BOOLEAN),NEW;\r
- PROCEDURE^ (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);\r
- PROCEDURE^ (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);\r
- PROCEDURE^ (os : PeFile)Locals(),NEW;\r
-\r
- PROCEDURE^ MkMthDef(os : PeFile;\r
- xhr : BOOLEAN;\r
- pTp : Ty.Procedure;\r
- cls : Api.ClassDef;\r
- str : RTS.NativeString) : Api.MethodDef;\r
-\r
- PROCEDURE^ MkMthRef(os : PeFile;\r
- pTp : Ty.Procedure;\r
- cls : Api.ClassRef;\r
- str : RTS.NativeString) : Api.MethodRef;\r
-\r
- PROCEDURE^ (os : PeFile)mth(pId : Id.Procs) : Api.Method,NEW;\r
- PROCEDURE^ (os : PeFile)fld(fId : Id.AbVar) : Api.Field,NEW;\r
- PROCEDURE^ (os : PeFile)add(fId : Id.AbVar) : Api.Method,NEW;\r
- PROCEDURE^ (os : PeFile)rem(fId : Id.AbVar) : Api.Method,NEW;\r
- PROCEDURE^ (os : PeFile)asm(bId : Id.BlkId) : Api.AssemblyRef,NEW;\r
- PROCEDURE^ (os : PeFile)dsc(bId : Id.BlkId) : Api.Class,NEW;\r
- PROCEDURE^ (os : PeFile)cls(rTy : Ty.Record) : Api.Class,NEW;\r
- PROCEDURE^ (os : PeFile)new(rTy : Ty.Record) : Api.Method,NEW;\r
- PROCEDURE^ (os : PeFile)cpy(rTy : Ty.Record) : Api.Method,NEW;\r
- PROCEDURE^ (os : PeFile)typ(tTy : Sy.Type) : Api.Type,NEW;\r
- PROCEDURE^ (os : PeFile)vDl(rTy : Ty.Record) : Api.Field,NEW;\r
- PROCEDURE^ (os : PeFile)dxt(pTy : Ty.Procedure) : DelXtn,NEW;\r
- PROCEDURE^ (os : PeFile)mcd() : Api.ClassRef,NEW;\r
- PROCEDURE^ (os : PeFile)rmv() : Api.MethodRef,NEW;\r
- PROCEDURE^ (os : PeFile)cmb() : Api.MethodRef,NEW;\r
-(*\r
- * PROCEDURE^ box(os : PeFile; rTy : Ty.Record) : Api.Class;\r
- *)\r
-(* ============================================================ *)\r
-(* Private Methods *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE boxedName(typ : Ty.Record) : RTS.NativeString;\r
- BEGIN\r
- ASSERT(typ.xName # NIL);\r
- RETURN MKSTR(boxedObj^ + typ.xName^);\r
- END boxedName;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE nms(idD : Sy.Idnt) : RTS.NativeString;\r
- BEGIN\r
- RETURN MKSTR(Sy.getName.ChPtr(idD)^);\r
- END nms;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE toTypeAttr(attr : SET) : INTEGER;\r
- VAR result : INTEGER;\r
- BEGIN\r
- CASE ORD(attr * {0 .. 3}) OF\r
- | ORD(Asm.att_public) : result := Api.TypeAttr.Public;\r
- | ORD(Asm.att_empty) : result := Api.TypeAttr.Private;\r
- END;\r
- IF attr * Asm.att_sealed # {} THEN \r
- INC(result, Api.TypeAttr.Sealed);\r
- END;\r
- IF attr * Asm.att_abstract # {} THEN \r
- INC(result, Api.TypeAttr.Abstract);\r
- END;\r
- IF attr * Asm.att_interface # {} THEN \r
- INC(result, Api.TypeAttr.Interface + Api.TypeAttr.Abstract);\r
- END;\r
-(*\r
- * what are "Import, AutoClass, UnicodeClass, *SpecialName" ? \r
- *)\r
- RETURN result;\r
- END toTypeAttr;\r
-\r
- \r
-(* ------------------------------------------------ *)\r
-(* New code for PERWAPI *)\r
-(* ------------------------------------------------ *)\r
-\r
- PROCEDURE getOrAddClass(mod : Api.ReferenceScope; \r
- nms : RTS.NativeString;\r
- nam : RTS.NativeString) : Api.ClassRef;\r
- VAR cls : Api.Class;\r
- BEGIN\r
- cls := mod.GetClass(nms, nam);\r
- IF cls = NIL THEN cls := mod.AddClass(nms, nam) END;\r
- RETURN cls(Api.ClassRef);\r
- END getOrAddClass;\r
-\r
- PROCEDURE getOrAddValueClass(mod : Api.ReferenceScope; \r
- nms : RTS.NativeString;\r
- nam : RTS.NativeString) : Api.ClassRef;\r
- VAR cls : Api.Class;\r
- BEGIN\r
- cls := mod.GetClass(nms, nam);\r
- IF cls = NIL THEN cls := mod.AddValueClass(nms, nam) END;\r
- RETURN cls(Api.ClassRef);\r
- END getOrAddValueClass;\r
-\r
- PROCEDURE getOrAddMethod(cls : Api.ClassRef; \r
- nam : RTS.NativeString;\r
- ret : Api.Type;\r
- prs : TypArr) : Api.MethodRef;\r
- VAR mth : Api.Method;\r
- BEGIN\r
- mth := cls.GetMethod(nam, prs);\r
- IF mth = NIL THEN mth := cls.AddMethod(nam, ret, prs) END;\r
- RETURN mth(Api.MethodRef);\r
- END getOrAddMethod;\r
-\r
- PROCEDURE getOrAddField(cls : Api.ClassRef; \r
- nam : RTS.NativeString;\r
- typ : Api.Type) : Api.FieldRef;\r
- VAR fld : Api.FieldRef;\r
- BEGIN\r
- fld := cls.GetField(nam);\r
- IF fld = NIL THEN fld := cls.AddField(nam, typ) END;\r
- RETURN fld(Api.FieldRef);\r
- END getOrAddField;\r
-\r
-(* ------------------------------------------------ *)\r
-\r
- PROCEDURE toMethAttr(attr : SET) : INTEGER;\r
- VAR result : INTEGER;\r
- BEGIN\r
- CASE ORD(attr * {0 .. 3}) OF\r
- | ORD(Asm.att_assembly) : result := Api.MethAttr.Assembly;\r
- | ORD(Asm.att_public) : result := Api.MethAttr.Public;\r
- | ORD(Asm.att_private) : result := Api.MethAttr.Private;\r
- | ORD(Asm.att_protected) : result := Api.MethAttr.Family;\r
- END;\r
- IF 5 IN attr THEN INC(result, Api.MethAttr.Static) END;\r
- IF 6 IN attr THEN INC(result, Api.MethAttr.Final) END;\r
- IF 8 IN attr THEN INC(result, Api.MethAttr.Abstract) END;\r
- IF 9 IN attr THEN INC(result, Api.MethAttr.NewSlot) END;\r
- IF 13 IN attr THEN INC(result, Api.MethAttr.Virtual) END;\r
- RETURN result;\r
- END toMethAttr;\r
-\r
-(* ------------------------------------------------ *)\r
-\r
- PROCEDURE toFieldAttr(attr : SET) : INTEGER;\r
- VAR result : INTEGER;\r
- BEGIN\r
- CASE ORD(attr * {0 .. 3}) OF\r
- | ORD(Asm.att_empty) : result := Api.FieldAttr.Default;\r
- | ORD(Asm.att_assembly) : result := Api.FieldAttr.Assembly;\r
- | ORD(Asm.att_public) : result := Api.FieldAttr.Public;\r
- | ORD(Asm.att_private) : result := Api.FieldAttr.Private;\r
- | ORD(Asm.att_protected) : result := Api.FieldAttr.Family;\r
- END;\r
- IF 5 IN attr THEN INC(result, Api.FieldAttr.Static) END;\r
- (* what about Initonly? *)\r
- RETURN result;\r
- END toFieldAttr;\r
-\r
-(* ------------------------------------------------ *)\r
-\r
- PROCEDURE (os : PeFile)MkCodeBuffer(),NEW;\r
- BEGIN\r
- ASSERT((defSrc # NIL) & (os.pePI.mthD # NIL));\r
- os.pePI.code := os.pePI.mthD.CreateCodeBuffer();\r
- os.pePI.code.OpenScope();\r
- os.pePI.code.set_DefaultSourceFile(defSrc);\r
- END MkCodeBuffer;\r
-\r
-(* ============================================================ *)\r
-(* Exported Methods *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MethodDecl*(attr : SET; proc : Id.Procs);\r
- VAR prcT : Ty.Procedure; (* NOT NEEDED? *)\r
- prcD : Api.MethodDef;\r
- BEGIN\r
- (*\r
- * Set the various attributes\r
- *)\r
- prcD := os.mth(proc)(Api.MethodDef);\r
- prcD.AddMethAttribute(toMethAttr(attr));\r
- prcD.AddImplAttribute(ilAtt);\r
- os.pePI.mthD := prcD;\r
- IF attr * Asm.att_abstract = {} THEN os.MkCodeBuffer() END;\r
- END MethodDecl;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)DoExtern(blk : Id.BlkId),NEW;\r
- (*\r
- * Add references to all imported assemblies.\r
- *)\r
- VAR asmRef : Api.AssemblyRef;\r
- blkXtn : BlkXtn;\r
- (* ----------------------------------------- *)\r
- PROCEDURE AsmName(bk : Id.BlkId) : Lv.CharOpen;\r
- VAR ix : INTEGER;\r
- ln : INTEGER;\r
- ch : CHAR;\r
- cp : Lv.CharOpen;\r
- BEGIN\r
- IF Sy.isFn IN bk.xAttr THEN\r
- ln := 0;\r
- FOR ix := LEN(bk.scopeNm) - 1 TO 1 BY -1 DO\r
- IF bk.scopeNm[ix] = "]" THEN ln := ix END;\r
- END;\r
- IF (ln = 0 ) OR (bk.scopeNm[0] # '[') THEN \r
- RTS.Throw("bad extern name "+bk.scopeNm^) END;\r
- NEW(cp, ln);\r
- FOR ix := 1 TO ln-1 DO cp[ix-1] := bk.scopeNm[ix] END;\r
- cp[ln-1] := 0X;\r
- RETURN cp;\r
- ELSE\r
- RETURN bk.xName;\r
- END;\r
- END AsmName;\r
- (* ----------------------------------------- *)\r
- PROCEDURE MkBytes(t1, t2 : INTEGER) : POINTER TO ARRAY OF UBYTE;\r
- VAR bIx : INTEGER;\r
- tok : POINTER TO ARRAY OF UBYTE;\r
- BEGIN [UNCHECKED_ARITHMETIC]\r
- NEW(tok, 8);\r
- FOR bIx := 3 TO 0 BY -1 DO\r
- tok[bIx] := USHORT(t1 MOD 256);\r
- t1 := t1 DIV 256;\r
- END;\r
- FOR bIx := 7 TO 4 BY -1 DO\r
- tok[bIx] := USHORT(t2 MOD 256);\r
- t2 := t2 DIV 256;\r
- END;\r
- RETURN tok;\r
- END MkBytes;\r
- (* ----------------------------------------- *)\r
- BEGIN\r
- IF blk.xName = NIL THEN Mu.MkBlkName(blk) END;\r
- asmRef := os.peFl.MakeExternAssembly(MKSTR(AsmName(blk)^));\r
- NEW(blkXtn);\r
- blk.tgXtn := blkXtn;\r
- blkXtn.asmD := asmRef;\r
- blkXtn.dscD := getOrAddClass(asmRef, \r
- MKSTR(blk.pkgNm^), \r
- MKSTR(blk.clsNm^));\r
- IF blk.verNm # NIL THEN\r
- asmRef.AddVersionInfo(blk.verNm[0], blk.verNm[1], \r
- blk.verNm[2], blk.verNm[3]);\r
- IF (blk.verNm[4] # 0) OR (blk.verNm[5] # 0) THEN\r
- asmRef.AddKeyToken(MkBytes(blk.verNm[4], blk.verNm[5]));\r
- END;\r
- END;\r
- END DoExtern;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)DoRtsMod(blk : Id.BlkId),NEW;\r
- (*\r
- * Add references to all imported assemblies.\r
- *)\r
- VAR blkD : BlkXtn;\r
- BEGIN\r
- IF blk.xName = NIL THEN Mu.MkBlkName(blk) END;\r
- NEW(blkD);\r
- blkD.asmD := os.rts;\r
- blkD.dscD := os.rts.AddClass("", MKSTR(blk.clsNm^));\r
- blk.tgXtn := blkD;\r
- END DoRtsMod;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CheckNestedClass*(typ : Ty.Record;\r
- scp : Sy.Scope;\r
- str : Lv.CharOpen);\r
- VAR len : INTEGER;\r
- idx : INTEGER;\r
- jdx : INTEGER;\r
- kdx : INTEGER;\r
- hsh : INTEGER;\r
- tId : Sy.Idnt;\r
- BEGIN\r
- (* \r
- * Find last occurrence of '$', except at index 0 \r
- * \r
- * We seek the last occurrence because this method might\r
- * be called recursively for a deeply nested class A$B$C.\r
- *)\r
- len := LEN(str$); (* LEN(x$) doen't count nul, therefore str[len] = 0X *)\r
- FOR idx := len TO 1 BY -1 DO\r
- IF str[idx] = '$' THEN (* a nested class *)\r
- str[idx] := 0X; (* terminate the string early *)\r
- hsh := NameHash.enterStr(str);\r
- tId := Sy.bind(hsh, scp);\r
- \r
- IF (tId = NIL) OR ~(tId IS Id.TypId) THEN \r
- RTS.Throw(\r
- "Foreign Class <" + str^ + "> not found in <" + typ.extrnNm^ + ">"\r
- );\r
- ELSE\r
- typ.encCls := tId.type.boundRecTp();\r
- jdx := 0; kdx := idx+1;\r
- WHILE kdx <= len DO str[jdx] := str[kdx]; INC(kdx); INC(jdx) END;\r
- END;\r
- RETURN;\r
- END;\r
- END;\r
- END CheckNestedClass;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)ExternList*();\r
- VAR idx : INTEGER;\r
- blk : Id.BlkId;\r
- BEGIN\r
- FOR idx := 0 TO CSt.impSeq.tide-1 DO\r
- blk := CSt.impSeq.a[idx](Id.BlkId);\r
- IF (Sy.need IN blk.xAttr) &\r
- (blk.tgXtn = NIL) THEN \r
- IF ~(Sy.rtsMd IN blk.xAttr) THEN \r
- os.DoExtern(blk);\r
- ELSE\r
- os.DoRtsMod(blk);\r
- END;\r
- END;\r
- END;\r
- END ExternList;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)DefLab*(l : Mu.Label);\r
- BEGIN\r
- os.pePI.code.CodeLabel(l(PeLab).labl);\r
- END DefLab;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)DefLabC*(l : Mu.Label; IN c : ARRAY OF CHAR);\r
- BEGIN\r
- os.pePI.code.CodeLabel(l(PeLab).labl);\r
- END DefLabC;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Code*(code : INTEGER);\r
- BEGIN\r
- os.pePI.code.Inst(Asm.cd[code]);\r
- os.Adjust(Asm.dl[code]);\r
- END Code;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeF(code : INTEGER;\r
- fld : Api.Field), NEW;\r
- BEGIN\r
- os.pePI.code.FieldInst(Asm.cd[code], fld);\r
- os.Adjust(Asm.dl[code]);\r
- END CodeF;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeI*(code,int : INTEGER);\r
- BEGIN\r
- os.pePI.code.IntInst(Asm.cd[code],int);\r
- os.Adjust(Asm.dl[code]);\r
- END CodeI;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeT*(code : INTEGER; type : Sy.Type);\r
- VAR xtn : Api.Type;\r
- BEGIN\r
- xtn := os.typ(type);\r
- os.pePI.code.TypeInst(Asm.cd[code], xtn);\r
- os.Adjust(Asm.dl[code]);\r
- END CodeT;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeTn*(code : INTEGER; type : Sy.Type);\r
- VAR xtn : Api.Type;\r
- BEGIN\r
- xtn := os.typ(type);\r
- os.pePI.code.TypeInst(Asm.cd[code], xtn);\r
- os.Adjust(Asm.dl[code]);\r
- END CodeTn;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeL*(code : INTEGER; long : LONGINT);\r
- BEGIN\r
- ASSERT(code = Asm.opc_ldc_i8);\r
- os.pePI.code.ldc_i8(long);\r
- os.Adjust(1);\r
- END CodeL;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeR*(code : INTEGER; real : REAL);\r
- BEGIN\r
- IF code = Asm.opc_ldc_r8 THEN\r
- os.pePI.code.ldc_r8(real);\r
- ELSIF code = Asm.opc_ldc_r4 THEN\r
- os.pePI.code.ldc_r4(SHORT(real));\r
- ELSE\r
- ASSERT(FALSE);\r
- END;\r
- os.Adjust(1);\r
- END CodeR;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeLb*(code : INTEGER; labl : Mu.Label);\r
- BEGIN\r
- os.pePI.code.Branch(Asm.cd[code], labl(PeLab).labl);\r
- END CodeLb;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)getMethod(s : INTEGER) : Api.Method,NEW;\r
- VAR mth : Api.MethodRef;\r
- cpr : Api.ClassRef;\r
- msc : Api.ClassRef;\r
- sys : Api.ClassRef;\r
- (* ----------------------------------- *)\r
- PROCEDURE p1(p : Api.Type) : TypArr;\r
- VAR a : TypArr;\r
- BEGIN\r
- NEW(a,1);\r
- a[0] := p;\r
- RETURN a;\r
- END p1;\r
- (* ----------------------------------- *)\r
- PROCEDURE p2(p,q : Api.Type) : TypArr;\r
- VAR a : TypArr;\r
- BEGIN\r
- NEW(a,2);\r
- a[0] := p;\r
- a[1] := q;\r
- RETURN a;\r
- END p2;\r
- (* ----------------------------------- *)\r
- BEGIN\r
- (*\r
- * Lazy evaluation of array elements\r
- *)\r
- mth := rHelper[s];\r
- IF mth = NIL THEN\r
- cpr := os.cprts;\r
- CASE s OF\r
- | Mu.vStr2ChO : mth := cpr.AddMethod("strToChO",charA,p1(strgD));\r
- | Mu.vStr2ChF : mth := cpr.AddMethod("StrToChF",voidD,p2(charA,strgD));\r
- | Mu.aStrLen : mth := cpr.AddMethod("chrArrLength",int4D,p1(charA));\r
- | Mu.aStrChk : mth := cpr.AddMethod("ChrArrCheck",voidD,p1(charA));\r
- | Mu.aStrLp1 : mth := cpr.AddMethod("chrArrLplus1",int4D,p1(charA));\r
- | Mu.aaStrCmp : mth := cpr.AddMethod("strCmp",int4D,p2(charA,charA));\r
- | Mu.aaStrCopy : mth := cpr.AddMethod("Stringify",voidD,p2(charA,charA));\r
- | Mu.CpModI : mth := cpr.AddMethod("CpModI",int4D,p2(int4D,int4D));\r
- | Mu.CpDivI : mth := cpr.AddMethod("CpDivI",int4D,p2(int4D,int4D));\r
- | Mu.CpModL : mth := cpr.AddMethod("CpModL",int8D,p2(int8D,int8D));\r
- | Mu.CpDivL : mth := cpr.AddMethod("CpDivL",int8D,p2(int8D,int8D));\r
- | Mu.caseMesg : mth := cpr.AddMethod("caseMesg",strgD,p1(int4D));\r
- | Mu.withMesg : mth := cpr.AddMethod("withMesg",strgD,p1(objtD));\r
- | Mu.chs2Str : mth := cpr.AddMethod("mkStr",strgD,p1(charA));\r
- | Mu.CPJstrCatAA : mth := cpr.AddMethod("aaToStr",strgD,p2(charA,charA));\r
- | Mu.CPJstrCatSA : mth := cpr.AddMethod("saToStr",strgD,p2(strgD,charA));\r
- | Mu.CPJstrCatAS : mth := cpr.AddMethod("asToStr",strgD,p2(charA,strgD));\r
- | Mu.CPJstrCatSS : mth := cpr.AddMethod("ssToStr",strgD,p2(strgD,strgD));\r
-\r
- | Mu.toUpper : sys := getOrAddClass(corlib, "System", "Char");\r
- mth := getOrAddMethod(sys,"ToUpper",charD,p1(charD));\r
-\r
- | Mu.sysExit : IF envrCls = NIL THEN\r
- envrCls := \r
- getOrAddClass(corlib, "System", "Environment");\r
- END;\r
- mth := getOrAddMethod(envrCls,"Exit",voidD,p1(int4D));\r
-\r
- | Mu.mkExcept : IF excpCls = NIL THEN\r
- IF CSt.ntvExc.tgXtn = NIL THEN\r
- excpCls := \r
- getOrAddClass(corlib, "System", "Exception");\r
- CSt.ntvExc.tgXtn := excpCls;\r
- ELSE\r
- excpCls := CSt.ntvExc.tgXtn(Api.ClassRef);\r
- END;\r
- END;\r
- sys := CSt.ntvExc.tgXtn(Api.ClassRef);\r
-(*\r
- * mth := sys.AddMethod(ctorS,voidD,p1(strgD));\r
- *)\r
- mth := getOrAddMethod(sys,ctorS,voidD,p1(strgD));\r
- mth.AddCallConv(Api.CallConv.Instance);\r
-\r
- | Mu.getTpM : IF CSt.ntvTyp.tgXtn = NIL THEN\r
- CSt.ntvTyp.tgXtn := \r
- getOrAddClass(corlib, "System", "Type");\r
- END;\r
- sys := CSt.ntvTyp.tgXtn(Api.ClassRef);\r
- mth := getOrAddMethod(sys,"GetType",sys,NIL);\r
- mth.AddCallConv(Api.CallConv.Instance);\r
-\r
- | Mu.dFloor, Mu.dAbs, Mu.fAbs, Mu.iAbs, Mu.lAbs :\r
- IF mathCls = NIL THEN\r
- mathCls := getOrAddClass(corlib, "System", "Math");\r
- END;\r
- rHelper[Mu.dFloor] := getOrAddMethod(mathCls,"Floor",flt8D,p1(flt8D));\r
- rHelper[Mu.dAbs] := getOrAddMethod(mathCls,"Abs",flt8D,p1(flt8D));\r
- rHelper[Mu.fAbs] := getOrAddMethod(mathCls,"Abs",flt4D,p1(flt4D));\r
- rHelper[Mu.iAbs] := getOrAddMethod(mathCls,"Abs",int4D,p1(int4D));\r
- rHelper[Mu.lAbs] := getOrAddMethod(mathCls,"Abs",int8D,p1(int8D));\r
- mth := rHelper[s];\r
- END;\r
- rHelper[s] := mth;\r
- END;\r
- RETURN mth;\r
- END getMethod;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)StaticCall*(s : INTEGER; d : INTEGER);\r
- VAR mth : Api.Method;\r
- BEGIN\r
- mth := os.getMethod(s);\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);\r
- os.Adjust(d);\r
- END StaticCall;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CodeS*(code : INTEGER; str : INTEGER);\r
- VAR mth : Api.Method;\r
- BEGIN\r
- mth := os.getMethod(str);\r
- os.pePI.code.MethInst(Asm.cd[code], mth);\r
- END CodeS;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Try*();\r
- VAR retT : Sy.Type;\r
- BEGIN\r
- os.proc.exLb := os.newLabel();\r
- retT := os.proc.prId.type.returnType();\r
- IF retT # NIL THEN os.proc.rtLc := os.proc.newLocal(retT) END;\r
- os.pePI.code.StartBlock();\r
- END Try;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)Catch*(proc : Id.Procs);\r
- BEGIN\r
- os.pePI.tryB := os.pePI.code.EndTryBlock();\r
- os.pePI.code.StartBlock();\r
- os.Adjust(1); (* allow for incoming exception reference *)\r
- os.StoreLocal(proc.except.varOrd);\r
- END Catch;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CloseCatch*();\r
- BEGIN\r
- IF excpCls = NIL THEN\r
- IF CSt.ntvExc.tgXtn = NIL THEN\r
- excpCls := getOrAddClass(corlib, "System", "Exception");\r
- CSt.ntvExc.tgXtn := excpCls;\r
- ELSE\r
- excpCls := CSt.ntvExc.tgXtn(Api.ClassRef);\r
- END;\r
- END;\r
- os.pePI.code.EndCatchBlock(excpCls, os.pePI.tryB);\r
- END CloseCatch;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)CopyCall*(typ : Ty.Record);\r
- BEGIN\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], os.cpy(typ));\r
- os.Adjust(-2);\r
- END CopyCall;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)PushStr*(IN str : ARRAY OF CHAR);\r
- (* Use target quoting conventions for the literal string *)\r
- BEGIN\r
- (* os.pePI.code.ldstr(MKSTR(str)); *)\r
- os.pePI.code.ldstr(Sys.String.init(BOX(str), 0, LEN(str) - 1));\r
- os.Adjust(1);\r
- END PushStr;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CallIT*(code : INTEGER; \r
- proc : Id.Procs; \r
- type : Ty.Procedure);\r
- VAR xtn : Api.Method;\r
- BEGIN\r
- xtn := os.mth(proc);\r
- os.pePI.code.MethInst(Asm.cd[code], xtn);\r
- os.Adjust(type.retN - type.argN); \r
- END CallIT;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CallCT*(proc : Id.Procs; \r
- type : Ty.Procedure);\r
- VAR xtn : Api.Method;\r
- BEGIN\r
- ASSERT(proc.tgXtn # NIL);\r
- xtn := proc.tgXtn(Api.Method);\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_newobj], xtn);\r
- os.Adjust(-type.argN); \r
- END CallCT;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CallDelegate*(typ : Ty.Procedure);\r
- VAR xtn : Api.Method;\r
- BEGIN\r
- ASSERT(typ.tgXtn # NIL);\r
-(*\r
- * xtn := typ.tgXtn(DelXtn).invD;\r
- *)\r
- xtn := os.dxt(typ).invD;\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_callvirt], xtn);\r
- os.Adjust(-typ.argN + typ.retN); \r
- END CallDelegate;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)PutGetS*(code : INTEGER;\r
- blk : Id.BlkId;\r
- fId : Id.VarId);\r
- (* Emit putstatic and getstatic for static field *)\r
- BEGIN\r
- os.pePI.code.FieldInst(Asm.cd[code], os.fld(fId));\r
- os.Adjust(Asm.dl[code]);\r
- END PutGetS;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)GetValObj*(code : INTEGER; ptrT : Ty.Pointer);\r
- VAR rTp : Ty.Record;\r
- BEGIN\r
- rTp := ptrT.boundRecTp()(Ty.Record);\r
- os.pePI.code.FieldInst(Asm.cd[code], os.vDl(rTp));\r
- os.Adjust(Asm.dl[code]);\r
- END GetValObj;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)PutGetXhr*(code : INTEGER; \r
- proc : Id.Procs; \r
- locl : Id.LocId);\r
- VAR ix : INTEGER;\r
- name : Lv.CharOpen;\r
- recT : Ty.Record;\r
- fldI : Id.FldId;\r
- BEGIN\r
- ix := 0;\r
- recT := proc.xhrType.boundRecTp()(Ty.Record);\r
- WHILE recT.fields.a[ix].hash # locl.hash DO INC(ix) END;;\r
- os.pePI.code.FieldInst(Asm.cd[code], os.fld(recT.fields.a[ix](Id.FldId)));\r
- END PutGetXhr;\r
-\r
-(* -------------------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)PutGetF*(code : INTEGER;\r
- fId : Id.FldId);\r
- BEGIN\r
- os.pePI.code.FieldInst(Asm.cd[code], os.fld(fId));\r
- os.Adjust(Asm.dl[code]);\r
- END PutGetF;\r
-\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkNewRecord*(typ : Ty.Record);\r
- CONST code = Asm.opc_newobj;\r
- VAR name : Lv.CharOpen;\r
- BEGIN\r
- (*\r
- * We need "newobj instance void <name>::.ctor()"\r
- *)\r
- os.pePI.code.MethInst(Asm.cd[code], os.new(typ));\r
- os.Adjust(1);\r
- END MkNewRecord;\r
-\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkNewProcVal*(p : Sy.Idnt; (* src Proc *)\r
- t : Sy.Type); (* dst Type *)\r
- VAR ctor : Api.Method;\r
- ldfi : INTEGER;\r
- pTyp : Ty.Procedure;\r
- proc : Id.Procs;\r
- BEGIN\r
-(*\r
- * ctor := t.tgXtn(DelXtn).newD;\r
- *)\r
- proc := p(Id.Procs);\r
- pTyp := t(Ty.Procedure);\r
- ctor := os.dxt(pTyp).newD;\r
- (*\r
- * We need "ldftn [instance] <retType> <procName>\r
- *)\r
- WITH p : Id.MthId DO\r
- IF p.bndType.isInterfaceType() THEN\r
- ldfi := Asm.opc_ldvirtftn;\r
- ELSIF p.mthAtt * Id.mask = Id.final THEN\r
- ldfi := Asm.opc_ldftn;\r
- ELSE\r
- ldfi := Asm.opc_ldvirtftn;\r
- END;\r
- ELSE\r
- ldfi := Asm.opc_ldftn;\r
- END;\r
- (*\r
- * These next are needed for imported events\r
- *)\r
- Mu.MkProcName(proc, os);\r
- os.NumberParams(proc, pTyp);\r
- (*\r
- * If this will be a virtual method call, then we\r
- * must duplicate the receiver, since the call of\r
- * ldvirtftn uses up one copy.\r
- *)\r
- IF ldfi = Asm.opc_ldvirtftn THEN os.Code(Asm.opc_dup) END;\r
- os.pePI.code.MethInst(Asm.cd[ldfi], os.mth(proc));\r
- os.Adjust(1);\r
- (*\r
- * Now we need "newobj instance void <name>::.ctor(...)"\r
- *)\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_newobj], ctor);\r
- os.Adjust(-2);\r
- END MkNewProcVal;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CallSuper*(rTp : Ty.Record;\r
- prc : Id.PrcId);\r
- VAR pNm : INTEGER;\r
- spr : Api.Method;\r
- (* ---------------------------------------- *)\r
- PROCEDURE getSuperCtor(os : PeFile; \r
- rTp : Ty.Record; \r
- prc : Id.Procs) : Api.Method;\r
- VAR bas : Ty.Record;\r
- pTp : Ty.Procedure;\r
- bcl : Api.Class;\r
- mth : Api.Method;\r
- BEGIN\r
- bas := rTp.superType();\r
- IF prc # NIL THEN\r
- (*\r
- * This constructor has arguments.\r
- * The super constructor is prc.basCll.sprCtor\r
- *)\r
- pTp := prc.type(Ty.Procedure);\r
- IF prc.tgXtn = NIL THEN\r
- bcl := os.cls(bas);\r
- WITH bcl : Api.ClassDef DO\r
- mth := MkMthDef(os, FALSE, pTp, bcl, ctorS);\r
- mth(Api.MethodDef).AddMethAttribute(ctAtt);\r
- | bcl : Api.ClassRef DO\r
- mth := MkMthRef(os, pTp, bcl, ctorS);\r
- END;\r
- mth.AddCallConv(Api.CallConv.Instance);\r
- prc.tgXtn := mth;\r
- RETURN mth;\r
- ELSE\r
- RETURN prc.tgXtn(Api.Method);\r
- END;\r
- ELSIF (bas # NIL) & (rTp.baseTp # Bi.anyRec) THEN\r
- (*\r
- * This is the explicit noarg constructor of the supertype.\r
- *)\r
- RETURN os.new(bas);\r
- ELSE\r
- (*\r
- * This is System.Object::.ctor()\r
- *)\r
- RETURN newObjt;\r
- END;\r
- END getSuperCtor;\r
- (* ---------------------------------------- *)\r
- BEGIN\r
- IF prc # NIL THEN \r
- pNm := prc.type(Ty.Procedure).formals.tide;\r
- ELSE \r
- pNm := 0;\r
- END;\r
- spr := getSuperCtor(os, rTp, prc);\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], spr);\r
- os.Adjust(-(pNm+1));\r
- END CallSuper;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)InitHead*(rTp : Ty.Record;\r
- prc : Id.PrcId);\r
- VAR mDf : Api.MethodDef;\r
- cDf : Api.ClassDef;\r
- BEGIN\r
- cDf := os.cls(rTp)(Api.ClassDef);\r
-\r
- IF prc # NIL THEN\r
- mDf := prc.tgXtn(Api.MethodDef);\r
- mDf.AddMethAttribute(ctAtt);\r
- ELSE\r
- mDf := os.new(rTp)(Api.MethodDef);\r
- END;\r
- os.pePI.mthD := mDf;\r
- os.MkCodeBuffer();\r
- mDf.AddCallConv(Api.CallConv.Instance);\r
- (*\r
- * Now we initialize the supertype;\r
- *)\r
- os.Code(Asm.opc_ldarg_0);\r
- END InitHead;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CopyHead*(typ : Ty.Record);\r
- VAR mDf : Api.MethodDef;\r
- cDf : Api.ClassDef;\r
- par : Id.ParId;\r
- prs : POINTER TO ARRAY OF Id.ParId;\r
- BEGIN\r
- cDf := os.cls(typ)(Api.ClassDef);\r
- mDf := os.cpy(typ)(Api.MethodDef);\r
- mDf.AddMethAttribute(Api.MethAttr.Public);\r
- mDf.AddImplAttribute(ilAtt);\r
- mDf.AddCallConv(Api.CallConv.Instance);\r
- os.pePI.mthD := mDf;\r
- os.MkCodeBuffer();\r
- END CopyHead;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MarkInterfaces*(IN seq : Sy.TypeSeq);\r
- VAR index : INTEGER;\r
- tideX : INTEGER;\r
- implT : Ty.Record;\r
- BEGIN\r
- tideX := seq.tide-1;\r
- ASSERT(tideX >= 0);\r
- FOR index := 0 TO tideX DO\r
- implT := seq.a[index].boundRecTp()(Ty.Record);\r
- os.clsD.AddImplementedInterface(os.cls(implT));\r
- END;\r
- END MarkInterfaces;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MainHead*(xAtt : SET);\r
- VAR mthD : Api.MethodDef;\r
-\r
- VAR strA : Api.Type;\r
- list : Api.Field;\r
- pars : POINTER TO ARRAY OF Api.Param;\r
- BEGIN \r
- NEW(pars, 1);\r
- strA := Api.ZeroBasedArray.init(strgD);\r
- pars[0] := Api.Param.init(0, "@args", strA);\r
-\r
- IF Sy.wMain IN xAtt THEN\r
- mthD := os.clsS.AddMethod(psAtt, ilAtt, ".WinMain", voidD, pars);\r
- ELSE (* Sy.cMain IN xAtt THEN *)\r
- mthD := os.clsS.AddMethod(psAtt, ilAtt, ".CPmain", voidD, pars);\r
- END;\r
- os.pePI.mthD := mthD;\r
- os.MkCodeBuffer();\r
- mthD.DeclareEntryPoint();\r
- IF CSt.debug THEN os.LineSpan(Scn.mkSpanT(CSt.thisMod.begTok)) END;\r
- (*\r
- * Save the command-line arguments to the RTS.\r
- *)\r
- os.Code(Asm.opc_ldarg_0);\r
- os.CodeF(Asm.opc_stsfld, os.fld(CSt.argLst));\r
- END MainHead;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)SubSys*(xAtt : SET);\r
- BEGIN\r
- IF Sy.wMain IN xAtt THEN os.peFl.SetSubSystem(2) END;\r
- END SubSys;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)StartBoxClass*(rec : Ty.Record;\r
- att : SET;\r
- blk : Id.BlkId);\r
- VAR mthD : Api.MethodDef;\r
- sprC : Api.Method;\r
- boxC : Api.ClassDef;\r
- BEGIN\r
- boxC := rec.tgXtn(RecXtn).boxD(Api.ClassDef);\r
- boxC.AddAttribute(toTypeAttr(att));\r
-\r
- (*\r
- * Emit the no-arg constructor\r
- *)\r
- os.MkNewProcInfo(blk);\r
- mthD := os.new(rec)(Api.MethodDef);\r
- os.pePI.mthD := mthD;\r
- os.MkCodeBuffer();\r
- mthD.AddCallConv(Api.CallConv.Instance);\r
-\r
- os.Code(Asm.opc_ldarg_0);\r
- sprC := newObjt;\r
-\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], sprC);\r
- os.InitHead(rec, NIL);\r
- os.CallSuper(rec, NIL);\r
- os.Code(Asm.opc_ret);\r
- os.Locals();\r
- os.InitTail(rec);\r
- os.pePI := NIL;\r
- os.proc := NIL;\r
- (*\r
- * Copies of value classes are always done inline.\r
- *)\r
- END StartBoxClass;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Tail(),NEW;\r
- BEGIN\r
- os.Locals();\r
- os.pePI.code.CloseScope(); (* Needed for PERWAPI pdb files *)\r
- os.pePI := NIL;\r
- os.proc := NIL;\r
- END Tail;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MainTail*();\r
- BEGIN os.Tail() END MainTail;\r
-\r
-(* ------------------------------------------------------------ *)\r
-\r
- PROCEDURE (os : PeFile)MethodTail*(id : Id.Procs);\r
- BEGIN os.Tail() END MethodTail;\r
-\r
-(* ------------------------------------------------------------ *)\r
-\r
- PROCEDURE (os : PeFile)ClinitTail*();\r
- BEGIN os.Tail() END ClinitTail;\r
-\r
-(* ------------------------------------------------------------ *)\r
-\r
- PROCEDURE (os : PeFile)CopyTail*();\r
- BEGIN os.Tail() END CopyTail;\r
-\r
-(* ------------------------------------------------------------ *)\r
-\r
- PROCEDURE (os : PeFile)InitTail*(typ : Ty.Record);\r
- BEGIN os.Tail() END InitTail;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)ClinitHead*();\r
- VAR mAtt : INTEGER;\r
- BEGIN\r
- mAtt := ctAtt + Api.MethAttr.Static;\r
- os.pePI.mthD := os.clsS.AddMethod(mAtt, ilAtt, ".cctor", voidD, NIL);\r
- os.MkCodeBuffer();\r
- IF CSt.debug THEN\r
- os.pePI.code.IntLine(CSt.thisMod.token.lin, \r
- CSt.thisMod.token.col, \r
- CSt.thisMod.token.lin,\r
- CSt.thisMod.token.col + CSt.thisMod.token.len);\r
- os.Code(Asm.opc_nop);\r
- END; \r
- END ClinitHead;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)EmitField*(id : Id.AbVar; att : SET);\r
- VAR fDf : Api.FieldDef;\r
- BEGIN\r
- fDf := os.fld(id)(Api.FieldDef);\r
- fDf.AddFieldAttr(toFieldAttr(att));\r
- END EmitField;\r
-\r
-(* ============================================================ *)\r
-(* Start of Procedure Variable and Event Stuff *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE MkAddRem(os : PeFile; fId : Id.AbVar);\r
- VAR xtn : EvtXtn;\r
- fXt : Api.Field;\r
- clD : Api.Class;\r
- namS : Lv.CharOpen;\r
- typA : POINTER TO ARRAY OF Api.Type;\r
- parA : POINTER TO ARRAY OF Api.Param;\r
- (* -------------------------------- *)\r
- PROCEDURE GetClass(os : PeFile; \r
- id : Id.AbVar;\r
- OUT cl : Api.Class;\r
- OUT nm : Lv.CharOpen);\r
- BEGIN\r
- WITH id : Id.FldId DO\r
- cl := os.cls(id.recTyp(Ty.Record));\r
- nm := id.fldNm;\r
- | id : Id.VarId DO\r
- IF id.recTyp # NIL THEN cl:= os.cls(id.recTyp(Ty.Record));\r
- ELSE cl:= os.dsc(id.dfScp(Id.BlkId));\r
- END;\r
- nm := id.varNm;\r
- END;\r
- END GetClass;\r
- (* -------------------------------- *)\r
- BEGIN\r
- (*\r
- * First, need to ensure that there is a field \r
- * descriptor created for this variable.\r
- *)\r
- IF fId.tgXtn = NIL THEN \r
- fXt := os.fld(fId);\r
- ELSE \r
- fXt := fId.tgXtn(Api.Field);\r
- END;\r
- (*\r
- * Now allocate the Event Extension object.\r
- *)\r
- NEW(xtn);\r
- xtn.fldD := fXt;\r
- (*\r
- * Now create the MethodRef or MethodDef descriptors\r
- * for add_<fieldname>() and remove_<fieldname>()\r
- *)\r
- GetClass(os, fId, clD, namS);\r
- WITH clD : Api.ClassDef DO\r
- NEW(parA, 1);\r
- parA[0] := Api.Param.init(0, "ev", os.typ(fId.type)); \r
- xtn.addD := clD.AddMethod(MKSTR(evtAdd^ + namS^), voidD, parA);\r
- xtn.remD := clD.AddMethod(MKSTR(evtRem^ + namS^), voidD, parA);\r
- | clD : Api.ClassRef DO\r
- NEW(typA, 1);\r
- typA[0] := os.typ(fId.type); \r
- xtn.addD := clD.AddMethod(MKSTR(evtAdd^ + namS^), voidD, typA);\r
- xtn.remD := clD.AddMethod(MKSTR(evtRem^ + namS^), voidD, typA);\r
- END;\r
- fId.tgXtn := xtn;\r
- END MkAddRem;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)EmitEventMethods*(id : Id.AbVar);\r
- CONST att = Api.MethAttr.Public + Api.MethAttr.SpecialName;\r
- VAR eTp : Ty.Event;\r
- evt : Api.Event;\r
- addD : Api.MethodDef;\r
- remD : Api.MethodDef;\r
- (* ------------------------------------------------- *)\r
- PROCEDURE EmitEvtMth(os : PeFile; \r
- id : Id.AbVar;\r
- add : BOOLEAN; \r
- mth : Api.MethodDef);\r
- VAR pFix : Lv.CharOpen;\r
- mStr : RTS.NativeString;\r
- mthD : Api.MethodDef;\r
- parA : POINTER TO ARRAY OF Api.Param;\r
- BEGIN\r
- os.MkNewProcInfo(NIL);\r
- WITH id : Id.FldId DO\r
- mth.AddMethAttribute(att);\r
- mth.AddCallConv(Api.CallConv.Instance);\r
- mth.AddImplAttribute(ilAtt + Api.ImplAttr.Synchronised);\r
- os.pePI.mthD := mth;\r
- os.MkCodeBuffer();\r
- os.Code(Asm.opc_ldarg_0);\r
- os.Code(Asm.opc_ldarg_0);\r
- os.PutGetF(Asm.opc_ldfld, id);\r
- os.Code(Asm.opc_ldarg_1);\r
- os.CallCombine(id.type, add);\r
- os.PutGetF(Asm.opc_stfld, id);\r
- | id : Id.VarId DO\r
- mth.AddMethAttribute(att + Api.MethAttr.Static);\r
- mth.AddImplAttribute(ilAtt + Api.ImplAttr.Synchronised);\r
- os.pePI.mthD := mth;\r
- os.MkCodeBuffer(); \r
- os.PutGetS(Asm.opc_ldsfld, id.dfScp(Id.BlkId), id);\r
- os.Code(Asm.opc_ldarg_0);\r
- os.CallCombine(id.type, add);\r
- os.PutGetS(Asm.opc_stsfld, id.dfScp(Id.BlkId),id);\r
- END;\r
- os.Code(Asm.opc_ret);\r
- os.Tail();\r
- END EmitEvtMth;\r
- (* ------------------------------------------------- *)\r
- BEGIN\r
- (*\r
- * Emit the "add_*" method\r
- *)\r
- addD := os.add(id)(Api.MethodDef);\r
- EmitEvtMth(os, id, TRUE, addD);\r
- (*\r
- * Emit the "remove_*" method\r
- *)\r
- remD := os.rem(id)(Api.MethodDef);\r
- EmitEvtMth(os, id, FALSE, remD);\r
- (*\r
- * Emit the .event declaration" \r
- *)\r
- WITH id : Id.FldId DO\r
- evt := os.clsD.AddEvent(MKSTR(id.fldNm^), os.typ(id.type));\r
- | id : Id.VarId DO\r
- evt := os.clsD.AddEvent(MKSTR(id.varNm^), os.typ(id.type));\r
- END;\r
- evt.AddMethod(addD, Api.MethodType.AddOn);\r
- evt.AddMethod(remD, Api.MethodType.RemoveOn);\r
- END EmitEventMethods;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)CallCombine(typ : Sy.Type;\r
- add : BOOLEAN),NEW;\r
- VAR xtn : Api.Method;\r
- BEGIN\r
- IF add THEN xtn := os.cmb() ELSE xtn := os.rmv() END; \r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], xtn);\r
- os.Adjust(-1); \r
- os.CodeT(Asm.opc_castclass, typ);\r
- END CallCombine;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkAndLinkDelegate*(dl : Sy.Idnt;\r
- id : Sy.Idnt;\r
- ty : Sy.Type;\r
- isA : BOOLEAN);\r
- (* --------------------------------------------------------- *)\r
- VAR rcv : INTEGER;\r
- mth : Api.Method;\r
- (* --------------------------------------------------------- *)\r
- BEGIN\r
- WITH id : Id.FldId DO\r
- (*\r
- * <push handle> // ... already done\r
- * <push receiver (or nil)> // ... already done\r
- * <make new proc value> // ... still to do\r
- * call instance void A.B::add_fld(class tyName)\r
- *)\r
- os.MkNewProcVal(dl, ty);\r
- IF isA THEN mth := os.add(id) ELSE mth := os.rem(id) END;\r
- mth.AddCallConv(Api.CallConv.Instance);\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);\r
- | id : Id.VarId DO\r
- (*\r
- * <push receiver (or nil)> // ... already done\r
- * <make new proc value> // ... still to do\r
- * call void A.B::add_fld(class tyName)\r
- *)\r
- os.MkNewProcVal(dl, ty);\r
- IF isA THEN mth := os.add(id) ELSE mth := os.rem(id) END;\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], mth);\r
- | id : Id.LocId DO\r
- (*\r
- * <save receiver> \r
- * ldloc 'local'\r
- * <restore receiver> \r
- * <make new proc value> // ... still to do\r
- * call class D D::Combine(class D, class D)\r
- *)\r
- rcv := os.proc.newLocal(CSt.ntvObj);\r
- os.StoreLocal(rcv);\r
- os.GetLocal(id);\r
- os.PushLocal(rcv);\r
- os.MkNewProcVal(dl, ty);\r
- os.CallCombine(ty, isA);\r
- os.PutLocal(id); \r
- END;\r
- END MkAndLinkDelegate;\r
-\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)EmitPTypeBody*(tId : Id.TypId);\r
- BEGIN\r
- ASSERT(tId.tgXtn # NIL);\r
- END EmitPTypeBody;\r
-\r
-(* ============================================================ *)\r
-(* End of Procedure Variable and Event Stuff *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Line*(nm : INTEGER);\r
- BEGIN\r
- os.pePI.code.IntLine(nm,1,nm,100);\r
- (*IF CSt.debug THEN os.Code(Asm.opc_nop) END;*)\r
- END Line;\r
- \r
- PROCEDURE (os : PeFile)LinePlus*(lin, col : INTEGER); \r
- BEGIN\r
- (*IF CSt.debug THEN os.Code(Asm.opc_nop) END;*)\r
- os.pePI.code.IntLine(lin,1,lin,col); \r
- END LinePlus;\r
- \r
- PROCEDURE (os : PeFile)LineSpan*(s : Scn.Span);\r
- BEGIN\r
- IF s # NIL THEN \r
- os.pePI.code.IntLine(s.sLin, s.sCol, s.eLin, s.eCol) END; \r
- END LineSpan;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Locals(),NEW;\r
- (** Declare the local of this method. *)\r
- VAR count : INTEGER;\r
- index : INTEGER;\r
- prcId : Sy.Scope;\r
- locId : Id.LocId;\r
- methD : Api.MethodDef;\r
- loclA : POINTER TO ARRAY OF Api.Local;\r
- boolA : POINTER TO ARRAY OF BOOLEAN;\r
- lBind : Api.LocalBinding;\r
- BEGIN\r
- methD := os.pePI.mthD;\r
- (*\r
- * If dMax < 8, leave maxstack as default \r
- *)\r
- IF os.proc.dMax > 8 THEN \r
- methD.SetMaxStack(os.proc.dMax);\r
- ELSE\r
- methD.SetMaxStack(8);\r
- END;\r
- NEW(loclA, os.proc.tLst.tide);\r
- NEW(boolA, os.proc.tLst.tide);\r
-\r
- count := 0;\r
- IF os.proc.prId # NIL THEN \r
- prcId := os.proc.prId;\r
- WITH prcId : Id.Procs DO\r
- IF Id.hasXHR IN prcId.pAttr THEN\r
- loclA[count] := Api.Local.init("", os.typ(prcId.xhrType)); \r
- INC(count);\r
- END;\r
- FOR index := 0 TO prcId.locals.tide-1 DO\r
- locId := prcId.locals.a[index](Id.LocId);\r
- IF ~(locId IS Id.ParId) & (locId.varOrd # Id.xMark) THEN\r
- loclA[count] := Api.Local.init(nms(locId), os.typ(locId.type));\r
- IF CSt.debug THEN boolA[count] := TRUE END;\r
- INC(count);\r
- END;\r
- END;\r
- ELSE (* nothing for module blocks *)\r
- END;\r
- END;\r
- WHILE count < os.proc.tLst.tide DO \r
- loclA[count] := Api.Local.init("", os.typ(os.proc.tLst.a[count])); \r
- INC(count);\r
- END;\r
- IF count > 0 THEN methD.AddLocals(loclA, TRUE) END;\r
- FOR index := 0 TO count-1 DO\r
- IF boolA[index] THEN lBind := os.pePI.code.BindLocal(loclA[index]) END;\r
- END;\r
- END Locals;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)LoadType*(id : Sy.Idnt);\r
- (* ---------------------------------- *)\r
- PROCEDURE getLdTyp(os : PeFile) : Api.MethodRef;\r
- VAR typD : Api.ClassRef;\r
- rthA : POINTER TO ARRAY OF Api.Type;\r
- BEGIN\r
- IF loadTyp = NIL THEN\r
- (*\r
- * Make params for the call\r
- *)\r
- NEW(rthA, 1);\r
- IF rtTpHdl = NIL THEN\r
- rtTpHdl := getOrAddValueClass(corlib, "System", "RuntimeTypeHandle");\r
- END;\r
- rthA[0] := rtTpHdl;\r
- (*\r
- * Make receiver/result type descriptor\r
- *)\r
- IF CSt.ntvTyp.tgXtn = NIL THEN\r
- CSt.ntvTyp.tgXtn := getOrAddClass(corlib, "System", "Type");\r
- END;\r
- typD := CSt.ntvTyp.tgXtn(Api.ClassRef);\r
- loadTyp := getOrAddMethod(typD, "GetTypeFromHandle", typD, rthA);\r
- END;\r
- RETURN loadTyp;\r
- END getLdTyp;\r
- (* ---------------------------------- *)\r
- BEGIN\r
- (*\r
- * ldtoken <Type>\r
- * call class [mscorlib]System.Type \r
- * [mscorlib]System.Type::GetTypeFromHandle(\r
- * value class [mscorlib]System.RuntimeTypeHandle)\r
- *)\r
- os.CodeT(Asm.opc_ldtoken, id.type);\r
- os.pePI.code.MethInst(Asm.cd[Asm.opc_call], getLdTyp(os));\r
- END LoadType;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)Finish*();\r
- (*(* ------------------------------------ *)\r
- PROCEDURE MakeDebuggable(pef : Api.PEFile);\r
- VAR thisAssm : Api.Assembly;\r
- debugRef : Api.ClassRef;\r
- dbugCtor : Api.MethodRef;\r
- trueCnst : Api.BoolConst;\r
- twoBools : TypArr;\r
- dbugArgs : POINTER TO ARRAY OF Api.Constant;\r
- BEGIN\r
- thisAssm := pef.GetThisAssembly();\r
- debugRef := getOrAddClass(corlib, "System.Diagnostics", "DebuggableAttribute");\r
- NEW(twoBools, 2);\r
- NEW(dbugArgs, 2);\r
- twoBools[0] := Api.PrimitiveType.Boolean;\r
- twoBools[1] := Api.PrimitiveType.Boolean;\r
- dbugArgs[0] := Api.BoolConst.init(TRUE);\r
- dbugArgs[1] := Api.BoolConst.init(TRUE);\r
- dbugCtor := getOrAddMethod(debugRef, ctorS, voidD, twoBools)(Api.MethodRef);\r
- dbugCtor.AddCallConv(Api.CallConv.Instance);\r
- thisAssm.AddCustomAttribute(dbugCtor, dbugArgs); \r
- END MakeDebuggable;\r
- (* ------------------------------------ *)*)\r
- BEGIN\r
- IF CSt.debug THEN os.peFl.MakeDebuggable(TRUE, TRUE) END; \r
- (* bake the assembly ... *)\r
- os.peFl.WritePEFile(CSt.debug); \r
- END Finish;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)RefRTS*();\r
- VAR i : INTEGER;\r
- xhrRc : Ty.Record;\r
- xhrNw : Api.Method;\r
- xhrXt : RecXtn;\r
- rtsXt : BlkXtn;\r
- recXt : RecXtn;\r
- BEGIN\r
- (*\r
- * Reset the descriptor pool.\r
- * Note that descriptors cannot persist between\r
- * compilation unit, since the token sequence\r
- * is reset in PEAPI.\r
- *)\r
- mathCls := NIL;\r
- envrCls := NIL;\r
- excpCls := NIL;\r
- rtTpHdl := NIL;\r
- loadTyp := NIL;\r
- FOR i := 0 TO Mu.rtsLen-1 DO rHelper[i] := NIL END;\r
- (*\r
- * Now we need to create tgXtn fields\r
- * for some of the system types. All \r
- * others are only allocated on demand.\r
- *)\r
- corlib := os.peFl.MakeExternAssembly("mscorlib");\r
- (*\r
- * Must put xtn markers on both the pointer AND the record\r
- *)\r
- NEW(recXt);\r
- CSt.ntvStr(Ty.Pointer).boundTp.tgXtn := recXt; (* the record *)\r
-(*\r
- * recXt.clsD := corlib.AddClass("System", "String");\r
- *)\r
-(* -- start replacement -- *)\r
- recXt.clsD := getOrAddClass(corlib, "System", "String");\r
-(* --- end replacement --- *)\r
- CSt.ntvStr.tgXtn := recXt.clsD; (* the pointer *)\r
- (*\r
- * Must put xtn markers on both the pointer AND the record\r
- *)\r
- NEW(recXt);\r
- CSt.ntvObj(Ty.Pointer).boundTp.tgXtn := recXt; (* the record *)\r
-(*\r
- * recXt.clsD := corlib.AddClass("System", "Object");\r
- *)\r
-(* -- start replacement -- *)\r
- recXt.clsD := getOrAddClass(corlib, "System", "Object");\r
-(* --- end replacement --- *)\r
- CSt.ntvObj.tgXtn := recXt.clsD; (* the pointer *)\r
- (*\r
- * CSt.ntvVal IS a record descriptor, not a pointer\r
- *)\r
- NEW(recXt);\r
- CSt.ntvVal.tgXtn := recXt; (* the record *)\r
-(*\r
- * recXt.clsD := corlib.AddClass("System", "ValueType");\r
- *)\r
-(* -- start replacement -- *)\r
- recXt.clsD := getOrAddClass(corlib, "System", "ValueType");\r
-(* --- end replacement --- *)\r
-\r
- newObjt := getOrAddMethod(CSt.ntvObj.tgXtn(Api.ClassRef),ctorS,voidD,NIL);\r
- newObjt.AddCallConv(Api.CallConv.Instance);\r
- (*\r
- * Create Api.AssemblyRef for "RTS"\r
- * Create Api.ClassRef for "[RTS]RTS"\r
- * Create Api.ClassRef for "[RTS]Cp_rts"\r
- *)\r
- IF CSt.rtsBlk.xName = NIL THEN Mu.MkBlkName(CSt.rtsBlk) END;\r
- os.rts := os.peFl.MakeExternAssembly("RTS");\r
- NEW(rtsXt);\r
- rtsXt.asmD := os.rts;\r
- rtsXt.dscD := os.rts.AddClass("", "RTS");\r
- CSt.rtsBlk.tgXtn := rtsXt;\r
- os.cprts := os.rts.AddClass("", "CP_rts");\r
- (*\r
- * Create Api.AssemblyRef for "ProgArgs" (same as RTS)\r
- * Create Api.ClassRef for "[RTS]ProgArgs"\r
- *)\r
- os.DoRtsMod(CSt.prgArg);\r
- os.progArgs := CSt.prgArg.tgXtn(BlkXtn).dscD(Api.ClassRef);\r
- (*\r
- * Create Api.ClassRef for "[RTS]XHR"\r
- * Create method "[RTS]XHR::.ctor()"\r
- *)\r
- xhrCl := os.rts.AddClass("", "XHR");\r
- xhrNw := xhrCl.AddMethod(ctorS, voidD, NIL);\r
- xhrNw.AddCallConv(Api.CallConv.Instance);\r
- xhrRc := CSt.rtsXHR.boundRecTp()(Ty.Record);\r
- NEW(xhrXt);\r
- xhrRc.tgXtn := xhrXt;\r
- xhrXt.clsD := xhrCl;\r
- xhrXt.newD := xhrNw;\r
- END RefRTS;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)StartNamespace*(nm : Lv.CharOpen);\r
- BEGIN\r
- os.nmSp := MKSTR(nm^);\r
- END StartNamespace;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkBodyClass*(mod : Id.BlkId);\r
- (*\r
- * Instantiate a ClassDef object for the synthetic\r
- * static class, and assign to the PeFile::clsS field.\r
- * Of course, for the time being it is also the \r
- * "current class" held in the PeFile::clsD field.\r
- *)\r
- VAR namStr : RTS.NativeString;\r
- clsAtt : INTEGER;\r
- modXtn : BlkXtn;\r
- BEGIN\r
- defSrc := Api.SourceFile.GetSourceFile(\r
- MKSTR(CSt.srcNam), Sys.Guid.Empty, Sys.Guid.Empty, Sys.Guid.Empty);\r
- namStr := MKSTR(mod.clsNm^);\r
- clsAtt := toTypeAttr(Asm.modAttr);\r
- os.clsS := os.peFl.AddClass(clsAtt, os.nmSp, namStr);\r
- os.clsD := os.clsS; \r
- NEW(modXtn);\r
- modXtn.asmD := NIL;\r
- modXtn.dscD := os.clsS;\r
- mod.tgXtn := modXtn;\r
- END MkBodyClass;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)ClassHead*(attSet : SET; \r
- thisRc : Ty.Record;\r
- superT : Ty.Record);\r
- VAR clsAtt : INTEGER;\r
- clsDef : Api.ClassDef;\r
- BEGIN\r
- clsAtt := toTypeAttr(attSet);\r
- clsDef := os.cls(thisRc)(Api.ClassDef);\r
- clsDef.AddAttribute(clsAtt);\r
- os.clsD := clsDef;\r
- END ClassHead;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)ClassTail*();\r
- BEGIN\r
- os.clsD := NIL;\r
- END ClassTail;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkRecX*(t : Ty.Record; s : Sy.Scope);\r
- (* -------------------------------- *\r
- * Create a ClassDef or a ClassRef for this type.\r
- * The type attributes are set to a default value\r
- * and are modified later for a ClassDef.\r
- * -------------------------------- *)\r
- VAR indx : INTEGER;\r
- valR : BOOLEAN; (* is a value record *)\r
- noNw : BOOLEAN; (* no constructor... *)\r
- base : Ty.Record;\r
- xAsm : Api.AssemblyRef;\r
- xCls : Api.ClassRef;\r
- cDef : Api.ClassDef;\r
- cRef : Api.ClassRef;\r
- nStr : RTS.NativeString; (* record name string *)\r
- aStr : RTS.NativeString; (* imported namespace *)\r
- recX : RecXtn;\r
- (* -------------------------------- *)\r
- PROCEDURE DoBoxDef(o : PeFile; t : Ty.Record);\r
- VAR nStr : RTS.NativeString;\r
- cDef : Api.ClassDef;\r
- cFld : Api.FieldDef;\r
- nMth : Api.MethodDef;\r
- tXtn : RecXtn;\r
- BEGIN\r
- nStr := boxedName(t);\r
- tXtn := t.tgXtn(RecXtn);\r
- cDef := o.peFl.AddClass(0, o.nmSp, nStr);\r
- cFld := cDef.AddField(vfldS, tXtn.clsD);\r
- nMth := cDef.AddMethod(ctAtt,ilAtt,ctorS,voidD,NIL);\r
-\r
- nMth.AddCallConv(Api.CallConv.Instance);\r
- cFld.AddFieldAttr(Api.FieldAttr.Public);\r
-\r
- tXtn.boxD := cDef;\r
- tXtn.newD := nMth;\r
- tXtn.vDlr := cFld;\r
- END DoBoxDef;\r
- (* -------------------------------- *)\r
- PROCEDURE DoBoxRef(o : PeFile; t : Ty.Record; c : Api.ClassRef);\r
- VAR cFld : Api.FieldRef;\r
- nMth : Api.MethodRef;\r
- tXtn : RecXtn;\r
- BEGIN\r
- tXtn := t.tgXtn(RecXtn);\r
- cFld := getOrAddField(c, vfldS, tXtn.clsD);\r
-(*\r
- * nMth := c.AddMethod(ctorS,voidD,NIL);\r
- *)\r
- nMth := getOrAddMethod(c, ctorS, voidD, NIL);\r
- nMth.AddCallConv(Api.CallConv.Instance);\r
-\r
- tXtn.boxD := c;\r
- tXtn.newD := nMth;\r
- tXtn.vDlr := cFld;\r
- END DoBoxRef;\r
- (* -------------------------------- *)\r
- BEGIN\r
- nStr := MKSTR(t.xName^);\r
- valR := Mu.isValRecord(t);\r
- NEW(recX);\r
- t.tgXtn := recX;\r
- (*\r
- * No default no-arg constructor is defined if this\r
- * is an abstract record, an interface, or extends a\r
- * foreign record that does not export a no-arg ctor.\r
- *)\r
- noNw := t.isInterfaceType() OR (Sy.noNew IN t.xAttr);\r
-\r
- IF s.kind # Id.impId THEN (* this is a classDEF *)\r
- base := t.superType(); (* might return System.ValueType *)\r
- IF base = NIL THEN\r
- cDef := os.peFl.AddClass(0, os.nmSp, nStr);\r
- ELSIF valR THEN\r
- cDef := os.peFl.AddValueClass(0, os.nmSp, nStr);\r
- ELSE\r
- cDef := os.peFl.AddClass(0, os.nmSp, nStr, os.cls(base));\r
- END;\r
- recX.clsD := cDef; (* this field needed for MkFldName() *)\r
- IF valR THEN \r
- (*\r
- * Create the boxed version of this value record\r
- * AND create a constructor for the boxed class\r
- *)\r
- DoBoxDef(os, t);\r
- ELSIF ~noNw THEN\r
- (*\r
- * Create a constructor for this reference class.\r
- *)\r
- recX.newD := cDef.AddMethod(ctAtt, ilAtt, ctorS, voidD, NIL);\r
- recX.newD.AddCallConv(Api.CallConv.Instance);\r
- END;\r
- FOR indx := 0 TO t.fields.tide-1 DO\r
- Mu.MkFldName(t.fields.a[indx](Id.FldId), os);\r
- END;\r
- ELSE (* this is a classREF *)\r
- IF t.encCls # NIL THEN (* ... a nested classREF *)\r
- base := t.encCls(Ty.Record);\r
- xCls := os.cls(base)(Api.ClassRef);\r
- cRef := xCls.AddNestedClass(nStr);\r
- recX.clsD := cRef;\r
- ELSE (* ... a normal classREF *)\r
- xAsm := os.asm(s(Id.BlkId));\r
- aStr := MKSTR(s(Id.BlkId).xName^);\r
- IF valR THEN\r
- cRef := getOrAddValueClass(xAsm, aStr, nStr);\r
- ELSE\r
- cRef := getOrAddClass(xAsm, aStr, nStr);\r
- END;\r
- recX.clsD := cRef;\r
- IF valR & ~(Sy.isFn IN t.xAttr) THEN\r
- DoBoxRef(os, t, xAsm.AddClass(aStr, boxedName(t)));\r
- END;\r
- END;\r
-\r
- IF ~noNw & ~valR THEN\r
- recX.newD := getOrAddMethod(cRef, ctorS, voidD, NIL);\r
- recX.newD.AddCallConv(Api.CallConv.Instance);\r
- END;\r
- END;\r
- END MkRecX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkVecX*(t : Sy.Type; m : Id.BlkId);\r
- VAR xAsm : Api.AssemblyRef;\r
- recX : RecXtn;\r
- nStr : RTS.NativeString; (* record name string *)\r
- aStr : RTS.NativeString; (* imported namespace *)\r
- cRef : Api.ClassRef;\r
- BEGIN\r
- NEW(recX);\r
- t.tgXtn := recX;\r
-\r
- IF m.tgXtn = NIL THEN os.DoRtsMod(m) END;\r
- IF t.xName = NIL THEN Mu.MkTypeName(t, os) END;\r
-\r
- aStr := MKSTR(m.xName^);\r
- nStr := MKSTR(t.xName^);\r
-\r
- xAsm := os.asm(m);\r
- cRef := xAsm.AddClass(aStr, nStr);\r
- recX.clsD := cRef;\r
- recX.newD := cRef.AddMethod(ctorS, voidD, NIL);\r
- recX.newD.AddCallConv(Api.CallConv.Instance);\r
- END MkVecX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkDelX(t : Ty.Procedure;\r
- s : Sy.Scope),NEW;\r
- (* -------------------------------- *)\r
- CONST dAtt = Asm.att_public + Asm.att_sealed;\r
- VAR xtn : DelXtn; (* The created descriptor *)\r
- str : RTS.NativeString; (* The proc-type nameString *)\r
- att : Api.TypeAttr; (* public,sealed (for Def) *)\r
- asN : RTS.NativeString; (* Assembly name (for Ref) *)\r
- asR : Api.AssemblyRef; (* Assembly ref (for Ref) *)\r
- rtT : Sy.Type; (* AST return type of proc *)\r
- rtD : Api.Type; (* Api return type of del. *)\r
- clD : Api.ClassDef;\r
- clR : Api.ClassRef;\r
- mtD : Api.MethodDef;\r
- (* -------------------------------- *)\r
- PROCEDURE t2() : POINTER TO ARRAY OF Api.Type;\r
- VAR a : POINTER TO ARRAY OF Api.Type;\r
- BEGIN \r
- NEW(a,2); a[0] := objtD; a[1] := nIntD; RETURN a; \r
- END t2;\r
- (* -------------------------------- *)\r
- PROCEDURE p2() : POINTER TO ARRAY OF Api.Param;\r
- VAR a : POINTER TO ARRAY OF Api.Param;\r
- BEGIN\r
- NEW(a,2);\r
- a[0] := Api.Param.init(0, "obj", objtD); \r
- a[1] := Api.Param.init(0, "mth", nIntD); \r
- RETURN a;\r
- END p2;\r
- (* -------------------------------- *)\r
- PROCEDURE tArr(t: Ty.Procedure; o: PeFile) : POINTER TO ARRAY OF Api.Type;\r
- VAR a : POINTER TO ARRAY OF Api.Type;\r
- i : INTEGER;\r
- p : Id.ParId;\r
- d : Api.Type;\r
- BEGIN\r
- NEW(a, t.formals.tide);\r
- FOR i := 0 TO t.formals.tide-1 DO\r
- p := t.formals.a[i];\r
- d := o.typ(p.type);\r
- IF Mu.takeAdrs(p) THEN \r
- p.boxOrd := p.parMod;\r
- d := Api.ManagedPointer.init(d);\r
- END; \r
- a[i] := d; \r
- END;\r
- RETURN a;\r
- END tArr;\r
- (* -------------------------------- *)\r
- PROCEDURE pArr(t: Ty.Procedure; o: PeFile) : POINTER TO ARRAY OF Api.Param;\r
- VAR a : POINTER TO ARRAY OF Api.Param;\r
- i : INTEGER;\r
- p : Id.ParId;\r
- d : Api.Type;\r
- BEGIN\r
- NEW(a, t.formals.tide);\r
- FOR i := 0 TO t.formals.tide-1 DO\r
- p := t.formals.a[i];\r
- d := o.typ(p.type);\r
- IF Mu.takeAdrs(p) THEN \r
- p.boxOrd := p.parMod;\r
- d := Api.ManagedPointer.init(d);\r
- END; \r
- a[i] := Api.Param.init(0, nms(p), d); \r
- END;\r
- RETURN a;\r
- END pArr;\r
- (* -------------------------------- *)\r
- BEGIN\r
- IF t.tgXtn # NIL THEN RETURN END;\r
- NEW(xtn);\r
- str := MKSTR(Sy.getName.ChPtr(t.idnt)^);\r
- rtT := t.retType;\r
- IF rtT = NIL THEN rtD := voidD ELSE rtD := os.typ(rtT) END;\r
-\r
- IF s.kind # Id.impId THEN (* this is a classDEF *)\r
- att := toTypeAttr(dAtt);\r
- clD := os.peFl.AddClass(att, os.nmSp, str, os.mcd());\r
- mtD := clD.AddMethod(ctorS, voidD, p2());\r
- mtD.AddMethAttribute(ctAtt);\r
- mtD.AddImplAttribute(rmAtt);\r
- xtn.newD := mtD;\r
- mtD := clD.AddMethod(invkS, rtD, pArr(t, os));\r
- mtD.AddMethAttribute(Api.MethAttr.Public);\r
- mtD.AddImplAttribute(rmAtt);\r
- xtn.invD := mtD;\r
- xtn.clsD := clD;\r
- ELSE (* this is a classREF *)\r
- asR := os.asm(s(Id.BlkId));\r
- asN := MKSTR(s(Id.BlkId).xName^);\r
- clR := getOrAddClass(asR, asN, str);\r
- xtn.newD := clR.AddMethod(ctorS, voidD, t2());\r
- xtn.invD := clR.AddMethod(invkS, rtD, tArr(t, os));\r
- xtn.clsD := clR;\r
- END;\r
- xtn.newD.AddCallConv(Api.CallConv.Instance);\r
- xtn.invD.AddCallConv(Api.CallConv.Instance);\r
- t.tgXtn := xtn;\r
- IF (t.idnt # NIL) & (t.idnt.tgXtn = NIL) THEN t.idnt.tgXtn := xtn END;\r
- END MkDelX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkPtrX*(t : Ty.Pointer);\r
- VAR bTyp : Sy.Type;\r
- recX : RecXtn;\r
- BEGIN\r
- bTyp := t.boundTp;\r
- IF bTyp.tgXtn = NIL THEN Mu.MkTypeName(bTyp, os) END;\r
- WITH bTyp : Ty.Record DO\r
- recX := bTyp.tgXtn(RecXtn);\r
- IF recX.boxD # NIL THEN t.tgXtn := recX.boxD;\r
- ELSE t.tgXtn := recX.clsD;\r
- END;\r
- | bTyp : Ty.Array DO\r
- t.tgXtn := bTyp.tgXtn;\r
- END;\r
- END MkPtrX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkArrX*(t : Ty.Array);\r
- BEGIN\r
- t.tgXtn := Api.ZeroBasedArray.init(os.typ(t.elemTp));\r
- END MkArrX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkBasX*(t : Ty.Base);\r
- BEGIN\r
- CASE t.tpOrd OF\r
- | Ty.uBytN : t.tgXtn := Api.PrimitiveType.UInt8;\r
- | Ty.byteN : t.tgXtn := Api.PrimitiveType.Int8;\r
- | Ty.sIntN : t.tgXtn := Api.PrimitiveType.Int16;\r
- | Ty.intN,Ty.setN : t.tgXtn := Api.PrimitiveType.Int32;\r
- | Ty.lIntN : t.tgXtn := Api.PrimitiveType.Int64;\r
- | Ty.boolN : t.tgXtn := Api.PrimitiveType.Boolean;\r
- | Ty.charN,Ty.sChrN : t.tgXtn := Api.PrimitiveType.Char;\r
- | Ty.realN : t.tgXtn := Api.PrimitiveType.Float64;\r
- | Ty.sReaN : t.tgXtn := Api.PrimitiveType.Float32;\r
- | Ty.anyRec,Ty.anyPtr : t.tgXtn := Api.PrimitiveType.Object;\r
- END;\r
- END MkBasX;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)MkEnuX*(t : Ty.Enum; s : Sy.Scope);\r
- VAR scNs : RTS.NativeString;\r
- enNm : RTS.NativeString;\r
- BEGIN\r
- ASSERT(s.kind = Id.impId);\r
- scNs := MKSTR(s(Id.BlkId).xName^);\r
- enNm := MKSTR(Sy.getName.ChPtr(t.idnt)^);\r
- t.tgXtn := getOrAddValueClass(os.asm(s(Id.BlkId)), scNs, enNm);\r
- END MkEnuX;\r
-\r
-(* ============================================================ *)\r
-(*\r
- PROCEDURE (os : PeFile)MkTyXtn*(t : Sy.Type; s : Sy.Scope);\r
- BEGIN\r
- IF t.tgXtn # NIL THEN RETURN END;\r
- WITH t : Ty.Record DO os.MkRecX(t, s);\r
- | t : Ty.Enum DO os.MkEnuX(t, s);\r
- | t : Ty.Procedure DO os.MkDelX(t, s);\r
- | t : Ty.Base DO os.MkBasX(t);\r
- | t : Ty.Pointer DO os.MkPtrX(t);\r
- | t : Ty.Array DO os.MkArrX(t);\r
- END;\r
- END MkTyXtn;\r
- *)\r
-(* ============================================================ *)\r
-\r
- PROCEDURE MkMthDef(os : PeFile;\r
- xhr : BOOLEAN;\r
- pTp : Ty.Procedure;\r
- cls : Api.ClassDef;\r
- str : RTS.NativeString) : Api.MethodDef;\r
- VAR par : Id.ParId;\r
- prd : Api.Type;\r
- prs : POINTER TO ARRAY OF Api.Param;\r
- rtT : Sy.Type;\r
- rtd : Api.Type;\r
- pId : Sy.Idnt;\r
-\r
- idx : INTEGER; (* index into formal array *)\r
- prX : INTEGER; (* index into param. array *)\r
- prO : INTEGER; (* runtime ordinal of arg. *)\r
- num : INTEGER; (* length of formal array *)\r
- len : INTEGER; (* length of param array *)\r
- BEGIN\r
- pId := pTp.idnt;\r
- IF (pId # NIL) & (pId IS Id.MthId) & (Id.covar IN pId(Id.MthId).mthAtt) THEN \r
- rtT := pId(Id.MthId).retTypBound();\r
- ELSE\r
- rtT := pTp.retType;\r
- END;\r
- num := pTp.formals.tide;\r
- IF xhr THEN len := num + 1 ELSE len := num END;\r
- NEW(prs, len);\r
- IF rtT = NIL THEN rtd := voidD ELSE rtd := os.typ(rtT) END;\r
-\r
- prO := pTp.argN; (* count from 1 if xhr OR has this *)\r
- IF xhr THEN\r
- prs[0] := Api.Param.init(0, "", xhrCl); prX := 1;\r
- ELSE\r
- prX := 0;\r
- END;\r
- FOR idx := 0 TO num-1 DO\r
- par := pTp.formals.a[idx];\r
- par.varOrd := prO; \r
- prd := os.typ(par.type);\r
- IF Mu.takeAdrs(par) THEN \r
- par.boxOrd := par.parMod;\r
- prd := Api.ManagedPointer.init(prd);\r
- IF Id.uplevA IN par.locAtt THEN \r
- par.boxOrd := Sy.val;\r
- ASSERT(Id.cpVarP IN par.locAtt);\r
- END;\r
- END; (* just mark *)\r
- prs[prX] := Api.Param.init(par.boxOrd, nms(par), prd); \r
- INC(prX); INC(prO);\r
- END;\r
- (*\r
- * Add attributes, Impl, Meth, CallConv in MethodDecl()\r
- *)\r
- RETURN cls.AddMethod(str, rtd, prs);\r
- END MkMthDef;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE MkMthRef(os : PeFile;\r
- pTp : Ty.Procedure;\r
- cls : Api.ClassRef;\r
- str : RTS.NativeString) : Api.MethodRef;\r
- VAR par : Id.ParId;\r
- tpD : Api.Type;\r
- prs : POINTER TO ARRAY OF Api.Type;\r
- rtT : Sy.Type;\r
- rtd : Api.Type;\r
- pId : Sy.Idnt;\r
-\r
- idx : INTEGER; (* index into formal array *)\r
- prO : INTEGER; (* runtime ordinal of arg. *)\r
- num : INTEGER; (* length of formal array *)\r
- BEGIN\r
- pId := pTp.idnt;\r
- IF (pId # NIL) & (pId IS Id.MthId) & (Id.covar IN pId(Id.MthId).mthAtt) THEN \r
- rtT := pId(Id.MthId).retTypBound();\r
- ELSE\r
- rtT := pTp.retType;\r
- END;\r
- num := pTp.formals.tide;\r
- NEW(prs, num);\r
- IF rtT = NIL THEN rtd := voidD ELSE rtd := os.typ(rtT) END;\r
-\r
- prO := pTp.argN;\r
- FOR idx := 0 TO num-1 DO\r
- par := pTp.formals.a[idx];\r
- tpD := os.typ(par.type);\r
- par.varOrd := prO; (* if hasThis, then is (idx+1) *)\r
- IF Mu.takeAdrs(par) THEN \r
- par.boxOrd := par.parMod;\r
- tpD := Api.ManagedPointer.init(tpD);\r
- END; (* just mark *)\r
- prs[idx] := tpD; INC(prO);\r
- END;\r
- RETURN getOrAddMethod(cls, str, rtd, prs);\r
- END MkMthRef;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)NumberParams*(pId : Id.Procs; \r
- pTp : Ty.Procedure);\r
- (*\r
- * (1) Generate signature information for this procedure\r
- * (2) Generate the target extension Method(Def | Ref)\r
- *)\r
- VAR class : Api.Class;\r
- methD : Api.Method;\r
- namSt : RTS.NativeString;\r
- xhrMk : BOOLEAN;\r
- pLeng : INTEGER;\r
- (* ----------------- *)\r
- PROCEDURE classOf(os : PeFile; id : Id.Procs) : Api.Class;\r
- VAR scp : Sy.Scope;\r
- BEGIN\r
- scp := id.dfScp;\r
- (*\r
- * Check for methods bound to explicit classes\r
- *)\r
- IF id.bndType # NIL THEN RETURN os.cls(id.bndType(Ty.Record)) END;\r
- (*\r
- * Or associate static methods with the dummy class\r
- *)\r
- WITH scp : Id.BlkId DO\r
- RETURN os.dsc(scp);\r
- | scp : Id.Procs DO (* Nested procs take class from scope *)\r
- RETURN classOf(os, scp);\r
- END;\r
- END classOf;\r
- (* ----------------- *)\r
- BEGIN\r
- IF pId = NIL THEN \r
- os.MkDelX(pTp, pTp.idnt.dfScp); RETURN; (* PREMATURE RETURN HERE *)\r
- END;\r
- IF pId.tgXtn # NIL THEN RETURN END; (* PREMATURE RETURN HERE *)\r
-\r
- class := classOf(os, pId); \r
- namSt := MKSTR(pId.prcNm^);\r
- xhrMk := pId.lxDepth > 0;\r
- (*\r
- * The incoming argN counts one for a receiver,\r
- * and also counts one for nested procedures.\r
- *)\r
- IF pId IS Id.MthId THEN pLeng := pTp.argN-1 ELSE pLeng := pTp.argN END;\r
- (*\r
- * Now create either a MethodDef or MethodRef\r
- *)\r
- WITH class : Api.ClassDef DO\r
- methD := MkMthDef(os, xhrMk, pTp, class, namSt);\r
- | class : Api.ClassRef DO\r
- methD := MkMthRef(os, pTp, class, namSt);\r
- END;\r
- INC(pTp.argN, pTp.formals.tide);\r
- IF pTp.retType # NIL THEN pTp.retN := 1 END;\r
- IF (pId.kind = Id.ctorP) OR\r
- (pId IS Id.MthId) THEN methD.AddCallConv(Api.CallConv.Instance) END;\r
-\r
- pId.tgXtn := methD;\r
- pTp.xName := cln2; (* an arbitrary "done" marker *)\r
-\r
- IF (pId.kind = Id.fwdPrc) OR (pId.kind = Id.fwdMth) THEN\r
- pId.resolve.tgXtn := methD;\r
- END;\r
- END NumberParams;\r
- \r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)SwitchHead*(num : INTEGER);\r
- BEGIN\r
- switch.next := 0;\r
- NEW(switch.list, num);\r
- END SwitchHead;\r
-\r
- PROCEDURE (os : PeFile)SwitchTail*();\r
- BEGIN\r
- os.pePI.code.Switch(switch.list);\r
- switch.list := NIL;\r
- END SwitchTail;\r
-\r
- PROCEDURE (os : PeFile)LstLab*(l : Mu.Label);\r
- BEGIN\r
- WITH l : PeLab DO\r
- switch.list[switch.next] := l.labl; \r
- INC(switch.next);\r
- END;\r
- END LstLab;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)mth(pId : Id.Procs) : Api.Method,NEW;\r
- BEGIN\r
- ASSERT(pId.tgXtn # NIL);\r
- RETURN pId.tgXtn(Api.Method);\r
- END mth;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)fld(fId : Id.AbVar) : Api.Field,NEW;\r
- VAR cDf : Api.Class;\r
- fNm : Lv.CharOpen;\r
- obj : ANYPTR;\r
- (* ---------------- *)\r
- PROCEDURE AddField(os : PeFile;\r
- cl : Api.Class; \r
- fn : Lv.CharOpen; \r
- ty : Sy.Type) : Api.Field;\r
- VAR fs : RTS.NativeString;\r
- BEGIN\r
- fs := MKSTR(fn^);\r
- WITH cl : Api.ClassDef DO\r
- RETURN cl.AddField(fs, os.typ(ty));\r
- | cl : Api.ClassRef DO\r
- RETURN getOrAddField(cl, fs, os.typ(ty));\r
- END;\r
- END AddField;\r
- (* ---------------- *)\r
- BEGIN\r
- IF fId.tgXtn = NIL THEN\r
- WITH fId : Id.VarId DO\r
- IF fId.varNm = NIL THEN Mu.MkVarName(fId,os) END;\r
- IF fId.recTyp = NIL THEN (* module variable *)\r
- cDf := os.dsc(fId.dfScp(Id.BlkId));\r
- ELSE (* static field *)\r
- cDf := os.cls(fId.recTyp(Ty.Record));\r
- END;\r
- fNm := fId.varNm;\r
- | fId : Id.FldId DO\r
- IF fId.fldNm = NIL THEN Mu.MkFldName(fId,os) END;\r
- cDf := os.cls(fId.recTyp(Ty.Record));\r
- fNm := fId.fldNm;\r
- END;\r
- fId.tgXtn := AddField(os, cDf, fNm, fId.type);\r
- END;\r
- obj := fId.tgXtn;\r
- WITH obj : Api.Field DO RETURN obj;\r
- | obj : EvtXtn DO RETURN obj.fldD;\r
- END;\r
- END fld;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)add(fId : Id.AbVar) : Api.Method,NEW;\r
- BEGIN (* returns the descriptor of add_<fieldname> *)\r
- IF (fId.tgXtn = NIL) OR ~(fId.tgXtn IS EvtXtn) THEN MkAddRem(os, fId) END;\r
- RETURN fId.tgXtn(EvtXtn).addD;\r
- END add;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)rem(fId : Id.AbVar) : Api.Method,NEW;\r
- BEGIN (* returns the descriptor of remove_<fieldname> *)\r
- IF (fId.tgXtn = NIL) OR ~(fId.tgXtn IS EvtXtn) THEN MkAddRem(os, fId) END;\r
- RETURN fId.tgXtn(EvtXtn).remD;\r
- END rem;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)asm(bId : Id.BlkId) : Api.AssemblyRef,NEW;\r
- BEGIN (* returns the assembly reference of this module *)\r
- IF bId.tgXtn = NIL THEN os.DoExtern(bId) END;\r
- RETURN bId.tgXtn(BlkXtn).asmD;\r
- END asm;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)dsc(bId : Id.BlkId) : Api.Class,NEW;\r
- BEGIN (* returns descriptor of dummy static class of this module *)\r
- IF bId.tgXtn = NIL THEN os.DoExtern(bId) END;\r
- RETURN bId.tgXtn(BlkXtn).dscD;\r
- END dsc;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)cls(rTy : Ty.Record) : Api.Class,NEW;\r
- BEGIN (* returns descriptor for this class *)\r
- IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;\r
- RETURN rTy.tgXtn(RecXtn).clsD;\r
- END cls;\r
-\r
-(* -------------------------------- *)\r
-(*\r
- * PROCEDURE (os : PeFile)box(rTy : Ty.Record) : Api.Class,NEW;\r
- * BEGIN\r
- * IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;\r
- * RETURN rTy.tgXtn(RecXtn).boxD;\r
- * END box;\r
- *)\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)new(rTy : Ty.Record) : Api.Method,NEW;\r
- BEGIN (* returns the ctor for this reference class *)\r
- IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;\r
- RETURN rTy.tgXtn(RecXtn).newD;\r
- END new;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)dxt(pTy : Ty.Procedure) : DelXtn,NEW;\r
- BEGIN (* returns the DelXtn extension for this delegate type *)\r
- IF pTy.tgXtn = NIL THEN os.MkDelX(pTy, pTy.idnt.dfScp) END;\r
- RETURN pTy.tgXtn(DelXtn);\r
- END dxt;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE mkCopyDef(cDf : Api.ClassDef; val : BOOLEAN) : Api.Method;\r
- VAR pra : POINTER TO ARRAY OF Api.Param;\r
- prd : Api.Type;\r
- BEGIN\r
- NEW(pra, 1);\r
- prd := cDf;\r
- IF val THEN prd := Api.ManagedPointer.init(prd) END;\r
- pra[0] := Api.Param.init(0, "src", prd);\r
- RETURN cDf.AddMethod(copyS, voidD, pra);\r
- END mkCopyDef;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)cpy(rTy : Ty.Record) : Api.Method,NEW;\r
- VAR tXtn : RecXtn;\r
- tCls : Api.Class;\r
- mthX : Api.Method;\r
- typA : POINTER TO ARRAY OF Api.Type;\r
- valR : BOOLEAN;\r
- BEGIN\r
- tXtn := rTy.tgXtn(RecXtn);\r
- tCls := tXtn.clsD;\r
- IF tXtn.cpyD = NIL THEN\r
- valR := Mu.isValRecord(rTy);\r
- WITH tCls : Api.ClassDef DO\r
- mthX := mkCopyDef(tCls, valR);\r
- | tCls : Api.ClassRef DO\r
- NEW(typA, 1);\r
- IF valR THEN \r
- typA[0] := Api.ManagedPointer.init(tCls);\r
- ELSE\r
- typA[0] := tCls;\r
- END;\r
- mthX := tCls.AddMethod(copyS, voidD, typA);\r
- mthX.AddCallConv(Api.CallConv.Instance);\r
- END;\r
- tXtn.cpyD := mthX;\r
- ELSE\r
- mthX := tXtn.cpyD;\r
- END;\r
- RETURN mthX;\r
- END cpy;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)vDl(rTy : Ty.Record) : Api.Field,NEW;\r
- BEGIN (* returns descriptor of field "v$" for this boxed value type *)\r
- IF rTy.tgXtn = NIL THEN Mu.MkRecName(rTy, os) END;\r
- RETURN rTy.tgXtn(RecXtn).vDlr;\r
- END vDl;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)RescueOpaque(tTy : Sy.Type),NEW;\r
- VAR blk : Id.BlkId;\r
- ext : BlkXtn;\r
- BEGIN\r
- blk := tTy.idnt.dfScp(Id.BlkId);\r
- os.DoExtern(blk);\r
- ext := blk.tgXtn(BlkXtn);\r
- (* Set tgXtn to a ClassRef *)\r
- tTy.tgXtn := getOrAddClass(ext.asmD, MKSTR(blk.xName^), MKSTR(Sy.getName.ChPtr(tTy.idnt)^));\r
- RESCUE (any)\r
- (* Just leave tgXtn = NIL *)\r
- END RescueOpaque;\r
-\r
-(* -------------------------------- *)\r
-\r
- PROCEDURE (os : PeFile)typ(tTy : Sy.Type) : Api.Type,NEW;\r
- VAR xtn : ANYPTR;\r
- BEGIN (* returns Api.Type descriptor for this type *)\r
- IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;\r
- IF (tTy IS Ty.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(Ty.Opaque)) END;\r
- xtn := tTy.tgXtn;\r
- IF xtn = NIL THEN\r
- IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName);\r
- ELSE tTy.TypeError(236);\r
- END;\r
- RTS.Throw("Opaque Type Error");\r
- END;\r
- WITH xtn : Api.Type DO\r
- RETURN xtn;\r
- | xtn : RecXtn DO\r
- RETURN xtn.clsD;\r
- | xtn : DelXtn DO\r
- RETURN xtn.clsD;\r
- END;\r
- END typ;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)mcd() : Api.ClassRef,NEW;\r
- BEGIN (* returns System.MulticastDelegate *)\r
- IF multiCD = NIL THEN \r
- multiCD := getOrAddClass(corlib, "System", "MulticastDelegate");\r
- END;\r
- RETURN multiCD;\r
- END mcd;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)del() : Api.ClassRef,NEW;\r
- BEGIN (* returns System.Delegate *)\r
- IF delegat = NIL THEN \r
- delegat := getOrAddClass(corlib, "System", "Delegate");\r
- END;\r
- RETURN delegat;\r
- END del;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)rmv() : Api.MethodRef,NEW;\r
- VAR prs : POINTER TO ARRAY OF Api.Type;\r
- dlg : Api.ClassRef;\r
- BEGIN (* returns System.Delegate::Remove *)\r
- IF remove = NIL THEN \r
- dlg := os.del();\r
- NEW(prs, 2);\r
- prs[0] := dlg; \r
- prs[1] := dlg;\r
- remove := dlg.AddMethod("Remove", dlg, prs);\r
- END;\r
- RETURN remove;\r
- END rmv;\r
-\r
-(* ============================================================ *)\r
-\r
- PROCEDURE (os : PeFile)cmb() : Api.MethodRef,NEW;\r
- VAR prs : POINTER TO ARRAY OF Api.Type;\r
- dlg : Api.ClassRef;\r
- BEGIN (* returns System.Delegate::Combine *)\r
- IF combine = NIL THEN \r
- dlg := os.del();\r
- NEW(prs, 2);\r
- prs[0] := dlg; \r
- prs[1] := dlg;\r
- combine := dlg.AddMethod("Combine", dlg, prs);\r
- END;\r
- RETURN combine;\r
- END cmb;\r
-\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-BEGIN\r
- evtAdd := Lv.strToCharOpen("add_"); \r
- evtRem := Lv.strToCharOpen("remove_"); \r
- cln2 := Lv.strToCharOpen("::"); \r
- boxedObj := Lv.strToCharOpen("Boxed_"); \r
-\r
- vfldS := MKSTR("v$");\r
- ctorS := MKSTR(".ctor");\r
- invkS := MKSTR("Invoke");\r
- copyS := MKSTR("__copy__");\r
-END PeUtil.\r
-(* ============================================================ *)\r
-(* ============================================================ *)\r
-\r
diff --git a/gpcp/PeUtilForNET.cp b/gpcp/PeUtilForNET.cp
index 246f1fc371d74934a8e330120fce015871215837..e7f26daa677bd26ccaba17161b90c6d55fa6babd 100644 (file)
--- a/gpcp/PeUtilForNET.cp
+++ b/gpcp/PeUtilForNET.cp
VAR xtn : ANYPTR;\r
BEGIN (* returns Api.Type descriptor for this type *)\r
IF tTy.tgXtn = NIL THEN Mu.MkTypeName(tTy, os) END;\r
- IF (tTy IS TypeDesc.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(TypeDesc.Opaque)) END;\r
+ IF (tTy IS Ty.Opaque) & (tTy.tgXtn = NIL) THEN os.RescueOpaque(tTy(Ty.Opaque)) END;\r
xtn := tTy.tgXtn;\r
IF xtn = NIL THEN\r
IF tTy.xName # NIL THEN tTy.TypeErrStr(236, tTy.xName);\r
diff --git a/libs/cpascal/JvmMakeAll.bat b/libs/cpascal/JvmMakeAll.bat
+++ /dev/null
@@ -1,25 +0,0 @@
-\r
-call cprun gpcp -special ASCII.cp\r
-call cprun gpcp -special Console.cp\r
-call cprun gpcp -special CPmain.cp\r
-call cprun gpcp -special Error.cp\r
-call cprun gpcp -special GPBinFiles.cp\r
-call cprun gpcp -special GPFiles.cp\r
-call cprun gpcp -special GPTextFiles.cp\r
-call cprun gpcp -special ProgArgs.cp\r
-call cprun gpcp -special RTS.cp\r
-call cprun gpcp -special StdIn.cp\r
-call cprun gpcp RealStr.cp\r
-call cprun gpcp StringLib.cp\r
-call cprun Browse -html -sort ASCII.cps\r
-call cprun Browse -html -sort Console.cps\r
-call cprun Browse -html -sort Error.cps\r
-call cprun Browse -html -sort GPFiles.cps\r
-call cprun Browse -html -sort GPBinFiles.cps\r
-call cprun Browse -html -sort GPTextFiles.cps\r
-call cprun Browse -html -sort ProgArgs.cps\r
-call cprun Browse -html -sort RTS.cps\r
-call cprun Browse -html -sort StdIn.cps\r
-call cprun Browse -html -sort RealStr.cps\r
-call cprun Browse -html -sort StringLib.cps\r
-\r
diff --git a/libs/cpascal/MakeAll.bat b/libs/cpascal/MakeAll.bat
--- a/libs/cpascal/MakeAll.bat
+++ /dev/null
@@ -1,26 +0,0 @@
-gpcp /special ASCII.cp\r
-gpcp /special Console.cp\r
-gpcp /special CPmain.cp\r
-gpcp /special Error.cp\r
-gpcp /special GPBinFiles.cp\r
-gpcp /special GPFiles.cp\r
-gpcp /special GPTextFiles.cp\r
-gpcp /special ProgArgs.cp\r
-gpcp /special RTS.cp\r
-gpcp /special StdIn.cp\r
-gpcp /special WinMain.cp\r
-gpcp /special STA.cp\r
-gpcp RealStr.cp\r
-gpcp StringLib.cp\r
-Browse /html /sort ASCII.cps\r
-Browse /html /sort Console.cps\r
-Browse /html /sort Error.cps\r
-Browse /html /sort GPFiles.cps\r
-Browse /html /sort GPBinFiles.cps\r
-Browse /html /sort GPTextFiles.cps\r
-Browse /html /sort ProgArgs.cps\r
-Browse /html /sort RTS.cps\r
-Browse /html /sort StdIn.cps\r
-Browse /html /sort RealStr.cps\r
-Browse /html /sort StringLib.cps\r
-\r
diff --git a/libs/cpascal/Makefile b/libs/cpascal/Makefile
--- /dev/null
+++ b/libs/cpascal/Makefile
@@ -0,0 +1,16 @@
+jvm:
+ cprun gpcp -special ASCII.cp
+ cprun gpcp -special Console.cp
+ cprun gpcp -special CPmain.cp
+ cprun gpcp -special Error.cp
+ cprun gpcp -special GPBinFiles.cp
+ cprun gpcp -special GPFiles.cp
+ cprun gpcp -special GPTextFiles.cp
+ cprun gpcp -special ProgArgs.cp
+ cprun gpcp -special RTS.cp
+ cprun gpcp -special StdIn.cp
+ cprun gpcp RealStr.cp
+ cprun gpcp StringLib.cp
+
+clean:
+ rm -rf CP *.cps *.lst
\ No newline at end of file
diff --git a/libs/java/MakeAll.bat b/libs/java/MakeAll.bat
--- a/libs/java/MakeAll.bat
+++ /dev/null
@@ -1,26 +0,0 @@
-@echo off\r
-REM this compiles all of the standard java-sourced libraries for GPCP\r
-javac -d . Console.java\r
-javac -d . CPJ.java\r
-javac -d . CPJrts.java\r
-javac -d . XHR.java\r
-javac -d . CPmain.java\r
-javac -d . Error.java\r
-javac -d . GPFiles_FILE.java\r
-javac -d . GPFiles.java\r
-javac -d . GPBinFiles_FILE.java\r
-javac -d . GPBinFiles.java\r
-javac -d . GPTextFiles_FILE.java\r
-javac -d . GPTextFiles.java\r
-javac -d . ProcType.java\r
-javac -d . ProgArgs.java\r
-javac -d . RTS.java\r
-javac -d . StdIn.java\r
-javac -d . VecBase.java\r
-javac -d . VecChr.java\r
-javac -d . VecI32.java\r
-javac -d . VecI64.java\r
-javac -d . VecR32.java\r
-javac -d . VecR64.java\r
-javac -d . VecBase.java\r
-javac -d . VecRef.java\r
diff --git a/libs/java/Makefile b/libs/java/Makefile
--- /dev/null
+++ b/libs/java/Makefile
@@ -0,0 +1,5 @@
+all:
+ javac -d . *.java
+
+clean:
+ rm -rf CP
\ No newline at end of file