Support compiling most of Lazarus + its components with -Sy option.

This commit is contained in:
Juha 2023-05-20 12:18:52 +03:00
parent 21ea45d415
commit 5c1be9de89
7 changed files with 8 additions and 6 deletions

View File

@ -470,7 +470,7 @@ begin
FCodeBase := NtHeaders.W32.OptionalHeader.BaseOfCode; FCodeBase := NtHeaders.W32.OptionalHeader.BaseOfCode;
SectionMax := FFileLoader.LoadMemory( SectionMax := FFileLoader.LoadMemory(
DosHeader.e_lfanew + DosHeader.e_lfanew +
(@NtHeaders.Sys.OptionalHeader - @NtHeaders.Sys) + (Pointer(@NtHeaders.Sys.OptionalHeader) - @NtHeaders.Sys) +
NtHeaders.Sys.FileHeader.SizeOfOptionalHeader, NtHeaders.Sys.FileHeader.SizeOfOptionalHeader,
SizeOf(TImageSectionHeader) * NtHeaders.Sys.FileHeader.NumberOfSections, SizeOf(TImageSectionHeader) * NtHeaders.Sys.FileHeader.NumberOfSections,
SectionHeader SectionHeader

View File

@ -1,6 +1,7 @@
unit TTProfile; unit TTProfile;
{$R-} // TODO: Fix out-of-bounds accesses. {$R-} // TODO: Fix out-of-bounds accesses.
{$T-} // TODO: Fix compilation with -Sy.
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface

View File

@ -15,6 +15,7 @@
} }
unit Masks; unit Masks;
{$T-} // TODO: Fix compilation with -Sy.
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{.$define debug_maskcompiled} {.$define debug_maskcompiled}
{.$define debug_anycharornone} {.$define debug_anycharornone}

View File

@ -390,7 +390,7 @@ begin
Result := PPSVariantPointer(res)^.DataDest; Result := PPSVariantPointer(res)^.DataDest;
end end
else else
Result := @(PPSVariantRecord(res)^.data); Result := PPoint(@(PPSVariantRecord(res)^.data));
if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"'); if typerec.BaseType <> btRecord then raise TEMScriptBadParamException.Create('Invalid result type for "point(x,y)"');
if typerec.RealSize <> SizeOf({$IFDEF NeedTPointFix}TPoint2{$ELSE}TPoint{$ENDIF}) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"'); if typerec.RealSize <> SizeOf({$IFDEF NeedTPointFix}TPoint2{$ELSE}TPoint{$ENDIF}) then raise TEMScriptBadParamException.Create('Invalid result size for "point(x,y)"');

View File

@ -61,7 +61,7 @@ var
Sorter: TParallelSortPointerList; Sorter: TParallelSortPointerList;
begin begin
if List.Count<=1 then exit; if List.Count<=1 then exit;
Sorter:=TParallelSortPointerList.Create(@List.List[0],List.Count,Compare, Sorter:=TParallelSortPointerList.Create(PPointer(@List.List[0]),List.Count,Compare,
MaxThreadCount); MaxThreadCount);
try try
Sorter.OnSortPart:=OnSortPart; Sorter.OnSortPart:=OnSortPart;

View File

@ -17308,7 +17308,7 @@ begin
GetKeyboardState(KeyState); GetKeyboardState(KeyState);
// Avoid conversion to control characters. We have captured the control key state already in Shift. // Avoid conversion to control characters. We have captured the control key state already in Shift.
KeyState[VK_CONTROL] := 0; KeyState[VK_CONTROL] := 0;
if ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, @Buffer, 0) > 0 then if ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PWord(@Buffer), 0) > 0 then
begin begin
case Buffer[0] of case Buffer[0] of
'*': '*':
@ -17326,7 +17326,7 @@ begin
// there is a problem with ToASCII when used in conjunction with dead chars. // there is a problem with ToASCII when used in conjunction with dead chars.
// The article recommends to call ToASCII twice to restore a deleted flag in the key message // The article recommends to call ToASCII twice to restore a deleted flag in the key message
// structure under certain circumstances. It turned out it is best to always call ToASCII twice. // structure under certain circumstances. It turned out it is best to always call ToASCII twice.
ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, @Buffer, 0); ToASCII(Message.CharCode, (Message.KeyData shr 16) and 7, KeyState, PWord(@Buffer), 0);
{$endif} {$endif}
case CharCode of case CharCode of
VK_F2: VK_F2:

View File

@ -393,7 +393,7 @@ begin
// FPC on darwin has a bug with -Cr // FPC on darwin has a bug with -Cr
fOptions.Add('-gw -gl -godwarfsets -gh -gt -Co -Ci -Sa'); fOptions.Add('-gw -gl -godwarfsets -gh -gt -Co -Ci -Sa');
{$ELSE} {$ELSE}
fOptions.Add('-gw3 -gl -gh -gt -Co -Cr -Ci -Sa'); fOptions.Add('-gw3 -gl -gh -gt -Co -Cr -Ci -Sa -Sy');
{$ENDIF} {$ENDIF}
end; end;
Add(Profile); Add(Profile);