From 67acb289d70eeb619d978e9c9e1329e552e6825e Mon Sep 17 00:00:00 2001 From: ondrej Date: Sun, 9 Aug 2020 06:13:06 +0000 Subject: [PATCH 1/8] TWriter: fix default value handling for Int64/QWord values. Issue #37525 git-svn-id: trunk@46337 - --- rtl/objpas/classes/writer.inc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rtl/objpas/classes/writer.inc b/rtl/objpas/classes/writer.inc index ac47559642..b7cb887a98 100644 --- a/rtl/objpas/classes/writer.inc +++ b/rtl/objpas/classes/writer.inc @@ -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); From f8144bb724759f33946c545b543f860e2948aeea Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sun, 9 Aug 2020 12:31:36 +0000 Subject: [PATCH 2/8] * fix bug causing misinterpretation of cursor keys in case of tab without shurtcuts git-svn-id: trunk@46338 - --- packages/fv/src/tabs.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/packages/fv/src/tabs.pas b/packages/fv/src/tabs.pas index c7a63d31e5..72cd301603 100644 --- a/packages/fv/src/tabs.pas +++ b/packages/fv/src/tabs.pas @@ -402,7 +402,8 @@ begin 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); From 2fd6661a9d08dded6bc0501e5201a7c5ef67ea69 Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sun, 9 Aug 2020 13:25:37 +0000 Subject: [PATCH 3/8] + added possibility to navigate among tabs using Ctrl-PgUp/Ctrl-PgDn git-svn-id: trunk@46340 - --- packages/fv/src/tabs.pas | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/packages/fv/src/tabs.pas b/packages/fv/src/tabs.pas index 72cd301603..7471a9af8f 100644 --- a/packages/fv/src/tabs.pas +++ b/packages/fv/src/tabs.pas @@ -399,6 +399,22 @@ 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 From 4f5881531b9cc293585d6aa749c7729202065759 Mon Sep 17 00:00:00 2001 From: ondrej Date: Sun, 9 Aug 2020 16:28:55 +0000 Subject: [PATCH 4/8] TProcessnamemacro: move FProcessID, FThreadID, FProcessHandle, FThreadHandle to the protected section so that descendants can fill them in overridden Execute procedure git-svn-id: trunk@46342 - --- packages/fcl-process/src/processbody.inc | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/packages/fcl-process/src/processbody.inc b/packages/fcl-process/src/processbody.inc index 7dca7b7650..d07a2839a7 100644 --- a/packages/fcl-process/src/processbody.inc +++ b/packages/fcl-process/src/processbody.inc @@ -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); From b168045119661021ba7bbc08973a17ed22057677 Mon Sep 17 00:00:00 2001 From: ondrej Date: Sun, 9 Aug 2020 16:30:53 +0000 Subject: [PATCH 5/8] process: explode with blocks git-svn-id: trunk@46343 - --- packages/fcl-process/src/win/process.inc | 113 +++++++++++------------ 1 file changed, 52 insertions(+), 61 deletions(-) diff --git a/packages/fcl-process/src/win/process.inc b/packages/fcl-process/src/win/process.inc index 01426d29de..7c690060d8 100644 --- a/packages/fcl-process/src/win/process.inc +++ b/packages/fcl-process/src/win/process.inc @@ -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 From 867786c9539272bbd6be20a4614bbd5fbd0a0a94 Mon Sep 17 00:00:00 2001 From: florian Date: Sun, 9 Aug 2020 18:52:25 +0000 Subject: [PATCH 6/8] * update version - -Oodfa removed git-svn-id: trunk@46345 - --- compiler/pp.lpi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/compiler/pp.lpi b/compiler/pp.lpi index 667942aa7e..a86c3c2522 100644 --- a/compiler/pp.lpi +++ b/compiler/pp.lpi @@ -1,17 +1,18 @@ - + + + - </General> <BuildModes Count="1"> @@ -67,8 +68,7 @@ </ConfigFile> <CustomOptions Value="-di386 -dEXTDEBUG --Sew --Oodfa"/> +-Sew"/> </Other> </CompilerOptions> </CONFIG> From 87615458481ea121410a7951a387694af6a65a7b Mon Sep 17 00:00:00 2001 From: florian <florian@freepascal.org> Date: Sun, 9 Aug 2020 18:55:46 +0000 Subject: [PATCH 7/8] * patch by J. Gareth Moreton: Long-range MOV + MOVS/Z optimisation, resolves #37390 git-svn-id: trunk@46346 - --- compiler/x86/aoptx86.pas | 267 +++++++++++++++++++++++---------------- 1 file changed, 155 insertions(+), 112 deletions(-) diff --git a/compiler/x86/aoptx86.pas b/compiler/x86/aoptx86.pas index 20b522af27..d037776bb4 100644 --- a/compiler/x86/aoptx86.pas +++ b/compiler/x86/aoptx86.pas @@ -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 From 2de0be96334891fdf07966fec883e1b9c612fcdf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= <karoly@freepascal.org> Date: Sun, 9 Aug 2020 21:31:18 +0000 Subject: [PATCH 8/8] * attempt to correct bitpacked arrays on big-endian systems after r43186. this fixed tparray13 test on m68k at least git-svn-id: trunk@46347 - --- compiler/ngtcon.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/ngtcon.pas b/compiler/ngtcon.pas index d546148eec..5faa38f53d 100644 --- a/compiler/ngtcon.pas +++ b/compiler/ngtcon.pas @@ -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