Merge branch 'main' into basemath

compiler/aarch64/aoptcpu.pas

@@ -35,7 +35,7 @@ Interface
       globtype, globals,
       cutils,
       cgbase, cpubase, aasmtai, aasmcpu,
-      aopt, aoptcpub, aoptarm;
+      aopt, aoptcpub, aoptarm, aoptobj;
 
     Type
       TCpuAsmOptimizer = class(TARMAsmOptimizer)
@@ -54,8 +54,6 @@ Interface
       private
         function RemoveSuperfluousFMov(const p: tai; movp: tai; const optimizer: string): boolean;
         function OptPass1Shift(var p: tai): boolean;
-        function OptPostCMP(var p: tai): boolean;
-        function OptPostAnd(var p: tai): Boolean;
         function OptPass1Data(var p: tai): boolean;
         function OptPass1FData(var p: tai): Boolean;
         function OptPass1STP(var p: tai): boolean;
@@ -65,15 +63,33 @@ Interface
         function OptPass1B(var p: tai): boolean;
         function OptPass1SXTW(var p: tai): Boolean;
 
+        function OptPass2CSEL(var p: tai): Boolean;
+        function OptPass2B(var p: tai): Boolean;
         function OptPass2LDRSTR(var p: tai): boolean;
+        function OptPass2MOV(var p: tai): Boolean;
+
+        function PostPeepholeOptAND(var p: tai): Boolean;
+        function PostPeepholeOptCMP(var p: tai): boolean;
+        function PostPeepholeOptTST(var p: tai): Boolean;
+      protected
+        { Like UpdateUsedRegs, but ignores deallocations }
+        class procedure UpdateIntRegsNoDealloc(var AUsedRegs: TAllUsedRegs; p: Tai); static;
+
+        { Attempts to allocate a volatile integer register for use between p and hp,
+          using AUsedRegs for the current register usage information.  Returns NR_NO
+          if no free register could be found }
+        function GetIntRegisterBetween(RegSize: TSubRegister; var AUsedRegs: TAllUsedRegs; p, hp: tai; DontAlloc: Boolean = False): TRegister;
       End;
 
 Implementation
 
   uses
     aasmbase,
+    aoptbase,
     aoptutils,
     cgutils,
+    procinfo,
+    paramgr,
     verbose;
 
 {$ifdef DEBUG_AOPTCPU}
@@ -86,6 +102,60 @@ Implementation
       SPeepholeOptimization = '';
 {$endif DEBUG_AOPTCPU}
 
+      MAX_CSEL_INSTRUCTIONS = 8;
+      MAX_CSEL_REGISTERS = 30;
+
+    type
+      TCSELTrackingState = (tsInvalid, tsSimple, tsDetour, tsBranching,
+        tsDouble, tsDoubleBranchSame, tsDoubleBranchDifferent, tsDoubleSecondBranching,
+        tsProcessed);
+
+      { For OptPass2Jcc }
+      TCSELTracking = object
+      private
+        CSELScore, ConstCount: LongInt;
+
+        RegWrites: array[0..MAX_CSEL_INSTRUCTIONS*2 - 1] of TRegister;
+
+        ConstRegs: array[0..MAX_CSEL_REGISTERS - 1] of TRegister;
+        ConstVals: array[0..MAX_CSEL_REGISTERS - 1] of TCGInt;
+        ConstSizes: array[0..MAX_CSEL_REGISTERS - 1] of TSubRegister; { May not match ConstRegs if one is shared over multiple CSELs. }
+        ConstMovs: array[0..MAX_CSEL_REGISTERS - 1] of tai; { Location of initialisation instruction }
+
+        ConstWriteSizes: array[0..first_int_imreg - 1] of TSubRegister; { Largest size of register written. }
+
+        fOptimizer: TCpuAsmOptimizer;
+
+        fLabel: TAsmSymbol;
+
+        fInsertionPoint,
+        fCondition,
+        fInitialJump,
+        fFirstMovBlock,
+        fFirstMovBlockStop,
+        fSecondJump,
+        fThirdJump,
+        fSecondMovBlock,
+        fSecondMovBlockStop,
+        fMidLabel,
+        fEndLabel,
+        fAllocationRange: tai;
+
+        fState: TCSELTrackingState;
+
+        function TryCSELConst(p, start, stop: tai; var Count: LongInt): Boolean;
+        function InitialiseBlock(BlockStart, OneBeforeBlock: tai; out BlockStop: tai; out EndJump: tai): Boolean;
+        function AnalyseMOVBlock(BlockStart, BlockStop, SearchStart: tai): LongInt;
+      public
+        RegisterTracking: TAllUsedRegs;
+        constructor Init(Optimizer: TCpuAsmOptimizer; var p_initialjump, p_initialmov: tai; var AFirstLabel: TAsmLabel);
+        destructor Done;
+        procedure Process(out new_p: tai);
+        property State: TCSELTrackingState read fState;
+      end;
+
+      PCSELTracking = ^TCSELTracking;
+
   function CanBeCond(p : tai) : boolean;
     begin
       result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None);
@@ -921,6 +991,97 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.OptPass2B(var p: tai): Boolean;
+    var
+      hp1: tai;
+      LabelSym: TAsmLabel;
+      CSELTracking: PCSELTracking;
+    begin
+      Result := False;
+      if (taicpu(p).condition = C_None) and
+        IsJumpToLabel(taicpu(p)) then
+        begin
+          { Check for:
+                B   @lbl
+                ...
+              @Lbl:
+                RET
+
+            Change to:
+                RET (and reduce reference count on label)
+          }
+
+          LabelSym := TAsmLabel(JumpTargetOp(taicpu(p))^.ref^.symbol);
+          hp1 := GetLabelWithSym(LabelSym);
+          if Assigned(hp1) and
+            GetNextInstruction(hp1, hp1) and
+            (hp1.typ = ait_instruction) and
+            (taicpu(hp1).opcode = A_RET) then
+            begin
+              DebugMsg(SPeepholeOptimization + 'B -> RET since a RET immediately follows the destination label (B2Ret)', p);
+              taicpu(p).ops := 0;
+              taicpu(p).clearop(0);
+              taicpu(p).is_jmp := false;
+              taicpu(p).opcode := A_RET;
+
+              { Make sure the label is dereferenced now }
+              LabelSym.decrefs;
+
+              Result := True;
+              Exit;
+            end;
+        end;
+
+
+      if (taicpu(p).condition <> C_None) and
+        IsJumpToLabel(taicpu(p)) and
+        GetNextInstruction(p, hp1) and
+        (hp1.typ = ait_instruction) and
+        (taicpu(hp1).opcode = A_MOV) then
+        begin
+          { check for
+                jCC   xxx
+                <several movs>
+             xxx:
+
+           Also spot:
+                Jcc   xxx
+                <several movs>
+                jmp   xxx
+
+           Change to:
+                <several csets with inverted condition>
+                jmp   xxx  (only for the 2nd case)
+          }
+          CSELTracking := New(PCSELTracking, Init(Self, p, hp1, TAsmLabel(JumpTargetOp(taicpu(p))^.ref^.symbol)));
+
+          if CSELTracking^.State <> tsInvalid then
+            begin
+              CSELTracking^.Process(p);
+              Result := True;
+            end;
+
+          CSELTracking^.Done;
+        end;
+    end;
+
+
+  function TCpuAsmOptimizer.OptPass2CSEL(var p: tai): Boolean;
+    begin
+      Result := False;
+
+      { Csel r0,r1,r1,cond -> mov r0,r1 }
+      if (taicpu(p).oper[1]^.reg = taicpu(p).oper[2]^.reg) then
+        begin
+          DebugMsg(SPeepholeOptimization + 'CSel2Mov (identical true/false registers)', p);
+          taicpu(p).opcode := A_MOV;
+          taicpu(p).ops := 2;
+          Result := True;
+          Exit;
+        end;
+    end;
+
+
   function TCpuAsmOptimizer.OptPass2LDRSTR(var p: tai): boolean;
     var
       hp1, hp1_last: tai;
@@ -1076,7 +1237,55 @@ Implementation
     end;
 
 
-  function TCpuAsmOptimizer.OptPostAnd(var p: tai): Boolean;
+  function TCpuAsmOptimizer.OptPass2MOV(var p: tai): Boolean;
+    var
+      hp1: tai;
+      X: Integer;
+    begin
+      Result := False;
+
+      { Merge MOV and CSEL instructions left behind by OptPass2B - that is,
+        change:
+
+          mov  r0,r1
+          csel r0,r2,r0,cond
+
+        To:
+          csel r0,r2,r1,cond
+
+        (Also if r0 is the second operand)
+      }
+      if (taicpu(p).oper[1]^.typ = top_reg) and
+        GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+        (hp1.typ = ait_instruction) and
+        (taicpu(hp1).opcode = A_CSEL) and
+        (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and
+        not RegModifiedBetween(taicpu(p).oper[1]^.reg, p, hp1) then
+        begin
+          { Use "Result" to note if a change was made so we only have to do
+            expensive register allocation once }
+          for X := 1 to 2 do
+            if (taicpu(hp1).oper[X]^.reg = taicpu(p).oper[0]^.reg) then
+              begin
+                taicpu(hp1).oper[X]^.reg := taicpu(p).oper[1]^.reg;
+                Result := True;
+              end;
+
+          if Result then
+            begin
+              DebugMSg(SPeepholeOptimization + 'MovCSel2CSel', p);
+              { Don't need to allocate the zero register - so save time by
+                skipping it in this case }
+              if getsupreg(taicpu(p).oper[1]^.reg) <> RS_XZR then
+                AllocRegBetween(taicpu(p).oper[1]^.reg, p, hp1, UsedRegs);
+              RemoveCurrentP(p);
+              Exit;
+            end;
+        end;
+    end;
+
+
+  function TCpuAsmOptimizer.PostPeepholeOptAND(var p: tai): Boolean;
     var
       hp1, hp2: tai;
       hp3: taicpu;
@@ -1126,7 +1335,7 @@ Implementation
     end;
 
 
-  function TCpuAsmOptimizer.OptPostCMP(var p : tai): boolean;
+  function TCpuAsmOptimizer.PostPeepholeOptCMP(var p : tai): boolean;
     var
      hp1,hp2: tai;
     begin
@@ -1168,6 +1377,46 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.PostPeepholeOptTST(var p : tai): boolean;
+    var
+      hp1: tai;
+      hp3: taicpu;
+      bitval : cardinal;
+    begin
+      Result:=false;
+      {
+        tst reg1,<const=power of 2>
+        b.e/b.ne label
+
+        into
+
+        tb(n)z reg0,<power of 2>,label
+      }
+      if MatchOpType(taicpu(p),top_reg,top_const) and
+        (PopCnt(QWord(taicpu(p).oper[1]^.val))=1) and
+        GetNextInstruction(p,hp1) and
+        MatchInstruction(hp1,A_B,[C_EQ,C_NE],[PF_None]) then
+        begin
+           bitval:=BsfQWord(qword(taicpu(p).oper[1]^.val));
+           case taicpu(hp1).condition of
+            C_NE:
+              hp3:=taicpu.op_reg_const_ref(A_TBNZ,taicpu(p).oper[0]^.reg,bitval,taicpu(hp1).oper[0]^.ref^);
+            C_EQ:
+              hp3:=taicpu.op_reg_const_ref(A_TBZ,taicpu(p).oper[0]^.reg,bitval,taicpu(hp1).oper[0]^.ref^);
+            else
+              Internalerror(2021100210);
+          end;
+          taicpu(hp3).fileinfo:=taicpu(p).fileinfo;
+          asml.insertafter(hp3, p);
+
+          RemoveInstruction(hp1);
+          RemoveCurrentP(p, hp3);
+          DebugMsg(SPeepholeOptimization + 'TST; B(E/NE) -> TB(Z/NZ) done', p);
+          Result:=true;
+        end;
+    end;
+
+
   function TCpuAsmOptimizer.PrePeepHoleOptsCpu(var p: tai): boolean;
     begin
       result := false;
@@ -1260,9 +1509,19 @@ Implementation
       if p.typ=ait_instruction then
         begin
           case taicpu(p).opcode of
+            A_AND:
+              Result := OptPass2AND(p);
+            A_B:
+              Result := OptPass2B(p);
+            A_CSEL:
+              Result := OptPass2CSEL(p);
+            A_MOV:
+              Result := OptPass2MOV(p);
             A_LDR,
             A_STR:
-              Result:=OptPass2LDRSTR(p);
+              Result := OptPass2LDRSTR(p);
+            A_TST:
+              Result := OptPass2TST(p);
             else
               ;
           end;
@@ -1277,15 +1536,812 @@ Implementation
         begin
           case taicpu(p).opcode of
             A_CMP:
-              Result:=OptPostCMP(p);
+              Result:=PostPeepholeOptCMP(p);
             A_AND:
-              Result:=OptPostAnd(p);
+              Result:=PostPeepholeOptAND(p);
+            A_TST:
+              Result:=PostPeepholeOptTST(p);
             else
               ;
           end;
         end;
     end;
 
+
+  class procedure TCpuAsmOptimizer.UpdateIntRegsNoDealloc(var AUsedRegs: TAllUsedRegs; p: Tai);
+    begin
+      { Update integer registers, ignoring deallocations }
+      repeat
+        while assigned(p) and
+              ((p.typ in (SkipInstr - [ait_RegAlloc])) or
+               (p.typ = ait_label) or
+               ((p.typ = ait_marker) and
+                (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do
+             p := tai(p.next);
+        while assigned(p) and
+              (p.typ=ait_RegAlloc) Do
+          begin
+            if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then
+              begin
+                case tai_regalloc(p).ratype of
+                  ra_alloc :
+                    IncludeRegInUsedRegs(tai_regalloc(p).reg, AUsedRegs);
+                  else
+                    ;
+                end;
+              end;
+            p := tai(p.next);
+          end;
+      until not(assigned(p)) or
+            (not(p.typ in SkipInstr) and
+             not((p.typ = ait_label) and
+                 labelCanBeSkipped(tai_label(p))));
+    end;
+
+  { Attempts to allocate a volatile integer register for use between p and hp,
+    using AUsedRegs for the current register usage information.  Returns NR_NO
+    if no free register could be found }
+  function TCpuAsmOptimizer.GetIntRegisterBetween(RegSize: TSubRegister; var AUsedRegs: TAllUsedRegs; p, hp: tai; DontAlloc: Boolean = False): TRegister;
+    var
+      RegSet: TCPURegisterSet;
+      CurrentSuperReg: Integer;
+      CurrentReg: TRegister;
+      Currentp: tai;
+      Breakout: Boolean;
+    begin
+      Result := NR_NO;
+      RegSet :=
+        paramanager.get_volatile_registers_int(current_procinfo.procdef.proccalloption) +
+        current_procinfo.saved_regs_int;
+(*
+      { Don't use the frame register unless explicitly allowed (fixes i40111) }
+      if ([cs_useebp, cs_userbp] * current_settings.optimizerswitches) = [] then
+        Exclude(RegSet, RS_FRAME_POINTER_REG);
+*)
+      for CurrentSuperReg in RegSet do
+        begin
+          CurrentReg := newreg(R_INTREGISTER, TSuperRegister(CurrentSuperReg), RegSize);
+          if not AUsedRegs[R_INTREGISTER].IsUsed(CurrentReg)
+            then
+            begin
+              Currentp := p;
+              Breakout := False;
+              while not Breakout and GetNextInstruction(Currentp, Currentp) and (Currentp <> hp) do
+                begin
+                  case Currentp.typ of
+                    ait_instruction:
+                      begin
+                        if RegInInstruction(CurrentReg, Currentp) then
+                          begin
+                            Breakout := True;
+                            Break;
+
+                          end;
+                        { Cannot allocate across an unconditional jump }
+                        if is_calljmpmaybeuncondret(taicpu(Currentp).opcode) and (taicpu(Currentp).condition = C_None) then
+                          Exit;
+                      end;
+                    ait_marker:
+                      { Don't try anything more if a marker is hit }
+                      Exit;
+                    ait_regalloc:
+                      if (tai_regalloc(Currentp).ratype <> ra_dealloc) and SuperRegistersEqual(CurrentReg, tai_regalloc(Currentp).reg) then
+                        begin
+                          Breakout := True;
+                          Break;
+                        end;
+                    else
+                      ;
+                  end;
+                end;
+
+              if Breakout then
+                { Try the next register }
+                Continue;
+
+              { We have a free register available }
+              Result := CurrentReg;
+              if not DontAlloc then
+                AllocRegBetween(CurrentReg, p, hp, AUsedRegs);
+              Exit;
+            end;
+        end;
+    end;
+
+
+  function TCSELTracking.InitialiseBlock(BlockStart, OneBeforeBlock: tai; out BlockStop: tai; out EndJump: tai): Boolean;
+    begin
+      Result := False;
+      EndJump := nil;
+      BlockStop := nil;
+
+      while (BlockStart <> fOptimizer.BlockEnd) and
+        { stop on labels }
+        (BlockStart.typ <> ait_label) do
+        begin
+          { Keep track of all integer registers that are used }
+          fOptimizer.UpdateIntRegsNoDealloc(RegisterTracking, tai(OneBeforeBlock.Next));
+          if BlockStart.typ = ait_instruction then
+            begin
+              if MatchInstruction(BlockStart, A_B, [C_None], []) then
+                begin
+                  if not IsJumpToLabel(taicpu(BlockStart)) or
+                    (JumpTargetOp(taicpu(BlockStart))^.ref^.index <> NR_NO) then
+                    Exit;
+
+                  EndJump := BlockStart;
+                  Break;
+                end
+              { Check to see if we have a valid MOV instruction instead }
+              else if (taicpu(BlockStart).opcode <> A_MOV) or
+                { Can't include the stack pointer in CSEL }
+                fOptimizer.RegInInstruction(NR_SP, BlockStart) then
+                begin
+                  Exit;
+                end
+              else
+                { This will be a valid MOV }
+                fAllocationRange := BlockStart;
+            end;
+
+          OneBeforeBlock := BlockStart;
+          fOptimizer.GetNextInstruction(BlockStart, BlockStart);
+        end;
+
+      if (BlockStart = fOptimizer.BlockEnd) then
+        Exit;
+
+      BlockStop := BlockStart;
+      Result := True;
+    end;
+
+
+  function TCSELTracking.AnalyseMOVBlock(BlockStart, BlockStop, SearchStart: tai): LongInt;
+    var
+      hp1: tai;
+      RefModified: Boolean;
+    begin
+      Result := 0;
+      hp1 := BlockStart;
+      RefModified := False; { As long as the condition is inverted, this can be reset }
+
+      while assigned(hp1) and
+        (hp1 <> BlockStop) do
+        begin
+          case hp1.typ of
+            ait_instruction:
+              if MatchInstruction(hp1, A_MOV, []) then
+                begin
+                  Inc(Result);
+                  if taicpu(hp1).oper[1]^.typ = top_reg then
+                    begin
+                      Inc(Result);
+                    end
+                  else if not (cs_opt_size in current_settings.optimizerswitches) and
+                    { CSEL with constants grows the code size }
+                    TryCSELConst(hp1, SearchStart, BlockStop, Result) then
+                    begin
+                      { Register was reserved by TryCSELConst and
+                        stored on ConstRegs }
+                    end
+                  else
+                    begin
+                      Result := -1;
+                      Exit;
+                    end;
+                end
+              else
+                begin
+                  Result := -1;
+                  Exit;
+                end;
+            else
+              { Most likely an align };
+          end;
+          fOptimizer.GetNextInstruction(hp1, hp1);
+        end;
+    end;
+
+
+  constructor TCSELTracking.Init(Optimizer: TCpuAsmOptimizer; var p_initialjump, p_initialmov: tai; var AFirstLabel: TAsmLabel);
+
+    { For the tsBranching type, increase the weighting score to account for the new conditional jump
+      (this is done as a separate stage because the double types are extensions of the branching type,
+      but we can't discount the conditional jump until the last step) }
+    procedure EvaluateBranchingType;
+      begin
+        Inc(CSELScore);
+        if (CSELScore > MAX_CSEL_INSTRUCTIONS) then
+          { Too many instructions to be worthwhile }
+          fState := tsInvalid;
+      end;
+
+    var
+      hp1: tai;
+      Count: Integer;
+    begin
+      { Table of valid CSEL block types
+
+        Block type                  2nd Jump    Mid-label   2nd MOVs    3rd Jump    End-label
+        ----------                  ---------   ---------   ---------   ---------   ---------
+        tsSimple                        X          Yes          X           X           X
+        tsDetour                      = 1st         X           X           X           X
+        tsBranching                  <> Mid        Yes          X           X           X
+        tsDouble                    End-label      Yes *       Yes          X          Yes
+        tsDoubleBranchSame           <> Mid        Yes *       Yes        = 2nd         X
+        tsDoubleBranchDifferent      <> Mid        Yes *       Yes       <> 2nd         X
+        tsDoubleSecondBranching     End-label      Yes *       Yes       <> 2nd        Yes
+
+        * Only one reference allowed
+      }
+
+      hp1 := nil; { To prevent compiler warnings }
+
+      Optimizer.CopyUsedRegs(RegisterTracking);
+      fOptimizer := Optimizer;
+      fLabel := AFirstLabel;
+
+      CSELScore := 0;
+      ConstCount := 0;
+
+      { Initialise RegWrites, ConstRegs, ConstVals, ConstSizes, ConstWriteSizes and ConstMovs }
+      FillChar(RegWrites[0], MAX_CSEL_INSTRUCTIONS * 2 * SizeOf(TRegister), 0);
+      FillChar(ConstRegs[0], MAX_CSEL_REGISTERS * SizeOf(TRegister), 0);
+      FillChar(ConstVals[0], MAX_CSEL_REGISTERS * SizeOf(TCGInt), 0);
+      FillChar(ConstSizes[0], MAX_CSEL_REGISTERS * SizeOf(TSubRegister), 0);
+      FillChar(ConstWriteSizes[0], first_int_imreg * SizeOf(TOpSize), 0);
+      FillChar(ConstMovs[0], MAX_CSEL_REGISTERS * SizeOf(taicpu), 0);
+
+      fInsertionPoint := p_initialjump;
+      fCondition := nil;
+      fInitialJump := p_initialjump;
+      fFirstMovBlock := p_initialmov;
+      fFirstMovBlockStop := nil;
+
+      fSecondJump := nil;
+      fSecondMovBlock := nil;
+      fSecondMovBlockStop := nil;
+
+      fMidLabel := nil;
+
+      fSecondJump := nil;
+      fSecondMovBlock := nil;
+
+      fEndLabel := nil;
+
+      fAllocationRange := nil;
+
+      { Assume it all goes horribly wrong! }
+      fState := tsInvalid;
+
+      { Look backwards at the comparisons to get an accurate picture of register usage and a better position for any MOV const,reg insertions }
+      if Optimizer.GetLastInstruction(p_initialjump, fCondition) and
+        (
+          MatchInstruction(fCondition, [A_CMP, A_CMN, A_TST], []) or
+          (
+            (fCondition.typ = ait_instruction) and
+            (taicpu(fCondition).opcode = A_AND) and
+            (taicpu(fCondition).oppostfix = PF_S)
+          )
+        ) then
+        begin
+          { Mark all the registers in the comparison as 'in use', even if they've just been deallocated }
+          for Count := 0 to taicpu(fCondition).ops - 1 do
+            with taicpu(fCondition).oper[Count]^ do
+              case typ of
+                top_reg:
+                  if getregtype(reg) = R_INTREGISTER then
+                    Optimizer.IncludeRegInUsedRegs(reg, RegisterTracking);
+                top_ref:
+                  begin
+                    if
+                      (ref^.base <> NR_NO) then
+                      Optimizer.IncludeRegInUsedRegs(ref^.base, RegisterTracking);
+
+                    if (ref^.index <> NR_NO) then
+                      Optimizer.IncludeRegInUsedRegs(ref^.index, RegisterTracking);
+                  end
+                else
+                  ;
+              end;
+
+          { When inserting instructions before hp_prev, try to insert them
+            before the allocation of the FLAGS register }
+          if not SetAndTest(Optimizer.FindRegAllocBackward(NR_DEFAULTFLAGS, tai(fCondition.Previous)), fInsertionPoint) or
+            (tai_regalloc(fInsertionPoint).ratype = ra_dealloc) then
+            { If not found, set it equal to the condition so it's something sensible }
+            fInsertionPoint := fCondition;
+
+        end
+      else
+        fCondition := nil;
+
+      { When inserting instructions, try to insert them before the allocation of the FLAGS register }
+      if SetAndTest(Optimizer.FindRegAllocBackward(NR_DEFAULTFLAGS, tai(p_initialjump.Previous)), hp1) and
+        (tai_regalloc(hp1).ratype <> ra_dealloc) then
+        { If not found, set it equal to p so it's something sensible }
+        fInsertionPoint := hp1;
+
+      hp1 := p_initialmov;
+
+      if not InitialiseBlock(p_initialmov, p_initialjump, fFirstMovBlockStop, fSecondJump) then
+        Exit;
+
+      hp1 := fFirstMovBlockStop; { Will either be on a label or a jump }
+
+      if (hp1.typ <> ait_label) then { should be on a jump }
+        begin
+          if not Optimizer.GetNextInstruction(hp1, fMidLabel) or (fMidLabel.typ <> ait_label) then
+            { Need a label afterwards }
+            Exit;
+        end
+      else
+        fMidLabel := hp1;
+
+      if tai_label(fMidLabel).labsym <> AFirstLabel then
+        { Not the correct label }
+        fMidLabel := nil;
+
+      if not Assigned(fSecondJump) and not Assigned(fMidLabel) then
+        { If there's neither a 2nd jump nor correct label, then it's invalid
+          (see above table) }
+        Exit;
+
+      { Analyse the first block of MOVs more closely }
+      CSELScore := AnalyseMOVBlock(fFirstMovBlock, fFirstMovBlockStop, fInsertionPoint);
+
+      if Assigned(fSecondJump) then
+        begin
+          if (JumpTargetOp(taicpu(fSecondJump))^.ref^.symbol = AFirstLabel) then
+            begin
+              fState := tsDetour
+            end
+          else
+            begin
+              { Need the correct mid-label for this one }
+              if not Assigned(fMidLabel) then
+                Exit;
+
+              fState := tsBranching;
+            end;
+        end
+      else
+        { No jump. but mid-label is present }
+        fState := tsSimple;
+
+      if (CSELScore > MAX_CSEL_INSTRUCTIONS) or (CSELScore <= 0) then
+        begin
+          { Invalid or too many instructions to be worthwhile }
+          fState := tsInvalid;
+          Exit;
+        end;
+
+
+      { check further for
+             b     xxx
+             <several movs 1>
+             bl    yyy
+         xxx:
+             <several movs 2>
+         yyy:
+
+        etc.
+      }
+      if (fState = tsBranching) and
+        { Estimate for required savings for extra jump }
+        (CSELScore <= MAX_CSEL_INSTRUCTIONS - 1) and
+        { Only one reference is allowed for double blocks }
+        (AFirstLabel.getrefs = 1) then
+        begin
+          Optimizer.GetNextInstruction(fMidLabel, hp1);
+          fSecondMovBlock := hp1;
+
+          if not InitialiseBlock(fSecondMovBlock, fMidLabel, fSecondMovBlockStop, fThirdJump) then
+            begin
+              EvaluateBranchingType;
+              Exit;
+            end;
+
+          hp1 := fSecondMovBlockStop; { Will either be on a label or a jump }
+
+          if (hp1.typ <> ait_label) then { should be on a jump }
+            begin
+              if not Optimizer.GetNextInstruction(hp1, fEndLabel) or (fEndLabel.typ <> ait_label) then
+                begin
+                  { Need a label afterwards }
+                  EvaluateBranchingType;
+                  Exit;
+                end;
+            end
+          else
+            fEndLabel := hp1;
+
+          if tai_label(fEndLabel).labsym <> JumpTargetOp(taicpu(fSecondJump))^.ref^.symbol then
+            { Second jump doesn't go to the end }
+            fEndLabel := nil;
+
+          if not Assigned(fThirdJump) and not Assigned(fEndLabel) then
+            begin
+            { If there's neither a 3rd jump nor correct end label, then it's
+              not a invalid double block, but is a valid single branching
+              block (see above table) }
+              EvaluateBranchingType;
+              Exit;
+            end;
+
+          Count := AnalyseMOVBlock(fSecondMovBlock, fSecondMovBlockStop, fMidLabel);
+
+          if (Count > MAX_CSEL_INSTRUCTIONS) or (Count <= 0) then
+            { Invalid or too many instructions to be worthwhile }
+            Exit;
+
+          Inc(CSELScore, Count);
+
+          if Assigned(fThirdJump) then
+            begin
+              if not Assigned(fSecondJump) then
+                fState := tsDoubleSecondBranching
+              else if (JumpTargetOp(taicpu(fSecondJump))^.ref^.symbol = JumpTargetOp(taicpu(fThirdJump))^.ref^.symbol) then
+                fState := tsDoubleBranchSame
+              else
+                fState := tsDoubleBranchDifferent;
+            end
+          else
+            fState := tsDouble;
+        end;
+
+      if fState = tsBranching then
+        EvaluateBranchingType;
+    end;
+
+  { Tries to convert a mov const,%reg instruction into a CSEL by reserving a
+    new register to store the constant }
+  function TCSELTracking.TryCSELConst(p, start, stop: tai; var Count: LongInt): Boolean;
+    var
+      RegSize: TSubRegister;
+      CurrentVal: TCGInt;
+      ANewReg: TRegister;
+      X: ShortInt;
+    begin
+      Result := False;
+
+      if not MatchOpType(taicpu(p), top_reg, top_const) then
+        Exit;
+
+      if ConstCount >= MAX_CSEL_REGISTERS then
+        { Arrays are full }
+        Exit;
+
+      { See if the value has already been reserved for another CSEL instruction }
+      CurrentVal := taicpu(p).oper[1]^.val;
+      RegSize := getsubreg(taicpu(p).oper[0]^.reg);
+      for X := 0 to ConstCount - 1 do
+        if ConstVals[X] = CurrentVal then
+          begin
+            ConstRegs[ConstCount] := ConstRegs[X];
+            ConstSizes[ConstCount] := RegSize;
+            ConstVals[ConstCount] := CurrentVal;
+
+            Inc(ConstCount);
+            Inc(Count);
+
+            Result := True;
+            Exit;
+          end;
+
+      ANewReg := fOptimizer.GetIntRegisterBetween(R_SUBWHOLE, RegisterTracking, start, stop, True);
+      if ANewReg = NR_NO then
+        { No free registers }
+        Exit;
+
+      { Reserve the register so subsequent TryCSELConst calls don't all end
+        up vying for the same register }
+      fOptimizer.IncludeRegInUsedRegs(ANewReg, RegisterTracking);
+
+      ConstRegs[ConstCount] := ANewReg;
+      ConstSizes[ConstCount] := RegSize;
+      ConstVals[ConstCount] := CurrentVal;
+
+      Inc(ConstCount);
+      Inc(Count);
+
+      Result := True;
+    end;
+
+  destructor TCSELTracking.Done;
+    begin
+      TAOptObj.ReleaseUsedRegs(RegisterTracking);
+    end;
+
+  procedure TCSELTracking.Process(out new_p: tai);
+    var
+      Count, Writes: LongInt;
+      RegMatch: Boolean;
+      hp1, hp_new: tai;
+      inverted_condition, condition: TAsmCond;
+    begin
+      if (fState in [tsInvalid, tsProcessed]) then
+        InternalError(2023110702);
+
+      { Repurpose RegisterTracking to mark registers that we've defined }
+      RegisterTracking[R_INTREGISTER].Clear;
+
+      Count := 0;
+      Writes := 0;
+      condition := taicpu(fInitialJump).condition;
+      inverted_condition := inverse_cond(condition);
+
+      { Exclude tsDoubleBranchDifferent from this check, as the second block
+        doesn't get CSELs in this case }
+      if (fState in [tsDouble, tsDoubleBranchSame, tsDoubleSecondBranching]) then
+        begin
+          { Include the jump in the flag tracking }
+          if Assigned(fThirdJump) then
+            begin
+              if (fState = tsDoubleBranchSame) then
+                begin
+                  { Will be an unconditional jump, so track to the instruction before it }
+                  if not fOptimizer.GetLastInstruction(fThirdJump, hp1) then
+                    InternalError(2023110712);
+                end
+              else
+                hp1 := fThirdJump;
+            end
+          else
+            hp1 := fSecondMovBlockStop;
+        end
+      else
+        begin
+          { Include a conditional jump in the flag tracking }
+          if Assigned(fSecondJump) then
+            begin
+              if (fState = tsDetour) then
+                begin
+                  { Will be an unconditional jump, so track to the instruction before it }
+                  if not fOptimizer.GetLastInstruction(fSecondJump, hp1) then
+                    InternalError(2023110713);
+                end
+              else
+                hp1 := fSecondJump;
+            end
+          else
+            hp1 := fFirstMovBlockStop;
+        end;
+
+      fOptimizer.AllocRegBetween(NR_DEFAULTFLAGS, fInitialJump, hp1, fOptimizer.UsedRegs);
+
+      { Process the second set of MOVs first, because if a destination
+        register is shared between the first and second MOV sets, it is more
+        efficient to turn the first one into a MOV instruction and place it
+        before the CMP if possible, but we won't know which registers are
+        shared until we've processed at least one list, so we might as well
+        make it the second one since that won't be modified again. }
+
+      if (fState in [tsDouble, tsDoubleBranchSame, tsDoubleBranchDifferent, tsDoubleSecondBranching]) then
+        begin
+          hp1 := fSecondMovBlock;
+          repeat
+            if not Assigned(hp1) then
+              InternalError(2018062902);
+
+            if (hp1.typ = ait_instruction) then
+              begin
+                { Extra safeguard }
+                if (taicpu(hp1).opcode <> A_MOV) then
+                  InternalError(2018062903);
+
+                { Note: tsDoubleBranchDifferent is essentially identical to
+                  tsBranching and the 2nd block is best left largely
+                  untouched, but we need to evaluate which registers the MOVs
+                  write to in order to track what would be complementary CSEL
+                  pairs that can be further optimised. [Kit] }
+                if fState <> tsDoubleBranchDifferent then
+                  begin
+                    if taicpu(hp1).oper[1]^.typ = top_const then
+                      begin
+                        RegMatch := False;
+
+                        for Count := 0 to ConstCount - 1 do
+                          if (ConstVals[Count] = taicpu(hp1).oper[1]^.val) and
+                            (getsubreg(taicpu(hp1).oper[0]^.reg) = ConstSizes[Count]) then
+                            begin
+                              RegMatch := True;
+
+                              { If it's in RegisterTracking, then this register
+                                is being used more than once and hence has
+                                already had its value defined (it gets added to
+                                UsedRegs through AllocRegBetween below) }
+                              if not RegisterTracking[R_INTREGISTER].IsUsed(ConstRegs[Count]) then
+                                begin
+                                  hp_new := tai(hp1.getcopy);
+                                  taicpu(hp_new).oper[0]^.reg := ConstRegs[Count];
+                                  taicpu(hp_new).fileinfo := taicpu(fInitialJump).fileinfo;
+
+                                  fOptimizer.asml.InsertBefore(hp_new, fInsertionPoint);
+                                  fOptimizer.IncludeRegInUsedRegs(ConstRegs[Count], RegisterTracking);
+
+                                  ConstMovs[Count] := hp_new;
+                                end
+                              else
+                                { We just need an instruction between hp_prev and hp1
+                                  where we know the register is marked as in use }
+                                hp_new := fSecondMovBlock;
+
+                              { Keep track of largest write for this register so it can be optimised later }
+                              if (getsubreg(taicpu(hp1).oper[0]^.reg) > ConstWriteSizes[getsupreg(ConstRegs[Count])]) then
+                                ConstWriteSizes[getsupreg(ConstRegs[Count])] := getsubreg(taicpu(hp1).oper[0]^.reg);
+
+                              fOptimizer.AllocRegBetween(ConstRegs[Count], hp_new, hp1, fOptimizer.UsedRegs);
+                              taicpu(hp1).loadreg(1, newreg(R_INTREGISTER, getsupreg(ConstRegs[Count]), ConstSizes[Count]));
+                              Break;
+                            end;
+
+                        if not RegMatch then
+                          InternalError(2021100413);
+                      end;
+
+                    taicpu(hp1).opcode := A_CSEL;
+                    taicpu(hp1).ops := 4;
+                    taicpu(hp1).loadreg(2, taicpu(hp1).oper[0]^.reg);
+                    taicpu(hp1).loadconditioncode(3, condition);
+                  end;
+
+                { Store these writes to search for duplicates later on }
+                RegWrites[Writes] := taicpu(hp1).oper[0]^.reg;
+                Inc(Writes);
+              end;
+
+            fOptimizer.GetNextInstruction(hp1, hp1);
+          until (hp1 = fSecondMovBlockStop);
+        end;
+
+      { Now do the first set of MOVs }
+      hp1 := fFirstMovBlock;
+      repeat
+        if not Assigned(hp1) then
+          InternalError(2018062904);
+
+        if (hp1.typ = ait_instruction) then
+          begin
+            RegMatch := False;
+
+            { Extra safeguard }
+            if (taicpu(hp1).opcode <> A_MOV) then
+              InternalError(2018062905);
+
+            { Search through the RegWrites list to see if there are any
+              opposing CSEL pairs that write to the same register }
+            for Count := 0 to Writes - 1 do
+              if (RegWrites[Count] = taicpu(hp1).oper[0]^.reg) then
+                begin
+                  { We have a match.  Keep this as a MOV }
+
+                  { Move ahead in preparation }
+                  fOptimizer.GetNextInstruction(hp1, hp1);
+
+                  RegMatch := True;
+                  Break;
+                end;
+
+            if RegMatch then
+              Continue;
+
+            if taicpu(hp1).oper[1]^.typ = top_const then
+              begin
+                for Count := 0 to ConstCount - 1 do
+                  if (ConstVals[Count] = taicpu(hp1).oper[1]^.val) and
+                    (getsubreg(taicpu(hp1).oper[0]^.reg) = ConstSizes[Count]) then
+                    begin
+                      RegMatch := True;
+
+                      { If it's in RegisterTracking, then this register is
+                        being used more than once and hence has already had
+                        its value defined (it gets added to UsedRegs through
+                        AllocRegBetween below) }
+                      if not RegisterTracking[R_INTREGISTER].IsUsed(ConstRegs[Count]) then
+                        begin
+                          hp_new := tai(hp1.getcopy);
+                          taicpu(hp_new).oper[0]^.reg := ConstRegs[Count];
+                          taicpu(hp_new).fileinfo := taicpu(fInitialJump).fileinfo;
+
+                          fOptimizer.asml.InsertBefore(hp_new, fInsertionPoint);
+                          fOptimizer.IncludeRegInUsedRegs(ConstRegs[Count], RegisterTracking);
+
+                          ConstMovs[Count] := hp_new;
+                        end
+                      else
+                        { We just need an instruction between hp_prev and hp1
+                          where we know the register is marked as in use }
+                          hp_new := fFirstMovBlock;
+
+                      { Keep track of largest write for this register so it can be optimised later }
+                      if (getsubreg(taicpu(hp1).oper[0]^.reg) > ConstWriteSizes[getsupreg(ConstRegs[Count])]) then
+                        ConstWriteSizes[getsupreg(ConstRegs[Count])] := getsubreg(taicpu(hp1).oper[0]^.reg);
+
+                      fOptimizer.AllocRegBetween(ConstRegs[Count], hp_new, hp1, fOptimizer.UsedRegs);
+                      taicpu(hp1).loadreg(1, newreg(R_INTREGISTER, getsupreg(ConstRegs[Count]), ConstSizes[Count]));
+                      Break;
+                    end;
+
+                if not RegMatch then
+                  InternalError(2021100412);
+              end;
+
+              taicpu(hp1).opcode := A_CSEL;
+              taicpu(hp1).ops := 4;
+              taicpu(hp1).loadreg(2, taicpu(hp1).oper[0]^.reg);
+              taicpu(hp1).loadconditioncode(3, inverted_condition);
+
+            if (fState = tsDoubleBranchDifferent) then
+              begin
+                { Store these writes to search for duplicates later on }
+                RegWrites[Writes] := taicpu(hp1).oper[0]^.reg;
+                Inc(Writes);
+              end;
+          end;
+
+        fOptimizer.GetNextInstruction(hp1, hp1);
+      until (hp1 = fFirstMovBlockStop);
+
+      { Update initialisation MOVs to the smallest possible size }
+      for Count := 0 to ConstCount - 1 do
+        if Assigned(ConstMovs[Count]) then
+          setsubreg(taicpu(ConstMovs[Count]).oper[0]^.reg, ConstWriteSizes[Word(ConstRegs[Count])]);
+
+      case fState of
+        tsSimple:
+          begin
+            fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Simple type)', fInitialJump);
+            { No branch to delete }
+          end;
+        tsDetour:
+          begin
+            fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Detour type)', fInitialJump);
+            { Preserve jump }
+          end;
+        tsBranching, tsDoubleBranchDifferent:
+          begin
+            if (fState = tsBranching) then
+              fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Branching type)', fInitialJump)
+            else
+              fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Double branching (different) type)', fInitialJump);
+            taicpu(fSecondJump).condition := inverted_condition;
+          end;
+        tsDouble, tsDoubleBranchSame:
+          begin
+            if (fState = tsDouble) then
+              fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Double type)', fInitialJump)
+            else
+              fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Double branching (same) type)', fInitialJump);
+            { Delete second jump }
+            JumpTargetOp(taicpu(fSecondJump))^.ref^.symbol.decrefs;
+            fOptimizer.RemoveInstruction(fSecondJump);
+          end;
+        tsDoubleSecondBranching:
+          begin
+            fOptimizer.DebugMsg(SPeepholeOptimization + 'CSEL Block (Double, second branching type)', fInitialJump);
+            { Delete second jump, preserve third jump as conditional }
+            JumpTargetOp(taicpu(fSecondJump))^.ref^.symbol.decrefs;
+            fOptimizer.RemoveInstruction(fSecondJump);
+            taicpu(fThirdJump).condition := condition;
+          end;
+        else
+          InternalError(2023110721);
+      end;
+
+      { Now we can safely decrement the reference count }
+      tasmlabel(fLabel).decrefs;
+
+      fOptimizer.UpdateUsedRegs(tai(fInitialJump.next));
+
+      { Remove the original jump }
+      fOptimizer.RemoveInstruction(fInitialJump); { Note, the choice to not use RemoveCurrentp is deliberate }
+
+      new_p := fFirstMovBlock; { Appears immediately after the initial jump }
+
+      fState := tsProcessed;
+    end;
+
 begin
   casmoptimizer:=TCpuAsmOptimizer;
 End.

compiler/aarch64/cgcpu.pas

@@ -1436,7 +1436,9 @@ implementation
       begin
         { add/sub instructions have only positive immediate operands }
         if (op in [OP_ADD,OP_SUB]) and
-           (a<0) then
+           (a<0) and
+           { this might result in a false positive overflow in case of a+0 }
+           (a<>$8000000000000000) then
           begin
             if op=OP_ADD then
               op:=op_SUB

compiler/aarch64/cpubase.pas

@@ -324,6 +324,7 @@ unit cpubase;
     function reg_cgsize(const reg: tregister) : tcgsize;
     function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+    function is_calljmpmaybeuncondret(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
     procedure inverse_flags(var f: TResFlags);
     function flags_to_cond(const f: TResFlags) : TAsmCond;
     function findreg_by_number(r:Tregister):tregisterindex;
@@ -451,6 +452,13 @@ unit cpubase;
       end;
 
 
+    function is_calljmpmaybeuncondret(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
+      begin
+        { Note that the caller still has to check the instruction's condition }
+        is_calljmpmaybeuncondret:=(o in [A_B,A_BL,A_BLR,A_RET]);
+      end;
+
+
     procedure inverse_flags(var f: TResFlags);
       const
         inv_flags: array[TResFlags] of TResFlags =

compiler/aarch64/naarch64util.pas

@@ -26,12 +26,12 @@ unit naarch64util;
 interface
 
 uses
-    cclasses, ngenutil;
+    cclasses, ngenutil, fmodule;
 
 type
     TAArch64NodeUtils = class(TNodeUtils)
         class procedure InsertObjectInfo; override;
-        class procedure Insert_Init_Final_Table(Entries: TFPList); override;
+        class procedure Insert_Init_Final_Table(main: tmodule; Entries: TFPList); override;
     end;
 
 implementation
@@ -54,7 +54,7 @@ end;
     TODO: This is a simple skeleton, not nearly as complex as the
     ARM (32-bit) version in compiler/arm/narmutil.pas
 }
-class procedure TAArch64NodeUtils.Insert_Init_Final_Table(Entries: TFPList);
+class procedure TAArch64NodeUtils.Insert_Init_Final_Table(main: tmodule; Entries: TFPList);
 
     procedure GenEntry(List: TAsmList);
     var
@@ -113,7 +113,7 @@ var
 begin
     if not(tf_init_final_units_by_calls in target_info.flags) then
     begin
-        inherited insert_init_final_table(Entries);
+        inherited insert_init_final_table(main,Entries);
         exit;
     end;
 
@@ -156,7 +156,7 @@ begin
     InitList.Free;
     FinalList.Free;
 
-    inherited Insert_Init_Final_Table(entries);
+    inherited Insert_Init_Final_Table(main,entries);
 end;
 
 begin

compiler/aarch64/ncpuadd.pas

@@ -45,12 +45,13 @@ interface
           procedure second_cmp64bit; override;
        public
           function use_generic_mul32to64: boolean; override;
+          function pass_1 : tnode;override;
        end;
 
   implementation
 
     uses
-      systems,symtype,symdef,
+      systems,symconst,symtype,symdef,
       globals,globtype,
       cutils,verbose,
       paramgr,procinfo,
@@ -414,7 +415,7 @@ interface
                 secondpass(left);
 
                 { Skip the not node completely }
-                Include(right.flags, nf_do_not_execute);
+                Include(right.transientflags, tnf_do_not_execute);
                 secondpass(tnotnode(right).left);
 
                 { allocate registers }
@@ -485,6 +486,18 @@ interface
         result:=false;
       end;
 
+    function taarch64addnode.pass_1: tnode;
+      begin
+        Result:=inherited pass_1;
+        { if the result is not nil, a new node has been generated and the current node will be discarted }
+        if Result=nil then
+          begin
+            if left.resultdef.typ=floatdef then
+              if needs_check_for_fpu_exceptions then
+                Include(current_procinfo.flags,pi_do_call);
+          end;
+      end;
+
 
 begin
   caddnode:=taarch64addnode;

compiler/aarch64/ncpuinl.pas

@@ -61,10 +61,11 @@ implementation
     uses
       globtype,verbose,globals,
       compinnr,
-      cpuinfo, defutil,symdef,aasmdata,aasmcpu,
+      cpuinfo, defutil,symdef,aasmbase,aasmdata,aasmcpu,
       cgbase,cgutils,pass_1,pass_2,
+      procinfo,
       ncal,nutils,
-      cpubase,ncgutil,cgobj,cgcpu, hlcgobj;
+      cpubase,ncgutil,cgobj,cgcpu,hlcgobj;
 
 {*****************************************************************************
                               taarch64inlinenode
@@ -84,6 +85,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -91,6 +94,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -98,6 +103,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -105,6 +112,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -112,6 +121,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -119,6 +130,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -126,6 +139,8 @@ implementation
       begin
         expectloc:=LOC_MMREGISTER;
         result:=nil;
+        if needs_check_for_fpu_exceptions then
+          Include(current_procinfo.flags,pi_do_call);
       end;
 
 
@@ -168,6 +183,7 @@ implementation
     procedure taarch64inlinenode.second_abs_long;
       var
         opsize : tcgsize;
+        hl: TAsmLabel;
       begin
         secondpass(left);
         opsize:=def_cgsize(left.resultdef);
@@ -175,6 +191,15 @@ implementation
         location:=left.location;
         location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
 
+        if cs_check_overflow in current_settings.localswitches then
+          begin
+            current_asmdata.getjumplabel(hl);
+            hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,resultdef,OC_NE,torddef(resultdef).low.svalue,left.location.register,hl);
+            hlcg.a_reg_dealloc(current_asmdata.CurrAsmList, NR_DEFAULTFLAGS);
+            hlcg.g_call_system_proc(current_asmdata.CurrAsmList,'fpc_overflow',[],nil).resetiftemp;
+            hlcg.a_label(current_asmdata.CurrAsmList,hl);
+          end;
+
         current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_NEG,location.register,left.location.register),PF_S));
         current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_cond(A_CSEL,location.register,location.register,left.location.register,C_GE));
       end;
@@ -356,8 +381,10 @@ implementation
           begin
             expectloc:=LOC_MMREGISTER;
             Result:=nil;
+            if needs_check_for_fpu_exceptions then
+              Include(current_procinfo.flags,pi_do_call);
           end
-        else if is_32bitint(resultdef) then
+        else if is_32bitint(resultdef) or is_64bitint(resultdef) then
           begin
             expectloc:=LOC_REGISTER;
             Result:=nil;
@@ -373,6 +400,7 @@ implementation
         i: Integer;
         ai: taicpu;
         op: TAsmOp;
+        cond: TAsmCond;
       begin
         paraarray[1]:=tcallparanode(tcallparanode(parameters).nextpara).paravalue;
           paraarray[2]:=tcallparanode(parameters).paravalue;
@@ -411,7 +439,7 @@ implementation
 
              cg.maybe_check_for_fpu_exception(current_asmdata.CurrAsmList);
            end
-         else if is_32bitint(resultdef) then
+         else if is_32bitint(resultdef) or is_64bitint(resultdef) then
            begin
              { no memory operand is allowed }
              for i:=low(paraarray) to high(paraarray) do
@@ -428,17 +456,23 @@ implementation
                paraarray[1].location.register,paraarray[2].location.register));
 
              case inlinenumber of
+               in_min_longint,
+               in_min_int64:
+                 cond := C_LT;
                in_min_dword,
-               in_min_longint:
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_cond(A_CSEL,
-                  location.register,paraarray[1].location.register,paraarray[2].location.register,C_LT));
+               in_min_qword:
+                 cond := C_LO;
+               in_max_longint,
+               in_max_int64:
+                 cond := C_GT;
                in_max_dword,
-               in_max_longint:
-                current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_cond(A_CSEL,
-                  location.register,paraarray[1].location.register,paraarray[2].location.register,C_GT));
+               in_max_qword:
+                 cond := C_HI;
                else
                  Internalerror(2021121901);
              end;
+             current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_cond(A_CSEL,
+               location.register,paraarray[1].location.register,paraarray[2].location.register,cond));
            end
          else
            internalerror(2021121801);

compiler/aarch64/ncpumat.pas

@@ -39,6 +39,7 @@ interface
       end;
 
       taarch64unaryminusnode = class(tcgunaryminusnode)
+         function pass_1: tnode; override;
          procedure second_float; override;
       end;
 
@@ -482,6 +483,15 @@ implementation
                                    taarch64unaryminusnode
 *****************************************************************************}
 
+    function taarch64unaryminusnode.pass_1: tnode;
+      begin
+        Result:=inherited pass_1;
+        if Result=nil then
+          if needs_check_for_fpu_exceptions then
+            Include(current_procinfo.flags,pi_do_call);
+      end;
+
+
     procedure taarch64unaryminusnode.second_float;
       begin
         secondpass(left);

compiler/aasmcnst.pas

@@ -2208,12 +2208,13 @@ implementation
      var
        resourcestrrec: trecorddef;
      begin
-       if cs.consttyp<>constresourcestring then
+       if not (cs.consttyp in [constresourcestring,constwresourcestring]) then
          internalerror(2014062102);
        if fqueue_offset<>0 then
          internalerror(2014062103);
        { warning: update if/when the type of resource strings changes }
        case cs.consttyp of
+         constwresourcestring,
          constresourcestring:
            begin
              resourcestrrec:=trecorddef(search_system_type('TRESOURCESTRINGRECORD').typedef);

compiler/aasmdata.pas

@@ -214,7 +214,9 @@ interface
         function  DefineAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype; def: tdef) : TAsmSymbol; virtual;
         function  DefineAsmSymbol(const s : TSymStr;_bind:TAsmSymBind;_typ:Tasmsymtype; def: tdef) : TAsmSymbol;
         function  DefineProcAsmSymbol(pd: tdef; const s: TSymStr; global: boolean): TAsmSymbol;
+        function  WeakRefAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
         function  WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
+        function  RefAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_typ:Tasmsymtype;indirect:boolean=false) : TAsmSymbol;
         function  RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean=false) : TAsmSymbol;
         function  GetAsmSymbol(const s : TSymStr) : TAsmSymbol;
         { create new assembler label }
@@ -609,7 +611,8 @@ implementation
           result:=DefineAsmSymbol(s,AB_LOCAL,AT_FUNCTION,pd);
       end;
 
-    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean) : TAsmSymbol;
+
+    function TAsmData.RefAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_typ:Tasmsymtype;indirect:boolean) : TAsmSymbol;
       var
         namestr : TSymStr;
         bind : tasmsymbind;
@@ -626,18 +629,30 @@ implementation
           end;
         result:=TAsmSymbol(FAsmSymbolDict.Find(namestr));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,namestr,bind,_typ)
+          result:=symclass.create(AsmSymbolDict,namestr,bind,_typ)
         { one normal reference removes the "weak" character of a symbol }
         else if (result.bind=AB_WEAK_EXTERNAL) then
           result.bind:=bind;
       end;
 
 
-    function TAsmData.WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
+    function TAsmData.RefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype;indirect:boolean) : TAsmSymbol;
+      begin
+        result:=RefAsmSymbolByClass(TAsmSymbol,s,_typ,indirect);
+      end;
+
+
+    function TAsmData.WeakRefAsmSymbolByClass(symclass: TAsmSymbolClass; const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
       begin
         result:=TAsmSymbol(FAsmSymbolDict.Find(s));
         if not assigned(result) then
-          result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,_typ);
+          result:=symclass.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,_typ);
+      end;
+
+
+    function TAsmData.WeakRefAsmSymbol(const s : TSymStr;_typ:Tasmsymtype) : TAsmSymbol;
+      begin
+        result:=WeakRefAsmSymbolByClass(TAsmSymbol,s,_typ);
       end;
 
 

compiler/aoptobj.pas

@@ -426,6 +426,11 @@ Unit AoptObj;
         { Jump/label optimisation entry method }
         function DoJumpOptimizations(var p: tai; var stoploop: Boolean): Boolean;
 
+        { Attempts to reconfigure the Regallocs and Regdeallocs before p1 and
+          after p2 so Reg is no longer allocated between them.  Returns True if
+          the register is no longer allocated at p1 }
+        function TryRemoveRegAlloc(const Reg: TRegister; p1, p2: tai): Boolean;
+
         { insert debug comments about which registers are read and written by
           each instruction. Useful for debugging the InstructionLoadsFromReg and
           other similar functions. }
@@ -1382,10 +1387,11 @@ Unit AoptObj;
           If Assigned(StartPai) And
              (StartPai.typ = ait_regAlloc) Then
             Begin
-              if (tai_regalloc(StartPai).ratype=ra_alloc) and
-                SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
+              if SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then
                begin
-                 Result:=tai_regalloc(StartPai);
+                 { If we find a dealloc first, say, return nil }
+                 if (tai_regalloc(StartPai).ratype<>ra_dealloc) then
+                   Result:=tai_regalloc(StartPai);
                  exit;
                end;
               StartPai := Tai(StartPai.Previous);
@@ -2566,6 +2572,79 @@ Unit AoptObj;
       end;
 
 
+    { Attempts to reconfigure the Regallocs and Regdeallocs before p1 and
+      after p2 so Reg is no longer allocated between them.  Returns True if the
+      register is no longer allocated at p1 }
+    function TAOptObj.TryRemoveRegAlloc(const Reg: TRegister; p1, p2: tai): Boolean;
+      var
+        CurrentAlloc: tai;
+      begin
+        Result := False;
+        if RegInInstruction(Reg, p1) then
+          { Register is definitely in use }
+          Exit;
+
+        { Search for the first de/alloc before p1 that relates to Reg }
+        CurrentAlloc := tai(p1.Previous);
+        repeat
+          while Assigned(CurrentAlloc) and
+                ((CurrentAlloc.typ in (SkipInstr - [ait_regAlloc])) or
+                 ((CurrentAlloc.typ = ait_label) and
+                  not(Tai_Label(CurrentAlloc).labsym.Is_Used))) do
+            CurrentAlloc := Tai(CurrentAlloc.Previous);
+          if Assigned(CurrentAlloc) and
+            (CurrentAlloc.typ = ait_regalloc) then
+            begin
+              if (getregtype(tai_regalloc(CurrentAlloc).Reg) = getregtype(Reg)) and
+                (getsupreg(tai_regalloc(CurrentAlloc).Reg) = getsupreg(Reg)) then
+               begin
+                 Break;
+               end;
+              CurrentAlloc := Tai(CurrentAlloc.Previous);
+            end
+          else
+            begin
+              CurrentAlloc := nil;
+              Break;
+            end;
+        until false;
+
+        { Remove any register allocation prior to p1 }
+        if Assigned(CurrentAlloc) and (CurrentAlloc.typ = ait_regalloc) and
+          (tai_regalloc(CurrentAlloc).ratype = ra_alloc) then
+          begin
+            RemoveInstruction(CurrentAlloc);
+            Result := True;
+          end
+        else if not Assigned(CurrentAlloc) or (CurrentAlloc.typ <> ait_regalloc) or
+          (tai_regalloc(CurrentAlloc).ratype <> ra_dealloc) then
+          begin
+            AsmL.InsertBefore(tai_regalloc.dealloc(Reg, nil), p1);
+            Result := True;
+          end;
+
+        if (p1 <> p2) and RegInInstruction(Reg, p2) then
+          begin
+            { Reg is in use, so insert allocation before it }
+            AsmL.InsertBefore(tai_regalloc.alloc(Reg, nil), p2);
+            Exit;
+          end;
+
+        { If a deallocation exists, remove it since the register will no longer be allocated by this time }
+        CurrentAlloc := FindRegDealloc(Reg, tai(p2.Next));
+        if Assigned(CurrentAlloc) and (CurrentAlloc.typ = ait_regalloc) and
+          (tai_regalloc(CurrentAlloc).ratype = ra_dealloc) then
+          begin
+            RemoveInstruction(CurrentAlloc);
+          end
+        else
+          begin
+            { Since no deallocation was found, Register may end up being used afterwards, so add a new alloc to play safe }
+            AsmL.InsertAfter(tai_regalloc.alloc(Reg, nil), p2);
+          end;
+      end;
+
+
     procedure TAOptObj.PrePeepHoleOpts;
       var
         p: tai;

compiler/arm/aoptcpu.pas

@@ -86,6 +86,7 @@ Type
     function OptPass1Push(var p: tai): Boolean;
 
     function OptPass2Bcc(var p: tai): Boolean;
+    function OptPass2CMP(var p: tai): Boolean;
     function OptPass2STM(var p: tai): Boolean;
     function OptPass2STR(var p: tai): Boolean;
   End;
@@ -853,53 +854,6 @@ Implementation
                 else
                   hp1 := hp2;
             end;
-
-          {
-            change
-            <op> reg,x,y
-            cmp reg,#0
-            into
-            <op>s reg,x,y
-          }
-          if (taicpu(p).oppostfix = PF_None) and
-            (taicpu(p).oper[1]^.val = 0) and
-            { be careful here, following instructions could use other flags
-              however after a jump fpc never depends on the value of flags }
-            { All above instructions set Z and N according to the following
-              Z := result = 0;
-              N := result[31];
-              EQ = Z=1; NE = Z=0;
-              MI = N=1; PL = N=0; }
-            (MatchInstruction(hp1, A_B, [C_EQ,C_NE,C_MI,C_PL], []) or
-            { mov is also possible, but only if there is no shifter operand, it could be an rxx,
-              we are too lazy to check if it is rxx or something else }
-            (MatchInstruction(hp1, A_MOV, [C_EQ,C_NE,C_MI,C_PL], []) and (taicpu(hp1).ops=2))) and
-            GetLastInstruction(p, hp_last) and
-            MatchInstruction(hp_last, [A_ADC,A_ADD,A_BIC,A_SUB,A_MUL,A_MVN,A_MOV,A_ORR,
-              A_EOR,A_AND,A_RSB,A_RSC,A_SBC,A_MLA], [C_None], [PF_None]) and
-            (
-              { mlas is only allowed in arm mode }
-              (taicpu(hp_last).opcode<>A_MLA) or
-              (current_settings.instructionset<>is_thumb)
-            ) and
-            (taicpu(hp_last).oper[0]^.reg = taicpu(p).oper[0]^.reg) and
-            assigned(FindRegDealloc(NR_DEFAULTFLAGS,tai(hp1.Next))) then
-            begin
-              DebugMsg(SPeepholeOptimization + 'OpCmp2OpS done', hp_last);
-
-              taicpu(hp_last).oppostfix:=PF_S;
-
-              { move flag allocation if possible }
-              hp1:=FindRegAlloc(NR_DEFAULTFLAGS,tai(hp_last.Next));
-              if assigned(hp1) then
-                begin
-                  asml.Remove(hp1);
-                  asml.insertbefore(hp1, hp_last);
-                end;
-
-              RemoveCurrentP(p);
-              Result:=true;
-            end;
         end;
     end;
 
@@ -2135,6 +2089,80 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.OptPass2CMP(var p: tai): Boolean;
+    var
+      hp1, hp_last: tai;
+    begin
+      Result := False;
+      if not GetNextInstructionUsingReg(p, hp1, NR_DEFAULTFLAGS) then
+        Exit;
+
+      if (hp1.typ = ait_label) or
+        (
+          (hp1.typ = ait_instruction) and
+          (taicpu(hp1).condition = C_None) and
+          (
+            RegModifiedByInstruction(NR_DEFAULTFLAGS, hp1) or
+            is_calljmp(taicpu(hp1).opcode)
+          )
+        ) then
+        begin
+          { The comparison is a null operation }
+          DebugMsg(SPeepholeOptimization + 'CMP -> nop', p);
+          RemoveCurrentP(p);
+          Result := True;
+          Exit;
+        end;
+
+      {
+        change
+        <op> reg,x,y
+        cmp reg,#0
+        into
+        <op>s reg,x,y
+      }
+      if (taicpu(p).oppostfix = PF_None) and
+        (taicpu(p).oper[1]^.val = 0) and
+        { be careful here, following instructions could use other flags
+          however after a jump fpc never depends on the value of flags }
+        { All above instructions set Z and N according to the following
+          Z := result = 0;
+          N := result[31];
+          EQ = Z=1; NE = Z=0;
+          MI = N=1; PL = N=0; }
+        (MatchInstruction(hp1, [A_B, A_CMP, A_CMN, A_TST, A_TEQ], [C_EQ,C_NE,C_MI,C_PL], []) or
+        { mov is also possible, but only if there is no shifter operand, it could be an rxx,
+          we are too lazy to check if it is rxx or something else }
+        (MatchInstruction(hp1, A_MOV, [C_EQ,C_NE,C_MI,C_PL], []) and (taicpu(hp1).ops=2))) and
+        GetLastInstruction(p, hp_last) and
+        MatchInstruction(hp_last, [A_ADC,A_ADD,A_BIC,A_SUB,A_MUL,A_MVN,A_MOV,A_ORR,
+          A_EOR,A_AND,A_RSB,A_RSC,A_SBC,A_MLA], [C_None], [PF_None]) and
+        (
+          { mlas is only allowed in arm mode }
+          (taicpu(hp_last).opcode<>A_MLA) or
+          (current_settings.instructionset<>is_thumb)
+        ) and
+        (taicpu(hp_last).oper[0]^.reg = taicpu(p).oper[0]^.reg) and
+        assigned(FindRegDealloc(NR_DEFAULTFLAGS,tai(hp1.Next))) then
+        begin
+          DebugMsg(SPeepholeOptimization + 'OpCmp2OpS done', hp_last);
+
+          taicpu(hp_last).oppostfix:=PF_S;
+
+          { move flag allocation if possible }
+          hp1:=FindRegAlloc(NR_DEFAULTFLAGS,tai(hp_last.Next));
+          if assigned(hp1) then
+            begin
+              asml.Remove(hp1);
+              asml.insertbefore(hp1, hp_last);
+            end;
+
+          RemoveCurrentP(p);
+          Result:=true;
+        end;
+    end;
+
+
   function TCpuAsmOptimizer.OptPass2STR(var p: tai): Boolean;
     var
       hp1: tai;
@@ -2388,12 +2416,18 @@ Implementation
       if p.typ = ait_instruction then
         begin
           case taicpu(p).opcode of
+            A_AND:
+              Result := OptPass2AND(p);
+            A_CMP:
+              Result := OptPass2CMP(p);
             A_B:
               Result := OptPass2Bcc(p);
             A_STM:
               Result := OptPass2STM(p);
             A_STR:
               Result := OptPass2STR(p);
+            A_TST:
+              Result := OptPass2TST(p);
             else
               ;
           end;
@@ -2418,7 +2452,24 @@ Implementation
               (getsupreg(taicpu(p1).oper[0]^.reg)+1=getsupreg(reg)) then
         Result:=true
       else
-        Result:=inherited RegInInstruction(Reg, p1);
+        begin
+          if SuperRegistersEqual(Reg, NR_DEFAULTFLAGS) and (p1.typ = ait_instruction) then
+            begin
+              { Conditional instruction reads CPSR register }
+              if (taicpu(p1).condition <> C_None) then
+                Exit(True);
+
+              { Comparison instructions (and procedural jump) }
+              if (taicpu(p1).opcode in [A_BL, A_CMP, A_CMN, A_TST, A_TEQ]) then
+                Exit(True);
+
+              { Instruction sets CPSR register due to S suffix (floating-point
+                instructios won't raise false positives) }
+              if (taicpu(p1).oppostfix = PF_S) then
+                Exit(True)
+            end;
+          Result:=inherited RegInInstruction(Reg, p1);
+        end;
     end;
 
   const

compiler/arm/aoptcpub.pas

@@ -119,6 +119,24 @@ Implementation
       i : Longint;
     begin
       result:=false;
+      if (p1.typ <> ait_instruction) then
+        Exit;
+
+      if SuperRegistersEqual(Reg, NR_DEFAULTFLAGS) then
+        begin
+          { Comparison instructions (and procedural jump) }
+          if (taicpu(p1).opcode in [A_BL, A_CMP, A_CMN, A_TST, A_TEQ]) then
+            Exit(True);
+
+          { Instruction sets CPSR register due to S suffix (floating-point
+            instructios won't raise false positives) }
+          if (taicpu(p1).oppostfix = PF_S) then
+            Exit(True);
+
+          { Everything else (conditional instructions only read CPSR) }
+          Exit;
+        end;
+
       case taicpu(p1).opcode of
         A_LDR:
           begin

compiler/arm/cgcpu.pas

@@ -1780,9 +1780,8 @@ unit cgcpu;
         ai: taicpu;
         l: TAsmLabel;
       begin
-        if ((cs_check_fpu_exceptions in current_settings.localswitches) and
-            not(FPUARM_HAS_EXCEPTION_TRAPPING in fpu_capabilities[current_settings.fputype]) and
-            (force or current_procinfo.FPUExceptionCheckNeeded)) then
+        if needs_check_for_fpu_exceptions and
+          (force or current_procinfo.FPUExceptionCheckNeeded) then
           begin
             r:=getintregister(list,OS_INT);
             list.concat(taicpu.op_reg_reg(A_FMRX,r,NR_FPSCR));

compiler/arm/narmadd.pas

@@ -573,6 +573,10 @@ interface
                (unsigned and (nodetype in [ltn,lten,gtn,gten]))
               ) then
               expectloc:=LOC_FLAGS;
+            if (left.resultdef.typ=floatdef) and
+              ([FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VFP_DOUBLE]*fpu_capabilities[current_settings.fputype]<>[]) and
+              needs_check_for_fpu_exceptions then
+              Include(current_procinfo.flags,pi_do_call);
           end;
       end;
 

compiler/arm/narminl.pas

@@ -61,6 +61,7 @@ implementation
 
     uses
       globtype,verbose,globals,
+      procinfo,
       cpuinfo, defutil,symdef,aasmdata,aasmcpu,
       cgbase,cgutils,pass_1,pass_2,
       cpubase,ncgutil,cgobj,cgcpu, hlcgobj,
@@ -135,6 +136,9 @@ implementation
               else
                 internalerror(2009112401);
             end;
+            if ([FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VFP_DOUBLE]*fpu_capabilities[current_settings.fputype]<>[]) and
+              needs_check_for_fpu_exceptions then
+              Include(current_procinfo.flags,pi_do_call);
             first_abs_real:=nil;
           end;
       end;
@@ -163,6 +167,9 @@ implementation
               else
                 internalerror(2009112402);
             end;
+            if ([FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VFP_DOUBLE]*fpu_capabilities[current_settings.fputype]<>[]) and
+              needs_check_for_fpu_exceptions then
+              Include(current_procinfo.flags,pi_do_call);
             first_sqr_real:=nil;
           end;
       end;
@@ -191,6 +198,9 @@ implementation
               else
                 internalerror(2009112403);
             end;
+            if ([FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VFP_DOUBLE]*fpu_capabilities[current_settings.fputype]<>[]) and
+              needs_check_for_fpu_exceptions then
+              Include(current_procinfo.flags,pi_do_call);
             first_sqrt_real := nil;
           end;
       end;
@@ -198,11 +208,13 @@ implementation
 
      function tarminlinenode.first_fma : tnode;
        begin
-         if (true) and
-           ((is_double(resultdef)) or (is_single(resultdef))) then
+         if ((is_double(resultdef)) or (is_single(resultdef))) then
            begin
              expectloc:=LOC_MMREGISTER;
              Result:=nil;
+             if ([FPUARM_HAS_VFP_EXTENSION,FPUARM_HAS_VFP_DOUBLE]*fpu_capabilities[current_settings.fputype]<>[]) and
+               needs_check_for_fpu_exceptions then
+               Include(current_procinfo.flags,pi_do_call);
            end
          else
            Result:=inherited first_fma;
@@ -400,6 +412,7 @@ implementation
     procedure tarminlinenode.second_abs_long;
       var
         opsize : tcgsize;
+        ovloc: tlocation;
       begin
         if GenerateThumbCode then
           begin
@@ -409,17 +422,35 @@ implementation
 
         secondpass(left);
         opsize:=def_cgsize(left.resultdef);
-        hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
-        location:=left.location;
-        location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
+        if is_64bitint(left.resultdef) then
+          begin
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
+            location:=left.location;
+            location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+            location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+            cg64.a_load64_reg_reg(current_asmdata.CurrAsmList,left.location.register64,location.register64);
+            cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_32,31,left.location.register64.reghi);
+            cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,left.location.register64.reghi,location.register64.reglo);
+            cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,left.location.register64.reghi,location.register64.reghi);
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,location.register64.reglo,location.register64.reglo,left.location.register64.reghi), PF_S));
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,location.register64.reghi,location.register64.reghi,left.location.register64.reghi), PF_S));
+          end
+        else
+          begin
+            hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+            location:=left.location;
+            location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
 
-        cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MOV,location.register,left.location.register), PF_S));
+            cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
+            current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MOV,location.register,left.location.register), PF_S));
 
-        if GenerateThumb2Code then
-          current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT,C_MI));
+            if GenerateThumb2Code then
+              current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT,C_MI));
 
-        current_asmdata.CurrAsmList.concat(setcondition(taicpu.op_reg_reg_const(A_RSB,location.register,location.register, 0), C_MI));
+            current_asmdata.CurrAsmList.concat(setoppostfix(setcondition(taicpu.op_reg_reg_const(A_RSB,location.register,location.register, 0), C_MI),PF_S));
+          end;
+        location_reset(ovloc,LOC_VOID,opsize);
+        cg.g_overflowCheck_loc(current_asmdata.CurrAsmList,ovloc,resultdef,ovloc);
 
         cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
       end;

compiler/arm/narmutil.pas

@@ -26,12 +26,12 @@ unit narmutil;
 interface
 
   uses
-    cclasses,ngenutil;
+    cclasses,ngenutil,fmodule;
 
   type
     tarmnodeutils = class(tnodeutils)
       class procedure InsertObjectInfo; override;
-      class procedure insert_init_final_table(entries: tfplist); override;
+      class procedure insert_init_final_table(main : tmodule; entries: tfplist); override;
     end;
 
 
@@ -251,7 +251,7 @@ interface
           end;
       end;
 
-    class procedure tarmnodeutils.insert_init_final_table(entries:tfplist);
+    class procedure tarmnodeutils.insert_init_final_table(main : tmodule; entries:tfplist);
 
       procedure genentry(list : TAsmList);
         var
@@ -290,7 +290,7 @@ interface
       begin
         if not(tf_init_final_units_by_calls in target_info.flags) then
           begin
-            inherited insert_init_final_table(entries);
+            inherited insert_init_final_table(main,entries);
             exit;
           end;
         initList:=TAsmList.create;
@@ -332,7 +332,7 @@ interface
         initList.Free;
         finalList.Free;
 
-        inherited insert_init_final_table(entries);
+        inherited insert_init_final_table(main,entries);
       end;
 
   begin

compiler/armgen/aoptarm.pas

@@ -57,6 +57,9 @@ Type
     function OptPass1LDR(var p: tai): Boolean; virtual;
     function OptPass1STR(var p: tai): Boolean; virtual;
     function OptPass1And(var p: tai): Boolean; virtual;
+
+    function OptPass2AND(var p: tai): Boolean;
+    function OptPass2TST(var p: tai): Boolean;
   End;
 
   function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;
@@ -538,6 +541,22 @@ Implementation
                     begin
                       if MatchOperand(taicpu(next_hp).oper[0]^, taicpu(p).oper[0]^.reg) then
                         begin
+                          { mov r0,r1; mov r1,r1 - remove second MOV here so
+                            so "RedundantMovProcess 2b" doesn't get erroneously
+                            applied }
+                          if MatchOperand(taicpu(next_hp).oper[0]^, taicpu(next_hp).oper[1]^.reg) then
+                            begin
+                              DebugMsg(SPeepholeOptimization + 'Mov2None 2a done', next_hp);
+
+                              if (next_hp = hp1) then
+                                { Don't let hp1 become a dangling pointer }
+                                hp1 := nil;
+
+                              asml.Remove(next_hp);
+                              next_hp.Free;
+                              Continue;
+                            end;
+
                           { Found another mov that writes entirely to the register }
                           if RegUsedBetween(taicpu(p).oper[0]^.reg, p, next_hp) then
                             begin
@@ -1582,6 +1601,7 @@ Implementation
                 end
             end;
         end;
+
       {
         change
         and reg1, ...
@@ -1595,5 +1615,232 @@ Implementation
         Result:=true;
     end;
 
+
+  function TARMAsmOptimizer.OptPass2AND(var p: tai): Boolean;
+    var
+      hp1, hp2: tai;
+      WorkingReg: TRegister;
+    begin
+      Result := False;
+      {
+        change
+        and  reg1, ...
+        ...
+        cmp  reg1, #0
+        b<ne/eq> @Lbl
+        to
+        ands reg1, ...
+
+        Also:
+
+        and  reg1, ...
+        ...
+        cmp  reg1, #0
+        (reg1 end of life)
+        b<ne/eq> @Lbl
+        to
+        tst  reg1, ...
+      }
+      if (taicpu(p).condition = C_None) and
+        (taicpu(p).ops>=3) and
+        GetNextInstructionUsingReg(p, hp1, taicpu(p).oper[0]^.reg) and
+        MatchInstruction(hp1, A_CMP, [C_None], [PF_None]) and
+        MatchOperand(taicpu(hp1).oper[1]^, 0) and
+{$ifdef AARCH64}
+        (SuperRegistersEqual(taicpu(hp1).oper[0]^.reg, taicpu(p).oper[0]^.reg)) and
+        (
+          (getsubreg(taicpu(hp1).oper[0]^.reg) = getsubreg(taicpu(p).oper[0]^.reg))
+          or
+          (
+            (taicpu(p).oper[2]^.typ = top_const) and
+            (taicpu(p).oper[2]^.val >= 0) and
+            (taicpu(p).oper[2]^.val <= $FFFFFFFF)
+          )
+        ) and
+{$else AARCH64}
+        (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and
+{$endif AARCH64}
+
+        not RegModifiedBetween(NR_DEFAULTFLAGS, p, hp1) and
+        GetNextInstruction(hp1, hp2) then
+        begin
+          if MatchInstruction(hp2, [A_B, A_CMP, A_CMN, A_TST{$ifndef AARCH64}, A_TEQ{$endif not AARCH64}], [C_EQ, C_NE], [PF_None]) then
+            begin
+              AllocRegBetween(NR_DEFAULTFLAGS, p, hp1, UsedRegs);
+
+              WorkingReg := taicpu(p).oper[0]^.reg;
+
+              if RegEndOfLife(WorkingReg, taicpu(hp1)) then
+                begin
+                  taicpu(p).opcode := A_TST;
+                  taicpu(p).oppostfix := PF_None;
+                  taicpu(p).loadreg(0, taicpu(p).oper[1]^.reg);
+                  taicpu(p).loadoper(1, taicpu(p).oper[2]^);
+                  if (taicpu(p).ops = 4) then
+                    begin
+                      { Make sure any shifter operator is also transferred }
+                      taicpu(p).loadshifterop(2, taicpu(p).oper[3]^.shifterop^);
+                      taicpu(p).ops := 3;
+                    end
+                  else
+                    taicpu(p).ops := 2;
+
+                  DebugMsg(SPeepholeOptimization + 'AND; CMP -> TST', p);
+                end
+              else
+                begin
+                  taicpu(p).oppostfix := PF_S;
+                  DebugMsg(SPeepholeOptimization + 'AND; CMP -> ANDS', p);
+                end;
+
+              RemoveInstruction(hp1);
+
+              { If a temporary register was used for and/cmp before, we might be
+                able to deallocate the register so it can be used for other
+                optimisations later }
+              if (taicpu(p).opcode = A_TST) and TryRemoveRegAlloc(WorkingReg, p, p) then
+                ExcludeRegFromUsedRegs(WorkingReg, UsedRegs);
+
+              Result := True;
+              Exit;
+            end
+          else if
+            (hp2.typ = ait_label) or
+            { Conditional comparison instructions have already been covered }
+            RegModifiedByInstruction(NR_DEFAULTFLAGS, hp2) then
+            begin
+              { The comparison is a null operation }
+              if RegEndOfLife(taicpu(p).oper[0]^.reg, taicpu(hp1)) then
+                begin
+                  DebugMsg(SPeepholeOptimization + 'AND; CMP -> nop', p);
+                  RemoveInstruction(hp1);
+                  RemoveCurrentP(p);
+                end
+              else
+                begin
+                  DebugMsg(SPeepholeOptimization + 'CMP -> nop', hp1);
+                  RemoveInstruction(hp1);
+                end;
+              Result := True;
+              Exit;
+            end;
+        end;
+    end;
+
+
+  function TARMAsmOptimizer.OptPass2TST(var p: tai): Boolean;
+    var
+      hp1, hp2: tai;
+    begin
+      Result := False;
+      if
+{$ifndef AARCH64}
+        (taicpu(p).condition = C_None) and
+{$endif AARCH64}
+        GetNextInstruction(p, hp1) and
+        MatchInstruction(hp1, A_B, [C_EQ, C_NE], [PF_None]) and
+        GetNextInstructionUsingReg(hp1, hp2, taicpu(p).oper[0]^.reg) then
+        begin
+          case taicpu(hp2).opcode of
+            A_AND:
+              { Change:
+                 tst  r1,##
+                 (r2 not in use, or r2 = r1)
+                 b.c  .Lbl
+                 ...
+                 and  r2,r1,##
+
+               Optimise to:
+                 ands r2,r1,##
+                 b.c  .Lbl
+                 ...
+              }
+              if (taicpu(hp2).oppostfix in [PF_None, PF_S]) and
+{$ifndef AARCH64}
+                (taicpu(hp2).condition = C_None) and
+{$endif AARCH64}
+                (taicpu(hp2).ops = taicpu(p).ops + 1) and
+                  not RegInUsedRegs(taicpu(hp2).oper[0]^.reg, UsedRegs) and
+                  MatchOperand(taicpu(hp2).oper[1]^, taicpu(p).oper[0]^.reg) and
+                  MatchOperand(taicpu(hp2).oper[2]^, taicpu(p).oper[1]^) and
+                  (
+                    (taicpu(hp2).ops = 3) or
+                    MatchOperand(taicpu(hp2).oper[3]^, taicpu(p).oper[2]^)
+                  ) and
+                  (
+                    not (cs_opt_level3 in current_settings.optimizerswitches) or
+                    (
+                      { Make sure the target register isn't used in between }
+                      not RegUsedBetween(taicpu(hp2).oper[0]^.reg, hp1, hp2) and
+                      (
+                        { If the second operand is a register, make sure it isn't modified in between }
+                        (taicpu(p).oper[1]^.typ <> top_reg) or
+                        not RegModifiedBetween(taicpu(p).oper[1]^.reg, hp1, hp2)
+                      )
+                    )
+                  ) then
+                  begin
+                    AllocRegBetween(taicpu(hp2).oper[0]^.reg, p, hp2, UsedRegs);
+
+                    if (taicpu(hp2).oppostfix = PF_S) then
+                      AllocRegBetween(NR_DEFAULTFLAGS, p, hp2, UsedRegs);
+
+                    DebugMsg(SPeepholeOptimization + 'TST; B.c; AND -> ANDS; B.c (TstBcAnd2AndsBc)', p);
+                    taicpu(hp2).oppostfix := PF_S;
+
+                    Asml.Remove(hp2);
+                    Asml.InsertAfter(hp2, p);
+
+                    RemoveCurrentP(p, hp2);
+                    Result := True;
+
+                    Exit;
+                  end;
+            A_TST:
+              { Change:
+                 tst  r1,##
+                 b.c  .Lbl
+                 ... (flags not modified)
+                 tst  r1,##
+
+                Remove second tst
+              }
+              if
+{$ifndef AARCH64}
+                (taicpu(hp2).condition = C_None) and
+{$endif AARCH64}
+                (taicpu(hp2).ops = taicpu(p).ops) and
+                MatchOperand(taicpu(hp2).oper[0]^, taicpu(p).oper[0]^.reg) and
+                MatchOperand(taicpu(hp2).oper[1]^, taicpu(p).oper[1]^) and
+                (
+                  (taicpu(hp2).ops = 2) or
+                  MatchOperand(taicpu(hp2).oper[2]^, taicpu(p).oper[2]^)
+                ) and
+                (
+                  not (cs_opt_level3 in current_settings.optimizerswitches) or
+                  (
+                    { Make sure the flags aren't modified in between }
+                    not RegModifiedBetween(NR_DEFAULTFLAGS, hp1, hp2) and
+                    (
+                      { If the second operand is a register, make sure it isn't modified in between }
+                      (taicpu(p).oper[1]^.typ <> top_reg) or
+                      not RegModifiedBetween(taicpu(p).oper[1]^.reg, hp1, hp2)
+                    )
+                  )
+                ) then
+                begin
+                  DebugMsg(SPeepholeOptimization + 'TST; B.c; TST -> TST; B.c (TstBcTst2TstBc)', p);
+
+                  AllocRegBetween(NR_DEFAULTFLAGS, hp1, hp2, UsedRegs);
+                  RemoveInstruction(hp2);
+                  Result := True;
+                  Exit;
+                end;
+            else
+              ;
+          end;
+        end;
+    end;
+
 end.
 

compiler/assemble.pas

@@ -1127,22 +1127,22 @@ Implementation
         ssingle: single;
         ddouble: double;
 {$ifdef FPC_COMP_IS_INT64}
-	ccomp: int64;
+        ccomp: int64;
 {$else}
         ccomp: comp;
 {$endif}
-	comp_data_size : byte;
+        comp_data_size : byte;
 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
         eextended: extended;
 {$else}
 {$ifdef FPC_SOFT_FPUX80}
 {$define USE_SOFT_FLOATX80}
-	f32 : float32;
-	f64 : float64;
-	eextended: floatx80;
-	gap_ofs_low,gap_ofs_high : byte;
-	gap_index, gap_size : byte;
-	has_gap : boolean;
+        f32 : float32;
+        f64 : float64;
+        eextended: floatx80;
+        gap_ofs_low,gap_ofs_high : byte;
+        gap_index, gap_size : byte;
+        has_gap : boolean;
 {$endif}
 {$endif cpuextended}
       begin
@@ -1167,20 +1167,20 @@ Implementation
 {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
              aitrealconst_s80bit:
                begin
-     	         if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
+                      if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
                    writer.AsmWriteLn(asminfo^.comment+'Emulated s80bit real value (on s64bit): '+double2str(tai_realconst(hp).value.s80val))
-     	         else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
+                      else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
                    writer.AsmWriteLn(asminfo^.comment+'Emulated s80bit real value (on s32bit): '+single2str(tai_realconst(hp).value.s80val))
                 else
-     	         internalerror(2017091901);
-       	      end;
+                      internalerror(2017091901);
+                     end;
 {$pop}
 {$endif}
 {$endif cpuextended}
               aitrealconst_s64comp:
                 begin
                   writer.AsmWriteLn(asminfo^.comment+'s64comp real value: '+extended2str(tai_realconst(hp).value.s64compval));
-	          comp_data_size:=sizeof(comp);
+                  comp_data_size:=sizeof(comp);
                   if (comp_data_size<>tai_realconst(hp).datasize) then
                     writer.AsmWriteLn(asminfo^.comment+'s64comp value type size is '+tostr(comp_data_size)+' but datasize is '+tostr(tai_realconst(hp).datasize));
                 end
@@ -1215,7 +1215,7 @@ Implementation
 {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
           aitrealconst_s80bit:
             begin
-	      if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
+              if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
                 begin
                   f64:=float64(double(tai_realconst(hp).value.s80val));
                   if float64_is_signaling_nan(f64)<>0 then
@@ -1225,23 +1225,23 @@ Implementation
                     end;
                   eextended:=float64_to_floatx80(f64);
                 end
-	      else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
+              else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
                 begin
                   f32:=float32(single(tai_realconst(hp).value.s80val));
                   if float32_is_signaling_nan(f32)<>0 then
                     begin
                       f32 := longword($ffc00000);
-	            end;
+                    end;
                   eextended:=float32_to_floatx80(f32);
                 end
-	      else
-	        internalerror(2017091902);
+              else
+                internalerror(2017091902);
               pdata:=@eextended;
               if sizeof(eextended)>10 then
                 begin
                   gap_ofs_high:=(pbyte(@eextended.high) - pbyte(@eextended));
                   gap_ofs_low:=(pbyte(@eextended.low) - pbyte(@eextended));
-		  if (gap_ofs_low<gap_ofs_high) then
+                  if (gap_ofs_low<gap_ofs_high) then
                     begin
                       gap_index:=gap_ofs_low+sizeof(eextended.low);
                       gap_size:=gap_ofs_high-gap_index;
@@ -1252,7 +1252,7 @@ Implementation
                       gap_size:=gap_ofs_low-gap_index;
                     end;
                   if source_info.endian<>target_info.endian then
-		      gap_index:=gap_index+gap_size-1;
+                      gap_index:=gap_index+gap_size-1;
                   has_gap:=gap_size <> 0;
                 end
               else
@@ -1680,7 +1680,7 @@ Implementation
               write a the value field with relocation }
             oldsec:=ObjData.CurrObjSec;
             ObjData.SetSection(ObjData.StabsSec);
-	    MaybeSwapStab(stab);
+            MaybeSwapStab(stab);
             ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
             ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
             ObjData.setsection(oldsec);
@@ -2169,17 +2169,26 @@ Implementation
         ddouble : double;
         {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
         eextended : extended;
-	{$else}
+        {$else}
         {$ifdef FPC_SOFT_FPUX80}
-	f32 : float32;
-	f64 : float64;
-	eextended : floatx80;
+        f32 : float32;
+        f64 : float64;
+        eextended : floatx80;
         {$endif}
         {$endif}
-        ccomp : comp;
+{$ifdef FPC_COMP_IS_INT64}
+        ccomp: int64;
+{$else}
+        ccomp: comp;
+{$endif}
+        comp_data_size : byte;
         tmp    : word;
         cpu: tcputype;
         ddword : dword;
+        b : byte;
+        w : word;
+        d : dword;
+        q : qword;
         eabi_section: TObjSection;
         s: String;
         TmpDataPos: TObjSectionOfs;
@@ -2286,12 +2295,22 @@ Implementation
          {$endif cpuextended}
                    aitrealconst_s64comp:
                      begin
+{$ifdef FPC_COMP_IS_INT64}
+                       ccomp:=system.trunc(tai_realconst(hp).value.s64compval);
+{$else}
                        ccomp:=comp(tai_realconst(hp).value.s64compval);
+{$endif}
                        pdata:=@ccomp;
                      end;
                    else
                      internalerror(2015030501);
                  end;
+                 if source_info.endian<>target_info.endian then
+                   begin
+                     for d:=0 to tai_realconst(hp).datasize-1 do
+                       lebbuf[d]:=pbyte(pdata)[tai_realconst(hp).datasize-1-d];
+                     pdata:=@lebbuf;
+                   end;
                  ObjData.writebytes(pdata^,tai_realconst(hp).datasize);
                  ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize);
                end;
@@ -2346,7 +2365,34 @@ Implementation
                        else if relative_reloc then
                          ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
                        else
-                         ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
+                         if source_info.endian<>target_info.endian then
+                           begin
+                             case tai_const(hp).size of
+                                1 : begin
+                                      b:=byte(Tai_const(hp).value);
+                                      ObjData.writebytes(b,1);
+                                    end;
+                                2 : begin
+                                      w:=word(Tai_const(hp).value);
+                                      w:=swapendian(w);
+                                      ObjData.writebytes(w,2);
+                                    end;
+                                4 : begin
+                                      d:=dword(Tai_const(hp).value);
+                                      d:=swapendian(d);
+                                      ObjData.writebytes(d,4);
+                                    end;
+                                8 : begin
+                                      q:=qword(Tai_const(hp).value);
+                                      q:=swapendian(q);
+                                      ObjData.writebytes(q,8);
+                                    end;
+                             else
+                               internalerror(2024012502);
+                             end;
+                           end
+                         else
+                           ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
                      end;
                    aitconst_rva_symbol :
                      begin

compiler/avr/aoptcpu.pas

@@ -444,12 +444,16 @@ Implementation
       }
       else if not(cs_opt_level3 in current_settings.optimizerswitches) and
       (taicpu(p).oper[0]^.typ=top_reg) and
+      assigned(FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous))) and
       (GetNextInstruction(p,hp1)) and MatchInstruction(hp1,A_LDS) and
       (taicpu(hp1).oper[0]^.typ=top_reg) and
+      assigned(FindRegAllocBackward(taicpu(hp1).oper[0]^.reg,tai(hp1.Previous))) and
       (GetNextInstruction(hp1, hp2)) and MatchInstruction(hp2,A_MOV) and
       (taicpu(hp2).oper[1]^.reg=taicpu(p).oper[0]^.reg) and
+      assigned(FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp2.Next))) and
       (GetNextInstruction(hp2, hp3)) and MatchInstruction(hp3,A_MOV) and
-      (taicpu(hp3).oper[1]^.reg=taicpu(hp1).oper[0]^.reg) then
+      (taicpu(hp3).oper[1]^.reg=taicpu(hp1).oper[0]^.reg) and
+      assigned(FindRegDeAlloc(taicpu(hp1).oper[0]^.reg,tai(hp3.Next))) then
       begin
         DebugMsg('Peephole LdsLdsMovMov2LdsLds performed', p);
 
@@ -498,21 +502,19 @@ Implementation
       (not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and
       (not RegUsedBetween(taicpu(hp1).oper[0]^.reg, p, hp1)) then
       begin
-        DebugMsg('Peephole LdsMov2Lds performed', p);
-
         alloc:=FindRegAllocBackward(taicpu(p).oper[0]^.reg,tai(p.Previous));
         dealloc:=FindRegDeAlloc(taicpu(p).oper[0]^.reg,tai(hp1.Next));
         if assigned(alloc) and assigned(dealloc) then
           begin
+            DebugMsg('Peephole LdsMov2Lds performed', p);
             asml.Remove(alloc);
             alloc.Free;
             asml.Remove(dealloc);
             dealloc.Free;
+            taicpu(p).oper[0]^.reg:=taicpu(hp1).oper[0]^.reg;
+            RemoveInstruction(hp1);
+            result:=true;
           end;
-
-        taicpu(p).oper[0]^.reg:=taicpu(hp1).oper[0]^.reg;
-        RemoveInstruction(hp1);
-        result:=true;
       end;
     end;
 

compiler/avr/navrutil.pas

@@ -27,6 +27,7 @@ interface
 
   uses
     cclasses,
+    fmodule,
     node,nbas,
     ngenutil,
     symtype,symconst,symsym,symdef;
@@ -35,13 +36,13 @@ interface
   type
     tavrnodeutils = class(tnodeutils)
     protected
-      class procedure insert_init_final_table(entries:tfplist); override;
+      class procedure insert_init_final_table(main: tmodule; entries:tfplist); override;
     end;
 
 implementation
 
     uses
-      verbose,cutils,globtype,globals,constexp,fmodule,
+      verbose,cutils,globtype,globals,constexp,
       aasmdata,aasmtai,aasmcpu,aasmcnst,aasmbase,
       cpubase,
       symbase,symcpu,symtable,defutil,
@@ -52,7 +53,7 @@ implementation
       pass_1;
 
 
-  class procedure tavrnodeutils.insert_init_final_table(entries:tfplist);
+  class procedure tavrnodeutils.insert_init_final_table(main: tmodule; entries:tfplist);
     var
       op : TAsmOp;
       initList, finalList, header: TAsmList;
@@ -104,7 +105,7 @@ implementation
       initList.Free;
       finalList.Free;
 
-      inherited insert_init_final_table(entries);
+      inherited insert_init_final_table(main,entries);
     end;
 
 begin

compiler/browcol.pas

@@ -1778,9 +1778,11 @@ begin
            name:=GetStr(T.Name);
            msource:=hp.mainsource;
            New(UnitS, Init(Name,msource));
+{          // A unit can be loaded from many other places, so a single loaded_from is misleading.
            if Assigned(hp.loaded_from) then
              if assigned(hp.loaded_from.globalsymtable) then
                UnitS^.SetLoadedFrom(tsymtable(hp.loaded_from.globalsymtable).name^);
+               }
 {           pimportlist(current_module^.imports^.first);}
 
            if assigned(hp.sourcefiles) then

compiler/cgutils.pas

@@ -224,11 +224,17 @@ unit cgutils;
       WARNING: d must not be a power of 2 (including 2^0 = 1) }
     procedure calc_mul_inverse(N: byte; d: aWord; out reciprocal: aWord; out shift: Byte);
 
+    { returns true if the CPU architecture we are currently compiling for needs
+      software checks for fpu exceptions }
+    function needs_check_for_fpu_exceptions : boolean;
+
 implementation
 
 uses
   systems,
   verbose,
+  globals,
+  cpuinfo,
   cgobj;
 
 {****************************************************************************
@@ -570,6 +576,24 @@ uses
           reciprocal:=swap_r;
         until d<=1;
       end;
+
+
+    function needs_check_for_fpu_exceptions: boolean;
+      begin
+{$if defined(AARCH64)}
+        result:=cs_check_fpu_exceptions in current_settings.localswitches;
+{$elseif defined(ARM)}
+        result:=(cs_check_fpu_exceptions in current_settings.localswitches) and
+          not(FPUARM_HAS_EXCEPTION_TRAPPING in fpu_capabilities[current_settings.fputype]);
+{$elseif defined(RISCV)}
+        result:=cs_check_fpu_exceptions in current_settings.localswitches;
+{$elseif defined(XTENSA)}
+        result:=cs_check_fpu_exceptions in current_settings.localswitches;
+{$else}
+        result:=false;
+{$endif}
+      end;
+
 {$pop}
 
 end.

compiler/compiler.pas

@@ -152,6 +152,7 @@ uses
 {$ifdef aix}
   ,i_aix
 {$endif aix}
+  ,ctask
   ,globtype;
 
 function Compile(const cmd:TCmdStr):longint;
@@ -159,6 +160,8 @@ function Compile(const cmd:TCmdStr):longint;
 implementation
 
 uses
+  finput,
+  fppu,
   aasmcpu;
 
 {$if defined(MEMDEBUG)}
@@ -196,6 +199,7 @@ begin
   DoneGlobals;
   DoneFileUtils;
   donetokens;
+  DoneTaskHandler;
 end;
 
 
@@ -233,6 +237,7 @@ begin
   InitAsm;
   InitWpo;
 
+  InitTaskHandler;
   CompilerInitedAfterArgs:=true;
 end;
 
@@ -261,6 +266,8 @@ var
 {$endif SHOWUSEDMEM}
   ExceptionMask : TFPUExceptionMask;
   totaltime : real;
+  m : tppumodule;
+
 begin
   try
     try
@@ -291,7 +298,18 @@ begin
         parser.preprocess(inputfilepath+inputfilename)
        else
   {$endif PREPROCWRITE}
-        parser.compile(inputfilepath+inputfilename);
+         begin
+         m:=tppumodule.create(Nil,'',inputfilepath+inputfilename,false);
+         m.state:=ms_compile;
+         m.is_initial:=true;
+         { We need to add the initial module manually to the list of units }
+         addloadedunit(m);
+         main_module:=m;
+         m.state:=ms_compile;
+         task_handler.addmodule(m);
+         task_handler.processqueue;
+         end;
+
 
        { Show statistics }
        if status.errorcount=0 then

compiler/compinnr.pas

@@ -172,6 +172,10 @@ type
      in_min_longint      = 142,
      in_max_dword        = 143,
      in_max_longint      = 144,
+     in_min_qword        = 145,
+     in_min_int64        = 146,
+     in_max_qword        = 147,
+     in_max_int64        = 148,
 
 { MMX functions }
 { these contants are used by the mmx unit }

compiler/cresstr.pas

@@ -338,7 +338,7 @@ uses
     procedure Tresourcestrings.ConstSym_Register(p:TObject;arg:pointer);
       begin
         if (tsym(p).typ=constsym) and
-           (tconstsym(p).consttyp=constresourcestring) then
+           (tconstsym(p).consttyp in [constresourcestring,constwresourcestring]) then
           List.Concat(TResourceStringItem.Create(TConstsym(p)));
       end;
 

compiler/ctask.pas

@@ -0,0 +1,401 @@
+{
+    Copyright (c) 2024- by Michael Van Canneyt
+
+    This unit handles the compiler tasks.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+
+unit ctask;
+
+{$mode ObjFPC}
+
+{ $DEFINE DEBUG_CTASK}
+
+interface
+
+uses
+  fmodule, cclasses, globstat;
+
+type
+  { ttask_list }
+
+  ttask_list = class(tlinkedlistitem)
+     module : tmodule;
+     state : tglobalstate;
+     constructor create(_m : tmodule);
+     destructor destroy; override;
+     procedure SaveState;
+     Procedure RestoreState;
+     procedure DiscardState;
+     function nexttask : ttask_list; inline;
+  end;
+
+  ttasklinkedlist = class(tlinkedlist)
+    function firsttask : ttask_list; inline;
+  end;
+
+  { ttask_handler }
+
+
+  ttask_handler = class
+  private
+    list : ttasklinkedlist;
+    hash : TFPHashList;
+    main : tmodule;
+    procedure rebuild_hash;
+  public
+    constructor create;
+    destructor destroy; override;
+    // Find the task for module m
+    function findtask(m : tmodule) : ttask_list;
+    // Can we continue processing this module ? If not, firstwaiting contains first module that m is waiting for.
+    function cancontinue(m : tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
+    // Overload of cancontinue, based on task.
+    function cancontinue(t: ttask_list; out firstwaiting: tmodule): boolean; inline;
+    // Continue processing this module. Return true if the module is done and can be removed.
+    function continue(t : ttask_list): Boolean;
+    // process the queue. Note that while processing the queue, elements will be added.
+    procedure processqueue;
+    // add a module to the queue. If a module is already in the queue, we do not add it again.
+    procedure addmodule(m : tmodule);
+  end;
+
+
+var
+  task_handler : TTask_handler;
+
+procedure InitTaskHandler;
+procedure DoneTaskHandler;
+
+implementation
+
+uses verbose, fppu, finput, globtype, sysutils, scanner, parser, pmodules;
+
+procedure InitTaskHandler;
+begin
+  task_handler:=ttask_handler.create;
+end;
+
+procedure DoneTaskHandler;
+begin
+  freeandnil(task_handler);
+end;
+
+{ ttasklinkedlist }
+
+function ttasklinkedlist.firsttask: ttask_list;
+begin
+  Result:=ttask_list(first);
+end;
+
+{ ttask_list }
+
+constructor ttask_list.create(_m: tmodule);
+begin
+  inherited create;
+  module:=_m;
+  state:=nil;
+end;
+
+
+destructor ttask_list.destroy;
+begin
+  DiscardState;
+  Inherited;
+end;
+
+procedure ttask_list.DiscardState;
+
+begin
+  FreeAndNil(state);
+end;
+
+function ttask_list.nexttask: ttask_list;
+begin
+  Result:=ttask_list(next);
+end;
+
+procedure ttask_list.SaveState;
+begin
+  if State=Nil then
+    State:=tglobalstate.Create(true)
+  else
+    State.save(true);
+end;
+
+procedure ttask_list.RestoreState;
+begin
+  if not module.is_reset then
+    state.restore(true);
+  if assigned(current_scanner) and assigned(current_scanner.inputfile) then
+      if current_scanner.inputfile.closed then
+      begin
+      current_scanner.tempopeninputfile;
+      current_scanner.gettokenpos;
+      end;
+end;
+
+{ ttask_handler }
+
+constructor ttask_handler.create;
+begin
+  list:=ttasklinkedlist.Create;
+  hash:=TFPHashList.Create;
+end;
+
+destructor ttask_handler.destroy;
+begin
+  hash.free;
+  List.Clear;
+  FreeAndNil(list);
+  inherited destroy;
+end;
+
+function ttask_handler.findtask(m: tmodule): ttask_list;
+
+begin
+  result:=list.FirstTask;
+  while result<>nil do
+    begin
+    if result.module=m then
+      exit;
+    result:=result.nexttask;
+    end;
+  {$IFDEF DEBUG_CTASK}Writeln('No task found for '+m.ToString);{$ENDIF}
+end;
+
+function ttask_handler.cancontinue(m: tmodule; checksub : boolean; out firstwaiting: tmodule): boolean;
+
+  procedure CheckUsed(out acandidate : tmodule);
+
+  var
+    itm : TLinkedListItem;
+    iscandidate : boolean;
+    m2 : tmodule;
+
+  begin
+    acandidate:=nil;
+    itm:=m.used_units.First;
+    while (acandidate=Nil) and assigned(itm) do
+      begin
+      iscandidate:=Not (tused_unit(itm).u.state in [ms_processed,ms_compiled]);
+      if iscandidate then
+        begin
+        acandidate:=tused_unit(itm).u;
+        if not cancontinue(acandidate,false,m2) then
+          acandidate:=nil;
+        end;
+      itm:=itm.Next;
+      end;
+   end;
+
+var
+  m2 : tmodule;
+
+begin
+  firstwaiting:=nil;
+  // We do not need to consider the program as long as there are units that need to be treated.
+  if (m.is_initial and not m.is_unit) and (list.count>1) then
+    exit(False);
+  case m.state of
+    ms_unknown : cancontinue:=true;
+    ms_registered : cancontinue:=true;
+    ms_compile : cancontinue:=true;
+    ms_compiling_waitimpl : cancontinue:=m.usedunitsloaded(false,firstwaiting);
+    ms_compiling_waitfinish : cancontinue:=m.nowaitingforunits(firstwaiting);
+    ms_compiling_waitintf : cancontinue:=m.usedunitsloaded(true,firstwaiting);
+    ms_compiling_wait : cancontinue:=m.usedunitsloaded(true,firstwaiting);
+    ms_compiled : cancontinue:=true;
+    ms_processed : cancontinue:=true;
+    ms_moduleerror : cancontinue:=true;
+  else
+    InternalError(2024011802);
+  end;
+  if (not cancontinue) and checksub then
+    begin
+    checkused(m2);
+    if m2<>nil then
+      firstwaiting:=m2;
+    end;
+  {$IFDEF DEBUG_CTASK}
+  Write(m.ToString,' state: ',m.state,', can continue: ',Result);
+  if result then
+    Writeln
+  else
+    begin
+    Write(' (First waiting: ');
+    If Assigned(FirstWaiting) then
+      Writeln(FirstWaiting.ToString,' )')
+    else
+      Writeln('<none>)');
+    end;
+  {$ENDIF}
+end;
+
+function ttask_handler.cancontinue(t : ttask_list; out firstwaiting : tmodule): boolean;
+
+begin
+  Result:=cancontinue(t.module,true,firstwaiting);
+end;
+
+function ttask_handler.continue(t : ttask_list) : Boolean;
+
+var
+  m : tmodule;
+  orgname : shortstring;
+
+begin
+  m:=t.module;
+  orgname:=m.modulename^;
+  {$IFDEF DEBUG_CTASK}Writeln(m.ToString,' Continues. State: ',m.state);{$ENDIF}
+  if Assigned(t.state) then
+    t.RestoreState;
+  case m.state of
+    ms_registered : parser.compile_module(m);
+    ms_compile : parser.compile_module(m);
+    ms_compiled : if (not m.is_initial) or m.is_unit  then
+                   (m as tppumodule).post_load_or_compile(m,m.compilecount>1);
+    ms_compiling_waitintf : pmodules.parse_unit_interface_declarations(m);
+    ms_compiling_waitimpl : pmodules.proc_unit_implementation(m);
+    ms_compiling_waitfinish : pmodules.finish_unit(m);
+    ms_compiling_wait : pmodules.proc_program_declarations(m,m.islibrary);
+    ms_processed : ;
+  else
+    InternalError(2024011801);
+  end;
+  if m.state=ms_compiled then
+    begin
+    parsing_done(m);
+    if m.is_initial and not m.is_unit then
+      m.state:=ms_processed;
+    end;
+  Result:=m.state=ms_processed;
+  {$IFDEF DEBUG_CTASK}
+  Write(m.ToString,' done: ',Result);
+  if Result then
+    Writeln
+  else
+    Writeln(', state is now: ',m.state);
+  {$ENDIF}
+  if not result then
+    // Not done, save state
+    t.SaveState;
+  {
+    the name can change as a result of processing, e.g. PROGRAM -> TB0406
+    Normally only for the initial module, but we'll do a generic check.
+  }
+  if m.modulename^<>orgname then
+    rebuild_hash;
+end;
+
+procedure ttask_handler.rebuild_hash;
+
+var
+  t : ttask_list;
+
+begin
+  Hash.Clear;
+  t:=list.firsttask;
+  While assigned(t) do
+    begin
+    Hash.Add(t.module.modulename^,t);
+    t:=t.nexttask;
+    end;
+end;
+
+procedure ttask_handler.processqueue;
+
+var
+  t,t2 : ttask_list;
+  process : boolean;
+  dummy,firstwaiting : tmodule;
+
+begin
+  t:=list.firsttask;
+  While t<>nil do
+    begin
+    process:=cancontinue(t,firstwaiting);
+    if process then
+      begin
+      if continue(t) then
+        begin
+        {$IFDEF DEBUG_CTASK}Writeln(t.module.ToString,' is finished, removing from task list');{$ENDIF}
+        hash.Remove(t.module);
+        list.Remove(t);
+        end;
+      // maybe the strategy can be improved.
+      t:=list.firsttask;
+      end
+    else if assigned(firstwaiting) and cancontinue(firstwaiting,true, dummy) then
+      begin
+      t2:=findtask(firstwaiting);
+      if t2=nil then
+        t2:=t.nexttask;
+      t:=t2;
+      end
+    else
+      begin
+      t:=t.nexttask;
+      end;
+    if t=nil then
+      t:=list.firsttask;
+    end;
+end;
+
+procedure ttask_handler.addmodule(m: tmodule);
+
+var
+  n : TSymStr;
+  e, t : ttask_list;
+
+begin
+  {$IFDEF DEBUG_CTASK}Writeln(m.ToString,' added to task scheduler. State: ',m.state);{$ENDIF}
+  n:=m.modulename^;
+  e:=ttask_list(Hash.Find(n));
+  if e=nil then
+    begin
+    // Clear reset flag.
+    // This can happen when during load, reset is done and unit is added to task list.
+    m.is_reset:=false;
+    t:=ttask_list.create(m);
+    list.insert(t);
+    hash.Add(n,t);
+    if list.count=1 then
+      main:=m;
+    end
+  else
+    begin
+    // We have a task, if it was reset, then clear the state and move the task to the start.
+    if m.is_reset then
+      begin
+      {$IFDEF DEBUG_CTASK}Writeln(m.ToString,' was reset, resetting flag. State: ',m.state);{$ENDIF}
+      m.is_reset:=false;
+      t:=findtask(m);
+      if assigned(t) then
+        begin
+        t.DiscardState;
+        list.Remove(t);
+        list.insertbefore(t,list.First);
+        end;
+      end;
+    end;
+end;
+
+
+
+end.
+

compiler/dbgdwarf.pas

@@ -2703,6 +2703,7 @@ implementation
                 usedef:=clongstringtype;
             end;
           constresourcestring,
+          constwresourcestring,
           constwstring:
             usedef:=nil;
           else
@@ -2753,6 +2754,7 @@ implementation
                 end;
             end;
           constwstring,
+          constwresourcestring,
           constresourcestring:
             begin
               { write dummy for now }

compiler/defcmp.pas

@@ -473,11 +473,13 @@ implementation
          if (
                (df_generic in def_to.defoptions) and
                (df_specialization in def_from.defoptions) and
-               (tstoreddef(def_from).genericdef=def_to)
+               (tstoreddef(def_from).genericdef=def_to) and
+               assigned(tstoreddef(def_to).genericparas)
              ) or (
                (df_generic in def_from.defoptions) and
                (df_specialization in def_to.defoptions) and
-               (tstoreddef(def_to).genericdef=def_from)
+               (tstoreddef(def_to).genericdef=def_from) and
+               assigned(tstoreddef(def_from).genericparas)
              ) then
            begin
              if tstoreddef(def_from).genericdef=def_to then

compiler/defutil.pas

@@ -283,6 +283,9 @@ interface
     {# Returns true, if def is a 64 bit signed integer type }
     function is_s64bitint(def : tdef) : boolean;
 
+    {# Returns true, if def is a qword type }
+    function is_u64bitint(def : tdef) : boolean;
+
     {# Returns true, if def is a 64 bit ordinal type }
     function is_64bit(def : tdef) : boolean;
 
@@ -1149,6 +1152,12 @@ implementation
       end;
 
 
+    function is_u64bitint(def: tdef): boolean;
+      begin
+        is_u64bitint:=(def.typ=orddef) and (torddef(def).ordtype=u64bit)
+      end;
+
+
     { true, if def is a 64 bit type }
     function is_64bit(def : tdef) : boolean;
       begin

compiler/finput.pas

@@ -117,17 +117,31 @@ interface
      type
         tmodulestate = (ms_unknown,
           ms_registered,
-          ms_load,ms_compile,
-          ms_second_load,ms_second_compile,
-          ms_compiled
+          ms_load,
+          ms_compile,
+          ms_compiling_waitintf,
+          ms_compiling_waitimpl,
+          ms_compiling_waitfinish,
+          ms_compiling_wait,
+          ms_compiled,
+          ms_processed,
+          ms_moduleerror
         );
+        tmodulestates = set of tmodulestate;
+
      const
-        ModuleStateStr : array[TModuleState] of string[20] = (
+        ModuleStateStr : array[TModuleState] of string[32] = (
           'Unknown',
           'Registered',
-          'Load','Compile',
-          'Second_Load','Second_Compile',
-          'Compiled'
+          'Load',
+          'Compile',
+          'Compiling_Waiting_interface',
+          'Compiling_Waiting_implementation',
+          'Compiling_Waiting_finish',
+          'Compiling_Waiting',
+          'Compiled',
+          'Processed',
+          'Error'
         );
 
      type
@@ -162,6 +176,7 @@ interface
 {$ifdef DEBUG_NODE_XML}
           ppxfilefail: Boolean;     { If the ppxfile could not be accessed, flag it }
 {$endif DEBUG_NODE_XML}
+          is_initial : boolean;     { is this the initial module, i.e. the one specified on the command-line ?}
           constructor create(const s:string);
           destructor destroy;override;
           procedure setfilename(const fn:TPathStr;allowoutput:boolean);
@@ -627,8 +642,7 @@ uses
            p:=path;
 
          { lib and exe could be loaded with a file specified with -o }
-         if AllowOutput and
-            (compile_level=1) and
+         if AllowOutput and is_initial and
             (OutputFileName<>'')then
            begin
              exefilename:=p+OutputFileName;

compiler/fmodule.pas

@@ -57,6 +57,10 @@ interface
         rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
       );
 
+{$ifdef VER3_2}
+      RTLString = ansistring;
+{$endif VER3_2}
+
       { unit options }
       tmoduleoption = (mo_none,
         mo_hint_deprecated,
@@ -107,6 +111,7 @@ interface
       private
         FImportLibraryList : TFPHashObjectList;
       public
+        is_reset,                 { has reset been called ? }
         do_reload,                { force reloading of the unit }
         do_compile,               { need to compile the sources }
         sources_avail,            { if all sources are reachable }
@@ -163,6 +168,7 @@ interface
         localsymtable : TSymtable;{ pointer to the local symtable of this unit }
         globalmacrosymtable,           { pointer to the global macro symtable of this unit }
         localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit }
+        mainscanner   : TObject;  { scanner object used }
         scanner       : TObject;  { scanner object used }
         procinfo      : TObject;  { current procedure being compiled }
         asmdata       : TObject;  { Assembler data }
@@ -171,7 +177,6 @@ interface
         externasmsyms : TFPHashObjectList; { contains the assembler symbols which are imported from another unit }
         unitimportsyms : tfpobjectlist; { list of symbols that are imported from other units }
         debuginfo     : TObject;
-        loaded_from   : tmodule;
         _exports      : tlinkedlist;
         dllscannerinputlist : TFPHashList;
         localnamespacelist,
@@ -198,6 +203,10 @@ interface
 
         moduleoptions: tmoduleoptions;
         deprecatedmsg: pshortstring;
+        loadcount : integer;
+        compilecount : integer;
+        consume_semicolon_after_uses : Boolean;
+        initfinalchecked : boolean;
 
         { contains a list of types that are extended by helper types; the key is
           the full name of the type and the data is a TFPObjectList of
@@ -224,7 +233,6 @@ interface
         waitingunits: tfpobjectlist;
 
         finishstate: pointer;
-        globalstate: pointer;
 
         namespace: pshortstring; { for JVM target: corresponds to Java package name }
 
@@ -246,10 +254,13 @@ interface
         destructor destroy;override;
         procedure reset;virtual;
         procedure loadlocalnamespacelist;
-        procedure adddependency(callermodule:tmodule);
+        procedure adddependency(callermodule:tmodule; frominterface : boolean);
         procedure flagdependent(callermodule:tmodule);
         procedure addimportedsym(sym:TSymEntry);
         function  addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit;
+        function  usesmodule_in_interface(m : tmodule) : boolean;
+        function usedunitsloaded(interface_units: boolean; out firstwaiting : tmodule): boolean;
+        function nowaitingforunits(out firstwaiting : tmodule) : Boolean;
         procedure updatemaps;
         function  derefidx_unit(id:longint):longint;
         function  resolve_unit(id:longint):tmodule;
@@ -261,7 +272,9 @@ interface
         procedure add_public_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
         procedure add_extern_asmsym(sym:TAsmSymbol);
         procedure add_extern_asmsym(const name:TSymStr;bind:TAsmsymbind;typ:Tasmsymtype);
+        procedure remove_from_waitingforunits(amodule : tmodule);
         property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
+        function ToString: RTLString; override;
       end;
 
        tused_unit = class(tlinkedlistitem)
@@ -278,7 +291,8 @@ interface
 
        tdependent_unit = class(tlinkedlistitem)
           u : tmodule;
-          constructor create(_u : tmodule);
+          in_interface : boolean;
+          constructor create(_u : tmodule; frominterface : boolean);
        end;
 
     var
@@ -334,6 +348,7 @@ implementation
       end;
 
     procedure set_current_module(p:tmodule);
+
       begin
         { save the state of the scanner }
         if assigned(current_scanner) then
@@ -347,7 +362,7 @@ implementation
             current_asmdata:=tasmdata(current_module.asmdata);
             current_debuginfo:=tdebuginfo(current_module.debuginfo);
             { restore scanner and file positions }
-            current_scanner:=tscannerfile(current_module.scanner);
+            set_current_scanner(tscannerfile(current_module.scanner));
             if assigned(current_scanner) then
               begin
                 current_scanner.tempopeninputfile;
@@ -363,7 +378,7 @@ implementation
         else
           begin
             current_asmdata:=nil;
-            current_scanner:=nil;
+            set_current_scanner(nil);
             current_debuginfo:=nil;
           end;
       end;
@@ -494,7 +509,7 @@ implementation
         in_interface:=intface;
         in_uses:=inuses;
         unitsym:=usym;
-        if _u.state=ms_compiled then
+        if _u.state in [ms_compiled,ms_processed] then
          begin
            checksum:=u.crc;
            interface_checksum:=u.interface_crc;
@@ -534,9 +549,10 @@ implementation
                             TDENPENDENT_UNIT
  ****************************************************************************}
 
-    constructor tdependent_unit.create(_u : tmodule);
+    constructor tdependent_unit.create(_u: tmodule; frominterface: boolean);
       begin
          u:=_u;
+         in_interface:=frominterface;
       end;
 
 
@@ -630,7 +646,6 @@ implementation
         localsymtable:=nil;
         globalmacrosymtable:=nil;
         localmacrosymtable:=nil;
-        loaded_from:=LoadedFrom;
         do_reload:=false;
         do_compile:=false;
         sources_avail:=true;
@@ -660,7 +675,7 @@ implementation
       end;
 
 
-    destructor tmodule.Destroy;
+    destructor tmodule.destroy;
       var
         i : longint;
         current_debuginfo_reset : boolean;
@@ -682,8 +697,9 @@ implementation
             { also update current_scanner if it was pointing
               to this module }
             if current_scanner=tscannerfile(scanner) then
-             current_scanner:=nil;
-            tscannerfile(scanner).free;
+              set_current_scanner(nil);
+            freeandnil(scanner);
+
          end;
         if assigned(asmdata) then
           begin
@@ -779,14 +795,14 @@ implementation
         i   : longint;
         current_debuginfo_reset : boolean;
       begin
+        is_reset:=true;
         if assigned(scanner) then
           begin
             { also update current_scanner if it was pointing
               to this module }
             if current_scanner=tscannerfile(scanner) then
-             current_scanner:=nil;
-            tscannerfile(scanner).free;
-            scanner:=nil;
+              set_current_scanner(nil);
+            freeandnil(scanner);
           end;
         if assigned(procinfo) then
           begin
@@ -954,32 +970,32 @@ implementation
 
     procedure tmodule.loadlocalnamespacelist;
 
-    var
-      nsitem : TCmdStrListItem;
+      var
+        nsitem : TCmdStrListItem;
 
-    begin
-      // Copying local namespace list
-      if premodule_namespacelist.Count>0 then
-        begin
-        nsitem:=TCmdStrListItem(premodule_namespacelist.First);
-        while assigned(nsItem) do
+      begin
+        // Copying local namespace list
+        if premodule_namespacelist.Count>0 then
           begin
-          localnamespacelist.Concat(nsitem.Str);
-          nsItem:=TCmdStrListItem(nsitem.Next);
+          nsitem:=TCmdStrListItem(premodule_namespacelist.First);
+          while assigned(nsItem) do
+            begin
+            localnamespacelist.Concat(nsitem.Str);
+            nsItem:=TCmdStrListItem(nsitem.Next);
+            end;
+          premodule_namespacelist.Clear;
           end;
-        premodule_namespacelist.Clear;
-        end;
-      current_namespacelist:=localnamespacelist;
-    end;
+        current_namespacelist:=localnamespacelist;
+      end;
 
 
-    procedure tmodule.adddependency(callermodule:tmodule);
+    procedure tmodule.adddependency(callermodule: tmodule; frominterface: boolean);
       begin
         { This is not needed for programs }
         if not callermodule.is_unit then
           exit;
         Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^);
-        dependent_units.concat(tdependent_unit.create(callermodule));
+        dependent_units.concat(tdependent_unit.create(callermodule,frominterface));
       end;
 
 
@@ -995,10 +1011,10 @@ implementation
              this unit, unless this unit is already compiled during
              the loading }
            if (pm.u=callermodule) and
-              (pm.u.state<>ms_compiled) then
+              (pm.u.state<ms_compiled) then
              Message1(unit_u_no_reload_is_caller,pm.u.modulename^)
            else
-            if pm.u.state=ms_second_compile then
+            if (pm.u.state=ms_compile) and (pm.u.compilecount>1) then
               Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^)
            else
             begin
@@ -1026,6 +1042,59 @@ implementation
       end;
 
 
+    function tmodule.usedunitsloaded(interface_units : boolean; out firstwaiting : tmodule): boolean;
+
+      const
+        statesneeded : array[boolean] of tmodulestates = ([ms_processed, ms_compiled,ms_compiling_waitimpl, ms_compiling_waitfinish],
+                                                          [ms_processed, ms_compiled,ms_compiling_waitimpl, ms_compiling_waitfinish]);
+
+      var
+        itm : TLinkedListItem;
+        states : set of tmodulestate;
+
+      begin
+        Result:=True;
+        States:=statesneeded[interface_units];
+        itm:=self.used_units.First;
+        firstwaiting:=Nil;
+        while Result and assigned(itm) do
+          begin
+          result:=tused_unit(itm).u.state in states;
+          {$IFDEF DEBUG_CTASK}writeln('  ',ToString,' checking state of ', tused_unit(itm).u.ToString,' : ',tused_unit(itm).u.state,' : ',Result);{$ENDIF}
+          if not result then
+             begin
+             if firstwaiting=Nil then
+                firstwaiting:=tused_unit(itm).u;
+             end;
+          itm:=itm.Next;
+          end;
+      end;
+
+    function tmodule.nowaitingforunits(out firstwaiting : tmodule): Boolean;
+
+      begin
+        firstwaiting:=nil;
+        Result:=waitingforunit.count=0;
+        If not Result then
+          firstwaiting:=tmodule(waitingforunit[0]);
+      end;
+
+    function tmodule.usesmodule_in_interface(m: tmodule): boolean;
+
+      var
+        u : tused_unit;
+
+      begin
+        result:=False;
+        u:=tused_unit(used_units.First);
+        while assigned(u) do
+          begin
+          if (u.u=m) then
+            exit(u.in_interface) ;
+          u:=tused_unit(u.next);
+          end;
+      end;
+
     procedure tmodule.updatemaps;
       var
         oldmapsize : longint;
@@ -1152,8 +1221,8 @@ implementation
         if assigned(scanner) then
           begin
             if current_scanner=tscannerfile(scanner) then
-              current_scanner:=nil;
-            tscannerfile(scanner).free;
+              set_current_scanner(nil);
+            FreeAndNil(scanner);
             scanner:=nil;
           end;
 
@@ -1210,8 +1279,8 @@ implementation
       end;
 
 
-    procedure TModule.AddExternalImport(const libname,symname,symmangledname:string;
-              OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean);
+    procedure tmodule.AddExternalImport(const libname, symname, symmangledname: string; OrdNr: longint; isvar: boolean;
+      ImportByOrdinalOnly: boolean);
       var
         ImportLibrary,OtherIL : TImportLibrary;
         ImportSymbol  : TImportSymbol;
@@ -1291,6 +1360,23 @@ implementation
         tasmsymbol.create(externasmsyms,name,bind,typ);
       end;
 
+    procedure tmodule.remove_from_waitingforunits(amodule: tmodule);
+    begin
+      // It can be nil after when this is called after end_of_parsing was called.
+      if assigned(waitingforunit) then
+        waitingforunit.remove(amodule);
+    end;
+
+    function tmodule.ToString: RTLString;
+      begin
+        // Assigned self so we can detect nil.
+        if assigned(modulename) then
+          Result:='('+ModuleName^+')'
+        else
+         Result:='(<'+inttostr(ptrint(self))+'>)';
+        // Possibly add some state ?
+      end;
+
 
 initialization
 {$ifdef MEMDEBUG}

compiler/fppu.pas

@@ -64,11 +64,14 @@ interface
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
           procedure reset;override;
+          procedure re_resolve(loadfrom: tmodule);
           function  openppufile:boolean;
           function  openppustream(strm:TCStream):boolean;
           procedure getppucrc;
           procedure writeppu;
-          procedure loadppu;
+          function loadppu(from_module : tmodule) : boolean;
+          procedure post_load_or_compile(from_module : tmodule; second_time: boolean);
+          procedure discardppu;
           function  needrecompile:boolean;
           procedure setdefgeneration;
           procedure reload_flagged_units;
@@ -82,9 +85,13 @@ interface
            avoid endless resolving loops in case of cyclic dependencies. }
           defsgeneration : longint;
 
+          function check_loadfrompackage: boolean;
+          procedure check_reload(from_module: tmodule; var do_load: boolean);
           function  openppu(ppufiletime:longint):boolean;
-          function  search_unit_files(onlysource:boolean):boolean;
-          function  search_unit(onlysource,shortname:boolean):boolean;
+          procedure prepare_second_load(from_module: tmodule);
+          procedure recompile_from_sources(from_module: tmodule);
+          function  search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
+          function  search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
           function  loadfrompackage:boolean;
           procedure load_interface;
           procedure load_implementation;
@@ -94,6 +101,7 @@ interface
           procedure buildderefunitimportsyms;
           procedure derefunitimportsyms;
           procedure freederefunitimportsyms;
+          procedure try_load_ppufile(from_module: tmodule);
           procedure writesourcefiles;
           procedure writeusedunit(intf:boolean);
           procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
@@ -124,7 +132,7 @@ interface
 {$ENDIF}
        end;
 
-    function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
+    function registerunit(callermodule:tmodule;const s : TIDString;const fn:string; out is_new:boolean) : tppumodule;
 
 
 implementation
@@ -158,11 +166,9 @@ var
       end;
 
 
-    destructor tppumodule.Destroy;
+    destructor tppumodule.destroy;
       begin
-        if assigned(ppufile) then
-         ppufile.free;
-        ppufile:=nil;
+        discardppu;
         comments.free;
         comments:=nil;
         { all derefs allocated with new
@@ -177,17 +183,50 @@ var
     procedure tppumodule.reset;
       begin
         inc(currentdefgeneration);
-        if assigned(ppufile) then
-         begin
-           ppufile.free;
-           ppufile:=nil;
-         end;
+        discardppu;
         freederefunitimportsyms;
         unitimportsymsderefs.free;
         unitimportsymsderefs:=tfplist.create;
         inherited reset;
       end;
 
+    procedure tppumodule.re_resolve(loadfrom: tmodule);
+
+      begin
+        Message1(unit_u_reresolving_unit,modulename^);
+        if tstoredsymtable(globalsymtable).is_deref_built then
+          tstoredsymtable(globalsymtable).deref(false);
+        if tstoredsymtable(globalsymtable).is_derefimpl_built then
+          tstoredsymtable(globalsymtable).derefimpl(false);
+        if assigned(localsymtable) then
+          begin
+            { we have only builderef(impl)'d the registered symbols of
+              the localsymtable -> also only deref those again }
+            if tstoredsymtable(localsymtable).is_deref_built then
+              tstoredsymtable(localsymtable).deref(true);
+            if tstoredsymtable(localsymtable).is_derefimpl_built then
+              tstoredsymtable(localsymtable).derefimpl(true);
+          end;
+        if assigned(wpoinfo) then
+          begin
+            tunitwpoinfo(wpoinfo).deref;
+            tunitwpoinfo(wpoinfo).derefimpl;
+          end;
+
+        { We have to flag the units that depend on this unit even
+          though it didn't change, because they might also
+          indirectly depend on the unit that did change (e.g.,
+          in case rgobj, rgx86 and rgcpu have been compiled
+          already, and then rgobj is recompiled for some reason
+          -> rgx86 is re-reresolved, but the vmtentries of trgcpu
+          must also be re-resolved, because they will also contain
+          pointers to procdefs in the old trgobj (in case of a
+          recompile, all old defs are freed) }
+        flagdependent(loadfrom);
+        reload_flagged_units;
+      end;
+
+
     procedure tppumodule.queuecomment(const s:TMsgStr;v,w:longint);
     begin
       if comments = nil then
@@ -225,8 +264,7 @@ var
         ppufile:=tcompilerppufile.create(ppufilename);
         if not ppufile.openfile then
          begin
-           ppufile.free;
-           ppufile:=nil;
+           discardppu;
            Message(unit_u_ppu_file_too_short);
            exit;
          end;
@@ -242,8 +280,7 @@ var
         ppufile:=tcompilerppufile.create(ppufilename);
         if not ppufile.openstream(strm) then
          begin
-           ppufile.free;
-           ppufile:=nil;
+           discardppu;
            Message(unit_u_ppu_file_too_short);
            exit;
          end;
@@ -380,8 +417,7 @@ var
         if not checkheader or
            not checkextraheader then
           begin
-            ppufile.free;
-            ppufile:=nil;
+            discardppu;
             exit;
           end;
 
@@ -407,23 +443,23 @@ var
       end;
 
 
-    function tppumodule.search_unit_files(onlysource:boolean):boolean;
+    function tppumodule.search_unit_files(loaded_from : tmodule; onlysource:boolean):boolean;
       var
         found : boolean;
       begin
         found:=false;
-        if search_unit(onlysource,false) then
+        if search_unit(loaded_from,onlysource,false) then
           found:=true;
         if (not found) and
            (ft83 in AllowedFilenameTransFormations) and
            (length(modulename^)>8) and
-           search_unit(onlysource,true) then
+           search_unit(loaded_from,onlysource,true) then
           found:=true;
         search_unit_files:=found;
       end;
 
 
-    function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
+    function tppumodule.search_unit(loaded_from : tmodule; onlysource,shortname:boolean):boolean;
       var
          singlepathstring,
          filename : TCmdStr;
@@ -1270,6 +1306,8 @@ var
         indchecksum,
         intfchecksum,
         checksum : cardinal;
+        isnew : boolean;
+
       begin
         while not ppufile.endofentry do
          begin
@@ -1279,7 +1317,10 @@ var
            indchecksum:=cardinal(ppufile.getlongint);
            { set the state of this unit before registering, this is
              needed for a correct circular dependency check }
-           hp:=registerunit(self,hs,'');
+           hp:=registerunit(self,hs,'',isnew);
+           if isnew then
+             usedunits.Concat(tused_unit.create(hp,in_interface,true,nil));
+
            pu:=addusedunit(hp,false,nil);
            pu.checksum:=checksum;
            pu.interface_checksum:=intfchecksum;
@@ -1775,9 +1816,7 @@ var
          close(ppufile.CRCFile);
 {$endif Test_Double_checksum_write}
 
-         ppufile.closefile;
-         ppufile.free;
-         ppufile:=nil;
+         discardppu;
       end;
 
 
@@ -1886,9 +1925,7 @@ var
          ppufile.header.common.flags:=headerflags;
          ppufile.writeheader;
 
-         ppufile.closefile;
-         ppufile.free;
-         ppufile:=nil;
+         discardppu;
       end;
 
 
@@ -1906,12 +1943,12 @@ var
          begin
            if pu.in_interface then
             begin
-              tppumodule(pu.u).loadppu;
+              tppumodule(pu.u).loadppu(self);
               { if this unit is compiled we can stop }
-              if state=ms_compiled then
+              if state in [ms_compiled,ms_processed] then
                exit;
               { add this unit to the dependencies }
-              pu.u.adddependency(self);
+              pu.u.adddependency(self,true);
               { need to recompile the current unit, check the interface
                 crc. And when not compiled with -Ur then check the complete
                 crc }
@@ -1938,7 +1975,6 @@ var
             end;
            pu:=tused_unit(pu.next);
          end;
-
         { ok, now load the interface of this unit }
         if current_module<>self then
          internalerror(200208187);
@@ -1968,12 +2004,12 @@ var
          begin
            if (not pu.in_interface) then
             begin
-              tppumodule(pu.u).loadppu;
+              tppumodule(pu.u).loadppu(self);
               { if this unit is compiled we can stop }
               if state=ms_compiled then
                exit;
               { add this unit to the dependencies }
-              pu.u.adddependency(self);
+              pu.u.adddependency(self,false);
               { need to recompile the current unit ? }
               if (pu.u.interface_crc<>pu.interface_checksum) or
                  (pu.u.indirect_crc<>pu.indirect_checksum) then
@@ -2070,7 +2106,7 @@ var
               (hp.defsgeneration<defsgeneration) then
              begin
                hp.defsgeneration:=defsgeneration;
-               hp.loadppu
+               hp.loadppu(self)
              end
            else
              hp.do_reload:=false;
@@ -2084,258 +2120,322 @@ var
         state:=ms_compiled;
 
         { free ppu }
-        if assigned(ppufile) then
-          begin
-            ppufile.free;
-            ppufile:=nil;
-          end;
+        discardppu;
 
         inherited end_of_parsing;
       end;
 
+    procedure tppumodule.check_reload(from_module : tmodule; var do_load : boolean);
 
-    procedure tppumodule.loadppu;
-      const
-        ImplIntf : array[boolean] of string[15]=('implementation','interface');
-      var
-        do_load,
-        second_time        : boolean;
-        old_current_module : tmodule;
-        pu : tused_unit;
       begin
-        old_current_module:=current_module;
-        Message3(unit_u_load_unit,old_current_module.modulename^,
-                 ImplIntf[old_current_module.in_interface],
-                 modulename^);
-
-        { Update loaded_from to detect cycles }
-        loaded_from:=old_current_module;
-
-        { check if the globalsymtable is already available, but
-          we must reload when the do_reload flag is set }
-        if (not do_reload) and
-           assigned(globalsymtable) then
-           exit;
+        { A force reload }
+        if not do_reload then
+          exit;
+        Message(unit_u_forced_reload);
+        do_reload:=false;
+        { When the unit is already loaded or being loaded
+         we can maybe skip a complete reload/recompile }
+        if assigned(globalsymtable) and
+          (not needrecompile) then
+         begin
+           { When we don't have any data stored yet there
+             is nothing to resolve }
+           if interface_compiled and
+             { it makes no sense to re-resolve the unit if it is already finally compiled }
+             not(state=ms_compiled) then
+             begin
+               re_resolve(from_module);
+             end
+           else
+             Message1(unit_u_skipping_reresolving_unit,modulename^);
+           do_load:=false;
+         end;
+      end;
 
-        { reset }
-        do_load:=true;
-        second_time:=false;
-        set_current_module(self);
+    { Returns true if the module was loaded from package }
+    function tppumodule.check_loadfrompackage : boolean;
 
+      begin
         { try to load it as a package unit first }
-        if (packagelist.count>0) and loadfrompackage then
+        Result:=(packagelist.count>0) and loadfrompackage;
+        if Result then
           begin
-            do_load:=false;
             do_reload:=false;
             state:=ms_compiled;
             { PPU is not needed anymore }
             if assigned(ppufile) then
              begin
-                ppufile.closefile;
-                ppufile.free;
-                ppufile:=nil;
+               discardppu;
              end;
             { add the unit to the used units list of the program }
             usedunits.concat(tused_unit.create(self,true,false,nil));
           end;
+      end;
 
-        { A force reload }
-        if do_reload then
+      procedure tppumodule.prepare_second_load(from_module: tmodule);
+
+      const
+         CompileStates  = [ms_compile, ms_compiling_waitintf, ms_compiling_waitimpl,
+                           ms_compiling_waitfinish, ms_compiling_wait, ms_compiled,
+                           ms_processed];
+
+
+        begin
+          { try to load the unit a second time first }
+          Message1(unit_u_second_load_unit,modulename^);
+          Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
+          { Flag modules to reload }
+          flagdependent(from_module);
+          { Reset the module }
+          reset;
+          if state in CompileStates then
+            begin
+              Message1(unit_u_second_compile_unit,modulename^);
+              state:=ms_compile;
+              do_compile:=true;
+            end
+          else
+            state:=ms_load;
+        end;
+
+    procedure tppumodule.try_load_ppufile(from_module : tmodule);
+
+      begin
+        Message1(unit_u_loading_unit,modulename^);
+        search_unit_files(from_module,false);
+        if not do_compile then
          begin
-           Message(unit_u_forced_reload);
-           do_reload:=false;
-           { When the unit is already loaded or being loaded
-             we can maybe skip a complete reload/recompile }
-           if assigned(globalsymtable) and
-              (not needrecompile) then
-             begin
-               { When we don't have any data stored yet there
-                 is nothing to resolve }
-               if interface_compiled and
-                 { it makes no sense to re-resolve the unit if it is already finally compiled }
-                 not(state=ms_compiled) then
-                 begin
-                   Message1(unit_u_reresolving_unit,modulename^);
-                   tstoredsymtable(globalsymtable).deref(false);
-                   tstoredsymtable(globalsymtable).derefimpl(false);
-                   if assigned(localsymtable) then
-                    begin
-                      { we have only builderef(impl)'d the registered symbols of
-                        the localsymtable -> also only deref those again }
-                      tstoredsymtable(localsymtable).deref(true);
-                      tstoredsymtable(localsymtable).derefimpl(true);
-                    end;
-                   if assigned(wpoinfo) then
-                     begin
-                       tunitwpoinfo(wpoinfo).deref;
-                       tunitwpoinfo(wpoinfo).derefimpl;
-                     end;
-
-                   { We have to flag the units that depend on this unit even
-                     though it didn't change, because they might also
-                     indirectly depend on the unit that did change (e.g.,
-                     in case rgobj, rgx86 and rgcpu have been compiled
-                     already, and then rgobj is recompiled for some reason
-                     -> rgx86 is re-reresolved, but the vmtentries of trgcpu
-                     must also be re-resolved, because they will also contain
-                     pointers to procdefs in the old trgobj (in case of a
-                     recompile, all old defs are freed) }
-                   flagdependent(old_current_module);
-                   reload_flagged_units;
-                 end
-               else
-                 Message1(unit_u_skipping_reresolving_unit,modulename^);
-               do_load:=false;
-             end;
+           load_interface;
+           setdefgeneration;
+           if not do_compile then
+            begin
+              load_usedunits;
+              if not do_compile then
+                Message1(unit_u_finished_loading_unit,modulename^);
+            end;
          end;
+        { PPU is not needed anymore }
+        if assigned(ppufile) then
+            discardppu;
+      end;
+
+    procedure tppumodule.recompile_from_sources(from_module : tmodule);
 
-        if do_load then
+      var
+        pu : tused_unit;
+      begin
+        { recompile the unit or give a fatal error if sources not available }
+        if not(sources_avail) then
          begin
-           { loading the unit for a second time? }
-           if state=ms_registered then
-            state:=ms_load
-           else
+           search_unit_files(from_module,true);
+           if not(sources_avail) then
             begin
-              { try to load the unit a second time first }
-              Message1(unit_u_second_load_unit,modulename^);
-              Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
-              { Flag modules to reload }
-              flagdependent(old_current_module);
-              { Reset the module }
-              reset;
-              if state in [ms_compile,ms_second_compile] then
+              printcomments;
+              if recompile_reason=rr_noppu then
                 begin
-                  Message1(unit_u_second_compile_unit,modulename^);
-                  state:=ms_second_compile;
-                  do_compile:=true;
+                  pu:=tused_unit(from_module.used_units.first);
+                  while assigned(pu) do
+                    begin
+                      if pu.u=self then
+                        break;
+                      pu:=tused_unit(pu.next);
+                    end;
+                  if assigned(pu) and assigned(pu.unitsym) then
+                    MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,from_module.realmodulename^)
+                  else
+                    Message2(unit_f_cant_find_ppu,realmodulename^,from_module.realmodulename^);
                 end
               else
-                state:=ms_second_load;
-              second_time:=true;
+                Message1(unit_f_cant_compile_unit,realmodulename^);
             end;
+         end;
+        { we found the sources, we do not need the verbose messages anymore }
+        if comments <> nil then
+        begin
+          comments.free;
+          comments:=nil;
+        end;
+        { Flag modules to reload }
+        flagdependent(from_module);
+        { Reset the module }
+        reset;
+        { mark this module for recompilation }
+        if not (state in [ms_compile]) then
+          state:=ms_compile;
+        setdefgeneration;
+      end;
+
+    procedure tppumodule.post_load_or_compile(from_module : tmodule; second_time : boolean);
+
+    begin
+      if current_module<>self then
+        internalerror(200212282);
 
-           { close old_current_ppu on system that are
-             short on file handles like DOS PM }
+      if in_interface then
+        internalerror(200212283);
+
+      { for a second_time recompile reload all dependent units,
+        for a first time compile register the unit _once_ }
+      if second_time then
+        reload_flagged_units;
+
+      { reopen the old module }
 {$ifdef SHORT_ON_FILE_HANDLES}
-           if old_current_module.is_unit and
-              assigned(tppumodule(old_current_module).ppufile) then
-             tppumodule(old_current_module).ppufile.tempclose;
+      if from_module.is_unit and
+          assigned(tppumodule(from_module).ppufile) then
+         tppumodule(from_module).ppufile.tempopen;
 {$endif SHORT_ON_FILE_HANDLES}
+      state:=ms_processed;
+    end;
 
-           { try to opening ppu, skip this when we already
-             know that we need to compile the unit }
-           if not do_compile then
-            begin
-              Message1(unit_u_loading_unit,modulename^);
-              search_unit_files(false);
-              if not do_compile then
-               begin
-                 load_interface;
-                 setdefgeneration;
-                 if not do_compile then
-                  begin
-                    load_usedunits;
-                    if not do_compile then
-                      Message1(unit_u_finished_loading_unit,modulename^);
-                  end;
-               end;
-              { PPU is not needed anymore }
-              if assigned(ppufile) then
-               begin
-                  ppufile.closefile;
-                  ppufile.free;
-                  ppufile:=nil;
-               end;
-            end;
+    function tppumodule.loadppu(from_module : tmodule) : boolean;
+      const
+        ImplIntf : array[boolean] of string[15]=('implementation','interface');
+      var
+        do_load,
+        second_time        : boolean;
 
-           { Do we need to recompile the unit }
-           if do_compile then
-            begin
-              { recompile the unit or give a fatal error if sources not available }
-              if not(sources_avail) then
-               begin
-                 search_unit_files(true);
-                 if not(sources_avail) then
-                  begin
-                    printcomments;
-                    if recompile_reason=rr_noppu then
-                      begin
-                        pu:=tused_unit(loaded_from.used_units.first);
-                        while assigned(pu) do
-                          begin
-                            if pu.u=self then
-                              break;
-                            pu:=tused_unit(pu.next);
-                          end;
-                        if assigned(pu) and assigned(pu.unitsym) then
-                          MessagePos2(pu.unitsym.fileinfo,unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^)
-                        else
-                          Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^);
-                      end
-                    else
-                      Message1(unit_f_cant_compile_unit,realmodulename^);
-                  end;
-               end;
-              { we found the sources, we do not need the verbose messages anymore }
-              if comments <> nil then
-              begin
-                comments.free;
-                comments:=nil;
-              end;
-              { Flag modules to reload }
-              flagdependent(old_current_module);
-              { Reset the module }
-              reset;
-              { compile this module }
-              if not(state in [ms_compile,ms_second_compile]) then
-                state:=ms_compile;
-              compile(mainsource);
-              setdefgeneration;
-            end
-           else
-            state:=ms_compiled;
+      begin
+        Result:=false;
+        Message3(unit_u_load_unit,from_module.modulename^,
+                 ImplIntf[from_module.in_interface],
+                 modulename^);
 
-           if current_module<>self then
-             internalerror(200212282);
+        { check if the globalsymtable is already available, but
+          we must reload when the do_reload flag is set }
+        if (not do_reload) and
+           assigned(globalsymtable) then
+           exit(True);
 
-           if in_interface then
-             internalerror(200212283);
+        { reset }
+        do_load:=true;
+        second_time:=false;
+        set_current_module(self);
 
-           { for a second_time recompile reload all dependent units,
-             for a first time compile register the unit _once_ }
-           if second_time then
-            reload_flagged_units
-           else
-            usedunits.concat(tused_unit.create(self,true,false,nil));
+        do_load:=not check_loadfrompackage;
+
+        { A force reload }
+        check_reload(from_module, do_load);
+
+        if not do_load then
+          begin
+            // No need to do anything, restore situation and exit.
+            set_current_module(from_module);
+            exit(state=ms_compiled);
+          end;
+
+        { loading the unit for a second time? }
+        if state=ms_registered then
+          state:=ms_load
+        else
+          begin
+            second_time:=true;
+            prepare_second_load(from_module);
+          end;
 
-           { reopen the old module }
+        { close old_current_ppu on system that are
+          short on file handles like DOS PM }
 {$ifdef SHORT_ON_FILE_HANDLES}
-           if old_current_module.is_unit and
-              assigned(tppumodule(old_current_module).ppufile) then
-             tppumodule(old_current_module).ppufile.tempopen;
+        if from_module.is_unit and
+           assigned(tppumodule(from_module).ppufile) then
+          tppumodule(from_module).ppufile.tempclose;
 {$endif SHORT_ON_FILE_HANDLES}
-         end;
+
+        { try to opening ppu, skip this when we already
+          know that we need to compile the unit }
+        if not do_compile then
+          try_load_ppufile(from_module);
+
+        { Do we need to recompile the unit }
+        if do_compile then
+          recompile_from_sources(from_module)
+        else
+          state:=ms_compiled;
+
+        Result:=(state=ms_compiled);
+
+        // We cannot do this here, the order is all messed up...
+        // if not second_time then
+        //   usedunits.concat(tused_unit.create(self,true,false,nil));
+
+        if result then
+          post_load_or_compile(from_module,second_time);
 
         { we are back, restore current_module }
-        set_current_module(old_current_module);
+        set_current_module(from_module);
       end;
 
+    procedure tppumodule.discardppu;
+      begin
+        { PPU is not needed anymore }
+        if not assigned(ppufile) then
+          exit;
+        ppufile.closefile;
+        ppufile.free;
+        ppufile:=nil;
+      end;
 
 {*****************************************************************************
                                RegisterUnit
 *****************************************************************************}
 
 
-    function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
+    function registerunit(callermodule:tmodule;const s : TIDString;const fn:string; out is_new:boolean) : tppumodule;
+
+
+          function FindCycle(aFile, SearchFor: TModule; var Cycle: TFPList): boolean;
+          // Note: when traversing, add every search file to Cycle, to avoid running in circles.
+          // When a cycle is detected, clear the Cycle list and build the cycle path
+          var
+
+            aParent: tdependent_unit;
+          begin
+            Cycle.Add(aFile);
+            aParent:=tdependent_unit(afile.dependent_units.First);
+            While Assigned(aParent) do
+              begin
+              if aParent.in_interface then
+                begin
+                // writeln('Registering ',Callermodule.get_modulename,': checking cyclic dependency of ',aFile.get_modulename, ' on ',aparent.u.get_modulename);
+                if aParent.u=SearchFor then
+                begin
+                  // unit cycle found
+                  Cycle.Clear;
+                  Cycle.Add(aParent.u);
+                  Cycle.Add(aFile);
+                  // Writeln('exit at ',aParent.u.get_modulename);
+                  exit(true);
+                end;
+                if Cycle.IndexOf(aParent.u)<0 then
+                  if FindCycle(aParent.u,SearchFor,Cycle) then
+                    begin
+                    // Writeln('Cycle found, exit at ',aParent.u.get_modulename);
+                    Cycle.Add(aFile);
+                    exit(true);
+                    end;
+                end;
+              aParent:=tdependent_unit(aParent.Next);
+              end;
+           Result:=false;
+          end;
+
+
       var
         ups   : TIDString;
         hp    : tppumodule;
         hp2   : tmodule;
+        cycle : TFPList;
+        havecycle: boolean;
+{$IFDEF DEBUGCYCLE}
+        cyclepath : ansistring
+{$ENDIF}
+
       begin
         { Info }
         ups:=upper(s);
         { search all loaded units }
         hp:=tppumodule(loaded_units.first);
+        hp2:=nil;
         while assigned(hp) do
          begin
            if hp.modulename^=ups then
@@ -2346,18 +2446,29 @@ var
               if hp.is_unit then
                begin
                  { both units in interface ? }
-                 if callermodule.in_interface and
-                    hp.in_interface then
+                 if hp.in_interface and callermodule.in_interface then
                   begin
                     { check for a cycle }
-                    hp2:=callermodule.loaded_from;
-                    while assigned(hp2) and (hp2<>hp) do
-                     begin
-                       if hp2.in_interface then
-                         hp2:=hp2.loaded_from
-                       else
-                         hp2:=nil;
-                     end;
+                    Cycle:=TFPList.Create;
+                    try
+                      HaveCycle:=FindCycle(CallerModule,hp,Cycle);
+                      if HaveCycle then
+                      begin
+                      {$IFDEF DEBUGCYCLE}
+                         Writeln('Done cycle check');
+                        CyclePath:='';
+                        hp2:=TModule(Cycle[Cycle.Count-1]);
+                        for i:=0 to Cycle.Count-1 do begin
+                          if i>0 then CyclePath:=CyclePath+',';
+                          CyclePath:=CyclePath+TModule(Cycle[i]).realmodulename^;
+                        end;
+                        Writeln('Unit cycle detected: ',CyclePath);
+                        {$ENDIF}
+                        Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
+                      end;
+                    finally
+                      Cycle.Free;
+                    end;
                     if assigned(hp2) then
                       Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
                   end;
@@ -2369,11 +2480,11 @@ var
          end;
         { the unit is not in the loaded units,
           we create an entry and register the unit }
-        if not assigned(hp) then
+        is_new:=not assigned(hp);
+        if is_new then
          begin
            Message1(unit_u_registering_new_unit,ups);
            hp:=tppumodule.create(callermodule,s,fn,true);
-           hp.loaded_from:=callermodule;
            addloadedunit(hp);
          end;
         { return }

compiler/globals.pas

@@ -405,7 +405,6 @@ Const
 
        block_type : tblock_type;         { type of currently parsed block }
 
-       compile_level : word;
        exceptblockcounter    : integer;  { each except block gets a unique number check gotos      }
        current_exceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
        LinkLibraryAliases : TLinkStrMap;
@@ -1702,7 +1701,6 @@ implementation
         do_build:=false;
         do_release:=false;
         do_make:=true;
-        compile_level:=0;
         codegenerror:=false;
 
         { Output }

compiler/globstat.pas

@@ -37,8 +37,8 @@ uses
 
 
 type
-  pglobalstate=^tglobalstate;
-  tglobalstate=record
+
+  tglobalstate = class
   { scanner }
     oldidtoken,
     oldtoken       : ttoken;
@@ -67,95 +67,194 @@ type
     old_debuginfo : tdebuginfo;
     old_scanner : tscannerfile;
     old_parser_file : string;
+    constructor create(savefull : boolean);
+    destructor destroy; override;
+    procedure clearscanner;
+    class procedure remove_scanner_from_states(scanner : tscannerfile); static;
+    procedure save(full : boolean);
+    procedure restore(full : boolean);
   end;
 
-procedure save_global_state(out state:tglobalstate;full:boolean);
-procedure restore_global_state(const state:tglobalstate;full:boolean);
+procedure save_global_state(state:tglobalstate;full:boolean);
+procedure restore_global_state(state:tglobalstate;full:boolean);
 
 implementation
 
 uses
-  pbase,comphook;
+  switches, verbose, pbase,comphook;
+
+var
+  states : array of tglobalstate;
+  statecount : integer = 0;
+
+
+
+  class procedure tglobalstate.remove_scanner_from_states(scanner : tscannerfile);
+
+  var
+    i : integer;
+
+  begin
+    for I:=0 to statecount-1 do
+      if (states[i].old_scanner=scanner) then
+        states[i].clearscanner;
+  end;
+
+  procedure addstate(astate : tglobalstate);
+
+  var
+    l : integer;
+
+  begin
+    l:=length(states);
+    if l=statecount then
+      setlength(states,l+10);
+    states[statecount]:=astate;
+    inc(statecount);
+  end;
+
+  procedure removestate(astate : tglobalstate);
+
+  var
+    l : integer;
 
-  procedure save_global_state(out state:tglobalstate;full:boolean);
+  begin
+    l:=statecount-1;
+    While (l>=0) and (states[l]<>astate) do
+      dec(l);
+    if l<0 then
+      exit;
+    if l<>statecount-1 then
+      states[l]:=states[statecount-1];
+    states[statecount-1]:=Nil;
+    Dec(Statecount);
+  end;
+
+  procedure save_global_state(state:tglobalstate;full:boolean);
     begin
-      with state do
+      state.save(full);
+    end;
+
+  procedure restore_global_state(state:tglobalstate;full:boolean);
+
+  begin
+    state.restore(full);
+  end;
+
+  procedure tglobalstate.save(full: boolean);
+
+    begin
+      old_current_module:=current_module;
+
+      { save symtable state }
+      oldsymtablestack:=symtablestack;
+      oldmacrosymtablestack:=macrosymtablestack;
+      oldcurrent_procinfo:=current_procinfo;
+
+      { save scanner state }
+      oldc:=c;
+      oldpattern:=pattern;
+      oldorgpattern:=orgpattern;
+      oldtoken:=token;
+      oldidtoken:=idtoken;
+      old_block_type:=block_type;
+      oldtokenpos:=current_tokenpos;
+      {
+        consuming the semicolon after a uses clause can add to the
+        pending state if the first directives change warning state.
+        So we must flush before context switch. See for example:
+        ppcgen/cgppc.pas
+        line 144 has a WARN 6018 OFF...
+      }
+      flushpendingswitchesstate;
+      old_switchesstatestack:=switchesstatestack;
+      old_switchesstatestackpos:=switchesstatestackpos;
+
+      { save cg }
+      oldparse_only:=parse_only;
+
+      { save akt... state }
+      { handle the postponed case first }
+      oldcurrent_filepos:=current_filepos;
+      old_settings:=current_settings;
+      old_verbosity:=status.verbosity;
+
+      if full then
         begin
-          old_current_module:=current_module;
-
-          { save symtable state }
-          oldsymtablestack:=symtablestack;
-          oldmacrosymtablestack:=macrosymtablestack;
-          oldcurrent_procinfo:=current_procinfo;
-
-          { save scanner state }
-          oldc:=c;
-          oldpattern:=pattern;
-          oldorgpattern:=orgpattern;
-          oldtoken:=token;
-          oldidtoken:=idtoken;
-          old_block_type:=block_type;
-          oldtokenpos:=current_tokenpos;
-          old_switchesstatestack:=switchesstatestack;
-          old_switchesstatestackpos:=switchesstatestackpos;
-
-          { save cg }
-          oldparse_only:=parse_only;
-
-          { save akt... state }
-          { handle the postponed case first }
-          //flushpendingswitchesstate;
-          oldcurrent_filepos:=current_filepos;
-          old_settings:=current_settings;
-          old_verbosity:=status.verbosity;
-
-          if full then
-            begin
-              old_asmdata:=current_asmdata;
-              old_debuginfo:=current_debuginfo;
-              old_parser_file:=parser_current_file;
-              old_scanner:=current_scanner;
-            end;
+          old_asmdata:=current_asmdata;
+          old_debuginfo:=current_debuginfo;
+          old_parser_file:=parser_current_file;
+          old_scanner:=current_scanner;
         end;
     end;
 
+  procedure tglobalstate.restore(full: boolean);
 
-  procedure restore_global_state(const state:tglobalstate;full:boolean);
     begin
-      with state do
+      { restore scanner }
+      c:=oldc;
+      pattern:=oldpattern;
+      orgpattern:=oldorgpattern;
+      token:=oldtoken;
+      idtoken:=oldidtoken;
+      current_tokenpos:=oldtokenpos;
+      block_type:=old_block_type;
+      switchesstatestack:=old_switchesstatestack;
+      switchesstatestackpos:=old_switchesstatestackpos;
+
+      { restore cg }
+      parse_only:=oldparse_only;
+
+      { restore symtable state }
+      symtablestack:=oldsymtablestack;
+      macrosymtablestack:=oldmacrosymtablestack;
+      current_procinfo:=oldcurrent_procinfo;
+      current_filepos:=oldcurrent_filepos;
+      current_settings:=old_settings;
+      status.verbosity:=old_verbosity;
+      { restore message settings which were recorded prior to unit switch }
+
+      RestoreLocalVerbosity(current_settings.pmessage);
+
+      if full then
         begin
-          { restore scanner }
-          c:=oldc;
-          pattern:=oldpattern;
-          orgpattern:=oldorgpattern;
-          token:=oldtoken;
-          idtoken:=oldidtoken;
-          current_tokenpos:=oldtokenpos;
-          block_type:=old_block_type;
-          switchesstatestack:=old_switchesstatestack;
-          switchesstatestackpos:=old_switchesstatestackpos;
-
-          { restore cg }
-          parse_only:=oldparse_only;
-
-          { restore symtable state }
-          symtablestack:=oldsymtablestack;
-          macrosymtablestack:=oldmacrosymtablestack;
-          current_procinfo:=oldcurrent_procinfo;
-          current_filepos:=oldcurrent_filepos;
-          current_settings:=old_settings;
-          status.verbosity:=old_verbosity;
-
-          if full then
-            begin
-              current_module:=old_current_module; {!}
-              current_asmdata:=old_asmdata;
-              current_debuginfo:=old_debuginfo;
-              current_scanner:=old_scanner;
-              parser_current_file:=old_parser_file;
-            end;
+          set_current_module(old_current_module);
+          // These can be different
+          current_asmdata:=old_asmdata;
+          current_debuginfo:=old_debuginfo;
         end;
     end;
 
+    constructor tglobalstate.create(savefull: boolean);
+
+    begin
+      addstate(self);
+      save(savefull);
+    end;
+
+  destructor tglobalstate.destroy;
+
+    begin
+      removestate(self);
+      inherited destroy;
+    end;
+
+  procedure tglobalstate.clearscanner;
+
+  begin
+    old_scanner:=nil;
+    oldidtoken:=NOTOKEN;
+    oldtoken:=NOTOKEN;
+    oldtokenpos:=Default(tfileposinfo);
+    oldc:=#0;
+    oldpattern:='';
+    oldorgpattern:='';
+    old_block_type:=bt_none;
+  end;
+
+initialization
+  onfreescanner:[email protected]_scanner_from_states;
+finalization
+  onfreescanner:=Nil;
 end.
 

compiler/hlcgobj.pas

@@ -2257,19 +2257,32 @@ implementation
               { zero the bits we have to insert }
               if (slopt<>SL_SETMAX) then
                 begin
-                  maskreg:=getintregister(list,osuinttype);
-                  if (target_info.endian = endian_big) then
+                  if (slopt=SL_SETZERO) and (sref.bitlen=1) and (target_info.endian=endian_little) then
                     begin
-                      a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
-                      a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
+                      a_bit_set_reg_reg(list,false,osuinttype,osuinttype,sref.bitindexreg,valuereg);
+
+                      { store back to memory }
+                      tmpreg:=getintregister(list,loadsize);
+                      a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+                      a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
+                      exit;
                     end
                   else
                     begin
-                      a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
-                      a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
+                      maskreg:=getintregister(list,osuinttype);
+                      if (target_info.endian = endian_big) then
+                        begin
+                          a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
+                          a_op_reg_reg(list,OP_SHR,osuinttype,sref.bitindexreg,maskreg);
+                        end
+                      else
+                        begin
+                          a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1),maskreg);
+                          a_op_reg_reg(list,OP_SHL,osuinttype,sref.bitindexreg,maskreg);
+                        end;
+                      a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
+                      a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
                     end;
-                  a_op_reg_reg(list,OP_NOT,osuinttype,maskreg,maskreg);
-                  a_op_reg_reg(list,OP_AND,osuinttype,maskreg,valuereg);
                 end;
 
               { insert the value }
@@ -2278,6 +2291,18 @@ implementation
                   tmpreg:=getintregister(list,osuinttype);
                   if (slopt<>SL_SETMAX) then
                     a_load_reg_reg(list,fromsize,osuinttype,fromreg,tmpreg)
+                  { setting of a single bit?
+                    then we might take advantage of the CPU's bit set instruction }
+                  else if (sref.bitlen=1) and (target_info.endian=endian_little) then
+                    begin
+                      a_bit_set_reg_reg(list,true,osuinttype,osuinttype,sref.bitindexreg,valuereg);
+
+                      { store back to memory }
+                      tmpreg:=getintregister(list,loadsize);
+                      a_load_reg_reg(list,osuinttype,loadsize,valuereg,tmpreg);
+                      a_load_reg_ref(list,loadsize,loadsize,tmpreg,sref.ref);
+                      exit;
+                    end
                   else if (sref.bitlen<>AIntBits) then
                     a_load_const_reg(list,osuinttype,tcgint((aword(1) shl sref.bitlen)-1), tmpreg)
                   else
@@ -4298,6 +4323,7 @@ implementation
       r : treference;
       forcesize: aint;
       hregister: TRegister;
+      hl: TAsmLabel;
     begin
       case l.loc of
         LOC_FPUREGISTER,
@@ -4331,6 +4357,23 @@ implementation
             l.reference:=r;
           end;
 {$endif cpuflags}
+        LOC_JUMP :
+          begin
+            a_label(list,l.truelabel);
+            tg.gethltemp(list,size,size.size,tt_normal,r);
+            if is_cbool(size) then
+              a_load_const_ref(list,size,-1,r)
+            else
+              a_load_const_ref(list,size,1,r);
+            current_asmdata.getjumplabel(hl);
+            a_jmp_always(list,hl);
+            a_label(list,l.falselabel);
+            a_load_const_ref(list,size,0,r);
+            a_label(list,hl);
+
+            location_reset_ref(l,LOC_REFERENCE,l.size,size.alignment,[]);
+            l.reference:=r;
+          end;
         LOC_CONSTANT,
         LOC_REGISTER,
         LOC_CREGISTER,
@@ -4460,7 +4503,7 @@ implementation
     var
       storepos : tfileposinfo;
     begin
-       if nf_error in p.flags then
+       if tnf_error in p.transientflags then
          exit;
        storepos:=current_filepos;
        current_filepos:=p.fileinfo;

compiler/htypechk.pas

@@ -1403,7 +1403,7 @@ implementation
            case p.nodetype of
              vecn:
                begin
-                 include(p.flags,nf_callunique);
+                 include(tvecnode(p).vecnodeflags,vnf_callunique);
                  break;
                end;
              typeconvn,
@@ -1939,7 +1939,7 @@ implementation
                      end;
                    constsym:
                      begin
-                       if (tconstsym(tloadnode(hp).symtableentry).consttyp=constresourcestring) and
+                       if (tconstsym(tloadnode(hp).symtableentry).consttyp in [constresourcestring,constwresourcestring]) and
                          (valid_addr in opts) then
                          result:=true
                        else
@@ -2913,7 +2913,7 @@ implementation
         convtype : tconverttype;
         pdtemp,
         pdoper   : tprocdef;
-        releasecurrpt : boolean;
+        releasecurrpt, check_valid_var : boolean;
         cdoptions : tcompare_defs_options;
         n : tnode;
 
@@ -2946,6 +2946,8 @@ implementation
                 is passed. This is to prevent that the change is permanent }
               currpt:=pt;
               releasecurrpt:=false;
+              { Should we check if the callparanode.left is valid for var }
+              check_valid_var:=true;
               { retrieve current parameter definitions to compares }
               eq:=te_incompatible;
               def_from:=currpt.resultdef;
@@ -3101,6 +3103,7 @@ implementation
                   def_is_related(tobjectdef(def_from),tobjectdef(def_to)) then
                  begin
                    eq:=te_convert_l1;
+                   check_valid_var:=false;
                    { resolve anonymous external class definitions }
                    obj_from:=find_real_class_definition(tobjectdef(def_from),false);
                    obj_to:=find_real_class_definition(tobjectdef(def_to),false);
@@ -3121,6 +3124,7 @@ implementation
                    n:=currpt.left.getcopy;
                    arrayconstructor_to_set(n);
                    eq:=compare_defs_ext(n.resultdef,def_to,n.nodetype,convtype,pdoper,cdoptions);
+                   check_valid_var:=false;
                    n.free;
                  end
               else if is_open_array(def_to) and
@@ -3146,6 +3150,7 @@ implementation
                     n:=tarrayconstructornode(n).right;
                   until not assigned(n);
                   eq:=mineq;
+                  check_valid_var:=false;
                 end
               else
               { generic type comparision }
@@ -3155,7 +3160,10 @@ implementation
                     is_ansistring(def_to) and
                     (tstringdef(def_from).encoding<>tstringdef(def_to).encoding) and
                     (currpara.varspez in [vs_var,vs_out]) then
-                    eq:=te_convert_l1 // don't allow to pass different ansistring types to each-other
+                    begin
+                      eq:=te_convert_l1; // don't allow to pass different ansistring types to each-other
+                      check_valid_var:=false;
+                    end
                  else
                    eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions);
 
@@ -3168,9 +3176,8 @@ implementation
                         { para requires an equal type so the previous found
                           match was not good enough, reset to incompatible }
                         eq:=te_incompatible;
-                        { var_para_allowed will return te_equal and te_convert_l1 to
-                          make a difference for best matching }
-                        var_para_allowed(eq,currpt.resultdef,currpara.vardef,currpt.left)
+                        var_para_allowed(eq,currpt.resultdef,currpara.vardef,currpt.left);
+                        check_valid_var:=false;
                       end
                     else
                       para_allowed(eq,currpt,def_to);
@@ -3191,6 +3198,10 @@ implementation
                 procvar is choosen. See tb0471 (PFV) }
               if (pt<>currpt) and (eq=te_exact) then
                 eq:=te_equal;
+              { if var or out parameter type but paranode not is_valid_for_var }
+              if check_valid_var and (currpara.varspez in [vs_var,vs_out]) and not valid_for_var(currpt.left,false)
+                 and (def_to.typ<>formaldef) and not is_open_array(def_to) then
+                eq:=te_incompatible;
 
               { increase correct counter }
               case eq of

compiler/i386/aoptcpu.pas

@@ -161,6 +161,8 @@ unit aoptcpu;
                   Result:=OptPass1ADD(p);
                 A_AND:
                   Result:=OptPass1And(p);
+                A_CMOVcc:
+                  Result:=OptPass1CMOVcc(p);
                 A_IMUL:
                   Result:=OptPass1Imul(p);
                 A_CMP:
@@ -255,6 +257,9 @@ unit aoptcpu;
                 A_VCVTSS2SD,
                 A_CVTSS2SD:
                   Result:=OptPass1_V_Cvtss2sd(p);
+                A_CLC,
+                A_STC:
+                  Result:=OptPass1STCCLC(p);
                 else
                   ;
               end;
@@ -291,6 +296,8 @@ unit aoptcpu;
               case taicpu(p).opcode Of
                 A_ADD:
                   Result:=OptPass2ADD(p);
+                A_CMOVcc:
+                  Result:=OptPass2CMOVcc(p);
                 A_CMP:
                   Result:=OptPass2CMP(p);
                 A_TEST:
@@ -313,6 +320,9 @@ unit aoptcpu;
                   Result:=OptPass2SUB(p);
                 A_SETcc:
                   Result:=OptPass2SETcc(p);
+                A_CLC,
+                A_STC:
+                  Result:=OptPass2STCCLC(p);
                 else
                   ;
               end;

compiler/i386/cpuinfo.pas

@@ -62,6 +62,7 @@ Type
        cpu_core_avx2,
        cpu_zen,
        cpu_zen2,
+       cpu_skylake_x,
        cpu_icelake,
        cpu_icelake_client,
        cpu_icelake_server,
@@ -140,6 +141,7 @@ Const
      'COREAVX2',
      'ZEN',
      'ZEN2',
+     'SKYLAKE-X',
      'ICELAKE',
      'ICELAKE-CLIENT',
      'ICELAKE-SERVER',
@@ -250,6 +252,7 @@ type
      { cpu_core_avx2 } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
      { cpu_zen       } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
      { cpu_zen2      } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
+     { cpu_skylake_x } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
      { cpu_icelake   } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
      { cpu_icelake_client } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
      { cpu_icelake_server } [CPUX86_HAS_BSWAP,CPUX86_HAS_BTX,CPUX86_HAS_CMOV,CPUX86_HAS_SSEUNIT,CPUX86_HAS_SSE2,CPUX86_HAS_POPCNT,CPUX86_HAS_BMI1,CPUX86_HAS_BMI2,CPUX86_HAS_LZCNT,CPUX86_HAS_MOVBE],
@@ -289,6 +292,7 @@ type
      { cpu_core_avx2 } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_PDEP_PEXT],
      { cpu_zen       } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_3COMP_ADDR],
      { cpu_zen2      } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_3COMP_ADDR],
+     { cpu_skylake_x } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_PDEP_PEXT,CPUX86_HINT_FAST_3COMP_ADDR],
      { cpu_icelake   } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_PDEP_PEXT,CPUX86_HINT_FAST_3COMP_ADDR],
      { cpu_icelake_client } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_PDEP_PEXT,CPUX86_HINT_FAST_3COMP_ADDR],
      { cpu_icelake_server } [CPUX86_HINT_FAST_BT_REG_IMM,CPUX86_HINT_FAST_BTX_REG_IMM,CPUX86_HINT_FAST_BT_MEM_IMM,CPUX86_HINT_FAST_XCHG,CPUX86_HINT_FAST_PDEP_PEXT,CPUX86_HINT_FAST_3COMP_ADDR],

compiler/i386/n386inl.pas

@@ -123,6 +123,8 @@ implementation
 
 
   procedure ti386inlinenode.second_abs_long;
+    var
+      hl: TAsmLabel;
     begin
       if is_64bitint(left.resultdef) then
         begin
@@ -137,6 +139,13 @@ implementation
           cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_32,left.location.register64.reghi,location.register64.reghi);
           emit_reg_reg(A_SUB,S_L,left.location.register64.reghi,location.register64.reglo);
           emit_reg_reg(A_SBB,S_L,left.location.register64.reghi,location.register64.reghi);
+          if cs_check_overflow in current_settings.localswitches then
+            begin
+              current_asmdata.getjumplabel(hl);
+              cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl);
+              cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
+              cg.a_label(current_asmdata.CurrAsmList,hl);
+            end;
         end
       else
         inherited second_abs_long;

compiler/i386/n386mem.pas

@@ -81,7 +81,7 @@ implementation
     procedure ti386vecnode.pass_generate_code;
       begin
         inherited pass_generate_code;
-        if nf_memseg in flags then
+        if vnf_memseg in vecnodeflags then
           location.reference.segment:=NR_FS;
       end;
 

compiler/i8086/n8086add.pas

@@ -137,7 +137,7 @@ interface
                     { pointer-pointer results in an integer }
                     if (rt=pointerconstn) then
                       begin
-                        if not(nf_has_pointerdiv in flags) then
+                        if not(anf_has_pointerdiv in addnodeflags) then
                           internalerror(2008030102);
                         { todo: implement pointer-pointer as well }
                         internalerror(2014040607);

compiler/i8086/n8086inl.pas

@@ -387,6 +387,7 @@ implementation
      procedure ti8086inlinenode.second_abs_long;
        var
          opsize: TCgSize;
+         hl: TAsmLabel;
        begin
          opsize:=def_cgsize(left.resultdef);
          if opsize in [OS_64,OS_S64] then
@@ -406,6 +407,13 @@ implementation
             emit_reg_reg(A_SBB,S_W,cg.GetNextReg(left.location.register64.reghi),cg.GetNextReg(location.register64.reglo));
             emit_reg_reg(A_SBB,S_W,cg.GetNextReg(left.location.register64.reghi),location.register64.reghi);
             emit_reg_reg(A_SBB,S_W,cg.GetNextReg(left.location.register64.reghi),cg.GetNextReg(location.register64.reghi));
+            if cs_check_overflow in current_settings.localswitches then
+              begin
+                current_asmdata.getjumplabel(hl);
+                cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl);
+                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
+                cg.a_label(current_asmdata.CurrAsmList,hl);
+              end;
            end
          else if opsize in [OS_32,OS_S32] then
            begin
@@ -419,6 +427,13 @@ implementation
             cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_16,cg.GetNextReg(left.location.register),cg.GetNextReg(location.register));
             emit_reg_reg(A_SUB,S_W,cg.GetNextReg(left.location.register),location.register);
             emit_reg_reg(A_SBB,S_W,cg.GetNextReg(left.location.register),cg.GetNextReg(location.register));
+            if cs_check_overflow in current_settings.localswitches then
+              begin
+                current_asmdata.getjumplabel(hl);
+                cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl);
+                cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
+                cg.a_label(current_asmdata.CurrAsmList,hl);
+              end;
            end
          else
            inherited second_abs_long;

compiler/i8086/n8086mem.pas

@@ -160,7 +160,7 @@ implementation
    {$ifdef x86}
                (tcpupointerdef(left.resultdef).x86pointertyp = tcpupointerdefclass(cpointerdef).default_x86_data_pointer_type) and
    {$endif x86}
-               not(nf_no_checkpointer in flags) and
+               not(drnf_no_checkpointer in derefnodeflags) and
                { can be NR_NO in case of LOC_CONSTANT }
                (location.reference.base<>NR_NO) then
              begin

compiler/jvm/njvmcnv.pas

@@ -502,7 +502,7 @@ implementation
           end;
         if not assigned(procdefparas) then
           procdefparas:=carrayconstructornode.create(nil,nil);
-        procdefparas.allow_array_constructor:=true;
+        Include(procdefparas.arrayconstructornodeflags, acnf_allow_array_constructor);
         constrparas:=ccallparanode.create(procdefparas,constrparas);
         result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
         { typecast to the procvar type }

compiler/jvm/njvmutil.pas

@@ -55,7 +55,7 @@ interface
       class procedure InsertResStrInits; override;
       class procedure InsertMemorySizes; override;
      protected
-       class procedure insert_init_final_table(entries:tfplist); override;
+       class procedure insert_init_final_table(main: tmodule; entries:tfplist); override;
      strict protected
        class procedure add_main_procdef_paras(pd: tdef); override;
     end;
@@ -387,24 +387,27 @@ implementation
         inherited;
     end;
 
-  class procedure tjvmnodeutils.insert_init_final_table(entries:tfplist);
+  class procedure tjvmnodeutils.insert_init_final_table(main: tmodule; entries:tfplist);
+
     var
       hp : tused_unit;
       unitinits : TAsmList;
       unitclassname: string;
       mainpsym: tsym;
       mainpd: tprocdef;
-    begin
-      { JVM does not use the entries list }
+      m : tmodule;
+      i : integer;
 
+    begin
       unitinits:=TAsmList.Create;
-      hp:=tused_unit(usedunits.first);
-      while assigned(hp) do
+      for I:=0 to entries.Count-1 do
         begin
+          hp:=tused_unit(entries[i]);
+          m:=hp.u;
           { class constructors are automatically handled by the JVM }
 
-          { call the unit init code and make it external }
-          if (hp.u.moduleflags*[mf_init,mf_finalize])<>[] then
+          { for non-main module, call the unit init code and make it external }
+          if (m<>main) and ((m.moduleflags*[mf_init,mf_finalize])<>[]) then
             begin
               { trigger init code by referencing the class representing the
                 unit; if necessary, it will register the fini code to run on
@@ -419,10 +422,10 @@ implementation
               unitinits.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(unitclassname,AT_METADATA)));
               unitinits.concat(taicpu.op_none(a_pop));
             end;
-          hp:=tused_unit(hp.next);
         end;
+
       { insert in main program routine }
-      mainpsym:=tsym(current_module.localsymtable.find(mainaliasname));
+      mainpsym:=tsym(main.localsymtable.find(mainaliasname));
       if not assigned(mainpsym) or
          (mainpsym.typ<>procsym) then
         internalerror(2011041901);

compiler/llvm/nllvmbas.pas

@@ -201,7 +201,7 @@ interface
       begin
         oldasmlist:=nil;
         if not(po_assembler in current_procinfo.procdef.procoptions) and
-           not(nf_get_asm_position in flags) then
+           not(asmnf_get_asm_position in asmnodeflags) then
           begin
             { store the assembler code in a separate list, so we can make it
               the argument of an asmblock instruction }
@@ -214,7 +214,7 @@ interface
           end;
         inherited;
         if not(po_assembler in current_procinfo.procdef.procoptions) and
-           not(nf_get_asm_position in flags) then
+           not(asmnf_get_asm_position in asmnodeflags) then
           begin
             asmai:=taillvm.asm_paras(current_asmdata.CurrAsmList,fsymboldata);
             fsymboldata:=nil;

compiler/loongarch64/cgcpu.pas

@@ -462,7 +462,7 @@ implementation
         utosize:=tcgsize2unsigned[tosize];
         ufrom:=ufromsize=fromsize;
         uto:=utosize=tosize;
-        if (fromsize=tosize) or ((ufromsize=OS_INT) and (utosize=OS_INT)) then
+        if (ufromsize=OS_INT) and (utosize=OS_INT) then
           begin
             ai:=taicpu.op_reg_reg(A_MOVE,reg2,reg1);
             list.concat(ai);

compiler/loongarch64/ncpuadd.pas

@@ -47,6 +47,7 @@ unit ncpuadd;
         procedure second_cmpfloat;override;
       public
         function use_generic_mul32to64: boolean; override;
+        function pass_1 : tnode;override;
       end;
 
 
@@ -396,6 +397,18 @@ implementation
         result:=false;
       end;
 
+    function tloongarch64addnode.pass_1: tnode;
+      begin
+        Result:=inherited pass_1;
+        { if the result is not nil, a new node has been generated and the current node will be discarted }
+        if Result=nil then
+          begin
+            if left.resultdef.typ=floatdef then
+              if needs_check_for_fpu_exceptions then
+                Include(current_procinfo.flags,pi_do_call);
+          end;
+      end;
+
 begin
   caddnode := tloongarch64addnode;
 end.

compiler/loongarch64/ncpuinl.pas

@@ -59,6 +59,7 @@ implementation
       aasmtai,aasmdata,aasmcpu,
       symconst,symdef,
       defutil,
+      procinfo,
       cgbase,pass_2,
       cpuinfo,ncgutil,
       hlcgobj,cgutils,cgobj,rgobj,tgobj;
@@ -72,6 +73,8 @@ implementation
        begin
          expectloc:=LOC_FPUREGISTER;
          first_sqrt_real := nil;
+         if needs_check_for_fpu_exceptions then
+           Include(current_procinfo.flags,pi_do_call);
        end;
 
 
@@ -86,6 +89,8 @@ implementation
        begin
          expectloc:=LOC_FPUREGISTER;
          first_sqr_real := nil;
+         if needs_check_for_fpu_exceptions then
+           Include(current_procinfo.flags,pi_do_call);
        end;
 
 
@@ -93,6 +98,8 @@ implementation
        begin
          expectloc:=LOC_FPUREGISTER;
          first_round_real := nil;
+         if needs_check_for_fpu_exceptions then
+           Include(current_procinfo.flags,pi_do_call);
        end;
 
 
@@ -100,6 +107,8 @@ implementation
        begin
          expectloc:=LOC_FPUREGISTER;
          first_trunc_real := nil;
+         if needs_check_for_fpu_exceptions then
+           Include(current_procinfo.flags,pi_do_call);
        end;
 
 

compiler/msg/errore.msg

@@ -1671,9 +1671,12 @@ parser_e_suspending_externals_not_supported_on_current_platform=03368_E_Declarin
 parser_w_widechar_set_reduced=03369_W_Reducing Widechar set to single-byte AnsiChar set.
 % The base type of a set can only have 255 elements. Sets of wide characters
 % are reduced to sets of 1-byte characters.
-parser_e_nostringaliasinsystem=03370_e_Using 'string' alias is not allowed in the system unit. Use short-,ansi- or unicodestring.
+parser_e_nostringaliasinsystem=03370_E_Using 'string' alias is not allowed in the system unit. Use short-,ansi- or unicodestring.
 % As a safeguard, the system unit may only use basic string types, not the
 % string alias which is dependent on the mode in which a unit is compiled.
+parser_e_coperators_off=03371_E_C styled assignment operators are turned off
+% By default, c style assignment operators (+=, -=, *=, /=) are turn off. Either turn them on by the command line
+% parameter -Sc or in the source code by {\$COPERATORS ON}
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -490,6 +490,7 @@ const
   parser_e_suspending_externals_not_supported_on_current_platform=03368;
   parser_w_widechar_set_reduced=03369;
   parser_e_nostringaliasinsystem=03370;
+  parser_e_coperators_off=03371;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1177,9 +1178,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 92723;
+  MsgTxtSize = 92776;
 
   MsgIdxMax : array[1..20] of longint=(
-    29,114,371,134,102,63,148,38,224,71,
+    29,114,372,134,102,63,148,38,224,71,
     69,20,30,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -32,12 +32,21 @@ interface
       node,symtype;
 
     type
+       TAddNodeFlag = (
+         anf_has_pointerdiv,
+         { the node shall be short boolean evaluated, this flag has priority over localswitches }
+         anf_short_bool
+       );
+
+       TAddNodeFlags = set of TAddNodeFlag;
+
        taddnode = class(tbinopnode)
        private
           resultrealdefderef: tderef;
           function pass_typecheck_internal:tnode;
        public
           resultrealdef : tdef;
+          addnodeflags : TAddNodeFlags;
           constructor create(tt : tnodetype;l,r : tnode);override;
           constructor create_internal(tt:tnodetype;l,r:tnode);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
@@ -52,6 +61,9 @@ interface
     {$ifdef state_tracking}
           function track_state_pass(exec_known:boolean):boolean;override;
     {$endif}
+    {$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+    {$endif DEBUG_NODE_XML}
          protected
           { override the following if you want to implement }
           { parts explicitely in the code generator (JM)    }
@@ -140,7 +152,8 @@ implementation
       {$ifdef state_tracking}
       nstate,
       {$endif}
-      cpuinfo;
+      cpuinfo,
+      ppu;
 
 
 {*****************************************************************************
@@ -179,9 +192,9 @@ implementation
     constructor taddnode.create(tt : tnodetype;l,r : tnode);
       begin
          inherited create(tt,l,r);
+         addnodeflags:=[];
       end;
 
-
     constructor taddnode.create_internal(tt:tnodetype;l,r:tnode);
       begin
         create(tt,l,r);
@@ -192,6 +205,7 @@ implementation
     constructor taddnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
       begin
         inherited ppuload(t, ppufile);
+        ppufile.getset(tppuset1(addnodeflags));
         ppufile.getderef(resultrealdefderef);
       end;
 
@@ -199,7 +213,8 @@ implementation
     procedure taddnode.ppuwrite(ppufile: tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-         ppufile.putderef(resultrealdefderef);
+        ppufile.putset(tppuset1(addnodeflags));
+        ppufile.putderef(resultrealdefderef);
       end;
 
 
@@ -392,10 +407,12 @@ implementation
       function is_range_test(nodel, noder: taddnode; out value: tnode; var cl,cr: Tconstexprint): boolean;
         const
           is_upper_test: array[ltn..gten] of boolean = (true,true,false,false);
-          inclusive_adjust: array[boolean,ltn..gten] of integer = ((-1,0,1,0),
-                                                                   (1,0,-1,0));
+          inclusive_adjust: array[boolean,boolean,ltn..gten] of integer = (((-1,0,1,0),
+                                                                            (1,0,-1,0)),
+                                                                           ((0,-1,0,1),
+                                                                            (0,1,0,-1)));
         var
-          swapl, swapr: Boolean;
+          swapl, swapr, inverted_range: Boolean;
           valuer: tnode;
           t: Tconstexprint;
         begin
@@ -434,12 +451,21 @@ implementation
           if not value.isequal(valuer) then
             exit;
 
+          { This is based on De Morgan's theorem, namely that
+            "A and B" = "not ((not A) or (not B))" }
+          inverted_range:=(nodetype=orn);
+          if inverted_range then
+            begin
+              swapl:=not swapl;
+              swapr:=not swapr;
+            end;
+
           { this could be simplified too, but probably never happens }
           if (is_upper_test[nodel.nodetype] xor swapl)=(is_upper_test[noder.nodetype] xor swapr) then
             exit;
 
-          cl:=cl+inclusive_adjust[swapl,nodel.nodetype];
-          cr:=cr+inclusive_adjust[swapr,noder.nodetype];
+          cl:=cl+inclusive_adjust[inverted_range,swapl,nodel.nodetype];
+          cr:=cr+inclusive_adjust[inverted_range,swapr,noder.nodetype];
 
           if is_upper_test[nodel.nodetype] xor swapl then
             begin
@@ -736,15 +762,15 @@ implementation
                      { pointer-pointer results in an integer }
                      if (rt=pointerconstn) then
                        begin
-                         if not(nf_has_pointerdiv in flags) then
+                         if not(anf_has_pointerdiv in addnodeflags) then
                            internalerror(2008030101);
-                         t := cpointerconstnode.create(qword(v),resultdef)
+                         t:=cpointerconstnode.create(qword(v),resultdef)
                        end
                      else
-                       t := cpointerconstnode.create(qword(v),resultdef)
+                       t:=cpointerconstnode.create(qword(v),resultdef)
                    else
                      if is_integer(ld) then
-                       t := create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
+                       t:=create_simplified_ord_const(v,resultdef,forinline,cs_check_overflow in localswitches)
                      else
                        t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef));
                  end;
@@ -901,8 +927,15 @@ implementation
         { Deal with anti-commutative subtraction }
         if (nodetype = subn) then
           begin
+            { transform -1-x into not(x) }
+            if is_signed(rd) and is_constintnode(left) and (tordconstnode(left).value=-1)  then
+              begin
+                result:=cnotnode.create(right.getcopy);
+                exit;
+              end
+
             { change "0 - val" to "-val" }
-            if is_constintnode(left) and (is_integer(right.resultdef) or is_pointer(right.resultdef)) then
+            else if is_constintnode(left) and (is_integer(right.resultdef) or is_pointer(right.resultdef)) then
               begin
                 if (tordconstnode(left).value = 0) then
                   result := ctypeconvnode.create_internal(cunaryminusnode.create(right.getcopy),right.resultdef);
@@ -917,6 +950,13 @@ implementation
                 left:=nil;
                 tmoddivnode(right).right:=nil;
                 exit;
+              end
+
+            { transform -x-1 into not(x) }
+            else if is_signed(ld) and is_constintnode(right) and (tordconstnode(right).value=1) and (left.nodetype=unaryminusn) then
+              begin
+                result:=cnotnode.create(tunaryminusnode(left).left.getcopy);
+                exit;
               end;
           end;
 
@@ -1540,7 +1580,7 @@ implementation
                 { transform unsigned comparisons of (v>=x) and (v<=y)
                   into (v-x)<=(y-x)
                 }
-                if (nodetype=andn) and
+                if (nodetype in [andn,orn]) and
                    (left.nodetype in [ltn,lten,gtn,gten]) and
                    (right.nodetype in [ltn,lten,gtn,gten]) and
                    (not might_have_sideeffects(left)) and
@@ -1552,9 +1592,19 @@ implementation
                     hdef:=get_unsigned_inttype(vl.resultdef);
                     vl:=ctypeconvnode.create_internal(vl.getcopy,hdef);
 
-                    result:=caddnode.create_internal(lten,
+                    { If the condition is of the inverted form (v<x) or (v>y),
+                      we have to invert the conditional result as well, since
+                      the above nodes return True for if v is within the range
+                      (we're merging "not ((v-x)<=(y-x))" into "(v-x)>(y-x)") }
+                    if (nodetype=orn) then
+                      nt:=gtn
+                    else
+                      nt:=lten;
+
+                    result:=caddnode.create_internal(nt,
                               ctypeconvnode.create_internal(caddnode.create_internal(subn,vl,cordconstnode.create(cl,hdef,false)),hdef),
                               cordconstnode.create(cr-cl,hdef,false));
+
                     exit;
                   end;
 
@@ -1657,7 +1707,7 @@ implementation
                             begin
                               { we need to copy the whole tree to force another pass_1 }
                               include(localswitches,cs_full_boolean_eval);
-                              exclude(flags,nf_short_bool);
+                              exclude(addnodeflags,anf_short_bool);
                               result:=getcopy;
                               exit;
                             end;
@@ -1856,7 +1906,7 @@ implementation
                         else
                           nt:=equaln;
                         result:=caddnode.create(nt,t,cordconstnode.create(0,vl.resultdef,false));
-                        Include(flags, nf_do_not_execute);
+                        Include(transientflags,tnf_do_not_execute);
                         if t=left then
                           left:=nil
                         else
@@ -1874,6 +1924,7 @@ implementation
         n: taddnode;
       begin
         n:=taddnode(inherited dogetcopy);
+        n.addnodeflags:=addnodeflags;
         n.resultrealdef:=resultrealdef;
         result:=n;
       end;
@@ -1985,7 +2036,7 @@ implementation
                         elem,nil)));
 
             result:=cinlinenode.create(in_insert_x_y_z,false,para);
-            include(aktassignmentnode.flags,nf_assign_done_in_right);
+            include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
           end;
 
       begin
@@ -2237,7 +2288,7 @@ implementation
            begin
               { set for & and | operations in macpas mode: they only work on }
               { booleans, and always short circuit evaluation                }
-              if (nf_short_bool in flags) then
+              if (anf_short_bool in addnodeflags) then
                 begin
                   if not is_boolean(ld) then
                     begin
@@ -2759,11 +2810,11 @@ implementation
                     else
                       CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
 
-                    if not(nf_has_pointerdiv in flags) and
+                    if not(anf_has_pointerdiv in addnodeflags) and
                       (tpointerdef(rd).pointeddef.size>1) then
                       begin
                         hp:=getcopy;
-                        include(hp.flags,nf_has_pointerdiv);
+                        include(taddnode(hp).addnodeflags, anf_has_pointerdiv);
                         result:=cmoddivnode.create(divn,hp,
                           cordconstnode.create(tpointerdef(rd).pointeddef.size,tpointerdef(rd).pointer_subtraction_result_type,false));
                       end;
@@ -3385,7 +3436,7 @@ implementation
                             'fpc_'+tstringdef(resultdef).stringtypname+'_concat',
                             para
                           );
-                  include(aktassignmentnode.flags,nf_assign_done_in_right);
+                  include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
                   firstpass(result);
                 end
               else
@@ -3529,7 +3580,7 @@ implementation
               left:=nil;
               right:=nil;
 
-              include(aktassignmentnode.flags,nf_assign_done_in_right);
+              include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
               firstpass(result);
             end
           else
@@ -3565,8 +3616,10 @@ implementation
         tempn: tnode;
         newstatement : tstatementnode;
         temp    : ttempcreatenode;
+        no_temp: Boolean;
       begin
         result:=nil;
+
         case nodetype of
           equaln,unequaln,lten,gten:
             begin
@@ -3600,40 +3653,31 @@ implementation
             end;
           addn:
             begin
+              { can we directly write into the result? }
+              no_temp:=assigned(aktassignmentnode) and
+                (aktassignmentnode.right=self) and
+                (aktassignmentnode.left.resultdef=self.resultdef) and
+                valid_for_var(aktassignmentnode.left,false);
+
               { optimize first loading of a set }
               if (right.nodetype=setelementn) and
                   not(assigned(tsetelementnode(right).right)) and
                   is_emptyset(left) then
                 begin
-                  result:=internalstatements(newstatement);
-
-                  { create temp for result }
-                  temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
-                  addstatement(newstatement,temp);
-
                   { adjust for set base }
                   tsetelementnode(right).left:=caddnode.create(subn,
                     ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
                     cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
 
-                  addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
-                    ccallparanode.create(ctemprefnode.create(temp),
-                    ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                    ccallparanode.create(tsetelementnode(right).left,nil))))
-                  );
-
-                  { the last statement should return the value as
-                    location and type, this is done be referencing the
-                    temp and converting it first from a persistent temp to
-                    normal temp }
-                  addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
-                  addstatement(newstatement,ctemprefnode.create(temp));
-
-                  tsetelementnode(right).left := nil;
-                end
-              else
-                begin
-                  if right.nodetype=setelementn then
+                  if no_temp then
+                    begin
+                      result:=ccallnode.createintern('fpc_varset_create_element',
+                        ccallparanode.create(aktassignmentnode.left.getcopy,
+                        ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                        ccallparanode.create(tsetelementnode(right).left,nil))));
+                      include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
+                    end
+                  else
                     begin
                       result:=internalstatements(newstatement);
 
@@ -3641,43 +3685,116 @@ implementation
                       temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
                       addstatement(newstatement,temp);
 
-                      { adjust for set base }
-                      tsetelementnode(right).left:=caddnode.create(subn,
-                        ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
-                        cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+                      addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element',
+                        ccallparanode.create(ctemprefnode.create(temp),
+                        ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                        ccallparanode.create(tsetelementnode(right).left,nil))))
+                      );
 
-                      { add a range or a single element? }
-                      if assigned(tsetelementnode(right).right) then
+                      { the last statement should return the value as
+                        location and type, this is done be referencing the
+                        temp and converting it first from a persistent temp to
+                        normal temp }
+                      addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+                      addstatement(newstatement,ctemprefnode.create(temp));
+                    end;
+                  tsetelementnode(right).left:=nil;
+                end
+              else
+                begin
+                  if right.nodetype=setelementn then
+                    begin
+                      if no_temp then
                         begin
-                          { adjust for set base }
-                          tsetelementnode(right).right:=caddnode.create(subn,
-                            ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
-                            cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
-                          addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
-                            ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                            ccallparanode.create(tsetelementnode(right).right,
-                            ccallparanode.create(tsetelementnode(right).left,
-                            ccallparanode.create(ctemprefnode.create(temp),
-                            ccallparanode.create(left,nil))))))
-                          );
+                          { add a range or a single element? }
+                          if assigned(tsetelementnode(right).right) then
+                            begin
+                              { adjust for set base }
+                              tsetelementnode(right).left:=caddnode.create(subn,
+                                ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
+                                cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+
+                              { adjust for set base }
+                              tsetelementnode(right).right:=caddnode.create(subn,
+                                ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
+                                cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+
+                              result:=ccallnode.createintern('fpc_varset_set_range',
+                                ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                                ccallparanode.create(tsetelementnode(right).right,
+                                ccallparanode.create(tsetelementnode(right).left,
+                                ccallparanode.create(aktassignmentnode.left.getcopy,
+                                ccallparanode.create(left,nil))))));
+                            end
+                          else
+                            begin
+                              { s:=s+[element]; ? }
+                              if left.isequal(aktassignmentnode.left) then
+                                result:=cinlinenode.createintern(in_include_x_y,false,ccallparanode.create(aktassignmentnode.left.getcopy,
+                                  ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,tsetdef(resultdef).elementdef),nil)))
+                              else
+                                begin
+                                  { adjust for set base }
+                                  tsetelementnode(right).left:=caddnode.create(subn,
+                                    ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
+                                    cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+
+                                  result:=ccallnode.createintern('fpc_varset_set',
+                                    ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                                    ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
+                                    ccallparanode.create(aktassignmentnode.left.getcopy,
+                                    ccallparanode.create(left,nil)))));
+                                end;
+                            end;
+
+                          include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
                         end
                       else
-                        addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
-                          ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
-                          ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
-                          ccallparanode.create(ctemprefnode.create(temp),
-                          ccallparanode.create(left,nil)))))
-                        );
+                        begin
+                          { adjust for set base }
+                          tsetelementnode(right).left:=caddnode.create(subn,
+                            ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
+                            cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+
+                          result:=internalstatements(newstatement);
+
+                          { create temp for result }
+                          temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true);
+                          addstatement(newstatement,temp);
+
+                          { add a range or a single element? }
+                          if assigned(tsetelementnode(right).right) then
+                            begin
+                              { adjust for set base }
+                              tsetelementnode(right).right:=caddnode.create(subn,
+                                ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype),
+                                cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false));
+                              addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range',
+                                ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                                ccallparanode.create(tsetelementnode(right).right,
+                                ccallparanode.create(tsetelementnode(right).left,
+                                ccallparanode.create(ctemprefnode.create(temp),
+                                ccallparanode.create(left,nil))))))
+                              );
+                            end
+                          else
+                            addstatement(newstatement,ccallnode.createintern('fpc_varset_set',
+                              ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false),
+                              ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype),
+                              ccallparanode.create(ctemprefnode.create(temp),
+                              ccallparanode.create(left,nil)))))
+                            );
+                          { the last statement should return the value as
+                            location and type, this is done be referencing the
+                            temp and converting it first from a persistent temp to
+                            normal temp }
+                          addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
+                          addstatement(newstatement,ctemprefnode.create(temp));
+                        end;
                       { remove reused parts from original node }
                       tsetelementnode(right).right:=nil;
                       tsetelementnode(right).left:=nil;
                       left:=nil;
-                      { the last statement should return the value as
-                        location and type, this is done be referencing the
-                        temp and converting it first from a persistent temp to
-                        normal temp }
-                      addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
-                      addstatement(newstatement,ctemprefnode.create(temp));
                     end
                   else
                     call_varset_helper('fpc_varset_add_sets');
@@ -3742,7 +3859,7 @@ implementation
                             'fpc_dynarray_concat',
                             para
                           );
-                  include(aktassignmentnode.flags,nf_assign_done_in_right);
+                  include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
                   firstpass(result);
                 end
               else
@@ -4272,9 +4389,6 @@ implementation
         end;
 
       var
-{$ifdef addstringopt}
-         hp      : tnode;
-{$endif addstringopt}
          rd,ld   : tdef;
          i,i2    : longint;
          lt,rt   : tnodetype;
@@ -4359,6 +4473,17 @@ implementation
                end;
            end;
 
+        { get rid of adding empty sets generated by set constructors (s+([]+[..]))
+
+          this needs to be done before firstpass, else the set additions get already converted into calls }
+        if (resultdef.typ=setdef) and (nodetype=addn) and (right.nodetype=addn) and (is_emptyset(taddnode(right).left)) then
+          begin
+            result:=caddnode.create(addn,left,taddnode(right).right);
+            left:=nil;
+            taddnode(right).right:=nil;
+            exit;
+          end;
+
          { first do the two subtrees }
          firstpass(left);
          firstpass(right);
@@ -4755,5 +4880,27 @@ implementation
         end;
     end;
 {$endif}
+{$ifdef DEBUG_NODE_XML}
+    procedure TAddNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TAddNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in addnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' addnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 end.

compiler/nbas.pas

@@ -71,11 +71,18 @@ interface
        end;
        tfinalizetempsnodeclass = class of tfinalizetempsnode;
 
+       TAsmNodeFlag = (
+         asmnf_get_asm_position,
+         { Used registers in assembler block }
+         asmnf_has_registerlist
+       );
+
+       TAsmNodeFlags = set of TAsmNodeFlag;
+
        tasmnode = class(tnode)
+          asmnodeflags : TAsmNodeFlags;
           p_asm : TAsmList;
           currenttai : tai;
-          { Used registers in assembler block }
-          has_registerlist : boolean;
           constructor create(p : TAsmList);virtual;
           constructor create_get_position;
           destructor destroy;override;
@@ -88,6 +95,7 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
 {$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
           procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
        end;
@@ -463,7 +471,7 @@ implementation
     function terrornode.pass_typecheck:tnode;
       begin
          result:=nil;
-         include(flags,nf_error);
+         include(transientflags,tnf_error);
          codegenerror:=true;
          resultdef:=generrordef;
       end;
@@ -864,6 +872,7 @@ implementation
       begin
         inherited create(asmn);
         p_asm:=p;
+        asmnodeflags:=[];
         currenttai:=nil;
       end;
 
@@ -872,7 +881,7 @@ implementation
       begin
         inherited create(asmn);
         p_asm:=nil;
-        include(flags,nf_get_asm_position);
+        asmnodeflags:=[asmnf_get_asm_position];
         currenttai:=nil;
       end;
 
@@ -880,7 +889,7 @@ implementation
     destructor tasmnode.destroy;
       begin
         if assigned(p_asm) then
-         p_asm.free;
+          p_asm.free;
         inherited destroy;
       end;
 
@@ -890,7 +899,8 @@ implementation
         hp : tai;
       begin
         inherited ppuload(t,ppufile);
-        if not(nf_get_asm_position in flags) then
+        ppufile.getset(tppuset1(asmnodeflags));
+        if not(asmnf_get_asm_position in asmnodeflags) then
           begin
             p_asm:=TAsmList.create;
             repeat
@@ -913,8 +923,9 @@ implementation
         hp : tai;
       begin
         inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(asmnodeflags));
 { TODO: FIXME Add saving of register sets}
-        if not(nf_get_asm_position in flags) then
+        if not(asmnf_get_asm_position in asmnodeflags) then
           begin
             hp:=tai(p_asm.first);
             while assigned(hp) do
@@ -933,7 +944,7 @@ implementation
         hp : tai;
       begin
         inherited buildderefimpl;
-        if not(nf_get_asm_position in flags) then
+        if not(asmnf_get_asm_position in asmnodeflags) then
           begin
             hp:=tai(p_asm.first);
             while assigned(hp) do
@@ -950,7 +961,7 @@ implementation
         hp : tai;
       begin
         inherited derefimpl;
-        if not(nf_get_asm_position in flags) then
+        if not(asmnf_get_asm_position in asmnodeflags) then
           begin
             hp:=tai(p_asm.first);
             while assigned(hp) do
@@ -966,15 +977,16 @@ implementation
       var
         n: tasmnode;
       begin
-        n := tasmnode(inherited dogetcopy);
+        n:=tasmnode(inherited dogetcopy);
+        n.asmnodeflags:=asmnodeflags;
         if assigned(p_asm) then
           begin
             n.p_asm:=TAsmList.create;
             n.p_asm.concatlistcopy(p_asm);
           end
-        else n.p_asm := nil;
+        else
+          n.p_asm:=nil;
         n.currenttai:=currenttai;
-        n.has_registerlist:=has_registerlist;
         result:=n;
       end;
 
@@ -983,7 +995,7 @@ implementation
       begin
         result:=nil;
         resultdef:=voidtype;
-        if not(nf_get_asm_position in flags) then
+        if not(asmnf_get_asm_position in asmnodeflags) then
           include(current_procinfo.flags,pi_has_assembler_block);
       end;
 
@@ -1002,6 +1014,28 @@ implementation
       end;
 
 {$ifdef DEBUG_NODE_XML}
+    procedure TAsmNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TAsmNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in asmnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' asmnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+
+
     procedure TAsmNode.XMLPrintNodeData(var T: Text);
 
       procedure PadString(var S: string; Len: Integer);

compiler/ncal.pas

@@ -1224,11 +1224,11 @@ implementation
                     if is_array_of_const(parasym.vardef) then
                      begin
                        { force variant array }
-                       include(left.flags,nf_forcevaria);
+                       include(tarrayconstructornode(left).arrayconstructornodeflags,acnf_forcevaria);
                      end
                     else
                      begin
-                       include(left.flags,nf_novariaallowed);
+                       include(tarrayconstructornode(left).arrayconstructornodeflags,acnf_novariaallowed);
                        { now that the resultting type is know we can insert the required
                          typeconvs for the array constructor }
                        if parasym.vardef.typ=arraydef then
@@ -3466,7 +3466,7 @@ implementation
                 funcretnode:=aktassignmentnode.left.getcopy;
                 include(funcretnode.flags,nf_is_funcret);
                 { notify the assignment node that the assignment can be removed }
-                include(aktassignmentnode.flags,nf_assign_done_in_right);
+                include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
               end
             else
               begin
@@ -5511,7 +5511,7 @@ implementation
                 if FindUnitSymtable(tloadnode(n).symtable).moduleid<>current_module.moduleid then
                   current_module.addimportedsym(sym);
               end
-            else if (sym.typ=constsym) and (tconstsym(sym).consttyp=constresourcestring) then
+            else if (sym.typ=constsym) and (tconstsym(sym).consttyp in [constwresourcestring,constresourcestring]) then
               begin
                 if tloadnode(n).symtableentry.owner.moduleid<>current_module.moduleid then
                   current_module.addimportedsym(sym);
@@ -5602,7 +5602,7 @@ implementation
 
         typecheckpass(tnode(inlineblock));
         doinlinesimplify(tnode(inlineblock));
-        node_reset_flags(tnode(inlineblock),[nf_pass1_done]);
+        node_reset_flags(tnode(inlineblock),[],[tnf_pass1_done]);
         firstpass(tnode(inlineblock));
         result:=inlineblock;
 

compiler/ncgadd.pas

@@ -388,7 +388,7 @@ interface
           needed nodes unless full boolean evaluation is enabled }
         if (nodetype in [orn,andn]) and
            (not(cs_full_boolean_eval in current_settings.localswitches) or
-            (nf_short_bool in flags)) then
+            (anf_short_bool in addnodeflags)) then
           begin
             case nodetype of
               andn :

compiler/ncgbas.pas

@@ -288,7 +288,7 @@ interface
       begin
          location_reset(location,LOC_VOID,OS_NO);
 
-         if (nf_get_asm_position in flags) then
+         if (asmnf_get_asm_position in asmnodeflags) then
            begin
              { Add a marker, to be sure the list is not empty }
              current_asmdata.CurrAsmList.concat(tai_marker.create(mark_Position));
@@ -299,8 +299,8 @@ interface
          current_asmdata.CurrAsmList.Concat(tai_directive.create(asd_cpu,cputypestr[current_settings.asmcputype]));
 
          { Allocate registers used in the assembler block }
-         { has_registerlist=true means that registers are specified and already allocated }
-         if (not has_registerlist) then
+         { asmnf_has_registerlist means that registers are specified and already allocated }
+         if not (asmnf_has_registerlist in asmnodeflags) then
            cg.allocallcpuregisters(current_asmdata.CurrAsmList);
 
          if (po_inline in current_procinfo.procdef.procoptions) then
@@ -431,7 +431,7 @@ interface
            end;
 
          { Release register used in the assembler block }
-         if (not has_registerlist) then
+         if not (asmnf_has_registerlist in asmnodeflags) then
            cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
 
          { Switch back to the CPU instruction set of the target CPU }

compiler/ncginl.pas

@@ -221,6 +221,10 @@ implementation
             in_max_dword,
             in_min_longint,
             in_min_dword,
+            in_min_int64,
+            in_min_qword,
+            in_max_int64,
+            in_max_qword,
             in_min_single,
             in_min_double,
             in_max_single,

compiler/ncgld.pas

@@ -441,7 +441,7 @@ implementation
               end;
            constsym:
              begin
-                if tconstsym(symtableentry).consttyp=constresourcestring then
+                if tconstsym(symtableentry).consttyp in [constresourcestring,constwresourcestring] then
                   begin
                      location_reset_ref(location,LOC_CREFERENCE,def_cgsize(cansistringtype),cansistringtype.size,[]);
                      indirect:=(tf_supports_packages in target_info.flags) and
@@ -807,7 +807,7 @@ implementation
                (right.nodetype in [blockn,calln]) then
               begin
                 { verify that we indeed have nothing to do }
-                if not(nf_assign_done_in_right in flags) then
+                if not(anf_assign_done_in_right in assignmentnodeflags) then
                   internalerror(2015042201);
               end
             { empty constant string }
@@ -1289,7 +1289,7 @@ implementation
         if is_packed_array(resultdef) then
           internalerror(200608042);
         dovariant:=
-          ((nf_forcevaria in flags) or is_variant_array(resultdef)) and
+          ((acnf_forcevaria in arrayconstructornodeflags) or is_variant_array(resultdef)) and
           not(target_info.system in systems_managed_vm);
         eledef:=tarraydef(resultdef).elementdef;
         elesize:=eledef.size;

compiler/ncgmem.pas

@@ -298,7 +298,7 @@ implementation
             (cs_checkpointer in current_settings.localswitches) and
             not(cs_compilesystem in current_settings.moduleswitches) and
             tpointerdef(left.resultdef).compatible_with_pointerdef_size(tpointerdef(voidpointertype)) and
-            not(nf_no_checkpointer in flags) and
+            not(drnf_no_checkpointer in derefnodeflags) and
             { can be NR_NO in case of LOC_CONSTANT }
             (location.reference.base<>NR_NO) then
           begin
@@ -610,7 +610,7 @@ implementation
 
      function tcgvecnode.get_mul_size : asizeint;
        begin
-         if nf_memindex in flags then
+         if vnf_memindex in vecnodeflags then
           get_mul_size:=1
          else
           begin
@@ -892,7 +892,7 @@ implementation
          if is_ansistring(left.resultdef) or
             is_wide_or_unicode_string(left.resultdef) then
            begin
-              if nf_callunique in flags then
+              if vnf_callunique in vecnodeflags then
                 internalerror(200304236);
 
               {DM!!!!!}

compiler/ncgrtti.pas

@@ -323,6 +323,10 @@ implementation
                             maybe_add_comment(tcb,#9'VMT index');
                             tcb.emit_ord_const(def.extnumber,u16inttype);
                           end;
+                        maybe_add_comment(tcb,#9'Code Address');
+                        tcb.emit_procdef_const(def);
+                        maybe_add_comment(tcb,#9'Attribute table');
+                        write_attribute_data(tcb,def.rtti_attribute_list);
                       end;
 
                     for k:=0 to def.paras.count-1 do
@@ -810,19 +814,20 @@ implementation
 
     procedure TRTTIWriter.write_extended_field_table(tcb:ttai_typedconstbuilder;def:tabstractrecorddef;packrecords:longint);
       var
-        i: integer;
-        sym: tsym;
+        i,cnt: integer;
+        asym: tsym;
+        fldsym : tfieldvarsym;
         list: TFPList;
       begin
         list:=TFPList.Create;
         { build list of visible fields }
         for i:=0 to def.symtable.symlist.Count-1 do
           begin
-            sym:=tsym(def.symtable.symlist[i]);
-            if (sym.typ=fieldvarsym) and
-               not(sp_static in sym.symoptions) and
-               def.is_visible_for_rtti(ro_fields, sym.visibility) then
-              list.add(sym);
+            asym:=tsym(def.symtable.symlist[i]);
+            if (asym.typ=fieldvarsym) and
+               not(sp_static in asym.symoptions) and
+               def.is_visible_for_rtti(ro_fields, asym.visibility) then
+              list.add(asym);
           end;
         {
           TExtendedFieldTable = record
@@ -834,24 +839,31 @@ implementation
         tcb.emit_ord_const(list.count,u16inttype);
         for i := 0 to list.count-1 do
           begin
-            sym:=tsym(list[i]);
+            fldsym:=tfieldvarsym(list[i]);
             {
               TExtendedFieldInfo = record
                 FieldOffset: SizeUInt;
                 FieldType: Pointer;
                 FieldVisibility: Byte;
                 Name: PShortString;
+                Attributes :
               end;
             }
-            tcb.begin_anonymous_record(internaltypeprefixName[itp_extended_rtti_field]+tostr(tfieldvarsym(sym).fieldoffset),packrecords,min(reqalign,SizeOf(PInt)),targetinfos[target_info.system]^.alignment.recordalignmin);
+            tcb.begin_anonymous_record(internaltypeprefixName[itp_extended_rtti_field]+tostr(fldsym.fieldoffset),packrecords,min(reqalign,SizeOf(PInt)),targetinfos[target_info.system]^.alignment.recordalignmin);
             { FieldOffset }
-            tcb.emit_tai(Tai_const.Create_sizeint(tfieldvarsym(sym).fieldoffset),sizeuinttype);
+            tcb.emit_tai(Tai_const.Create_sizeint(fldsym.fieldoffset),sizeuinttype);
             { FieldType: PPTypeInfo }
-            tcb.emit_tai(Tai_const.Create_sym(RTTIWriter.get_rtti_label(tfieldvarsym(sym).vardef,fullrtti,true)),voidpointertype);
+            tcb.emit_tai(Tai_const.Create_sym(RTTIWriter.get_rtti_label(fldsym.vardef,fullrtti,true)),voidpointertype);
             { FieldVisibility }
-            tcb.emit_ord_const(visibility_to_rtti_flags(tfieldvarsym(sym).visibility),u8inttype);
+            tcb.emit_ord_const(visibility_to_rtti_flags(fldsym.visibility),u8inttype);
             { Name }
-            tcb.emit_pooled_shortstring_const_ref(sym.realname);
+            tcb.emit_pooled_shortstring_const_ref(fldsym.realname);
+            { Attribute table }
+            if assigned(fldsym.rtti_attribute_list) and assigned(fldsym.rtti_attribute_list.rtti_attributes) then
+              cnt:=fldsym.rtti_attribute_list.rtti_attributes.count
+            else
+              cnt:=0;
+            write_attribute_data(tcb,fldsym.rtti_attribute_list);
             tcb.end_anonymous_record;
           end;
         tcb.end_anonymous_record;

compiler/ncgutil.pas

@@ -236,7 +236,7 @@ implementation
         storepos : tfileposinfo;
         tmpreg : tregister;
       begin
-         if nf_error in p.flags then
+         if tnf_error in p.transientflags then
            exit;
          storepos:=current_filepos;
          current_filepos:=p.fileinfo;

compiler/ncnv.pas

@@ -503,6 +503,7 @@ implementation
         lr,hr : TConstExprInt;
         hp : tarrayconstructornode;
         oldfilepos: tfileposinfo;
+        first: Boolean;
       begin
         { keep in sync with arrayconstructor_can_be_set }
         if p.nodetype<>arrayconstructorn then
@@ -522,10 +523,11 @@ implementation
         hp:=tarrayconstructornode(p);
         if assigned(hp.left) then
          begin
+           first:=true;
            while assigned(hp) do
             begin
               p4:=nil; { will contain the tree to create the set }
-            {split a range into p2 and p3 }
+              { split a range into p2 and p3 }
               if hp.left.nodetype=arrayconstructorrangen then
                begin
                  p2:=tarrayconstructorrangenode(hp.left).left;
@@ -551,130 +553,120 @@ implementation
               oldfilepos:=current_filepos;
               current_filepos:=p2.fileinfo;
               case p2.resultdef.typ of
-                 enumdef,
-                 orddef:
-                   begin
-                      { widechars are not yet supported }
-                      if is_widechar(p2.resultdef) then
-                        begin
+                enumdef,
+                orddef:
+                  begin
+                    { widechars are not yet supported }
+                    if is_widechar(p2.resultdef) then
+                      begin
+                        if block_type<>bt_const then
+                          inserttypeconv(p2,cansichartype);
+                        if (p2.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
+                          incompatibletypes(cwidechartype,cansichartype);
+                      end;
 
-                          if block_type<>bt_const then
-                            inserttypeconv(p2,cansichartype);
-                          if (p2.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
-                            incompatibletypes(cwidechartype,cansichartype);
+                    getrange(p2.resultdef,lr,hr);
+                    if assigned(p3) then
+                     begin
+                       if is_widechar(p3.resultdef) then
+                         begin
+                           if block_type<>bt_const then
+                             inserttypeconv(p3,cansichartype);
+                           if (p3.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
+                             begin
+                               current_filepos:=p3.fileinfo;
+                               incompatibletypes(cwidechartype,cansichartype);
+                             end;
+                         end;
+                       { this isn't good, you'll get problems with
+                         type t010 = 0..10;
+                              ts = set of t010;
+                         var  s : ts;b : t010
+                         begin  s:=[1,2,b]; end.
+                       if is_integer(p3^.resultdef) then
+                        begin
+                          inserttypeconv(p3,u8bitdef);
                         end;
+                       }
+                       if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then
+                         begin
+                            CGMessagePos(p3.fileinfo,type_e_typeconflict_in_set);
+                         end
+                       else
+                         begin
+                           if (p2.nodetype=ordconstn) and (p3.nodetype=ordconstn) then
+                            begin
+                               if not(is_integer(p3.resultdef)) then
+                                 begin
+                                   if not(assigned(hdef)) and first then
+                                     hdef:=p3.resultdef;
+                                 end
+                               else
+                                 begin
+                                   inserttypeconv(p3,u8inttype);
+                                   inserttypeconv(p2,u8inttype);
+                                 end;
+
+                              if tordconstnode(p2).value.svalue>tordconstnode(p3).value.svalue then
+                                CGMessagePos(p2.fileinfo,type_w_empty_constant_range_set);
+                              for l:=tordconstnode(p2).value.svalue to tordconstnode(p3).value.svalue do
+                                do_set(l);
+                              p2.free;
+                              p3.free;
+                            end
+                           else
+                            begin
+                              update_constsethi(p2.resultdef,false);
+                              inserttypeconv(p2,hdef);
+
+                              update_constsethi(p3.resultdef,false);
+                              inserttypeconv(p3,hdef);
+
+                              if assigned(hdef) then
+                                inserttypeconv(p3,hdef)
+                              else if first then
+                                hdef:=p3.resultdef
+                              else
+                                inserttypeconv(p3,u8inttype);
+                              p4:=csetelementnode.create(p2,p3);
+                            end;
+                         end;
+                     end
+                    else
+                     begin
+                       { Single value }
+                       if p2.nodetype=ordconstn then
+                        begin
+                          if assigned(hdef) then
+                            inserttypeconv(p2,hdef)
+                          else if not(is_integer(p2.resultdef)) and first then
+                            hdef:=p2.resultdef
+                          else
+                            inserttypeconv(p2,u8inttype);
 
-                      getrange(p2.resultdef,lr,hr);
-                      if assigned(p3) then
-                       begin
-                         if is_widechar(p3.resultdef) then
-                           begin
-                             if block_type<>bt_const then
-                               inserttypeconv(p3,cansichartype);
-                             if (p3.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
-                               begin
-                                 current_filepos:=p3.fileinfo;
-                                 incompatibletypes(cwidechartype,cansichartype);
-                               end;
-                           end;
-                         { this isn't good, you'll get problems with
-                           type t010 = 0..10;
-                                ts = set of t010;
-                           var  s : ts;b : t010
-                           begin  s:=[1,2,b]; end.
-                         if is_integer(p3^.resultdef) then
-                          begin
-                            inserttypeconv(p3,u8bitdef);
-                          end;
-                         }
-                         if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then
-                           begin
-                              CGMessagePos(p3.fileinfo,type_e_typeconflict_in_set);
-                           end
-                         else
-                           begin
-                             if (p2.nodetype=ordconstn) and (p3.nodetype=ordconstn) then
-                              begin
-                                 if not(is_integer(p3.resultdef)) then
-                                   hdef:=p3.resultdef
-                                 else
-                                   begin
-                                     inserttypeconv(p3,u8inttype);
-                                     inserttypeconv(p2,u8inttype);
-                                   end;
-
-                                if tordconstnode(p2).value.svalue>tordconstnode(p3).value.svalue then
-                                  CGMessagePos(p2.fileinfo,type_w_empty_constant_range_set);
-                                for l:=tordconstnode(p2).value.svalue to tordconstnode(p3).value.svalue do
-                                  do_set(l);
-                                p2.free;
-                                p3.free;
-                              end
-                             else
-                              begin
-                                update_constsethi(p2.resultdef,false);
-                                inserttypeconv(p2,hdef);
-
-                                update_constsethi(p3.resultdef,false);
-                                inserttypeconv(p3,hdef);
-
-                                if assigned(hdef) then
-                                  inserttypeconv(p3,hdef)
-                                else
-                                  inserttypeconv(p3,u8inttype);
-                                p4:=csetelementnode.create(p2,p3);
-                              end;
-                           end;
-                       end
-                      else
-                       begin
-                         { Single value }
-                         if p2.nodetype=ordconstn then
-                          begin
-                            if not(is_integer(p2.resultdef)) then
-                              update_constsethi(p2.resultdef,true);
-
-                            if assigned(hdef) then
-                              inserttypeconv(p2,hdef)
-                            else
-                              inserttypeconv(p2,u8inttype);
-
-                            do_set(tordconstnode(p2).value.svalue);
-                            p2.free;
-                          end
-                         else
-                          begin
-                            update_constsethi(p2.resultdef,false);
-
-                            if assigned(hdef) then
-                              inserttypeconv(p2,hdef)
-                            else
-                              inserttypeconv(p2,u8inttype);
+                          if not(is_integer(p2.resultdef)) then
+                            update_constsethi(p2.resultdef,true);
 
-                            p4:=csetelementnode.create(p2,nil);
-                          end;
-                       end;
-                    end;
+                          do_set(tordconstnode(p2).value.svalue);
+                          p2.free;
+                        end
+                       else
+                        begin
+                          update_constsethi(p2.resultdef,false);
 
-                  stringdef :
-                    begin
-                        if (p2.nodetype<>stringconstn) then
-                          Message(parser_e_illegal_expression)
-                        { if we've already set elements which are constants }
-                        { throw an error                                    }
-                        else if ((hdef=nil) and assigned(result)) or
-                          not(is_char(hdef)) then
-                          CGMessage(type_e_typeconflict_in_set)
-                        else
-                         for l:=1 to length(pshortstring(tstringconstnode(p2).value_str)^) do
-                          do_set(ord(pshortstring(tstringconstnode(p2).value_str)^[l]));
-                        if hdef=nil then
-                         hdef:=cansichartype;
-                        p2.free;
-                      end;
+                          if assigned(hdef) then
+                            inserttypeconv(p2,hdef)
+                          else if not(is_integer(p2.resultdef)) and first then
+                            hdef:=p2.resultdef
+                          else
+                            inserttypeconv(p2,u8inttype);
 
-                    else
-                      CGMessage(type_e_ordinal_expr_expected);
+                          p4:=csetelementnode.create(p2,nil);
+                        end;
+                     end;
+                  end;
+                else
+                  CGMessage(type_e_ordinal_expr_expected);
               end;
               { insert the set creation tree }
               if assigned(p4) then
@@ -686,8 +678,9 @@ implementation
               if freep then
                 p2.free;
               current_filepos:=oldfilepos;
+              first:=false;
             end;
-           if (hdef=nil) then
+          if (hdef=nil) then
             hdef:=u8inttype;
          end
         else
@@ -1842,12 +1835,12 @@ implementation
           CGMessage(type_e_no_addr_of_constant);
         { a dynamic array is a pointer to an array, so to convert it to }
         { an open array, we have to dereference it (JM)                 }
-        result := ctypeconvnode.create_internal(left,cpointerdef.getreusable(resultdef));
+        result:=ctypeconvnode.create_internal(left,cpointerdef.getreusable(resultdef));
         typecheckpass(result);
         { left is reused }
-        left := nil;
-        result := cderefnode.create(result);
-        include(result.flags,nf_no_checkpointer);
+        left:=nil;
+        result:=cderefnode.create(result);
+        include(TDerefNode(result).derefnodeflags,drnf_no_checkpointer);
       end;
 
 

compiler/ncon.pas

@@ -305,7 +305,7 @@ implementation
       begin
         is_constresourcestringnode:=(p.nodetype=loadn) and
           (tloadnode(p).symtableentry.typ=constsym) and
-          (tconstsym(tloadnode(p).symtableentry).consttyp=constresourcestring);
+          (tconstsym(tloadnode(p).symtableentry).consttyp in [constresourcestring,constwresourcestring]);
       end;
 
 

compiler/nflw.pas

@@ -1621,10 +1621,15 @@ implementation
 {$if defined(i386) or defined(x86_64)}
 {$ifdef i386}
           (((current_settings.fputype>=fpu_sse) and is_single(tassignmentnode(thenstmnt).left.resultdef)) or
-           ((current_settings.fputype>=fpu_sse2) and is_double(tassignmentnode(thenstmnt).left.resultdef))
+           ((current_settings.fputype>=fpu_sse2) and is_double(tassignmentnode(thenstmnt).left.resultdef)) or
+           ((CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype]) and is_32bitint(tassignmentnode(thenstmnt).left.resultdef))
           ) and
 {$else i386}
-          (is_single(tassignmentnode(thenstmnt).left.resultdef) or is_double(tassignmentnode(thenstmnt).left.resultdef)) and
+          (is_single(tassignmentnode(thenstmnt).left.resultdef) or
+           is_double(tassignmentnode(thenstmnt).left.resultdef) or
+           is_32bitint(tassignmentnode(thenstmnt).left.resultdef) or
+           is_64bitint(tassignmentnode(thenstmnt).left.resultdef)
+          ) and
 {$endif i386}
 {$endif defined(i386) or defined(x86_64)}
 {$if defined(xtensa)}
@@ -1632,7 +1637,7 @@ implementation
 {$endif defined(xtensa)}
 {$if defined(aarch64)}
           (is_single(tassignmentnode(thenstmnt).left.resultdef) or is_double(tassignmentnode(thenstmnt).left.resultdef) or
-           is_32bitint(tassignmentnode(thenstmnt).right.resultdef)) and
+           is_32bitint(tassignmentnode(thenstmnt).left.resultdef) or is_64bitint(tassignmentnode(thenstmnt).left.resultdef)) and
 {$endif defined(aarch64)}
           (
           { the right size of the assignment in the then clause must either }
@@ -1679,7 +1684,11 @@ implementation
                 else if is_u32bitint(paratype) then
                   in_nr:=in_max_dword
                 else if is_s32bitint(paratype) then
-                  in_nr:=in_max_longint;
+                  in_nr:=in_max_longint
+                else if is_u64bitint(paratype) then
+                  in_nr:=in_max_qword
+                else if is_s64bitint(paratype) then
+                  in_nr:=in_max_int64;
               end
             else
               begin
@@ -1690,7 +1699,11 @@ implementation
                 else if is_u32bitint(paratype) then
                   in_nr:=in_min_dword
                 else if is_s32bitint(paratype) then
-                  in_nr:=in_min_longint;
+                  in_nr:=in_min_longint
+                else if is_u64bitint(paratype) then
+                  in_nr:=in_min_qword
+                else if is_s64bitint(paratype) then
+                  in_nr:=in_min_int64;
               end;
             { for inline nodes, the first parameter is the last one in the linked list
 
@@ -1860,7 +1873,7 @@ implementation
            (cs_opt_loopunroll in current_settings.optimizerswitches) and
            assigned(t2) and
            { statements must be error free }
-           not(nf_error in t2.flags) then
+           not(tnf_error in t2.transientflags) then
            begin
              typecheckpass(t2);
              res:=t2.simplify(false);
@@ -1925,7 +1938,7 @@ implementation
         begin
           { get rid of nf_write etc. as the left node is now only read }
           leftcopy:=left.getcopy;
-          node_reset_flags(leftcopy,[nf_pass1_done,nf_modify,nf_write]);
+          node_reset_flags(leftcopy,[nf_modify,nf_write],[tnf_pass1_done]);
 
           if fw then
             addstatement(s,
@@ -2079,7 +2092,7 @@ implementation
 
         { get rid of nf_write etc. as the left node is now only read }
         leftcopy:=left.getcopy;
-        node_reset_flags(leftcopy,[nf_pass1_done,nf_modify,nf_write]);
+        node_reset_flags(leftcopy,[nf_modify,nf_write],[tnf_pass1_done]);
 
         if needsifblock then
           begin

compiler/ngenutil.pas

@@ -113,14 +113,14 @@ interface
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
       class function create_main_procdef(const name: string; potype:tproctypeoption; ps: tprocsym):tdef; virtual;
-      class procedure InsertInitFinalTable;
+      class procedure InsertInitFinalTable(main : tmodule);
      protected
       class procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:tmoduleflag); virtual;
       class procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:tmoduleflag); virtual;
 
-      class procedure insert_init_final_table(entries:tfplist); virtual;
+      class procedure insert_init_final_table(main: tmodule; entries:tfplist); virtual;
 
-      class function get_init_final_list: tfplist;
+      class function get_init_final_list(main : tmodule): tfplist;
       class procedure release_init_final_list(list:tfplist);
      public
       class procedure InsertThreadvarTablesTable; virtual;
@@ -1020,37 +1020,53 @@ implementation
     end;
 
 
-  class function tnodeutils.get_init_final_list:tfplist;
+  class function tnodeutils.get_init_final_list(main : tmodule):tfplist;
+
+    procedure addusedunits(m : tmodule);
+
     var
       hp : tused_unit;
       entry : pinitfinalentry;
     begin
-      result:=tfplist.create;
-      { Insert initialization/finalization of the used units }
-      hp:=tused_unit(usedunits.first);
+      hp:=tused_unit(m.used_units.first);
       while assigned(hp) do
        begin
-         if (hp.u.moduleflags * [mf_init,mf_finalize])<>[] then
+         if (not hp.u.initfinalchecked) then
            begin
-             new(entry);
-             entry^.module:=hp.u;
-             entry^.initpd:=nil;
-             entry^.finipd:=nil;
-             if mf_init in hp.u.moduleflags then
-               entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
-             else
-               entry^.initfunc:='';
-             if mf_finalize in hp.u.moduleflags then
-               entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
-             else
-               entry^.finifunc:='';
-             result.add(entry);
+           hp.u.initfinalchecked:=True;
+           addusedunits(hp.u);
+           if ((hp.u.moduleflags * [mf_init,mf_finalize])<>[]) then
+             begin
+               new(entry);
+               entry^.module:=hp.u;
+               entry^.initpd:=nil;
+               entry^.finipd:=nil;
+               if mf_init in hp.u.moduleflags then
+                 entry^.initfunc:=make_mangledname('INIT$',hp.u.globalsymtable,'')
+               else
+                 entry^.initfunc:='';
+               if mf_finalize in hp.u.moduleflags then
+                 entry^.finifunc:=make_mangledname('FINALIZE$',hp.u.globalsymtable,'')
+               else
+                 entry^.finifunc:='';
+               result.add(entry);
+             end;
            end;
          hp:=tused_unit(hp.next);
        end;
 
+    end;
+
+    var
+      entry : pinitfinalentry;
+    begin
+      result:=tfplist.create;
+
+      { Insert initialization/finalization of the used units }
+      addusedunits(main);
+
       { Insert initialization/finalization of the program }
-      if (current_module.moduleflags * [mf_init,mf_finalize])<>[] then
+      if (main.moduleflags * [mf_init,mf_finalize])<>[] then
         begin
           new(entry);
           entry^.module:=current_module;
@@ -1081,19 +1097,19 @@ implementation
     end;
 
 
-  class procedure tnodeutils.InsertInitFinalTable;
+  class procedure tnodeutils.InsertInitFinalTable(main : tmodule);
     var
       entries : tfplist;
     begin
-      entries := get_init_final_list;
+      entries := get_init_final_list(main);
 
-      insert_init_final_table(entries);
+      insert_init_final_table(main,entries);
 
       release_init_final_list(entries);
     end;
 
 
-  class procedure tnodeutils.insert_init_final_table(entries:tfplist);
+  class procedure tnodeutils.insert_init_final_table(main : tmodule; entries:tfplist);
     var
       i : longint;
       unitinits : ttai_typedconstbuilder;

compiler/ngtcon.pas

@@ -1022,7 +1022,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                     labelsym :
                       ftcb.queue_emit_label(tlabelsym(srsym));
                     constsym :
-                      if tconstsym(srsym).consttyp=constresourcestring then
+                      if tconstsym(srsym).consttyp in [constresourcestring,constwresourcestring] then
                         ftcb.queue_emit_const(tconstsym(srsym))
                       else
                         Message(type_e_constant_expr_expected);

compiler/ninl.pas

@@ -29,7 +29,14 @@ interface
        node,htypechk,symtype,compinnr;
 
     type
+       TInlineNodeFlag = (
+         inf_inlineconst
+       );
+
+       TInlineNodeFlags = set of TInlineNodeFlag;
+
        tinlinenode = class(tunarynode)
+          inlinenodeflags : TInlineNodeFlags;
           inlinenumber : tinlinenumber;
           constructor create(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
           constructor createintern(number : tinlinenumber;is_const:boolean;l : tnode);virtual;
@@ -137,7 +144,7 @@ implementation
       globtype,cutils,cclasses,fmodule,
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
       cpuinfo,cpubase,
-      pass_1,
+      pass_1,ppu,
       ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,ngenutil,
       nobjc,objcdef,
       cgbase,procinfo;
@@ -153,11 +160,12 @@ implementation
 *****************************************************************************}
 
     constructor tinlinenode.create(number : tinlinenumber;is_const:boolean;l : tnode);
-
       begin
          inherited create(inlinen,l);
          if is_const then
-           include(flags,nf_inlineconst);
+           inlinenodeflags:=[inf_inlineconst]
+         else
+           inlinenodeflags:=[];
          inlinenumber:=number;
       end;
 
@@ -166,6 +174,7 @@ implementation
      l : tnode);
       begin
          create(number,is_const,l);
+         inlinenodeflags:=[];
          include(flags,nf_internal);
       end;
 
@@ -173,6 +182,7 @@ implementation
     constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
+        ppufile.getset(tppuset1(inlinenodeflags));
         inlinenumber:=tinlinenumber(ppufile.getlongint);
       end;
 
@@ -180,6 +190,7 @@ implementation
     procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(inlinenodeflags));
         ppufile.putlongint(longint(inlinenumber));
       end;
 
@@ -189,6 +200,7 @@ implementation
          n : tinlinenode;
       begin
          n:=tinlinenode(inherited dogetcopy);
+         n.inlinenodeflags:=inlinenodeflags;
          n.inlinenumber:=inlinenumber;
          result:=n;
       end;
@@ -202,8 +214,25 @@ implementation
 
 {$ifdef DEBUG_NODE_XML}
     procedure TInlineNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TInlineNodeFlag;
+        First: Boolean;
       begin
-        inherited;
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in inlinenodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' inlinenodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+
         Write(T, ' inlinenumber="', inlinenumber, '"');
       end;
 {$endif DEBUG_NODE_XML}
@@ -2330,15 +2359,34 @@ implementation
             end;
         end;
 
+      function is_minmax_deterministic(var node: tordconstnode; const DoMax: Boolean; out res: Boolean): Boolean;
+        begin
+          Result := False;
+          if not is_integer(resultdef) then
+            InternalError(2024031501);
+
+          if (node.value <= torddef(resultdef).low) then
+            begin
+              res := not DoMax;
+              Exit(True);
+            end
+          else if (node.value >= torddef(resultdef).high) then
+            begin
+              res := DoMax;
+              Exit(True);
+            end
+        end;
+
       var
-        hp        : tnode;
+        hp,hp2    : tnode;
         vl,vl2    : TConstExprInt;
         vr        : bestreal;
+        helperres : Boolean;
 
       begin { simplify }
          result:=nil;
          { handle intern constant functions in separate case }
-         if nf_inlineconst in flags then
+         if inf_inlineconst in inlinenodeflags then
           begin
             { no parameters? }
             if not assigned(left) then
@@ -2862,6 +2910,262 @@ implementation
                       result:=cordconstnode.create(PopCnt(tordconstnode(left).value),resultdef,false);
                     end;
                 end;
+              in_min_single,
+              in_min_double:
+                begin
+                  { Check to see if the result is deterministic }
+                  if left.nodetype=callparan then
+                    begin
+                      hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+                      hp2:=tcallparanode(left).paravalue;
+
+                      if (hp.nodetype=realconstn) then
+                        begin
+                          if (trealconstnode(hp).value_real = MathQNaN.value) then
+                            { If one of the inputs is NaN, the second parameter
+                              is taken }
+                            result:=hp2.getcopy()
+                          else if (trealconstnode(hp).value_real = MathNegInf.value) then
+                            { Nothing is less than than -oo }
+                            result:=crealconstnode.create(MathNegInf.value,resultdef)
+                          else if (trealconstnode(hp).value_real = MathInf.value) then
+                            { Everything is less than +oo }
+                            result:=hp2.getcopy()
+                          else if (hp2.nodetype=realconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the smaller of the two right now }
+                              if (trealconstnode(hp).value_real < trealconstnode(hp2).value_real) then
+                                result:=crealconstnode.create(trealconstnode(hp).value_real,resultdef)
+                              else
+                                result:=crealconstnode.create(trealconstnode(hp2).value_real,resultdef);
+                            end;
+                        end
+                      else if (hp2.nodetype=realconstn) then
+                        begin
+                          if (trealconstnode(hp2).value_real = MathQNaN.value) then
+                            { If one of the inputs is NaN, the second parameter
+                              is taken (even if it is NaN) }
+                            result:=crealconstnode.create(MathQNaN.value,resultdef)
+                          else if (trealconstnode(hp2).value_real = MathNegInf.value) then
+                            { Nothing is less than than -oo }
+                            result:=crealconstnode.create(MathNegInf.value,resultdef)
+                          else if (trealconstnode(hp2).value_real = MathInf.value) then
+                            { Everything is less than +oo }
+                            result:=hp.getcopy();
+                        end;
+                    end;
+                end;
+              in_max_single,
+              in_max_double:
+                begin
+                  { Check to see if the result is deterministic }
+                  if left.nodetype=callparan then
+                    begin
+                      hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+                      hp2:=tcallparanode(left).paravalue;
+
+                      if (hp.nodetype=realconstn) then
+                        begin
+                          if (trealconstnode(hp).value_real = MathQNaN.value) then
+                            { If one of the inputs is NaN, the second parameter
+                              is taken }
+                            result:=hp2.getcopy()
+                          else if (trealconstnode(hp).value_real = MathNegInf.value) then
+                            { Everything is greater than than -oo }
+                            result:=hp2.getcopy()
+                          else if (trealconstnode(hp).value_real = MathInf.value) then
+                            { Nothing is greater than +oo }
+                            result:=crealconstnode.create(MathInf.value,resultdef)
+                          else if (hp2.nodetype=realconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the larger of the two right now }
+                              if (trealconstnode(hp).value_real > trealconstnode(hp2).value_real) then
+                                result:=crealconstnode.create(trealconstnode(hp).value_real,resultdef)
+                              else
+                                result:=crealconstnode.create(trealconstnode(hp2).value_real,resultdef)
+                            end;
+                        end
+                      else if (hp2.nodetype=realconstn) then
+                        begin
+                          if (trealconstnode(hp2).value_real = MathQNaN.value) then
+                            { If one of the inputs is NaN, the second parameter
+                              is taken (even if it is NaN) }
+                            result:=crealconstnode.create(MathQNaN.value,resultdef)
+                          else if (trealconstnode(hp2).value_real = MathNegInf.value) then
+                            { Everything is greater than than -oo }
+                            result:=hp.getcopy()
+                          else if (trealconstnode(hp2).value_real = MathInf.value) then
+                            { Nothing is greater than +oo }
+                            result:=crealconstnode.create(MathInf.value,resultdef);
+                        end;
+                    end;
+                end;
+              in_min_longint,
+              in_min_int64:
+                begin
+                  if left.nodetype=callparan then
+                    begin
+                      { Check to see if the result is deterministic }
+                      hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+                      hp2:=tcallparanode(left).paravalue;
+
+                      if (hp.nodetype=ordconstn) then
+                        begin
+                          if (hp2.nodetype=ordconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the smaller of the two right now }
+                              if inlinenumber=in_min_longint then
+                                result:=cordconstnode.create(min(LongInt(tordconstnode(hp).value.svalue),LongInt(tordconstnode(hp2).value.svalue)),resultdef,false)
+                              else
+                                result:=cordconstnode.create(min(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
+                            end;
+
+                          if is_minmax_deterministic(tordconstnode(hp), False, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
+                              else
+                                result:=hp2.getcopy();
+                            end;
+                        end
+                      else if (hp2.nodetype=ordconstn) then
+                        begin
+                          if is_minmax_deterministic(tordconstnode(hp2), False, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
+                              else
+                                result:=hp.getcopy();
+                            end;
+                        end;
+                    end;
+                end;
+              in_max_longint,
+              in_max_int64:
+                begin
+                  if left.nodetype=callparan then
+                    begin
+                      { Check to see if the result is deterministic }
+                      hp:=tcallparanode(left).paravalue;
+                      hp2:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+
+                      if (hp.nodetype=ordconstn) then
+                        begin
+                          if (hp2.nodetype=ordconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the larger of the two right now }
+                              if inlinenumber=in_max_longint then
+                                result:=cordconstnode.create(max(LongInt(tordconstnode(hp).value.svalue),LongInt(tordconstnode(hp2).value.svalue)),resultdef,false)
+                              else
+                                result:=cordconstnode.create(max(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
+                            end;
+
+                          if is_minmax_deterministic(tordconstnode(hp), True, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
+                              else
+                                result:=hp2.getcopy();
+                            end;
+                        end
+                      else if (hp2.nodetype=ordconstn) then
+                        begin
+                          if is_minmax_deterministic(tordconstnode(hp2), True, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
+                              else
+                                result:=hp.getcopy();
+                            end;
+                        end;
+                    end;
+                end;
+              in_min_dword,
+              in_min_qword:
+                begin
+                  if left.nodetype=callparan then
+                    begin
+                      { Check to see if the result is deterministic }
+                      hp:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+                      hp2:=tcallparanode(left).paravalue;
+
+                      if (hp.nodetype=ordconstn) then
+                        begin
+                          if (hp2.nodetype=ordconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the smaller of the two right now }
+                              if inlinenumber=in_min_dword then
+                                result:=cordconstnode.create(min(DWord(tordconstnode(hp).value.uvalue),DWord(tordconstnode(hp2).value.uvalue)),resultdef,false)
+                              else
+                                result:=cordconstnode.create(min(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
+                            end;
+
+                          if is_minmax_deterministic(tordconstnode(hp), False, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
+                              else
+                                result:=hp2.getcopy();
+                            end;
+                        end
+                      else if (hp2.nodetype=ordconstn) then
+                        begin
+                          if is_minmax_deterministic(tordconstnode(hp2), False, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
+                              else
+                                result:=hp.getcopy();
+                            end;
+                        end;
+                    end;
+                end;
+              in_max_dword,
+              in_max_qword:
+                begin
+                  if left.nodetype=callparan then
+                    begin
+                      { Check to see if the result is deterministic }
+                      hp:=tcallparanode(left).paravalue;
+                      hp2:=tcallparanode(tcallparanode(left).nextpara).paravalue;
+
+                      if (hp.nodetype=ordconstn) then
+                        begin
+                          if (hp2.nodetype=ordconstn) then
+                            begin
+                              { Both actual parameters are constants, so take
+                                the larger of the two right now }
+                              if inlinenumber=in_max_dword then
+                                result:=cordconstnode.create(max(DWord(tordconstnode(hp).value.uvalue),DWord(tordconstnode(hp2).value.uvalue)),resultdef,false)
+                              else
+                                result:=cordconstnode.create(max(tordconstnode(hp).value,tordconstnode(hp2).value),resultdef,false);
+                            end;
+
+                          if is_minmax_deterministic(tordconstnode(hp), True, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp).value,resultdef,false)
+                              else
+                                result:=hp2.getcopy();
+                            end;
+                        end
+                      else if (hp2.nodetype=ordconstn) then
+                        begin
+                          if is_minmax_deterministic(tordconstnode(hp2), True, helperres) then
+                            begin
+                              if helperres then
+                                result:=cordconstnode.create(tordconstnode(hp2).value,resultdef,false)
+                              else
+                                result:=hp.getcopy();
+                            end;
+                        end;
+                    end;
+                end;
               else
                 ;
             end;
@@ -3040,7 +3344,7 @@ implementation
               typecheckpass(left);
           end;
 
-        if not(nf_inlineconst in flags) then
+        if not(inf_inlineconst in inlinenodeflags) then
           begin
             case inlinenumber of
               in_lo_long,
@@ -3860,6 +4164,10 @@ implementation
               in_max_dword,
               in_min_longint,
               in_min_dword,
+              in_max_int64,
+              in_max_qword,
+              in_min_int64,
+              in_min_qword,
               in_max_single,
               in_max_double,
               in_min_single,
@@ -3918,7 +4226,7 @@ implementation
            end;
 
          { intern const should already be handled }
-         if nf_inlineconst in flags then
+         if inf_inlineconst in inlinenodeflags then
           internalerror(200104044);
          case inlinenumber of
           in_lo_qword,
@@ -4316,6 +4624,10 @@ implementation
          in_max_dword,
          in_min_longint,
          in_min_dword,
+         in_max_int64,
+         in_max_qword,
+         in_min_int64,
+         in_min_qword,
          in_min_single,
          in_min_double,
          in_max_single,
@@ -4771,6 +5083,17 @@ implementation
         { first param must be a string or dynamic array ...}
         if isarray then
          begin
+           { SetLength(Arr, 0), Arr := nil, Arr := [] }
+           if (dims=1) and is_constintvalue(tcallparanode(paras).left, 0) then
+             begin
+               ppn.left:=nil; { unlink destppn }
+               result:=ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil);
+               result:=ccallnode.createintern('fpc_dynarray_clear',
+                 ccallparanode.create(caddrnode.create_internal(
+                   crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)),
+                 result));
+               exit;
+             end;
            { create statements with call initialize the arguments and
              call fpc_dynarr_setlength }
            newblock:=internalstatements(newstatement);
@@ -5436,7 +5759,7 @@ implementation
                      inserttypeconv_internal(n,voidpointertype);
                      arrconstr:=carrayconstructornode.create(n,arrconstr);
                    end;
-                 arrconstr.allow_array_constructor:=true;
+                 Include(arrconstr.arrayconstructornodeflags,acnf_allow_array_constructor);
 
                  { based on the code from nopt.genmultistringadd() }
                  tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);

compiler/nld.pas

@@ -85,10 +85,17 @@ interface
        { different assignment types }
        tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash);
 
+       TAssignmentNodeFlag = (
+         anf_assign_done_in_right
+       );
+
+       TAssignmentNodeFlags = set of TAssignmentNodeFlag;
+
        tassignmentnode = class(tbinarynode)
          protected
           function direct_shortstring_assignment: boolean; virtual;
          public
+          assignmentnodeflags : TAssignmentNodeFlags;
           assigntype : tassigntype;
           constructor create(l,r : tnode);virtual;
           { no checks for validity of assignment }
@@ -104,6 +111,7 @@ interface
        {$endif state_tracking}
           function docompare(p: tnode): boolean; override;
 {$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
           procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
        end;
@@ -116,14 +124,24 @@ interface
        end;
        tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
 
+       TArrayConstructorNodeFlag = (
+         acnf_allow_array_constructor,
+         acnf_forcevaria,
+         acnf_novariaallowed
+       );
+
+       TArrayConstructorNodeFlags = set of TArrayConstructorNodeFlag;
+
        tarrayconstructornode = class(tbinarynode)
-          allow_array_constructor : boolean;
+          arrayconstructornodeflags : TArrayConstructorNodeFlags;
          private
           function has_range_node:boolean;
          protected
-          procedure wrapmanagedvarrec(var n: tnode);virtual;abstract;
+          procedure wrapmanagedvarrec(var n : tnode);virtual;abstract;
          public
           constructor create(l,r : tnode);virtual;
+          constructor ppuload(t : tnodetype;ppufile : tcompilerppufile);override;
+          procedure ppuwrite(ppufile : tcompilerppufile);override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
@@ -131,6 +149,9 @@ interface
           procedure force_type(def:tdef);
           procedure insert_typeconvs;
           function isempty : boolean;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_XML}
        end;
        tarrayconstructornodeclass = class of tarrayconstructornode;
 
@@ -350,6 +371,8 @@ implementation
              begin
                if tconstsym(symtableentry).consttyp=constresourcestring then
                  resultdef:=getansistringdef
+               else if tconstsym(symtableentry).consttyp=constwresourcestring then
+                 resultdef:=cunicodestringtype
                else
                  internalerror(22799);
              end;
@@ -481,7 +504,7 @@ implementation
               ;
             constsym:
               begin
-                if tconstsym(symtableentry).consttyp=constresourcestring then
+                if tconstsym(symtableentry).consttyp in [constresourcestring,constwresourcestring] then
                   expectloc:=LOC_CREFERENCE;
               end;
             staticvarsym,
@@ -614,6 +637,7 @@ implementation
 
       begin
          inherited create(assignn,l,r);
+         assignmentnodeflags:=[];
          assigntype:=at_normal;
          if r.nodetype = typeconvn then
            ttypeconvnode(r).warn_pointer_to_signed:=false;
@@ -630,6 +654,7 @@ implementation
     constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
+        ppufile.getset(tppuset1(assignmentnodeflags));
         assigntype:=tassigntype(ppufile.getbyte);
       end;
 
@@ -637,6 +662,7 @@ implementation
     procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(assignmentnodeflags));
         ppufile.putbyte(byte(assigntype));
       end;
 
@@ -648,6 +674,7 @@ implementation
 
       begin
          n:=tassignmentnode(inherited dogetcopy);
+         n.assignmentnodeflags:=assignmentnodeflags;
          n.assigntype:=assigntype;
          result:=n;
       end;
@@ -705,7 +732,7 @@ implementation
           exit;
 
         { just in case the typecheckpass of right optimized something here }
-        if nf_assign_done_in_right in flags then
+        if anf_assign_done_in_right in assignmentnodeflags then
           begin
             result:=right;
             right:=nil;
@@ -720,7 +747,11 @@ implementation
 
         { assignments to formaldefs and open arrays aren't allowed }
         if is_open_array(left.resultdef) then
-          CGMessage(type_e_assignment_not_allowed)
+          begin
+            CGMessage(type_e_assignment_not_allowed);
+            result:=cerrornode.create;
+            exit;
+          end
         else if (left.resultdef.typ=formaldef) then
           if not(target_info.system in systems_managed_vm) then
             CGMessage(type_e_assignment_not_allowed)
@@ -910,7 +941,7 @@ implementation
          aktassignmentnode:=self;
          firstpass(right);
          aktassignmentnode:=oldassignmentnode;
-         if nf_assign_done_in_right in flags then
+         if anf_assign_done_in_right in assignmentnodeflags then
            begin
              result:=right;
              right:=nil;
@@ -1073,6 +1104,28 @@ implementation
 
 
 {$ifdef DEBUG_NODE_XML}
+    procedure TAssignmentNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TAssignmentNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in assignmentnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' assignmentnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+
+
     procedure TAssignmentNode.XMLPrintNodeData(var T: Text);
       begin
         { For assignments, put the left and right branches on the same level for clarity }
@@ -1121,7 +1174,21 @@ implementation
     constructor tarrayconstructornode.create(l,r : tnode);
       begin
          inherited create(arrayconstructorn,l,r);
-         allow_array_constructor:=false;
+         arrayconstructornodeflags:=[];
+      end;
+
+
+    constructor tarrayconstructornode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getset(tppuset1(arrayconstructornodeflags));
+      end;
+
+
+    procedure tarrayconstructornode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(arrayconstructornodeflags));
       end;
 
 
@@ -1130,6 +1197,7 @@ implementation
          n : tarrayconstructornode;
       begin
          n:=tarrayconstructornode(inherited dogetcopy);
+         n.arrayconstructornodeflags:=arrayconstructornodeflags;
          result:=n;
       end;
 
@@ -1174,7 +1242,7 @@ implementation
         Do this only if we didn't convert the arrayconstructor yet. This
         is needed for the cases where the resultdef is forced for a second
         run }
-        if not allow_array_constructor or has_range_node then
+        if not (acnf_allow_array_constructor in arrayconstructornodeflags) or has_range_node then
          begin
            hp:=tarrayconstructornode(getcopy);
            arrayconstructor_to_set(tnode(hp));
@@ -1230,7 +1298,7 @@ implementation
                            hdef:=hp.left.resultdef;
                        end
                      else
-                       if (nf_novariaallowed in flags) then
+                       if (acnf_novariaallowed in arrayconstructornodeflags) then
                          varia:=true;
                    end;
                end;
@@ -1280,7 +1348,7 @@ implementation
         hp        : tarrayconstructornode;
         dovariant : boolean;
       begin
-        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        dovariant:=(acnf_forcevaria in arrayconstructornodeflags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
         { only pass left tree, right tree contains next construct if any }
         if assigned(left) then
          begin
@@ -1304,7 +1372,7 @@ implementation
         do_variant,
         do_managed_variant:boolean;
       begin
-        do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        do_variant:=(acnf_forcevaria in arrayconstructornodeflags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
         do_managed_variant:=
           do_variant and
           (target_info.system in systems_managed_vm);
@@ -1347,6 +1415,28 @@ implementation
         docompare:=inherited docompare(p);
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TArrayConstructorNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TArrayConstructorNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in arrayconstructornodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' arrayconstructornodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                               TTYPENODE

compiler/nmat.pas

@@ -26,13 +26,27 @@ unit nmat;
 interface
 
     uses
-       node;
+       node,symtype;
 
     type
+       TModDivNodeFlag = (
+         mdnf_isomod
+       );
+
+       TModDivNodeFlags = set of TModDivNodeFlag;
+
        tmoddivnode = class(tbinopnode)
+          moddivnodeflags : TModDivNodeFlags;
+          constructor create(t:tnodetype;l,r : tnode); override;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean) : tnode;override;
+          function dogetcopy : tnode;override;
+    {$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+    {$endif DEBUG_NODE_XML}
          protected
           { override the following if you want to implement }
           { parts explicitely in the code generator (JM)    }
@@ -97,17 +111,39 @@ implementation
       systems,
       verbose,globals,cutils,compinnr,
       globtype,constexp,
-      symconst,symtype,symdef,symcpu,
+      symconst,symdef,symcpu,
       defcmp,defutil,
       htypechk,pass_1,
       cgbase,
       ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl,
-      nutils;
+      nutils,ppu;
 
 {****************************************************************************
                               TMODDIVNODE
  ****************************************************************************}
 
+
+    constructor tmoddivnode.create(t:tnodetype;l,r : tnode);
+      begin
+        inherited create(t, l, r);
+        moddivnodeflags:=[];
+      end;
+
+
+    constructor tmoddivnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t, ppufile);
+        ppufile.getset(tppuset1(moddivnodeflags));
+      end;
+
+
+    procedure tmoddivnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(moddivnodeflags));
+      end;
+
+
     function tmoddivnode.simplify(forinline : boolean):tnode;
       var
         rv,lv : tconstexprint;
@@ -149,7 +185,7 @@ implementation
                 left:=nil;
                 exit;
               end;
-            if (nf_isomod in flags) and
+            if (mdnf_isomod in moddivnodeflags) and
               (rv<=0) then
                begin
                  Message(cg_e_mod_only_defined_for_pos_quotient);
@@ -186,7 +222,7 @@ implementation
 
                 case nodetype of
                   modn:
-                    if nf_isomod in flags then
+                    if mdnf_isomod in moddivnodeflags then
                       begin
                         if lv>=0 then
                           result:=create_simplified_ord_const(lv mod rv,resultdef,forinline,false)
@@ -208,6 +244,16 @@ implementation
       end;
 
 
+    function tmoddivnode.dogetcopy: tnode;
+      var
+        n: tmoddivnode;
+      begin
+        n:=tmoddivnode(inherited dogetcopy);
+        n.moddivnodeflags:=moddivnodeflags;
+        result:=n;
+      end;
+
+
     function tmoddivnode.use_moddiv64bitint_helper: boolean;
       begin
         { not with an ifdef around the call to this routine, because e.g. the
@@ -412,7 +458,7 @@ implementation
             result:=hp;
           end;
 
-         if (nodetype=modn) and (nf_isomod in flags) then
+         if (nodetype=modn) and (mdnf_isomod in moddivnodeflags) then
            begin
              result:=internalstatements(statements);
              else_block:=internalstatements(else_statements);
@@ -722,7 +768,28 @@ implementation
          expectloc:=LOC_REGISTER;
       end;
 
-
+{$ifdef DEBUG_NODE_XML}
+    procedure TModDivNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TModDivNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in moddivnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' moddivnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {****************************************************************************
                               TSHLSHRNODE
@@ -1025,6 +1092,20 @@ implementation
                 result:=tunarynode(left).left.getcopy;
                 exit;
               end;
+          end
+        { transform -(x+1) or -(1+x) into not(x) }
+        else if is_integer(left.resultdef) and is_signed(left.resultdef) and (left.nodetype=addn) and ((localswitches*[cs_check_overflow,cs_check_range])=[]) then
+          begin
+            if is_constintnode(taddnode(left).right) and (tordconstnode(taddnode(left).right).value=1) then
+              begin
+                result:=cnotnode.create(taddnode(left).left.getcopy);
+                exit;
+              end
+            else if is_constintnode(taddnode(left).left) and (tordconstnode(taddnode(left).left).value=1) then
+              begin
+                result:=cnotnode.create(taddnode(left).right.getcopy);
+                exit;
+              end;
           end;
       end;
 

compiler/nmem.pas

@@ -103,11 +103,24 @@ interface
        end;
        taddrnodeclass = class of taddrnode;
 
+       TDerefNodeFlag = (
+         drnf_no_checkpointer
+       );
+
+       TDerefNodeFlags = set of TDerefNodeFlag;
+
        tderefnode = class(tunarynode)
+          derefnodeflags : TDerefNodeFlags;
           constructor create(l : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
+          function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure mark_write;override;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
+{$endif DEBUG_NODE_XML}
        end;
        tderefnodeclass = class of tderefnode;
 
@@ -131,17 +144,30 @@ interface
        end;
        tsubscriptnodeclass = class of tsubscriptnode;
 
+       TVecNodeFlag = (
+         vnf_memindex,
+         vnf_memseg,
+         vnf_callunique
+       );
+
+       TVecNodeFlags = set of TVecNodeFlag;
+
        tvecnode = class(tbinarynode)
        protected
-          function first_arraydef: tnode; virtual;
+          function first_arraydef : tnode; virtual;
           function gen_array_rangecheck: tnode; virtual;
        public
-          constructor create(l,r : tnode);virtual;
+          vecnodeflags: TVecNodeFlags;
+          constructor  create(l,r : tnode);virtual;
+          constructor ppuload(t : tnodetype;ppufile : tcompilerppufile);override;
+          procedure ppuwrite(ppufile : tcompilerppufile);override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function simplify(forinline : boolean) : tnode; override;
+          function dogetcopy : tnode;override;
           procedure mark_write;override;
 {$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var T: Text); override;
           procedure XMLPrintNodeData(var T: Text); override;
 {$endif DEBUG_NODE_XML}
        end;
@@ -837,6 +863,30 @@ implementation
       end;
 
 
+    constructor tderefnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t, ppufile);
+        ppufile.getset(tppuset1(derefnodeflags));
+      end;
+
+
+    procedure tderefnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(derefnodeflags));
+      end;
+
+
+    function tderefnode.dogetcopy : tnode;
+      var
+        n: TDerefNode;
+      begin
+        n := TDerefNode(inherited dogetcopy);
+        n.derefnodeflags := derefnodeflags;
+        Result := n;
+      end;
+
+
     function tderefnode.pass_typecheck:tnode;
       begin
          result:=nil;
@@ -872,6 +922,28 @@ implementation
          expectloc:=LOC_REFERENCE;
       end;
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TDerefNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TDerefNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in derefnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' derefnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 {*****************************************************************************
                             TSUBSCRIPTNODE
@@ -1012,9 +1084,23 @@ implementation
 *****************************************************************************}
 
     constructor tvecnode.create(l,r : tnode);
-
       begin
          inherited create(vecn,l,r);
+         vecnodeflags:=[];
+      end;
+
+
+    constructor tvecnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t, ppufile);
+        ppufile.getset(tppuset1(vecnodeflags));
+      end;
+
+
+    procedure tvecnode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(vecnodeflags));
       end;
 
 
@@ -1312,7 +1398,7 @@ implementation
          if codegenerror then
            exit;
 
-         if (nf_callunique in flags) and
+         if (vnf_callunique in vecnodeflags) and
             (is_ansistring(left.resultdef) or
              is_unicodestring(left.resultdef) or
             (is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then
@@ -1324,10 +1410,10 @@ implementation
              firstpass(left);
              { double resultdef passes somwhere else may cause this to be }
              { reset though :/                                             }
-             exclude(flags,nf_callunique);
+             exclude(vecnodeflags,vnf_callunique);
            end
          else if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then
-           exclude(flags,nf_callunique);
+           exclude(vecnodeflags,vnf_callunique);
 
          { a range node as array index can only appear in function calls, and
            those convert the range node into something else in
@@ -1393,6 +1479,16 @@ implementation
       end;
 
 
+    function tvecnode.dogetcopy: tnode;
+      var
+        n: tvecnode;
+      begin
+        n:=tvecnode(inherited dogetcopy);
+        n.vecnodeflags:=vecnodeflags;
+        result:=n;
+      end;
+
+
     function tvecnode.first_arraydef: tnode;
       begin
         result:=nil;
@@ -1409,6 +1505,7 @@ implementation
             expectloc:=LOC_SUBSETREF;
       end;
 
+
     function tvecnode.gen_array_rangecheck: tnode;
     var
       htype: tdef;
@@ -1486,6 +1583,28 @@ implementation
 
 
 {$ifdef DEBUG_NODE_XML}
+    procedure TVecNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TVecNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in vecnodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' vecnodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+
+
     procedure TVecNode.XMLPrintNodeData(var T: Text);
       begin
         XMLPrintNode(T, Left);

compiler/node.pas

@@ -208,14 +208,10 @@ interface
     type
        { all boolean field of ttree are now collected in flags }
        tnodeflag = (
-         { tbinop operands can be swaped }
-         nf_swapable,
          { tbinop operands are swaped    }
          nf_swapped,
-         nf_error,
 
          { general }
-         nf_pass1_done,
          { Node is written to    }
          nf_write,
          { Node is modified      }
@@ -224,40 +220,20 @@ interface
          nf_address_taken,
          nf_is_funcret,
          nf_isproperty,
-         nf_processing,
          { Node cannot be assigned to }
          nf_no_lvalue,
          { this node is the user code entry, if a node with this flag is removed
-           during simplify, the flag must be moved to another node }
+           during simplify, the flag must be moved to another node.  Though
+           normally applicable to block nodes, they can also appear on asm nodes
+           in the case of pure assembly routines }
          nf_usercode_entry,
 
-         { tderefnode }
-         nf_no_checkpointer,
-
-         { tvecnode }
-         nf_memindex,
-         nf_memseg,
-         nf_callunique,
-
          { tloadnode/ttypeconvnode }
          nf_absolute,
 
-         { taddnode }
+         { taddnode, but appears in typeconv nodes as well among other places }
          { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 }
          nf_is_currency,
-         nf_has_pointerdiv,
-         { the node shall be short boolean evaluated, this flag has priority over localswitches }
-         nf_short_bool,
-
-         { tmoddivnode }
-         nf_isomod,
-
-         { tassignmentnode }
-         nf_assign_done_in_right,
-
-         { tarrayconstructnode }
-         nf_forcevaria,
-         nf_novariaallowed,
 
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
          { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
@@ -266,32 +242,42 @@ interface
          nf_internal,  { no warnings/hints generated }
          nf_load_procvar,
 
-         { tinlinenode }
-         nf_inlineconst,
-
-         { tasmnode }
-         nf_get_asm_position,
-
-         { tblocknode }
+         { tblocknode / this is not node-specific because it can also appear on
+           implicit try/finally nodes }
          nf_block_with_exit,
 
-         { tloadvmtaddrnode }
+         { tloadvmtaddrnode / tisnode }
          nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
 
          { node is derived from generic parameter }
-         nf_generic_para,
+         nf_generic_para
+       );
+
+       tnodeflags = set of tnodeflag;
+
+       TTransientNodeFlag = (
+         { general }
+         tnf_pass1_done,
+         tnf_error,
+
+         { tbinop operands can be swaped }
+         tnf_swapable,
+
+         tnf_processing,
 
          { internal flag to indicate that this node has been removed from the tree or must otherwise not be
            execute.  Running it through firstpass etc. will raise an internal error }
-         nf_do_not_execute
+         tnf_do_not_execute
        );
 
-       tnodeflags = set of tnodeflag;
+       TTransientNodeFlags = set of TTransientNodeFlag;
+
 
     const
        { contains the flags which must be equal for the equality }
        { of nodes                                                }
-       flagsequal : tnodeflags = [nf_error];
+       flagsequal : tnodeflags = [];
+       transientflagsequal : TTransientNodeFlags = [tnf_error];
 
     type
        tnodelist = class
@@ -320,6 +306,7 @@ interface
          successor : tnode;
          { there are some properties about the node stored }
          flags  : tnodeflags;
+         transientflags : TTransientNodeFlags;
          resultdef     : tdef;
          resultdefderef : tderef;
          fileinfo      : tfileposinfo;
@@ -783,7 +770,7 @@ implementation
         ppufile.getset(tppuset5(localswitches));
         verbosity:=ppufile.getlongint;
         ppufile.getderef(resultdefderef);
-        ppufile.getset(tppuset5(flags));
+        ppufile.getset(tppuset2(flags));
         { updated by firstpass }
         expectloc:=LOC_INVALID;
         { updated by secondpass }
@@ -798,7 +785,7 @@ implementation
         ppufile.putset(tppuset5(localswitches));
         ppufile.putlongint(verbosity);
         ppufile.putderef(resultdefderef);
-        ppufile.putset(tppuset5(flags));
+        ppufile.putset(tppuset2(flags));
       end;
 
 
@@ -891,7 +878,7 @@ implementation
               write(t, i);
             end;
         write(t,']');
-        if (nf_pass1_done in flags) then
+        if (tnf_pass1_done in transientflags) then
           write(t,', cmplx = ',node_complexity(self));
         if assigned(optinfo) then
           write(t,', optinfo = ',HexStr(optinfo));
@@ -919,7 +906,8 @@ implementation
       instead call XMLPrintNode to write a complete tree }
     procedure tnode.XMLPrintNodeInfo(var T: Text);
       var
-        i: TNodeFlag;
+        i_nf: TNodeFlag;
+        i_tnf: TTransientNodeFlag;
         first: Boolean;
       begin
         if Assigned(resultdef) then
@@ -928,19 +916,31 @@ implementation
         Write(T,' pos="',fileinfo.line,',',fileinfo.column);
 
         First := True;
-        for i := Low(TNodeFlag) to High(TNodeFlag) do
-          if i in flags then
-            begin
-              if First then
-                begin
-                  Write(T, '" flags="', i);
-                  First := False;
-                end
-              else
-                Write(T, ',', i)
-            end;
-        write(t,'"');
-        if (nf_pass1_done in flags) then
+        for i_nf in flags do
+          begin
+            if First then
+              begin
+                Write(T, '" flags="', i_nf);
+                First := False;
+              end
+            else
+              Write(T, ',', i_nf)
+          end;
+
+        First := True;
+        for i_tnf in transientflags do
+          begin
+            if First then
+              begin
+                Write(T, '" transientflags="', i_tnf);
+                First := False;
+              end
+            else
+              Write(T, ',', i_tnf)
+          end;
+        write(T,'"');
+
+        if (tnf_pass1_done in transientflags) then
           write(t,' complexity="',node_complexity(self),'"');
       end;
 
@@ -971,6 +971,7 @@ implementation
             (p.classtype=classtype) and
             (p.nodetype=nodetype) and
             (flags*flagsequal=p.flags*flagsequal) and
+            (transientflags*transientflagsequal=p.transientflags*transientflagsequal) and
             docompare(p));
       end;
 
@@ -1024,6 +1025,7 @@ implementation
          p.expectloc:=expectloc;
          p.location:=location;
          p.flags:=flags;
+         p.transientflags:=transientflags;
          p.resultdef:=resultdef;
          p.fileinfo:=fileinfo;
          p.localswitches:=localswitches;
@@ -1152,7 +1154,7 @@ implementation
       begin
         Result := left;
         left := nil;
-        Include(flags, nf_do_not_execute);
+        Include(transientflags, tnf_do_not_execute);
       end;
 
 
@@ -1306,7 +1308,7 @@ implementation
       begin
         Result := right;
         right := nil;
-        Include(flags, nf_do_not_execute);
+        Include(transientflags, tnf_do_not_execute);
       end;
 
 
@@ -1421,7 +1423,7 @@ implementation
       begin
         Result := third;
         third := nil;
-        Include(flags, nf_do_not_execute);
+        Include(transientflags, tnf_do_not_execute);
       end;
 
 
@@ -1439,7 +1441,7 @@ implementation
       begin
          docompare:=(inherited docompare(p)) or
            { if that's in the flags, is p then always a tbinopnode (?) (JM) }
-           ((nf_swapable in flags) and
+           ((tnf_swapable in transientflags) and
             left.isequal(tbinopnode(p).right) and
             right.isequal(tbinopnode(p).left));
       end;

compiler/nopt.pas

@@ -339,7 +339,7 @@ begin
       include(sn.flags,nf_internal);
     end;
   arrp:=carrayconstructornode.create(sn,arrp);
-  arrp.allow_array_constructor:=true;
+  Include(arrp.arrayconstructornodeflags, acnf_allow_array_constructor);
   if assigned(aktassignmentnode) and
      (aktassignmentnode.right=p) and
      (
@@ -370,7 +370,7 @@ begin
                 'fpc_'+tstringdef(p.resultdef).stringtypname+'_concat_multi',
                 para
               );
-      include(aktassignmentnode.flags,nf_assign_done_in_right);
+      include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
     end
   else
     begin
@@ -452,7 +452,7 @@ begin
     end;
   sn:=ctypeconvnode.create_internal(hp.getcopy,voidpointertype);
   arrp:=carrayconstructornode.create(sn,arrp);
-  arrp.allow_array_constructor:=true;
+  Include(arrp.arrayconstructornodeflags, acnf_allow_array_constructor);
   if assigned(aktassignmentnode) and
      (aktassignmentnode.right=p) and
      (aktassignmentnode.left.resultdef=p.resultdef) and
@@ -469,7 +469,7 @@ begin
                 'fpc_dynarray_concat_multi',
                 para
               );
-      include(aktassignmentnode.flags,nf_assign_done_in_right);
+      include(aktassignmentnode.assignmentnodeflags,anf_assign_done_in_right);
     end
   else
     begin

compiler/nutils.pas

@@ -162,7 +162,7 @@ interface
     function get_open_const_array(p : tnode) : tnode;
 
     { excludes the flags passed in nf from the node tree passed }
-    procedure node_reset_flags(p : tnode;nf : tnodeflags);
+    procedure node_reset_flags(p : tnode;nf : TNodeFlags; tnf : TTransientNodeFlags);
 
     { include or exclude cs from p.localswitches }
     procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
@@ -1565,17 +1565,28 @@ implementation
           result:=get_open_const_array(taddrnode(tderefnode(result).left).left);
       end;
 
+    type
+      TFlagSet = record
+        nf : TNodeFlags;
+        tnf : TTransientNodeFlags;
+      end;
+
 
     function do_node_reset_flags(var n: tnode; arg: pointer): foreachnoderesult;
       begin
         result:=fen_false;
-        n.flags:=n.flags-tnodeflags(arg^);
+        n.flags:=n.flags-TFlagSet(arg^).nf;
+        n.transientflags:=n.transientflags-TFlagSet(arg^).tnf;
       end;
 
 
-    procedure node_reset_flags(p : tnode; nf : tnodeflags);
+    procedure node_reset_flags(p : tnode; nf : TNodeFlags; tnf : TTransientNodeFlags);
+      var
+        FlagSet: TFlagSet;
       begin
-        foreachnodestatic(p,@do_node_reset_flags,@nf);
+        FlagSet.nf:=nf;
+        FlagSet.tnf:=tnf;
+        foreachnodestatic(p,@do_node_reset_flags,@FlagSet);
       end;
 
     type
@@ -1608,7 +1619,7 @@ implementation
 
     function doshortbooleval(p : tnode) : Boolean;
       begin
-        Result:=(p.nodetype in [orn,andn]) and ((nf_short_bool in taddnode(p).flags) or not(cs_full_boolean_eval in p.localswitches));
+        Result:=(p.nodetype in [orn,andn]) and ((anf_short_bool in taddnode(p).addnodeflags) or not(cs_full_boolean_eval in p.localswitches));
       end;
 
 
@@ -1709,7 +1720,8 @@ implementation
      function _node_reset_pass1_write(var n: tnode; arg: pointer): foreachnoderesult;
        begin
          Result := fen_false;
-         n.flags := n.flags - [nf_pass1_done,nf_write,nf_modify];
+         n.flags := n.flags - [nf_write,nf_modify];
+         n.transientflags := n.transientflags - [tnf_pass1_done];
          if n.nodetype = assignn then
            begin
              { Force re-evaluation of assignments so nf_modify and nf_write

compiler/ogbase.pas

@@ -343,12 +343,14 @@ interface
        constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:longint;Aoptions:TObjSectionOptions);virtual;
        destructor  destroy;override;
        function  write(const d;l:TObjSectionOfs):TObjSectionOfs;
+       procedure writeInt8(v: int8);
        procedure writeInt16LE(v: int16);
        procedure writeInt16BE(v: int16);
        procedure writeInt32LE(v: int32);
        procedure writeInt32BE(v: int32);
        procedure writeInt64LE(v: int64);
        procedure writeInt64BE(v: int64);
+       procedure writeUInt8(v: uint8);
        procedure writeUInt16LE(v: uint16);
        procedure writeUInt16BE(v: uint16);
        procedure writeUInt32LE(v: uint32);
@@ -456,12 +458,14 @@ interface
        procedure alloc(len:TObjSectionOfs);
        procedure allocalign(len:longint);
        procedure writebytes(const Data;len:TObjSectionOfs);
+       procedure writeInt8(v: int8);
        procedure writeInt16LE(v: int16);
        procedure writeInt16BE(v: int16);
        procedure writeInt32LE(v: int32);
        procedure writeInt32BE(v: int32);
        procedure writeInt64LE(v: int64);
        procedure writeInt64BE(v: int64);
+       procedure writeUInt8(v: uint8);
        procedure writeUInt16LE(v: uint16);
        procedure writeUInt16BE(v: uint16);
        procedure writeUInt32LE(v: uint32);
@@ -1075,6 +1079,12 @@ implementation
       end;
 
 
+    procedure TObjSection.writeInt8(v: int8);
+      begin
+        write(v,1);
+      end;
+
+
     procedure TObjSection.writeInt16LE(v: int16);
       begin
 {$ifdef FPC_BIG_ENDIAN}
@@ -1129,6 +1139,12 @@ implementation
       end;
 
 
+    procedure TObjSection.writeUInt8(v: uint8);
+      begin
+        write(v,1);
+      end;
+
+
     procedure TObjSection.writeUInt16LE(v: uint16);
       begin
 {$ifdef FPC_BIG_ENDIAN}
@@ -1709,6 +1725,12 @@ implementation
       end;
 
 
+    procedure TObjData.writeInt8(v: int8);
+      begin
+        writebytes(v,1);
+      end;
+
+
     procedure TObjData.writeInt16LE(v: int16);
       begin
 {$ifdef FPC_BIG_ENDIAN}
@@ -1763,6 +1785,12 @@ implementation
       end;
 
 
+    procedure TObjData.writeUInt8(v: uint8);
+      begin
+        writebytes(v,1);
+      end;
+
+
     procedure TObjData.writeUInt16LE(v: uint16);
       begin
 {$ifdef FPC_BIG_ENDIAN}

compiler/ogelf.pas

@@ -623,8 +623,20 @@ implementation
 
 
     procedure TElfObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType);
+      type 
+        multi = record
+          case integer of
+          0 : (ba : array[0..sizeof(aint)-1] of byte);
+          1 : (b : byte);
+          2 : (w : word);
+          4 : (d : dword);
+          8 : (q : qword);
+        end;
+
       var
         symaddr : aint;
+        ba : multi;
+        b : byte;
         objreloc: TObjRelocation;
       begin
         if CurrObjSec=nil then
@@ -683,7 +695,31 @@ implementation
                 data:=0;
               end;
           end;
-        CurrObjSec.write(data,len);
+        if target_info.endian<>source_info.endian then
+          begin
+            ba.q:=0;
+            if (len<=sizeof(data)) then
+              case len of
+                1 : ba.b:=byte(data);
+                2 : begin
+                      ba.w:=word(data);
+                      ba.w:=swapendian(ba.w);
+                    end;
+                4 : begin
+                      ba.d:=dword(data);
+                      ba.d:=swapendian(ba.d);
+                    end;
+                8 : begin
+                      ba.q:=qword(data);
+                      ba.q:=swapendian(ba.q);
+                    end;
+              else
+                internalerror(2024012501);
+              end;
+            CurrObjSec.write(ba,len);
+          end
+        else
+          CurrObjSec.write(data,len);
       end;
 
 

compiler/optbase.pas

@@ -35,7 +35,7 @@ unit optbase;
       PDFASet = ^TDFASet;
 
       toptinfo = record
-        { index of the current node inside the dfa sets, aword(-1) if no entry }
+        { index of the current node inside the dfa sets }
         index : aword;
         { dfa }
         def : tdfaset;

compiler/optconstprop.pas

@@ -288,7 +288,7 @@ unit optconstprop;
         if n.nodetype<>callparan then
           begin
             if tree_modified then
-              exclude(n.flags,nf_pass1_done);
+              exclude(n.transientflags,tnf_pass1_done);
 
             do_firstpass(n);
           end;

compiler/optcse.pas

@@ -76,7 +76,8 @@ unit optcse;
                with more than one parameter }
              in_fma_single,in_fma_double,in_fma_extended,in_fma_float128,
              in_min_single,in_min_double,in_max_single,in_max_double,
-             in_max_longint,in_max_dword,in_min_longint,in_min_dword
+             in_max_longint,in_max_dword,in_min_longint,in_min_dword,
+             in_max_int64,in_max_qword,in_min_int64,in_min_qword
              ])
           ) or
           ((n.nodetype=callparan) and not(assigned(tcallparanode(n).right))) or
@@ -380,8 +381,14 @@ unit optcse;
                                 begin
                                   n.localswitches:=n.localswitches+(tbinarynode(n).left.localswitches*[cs_full_boolean_eval]);
                                   exclude(tbinarynode(n).left.localswitches,cs_full_boolean_eval);
-                                  tbinarynode(n).left.flags:=tbinarynode(n).left.flags+(n.flags*[nf_short_bool]);
-                                  exclude(n.Flags,nf_short_bool);
+                                  if (n.nodetype in [orn,andn]) then
+                                    begin
+                                      if (tbinarynode(n).left.nodetype in [orn,andn]) then
+                                        taddnode(tbinarynode(n).left).addnodeflags:=taddnode(tbinarynode(n).left).addnodeflags+
+                                          (taddnode(n).addnodeflags*[anf_short_bool]);
+
+                                      exclude(taddnode(n).addnodeflags,anf_short_bool);
+                                    end;
                                 end;
 
                               hp2:=tbinarynode(tbinarynode(n).left).left;
@@ -392,7 +399,7 @@ unit optcse;
 
                               { the transformed tree could result in new possibilities to fold constants
                                 so force a firstpass on the root node }
-                              exclude(tbinarynode(n).right.flags,nf_pass1_done);
+                              exclude(tbinarynode(n).right.transientflags,tnf_pass1_done);
                               do_firstpass(tbinarynode(n).right);
                             end
                           else

compiler/optdeadstore.pas

@@ -59,7 +59,6 @@ unit optdeadstore;
 
                 { we need to have dfa for the node }
                 if assigned(a.left.optinfo) and
-                   (a.left.optinfo^.index<>aword(-1)) and
                    { node must be either a local or parameter load node }
                    (a.left.nodetype=loadn) and
                    { its address cannot have escaped the current routine }

compiler/optdfa.pas

@@ -148,7 +148,7 @@ unit optdfa;
 
     function ResetProcessing(var n: tnode; arg: pointer): foreachnoderesult;
       begin
-        exclude(n.flags,nf_processing);
+        exclude(n.transientflags,tnf_processing);
         { dfa works only on normalized trees, so do not recurse into expressions, because
           ResetProcessing eats a signififcant amount of time of CheckAndWarn
 
@@ -188,12 +188,11 @@ unit optdfa;
           life info for the node
         }
         procedure updatelifeinfo(n : tnode;const l : TDFASet);
-          var
-            b : boolean;
           begin
-            b:=DFASetNotEqual(l,n.optinfo^.life);
+            if not DFASetNotEqual(l,n.optinfo^.life) then
+              exit;
 {$ifdef DEBUG_DFA}
-            if not(changed) and b then
+            if not(changed) then
               begin
                 writeln('Another DFA pass caused by: ',nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,')');
                 write('  Life info set was:     ');PrintDFASet(Output,n.optinfo^.life);writeln;
@@ -201,7 +200,7 @@ unit optdfa;
               end;
 {$endif DEBUG_DFA}
 
-            changed:=changed or b;
+            changed:=true;
             n.optinfo^.life:=l;
           end;
 
@@ -238,9 +237,9 @@ unit optdfa;
           { ensure we've already optinfo set }
           node.allocoptinfo;
 
-          if nf_processing in node.flags then
+          if tnf_processing in node.transientflags then
             exit;
-          include(node.flags,nf_processing);
+          include(node.transientflags,tnf_processing);
 
           if assigned(node.successor) then
             CreateInfo(node.successor);
@@ -610,7 +609,7 @@ unit optdfa;
           CreateInfo(node);
           foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil);
           { the result node is not reached by foreachnodestatic }
-          exclude(resultnode.flags,nf_processing);
+          exclude(resultnode.transientflags,tnf_processing);
 {$ifdef DEBUG_DFA}
           PrintIndexedNodeSet(output,map);
           PrintDFAInfo(output,node);
@@ -896,9 +895,9 @@ unit optdfa;
           if node=nil then
             exit;
 
-          if nf_processing in node.flags then
+          if tnf_processing in node.transientflags then
             exit;
-          include(node.flags,nf_processing);
+          include(node.transientflags,tnf_processing);
 
           if not(assigned(node.optinfo)) or not(DFASetIn(node.optinfo^.life,nodetosearch.optinfo^.index)) then
             exit;

compiler/options.pas

@@ -4758,9 +4758,9 @@ procedure read_arguments(cmd:TCmdStr);
       {$endif i8086 or avr}
       { abs(long) is handled internally on all CPUs }
         def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
-      {$if defined(i8086) or defined(i386) or defined(x86_64) or defined(powerpc64) or defined(aarch64)}
+      {$if defined(i8086) or defined(i386) or defined(x86_64) or defined(powerpc64) or defined(aarch64) or defined(arm)}
         def_system_macro('FPC_HAS_INTERNAL_ABS_INT64');
-      {$endif i8086 or i386 or x86_64 or powerpc64 or aarch64}
+      {$endif i8086 or i386 or x86_64 or powerpc64 or aarch64 or arm}
 
         def_system_macro('FPC_HAS_UNICODESTRING');
         def_system_macro('FPC_RTTI_PACKSET1');

compiler/optloop.pas

@@ -675,7 +675,7 @@ unit optloop;
                   cordconstnode.create(1,tfornode(n).left.resultdef,false));
                 tfornode(n).t1:=cordconstnode.create(1,tfornode(n).left.resultdef,false);
                 include(tfornode(n).loopflags,lnf_counter_not_used);
-                exclude(n.flags,nf_pass1_done);
+                exclude(n.transientflags,tnf_pass1_done);
                 do_firstpass(n);
 {$ifdef DEBUG_OPTFORLOOP}
                 writeln('Loop reverted: ');

compiler/optvirt.pas

@@ -590,7 +590,7 @@ unit optvirt;
         objparentsymtab:=objdef.symtable;
         mainsymtab:=objparentsymtab.defowner.owner;
         classprefix:='';
-        while mainsymtab.symtabletype in [recordsymtable,objectsymtable] do
+        while mainsymtab.symtabletype in [recordsymtable,objectsymtable,localsymtable] do
           begin
             classprefix:=mainsymtab.name^+'.'+classprefix;
             mainsymtab:=mainsymtab.defowner.owner;

compiler/parser.pas

@@ -25,10 +25,14 @@ unit parser;
 
 interface
 
+uses fmodule;
+
 {$ifdef PREPROCWRITE}
     procedure preprocess(const filename:string);
 {$endif PREPROCWRITE}
-    procedure compile(const filename:string);
+    function compile(const filename:string) : boolean;
+    function compile_module(module : tmodule) : boolean;
+    procedure parsing_done(module : tmodule);
     procedure initparser;
     procedure doneparser;
 
@@ -43,7 +47,7 @@ implementation
       cclasses,
       globtype,tokens,systems,globals,verbose,switches,globstat,
       symbase,symtable,symdef,
-      finput,fmodule,fppu,
+      finput,fppu,
       aasmdata,
       cscript,gendef,
       comphook,
@@ -51,12 +55,76 @@ implementation
       pbase,psystem,pmodules,psub,ncgrtti,
       cpuinfo,procinfo;
 
+    procedure parsing_done(module: tmodule);
+
+    var
+       hp,hp2 :  tmodule;
+
+    begin
+
+       module.end_of_parsing;
+
+       if (module.is_initial) and
+          (status.errorcount=0) then
+         { Write Browser Collections }
+         do_extractsymbolinfo;
+
+       // olddata.restore(false);
+
+       { Restore all locally modified warning messages }
+       RestoreLocalVerbosity(current_settings.pmessage);
+       current_exceptblock:=0;
+       exceptblockcounter:=0;
+
+       { Shut down things when the last file is compiled succesfull }
+       if (module.is_initial) and (module.state=ms_compiled) and
+           (status.errorcount=0) then
+         begin
+           parser_current_file:='';
+           { Close script }
+           if (not AsmRes.Empty) then
+           begin
+             Message1(exec_i_closing_script,AsmRes.Fn);
+             AsmRes.WriteToDisk;
+           end;
+         end;
+
+     { free now what we did not free earlier in
+       proc_program PM }
+     if (module.is_initial) and (module.state=ms_compiled) and needsymbolinfo then
+       begin
+         hp:=tmodule(loaded_units.first);
+         while assigned(hp) do
+          begin
+            hp2:=tmodule(hp.next);
+            if (hp<>module) then
+              begin
+                loaded_units.remove(hp);
+                hp.free;
+              end;
+            hp:=hp2;
+          end;
+         { free also unneeded units we didn't free before }
+         unloaded_units.Clear;
+        end;
+
+      { If used units are compiled current_module is already the same as
+        the stored module. Now if the unit is not finished its scanner is
+        not yet freed and thus set_current_module would reopen the scanned
+        file which will result in pointing to the wrong position in the
+        file. In the normal case current_scanner and current_module.scanner
+        would be Nil, thus nothing bad would happen }
+{           if olddata.old_current_module<>current_module then
+        set_current_module(olddata.old_current_module);}
+
+      FreeLocalVerbosity(current_settings.pmessage);
+
+    end;
 
     procedure initparser;
       begin
          { Current compiled module/proc }
          set_current_module(nil);
-         current_module:=nil;
          current_asmdata:=nil;
          current_procinfo:=nil;
          current_structdef:=nil;
@@ -83,7 +151,7 @@ implementation
          pattern:='';
          orgpattern:='';
          cstringpattern:='';
-         current_scanner:=nil;
+         set_current_scanner(nil);
          switchesstatestackpos:=0;
 
          { register all nodes and tais }
@@ -188,7 +256,6 @@ implementation
          { Reset current compiling info, so destroy routines can't
            reference the data that might already be destroyed }
          set_current_module(nil);
-         current_module:=nil;
          current_procinfo:=nil;
          current_asmdata:=nil;
          current_structdef:=nil;
@@ -217,7 +284,8 @@ implementation
          if assigned(current_scanner) then
           begin
             current_scanner.free;
-            current_scanner:=nil;
+            set_current_scanner(nil);
+
           end;
 
          { close scanner }
@@ -319,26 +387,38 @@ implementation
                              Compile a source file
 *****************************************************************************}
 
-    procedure compile(const filename:string);
+    function compile(const filename:string) : boolean;
+
+    var
+      m : TModule;
+
+    begin
+      m:=tppumodule.create(nil,'',filename,false);
+      m.state:=ms_compile;
+      result:=compile_module(m);
+    end;
+
+    function compile_module(module : tmodule) : boolean;
+
       var
-         olddata : pglobalstate;
          hp,hp2 : tmodule;
          finished : boolean;
+         sc : tscannerfile;
+
        begin
+         Result:=True;
          { parsing a procedure or declaration should be finished }
          if assigned(current_procinfo) then
            internalerror(200811121);
          if assigned(current_structdef) then
            internalerror(200811122);
-         inc(compile_level);
-         parser_current_file:=filename;
+         inc(module.compilecount);
+         parser_current_file:=module.mainsource;
          { Uses heap memory instead of placing everything on the
            stack. This is needed because compile() can be called
            recursively }
-         new(olddata);
          { handle the postponed case first }
          flushpendingswitchesstate;
-         save_global_state(olddata^,false);
 
        { reset parser, a previous fatal error could have left these variables in an unreliable state, this is
          important for the IDE }
@@ -350,7 +430,7 @@ implementation
          getfuncrefdef:=nil;
 
        { show info }
-         Message1(parser_i_compiling,filename);
+         Message1(parser_i_compiling,module.mainsource);
 
        { reset symtable }
          symtablestack:=tdefawaresymtablestack.create;
@@ -365,33 +445,24 @@ implementation
          { Load current state from the init values }
          current_settings:=init_settings;
 
-       { reset the unit or create a new program }
-         { a unit compiled at command line must be inside the loaded_unit list }
-         if (compile_level=1) then
-           begin
-             if assigned(current_module) then
-               internalerror(200501158);
-             set_current_module(tppumodule.create(nil,'',filename,false));
-             addloadedunit(current_module);
-             main_module:=current_module;
-             current_module.state:=ms_compile;
-           end;
-         if not(assigned(current_module) and
-                (current_module.state in [ms_compile,ms_second_compile])) then
+         set_current_module(module);
+         if not (module.state in [ms_compile]) then
            internalerror(200212281);
 
          { load current asmdata from current_module }
-         current_asmdata:=TAsmData(current_module.asmdata);
+         current_asmdata:=TAsmData(module.asmdata);
 
          { startup scanner and load the first file }
-         current_scanner:=tscannerfile.Create(filename);
-         current_scanner.firstfile;
-         current_module.scanner:=current_scanner;
+         sc:=tscannerfile.Create(module.mainsource);
+         sc.firstfile;
+         module.scanner:=sc;
+         module.mainscanner:=sc;
+         set_current_scanner(sc);
 
          { init macros before anything in the file is parsed.}
-         current_module.localmacrosymtable:= tmacrosymtable.create(false);
+         module.localmacrosymtable:= tmacrosymtable.create(false);
          macrosymtablestack.push(initialmacrosymtable);
-         macrosymtablestack.push(current_module.localmacrosymtable);
+         macrosymtablestack.push(module.localmacrosymtable);
 
          { read the first token }
          current_scanner.readtoken(false);
@@ -403,18 +474,18 @@ implementation
            message if we are trying to use a program as unit.}
          try
            try
-             if (token=_UNIT) or (compile_level>1) then
+             if (token=_UNIT) or (not module.is_initial) then
                begin
-                 current_module.is_unit:=true;
-                 finished:=proc_unit;
+                 module.is_unit:=true;
+                 finished:=proc_unit(module);
                end
              else if (token=_ID) and (idtoken=_PACKAGE) then
                begin
-                 current_module.IsPackage:=true;
-                 proc_package;
+                 module.IsPackage:=true;
+                 finished:=proc_package(module);
                end
              else
-               proc_program(token=_LIBRARY);
+               finished:=proc_program(module,token=_LIBRARY);
            except
              on ECompilerAbort do
                raise;
@@ -431,83 +502,14 @@ implementation
                  raise;
                end;
            end;
-
+           Result:=Finished;
            { the program or the unit at the command line should not need to wait
              for other units }
-           if (compile_level=1) and not finished then
-             internalerror(2012091901);
+           // if (module.is_initial) and not finished then
+           //  internalerror(2012091901);
          finally
-           if assigned(current_module) then
-             begin
-               if finished then
-                 current_module.end_of_parsing
-               else
-                 begin
-                   { these are saved in the unit's state and thus can be set to
-                     Nil again as would be done by tmodule.end_of_parsing }
-                   macrosymtablestack:=nil;
-                   symtablestack:=nil;
-                   if current_scanner=current_module.scanner then
-                     current_scanner:=nil;
-                 end;
-             end;
-
-            if (compile_level=1) and
-               (status.errorcount=0) then
-              { Write Browser Collections }
-              do_extractsymbolinfo;
-
-            restore_global_state(olddata^,false);
-
-            { Restore all locally modified warning messages }
-            RestoreLocalVerbosity(current_settings.pmessage);
-            current_exceptblock:=0;
-            exceptblockcounter:=0;
-
-            { Shut down things when the last file is compiled succesfull }
-            if (compile_level=1) and
-                (status.errorcount=0) then
-              begin
-                parser_current_file:='';
-                { Close script }
-                if (not AsmRes.Empty) then
-                begin
-                  Message1(exec_i_closing_script,AsmRes.Fn);
-                  AsmRes.WriteToDisk;
-                end;
-              end;
-
-          { free now what we did not free earlier in
-            proc_program PM }
-          if (compile_level=1) and needsymbolinfo then
-            begin
-              hp:=tmodule(loaded_units.first);
-              while assigned(hp) do
-               begin
-                 hp2:=tmodule(hp.next);
-                 if (hp<>current_module) then
-                   begin
-                     loaded_units.remove(hp);
-                     hp.free;
-                   end;
-                 hp:=hp2;
-               end;
-              { free also unneeded units we didn't free before }
-              unloaded_units.Clear;
-             end;
-           dec(compile_level);
-           { If used units are compiled current_module is already the same as
-             the stored module. Now if the unit is not finished its scanner is
-             not yet freed and thus set_current_module would reopen the scanned
-             file which will result in pointing to the wrong position in the
-             file. In the normal case current_scanner and current_module.scanner
-             would be Nil, thus nothing bad would happen }
-           if olddata^.old_current_module<>current_module then
-             set_current_module(olddata^.old_current_module);
-
-           FreeLocalVerbosity(current_settings.pmessage);
-
-           dispose(olddata);
+            if finished then
+              parsing_done(module);
          end;
     end;
 

compiler/pass_1.pas

@@ -87,7 +87,7 @@ implementation
               assigned(hp.resultdef);
         if codegenerror then
           begin
-            include(p.flags,nf_error);
+            include(p.transientflags,tnf_error);
             { default to errortype if no type is set yet }
             if p.resultdef=nil then
               p.resultdef:=generrordef;
@@ -117,7 +117,7 @@ implementation
         else
           begin
             { update the codegenerror boolean with the previous result of this node }
-            if (nf_error in p.flags) then
+            if (tnf_error in p.transientflags) then
               codegenerror:=true;
           end;
       end;
@@ -156,10 +156,10 @@ implementation
          hp : tnode;
          nodechanged : boolean;
       begin
-         if (nf_pass1_done in p.flags) then
+         if (tnf_pass1_done in p.transientflags) then
            exit;
 
-         if not(nf_error in p.flags) then
+         if not(tnf_error in p.transientflags) then
            begin
              oldcodegenerror:=codegenerror;
              oldpos:=current_filepos;
@@ -168,8 +168,8 @@ implementation
              codegenerror:=false;
              repeat
                { The error flag takes precedence over the 'do not execute' flag,
-                 as its assumed the node tree isn't tenable beyond this point }
-               if (nf_do_not_execute in p.flags) then
+                 as it's assumed the node tree isn't tenable beyond this point }
+               if (tnf_do_not_execute in p.transientflags) then
                  InternalError(2022112401);
 
                { checks make always a call }
@@ -182,7 +182,7 @@ implementation
                  end;
 
                hp:=nil;
-               if not(nf_error in p.flags) then
+               if not(tnf_error in p.transientflags) then
                  begin
                    current_filepos:=p.fileinfo;
                    current_settings.localswitches:=p.localswitches;
@@ -196,19 +196,18 @@ implementation
                    { should the node be replaced? }
                    if assigned(hp) then
                      begin
-                       hp.flags := hp.flags + (p.flags * [nf_usercode_entry]);
                        p.free;
                        { switch to new node }
                        p:=hp;
                      end;
                    if codegenerror then
-                     include(p.flags,nf_error);
+                     include(p.transientflags,tnf_error);
                  end;
              until not assigned(hp) or
-                   (nf_pass1_done in hp.flags);
-             include(p.flags,nf_pass1_done);
+                   (tnf_pass1_done in hp.transientflags);
+             include(p.transientflags,tnf_pass1_done);
 {$ifdef EXTDEBUG}
-             if not(nf_error in p.flags) then
+             if not(tnf_error in p.transientflags) then
                begin
                  if (p.expectloc=LOC_INVALID) then
                    Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]);

compiler/pass_2.pas

@@ -187,11 +187,11 @@ implementation
       begin
          if not assigned(p) then
           internalerror(200208221);
-         if not(nf_error in p.flags) then
+         if not(tnf_error in p.transientflags) then
           begin
             { The error flag takes precedence over the 'do not execute' flag,
-              as its assumed the node tree isn't tenable beyond this point }
-            if (nf_do_not_execute in p.flags) then
+              as it's assumed the node tree isn't tenable beyond this point }
+            if (tnf_do_not_execute in p.transientflags) then
               InternalError(2022112402);
 
             oldcodegenerror:=codegenerror;
@@ -237,7 +237,7 @@ implementation
              end;
 {$endif EXTDEBUG}
             if codegenerror then
-              include(p.flags,nf_error);
+              include(p.transientflags,tnf_error);
             codegenerror:=codegenerror or oldcodegenerror;
             current_settings.localswitches:=oldlocalswitches;
             current_filepos:=oldpos;
@@ -256,7 +256,7 @@ implementation
 
          { clear errors before starting }
          codegenerror:=false;
-         if not(nf_error in p.flags) then
+         if not(tnf_error in p.transientflags) then
            secondpass(p);
          do_secondpass:=codegenerror;
       end;

compiler/pbase.pas

@@ -76,6 +76,10 @@ interface
     { a syntax error is written                           }
     procedure consume(i : ttoken);
 
+    { Same as consume, but will not attempt to read next token if the token is a point }
+
+    procedure consume_last_dot;
+
     {Tries to consume the token i, and returns true if it was consumed:
      if token=i.}
     function try_to_consume(i:Ttoken):boolean;
@@ -144,8 +148,10 @@ implementation
 
 
     { consumes token i, write error if token is different }
+
     procedure consume(i : ttoken);
-      begin
+
+    begin
         if (token<>i) and (idtoken<>i) then
           if token=_id then
             Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
@@ -159,6 +165,19 @@ implementation
           end;
       end;
 
+    procedure consume_last_dot;
+
+    begin
+        if (token<>_POINT) then
+          begin
+          if token=_id then
+            Message2(scan_f_syn_expected,tokeninfo^[_POINT].str,'identifier '+pattern)
+          else
+            Message2(scan_f_syn_expected,tokeninfo^[_POINT].str,tokeninfo^[token].str)
+          end
+        else if c<>#0 then
+          current_scanner.readtoken(true);
+    end;
 
     function try_to_consume(i:Ttoken):boolean;
       begin

compiler/pdecl.pas

@@ -781,7 +781,6 @@ implementation
                genorgtypename:=orgtypename;
              end;
 
-
            consume(_EQ);
 
            { support 'ttype=type word' syntax }
@@ -1362,7 +1361,7 @@ implementation
                                  changestringtype(cunicodestringtype);
                                initwidestring(pw);
                                copywidestring(pcompilerwidestring(value_str),pw);
-                               sym:=cconstsym.create_wstring(orgname,constresourcestring,pw);
+                               sym:=cconstsym.create_wstring(orgname,constwresourcestring,pw);
                                end;
                           end;
                       else

compiler/pdecobj.pas

@@ -589,7 +589,7 @@ implementation
                        end
                      else
                        if oo_is_sealed in childof.objectoptions then
-                         Message1(parser_e_sealed_descendant,childof.typename)
+                         Message1(parser_e_sealed_descendant,childof.typesymbolprettyname)
                        else
                          childof:=find_real_class_definition(childof,true);
                    odt_interfacecorba,
@@ -774,6 +774,9 @@ implementation
           Internalerror(2011021103);
 
         consume(_FOR);
+        { set extendeddef to non-Nil so that potential checks for it won't trigger
+          access violations }
+        current_objectdef.extendeddef:=generrordef;
         single_type(hdef,[stoParseClassParent]);
         if not assigned(hdef) or (hdef.typ=errordef) then
           begin
@@ -837,9 +840,7 @@ implementation
           end;
 
         if assigned(hdef) then
-          current_objectdef.extendeddef:=hdef
-        else
-          current_objectdef.extendeddef:=generrordef;
+          current_objectdef.extendeddef:=hdef;
       end;
 
     procedure parse_guid;
@@ -1083,7 +1084,8 @@ implementation
         vdoptions: tvar_dec_options;
         fieldlist: tfpobjectlist;
         rtti_attrs_def: trtti_attribute_list;
-
+        attr_element_count,fldCount : Integer;
+        method_def : tprocdef;
 
       procedure parse_const;
         begin
@@ -1241,7 +1243,6 @@ implementation
               end;
             _ID :
               begin
-                check_unbound_attributes;
                 if is_objcprotocol(current_structdef) and
                    ((idtoken=_REQUIRED) or
                     (idtoken=_OPTIONAL)) then
@@ -1322,7 +1323,6 @@ implementation
                       begin
                         if object_member_blocktype=bt_general then
                           begin
-                            rtti_attrs_def := nil;
                             if (idtoken=_GENERIC) and
                                 not (m_delphi in current_settings.modeswitches) and
                                 (
@@ -1366,13 +1366,47 @@ implementation
                                   include(vdoptions,vd_final);
                                 if threadvar_fields then
                                   include(vdoptions,vd_threadvar);
-                                read_record_fields(vdoptions,fieldlist,nil,hadgeneric);
+                                // Record count
+                                fldCount:=FieldList.Count;
+                                read_record_fields(vdoptions,fieldlist,nil,hadgeneric,attr_element_count);
+                                {
+                                  attr_element_count returns the number of fields to which the attribute must be applied.
+                                  For
+                                  [someattr]
+                                  a : integer;
+                                  b : integer;
+                                  attr_element_count returns 1. For
+                                  [someattr]
+                                  a, b : integer;
+                                  it returns 2.
+                                  Basically the number of variables before the first colon.
+                                }
+                                if assigned(rtti_attrs_def) then
+                                  begin
+                                  { read_record_fields can read a list of fields with the same type.
+                                    for the first fields, we simply copy. for the last one we bind.}
+                                  While (attr_element_count>1) do
+                                    begin
+                                    trtti_attribute_list.copyandbind(rtti_attrs_def,tfieldvarsym(fieldlist[FldCount]).rtti_attribute_list);
+                                    inc(fldcount);
+                                    dec(attr_element_count);
+                                    end;
+                                  if fldCount<FieldList.Count then
+                                    trtti_attribute_list.bind(rtti_attrs_def,tfieldvarsym(fieldlist[FldCount]).rtti_attribute_list)
+                                  else
+                                    rtti_attrs_def.free;
+                                  end;
+                                rtti_attrs_def:=nil;
                               end;
                           end
                         else if object_member_blocktype=bt_type then
+                          begin
+                          check_unbound_attributes;
                           types_dec(true,hadgeneric, rtti_attrs_def)
+                          end
                         else if object_member_blocktype=bt_const then
                           begin
+                            check_unbound_attributes;
                             typedconstswritable:=false;
                             if final_fields then
                               begin
@@ -1393,9 +1427,6 @@ implementation
               end;
             _PROPERTY :
               begin
-                { for now attributes are only allowed on published properties }
-                if current_structdef.symtable.currentvisibility<>vis_published then
-                  check_unbound_attributes;
                 struct_property_dec(is_classdef, rtti_attrs_def);
                 fields_allowed:=false;
                 is_classdef:=false;
@@ -1412,9 +1443,12 @@ implementation
             _CONSTRUCTOR,
             _DESTRUCTOR :
               begin
-                check_unbound_attributes;
-                rtti_attrs_def := nil;
-                method_dec(current_structdef,is_classdef,hadgeneric);
+                method_def:=method_dec(current_structdef,is_classdef,hadgeneric);
+                if assigned(rtti_attrs_def) then
+                  begin
+                  trtti_attribute_list.bind(rtti_attrs_def,method_def.rtti_attribute_list);
+                  rtti_attrs_def:=nil;
+                  end;
                 fields_allowed:=false;
                 is_classdef:=false;
                 hadgeneric:=false;
@@ -1672,6 +1706,14 @@ implementation
             { apply $RTTI directive to current object }
             current_structdef.apply_rtti_directive(current_module.rtti_directive);
 
+            { generate TObject VMT space }
+            { We must insert the VMT at the start for system.tobject, and class_tobject was already set.
+              The cs_compilesystem is superfluous, but we add it for safety.
+
+            }
+            if (current_objectdef=class_tobject) and (cs_compilesystem in current_settings.moduleswitches) then
+              current_objectdef.insertvmt;
+
             { parse and insert object members }
             parse_object_members;
 
@@ -1705,15 +1747,18 @@ implementation
           end;
 
         { generate vmt space if needed }
+        {
+           Here we only do it for non-classes, all classes have it since they depend on TObject
+           so their vmt is already created when TObject was parsed.
+        }
         if not(oo_has_vmt in current_structdef.objectoptions) and
+           not(current_objectdef.objecttype in [odt_class]) and
            not(oo_is_forward in current_structdef.objectoptions) and
            not(parse_generic) and
            { no vmt for helpers ever }
            not is_objectpascal_helper(current_structdef) and
-           (
-            ([oo_has_virtual,oo_has_constructor,oo_has_destructor]*current_structdef.objectoptions<>[]) or
-            (current_objectdef.objecttype in [odt_class])
-           ) then
+            ([oo_has_virtual,oo_has_constructor,oo_has_destructor]*current_structdef.objectoptions<>[])
+           then
           current_objectdef.insertvmt;
 
         { for implemented classes with a vmt check if there is a constructor }

compiler/pdecvar.pas

@@ -38,7 +38,7 @@ interface
 
     procedure read_var_decls(options:Tvar_dec_options;out had_generic:boolean);
 
-    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc: ppvariantrecdesc;out had_generic:boolean);
+    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc: ppvariantrecdesc;out had_generic:boolean; out attr_element_count : integer);
 
     procedure read_public_and_external(vs: tabstractvarsym);
 
@@ -1679,7 +1679,7 @@ implementation
       end;
 
 
-    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc : ppvariantrecdesc;out had_generic:boolean);
+    procedure read_record_fields(options:Tvar_dec_options; reorderlist: TFPObjectList; variantdesc : ppvariantrecdesc;out had_generic:boolean; out attr_element_count : integer);
       var
          sc : TFPObjectList;
          i  : longint;
@@ -1707,6 +1707,7 @@ implementation
          hadgendummy,
          semicoloneaten,
          removeclassoption: boolean;
+         dummyattrelementcount : integer;
 {$if defined(powerpc) or defined(powerpc64)}
          tempdef: tdef;
          is_first_type: boolean;
@@ -1727,6 +1728,7 @@ implementation
          sc:=TFPObjectList.create(false);
          removeclassoption:=false;
          had_generic:=false;
+         attr_element_count:=0;
          while (token=_ID) and
             not(((vd_object in options) or
                  ((vd_record in options) and (m_advanced_records in current_settings.modeswitches))) and
@@ -1775,6 +1777,9 @@ implementation
              if had_generic and (sc.count=0) then
                break;
              consume(_COLON);
+             if attr_element_count=0 then
+               attr_element_count:=sc.Count;
+
              typepos:=current_filepos;
 
              read_anon_type(hdef,false);
@@ -2056,7 +2061,7 @@ implementation
                 consume(_LKLAMMER);
                 inc(variantrecordlevel);
                 if token<>_RKLAMMER then
-                  read_record_fields([vd_record],nil,@variantdesc^^.branches[high(variantdesc^^.branches)].nestedvariant,hadgendummy);
+                  read_record_fields([vd_record],nil,@variantdesc^^.branches[high(variantdesc^^.branches)].nestedvariant,hadgendummy,dummyattrelementcount);
                 dec(variantrecordlevel);
                 consume(_RKLAMMER);
 

compiler/pexpr.pas

@@ -2349,8 +2349,8 @@ implementation
                                     { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
                                     p2:=crangenode.create(p2,caddnode.create(addn,comp_expr([ef_accept_equal]),p3.getcopy));
                                   p1:=cvecnode.create(p1,p2);
-                                  include(tvecnode(p1).flags,nf_memseg);
-                                  include(tvecnode(p1).flags,nf_memindex);
+                                  include(tvecnode(p1).vecnodeflags,vnf_memseg);
+                                  include(tvecnode(p1).vecnodeflags,vnf_memindex);
                                 end
                                else
                                 begin
@@ -2358,7 +2358,7 @@ implementation
                                     { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
                                     p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
                                   p1:=cvecnode.create(p1,p2);
-                                  include(tvecnode(p1).flags,nf_memindex);
+                                  include(tvecnode(p1).vecnodeflags,vnf_memindex);
                                 end;
 {$else}
                                internalerror(2013053105);
@@ -3121,7 +3121,7 @@ implementation
 
           constsym :
             begin
-              if tconstsym(srsym).consttyp=constresourcestring then
+              if tconstsym(srsym).consttyp in [constresourcestring,constwresourcestring]then
                 begin
                   result:=cloadnode.create(srsym,srsymtable);
                   do_typecheckpass(result);
@@ -3639,7 +3639,8 @@ implementation
                end;
            { there could be more elements }
            until not try_to_consume(_COMMA);
-           buildp.allow_array_constructor:=block_type in [bt_body,bt_except];
+           if block_type in [bt_body,bt_except] then
+             Include(buildp.arrayconstructornodeflags, acnf_allow_array_constructor);
            factor_read_set:=buildp;
          end;
 
@@ -4829,14 +4830,14 @@ implementation
                  begin
                    p1:=caddnode.create(orn,p1,p2);
                    if (oldt = _PIPE) then
-                     include(p1.flags,nf_short_bool);
+                     include(taddnode(p1).addnodeflags,anf_short_bool);
                  end;
                _OP_AND,
                _AMPERSAND {macpas only} :
                  begin
                    p1:=caddnode.create(andn,p1,p2);
                    if (oldt = _AMPERSAND) then
-                     include(p1.flags,nf_short_bool);
+                     include(taddnode(p1).addnodeflags,anf_short_bool);
                  end;
                _OP_DIV :
                  p1:=cmoddivnode.create(divn,p1,p2);
@@ -4846,7 +4847,7 @@ implementation
                  begin
                    p1:=cmoddivnode.create(modn,p1,p2);
                    if m_isolike_mod in current_settings.modeswitches then
-                     include(p1.flags,nf_isomod);
+                     include(tmoddivnode(p1).moddivnodeflags,mdnf_isomod);
                  end;
                _OP_SHL :
                  p1:=cshlshrnode.create(shln,p1,p2);
@@ -4952,24 +4953,32 @@ implementation
              end;
            _PLUSASN :
              begin
+               if not(cs_support_c_operators in current_settings.moduleswitches) then
+                 Message(parser_e_coperators_off);
                consume(_PLUSASN);
                p2:=sub_expr(opcompare,[ef_accept_equal],nil);
                p1:=gen_c_style_operator(addn,p1,p2);
             end;
           _MINUSASN :
             begin
+               if not(cs_support_c_operators in current_settings.moduleswitches) then
+                 Message(parser_e_coperators_off);
                consume(_MINUSASN);
                p2:=sub_expr(opcompare,[ef_accept_equal],nil);
                p1:=gen_c_style_operator(subn,p1,p2);
             end;
           _STARASN :
             begin
+               if not(cs_support_c_operators in current_settings.moduleswitches) then
+                 Message(parser_e_coperators_off);
                consume(_STARASN  );
                p2:=sub_expr(opcompare,[ef_accept_equal],nil);
                p1:=gen_c_style_operator(muln,p1,p2);
             end;
           _SLASHASN :
             begin
+               if not(cs_support_c_operators in current_settings.moduleswitches) then
+                 Message(parser_e_coperators_off);
                consume(_SLASHASN  );
                p2:=sub_expr(opcompare,[ef_accept_equal],nil);
                p1:=gen_c_style_operator(slashn,p1,p2);

compiler/pgenutil.pas

@@ -269,7 +269,7 @@ uses
         if hmodule=current_module then
           exit;
 
-        if hmodule.state<>ms_compiled then
+        if not (hmodule.state in [ms_compiled,ms_processed]) then
           begin
 {$ifdef DEBUG_UNITWAITING}
             Writeln('Unit ', current_module.modulename^,
@@ -2001,12 +2001,18 @@ uses
                     else
                       begin
                         hadtypetoken:=false;
+
+                        { ensure a pretty name for error messages, might be chanced below }
+                        if _prettyname<>'' then
+                          ttypesym(srsym).fprettyname:=_prettyname
+                        else
+                          ttypesym(srsym).fprettyname:=prettyname;
+
                         read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
                         ttypesym(srsym).typedef:=result;
                         result.typesym:=srsym;
                       end;
 
-
                     if _prettyname<>'' then
                       ttypesym(result.typesym).fprettyname:=_prettyname
                     else
@@ -2859,8 +2865,11 @@ uses
                   ) and
                   { may not be assigned in case it's a synthetic procdef that
                     still needs to be generated }
-                  assigned(tprocdef(hp).genericdef) and
-                  tprocdef(tprocdef(hp).genericdef).forwarddef then
+                  (assigned(tprocdef(hp).genericdef) and
+                  tprocdef(tprocdef(hp).genericdef).forwarddef)
+                  { when the implementation of the module was not yet parsed, it will not yet have a generictokenbuf }
+                  or not assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then
+
                  begin
                    result:=false;
                    continue;
@@ -2883,6 +2892,8 @@ uses
         def : tstoreddef;
         state : tspecializationstate;
         hmodule : tmodule;
+        mstate : tmodulestate;
+
       begin
         { first copy all entries and then work with that list to ensure that
           we don't get an infinite recursion }
@@ -2914,7 +2925,8 @@ uses
                   { we need to check for a forward declaration only if the
                     generic was declared in the same unit (otherwise there
                     should be one) }
-                  if ((hmodule=current_module) or (hmodule.state=ms_compile)) and tprocdef(def.genericdef).forwarddef then
+                  mstate:=hmodule.state;
+                  if ((hmodule=current_module) or (hmodule.state<ms_compiling_waitfinish)) and tprocdef(def.genericdef).forwarddef then
                     begin
                       readdlist.add(def);
                       continue;

compiler/pinline.pas

@@ -277,7 +277,7 @@ implementation
                 if is_new then
                   begin
                     p2:=cderefnode.create(p.getcopy);
-                    include(p2.flags,nf_no_checkpointer);
+                    include(TDerefNode(p2).derefnodeflags,drnf_no_checkpointer);
                   end
                 else
                   p2:=cderefnode.create(p);

compiler/pparautl.pas

@@ -369,6 +369,8 @@ implementation
                  hs:=pd.resultname^
                else
                  hs:=pd.procsym.name;
+               if (hs='') then
+                 hs:='$_result';
                sl:=tpropaccesslist.create;
                sl.addsym(sl_load,pd.funcretsym);
                aliasvs:=cabsolutevarsym.create_ref(hs,pd.returndef,sl);

compiler/ppcgen/ngppcadd.pas

@@ -223,7 +223,7 @@ implementation
 
         if {$ifndef cpu64bitalu}(cgsize<>OS_64) and{$endif}
            (((cs_full_boolean_eval in current_settings.localswitches) and
-             not(nf_short_bool in flags)) or
+             not(anf_short_bool in addnodeflags)) or
             (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn])) then
           begin
             if left.nodetype in [ordconstn,realconstn] then

compiler/ppcloongarch64.lpi

@@ -0,0 +1,87 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="loongarch64"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
+    </RunParams>
+    <Units Count="4">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="loongarch64\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="loongarch64\aoptcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="aopt.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="loongarch64\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="loongarch64"/>
+      <OtherUnitFiles Value="loongarch64;systems"/>
+      <UnitOutputDirectory Value="loongarch64\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dloongarch64 
+-Sew"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

compiler/ppu.pas

@@ -48,7 +48,7 @@ const
   CurrentPPUVersion = 208;
   { for any other changes to the ppu format, increase this version number
     (it's a cardinal) }
-  CurrentPPULongVersion = 21;
+  CurrentPPULongVersion = 24;
 
 { unit flags }
   uf_big_endian          = $000004;
@@ -174,6 +174,7 @@ implementation
   uses
 {$ifdef Test_Double_checksum}
     comphook,
+    globals,
 {$endif def Test_Double_checksum}
     fpchash;
 

compiler/pstatmnt.pas

@@ -622,7 +622,7 @@ implementation
          do_typecheckpass(p);
 
          if (p.nodetype=vecn) and
-            (nf_memseg in p.flags) then
+            (vnf_memseg in tvecnode(p).vecnodeflags) then
            CGMessage(parser_e_no_with_for_variable_in_other_segments);
 
          { "with procvar" can never mean anything, so always try
@@ -968,7 +968,7 @@ implementation
                                unit_found:=try_consume_unitsym_no_specialize(srsym,srsymtable,t,[],objname);
                                if srsym=nil then
                                  begin
-                                   identifier_not_found(orgpattern);
+                                   identifier_not_found(objrealname);
                                    srsym:=generrorsym;
                                  end;
                                if unit_found then
@@ -1099,7 +1099,8 @@ implementation
 
          { Force an empty register list for pure assembler routines,
            so that pass2 won't allocate volatile registers for them. }
-         asmstat.has_registerlist:=(po_assembler in current_procinfo.procdef.procoptions);
+         if (po_assembler in current_procinfo.procdef.procoptions) then
+           Include(asmstat.asmnodeflags,asmnf_has_registerlist);
 
          { END is read, got a list of changed registers? }
          if try_to_consume(_LECKKLAMMER) then
@@ -1139,7 +1140,7 @@ implementation
                   if not try_to_consume(_COMMA) then
                     break;
                 until false;
-                asmstat.has_registerlist:=true;
+                Include(asmstat.asmnodeflags,asmnf_has_registerlist);
               end;
              consume(_RECKKLAMMER);
            end;