Merge branch 'fv-fixes' into 'main'

Fixes for FV TInputLine's GetData, SetData and DataSize functions

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

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/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/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/java/jsystemh_types.inc

@@ -365,6 +365,20 @@ Type
   ValUInt = Word;
 {$endif CPU16}
 
+{$if defined(CPUINT8)}
+  ALUSInt = ShortInt;
+  ALUUInt = Byte;
+{$elseif defined(CPUINT16)}
+  ALUSInt = SmallInt;
+  ALUUInt = Word;
+{$elseif defined(CPUINT32)}
+  ALUSInt = Longint;
+  ALUUInt = DWord;
+{$elseif defined(CPUINT64)}
+  ALUSInt = Int64;
+  ALUUInt = QWord;
+{$endif defined(CPUINT64)}
+
   { NativeInt and NativeUInt are Delphi compatibility types. Even though Delphi
     has IntPtr and UIntPtr, the Delphi documentation for NativeInt states that
     'The size of NativeInt is equivalent to the size of the pointer on the

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;