Merge branch 'FixVisibility' into 'main'

Fix for visibility information when a function is a publish declaration.

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

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);

packages/pastojs/src/fppas2js.pp

@@ -20945,11 +20945,14 @@ var
   ResultTypeInfo: TJSElement;
   Call: TJSCallExpression;
   Flags: Integer;
-  ExtVis: word;
+  ExtVis: Integer;
 
   procedure AddExtRTTIVisibility;
   begin
-    Call.AddArg(CreateLiteralNumber(Proc,ExtVis));
+    if ExtVis > -1 then
+      Call.AddArg(CreateLiteralNumber(Proc,ExtVis));
+
+    ExtVis := -1;
   end;
 
   procedure AddOption(const aName: String; JS: TJSElement);
@@ -20959,8 +20962,7 @@ var
     if JS=nil then exit;
     if OptionsEl=nil then
       begin
-      if ExtVis=ExtRTTIVisDefaultMethod then
-        AddExtRTTIVisibility;
+      AddExtRTTIVisibility;
       OptionsEl:=TJSObjectLiteral(CreateElement(TJSObjectLiteral,Proc));
       Call.AddArg(OptionsEl);
       end;
@@ -21054,10 +21056,19 @@ begin
       ResultEl:=TPasFunction(Proc).FuncType.ResultEl;
       ResultTypeInfo:=CreateTypeInfoRef(ResultEl.ResultType,AContext,ResultEl);
       if ResultTypeInfo<>nil then
+        begin
+        AddExtRTTIVisibility;
+
         Call.AddArg(ResultTypeInfo);
+        end;
       end;
+
     if (ResultTypeInfo=nil) and ((Flags>0) or (length(Attr)>0)) then
+    begin
+      AddExtRTTIVisibility;
+
       Call.AddArg(CreateLiteralNull(Proc));
+    end;
 
     // flags if needed
     if (Flags>0) or (length(Attr)>0) then

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;