Skip to content

Commit 29ad2f9

Browse files
vincentparrettvincentparrett
committed
Prep work for 64bit
1 parent 2adfbd7 commit 29ad2f9

12 files changed

Lines changed: 184 additions & 174 deletions

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,3 +67,4 @@ Source/IDE/EditorView/__recovery
6767
Packages
6868
Source/DSpecCreator/__recovery
6969
*.user
70+
*.dll

‎Source/Core/Compiler/DPM.Core.Compiler.EnvironmentProvider.pas‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,7 @@ TCompilerEnvironmentProvider = class(TInterfacedObject, ICompilerEnvironmentPr
4848
FRsVarFiles : array[TCompilerVersion.UnknownVersion..TCompilerVersion.RS12_0] of string;
4949
protected
5050
function FoundCompilerInfo(const compilerVersion : TCompilerVersion) : Boolean;
51-
function GetRsVarsFilePath(const compilerVersion : TCompilerVersion) : string;
51+
function GetRsVarsFilePath(const platform : TDPMPlatform; const compilerVersion : TCompilerVersion) : string;
5252

5353
public
5454
constructor Create(const logger : ILogger);
@@ -60,7 +60,8 @@ implementation
6060
uses
6161
System.Win.Registry,
6262
System.SysUtils,
63-
WinApi.Windows;
63+
WinApi.Windows,
64+
DPM.Core.Utils.System;
6465

6566

6667
{ TCompilerEnvironmentProvider }
@@ -80,7 +81,7 @@ function TCompilerEnvironmentProvider.FoundCompilerInfo(const compilerVersion :
8081
result := FFound[compilerVersion] = TStatus.found;
8182
end;
8283

83-
function TCompilerEnvironmentProvider.GetRsVarsFilePath(const compilerVersion : TCompilerVersion) : string;
84+
function TCompilerEnvironmentProvider.GetRsVarsFilePath(const platform : TDPMPlatform; const compilerVersion : TCompilerVersion) : string;
8485
var
8586
bdsVersion : string;
8687
key : string;
@@ -100,15 +101,17 @@ function TCompilerEnvironmentProvider.GetRsVarsFilePath(const compilerVersion :
100101
begin
101102
bdsVersion := CompilerToBDSVersion(compilerVersion);
102103
key := 'Software\Embarcadero\BDS\%s';
103-
104104
key := Format(key, [bdsVersion]);
105105

106106
reg := TRegistry.Create(KEY_READ);
107107
try
108-
reg.RootKey := HKEY_LOCAL_MACHINE;
108+
reg.RootKey := HKEY_CURRENT_USER;
109+
FLogger.Debug('Attempting to open ' + key);
109110
if reg.OpenKey(key, False) then
110111
begin
112+
FLogger.Debug('Reading RootDir');
111113
rootDir := reg.ReadString('RootDir');
114+
FLogger.Debug('RootDir : ' + rootDir);
112115
if rootDir = '' then
113116
begin
114117
FLogger.Error('Unable to find install location for compiler [' + CompilerToString(compilerVersion) + ']');
@@ -127,7 +130,10 @@ function TCompilerEnvironmentProvider.GetRsVarsFilePath(const compilerVersion :
127130
finally
128131
reg.Free;
129132
end;
130-
FRsVarFiles[compilerVersion] := IncludeTrailingPathDelimiter(rootDir) + 'bin\rsvars.bat';
133+
if TSystemUtils.Is64BitIDE then
134+
FRsVarFiles[compilerVersion] := IncludeTrailingPathDelimiter(rootDir) + 'bin64\rsvars64.bat'
135+
else
136+
FRsVarFiles[compilerVersion] := IncludeTrailingPathDelimiter(rootDir) + 'bin\rsvars.bat';
131137
result := FRsVarFiles[compilerVersion];
132138
FFound[compilerVersion] := TStatus.found;
133139
end;

‎Source/Core/Compiler/DPM.Core.Compiler.Interfaces.pas‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,7 @@ interface
6262

6363
function GetCompilerOutput : TStrings;
6464

65-
function BuildProject(const cancellationToken : ICancellationToken; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean = false) : boolean;
65+
function BuildProject(const cancellationToken : ICancellationToken; const platform : TDPMPlatform; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean = false) : boolean;
6666

6767
property CompilerVersion : TCompilerVersion read GetCompilerVersion;
6868
property Configuration : string read GetConfiguration write SetConfiguration;
@@ -77,7 +77,7 @@ interface
7777
//inject
7878
ICompilerEnvironmentProvider = interface
7979
['{54814318-551F-4F53-B0FB-66AC0E430DB7}']
80-
function GetRsVarsFilePath(const compilerVersion : TCompilerVersion) : string;
80+
function GetRsVarsFilePath(const platform : TDPMPlatform; const compilerVersion : TCompilerVersion) : string;
8181
end;
8282

8383
//inject

‎Source/Core/Compiler/DPM.Core.Compiler.MSBuild.pas‎

Lines changed: 29 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -76,15 +76,15 @@ TMSBuildCompiler = class(TInterfacedObject, ICompiler)
7676
procedure SetVerbosity(const value : TCompilerVerbosity);
7777

7878

79-
function GetPlatformName : string;
79+
// function GetPlatformName : string;
8080
function GetProjectSearchPath(const configName : string) : string;
8181

8282
function GetCompilerOutput : TStrings;
8383

8484
function GetMSBuildParameters(const configName : string; const packageVersion : TPackageVersion) : string;
85-
function GetCommandLine(const projectFile : string; const configName : string; const packageVersion : TPackageVersion) : string;
85+
function GetCommandLine(const platform : TDPMPlatform; const projectFile : string; const configName : string; const packageVersion : TPackageVersion) : string;
8686

87-
function BuildProject(const cancellationToken : ICancellationToken; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean) : Boolean;
87+
function BuildProject(const cancellationToken : ICancellationToken; const platform : TDPMPlatform; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean) : Boolean;
8888
public
8989
constructor Create(const logger : ILogger; const compilerVersion : TCompilerVersion; const platform : TDPMPlatform; const env : ICompilerEnvironmentProvider);
9090
destructor Destroy; override;
@@ -98,17 +98,19 @@ implementation
9898
System.IOUtils,
9999
DPM.Core.Utils.Path,
100100
DPM.Core.Utils.Process,
101+
DPM.Core.Utils.System,
101102
DPM.Core.Compiler.ProjectSettings;
102103

103104

104105
{ TMSBuildCompiler }
105106

106-
function TMSBuildCompiler.BuildProject(const cancellationToken : ICancellationToken; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean) : Boolean;
107+
function TMSBuildCompiler.BuildProject(const cancellationToken : ICancellationToken; const platform : TDPMPlatform; const projectFile : string; const configName : string; const packageVersion : TPackageVersion; const forDesign : boolean) : Boolean;
107108
var
108109
commandLine : string;
109110
env : IEnvironmentBlock;
110111
i : integer;
111112
begin
113+
112114
result := false;
113115
FBuildForDesign := forDesign;
114116
FCompilerOutput.Clear;
@@ -117,7 +119,7 @@ function TMSBuildCompiler.BuildProject(const cancellationToken : ICancellationTo
117119
FProjectFile := projectFile;
118120

119121
try
120-
commandLine := GetCommandLine(projectFile, configName, packageVersion);
122+
commandLine := GetCommandLine(platform, projectFile, configName, packageVersion);
121123
except
122124
on e : Exception do
123125
begin
@@ -189,11 +191,11 @@ function TMSBuildCompiler.GetBPLOutput : string;
189191
result := FBPLOutput;
190192
end;
191193

192-
function TMSBuildCompiler.GetCommandLine(const projectFile, configName : string; const packageVersion : TPackageVersion) : string;
194+
function TMSBuildCompiler.GetCommandLine(const platform : TDPMPlatform; const projectFile, configName : string; const packageVersion : TPackageVersion) : string;
193195
begin
194196
//I don't like this... but it will do for a start.
195197

196-
result := 'call "' + FEnv.GetRsVarsFilePath(FCompilerVersion) + '"';
198+
result := 'call "' + FEnv.GetRsVarsFilePath(platform, FCompilerVersion) + '"';
197199
result := result + ' & msbuild "' + projectfile + '" ' + GetMSBuildParameters(configName, packageVersion);
198200
result := ' cmd /c ' + result + ' > ' + FCompilerLogFile;
199201
end;
@@ -224,7 +226,7 @@ function TMSBuildCompiler.GetMSBuildParameters(const configName : string; const
224226
//We should investigate updating the dproj.
225227
result := '/target:BuildVersionResource;Build';
226228
result := result + ' /p:Config=' + configName;
227-
if FBuildForDesign then
229+
if FBuildForDesign and (not TSystemUtils.Is64bitIDE) then
228230
result := result + ' /p:Platform=' + DPMPlatformToBDString(TDPMPlatform.Win32)
229231
else
230232
result := result + ' /p:Platform=' + DPMPlatformToBDString(FPlatform);
@@ -275,13 +277,15 @@ function TMSBuildCompiler.GetPlatform : TDPMPlatform;
275277
result := FPlatform;
276278
end;
277279

278-
function TMSBuildCompiler.GetPlatformName: string;
279-
begin
280-
if FBuildForDesign then
281-
result := DPMPlatformToBDString(TDPMPlatform.Win32)
282-
else
283-
result := DPMPlatformToBDString(FPlatform);
284-
end;
280+
//function TMSBuildCompiler.GetPlatformName: string;
281+
//begin
282+
// if FBuildForDesign then
283+
// begin
284+
// result := DPMPlatformToBDString(TDPMPlatform.Win32)
285+
// end
286+
// else
287+
// result := DPMPlatformToBDString(FPlatform);
288+
//end;
285289

286290
function TMSBuildCompiler.GetProjectSearchPath(const configName: string): string;
287291
var
@@ -301,12 +305,20 @@ function TMSBuildCompiler.GetProjectSearchPath(const configName: string): string
301305
end;
302306

303307
if FBuildForDesign then
304-
platform := TDPMPlatform.Win32
308+
begin
309+
if TSystemUtils.Is64BitIDE then
310+
platform := TDPMPlatform.Win64
311+
else
312+
platform := TDPMPlatform.Win32
313+
end
305314
else
306315
platform := FPlatform;
307316

308-
settingsLoader := TDPMProjectSettingsLoader.Create(FProjectFile, configName, platform);
317+
FLogger.Debug('Loading project to get search path : ' + FProjectFile);
318+
settingsLoader := TDPMProjectSettingsLoader.Create(FLogger, FProjectFile, configName, platform);
309319
s := settingsLoader.GetSearchPath;
320+
FLogger.Debug('Project Search Path : ' + s);
321+
310322
if s <> '' then
311323
result := s + ';' + result;
312324

‎Source/Core/Compiler/DPM.Core.Compiler.ProjectSettings.pas‎

Lines changed: 15 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ interface
55
uses
66
System.Classes,
77
DPM.Core.Types,
8+
DPM.Core.Logging,
89
DPM.Core.MSXML;
910

1011
type
@@ -15,6 +16,7 @@ interface
1516

1617
TDPMProjectSettingsLoader = class(TInterfacedObject, IProjectSettingsLoader)
1718
private
19+
FLogger : ILogger;
1820
FConfigKeys : TStringList;
1921
FConfigParents : TStringList;
2022
FConfigName : string;
@@ -27,7 +29,7 @@ TDPMProjectSettingsLoader = class(TInterfacedObject, IProjectSettingsLoader)
2729
function DoGetStringProperty(const configKey, propName, defaultValue: string): string;
2830
function GetSearchPath : string;
2931
public
30-
constructor Create(const projectFile : string; const configName : string; const platform : TDPMPlatform);
32+
constructor Create(const logger : ILogger; const projectFile : string; const configName : string; const platform : TDPMPlatform);
3133
destructor Destroy;override;
3234
end;
3335

@@ -43,10 +45,12 @@ implementation
4345

4446
{ TDOMProjectSettingsLoader }
4547

46-
constructor TDPMProjectSettingsLoader.Create(const projectFile, configName: string; const platform : TDPMPlatform);
48+
constructor TDPMProjectSettingsLoader.Create(const logger : ILogger; const projectFile, configName: string; const platform : TDPMPlatform);
4749
begin
50+
FLogger := logger;
4851
FConfigName := configName;
4952
FXMLDoc := CoDOMDocument60.Create;
53+
FLogger.Debug('Loading project xml');
5054
if not FXMLDoc.load(projectFile) then
5155
raise Exception.Create('Error loading dproj [' + projectFile + '] : ' + FXMLDoc.parseError.reason);
5256
(FXMLDoc as IXMLDOMDocument2).setProperty('SelectionLanguage', 'XPath');
@@ -56,6 +60,7 @@ constructor TDPMProjectSettingsLoader.Create(const projectFile, configName: stri
5660
FConfigParents := TStringList.Create;
5761
FPlatform := DPMPlatformToBDString(platform);
5862

63+
FLogger.Debug('Loading configs');
5964
LoadConfigs;
6065
end;
6166

@@ -164,7 +169,10 @@ function TDPMProjectSettingsLoader.GetStringProperty(const propName, defaultVal
164169
sConfigKey : string;
165170
begin
166171
sConfigKey := FConfigKeys.Values[FConfigName];
167-
result := DoGetStringProperty(sConfigKey, propName, defaultValue);
172+
if sConfigKey <> '' then
173+
result := DoGetStringProperty(sConfigKey, propName, defaultValue)
174+
else
175+
result := '';
168176
end;
169177

170178
procedure TDPMProjectSettingsLoader.LoadConfigs;
@@ -182,7 +190,10 @@ procedure TDPMProjectSettingsLoader.LoadConfigs;
182190
//dproj files.. sometimes the intermediate configs are not present in the dproj
183191
//so we have to fudge things to make the tree correct.
184192
//TODO : find a neater way to do this.
193+
FLogger.Debug('Loading project configs');
185194
configs := FXMLDoc.selectNodes('/def:Project/def:ItemGroup/def:BuildConfiguration');
195+
FLogger.Debug('configs.length : ' + IntToStr(configs.length));
196+
186197
if configs.length > 0 then
187198
begin
188199
for i := 0 to configs.length - 1 do
@@ -209,6 +220,7 @@ procedure TDPMProjectSettingsLoader.LoadConfigs;
209220
end;
210221
end;
211222
end;
223+
FLogger.Debug('ConfigKeys.Count : ' + IntToStr(FConfigKeys.Count));
212224
for i := 0 to FConfigKeys.Count - 1 do
213225
begin
214226
sKey := FConfigKeys.ValueFromIndex[i];

‎Source/Core/Package/DPM.Core.Package.Installer.pas‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -404,7 +404,7 @@ function TPackageInstaller.CompilePackage(const cancellationToken : ICancellatio
404404

405405
FLogger.Information('Building project [' + projectFile + '] for design time...');
406406

407-
result := Compiler.BuildProject(cancellationToken, projectFile, configuration, packageInfo.Version, true);
407+
result := Compiler.BuildProject(cancellationToken, packageInfo.Platform, projectFile, configuration, packageInfo.Version, true);
408408
if result then
409409
FLogger.Success('Project [' + buildEntry.Project + '] build succeeded.')
410410
else
@@ -442,7 +442,7 @@ function TPackageInstaller.CompilePackage(const cancellationToken : ICancellatio
442442
else
443443
Compiler.SetSearchPaths(nil);
444444

445-
result := Compiler.BuildProject(cancellationToken, projectFile, configuration, packageInfo.Version);
445+
result := Compiler.BuildProject(cancellationToken, packageInfo.Platform, projectFile, configuration, packageInfo.Version);
446446
if result then
447447
FLogger.Success('Project [' + buildEntry.Project + '] build succeeded.')
448448
else
@@ -476,7 +476,7 @@ function TPackageInstaller.CompilePackage(const cancellationToken : ICancellatio
476476
else
477477
Compiler.SetSearchPaths(nil);
478478

479-
result := Compiler.BuildProject(cancellationToken, projectFile, buildEntry.config, packageInfo.Version, true);
479+
result := Compiler.BuildProject(cancellationToken, packageInfo.Platform, projectFile, buildEntry.config, packageInfo.Version, true);
480480
if result then
481481
FLogger.Success('Project [' + buildEntry.Project + '] Compiled for designtime Ok.')
482482
else

‎Source/Core/Utils/DPM.Core.Utils.System.pas‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,10 @@ TSystemUtils = class
3636
class function GetVersionString: string;
3737
class procedure GetResourceVersionNumbers(out AMajor, AMinor, ARelease, ABuild: Integer);
3838
class procedure OutputDebugString(const value : string);
39+
class function Is64BitProcess : boolean;
40+
class function IsIDEProcess : boolean;
41+
class function Is64BitIDE : boolean;
42+
class procedure SetIsIDE;
3943
end;
4044

4145
implementation
@@ -44,6 +48,9 @@ implementation
4448
System.SysUtils,
4549
WinApi.Windows;
4650

51+
var
52+
_isIDE : boolean = false;
53+
4754
{ TSystemUtils }
4855

4956
class function TSystemUtils.ExpandEnvironmentStrings(const value : string) : string;
@@ -115,5 +122,30 @@ class procedure TSystemUtils.OutputDebugString(const value: string);
115122
{$ENDIF}
116123
end;
117124

125+
class function TSystemUtils.Is64BitIDE: boolean;
126+
begin
127+
result := _isIDE and Is64BitProcess;
128+
end;
129+
130+
class function TSystemUtils.Is64BitProcess : boolean;
131+
begin
132+
{$IFDEF WIN64}
133+
result := true;
134+
{$ELSE}
135+
result := false;
136+
{$ENDIF}
137+
end;
138+
139+
class function TSystemUtils.IsIDEProcess: boolean;
140+
begin
141+
result := _isIDE;
142+
end;
143+
144+
145+
class procedure TSystemUtils.SetIsIDE;
146+
begin
147+
_isIDE := true;
148+
end;
149+
118150
end.
119151

0 commit comments

Comments
 (0)