Merge branch 'case-ppu-efficiency' into 'main'

[Cross-platform] PPU storage optimisation for case blocks

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

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/entfile.pas

@@ -310,8 +310,10 @@ type
     function  getword:word;
     function  getdword:dword;
     function  getlongint:longint;
-    function getint64:int64;
+    function  getint64:int64;
     function  getqword:qword;
+    function  getsleb128:int64;
+    function  getuleb128:qword;
     function getaint:{$ifdef generic_cpu}int64{$else}aint{$ifdef USEINLINE}; inline{$endif}{$endif};
     function getasizeint:{$ifdef generic_cpu}int64{$else}asizeint{$ifdef USEINLINE}; inline{$endif}{$endif};
     function getpuint:{$ifdef generic_cpu}qword{$else}puint{$ifdef USEINLINE}; inline{$endif}{$endif};
@@ -339,6 +341,8 @@ type
     procedure putlongint(l:longint); {$ifdef USEINLINE}inline;{$endif}
     procedure putint64(i:int64); {$ifdef USEINLINE}inline;{$endif}
     procedure putqword(q:qword); {$ifdef USEINLINE}inline;{$endif}
+    procedure putsleb128(i:int64);
+    procedure putuleb128(q:qword);
     procedure putaint(i:aint); {$ifdef USEINLINE}inline;{$endif}
     procedure putasizeint(i:asizeint); {$ifdef USEINLINE}inline;{$endif}
     procedure putpuint(i:puint); {$ifdef USEINLINE}inline;{$endif}
@@ -1052,6 +1056,41 @@ begin
 end;
 
 
+function tentryfile.getsleb128:int64;
+var
+  b: Byte;
+  s: Integer;
+begin
+  Result:=0;
+  s:=0;
+  repeat
+    b:=getbyte();
+    Result:=Result or ((b and $7F) shl s);
+    Inc(s);
+  until (b and $80)=0;
+
+  if (s<size) and ((b and $40)<>0) then
+    { Sign extend }
+    Result:=Result or (-1 shl s);
+end;
+
+
+function tentryfile.getuleb128:qword;
+var
+  b: Byte;
+  s: Integer;
+begin
+  Result:=0;
+  s:=0;
+  repeat
+    b:=getbyte();
+    Result:=Result or ((b and $7F) shl s);
+    Inc(s);
+  until (b and $80)=0;
+
+end;
+
+
 function tentryfile.getaint:{$ifdef generic_cpu}int64{$else}aint{$endif};
 {$ifdef generic_cpu}
 var
@@ -1857,6 +1896,53 @@ begin
 end;
 
 
+procedure tentryfile.putsleb128(i:int64);
+var
+  b: Byte;
+  more: Boolean;
+begin
+  if i=0 then
+    begin
+      putbyte(0);
+      Exit;
+    end;
+
+  more:=True;
+
+  repeat
+    b:=i and $7F;
+    i:=SarInt64(i,7);
+
+    if ((i=0) and ((b and $40)=0)) or ((i=-1) and ((b and $40)<>0)) then
+      more:=False
+    else
+      b:=b or $80;
+    putbyte(b);
+  until not more
+end;
+
+
+procedure tentryfile.putuleb128(q:qword);
+var
+  b: Byte;
+begin
+  if q=0 then
+    begin
+      putbyte(0);
+      Exit;
+    end;
+
+  repeat
+    b:=q and $7F;
+    q:=q shr 7;
+    if (q<>0) then
+      b:=b or $80;
+    putbyte(b);
+  until q=0;
+
+end;
+
+
 procedure tentryfile.putaint(i:aint);
 begin
 {$ifdef DEBUG_PPU}

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

compiler/nset.pas

@@ -36,7 +36,7 @@ interface
        pcaselabel = ^tcaselabel;
        tcaselabel = record
           { unique blockid }
-          blockid : longint;
+          blockid : longword;
           { left and right tree node }
           less,
           greater : pcaselabel;
@@ -565,26 +565,203 @@ implementation
          copycaselabel:=n;
       end;
 
+    const
+      ppu_labeltype_ordinal_shortint             = 0;
+      ppu_labeltype_ordinal_shortint_range       = 1;
+      ppu_labeltype_ordinal_byte                 = 2;
+      ppu_labeltype_ordinal_byte_range           = 3;
+      ppu_labeltype_ordinal_smallint             = 4;
+      ppu_labeltype_ordinal_smallint_range       = 5;
+      ppu_labeltype_ordinal_word                 = 6;
+      ppu_labeltype_ordinal_word_range           = 7;
+      ppu_labeltype_ordinal_longint              = 8;
+      ppu_labeltype_ordinal_longint_range        = 9;
+      ppu_labeltype_ordinal_longword             = 10;
+      ppu_labeltype_ordinal_longword_range       = 11;
+      ppu_labeltype_ordinal_int64                = 12;
+      ppu_labeltype_ordinal_int64_range          = 13;
+      ppu_labeltype_ordinal_qword                = 14;
+      ppu_labeltype_ordinal_qword_range          = 15;
+
+      ppu_labeltype_string                       = 16;
+      ppu_labeltype_string_range                 = 17;
+
+      ppu_labeltype_mask                         = $1F;
+
+      ppu_has_greater_branch                     = $40;
+      ppu_has_lesser_branch                      = $80;
+
 
     procedure ppuwritecaselabel(ppufile:tcompilerppufile;p : pcaselabel);
       var
         b : byte;
+        IsSigned: Boolean;
       begin
-        ppufile.putboolean(p^.label_type = ltConstString);
+        { Store high-order flags relating to the presence of a greater and
+          lesser node.  The label type will be OR'd to this }
+        b:=(ord(assigned(p^.greater)) shl 6) or (ord(assigned(p^.less)) shl 7);
+
         if (p^.label_type = ltConstString) then
           begin
-            p^._low_str.ppuwrite(ppufile);
-            p^._high_str.ppuwrite(ppufile);
+            if p^._high_str.isequal(p^._low_str) then
+              begin
+                ppufile.putbyte(b or ppu_labeltype_string);
+                p^._low_str.ppuwrite(ppufile);
+              end
+            else
+              begin
+                ppufile.putbyte(b or ppu_labeltype_string_range);
+                p^._low_str.ppuwrite(ppufile);
+                p^._high_str.ppuwrite(ppufile);
+              end;
           end
         else
           begin
-            ppufile.putexprint(p^._low);
-            ppufile.putexprint(p^._high);
+            if p^._high = p^._low then
+              begin
+                if p^._low.signed then
+                  begin
+                    case p^._low.svalue of
+                      -128..127:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_shortint);
+                          ppufile.putbyte(Byte(p^._low.svalue));
+                        end;
+                     -32768..-129, 128..32767:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_smallint);
+                          ppufile.putword(Word(p^._low.svalue));
+                        end;
+                      -2147483648..-32769, 32768..2147483647:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_longint);
+                          ppufile.putlongint(p^._low.svalue);
+                        end;
+                      else
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_int64);
+                          ppufile.putint64(p^._low.svalue);
+                        end;
+                    end;
+                  end
+                else
+                  begin
+                    case p^._low.uvalue of
+                      $00..$FF:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_byte);
+                          ppufile.putbyte(p^._low.uvalue);
+                        end;
+                      $100..$FFFF:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_word);
+                          ppufile.putword(p^._low.uvalue);
+                        end;
+                      $10000..$FFFFFFFF:
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_longword);
+                          ppufile.putlongint(LongInt(p^._low.uvalue));
+                        end;
+                      else
+                        begin
+                          ppufile.putbyte(b or ppu_labeltype_ordinal_qword);
+                          ppufile.putqword(p^._low.uvalue);
+                        end;
+                    end;
+                  end;
+              end
+            else
+              begin
+                { If for some reason, one is signed and one isn't, try to
+                  determine the best type to use based on the values present}
+                if p^._low.signed xor p^._high.signed then
+                  begin
+                    if (p^._low.signed and (p^._low.svalue<0)) or
+                      (p^._high.signed and (p^._high.svalue<0)) then
+                      begin
+                        if (not p^._low.signed and (p^._low.uvalue>$7FFFFFFFFFFFFFFF)) or
+                          (not p^._high.signed and (p^._high.uvalue>$7FFFFFFFFFFFFFFF)) then
+                          { This is a problem because at least one of the
+                            values is out of range and should have been trapped
+                            by the compiler or at least clamped. }
+                          InternalError(2024121110);
+
+                        IsSigned:=True;
+                      end
+                    else if (not p^._low.signed and (p^._low.uvalue>$7FFFFFFFFFFFFFFF)) or
+                      (not p^._high.signed and (p^._high.uvalue>$7FFFFFFFFFFFFFFF)) then
+                      IsSigned:=False
+                    else
+                      { Signed by default }
+                      IsSigned:=True;
+                  end
+                else
+                  IsSigned:=p^._low.signed;
+
+                if IsSigned then
+                  begin
+                    if (p^._low.svalue>=-128) and (p^._low.svalue<=127) and
+                      (p^._high.svalue>=-128) and (p^._high.svalue<=127) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_shortint_range);
+                        ppufile.putbyte(Byte(p^._low.svalue));
+                        ppufile.putbyte(Byte(p^._high.svalue));
+                      end
+                    else if (p^._low.svalue>=-32768) and (p^._low.svalue<=32767) and
+                      (p^._high.svalue>=-32768) and (p^._high.svalue<=32767) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_smallint_range);
+                        ppufile.putword(Word(p^._low.svalue));
+                        ppufile.putword(Word(p^._high.svalue));
+                      end
+                    else if (p^._low.svalue>=-2147483648) and (p^._low.svalue<=2147483647) and
+                      (p^._high.svalue>=-2147483648) and (p^._high.svalue<=2147483647) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_longint_range);
+                        ppufile.putlongint(p^._low.svalue);
+                        ppufile.putlongint(p^._high.svalue);
+                      end
+                    else
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_int64_range);
+                        ppufile.putint64(p^._low.svalue);
+                        ppufile.putint64(p^._high.svalue);
+                      end;
+                  end
+                else
+                  begin
+                    if (p^._low.svalue<=$FF) and
+                      (p^._high.svalue<=$FF) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_byte_range);
+                        ppufile.putbyte(p^._low.uvalue);
+                        ppufile.putbyte(p^._high.uvalue);
+                      end
+                    else if (p^._low.svalue<=$FFFF) and
+                      (p^._high.svalue<=$FFFF) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_word_range);
+                        ppufile.putword(p^._low.uvalue);
+                        ppufile.putword(p^._high.uvalue);
+                      end
+                    else if (p^._low.svalue<=$FFFFFFFF) and
+                      (p^._high.svalue<=$FFFFFFFF) then
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_longword_range);
+                        ppufile.putlongint(LongInt(p^._low.uvalue));
+                        ppufile.putlongint(LongInt(p^._high.uvalue));
+                      end
+                    else
+                      begin
+                        ppufile.putbyte(b or ppu_labeltype_ordinal_qword_range);
+                        ppufile.putqword(p^._low.uvalue);
+                        ppufile.putqword(p^._high.uvalue);
+                      end;
+                  end;
+              end;
           end;
 
-        ppufile.putlongint(p^.blockid);
-        b:=ord(assigned(p^.greater)) or (ord(assigned(p^.less)) shl 1);
-        ppufile.putbyte(b);
+        ppufile.putuleb128(p^.blockid);
         if assigned(p^.greater) then
           ppuwritecaselabel(ppufile,p^.greater);
         if assigned(p^.less) then
@@ -598,27 +775,144 @@ implementation
         p : pcaselabel;
       begin
         new(p);
-        if ppufile.getboolean then
-          begin
-            p^.label_type := ltConstString;
-            p^._low_str := cstringconstnode.ppuload(stringconstn,ppufile);
-            p^._high_str := cstringconstnode.ppuload(stringconstn,ppufile);
-          end
-        else
-          begin
-            p^.label_type := ltOrdinal;
-
-            p^._low:=ppufile.getexprint;
-            p^._high:=ppufile.getexprint;
-          end;
-
-        p^.blockid:=ppufile.getlongint;
         b:=ppufile.getbyte;
-        if (b and 1)=1 then
+        case b and ppu_labeltype_mask of
+          ppu_labeltype_ordinal_shortint:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ShortInt(ppufile.getbyte);
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_shortint_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ShortInt(ppufile.getbyte);
+              p^._high:=ShortInt(ppufile.getbyte);
+            end;
+
+          ppu_labeltype_ordinal_byte:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getbyte;
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_byte_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getbyte;
+              p^._high:=ppufile.getbyte;
+            end;
+
+          ppu_labeltype_ordinal_smallint:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=SmallInt(ppufile.getword);
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_smallint_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=SmallInt(ppufile.getword);
+              p^._high:=SmallInt(ppufile.getword);
+            end;
+
+          ppu_labeltype_ordinal_word:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getword;
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_word_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getword;
+              p^._high:=ppufile.getword;
+            end;
+
+          ppu_labeltype_ordinal_longint:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getlongint;
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_longint_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getlongint;
+              p^._high:=ppufile.getlongint;
+            end;
+
+          ppu_labeltype_ordinal_longword:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=LongWord(ppufile.getlongint);
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_longword_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=LongWord(ppufile.getlongint);
+              p^._high:=LongWord(ppufile.getlongint);
+            end;
+
+          ppu_labeltype_ordinal_int64:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getint64;
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_int64_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getint64;
+              p^._high:=ppufile.getint64;
+            end;
+
+          ppu_labeltype_ordinal_qword:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getqword;
+              p^._high:=p^._low;
+            end;
+
+          ppu_labeltype_ordinal_qword_range:
+            begin
+              p^.label_type:=ltOrdinal;
+              p^._low:=ppufile.getqword;
+              p^._high:=ppufile.getqword;
+            end;
+
+          ppu_labeltype_string:
+            begin
+              p^.label_type:=ltConstString;
+              p^._low_str:=cstringconstnode.ppuload(stringconstn,ppufile);
+              p^._high_str:=TStringConstNode(p^._low_str.getcopy());
+            end;
+
+          ppu_labeltype_string_range:
+            begin
+              p^.label_type:=ltConstString;
+              p^._low_str:=cstringconstnode.ppuload(stringconstn,ppufile);
+              p^._high_str:=cstringconstnode.ppuload(stringconstn,ppufile);
+            end;
+
+          else
+            InternalError(2024121101);
+        end;
+
+        p^.blockid:=LongWord(ppufile.getuleb128);
+        if (b and ppu_has_greater_branch)<>0 then
          p^.greater:=ppuloadcaselabel(ppufile)
         else
          p^.greater:=nil;
-        if (b and 2)=2 then
+        if (b and ppu_has_lesser_branch)<>0 then
          p^.less:=ppuloadcaselabel(ppufile)
         else
          p^.less:=nil;

compiler/riscv/aasmcpu.pas

@@ -507,7 +507,8 @@ uses cutils, cclasses;
               result:=operand_read;
 
           // SB type
-          A_Bxx:
+          A_BEQZ,A_BNEZ,A_BLEZ,A_BGEZ,A_BLTZ,A_BGTZ,A_BGT,A_BLE,
+          A_BGTU,A_BLEU,A_Bxx:
             result:=operand_read;
 
           // S type

compiler/riscv/aoptcpurv.pas

@@ -590,7 +590,7 @@ implementation
                 taicpu(hp1).condition:=C_GE;
             end;
 
-          DebugMsg('Peephole SltuB2B performed', hp1);
+          DebugMsg('Peephole SltuB2B 1 performed', hp1);
 
           RemoveInstr(p);
 
@@ -632,7 +632,7 @@ implementation
                 taicpu(hp1).condition:=C_GE;
             end;
 
-          DebugMsg('Peephole SltuB2B performed', hp1);
+          DebugMsg('Peephole SltuB2B 2 performed', hp1);
 
           RemoveInstr(p);
 

compiler/riscv/cpubase.pas

@@ -552,6 +552,8 @@ implementation
       begin
        is_calljmp:=false;
         case o of
+          A_BEQZ,A_BNEZ,A_BLEZ,A_BGEZ,A_BLTZ,A_BGTZ,A_BGT,A_BLE,
+          A_BGTU,A_BLEU,A_J,A_JR,
           A_JAL,A_JALR,A_Bxx,A_CALL:
             is_calljmp:=true;
           else

packages/wasm-utils/fpmake.pp

@@ -27,6 +27,8 @@ begin
     P.SourcePath.Add('src');
     // Logger
     T:=P.Targets.AddUnit('wasm.logger.api.pas');
+    // Memutils
+    T:=P.Targets.AddUnit('wasm.memutils.pas');
     
     // Timer
     T:=P.Targets.AddUnit('wasm.timer.shared.pas');

packages/wasm-utils/src/wasm.memutils.pas

@@ -0,0 +1,45 @@
+{
+    This file is part of the Free Component Library
+
+    Webassembly memory utils.
+    Copyright (c) 2025 by Michael Van Canneyt michael@freepascal.org
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit wasm.memutils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+Type
+  TWasmGrowMemoryEvent = procedure(aPages : longint) of object;
+
+var
+  MemGrowNotifyCallBack : TWasmGrowMemoryCallBack;
+  MemGrowNotifyEvent : TWasmGrowMemoryEvent;
+
+implementation
+
+procedure __wasm_memory_grow_notification(aPages : Longint); external 'wasmmem' name 'wasm_memory_grow_notification' ;
+
+procedure MemNotify(aPages : longint);
+
+begin
+  __wasm_memory_grow_notification(aPages);
+  if assigned(MemGrowNotifyCallBack) then
+    MemGrowNotifyCallBack(aPages);
+  if assigned(MemGrowNotifyEvent) then
+    MemGrowNotifyEvent(aPages);
+end;
+
+initialization
+  WasmGrowMemoryCallback:=@MemNotify;
+end.
+

rtl/wasicommon/sysheap.inc

@@ -71,6 +71,8 @@ begin
         end
       else
         SysOSAlloc:=nil;
+      if assigned(WasmGrowMemoryCallback) then
+        WasmGrowMemoryCallback(grow_pages);
     end;
 {$ifdef FPC_WASM_THREADS}
   if InitialHeapCriticalSectionInitialized then

rtl/wasicommon/system.pp

@@ -66,17 +66,23 @@ const
   sLineBreak = LineEnding;
   DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
 
+type
+  TWasmGrowMemoryCallBack = procedure(aGrowPages: longint);
+
 var
   argc: longint;
   argv: PPAnsiChar;
   envp: PPAnsiChar;
   ___fpc_wasm_suspender: WasmExternRef; section 'WebAssembly.Global';
+  WasmGrowMemoryCallback : TWasmGrowMemoryCallBack;
   
 function __fpc_get_wasm_suspender: WasmExternRef;
 procedure __fpc_set_wasm_suspender(v: WasmExternRef);
 
 property __fpc_wasm_suspender: WasmExternRef read __fpc_get_wasm_suspender write __fpc_set_wasm_suspender;
 
+
+
 Procedure DebugWriteln(aString : ShortString);
 
 implementation

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;
 

rtl/win32/seh32.inc

@@ -275,6 +275,8 @@ procedure CommonHandler(
 var
   Exc: TExceptObject;
   code: Longint;
+  _oldebx,_oldedi,_oldesi,
+  _ebx,_edi,_esi: dword;
 begin
   if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
   begin
@@ -297,7 +299,20 @@ begin
     Exc.Frames:=rec.ExceptionInformation[3];
   end;
 
+  asm
+    movl %ebx,_oldebx
+    movl %esi,_oldesi
+    movl %edi,_oldedi
+  end;
   RtlUnwind(@frame,nil,@rec,nil);
+  asm
+    movl %ebx,_ebx
+    movl %esi,_esi
+    movl %edi,_edi
+    movl _oldebx,%ebx
+    movl _oldesi,%esi
+    movl _oldedi,%edi
+  end;
 
   Exc.Refcount:=0;
   Exc.SEHFrame:=@frame;
@@ -312,6 +327,9 @@ begin
       movl   Exc.FObject,%eax
       movl   frame,%edx
       movl   TargetAddr,%ecx              // load ebp-based var before changing ebp
+      movl   _ebx,%ebx
+      movl   _esi,%esi
+      movl   _edi,%edi
       movl   TSEHFrame._EBP(%edx),%ebp
       jmpl   *%ecx
   end;