* synchronized with trunk

git-svn-id: branches/wasm@46305 -

.gitattributes

@@ -18445,6 +18445,7 @@ tests/webtbs/tw3742.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal
 tests/webtbs/tw37449.pp svneol=native#text/pascal
 tests/webtbs/tw37468.pp svneol=native#text/pascal
+tests/webtbs/tw37477.pp svneol=native#text/pascal
 tests/webtbs/tw37493.pp svneol=native#text/pascal
 tests/webtbs/tw3751.pp svneol=native#text/plain
 tests/webtbs/tw3758.pp svneol=native#text/plain

compiler/nset.pas

@@ -373,6 +373,25 @@ implementation
                      exit;
                    end;
                end;
+           end
+         { a in [a] => true, if a has no side effects }
+         else if (right.nodetype=addn) and
+           (taddnode(right).left.nodetype=setconstn) and
+           (tsetconstnode(taddnode(right).left).elements=0) and
+           (taddnode(right).right.nodetype=setelementn) and
+           (tsetelementnode(taddnode(right).right).right=nil) and
+           ((tsetelementnode(taddnode(right).right).left.isequal(left)) or
+            (
+              (tsetelementnode(taddnode(right).right).left.nodetype=typeconvn) and
+              (ttypeconvnode(tsetelementnode(taddnode(right).right).left).left.isequal(left))
+            )
+           ) and
+           not(might_have_sideeffects(left,[mhs_exceptions])) then
+           begin
+             t:=cordconstnode.create(1, pasbool1type, true);
+             typecheckpass(t);
+             result:=t;
+             exit;
            end;
       end;
 

compiler/ogbase.pas

@@ -309,6 +309,8 @@ interface
        FSizeLimit : TObjSectionOfs;
        procedure SetSecOptions(Aoptions:TObjSectionOptions);
        procedure SectionTooLargeError;
+     protected
+       function GetAltName: string; virtual;
      public
        ObjData    : TObjData;
        index      : longword;  { index of section in section headers }
@@ -1013,6 +1015,12 @@ implementation
       end;
 
 
+    function TObjSection.GetAltName: string;
+      begin
+        result:='';
+      end;
+
+
     function TObjSection.write(const d;l:TObjSectionOfs):TObjSectionOfs;
       begin
         result:=size;
@@ -1152,13 +1160,20 @@ implementation
 
 
     function  TObjSection.FullName:string;
+      var
+        s: string;
       begin
         if not assigned(FCachedFullName) then
           begin
+            s:=GetAltName;
+            if s<>'' then
+              s:=Name+s
+            else
+              s:=Name;
             if assigned(ObjData) then
-              FCachedFullName:=stringdup(ObjData.Name+'('+Name+')')
+              FCachedFullName:=stringdup(ObjData.Name+'('+s+')')
             else
-              FCachedFullName:=stringdup(Name);
+              FCachedFullName:=stringdup(s);
           end;
         result:=FCachedFullName^;
       end;

compiler/ogomf.pas

@@ -74,6 +74,7 @@ interface
       private
         FClassName: string;
         FOverlayName: string;
+        FFirstSym: TObjSymbol;
         FCombination: TOmfSegmentCombination;
         FUse: TOmfSegmentUse;
         FPrimaryGroup: TObjSectionGroup;
@@ -81,6 +82,8 @@ interface
         FMZExeUnifiedLogicalSegment: TMZExeUnifiedLogicalSegment;
         FLinNumEntries: TOmfSubRecord_LINNUM_MsLink_LineNumberList;
         function GetOmfAlignment: TOmfSegmentAlignment;
+      protected
+        function GetAltName: string; override;
       public
         constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:longint;Aoptions:TObjSectionOptions);override;
         destructor destroy;override;
@@ -1006,6 +1009,14 @@ implementation
         end;
       end;
 
+    function TOmfObjSection.GetAltName: string;
+      begin
+        if FFirstSym<>nil then
+          result:='/'+FFirstSym.Name
+        else
+          result:='';
+      end;
+
     constructor TOmfObjSection.create(AList: TFPHashObjectList;
           const Aname: string; Aalign: longint; Aoptions: TObjSectionOptions);
       begin
@@ -1983,6 +1994,8 @@ implementation
             objsym.objsection:=objsec;
             objsym.offset:=PubDefElem.PublicOffset;
             objsym.size:=0;
+            if (objsym.bind=AB_GLOBAL) and (objsec.FFirstSym=nil) then
+              objsec.FFirstSym:=objsym;
           end;
         PubDefRec.Free;
         Result:=True;

compiler/optcse.pas

@@ -307,7 +307,10 @@ unit optcse;
       begin
         result:=fen_false;
         nodes:=nil;
-        if n.nodetype in cseinvariant then
+        if (n.nodetype in cseinvariant) and
+          { a setelement node is cseinvariant, but it might not be replaced by a block so
+            it cannot be the root of the cse search }
+          (n.nodetype<>setelementn) then
           begin
             csedomain:=true;
             foreachnodestatic(pm_postprocess,n,@searchsubdomain,@csedomain);

compiler/rgobj.pas

@@ -320,7 +320,7 @@ unit rgobj;
     uses
       sysutils,
       globals,
-      verbose,tgobj,procinfo;
+      verbose,tgobj,procinfo,cgobj;
 
     procedure sort_movelist(ml:Pmovelist);
 
@@ -2107,10 +2107,39 @@ unit rgobj;
 
 
     procedure Trgobj.translate_registers(list:TAsmList);
+
+      function get_reg_name_full(r: tregister): string;
+        var
+          rr:tregister;
+          sr:TSuperRegister;
+        begin
+          rr:=r;
+          sr:=getsupreg(r);
+          if reginfo[sr].live_start=nil then
+            begin
+              result:='';
+              exit;
+            end;
+          setsupreg(rr,reginfo[sr].colour);
+          result:=std_regname(rr);
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+          if sr<first_int_imreg then
+            exit;
+          while cg.has_next_reg[sr] do
+            begin
+              r:=cg.GetNextReg(r);
+              sr:=getsupreg(r);
+              setsupreg(rr,reginfo[sr].colour);
+              result:=result+':'+std_regname(rr);
+            end;
+{$endif defined(cpu8bitalu) or defined(cpu16bitalu)}
+        end;
+
       var
         hp,p,q:Tai;
         i:shortint;
         u:longint;
+        s:string;
 {$ifdef arm}
         so:pshifterop;
 {$endif arm}
@@ -2158,17 +2187,17 @@ unit rgobj;
                     begin
                       if (cs_asm_source in current_settings.globalswitches) then
                         begin
+                          s:=get_reg_name_full(tai_varloc(p).newlocation);
+                          if s<>'' then
+                            begin
+                              if tai_varloc(p).newlocationhi<>NR_NO then
+                                s:=get_reg_name_full(tai_varloc(p).newlocationhi)+':'+s;
+                              hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+s));
+                              list.insertafter(hp,p);
+                            end;
                           setsupreg(tai_varloc(p).newlocation,reginfo[getsupreg(tai_varloc(p).newlocation)].colour);
                           if tai_varloc(p).newlocationhi<>NR_NO then
-                            begin
-                              setsupreg(tai_varloc(p).newlocationhi,reginfo[getsupreg(tai_varloc(p).newlocationhi)].colour);
-                                hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+
-                                  std_regname(tai_varloc(p).newlocationhi)+':'+std_regname(tai_varloc(p).newlocation)));
-                            end
-                          else
-                            hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+
-                              std_regname(tai_varloc(p).newlocation)));
-                          list.insertafter(hp,p);
+                            setsupreg(tai_varloc(p).newlocationhi,reginfo[getsupreg(tai_varloc(p).newlocationhi)].colour);
                         end;
                       q:=tai(p.next);
                       list.remove(p);

compiler/systems/i_wasi.pas

@@ -51,7 +51,7 @@ unit i_wasi;
             cpu          : cpu_wasm32;
             unit_env     : '';
             extradefines : '';
-            exeext       : '';
+            exeext       : '.wasm';
             defext       : '.def';
             scriptext    : '.sh';
             smartext     : '.sl';

compiler/systems/t_msdos.pas

@@ -265,14 +265,17 @@ begin
 
   LinkRes.Add('option quiet');
 
-  if target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then
-    LinkRes.Add('debug dwarf')
-  else if target_dbg.id=dbg_codeview then
-    LinkRes.Add('debug codeview')
-  else if cs_debuginfo in current_settings.moduleswitches then
-    LinkRes.Add('debug watcom all');
-  if cs_link_separate_dbg_file in current_settings.globalswitches then
-    LinkRes.Add('option symfile');
+  if cs_debuginfo in current_settings.moduleswitches then
+  begin
+    if target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then
+      LinkRes.Add('debug dwarf')
+    else if target_dbg.id=dbg_codeview then
+      LinkRes.Add('debug codeview')
+    else
+      LinkRes.Add('debug watcom all');
+    if cs_link_separate_dbg_file in current_settings.globalswitches then
+      LinkRes.Add('option symfile');
+  end;
 
   { add objectfiles, start with prt0 always }
   case current_settings.x86memorymodel of

packages/fcl-passrc/src/pastree.pp

@@ -174,7 +174,7 @@ type
       const Arg: Pointer); virtual;
     procedure ForEachChildCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer; Child: TPasElement; CheckParent: boolean); virtual;
-    Function SafeName : String;                 // Name but with & prepended if name is a keyword.
+    Function SafeName : String; virtual;                // Name but with & prepended if name is a keyword.
     function FullPath: string;                  // parent's names, until parent is not TPasDeclarations
     function ParentPath: string;                // parent's names
     function FullName: string; virtual;         // FullPath + Name
@@ -514,6 +514,7 @@ type
   Protected
     Function FixTypeDecl(aDecl: String) : String;
   public
+    Function SafeName : String; override;
     function ElementTypeName: string; override;
   end;
   TPasTypeArray = array of TPasType;
@@ -2591,6 +2592,14 @@ begin
   ProcessHints(false,Result);
 end;
 
+function TPasType.SafeName: String;
+begin
+  if SameText(Name,'string') then
+    Result:=Name
+  else
+    Result:=inherited SafeName;
+end;
+
 function TPasType.ElementTypeName: string; begin Result := SPasTreeType; end;
 function TPasPointerType.ElementTypeName: string; begin Result := SPasTreePointerType; end;
 function TPasAliasType.ElementTypeName: string; begin Result := SPasTreeAliasType; end;

packages/fcl-passrc/src/paswrite.pp

@@ -101,7 +101,7 @@ type
     procedure WriteOverloadedProc(aProc : TPasOverloadedProc; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
     Procedure WriteAliasType(AType : TPasAliasType); virtual;
     Procedure WriteRecordType(AType : TPasRecordType); virtual;
-    Procedure WriteArrayType(AType : TPasArrayType); virtual;
+    Procedure WriteArrayType(AType : TPasArrayType; Full : Boolean = True); virtual;
     procedure WriteProcType(AProc: TPasProcedureType);  virtual;
     procedure WriteProcDecl(AProc: TPasProcedure; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
     procedure WriteProcImpl(AProc: TProcedureBody; IsAsm : Boolean = false); virtual;
@@ -282,7 +282,7 @@ begin
   else if AType is TPasProcedureType then
     WriteProcType(TPasProcedureType(AType))
   else if AType is TPasArrayType then
-    WriteArrayType(TPasArrayType(AType))
+    WriteArrayType(TPasArrayType(AType),Full)
   else if AType is TPasRecordType then
     WriteRecordType(TPasRecordType(AType))
   else if AType is TPasAliasType then
@@ -291,6 +291,8 @@ begin
     Add(AType.GetDeclaration(true))
   else if AType is TPasSetType then
     Add(AType.GetDeclaration(true))
+  else if AType is TPasRangeType then
+    Add(AType.GetDeclaration(true))
   else
     raise EPasWriter.CreateFmt('Writing not implemented for %s type nodes',[aType.ElementTypeName]);
   if Full then
@@ -785,10 +787,10 @@ begin
   end;
 end;
 
-procedure TPasWriter.WriteArrayType(AType: TPasArrayType);
+procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True);
 
 begin
-  Add(AType.GetDeclaration(true));
+  Add(AType.GetDeclaration(Full));
 end;
 
 procedure TPasWriter.WriteProcType(AProc: TPasProcedureType);

packages/fcl-process/src/dbugintf.pp

@@ -41,13 +41,14 @@ function GetDebuggingEnabled : Boolean;
 
 Function  StartDebugServer : integer;
 Function InitDebugClient : Boolean;
+Function InitDebugClient(const ShowOrNotPID: Boolean) : Boolean; overload;
 
 Const
   SendError       : String = '';
   DefaultDebugServer = 'debugserver';
  
 ResourceString
-  SProcessID = 'Process %s';
+  SProcessID = 'Process %s (PID=%d)';
   SEntering = '> Entering ';
   SExiting  = '< Exiting ';
   SSeparator = '>-=-=-=-=-=-=-=-=-=-=-=-=-=-=-<';
@@ -72,6 +73,7 @@ Const
 var
   DebugClient : TSimpleIPCClient = nil;
   MsgBuffer : TMemoryStream = Nil;
+  AlwaysDisplayPID : Boolean = False;
   ServerID : Integer;
   DebugDisabled : Boolean = False;
   Indent : Integer = 0;
@@ -139,7 +141,10 @@ Var
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=ErrorLevel[MTYpe];
-  Mesg.Msg:=Msg;
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
+  else
+    Mesg.Msg:=Msg;
   SendDebugMessage(Mesg);
 end;
 
@@ -150,7 +155,10 @@ Var
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=dmtInformation;
-  Mesg.Msg:=Msg;
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Msg
+  else
+    Mesg.Msg:=Msg;
   SendDebugMessage(Mesg);
 end;
 
@@ -184,7 +192,10 @@ Var
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=dmtInformation;
-  Mesg.Msg:=Format(Msg,Args);
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
+  else
+    Mesg.Msg:=Format(Msg,Args);
   SendDebugMessage(Mesg);
 end;
 
@@ -196,7 +207,10 @@ Var
 begin
   Mesg.MsgTimeStamp:=Now;
   Mesg.MsgType:=ErrorLevel[mType];
-  Mesg.Msg:=Format(Msg,Args);
+  if AlwaysDisplayPID then
+    Mesg.Msg:=IntToStr(GetProcessID)+' '+Format(Msg,Args)
+  else
+    Mesg.Msg:=Format(Msg,Args);
   SendDebugMessage(Mesg);
 end;
 
@@ -247,7 +261,7 @@ begin
       begin
       Msg.MsgType:=lctStop;
       Msg.MsgTimeStamp:=Now;
-      Msg.Msg:=Format(SProcessID,[ApplicationName]);
+      Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
       WriteMessage(Msg);
       end;
     if assigned(MsgBuffer) then FreeAndNil(MsgBuffer);
@@ -261,7 +275,7 @@ Function InitDebugClient : Boolean;
 Var
   msg : TDebugMessage;
   I : Integer;
-  
+
 begin
   Result := False;
   DebugClient:=TSimpleIPCClient.Create(Nil);
@@ -294,11 +308,17 @@ begin
   MsgBuffer:=TMemoryStream.Create;
   Msg.MsgType:=lctIdentify;
   Msg.MsgTimeStamp:=Now;
-  Msg.Msg:=Format(SProcessID,[ApplicationName]);
+  Msg.Msg:=Format(SProcessID,[ApplicationName, GetProcessID]);
   WriteMessage(Msg);
   Result := True;
 end;
 
+function InitDebugClient(const ShowOrNotPID: Boolean): Boolean;
+begin
+  AlwaysDisplayPID:= ShowOrNotPID;
+  Result:= InitDebugClient;
+end;
+
 Finalization
   FreeDebugClient;
 end.

tests/webtbs/tw37477.pp

@@ -0,0 +1,6 @@
+{ %OPT=-O3 }
+{ %norun }
+var a : integer;
+begin
+    write(a = a in[a in[a], a / 0 > a])
+end.