Merge branch 'arm-conditional-ops' into 'main'

Draft: [ARM] New Bcc; CMP; Bcc -> CMP(~c); Bcc optimisation

See merge request freepascal.org/fpc/source!644

compiler/arm/aasmcpu.pas

@@ -832,6 +832,21 @@ implementation
                 result:=operand_read;
             A_STREX:
               result:=operand_write;
+            A_LDM:
+              if opnr=0 then
+                result:=operand_readwrite
+              else
+                result:=operand_write;
+            A_STM:
+              if opnr=0 then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_ADR:
+              if opnr=0 then
+                result:=operand_write
+              else
+                result:=operand_read;
             else
               internalerror(200403151);
           end
@@ -923,6 +938,21 @@ implementation
                 result:=operand_read;
             A_STREX:
               result:=operand_write;
+            A_LDM:
+              if opnr=0 then
+                result:=operand_readwrite
+              else
+                result:=operand_write;
+            A_STM:
+              if opnr=0 then
+                result:=operand_readwrite
+              else
+                result:=operand_read;
+            A_ADR:
+              if opnr=0 then
+                result:=operand_write
+              else
+                result:=operand_read;
             else
               begin
                 writeln(opcode);

compiler/arm/aoptcpu.pas

@@ -79,6 +79,7 @@ Type
     { Individual optimisation routines }
     function OptPass1DataCheckMov(var p: tai): Boolean;
     function OptPass1ADDSUB(var p: tai): Boolean;
+    function OptPass1Bcc(var p: tai): Boolean;
     function OptPass1CMP(var p: tai): Boolean;
     function OptPass1STM(var p: tai): Boolean;
     function OptPass1MOV(var p: tai): Boolean;
@@ -815,6 +816,60 @@ Implementation
     end;
 
 
+  function TCpuAsmOptimizer.OptPass1Bcc(var p: tai): Boolean;
+    var
+      hp1, hp2, hp_last: tai;
+    begin
+      Result := False;
+
+      { Change:
+          b(c) @Lbl
+          cmp     ## (also cmn, tst and teq)
+          b(c) @Lbl (same label)
+
+        To:
+          cmp(~c) ##
+          b(c) @Lbl
+      }
+      if (taicpu(p).condition <> C_None) and
+        IsJumpToLabel(taicpu(p)) and
+        GetNextInstruction(p, hp1) and
+        (hp1.typ = ait_instruction) then
+        begin
+          if (
+              (cs_opt_size in current_settings.optimizerswitches) or
+              { Too many chained conditional CMPs will cause slowdown }
+              (
+                GetLastInstruction(p, hp_last) and
+                (
+                  { Permit if previous entry is either not an instruction or is
+                    unconditional (e.g. a regular CMP) }
+                  (hp_last.typ <> ait_instruction) or
+                  (taicpu(hp_last).condition = C_None)
+                )
+              )
+            ) and
+            MatchInstruction(hp1, [A_CMP, A_CMN, A_TST, A_TEQ], [C_None], [PF_None]) and
+            GetNextInstruction(hp1, hp2) and
+            { Conditions must match }
+            MatchInstruction(hp2, [A_B], [taicpu(p).condition], [PF_None]) and
+            { Make sure jumps go to the same destination }
+            references_equal(JumpTargetOp(taicpu(p))^.ref^, JumpTargetOp(taicpu(hp2))^.ref^) then
+            begin
+              DebugMsg(SPeepholeOptimization + 'Bcc; CMP; Bcc -> CMP(~c); Bcc', p);
+              { Apply inverted condition to the comparison, thus preserving the
+                flags if the inverted condition is not fulfilled }
+              taicpu(hp1).condition := inverse_cond(taicpu(p).condition);
+              JumpTargetOp(taicpu(p))^.ref^.symbol.decrefs;
+              AllocRegBetween(NR_DEFAULTFLAGS, p, hp1, UsedRegs);
+              RemoveCurrentP(p, hp1);
+              Result := True;
+              Exit;
+            end;
+        end;
+    end;
+
+
   function TCpuAsmOptimizer.OptPass1CMP(var p: tai): Boolean;
     var
       hp1, hp2, hp_last: tai;
@@ -2406,6 +2461,8 @@ Implementation
       if p.typ = ait_instruction then
         begin
           case taicpu(p).opcode of
+            A_B:
+              Result := OptPass1Bcc(p);
             A_CMP:
               Result := OptPass1CMP(p);
             A_STR:

compiler/ncgld.pas

@@ -326,8 +326,12 @@ implementation
              else
                reference_reset_symbol(tvref,current_asmdata.WeakRefAsmSymbol(gvs.mangledname,AT_DATA),0,sizeof(pint),[]);
              { Enable size optimization with -Os or PIC code is generated and PIC uses GOT }
-             size_opt:=(cs_opt_size in current_settings.optimizerswitches)
-                       or ((cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags));
+             size_opt:={$if defined(RISCV)}
+                         true
+                       {$else defined(RISCV)}
+                         (cs_opt_size in current_settings.optimizerswitches)
+                         or ((cs_create_pic in current_settings.moduleswitches) and (tf_pic_uses_got in target_info.flags))
+                       {$endif defined(RISCV)};
              hreg_tv_rec:=NR_INVALID;
              if size_opt then
                begin

rtl/wasicommon/systhrd.inc

@@ -399,12 +399,14 @@ procedure WasiAllocateThreadVars; forward;
 {$push}{$S-}  // no stack checking for this procedure
 procedure FPCWasmThreadStartPascal(tid: longint; start_arg: PWasmThread);
 begin
-  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadStartPascal(...)');{$ENDIF}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('FPCWasmThreadStartPascal('+IntToStr(tid)+','+IntToStr(ptrint(start_arg))+')');{$ENDIF}
 
   start_arg^.ID:=tid;
-  GlobalCurrentThread:=@start_arg;
+  GlobalCurrentThread:=start_arg;
   GlobalIsMainThread:=0;
   GlobalIsWorkerThread:=1;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('Check : TID='+IntToStr(tid)+', start_arg_id='+IntToStr(start_arg^.ID)+', currentthread= '+IntTostr(ptrint(GetCurrentThreadID))+')');{$ENDIF}
+
 {$IFDEF FPC_WASM_WORKER_THREADS_CAN_WAIT}
   GlobalIsThreadBlockable:=1;
 {$ELSE FPC_WASM_WORKER_THREADS_CAN_WAIT}
@@ -610,6 +612,7 @@ begin
   Result:=0;
 end;
 
+
 function WasiGetCurrentThreadId : TThreadID;
 begin
   Result:=GetSelfThread;

rtl/wasicommon/tthread.inc

@@ -63,7 +63,7 @@ Var
   LFreeOnTerminate : Boolean;
 
 begin
-  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('In threadfunc. Thread object: '+IntToStr(PTrUint(LThread)));{$ENDIF}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('In threadfunc. Thread object: '+IntToStr(PTrUint(LThread))+' thread id :'+IntToStr(ptrint(Lthread.FThreadID)));{$ENDIF}
   try
     if LThread.FInitialSuspended then
       begin
@@ -142,9 +142,11 @@ end;
 procedure TThread.SysDestroy;
 
 begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: enter');{$ENDIF}
   { exception in constructor }
   if not assigned(FSuspendEvent) then
     exit;
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: have suspendevent');{$ENDIF}
   { exception in constructor }
   if (FHandle = TThreadID(0)) then
     begin
@@ -154,25 +156,43 @@ begin
   { Thread itself called destroy ? }
   if (FThreadID = GetCurrentThreadID) then
     begin
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: '+IntToStr(PtrInt(FThreadID))+' = '+IntToStr(PtrInt(GetCurrentThreadID)));{$ENDIF}
+  {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: thread itself is freeing');{$ENDIF}
     if not(FFreeOnTerminate) and not FFinished then
+       begin 
+       {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: error condition');{$ENDIF}
        raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+       end;
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: clearing FreeOnTerminate');{$ENDIF}
     FFreeOnTerminate := false;
     end
   else
     begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: other thread is freeing');{$ENDIF}
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: '+IntToStr(PtrInt(FThreadID))+' = '+IntToStr(PtrInt(GetCurrentThreadID)));{$ENDIF}
     { avoid recursion}
     FFreeOnTerminate := false;
     { you can't join yourself, so only for FThreadID<>GetCurrentThreadID }
     { and you can't join twice -> make sure we didn't join already       }
     if not FThreadReaped then
       begin
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: reaping thread');{$ENDIF}
       Terminate;
       if (FSuspendedInternal or FInitialSuspended) then
+        begin
+        {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: resuming thread in order to reap');{$ENDIF}
         Resume;
+        end;
+      {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: waiting on thread');{$ENDIF}
+      // Before calling WaitFor, signal main thread with WakeMainThread, so pending checksynchronize calls are handled.
+      if assigned(WakeMainThread) then
+        WakeMainThread(Self);
       WaitFor;
       end;
     end;
+   {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: destroying RTL suspend event');{$ENDIF}
    RtlEventDestroy(FSuspendEvent);
+   {$IFDEF DEBUGWASMTHREADS}DebugWriteln('TThread.SysDestroy: freeing fatal exception if it exists');{$ENDIF}
    FFatalException.Free;
    FFatalException := nil;
 end;
@@ -188,6 +208,7 @@ begin
     end
   else
     begin
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming thread '+IntToStr(ptruint(self)));{$ENDIF}
     { don't compare with ord(true) or ord(longbool(true)), }
     { becaue a longbool's "true" value is anyting <> false }
     if FSuspended and
@@ -195,7 +216,8 @@ begin
       begin
       {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resuming '+IntToStr(ptruint(self)));{$ENDIF}
       RtlEventSetEvent(FSuspendEvent);
-      end
+      end;
+    {$IFDEF DEBUGWASMTHREADS}DebugWriteln('resumed thread '+IntToStr(ptruint(self)));{$ENDIF}
     end
 end;