Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@48090 -
nickysn 4 years ago
parent
commit
77578f0e03

+ 4 - 0
.gitattributes

@@ -18683,6 +18683,10 @@ tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw38295.pp svneol=native#text/pascal
 tests/webtbs/tw38299.pp svneol=native#text/pascal
+tests/webtbs/tw38309.pp svneol=native#text/pascal
+tests/webtbs/tw38310a.pp svneol=native#text/pascal
+tests/webtbs/tw38310b.pp svneol=native#text/pascal
+tests/webtbs/tw38310c.pp svneol=native#text/pascal
 tests/webtbs/tw3833.pp svneol=native#text/plain
 tests/webtbs/tw3840.pp svneol=native#text/plain
 tests/webtbs/tw3841.pp svneol=native#text/plain

+ 3 - 3
compiler/defcmp.pas

@@ -843,11 +843,11 @@ implementation
                          { and conversion to float is favoured)                }
                          doconv:=tc_int_2_real;
                          if is_extended(def_to) then
-                           eq:=te_convert_l2
+                           eq:=te_convert_l1
                          else if is_double(def_to) then
-                           eq:=te_convert_l3
+                           eq:=te_convert_l2
                          else if is_single(def_to) then
-                           eq:=te_convert_l4
+                           eq:=te_convert_l3
                          else
                            eq:=te_convert_l2;
                        end;

+ 6 - 3
compiler/htypechk.pas

@@ -2299,7 +2299,8 @@ implementation
               srsym:=tsym(helperdef.symtable.FindWithHash(hashedid));
               if assigned(srsym) and
                   { Delphi allows hiding a property by a procedure with the same name }
-                  (srsym.typ=procsym) then
+                  (srsym.typ=procsym) and
+                  (tprocsym(srsym).procdeflist.count>0) then
                 begin
                   hasoverload:=processprocsym(tprocsym(srsym),foundanything);
                   { when there is no explicit overload we stop searching }
@@ -2388,7 +2389,8 @@ implementation
                srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid));
                if assigned(srsym) and
                   { Delphi allows hiding a property by a procedure with the same name }
-                  (srsym.typ=procsym) then
+                  (srsym.typ=procsym) and
+                  (tprocsym(srsym).procdeflist.count>0) then
                  begin
                    hasoverload:=processprocsym(tprocsym(srsym),foundanything);
                    { when there is no explicit overload we stop searching }
@@ -2463,7 +2465,8 @@ implementation
               begin
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
-                   (srsym.typ=procsym) then
+                   (srsym.typ=procsym) and
+                   (tprocsym(srsym).procdeflist.count>0) then
                   begin
                     { add all definitions }
                     hasoverload:=false;

+ 7 - 1
compiler/i386/aoptcpu.pas

@@ -252,6 +252,8 @@ unit aoptcpu;
                   Result:=OptPass2Jmp(p);
                 A_MOV:
                   Result:=OptPass2MOV(p);
+                A_MOVZX:
+                  Result:=OptPass2Movx(p);
                 A_SUB:
                   Result:=OptPass2SUB(p);
                 else
@@ -288,7 +290,9 @@ unit aoptcpu;
                   {   "cmpl $3,%eax; movzbl 8(%ebp),%ebx; je .Lxxx"           }
                   { so we can't safely replace the movzx then with xor/mov,   }
                   { since that would change the flags (JM)                    }
-                  if not(cs_opt_regvar in current_settings.optimizerswitches) then
+                  if PostPeepholeOptMovzx(p) then
+                    Result := True
+                  else if not(cs_opt_regvar in current_settings.optimizerswitches) then
                     begin
                       if (taicpu(p).oper[1]^.typ = top_reg) then
                         if (taicpu(p).oper[0]^.typ = top_reg)
@@ -340,6 +344,8 @@ unit aoptcpu;
                   Result:=PostPeepholeOptAnd(p);
                 A_MOVSX:
                   Result:=PostPeepholeOptMOVSX(p);
+                A_SHR:
+                  Result:=PostPeepholeOptShr(p);
                 else
                   ;
               end;

+ 702 - 2
compiler/x86/aoptx86.pas

@@ -140,6 +140,7 @@ unit aoptx86;
         function OptPass1VPXor(var p: tai): boolean;
         function OptPass1Imul(var p : tai) : boolean;
 
+        function OptPass2Movx(var p : tai): Boolean;
         function OptPass2MOV(var p : tai) : boolean;
         function OptPass2Imul(var p : tai) : boolean;
         function OptPass2Jmp(var p : tai) : boolean;
@@ -149,8 +150,8 @@ unit aoptx86;
         function OptPass2ADD(var p : tai): Boolean;
 
         function PostPeepholeOptMov(var p : tai) : Boolean;
-{$ifdef x86_64} { These post-peephole optimisations only affect 64-bit registers. [Kit] }
         function PostPeepholeOptMovzx(var p : tai) : Boolean;
+{$ifdef x86_64} { These post-peephole optimisations only affect 64-bit registers. [Kit] }
         function PostPeepholeOptXor(var p : tai) : Boolean;
 {$endif}
         function PostPeepholeOptAnd(var p : tai) : boolean;
@@ -160,6 +161,7 @@ unit aoptx86;
         function PostPeepholeOptCall(var p : tai) : Boolean;
         function PostPeepholeOptLea(var p : tai) : Boolean;
         function PostPeepholeOptPush(var p: tai): Boolean;
+        function PostPeepholeOptShr(var p : tai) : boolean;
 
         procedure ConvertJumpToRET(const p: tai; const ret_p: tai);
 
@@ -4935,6 +4937,529 @@ unit aoptx86;
       end;
 
 
+    function TX86AsmOptimizer.OptPass2Movx(var p : tai) : boolean;
+      const
+        LIST_STEP_SIZE = 4;
+      var
+        ThisReg: TRegister;
+        MinSize, MaxSize, TrySmaller, TargetSize: TOpSize;
+        TargetSubReg: TSubRegister;
+        hp1, hp2: tai;
+        RegInUse, p_removed: Boolean;
+
+        { Store list of found instructions so we don't have to call
+          GetNextInstructionUsingReg multiple times }
+        InstrList: array of taicpu;
+        InstrMax, Index: Integer;
+        UpperLimit, TrySmallerLimit: TCgInt;
+
+        { Data flow analysis }
+        TestValMin, TestValMax: TCgInt;
+        SmallerOverflow: Boolean;
+
+      begin
+        Result := False;
+        p_removed := False;
+
+        { This is anything but quick! }
+        if not(cs_opt_level2 in current_settings.optimizerswitches) then
+          Exit;
+
+        SetLength(InstrList, 0);
+        InstrMax := -1;
+        ThisReg := taicpu(p).oper[1]^.reg;
+        hp1 := p;
+
+        case taicpu(p).opsize of
+          S_BW, S_BL:
+            begin
+              UpperLimit := $FF;
+              MinSize := S_B;
+              if taicpu(p).opsize = S_BW then
+                MaxSize := S_W
+              else
+                MaxSize := S_L;
+            end;
+          S_WL:
+            begin
+              UpperLimit := $FFFF;
+              MinSize := S_W;
+              MaxSize := S_L;
+            end
+          else
+            InternalError(2020112301);
+        end;
+
+        TestValMin := 0;
+        TestValMax := UpperLimit;
+        TrySmallerLimit := UpperLimit;
+        TrySmaller := S_NO;
+        SmallerOverflow := False;
+
+        while GetNextInstructionUsingReg(hp1, hp1, ThisReg) and
+          (hp1.typ = ait_instruction) and
+          (
+            { Under -O1 and -O2, GetNextInstructionUsingReg may return an
+              instruction that doesn't actually contain ThisReg }
+            (cs_opt_level3 in current_settings.optimizerswitches) or
+            RegInInstruction(ThisReg, hp1)
+          ) do
+          begin
+            case taicpu(hp1).opcode of
+              A_INC,A_DEC:
+                begin
+                  { Has to be an exact match on the register }
+                  if not MatchOperand(taicpu(hp1).oper[0]^, ThisReg) then
+                    Break;
+
+                  if taicpu(hp1).opcode = A_INC then
+                    begin
+                      Inc(TestValMin);
+                      Inc(TestValMax);
+                    end
+                  else
+                    begin
+                      Dec(TestValMin);
+                      Dec(TestValMax);
+                    end;
+                end;
+
+              { OR and XOR are not included because they can too easily fool
+                the data flow analysis (they can cause non-linear behaviour) }
+              A_ADD,A_SUB,A_AND,A_SHL,A_SHR:
+                begin
+                  if
+                    (taicpu(hp1).oper[1]^.typ <> top_reg) or
+                    { Has to be an exact match on the register }
+                    (taicpu(hp1).oper[1]^.reg <> ThisReg) or not
+                    (
+                      (
+                        (taicpu(hp1).oper[0]^.typ = top_const) and
+                        (
+                          (
+                            (taicpu(hp1).opcode = A_SHL) and
+                            (
+                              ((MinSize = S_B) and (taicpu(hp1).oper[0]^.val < 8)) or
+                              ((MinSize = S_W) and (taicpu(hp1).oper[0]^.val < 16)) or
+                              ((MinSize = S_L) and (taicpu(hp1).oper[0]^.val < 32))
+                            )
+                          ) or (
+                            (taicpu(hp1).opcode <> A_SHL) and
+                            (
+                              ((taicpu(hp1).oper[0]^.val and UpperLimit) = taicpu(hp1).oper[0]^.val) or
+                              { Is it in the negative range? }
+                              (((not taicpu(hp1).oper[0]^.val) and (UpperLimit shr 1)) = (not taicpu(hp1).oper[0]^.val))
+                            )
+                          )
+                        )
+                      ) or (
+                        MatchOperand(taicpu(hp1).oper[0]^, taicpu(hp1).oper[1]^.reg) and
+                        ((taicpu(hp1).opcode = A_ADD) or (taicpu(hp1).opcode = A_AND) or (taicpu(hp1).opcode = A_SUB))
+                      )
+                    ) then
+                    Break;
+
+                  case taicpu(hp1).opcode of
+                    A_ADD:
+                      if (taicpu(hp1).oper[0]^.typ = top_reg) then
+                        begin
+                          TestValMin := TestValMin * 2;
+                          TestValMax := TestValMax * 2;
+                        end
+                      else
+                        begin
+                          TestValMin := TestValMin + taicpu(hp1).oper[0]^.val;
+                          TestValMax := TestValMax + taicpu(hp1).oper[0]^.val;
+                        end;
+                    A_SUB:
+                      if (taicpu(hp1).oper[0]^.typ = top_reg) then
+                        begin
+                          TestValMin := 0;
+                          TestValMax := 0;
+                        end
+                      else
+                        begin
+                          TestValMin := TestValMin - taicpu(hp1).oper[0]^.val;
+                          TestValMax := TestValMax - taicpu(hp1).oper[0]^.val;
+                        end;
+                    A_AND:
+                      if (taicpu(hp1).oper[0]^.typ = top_const) then
+                        begin
+                          { we might be able to go smaller if AND appears first }
+                          if InstrMax = -1 then
+                            case MinSize of
+                              S_B:
+                                ;
+                              S_W:
+                                if ((taicpu(hp1).oper[0]^.val and $FF) = taicpu(hp1).oper[0]^.val) or
+                                  ((not(taicpu(hp1).oper[0]^.val) and $7F) = (not taicpu(hp1).oper[0]^.val)) then
+                                  begin
+                                    TrySmaller := S_B;
+                                    TrySmallerLimit := $FF;
+                                  end;
+                              S_L:
+                                if ((taicpu(hp1).oper[0]^.val and $FF) = taicpu(hp1).oper[0]^.val) or
+                                  ((not(taicpu(hp1).oper[0]^.val) and $7F) = (not taicpu(hp1).oper[0]^.val)) then
+                                  begin
+                                    TrySmaller := S_B;
+                                    TrySmallerLimit := $FF;
+                                  end
+                                else if ((taicpu(hp1).oper[0]^.val and $FFFF) = taicpu(hp1).oper[0]^.val) or
+                                  ((not(taicpu(hp1).oper[0]^.val) and $7FFF) = (not taicpu(hp1).oper[0]^.val)) then
+                                  begin
+                                    TrySmaller := S_W;
+                                    TrySmallerLimit := $FFFF;
+                                  end;
+                              else
+                                InternalError(2020112320);
+                            end;
+
+                          TestValMin := TestValMin and taicpu(hp1).oper[0]^.val;
+                          TestValMax := TestValMax and taicpu(hp1).oper[0]^.val;
+                        end;
+                    A_SHL:
+                      begin
+                        TestValMin := TestValMin shl taicpu(hp1).oper[0]^.val;
+                        TestValMax := TestValMax shl taicpu(hp1).oper[0]^.val;
+                      end;
+                    A_SHR:
+                      begin
+                        { we might be able to go smaller if SHR appears first }
+                        if InstrMax = -1 then
+                          case MinSize of
+                            S_B:
+                              ;
+                            S_W:
+                              if (taicpu(hp1).oper[0]^.val >= 8) then
+                                begin
+                                  TrySmaller := S_B;
+                                  TrySmallerLimit := $FF;
+                                end;
+                            S_L:
+                              if (taicpu(hp1).oper[0]^.val >= 24) then
+                                begin
+                                  TrySmaller := S_B;
+                                  TrySmallerLimit := $FF;
+                                end
+                              else if (taicpu(hp1).oper[0]^.val >= 16) then
+                                begin
+                                  TrySmaller := S_W;
+                                  TrySmallerLimit := $FFFF;
+                                end;
+                            else
+                              InternalError(2020112321);
+                          end;
+
+                        TestValMin := TestValMin shr taicpu(hp1).oper[0]^.val;
+                        TestValMax := TestValMax shr taicpu(hp1).oper[0]^.val;
+                      end;
+                    else
+                      InternalError(2020112303);
+                  end;
+                end;
+(*
+              A_IMUL:
+                case taicpu(hp1).ops of
+                  2:
+                    begin
+                      if not MatchOpType(hp1, top_reg, top_reg) or
+                        { Has to be an exact match on the register }
+                        (taicpu(hp1).oper[0]^.reg <> ThisReg) or
+                        (taicpu(hp1).oper[1]^.reg <> ThisReg) then
+                        Break;
+
+                      TestValMin := TestValMin * TestValMin;
+                      TestValMax := TestValMax * TestValMax;
+                    end;
+                  3:
+                    begin
+                      if not MatchOpType(hp1, top_const, top_reg, top_reg) or
+                        { Has to be an exact match on the register }
+                        (taicpu(hp1).oper[1]^.reg <> ThisReg) or
+                        (taicpu(hp1).oper[2]^.reg <> ThisReg) or
+                        ((taicpu(hp1).oper[0]^.val and UpperLimit) = taicpu(hp1).oper[0]^.val) or
+                        { Is it in the negative range? }
+                        (((not taicpu(hp1).oper[0]^.val) and (UpperLimit shr 1)) = (not taicpu(hp1).oper[0]^.val)) then
+                        Break;
+
+                      TestValMin := TestValMin * taicpu(hp1).oper[0]^.val;
+                      TestValMax := TestValMax * taicpu(hp1).oper[0]^.val;
+                    end;
+                  else
+                    Break;
+                end;
+
+              A_IDIV:
+                case taicpu(hp1).ops of
+                  3:
+                    begin
+                      if not MatchOpType(hp1, top_const, top_reg, top_reg) or
+                        { Has to be an exact match on the register }
+                        (taicpu(hp1).oper[1]^.reg <> ThisReg) or
+                        (taicpu(hp1).oper[2]^.reg <> ThisReg) or
+                        ((taicpu(hp1).oper[0]^.val and UpperLimit) = taicpu(hp1).oper[0]^.val) or
+                        { Is it in the negative range? }
+                        (((not taicpu(hp1).oper[0]^.val) and (UpperLimit shr 1)) = (not taicpu(hp1).oper[0]^.val)) then
+                        Break;
+
+                      TestValMin := TestValMin div taicpu(hp1).oper[0]^.val;
+                      TestValMax := TestValMax div taicpu(hp1).oper[0]^.val;
+                    end;
+                  else
+                    Break;
+                end;
+*)
+              A_MOVZX:
+                begin
+                  if not MatchOpType(taicpu(hp1), top_reg, top_reg) then
+                    Break;
+
+                  { The objective here is to try to find a combination that
+                    removes one of the MOV/Z instructions. }
+                  case taicpu(hp1).opsize of
+                    S_WL:
+                      if (MinSize in [S_B, S_W]) then
+                        begin
+                          TargetSize := S_L;
+                          TargetSubReg := R_SUBD;
+                        end
+                      else if ((TrySmaller in [S_B, S_W]) and not SmallerOverflow) then
+                        begin
+                          TargetSize := TrySmaller;
+                          if TrySmaller = S_B then
+                            TargetSubReg := R_SUBL
+                          else
+                            TargetSubReg := R_SUBW;
+                        end
+                      else
+                        Break;
+
+                    S_BW:
+                      if (MinSize in [S_B, S_W]) then
+                        begin
+                          TargetSize := S_W;
+                          TargetSubReg := R_SUBW;
+                        end
+                      else if ((TrySmaller = S_B) and not SmallerOverflow) then
+                        begin
+                          TargetSize := S_B;
+                          TargetSubReg := R_SUBL;
+                        end
+                      else
+                        Break;
+
+                    S_BL:
+                      if (MinSize in [S_B, S_W]) then
+                        begin
+                          TargetSize := S_L;
+                          TargetSubReg := R_SUBD;
+                        end
+                      else if ((TrySmaller = S_B) and not SmallerOverflow) then
+                        begin
+                          TargetSize := S_B;
+                          TargetSubReg := R_SUBL;
+                        end
+                      else
+                        Break;
+
+                    else
+                      InternalError(2020112302);
+                  end;
+
+                  { Update the register to its new size }
+                  ThisReg := newreg(R_INTREGISTER, getsupreg(ThisReg), TargetSubReg);
+
+                  if TargetSize = MinSize then
+                    begin
+                      { Convert the input MOVZX to a MOV }
+                      if (taicpu(p).oper[0]^.typ = top_reg) and
+                        SuperRegistersEqual(taicpu(p).oper[0]^.reg, ThisReg) then
+                        begin
+                          { Or remove it completely! }
+                          DebugMsg(SPeepholeOptimization + 'Movzx2Nop 1', p);
+                          RemoveCurrentP(p);
+                          p_removed := True;
+                        end
+                      else
+                        begin
+                          DebugMsg(SPeepholeOptimization + 'Movzx2Mov 1', p);
+                          taicpu(p).opcode := A_MOV;
+                          taicpu(p).oper[1]^.reg := ThisReg;
+                          taicpu(p).opsize := TargetSize;
+                        end;
+
+                      Result := True;
+                    end
+                  else if TargetSize <> MaxSize then
+                    begin
+
+                      case MaxSize of
+                        S_L:
+                          if TargetSize = S_W then
+                            begin
+                              DebugMsg(SPeepholeOptimization + 'movzbl2movzbw', p);
+                              taicpu(p).opsize := S_BW;
+                              taicpu(p).oper[1]^.reg := ThisReg;
+                              Result := True;
+                            end
+                          else
+                            InternalError(2020112341);
+
+                        S_W:
+                          if TargetSize = S_L then
+                            begin
+                              DebugMsg(SPeepholeOptimization + 'movzbw2movzbl', p);
+                              taicpu(p).opsize := S_BL;
+                              taicpu(p).oper[1]^.reg := ThisReg;
+                              Result := True;
+                            end
+                          else
+                            InternalError(2020112342);
+                        else
+                          ;
+                      end;
+                    end;
+
+
+                  if (MaxSize = TargetSize) or
+                    ((TargetSize = S_L) and (taicpu(hp1).opsize in [S_L, S_BL, S_WL])) or
+                    ((TargetSize = S_W) and (taicpu(hp1).opsize in [S_W, S_BW])) then
+                    begin
+                      { Convert the output MOVZX to a MOV }
+                      if (taicpu(hp1).oper[0]^.typ = top_reg) and
+                        SuperRegistersEqual(taicpu(hp1).oper[1]^.reg, ThisReg) then
+                        begin
+                          { Or remove it completely! }
+                          DebugMsg(SPeepholeOptimization + 'Movzx2Nop 2', hp1);
+
+                          { Be careful; if p = hp1 and p was also removed, p
+                            will become a dangling pointer }
+                          if p = hp1 then
+                            RemoveCurrentp(p) { p = hp1 and will then become the next instruction }
+                          else
+                            RemoveInstruction(hp1);
+                        end
+                      else
+                        begin
+                          taicpu(hp1).opcode := A_MOV;
+                          taicpu(hp1).oper[0]^.reg := ThisReg;
+                          taicpu(hp1).opsize := TargetSize;
+
+                          { Check to see if the active register is used afterwards;
+                            if not, we can change it and make a saving. }
+                          RegInUse := False;
+                          TransferUsedRegs(TmpUsedRegs);
+
+                          { The target register may be marked as in use to cross
+                            a jump to a distant label, so exclude it }
+                          ExcludeRegFromUsedRegs(taicpu(hp1).oper[1]^.reg, TmpUsedRegs);
+
+                          hp2 := p;
+                          repeat
+
+                            UpdateUsedRegs(TmpUsedRegs, tai(hp2.next));
+
+                            { Explicitly check for the excluded register (don't include the first
+                              instruction as it may be reading from here }
+                            if ((p <> hp2) and (RegInInstruction(taicpu(hp1).oper[1]^.reg, hp2))) or
+                              RegInUsedRegs(taicpu(hp1).oper[1]^.reg, TmpUsedRegs) then
+                              begin
+                                RegInUse := True;
+                                Break;
+                              end;
+
+                            if not GetNextInstruction(hp2, hp2) then
+                              InternalError(2020112340);
+
+                          until (hp2 = hp1);
+
+                          if not RegInUse and not RegUsedAfterInstruction(ThisReg, hp1, TmpUsedRegs) then
+                            begin
+                              DebugMsg(SPeepholeOptimization + 'Simplified register usage so ' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' = ' + debug_regname(taicpu(p).oper[1]^.reg), p);
+                              ThisReg := taicpu(hp1).oper[1]^.reg;
+
+                              TransferUsedRegs(TmpUsedRegs);
+                              AllocRegBetween(ThisReg, p, hp1, TmpUsedRegs);
+
+                              DebugMsg(SPeepholeOptimization + 'Movzx2Nop 3', hp1);
+                              if p = hp1 then
+                                RemoveCurrentp(p) { p = hp1 and will then become the next instruction }
+                              else
+                                RemoveInstruction(hp1);
+
+                              { Instruction will become "mov %reg,%reg" }
+                              if not p_removed and (taicpu(p).opcode = A_MOV) and
+                                MatchOperand(taicpu(p).oper[0]^, ThisReg) then
+                                begin
+                                  DebugMsg(SPeepholeOptimization + 'Movzx2Nop 6', p);
+                                  RemoveCurrentP(p);
+                                  p_removed := True;
+                                end
+                              else
+                                taicpu(p).oper[1]^.reg := ThisReg;
+
+                              Result := True;
+                            end
+                          else
+                            DebugMsg(SPeepholeOptimization + 'Movzx2Mov 2', hp1);
+
+                        end;
+                    end
+                  else
+                    InternalError(2020112330);
+
+                  { Now go through every instruction we found and change the
+                    size. If TargetSize = MaxSize, then almost no changes are
+                    needed and Result can remain False if it hasn't been set
+                    yet. }
+
+                  if (TargetSize <> MaxSize) and (InstrMax >= 0) then
+                    begin
+                      for Index := 0 to InstrMax do
+                        begin
+
+                          { If p_removed is true, then the original MOV/Z was removed
+                            and removing the AND instruction may not be safe if it
+                            appears first }
+                          if (InstrList[Index].oper[InstrList[Index].ops - 1]^.typ <> top_reg) then
+                            InternalError(2020112310);
+
+                          if InstrList[Index].oper[0]^.typ = top_reg then
+                            InstrList[Index].oper[0]^.reg := ThisReg;
+
+                          InstrList[Index].oper[InstrList[Index].ops - 1]^.reg := ThisReg;
+                          InstrList[Index].opsize := TargetSize;
+                        end;
+
+                      Result := True;
+                    end;
+
+                  Exit;
+                end;
+
+              else
+                { This includes ADC, SBB, IDIV and SAR }
+                Break;
+            end;
+
+            if (TestValMin < 0) or (TestValMax < 0) or
+              (TestValMin > UpperLimit) or (TestValMax > UpperLimit) then
+              { Overflow }
+              Break
+            else if not SmallerOverflow and (TrySmaller <> S_NO) and
+              ((TestValMin > TrySmallerLimit) or (TestValMax > TrySmallerLimit)) then
+              SmallerOverflow := True;
+
+            { Contains highest index (so instruction count - 1) }
+            Inc(InstrMax);
+            if InstrMax > High(InstrList) then
+              SetLength(InstrList, InstrMax + LIST_STEP_SIZE);
+
+            InstrList[InstrMax] := taicpu(hp1);
+          end;
+      end;
+
+
     function TX86AsmOptimizer.OptPass2Imul(var p : tai) : boolean;
       var
         hp1 : tai;
@@ -6691,6 +7216,41 @@ unit aoptx86;
       end;
 
 
+    function TX86AsmOptimizer.PostPeepholeOptShr(var p : tai) : boolean;
+      var
+        hp1: tai;
+      begin
+        { Detect:
+            shr    x,  %ax (x > 0)
+            ...
+            movzwl %ax,%eax
+
+          Change movzwl %ax,%eax to cwtl (shorter encoding for movswl %ax,%eax)
+        }
+
+        Result := False;
+        if MatchOpType(taicpu(p), top_const, top_reg) and
+          (taicpu(p).oper[1]^.reg = NR_AX) and { This is also enough to determine that opsize = S_W }
+          (taicpu(p).oper[0]^.val > 0) and
+          GetNextInstructionUsingReg(p, hp1, NR_EAX) and
+          MatchInstruction(hp1, A_MOVZX, [S_WL]) and
+          MatchOperand(taicpu(hp1).oper[0]^, NR_AX) and
+          MatchOperand(taicpu(hp1).oper[1]^, NR_EAX) then
+          begin
+            DebugMsg(SPeepholeOptimization + 'Converted movzwl %ax,%eax to cwtl (via ShrMovz2ShrCwtl)', hp1);
+            taicpu(hp1).opcode := A_CWDE;
+            taicpu(hp1).clearop(0);
+            taicpu(hp1).clearop(1);
+            taicpu(hp1).ops := 0;
+
+            { A change was made, but not with p, so move forward 1 }
+            p := tai(p.Next);
+            Result := True;
+          end;
+
+      end;
+
+
     function TX86AsmOptimizer.PostPeepholeOptCmp(var p : tai) : Boolean;
       begin
         Result:=false;
@@ -6864,12 +7424,150 @@ unit aoptx86;
       end;
 
 
-{$ifdef x86_64}
     function TX86AsmOptimizer.PostPeepholeOptMovzx(var p : tai) : Boolean;
+
+      function ConstInRange(const Val: TCGInt; const OpSize: TOpSize): Boolean;
+        begin
+          case OpSize of
+            S_B, S_BW, S_BL{$ifdef x86_64}, S_BQ{$endif x86_64}:
+              Result := (Val <= $FF) and (Val >= -128);
+            S_W, S_WL{$ifdef x86_64}, S_WQ{$endif x86_64}:
+              Result := (Val <= $FFFF) and (Val >= -32768);
+            S_L{$ifdef x86_64}, S_LQ{$endif x86_64}:
+              Result := (Val <= $FFFFFFFF) and (Val >= -2147483648);
+            else
+              Result := True;
+          end;
+        end;
+
       var
+        hp1, hp2 : tai;
+        SizeChange: Boolean;
         PreMessage: string;
       begin
         Result := False;
+
+        if (taicpu(p).oper[0]^.typ = top_reg) and
+          SuperRegistersEqual(taicpu(p).oper[0]^.reg, taicpu(p).oper[1]^.reg) and
+          GetNextInstruction(p, hp1) and (hp1.typ = ait_instruction) then
+          begin
+            { Change (using movzbl %al,%eax as an example):
+
+                movzbl %al, %eax    movzbl %al, %eax
+                cmpl   x,   %eax    testl  %eax,%eax
+
+              To:
+                cmpb   x,   %al     testb  %al, %al  (Move one back to avoid a false dependency)
+                movzbl %al, %eax    movzbl %al, %eax
+
+              Smaller instruction and minimises pipeline stall as the CPU
+              doesn't have to wait for the register to get zero-extended. [Kit]
+
+              Also allow if the smaller of the two registers is being checked,
+              as this still removes the false dependency.
+            }
+            if
+              (
+                (
+                  (taicpu(hp1).opcode = A_CMP) and MatchOpType(taicpu(hp1), top_const, top_reg) and
+                  ConstInRange(taicpu(hp1).oper[0]^.val, taicpu(p).opsize)
+                ) or (
+                  { If MatchOperand returns True, they must both be registers }
+                  (taicpu(hp1).opcode = A_TEST) and MatchOperand(taicpu(hp1).oper[0]^, taicpu(hp1).oper[1]^)
+                )
+              ) and
+              (reg2opsize(taicpu(hp1).oper[1]^.reg) <= reg2opsize(taicpu(p).oper[1]^.reg)) then
+              begin
+                PreMessage := debug_op2str(taicpu(hp1).opcode) + debug_opsize2str(taicpu(hp1).opsize) + ' ' + debug_operstr(taicpu(hp1).oper[0]^) + ',' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' -> ' + debug_op2str(taicpu(hp1).opcode);
+
+                asml.Remove(hp1);
+                asml.InsertBefore(hp1, p);
+
+                { Swap instructions in the case of cmp 0,%reg or test %reg,%reg }
+                if (taicpu(hp1).opcode = A_TEST) or (taicpu(hp1).oper[0]^.val = 0) then
+                  begin
+                    taicpu(hp1).opcode := A_TEST;
+                    taicpu(hp1).loadreg(0, taicpu(p).oper[0]^.reg);
+                  end;
+
+                taicpu(hp1).oper[1]^.reg := taicpu(p).oper[0]^.reg;
+
+                case taicpu(p).opsize of
+                  S_BW, S_BL:
+                    begin
+                      SizeChange := taicpu(hp1).opsize <> S_B;
+                      taicpu(hp1).changeopsize(S_B);
+                    end;
+                  S_WL:
+                    begin
+                      SizeChange := taicpu(hp1).opsize <> S_W;
+                      taicpu(hp1).changeopsize(S_W);
+                    end
+                  else
+                    InternalError(2020112701);
+                end;
+
+                UpdateUsedRegs(tai(p.Next));
+
+                { Check if the register is used aferwards - if not, we can
+                  remove the movzx instruction completely }
+                if not RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg, p, UsedRegs) then
+                  begin
+                    { Hp1 is a better position than p for debugging purposes }
+                    DebugMsg(SPeepholeOptimization + 'Movzx2Nop 4a', hp1);
+                    RemoveCurrentp(p, hp1);
+                    Result := True;
+                  end;
+
+                if SizeChange then
+                  DebugMsg(SPeepholeOptimization + PreMessage +
+                    debug_opsize2str(taicpu(hp1).opsize) + ' ' + debug_operstr(taicpu(hp1).oper[0]^) + ',' + debug_regname(taicpu(hp1).oper[1]^.reg) + ' (smaller and minimises pipeline stall - MovzxCmp2CmpMovzx)', hp1)
+                else
+                  DebugMsg(SPeepholeOptimization + 'MovzxCmp2CmpMovzx', hp1);
+
+                Exit;
+              end;
+
+            { Change (using movzwl %ax,%eax as an example):
+
+                movzwl %ax, %eax
+                movb   %al, (dest)  (Register is smaller than read register in movz)
+
+              To:
+                movb   %al, (dest)  (Move one back to avoid a false dependency)
+                movzwl %ax, %eax
+            }
+            if (taicpu(hp1).opcode = A_MOV) and
+              (taicpu(hp1).oper[0]^.typ = top_reg) and
+              not RegInOp(taicpu(hp1).oper[0]^.reg, taicpu(hp1).oper[1]^) and
+              SuperRegistersEqual(taicpu(hp1).oper[0]^.reg, taicpu(p).oper[0]^.reg) and
+              (reg2opsize(taicpu(hp1).oper[0]^.reg) <= reg2opsize(taicpu(p).oper[0]^.reg)) then
+              begin
+                DebugMsg(SPeepholeOptimization + 'MovzxMov2MovMovzx', hp1);
+
+                hp2 := tai(hp1.Previous); { Effectively the old position of hp1 }
+                asml.Remove(hp1);
+                asml.InsertBefore(hp1, p);
+                if taicpu(hp1).oper[1]^.typ = top_reg then
+                  AllocRegBetween(taicpu(hp1).oper[1]^.reg, hp1, hp2, UsedRegs);
+
+                { Check if the register is used aferwards - if not, we can
+                  remove the movzx instruction completely }
+
+                if not RegUsedAfterInstruction(taicpu(hp1).oper[0]^.reg, p, UsedRegs) then
+                  begin
+                    { Hp1 is a better position than p for debugging purposes }
+                    DebugMsg(SPeepholeOptimization + 'Movzx2Nop 4b', hp1);
+                    RemoveCurrentp(p, hp1);
+                    Result := True;
+                  end;
+
+                Exit;
+              end;
+
+          end;
+
+{$ifdef x86_64}
         { Code size reduction by J. Gareth "Kit" Moreton }
         { Convert MOVZBQ and MOVZWQ to MOVZBL and MOVZWL respectively if it removes the REX prefix }
         if (taicpu(p).opsize in [S_BQ, S_WQ]) and
@@ -6889,9 +7587,11 @@ unit aoptx86;
             DebugMsg(SPeepholeOptimization + PreMessage +
               debug_opsize2str(taicpu(p).opsize) + ' ' + debug_operstr(taicpu(p).oper[0]^) + ',' + debug_regname(taicpu(p).oper[1]^.reg) + ' (removes REX prefix)', p);
           end;
+{$endif}
       end;
 
 
+{$ifdef x86_64}
     function TX86AsmOptimizer.PostPeepholeOptXor(var p : tai) : Boolean;
       var
         PreMessage, RegName: string;

+ 4 - 0
compiler/x86_64/aoptcpu.pas

@@ -163,6 +163,8 @@ uses
               case taicpu(p).opcode of
                 A_MOV:
                   Result:=OptPass2MOV(p);
+                A_MOVZX:
+                  Result:=OptPass2Movx(p);
                 A_IMUL:
                   Result:=OptPass2Imul(p);
                 A_JMP:
@@ -213,6 +215,8 @@ uses
                   Result:=PostPeepholeOptLea(p);
                 A_PUSH:
                   Result:=PostPeepholeOptPush(p);
+                A_SHR:
+                  Result:=PostPeepholeOptShr(p);
                 else
                   ;
               end;

+ 2 - 2
packages/fcl-passrc/src/pastree.pp

@@ -3100,7 +3100,7 @@ begin
   CN:=CN+' '+IntToStr(FRefCount);
   //If Assigned(Parent) then
   //  CN:=CN+' ('+Parent.ClassName+')';
-  Writeln('TPasElement.Release : ',Cn);
+  Writeln('TPasElement.Release : ',Cn,' at ',aId);
   {AllowWriteln-}
   {$endif}
   {$IFDEF CheckPasTreeRefCount}
@@ -3136,7 +3136,7 @@ begin
     Dec(FGlobalRefCount);
     {$endif}
     end;
-{$if defined(debugrefcount) or defined(VerbosePasTreeMem)}  Writeln('TPasElement.Released : ',Cn); {$endif}
+{$if defined(debugrefcount) or defined(VerbosePasTreeMem)}  Writeln('TPasElement.Released : ',Cn,' at ',aID); {$endif}
 end;
 
 procedure TPasElement.ForEachCall(const aMethodCall: TOnForEachPasElement;

+ 3 - 0
packages/fcl-passrc/src/pparser.pp

@@ -3142,7 +3142,10 @@ begin
       FinishedModule;
   finally
     if HasFinished then
+      begin
+      Module.Release{$IFDEF CheckPasTreeRefCount}('TPasPackage.Modules'){$ENDIF};
       FCurModule:=nil; // clear module if there is an error or finished parsing
+      end;
   end;
 end;
 

+ 56 - 0
tests/webtbs/tw38309.pp

@@ -0,0 +1,56 @@
+program c;
+
+{$mode objfpc}
+
+uses
+  Math;
+
+type
+  generic TBase<T> = class
+  private const
+    AConst = 1;
+  private
+    GenVarA: T;
+    GenVarB: T;
+    function Foo: Boolean;
+  end;
+
+  function TBase.Foo: Boolean;
+  begin
+    //Fails with trunk win-64 if TCur type is defined (e.g. not commented out) (*)
+    Result := SameValue(AConst, GenVarB);
+
+    //Fails with trunk win-64, EVEN if TCur definition is commented out
+    //Fails with 3.2.0 win-32, EVEN if TCur definition is commented out
+    //Fails with 3.2.0 win-64, EVEN if TCur definition is commented out, if it is defined it gives the errormesage twice for this line
+    Result := SameValue(GenVarA, GenVarB);
+
+    //Fails with trunk win-64 if TCur type is defined (e.g. not commented out)
+    Result := SameValue(GenVarA, AConst);
+  end;
+
+type
+  TCur = specialize TBase<Currency>;
+
+const
+  CurConst = 1;
+var
+  CurVarA: Currency = 1;
+  CurVarB: Currency = 2;
+
+begin
+  //Fails with trunk win-64
+  SameValue(CurConst, CurVarA);
+
+  //Fails with 3.2.0 win-64
+  SameValue(Currency(CurConst), CurVarA);
+
+  //Fails with 3.2.0 win-64
+  SameValue(CurVarA, CurVarB);
+
+  //Fails with trunk win-64
+  SameValue(CurVarA, CurConst);
+
+  //Fails with 3.2.0 win-64
+  SameValue(CurVarA, Currency(CurConst));
+end.

+ 12 - 0
tests/webtbs/tw38310a.pp

@@ -0,0 +1,12 @@
+{ %NORUN }
+
+program tw38310a;
+
+{$mode objfpc}{$H+}
+
+uses
+  SysUtils, StrUtils, Math;
+
+begin
+  IfThen(true, 'A', IfThen(true, 'B', 'C'));
+end.

+ 12 - 0
tests/webtbs/tw38310b.pp

@@ -0,0 +1,12 @@
+{ %NORUN }
+
+program tw38310b;
+
+{$mode objfpc}{$H+}
+
+uses
+  StrUtils, SysUtils, Math;
+
+begin
+  IfThen(true, 'A', IfThen(true, 'B', 'C'));
+end.

+ 12 - 0
tests/webtbs/tw38310c.pp

@@ -0,0 +1,12 @@
+{ %NORUN }
+
+program tw38310c;
+
+{$mode objfpc}{$H+}
+
+uses
+  StrUtils, Math, SysUtils;
+
+begin
+  IfThen(true, 'A', IfThen(true, 'B', 'C'));
+end.

+ 201 - 196
utils/fpdoc/dw_chm.pp

@@ -322,58 +322,60 @@ var
 
 begin
   DoLog('Generating Table of contents...');
-  if Assigned(Package) then
+  if not Assigned(Package) then
   begin
-    Toc := TChmSiteMap.Create(stTOC);
-    Stream := TMemoryStream.Create;
-    ObjByUnitItem := TOC.Items.NewItem;
-    ObjByUnitItem.Text      := 'Classes and Objects, by Unit';
-    AlphaObjItem := TOC.Items.NewItem;
-    AlphaObjItem.Text       := 'Alphabetical Classes and Objects List';
-    RoutinesByUnitItem := TOC.Items.NewItem;
-    RoutinesByUnitItem.Text := 'Routines, by Unit';
-    AlphaRoutinesItem  := TOC.Items.NewItem;
-    AlphaRoutinesItem.Text  := 'Alphabetical Routines List';
-
-    // objects and classes
-    for i := 0 to Package.Modules.Count - 1 do
+    DoLog('Package is not assigned...');
+    Exit;
+  end;
+  Toc := TChmSiteMap.Create(stTOC);
+  Stream := TMemoryStream.Create;
+  ObjByUnitItem := TOC.Items.NewItem;
+  ObjByUnitItem.Text      := 'Classes and Objects, by Unit';
+  AlphaObjItem := TOC.Items.NewItem;
+  AlphaObjItem.Text       := 'Alphabetical Classes and Objects List';
+  RoutinesByUnitItem := TOC.Items.NewItem;
+  RoutinesByUnitItem.Text := 'Routines, by Unit';
+  AlphaRoutinesItem  := TOC.Items.NewItem;
+  AlphaRoutinesItem.Text  := 'Alphabetical Routines List';
+
+  // objects and classes
+  for i := 0 to Package.Modules.Count - 1 do
+  begin
+    AModule := TPasModule(Package.Modules[i]);
+    If not assigned(AModule.InterfaceSection) Then
+       Continue;
+    ObjUnitItem := ObjByUnitItem.Children.NewItem;
+    ObjUnitItem.Text := AModule.Name;
+    RoutinesUnitItem := RoutinesByUnitItem.Children.NewItem;
+    RoutinesUnitItem.Text := AModule.Name;
+    for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
     begin
-      AModule := TPasModule(Package.Modules[i]);
-      If not assigned(AModule.InterfaceSection) Then
-         Continue;
-      ObjUnitItem := ObjByUnitItem.Children.NewItem;
-      ObjUnitItem.Text := AModule.Name;
-      RoutinesUnitItem := RoutinesByUnitItem.Children.NewItem;
-      RoutinesUnitItem.Text := AModule.Name;
-      for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
-      begin
-        Element := TPasClassType(AModule.InterfaceSection.Classes[j]);
-        // by unit
-        TmpItem := ObjUnitItem.Children.NewItem;
-        TmpItem.Text := Element.Name;
-        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
-        
-        //alpha
-        TmpItem := GetAlphaItem(AlphaObjItem.Children, UpperCase(Copy(Element.Name, 1, 2))).Children.NewItem;
-        TmpItem.Text := Element.Name;
-        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
-        
-      end;
-      
-      // non object procedures and functions
-      for j := 0 to AModule.InterfaceSection.Functions.Count-1 do
-      begin
-        Element := TPasFunctionType(AModule.InterfaceSection.Functions[j]);
-        // by unit
-        TmpItem := RoutinesUnitItem.Children.NewItem;
-        TmpItem.Text := Element.Name;
-        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
-        
-        // alpha
-        TmpItem := GetAlphaItem(AlphaRoutinesItem.Children, UpperCase(Element.Name[1])).Children.NewItem;
-        TmpItem.Text := Element.Name;
-        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
-      end;
+      Element := TPasClassType(AModule.InterfaceSection.Classes[j]);
+      // by unit
+      TmpItem := ObjUnitItem.Children.NewItem;
+      TmpItem.Text := Element.Name;
+      TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
+
+      //alpha
+      TmpItem := GetAlphaItem(AlphaObjItem.Children, UpperCase(Copy(Element.Name, 1, 2))).Children.NewItem;
+      TmpItem.Text := Element.Name;
+      TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
+
+    end;
+
+    // non object procedures and functions
+    for j := 0 to AModule.InterfaceSection.Functions.Count-1 do
+    begin
+      Element := TPasFunctionType(AModule.InterfaceSection.Functions[j]);
+      // by unit
+      TmpItem := RoutinesUnitItem.Children.NewItem;
+      TmpItem.Text := Element.Name;
+      TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
+
+      // alpha
+      TmpItem := GetAlphaItem(AlphaRoutinesItem.Children, UpperCase(Element.Name[1])).Children.NewItem;
+      TmpItem.Text := Element.Name;
+      TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(Element, 0)));
     end;
   end;
   // cleanup
@@ -406,7 +408,7 @@ begin
   end;
 
   if not fnobintoc then
-    fchm.AppendBinaryTOCFromSiteMap(Toc);  
+    fchm.AppendBinaryTOCFromSiteMap(Toc);
   TOC.SaveToStream(Stream);
   TOC.Free;
 
@@ -461,164 +463,166 @@ var
 begin
   DoLog('Generating Index...');
 
-  if Assigned(Package) then
+  if not Assigned(Package) then
   begin
-    Index := TChmSiteMap.Create(stIndex);
-    Stream := TMemoryStream.Create;
-    for i := 0 to Package.Modules.Count - 1 do
+    DoLog('Package is not assigned...');
+    Exit;
+  end;
+  Index := TChmSiteMap.Create(stIndex);
+  Stream := TMemoryStream.Create;
+  for i := 0 to Package.Modules.Count - 1 do
+  //if false then
+  begin
+    AModule := TPasModule(Package.Modules[i]);
+    if not assigned(AModule.InterfaceSection) then
+      continue;
+    ParentItem := Index.Items.NewItem;
+    ParentItem.Text := AModule.Name;
+    ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, 0)));
+
+    //  classes
+    for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
     begin
-      AModule := TPasModule(Package.Modules[i]);
-      if not assigned(AModule.InterfaceSection) then
-        continue;
+      ParentElement := TPasClassType(AModule.InterfaceSection.Classes[j]);
       ParentItem := Index.Items.NewItem;
-      ParentItem.Text := AModule.Name;
-      ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(AModule, 0)));
-
-      //  classes
-      for j := 0 to AModule.InterfaceSection.Classes.Count-1 do
+      ParentItem.Text := ParentELement.Name;
+      ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
+      for k := 0 to TPasClassType(ParentElement).Members.Count-1 do
       begin
-        ParentElement := TPasClassType(AModule.InterfaceSection.Classes[j]);
-        ParentItem := Index.Items.NewItem;
-        ParentItem.Text := ParentELement.Name;
-        ParentItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
-        for k := 0 to TPasClassType(ParentElement).Members.Count-1 do
-        begin
-          TmpElement := TPasElement(TPasClassType(ParentElement).Members.Items[k]);
-          if Engine.HidePrivate and(TmpElement.Visibility = visPrivate) then
-            continue;
-          if Engine.HideProtected and(TmpElement.Visibility = visProtected) then
-            continue;
-          Urls:=FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
-          RedirectUrl:='';
-          if TmpElement is TPasEnumValue then
-             RedirectUrl := UTF8Encode(ResolveLinkIDAbs(tmpElement.Parent.PathName))
-           else
-             RedirectUrl := UTF8Encode(ResolveLinkIDAbs(tmpElement.PathName));
-
-          if(trim(RedirectUrl)<>'') and (RedirectUrl<>urls) then
-            begin
-              //writeln('Hint: Index Resolved:',urls,' to ',RedirectUrl);
-              urls:=RedirectUrl;
-            end;
-
-          TmpItem := ParentItem.Children.NewItem;
-          case ElementType(TmpElement) of
-            cmtProcedure   : TmpItem.Text := TmpElement.Name + ' procedure';
-            cmtFunction    : TmpItem.Text := TmpElement.Name + ' function';
-            cmtConstructor : TmpItem.Text := TmpElement.Name + ' constructor';
-            cmtDestructor  : TmpItem.Text := TmpElement.Name + ' destructor';
-            cmtProperty    : TmpItem.Text := TmpElement.Name + ' property';
-            cmtVariable    : TmpItem.Text := TmpElement.Name + ' variable';
-            cmtInterface   : TmpItem.Text := TmpElement.Name + ' interface';
-            cmtOperator    : TmpItem.Text := TmpElement.Name + ' operator';
-            cmtConstant    : TmpItem.Text := TmpElement.Name + ' const';
-            cmtUnknown     : TmpItem.Text := TmpElement.Name;
+        TmpElement := TPasElement(TPasClassType(ParentElement).Members.Items[k]);
+        if Engine.HidePrivate and(TmpElement.Visibility = visPrivate) then
+          continue;
+        if Engine.HideProtected and(TmpElement.Visibility = visProtected) then
+          continue;
+        Urls:=FixHTMLpath(Allocator.GetFilename(TmpElement, 0));
+        RedirectUrl:='';
+        if TmpElement is TPasEnumValue then
+           RedirectUrl := UTF8Encode(ResolveLinkIDAbs(tmpElement.Parent.PathName))
+         else
+           RedirectUrl := UTF8Encode(ResolveLinkIDAbs(tmpElement.PathName));
+
+        if(trim(RedirectUrl)<>'') and (RedirectUrl<>urls) then
+          begin
+            //writeln('Hint: Index Resolved:',urls,' to ',RedirectUrl);
+            urls:=RedirectUrl;
           end;
-          TmpItem.addLocal(Urls);
-          {
-          ParentElement = Class
-             TmpElement = Member
-          }
-          MemberItem := nil;
-          MemberItem := GetAlphaItem(Index.Items, TmpElement.Name);
-          // ahh! if MemberItem.Local is empty MemberType is not shown!
-          MemberItem.addLocal(Urls);
-
-          TmpItem := MemberItem.Children.NewItem;
-          TmpItem.Text := ParentElement.Name;
-          TmpItem.AddLocal(Urls);
-        end;
-      end;
-      // routines
-      for j := 0 to AModule.InterfaceSection.Functions.Count-1 do
-      begin
-        // routine name
-        ParentElement := TPasElement(AModule.InterfaceSection.Functions[j]);
-        case ElementType(ParentElement) of
-          cmtProcedure   : SName:= ' procedure';
-          cmtFunction    : SName:= ' function';
-          cmtOperator    : SName:= ' operator';
-          //cmtConstant    : SName:= ' const';
-          else             SName:= ' unknown'
+
+        TmpItem := ParentItem.Children.NewItem;
+        case ElementType(TmpElement) of
+          cmtProcedure   : TmpItem.Text := TmpElement.Name + ' procedure';
+          cmtFunction    : TmpItem.Text := TmpElement.Name + ' function';
+          cmtConstructor : TmpItem.Text := TmpElement.Name + ' constructor';
+          cmtDestructor  : TmpItem.Text := TmpElement.Name + ' destructor';
+          cmtProperty    : TmpItem.Text := TmpElement.Name + ' property';
+          cmtVariable    : TmpItem.Text := TmpElement.Name + ' variable';
+          cmtInterface   : TmpItem.Text := TmpElement.Name + ' interface';
+          cmtOperator    : TmpItem.Text := TmpElement.Name + ' operator';
+          cmtConstant    : TmpItem.Text := TmpElement.Name + ' const';
+          cmtUnknown     : TmpItem.Text := TmpElement.Name;
         end;
-        SName:= ParentElement.Name + ' ' + SName;
-        MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
+        TmpItem.addLocal(Urls);
+        {
+        ParentElement = Class
+           TmpElement = Member
+        }
+        MemberItem := nil;
+        MemberItem := GetAlphaItem(Index.Items, TmpElement.Name);
+        // ahh! if MemberItem.Local is empty MemberType is not shown!
+        MemberItem.addLocal(Urls);
+
+        TmpItem := MemberItem.Children.NewItem;
+        TmpItem.Text := ParentElement.Name;
+        TmpItem.AddLocal(Urls);
       end;
-      // consts
-      for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
-      begin
-        ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
-        SName:= ParentElement.Name + ' const';
-        MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
+    end;
+    // routines
+    for j := 0 to AModule.InterfaceSection.Functions.Count-1 do
+    begin
+      // routine name
+      ParentElement := TPasElement(AModule.InterfaceSection.Functions[j]);
+      case ElementType(ParentElement) of
+        cmtProcedure   : SName:= ' procedure';
+        cmtFunction    : SName:= ' function';
+        cmtOperator    : SName:= ' operator';
+        //cmtConstant    : SName:= ' const';
+        else             SName:= ' unknown'
       end;
-      // types
-      for j := 0 to AModule.InterfaceSection.Types.Count-1 do
+      SName:= ParentElement.Name + ' ' + SName;
+      MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
+    end;
+    // consts
+    for j := 0 to AModule.InterfaceSection.Consts.Count-1 do
+    begin
+      ParentElement := TPasElement(AModule.InterfaceSection.Consts[j]);
+      SName:= ParentElement.Name + ' const';
+      MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
+    end;
+    // types
+    for j := 0 to AModule.InterfaceSection.Types.Count-1 do
+    begin
+      ParentElement := TPasType(AModule.InterfaceSection.Types[j]);
+      TmpItem := Index.Items.NewItem;
+      TmpItem.Text := ParentElement.Name;
+      TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
+      // enums
+      if ParentELement is TPasEnumType then
       begin
-        ParentElement := TPasType(AModule.InterfaceSection.Types[j]);
-        TmpItem := Index.Items.NewItem;
-        TmpItem.Text := ParentElement.Name;
-        TmpItem.addLocal(FixHTMLpath(Allocator.GetFilename(ParentElement, 0)));
-        // enums
-        if ParentELement is TPasEnumType then
+        ParentItem := TmpItem;
+        for k := 0 to TPasEnumType(ParentElement).Values.Count-1 do
         begin
-          ParentItem := TmpItem;
-          for k := 0 to TPasEnumType(ParentElement).Values.Count-1 do
-          begin
-            TmpElement := TPasType(TPasEnumType(ParentElement).Values.Items[k]);
-            // subitem
-            TmpItem := ParentItem.Children.NewItem;
-            TmpItem.Text := TmpElement.Name;
-            TmpItem.addLocal(ParentItem.Local);
-            // root level
-            TmpItem := Index.Items.NewItem;
-            TmpItem.Text := TmpElement.Name;
-            TmpItem.addLocal(ParentItem.Local);
-          end;
+          TmpElement := TPasType(TPasEnumType(ParentElement).Values.Items[k]);
+          // subitem
+          TmpItem := ParentItem.Children.NewItem;
+          TmpItem.Text := TmpElement.Name;
+          TmpItem.addLocal(ParentItem.Local);
+          // root level
+          TmpItem := Index.Items.NewItem;
+          TmpItem.Text := TmpElement.Name;
+          TmpItem.addLocal(ParentItem.Local);
         end;
       end;
-      // variables
-      for j := 0 to AModule.InterfaceSection.Variables.Count-1 do
-      begin
-        ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
-        SName:= ParentElement.Name + ' variable';
-        MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
-      end;
-      // declarations
-      {
-      for j := 0 to AModule.InterfaceSection.Declarations.Count-1 do
-      begin
-        ParentElement := TPasElement(AModule.InterfaceSection.Declarations[j]);
-        TmpItem := Index.Items.NewItem;
-        TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
-      end;
-      // resource strings
-      for j := 0 to AModule.InterfaceSection.ResStrings.Count-1 do
-      begin
-        ParentElement := TPasElement(AModule.InterfaceSection.ResStrings[j]);
-        TmpItem := Index.Items.NewItem;
-        TmpItem.Text := ParentElement.Name;
-        TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
-      end;
-      }
     end;
-
-    // Sort
-    Index.Items.Sort(TListSortCompare(@TOCSort));
-    for i := 0 to Index.Items.Count-1 do
+    // variables
+    for j := 0 to AModule.InterfaceSection.Variables.Count-1 do
     begin
-      Index.Items.Item[i].Children.Sort(TListSortCompare(@TOCSort));
+      ParentElement := TPasElement(AModule.InterfaceSection.Variables[j]);
+      SName:= ParentElement.Name + ' variable';
+      MultiAlphaItem(Index.Items, SName, ParentElement, AModule.Name);
     end;
+    // declarations
+    {
+    for j := 0 to AModule.InterfaceSection.Declarations.Count-1 do
+    begin
+      ParentElement := TPasElement(AModule.InterfaceSection.Declarations[j]);
+      TmpItem := Index.Items.NewItem;
+      TmpItem.Text := ParentElement.Name;
+      TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+    end;
+    // resource strings
+    for j := 0 to AModule.InterfaceSection.ResStrings.Count-1 do
+    begin
+      ParentElement := TPasElement(AModule.InterfaceSection.ResStrings[j]);
+      TmpItem := Index.Items.NewItem;
+      TmpItem.Text := ParentElement.Name;
+      TmpItem.Local := FixHTMLpath(Allocator.GetFilename(ParentElement, 0));
+    end;
+    }
+  end;
 
-    // save
-    Index.SaveToStream(Stream);
-    if not fnobinindex then
-      fchm.AppendBinaryindexFromSitemap(index,false);
-    Index.Free;
-    Stream.Position :=0 ;
-    FChm.AppendIndex(Stream);
-    Stream.Free;
+  // Sort
+  Index.Items.Sort(TListSortCompare(@TOCSort));
+  for i := 0 to Index.Items.Count-1 do
+  begin
+    Index.Items.Item[i].Children.Sort(TListSortCompare(@TOCSort));
   end;
+  // save
+  Index.SaveToStream(Stream);
+  if not fnobinindex then
+    fchm.AppendBinaryindexFromSitemap(index,false);
+  Index.Free;
+  Stream.Position :=0 ;
+  FChm.AppendIndex(Stream);
+  Stream.Free;
   DoLog('Generating Index Done');
 end;
 
@@ -646,8 +650,9 @@ begin
   FChm.TempRawStream := FTempUncompressed;
   FChm.OnGetFileData := @RetrieveOtherFiles;
   FChm.OnLastFile := @LastFileAdded;
-  fchm.hasbinarytoc:=not fnobintoc;;
-  fchm.hasbinaryindex:=not fnobinindex;
+  FChm.hasbinarytoc:=not fnobintoc;
+  FChm.hasbinaryindex:=not fnobinindex;
+  //FChm.Cores:=1;
   ProcessOptions;
 
   FileStream := TMemoryStream.Create;
@@ -663,7 +668,7 @@ begin
           WriteHTMLFile(PageDoc, FileStream);
           FChm.AddStreamToArchive(FileName, FilePath, FileStream, True);
         except
-	  on E: Exception do
+          on E: Exception do
             DoLog(Format(SErrCouldNotCreateFile, [FileName, e.Message]));
         end;
       finally
@@ -698,7 +703,7 @@ begin
   FChm.Execute;
   FChm.Free;
   DoLog('Collecting done');
-  // we don't need to free FTempUncompressed
+  // we don't need to free FTempUncompressed it is freed into TFpDocChmWriter
   // FTempUncompressed.Free;
   FOutChm.Free;
   DeleteFile(FTempUncompressedName);