paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 20:49:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@46348 -
This commit is contained in:
nickysn 2020-08-09 22:02:29 +00:00
commit e3cd60cd10
7 changed files with 237 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/ngtcon.pas
View File

@ -350,11 +350,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
{ carry-over to the next element? }
if (shiftcount<0) then
begin
if shiftcount>=AIntBits then
if shiftcount>=-AIntBits then
bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
(AIntBits+shiftcount)
else
bp.nextval:=0
bp.nextval:=0;
end
end
else

8
compiler/pp.lpi
View File

@ -1,17 +1,18 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<LRSInOutputDirectory Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="ppc386"/>
</General>
<BuildModes Count="1">
@ -67,8 +68,7 @@
</ConfigFile>
<CustomOptions Value="-di386
-dEXTDEBUG
-Sew
-Oodfa"/>
-Sew"/>
</Other>
</CompilerOptions>
</CONFIG>

267
compiler/x86/aoptx86.pas
View File

@ -2611,128 +2611,171 @@ unit aoptx86;
checking for GetNextInstruction_p }
{ GetNextInstructionUsingReg only searches one instruction ahead unless -O3 is specified }
GetNextInstructionUsingReg(hp1,hp2,taicpu(p).oper[1]^.reg) and
MatchInstruction(hp2,A_MOV,[]) and
MatchOperand(taicpu(p).oper[1]^,taicpu(hp2).oper[0]^) and
((taicpu(p).oper[0]^.typ=top_const) or
((taicpu(p).oper[0]^.typ=top_reg) and
not(RegUsedBetween(taicpu(p).oper[0]^.reg, p, hp2))
)
) then
(hp2.typ=ait_instruction) then
begin
{ we have
mov x, %treg
mov %treg, y
}
TransferUsedRegs(TmpUsedRegs);
TmpUsedRegs[R_INTREGISTER].Update(tai(p.Next));
{ We don't need to call UpdateUsedRegs for every instruction between
p and hp2 because the register we're concerned about will not
become deallocated (otherwise GetNextInstructionUsingReg would
have stopped at an earlier instruction). [Kit] }
TempRegUsed :=
RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp2, TmpUsedRegs) or
RegReadByInstruction(taicpu(p).oper[1]^.reg, hp1);
case taicpu(p).oper[0]^.typ Of
top_reg:
begin
{ change
mov %reg, %treg
mov %treg, y
to
mov %reg, y
}
CurrentReg := taicpu(p).oper[0]^.reg; { Saves on a handful of pointer dereferences }
RegName1 := debug_regname(taicpu(hp2).oper[0]^.reg);
if taicpu(hp2).oper[1]^.reg = CurrentReg then
begin
{ %reg = y - remove hp2 completely (doing it here instead of relying on
the "mov %reg,%reg" optimisation might cut down on a pass iteration) }
if TempRegUsed then
begin
DebugMsg(SPeepholeOptimization + debug_regname(CurrentReg) + ' = ' + RegName1 + '; removed unnecessary instruction (MovMov2MovNop 6b}',hp2);
AllocRegBetween(CurrentReg, p, hp2, UsedRegs);
asml.remove(hp2);
hp2.Free;
end
else
begin
asml.remove(hp2);
hp2.Free;
{ We can remove the original MOV too }
DebugMsg(SPeepholeOptimization + 'MovMov2NopNop 6b done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
end;
end
else
begin
AllocRegBetween(CurrentReg, p, hp2, UsedRegs);
taicpu(hp2).loadReg(0, CurrentReg);
if TempRegUsed then
begin
{ Don't remove the first instruction if the temporary register is in use }
DebugMsg(SPeepholeOptimization + RegName1 + ' = ' + debug_regname(CurrentReg) + '; changed to minimise pipeline stall (MovMov2Mov 6a}',hp2);
{ No need to set Result to True. If there's another instruction later on
that can be optimised, it will be detected when the main Pass 1 loop
reaches what is now hp2 and passes it through OptPass1MOV. [Kit] };
end
else
begin
DebugMsg(SPeepholeOptimization + 'MovMov2Mov 6 done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
end;
end;
end;
top_const:
if not (cs_opt_size in current_settings.optimizerswitches) or (taicpu(hp2).opsize = S_B) then
case taicpu(hp2).opcode of
A_MOV:
if MatchOperand(taicpu(hp2).oper[0]^,taicpu(p).oper[1]^.reg) and
((taicpu(p).oper[0]^.typ=top_const) or
((taicpu(p).oper[0]^.typ=top_reg) and
not(RegUsedBetween(taicpu(p).oper[0]^.reg, p, hp2))
)
) then
begin
{ change
mov const, %treg
{ we have
mov x, %treg
mov %treg, y
to
mov const, y
}
if (taicpu(hp2).oper[1]^.typ=top_reg) or
((taicpu(p).oper[0]^.val>=low(longint)) and (taicpu(p).oper[0]^.val<=high(longint))) then
begin
RegName1 := debug_regname(taicpu(hp2).oper[0]^.reg);
taicpu(hp2).loadOper(0,taicpu(p).oper[0]^);
if TempRegUsed then
begin
{ Don't remove the first instruction if the temporary register is in use }
DebugMsg(SPeepholeOptimization + RegName1 + ' = ' + debug_tostr(taicpu(p).oper[0]^.val) + '; changed to minimise pipeline stall (MovMov2Mov 7a)',hp2);
TransferUsedRegs(TmpUsedRegs);
TmpUsedRegs[R_INTREGISTER].Update(tai(p.Next));
{ No need to set Result to True. If there's another instruction later on
that can be optimised, it will be detected when the main Pass 1 loop
reaches what is now hp2 and passes it through OptPass1MOV. [Kit] };
end
else
{ We don't need to call UpdateUsedRegs for every instruction between
p and hp2 because the register we're concerned about will not
become deallocated (otherwise GetNextInstructionUsingReg would
have stopped at an earlier instruction). [Kit] }
TempRegUsed :=
RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp2, TmpUsedRegs) or
RegReadByInstruction(taicpu(p).oper[1]^.reg, hp1);
case taicpu(p).oper[0]^.typ Of
top_reg:
begin
{ change
mov %reg, %treg
mov %treg, y
to
mov %reg, y
}
CurrentReg := taicpu(p).oper[0]^.reg; { Saves on a handful of pointer dereferences }
RegName1 := debug_regname(taicpu(hp2).oper[0]^.reg);
if taicpu(hp2).oper[1]^.reg = CurrentReg then
begin
{ %reg = y - remove hp2 completely (doing it here instead of relying on
the "mov %reg,%reg" optimisation might cut down on a pass iteration) }
if TempRegUsed then
begin
DebugMsg(SPeepholeOptimization + debug_regname(CurrentReg) + ' = ' + RegName1 + '; removed unnecessary instruction (MovMov2MovNop 6b}',hp2);
AllocRegBetween(CurrentReg, p, hp2, UsedRegs);
asml.remove(hp2);
hp2.Free;
end
else
begin
asml.remove(hp2);
hp2.Free;
{ We can remove the original MOV too }
DebugMsg(SPeepholeOptimization + 'MovMov2NopNop 6b done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
end;
end
else
begin
AllocRegBetween(CurrentReg, p, hp2, UsedRegs);
taicpu(hp2).loadReg(0, CurrentReg);
if TempRegUsed then
begin
{ Don't remove the first instruction if the temporary register is in use }
DebugMsg(SPeepholeOptimization + RegName1 + ' = ' + debug_regname(CurrentReg) + '; changed to minimise pipeline stall (MovMov2Mov 6a}',hp2);
{ No need to set Result to True. If there's another instruction later on
that can be optimised, it will be detected when the main Pass 1 loop
reaches what is now hp2 and passes it through OptPass1MOV. [Kit] };
end
else
begin
DebugMsg(SPeepholeOptimization + 'MovMov2Mov 6 done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
end;
end;
end;
top_const:
if not (cs_opt_size in current_settings.optimizerswitches) or (taicpu(hp2).opsize = S_B) then
begin
DebugMsg(SPeepholeOptimization + 'MovMov2Mov 7 done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
{ change
mov const, %treg
mov %treg, y
to
mov const, y
}
if (taicpu(hp2).oper[1]^.typ=top_reg) or
((taicpu(p).oper[0]^.val>=low(longint)) and (taicpu(p).oper[0]^.val<=high(longint))) then
begin
RegName1 := debug_regname(taicpu(hp2).oper[0]^.reg);
taicpu(hp2).loadOper(0,taicpu(p).oper[0]^);
if TempRegUsed then
begin
{ Don't remove the first instruction if the temporary register is in use }
DebugMsg(SPeepholeOptimization + RegName1 + ' = ' + debug_tostr(taicpu(p).oper[0]^.val) + '; changed to minimise pipeline stall (MovMov2Mov 7a)',hp2);
{ No need to set Result to True. If there's another instruction later on
that can be optimised, it will be detected when the main Pass 1 loop
reaches what is now hp2 and passes it through OptPass1MOV. [Kit] };
end
else
begin
DebugMsg(SPeepholeOptimization + 'MovMov2Mov 7 done',p);
RemoveCurrentP(p, hp1);
Result:=true;
Exit;
end;
end;
end;
else
Internalerror(2019103001);
end;
end;
else
Internalerror(2019103001);
end;
A_MOVZX, A_MOVSX{$ifdef x86_64}, A_MOVSXD{$endif x86_64}:
if MatchOpType(taicpu(hp2), top_reg, top_reg) and
MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[1]^.reg) and
SuperRegistersEqual(taicpu(hp2).oper[1]^.reg, taicpu(p).oper[1]^.reg) then
begin
{
Change from:
mov ###, %reg
...
movs/z %reg,%reg (Same register, just different sizes)
To:
movs/z ###, %reg (Longer version)
...
(remove)
}
DebugMsg(SPeepholeOptimization + 'MovMovs/z2Mov/s/z done', p);
taicpu(p).oper[1]^.reg := taicpu(hp2).oper[1]^.reg;
{ Keep the first instruction as mov if ### is a constant }
if taicpu(p).oper[0]^.typ = top_const then
taicpu(p).opsize := reg2opsize(taicpu(hp2).oper[1]^.reg)
else
begin
taicpu(p).opcode := taicpu(hp2).opcode;
taicpu(p).opsize := taicpu(hp2).opsize;
end;
DebugMsg(SPeepholeOptimization + 'Removed movs/z instruction and extended earlier write (MovMovs/z2Mov/s/z)', hp2);
AllocRegBetween(taicpu(hp2).oper[1]^.reg, p, hp2, UsedRegs);
AsmL.Remove(hp2);
hp2.Free;
Result := True;
Exit;
end;
else
;
end;
end;
if (aoc_MovAnd2Mov_3 in OptsToCheck) and

8
packages/fcl-process/src/processbody.inc
View File

@ -48,10 +48,6 @@ Type
FProcessOptions : TProcessOptions;
FRunCommandSleepTime: Integer;
FStartupOptions : TStartupOptions;
FProcessID : Integer;
FThreadID : Integer;
FProcessHandle : Thandle;
FThreadHandle : Thandle;
FFillAttribute : Cardinal;
FApplicationName : TProcessString;
FConsoleTitle : TProcessString;
@ -103,6 +99,10 @@ Type
FInputStream : TOutputPipeStream;
FOutputStream : TInputPipeStream;
FStderrStream : TInputPipeStream;
FProcessID : Integer;
FThreadID : Integer;
FProcessHandle : Thandle;
FThreadHandle : Thandle;
procedure CloseProcessHandles; virtual;
Procedure CreateStreams(InHandle,OutHandle,ErrHandle : Longint);virtual;
procedure FreeStream(var AStream: THandleStream);

113
packages/fcl-process/src/win/process.inc
View File

@ -44,49 +44,43 @@ end;
Function GetStartupFlags (P : TProcessnamemacro): Cardinal;
begin
With P do
begin
Result:=0;
if poUsePipes in Options then
Result:=Result or Startf_UseStdHandles;
if suoUseShowWindow in StartupOptions then
Result:=Result or startf_USESHOWWINDOW;
if suoUSESIZE in StartupOptions then
Result:=Result or startf_usesize;
if suoUsePosition in StartupOptions then
Result:=Result or startf_USEPOSITION;
if suoUSECOUNTCHARS in Startupoptions then
Result:=Result or startf_usecountchars;
if suoUsefIllAttribute in StartupOptions then
Result:=Result or startf_USEFILLATTRIBUTE;
end;
Result:=0;
if poUsePipes in P.Options then
Result:=Result or Startf_UseStdHandles;
if suoUseShowWindow in P.StartupOptions then
Result:=Result or startf_USESHOWWINDOW;
if suoUSESIZE in P.StartupOptions then
Result:=Result or startf_usesize;
if suoUsePosition in P.StartupOptions then
Result:=Result or startf_USEPOSITION;
if suoUSECOUNTCHARS in P.Startupoptions then
Result:=Result or startf_usecountchars;
if suoUsefIllAttribute in P.StartupOptions then
Result:=Result or startf_USEFILLATTRIBUTE;
end;
Function GetCreationFlags(P : TProcessnamemacro) : Cardinal;
begin
With P do
begin
Result:=CREATE_UNICODE_ENVIRONMENT;
if poNoConsole in Options then
Result:=Result or CREATE_NO_WINDOW;
if poNewConsole in Options then
Result:=Result or Create_new_console;
if poNewProcessGroup in Options then
Result:=Result or CREATE_NEW_PROCESS_GROUP;
If poRunSuspended in Options Then
Result:=Result or Create_Suspended;
if poDebugProcess in Options Then
Result:=Result or DEBUG_PROCESS;
if poDebugOnlyThisProcess in Options Then
Result:=Result or DEBUG_ONLY_THIS_PROCESS;
if poDefaultErrorMode in Options Then
Result:=Result or CREATE_DEFAULT_ERROR_MODE;
if poDetached in Options Then
Result:=Result or DETACHED_PROCESS;
Result:=CREATE_UNICODE_ENVIRONMENT;
if poNoConsole in P.Options then
Result:=Result or CREATE_NO_WINDOW;
if poNewConsole in P.Options then
Result:=Result or Create_new_console;
if poNewProcessGroup in P.Options then
Result:=Result or CREATE_NEW_PROCESS_GROUP;
If poRunSuspended in P.Options Then
Result:=Result or Create_Suspended;
if poDebugProcess in P.Options Then
Result:=Result or DEBUG_PROCESS;
if poDebugOnlyThisProcess in P.Options Then
Result:=Result or DEBUG_ONLY_THIS_PROCESS;
if poDefaultErrorMode in P.Options Then
Result:=Result or CREATE_DEFAULT_ERROR_MODE;
if poDetached in P.Options Then
Result:=Result or DETACHED_PROCESS;
result:=result or PriorityConstants[FProcessPriority];
end;
result:=result or PriorityConstants[P.FProcessPriority];
end;
function WStrAsUniquePWideChar(var s: UnicodeString): PWideChar;
@ -137,31 +131,28 @@ Const
begin
FillChar(SI,SizeOf(SI),0);
With SI do
SI.cb:=SizeOf(SI);
SI.dwFlags:=GetStartupFlags(P);
if P.FShowWindow<>swoNone then
SI.dwFlags:=SI.dwFlags or Startf_UseShowWindow
else
SI.dwFlags:=SI.dwFlags and not Startf_UseShowWindow;
SI.wShowWindow:=SWC[P.FShowWindow];
if (poUsePipes in P.Options) then
begin
cb:=SizeOf(SI);
dwFlags:=GetStartupFlags(P);
if P.FShowWindow<>swoNone then
dwFlags:=dwFlags or Startf_UseShowWindow
else
dwFlags:=dwFlags and not Startf_UseShowWindow;
wShowWindow:=SWC[P.FShowWindow];
if (poUsePipes in P.Options) then
begin
dwFlags:=dwFlags or Startf_UseStdHandles;
end;
if P.FillAttribute<>0 then
begin
dwFlags:=dwFlags or Startf_UseFillAttribute;
dwFillAttribute:=P.FillAttribute;
end;
dwXCountChars:=P.WindowColumns;
dwYCountChars:=P.WindowRows;
dwYsize:=P.WindowHeight;
dwXsize:=P.WindowWidth;
dwy:=P.WindowTop;
dwX:=P.WindowLeft;
end;
SI.dwFlags:=SI.dwFlags or Startf_UseStdHandles;
end;
if P.FillAttribute<>0 then
begin
SI.dwFlags:=SI.dwFlags or Startf_UseFillAttribute;
SI.dwFillAttribute:=P.FillAttribute;
end;
SI.dwXCountChars:=P.WindowColumns;
SI.dwYCountChars:=P.WindowRows;
SI.dwYsize:=P.WindowHeight;
SI.dwXsize:=P.WindowWidth;
SI.dwy:=P.WindowTop;
SI.dwX:=P.WindowLeft;
end;
{ The handles that are to be passed to the child process must be

19
packages/fv/src/tabs.pas
View File

@ -399,10 +399,27 @@ begin
ClearEvent(Event);
end;
end;
kbCtrlPgUp:
begin
if ActiveDef > 0 then
Index := Pred (ActiveDef)
else
Index := Pred (DefCount);
ClearEvent(Event);
end;
kbCtrlPgDn:
begin
if ActiveDef < Pred (DefCount) then
Index := Succ (ActiveDef)
else
Index := 0;
ClearEvent(Event);
end;
else
for I:=0 to DefCount-1 do
begin
if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut
if (AtTab(I)^.ShortCut <> #0) and
(Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut)
then begin
Index:=I;
ClearEvent(Event);

4
rtl/objpas/classes/writer.inc
View File

@ -1171,8 +1171,8 @@ begin
if HasAncestor then
DefInt64Value := GetInt64Prop(Ancestor, PropInfo)
else
DefInt64Value := 0;
if Int64Value <> DefInt64Value then
DefInt64Value := PPropInfo(PropInfo)^.Default;
if (Int64Value <> DefInt64Value) or (DefInt64Value=longint($80000000)) then
begin
Driver.BeginProperty(FPropPath + PPropInfo(PropInfo)^.Name);
WriteInteger(Int64Value);