Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46348 -
nickysn 5 years ago
parent
commit
e3cd60cd10

+ 2 - 2
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

+ 4 - 4
compiler/pp.lpi

@@ -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>

+ 147 - 104
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
-            }
+            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
+                    { we have
+                        mov x, %treg
+                        mov %treg, y
+                    }
 
-            TransferUsedRegs(TmpUsedRegs);
-            TmpUsedRegs[R_INTREGISTER].Update(tai(p.Next));
+                    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] }
+                    { 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);
+                    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
+                    case taicpu(p).oper[0]^.typ Of
+                      top_reg:
+                        begin
+                          { change
+                              mov %reg, %treg
+                              mov %treg, y
 
-                      to
+                              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) }
+                              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;
+                              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);
 
-                          { We can remove the original MOV too }
-                          DebugMsg(SPeepholeOptimization + 'MovMov2NopNop 6b done',p);
-                          RemoveCurrentP(p, hp1);
-                          Result:=true;
-                          Exit;
+                                  { 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;
-                    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);
+                      top_const:
+                        if not (cs_opt_size in current_settings.optimizerswitches) or (taicpu(hp2).opsize = S_B) then
+                          begin
+                            { change
+                                mov const, %treg
+                                mov %treg, y
 
-                          { 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
-                    { change
-                        mov const, %treg
-                        mov %treg, y
+                                to
 
-                        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]^);
 
-                        mov const, y
+                                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;
+              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)
                     }
-                    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
+                    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
-                        RegName1 := debug_regname(taicpu(hp2).oper[0]^.reg);
-                        taicpu(hp2).loadOper(0,taicpu(p).oper[0]^);
+                        taicpu(p).opcode := taicpu(hp2).opcode;
+                        taicpu(p).opsize := taicpu(hp2).opsize;
+                      end;
 
-                        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);
+                    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;
 
-                            { 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;
+                    Result := True;
+                    Exit;
                   end;
-                else
-                  Internalerror(2019103001);
-              end;
+              else
+                ;
+            end;
           end;
 
         if (aoc_MovAnd2Mov_3 in OptsToCheck) and

+ 4 - 4
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);

+ 53 - 62
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:=result or PriorityConstants[FProcessPriority];
-    end;
+  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[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
+    SI.dwFlags:=SI.dwFlags or Startf_UseStdHandles;
+    end;
+  if P.FillAttribute<>0 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_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

+ 18 - 1
packages/fv/src/tabs.pas

@@ -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);

+ 2 - 2
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);