paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 09:06:02 +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? } { carry-over to the next element? }
if (shiftcount<0) then if (shiftcount<0) then
begin begin
if shiftcount>=AIntBits then if shiftcount>=-AIntBits then
bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl
(AIntBits+shiftcount) (AIntBits+shiftcount)
else else
bp.nextval:=0 bp.nextval:=0;
end end
end end
else else

8
compiler/pp.lpi
View File

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

267
compiler/x86/aoptx86.pas
View File

@ -2611,128 +2611,171 @@ unit aoptx86;
checking for GetNextInstruction_p } checking for GetNextInstruction_p }
{ GetNextInstructionUsingReg only searches one instruction ahead unless -O3 is specified } { GetNextInstructionUsingReg only searches one instruction ahead unless -O3 is specified }
GetNextInstructionUsingReg(hp1,hp2,taicpu(p).oper[1]^.reg) and GetNextInstructionUsingReg(hp1,hp2,taicpu(p).oper[1]^.reg) and
MatchInstruction(hp2,A_MOV,[]) and (hp2.typ=ait_instruction) then
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
begin begin
{ we have case taicpu(hp2).opcode of
mov x, %treg A_MOV:
mov %treg, y 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
TransferUsedRegs(TmpUsedRegs); not(RegUsedBetween(taicpu(p).oper[0]^.reg, p, hp2))
TmpUsedRegs[R_INTREGISTER].Update(tai(p.Next)); )
) then
{ 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 begin
{ change { we have
mov const, %treg mov x, %treg
mov %treg, y 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 TransferUsedRegs(TmpUsedRegs);
begin TmpUsedRegs[R_INTREGISTER].Update(tai(p.Next));
{ 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 { We don't need to call UpdateUsedRegs for every instruction between
that can be optimised, it will be detected when the main Pass 1 loop p and hp2 because the register we're concerned about will not
reaches what is now hp2 and passes it through OptPass1MOV. [Kit] }; become deallocated (otherwise GetNextInstructionUsingReg would
end have stopped at an earlier instruction). [Kit] }
else
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 begin
DebugMsg(SPeepholeOptimization + 'MovMov2Mov 7 done',p); { change
RemoveCurrentP(p, hp1); mov const, %treg
Result:=true; mov %treg, y
Exit;
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; end;
else
Internalerror(2019103001);
end; end;
end; end;
else A_MOVZX, A_MOVSX{$ifdef x86_64}, A_MOVSXD{$endif x86_64}:
Internalerror(2019103001); if MatchOpType(taicpu(hp2), top_reg, top_reg) and
end; 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; end;
if (aoc_MovAnd2Mov_3 in OptsToCheck) and if (aoc_MovAnd2Mov_3 in OptsToCheck) and

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

@ -48,10 +48,6 @@ Type
FProcessOptions : TProcessOptions; FProcessOptions : TProcessOptions;
FRunCommandSleepTime: Integer; FRunCommandSleepTime: Integer;
FStartupOptions : TStartupOptions; FStartupOptions : TStartupOptions;
FProcessID : Integer;
FThreadID : Integer;
FProcessHandle : Thandle;
FThreadHandle : Thandle;
FFillAttribute : Cardinal; FFillAttribute : Cardinal;
FApplicationName : TProcessString; FApplicationName : TProcessString;
FConsoleTitle : TProcessString; FConsoleTitle : TProcessString;
@ -103,6 +99,10 @@ Type
FInputStream : TOutputPipeStream; FInputStream : TOutputPipeStream;
FOutputStream : TInputPipeStream; FOutputStream : TInputPipeStream;
FStderrStream : TInputPipeStream; FStderrStream : TInputPipeStream;
FProcessID : Integer;
FThreadID : Integer;
FProcessHandle : Thandle;
FThreadHandle : Thandle;
procedure CloseProcessHandles; virtual; procedure CloseProcessHandles; virtual;
Procedure CreateStreams(InHandle,OutHandle,ErrHandle : Longint);virtual; Procedure CreateStreams(InHandle,OutHandle,ErrHandle : Longint);virtual;
procedure FreeStream(var AStream: THandleStream); 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; Function GetStartupFlags (P : TProcessnamemacro): Cardinal;
begin begin
With P do Result:=0;
begin if poUsePipes in P.Options then
Result:=0; Result:=Result or Startf_UseStdHandles;
if poUsePipes in Options then if suoUseShowWindow in P.StartupOptions then
Result:=Result or Startf_UseStdHandles; Result:=Result or startf_USESHOWWINDOW;
if suoUseShowWindow in StartupOptions then if suoUSESIZE in P.StartupOptions then
Result:=Result or startf_USESHOWWINDOW; Result:=Result or startf_usesize;
if suoUSESIZE in StartupOptions then if suoUsePosition in P.StartupOptions then
Result:=Result or startf_usesize; Result:=Result or startf_USEPOSITION;
if suoUsePosition in StartupOptions then if suoUSECOUNTCHARS in P.Startupoptions then
Result:=Result or startf_USEPOSITION; Result:=Result or startf_usecountchars;
if suoUSECOUNTCHARS in Startupoptions then if suoUsefIllAttribute in P.StartupOptions then
Result:=Result or startf_usecountchars; Result:=Result or startf_USEFILLATTRIBUTE;
if suoUsefIllAttribute in StartupOptions then
Result:=Result or startf_USEFILLATTRIBUTE;
end;
end; end;
Function GetCreationFlags(P : TProcessnamemacro) : Cardinal; Function GetCreationFlags(P : TProcessnamemacro) : Cardinal;
begin begin
With P do Result:=CREATE_UNICODE_ENVIRONMENT;
begin if poNoConsole in P.Options then
Result:=CREATE_UNICODE_ENVIRONMENT; Result:=Result or CREATE_NO_WINDOW;
if poNoConsole in Options then if poNewConsole in P.Options then
Result:=Result or CREATE_NO_WINDOW; Result:=Result or Create_new_console;
if poNewConsole in Options then if poNewProcessGroup in P.Options then
Result:=Result or Create_new_console; Result:=Result or CREATE_NEW_PROCESS_GROUP;
if poNewProcessGroup in Options then If poRunSuspended in P.Options Then
Result:=Result or CREATE_NEW_PROCESS_GROUP; Result:=Result or Create_Suspended;
If poRunSuspended in Options Then if poDebugProcess in P.Options Then
Result:=Result or Create_Suspended; Result:=Result or DEBUG_PROCESS;
if poDebugProcess in Options Then if poDebugOnlyThisProcess in P.Options Then
Result:=Result or DEBUG_PROCESS; Result:=Result or DEBUG_ONLY_THIS_PROCESS;
if poDebugOnlyThisProcess in Options Then if poDefaultErrorMode in P.Options Then
Result:=Result or DEBUG_ONLY_THIS_PROCESS; Result:=Result or CREATE_DEFAULT_ERROR_MODE;
if poDefaultErrorMode in Options Then if poDetached in P.Options Then
Result:=Result or CREATE_DEFAULT_ERROR_MODE; Result:=Result or DETACHED_PROCESS;
if poDetached in Options Then
Result:=Result or DETACHED_PROCESS;
result:=result or PriorityConstants[FProcessPriority]; result:=result or PriorityConstants[P.FProcessPriority];
end;
end; end;
function WStrAsUniquePWideChar(var s: UnicodeString): PWideChar; function WStrAsUniquePWideChar(var s: UnicodeString): PWideChar;
@ -137,31 +131,28 @@ Const
begin begin
FillChar(SI,SizeOf(SI),0); 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 begin
cb:=SizeOf(SI); SI.dwFlags:=SI.dwFlags or Startf_UseStdHandles;
dwFlags:=GetStartupFlags(P); end;
if P.FShowWindow<>swoNone then if P.FillAttribute<>0 then
dwFlags:=dwFlags or Startf_UseShowWindow begin
else SI.dwFlags:=SI.dwFlags or Startf_UseFillAttribute;
dwFlags:=dwFlags and not Startf_UseShowWindow; SI.dwFillAttribute:=P.FillAttribute;
wShowWindow:=SWC[P.FShowWindow]; end;
if (poUsePipes in P.Options) then SI.dwXCountChars:=P.WindowColumns;
begin SI.dwYCountChars:=P.WindowRows;
dwFlags:=dwFlags or Startf_UseStdHandles; SI.dwYsize:=P.WindowHeight;
end; SI.dwXsize:=P.WindowWidth;
if P.FillAttribute<>0 then SI.dwy:=P.WindowTop;
begin SI.dwX:=P.WindowLeft;
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;
end; end;
{ The handles that are to be passed to the child process must be { 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); ClearEvent(Event);
end; end;
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 else
for I:=0 to DefCount-1 do for I:=0 to DefCount-1 do
begin begin
if Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut if (AtTab(I)^.ShortCut <> #0) and
(Upcase(GetAltChar(Event.KeyCode))=AtTab(I)^.ShortCut)
then begin then begin
Index:=I; Index:=I;
ClearEvent(Event); ClearEvent(Event);

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

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