Procházet zdrojové kódy

Merge branch 'main' into wasm_goto

Nikolay Nikolov před 1 rokem
rodič
revize
b713a64504
100 změnil soubory, kde provedl 6504 přidání a 3484 odebrání
  1. 1 0
      .gitignore
  2. 1 0
      compiler/.gitignore
  3. 2 3
      compiler/aarch64/cpupara.pas
  4. 1 1
      compiler/cfileutl.pas
  5. 5 1
      compiler/cgbase.pas
  6. 12 26
      compiler/comphook.pas
  7. 83 21
      compiler/cresstr.pas
  8. 1 0
      compiler/dbgbase.pas
  9. 22 0
      compiler/defutil.pas
  10. 3 1
      compiler/export.pas
  11. 23 0
      compiler/fmodule.pas
  12. 30 20
      compiler/fppu.pas
  13. 46 3
      compiler/globals.pas
  14. 4 1
      compiler/globtype.pas
  15. 1 1
      compiler/htypechk.pas
  16. 2 2
      compiler/ldscript.pas
  17. 11 3
      compiler/llvm/llvminfo.pas
  18. 6 1
      compiler/llvm/llvmpara.pas
  19. 16 7
      compiler/loongarch64/agcpugas.pas
  20. 1 1
      compiler/loongarch64/loongarchreg.dat
  21. 1 1
      compiler/loongarch64/rloongarch64abi.inc
  22. 86 46
      compiler/msg/errord.msg
  23. 86 46
      compiler/msg/errordu.msg
  24. 81 23
      compiler/msg/errore.msg
  25. 15 3
      compiler/msgidx.inc
  26. 328 311
      compiler/msgtxt.inc
  27. 18 6
      compiler/nadd.pas
  28. 4 3
      compiler/ncal.pas
  29. 8 0
      compiler/ncgrtti.pas
  30. 25 8
      compiler/ncnv.pas
  31. 2 2
      compiler/ngenutil.pas
  32. 21 6
      compiler/ninl.pas
  33. 384 16
      compiler/ogcoff.pas
  34. 1 1
      compiler/ogmap.pas
  35. 15 1
      compiler/ogwasm.pas
  36. 2745 2466
      compiler/options.pas
  37. 1 1
      compiler/owomflib.pas
  38. 3 1
      compiler/pbase.pas
  39. 32 10
      compiler/pdecl.pas
  40. 12 1
      compiler/pdecobj.pas
  41. 73 14
      compiler/pdecsub.pas
  42. 5 1
      compiler/pdecvar.pas
  43. 18 0
      compiler/pexports.pas
  44. 27 2
      compiler/pexpr.pas
  45. 8 1
      compiler/pgenutil.pas
  46. 58 6
      compiler/pmodules.pas
  47. 1 1
      compiler/powerpc64/cpubase.pas
  48. 101 62
      compiler/pparautl.pas
  49. 2 0
      compiler/ppcx64.lpi
  50. 1 1
      compiler/ppu.pas
  51. 12 12
      compiler/procdefutil.pas
  52. 0 39
      compiler/psub.pas
  53. 13 3
      compiler/psystem.pas
  54. 11 3
      compiler/ptype.pas
  55. 17 6
      compiler/riscv/agrvgas.pas
  56. 18 5
      compiler/riscv32/cpuinfo.pas
  57. 8 3
      compiler/riscv32/cpupara.pas
  58. 34 0
      compiler/scandir.pas
  59. 1 1
      compiler/scanner.pas
  60. 3 0
      compiler/sparcgen/cgsparc.pas
  61. 17 3
      compiler/symconst.pas
  62. 660 6
      compiler/symcreat.pas
  63. 23 1
      compiler/symdef.pas
  64. 11 1
      compiler/symtable.pas
  65. 1 1
      compiler/systems.pas
  66. 2 2
      compiler/systems/i_embed.pas
  67. 1 1
      compiler/systems/i_linux.pas
  68. 3 1
      compiler/systems/t_bsd.pas
  69. 67 30
      compiler/systems/t_embed.pas
  70. 70 28
      compiler/systems/t_linux.pas
  71. 12 3
      compiler/systems/t_wasi.pas
  72. 21 19
      compiler/systems/t_win.pas
  73. 10 0
      compiler/tokens.pas
  74. 35 1
      compiler/utils/dummyas.pp
  75. 199 53
      compiler/utils/fpc.pp
  76. 17 2
      compiler/utils/ppuutils/ppudump.pp
  77. 6 26
      compiler/verbose.pas
  78. 17 2
      compiler/wasm32/aasmcpu.pas
  79. 11 4
      compiler/wasm32/agllvmmc.pas
  80. 20 0
      compiler/wasm32/cgcpu.pas
  81. 7 1
      compiler/wasm32/cpubase.pas
  82. 1 0
      compiler/wasm32/cpunode.pas
  83. 100 7
      compiler/wasm32/hlcgcpu.pas
  84. 1 1
      compiler/wasm32/itcpugas.pas
  85. 27 1
      compiler/wasm32/nwasmcal.pas
  86. 12 0
      compiler/wasm32/nwasmcnv.pas
  87. 63 0
      compiler/wasm32/nwasmmem.pas
  88. 28 2
      compiler/wasm32/rgcpu.pas
  89. 1 1
      compiler/wasm32/strinst.inc
  90. 131 12
      compiler/wasm32/symcpu.pas
  91. 28 1
      compiler/wasm32/tgcpu.pas
  92. 30 2
      compiler/x86/aasmcpu.pas
  93. 30 0
      compiler/x86/agx86att.pas
  94. 115 26
      compiler/x86/aoptx86.pas
  95. 10 3
      compiler/x86/cpubase.pas
  96. 3 3
      compiler/x86/nx86set.pas
  97. 12 1
      compiler/x86/rax86.pas
  98. 145 30
      compiler/x86/rax86att.pas
  99. 2 2
      compiler/x86/rax86int.pas
  100. 5 3
      compiler/x86_64/cpupara.pas

+ 1 - 0
.gitignore

@@ -29,6 +29,7 @@
 *.app
 *.ttp
 *.prg
+*.compiled
 fpcmade.*
 *-stamp.*
 build-stamp.*

+ 1 - 0
compiler/.gitignore

@@ -0,0 +1 @@
+msg2inc

+ 2 - 3
compiler/aarch64/cpupara.pas

@@ -309,10 +309,9 @@ unit cpupara;
            Therefore at caller side force the ordinal result to be always 64-bit, so it
            will be stripped to the required size and uneeded bits are discarded.
 
-           This is not required for iOS, where the result is zero/sign extended.
+           According to Jonas iOS doesn't zero extend results in the callee either
          }
-         if (target_info.abi<>abi_aarch64_darwin) and
-            (side=callerside) and (result.location^.loc = LOC_REGISTER) and
+         if (side=callerside) and (result.location^.loc = LOC_REGISTER) and
             (result.def.size<8) and is_ordinal(result.def) then
            begin
              result.location^.size:=OS_64;

+ 1 - 1
compiler/cfileutl.pas

@@ -70,7 +70,7 @@ interface
 
       TCachedSearchRec = record
         Name       : TCmdStr;
-        Attr       : byte;
+        Attr       : longint;
         Pattern    : TCmdStr;
         CachedDir  : TCachedDirectory;
         EntryIndex : longint;

+ 5 - 1
compiler/cgbase.pas

@@ -241,7 +241,11 @@ interface
         { used on llvm for tracking metadata (every unique metadata has its own base register) }
         R_METADATAREGISTER,{ = 8 }
         { optional MAC16 (16 bit multiply-accumulate) registers on Xtensa }
-        R_MAC16REGISTER    { = 9 }
+        R_MAC16REGISTER,   { = 9 }
+        { WebAssembly externref }
+        R_EXTERNREFREGISTER, { = 10 }
+        { WebAssembly funcref }
+        R_FUNCREFREGISTER  { = 11 }
 
         { do not add more than 16 elements (ifdef by cpu type if needed)
           so we can store this in one nibble and pack TRegister

+ 12 - 26
compiler/comphook.pas

@@ -34,31 +34,6 @@ uses
   globtype,
   finput;
 
-Const
-  { Levels }
-  V_None         = $0;
-  V_Fatal        = $1;
-  V_Error        = $2;
-  V_Normal       = $4; { doesn't show a text like Error: }
-  V_Warning      = $8;
-  V_Note         = $10;
-  V_Hint         = $20;
-  V_LineInfoMask = $fff;
-  { From here by default no line info }
-  V_Info         = $1000;
-  V_Status       = $2000;
-  V_Used         = $4000;
-  V_Tried        = $8000;
-  V_Conditional  = $10000;
-  V_Debug        = $20000;
-  V_Executable   = $40000;
-  V_TimeStamps   = $80000;
-  V_LevelMask    = $fffffff;
-  V_All          = V_LevelMask;
-  V_Default      = V_Fatal + V_Error + V_Normal;
-  { Flags }
-  V_LineInfo     = $10000000;
-
 const
   { RHIDE expect gcc like error output }
   fatalstr      : string[6] = 'Fatal:';
@@ -69,6 +44,7 @@ const
   warningerrorstr    : string[29] = 'Warning: (treated as error)';
   noteerrorstr       : string[27] = 'Note: (treated as error)';
   hinterrorstr       : string[27] = 'Hint: (treated as error)';
+
 type
   PCompilerStatus = ^TCompilerStatus;
   TCompilerStatus = record
@@ -334,8 +310,18 @@ begin
         MsgTypeStr:=errorstr;
       if (status.verbosity and Level)=V_Fatal then
         MsgTypeStr:=fatalstr;
-      if (status.verbosity and Level)=V_Used then
+      if (status.verbosity and V_Parallel)=V_Parallel then
+        begin
+          if (inputfilename<>'') and (status.currentmodule<>'') then
+            MsgTypeStr:=MsgTypeStr+'('+inputfilename+'/'+status.currentmodule+')'
+          else if (status.currentmodule<>'') then
+            MsgTypeStr:=MsgTypeStr+'('+status.currentmodule+')'
+          else if (inputfilename<>'') then
+            MsgTypeStr:=MsgTypeStr+'('+inputfilename+')';
+        end
+      else if (status.verbosity and Level)=V_Used then
         MsgTypeStr:=PadSpace('('+status.currentmodule+')',10);
+
     end
   else
     begin

+ 83 - 21
compiler/cresstr.pas

@@ -34,7 +34,7 @@ uses
    SysUtils,
    cclasses,widestr,
    cutils,globtype,globals,systems,
-   symbase,symconst,symtype,symdef,symsym,symtable,
+   symbase,symconst,symtype,defutil, symdef,symsym,symtable,
    verbose,fmodule,ppu,
    aasmtai,aasmdata,aasmcnst,
    aasmcpu;
@@ -44,9 +44,11 @@ uses
       TResourceStringItem = class(TLinkedListItem)
         Sym   : TConstSym;
         Name  : String;
-        Value : Pchar;
-        Len   : Longint;
+        AValue : PAnsiChar;
+        WValue : pcompilerwidestring; // just a reference, do not free.
+        Len   : Longint; // in bytes, not characters
         hash  : Cardinal;
+        isUnicode : Boolean;
         constructor Create(asym:TConstsym);
         destructor  Destroy;override;
         procedure CalcHash;
@@ -71,33 +73,67 @@ uses
   ---------------------------------------------------------------------}
 
     constructor TResourceStringItem.Create(asym:TConstsym);
+
+    var
+      pw : pcompilerwidestring;
+      t : TDef;
+
       begin
         inherited Create;
         Sym:=Asym;
         Name:=lower(asym.owner.name^+'.'+asym.Name);
-        Len:=asym.value.len;
-        GetMem(Value,Len);
-        Move(asym.value.valueptr^,Value^,Len);
+        isUnicode:=is_systemunit_unicode;
+        if IsUnicode then
+          begin
+          T:=aSym.constdef;
+          WValue:=pcompilerwidestring(asym.value.valueptr);
+          Len:=WValue^.len*sizeOf(tcompilerwidechar);
+          end
+        else
+          begin
+          Len:=asym.value.len;
+          GetMem(AValue,Len);
+          Move(asym.value.valueptr^,AValue^,Len);
+          end;
         CalcHash;
       end;
 
 
     destructor TResourceStringItem.Destroy;
       begin
-        FreeMem(Value);
+        if Assigned(AValue) then
+          FreeMem(AValue);
       end;
 
 
     procedure TResourceStringItem.CalcHash;
       Var
         g : Cardinal;
-        I : longint;
+        llen,wlen,I : longint;
+        P : PByte;
+        pc : PAnsiChar;
+
       begin
+        pc:=nil;
         hash:=0;
-        For I:=0 to Len-1 do { 0 terminated }
+        if IsUnicode then
+          begin
+          // Need to calculate hash on UTF8 encoded string, GNU gettext.
+          llen:=UnicodeToUtf8(nil,0,PUnicodeChar(wValue^.data),wValue^.len);
+          getmem(pc,llen);
+          UnicodeToUtf8(PC,llen,PUnicodeChar(wValue^.data),len);
+          P:=PByte(pc);
+          llen:=llen-1; // Take of terminating #0
+          end
+        else
+          begin
+          llen:=Len;
+          P:=PByte(AValue);
+          end;
+        For I:=0 to lLen-1 do { 0 terminated }
          begin
            hash:=hash shl 4;
-           inc(Hash,Ord(Value[i]));
+           inc(Hash,P[i]);
            g:=hash and ($f shl 28);
            if g<>0 then
             begin
@@ -105,6 +141,8 @@ uses
               hash:=hash xor g;
             end;
          end;
+        if Assigned(Pc) then
+          FreeMem(PC);
         If Hash=0 then
           Hash:=$ffffffff;
       end;
@@ -133,6 +171,8 @@ uses
         R : TResourceStringItem;
         resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
+        enc : tstringencoding;
+
       begin
         resstrdef:=search_system_type('TRESOURCESTRINGRECORD').typedef;
 
@@ -157,12 +197,20 @@ uses
         while assigned(R) do
           begin
             tcb:=ctai_typedconstbuilder.create([tcalo_vectorized_dead_strip_item,tcalo_data_force_indirect]);
-            if assigned(R.value) and (R.len<>0) then
-              valuelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage)
-            else
+            valuelab.lab:=nil;
+            valuelab.ofs:=0;
+            if (R.len<>0) then
               begin
-                valuelab.lab:=nil;
-                valuelab.ofs:=0;
+              if R.isUnicode and assigned(R.WValue) then
+                begin
+                enc:=tstringdef(cunicodestringtype).encoding;
+                valuelab:=tcb.emit_unicodestring_const(current_asmdata.asmlists[al_const],R.WValue,enc,False);
+                end
+              else
+                begin
+                if assigned(R.AValue) then
+                  valuelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],R.AValue,R.Len,getansistringcodepage)
+                end;
               end;
             current_asmdata.asmlists[al_const].concat(cai_align.Create(sizeof(pint)));
             namelab:=tcb.emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage);
@@ -171,7 +219,7 @@ uses
                   TResourceStringRecord = Packed Record
                      Name,
                      CurrentValue,
-                     DefaultValue : AnsiString;
+                     DefaultValue : AnsiString/Widestring;
                      HashValue    : LongWord;
                    end;
             }
@@ -205,9 +253,11 @@ uses
         F: Text;
         R: TResourceStringItem;
         ResFileName: string;
-        I: Integer;
+        I,Len: Integer;
         C: tcompilerwidechar;
         W: pcompilerwidestring;
+        P : PByte;
+
       begin
         ResFileName:=ChangeFileExt(current_module.ppufilename,'.rsj');
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
@@ -229,15 +279,26 @@ uses
         while assigned(R) do
           begin
             write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","sourcebytes":[');
+            if R.isUnicode then
+              P:=PByte(R.WValue^.data)
+            else
+              P:=PByte(R.AValue);
             for i:=0 to R.Len-1 do
               begin
-                write(f,ord(R.Value[i]));
+                write(f,P[i]);
                 if i<>R.Len-1 then
                   write(f,',');
               end;
             write(f,'],"value":"');
-            initwidestring(W);
-            ascii2unicode(R.Value,R.Len,current_settings.sourcecodepage,W);
+            if Not r.isUnicode then
+              begin
+              initwidestring(W);
+              ascii2unicode(R.AValue,R.Len,current_settings.sourcecodepage,W);
+              end
+            else
+              begin
+              W:=R.WValue;
+              end;
             for I := 0 to W^.len - 1 do
               begin
                 C := W^.Data[I];
@@ -261,7 +322,8 @@ uses
                     write(f,Chr(C));
                 end;
               end;
-            donewidestring(W);
+            if W<>R.WValue then
+              donewidestring(W);
             write(f,'"}');
             R:=TResourceStringItem(R.Next);
             if assigned(R) then

+ 1 - 0
compiler/dbgbase.pas

@@ -103,6 +103,7 @@ implementation
 
     uses
       cutils,
+      globals,
       verbose,
       cgbase;
 

+ 22 - 0
compiler/defutil.pas

@@ -313,6 +313,9 @@ interface
     { true, if def is a signed int type, equal in size to the processor's native int size }
     function is_nativesint(def : tdef) : boolean;
 
+    { true, if the char type is a widechar in the system unit }
+    function is_systemunit_unicode : boolean;
+
   type
     tperformrangecheck = (
       rc_internal,  { nothing, internal conversion }
@@ -417,6 +420,7 @@ implementation
 
     uses
        verbose,cutils,
+       symtable, // search_system_type
        symsym,
        cpuinfo;
 
@@ -1250,6 +1254,24 @@ implementation
          result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [s64bit,s32bit,s16bit,s8bit]);
       end;
 
+    function is_systemunit_unicode: boolean;
+
+    var
+      t : ttypesym;
+
+    begin
+      if cchartype=nil then
+        begin
+          t:=search_system_type('CHAR');
+          if t<>nil then
+            cchartype:=t.typedef;
+        end;
+      if cchartype=nil then
+        is_systemunit_unicode:=(sizeof(char)=2)
+      else
+        is_systemunit_unicode:=(cchartype.size=2);
+    end;
+
     { if l isn't in the range of todef a range check error (if not explicit) is generated and
       the value is placed within the range }
     procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);

+ 3 - 1
compiler/export.pas

@@ -37,7 +37,9 @@ type
      eo_resident,
      eo_index,
      eo_name,
-     eo_no_sym_name { don't try to use another mangled name if symbol is known }
+     eo_no_sym_name, { don't try to use another mangled name if symbol is known }
+     eo_promising_first,
+     eo_promising_last
    );
    texportoptions=set of texportoption;
 

+ 23 - 0
compiler/fmodule.pas

@@ -174,6 +174,7 @@ interface
         loaded_from   : tmodule;
         _exports      : tlinkedlist;
         dllscannerinputlist : TFPHashList;
+        localnamespacelist,
         resourcefiles,
         linkorderedsymbols : TCmdStrList;
         linkunitofiles,
@@ -241,6 +242,7 @@ interface
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         destructor destroy;override;
         procedure reset;virtual;
+        procedure loadlocalnamespacelist;
         procedure adddependency(callermodule:tmodule);
         procedure flagdependent(callermodule:tmodule);
         procedure addimportedsym(sym:TSymEntry);
@@ -572,6 +574,7 @@ implementation
         localframeworksearchpath:=TSearchPathList.Create;
         used_units:=TLinkedList.Create;
         dependent_units:=TLinkedList.Create;
+        localnamespacelist:=TCmdStrList.Create;
         resourcefiles:=TCmdStrList.Create;
         linkorderedsymbols:=TCmdStrList.Create;
         linkunitofiles:=TLinkContainer.Create;
@@ -946,6 +949,26 @@ implementation
         }
       end;
 
+    procedure tmodule.loadlocalnamespacelist;
+
+    var
+      nsitem : TCmdStrListItem;
+
+    begin
+      // Copying local namespace list
+      if premodule_namespacelist.Count>0 then
+        begin
+        nsitem:=TCmdStrListItem(premodule_namespacelist.First);
+        while assigned(nsItem) do
+          begin
+          localnamespacelist.Concat(nsitem.Str);
+          nsItem:=TCmdStrListItem(nsitem.Next);
+          end;
+        premodule_namespacelist.Clear;
+        end;
+      current_namespacelist:=localnamespacelist;
+    end;
+
 
     procedure tmodule.adddependency(callermodule:tmodule);
       begin

+ 30 - 20
compiler/fppu.pas

@@ -562,10 +562,35 @@ var
              result:=SearchPathList(UnitSearchPath,prefix);
          end;
 
+         function SearchNamespaceList(const prefixes:TCmdStrList):boolean;
+         var
+           nsitem : TCmdStrListItem;
+           res : Boolean;
+         begin
+           res:=false;
+           nsitem:=TCmdStrListItem(prefixes.first);
+           while assigned(nsitem) do
+             begin
+               if not onlysource then
+                 begin
+                   res:=SearchPPUPaths(nsitem.str);
+                   if res then
+                     break;
+                 end;
+               res:=SearchSourcePaths(nsitem.str);
+               if res then
+                 break;
+               nsitem:=TCmdStrListItem(nsitem.next);
+             end;
+           if assigned(nsitem) then
+             nsprefix:=nsitem.str;
+           result:=res;
+         end;
+
+
        var
          fnd : boolean;
          hs : TPathStr;
-         nsitem : TCmdStrListItem;
        begin
          if shortname then
           filename:=FixFileName(Copy(realmodulename^,1,8))
@@ -618,26 +643,11 @@ var
          if not fnd then
            begin
              fnd:=SearchSourcePaths('');
+             // current_namespacelist is set to the current module's namespacelist.
+             if not fnd and assigned(current_namespacelist) and (current_namespacelist.count>0) then
+               fnd:=SearchNameSpaceList(current_namespacelist);
              if not fnd and (namespacelist.count>0) then
-               begin
-                 nsitem:=TCmdStrListItem(namespacelist.first);
-                 while assigned(nsitem) do
-                   begin
-                     if not onlysource then
-                       begin
-                         fnd:=SearchPPUPaths(nsitem.str);
-                         if fnd then
-                           break;
-                       end;
-                     fnd:=SearchSourcePaths(nsitem.str);
-                     if fnd then
-                       break;
-
-                     nsitem:=TCmdStrListItem(nsitem.next);
-                   end;
-                 if assigned(nsitem) then
-                   nsprefix:=nsitem.str;
-               end;
+               fnd:=SearchNameSpaceList(namespacelist);
            end;
          search_unit:=fnd;
       end;

+ 46 - 3
compiler/globals.pas

@@ -124,6 +124,33 @@ interface
        nroftrashvalues = 4;
        trashintvalues: array[0..nroftrashvalues-1] of int64 = ($5555555555555555,$AAAAAAAAAAAAAAAA,$EFEFEFEFEFEFEFEF,0);
 
+{ Verbosity constants }
+Const
+  { Levels }
+  V_None         = $0;
+  V_Fatal        = $1;
+  V_Error        = $2;
+  V_Normal       = $4; { doesn't show a text like Error: }
+  V_Warning      = $8;
+  V_Note         = $10;
+  V_Hint         = $20;
+  V_LineInfoMask = $fff;
+  { From here by default no line info }
+  V_Info         = $1000;
+  V_Status       = $2000;
+  V_Used         = $4000;
+  V_Tried        = $8000;
+  V_Conditional  = $10000;
+  V_Debug        = $20000;
+  V_Executable   = $40000;
+  V_TimeStamps   = $80000;
+  V_LevelMask    = $ffffff;
+  V_All          = V_LevelMask;
+  V_Default      = V_Fatal + V_Error + V_Normal;
+  { Flags }
+  V_LineInfo     = $10000000;
+  V_Parallel     = $20000000;
+
 
     type
        { this is written to ppus during token recording for generics,
@@ -256,6 +283,9 @@ interface
        outputfilename    : string;
        outputprefix      : pshortstring;
        outputsuffix      : pshortstring;
+       { selected subtarget }
+       subtarget         : string;
+
        { specified with -FE or -FU }
        outputexedir      : TPathStr;
        outputunitdir     : TPathStr;
@@ -313,8 +343,13 @@ interface
        includesearchpath,
        frameworksearchpath  : TSearchPathList;
        packagesearchpath     : TSearchPathList;
+
        { list of default namespaces }
        namespacelist : TCmdStrList;
+       // During scanning/parsing, a module may not yet be available.
+       // Scanner checks first current_namespacelist, then local_namespacelist
+       premodule_namespacelist,                    // always set: used as long as current_namespacelist is not correctly set.
+       current_namespacelist : TCmdStrList;        // Set when parsing module to the current module's namespace.
        { contains tpackageentry entries }
        packagelist : TFPHashList;
        autoloadunits      : string;
@@ -375,6 +410,7 @@ interface
        LinkLibraryAliases : TLinkStrMap;
        LinkLibraryOrder   : TLinkStrMap;
 
+
        init_settings,
        current_settings   : tsettings;
 
@@ -653,7 +689,7 @@ interface
     function getrealtime(const st: TSystemTime) : real;
     function getrealtime : real;
 
-    procedure DefaultReplacements(var s:ansistring);
+    procedure DefaultReplacements(var s:ansistring; substitute_env_variables:boolean=true);
 
     function  GetEnvPChar(const envname:ansistring):pchar;
     procedure FreeEnvPChar(p:pchar);
@@ -952,7 +988,7 @@ implementation
 ****************************************************************************}
 
 
-     procedure DefaultReplacements(var s:ansistring);
+     procedure DefaultReplacements(var s:ansistring; substitute_env_variables:boolean=true);
 {$ifdef mswindows}
        procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer);
          begin
@@ -1002,6 +1038,8 @@ implementation
          if (tf_use_8_3 in Source_Info.Flags) or
             (tf_use_8_3 in Target_Info.Flags) then
            Replace(s,'$FPCTARGET',target_os_string)
+         else if subtarget<>'' then
+           Replace(s,'$FPCTARGET',target_full_string+'-'+lower(subtarget))
          else
            Replace(s,'$FPCTARGET',target_full_string);
          Replace(s,'$FPCSUBARCH',lower(cputypestr[init_settings.cputype]));
@@ -1024,6 +1062,8 @@ implementation
          Replace(s,'$OPENBSD_LOCALBASE',GetOpenBSDLocalBase);
          Replace(s,'$OPENBSD_X11BASE',GetOpenBSDX11Base);
 {$endif openbsd}
+         if not substitute_env_variables then
+           exit;
          { Replace environment variables between dollar signs }
          i := pos('$',s);
          while i>0 do
@@ -1646,6 +1686,8 @@ implementation
        LinkLibraryOrder.Free;
        packagesearchpath.Free;
        namespacelist.Free;
+       premodule_namespacelist.Free;
+       current_namespacelist:=Nil;
      end;
 
    procedure InitGlobals;
@@ -1687,7 +1729,8 @@ implementation
         frameworksearchpath:=TSearchPathList.Create;
         packagesearchpath:=TSearchPathList.Create;
         namespacelist:=TCmdStrList.Create;
-
+        premodule_namespacelist:=TCmdStrList.Create;
+        current_namespacelist:=Nil;
         { Def file }
         usewindowapi:=false;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;

+ 4 - 1
compiler/globtype.pas

@@ -232,6 +232,7 @@ interface
          cs_link_native,
          cs_link_pre_binutils_2_19,
          cs_link_vlink,
+         cs_link_discard_start,cs_link_discard_zeroreg_sp,cs_link_discard_copydata,cs_link_discard_jmp_main,
          { disable LTO for the system unit (needed to work around linker bugs on macOS) }
          cs_lto_nosystem,
          cs_assemble_on_target,
@@ -239,7 +240,9 @@ interface
            this not supported on all OSes }
          cs_large,
          { if applicable, the compiler generates an executable in uf2 format }
-         cs_generate_uf2
+         cs_generate_uf2,
+	 { Use ld.lld linker }
+         cs_link_lld
        );
        tglobalswitches = set of tglobalswitch;
 

+ 1 - 1
compiler/htypechk.pas

@@ -1869,7 +1869,7 @@ implementation
                begin
                  if ((valid_const in opts) and
                      (tinlinenode(hp).inlinenumber in [in_typeof_x])) or
-                    (tinlinenode(hp).inlinenumber in [in_unaligned_x,in_aligned_x]) then
+                    (tinlinenode(hp).inlinenumber in [in_unaligned_x,in_aligned_x,in_volatile_x]) then
                    result:=true
                  else
                    if report_errors then

+ 2 - 2
compiler/ldscript.pas

@@ -278,9 +278,9 @@ procedure TScriptLexer.nextToken;
       tkLSHIFT..tkEQ: inc(p,2);
       #32..#255: inc(p);
       tkIDENT,tkNUMBER:
-        setstring(curtokenstr,@data[start],p-start);
+        setstring(curtokenstr,PChar(@data[start]),p-start);
       tkLITERAL:
-        setstring(curtokenstr,@data[start+1],p-start-2);
+        setstring(curtokenstr,PChar(@data[start+1]),p-start-2);
     end;
     curpos:=p;
   end;

+ 11 - 3
compiler/llvm/llvminfo.pas

@@ -55,8 +55,10 @@ Type
        llvmver_xc_13_3,
        llvmver_xc_14_0,
        llvmver_14_0,
+       llvmver_xc_14_3,
        llvmver_15_0,
-       llvmver_16_0
+       llvmver_16_0,
+       llvmver_17_0
       );
 
 type
@@ -99,8 +101,10 @@ Const
      'Xcode-13.3',
      'Xcode-14.0',
      '14.0',
+     'Xcode-14.3',
      '15.0',
-     '16.0'
+     '16.0',
+     '17.0'
    );
 
    llvm_debuginfo_metadata_format : array[tllvmversion] of byte = (
@@ -123,6 +127,8 @@ Const
      3,
      3,
      3,
+     3,
+     3,
      3
    );
 
@@ -146,8 +152,10 @@ Const
        { llvmver_xc_13_3 } [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type, llvmflag_old_function_memory_attributes],
        { llvmver_xc_14_0 } [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_old_function_memory_attributes],
        { llvmver_14_0 }    [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr_transition, llvmflag_old_function_memory_attributes],
+       { llvmver_xc_14_3 } [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr,llvmflag_sanitizer_attributes, llvmflag_old_function_memory_attributes],
        { llvmver_15_0 }    [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr,llvmflag_sanitizer_attributes, llvmflag_old_function_memory_attributes],
-       { llvmver_16_0 }    [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr,llvmflag_sanitizer_attributes]
+       { llvmver_16_0 }    [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr,llvmflag_sanitizer_attributes],
+       { llvmver_17_0 }    [llvmflag_memcpy_indiv_align,llvmflag_null_pointer_valid_new,llvmflag_constrained_fptrunc_fpext,llvmflag_constrained_fptoi_itofp,llvmflag_array_datalocation,llvmflag_para_attr_type,llvmflag_opaque_ptr,llvmflag_sanitizer_attributes]
      );
 
    { Supported optimizations, only used for information }

+ 6 - 1
compiler/llvm/llvmpara.pas

@@ -163,7 +163,12 @@ unit llvmpara;
         paralocs }
       while assigned(paraloc) do
         begin
-          if (vo_is_funcret in parasym.varoptions)
+          if (vo_is_funcret in parasym.varoptions) and
+             { sret attribute is only valid for the first parameter; sometimes
+               FPC will place other parameters first (e.g. self), and then
+               we can't use it; we use other attributes in that case to
+               approximate the optimisations that LLVM can do for sret }
+             (tabstractprocdef(parasym.owner.defowner).paras[0] = parasym)
  {$ifdef aarch64}
              { see AArch64's tcpuparamanager.create_paraloc_info_intern() }
              and not is_managed_type(parasym.vardef)

+ 16 - 7
compiler/loongarch64/agcpugas.pas

@@ -54,11 +54,10 @@ unit agcpugas;
 
     uses
        cutils,globals,verbose,
-       cgbase,
+       cgbase,rgbase,
        itcpugas,cpuinfo,
        aasmcpu;
 
-
     function getreferencestring(asminfo: pasminfo; var ref : treference) : string;
     var
       s : string;
@@ -143,13 +142,16 @@ unit agcpugas;
     end;
 
 
-    function getopstr(asminfo: pasminfo; const o:toper) : string;
+    function getopstr(asminfo: pasminfo; const o:toper;use_std_regname : boolean) : string;
     var
       hs : string;
     begin
       case o.typ of
         top_reg:
-          getopstr:=gas_regname(o.reg);
+          if use_std_regname then
+            getopstr:=std_regname(o.reg)
+          else
+            getopstr:=gas_regname(o.reg);
         top_const:
           getopstr:=tostr(o.val);
         top_ref:
@@ -159,11 +161,11 @@ unit agcpugas;
       end;
     end;
 
-
     Procedure TLoongArch64InstrWriter.WriteInstruction(hp : tai);
     var op: TAsmOp;
         s: string;
-        i: byte;
+	i : byte;
+	use_std_regname_index : byte;
         sep: string[3];
     begin
       s:=#9+gas_op2str[taicpu(hp).opcode];
@@ -171,12 +173,19 @@ unit agcpugas;
         s:=s+cond2str[taicpu(hp).condition];
 
       curop:=taicpu(hp).opcode;
+      if curop=A_MOVFCSR2GR then
+        use_std_regname_index:=1
+      else if curop=A_MOVGR2FCSR then
+        use_std_regname_index:=0
+      else
+        use_std_regname_index:=255;
+
       if taicpu(hp).ops<>0 then
         begin
           sep:=#9;
           for i:=0 to taicpu(hp).ops-1 do
             begin
-               s:=s+sep+getopstr(owner.asminfo,taicpu(hp).oper[i]^);
+               s:=s+sep+getopstr(owner.asminfo,taicpu(hp).oper[i]^,use_std_regname_index=i);
                sep:=',';
             end;
         end;

+ 1 - 1
compiler/loongarch64/loongarchreg.dat

@@ -28,7 +28,7 @@ R17,$01,$00,$11,$t5,$r17,17,17
 R18,$01,$00,$12,$t6,$r18,18,18
 R19,$01,$00,$13,$t7,$r19,19,19
 R20,$01,$00,$14,$t8,$r20,20,20
-R21,$01,$00,$15,$x,$r21,21,21
+R21,$01,$00,$15,$r21,$r21,21,21
 R22,$01,$00,$16,$fp,$r22,22,22
 R23,$01,$00,$17,$s0,$r23,23,23
 R24,$01,$00,$18,$s1,$r24,24,24

+ 1 - 1
compiler/loongarch64/rloongarch64abi.inc

@@ -21,7 +21,7 @@
 '$t6',
 '$t7',
 '$t8',
-'$x',
+'$r21',
 '$fp',
 '$s0',
 '$s1',

+ 86 - 46
compiler/msg/errord.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of git commit 403292a1, 06 Jul, 2022
+#   Based on errore.msg of git commit f364bb6b + 1, 29 Jul, 2023
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
@@ -34,6 +34,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   package_  package handling
+#   sym_      symbol handling 
 #
 # <type> the type of the message it should normally used for
 #   f_   fatal error
@@ -417,9 +418,9 @@ scan_e_illegal_peoptflag=02094_E_Ung
 scan_e_unsupported_switch=02095_E_Direktive $1 wird auf diesem Zielbetriebssystem nicht unterst�tzt
 % Not all compiler directives are supported on all targets.
 scan_w_invalid_stacksize=02096_W_Die spezifizierte Gr”áe des Stack ist auáerhalb des g�ltigen Bereichs der Plattform. Setzen der Gr”áe des Stack ignoriert.
-% The valid range for the stack size is 1024 - 67107839 on 32-bit and 64-bit
-% platforms and 1024 - 65520 on 16-bit platforms. Additionally, for Turbo Pascal 7
-% compatibility reasons, specifying a stack size of 65521 on 16-bit platforms
+% The valid range for the stack size is 1024 - 67107839 on 32 bit and 64 bit
+% platforms and 1024 - 65520 on 16 bit platforms. Additionally, for Turbo Pascal 7
+% compatibility reasons, specifying a stack size of 65521 on 16 bit platforms
 % actually sets the stack size to 65520.
 scan_w_heapmax_lessthan_heapmin=02097_W_Die spezifizierte GrӇe des HeapMax ist kleiner als der des HeapMin. Setzen der GrӇe des HeapMax ignoriert.
 % The HeapMax value (if specified) must be greater than or equal to the HeapMin
@@ -458,7 +459,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF Direktive ohne entsprechende $IF(N)DEF Di
 #
 # Parser
 #
-# 03364 is the last used one
+# 03370 is the last used one
 #
 # BeginOfTeX
 %
@@ -1103,7 +1104,7 @@ parser_e_paraloc_all_paras=03198_E_Jedes Argument muss seine explizite "location
 parser_e_illegal_explicit_paraloc=03199_E_Ung�ltiger expliziter Parameter "location" spezifiziert
 % Syscalls specific: the specified explicit location string for this parameter cannot be parsed, invalid,
 % or the location specified for an argument isn't recognized by the compiler.
-parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer oder Zeiger-Variable erwartet
+parser_e_32bitint_or_pointer_variable_expected=03200_E_32-Bit-Integer oder Zeiger-Variable erwartet
 % The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable.
 parser_e_goto_outside_proc=03201_E_Goto Statements zwischen verschiedenen Prozeduren sind nicht erlaubt
 % It isn't allowed to use \var{goto} statements referencing labels outside the
@@ -1201,7 +1202,7 @@ parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Fel
 % (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
-parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt
+parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb von Records, Objekten und Klassen erlaubt
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
@@ -1449,7 +1450,7 @@ parser_e_forward_intf_declaration_must_be_resolved=03298_E_Die Vorw
 %       end;
 % \end{verbatim}
 % where \var{MyProtocol} is declared but not defined.
-parser_e_no_record_published=03299_E_Record -Typen k”nnen keine ”ffentlichen Abschnitte (published sections) haben
+parser_e_no_record_published=03299_E_Record-Typen k”nnen keine ”ffentlichen Abschnitte (published sections) haben
 % Published sections can be used only inside classes.
 parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt
 % Destructor declarations are not allowed in records or helpers.
@@ -1621,7 +1622,7 @@ parser_e_only_static_members_via_object_type=03349_E_Nur statische Methoden und
 %   TObj.test;
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
-parser_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Platform nicht als external redeklarieren; schon die erste Deklaration muss external sein
+parser_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Plattform nicht als external redeklarieren; schon die erste Deklaration muss external sein
 % If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
 % must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
 % platforms. Even on platforms where it is supported, this is quite inefficient.
@@ -1629,10 +1630,10 @@ parser_e_unbound_attribute=03351_E_Nicht verkn
 % A custom attribute is defined, but there is no identifier to bind it to.
 parser_e_enumeration_out_of_range=03352_E_Aufz„hlungssymbole k”nnen nur Werte im Bereich von -2^31 bis 2^31-1 annehmen
 % The size of enumeration values is limited to 4 bytes. As the value can be signed, the range
-% of valid values is limited to a signed 32 Bit value (i.e. \var{longint}).
+% of valid values is limited to a signed 32 bit value (i.e. \var{longint}).
 parser_w_enumeration_out_of_range=03353_W_Aufz„hlungssymbole k”nnen nur Werte im Bereich von -2^31 bis 2^31-1 annehmen
 % The size of enumeration values is limited to 4 bytes. As the value can be signed, the range
-% of valid values is limited to a signed 32 Bit value (i.e. \var{longint}).
+% of valid values is limited to a signed 32 bit value (i.e. \var{longint}).
 parser_e_method_for_type_in_other_unit=03354_E_Implementierung einer Methods f�r den Typ "$1", der in einer anderen Unit deklariert ist
 % This error occurs if one tries to define a method for a type that is originally declared
 % in a different unit.
@@ -1642,11 +1643,11 @@ parser_e_generic_constraints_not_allowed_here=03355_E_Eine generische Einschr
 parser_e_location_size_too_small=03356_E_Die explizite "location" ist zu klein f�r den Parameter
 % AmigaOS/MorphOS syscall specific: for int64/qword parameter only a single register location is specified
 parser_e_location_size_too_large=03357_E_Die GrӇe der expliziten "location" ist grӇer als vom Parameter verlangt
-% AmigaOS/MorphOS syscall specific: for a parameter which is smaller than 64bit, a register pair is specified
+% AmigaOS/MorphOS syscall specific: for a parameter which is smaller than 64 bits, a register pair is specified
 parser_e_location_regpair_only_data=03358_E_Nur Daten-Register werden f�r explizite "location" Registerpaare unterst�tzt
-% AmigaOS/MorphOS syscall specific: for 64bit register pairs, only data registers are supported
+% AmigaOS/MorphOS syscall specific: for 64 bit register pairs, only data registers are supported
 parser_e_location_regpair_only_consecutive=03359_E_Nur aufeinander folgende Register werden f�r explizite "location" Registerpaare unterst�tzt
-% MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64bit register pairs
+% MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64 bit register pairs
 parser_e_constructurs_cannot_take_type_parameters=03360_E_Konstruktoren k”nnen keine Type-Parameter �bernehmen
 % The use of type parameters in constructors is not allowed.
 parser_e_raise_with_noreturn_not_allowed=03361_E_Deklaration von Raise in einer Subroutine als noreturn ist nicht erlaubt
@@ -1659,6 +1660,20 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
+parser_w_ignoring_published_property=03365_W_Diese Eigenschaft wird nicht ver”ffentlicht
+% Published property is ignored
+parser_e_wasm_ref_types_can_only_be_passed_by_value=03366_E_WebAssembly-Referenz-Typen k”nnen nur "by value" �bergeben werden
+% WebAssembly reference types don't have an in-memory representation and can only be passed by value.
+parser_e_promising_exports_not_supported_on_current_platform=03367_E_Exporte als 'promising' zu deklarieren ist WebAssembly-spezifisch und nicht auf der aktuellen Plattform unterst�tzt
+% Promising exports are WebAssembly-specific. They are not allowed on other platforms.
+parser_e_suspending_externals_not_supported_on_current_platform=03368_E_Externals als 'suspending' zu deklarieren ist WebAssembly-spezifisch und nicht auf der aktuellen Plattform unterst�tzt
+% Suspending externals are WebAssembly-specific. They are not allowed on other platforms.
+parser_w_widechar_set_reduced=03369_W_Reduziere Widechar-Set zu Single-Byte-AnsiChar-Set.
+% The base type of a set can only have 255 elements. Sets of wide characters
+% are reduced to sets of 1-byte characters.
+parser_e_nostringaliasinsystem=03370_e_Das Alias 'string' ist in der Unit "system" nicht erlaubt. Benutze Short-, Ansi- oder Unicodestring.
+% As a safeguard, the system unit may only use basic string types, not the
+% string alias which is dependent on the mode in which a unit is compiled.
 %
 % \end{description}
 # EndOfTeX
@@ -1666,7 +1681,7 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 #
 # Type Checking
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 # BeginOfTeX
 %
@@ -1736,7 +1751,7 @@ type_e_set_operation_unknown=04013_E_Operation f
 % several binary operations are not defined for sets.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % The last two may be  defined for sets in the future.
-type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 bit)
+type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 Bit)
 % An implicit type conversion from a real type to a \var{comp} is
 % encountered. Since \var{Comp} is a 64 bit integer type, this may indicate
 % an error.
@@ -1817,12 +1832,12 @@ type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalte
 % Type
 %   TMyStream = Class(TStream,Integer)
 % \end{verbatim}
-type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdr�cken und Longwords ergibt ein 64bit Ergebnis
+type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdr�cken und Longwords ergibt ein 64-Bit-Ergebnis
 % If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa),
 % or if you have overflow and/or range checking turned on and use an arithmetic
 % expression (+, -, *, div, mod) in which both signed numbers and longwords appear,
-% then everything has to be evaluated in 64-bit arithmetic which is slower than normal
-% 32-bit arithmetic. You can avoid this by typecasting one operand so it
+% then everything has to be evaluated in 64 bit arithmetic which is slower than normal
+% 32 bit arithmetic. You can avoid this by typecasting one operand so it
 % matches the result type of the other one.
 type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdr�cken und kardinalen Typen hier kann eine Bereichs�berschreitung verursachen
 % If you use a binary operator (and, or, xor) and one of
@@ -1898,7 +1913,7 @@ type_h_pointer_to_longint_conv_not_portable=04055_H_Konversion zwischen ordinale
 % on a machine using 64 bits addressing.
 type_w_pointer_to_longint_conv_not_portable=04056_W_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar
 % If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can
-% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used
+% cause problems. This is a warning to help in finding the 32 bit specific code where cardinal/longint is used
 % to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead.
 type_e_cant_choose_overload_function=04057_E_Kann nicht bestimmen, welche der �berladenen Funktionen aufgerufen werden soll
 % You're calling overloaded functions with a parameter that doesn't correspond
@@ -1946,7 +1961,7 @@ type_h_convert_mul_operands_to_prevent_overflow=04081_H_Konvertierung des Operan
 % Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you
 % could prevent such errors by converting the operands to this type before doing the multiplication.
 type_w_pointer_to_signed=04082_W_Die Konvertierung von Zeigern in einen Integertyp mit Vorzeichen kann zu falschen Ergebnissen bei Vergleichen und zu Bereichs�berschreitungen f�hren; verwenden sie statt dessen besser einen Typ ohne Vorzeichen
-% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff.
+% The virtual address space on 32 bit machines runs from \$00000000 to \$ffffffff.
 % Many operating systems allow you to allocate memory above \$80000000.
 % For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff.
 % If you convert pointers to signed types, this can cause overflow and range check errors,
@@ -2124,6 +2139,10 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 % Function references can live beyond the scope of the function they're contained in while
 % nested functions assigned to nested function variables can't. Due to this discrepancy
 % in design assigning a nested function variable to a function reference is forbidden.
+type_e_cannot_take_address_of_wasm_externref=04132_E_Kann die Adresse einer externen WebAssembly-Referenz nicht verwenden
+% WebAssembly externref types don't have an in-memory representation and therefore, their address cannot be taken.
+type_e_cannot_determine_size_of_wasm_reference_type=04133_E_WebAssembly-Referenz-Typen haben keine beobachtbare GrӇe
+% WebAssembly reference types are opaque, meaning neither their size, nor their bit pattern can be observed.
 %
 % \end{description}
 # EndOfTeX
@@ -2131,7 +2150,7 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 #
 # Symtable
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 # BeginOfTeX
 %
@@ -2454,6 +2473,12 @@ sym_e_type_must_be_rec_or_object=05098_E_Record- oder Objecttyp erwartet
 sym_e_symbol_no_capture=05099_E_Symbol "$1" kann nicht erfasst werden
 % The specified symbol can not be captured to be used in a function reference.
 % For example \var{var} or \var{out} parameters can not be captured in that way.
+sym_f_systemunitnotloaded=05100_F_Unit "system" nicht geladen
+% The compiler used a function that requires the system unit to be loaded,
+% but it was not yet loaded. This is an internal compiler error and must be reported.
+sym_e_wasm_ref_types_cannot_be_used_in_records=05101_E_WebAssembly-Referenz-Typen k”nnen nicht innerhalb von Records, Objekten oder Klassen verwendet werden
+% WebAssembly reference types don't have an in-memory representation and therefore
+% cannot be used inside records, objects or classes.
 %
 % \end{description}
 # EndOfTeX
@@ -2900,7 +2925,7 @@ asmr_e_bad_seh_directive_offset=07112_E_Ung
 % Win64 SEH directives have certain restrictions on possible offset values, e.g. they should
 % be positive and have 3 or 4 low bits clear.
 asmr_e_bad_seh_directive_register=07113_E_Ung�ltiges Register f�r $1
-% Win64 SEH directives accept only 64-bit integer registers or XMM registers.
+% Win64 SEH directives accept only 64 bit integer registers or XMM registers.
 asmr_e_seh_in_pure_asm_only=07114_E_SEH-Direktiven sind nur in reinen Assemblerroutinen erlaubt
 % Win64 SEH directives are allowed only in pure assembler procedures, not in assembler
 % blocks of regular procedures.
@@ -2924,10 +2949,10 @@ asmr_w_global_access_without_got=07119_W_Auf exportierte/globale Symbole sollte
 asmr_w_check_mem_operand_size=07120_W_šberpr�fe die Gr”áe des Speicheroperanden "$1"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
-asmr_w_check_mem_operand_size3=07121_W_šberpr�fe die Gr”áe des Speicheroperanden "$1: Sie ist $2 bits, aber [$3 bits] werden erwartet"
+asmr_w_check_mem_operand_size3=07121_W_šberpr�fe die Gr”áe des Speicheroperanden "$1: Sie ist $2 Bits, aber [$3 Bits] werden erwartet"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
-asmr_w_check_mem_operand_size_offset=07122_W_šberpr�fe die Gr”áe des Speicheroperanden "$1: Sie ist $2 bits, aber[$3 bits + $4 byte offset] werden erwartet"
+asmr_w_check_mem_operand_size_offset=07122_W_šberpr�fe die Gr”áe des Speicheroperanden "$1: Sie ist $2 Bits, aber[$3 Bits + $4 Byte Offset] werden erwartet"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 asmr_w_check_mem_operand_negative_offset=07123_W_šberpr�fe "$1: Der Offset des Speicheroperanden ist negativ "$2 byte
@@ -3016,8 +3041,8 @@ asmw_e_duplicate_label=08016_E_Asm: Doppeltes Label $1
 asmw_e_redefined_label=08017_E_Asm: Neu definiertes Label $1
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_invalid_register=08019_E_Asm: Ung�ltiges Register $1
-asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 oder 32 Bit Referenzen werden nicht unterst�tzt
-asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit Operanden werden nicht unterst�tzt
+asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16- oder 32-Bit-Verweise werden nicht unterst�tzt
+asmw_e_64bit_not_supported=08021_E_Asm: 64-Bit-Operanden werden nicht unterst�tzt
 asmw_e_bad_reg_with_rex=08022_E_Asm: AH, BH, CH oder DH k”nnen nicht in einer Instruktion verwendt werden, die den Prefix REX ben”tigt
 % x86_64 only: instruction encoding of this platform does not allow using
 % 8086 high byte registers (AH, BH, CH or DH) together with REX prefix in a single instruction.
@@ -3041,7 +3066,7 @@ asmw_h_changing_bind_type=08028_H_
 % First version is reserved for changig to local label, which is the most probable cause
 % of wrong code generation, but currently set to Note level as it appears inside
 % the compiler compilation.
-asmw_e_32bit_not_supported=08029_E_Asm: 32 Bit Referenzen werden nicht unterst�tzt
+asmw_e_32bit_not_supported=08029_E_Asm: 32-Bit-Referenzen werden nicht unterst�tzt
 asmw_f_code_segment_too_large=08030_F_Code-Segment zu groá
 asmw_f_data_segment_too_large=08031_F_Data-Segment zu groá
 asmw_e_instruction_not_supported_by_cpu=08032_E_Befehl wird vom ausgew„hlten Befehlssatz nicht unterst�tzt
@@ -3102,7 +3127,7 @@ exec_w_libfile_not_found=09012_W_Bibliothek $1 nicht gefunden, Linken kann fehls
 % Check your paths.
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 % Generic error while linking.
-exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken
+exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken (Fehler war "$1")
 % An error occurred when calling an external linker. The compiler will produce a script that
 % can be used to assemble and link the program.
 exec_i_linking=09015_I_Linke $1
@@ -3206,20 +3231,20 @@ execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % \begin{description}
 link_f_executable_too_big=09200_F_Das Programm - Image ist f�r das Target $1 zu groá
 % Fatal error when resulting executable is too big.
-link_w_32bit_absolute_reloc=09201_W_Objektdatei "$1" enth„lt eine 32-bit absolute Relocation auf Symbol "$2".
-% Warning when 64-bit object file contains 32-bit absolute relocations.
+link_w_32bit_absolute_reloc=09201_W_Objektdatei "$1" enth„lt eine 32-Bit absolute Relocation auf Symbol "$2".
+% Warning when 64 bit object file contains 32 bit absolute relocations.
 % In such case an executable image can be loaded into lower 4Gb of
 % address space only.
 link_e_program_segment_too_large=09202_E_Program-Segment zu groá (�bersteigt 64k um $1 Byte)
-% Error when a 16-bit program is compiled in the tiny memory model, but its size exceeds 64k
+% Error when a 16 bit program is compiled in the tiny memory model, but its size exceeds 64k
 link_e_code_segment_too_large=09203_E_Code-Segment "$1" zu groá (�bersteigt 64k um $2 Byte)
-% Error when a 16-bit program's code segment exceeds 64k bytes
+% Error when a 16 bit program's code segment exceeds 64k bytes
 link_e_data_segment_too_large=09204_E_Data-Segment "$1" zu groá (�bersteigt 64k um $2 Byte)
-% Error when a 16-bit program's data segment exceeds 64k bytes
+% Error when a 16 bit program's data segment exceeds 64k bytes
 link_e_segment_too_large=09205_E_Segment "$1" zu groá (�bersteigt 64k um $2 Byte)
-% Error when a 16-bit program contains a segment that exceeds 64k bytes
+% Error when a 16 bit program contains a segment that exceeds 64k bytes
 link_e_group_too_large=09206_E_Gruppe "$1" zu groá (�bersteigt 64k um $2 Byte)
-% Error when a 16-bit program's object modules define a segment group that
+% Error when a 16 bit program's object modules define a segment group that
 % exceeds 64k bytes
 link_e_com_program_uses_segment_relocations=09207_E_Eine .COM-Datei kann nicht erzeugt werden, weil das Programm Segment-Relocations enth„lt
 % Error occurs, when creating a tiny model DOS .COM file, but at least one of
@@ -3511,7 +3536,7 @@ unit_u_ppu_wasm_threads_mismatch=10070_U_PPU und Programm m
 #
 # Options
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
 # BeginOfTeX
 %
@@ -3672,6 +3697,12 @@ option_unsupported_fpu=11063_F_Der ausgew
 % Not all instruction sets support all FPU types. For example on ARM, Thumb(-1) supports no FPU/VFP instruction set
 option_too_many_exception_modes=11064_E_Nur ein unterst�tzter Modus von WebAssembly Exceptions darf angegeben werden.
 % Only one WebAssembly exception support mode (NOEXCEPTIONS, JSEXCEPTIONS, BFEXCEPTIONS or NATIVEEXCEPTIONS) can be specified.
+option_subtarget_is_already_set=11065_W_Subzielsystem is bereits auf $1 gesetzt
+% Displayed if more than one \var{-t} option is specified.
+option_subtarget_config_not_found=11066_E_Subzielsystem $1 angegeben, aber keine entsprechende Konfigurationsdatei $2 gefunden.
+% Displayed if more than one \var{-t} option is specified.
+option_x_ignored=11067_N_Ignoriere den Compiler-Programm-Suffix $1.
+% Displayed if more than one \var{-t} option is specified.
 %
 % \end{description}
 # EndOfTeX
@@ -3749,8 +3780,8 @@ wpo_symbol_live_info_needs_smart_linking=12018_E_Die Sammlung der "symbol livene
 % actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective.
 wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1" f�r die Gesamtprogramm-Optimierung kann nicht erzeugt werden
 % The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information.
-%\end{description}
 %
+% \end{description}
 # EndOfTeX
 
 #
@@ -3921,7 +3952,7 @@ diskutiert werden k
 #    3 = 80x86 targets
 #    4 = x86_64
 #    6 = 680x0 targets
-#    8 = 8086 (16-bit) targets
+#    8 = 8086 (16 bit) targets
 #    a = AArch64
 #    A = ARM
 #    e = in extended debug mode only
@@ -3929,6 +3960,7 @@ diskutiert werden k
 #    I = VIS
 #    J = JVM
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    P = PowerPC targets
@@ -3961,6 +3993,7 @@ F*0*_Es werden nur Optionen aufgelistet, die f
 **2ao_F�ge eine zus„tzliche Option zum Aufruf des externen Assemblers hinzu (ignoriert f�r den internen Assembler)
 *L2ap_Benutze Pipes anstelle tempor„rer Assembler-Dateien
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
+**2aR_Liste RTTI-Informationen in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 # Choice of assembler used
 **1A<x>_Ausgabe Format:
@@ -3969,7 +4002,7 @@ F*0*_Es werden nur Optionen aufgelistet, die f
 3*2Aas-darwin_Assembliere Darwin Mach-O mit Hilfe von GNU GAS
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Aelf_ELF (Linux) mit Hilfe des internen Schreibers
-3*2Amacho_Mach-O (Darwin, Intel 32 bit) mit Hilfe des internen Schreibers
+3*2Amacho_Mach-O (Darwin, Intel-32-Bit) mit Hilfe des internen Schreibers
 3*2Amasm_Objektdatei mit Hilfe von Masm (Microsoft)
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasmcoff_COFF (Go32v2) Datei mit Hilfe von Nasm
@@ -3984,12 +4017,12 @@ F*0*_Es werden nur Optionen aufgelistet, die f
 3*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas-darwin_Assembliere Darwin Mach-O64 mit Hilfe von GNU GAS
-4*2Aelf_ELF (Linux-64bit) mit Hilfe des internen Schreibers
+4*2Aelf_ELF (Linux-64-Bit) mit Hilfe des internen Schreibers
 4*2Agas_Assembliere mit Hilfe von GNU AS
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasmdarwin_Assembliere darwin Macho64 Objektdatei mit Hilfe von Nasm (experimentell)
-4*2Anasmelf_Assembliere Linux-64bit Objektdatei mit Hilfe von Nasm (experimentell)
+4*2Anasmelf_Assembliere Linux-64-Bit Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Anasmwin64_Assembliere Win64 Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
@@ -4256,7 +4289,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 3*2Tsymbian_Symbian OS
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
-3*2Twin32_Windows 32 Bit
+3*2Twin32_Windows 32-Bit
 3*2Twince_Windows CE
 # x86_64 targets
 4*2Tandroid_Android
@@ -4271,7 +4304,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 4*2Tnetbsd_NetBSD
 4*2Topenbsd_OpenBSD
 4*2Tsolaris_Solaris
-4*2Twin64_Win64 (64 bit Windows Systeme)
+4*2Twin64_Win64 (64-Bit Windows Systeme)
 # m68k targets
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
@@ -4285,7 +4318,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 # i8086 targets
 8*2Tembedded_Embedded
 8*2Tmsdos_MS-DOS (und kompatible)
-8*2Twin16_Windows 16 Bit
+8*2Twin16_Windows 16-Bit
 # arm targets
 A*2Tandroid_Android
 A*2Taros_AROS
@@ -4309,6 +4342,8 @@ a*2Twin64_Windows 64
 # jvm targets
 J*2Tandroid_Android
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 m*2Tandroid_Android
 m*2Tembedded_Embedded
@@ -4359,6 +4394,10 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Twasi_Das WebAssembly System Interface (WASI)
 # end of targets section
+**1t<x>_Zielsystem-Architektur
+**2*_ * Definiert FPC_SUBTARGET_<x> 
+**2*_ * Definiert FPC_SUBTARGET als <arg>
+**2*_ * Liest zus„tzlich die Konfigurationsdatei fpc-<subtarget>.cfg
 **1u<x>_Entferne die Definition f�r das Symbol <x>
 **1U<x>_Unit-Optionen:
 **2Un_Pr�fe den Unitnamen nicht
@@ -4463,9 +4502,10 @@ P*2WT_Spezifiziere "MPW tool type application" (Classic Mac OS)
 6*3WQqhdr_Setze Metadata auf QDOS Datei-Header Stil (Voreinstellung)
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 **2WX_Erm”gliche den executable stack (Linux)
+**1x<suff>_Setze den Suffix f�r das Compiler-Programm (nur f�r das fpc Kommando)
 **1X_Programm-Optionen:
 **2X9_Erzeuge Linkerscript f�r GNU Binutils ld „lter als Version 2.19.1 (Linux)
-**2Xa_Erzeuge Code, der auf 64-Bit Zielsystemen mehr als 2 GB statische Daten erlaubt (Linux)
+**2Xa_Erzeuge Code, der auf 64-Bit-Zielsystemen mehr als 2 GB statische Daten erlaubt (Linux)
 **2Xc_šbergebe --shared an den Linker (BeOS, Darwin, FreeBSD, Linux)
 **2Xd_Den Standard Bibliotheks-Suchpfad NICHT nutzen (ben”tigt f�r cross compile, wenn nicht -XR verwendet wird)
 **2XD_Versuche Units dynamisch zu linken             (definiert FPC_LINK_DYNAMIC)

+ 86 - 46
compiler/msg/errordu.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #
-#   Based on errore.msg of git commit 403292a1, 06 Jul, 2022
+#   Based on errore.msg of git commit f364bb6b + 1, 29 Jul, 2023
 #
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
@@ -34,6 +34,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   package_  package handling
+#   sym_      symbol handling 
 #
 # <type> the type of the message it should normally used for
 #   f_   fatal error
@@ -417,9 +418,9 @@ scan_e_illegal_peoptflag=02094_E_Ungültiges Argument für SETPEOPTFLAGS
 scan_e_unsupported_switch=02095_E_Direktive $1 wird auf diesem Zielbetriebssystem nicht unterstützt
 % Not all compiler directives are supported on all targets.
 scan_w_invalid_stacksize=02096_W_Die spezifizierte Größe des Stack ist außerhalb des gültigen Bereichs der Plattform. Setzen der Größe des Stack ignoriert.
-% The valid range for the stack size is 1024 - 67107839 on 32-bit and 64-bit
-% platforms and 1024 - 65520 on 16-bit platforms. Additionally, for Turbo Pascal 7
-% compatibility reasons, specifying a stack size of 65521 on 16-bit platforms
+% The valid range for the stack size is 1024 - 67107839 on 32 bit and 64 bit
+% platforms and 1024 - 65520 on 16 bit platforms. Additionally, for Turbo Pascal 7
+% compatibility reasons, specifying a stack size of 65521 on 16 bit platforms
 % actually sets the stack size to 65520.
 scan_w_heapmax_lessthan_heapmin=02097_W_Die spezifizierte Größe des HeapMax ist kleiner als der des HeapMin. Setzen der Größe des HeapMax ignoriert.
 % The HeapMax value (if specified) must be greater than or equal to the HeapMin
@@ -458,7 +459,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF Direktive ohne entsprechende $IF(N)DEF Di
 #
 # Parser
 #
-# 03364 is the last used one
+# 03370 is the last used one
 #
 # BeginOfTeX
 %
@@ -1103,7 +1104,7 @@ parser_e_paraloc_all_paras=03198_E_Jedes Argument muss seine explizite "location
 parser_e_illegal_explicit_paraloc=03199_E_Ungültiger expliziter Parameter "location" spezifiziert
 % Syscalls specific: the specified explicit location string for this parameter cannot be parsed, invalid,
 % or the location specified for an argument isn't recognized by the compiler.
-parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer oder Zeiger-Variable erwartet
+parser_e_32bitint_or_pointer_variable_expected=03200_E_32-Bit-Integer oder Zeiger-Variable erwartet
 % The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable.
 parser_e_goto_outside_proc=03201_E_Goto Statements zwischen verschiedenen Prozeduren sind nicht erlaubt
 % It isn't allowed to use \var{goto} statements referencing labels outside the
@@ -1201,7 +1202,7 @@ parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Fel
 % (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
-parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt
+parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb von Records, Objekten und Klassen erlaubt
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
@@ -1448,7 +1449,7 @@ parser_e_forward_intf_declaration_must_be_resolved=03298_E_Die Vorwärtsdeklarat
 %       end;
 % \end{verbatim}
 % where \var{MyProtocol} is declared but not defined.
-parser_e_no_record_published=03299_E_Record -Typen können keine öffentlichen Abschnitte (published sections) haben
+parser_e_no_record_published=03299_E_Record-Typen können keine öffentlichen Abschnitte (published sections) haben
 % Published sections can be used only inside classes.
 parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt
 % Destructor declarations are not allowed in records or helpers.
@@ -1620,7 +1621,7 @@ parser_e_only_static_members_via_object_type=03349_E_Nur statische Methoden und
 %   TObj.test;
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
-parser_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Platform nicht als external redeklarieren; schon die erste Deklaration muss external sein
+parser_e_callthrough_varargs=03350_E_Kann die variadische Funktion "$1" im C-Stil auf dieser Plattform nicht als external redeklarieren; schon die erste Deklaration muss external sein
 % If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
 % must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
 % platforms. Even on platforms where it is supported, this is quite inefficient.
@@ -1628,10 +1629,10 @@ parser_e_unbound_attribute=03351_E_Nicht verknüpftes Kundenattribut: "$1".
 % A custom attribute is defined, but there is no identifier to bind it to.
 parser_e_enumeration_out_of_range=03352_E_Aufzählungssymbole können nur Werte im Bereich von -2^31 bis 2^31-1 annehmen
 % The size of enumeration values is limited to 4 bytes. As the value can be signed, the range
-% of valid values is limited to a signed 32 Bit value (i.e. \var{longint}).
+% of valid values is limited to a signed 32 bit value (i.e. \var{longint}).
 parser_w_enumeration_out_of_range=03353_W_Aufzählungssymbole können nur Werte im Bereich von -2^31 bis 2^31-1 annehmen
 % The size of enumeration values is limited to 4 bytes. As the value can be signed, the range
-% of valid values is limited to a signed 32 Bit value (i.e. \var{longint}).
+% of valid values is limited to a signed 32 bit value (i.e. \var{longint}).
 parser_e_method_for_type_in_other_unit=03354_E_Implementierung einer Methods für den Typ "$1", der in einer anderen Unit deklariert ist
 % This error occurs if one tries to define a method for a type that is originally declared
 % in a different unit.
@@ -1641,11 +1642,11 @@ parser_e_generic_constraints_not_allowed_here=03355_E_Eine generische Einschrän
 parser_e_location_size_too_small=03356_E_Die explizite "location" ist zu klein für den Parameter
 % AmigaOS/MorphOS syscall specific: for int64/qword parameter only a single register location is specified
 parser_e_location_size_too_large=03357_E_Die Größe der expliziten "location" ist größer als vom Parameter verlangt
-% AmigaOS/MorphOS syscall specific: for a parameter which is smaller than 64bit, a register pair is specified
+% AmigaOS/MorphOS syscall specific: for a parameter which is smaller than 64 bits, a register pair is specified
 parser_e_location_regpair_only_data=03358_E_Nur Daten-Register werden für explizite "location" Registerpaare unterstützt
-% AmigaOS/MorphOS syscall specific: for 64bit register pairs, only data registers are supported
+% AmigaOS/MorphOS syscall specific: for 64 bit register pairs, only data registers are supported
 parser_e_location_regpair_only_consecutive=03359_E_Nur aufeinander folgende Register werden für explizite "location" Registerpaare unterstützt
-% MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64bit register pairs
+% MorphOS syscall specific: only consecutive (f.e.: d1-d2) registers are supported for 64 bit register pairs
 parser_e_constructurs_cannot_take_type_parameters=03360_E_Konstruktoren können keine Type-Parameter übernehmen
 % The use of type parameters in constructors is not allowed.
 parser_e_raise_with_noreturn_not_allowed=03361_E_Deklaration von Raise in einer Subroutine als noreturn ist nicht erlaubt
@@ -1658,6 +1659,20 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
+parser_w_ignoring_published_property=03365_W_Diese Eigenschaft wird nicht veröffentlicht
+% Published property is ignored
+parser_e_wasm_ref_types_can_only_be_passed_by_value=03366_E_WebAssembly-Referenz-Typen können nur "by value" übergeben werden
+% WebAssembly reference types don't have an in-memory representation and can only be passed by value.
+parser_e_promising_exports_not_supported_on_current_platform=03367_E_Exporte als 'promising' zu deklarieren ist WebAssembly-spezifisch und nicht auf der aktuellen Plattform unterstützt
+% Promising exports are WebAssembly-specific. They are not allowed on other platforms.
+parser_e_suspending_externals_not_supported_on_current_platform=03368_E_Externals als 'suspending' zu deklarieren ist WebAssembly-spezifisch und nicht auf der aktuellen Plattform unterstützt
+% Suspending externals are WebAssembly-specific. They are not allowed on other platforms.
+parser_w_widechar_set_reduced=03369_W_Reduziere Widechar-Set zu Single-Byte-AnsiChar-Set.
+% The base type of a set can only have 255 elements. Sets of wide characters
+% are reduced to sets of 1-byte characters.
+parser_e_nostringaliasinsystem=03370_e_Das Alias 'string' ist in der Unit "system" nicht erlaubt. Benutze Short-, Ansi- oder Unicodestring.
+% As a safeguard, the system unit may only use basic string types, not the
+% string alias which is dependent on the mode in which a unit is compiled.
 %
 % \end{description}
 # EndOfTeX
@@ -1665,7 +1680,7 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 #
 # Type Checking
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 # BeginOfTeX
 %
@@ -1735,7 +1750,7 @@ type_e_set_operation_unknown=04013_E_Operation für Sets nicht implementiert
 % several binary operations are not defined for sets.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % The last two may be  defined for sets in the future.
-type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 bit)
+type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 Bit)
 % An implicit type conversion from a real type to a \var{comp} is
 % encountered. Since \var{Comp} is a 64 bit integer type, this may indicate
 % an error.
@@ -1816,12 +1831,12 @@ type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalte
 % Type
 %   TMyStream = Class(TStream,Integer)
 % \end{verbatim}
-type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdrücken und Longwords ergibt ein 64bit Ergebnis
+type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdrücken und Longwords ergibt ein 64-Bit-Ergebnis
 % If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa),
 % or if you have overflow and/or range checking turned on and use an arithmetic
 % expression (+, -, *, div, mod) in which both signed numbers and longwords appear,
-% then everything has to be evaluated in 64-bit arithmetic which is slower than normal
-% 32-bit arithmetic. You can avoid this by typecasting one operand so it
+% then everything has to be evaluated in 64 bit arithmetic which is slower than normal
+% 32 bit arithmetic. You can avoid this by typecasting one operand so it
 % matches the result type of the other one.
 type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdrücken und kardinalen Typen hier kann eine Bereichsüberschreitung verursachen
 % If you use a binary operator (and, or, xor) and one of
@@ -1897,7 +1912,7 @@ type_h_pointer_to_longint_conv_not_portable=04055_H_Konversion zwischen ordinale
 % on a machine using 64 bits addressing.
 type_w_pointer_to_longint_conv_not_portable=04056_W_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar
 % If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can
-% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used
+% cause problems. This is a warning to help in finding the 32 bit specific code where cardinal/longint is used
 % to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead.
 type_e_cant_choose_overload_function=04057_E_Kann nicht bestimmen, welche der überladenen Funktionen aufgerufen werden soll
 % You're calling overloaded functions with a parameter that doesn't correspond
@@ -1945,7 +1960,7 @@ type_h_convert_mul_operands_to_prevent_overflow=04081_H_Konvertierung des Operan
 % Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you
 % could prevent such errors by converting the operands to this type before doing the multiplication.
 type_w_pointer_to_signed=04082_W_Die Konvertierung von Zeigern in einen Integertyp mit Vorzeichen kann zu falschen Ergebnissen bei Vergleichen und zu Bereichsüberschreitungen führen; verwenden sie statt dessen besser einen Typ ohne Vorzeichen
-% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff.
+% The virtual address space on 32 bit machines runs from \$00000000 to \$ffffffff.
 % Many operating systems allow you to allocate memory above \$80000000.
 % For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff.
 % If you convert pointers to signed types, this can cause overflow and range check errors,
@@ -2123,6 +2138,10 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 % Function references can live beyond the scope of the function they're contained in while
 % nested functions assigned to nested function variables can't. Due to this discrepancy
 % in design assigning a nested function variable to a function reference is forbidden.
+type_e_cannot_take_address_of_wasm_externref=04132_E_Kann die Adresse einer externen WebAssembly-Referenz nicht verwenden
+% WebAssembly externref types don't have an in-memory representation and therefore, their address cannot be taken.
+type_e_cannot_determine_size_of_wasm_reference_type=04133_E_WebAssembly-Referenz-Typen haben keine beobachtbare Größe
+% WebAssembly reference types are opaque, meaning neither their size, nor their bit pattern can be observed.
 %
 % \end{description}
 # EndOfTeX
@@ -2130,7 +2149,7 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 #
 # Symtable
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 # BeginOfTeX
 %
@@ -2453,6 +2472,12 @@ sym_e_type_must_be_rec_or_object=05098_E_Record- oder Objecttyp erwartet
 sym_e_symbol_no_capture=05099_E_Symbol "$1" kann nicht erfasst werden
 % The specified symbol can not be captured to be used in a function reference.
 % For example \var{var} or \var{out} parameters can not be captured in that way.
+sym_f_systemunitnotloaded=05100_F_Unit "system" nicht geladen
+% The compiler used a function that requires the system unit to be loaded,
+% but it was not yet loaded. This is an internal compiler error and must be reported.
+sym_e_wasm_ref_types_cannot_be_used_in_records=05101_E_WebAssembly-Referenz-Typen können nicht innerhalb von Records, Objekten oder Klassen verwendet werden
+% WebAssembly reference types don't have an in-memory representation and therefore
+% cannot be used inside records, objects or classes.
 %
 % \end{description}
 # EndOfTeX
@@ -2899,7 +2924,7 @@ asmr_e_bad_seh_directive_offset=07112_E_Ungültiger Offsetwert für $1
 % Win64 SEH directives have certain restrictions on possible offset values, e.g. they should
 % be positive and have 3 or 4 low bits clear.
 asmr_e_bad_seh_directive_register=07113_E_Ungültiges Register für $1
-% Win64 SEH directives accept only 64-bit integer registers or XMM registers.
+% Win64 SEH directives accept only 64 bit integer registers or XMM registers.
 asmr_e_seh_in_pure_asm_only=07114_E_SEH-Direktiven sind nur in reinen Assemblerroutinen erlaubt
 % Win64 SEH directives are allowed only in pure assembler procedures, not in assembler
 % blocks of regular procedures.
@@ -2923,10 +2948,10 @@ asmr_w_global_access_without_got=07119_W_Auf exportierte/globale Symbole sollte
 asmr_w_check_mem_operand_size=07120_W_Überprüfe die Größe des Speicheroperanden "$1"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
-asmr_w_check_mem_operand_size3=07121_W_Überprüfe die Größe des Speicheroperanden "$1: Sie ist $2 bits, aber [$3 bits] werden erwartet"
+asmr_w_check_mem_operand_size3=07121_W_Überprüfe die Größe des Speicheroperanden "$1: Sie ist $2 Bits, aber [$3 Bits] werden erwartet"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
-asmr_w_check_mem_operand_size_offset=07122_W_Überprüfe die Größe des Speicheroperanden "$1: Sie ist $2 bits, aber[$3 bits + $4 byte offset] werden erwartet"
+asmr_w_check_mem_operand_size_offset=07122_W_Überprüfe die Größe des Speicheroperanden "$1: Sie ist $2 Bits, aber[$3 Bits + $4 Byte Offset] werden erwartet"
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 asmr_w_check_mem_operand_negative_offset=07123_W_Überprüfe "$1: Der Offset des Speicheroperanden ist negativ "$2 byte
@@ -3015,8 +3040,8 @@ asmw_e_duplicate_label=08016_E_Asm: Doppeltes Label $1
 asmw_e_redefined_label=08017_E_Asm: Neu definiertes Label $1
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_invalid_register=08019_E_Asm: Ungültiges Register $1
-asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 oder 32 Bit Referenzen werden nicht unterstützt
-asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit Operanden werden nicht unterstützt
+asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16- oder 32-Bit-Verweise werden nicht unterstützt
+asmw_e_64bit_not_supported=08021_E_Asm: 64-Bit-Operanden werden nicht unterstützt
 asmw_e_bad_reg_with_rex=08022_E_Asm: AH, BH, CH oder DH können nicht in einer Instruktion verwendt werden, die den Prefix REX benötigt
 % x86_64 only: instruction encoding of this platform does not allow using
 % 8086 high byte registers (AH, BH, CH or DH) together with REX prefix in a single instruction.
@@ -3040,7 +3065,7 @@ asmw_h_changing_bind_type=08028_H_Änderung des Bind-Typs des Symbols $1 von $2
 % First version is reserved for changig to local label, which is the most probable cause
 % of wrong code generation, but currently set to Note level as it appears inside
 % the compiler compilation.
-asmw_e_32bit_not_supported=08029_E_Asm: 32 Bit Referenzen werden nicht unterstützt
+asmw_e_32bit_not_supported=08029_E_Asm: 32-Bit-Referenzen werden nicht unterstützt
 asmw_f_code_segment_too_large=08030_F_Code-Segment zu groß
 asmw_f_data_segment_too_large=08031_F_Data-Segment zu groß
 asmw_e_instruction_not_supported_by_cpu=08032_E_Befehl wird vom ausgewählten Befehlssatz nicht unterstützt
@@ -3101,7 +3126,7 @@ exec_w_libfile_not_found=09012_W_Bibliothek $1 nicht gefunden, Linken kann fehls
 % Check your paths.
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 % Generic error while linking.
-exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken
+exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken (Fehler war "$1")
 % An error occurred when calling an external linker. The compiler will produce a script that
 % can be used to assemble and link the program.
 exec_i_linking=09015_I_Linke $1
@@ -3205,20 +3230,20 @@ execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % \begin{description}
 link_f_executable_too_big=09200_F_Das Programm - Image ist für das Target $1 zu groß
 % Fatal error when resulting executable is too big.
-link_w_32bit_absolute_reloc=09201_W_Objektdatei "$1" enthält eine 32-bit absolute Relocation auf Symbol "$2".
-% Warning when 64-bit object file contains 32-bit absolute relocations.
+link_w_32bit_absolute_reloc=09201_W_Objektdatei "$1" enthält eine 32-Bit absolute Relocation auf Symbol "$2".
+% Warning when 64 bit object file contains 32 bit absolute relocations.
 % In such case an executable image can be loaded into lower 4Gb of
 % address space only.
 link_e_program_segment_too_large=09202_E_Program-Segment zu groß (übersteigt 64k um $1 Byte)
-% Error when a 16-bit program is compiled in the tiny memory model, but its size exceeds 64k
+% Error when a 16 bit program is compiled in the tiny memory model, but its size exceeds 64k
 link_e_code_segment_too_large=09203_E_Code-Segment "$1" zu groß (übersteigt 64k um $2 Byte)
-% Error when a 16-bit program's code segment exceeds 64k bytes
+% Error when a 16 bit program's code segment exceeds 64k bytes
 link_e_data_segment_too_large=09204_E_Data-Segment "$1" zu groß (übersteigt 64k um $2 Byte)
-% Error when a 16-bit program's data segment exceeds 64k bytes
+% Error when a 16 bit program's data segment exceeds 64k bytes
 link_e_segment_too_large=09205_E_Segment "$1" zu groß (übersteigt 64k um $2 Byte)
-% Error when a 16-bit program contains a segment that exceeds 64k bytes
+% Error when a 16 bit program contains a segment that exceeds 64k bytes
 link_e_group_too_large=09206_E_Gruppe "$1" zu groß (übersteigt 64k um $2 Byte)
-% Error when a 16-bit program's object modules define a segment group that
+% Error when a 16 bit program's object modules define a segment group that
 % exceeds 64k bytes
 link_e_com_program_uses_segment_relocations=09207_E_Eine .COM-Datei kann nicht erzeugt werden, weil das Programm Segment-Relocations enthält
 % Error occurs, when creating a tiny model DOS .COM file, but at least one of
@@ -3510,7 +3535,7 @@ unit_u_ppu_wasm_threads_mismatch=10070_U_PPU und Programm müssen beide mit oder
 #
 # Options
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
 # BeginOfTeX
 %
@@ -3671,6 +3696,12 @@ option_unsupported_fpu=11063_F_Der ausgewählte FPU-Typ "$1" wird vom ausgewähl
 % Not all instruction sets support all FPU types. For example on ARM, Thumb(-1) supports no FPU/VFP instruction set
 option_too_many_exception_modes=11064_E_Nur ein unterstützter Modus von WebAssembly Exceptions darf angegeben werden.
 % Only one WebAssembly exception support mode (NOEXCEPTIONS, JSEXCEPTIONS, BFEXCEPTIONS or NATIVEEXCEPTIONS) can be specified.
+option_subtarget_is_already_set=11065_W_Subzielsystem is bereits auf $1 gesetzt
+% Displayed if more than one \var{-t} option is specified.
+option_subtarget_config_not_found=11066_E_Subzielsystem $1 angegeben, aber keine entsprechende Konfigurationsdatei $2 gefunden.
+% Displayed if more than one \var{-t} option is specified.
+option_x_ignored=11067_N_Ignoriere den Compiler-Programm-Suffix $1.
+% Displayed if more than one \var{-t} option is specified.
 %
 % \end{description}
 # EndOfTeX
@@ -3748,8 +3779,8 @@ wpo_symbol_live_info_needs_smart_linking=12018_E_Die Sammlung der "symbol livene
 % actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective.
 wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1" für die Gesamtprogramm-Optimierung kann nicht erzeugt werden
 % The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information.
-%\end{description}
 %
+% \end{description}
 # EndOfTeX
 
 #
@@ -3920,7 +3951,7 @@ diskutiert werden können, usw.):
 #    3 = 80x86 targets
 #    4 = x86_64
 #    6 = 680x0 targets
-#    8 = 8086 (16-bit) targets
+#    8 = 8086 (16 bit) targets
 #    a = AArch64
 #    A = ARM
 #    e = in extended debug mode only
@@ -3928,6 +3959,7 @@ diskutiert werden können, usw.):
 #    I = VIS
 #    J = JVM
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    P = PowerPC targets
@@ -3960,6 +3992,7 @@ F*0*_Es werden nur Optionen aufgelistet, die für die voreingestellte oder ausge
 **2ao_Füge eine zusätzliche Option zum Aufruf des externen Assemblers hinzu (ignoriert für den internen Assembler)
 *L2ap_Benutze Pipes anstelle temporärer Assembler-Dateien
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
+**2aR_Liste RTTI-Informationen in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 # Choice of assembler used
 **1A<x>_Ausgabe Format:
@@ -3968,7 +4001,7 @@ F*0*_Es werden nur Optionen aufgelistet, die für die voreingestellte oder ausge
 3*2Aas-darwin_Assembliere Darwin Mach-O mit Hilfe von GNU GAS
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Aelf_ELF (Linux) mit Hilfe des internen Schreibers
-3*2Amacho_Mach-O (Darwin, Intel 32 bit) mit Hilfe des internen Schreibers
+3*2Amacho_Mach-O (Darwin, Intel-32-Bit) mit Hilfe des internen Schreibers
 3*2Amasm_Objektdatei mit Hilfe von Masm (Microsoft)
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasmcoff_COFF (Go32v2) Datei mit Hilfe von Nasm
@@ -3983,12 +4016,12 @@ F*0*_Es werden nur Optionen aufgelistet, die für die voreingestellte oder ausge
 3*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas-darwin_Assembliere Darwin Mach-O64 mit Hilfe von GNU GAS
-4*2Aelf_ELF (Linux-64bit) mit Hilfe des internen Schreibers
+4*2Aelf_ELF (Linux-64-Bit) mit Hilfe des internen Schreibers
 4*2Agas_Assembliere mit Hilfe von GNU AS
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasmdarwin_Assembliere darwin Macho64 Objektdatei mit Hilfe von Nasm (experimentell)
-4*2Anasmelf_Assembliere Linux-64bit Objektdatei mit Hilfe von Nasm (experimentell)
+4*2Anasmelf_Assembliere Linux-64-Bit Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Anasmwin64_Assembliere Win64 Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
@@ -4255,7 +4288,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 3*2Tsymbian_Symbian OS
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
-3*2Twin32_Windows 32 Bit
+3*2Twin32_Windows 32-Bit
 3*2Twince_Windows CE
 # x86_64 targets
 4*2Tandroid_Android
@@ -4270,7 +4303,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 4*2Tnetbsd_NetBSD
 4*2Topenbsd_OpenBSD
 4*2Tsolaris_Solaris
-4*2Twin64_Win64 (64 bit Windows Systeme)
+4*2Twin64_Win64 (64-Bit Windows Systeme)
 # m68k targets
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
@@ -4284,7 +4317,7 @@ F*2P<x>_Setze den Zielprozessor (aarch64,arm,avr,i386,i8086,jvm,m68k,mips,mipsel
 # i8086 targets
 8*2Tembedded_Embedded
 8*2Tmsdos_MS-DOS (und kompatible)
-8*2Twin16_Windows 16 Bit
+8*2Twin16_Windows 16-Bit
 # arm targets
 A*2Tandroid_Android
 A*2Taros_AROS
@@ -4308,6 +4341,8 @@ a*2Twin64_Windows 64
 # jvm targets
 J*2Tandroid_Android
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 m*2Tandroid_Android
 m*2Tembedded_Embedded
@@ -4358,6 +4393,10 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Twasi_Das WebAssembly System Interface (WASI)
 # end of targets section
+**1t<x>_Zielsystem-Architektur
+**2*_ * Definiert FPC_SUBTARGET_<x> 
+**2*_ * Definiert FPC_SUBTARGET als <arg>
+**2*_ * Liest zusätzlich die Konfigurationsdatei fpc-<subtarget>.cfg
 **1u<x>_Entferne die Definition für das Symbol <x>
 **1U<x>_Unit-Optionen:
 **2Un_Prüfe den Unitnamen nicht
@@ -4462,9 +4501,10 @@ P*2WT_Spezifiziere "MPW tool type application" (Classic Mac OS)
 6*3WQqhdr_Setze Metadata auf QDOS Datei-Header Stil (Voreinstellung)
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 **2WX_Ermögliche den executable stack (Linux)
+**1x<suff>_Setze den Suffix für das Compiler-Programm (nur für das fpc Kommando)
 **1X_Programm-Optionen:
 **2X9_Erzeuge Linkerscript für GNU Binutils ld älter als Version 2.19.1 (Linux)
-**2Xa_Erzeuge Code, der auf 64-Bit Zielsystemen mehr als 2 GB statische Daten erlaubt (Linux)
+**2Xa_Erzeuge Code, der auf 64-Bit-Zielsystemen mehr als 2 GB statische Daten erlaubt (Linux)
 **2Xc_Übergebe --shared an den Linker (BeOS, Darwin, FreeBSD, Linux)
 **2Xd_Den Standard Bibliotheks-Suchpfad NICHT nutzen (benötigt für cross compile, wenn nicht -XR verwendet wird)
 **2XD_Versuche Units dynamisch zu linken             (definiert FPC_LINK_DYNAMIC)

+ 81 - 23
compiler/msg/errore.msg

@@ -30,6 +30,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   package_  package handling
+#   sym_      symbol handling 
 #
 # <type> the type of the message it should normally used for
 #   f_   fatal error
@@ -445,7 +446,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 # Parser
 #
-# 03365 is the last used one
+# 03368 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1639,17 +1640,29 @@ parser_e_section_directive_not_allowed_for_target=03362_E_Directive section not
 % Only some targets (e.g. Embedded and FreeRTOS) support the section directive.
 parser_e_absolute_sym_cannot_reference_itself=03363_E_Absolute variable cannot reference itself
 parser_e_syscall_format_not_support=03364_E_Syntax of syscall directive not supported by current target
-% Published property is ignored
-parser_w_ignoring_published_property=03365_W_This property will not be published
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
+parser_w_ignoring_published_property=03365_W_This property will not be published
+% Published property is ignored
+parser_e_wasm_ref_types_can_only_be_passed_by_value=03366_E_WebAssembly reference types can only be passed by value
+% WebAssembly reference types don't have an in-memory representation and can only be passed by value.
+parser_e_promising_exports_not_supported_on_current_platform=03367_E_Declaring exports as 'promising' is WebAssembly-specific and is not supported on the current platform
+% Promising exports are WebAssembly-specific. They are not allowed on other platforms.
+parser_e_suspending_externals_not_supported_on_current_platform=03368_E_Declaring externals as 'suspending' is WebAssembly-specific and is not supported on the current platform
+% Suspending externals are WebAssembly-specific. They are not allowed on other platforms.
+parser_w_widechar_set_reduced=03369_W_Reducing Widechar set to single-byte AnsiChar set.
+% The base type of a set can only have 255 elements. Sets of wide characters
+% are reduced to sets of 1-byte characters.
+parser_e_nostringaliasinsystem=03370_e_Using 'string' alias is not allowed in the system unit. Use short-,ansi- or unicodestring.
+% As a safeguard, the system unit may only use basic string types, not the
+% string alias which is dependent on the mode in which a unit is compiled.
 %
 % \end{description}
 %
 # Type Checking
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -2105,12 +2118,16 @@ type_e_nested_procvar_to_funcref=04131_E_A nested function variable can not be a
 % Function references can live beyond the scope of the function they're contained in while
 % nested functions assigned to nested function variables can't. Due to this discrepancy
 % in design assigning a nested function variable to a function reference is forbidden.
+type_e_cannot_take_address_of_wasm_externref=04132_E_Cannot take the address of a WebAssembly externref
+% WebAssembly externref types don't have an in-memory representation and therefore, their address cannot be taken.
+type_e_cannot_determine_size_of_wasm_reference_type=04133_E_WebAssembly reference types don't have an observable size
+% WebAssembly reference types are opaque, meaning neither their size, nor their bit pattern can be observed.
 %
 % \end{description}
 #
 # Symtable
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2431,6 +2448,13 @@ sym_e_type_must_be_rec_or_object=05098_E_Record or object type expected
 sym_e_symbol_no_capture=05099_E_Symbol "$1" can not be captured
 % The specified symbol can not be captured to be used in a function reference.
 % For example \var{var} or \var{out} parameters can not be captured in that way.
+sym_f_systemunitnotloaded=05100_F_System unit not loaded
+% The compiler used a function that requires the system unit to be loaded,
+% but it was not yet loaded. This is an internal compiler error and must be reported.
+sym_e_wasm_ref_types_cannot_be_used_in_records=05101_E_WebAssembly reference types cannot be used inside records, objects, or classes
+% WebAssembly reference types don't have an in-memory representation and therefore
+% cannot be used inside records, objects or classes.
+%
 % \end{description}
 #
 # Codegenerator
@@ -3125,7 +3149,7 @@ exec_f_controllertype_expected=09036_F_To generate the correct linker call, a co
 % Xtensa micro controller require a detailed specification linker command which depends on the target controller.
 % If no target controller is set, this command cannot be build and thus linking cannot be carried out.
 %
-%\end{description}
+% \end{description}
 # EndOfTeX
 
 #
@@ -3152,7 +3176,7 @@ execinfo_x_stackreserve=09133_X_Stack space reserved: $1 bytes
 % Informational message showing the stack size that the compiler reserved for the executable.
 execinfo_x_stackcommit=09134_X_Stack space committed: $1 bytes
 % Informational message showing the stack size that the compiler committed for the executable.
-%\end{description}
+% \end{description}
 # EndOfTeX
 
 #
@@ -3223,7 +3247,7 @@ link_e_undefined_symbol_in_obj=09221_E_Undefined symbol: $1 (first seen in $2)
 % The specified symbol is used, but not defined and was first seen in the specified object file.
 link_e_undefined_symbol=09222_E_Undefined symbol: $1
 % The specified symbol is used, but not defined.
-%\end{description}
+% \end{description}
 # EndOfTeX
 
 #
@@ -3468,15 +3492,15 @@ unit_u_ppu_wasm_threads_mismatch=10070_U_PPU and program must both be compiled w
 #
 #  Options
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
-option_usage=11000_O_$1 [options] <inputfile> [options]
 # BeginOfTeX
 %
 % \section{Command line handling errors}
 % This section lists errors that occur when the compiler is processing the
 % command line or handling the configuration files.
 % \begin{description}
+option_usage=11000_O_$1 [options] <inputfile> [options]
 option_only_one_source_support=11001_W_Only one source file supported, changing source file to compile from "$1" into "$2"
 % You can specify only one source file on the command line. The last
 % one will be compiled, others will be ignored. This may indicate that
@@ -3629,7 +3653,13 @@ option_unsupported_fpu=11063_F_The selected FPU type "$1" is not supported by th
 % Not all instruction sets support all FPU types. For example on ARM, Thumb(-1) supports no FPU/VFP instruction set
 option_too_many_exception_modes=11064_E_Only one WebAssembly exception support mode can be specified.
 % Only one WebAssembly exception support mode (NOEXCEPTIONS, JSEXCEPTIONS, BFEXCEPTIONS or NATIVEEXCEPTIONS) can be specified.
-%\end{description}
+option_subtarget_is_already_set=11065_W_Subtarget is already set to: $1
+% Displayed if more than one \var{-t} option is specified.
+option_subtarget_config_not_found=11066_E_Subtarget $1 specified but no corresponding config file $2 found.
+% Displayed if more than one \var{-t} option is specified.
+option_x_ignored=11067_N_Ignoring compiler executable suffix $1.
+% Displayed if more than one \var{-t} option is specified.
+% \end{description}
 # EndOfTeX
 
 #
@@ -3705,7 +3735,7 @@ wpo_symbol_live_info_needs_smart_linking=12018_E_Collection of symbol liveness i
 % actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective.
 wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program optimisation feedback file "$1"
 % The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information.
-%\end{description}
+% \end{description}
 # EndOfTeX
 
 
@@ -3883,6 +3913,7 @@ new features, etc.):
 #    I = VIS
 #    J = JVM
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    P = PowerPC targets
@@ -3987,6 +4018,11 @@ Z*2Az80asm_Assemble using z80asm
 **2Ca<x>_Select ABI; see fpc -i or fpc -ia for possible values
 **2Cb_Generate code for a big-endian variant of the target architecture
 **2Cc<x>_Set default calling convention to <x>
+V*2Cd<x>_Discard selected RTL startup sections (use with caution)
+V*3Cdc_Discard initializing data. Data defaults to noinit section
+V*3Cdj_Discard jump to PASCALMAIN. Use only if PASCALMAIN follows directly after startup code
+V*3Cds_Discard _START code. Use only if all interrupts are disabled
+V*3Cdz_Discard code initializing the zero register and stack pointer
 **2CD_Create also dynamic library (not supported)
 **2Ce_Compilation with emulated floating point opcodes
 **2CE_Generate FPU code which can raise exceptions
@@ -4264,6 +4300,8 @@ a*2Twin64_Windows 64
 # jvm targets
 J*2Tandroid_Android
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 m*2Tandroid_Android
 m*2Tembedded_Embedded
@@ -4313,24 +4351,43 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Twasi_The WebAssembly System Interface (WASI)
 # end of targets section
+**1t<x>_Target architecture
+**2*_ * Defines FPC_SUBTARGET_<x> 
+**2*_ * Defines FPC_SUBTARGET as <arg>
+**2*_ * Additionally reads config file fpc-<subtarget>.cfg
 **1u<x>_Undefines the symbol <x>
 **1U_Unit options:
 **2Un_Do not check where the unit name matches the file name
 **2Ur_Generate release unit files (never automatically recompiled)
 **2Us_Compile a system unit
 **1v<x>_Be verbose. <x> is a combination of the following letters:
-**2*_0 : Show nothing (except errors) p : Write tree.log with parse tree
-**2*_a : Show everything              q : Show message numbers
-**2*_b : Write file names messages    r : Rhide/GCC compatibility mode
-**2*_    with full path               s : Show time stamps
-**2*_c : Show conditionals            t : Show tried/used files
-**2*_d : Show debug info              u : Show unit info
-**2*_e : Show errors (default)        v : Write fpcdebug.txt with
-**2*_h : Show hints                       lots of debugging info
-**2*_i : Show general info            w : Show warnings
-**2*_l : Show linenumbers             x : Show info about invoked tools
+**2*_0 : Show nothing (except errors)
+**2*_a : Show everything
+**2*_b : Write file names messages with full path
+**2*_c : Show conditionals
+**2*_d : Show debug info
+**2*_e : Show errors (default)
+#**2*_f : Not used yet
+#**2*_g : Not used yet
+**2*_h : Show hints
+**2*_i : Show general info
+**2*_j : Always add main source (useful when run in parallel make)
+#**2*_k : Not used yet
+**2*_l : Show linenumbers
 **2*_m<x>,<y> : Do not show messages numbered <x> and <y>
-**2*_n : Show notes                   z : Write output to stderr
+**2*_n : Show notes
+#**2*_o : Not used yet
+**2*_p : Write tree.log with parse tree
+**2*_q : Show message numbers
+**2*_r : Rhide/GCC compatibility mode
+**2*_s : Show time stamps
+**2*_t : Show tried/used files
+**2*_u : Show unit info
+**2*_v : Write fpcdebug.txt with lots of debugging info
+**2*_w : Show warnings
+**2*_x : Show info about invoked tools
+#**2*_y : Not used yet
+**2*_z : Write output to stderr
 F*1V<x>_Append '-<x>' to the used compiler binary name (e.g. for version)
 **1W<x>_Target-specific options (targets)
 3*2WA_Specify native type application (Windows)
@@ -4416,6 +4473,7 @@ P*2WT_Specify MPW tool type application (Classic Mac OS)
 6*3WQqhdr_Set metadata to QDOS File Header style (default)
 6*3WQxtcc_Set metadata to XTcc style
 **2WX_Enable executable stack (Linux)
+**1x<suff>_Set suffix for compiler executable (fpc command only)
 **1X_Executable options:
 **2X9_Generate linkerscript for GNU Binutils ld older than version 2.19.1 (Linux)
 **2Xa_Generate code which allows to use more than 2 GB static data on 64 bit targets (Linux)

+ 15 - 3
compiler/msgidx.inc

@@ -479,6 +479,11 @@ const
   parser_e_absolute_sym_cannot_reference_itself=03363;
   parser_e_syscall_format_not_support=03364;
   parser_w_ignoring_published_property=03365;
+  parser_e_wasm_ref_types_can_only_be_passed_by_value=03366;
+  parser_e_promising_exports_not_supported_on_current_platform=03367;
+  parser_e_suspending_externals_not_supported_on_current_platform=03368;
+  parser_w_widechar_set_reduced=03369;
+  parser_e_nostringaliasinsystem=03370;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -601,6 +606,8 @@ const
   type_e_cant_read_write_type_in_iso_mode=04129;
   type_w_array_size_does_not_match_size_of_constant_string=04130;
   type_e_nested_procvar_to_funcref=04131;
+  type_e_cannot_take_address_of_wasm_externref=04132;
+  type_e_cannot_determine_size_of_wasm_reference_type=04133;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -687,6 +694,8 @@ const
   sym_e_generic_type_param_decl=05097;
   sym_e_type_must_be_rec_or_object=05098;
   sym_e_symbol_no_capture=05099;
+  sym_f_systemunitnotloaded=05100;
+  sym_e_wasm_ref_types_cannot_be_used_in_records=05101;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1104,6 +1113,9 @@ const
   option_valgrind_heaptrc_mismatch=11062;
   option_unsupported_fpu=11063;
   option_too_many_exception_modes=11064;
+  option_subtarget_is_already_set=11065;
+  option_subtarget_config_not_found=11066;
+  option_x_ignored=11067;
   wpo_cant_find_file=12000;
   wpo_begin_processing=12001;
   wpo_end_processing=12002;
@@ -1157,9 +1169,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 90618;
+  MsgTxtSize = 92057;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,109,366,132,100,63,148,38,223,71,
-    65,20,30,1,1,1,1,1,1,1
+    28,109,371,134,102,63,148,38,223,71,
+    68,20,30,1,1,1,1,1,1,1
   );

Rozdílová data souboru nebyla zobrazena, protože soubor je příliš velký
+ 328 - 311
compiler/msgtxt.inc


+ 18 - 6
compiler/nadd.pas

@@ -2675,9 +2675,9 @@ implementation
             case nodetype of
                equaln,unequaln :
                  begin
-                    if is_voidpointer(right.resultdef) then
+                    if is_voidpointer(right.resultdef) and (left.nodetype<>niln) then
                       inserttypeconv(right,left.resultdef)
-                    else if is_voidpointer(left.resultdef) then
+                    else if is_voidpointer(left.resultdef) and (right.nodetype<>niln) then
                       inserttypeconv(left,right.resultdef)
                     else if not(equal_defs(ld,rd)) then
                       IncompatibleTypes(ld,rd);
@@ -2704,6 +2704,16 @@ implementation
                       inserttypeconv_internal(right,charfarpointertype)
                     else
                       inserttypeconv_internal(right,charnearpointertype);
+{$elseif defined(wasm)}
+                    if is_wasm_reference_type(left.resultdef) then
+                      inserttypeconv(right,left.resultdef)
+                    else if is_wasm_reference_type(right.resultdef) then
+                      inserttypeconv(left,right.resultdef)
+                    else
+                      begin
+                        inserttypeconv_internal(left,charpointertype);
+                        inserttypeconv_internal(right,charpointertype);
+                      end;
 {$else}
                     inserttypeconv_internal(left,charpointertype);
                     inserttypeconv_internal(right,charpointertype);
@@ -2827,9 +2837,11 @@ implementation
                   st_unicodestring :
                     begin
                       if not(is_unicodestring(rd)) then
-                        inserttypeconv(right,cunicodestringtype);
+                        if not ((ld.size=0) and (nodetype in [equaln,unequaln])) then
+                          inserttypeconv(right,cunicodestringtype);
                       if not(is_unicodestring(ld)) then
-                        inserttypeconv(left,cunicodestringtype);
+                        if not ((rd.size=0) and (nodetype in [equaln,unequaln])) then
+                          inserttypeconv(left,cunicodestringtype);
                     end;
                   st_ansistring :
                     begin
@@ -3058,9 +3070,9 @@ implementation
                 if (rt=niln) then
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,'NIL');
                 if (not(cs_extsyntax in current_settings.moduleswitches) and not(nf_internal in flags))  or
-                   (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and
+                   (not (is_pchar(rd) or is_chararray(rd) or is_open_chararray(rd) or is_widechar(rd) or is_widechararray(rd) or is_open_widechararray(rd)) and
                     not(cs_pointermath in current_settings.localswitches) and
-                    not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then
+                    not((rd.typ=pointerdef) and tpointerdef(rd).has_pointer_math)) then
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
                 if (rd.typ=pointerdef) and
                    (tpointerdef(rd).pointeddef.size>1) then

+ 4 - 3
compiler/ncal.pas

@@ -58,7 +58,8 @@ interface
                                    (to prevent it from potentially happening again in a wrong context in case of constant propagation or so) }
          cnf_ignore_visibility,  { internally generated call that should ignore visibility checks }
          cnf_check_fpu_exceptions, { after the call fpu exceptions shall be checked }
-         cnf_ignore_devirt_wpo   { ignore this call for devirtualisatio info tracking: calls to newinstance generated by the compiler do not result in extra class types being instanced }
+         cnf_ignore_devirt_wpo,  { ignore this call for devirtualisation info tracking: calls to newinstance generated by the compiler do not result in extra class types being instanced }
+         cnf_no_convert_procvar  { don't convert a procdef to a procvar }
        );
        tcallnodeflags = set of tcallnodeflag;
 
@@ -3775,7 +3776,7 @@ implementation
                           { in tp mode we can try to convert to procvar if
                             there are no parameters specified }
                           if not(assigned(left)) and
-                             not(cnf_inherited in callnodeflags) and
+                             ([cnf_inherited,cnf_no_convert_procvar]*callnodeflags=[]) and
                              ((m_tp_procvar in current_settings.modeswitches) or
                               (m_mac_procvar in current_settings.modeswitches)) and
                              (not assigned(methodpointer) or
@@ -3823,7 +3824,7 @@ implementation
                            with generic types as arguments we don't complain in
                            the generic, but only during the specialization }
                          ignoregenericparacall:=false;
-                         if df_generic in current_procinfo.procdef.defoptions then
+                         if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
                            begin
                              pt:=tcallparanode(left);
                              while assigned(pt) do

+ 8 - 0
compiler/ncgrtti.pas

@@ -268,6 +268,11 @@ implementation
                       tcb.emit_ord_const(def.paras.count,u16inttype);
                       maybe_add_comment(tcb,#9'caller args size');
                       tcb.emit_ord_const(def.callerargareasize,ptrsinttype);
+                      maybe_add_comment(tcb,#9'invoke helper');
+                      if def.invoke_helper=nil then
+                        tcb.emit_tai(Tai_const.Create_nil_dataptr,voidcodepointertype)
+                      else
+                        tcb.emit_procdef_const(def.invoke_helper);
                       maybe_add_comment(tcb,#9'name');
                       tcb.emit_pooled_shortstring_const_ref(sym.realname);
 
@@ -1741,6 +1746,9 @@ implementation
             { write GUID }
             tcb.emit_guid_const(def.iidguid^);
 
+            { write hidden class reference - if it is nil, write_rtti_reference writes nil }
+            write_rtti_reference(tcb,def.hiddenclassdef,fullrtti);
+
             { write unit name }
             tcb.emit_shortstring_const(current_module.realmodulename^);
 

+ 25 - 8
compiler/ncnv.pas

@@ -557,8 +557,10 @@ implementation
                       { widechars are not yet supported }
                       if is_widechar(p2.resultdef) then
                         begin
-                          inserttypeconv(p2,cansichartype);
-                          if (p2.nodetype<>ordconstn) then
+
+                          if block_type<>bt_const then
+                            inserttypeconv(p2,cansichartype);
+                          if (p2.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
                             incompatibletypes(cwidechartype,cansichartype);
                         end;
 
@@ -567,8 +569,9 @@ implementation
                        begin
                          if is_widechar(p3.resultdef) then
                            begin
-                             inserttypeconv(p3,cansichartype);
-                             if (p3.nodetype<>ordconstn) then
+                             if block_type<>bt_const then
+                               inserttypeconv(p3,cansichartype);
+                             if (p3.nodetype<>ordconstn) and not (m_default_unicodestring in current_settings.modeswitches) then
                                begin
                                  current_filepos:=p3.fileinfo;
                                  incompatibletypes(cwidechartype,cansichartype);
@@ -741,7 +744,7 @@ implementation
                         begin
                           if p1.nodetype<>ordconstn then
                             exit
-                          else if tordconstnode(p1).value.uvalue>high(byte) then
+                          else if (tordconstnode(p1).value.uvalue>high(byte)) and not (m_default_unicodestring in current_settings.modeswitches) then
                             exit;
                         end;
 
@@ -751,7 +754,7 @@ implementation
                             begin
                               if p2.nodetype<>ordconstn then
                                 exit
-                              else if tordconstnode(p2).value.uvalue>high(byte) then
+                              else if (tordconstnode(p2).value.uvalue>high(byte)) and not (m_default_unicodestring in current_settings.modeswitches) then
                                 exit;
                             end;
 
@@ -2508,7 +2511,10 @@ implementation
                             not is_self_sym(tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym))
                           )
                         ) then
-                      internalerror(2021060801);
+                      begin
+                        result:=cerrornode.create;
+                        exit;
+                      end;
 
                     { so that insert_self_and_vmt_para correctly inserts the
                       Self, cause it otherwise skips that for anonymous functions }
@@ -2619,7 +2625,10 @@ implementation
                 else if tprocvardef(totypedef).is_addressonly then
                   begin
                     if assigned(tprocdef(pd).capturedsyms) and (tprocdef(pd).capturedsyms.count>0) then
-                      internalerror(2021060802);
+                      begin
+                        result:=cerrornode.create;
+                        exit;
+                      end;
 
                     { remove framepointer and Self parameters }
                     for i:=tprocdef(pd).parast.symlist.count-1 downto 0 do
@@ -3172,6 +3181,14 @@ implementation
                                  not(is_open_array(left.resultdef)) and
                                  not(is_array_constructor(left.resultdef)) and
                                  not(is_array_of_const(left.resultdef)) and
+                                 { if the from type is an anonymous function then
+                                   don't blindly convert it if the size is the same
+                                   as compare_defs_ext already determined that the
+                                   anonymous function is not compatible }
+                                 not(
+                                   (left.resultdef.typ=procdef) and
+                                   (po_anonymous in tprocdef(left.resultdef).procoptions)
+                                 ) and
                                  (left.resultdef.size=resultdef.size) and
                                  { disallow casts of const nodes }
                                  (not is_constnode(left) or

+ 2 - 2
compiler/ngenutil.pas

@@ -239,7 +239,7 @@ implementation
       if (target_info.system in systems_fpnestedstruct) and
          (p.nodetype=loadn) and
          (tloadnode(p).symtableentry.typ=localvarsym) and
-         (tloadnode(p).symtableentry.visibility=vis_hidden) then
+         tlocalvarsym(tloadnode(p).symtableentry).inparentfpstruct then
         begin
           p.free;
           result:=cnothingnode.create;
@@ -288,7 +288,7 @@ implementation
       if (target_info.system in systems_fpnestedstruct) and
          (p.nodetype=loadn) and
          (tloadnode(p).symtableentry.typ=localvarsym) and
-         (tloadnode(p).symtableentry.visibility=vis_hidden) then
+         tlocalvarsym(tloadnode(p).symtableentry).inparentfpstruct then
         begin
           p.free;
           result:=cnothingnode.create;

+ 21 - 6
compiler/ninl.pas

@@ -138,7 +138,7 @@ implementation
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
       cpuinfo,cpubase,
       pass_1,
-      ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,
+      ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils,ngenutil,
       nobjc,objcdef,
       cgbase,procinfo;
 
@@ -445,6 +445,7 @@ implementation
               not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
               ((def.typ=objectdef) and not is_object(def)) then
             internalerror(201202101);
+
           { extra '$' prefix because on darwin the result of makemangledname
             is prefixed by '_' and hence adding a '$' at the start of the
             prefix passed to makemangledname doesn't help (the whole point of
@@ -462,20 +463,21 @@ implementation
           if assigned(current_procinfo) then
             begin
               { the default sym is always part of the current procedure/function }
-              srsymtable:=current_procinfo.procdef.localst;
+              srsymtable:=current_module.localsymtable;
               srsym:=tsym(srsymtable.findwithhash(hashedid));
               if not assigned(srsym) then
                 begin
                   { no valid default variable found, so create it }
-                  srsym:=clocalvarsym.create(defaultname,vs_const,def,[]);
-                  srsymtable.insertsym(srsym);
+                  srsym:=cstaticvarsym.create(defaultname,vs_const,def,[]);
                   { mark the staticvarsym as typedconst }
                   include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
                   include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
                   { The variable has a value assigned }
                   tabstractvarsym(srsym).varstate:=vs_initialised;
-                  { the variable can't be placed in a register }
-                  tabstractvarsym(srsym).varregable:=vr_none;
+
+                  srsymtable.insertsym(srsym);
+                  cnodeutils.insertbssdata(tstaticvarsym(srsym));
+
                 end;
               result:=cloadnode.create(srsym,srsymtable);
             end
@@ -488,7 +490,20 @@ implementation
       begin
         if not assigned(left) or (left.nodetype<>typen) then
           internalerror(2012032102);
+
         def:=ttypenode(left).typedef;
+        if assigned(current_procinfo) and
+           (df_generic in current_procinfo.procdef.defoptions) then
+          begin
+            { don't allow as a default parameter value, because it may not be valid
+              when specialising }
+            if block_type<>bt_const then
+              result:=cpointerconstnode.create(0,def)
+            else
+              result:=cerrornode.create;
+            exit;
+          end;
+
         result:=nil;
         case def.typ of
           enumdef,

+ 384 - 16
compiler/ogcoff.pas

@@ -564,6 +564,318 @@ implementation
          NumberOfAuxSymbols : byte;
        end;
 
+       { This is defined in rtl/win/sysos.inc source }
+       tlsdirectory=packed record
+         data_start, data_end : globtype.PUInt;
+         index_pointer, callbacks_pointer : globtype.PUInt;
+         zero_fill_size : dword;
+         flags : dword;
+       end;
+
+       TPECoffExpDir=packed record
+         flag,
+         stamp      : cardinal;
+         Major,
+         Minor      : word;
+         Name,
+         Base,
+         NumFuncs,
+         NumNames,
+         AddrFuncs,
+         AddrNames,
+         AddrOrds   : cardinal;
+       end;
+       { MaybeSwap procedures 
+       tcoffpedatadir = packed record
+         vaddr : longword;
+         size  : longword;
+       end; }
+   procedure MaybeSwap(var v : tcoffpedatadir);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.vaddr:=SwapEndian(v.vaddr);
+            v.size:=SwapEndian(v.size);
+          end;
+      end;
+ (*
+       tcoffheader = packed record
+         mach   : word;
+         nsects : word;
+         time   : longword;
+         sympos : longword;
+         syms   : longword;
+         opthdr : word;
+         flag   : word;
+       end; *)
+   procedure MaybeSwap(var v : tcoffheader);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.mach:=SwapEndian(v.mach);
+            v.nsects:=SwapEndian(v.nsects);
+            v.time:=SwapEndian(v.time);
+            v.sympos:=SwapEndian(v.sympos);
+            v.syms:=SwapEndian(v.syms);
+            v.opthdr:=SwapEndian(v.opthdr);
+            v.flag:=SwapEndian(v.flag);
+          end;
+      end;
+(*
+       tcoffbigobjheader = packed record
+         Sig1 : word;
+         Sig2 : word;
+         Version : word;
+         Machine : word;
+         TimeDateStame : longword;
+         UUID : array[0..15] of byte;
+         unused : array[0..3] of longword;
+         NumberOfSections : longword;
+         PointerToSymbolTable : longword;
+         NumberOfSymbols : longword;
+       end; *)
+   procedure MaybeSwap(var v : tcoffbigobjheader);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.Sig1:=SwapEndian(v.Sig1);
+            v.Sig2:=SwapEndian(v.Sig2);
+            v.Version:=SwapEndian(v.Version);
+            v.Machine:=SwapEndian(v.Machine);
+            v.TimeDateStame:=SwapEndian(v.TimeDateStame);
+	    { UUID byte array no swap neeeded }
+	    { Assume unused fields are indeed really unused }
+            v.NumberOfSections:=SwapEndian(v.NumberOfSections);
+            v.PointerToSymbolTable:=SwapEndian(v.PointerToSymbolTable);
+            v.NumberOfSymbols:=SwapEndian(v.NumberOfSymbols);
+          end;
+      end;
+
+(*       tcoffpeoptheader = packed record
+         Magic : word;
+         MajorLinkerVersion : byte;
+         MinorLinkerVersion : byte;
+         tsize : longword;
+         dsize : longword;
+         bsize : longword;
+         entry : longword;
+         text_start : longword;
+{$ifndef cpu64bitaddr}
+         data_start : longword;
+{$endif cpu64bitaddr}
+         ImageBase : aword;
+         SectionAlignment : longword;
+         FileAlignment : longword;
+         MajorOperatingSystemVersion : word;
+         MinorOperatingSystemVersion : word;
+         MajorImageVersion : word;
+         MinorImageVersion : word;
+         MajorSubsystemVersion : word;
+         MinorSubsystemVersion : word;
+         Win32Version : longword;
+         SizeOfImage : longword;
+         SizeOfHeaders : longword;
+         CheckSum : longword;
+         Subsystem : word;
+         DllCharacteristics : word;
+         SizeOfStackReserve : aword;
+         SizeOfStackCommit : aword;
+         SizeOfHeapReserve : aword;
+         SizeOfHeapCommit : aword;
+         LoaderFlags : longword;          { This field is obsolete }
+         NumberOfRvaAndSizes : longword;
+         DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of tcoffpedatadir;
+       end; *)
+    procedure MaybeSwap(var v : tcoffpeoptheader);
+      var
+        i : longint;
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.Magic:=SwapEndian(v.Magic);
+            v.tsize:=SwapEndian(v.tsize);
+            v.dsize:=SwapEndian(v.dsize);
+            v.bsize:=SwapEndian(v.bsize);
+            v.entry:=SwapEndian(v.entry);
+            v.text_start:=SwapEndian(v.text_start);
+{$ifndef cpu64bitaddr}
+            v.data_start:=SwapEndian(v.data_start);
+{$endif cpu64bitaddr}
+            v.ImageBase:=SwapEndian(v.ImageBase);
+            v.SectionAlignment:=SwapEndian(v.SectionAlignment);
+            v.FileAlignment:=SwapEndian(v.FileAlignment);
+            v.MajorOperatingSystemVersion:=SwapEndian(v.MajorOperatingSystemVersion);
+            v.MinorOperatingSystemVersion:=SwapEndian(v.MinorOperatingSystemVersion);
+            v.MajorImageVersion:=SwapEndian(v.MajorImageVersion);
+            v.MinorImageVersion:=SwapEndian(v.MinorImageVersion);
+            v.MajorSubsystemVersion:=SwapEndian(v.MajorSubsystemVersion);
+            v.MinorSubsystemVersion:=SwapEndian(v.MinorSubsystemVersion);
+            v.Win32Version:=SwapEndian(v.Win32Version);
+            v.SizeOfImage:=SwapEndian(v.SizeOfImage);
+            v.SizeOfHeaders:=SwapEndian(v.SizeOfHeaders);
+            v.CheckSum:=SwapEndian(v.CheckSum);
+            v.Subsystem:=SwapEndian(v.Subsystem);
+            v.DllCharacteristics:=SwapEndian(v.DllCharacteristics);
+            v.SizeOfStackReserve:=SwapEndian(v.SizeOfStackReserve);
+            v.SizeOfStackCommit:=SwapEndian(v.SizeOfStackCommit);
+            v.SizeOfHeapReserve:=SwapEndian(v.SizeOfHeapReserve);
+            v.SizeOfHeapCommit:=SwapEndian(v.SizeOfHeapCommit);
+            v.LoaderFlags:=SwapEndian(v.LoaderFlags);
+            v.NumberOfRvaAndSizes:=SwapEndian(v.NumberOfRvaAndSizes);
+	    for i:=0 to PE_DATADIR_ENTRIES-1 do
+              MaybeSwap(v.DataDirectory[i]);
+          end;
+      end;
+
+(*
+       tcoffsechdr = packed record
+         name     : array[0..7] of char;
+         vsize    : longword;
+         rvaofs   : longword;
+         datasize : longword;
+         datapos  : longword;
+         relocpos : longword;
+         lineno1  : longword;
+         nrelocs  : word;
+         lineno2  : word;
+         flags    : longword;
+       end; *)
+    procedure MaybeSwap(var v : tcoffsechdr);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.vsize:=SwapEndian(v.vsize);
+            v.rvaofs:=SwapEndian(v.rvaofs);
+            v.datasize:=SwapEndian(v.datasize);
+            v.datapos:=SwapEndian(v.datapos);
+            v.relocpos:=SwapEndian(v.relocpos);
+            v.lineno1:=SwapEndian(v.lineno1);
+            v.nrelocs:=SwapEndian(v.nrelocs);
+            v.lineno2:=SwapEndian(v.lineno2);
+            v.flags:=SwapEndian(v.flags);
+          end;
+      end;
+(*
+      coffdjoptheader=packed record
+         magic  : word;
+         vstamp : word;
+         tsize  : longint;
+         dsize  : longint;
+         bsize  : longint;
+         entry  : longint;
+         text_start : longint;
+         data_start : longint;
+       end; *)
+    procedure MaybeSwap(var v : coffdjoptheader);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.magic:=SwapEndian(v.magic);
+            v.vstamp:=SwapEndian(v.vstamp);
+            v.tsize:=SwapEndian(v.tsize);
+            v.dsize:=SwapEndian(v.dsize);
+            v.bsize:=SwapEndian(v.bsize);
+            v.entry:=SwapEndian(v.entry);
+            v.text_start:=SwapEndian(v.text_start);
+            v.data_start:=SwapEndian(v.data_start);
+          end;
+      end;
+(*
+       coffsectionrec=packed record
+         len     : longword;
+         nrelocs : word;
+         nlines  : word;
+         checksum: longword;
+         assoc   : word;
+         select  : byte;
+         empty   : array[0..2] of char;
+       end; *)
+    procedure MaybeSwap(var v : coffsectionrec);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.len:=SwapEndian(v.len);
+            v.nrelocs:=SwapEndian(v.nrelocs);
+            v.nlines:=SwapEndian(v.nlines);
+            v.checksum:=SwapEndian(v.checksum);
+            v.assoc:=SwapEndian(v.assoc);
+          end;
+      end;
+(*
+       coffreloc=packed record
+         address  : longword;
+         sym      : longword;
+         reloctype : word;
+       end; *)
+    procedure MaybeSwap(var v : coffreloc);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.address:=SwapEndian(v.address);
+            v.sym:=SwapEndian(v.sym);
+            v.reloctype:=SwapEndian(v.reloctype);
+          end;
+      end;
+(*
+       strtableoffset=packed record
+         Zeroes : longword;
+         Offset : longword;
+       end;*)
+    procedure MaybeSwap(var v : strtableoffset);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.Zeroes:=SwapEndian(v.Zeroes);
+            v.Offset:=SwapEndian(v.Offset);
+          end;
+      end;
+(*
+       coffsymbol=packed record
+         name    : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
+         strpos  : longword;
+         value   : longword;
+         section : smallint;
+         empty   : word;                { actually type, $20: function, 0: not a function }
+         typ     : byte;
+         aux     : byte;
+       end; *)
+    procedure MaybeSwap(var v : coffsymbol);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            if v.name[0]=#0 then
+              v.strpos:=SwapEndian(v.strpos);
+            v.value:=SwapEndian(v.value);
+            v.section:=SwapEndian(v.section);
+            v.empty:=SwapEndian(v.empty);
+          end;
+      end;
+(*
+       coffbigobjsymbol=packed record
+         Name               : record
+                                case boolean of
+                                  True: (ShortName : array[0..7] of char);
+                                  False: (Offset : strtableoffset)
+                              end;
+         Value              : longword;
+         SectionNumber      : longword;
+         _Type              : word;
+         StorageClass       : byte;
+         NumberOfAuxSymbols : byte;
+       end; *)
+
+    procedure MaybeSwap(var v : coffbigobjsymbol);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            if (true) then
+              MaybeSwap(v.Name.Offset);
+            v.Value:=SwapEndian(v.Value);
+            v.SectionNumber:=SwapEndian(v.SectionNumber);
+            v._Type:=SwapEndian(v._Type);
+          end;
+      end;
+(*
        { This is defined in rtl/win/sysos.inc source }
        tlsdirectory=packed record
          data_start, data_end : PUInt;
@@ -571,7 +883,52 @@ implementation
          zero_fill_size : dword;
          flags : dword;
        end;
-
+     *)
+    procedure MaybeSwap(var v : tlsdirectory);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.data_start:=SwapEndian(v.data_start);
+            v.data_end:=SwapEndian(v.data_end);
+            v.index_pointer:=SwapEndian(v.index_pointer);
+            v.callbacks_pointer:=SwapEndian(v.callbacks_pointer);
+            v.zero_fill_size:=SwapEndian(v.zero_fill_size);
+            v.flags:=SwapEndian(v.flags);
+          end;
+      end;
+(*
+      TPECoffExpDir=packed record
+         flag,
+         stamp      : cardinal;
+         Major,
+         Minor      : word;
+         Name,
+         Base,
+         NumFuncs,
+         NumNames,
+         AddrFuncs,
+         AddrNames,
+         AddrOrds   : cardinal;
+       end;
+     *)
+    procedure MaybeSwap(var v : TPECoffExpDir);
+      begin
+        if source_info.endian<>target_info.endian then
+          begin
+            v.flag:=SwapEndian(v.flag);
+            v.stamp:=SwapEndian(v.stamp);
+            v.Major:=SwapEndian(v.Major);
+            v.Minor:=SwapEndian(v.Minor);
+            v.Name:=SwapEndian(v.Name);
+            v.Base:=SwapEndian(v.Base);
+            v.NumFuncs:=SwapEndian(v.NumFuncs);
+            v.NumNames:=SwapEndian(v.NumNames);
+            v.AddrFuncs:=SwapEndian(v.AddrFuncs);
+            v.AddrNames:=SwapEndian(v.AddrNames);
+            v.AddrOrds:=SwapEndian(v.AddrOrds);
+          end;
+     end;
+  
      const
        SymbolMaxGrow = 200*sizeof(coffsymbol);
        StrsMaxGrow   = 8192;
@@ -1437,6 +1794,7 @@ const pemagic : array[0..3] of byte = (
             bosym.StorageClass:=typ;
             bosym.NumberOfAuxSymbols:=aux;
             inc(symidx);
+	    MaybeSwap(bosym);
             FCoffSyms.write(bosym,sizeof(bosym));
           end
         else
@@ -1453,6 +1811,7 @@ const pemagic : array[0..3] of byte = (
             sym.typ:=typ;
             sym.aux:=aux;
             inc(symidx);
+	    MaybeSwap(sym);
             FCoffSyms.write(sym,sizeof(sym));
           end;
       end;
@@ -1503,6 +1862,7 @@ const pemagic : array[0..3] of byte = (
             rel.address:=TObjSection(p).ObjRelocations.Count+1;
             rel.sym:=0;
             rel.reloctype:=0;
+	    MaybeSwap(rel);
             FWriter.Write(rel,sizeof(rel));
           end;
         for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
@@ -1614,6 +1974,7 @@ const pemagic : array[0..3] of byte = (
               else
                 internalerror(200905071);
             end;
+	    MaybeSwap(rel);
             FWriter.write(rel,sizeof(rel));
           end;
       end;
@@ -1745,6 +2106,7 @@ const pemagic : array[0..3] of byte = (
               end
             else
               sechdr.flags:=djencodesechdrflags(secoptions);
+            MaybeSwap(sechdr);
             FWriter.write(sechdr,sizeof(sechdr));
           end;
       end;
@@ -1794,6 +2156,7 @@ const pemagic : array[0..3] of byte = (
                boheader.NumberOfSymbols:=longword(symidx);
                boheader.PointerToSymbolTable:=sympos;
                Move(COFF_BIG_OBJ_MAGIC,boheader.UUID,length(boheader.UUID));
+	       MaybeSwap(boheader);
                FWriter.write(boheader,sizeof(boheader));
              end
            else
@@ -1814,6 +2177,7 @@ const pemagic : array[0..3] of byte = (
                  end
                else
                  header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS;
+	       MaybeSwap(header);
                FWriter.write(header,sizeof(header));
              end;
            { Section headers }
@@ -1910,6 +2274,7 @@ const pemagic : array[0..3] of byte = (
             { If number of relocations exceeds 65535, it is stored in address field
               of the first record, and includes this first fake relocation. }
             FReader.read(rel,sizeof(rel));
+	    MaybeSwap(rel);
             s.coffrelocs:=rel.address-1;
             if s.coffrelocs<=65535 then
               InternalError(2013012503);
@@ -1917,6 +2282,7 @@ const pemagic : array[0..3] of byte = (
         for i:=1 to s.coffrelocs do
          begin
            FReader.read(rel,sizeof(rel));
+	   MaybeSwap(rel);
            case rel.reloctype of
 {$ifdef arm}
              IMAGE_REL_ARM_ABSOLUTE:
@@ -2061,6 +2427,7 @@ const pemagic : array[0..3] of byte = (
               if bigobj then
                 begin
                   FCoffSyms.Read(bosym,sizeof(bosym));
+		  MaybeSwap(bosym);
                   if bosym.Name.Offset.Zeroes<>0 then
                     begin
                       { Added for sake of global data analysis }
@@ -2081,6 +2448,7 @@ const pemagic : array[0..3] of byte = (
               else
                 begin
                   FCoffSyms.Read(sym,sizeof(sym));
+		  MaybeSwap(sym);
                   if plongint(@sym.name)^<>0 then
                     begin
                       { Added for sake of global data analysis }
@@ -2293,6 +2661,7 @@ const pemagic : array[0..3] of byte = (
                InputError('Can''t read COFF Header');
                exit;
              end;
+           MaybeSwap(header);
            if (header.mach=0) and (header.nsects=$ffff) then
              begin
                { either a library or big obj COFF }
@@ -2302,6 +2671,7 @@ const pemagic : array[0..3] of byte = (
                    InputError('Can''t read Big Obj COFF Header');
                    exit;
                  end;
+               MaybeSwap(boheader);
                if CompareByte(boheader.UUID,COFF_BIG_OBJ_MAGIC,length(boheader.uuid))<>0 then
                  begin
                    { ToDo: this should be treated as a library }
@@ -2385,6 +2755,7 @@ const pemagic : array[0..3] of byte = (
                   InputError('Error reading COFF Section Headers');
                   exit;
                 end;
+               MaybeSwap(sechdr);
                move(sechdr.name,secnamebuf,8);
                secnamebuf[8]:=#0;
                secname:=strpas(secnamebuf);
@@ -2513,6 +2884,7 @@ const pemagic : array[0..3] of byte = (
         sym.section:=section;
         sym.typ:=typ;
         sym.aux:=aux;
+	MaybeSwap(sym);
         FWriter.write(sym,sizeof(sym));
       end;
 
@@ -2612,6 +2984,7 @@ const pemagic : array[0..3] of byte = (
               end
             else
               sechdr.flags:=djencodesechdrflags(SecOptions);
+            MaybeSwap(sechdr);
             FWriter.write(sechdr,sizeof(sechdr));
           end;
       end;
@@ -2843,6 +3216,7 @@ const pemagic : array[0..3] of byte = (
           end
         else
           header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
+        MaybeSwap(header);
         FWriter.write(header,sizeof(header));
         { Optional COFF Header }
         if win32 then
@@ -2938,6 +3312,7 @@ const pemagic : array[0..3] of byte = (
             UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
             UpdateDataDir('.pdata',PE_DATADIR_PDATA);
             UpdateDataDir('.reloc',PE_DATADIR_RELOC);
+	    MaybeSwap(peoptheader);
             FWriter.write(peoptheader,sizeof(peoptheader));
           end
         else
@@ -2951,6 +3326,7 @@ const pemagic : array[0..3] of byte = (
             djoptheader.text_start:=TextExeSec.mempos;
             djoptheader.data_start:=DataExeSec.mempos;
             djoptheader.entry:=EntrySym.Address;
+	    MaybeSwap(djoptheader);
             FWriter.write(djoptheader,sizeof(djoptheader));
           end;
 
@@ -3414,20 +3790,6 @@ const pemagic : array[0..3] of byte = (
 {$endif win32}
 
     function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
-      type
-       TPECoffExpDir=packed record
-         flag,
-         stamp      : cardinal;
-         Major,
-         Minor      : word;
-         Name,
-         Base,
-         NumFuncs,
-         NumNames,
-         AddrFuncs,
-         AddrNames,
-         AddrOrds   : cardinal;
-       end;
       var
         DLLReader : TObjectReader;
         DosHeader : array[0..$7f] of byte;
@@ -3440,6 +3802,7 @@ const pemagic : array[0..3] of byte = (
         expdir    : TPECoffExpDir;
         i         : longint;
         found     : boolean;
+	header_ok : boolean;
         sechdr    : tCoffSecHdr;
 {$ifdef win32}
         p : pointer;
@@ -3473,7 +3836,9 @@ const pemagic : array[0..3] of byte = (
             Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
             exit;
           end;
-        if not DLLReader.Read(Header,sizeof(TCoffHeader)) or
+	header_ok:=DLLReader.Read(Header,sizeof(TCoffHeader));
+	MaybeSwap(Header);
+        if not header_ok or
            (Header.mach<>COFF_MAGIC) or
            (Header.opthdr<>sizeof(tcoffpeoptheader)) then
           begin
@@ -3482,6 +3847,7 @@ const pemagic : array[0..3] of byte = (
           end;
         { Read optheader }
         DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
+	MaybeSwap(peheader);
         { Section headers }
         found:=false;
         for i:=1 to header.nsects do
@@ -3491,6 +3857,7 @@ const pemagic : array[0..3] of byte = (
                 Comment(V_Error,'Error reading coff file '+DLLName);
                 exit;
               end;
+            MaybeSwap(sechdr);
             if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
                (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
               begin
@@ -3506,6 +3873,7 @@ const pemagic : array[0..3] of byte = (
         { Process edata }
         DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
         DLLReader.Read(expdir,sizeof(expdir));
+	MaybeSwap(expdir);
         for i:=0 to expdir.NumNames-1 do
           begin
             DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);

+ 1 - 1
compiler/ogmap.pas

@@ -81,7 +81,7 @@ implementation
               end;
             tmp[i]:='x';
             tmp[i-1]:='0';
-            setstring(result,@tmp[i-1],high(tmp)+2-i);
+            setstring(result,PChar(@tmp[i-1]),high(tmp)+2-i);
           end;
       end;
 

+ 15 - 1
compiler/ogwasm.pas

@@ -1669,6 +1669,18 @@ implementation
                           WriteByte(FWasmSections[wsiGlobal],$00);
                           WriteByte(FWasmSections[wsiGlobal],$0B);  { end }
                         end;
+                      wbt_externref:
+                        begin
+                          WriteByte(FWasmSections[wsiGlobal],$D0); { ref.null extern }
+                          WriteByte(FWasmSections[wsiGlobal],$6F);
+                          WriteByte(FWasmSections[wsiGlobal],$0B);  { end }
+                        end;
+                      wbt_funcref:
+                        begin
+                          WriteByte(FWasmSections[wsiGlobal],$D0); { ref.null func }
+                          WriteByte(FWasmSections[wsiGlobal],$70);
+                          WriteByte(FWasmSections[wsiGlobal],$0B);  { end }
+                        end;
                       else
                         internalerror(2022052801);
                     end;
@@ -1840,10 +1852,12 @@ implementation
           end
         else
           begin
-            WriteUleb(FWasmCustomSections[wcstTargetFeatures],2);
+            WriteUleb(FWasmCustomSections[wcstTargetFeatures],3);
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteName(FWasmCustomSections[wcstTargetFeatures],'bulk-memory');
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
+            WriteName(FWasmCustomSections[wcstTargetFeatures],'mutable-globals');
+            WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteName(FWasmCustomSections[wcstTargetFeatures],'sign-ext');
           end;
 

Rozdílová data souboru nebyla zobrazena, protože soubor je příliš velký
+ 2745 - 2466
compiler/options.pas


+ 1 - 1
compiler/owomflib.pas

@@ -134,7 +134,7 @@ implementation
     uses
       SysUtils,
       cstreams,cutils,
-      verbose,
+      globals,verbose,
       omfbase;
 
     const

+ 3 - 1
compiler/pbase.pas

@@ -372,7 +372,7 @@ implementation
                             exit(true);
                         end;
                       { system.char? (char=widechar comes from the implicit
-                        uuchar unit -> override) }
+                        uachar/uuchar unit -> override) }
                       if (pattern='CHAR') and
                          (tmodule(tunitsym(srsym).module).globalsymtable=systemunit) then
                         begin
@@ -399,6 +399,8 @@ implementation
                      end;
                   _STRING:
                     begin
+                      if cs_compilesystem in current_settings.moduleswitches then
+                        Message(parser_e_nostringaliasinsystem);
                       { system.string? }
                       if tmodule(tunitsym(srsym).module).globalsymtable=systemunit then
                         begin

+ 32 - 10
compiler/pdecl.pas

@@ -460,6 +460,7 @@ implementation
 
       var
         p,paran,pcalln,ptmp : tnode;
+        ecnt : longint;
         i,pcount : sizeint;
         paras : array of tnode;
         od : tobjectdef;
@@ -492,8 +493,9 @@ implementation
               if constrsym.typ<>procsym then
                 internalerror(2018102301);
 
-              pcalln:=ccallnode.create(paran,tprocsym(constrsym),od.symtable,cloadvmtaddrnode.create(p),[],nil);
+              pcalln:=ccallnode.create(paran,tprocsym(constrsym),od.symtable,cloadvmtaddrnode.create(p),[cnf_no_convert_procvar],nil);
               p:=nil;
+              ecnt:=errorcount;
               typecheckpass(pcalln);
 
               if (pcalln.nodetype=calln) and assigned(tcallnode(pcalln).procdefinition) and not codegenerror then
@@ -555,8 +557,12 @@ implementation
                         paras[i].free;
                     end;
                 end
-              else
+              else begin
+                { provide *some* error in case there hasn't been one }
+                if errorcount=ecnt then
+                  message(parser_e_illegal_expression);
                 pcalln.free;
+              end;
             end
           else
             begin
@@ -912,12 +918,15 @@ implementation
                             Delphi-compatible }
                           hdef2:=tstoreddef(hdef).getcopy;
                           tobjectdef(hdef2).childof:=tobjectdef(hdef);
+                          tstoreddef(hdef2).orgdef:=tstoreddef(hdef);
                           hdef:=hdef2;
                         end
                       else
                         begin
-                          hdef:=tstoreddef(hdef).getcopy;
-                          { check if it is an ansistirng(codepage) declaration }
+                          hdef2:=tstoreddef(hdef).getcopy;
+                          tstoreddef(hdef2).orgdef:=tstoreddef(hdef);
+                          hdef:=hdef2;
+                          { check if it is an ansistring(codepage) declaration }
                           if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then
                             begin
                               p:=comp_expr([ef_accept_equal]);
@@ -1297,6 +1306,8 @@ implementation
          sym : tsym;
          first,
          isgeneric : boolean;
+         pw : pcompilerwidestring;
+
       begin
          if target_info.system in systems_managed_vm then
            message(parser_e_feature_unsupported_for_vm);
@@ -1336,12 +1347,23 @@ implementation
                       stringconstn:
                         with Tstringconstnode(p) do
                           begin
-                             { resourcestrings are currently always single byte }
-                             if cst_type in [cst_widestring,cst_unicodestring] then
-                               changestringtype(getansistringdef);
-                             getmem(sp,len+1);
-                             move(value_str^,sp^,len+1);
-                             sym:=cconstsym.create_string(orgname,constresourcestring,sp,len,nil);
+                             if not is_systemunit_unicode  then
+                               begin
+                               if cst_type in [cst_widestring,cst_unicodestring] then
+                                 changestringtype(getansistringdef);
+                               getmem(sp,len+1);
+                               move(value_str^,sp^,len+1);
+                               sym:=cconstsym.create_string(orgname,constresourcestring,sp,len,nil);
+                               end
+                             else
+                               begin
+                               // For unicode rtl, resourcestrings are unicodestrings
+                               if cst_type in [cst_conststring,cst_longstring, cst_shortstring,cst_ansistring] then
+                                 changestringtype(cunicodestringtype);
+                               initwidestring(pw);
+                               copywidestring(pcompilerwidestring(value_str),pw);
+                               sym:=cconstsym.create_wstring(orgname,constresourcestring,pw);
+                               end;
                           end;
                       else
                         Message(parser_e_illegal_expression);

+ 12 - 1
compiler/pdecobj.pas

@@ -730,11 +730,22 @@ implementation
         end;
 
       procedure check_inheritance_record_type_helper(var def:tdef);
+        var
+          tmp : tstoreddef;
         begin
           if (def.typ<>errordef) and assigned(current_objectdef.childof) then
             begin
               if def<>current_objectdef.childof.extendeddef then
                 begin
+                  { a type helper may extend a type alias of the type its
+                    parent type helper extends }
+                  tmp:=tstoreddef(def);
+                  while (df_unique in tmp.defoptions) and assigned(tstoreddef(tmp).orgdef) do
+                    begin
+                      if tmp.orgdef=current_objectdef.childof.extendeddef then
+                        exit;
+                      tmp:=tstoreddef(tmp.orgdef);
+                    end;
                   Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
                   def:=generrordef;
                 end;
@@ -1558,7 +1569,7 @@ implementation
         { set published flag in $M+ mode, it can also be inherited and will
           be added when the parent class set with tobjectdef.set_parent (PFV) }
         if (cs_generate_rtti in current_settings.localswitches) and
-           (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
+           (current_objectdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_class,odt_helper]) then
           include(current_structdef.objectoptions,oo_can_have_published);
 
         { Objective-C/Java objectdefs can be "formal definitions", in which case

+ 73 - 14
compiler/pdecsub.pas

@@ -400,6 +400,8 @@ implementation
                    else
                      stoptions:=[];
                    single_type(arrayelementdef,stoptions);
+                   if assigned(arrayelementdef.typesym) then
+                     check_hints(arrayelementdef.typesym,arrayelementdef.typesym.symoptions,arrayelementdef.typesym.deprecatedmsg);
                    tarraydef(hdef).elementdef:=arrayelementdef;
                  end;
               end
@@ -469,6 +471,9 @@ implementation
           else
            hdef:=cformaltype;
 
+          if assigned(hdef.typesym) then
+            check_hints(hdef.typesym,hdef.typesym.symoptions,hdef.typesym.deprecatedmsg);
+
           { File types are only allowed for var and out parameters }
           if (hdef.typ=filedef) and
              not(varspez in [vs_out,vs_var]) then
@@ -510,6 +515,10 @@ implementation
                     if explicit_paraloc then
                       Message(parser_e_paraloc_all_paras);
                 end;
+{$ifdef wasm}
+              if (vs.varspez in [vs_var,vs_constref,vs_out]) and is_wasm_reference_type(vs.vardef) then
+                Message(parser_e_wasm_ref_types_can_only_be_passed_by_value);
+{$endif wasm}
             end;
         until not try_to_consume(_SEMICOLON);
 
@@ -541,6 +550,7 @@ implementation
         found,
         searchagain : boolean;
         st,
+        insertst,
         genericst: TSymtable;
         aprocsym : tprocsym;
         popclass : integer;
@@ -850,19 +860,23 @@ implementation
         hadspecialize:=false;
         addgendummy:=false;
 
+        { ensure that we don't insert into a withsymtable (can happen with
+          anonymous functions) }
+        checkstack:=symtablestack.stack;
+        while checkstack^.symtable.symtabletype in [withsymtable] do
+          checkstack:=checkstack^.next;
+        insertst:=checkstack^.symtable;
+
         if not assigned(genericdef) then
           begin
             if ppf_anonymous in flags then
               begin
-                checkstack:=symtablestack.stack;
-                while checkstack^.symtable.symtabletype in [withsymtable] do
-                  checkstack:=checkstack^.next;
-                if not (checkstack^.symtable.symtabletype in [localsymtable,staticsymtable]) then
+                if not (insertst.symtabletype in [localsymtable,staticsymtable]) then
                   internalerror(2021050101);
                 { generate a unique name for the anonymous function; don't use
                   something like file position however as this might be inside
                   an include file that's included multiple times }
-                str(checkstack^.symtable.symlist.count,orgsp);
+                str(insertst.symlist.count,orgsp);
                 orgsp:='__FPCINTERNAL__Anonymous_'+orgsp;
                 sp:=upper(orgsp);
                 spnongen:=sp;
@@ -1028,7 +1042,7 @@ implementation
                  if (potype=potype_operator)and(optoken=NOTOKEN) then
                    parse_operator_name;
 
-                 srsym:=tsym(symtablestack.top.Find(sp));
+                 srsym:=tsym(insertst.Find(sp));
 
                  { Also look in the globalsymtable if we didn't found
                    the symbol in the localsymtable }
@@ -1098,7 +1112,7 @@ implementation
                   operation }
                 if (potype=potype_operator) then
                   begin
-                    aprocsym:=Tprocsym(symtablestack.top.Find(sp));
+                    aprocsym:=Tprocsym(insertst.Find(sp));
                     if aprocsym=nil then
                       aprocsym:=cprocsym.create('$'+sp);
                   end
@@ -1111,7 +1125,7 @@ implementation
                   include(aprocsym.symoptions,sp_internal);
                 if addgendummy then
                   include(aprocsym.symoptions,sp_generic_dummy);
-                symtablestack.top.insertsym(aprocsym);
+                insertst.insertsym(aprocsym);
               end;
           end;
 
@@ -1172,7 +1186,7 @@ implementation
                   dummysym:=tsym(astruct.symtable.find(spnongen))
                 else
                   begin
-                    dummysym:=tsym(symtablestack.top.find(spnongen));
+                    dummysym:=tsym(insertst.find(spnongen));
                     if not assigned(dummysym) and
                         (symtablestack.top=current_module.localsymtable) and
                         assigned(current_module.globalsymtable) then
@@ -1186,7 +1200,7 @@ implementation
                     if assigned(astruct) then
                       astruct.symtable.insertsym(dummysym)
                     else
-                      symtablestack.top.insertsym(dummysym);
+                      insertst.insertsym(dummysym);
                   end
                 else if (dummysym.typ<>procsym) and
                     (
@@ -1278,10 +1292,18 @@ implementation
 
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
-        pd.visibility:=symtablestack.top.currentvisibility;
-        if symtablestack.top.currentlyoptional then
+        pd.visibility:=insertst.currentvisibility;
+        if insertst.currentlyoptional then
           include(pd.procoptions,po_optional);
 
+        { when extended rtti appears, then we must adapt this check}
+        if  (target_cpu=tsystemcpu.cpu_wasm32) and
+             assigned(astruct) and
+            (astruct.typ=objectdef) and
+            (tobjectdef(astruct).objecttype in [odt_interfacecom,odt_interfacecorba]) and
+            (pd.visibility=vis_published)  then
+          pd.synthetickind:=tsk_invoke_helper;
+
         { parse parameters }
         if token=_LKLAMMER then
           begin
@@ -1390,6 +1412,9 @@ implementation
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
               Message1(type_e_not_automatable,pd.returndef.typename);
 
+            if assigned(pd.returndef.typesym) then
+              check_hints(pd.returndef.typesym,pd.returndef.typesym.symoptions,pd.returndef.typesym.deprecatedmsg);
+
             if pd.is_generic or pd.is_specialization then
               symtablestack.pop(pd.parast);
             if popclass>0 then
@@ -2397,6 +2422,31 @@ begin
              else
                import_nr:=longint(v.svalue);
            end;
+          if (idtoken=_SUSPENDING) then
+           begin
+             if (target_info.system in systems_wasm) then
+              begin
+                consume(_SUSPENDING);
+                include(procoptions,po_wasm_suspending);
+                synthetickind:=tsk_wasm_suspending_first;
+                if idtoken=_FIRST then
+                  consume(_FIRST)
+                else if idtoken=_LAST then
+                  begin
+                    consume(_LAST);
+                    synthetickind:=tsk_wasm_suspending_last;
+                  end;
+              end
+             else
+              begin
+                message(parser_e_suspending_externals_not_supported_on_current_platform);
+                consume(_SUSPENDING);
+                if idtoken=_FIRST then
+                  consume(_FIRST)
+                else if idtoken=_LAST then
+                  consume(_LAST);
+              end;
+           end;
           { default is to used the realname of the procedure }
           if (import_nr=0) and not assigned(import_name) then
             begin
@@ -2476,7 +2526,7 @@ type
    end;
 const
   {Should contain the number of procedure directives we support.}
-  num_proc_directives=54;
+  num_proc_directives=55;
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
     (
@@ -2983,6 +3033,15 @@ const
       mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_interrupt]
+    ),(
+      idtok:_WASMFUNCREF;
+      pd_flags : [pd_procvar];
+      handler  : nil;
+      pocall   : pocall_none;
+      pooption : [po_wasm_funcref];
+      mutexclpocall : [];
+      mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
+      mutexclpo     : [po_interrupt]
     )
    );
 
@@ -3283,7 +3342,7 @@ const
           it because it can already be used somewhere (PFV) }
         if not(po_has_mangledname in pd.procoptions) then
           begin
-            if (po_external in pd.procoptions) then
+            if (po_external in pd.procoptions) and not (po_wasm_suspending in pd.procoptions) then
               begin
                 { External Procedures are only allowed to change the mangledname
                   in their first declaration }

+ 5 - 1
compiler/pdecvar.pas

@@ -57,7 +57,7 @@ implementation
        systems,
        { symtable }
        symconst,symbase,defutil,defcmp,symutil,symcreat,
-{$if defined(i386) or defined(i8086)}
+{$if defined(i386) or defined(i8086) or defined(wasm)}
        symcpu,
 {$endif}
        fmodule,htypechk,procdefutil,
@@ -1779,6 +1779,10 @@ implementation
 
              read_anon_type(hdef,false);
              maybe_guarantee_record_typesym(hdef,symtablestack.top);
+{$ifdef wasm}
+             if is_wasm_reference_type(hdef) then
+               messagepos(typepos,sym_e_wasm_ref_types_cannot_be_used_in_records);
+{$endif wasm}
              block_type:=bt_var;
              { allow only static fields reference to struct where they are declared }
              if not (vd_class in options) then

+ 18 - 0
compiler/pexports.pas

@@ -176,6 +176,24 @@ implementation
                        include(options,eo_resident);
                        DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                      end;
+                    if try_to_consume(_PROMISING) then
+                     begin
+                       if target_info.system in systems_wasm then
+                         begin
+                           if try_to_consume(_FIRST) then
+                             include(options,eo_promising_first)
+                           else if try_to_consume(_LAST) then
+                             include(options,eo_promising_last)
+                           else
+                             include(options,eo_promising_first);
+                         end
+                       else
+                         begin
+                           Message(parser_e_promising_exports_not_supported_on_current_platform);
+                           if not try_to_consume(_FIRST) then
+                             try_to_consume(_LAST);
+                         end;
+                     end;
                     if (DefString<>'') and UseDeffileForExports then
                      DefFile.AddExport(DefString);
                   end;

+ 27 - 2
compiler/pexpr.pas

@@ -141,6 +141,9 @@ implementation
            end
           else
             begin
+             // string[x] is allowed in system unit since it is a shortstring.
+             if cs_compilesystem in current_settings.moduleswitches then
+               Message(parser_e_nostringaliasinsystem);
               if cs_refcountedstrings in current_settings.localswitches then
                 begin
                   if m_default_unicodestring in current_settings.modeswitches then
@@ -459,6 +462,10 @@ implementation
                    ttypenode(p1).helperallowed:=true;
                  if (p1.resultdef.typ=forwarddef) then
                    Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
+{$ifdef wasm}
+                 if is_wasm_reference_type(p1.resultdef) then
+                   Message(type_e_cannot_determine_size_of_wasm_reference_type);
+{$endif wasm}
                  if (l = in_sizeof_x) or
                     (not((p1.nodetype = vecn) and
                          is_packed_array(tvecnode(p1).left.resultdef)) and
@@ -3110,7 +3117,10 @@ implementation
                 begin
                   result:=cloadnode.create(srsym,srsymtable);
                   do_typecheckpass(result);
-                  result.resultdef:=getansistringdef;
+                  if is_systemunit_unicode then
+                    result.resultdef:=cstringdef.createunicode(true)
+                  else
+                    result.resultdef:=getansistringdef;
                 end
               else
                 result:=genconstsymtree(tconstsym(srsym));
@@ -4032,6 +4042,8 @@ implementation
 
              _STRING :
                begin
+                 if cs_compilesystem in current_settings.moduleswitches then
+                   Message(parser_e_nostringaliasinsystem);
                  string_dec(hdef,true);
                  { STRING can be also a type cast }
                  if try_to_consume(_LKLAMMER) then
@@ -4996,6 +5008,11 @@ implementation
      constant. Then the constant is returned.}
     var
       p:tnode;
+      snode : tstringconstnode absolute p;
+      s : string;
+      pw : pcompilerwidestring;
+      pc : pansichar;
+
     begin
       get_stringconst:='';
       p:=comp_expr([ef_accept_equal]);
@@ -5006,8 +5023,16 @@ implementation
           else
             Message(parser_e_illegal_expression);
         end
+      else if (tstringconstnode(p).cst_type in [cst_unicodestring,cst_widestring]) then
+         begin
+           pw:=pcompilerwideString(tstringconstnode(p).value_str);
+           pc:=getmem(getlengthwidestring(pw));
+           unicode2ascii(pw,pc,current_settings.sourcecodepage);
+           get_stringconst:=strpas(pc);
+           freemem(pc);
+         end
       else
-        get_stringconst:=strpas(tstringconstnode(p).value_str);
+        get_stringconst:=strpas(snode.value_str);
       p.free;
     end;
 

+ 8 - 1
compiler/pgenutil.pas

@@ -2702,6 +2702,8 @@ uses
       unitsyms : TFPHashObjectList;
       sym : tsym;
       i : Integer;
+      n : string;
+
     begin
       if not assigned(genericdef) then
         internalerror(200705151);
@@ -2728,7 +2730,12 @@ uses
           begin
             sym:=tsym(hmodule.globalsymtable.symlist[i]);
             if sym.typ=unitsym then
-              unitsyms.add(upper(sym.realname),sym);
+              begin
+              n:=sym.realname;
+              if (Copy(n,1,7)='$hidden') then
+                Delete(n,1,7);
+              unitsyms.add(upper(n),sym);
+              end;
           end;
       { add all units if we are specializing inside the current unit (as the
         generic could have been declared in the implementation part), but load

+ 58 - 6
compiler/pmodules.pas

@@ -36,7 +36,7 @@ implementation
        globtype,systems,tokens,
        cutils,cfileutl,cclasses,comphook,
        globals,verbose,fmodule,finput,fppu,globstat,fpcp,fpkg,
-       symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
+       symconst,symbase,symtype,symdef,symsym,symtable,defutil,symcreat,
        wpoinfo,
        aasmtai,aasmdata,aasmbase,aasmcpu,
        cgbase,ngenutil,
@@ -211,23 +211,30 @@ implementation
     procedure maybeloadvariantsunit;
       var
         hp : tmodule;
+        addsystemnamespace : Boolean;
       begin
         { Do we need the variants unit? Skip this
           for VarUtils unit for bootstrapping }
         if not(mf_uses_variants in current_module.moduleflags) or
-           (current_module.modulename^='VARUTILS') then
+           (current_module.modulename^='VARUTILS') or
+           (current_module.modulename^='SYSTEM.VARUTILS') then
           exit;
         { Variants unit already loaded? }
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
           begin
-            if hp.modulename^='VARIANTS' then
+            if (hp.modulename^='VARIANTS') or (hp.modulename^='SYSTEM.VARIANTS') then
               exit;
             hp:=tmodule(hp.next);
           end;
         { Variants unit is not loaded yet, load it now }
         Message(parser_w_implicit_uses_of_variants_unit);
+        addsystemnamespace:=namespacelist.Find('System')=Nil;
+        if addsystemnamespace then
+          namespacelist.concat('System');
         AddUnit('variants');
+        if addsystemnamespace then
+          namespacelist.Remove('System');
       end;
 
 
@@ -316,6 +323,12 @@ implementation
           prevent crashes when accessing .owner }
         generrorsym.owner:=systemunit;
         generrordef.owner:=systemunit;
+        // Implicitly enable unicode strings in unicode RTL in modes objfpc/delphi.
+        { TODO: Check if we should also do this for mode macpas }
+        if not (cs_compilesystem in current_settings.moduleswitches) then
+          if ([m_objfpc,m_delphi] * current_settings.modeswitches)<>[] then
+            if is_systemunit_unicode then
+              Include(current_settings.modeswitches,m_default_unicodestring)
       end;
 
 
@@ -382,9 +395,21 @@ implementation
         if m_blocks in current_settings.modeswitches then
           AddUnit('blockrtl');
 
-        { default char=widechar? }
-        if m_default_unicodestring in current_settings.modeswitches then
-          AddUnit('uuchar');
+        { Determine char size. }
+
+        // Ansi RTL ?
+        if not is_systemunit_unicode then
+          begin
+          if m_default_unicodestring in current_settings.modeswitches then
+            AddUnit('uuchar'); // redefines char as widechar
+          end
+        else
+          begin
+          // Unicode RTL
+          if not (m_default_ansistring in current_settings.modeswitches) then
+            if not (current_module.modulename^<>'UACHAR') then
+              AddUnit('uachar'); // redefines char as ansichar
+          end;
 
         { Objective-C support unit? }
         if (m_objectivec1 in current_settings.modeswitches) then
@@ -1000,6 +1025,11 @@ type
          if not(cs_compilesystem in current_settings.moduleswitches) and
             (token=_USES) then
            begin
+             // We do this as late as possible.
+             if Assigned(current_module) then
+               current_module.Loadlocalnamespacelist
+             else
+               current_namespacelist:=Nil;
              loadunits(nil);
              { has it been compiled at a higher level ?}
              if current_module.state=ms_compiled then
@@ -1233,6 +1263,13 @@ type
          { Generate specializations of objectdefs methods }
          generate_specialization_procs;
 
+         // This needs to be done before we generate the VMTs
+         if (target_cpu=tsystemcpu.cpu_wasm32) then
+           begin
+           add_synthetic_interface_classes_for_st(current_module.globalsymtable);
+           add_synthetic_interface_classes_for_st(current_module.localsymtable);
+           end;
+
          { Generate VMTs }
          if Errorcount=0 then
            begin
@@ -1615,6 +1652,12 @@ type
          { ensure that no packages are picked up from the options }
          packagelist.clear;
 
+         // There should always be a requires, except for the system package. So we load here
+         if Assigned(current_module) then
+           current_module.Loadlocalnamespacelist
+         else
+           current_namespacelist:=Nil;
+
          {Read the packages used by the package we compile.}
          if (token=_ID) and (idtoken=_REQUIRES) then
            begin
@@ -2163,6 +2206,11 @@ type
          { Load the units used by the program we compile. }
          if token=_USES then
            begin
+             // We can do this here: if there is no uses then the namespace directive makes no sense.
+             if Assigned(current_module) then
+               current_module.Loadlocalnamespacelist
+             else
+               current_namespacelist:=Nil;
              loadunits(nil);
              consume_semicolon_after_uses:=true;
            end
@@ -2260,6 +2308,10 @@ type
          { Generate specializations of objectdefs methods }
          generate_specialization_procs;
 
+         // This needs to be done before we generate the VMTs
+         if (target_cpu=tsystemcpu.cpu_wasm32) then
+           add_synthetic_interface_classes_for_st(current_module.localsymtable);
+
          { Generate VMTs }
          if Errorcount=0 then
            write_vmts(current_module.localsymtable,false);

+ 1 - 1
compiler/powerpc64/cpubase.pas

@@ -405,7 +405,7 @@ function eh_return_data_regno(nr: longint): longint;
 implementation
 
 uses
-  rgBase, verbose, itcpugas;
+  rgBase, globals, verbose, itcpugas;
 
 const
   std_regname_table: TRegNameTable = (

+ 101 - 62
compiler/pparautl.pas

@@ -76,6 +76,8 @@ implementation
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
+      const
+        name_result='result';
       var
         storepos : tfileposinfo;
         vs       : tparavarsym;
@@ -87,7 +89,8 @@ implementation
            { if this was originally an anonymous function then this was already
              done earlier }
            not ((pd.typ=procdef) and tprocdef(pd).was_anonymous) and
-           paramanager.ret_in_param(pd.returndef,pd) then
+           paramanager.ret_in_param(pd.returndef,pd) and
+           not assigned(pd.parast.find(name_result)) then
          begin
            storepos:=current_tokenpos;
            if pd.typ=procdef then
@@ -113,7 +116,7 @@ implementation
            else
              paranr:=paranr_result;
            { Generate result variable accessing function result }
-           vs:=cparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
+           vs:=cparavarsym.create('$'+name_result,paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]);
            pd.parast.insertsym(vs);
            { Store this symbol as funcretsym for procedures }
            if pd.typ=procdef then
@@ -125,12 +128,15 @@ implementation
 
 
     procedure insert_parentfp_para(pd:tabstractprocdef);
+      const
+        name_parentfp='parentfp';
       var
         storepos : tfileposinfo;
         vs       : tparavarsym;
         paranr   : longint;
       begin
-        if pd.parast.symtablelevel>normal_function_level then
+        if (pd.parast.symtablelevel>normal_function_level) and
+           not assigned(pd.parast.find(name_parentfp)) then
           begin
             storepos:=current_tokenpos;
             if pd.typ=procdef then
@@ -157,14 +163,14 @@ implementation
                not assigned(pd.owner.defowner) or
                (pd.owner.defowner.typ<>procdef) then
               begin
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value
+                vs:=cparavarsym.create('$'+name_parentfp,paranr,vs_value
                       ,parentfpvoidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
               end
             else
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value,
+                vs:=cparavarsym.create('$'+name_parentfp,paranr,vs_value,
                       tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
             pd.parast.insertsym(vs);
@@ -175,6 +181,11 @@ implementation
 
 
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
+      const
+        name_cmd='_cmd';
+        name_self='self';
+        name_block_literal='_block_literal';
+        name_vmt='vmt';
       var
         storepos : tfileposinfo;
         vs       : tparavarsym;
@@ -188,55 +199,65 @@ implementation
            is_objc_class_or_protocol(tprocdef(pd).struct) and
            (pd.parast.symtablelevel=normal_function_level) then
           begin
-            { insert Objective-C self and selector parameters }
-            vs:=cparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
-            { make accessible to code }
-            sl:=tpropaccesslist.create;
-            sl.addsym(sl_load,vs);
-            aliasvs:=cabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
-            include(aliasvs.varoptions,vo_is_msgsel);
-            tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
-
-            if (po_classmethod in pd.procoptions) then
-              { compatible with what gcc does }
-              hdef:=objc_idtype
-            else
-              hdef:=tprocdef(pd).struct;
+            if not assigned(pd.parast.find(name_cmd)) or
+                not assigned(pd.parast.find(name_self)) then
+              begin
+                { insert Objective-C self and selector parameters }
+                vs:=cparavarsym.create('$'+name_cmd,paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+                { make accessible to code }
+                sl:=tpropaccesslist.create;
+                sl.addsym(sl_load,vs);
+                aliasvs:=cabsolutevarsym.create_ref('_CMD',objc_seltype,sl);
+                include(aliasvs.varoptions,vo_is_msgsel);
+                tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
 
-            vs:=cparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
+                if (po_classmethod in pd.procoptions) then
+                  { compatible with what gcc does }
+                  hdef:=objc_idtype
+                else
+                  hdef:=tprocdef(pd).struct;
+
+                vs:=cparavarsym.create('$'+name_self,paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+              end;
           end
         else if (pd.typ=procvardef) and
            pd.is_methodpointer then
           begin
-            { Generate self variable }
-            vs:=cparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
-            pd.parast.insertsym(vs);
+            if not assigned(pd.parast.find(name_self)) then
+              begin
+                { Generate self variable }
+                vs:=cparavarsym.create('$'+name_self,paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]);
+                pd.parast.insertsym(vs);
+              end;
           end
         { while only procvardefs of this type can be declared in Pascal code,
           internally we also generate procdefs of this type when creating
           block wrappers }
         else if (po_is_block in pd.procoptions) then
           begin
-            { generate the first hidden parameter, which is a so-called "block
-              literal" describing the block and containing its invocation
-              procedure  }
-            hdef:=cpointerdef.getreusable(get_block_literal_type_for_proc(pd));
-            { mark as vo_is_parentfp so that proc2procvar comparisons will
-              succeed when assigning arbitrary routines to the block }
-            vs:=cparavarsym.create('$_block_literal',paranr_blockselfpara,vs_value,
-              hdef,[vo_is_hidden_para,vo_is_parentfp]
-            );
-            pd.parast.insertsym(vs);
-            if pd.typ=procdef then
+            if not assigned(pd.parast.find('$'+name_block_literal)) then
               begin
-                { make accessible to code }
-                sl:=tpropaccesslist.create;
-                sl.addsym(sl_load,vs);
-                aliasvs:=cabsolutevarsym.create_ref('FPC_BLOCK_SELF',hdef,sl);
-                include(aliasvs.varoptions,vo_is_parentfp);
-                tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
+                { generate the first hidden parameter, which is a so-called "block
+                  literal" describing the block and containing its invocation
+                  procedure  }
+                hdef:=cpointerdef.getreusable(get_block_literal_type_for_proc(pd));
+                { mark as vo_is_parentfp so that proc2procvar comparisons will
+                  succeed when assigning arbitrary routines to the block }
+                vs:=cparavarsym.create('$'+name_block_literal,paranr_blockselfpara,vs_value,
+                  hdef,[vo_is_hidden_para,vo_is_parentfp]
+                );
+                pd.parast.insertsym(vs);
+                if pd.typ=procdef then
+                  begin
+                    { make accessible to code }
+                    sl:=tpropaccesslist.create;
+                    sl.addsym(sl_load,vs);
+                    aliasvs:=cabsolutevarsym.create_ref('FPC_BLOCK_SELF',hdef,sl);
+                    include(aliasvs.varoptions,vo_is_parentfp);
+                    tlocalsymtable(tprocdef(pd).localst).insertsym(aliasvs);
+                  end;
               end;
           end
         else
@@ -264,9 +285,10 @@ implementation
                          { no vmt for record/type helper constructors }
                          is_objectpascal_helper(tprocdef(pd).struct) and
                          (tobjectdef(tprocdef(pd).struct).extendeddef.typ<>objectdef)
-                       )) then
+                       )) and
+                   not assigned(pd.parast.find(name_vmt)) then
                  begin
-                   vs:=cparavarsym.create('$vmt',paranr_vmt,vs_value,cclassrefdef.create(tprocdef(pd).struct),[vo_is_vmt,vo_is_hidden_para]);
+                   vs:=cparavarsym.create('$'+name_vmt,paranr_vmt,vs_value,cclassrefdef.create(tprocdef(pd).struct),[vo_is_vmt,vo_is_hidden_para]);
                    pd.parast.insertsym(vs);
                  end;
 
@@ -291,10 +313,10 @@ implementation
                       vsp:=vs_var;
                     hdef:=selfdef;
                   end;
-                vs:=tparavarsym(pd.parast.find('self'));
+                vs:=tparavarsym(pd.parast.find(name_self));
                 if not assigned(vs) or (vs.typ<>paravarsym) or (vs.vardef<>hdef) then
                   begin
-                    vs:=cparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
+                    vs:=cparavarsym.create('$'+name_self,paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
                     pd.parast.insertsym(vs);
                   end;
 
@@ -335,8 +357,13 @@ implementation
 
            { insert the name of the procedure as alias for the function result,
              we can't use realname because that will not work for compilerprocs
-             as the name is lowercase and unreachable from the code }
-           if (pd.proctypeoption<>potype_operator) or assigned(pd.resultname) then
+             as the name is lowercase and unreachable from the code;
+             don't insert this alias for an anonymous function unless an
+             explicit name is provided }
+           if (
+                 (pd.proctypeoption<>potype_operator) and
+                 not (po_anonymous in pd.procoptions)
+               ) or assigned(pd.resultname) then
              begin
                if assigned(pd.resultname) then
                  hs:=pd.resultname^
@@ -384,7 +411,11 @@ implementation
 
 
     procedure insert_hidden_para(p:TObject;arg:pointer);
+      const
+        name_high = 'high';
+        name_typinfo = 'typinfo';
       var
+        n   : tsymstr;
         hvs : tparavarsym;
         pd  : tabstractprocdef absolute arg;
       begin
@@ -415,19 +446,23 @@ implementation
            { needs high parameter ? }
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
+               n:=name_high+name;
+               if not assigned(owner.find(n)) then
+                 begin
 {$ifdef cpu8bitalu}
-               if is_shortstring(vardef) then
-                 hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,aluuinttype,[vo_is_high_para,vo_is_hidden_para])
-               else
+                   if is_shortstring(vardef) then
+                     hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,aluuinttype,[vo_is_high_para,vo_is_hidden_para])
+                   else
 {$endif cpu8bitalu}
-                 hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,sizesinttype,[vo_is_high_para,vo_is_hidden_para]);
-               hvs.symoptions:=[];
-               owner.insertsym(hvs);
-               { don't place to register if it will be accessed from implicit finally block }
-               if (varspez=vs_value) and
-                  is_open_array(vardef) and
-                  is_managed_type(vardef) then
-                 hvs.varregable:=vr_none;
+                     hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,sizesinttype,[vo_is_high_para,vo_is_hidden_para]);
+                   hvs.symoptions:=[];
+                   owner.insertsym(hvs);
+                   { don't place to register if it will be accessed from implicit finally block }
+                   if (varspez=vs_value) and
+                      is_open_array(vardef) and
+                      is_managed_type(vardef) then
+                     hvs.varregable:=vr_none;
+                 end;
              end
            else
             begin
@@ -448,9 +483,13 @@ implementation
                end;
               if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
                 begin
-                  hvs:=cparavarsym.create('$typinfo'+name,paranr+1,vs_const,voidpointertype,
-                                          [vo_is_typinfo_para,vo_is_hidden_para]);
-                  owner.insertsym(hvs);
+                  n:=name_typinfo+name;
+                  if not assigned(owner.find(n)) then
+                    begin
+                      hvs:=cparavarsym.create('$'+n,paranr+1,vs_const,voidpointertype,
+                                              [vo_is_typinfo_para,vo_is_hidden_para]);
+                      owner.insertsym(hvs);
+                    end;
                 end;
             end;
          end;

+ 2 - 0
compiler/ppcx64.lpi

@@ -22,7 +22,9 @@
     </PublishOptions>
     <RunParams>
       <local>
+        <CommandLineParams Value="-Tlinux -tunicodertl -FUrtl-objpas\units\x86_64-linux-unicodertl\ -Fu\home\tixeo\FPC\FPC\src\rtl\units\x86_64-linux-unicodertl\ -Furtl-objpas\src\inc -Furtl-objpas\src\common -Firtl-objpas\src\inc -Firtl-objpas\src\linux -Firtl-objpas\src\x86_64 -Firtl-objpas\src\common -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -tunicodertl -Cg -Fl\usr\lib\gcc\x86_64-linux-gnu\11 -gl -dx86_64 -Sc -viq rtl-objpas\BuildUnit_rtl_objpas.pp"/>
         <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="\home\tixeo\fpc\packages"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">

+ 1 - 1
compiler/ppu.pas

@@ -48,7 +48,7 @@ const
   CurrentPPUVersion = 208;
   { for any other changes to the ppu format, increase this version number
     (it's a cardinal) }
-  CurrentPPULongVersion = 18;
+  CurrentPPULongVersion = 19;
 
 { unit flags }
   uf_big_endian          = $000004;

+ 12 - 12
compiler/procdefutil.pas

@@ -1138,6 +1138,7 @@ implementation
       invokename : tsymstr;
       i : longint;
       outerself,
+      fpsym,
       selfsym,
       sym : tsym;
       info : pcapturedsyminfo;
@@ -1146,7 +1147,6 @@ implementation
       invokedef,
       parentdef,
       curpd : tprocdef;
-      syms : tfpobjectlist;
     begin
       capturer:=nil;
       result:=funcref_intf_for_proc(pd,fileinfo_to_suffix(pd.fileinfo));
@@ -1203,24 +1203,24 @@ implementation
           pd.procsym.realname:=invokename;
           pd.parast.symtablelevel:=normal_function_level;
           pd.localst.symtablelevel:=normal_function_level;
-          { collect all hidden parameters and especially the self parameter (if any) }
+          { retrieve framepointer and self parameters if any }
+          fpsym:=nil;
           selfsym:=nil;
-          syms:=tfpobjectlist.create(false);
           for i:=0 to pd.parast.symlist.count-1 do
             begin
               sym:=tsym(pd.parast.symlist[i]);
               if sym.typ<>paravarsym then
                 continue;
-              if vo_is_self in tparavarsym(sym).varoptions then
-                selfsym:=sym
-              else if vo_is_hidden_para in tparavarsym(sym).varoptions then
-                syms.add(sym);
+              if vo_is_parentfp in tparavarsym(sym).varoptions then
+                fpsym:=sym
+              else if vo_is_self in tparavarsym(sym).varoptions then
+                selfsym:=sym;
+              if assigned(fpsym) and assigned(selfsym) then
+                break;
             end;
-          { get rid of the hidden parameters; they will be added again during
-            buildvmt of the capturer }
-          for i:=0 to syms.count-1 do
-            pd.parast.deletesym(tsym(syms[i]));
-          syms.free;
+          { get rid of the framepointer parameter }
+          if assigned(fpsym) then
+            pd.parast.deletesym(fpsym);
           outerself:=nil;
           { complain about all symbols that can't be captured and add the symbols
             to this procdefs capturedsyms if it isn't a top level function }

+ 0 - 39
compiler/psub.pas

@@ -275,34 +275,6 @@ implementation
                       PROCEDURE/FUNCTION BODY PARSING
 ****************************************************************************}
 
-    procedure initializedefaultvars(p:TObject;arg:pointer);
-      var
-        b : tblocknode;
-      begin
-        if tsym(p).typ<>localvarsym then
-         exit;
-        with tabstractnormalvarsym(p) do
-         begin
-           if (vo_is_default_var in varoptions) and (vardef.size>0) then
-             begin
-               b:=tblocknode(arg);
-               b.left:=cstatementnode.create(
-                         ccallnode.createintern('fpc_zeromem',
-                           ccallparanode.create(
-                             cordconstnode.create(vardef.size,sizeuinttype,false),
-                             ccallparanode.create(
-                               caddrnode.create_internal(
-                                 cloadnode.create(tsym(p),tsym(p).owner)),
-                                 nil
-                               )
-                             )
-                           ),
-                         b.left);
-             end;
-         end;
-      end;
-
-
     procedure initializevars(p:TObject;arg:pointer);
       var
         b : tblocknode;
@@ -320,8 +292,6 @@ implementation
                             cloadnode.create(defaultconstsym,defaultconstsym.owner)),
                         b.left);
             end
-           else
-             initializedefaultvars(p,arg);
          end;
       end;
 
@@ -365,15 +335,6 @@ implementation
            current_filepos:=current_procinfo.entrypos;
            current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block);
            current_filepos:=oldfilepos;
-         end
-        else if current_procinfo.procdef.localst.symtabletype=staticsymtable then
-         begin
-           { for program and unit initialization code we also need to
-             initialize the local variables used of Default() }
-           oldfilepos:=current_filepos;
-           current_filepos:=current_procinfo.entrypos;
-           current_procinfo.procdef.localst.SymList.ForEachCall(@initializedefaultvars,block);
-           current_filepos:=oldfilepos;
          end;
 
         if assigned(current_procinfo.procdef.parentfpstruct) then

+ 13 - 3
compiler/psystem.pas

@@ -441,6 +441,9 @@ implementation
         tarraydef(x86_m256dtype).elementdef:=s64floattype;
         tarraydef(x86_m256itype).elementdef:=s32floattype;
 {$endif x86}
+{$ifdef wasm}
+        wasmvoidexternreftype:=tcpupointerdefclass.create_externref(voidtype);
+{$endif wasm}
         set_default_ptr_types;
         openchararraytype:=carraydef.create_openarray;
         tarraydef(openchararraytype).elementdef:=cansichartype;
@@ -541,7 +544,7 @@ implementation
         addtype('LongInt',s32inttype);
         addtype('QWord',u64inttype);
         addtype('Int64',s64inttype);
-        addtype('Char',cansichartype);
+        addtype('AnsiChar',cansichartype);
         addtype('WideChar',cwidechartype);
         addtype('Text',cfiledef.createtext);
         addtype('TypedFile',cfiledef.createtyped(voidtype));
@@ -574,7 +577,7 @@ implementation
         addtype('$int64',s64inttype);
         addtype('$uint128',u128inttype);
         addtype('$int128',s128inttype);
-        addtype('$char',cansichartype);
+        addtype('$ansichar',cansichartype);
         addtype('$widechar',cwidechartype);
         addtype('$shortstring',cshortstringtype);
         addtype('$longstring',clongstringtype);
@@ -627,6 +630,10 @@ implementation
         addtype('$__m256d',x86_m256dtype);
         addtype('$__m256i',x86_m256itype);
 {$endif x86}
+{$ifdef wasm}
+        addtype('$wasm_void_externref',wasmvoidexternreftype);
+        addtype('WasmExternRef',wasmvoidexternreftype);
+{$endif wasm}
         addtype('$openchararray',openchararraytype);
         addtype('$file',cfiletype);
         if f_variants in features then
@@ -732,7 +739,7 @@ implementation
         loadtype('typedformal',ctypedformaltype);
         loadtype('void',voidtype);
         loadtype('void_pointer',voidpointertype);
-        loadtype('char',cansichartype);
+        loadtype('ansichar',cansichartype);
         loadtype('widechar',cwidechartype);
         loadtype('shortstring',cshortstringtype);
         loadtype('longstring',clongstringtype);
@@ -791,6 +798,9 @@ implementation
         loadtype('llvmbool1',llvmbool1type);
         loadtype('metadata',llvm_metadatatype);
 {$endif llvm}
+{$ifdef wasm}
+        loadtype('wasm_void_externref',wasmvoidexternreftype);
+{$endif wasm}
         loadtype('file',cfiletype);
         if target_info.system=system_i386_watcom then
           pvmt_name:='lower__pvmt'

+ 11 - 3
compiler/ptype.pas

@@ -495,7 +495,6 @@ implementation
              case token of
                _STRING:
                  string_dec(def,stoAllowTypeDef in options);
-
                _FILE:
                  begin
                     consume(_FILE);
@@ -1320,8 +1319,17 @@ implementation
                   Message(sym_e_ill_type_decl_set);
                orddef :
                  begin
-                   if (torddef(tt2).ordtype<>uvoid) and
-                      (torddef(tt2).ordtype<>uwidechar) and
+                   if (torddef(tt2).ordtype=uwidechar) then
+                     begin
+                     if (m_default_unicodestring in current_settings.modeswitches) then
+                       begin
+                         Message(parser_w_widechar_set_reduced);
+                         def:=csetdef.create(cansichartype,torddef(cansichartype).low.svalue,torddef(cansichartype).high.svalue,true);
+                       end
+                     else
+                       Message(sym_e_ill_type_decl_set);  
+                     end
+                   else if (torddef(tt2).ordtype<>uvoid) and
                       (torddef(tt2).low>=0) then
                      // !! def:=csetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high),true)
                      if Torddef(tt2).high>int64(high(byte)) then

+ 17 - 6
compiler/riscv/agrvgas.pas

@@ -233,8 +233,8 @@ unit agrvgas;
       const
         arch_str: array[boolean,tcputype] of string[10] = (
 {$ifdef RISCV32}
-          ('','rv32imac','rv32ima','rv32im','rv32i','rv32e','rv32imc'),
-          ('','rv32imafdc','rv32imafd','rv32imfd','rv32ifd','rv32efd','rv32imcfd')
+          ('','rv32imac','rv32ima','rv32im','rv32i','rv32e','rv32imc','rv32ec'),
+          ('','rv32imafdc','rv32imafd','rv32imfd','rv32ifd','rv32efd','rv32imcfd','rv32ecfd')
 {$endif RISCV32}
 {$ifdef RISCV64}
           ('','rv64imac','rv64ima','rv64im','rv64i'),
@@ -245,13 +245,24 @@ unit agrvgas;
         result := inherited MakeCmdLine;
         Replace(result,'$ARCH',arch_str[current_settings.fputype=fpu_fd,current_settings.cputype]);
 {$ifdef RISCV32}
-        Replace(result,'$ABI','ilp32');
+      case target_info.abi of
+        abi_riscv_ilp32:
+          Replace(result,'$ABI','ilp32');
+        abi_riscv_ilp32f:
+          Replace(result,'$ABI','ilp32f');
+	else
+          Replace(result,'$ABI','ilp32d');
+      end;
 {$endif RISCV32}
 {$ifdef RISCV64}
-        if target_info.abi=abi_riscv_hf then
-          Replace(result,'$ABI','lp64d')
-        else
+      case target_info.abi of
+        abi_riscv_lp64:
           Replace(result,'$ABI','lp64');
+        abi_riscv_lp64f:
+          Replace(result,'$ABI','lp64f');
+	else
+          Replace(result,'$ABI','lp64d');
+      end;
 {$endif RISCV64}
       end;
 

+ 18 - 5
compiler/riscv32/cpuinfo.pas

@@ -40,7 +40,8 @@ Type
        cpu_rv32im,
        cpu_rv32i,
        cpu_rv32e,
-       cpu_rv32imc
+       cpu_rv32imc,
+       cpu_rv32ec
       );
 
    tfputype =
@@ -81,7 +82,12 @@ Type
       ct_ch32v307rc,
       ct_ch32v307wc,
       ct_ch32V307vc,
-      ct_esp32c3
+      ct_esp32c3,
+      ct_CH32V0x,
+      ct_CH32Vxxxx6,
+      ct_CH32Vxxxx8,
+      ct_CH32VxxxxB,
+      ct_CH32VxxxxC
      );
 
    tcontrollerdatatype = record
@@ -133,7 +139,12 @@ Const
       (controllertypestr:'CH32V307RC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'CH32V307WC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
       (controllertypestr:'CH32V307VC'; controllerunitstr:'CH32V307';    cputype:cpu_rv32imac; fputype:fpu_fd; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00010000),
-      (controllertypestr:'ESP32C3'; controllerunitstr:'ESP32C3';    cputype:cpu_rv32imc; fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:400*1024)
+      (controllertypestr:'ESP32C3'; controllerunitstr:'ESP32C3';    cputype:cpu_rv32imc; fputype:fpu_none; flashbase:$00000000; flashsize:4*1024*1024; srambase:$20000000; sramsize:400*1024),
+      (controllertypestr:'CH32V0X' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32e; fputype:fpu_none; flashbase:$00000000; flashsize:$00004000; srambase:$20000000; sramsize:$00000800; eeprombase:0; eepromsize:0;BootBase:$1FFFF000; BootSize:1920),
+      (controllertypestr:'CH32VXXXX6' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00008000; srambase:$20000000; sramsize:$00002800),
+      (controllertypestr:'CH32VXXXX8' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00010000; srambase:$20000000; sramsize:$00008000),
+      (controllertypestr:'CH32VXXXXB' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00020000; srambase:$20000000; sramsize:$00010000),
+      (controllertypestr:'CH32VXXXXC' ; controllerunitstr:'CH32VxBootstrap';   cputype:cpu_rv32imac; fputype:fpu_none; flashbase:$00000000; flashsize:$00040000; srambase:$20000000; sramsize:$00020000)
    );
    {$POP}
 
@@ -156,7 +167,8 @@ Const
      'RV32IM',
      'RV32I',
      'RV32E',
-     'RV32IMC'
+     'RV32IMC',
+     'RV32EC'
    );
 
    fputypestr : array[tfputype] of string[8] = (         
@@ -197,7 +209,8 @@ Const
        { cpu_rv32im    } [CPURV_HAS_MUL],
        { cpu_rv32i     } [],
        { cpu_rv32e     } [CPURV_HAS_16REGISTERS],
-       { cpu_rv32imc   } [CPURV_HAS_MUL,CPURV_HAS_COMPACT]
+       { cpu_rv32imc   } [CPURV_HAS_MUL,CPURV_HAS_COMPACT],
+       { cpu_rv32ec    } [CPURV_HAS_16REGISTERS,CPURV_HAS_COMPACT]
      );
 
 Implementation

+ 8 - 3
compiler/riscv32/cpupara.pas

@@ -306,6 +306,7 @@ unit cpupara;
          stack_offset: longint;
          paralen: aint;
          nextintreg,nextfloatreg,nextmmreg, maxfpureg : tsuperregister;
+         MaxIntReg : TSuperRegister;
          locdef,
          fdef,
          paradef : tdef;
@@ -328,6 +329,10 @@ unit cpupara;
          nextmmreg := curmmreg;
          stack_offset := cur_stack_offset;
          maxfpureg := RS_F17;
+         if CPURV_HAS_16REGISTERS in cpu_capabilities[current_settings.cputype] then
+           MaxIntReg := RS_X15 
+         else
+           MaxIntReg := RS_X17;
 
           for i:=0 to paras.count-1 do
             begin
@@ -398,7 +403,7 @@ unit cpupara;
                   { In case of po_delphi_nested_cc, the parent frame pointer
                     is always passed on the stack. }
                   if (loc = LOC_REGISTER) and
-                     (nextintreg <= RS_X17) and
+                     (nextintreg <= MaxIntReg) and
                      (not(vo_is_parentfp in hp.varoptions) or
                       not(po_delphi_nested_cc in p.procoptions)) then
                     begin
@@ -424,7 +429,7 @@ unit cpupara;
                       dec(paralen,tcgsize2size[paraloc^.size]);
                     end
                   else if (loc = LOC_FPUREGISTER) and
-                          (nextintreg <= RS_X17) then
+                          (nextintreg <= MaxIntReg) then
                     begin
                       paraloc^.loc:=loc;
                       paraloc^.size := paracgsize;
@@ -475,7 +480,7 @@ unit cpupara;
 
                        inc(stack_offset,align(paralen,4));
                        while (paralen > 0) and
-                             (nextintreg < RS_X18) do
+                             (nextintreg <= MaxIntReg) do
                           begin
                             inc(nextintreg);
                             dec(paralen,sizeof(pint));

+ 34 - 0
compiler/scandir.pas

@@ -1019,6 +1019,39 @@ unit scandir;
       end;
 
 
+    procedure dir_namespaces;
+
+    { add namespaces to the local namespace list }
+      var
+        s : string;
+
+    begin
+      if not current_module.in_global then
+        Message(scan_w_switch_is_global)
+      else
+        begin
+          current_scanner.skipspace;
+          current_scanner.readstring;
+          s:=orgpattern;
+          While (s<>'') do
+            begin
+              // We may not yet have a correct module namespacelist.
+              if assigned(current_namespacelist) then
+                current_namespacelist.Insert(s)
+              else // copied when correct module is activated
+                premodule_namespacelist.Insert(s);
+              s:='';  
+              if c=',' then
+                begin
+                  current_scanner.readchar;
+                  current_scanner.skipspace;
+                  current_scanner.readstring;
+                  s:=orgpattern;
+                end;
+            end;
+        end;
+    end;
+
     procedure dir_namespace;
       var
         s : string;
@@ -2029,6 +2062,7 @@ unit scandir;
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
         AddDirective('NAMESPACE',directive_all, @dir_namespace);
+        AddDirective('NAMESPACES',directive_all, @dir_namespaces);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
         AddDirective('NOTE',directive_all, @dir_note);
         AddDirective('NOTES',directive_all, @dir_notes);

+ 1 - 1
compiler/scanner.pas

@@ -1635,7 +1635,7 @@ type
                     case current_scanner.preproc_token of
                       _ID:
                         { system.char? (char=widechar comes from the implicit
-                          uuchar unit -> override) }
+                          uachar/uuchar unit -> override) }
                         if (current_scanner.preproc_pattern='CHAR') and
                            (tmodule(tunitsym(srsym).module).globalsymtable=systemunit) then
                           begin

+ 3 - 0
compiler/sparcgen/cgsparc.pas

@@ -1155,6 +1155,9 @@ implementation
         { anybody wants to determine a good value here :)? }
         if len>100 then
           g_concatcopy_move(list,source,dest,len)
+        else if ((source.alignment>0) and (source.alignment<4)) or
+                ((dest.alignment>0) and (dest.alignment<4)) then
+          g_concatcopy_unaligned(list,source,dest,len)
         else
           begin
             count:=len div 4;

+ 17 - 3
compiler/symconst.pas

@@ -446,7 +446,15 @@ type
     { implicitly return same type as the class instance to which the message is sent }
     po_objc_related_result_type,
     { Delphi-style anonymous function }
-    po_anonymous
+    po_anonymous,
+    { WebAssembly funcref reference type (an opaque reference to a function, that
+      is managed by the host. It doesn't have an in-memory representation, which
+      means it cannot be stored in linear memory or have its address taken. It can
+      however be stored in WebAssembly globals, locals, used in function parameters
+      and returns and it can be called.) }
+    po_wasm_funcref,
+    { WebAssembly suspending external }
+    po_wasm_suspending
   );
   tprocoptions=set of tprocoption;
 
@@ -497,7 +505,11 @@ type
     tsk_field_setter,          // Setter for a field (callthrough property is passed in skpara)
     tsk_block_invoke_procvar,  // Call a procvar to invoke inside a block
     tsk_interface_wrapper,     // Call through to a method from an interface wrapper
-    tsk_call_no_parameters     // Call skpara procedure without passing any parameters nor returning a result
+    tsk_call_no_parameters,    // Call skpara procedure without passing any parameters nor returning a result
+    tsk_wasm_suspending_first, // WebAssembly suspending external wrapper, suspender object is first argument
+    tsk_wasm_suspending_last,  // WebAssembly suspending external wrapper, suspender object is last argument
+    tsk_wasm_promising,        // WebAssembly promising export wrapper
+    tsk_invoke_helper          // Method invoke helper, primarily used in WebAssembly.
   );
 
   { synthetic procdef supplementary information (tprocdef.skpara) }
@@ -1113,7 +1125,9 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       'po_noinline',{po_noinline}
       'C-style array-of-const', {po_variadic}
       'objc-related-result-type', {po_objc_related_result_type}
-      'po_anonymous' {po_anonymous}
+      'po_anonymous', {po_anonymous}
+      '"WASMFUNCREF"', {po_wasm_funcref}
+      '"SUSPENDING"' {po_wasm_suspending}
     );
 
 implementation

+ 660 - 6
compiler/symcreat.pas

@@ -126,6 +126,10 @@ interface
   function generate_pkg_stub(pd:tprocdef):tnode;
   procedure generate_attr_constrs(attrs:tfpobjectlist);
 
+  { Generate the hidden thunk class for interfaces,
+    so we can use them in TVirtualInterface on platforms that do not allow
+    generating executable code in memory at runtime.}
+  procedure add_synthetic_interface_classes_for_st(st : tsymtable);
 
 
 implementation
@@ -133,10 +137,11 @@ implementation
   uses
     cutils,globals,verbose,systems,comphook,fmodule,constexp,
     symtable,defutil,symutil,procinfo,
-    pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
+    pbase,pdecl, pdecobj,pdecsub,psub,ptconst,pparautl,
 {$ifdef jvm}
     pjvm,jvmdef,
 {$endif jvm}
+    aasmcpu,symcpu,
     nbas,nld,nmem,ncon,
     defcmp,
     paramgr;
@@ -229,7 +234,7 @@ implementation
     end;
 
 
-  function str_parse_method_impl_with_fileinfo(str: ansistring; usefwpd: tprocdef; fileno, lineno: longint; is_classdef: boolean):boolean;
+  function str_parse_method_impl_with_fileinfo(str: ansistring; usefwpd: tprocdef; fileno, lineno: longint; is_classdef: boolean; out result_procdef: tprocdef):boolean;
      var
        oldparse_only: boolean;
        tmpstr: ansistring;
@@ -260,7 +265,7 @@ implementation
       flags:=[];
       if is_classdef then
         include(flags,rpf_classmethod);
-      read_proc(flags,usefwpd);
+      result_procdef:=read_proc(flags,usefwpd);
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
@@ -271,8 +276,16 @@ implementation
 
 
   function str_parse_method_impl(const str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
+    var
+      tmpproc: tprocdef;
+    begin
+      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef, tmpproc);
+    end;
+
+
+  function str_parse_method_impl(const str: ansistring; usefwpd: tprocdef; is_classdef: boolean; out result_procdef: tprocdef):boolean;
     begin
-      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef);
+      result:=str_parse_method_impl_with_fileinfo(str, usefwpd, current_scanner.inputfile.ref_index, current_scanner.line_no, is_classdef, result_procdef);
     end;
 
 
@@ -300,6 +313,34 @@ implementation
       current_scanner.tempopeninputfile;
     end;
 
+    function str_parse_objecttypedef(typename : shortstring;str: ansistring): tobjectdef;
+     var
+       b,oldparse_only: boolean;
+       tmpstr: ansistring;
+       flags : tread_proc_flags;
+
+     begin
+      result:=nil;
+      Message1(parser_d_internal_parser_string,str);
+      oldparse_only:=parse_only;
+      parse_only:=true;
+      { "const" starts a new kind of block and hence makes the scanner return }
+      str:=str+'const;';
+      block_type:=bt_type;
+      { inject the string in the scanner }
+      current_scanner.substitutemacro('hidden_interface_class_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
+      current_scanner.readtoken(false);
+      type_dec(b);
+      if (current_module.DefList.Last is tobjectdef) and
+         (tobjectdef(current_module.DefList.Last).GetTypeName=typename) then
+           result:=tobjectdef(current_module.DefList.Last);
+      parse_only:=oldparse_only;
+      { remove the temporary macro input file again }
+      current_scanner.closeinputfile;
+      current_scanner.nextfile;
+      current_scanner.tempopeninputfile;
+     end;
+
 
   function def_unit_name_prefix_if_toplevel(def: tdef): TSymStr;
     begin
@@ -869,6 +910,151 @@ implementation
     end;
 {$endif jvm}
 
+
+{$ifdef wasm}
+  procedure addvisibleparameterdeclarations(var str: ansistring; pd: tprocdef);
+    var
+      currpara: tparavarsym;
+      i: longint;
+      firstpara: boolean;
+    begin
+      firstpara:=true;
+      for i:=0 to pd.paras.count-1 do
+        begin
+          currpara:=tparavarsym(pd.paras[i]);
+          if not(vo_is_hidden_para in currpara.varoptions) then
+            begin
+              if not firstpara then
+                str:=str+';';
+              firstpara:=false;
+              case currpara.varspez of
+                vs_constref:
+                  str:=str+'constref ';
+                vs_out:
+                  str:=str+'out ';
+                vs_var:
+                  str:=str+'var ';
+                vs_const:
+                  str:=str+'const ';
+                vs_value:
+                  ;
+                else
+                  internalerror(2023061108);
+              end;
+
+              str:=str+currpara.realname;
+              if currpara.vardef.typ<>formaldef then
+                str:=str+':'+currpara.vardef.fulltypename;
+            end;
+        end;
+    end;
+
+  procedure implement_wasm_suspending(pd: tcpuprocdef; last: Boolean);
+    var
+      str: ansistring;
+      wrapper_name: ansistring;
+    begin
+      wrapper_name:=pd.suspending_wrapper_name;
+
+      if is_void(pd.returndef) then
+        str:='procedure '
+      else
+        str:='function ';
+      str:=str+wrapper_name+'(';
+      if last then
+        begin
+          addvisibleparameterdeclarations(str,pd);
+          if str[Length(str)]<>'(' then
+            str:=str+';';
+          str:=str+'__fpc_wasm_susp: WasmExternRef';
+        end
+      else
+        begin
+          str:=str+'__fpc_wasm_susp: WasmExternRef;';
+          addvisibleparameterdeclarations(str,pd);
+          if str[Length(str)]=';' then
+            delete(str,Length(str),1);
+        end;
+      str:=str+')';
+      if not is_void(pd.returndef) then
+        str:=str+': '+pd.returndef.fulltypename;
+      str:=str+'; external '''+pd.import_dll^+ ''' name '''+pd.import_name^+''';';
+      str_parse_method_impl(str,nil,false);
+
+      str:='var __fpc_wasm_suspender_copy:WasmExternRef; begin __fpc_wasm_suspender_copy:=__fpc_wasm_suspender; ';
+
+      if not is_void(pd.returndef) then
+        str:=str+' result:=';
+
+      str:=str+wrapper_name+'(__fpc_wasm_suspender_copy,';
+      addvisibleparameters(str,pd);
+      if str[Length(str)]=',' then
+        delete(str,Length(str),1);
+      str:=str+');';
+      str:=str+' __fpc_wasm_suspender:=__fpc_wasm_suspender_copy;';
+      str:=str+' end;';
+      str_parse_method_impl(str,pd,false);
+      exclude(pd.procoptions,po_external);
+    end;
+
+  function implement_wasm_promising_wrapper(pd: tcpuprocdef;last:boolean):tprocdef;
+    var
+      str: ansistring;
+      wrapper_name: ansistring;
+    begin
+      wrapper_name:=pd.promising_wrapper_name(last);
+
+      if is_void(pd.returndef) then
+        str:='procedure '
+      else
+        str:='function ';
+      str:=str+wrapper_name+'(';
+      if last then
+        begin
+          addvisibleparameterdeclarations(str,pd);
+          if str[Length(str)]<>'(' then
+            str:=str+';';
+          str:=str+'__fpc_wasm_susp: WasmExternRef';
+        end
+      else
+        begin
+          str:=str+'__fpc_wasm_susp: WasmExternRef;';
+          addvisibleparameterdeclarations(str,pd);
+          if str[Length(str)]=';' then
+            delete(str,Length(str),1);
+        end;
+      str:=str+')';
+      if not is_void(pd.returndef) then
+        str:=str+': '+pd.returndef.fulltypename;
+      str:=str+'; begin __fpc_wasm_suspender:=__fpc_wasm_susp;';
+      if not is_void(pd.returndef) then
+        str:=str+' result:=';
+      str:=str+pd.procsym.RealName+'(';
+      addvisibleparameters(str,pd);
+      if str[Length(str)]=',' then
+        delete(str,Length(str),1);
+      str:=str+'); end;';
+      str_parse_method_impl(str,nil,false,result);
+    end;
+
+  procedure implement_wasm_promising(pd: tcpuprocdef);
+    var
+      new_wrapper_pd: tprocdef;
+    begin
+      if pd.promising_first_export_name<>'' then
+        begin
+          new_wrapper_pd:=implement_wasm_promising_wrapper(pd,false);
+          current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(pd.promising_first_export_name,new_wrapper_pd.mangledname,ie_Func));
+        end;
+      if pd.promising_last_export_name<>'' then
+        begin
+          new_wrapper_pd:=implement_wasm_promising_wrapper(pd,true);
+          current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(pd.promising_last_export_name,new_wrapper_pd.mangledname,ie_Func));
+        end;
+    end;
+{$endif wasm}
+
+
   procedure implement_field_getter(pd: tprocdef);
     var
       i: longint;
@@ -974,7 +1160,7 @@ implementation
   procedure implement_interface_wrapper(pd: tprocdef);
     var
       wrapperinfo: pskpara_interface_wrapper;
-      callthroughpd: tprocdef;
+      callthroughpd, tmpproc: tprocdef;
       str: ansistring;
       fileinfo: tfileposinfo;
     begin
@@ -1002,7 +1188,7 @@ implementation
           fileinfo.line:=1;
           fileinfo.column:=1;
         end;
-      str_parse_method_impl_with_fileinfo(str,pd,fileinfo.fileindex,fileinfo.line,false);
+      str_parse_method_impl_with_fileinfo(str,pd,fileinfo.fileindex,fileinfo.line,false,tmpproc);
       dispose(wrapperinfo);
       pd.skpara:=nil;
     end;
@@ -1029,11 +1215,86 @@ implementation
         setverbosity('W+');
     end;
 
+  function get_method_paramtype(vardef  : Tdef; asPointer : Boolean; out isAnonymousArrayDef : Boolean) : ansistring; forward;
+  function str_parse_method(str: ansistring): tprocdef; forward;
+
+
+  procedure implement_invoke_helper(cn : string;pd: tprocdef);
+
+    var
+      sarg,str : ansistring;
+      pt, pn,d : shortstring;
+      sym : tsym;
+      aArg,argcount,i : integer;
+      isarray,haveresult : boolean;
+      para : tparavarsym;
+      hasopenarray, washigh: Boolean;
+
+    begin
+      str:='procedure __invoke_helper__';
+      pn:=pd.procsym.realname;
+      str:=str+cn+'__'+pn;
+      for I:=1 to length(str) do
+        if str[i]='.' then
+          str[i]:='_';
+      str:=str+'(Instance : Pointer; Args : PPointer);'#10;
+      argCount:=0;
+      for i:=0 to pd.paras.Count-1 do
+        begin
+          para:=tparavarsym(pd.paras[i]);
+          if vo_is_hidden_para in para.varoptions then
+            continue;
+          inc(argCount);
+          if argCount=1 then
+            str:=str+'Type'#10;
+          pt:=get_method_paramtype(para.vardef,true,isArray);
+          if isArray then
+            begin
+            str:=str+'  tpa'+tostr(argcount)+' = '+pt+';'#10;
+            pt:='^tpa'+tostr(argcount);
+            end;
+          str:=str+'  tp'+tostr(argcount)+' = '+pt+';'#10;
+        end;
+      haveresult:=pd.returndef<>voidtype;
+      if haveresult then
+        begin
+        if argCount=0 then
+          str:=str+'Type'#10;
+        pt:=get_method_paramtype(pd.returndef ,true,isArray);
+        if isArray then
+          begin
+          str:=str+'  tra'+tostr(argcount)+' = '+pt+';'#10;
+          pt:='^tra';
+          end;
+        str:=str+'  tr = '+pt+';'#10;
+        end;
+      str:=str+'begin'#10'  ';
+      if haveResult then
+        str:=str+'TR(args[0])^:=';
+      str:=str+cn+'(Instance).'+pn+'(';
+      argCount:=0;
+      for i:=0 to pd.paras.Count-1 do
+        begin
+          para:=tparavarsym(pd.paras[i]);
+          if vo_is_hidden_para in para.varoptions then
+            continue;
+          inc(argCount);
+          sarg:=tostr(argcount);
+          if argCount>1 then
+            str:=str+',';
+          str:=str+'tp'+sarg+'(Args['+sarg+'])^';
+        end;
+      str:=str+');'#10;
+      str:=str+'end;'#10;
+      pd.invoke_helper:=str_parse_method(str);
+  end;
+
   procedure add_synthetic_method_implementations_for_st(st: tsymtable);
     var
       i   : longint;
       def : tdef;
       pd  : tprocdef;
+      cn  : shortstring;
     begin
       for i:=0 to st.deflist.count-1 do
         begin
@@ -1109,6 +1370,19 @@ implementation
             tsk_jvm_virtual_clmethod:
               internalerror(2011032801);
 {$endif jvm}
+{$ifdef wasm}
+            tsk_wasm_suspending_first:
+              implement_wasm_suspending(tcpuprocdef(pd),false);
+            tsk_wasm_suspending_last:
+              implement_wasm_suspending(tcpuprocdef(pd),true);
+            tsk_wasm_promising:
+              implement_wasm_promising(tcpuprocdef(pd));
+{$else wasm}
+            tsk_wasm_suspending_first,
+            tsk_wasm_suspending_last,
+            tsk_wasm_promising:
+              internalerror(2023061107);
+{$endif wasm}
             tsk_field_getter:
               implement_field_getter(pd);
             tsk_field_setter:
@@ -1119,10 +1393,390 @@ implementation
               implement_interface_wrapper(pd);
             tsk_call_no_parameters:
               implement_call_no_parameters(pd);
+            tsk_invoke_helper:
+              begin
+                if (pd.owner.defowner) is tobjectdef  then
+                  cn:=tobjectdef(def.owner.defowner).GetTypeName
+                else
+                  internalerror(2023061107);
+                implement_invoke_helper(cn,pd);
+              end;
           end;
         end;
     end;
 
+  function get_method_paramtype(vardef  : Tdef; asPointer : Boolean; out isAnonymousArrayDef : Boolean) : ansistring;
+
+  var
+    p : integer;
+    arrdef : tarraydef absolute vardef;
+
+  begin
+    {
+      None of the existing routines fulltypename,OwnerHierarchyName,FullOwnerHierarchyName,typename
+      results in a workable definition for open array parameters.
+    }
+    isAnonymousArrayDef:=false;
+    if asPointer and (vardef.typ=formaldef) then
+      exit('pointer');
+    if not (vardef is tarraydef) then
+      result:=vardef.fulltypename
+    else
+      begin
+      if (ado_isarrayofconst in arrdef.arrayoptions) then
+        begin
+          if asPointer then
+            Result:='Array of TVarRec'
+          else
+            result:='Array Of Const';
+          asPointer:=False;
+          isAnonymousArrayDef:=true;
+        end
+      else if (ado_OpenArray in arrdef.arrayoptions) then
+        begin
+        result:='Array of '+arrdef.elementdef.fulltypename;
+        asPointer:=False;
+        isAnonymousArrayDef:=true;
+        end
+      else
+        begin
+        result:=vardef.fulltypename;
+        end;
+      end;
+    // ansistring(0) -> ansistring
+    p:=pos('(',result);
+    if p=0 then
+      p:=pos('[',result);
+    if p>0 then
+      result:=copy(result,1,p-1);
+    if asPointer then
+      Result:='^'+Result;
+  end;
+
+  function get_method_paramtype(vardef  : Tdef; asPointer : Boolean) : ansistring;
+
+  var
+    ad : boolean;
+
+  begin
+    result:=get_method_paramtype(vardef,aspointer,ad);
+  end;
+
+  function create_intf_method_args(p : tprocdef; out argcount: integer) : ansistring;
+
+  const
+    varspezprefixes : array[tvarspez] of shortstring =
+      ('','const','var','out','constref','final');
+  var
+    i : integer;
+    s : string;
+    para : tparavarsym;
+
+
+  begin
+    result:='';
+    argCount:=0;
+    for i:=0 to p.paras.Count-1 do
+      begin
+      para:=tparavarsym(p.paras[i]);
+      if vo_is_hidden_para in para.varoptions then
+        continue;
+      if Result<>'' then
+        Result:=Result+';';
+      inc(argCount);
+      result:=result+varspezprefixes[para.varspez]+' p'+tostr(argcount);
+      if Assigned(para.vardef) and not (para.vardef is tformaldef) then
+        result:=Result+' : '+get_method_paramtype(para.vardef,false);
+      end;
+    if Result<>'' then
+      Result:='('+Result+')';
+  end;
+
+  function generate_thunkclass_name(acount: Integer; objdef : tobjectdef) : shortstring;
+
+  var
+    cn : shortstring;
+    i : integer;
+
+  begin
+    cn:=ObjDef.GetTypeName;
+    for i:=0 to Length(cn) do
+      if cn[i]='.' then
+        cn[i]:='_';
+    result:='_t_hidden'+tostr(acount)+cn;
+  end;
+
+  function get_thunkclass_interface_vmtoffset(objdef : tobjectdef) : integer;
+
+  var
+    i,j,offs : integer;
+    sym : tsym;
+    proc : tprocsym absolute sym;
+    pd : tprocdef;
+
+  begin
+    offs:=maxint;
+    for I:=0 to objdef.symtable.symList.Count-1 do
+      begin
+      sym:=tsym(objdef.symtable.symList[i]);
+      if Not assigned(sym) then
+        continue;
+      if (Sym.typ<>procsym) then
+        continue;
+      for j:=0 to proc.ProcdefList.Count-1 do
+        begin
+        pd:=tprocdef(proc.ProcdefList[j]);
+        if pd.extnumber<offs then
+          offs:=pd.extnumber;
+        end;
+      end;
+      if offs=maxint then
+        offs:=0;
+      result:=offs;
+    end;
+
+  procedure implement_interface_thunkclass_decl(cn : shortstring; objdef : tobjectdef);
+
+  var
+    str : ansistring;
+    sym : tsym;
+    proc : tprocsym absolute sym;
+    pd : tprocdef;
+    def : tobjectdef;
+    offs,argcount,i,j : integer;
+
+  begin
+    str:='type '#10;
+    str:=str+cn+' = class(TInterfaceThunk,'+objdef.GetTypeName+')'#10;
+    str:=str+' protected '#10;
+    for I:=0 to objdef.symtable.symList.Count-1 do
+      begin
+      sym:=tsym(objdef.symtable.symList[i]);
+      if Not assigned(sym) then
+        continue;
+      if (Sym.typ<>procsym) then
+        continue;
+      for j:=0 to proc.ProcdefList.Count-1 do
+        begin
+        pd:=tprocdef(proc.ProcdefList[j]);
+        if pd.returndef<>voidtype then
+          str:=str+'function '
+        else
+          str:=str+'procedure ';
+        str:=str+proc.RealName;
+        str:=str+create_intf_method_args(pd,argcount);
+        if pd.returndef<>voidtype then
+          str:=str+' : '+get_method_paramtype(pd.returndef,false);
+        str:=str+';'#10;
+        end;
+      end;
+    offs:=get_thunkclass_interface_vmtoffset(objdef);
+    if offs>0 then
+      begin
+      str:=str+'public '#10;
+      str:=str+'  function InterfaceVMTOffset : word; override;'#10;
+      end;
+    str:=str+' end;'#10;
+    def:=str_parse_objecttypedef(cn,str);
+    if assigned(def) then
+      begin
+      def.created_in_current_module:=true;
+      include(def.objectoptions,oo_can_have_published);
+      end;
+    objdef.hiddenclassdef:=def;
+  end;
+
+  function str_parse_method(str: ansistring): tprocdef;
+   var
+     oldparse_only: boolean;
+     tmpstr: ansistring;
+     flags : tread_proc_flags;
+
+   begin
+    Message1(parser_d_internal_parser_string,str);
+    oldparse_only:=parse_only;
+    parse_only:=false;
+    { "const" starts a new kind of block and hence makes the scanner return }
+    str:=str+'const;';
+    block_type:=bt_none;
+    { inject the string in the scanner }
+    current_scanner.substitutemacro('hidden_interface_method',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
+    current_scanner.readtoken(false);
+    Result:=read_proc([],Nil);
+    parse_only:=oldparse_only;
+    { remove the temporary macro input file again }
+    current_scanner.closeinputfile;
+    current_scanner.nextfile;
+    current_scanner.tempopeninputfile;
+   end;
+
+
+  procedure implement_interface_thunkclass_impl_method(cn : shortstring; objdef : tobjectdef; proc : tprocsym; pd : tprocdef);
+
+  var
+    rest,str : ansistring;
+    pn,d : shortstring;
+    sym : tsym;
+    aArg,argcount,i : integer;
+    haveresult : boolean;
+    para : tparavarsym;
+    hasopenarray, washigh: Boolean;
+
+  begin
+    rest:='';
+    str:='';
+    if pd.returndef<>voidtype then
+      str:=str+'function '
+    else
+      str:=str+'procedure ';
+    pn:=proc.RealName;
+    str:=str+cn+'.'+pn;
+    str:=str+create_intf_method_args(pd,argcount);
+    haveresult:=pd.returndef<>voidtype;
+    if haveresult then
+      begin
+      rest:=get_method_paramtype(pd.returndef,false);
+      str:=str+' : '+rest;
+      end;
+    str:=str+';'#10;
+    str:=str+'var '#10;
+    str:=str+'  data : array[0..'+tostr(argcount)+'] of System.TInterfaceThunk.TArgData;'#10;
+    if haveresult then
+      str:=str+'  res : '+rest+';'#10;
+    str:=str+'begin'#10;
+    // initialize result.
+    if HaveResult then
+      begin
+      str:=Str+'  data[0].addr:=@Res;'#10;
+      str:=Str+'  data[0].info:=TypeInfo(Res);'#10;
+      end
+    else
+      begin
+      str:=Str+'  data[0].addr:=nil;'#10;
+      str:=Str+'  data[0].idx:=-1;'#10;
+      end;
+    str:=Str+'  data[0].idx:=-1;'#10;
+    str:=Str+'  data[0].ahigh:=-1;'#10;
+    // Fill rest of data
+    aArg:=0;
+    washigh:=false;
+    d:='0';
+    for i:=0 to pd.paras.Count-1 do
+      begin
+      para:=tparavarsym(pd.paras[i]);
+      // previous was open array. Record high
+      if (i>1) then
+        begin
+        WasHigh:=(vo_is_high_para in para.varoptions);
+        if Washigh then
+          // D is still value of previous (real) parameter
+          str:=str+'  data['+d+'].ahigh:=High(p'+d+');'#10
+        else
+          str:=str+'  data['+d+'].ahigh:=-1;'#10;
+        end;
+      if vo_is_hidden_para in para.varoptions then
+        continue;
+      inc(aArg);
+      d:=tostr(aArg);
+      Str:=Str+'  data['+d+'].addr:=@p'+d+';'#10;
+      Str:=Str+'  data['+d+'].idx:='+tostr(i)+';'#10;
+      if Assigned(para.vardef) and not (para.vardef is tformaldef) then
+        Str:=Str+'  data['+d+'].info:=TypeInfo(p'+d+');'#10
+      else
+        Str:=Str+'  data['+d+'].info:=Nil;'#10
+      end;
+    // if last was not high, set to sentinel.
+    if not WasHigh then
+      str:=str+'  data['+d+'].ahigh:=-1;'#10;
+    str:=str+'  Thunk('+tostr(pd.extnumber)+','+tostr(argcount)+',@Data);'#10;
+    if HaveResult then
+      str:=str+'  Result:=res;'#10;
+    str:=str+'end;'#10;
+    pd:=str_parse_method(str);
+  end;
+
+  procedure implement_thunkclass_interfacevmtoffset(cn : shortstring; objdef : tobjectdef; offs : integer);
+
+  var
+    str : ansistring;
+  begin
+    str:='function '+cn+'.InterfaceVMTOffset : word;'#10;
+    str:=str+'begin'#10;
+    str:=str+'  result:='+toStr(offs)+';'#10;
+    str:=str+'end;'#10;
+    str_parse_method(str);
+  end;
+
+
+  procedure implement_interface_thunkclass_impl(cn: shortstring; objdef : tobjectdef);
+
+  var
+    str : ansistring;
+    sym : tsym;
+    proc : tprocsym absolute sym;
+    pd : tprocdef;
+    offs,i,j : integer;
+
+  begin
+    offs:=get_thunkclass_interface_vmtoffset(objdef);
+    if offs>0 then
+      implement_thunkclass_interfacevmtoffset(cn,objdef,offs);
+    for I:=0 to objdef.symtable.symList.Count-1 do
+      begin
+      sym:=tsym(objdef.symtable.symList[i]);
+      if Not assigned(sym) then
+        continue;
+      if (Sym.typ<>procsym) then
+        continue;
+      for j:=0 to proc.ProcdefList.Count-1 do
+        begin
+        pd:=tprocdef(proc.ProcdefList[j]);
+        implement_interface_thunkclass_impl_method(cn,objdef,proc,pd);
+        end;
+      end;
+  end;
+
+  procedure add_synthetic_interface_classes_for_st(st : tsymtable);
+
+  var
+    i   : longint;
+    def : tdef;
+    objdef : tobjectdef absolute def;
+    recdef : trecorddef absolute def;
+    sstate: tscannerstate;
+    cn : shortstring;
+
+  begin
+    { skip if any errors have occurred, since then this can only cause more
+      errors }
+    if ErrorCount<>0 then
+      exit;
+    replace_scanner('hiddenclass_impl',sstate);
+    for i:=0 to st.deflist.count-1 do
+      begin
+      def:=tdef(st.deflist[i]);
+      if (def.typ<>objectdef) then
+        continue;
+      if not (objdef.objecttype in [odt_interfacecorba,odt_interfacecom]) then
+        continue;
+      if not (oo_can_have_published in objdef.objectoptions) then
+        continue;
+      // need to add here extended rtti check when it is available
+      cn:=generate_thunkclass_name(i,objdef);
+      implement_interface_thunkclass_decl(cn,objdef);
+      implement_interface_thunkclass_impl(cn,objdef);
+      end;
+    restore_scanner(sstate);
+    // Recurse for interfaces defined in a type section of a class/record.
+    for i:=0 to st.deflist.count-1 do
+      begin
+      def:=tdef(st.deflist[i]);
+      if (def.typ=objectdef) and (objdef.objecttype=odt_class) then
+        add_synthetic_interface_classes_for_st(objdef.symtable)
+      else if (def.typ=recorddef) and (m_advanced_records in current_settings.modeswitches) then
+        add_synthetic_interface_classes_for_st(recdef.symtable);
+      end;
+  end;
 
   procedure add_synthetic_method_implementations(st: tsymtable);
     var

+ 23 - 1
compiler/symdef.pas

@@ -138,6 +138,9 @@ interface
           genconstraintdata : tgenericconstraintdata;
           { this is Nil if the def has no RTTI attributes }
           rtti_attribute_list : trtti_attribute_list;
+          { original def for "type <name>" declarations }
+          orgdef          : tstoreddef;
+          orgdefderef     : tderef;
           constructor create(dt:tdeftyp;doregister:boolean);
           constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -503,6 +506,12 @@ interface
           }
           classref_created_in_current_module : boolean;
           objecttype     : tobjecttyp;
+          { for interfaces that can be invoked using Invoke(),
+            this is the definition of the hidden class that is generated by the compiler.
+            we need this definition to reference it in the RTTI, only during compilation of unit. 
+            so no need to write it to the .ppu file.
+          }
+          hiddenclassdef : tobjectdef;
           constructor create(ot:tobjecttyp;const n:string;c:tobjectdef;doregister:boolean);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -895,6 +904,8 @@ interface
 {$else symansistr}
          section: pshortstring;
 {$endif}
+          { only needed when actually compiling a unit, no need to save/load from ppu }
+          invoke_helper : tprocdef;
           constructor create(level:byte;doregister:boolean);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -1157,12 +1168,16 @@ interface
        longintfarpointertype,     { used for MemL[] }
   {$endif i8086}
 {$endif x86}
+{$ifdef wasm}
+       wasmvoidexternreftype,
+{$endif wasm}
        cundefinedtype,
        cformaltype,               { unique formal definition }
        ctypedformaltype,          { unique typed formal definition }
        voidtype,                  { Void (procedure) }
        cansichartype,             { Char }
        cwidechartype,             { WideChar }
+       cchartype,                 { either cansichartype or cwidechartype. Do not free }
        pasbool1type,              { boolean type }
        pasbool8type,
        pasbool16type,
@@ -2100,6 +2115,8 @@ implementation
          ppufile.getderef(typesymderef);
          ppufile.getset(tppuset2(defoptions));
          ppufile.getset(tppuset1(defstates));
+         if df_unique in defoptions then
+           ppufile.getderef(orgdefderef);
          if df_genconstraint in defoptions then
            begin
              genconstraintdata:=tgenericconstraintdata.create;
@@ -2270,6 +2287,8 @@ implementation
         oldintfcrc:=ppufile.do_crc;
         ppufile.do_crc:=false;
         ppufile.putset(tppuset1(defstates));
+        if df_unique in defoptions then
+          ppufile.putderef(orgdefderef);
         if df_genconstraint in defoptions then
           genconstraintdata.ppuwrite(ppufile);
         if [df_generic,df_specialization]*defoptions<>[] then
@@ -2337,6 +2356,7 @@ implementation
         if not registered then
           register_def;
         typesymderef.build(typesym);
+        orgdefderef.build(orgdef);
         genericdefderef.build(genericdef);
         if assigned(rtti_attribute_list) then
           rtti_attribute_list.buildderef;
@@ -2368,6 +2388,8 @@ implementation
         i : longint;
       begin
         typesym:=ttypesym(typesymderef.resolve);
+        if df_unique in defoptions then
+          orgdef:=tstoreddef(orgdefderef.resolve);
         if df_specialization in defoptions then
           genericdef:=tstoreddef(genericdefderef.resolve);
         if assigned(rtti_attribute_list) then
@@ -3522,7 +3544,7 @@ implementation
           'ShortInt','SmallInt','LongInt','Int64','Int128',
           'Boolean','Boolean8','Boolean16','Boolean32','Boolean64',
           'ByteBool','WordBool','LongBool','QWordBool',
-          'Char','WideChar','Currency','CustomRange');
+          'AnsiChar','WideChar','Currency','CustomRange');
 
       begin
          GetTypeName:=names[ordtype];

+ 11 - 1
compiler/symtable.pas

@@ -3071,11 +3071,17 @@ implementation
           end;
       end;
 
+    procedure check_systemunit_loaded; inline;
+    begin
+      if systemunit=nil then
+       Message(sym_f_systemunitnotloaded);
+    end;
 
     procedure write_system_parameter_lists(const name:string);
       var
         srsym:tprocsym;
       begin
+        check_systemunit_loaded;
         srsym:=tprocsym(systemunit.find(name));
         if not assigned(srsym) or not (srsym.typ=procsym) then
           internalerror(2016060302);
@@ -3617,8 +3623,9 @@ implementation
       var
         pmod : tmodule;
       begin
-        pmod:=tmodule(pm);
         result:=false;
+        if not assigned(pm) then exit;
+        pmod:=tmodule(pm);
         if assigned(pmod.globalsymtable) then
           begin
             srsym:=tsym(pmod.globalsymtable.Find(s));
@@ -4218,6 +4225,7 @@ implementation
       var
         sym : tsym;
       begin
+        check_systemunit_loaded;
         sym:=tsym(systemunit.Find(s));
         if not assigned(sym) or
            (sym.typ<>typesym) then
@@ -4230,6 +4238,7 @@ implementation
       var
         sym : tsym;
       begin
+        check_systemunit_loaded;
         sym:=tsym(systemunit.Find(s));
         if not assigned(sym) then
           result:=nil
@@ -4267,6 +4276,7 @@ implementation
       var
         srsym: tsym;
       begin
+        check_systemunit_loaded;
         srsym:=tsym(systemunit.find(s));
         if not assigned(srsym) and
            (cs_compilesystem in current_settings.moduleswitches) then

+ 1 - 1
compiler/systems.pas

@@ -86,7 +86,7 @@ interface
           id          : tasm;
           idtxt       : string[17];
           asmbin      : string[16];
-          asmcmd      : string[121];
+          asmcmd      : string[138];
           supported_targets : set of tsystem;
           flags        : set of tasmflags;
           labelprefix : string[3];

+ 2 - 2
compiler/systems/i_embed.pas

@@ -645,7 +645,7 @@ unit i_embed;
             first_parm_offset : 8;
             stacksize    : 262144;
             stackalign   : 4;
-            abi : abi_default;
+            abi : abi_riscv_ilp32;
             llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32-S32';
           );
 
@@ -712,7 +712,7 @@ unit i_embed;
             first_parm_offset : 16;
             stacksize    : 262144;
             stackalign   : 8;
-            abi : abi_default;
+            abi : abi_riscv_lp64;
             llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:64:128-a0:0:64-n32-S32';
           );
 

+ 1 - 1
compiler/systems/i_linux.pas

@@ -1309,7 +1309,7 @@ unit i_linux;
             first_parm_offset : 0;
             stacksize    : 32*1024*1024;
             stackalign   : 8;
-            abi : abi_riscv_hf;
+            abi : abi_riscv_ilp32;
             llvmdatalayout : 'e-p:32:32:32-i1:8:8-i8:8:32-i16:16:32-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-n32-S64';
           );
 

+ 3 - 1
compiler/systems/t_bsd.pas

@@ -127,7 +127,9 @@ procedure TLinkerBSD.SetDefaultInfo;
 var
   LdProgram: string='ld';
 begin
-  if target_info.system in (systems_openbsd+systems_freebsd+[system_x86_64_dragonfly]) then
+  if cs_link_lld in current_settings.globalswitches then
+    LdProgram:='ld.lld'
+  else if target_info.system in (systems_openbsd+systems_freebsd+[system_x86_64_dragonfly]) then
     LdProgram:='ld.bfd';
   LibrarySuffix:=' ';
   LdSupportsNoResponseFile := (target_info.system in ([system_m68k_netbsd]+systems_darwin));

+ 67 - 30
compiler/systems/t_embed.pas

@@ -1051,6 +1051,24 @@ begin
       Add('  .rela.bss      : { *(.rela.bss)		}');
       Add('  .rel.plt       : { *(.rel.plt)		}');
       Add('  .rela.plt      : { *(.rela.plt)		}');
+      if [cs_link_discard_start,cs_link_discard_zeroreg_sp,cs_link_discard_copydata,
+          cs_link_discard_jmp_main]*current_settings.globalswitches<>[] then
+        begin
+          Add('  /DISCARD/ :');
+          Add('  { /* Discard RTL startup code */');
+          if cs_link_discard_start in current_settings.globalswitches then
+            begin
+              Add('    *(.init)  /* vector table */');
+              Add('    *(.text.*_default_irq_handler)');
+            end;
+          if cs_link_discard_zeroreg_sp in current_settings.globalswitches then
+            Add('    *(.init2) /* _FPC_init_zeroreg_SP */');
+          if cs_link_discard_copydata in current_settings.globalswitches then
+            Add('    *(.init4) /* _FPC_copy_data */');
+          if cs_link_discard_jmp_main in current_settings.globalswitches then
+            Add('    *(.init9) /* _FPC_jmp_main */');
+          Add('  }');
+        end;
       Add('  /* Internal text space or external memory.  */');
       Add('  .text   :');
       Add('  {');
@@ -1127,36 +1145,55 @@ begin
       Add('    KEEP (*(.fini0))');
       Add('     _etext = . ;');
       Add('  }  > text');
-      Add('  .data	  : AT (ADDR (.text) + SIZEOF (.text))');
-      Add('  {');
-      Add('     PROVIDE (__data_start = .) ;');
-      Add('    *(.data)');
-      Add('    *(.data*)');
-      Add('    *(.rodata)  /* We need to include .rodata here if gcc is used */');
-      Add('    *(.rodata*) /* with -fdata-sections.  */');
-      Add('    *(.gnu.linkonce.d*)');
-      Add('    . = ALIGN(2);');
-      Add('     _edata = . ;');
-      Add('     PROVIDE (__data_end = .) ;');
-      Add('  }  > data');
-      Add('  .bss   : AT (ADDR (.bss))');
-      Add('  {');
-      Add('     PROVIDE (__bss_start = .) ;');
-      Add('    *(.bss)');
-      Add('    *(.bss*)');
-      Add('    *(COMMON)');
-      Add('     PROVIDE (__bss_end = .) ;');
-      Add('  }  > data');
-      Add('   __data_load_start = LOADADDR(.data);');
-      Add('   __data_load_end = __data_load_start + SIZEOF(.data);');
-      Add('  /* Global data not cleared after reset.  */');
-      Add('  .noinit  :');
-      Add('  {');
-      Add('     PROVIDE (__noinit_start = .) ;');
-      Add('    *(.noinit*)');
-      Add('     PROVIDE (__noinit_end = .) ;');
-      Add('     _end = . ;');
-      Add('     PROVIDE (__heap_start = .) ;');
+      if not(cs_link_discard_copydata in current_settings.globalswitches) then
+        begin
+          Add('  .data	  : AT (ADDR (.text) + SIZEOF (.text))');
+          Add('  {');
+          Add('     PROVIDE (__data_start = .) ;');
+          Add('    *(.data)');
+          Add('    *(.data*)');
+          Add('    *(.rodata)  /* We need to include .rodata here if gcc is used */');
+          Add('    *(.rodata*) /* with -fdata-sections.  */');
+          Add('    *(.gnu.linkonce.d*)');
+          Add('    . = ALIGN(2);');
+          Add('     _edata = . ;');
+          Add('     PROVIDE (__data_end = .) ;');
+          Add('  }  > data');
+          Add('  .bss   : AT (ADDR (.bss))');
+          Add('  {');
+          Add('     PROVIDE (__bss_start = .) ;');
+          Add('    *(.bss)');
+          Add('    *(.bss*)');
+          Add('    *(COMMON)');
+          Add('     PROVIDE (__bss_end = .) ;');
+          Add('  }  > data');
+          Add('   __data_load_start = LOADADDR(.data);');
+          Add('   __data_load_end = __data_load_start + SIZEOF(.data);');
+          Add('  /* Global data not cleared after reset.  */');
+          Add('  .noinit  :');
+          Add('  {');
+          Add('     PROVIDE (__noinit_start = .) ;');
+          Add('    *(.noinit*)');
+          Add('     PROVIDE (__noinit_end = .) ;');
+          Add('     _end = . ;');
+          Add('     PROVIDE (__heap_start = .) ;');
+        end
+      else
+        begin
+          { Move all data into noinit section }
+          Add('  /* Global data not cleared after reset.  */');
+          Add('  .noinit  :');
+          Add('  {');
+          Add('    *(.data)');
+          Add('    *(.data*)');
+          Add('    *(.rodata)');
+          Add('    *(.rodata*)');
+          Add('    *(.gnu.linkonce.d*)');
+          Add('    *(.bss)');
+          Add('    *(.bss*)');
+          Add('    *(COMMON)');
+          Add('    *(.noinit*)');
+        end;
       Add('  }  > data');
       Add('  .eeprom  :');
       Add('  {');

+ 70 - 28
compiler/systems/t_linux.pas

@@ -288,7 +288,7 @@ const defdynlinker='/lib/ld-linux-aarch64.so.1';
 {$endif xtensa}
 
 {$ifdef loongarch64}
-  const defdynlinker='/usr/lib64/ld-linux-loongarch-lp64d.so.1';
+  const defdynlinker='/lib64/ld-linux-loongarch-lp64d.so.1';
 {$endif loongarch64}
 
 procedure SetupDynlinker(out DynamicLinker:string;out libctype:TLibcType);
@@ -409,45 +409,80 @@ procedure TLinkerLinux.SetDefaultInfo;
 {
   This will also detect which libc version will be used
 }
-
-const
-{$ifdef i386}      platform_select='-b elf32-i386 -m elf_i386';{$endif}
-{$ifdef x86_64}    platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif}
-{$ifdef powerpc}   platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif}
-{$ifdef POWERPC64} platform_select='';{$endif}
-{$ifdef sparc}     platform_select='-b elf32-sparc -m elf32_sparc';{$endif}
-{$ifdef sparc64}   platform_select='-b elf64-sparc -m elf64_sparc';{$endif}
-{$ifdef arm}       platform_select='';{$endif} {unknown :( }
-{$ifdef aarch64}   platform_select='';{$endif} {unknown :( }
-{$ifdef m68k}      platform_select='';{$endif} {unknown :( }
+var
+  target_opt: string;
+  emulation_opt: string;
+  platformopt: string;
+  LdProgram: string;
+begin
+  target_opt:='';
+  emulation_opt:='';
+  platformopt:='';
+  LdProgram:='';
+{$ifdef i386}
+  target_opt:=' -b elf32-i386';
+  emulation_opt:=' -m elf_i386';
+{$endif}
+{$ifdef x86_64}
+  target_opt:=' -b elf64-x86-64';
+  emulation_opt:=' -m elf_x86_64';
+{$endif}
+{$ifdef powerpc}
+  target_opt:=' -b elf32-powerpc';
+  emulation_opt:=' -m elf32ppclinux';
+{$endif}
+{$ifdef sparc}
+  target_opt:=' -b elf32-sparc';
+  emulation_opt:=' -m elf32_sparc';
+{$endif}
+{$ifdef sparc64}
+  target_opt:=' -b elf64-sparc';
+  emulation_opt:=' -m elf64_sparc';
+{$endif}
+{$ifdef arm}       target_opt:='';{$endif} {unknown :( }
+{$ifdef aarch64}   target_opt:='';{$endif} {unknown :( }
+{$ifdef m68k}      target_opt:='';{$endif} {unknown :( }
 {$ifdef mips}
   {$ifdef mipsel}
-                   platform_select='-EL';
+  platformopt:=' -EL';
   {$else}
-                   platform_select='-EB';
+  platformopt:=' -EB';
   {$endif}
 {$endif}
-{$ifdef riscv32}   platform_select='-m elf32lriscv';{$endif}
-{$ifdef riscv64}   platform_select='-m elf64lriscv';{$endif}
-{$ifdef xtensa}    platform_select='';{$endif}
-{$ifdef loongarch64}   platform_select='';{$endif}
+{$ifdef riscv32}
+  target_opt:=' -m elf32lriscv';
+{$endif}
+{$ifdef riscv64}
+  target_opt:=' -m elf64lriscv';
+{$endif}
+{$ifdef loongarch64}
+  target_opt:='';
+{$endif}
 
-var
-  platformopt: string;
-begin
-  platformopt:='';
 {$ifdef powerpc64}
   if (target_info.abi=abi_powerpc_elfv2) and
      (target_info.endian=endian_little) then
-    platformopt:=' -b elf64-powerpcle -m elf64lppc'
+    begin
+      target_opt:=' -b elf64-powerpcle';
+      emulation_opt:=' -m elf64lppc';
+    end
   else
-    platformopt:=' -b elf64-powerpc -m elf64ppc';
+    begin
+      target_opt:=' -b elf64-powerpc';
+      emulation_opt:=' -m elf64ppc';
+    end;
 {$endif powerpc64}
 {$ifdef xtensa}
   if target_info.endian=endian_little then
-    platformopt:=' -b elf32-xtensa-le -m elf32xtensa'
+    begin
+      target_opt:=' -b elf32-xtensa-le';
+      emulation_opt:=' -m elf32xtensa';
+    end
   else
-    platformopt:=' -b elf32-xtensa-be -m elf32xtensa';
+    begin
+      target_opt:=' -b elf32-xtensa-be';
+      emulation_opt:=' -m elf32xtensa';
+    end;
   if target_info.abi=abi_xtensa_call0 then
     platformopt:=platformopt+' --abi-call0'
   else if target_info.abi=abi_xtensa_windowed then
@@ -456,11 +491,18 @@ begin
 {$ifdef arm}
   platformopt:=' -z noexecstack';
 {$endif arm}
+  if cs_link_lld in current_settings.globalswitches then
+    begin
+      LdProgram:='ld.lld';
+      target_opt:=' -b elf';
+    end
+  else
+    LdProgram:='ld';
 
   with Info do
    begin
-     ExeCmd[1]:='ld '+platform_select+platformopt+' $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP $MAP $LTO $RPATH -L. -o $EXE';
-     DllCmd[1]:='ld '+platform_select+platformopt+' $OPT $INIT $FINI $SONAME $MAP $LTO $RPATH -shared $GCSECTIONS -L. -o $EXE';
+     ExeCmd[1]:=LdProgram+target_opt+emulation_opt+platformopt+' $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP $MAP $LTO $RPATH -L. -o $EXE';
+     DllCmd[1]:=LdProgram+target_opt+emulation_opt+platformopt+' $OPT $INIT $FINI $SONAME $MAP $LTO $RPATH -shared $GCSECTIONS -L. -o $EXE';
      { when we want to cross-link we need to override default library paths;
        when targeting binutils 2.19 or later, we use the "INSERT" command to
        augment the default linkerscript, which also requires -T (normally that

+ 12 - 3
compiler/systems/t_wasi.pas

@@ -37,7 +37,7 @@ uses
   import, export, aasmdata, aasmcpu,
   fmodule, ogbase,
 
-  symsym, symdef,
+  symconst, symsym, symdef, symcpu,
 
   link,
 
@@ -247,9 +247,18 @@ end;
 procedure texportlibwasi.exportprocedure(hp: texported_item);
 var
   nm : TSymStr;
+  pd: tcpuprocdef;
 begin
-  nm := tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname;
-  current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(hp.name^, nm, ie_Func));
+  pd:=tcpuprocdef(tprocsym(hp.sym).ProcdefList[0]);
+  if eo_promising_first in hp.options then
+    pd.add_promising_export(hp.name^,false)
+  else if eo_promising_last in hp.options then
+    pd.add_promising_export(hp.name^,true)
+  else
+    begin
+      nm := pd.mangledname;
+      current_asmdata.asmlists[al_exports].Concat(tai_export_name.create(hp.name^, nm, ie_Func));
+    end;
 end;
 
 procedure texportlibwasi.exportvar(hp: texported_item);

+ 21 - 19
compiler/systems/t_win.pas

@@ -995,25 +995,25 @@ implementation
             Concat('  SYMBOL ___CTOR_LIST__');
             Concat('  SYMBOL __CTOR_LIST__');
             Concat('  LONG -1');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG -1');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  OBJSECTION .ctor*');
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL ___DTOR_LIST__');
             Concat('  SYMBOL __DTOR_LIST__');
             Concat('  LONG -1');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG -1');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  OBJSECTION .dtor*');
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL etext');
             Concat('ENDEXESECTION');
             Concat('EXESECTION .data');
@@ -1061,9 +1061,9 @@ implementation
             Concat('  PROVIDE ___crt_xl_end__');
             { Add a nil pointer as last element }
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL ___crt_xp_start__');
             Concat('  OBJSECTION .CRT$XP*'); {  /* Pre-termination */');}
             Concat('  SYMBOL ___crt_xp_end__');
@@ -1255,7 +1255,9 @@ implementation
              end;
 
             Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
-{$ifdef x86_64}
+{$if defined(aarch64)}
+            Add('OUTPUT_FORMAT(pei-aarch64-little)');
+{$elseif defined(x86_64)}
             Add('OUTPUT_FORMAT(pei-x86-64)');
 {$else not 86_64}
             Add('OUTPUT_FORMAT(pei-i386)');
@@ -1276,22 +1278,22 @@ implementation
             Add('    . = ALIGN(8);');
             Add('     ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
             Add('    LONG (-1);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (-1);');
-{$endif x86_64}
+{$endif cpu64}
             Add('    *(.ctors); *(.ctor); *(SORT(.ctors.*));  LONG (0);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (0);');
-{$endif x86_64}
+{$endif cpu64}
             Add('     ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
             Add('    LONG (-1);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (-1);');
-{$endif x86_64}
+{$endif cpu64}
             Add('    *(.dtors); *(.dtor); *(SORT(.dtors.*));  LONG (0);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (0);');
-{$endif x86_64}
+{$endif cpu64}
             Add('     *(.fini)');
             Add('    PROVIDE (etext = .);');
             Add('    *(.gcc_except_table)');

+ 10 - 0
compiler/tokens.pas

@@ -141,6 +141,7 @@ type
     _FILE,
     _GOTO,
     _HUGE,
+    _LAST,
     _NAME,
     _NEAR,
     _READ,
@@ -162,6 +163,7 @@ type
     _EQUAL,
     _FAR16,
     _FINAL,
+    _FIRST,
     _INDEX,
     _LABEL,
     _LOCAL,
@@ -270,6 +272,7 @@ type
     _OBJCCLASS,
     _OTHERWISE,
     _PROCEDURE,
+    _PROMISING,
     _PROTECTED,
     _PUBLISHED,
     _REFERENCE,
@@ -291,12 +294,14 @@ type
     _OPENSTRING,
     _RIGHTSHIFT,
     _SPECIALIZE,
+    _SUSPENDING,
     _VECTORCALL,
     _CONSTRUCTOR,
     _GREATERTHAN,
     _INTERNCONST,
     _REINTRODUCE,
     _SHORTSTRING,
+    _WASMFUNCREF,
     _COMPILERPROC,
     _EXPERIMENTAL,
     _FINALIZATION,
@@ -483,6 +488,7 @@ const
       (str:'FILE'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'GOTO'          ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'HUGE'          ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'LAST'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'NAME'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'NEAR'          ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'READ'          ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -504,6 +510,7 @@ const
       (str:'EQUAL'         ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'FAR16'         ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'FINAL'         ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'FIRST'         ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'INDEX'         ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'LABEL'         ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
       (str:'LOCAL'         ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -612,6 +619,7 @@ const
       (str:'OBJCCLASS'     ;special:false;keyword:[m_objectivec1];op:NOTOKEN),
       (str:'OTHERWISE'     ;special:false;keyword:alllanguagemodes-[m_iso];op:NOTOKEN),
       (str:'PROCEDURE'     ;special:false;keyword:alllanguagemodes;op:NOTOKEN),
+      (str:'PROMISING'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PROTECTED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'PUBLISHED'     ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'REFERENCE'     ;special:false;keyword:[m_none];op:NOTOKEN),
@@ -633,12 +641,14 @@ const
       (str:'OPENSTRING'    ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'RIGHTSHIFT'    ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'SPECIALIZE'    ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'SUSPENDING'    ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'VECTORCALL'    ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'CONSTRUCTOR'   ;special:false;keyword:alllanguagemodes-[m_iso,m_extpas];op:NOTOKEN),
       (str:'GREATERTHAN'   ;special:false;keyword:[m_none];op:NOTOKEN), { delphi operator name }
       (str:'INTERNCONST'   ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'REINTRODUCE'   ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'SHORTSTRING'   ;special:false;keyword:[m_none];op:NOTOKEN),
+      (str:'WASMFUNCREF'   ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'COMPILERPROC'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'EXPERIMENTAL'  ;special:false;keyword:[m_none];op:NOTOKEN),
       (str:'FINALIZATION'  ;special:false;keyword:[m_initfinal];op:NOTOKEN),

+ 35 - 1
compiler/utils/dummyas.pp

@@ -39,7 +39,7 @@ begin
 end;
 
 var
-  i : longint;
+  i,j : longint;
   param : string;
   skipnext : boolean;
 begin
@@ -58,6 +58,36 @@ begin
           skipnext:=true;
           object_name:=ParamStr(i+1);
         end
+      else if (param='-x') then
+        begin
+        // darwin -x assembler for clang
+        skipnext:=true
+        end
+      else if (param='-target') then
+        begin
+        // darwin -target x86_64-apple-macosx10.8.0 for clang
+        skipnext:=true
+        end
+      else if (param='--32') then
+        begin
+        // Android
+        // Ignore
+        end
+      else if (param='--defsym') then
+        begin
+        // Android
+        skipnext:=true;
+        end
+      else if (Param='-f') then
+        begin
+          // ignore format in nasm
+          skipnext:=true;
+        end
+      else if copy(param,1,4)='-fo=' then  
+        begin
+        // Watcom
+        object_name:=copy(param,5);
+        end
       else if (Param[1]='-') then
         begin
           { option Param not handled }
@@ -73,6 +103,10 @@ begin
               Writeln(stderr,'first non option param =',assembler_name);
               Writeln(stderr,'second non option param =',Param);
               Writeln(stderr,'Don''t know how to handle this!');
+              write(stderr,'full command-line was:');
+              for j:=1 to ParamCount do
+                Write(' ',paramstr(j));
+              Writeln;  
               halt(1);
             end;
         end;

+ 199 - 53
compiler/utils/fpc.pp

@@ -126,7 +126,7 @@ Const
     {$endif sparc}
     {$ifdef sparc64}
          ppcbin:='ppcsparc64';
-          processorname:='sparc64';
+         processorname:='sparc64';
     {$endif sparc64}
     {$ifdef x86_64}
          ppcbin:='ppcx64';
@@ -183,6 +183,8 @@ Const
     end;
 
   var
+    warn : Boolean;
+    ShowErrno : Boolean;
     extrapath : ansistring;
 
   function findexe(var ppcbin:string): boolean;
@@ -261,18 +263,146 @@ Const
           writeln(processorname);
           halt(0);
         end;
-   end;
+      end;
 
+Function FindConfigFile(const aFile : string) : String;
+// Adapted from check_configfile(fn:string; var foundfn:string):boolean;
+{
+  Order to read configuration file :
+  Unix:
+   1 - current dir
+   2 - ~/.fpc.cfg
+   3 - configpath
+   4 - /etc
+  Windows:
+   1 - current dir
+   2 - home dir of user or all users
+   3 - config path
+   4 - next to binary
+  Other:
+   1 - current dir
+   3 - config path
+   4 - next to binary
+}
+
+var
+  {$ifdef unix}hs,{$endif} aSearchPath,exepath,configpath : string;
+
+  Procedure AddToPath(aDir : String);
+
+  begin
+    if aDir='' then exit;
+    if (aSearchPath<>'') then
+      aSearchPath:=aSearchPath+PathSeparator;
+    aSearchPath:=aSearchPath+IncludeTrailingPathDelimiter(SetDirSeparators(aDir));
+  end;
+
+begin
+  if FileExists(aFile) then
+    Exit(aFile);
+  ExePath:=SetDirSeparators(ExtractFilePath(paramstr(0)));
+  aSearchPath:='';
+  { retrieve configpath }
+  configpath:=SetDirSeparators(GetEnvironmentVariable('PPC_CONFIG_PATH'));
+{$ifdef Unix}
+  hs:=SetDirSeparators(GetEnvironmentVariable('HOME'));
+  if (hs<>'') then
+    begin
+    Result:=IncludeTrailingPathDelimiter(hs)+'.'+aFile;
+    if FileExists(Result) then
+      exit;
+    end;
+  if configpath='' then
+    configpath:=ExpandFileName(ExePath+'../etc/');
+{$endif}
+  AddToPath(ConfigPath);
+{$ifdef WINDOWS}
+  AddToPath(GetEnvironmentVariable('USERPROFILE'));
+  AddToPath(GetEnvironmentVariable('ALLUSERSPROFILE'));
+{$endif WINDOWS}
+{$ifdef Unix}
+  AddToPath('/etc/');
+{$else}
+  AddToPath(exepath);
+{$endif}
+  Result:=FileSearch(aFile,aSearchPath);
+end;
+
+Procedure CheckWarn(aOpt : String);
+
+Var
+  Len,I : integer;
+
+begin
+  Len:=Length(aOpt);
+  For I:=1 to Len do
+    begin
+    if (aOpt[i]='w') then
+      Warn:=(I=Len) or (aOpt[i+1]<>'-');
+    if (aOpt[i]='q') then
+      ShowErrNo:=(I=Len) or (aOpt[i+1]<>'-');
+    end;
+end;
+
+procedure SetExeSuffix(var ExeSuffix : string; aValue : string);
+
+begin
+  if ExeSuffix='' then
+    exesuffix :=aValue
+  else if Warn then
+    begin
+    Write('Warning: ');
+    if ShowErrNo then
+      Write('(99999) ');
+    Writeln('Compiler version already set to: ',ExeSuffix);
+    end;
+end;
+
+Procedure ProcessConfigFile(aFileName : String; var ExeSuffix : String);
+
+  Function Stripline(aLine : String) : string;
+
+  Var
+    P : integer;
+
+  begin
+    if (aLine<>'') and (aLine[1]=';') then exit;
+    Pos('#',aLine); // no ifdef or include.
+    if P=0 then
+      P:=Length(aLine)+1;
+    Result:=Copy(aLine,1,P-1);
+  end;
+
+Var
+  aFile : Text;
+  aLine : String;
+
+begin
+  Assign(aFile,aFileName);
+  {$push}{$I-}
+  filemode:=0;
+  Reset(aFile);
+  {$pop}
+  if ioresult<>0 then
+    Error('Cannot open config file: '+aFileName);
+  While not EOF(aFile) do
+    begin
+    ReadLn(aFile,aLine);
+    aLine:=StripLine(aLine);
+    if aLine='' then
+      continue;
+    if Copy(aLine,1,2)='-V' then
+      SetExeSuffix(ExeSuffix,Copy(aLine,3,Length(aLine)-2));
+    end;
+  {$i+}
+  Close(aFile);
+end;
 
   var
-     s              : ansistring;
-     cpusuffix,
-     SourceCPU,
-     ppcbin,
-     versionStr,
-     TargetCPU   : string;
-     ppccommandline : array of ansistring;
-     ppccommandlinelen : longint;
+     s,CfgFile: ansistring;
+     CPUSuffix, ExeSuffix, SourceCPU, ppcbin, TargetName, TargetCPU: string;
+     PPCCommandLine: array of ansistring;
+     PPCCommandLineLen: longint;
      i : longint;
      errorvalue     : Longint;
 
@@ -283,54 +413,70 @@ Const
        Inc(PPCCommandLineLen);
      end;
 
+begin
+  ppccommandline := [];
+  setlength(ppccommandline, paramcount);
+  ppccommandlinelen := 0;
+  cpusuffix := '';        // if not empty, signals attempt at cross
+  // compiler.
+  extrapath := '';
+  initplatform(ppcbin, SourceCPU);
+  exesuffix := '';                      { Default is just the name }
+  if ParamCount = 0 then
   begin
-     ppccommandline:=[];
-     setlength(ppccommandline,paramcount);
-     ppccommandlinelen:=0;
-     cpusuffix     :='';        // if not empty, signals attempt at cross
-                                // compiler.
-     extrapath     :='';
-     versionstr:='';                      { Default is just the name }
-     initplatform(ppcbin,SourceCPU);
-     if ParamCount = 0 then
-       begin
-         SetLength (PPCCommandLine, 1);
-         AddToCommandLine('-?F' + ParamStr (0));
-       end
-     else
-      for i:=1 to paramcount do
-       begin
-          s:=paramstr(i);
-          if pos('-V',s)=1 then
-              versionstr:=copy(s,3,length(s)-2)
+    SetLength(PPCCommandLine, 1);
+    AddToCommandLine('-?F'+ParamStr(0));
+  end
+  else
+    for i := 1 to paramcount do
+    begin
+      s := ParamStr(i);
+      if pos('-t', s) = 1 then
+      begin
+        targetname := copy(s, 3, length(s)-2);
+        AddToCommandLine(S);
+      end
+      else if pos('-V', s) = 1 then
+        SetExeSuffix(ExeSuffix,copy(s, 3, length(s)-2))
+      else
+      begin
+        if pos('-P', s) = 1 then
+           begin
+             TargetCPU:=copy(s,3,length(s)-2);
+             CheckSpecialProcessors(TargetCPU,SourceCPU,ppcbin,cpusuffix,exesuffix);
+             if TargetCPU <> SourceCPU then
+               begin
+                 cpusuffix:=processortosuffix(TargetCPU);
+                 ppcbin:='ppc'+crosssuffix+cpusuffix;
+               end;
+           end
+        else if pos('-Xp',s)=1 then
+          extrapath:=copy(s,4,length(s)-3)
+        else
+        begin
+          if pos('-h', s) = 1 then
+            AddToCommandLine('-hF'+ParamStr(0))
+          else if pos('-?', s) = 1 then
+            AddToCommandLine('-?F'+ParamStr(0))
           else
             begin
-              if pos('-P',s)=1 then
-                 begin
-                   TargetCPU:=copy(s,3,length(s)-2);
-                   CheckSpecialProcessors(TargetCPU,SourceCPU,ppcbin,cpusuffix,versionstr);
-                   if TargetCPU <> SourceCPU then
-                     begin
-                       cpusuffix:=processortosuffix(TargetCPU);
-                       ppcbin:='ppc'+crosssuffix+cpusuffix;
-                     end;
-                 end
-              else if pos('-Xp',s)=1 then
-                extrapath:=copy(s,4,length(s)-3)
-              else
-                begin
-                  if pos('-h',s)=1 then
-                    AddToCommandLine('-hF'+ParamStr(0))
-                  else if pos('-?',s)=1 then
-                    AddToCommandLine('-?F'+ParamStr(0))
-                  else
-                    AddToCommandLine(S);
-                end;
+            AddToCommandLine(S);
+            if pos('-v', s) = 1 then
+              CheckWarn(Copy(S,3,length(S)-2));
             end;
+        end;
+      end;
+    end;
+     if (TargetName<>'') then
+       begin
+       S:='fpc-'+lowercase(TargetName)+'.cfg';
+       CfgFile:=FindConfigFile(s);
+       if CfgFile='' then
+         Error('Cannot find subtarget config file: '+s);
+       ProcessConfigFile(CfgFile,ExeSuffix);
        end;
-     SetLength(ppccommandline,ppccommandlinelen);
-
-     ppcbin:=findcompiler(ppcbin,cpusuffix,versionstr);
+     SetLength(ppccommandline, ppccommandlinelen);
+     ppcbin := findcompiler(ppcbin, cpusuffix, exesuffix);
 
      { call ppcXXX }
      try

+ 17 - 2
compiler/utils/ppuutils/ppudump.pp

@@ -2339,10 +2339,15 @@ const
         'Link using native linker', {cs_link_native}
         'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19}
         'Link using vlink', {cs_link_vlink}
+        'Discard _START code', {cs_link_discard_start}
+        'Discard code initializing the zero register and stack pointer', {cs_link_discard_zeroreg_sp}
+        'Discard initializing data', {cs_link_discard_copydata}
+        'Discard jump to PASCALMAIN', {cs_link_discard_jmp_main}
         'Link-Time Optimization disabled for system unit', {cs_lto_nosystem}
         'Assemble on target OS', {cs_asemble_on_target}
         'Use a memory model to support >2GB static data on 64 Bit target', {cs_large}
-        'Generate UF2 binary' {cs_generate_uf2}
+        'Generate UF2 binary', {cs_generate_uf2}
+	'Link using ld.lld GNU compatible LLVM linker' {cs_link_lld}
        );
     localswitchname : array[tlocalswitch] of string[50] =
        { Switches which can be changed locally }
@@ -2872,6 +2877,12 @@ begin
     end;
   writeln;
 
+  if df_unique in defoptions then
+    begin
+      write  ([space,'      OriginalDef : ']);
+      readderef(space);
+    end;
+
   if df_genconstraint in defoptions then
     begin
       ppufile.getset(tppuset1(genconstr));
@@ -3041,7 +3052,9 @@ const
      (mask:po_noinline;        str: 'Never inline'),
      (mask:po_variadic;        str: 'C VarArgs with array-of-const para'),
      (mask:po_objc_related_result_type; str: 'Objective-C related result type'),
-     (mask:po_anonymous;       str: 'Anonymous')
+     (mask:po_anonymous;       str: 'Anonymous'),
+     (mask:po_wasm_funcref;    str: 'WebAssembly funcref'),
+     (mask:po_wasm_suspending; str: 'WebAssembly suspending')
   );
 var
   proctypeoption  : tproctypeoption;
@@ -4080,6 +4093,8 @@ begin
                      WriteWarning('Invalid x86 pointer type: ' + IntToStr(b));
                  end;
                end;
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_wasm32 then
+               writeln([space,'   WASM externref : ',(getbyte<>0)]);
            end;
 
          iborddef :

+ 6 - 26
compiler/verbose.pas

@@ -41,30 +41,6 @@ interface
 
 {$i msgidx.inc}
 
-    Const
-      { Levels }
-      V_None         = $0;
-      V_Fatal        = $1;
-      V_Error        = $2;
-      V_Normal       = $4; { doesn't show a text like Error: }
-      V_Warning      = $8;
-      V_Note         = $10;
-      V_Hint         = $20;
-      V_LineInfoMask = $fff;
-      { From here by default no line info }
-      V_Info         = $1000;
-      V_Status       = $2000;
-      V_Used         = $4000;
-      V_Tried        = $8000;
-      V_Conditional  = $10000;
-      V_Debug        = $20000;
-      V_Executable   = $40000;
-      V_LevelMask    = $fffffff;
-      V_All          = V_LevelMask;
-      V_Default      = V_Fatal + V_Error + V_Normal;
-      { Flags }
-      V_LineInfo     = $10000000;
-
     var
       msg : pmessage;
 
@@ -351,6 +327,10 @@ implementation
                          status.verbosity:=status.verbosity and (not V_Info)
                        else
                          status.verbosity:=status.verbosity or V_Info;
+                 'J' : if inverse then
+                         status.verbosity:=status.verbosity and (not V_Parallel)
+                       else
+                         status.verbosity:=status.verbosity or V_Parallel;
                  'L' : if inverse then
                          status.verbosity:=status.verbosity and (not V_Status)
                        else
@@ -622,7 +602,7 @@ implementation
       { Create status info }
         UpdateStatus;
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
       { show comment }
         if do_comment(l,s) or dostop then
           raise ECompilerAbort.Create;
@@ -754,7 +734,7 @@ implementation
       { fix status }
         UpdateStatus;
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
         if status.showmsgnrs and ((v and V_Normal)=0) then
           s:='('+tostr(w)+') '+s;
         if doqueue then

+ 17 - 2
compiler/wasm32/aasmcpu.pas

@@ -570,7 +570,8 @@ uses
           a_end_if,
           a_end_loop,
           a_end_try,
-          a_catch_all:
+          a_catch_all,
+          a_ref_is_null:
             result:=1;
           a_i32_trunc_sat_f32_s,
           a_i32_trunc_sat_f32_u,
@@ -581,7 +582,9 @@ uses
           a_i64_trunc_sat_f64_s,
           a_i64_trunc_sat_f64_u,
           a_memory_size,
-          a_memory_grow:
+          a_memory_grow,
+          a_ref_null_funcref,
+          a_ref_null_externref:
             result:=2;
           a_memory_copy:
             result:=4;
@@ -1991,6 +1994,18 @@ uses
               WriteByte($FC);
               WriteByte($07);
             end;
+          a_ref_null_funcref:
+            begin
+              WriteByte($D0);
+              WriteByte($70);
+            end;
+          a_ref_null_externref:
+            begin
+              WriteByte($D0);
+              WriteByte($6F);
+            end;
+          a_ref_is_null:
+            WriteByte($D1);
           else
             internalerror(2021092624);
         end;

+ 11 - 4
compiler/wasm32/agllvmmc.pas

@@ -241,7 +241,14 @@ implementation
             else
               begin
                 result:=result+'nan';
+{$ifndef CPUMIPS}
                 if fraction<>(int64(1) shl (fraction_bits-1)) then
+{$else CPUMIPS}
+                { Legacy mips fpu has a different representation of 'standard' nan }
+                { Signalling bit is clear to signify non-signalling }
+                { Standard non-signalling NaN thus has all other bits set }
+                if fraction<>((int64(1) shl (fraction_bits-1))-1) then
+{$endif CPUMIPS}
                   result:=result+'(0x'+HexStr(fraction,fraction_hexdigits)+')';
               end;
           end
@@ -372,7 +379,7 @@ implementation
          id     : as_wasm32_llvm_mc_v11;
          idtxt  : 'LLVM-MC-11';
          asmbin : 'llvm-mc-11';
-         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics --filetype=obj -o $OBJ $EXTRAOPT $ASM';
+         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics,+reference-types --filetype=obj -o $OBJ $EXTRAOPT $ASM';
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
@@ -385,7 +392,7 @@ implementation
          id     : as_wasm32_llvm_mc_v12;
          idtxt  : 'LLVM-MC-12';
          asmbin : 'llvm-mc-12';
-         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics --filetype=obj -o $OBJ $EXTRAOPT $ASM';
+         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics,+reference-types --filetype=obj -o $OBJ $EXTRAOPT $ASM';
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
@@ -398,7 +405,7 @@ implementation
          id     : as_wasm32_llvm_mc_v13;
          idtxt  : 'LLVM-MC-13';
          asmbin : 'llvm-mc-13';
-         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics --filetype=obj -o $OBJ $EXTRAOPT $ASM';
+         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics,+reference-types --filetype=obj -o $OBJ $EXTRAOPT $ASM';
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
@@ -411,7 +418,7 @@ implementation
          id     : as_wasm32_llvm_mc;
          idtxt  : 'LLVM-MC';
          asmbin : 'llvm-mc';
-         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics --filetype=obj -o $OBJ $EXTRAOPT $ASM';
+         asmcmd : '--assemble --arch=wasm32 -mattr=+sign-ext,+exception-handling,+bulk-memory,+atomics,+reference-types --filetype=obj -o $OBJ $EXTRAOPT $ASM';
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          labelprefix : '.L';

+ 20 - 0
compiler/wasm32/cgcpu.pas

@@ -41,6 +41,8 @@ interface
         function  getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getaddressregister(list:TAsmList):Tregister;override;
+        function  getfuncrefregister(list:TAsmList):Tregister;
+        function  getexternrefregister(list:TAsmList):Tregister;
         procedure do_register_allocation(list:TAsmList;headertai:tai);override;
         procedure a_label_pascal_goto_target(list : TAsmList;l : tasmlabel);override;
       end;
@@ -74,6 +76,10 @@ implementation
           [RS_R0],first_fpu_imreg,[]);
         rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
           [RS_R0],first_mm_imreg,[]);
+        rg[R_FUNCREFREGISTER]:=Trgcpu.create(R_FUNCREFREGISTER,R_SUBNONE,
+          [RS_R0],first_funcref_imreg,[]);
+        rg[R_EXTERNREFREGISTER]:=Trgcpu.create(R_EXTERNREFREGISTER,R_SUBNONE,
+          [RS_R0],first_externref_imreg,[]);
       end;
 
 
@@ -82,6 +88,8 @@ implementation
         rg[R_INTREGISTER].free;
         rg[R_FPUREGISTER].free;
         rg[R_MMREGISTER].free;
+        rg[R_FUNCREFREGISTER].free;
+        rg[R_EXTERNREFREGISTER].free;
         inherited done_register_allocators;
       end;
 
@@ -113,6 +121,18 @@ implementation
       end;
 
 
+    function  tcgwasm.getfuncrefregister(list:TAsmList):Tregister;
+      begin
+        result:=rg[R_FUNCREFREGISTER].getregister(list,R_SUBNONE);
+      end;
+
+
+    function  tcgwasm.getexternrefregister(list:TAsmList):Tregister;
+      begin
+        result:=rg[R_EXTERNREFREGISTER].getregister(list,R_SUBNONE);
+      end;
+
+
     procedure tcgwasm.do_register_allocation(list:TAsmList;headertai:tai);
       begin
         { We only run the "register allocation" once for an arbitrary allocator,

+ 7 - 1
compiler/wasm32/cpubase.pas

@@ -87,7 +87,7 @@ uses
       // bulk memory operations
       a_memory_copy, a_memory_fill, a_memory_init, a_data_drop,
       // reference instructions
-      a_ref_null, a_ref_is_null, a_ref_func,
+      a_ref_null_funcref, a_ref_null_externref, a_ref_is_null, a_ref_func,
       // table instructions
       a_table_get, a_table_set, a_table_size, a_table_grow, a_table_fill, a_table_copy, a_table_init, a_elem_drop,
       // saturating truncation instructions
@@ -230,6 +230,12 @@ uses
       { MM Super register first and last }
       first_mm_imreg     = 4;
 
+      { funcref Super register first and last }
+      first_funcref_imreg     = 4;
+
+      { externref Super register first and last }
+      first_externref_imreg     = 4;
+
       regnumber_table : array[tregisterindex] of tregister = (
         {$i rwasmnum.inc}
       );

+ 1 - 0
compiler/wasm32/cpunode.pas

@@ -34,6 +34,7 @@ implementation
     ncgadd, ncgcal,ncgmat,ncginl,
     
     nwasmbas,nwasmadd,nwasmcal,nwasmmat,nwasmflw,nwasmcon,nwasmcnv,nwasmset,nwasminl,nwasmld,
+    nwasmmem,
     { these are not really nodes }
     nwasmutil,
     { symtable }

+ 100 - 7
compiler/wasm32/hlcgcpu.pas

@@ -65,6 +65,8 @@ uses
       procedure decstack(list : TAsmList;slots: longint);
 
       class function def2regtyp(def: tdef): tregistertype; override;
+      function getintregister(list:TAsmList;size:tdef):Tregister;override;
+      function getregisterfordef(list: TAsmList;size:tdef):Tregister;override;
 
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
 
@@ -256,7 +258,7 @@ implementation
     defutil,cpupi,
     aasmtai,aasmcpu,
     symtable,symcpu,
-    procinfo,cpuinfo,cgcpu,tgobj,tgcpu,paramgr;
+    procinfo,cpuinfo,cgobj,cgcpu,tgobj,tgcpu,paramgr;
 
   const
     TOpCG2IAsmOp : array[topcg] of TAsmOp=(
@@ -364,13 +366,39 @@ implementation
 
   class function thlcgwasm.def2regtyp(def: tdef): tregistertype;
     begin
-      if (def.typ=recorddef) and (def.size in [4,8]) and (trecorddef(def).contains_float_field) then
+      if is_wasm_externref(def) then
+        result:=R_EXTERNREFREGISTER
+      else if is_wasm_funcref(def) then
+        result:=R_FUNCREFREGISTER
+      else if (def.typ=recorddef) and (def.size in [4,8]) and (trecorddef(def).contains_float_field) then
         result:=R_FPUREGISTER
       else
         result:=inherited;
     end;
 
 
+  function thlcgwasm.getintregister(list:TAsmList;size:tdef):Tregister;
+    begin
+      if is_wasm_reference_type(size) then
+        internalerror(2023060702)
+      else
+        result:=inherited;
+    end;
+
+
+  function thlcgwasm.getregisterfordef(list: TAsmList;size:tdef):Tregister;
+    begin
+      case def2regtyp(size) of
+        R_EXTERNREFREGISTER:
+          result:=TCgWasm(cg).getexternrefregister(list);
+        R_FUNCREFREGISTER:
+          result:=TCgWasm(cg).getfuncrefregister(list);
+        else
+          result:=inherited;
+      end;
+    end;
+
+
   procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
     begin
       tosize:=get_para_push_size(tosize);
@@ -421,6 +449,18 @@ implementation
                 internalerror(2010110702);
             end;
           end;
+        R_EXTERNREFREGISTER:
+          begin
+            if a<>0 then
+              internalerror(2023061101);
+            list.Concat(taicpu.op_none(a_ref_null_externref));
+          end;
+        R_FUNCREFREGISTER:
+          begin
+            if a<>0 then
+              internalerror(2023061102);
+            list.Concat(taicpu.op_none(a_ref_null_funcref));
+          end;
         else
           internalerror(2010110703);
       end;
@@ -714,19 +754,62 @@ implementation
   procedure thlcgwasm.a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
     var
       tmpref: treference;
+      regtyp: TRegisterType;
     begin
       tmpref:=ref;
       if tmpref.base<>NR_EVAL_STACK_BASE then
         a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
-      a_load_const_stack(list,size,a,def2regtyp(size));
-      a_cmp_stack_stack(list,size,cmp_op);
+      regtyp:=def2regtyp(size);
+      case regtyp of
+        R_EXTERNREFREGISTER,
+        R_FUNCREFREGISTER:
+          begin
+            if a<>0 then
+              internalerror(2023061103);
+            if not (cmp_op in [OC_EQ,OC_NE]) then
+              internalerror(2023061104);
+            list.Concat(taicpu.op_none(a_ref_is_null));
+            if cmp_op=OC_NE then
+              begin
+                a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
+                a_cmp_stack_stack(list,s32inttype,OC_EQ);
+              end;
+          end;
+        else
+          begin
+            a_load_const_stack(list,size,a,regtyp);
+            a_cmp_stack_stack(list,size,cmp_op);
+          end;
+      end;
     end;
 
   procedure thlcgwasm.a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
+    var
+      regtyp: TRegisterType;
     begin
       a_load_reg_stack(list,size,reg);
-      a_load_const_stack(list,size,a,def2regtyp(size));
-      a_cmp_stack_stack(list,size,cmp_op);
+      regtyp:=def2regtyp(size);
+      case regtyp of
+        R_EXTERNREFREGISTER,
+        R_FUNCREFREGISTER:
+          begin
+            if a<>0 then
+              internalerror(2023061105);
+            if not (cmp_op in [OC_EQ,OC_NE]) then
+              internalerror(2023061106);
+            list.Concat(taicpu.op_none(a_ref_is_null));
+            if cmp_op=OC_NE then
+              begin
+                a_load_const_stack(list,s32inttype,0,R_INTREGISTER);
+                a_cmp_stack_stack(list,s32inttype,OC_EQ);
+              end;
+          end;
+        else
+          begin
+            a_load_const_stack(list,size,a,regtyp);
+            a_cmp_stack_stack(list,size,cmp_op);
+          end;
+      end;
     end;
 
   procedure thlcgwasm.a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
@@ -1024,7 +1107,17 @@ implementation
               end;
             else
               internalerror(2011010302);
-          end
+          end;
+        R_FUNCREFREGISTER:
+          begin
+            list.concat(taicpu.op_none(a_ref_null_funcref));
+            incstack(list,1);
+          end;
+        R_EXTERNREFREGISTER:
+          begin
+            list.concat(taicpu.op_none(a_ref_null_externref));
+            incstack(list,1);
+          end;
         else
           internalerror(2011010301);
       end;

+ 1 - 1
compiler/wasm32/itcpugas.pas

@@ -86,7 +86,7 @@ interface
       // bulk memory operations
       'memory.copy 0,0', 'memory.fill 0', 'memory.init', 'data.drop',
       // reference instructions
-      'ref.null', 'ref.is_null', 'ref.func',
+      'ref.null_func', 'ref.null_extern', 'ref.is_null', 'ref.func',
       // table instructions
       'table.get', 'table.set', 'table.size', 'table.grow', 'table.fill', 'table.copy', 'table.init', 'elem.drop',
       // saturating truncation instructions

+ 27 - 1
compiler/wasm32/nwasmcal.pas

@@ -40,6 +40,7 @@ interface
 
        twasmcallnode = class(tcgcallnode)
        protected
+         function  pass_typecheck:tnode;override;
          procedure extra_post_call_code; override;
          procedure do_release_unused_return_value; override;
          procedure set_result_location(realresdef: tstoreddef); override;
@@ -49,10 +50,35 @@ interface
 implementation
 
     uses
-      globals, globtype, aasmdata, defutil, tgobj, hlcgcpu, symconst, symcpu;
+      globals, globtype, verbose, aasmdata, defutil, tgobj, hlcgcpu, symconst, symsym, symcpu;
 
       { twasmcallnode }
 
+    function twasmcallnode.pass_typecheck:tnode;
+      var
+        p: tcallparanode;
+        pvs: tparavarsym;
+      begin
+        result:=inherited;
+        if codegenerror then
+          exit;
+
+        if assigned(procdefinition) then
+          begin
+            p:=tcallparanode(left);
+            while assigned(p) do
+              begin
+                pvs:=p.parasym;
+                if assigned(p.left) and is_wasm_reference_type(p.left.resultdef) and
+                   assigned(pvs) and
+                  ((pvs.varspez in [vs_var,vs_constref,vs_out]) or
+                   ((pvs.varspez=vs_const) and (pvs.vardef.typ=formaldef))) then
+                  CGMessage(parser_e_wasm_ref_types_can_only_be_passed_by_value);
+                p:=tcallparanode(tcallparanode(p).right);
+              end;
+          end;
+      end;
+
     procedure twasmcallnode.extra_post_call_code;
       begin
         thlcgwasm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition);

+ 12 - 0
compiler/wasm32/nwasmcnv.pas

@@ -38,6 +38,8 @@ interface
          procedure second_int_to_bool;override;
          procedure second_ansistring_to_pchar;override;
          procedure second_class_to_intf;override;
+       public
+         function target_specific_explicit_typeconv: boolean;override;
        end;
 
 implementation
@@ -253,6 +255,16 @@ implementation
           internalerror(2002081301);
       end;
 
+
+    function twasmtypeconvnode.target_specific_explicit_typeconv: boolean;
+      begin
+        result:=false;
+        if is_pointer(left.resultdef) and
+           is_pointer(resultdef) and
+           not tpointerdef(left.resultdef).compatible_with_pointerdef_size(tpointerdef(resultdef)) then
+          CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
+      end;
+
 begin
   ctypeconvnode:=twasmtypeconvnode;
 end.

+ 63 - 0
compiler/wasm32/nwasmmem.pas

@@ -0,0 +1,63 @@
+{
+    Copyright (c) 1998-2023 by Florian Klaempfl and Nikolay Nikolov
+
+    Generate WebAssembly code for memory related nodes
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+unit nwasmmem;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node,nmem,ncgmem;
+
+    type
+
+      { twasmaddrnode }
+
+      twasmaddrnode = class(tcgaddrnode)
+        function pass_typecheck:tnode;override;
+      end;
+
+implementation
+
+    uses
+      globals,
+      verbose,
+      symcpu;
+
+    { twasmaddrnode }
+
+    function twasmaddrnode.pass_typecheck: tnode;
+    begin
+      Result:=inherited;
+      if codegenerror then
+       exit;
+
+      if assigned(left) and is_wasm_externref(left.resultdef) then
+        begin
+          CGMessagePos(left.fileinfo,type_e_cannot_take_address_of_wasm_externref);
+          result:=nil;
+          exit;
+        end;
+    end;
+
+begin
+  caddrnode:=twasmaddrnode;
+end.

+ 28 - 2
compiler/wasm32/rgcpu.pas

@@ -54,7 +54,7 @@ implementation
       globtype,globals,
       cgobj,
       tgobj,
-      symtype,symdef,symcpu;
+      symtype,symdef,symconst,symcpu;
 
     { trgcpu }
 
@@ -326,7 +326,9 @@ implementation
         spill_temps : tspilltemps;
         templist : TAsmList;
         intrg,
-        fprg     : trgcpu;
+        fprg,
+        frrg,
+        errg     : trgcpu;
         p,q      : tai;
         size     : longint;
 
@@ -340,6 +342,7 @@ implementation
         pidx    : integer;
         t: treftemppos;
         def: tdef;
+        wasmfuncreftype: tprocvardef;
 
       begin
         { Since there are no actual registers, we simply spill everything. We
@@ -350,9 +353,13 @@ implementation
         { get references to all register allocators }
         intrg:=trgcpu(cg.rg[R_INTREGISTER]);
         fprg:=trgcpu(cg.rg[R_FPUREGISTER]);
+        frrg:=trgcpu(cg.rg[R_FUNCREFREGISTER]);
+        errg:=trgcpu(cg.rg[R_EXTERNREFREGISTER]);
         { determine the live ranges of all registers }
         intrg.insert_regalloc_info_all(list);
         fprg.insert_regalloc_info_all(list);
+        frrg.insert_regalloc_info_all(list);
+        errg.insert_regalloc_info_all(list);
         { Don't do the actual allocation when -sr is passed }
         if (cs_no_regalloc in current_settings.globalswitches) then
           exit;
@@ -361,8 +368,13 @@ implementation
         { allocate room to store the virtual register -> temp mapping }
         spill_temps[R_INTREGISTER]:=allocmem(sizeof(treference)*intrg.maxreg);
         spill_temps[R_FPUREGISTER]:=allocmem(sizeof(treference)*fprg.maxreg);
+        spill_temps[R_FUNCREFREGISTER]:=allocmem(sizeof(treference)*frrg.maxreg);
+        spill_temps[R_EXTERNREFREGISTER]:=allocmem(sizeof(treference)*errg.maxreg);
         { List to insert temp allocations into }
         templist:=TAsmList.create;
+        {  }
+        wasmfuncreftype:=cprocvardef.create(normal_function_level,true);
+        include(wasmfuncreftype.procoptions,po_wasm_funcref);
         { allocate/replace all registers }
         p:=headertai;
         insbefore := nil;
@@ -408,6 +420,16 @@ implementation
                           else
                             internalerror(2020120804);
                         end;
+                      R_FUNCREFREGISTER:
+                        begin
+                          size:=0;
+                          def:=wasmfuncreftype;
+                        end;
+                      R_EXTERNREFREGISTER:
+                        begin
+                          size:=0;
+                          def:=wasmvoidexternreftype;
+                        end;
                       else
                         internalerror(2010122912);
                     end;
@@ -445,7 +467,11 @@ implementation
           list.insertListBefore(nil, templist);
         freemem(spill_temps[R_INTREGISTER]);
         freemem(spill_temps[R_FPUREGISTER]);
+        freemem(spill_temps[R_FUNCREFREGISTER]);
+        freemem(spill_temps[R_EXTERNREFREGISTER]);
         templist.free;
+        { Not needed anymore }
+        wasmfuncreftype.owner.deletedef(wasmfuncreftype);
       end;
 
 end.

+ 1 - 1
compiler/wasm32/strinst.inc

@@ -70,7 +70,7 @@
         // bulk memory operations
         'memory.copy', 'memory.fill', 'memory.init', 'data.drop',
         // reference instructions
-        'ref.null', 'ref.is_null', 'ref.func',
+        'ref.null_func', 'ref.null_extern', 'ref.is_null', 'ref.func',
         // table instructions
         'table.get', 'table.set', 'table.size', 'table.grow', 'table.fill', 'table.copy', 'table.init', 'elem.drop',
         // saturating truncation instructions

+ 131 - 12
compiler/wasm32/symcpu.pas

@@ -60,6 +60,16 @@ type
   tcpuerrordefclass = class of tcpuerrordef;
 
   tcpupointerdef = class(tpointerdef)
+  protected
+    procedure ppuload_platform(ppufile: tcompilerppufile); override;
+    procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
+  public
+    { flag, indicating whether the pointer is a WebAssembly externref reference type }
+    is_wasm_externref: boolean;
+    constructor create_externref(def: tdef);
+    function getcopy: tstoreddef; override;
+    function GetTypeName: string; override;
+    function compatible_with_pointerdef_size(ptr: tpointerdef): boolean; override;
   end;
   tcpupointerdefclass = class of tcpupointerdef;
 
@@ -107,9 +117,14 @@ type
     { generated assembler code; used by WebAssembly backend so it can afterwards
       easily write out all methods grouped per class }
     exprasmlist  : TAsmList;
+    promising_first_export_name: string;
+    promising_last_export_name: string;
     destructor destroy; override;
     function create_functype: TWasmFuncType;
     function is_pushleftright: boolean; override;
+    function suspending_wrapper_name: ansistring;
+    function promising_wrapper_name(last:boolean): ansistring;
+    procedure add_promising_export(aextname: ansistring;last:boolean);
   end;
   tcpuprocdefclass = class of tcpuprocdef;
 
@@ -196,6 +211,14 @@ type
 const
   pbestrealtype : ^tdef = @s64floattype;
 
+  {# Returns true if p is a WebAssembly funcref reference type }
+  function is_wasm_funcref(p : tdef): boolean;
+
+  {# Returns true if p is a WebAssembly externref reference type }
+  function is_wasm_externref(p : tdef): boolean;
+
+  {# Returns true if p is a WebAssembly reference type (funcref or externref) }
+  function is_wasm_reference_type(p : tdef): boolean;
 
 implementation
 
@@ -209,6 +232,21 @@ implementation
     tgcpu
     ;
 
+  function is_wasm_funcref(p: tdef): boolean;
+    begin
+      result:=(p.typ=procvardef) and (po_wasm_funcref in tprocvardef(p).procoptions);
+    end;
+
+  function is_wasm_externref(p: tdef): boolean;
+    begin
+      result:=(p.typ=pointerdef) and (tcpupointerdef(p).is_wasm_externref);
+    end;
+
+  function is_wasm_reference_type(p: tdef): boolean;
+    begin
+      result:=is_wasm_funcref(p) or is_wasm_externref(p);
+    end;
+
 
   {****************************************************************************
                                tcpuproptertysym
@@ -221,6 +259,53 @@ implementation
 ****************************************************************************}
 
 
+{****************************************************************************
+                             tcpupointerdef
+****************************************************************************}
+
+
+  procedure tcpupointerdef.ppuload_platform(ppufile: tcompilerppufile);
+    begin
+      inherited;
+      is_wasm_externref:=ppufile.getboolean;
+    end;
+
+
+  procedure tcpupointerdef.ppuwrite_platform(ppufile: tcompilerppufile);
+    begin
+      inherited;
+      ppufile.putboolean(is_wasm_externref);
+    end;
+
+
+  constructor tcpupointerdef.create_externref(def: tdef);
+    begin
+      inherited create(def);
+      is_wasm_externref:=true;
+    end;
+
+
+  function tcpupointerdef.getcopy: tstoreddef;
+    begin
+      result:=inherited;
+      tcpupointerdef(result).is_wasm_externref:=is_wasm_externref;
+    end;
+
+
+  function tcpupointerdef.GetTypeName: string;
+    begin
+      result:=inherited;
+      if is_wasm_externref then
+        result:=result+';wasmexternref';
+    end;
+
+
+  function tcpupointerdef.compatible_with_pointerdef_size(ptr: tpointerdef): boolean;
+    begin
+      result:=tcpupointerdef(ptr).is_wasm_externref=is_wasm_externref;
+    end;
+
+
 {****************************************************************************
                              tcpuprocdef
 ****************************************************************************}
@@ -239,7 +324,11 @@ implementation
           for i:=0 to pd.paras.Count-1 do
             begin
               prm := tcpuparavarsym(pd.paras[i]);
-              case prm.paraloc[callerside].Size of
+              if is_wasm_funcref(prm.vardef) then
+                result.add_param(wbt_funcref)
+              else if is_wasm_externref(prm.vardef) then
+                result.add_param(wbt_externref)
+              else case prm.paraloc[callerside].Size of
                 OS_8..OS_32, OS_S8..OS_S32:
                   result.add_param(wbt_i32);
                 OS_64, OS_S64:
@@ -264,16 +353,7 @@ implementation
         begin
           if not defToWasmBasic(pd.returndef,bt) then
             bt:=wbt_i32;
-          case bt of
-            wbt_i64:
-              result.add_result(wbt_i64);
-            wbt_f32:
-              result.add_result(wbt_f32);
-            wbt_f64:
-              result.add_result(wbt_f64);
-          else
-            result.add_result(wbt_i32);
-          end;
+          result.add_result(bt);
         end;
     end;
 
@@ -297,6 +377,41 @@ implementation
     end;
 
 
+  function tcpuprocdef.suspending_wrapper_name: ansistring;
+    begin
+      Result:='__fpc_wasm_suspending_'+procsym.realname;
+    end;
+
+
+  function tcpuprocdef.promising_wrapper_name(last: boolean): ansistring;
+    begin
+      if last then
+        Result:='__fpc_wasm_promising_last_'+procsym.realname
+      else
+        Result:='__fpc_wasm_promising_first_'+procsym.realname;
+    end;
+
+
+  procedure tcpuprocdef.add_promising_export(aextname: ansistring; last: boolean);
+    begin
+      if (synthetickind<>tsk_none) and (synthetickind<>tsk_wasm_promising) then
+        internalerror(2023061301);
+      synthetickind:=tsk_wasm_promising;
+      if last then
+        begin
+          if promising_last_export_name<>'' then
+            internalerror(2023061601);
+          promising_last_export_name:=aextname;
+        end
+      else
+        begin
+          if promising_first_export_name<>'' then
+            internalerror(2023061602);
+          promising_first_export_name:=aextname;
+        end;
+    end;
+
+
 {****************************************************************************
                              tcpuprocvardef
 ****************************************************************************}
@@ -328,7 +443,11 @@ implementation
     function tcpustaticvarsym.try_get_wasm_global_vardef_type(out res: TWasmBasicType): Boolean;
       begin
         Result:=True;
-        if is_64bitint(vardef) then
+        if is_wasm_externref(vardef) then
+          res:=wbt_externref
+        else if is_wasm_funcref(vardef) then
+          res:=wbt_funcref
+        else if is_64bitint(vardef) then
           res:=wbt_i64
         else if is_pointer(vardef) then
           res:=wbt_i32

+ 28 - 1
compiler/wasm32/tgcpu.pas

@@ -83,6 +83,7 @@ unit tgcpu;
          procedure ungettemp(list: TAsmList; const ref : treference); override;
          procedure allocframepointer(list: TAsmList; out ref: treference);
          procedure allocbasepointer(list: TAsmList; out ref: treference);
+         procedure getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref : treference); override;
        end;
 
     function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
@@ -105,7 +106,11 @@ unit tgcpu;
       if not Result then
         Exit;
 
-      if is_pointer(def) then
+      if is_wasm_funcref(def) then
+        wbt := wbt_funcref
+      else if is_wasm_externref(def) then
+        wbt := wbt_externref
+      else if is_pointer(def) then
         wbt := wbt_i32 // wasm32
       else if is_currency(def) then
         wbt := wbt_i64
@@ -235,6 +240,13 @@ unit tgcpu;
             else
               internalerror(2020121801);
           end
+        else if Assigned(def) and is_wasm_reference_type(def) then
+          begin
+            if defToWasmBasic(def, wbt) then
+              allocLocalVarToRef(wbt, ref)
+            else
+              internalerror(2023060701);
+          end
         else
           inherited;
       end;
@@ -284,6 +296,21 @@ unit tgcpu;
         updateFirstTemp;
       end;
 
+    procedure ttgwasm.getlocal(list: TAsmList; size: asizeint; alignment: shortint; def: tdef; var ref : treference);
+      var
+        wbt: TWasmBasicType;
+      begin
+        if is_wasm_reference_type(def) then
+          begin
+            if defToWasmBasic(def, wbt) then
+              allocLocalVarToRef(wbt, ref)
+            else
+              internalerror(2023060703);
+          end
+        else
+          inherited;
+      end;
+
     function TWasmLocalVars.alloc(bt: TWasmBasicType): integer;
       var
         i : integer;

+ 30 - 2
compiler/x86/aasmcpu.pas

@@ -659,6 +659,8 @@ interface
     function get_ref_address_size(const ref:treference):byte;
     function get_default_segment_of_ref(const ref:treference):tregister;
     procedure optimize_ref(var ref:treference; inlineasm: boolean);
+    { returns true if opcode can be used with one memory operand without size }
+    function NoMemorySizeRequired(opcode : TAsmOp) : Boolean;
 
     function spilling_create_load(const ref:treference;r:tregister):Taicpu;
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
@@ -2490,9 +2492,9 @@ implementation
           (0, 1, 2, 3, 6, 7, 5, 4);
         maxsupreg: array[tregistertype] of tsuperregister=
 {$ifdef x86_64}
-          (0, 16, 9, 8, 32, 32, 8, 0, 0, 0);
+          (0, 16, 9, 8, 32, 32, 8, 0, 0, 0, 0, 0);
 {$else x86_64}
-          (0,  8, 9, 8,  8, 32, 8, 0, 0, 0);
+          (0,  8, 9, 8,  8, 32, 8, 0, 0, 0, 0, 0);
 {$endif x86_64}
       var
         rs: tsuperregister;
@@ -5581,6 +5583,32 @@ implementation
       end;
     end;
 
+
+    function NoMemorySizeRequired(opcode : TAsmOp) : Boolean;
+      var
+        i : LongInt;
+        insentry  : PInsEntry;
+      begin
+        result:=false;
+        i:=instabcache^[opcode];
+        if i=-1 then
+         begin
+           Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]);
+           exit;
+         end;
+        insentry:=@instab[i];
+        while (insentry^.opcode=opcode) do
+         begin
+           if (insentry^.ops=1) and (insentry^.optypes[0]=OT_MEMORY) then
+             begin
+               result:=true;
+               exit;
+             end;
+           inc(insentry);
+         end;
+      end;
+
+
     procedure InitAsm;
       begin
         build_spilling_operation_type_table;

+ 30 - 0
compiler/x86/agx86att.pas

@@ -521,6 +521,20 @@ interface
             dollarsign: '$';
           );
 
+       as_x86_64_clang_gas_info : tasminfo =
+          (
+            id     : as_clang_gas;
+            idtxt  : 'AS-CLANG';
+            asmbin : 'clang';
+            asmcmd : '-x assembler -c -target $TRIPLET -o $OBJ $EXTRAOPT -x assembler $ASM';
+            supported_targets : [system_x86_64_linux, system_x86_64_freebsd, system_x86_64_netbsd, system_x86_64_openbsd];
+            flags : [af_needar,af_smartlink_sections,af_supports_dwarf,af_llvm,af_supports_hlcfi];
+            labelprefix : '.L';
+            labelmaxlen : -1;
+            comment : '// ';
+            dollarsign: '$';
+          );
+
 {$else x86_64}
        as_i386_as_info : tasminfo =
           (
@@ -600,6 +614,20 @@ interface
             dollarsign: '$';
           );
 
+       as_i386_clang_gas_info : tasminfo =
+          (
+            id     : as_clang_gas;
+            idtxt  : 'AS-CLANG';
+            asmbin : 'clang';
+            asmcmd : '-x assembler -c -target $TRIPLET -o $OBJ $EXTRAOPT -x assembler $ASM';
+            supported_targets : [system_i386_linux, system_i386_freebsd, system_i386_netbsd, system_i386_openbsd];
+            flags : [af_needar,af_smartlink_sections,af_supports_dwarf,af_llvm,af_supports_hlcfi];
+            labelprefix : '.L';
+            labelmaxlen : -1;
+            comment : '// ';
+            dollarsign: '$';
+          );
+
        as_i386_gas_info : tasminfo =
           (
             id     : as_ggas;
@@ -641,6 +669,7 @@ initialization
   RegisterAssembler(as_x86_64_gas_info,Tx86ATTAssembler);
   RegisterAssembler(as_x86_64_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_x86_64_clang_darwin_info,Tx86AppleGNUAssembler);
+  RegisterAssembler(as_x86_64_clang_gas_info,Tx86ATTAssembler);
   RegisterAssembler(as_x86_64_solaris_info,Tx86ATTAssembler);
 {$else x86_64}
   RegisterAssembler(as_i386_as_info,Tx86ATTAssembler);
@@ -648,6 +677,7 @@ initialization
   RegisterAssembler(as_i386_yasm_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_i386_clang_darwin_info,Tx86AppleGNUAssembler);
+  RegisterAssembler(as_i386_clang_gas_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_as_aout_info,Tx86AoutGNUAssembler);
   RegisterAssembler(as_i386_solaris_info,Tx86ATTAssembler);
 {$endif x86_64}

+ 115 - 26
compiler/x86/aoptx86.pas

@@ -2254,12 +2254,22 @@ unit aoptx86;
                 exit;
               end;
 
-            if GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
+            if GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) and
+              (hp1.typ = ait_instruction) and
+              (
+                { Under -O2 and below, the instructions are always adjacent }
+                not (cs_opt_level3 in current_settings.optimizerswitches) or
+                (taicpu(hp1).ops <= 1) or
+                not RegInOp(taicpu(p).oper[0]^.reg, taicpu(hp1).oper[1]^) or
+                { If reg1 = reg3, reg1 must not be modified in between }
+                not RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)
+              ) then
               begin
                 if MatchInstruction(hp1,[taicpu(p).opcode],[S_NO]) and
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   begin
                     { vmova* reg1,reg2
+                      ...
                       vmova* reg2,reg3
                       dealloc reg2
                       =>
@@ -2267,16 +2277,22 @@ unit aoptx86;
                     TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     if MatchOpType(taicpu(hp1),top_reg,top_reg) and
+                      not RegUsedBetween(taicpu(hp1).oper[1]^.reg, p, hp1) and
                       not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
                       begin
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVA*2(V)MOVA* 1',p);
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
+
+                        TransferUsedRegs(TmpUsedRegs);
+                        AllocRegBetween(taicpu(hp1).oper[1]^.reg, p, hp1, TmpUsedRegs);
+
                         RemoveInstruction(hp1);
                         result:=true;
                         exit;
                       end;
                     { special case:
                       vmova* reg1,<op>
+                      ...
                       vmova* <op>,reg1
                       =>
                       vmova* reg1,<op> }
@@ -2299,10 +2315,11 @@ unit aoptx86;
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   begin
                     { vmova* reg1,reg2
+                      ...
                       vmovs* reg2,<op>
                       dealloc reg2
                       =>
-                      vmovs* reg1,reg3 }
+                      vmovs* reg1,<op> }
                     TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegsBetween(TmpUsedRegs, p, hp1);
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
@@ -2310,14 +2327,16 @@ unit aoptx86;
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVS*2(V)MOVS* 1',p);
                         taicpu(p).opcode:=taicpu(hp1).opcode;
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
+
+                        TransferUsedRegs(TmpUsedRegs);
+                        AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, TmpUsedRegs);
+
                         RemoveInstruction(hp1);
                         result:=true;
                         exit;
                       end
                   end;
-              end;
-          if GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
-            begin
+
               if MatchInstruction(hp1,[A_VFMADDPD,
                                               A_VFMADD132PD,
                                               A_VFMADD132PS,
@@ -5313,7 +5332,6 @@ unit aoptx86;
         { Search for:
             test  $x,(reg/ref)
             jne   @lbl1
-            ...
             test  $y,(reg/ref) (same register or reference)
             jne   @lbl1
 
@@ -5481,6 +5499,16 @@ unit aoptx86;
                         (FirstValue = -1) or
                         (SecondValue = -1) or
                         MatchOperand(taicpu(hp1_dist).oper[0]^, taicpu(hp1).oper[0]^)
+                      ) and
+                      (
+                        { In this situation, the TEST/JNE pairs must be adjacent (fixes #40366) }
+
+                        { Always adjacent under -O2 and under }
+                        not(cs_opt_level3 in current_settings.optimizerswitches) or
+                        (
+                          GetNextInstruction(hp1, hp1_last) and
+                          (hp1_last = p_dist)
+                        )
                       ) then
                       begin
                         { Same jump location... can be a register since nothing's changed }
@@ -5492,15 +5520,29 @@ unit aoptx86;
                         if IsJumpToLabel(taicpu(hp1_dist)) then
                           TAsmLabel(taicpu(hp1_dist).oper[0]^.ref^.symbol).DecRefs;
 
-                        DebugMsg(SPeepholeOptimization + 'TEST/JNE/TEST/JNE merged', p);
-                        RemoveInstruction(hp1_dist);
-
                         { Only remove the second test if no jumps or other conditional instructions follow }
                         TransferUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
                         UpdateUsedRegs(TmpUsedRegs, tai(hp1.Next));
-                        if not RegUsedAfterInstruction(NR_DEFAULTFLAGS, p_dist, TmpUsedRegs) then
-                          RemoveInstruction(p_dist);
+                        UpdateUsedRegs(TmpUsedRegs, tai(p_dist.Next));
+                        if not RegUsedAfterInstruction(NR_DEFAULTFLAGS, hp1_dist, TmpUsedRegs) then
+                          begin
+                            DebugMsg(SPeepholeOptimization + 'TEST/JNE/TEST/JNE merged', p);
+                            RemoveInstruction(p_dist);
+
+                            { Remove the first jump, not the second, to keep
+                              any register deallocations between the second
+                              TEST/JNE pair in the same place.  Aids future
+                              optimisation. }
+                            RemoveInstruction(hp1);
+                          end
+                        else
+                          begin
+                            DebugMsg(SPeepholeOptimization + 'TEST/JNE/TEST/JNE merged (second TEST preserved)', p);
+
+                            { Remove second jump in this instance }
+                            RemoveInstruction(hp1_dist);
+                          end;
 
                         Result := True;
                         Exit;
@@ -11714,6 +11756,10 @@ unit aoptx86;
 
         ConstRegs: array[0..MAX_CMOV_REGISTERS - 1] of TRegister;
         ConstVals: array[0..MAX_CMOV_REGISTERS - 1] of TCGInt;
+        ConstSizes: array[0..MAX_CMOV_REGISTERS - 1] of TSubRegister; { May not match ConstRegs if one is shared over multiple CMOVs. }
+        ConstMovs: array[0..MAX_CMOV_REGISTERS - 1] of tai; { Location of initialisation instruction }
+
+        ConstWriteSizes: array[0..first_int_imreg - 1] of TSubRegister; { Largest size of register written. }
 
         { Tries to convert a mov const,%reg instruction into a CMOV by reserving a
           new register to store the constant }
@@ -11721,7 +11767,7 @@ unit aoptx86;
           var
             RegSize: TSubRegister;
             CurrentVal: TCGInt;
-            NewReg: TRegister;
+            ANewReg: TRegister;
             X: ShortInt;
           begin
             Result := False;
@@ -11739,8 +11785,10 @@ unit aoptx86;
                 RegSize := R_SUBW;
               S_L:
                 RegSize := R_SUBD;
+{$ifdef x86_64}
               S_Q:
                 RegSize := R_SUBQ;
+{$endif x86_64}
               else
                 InternalError(2021100401);
             end;
@@ -11751,6 +11799,7 @@ unit aoptx86;
               if ConstVals[X] = CurrentVal then
                 begin
                   ConstRegs[StoredCount] := ConstRegs[X];
+                  ConstSizes[StoredCount] := RegSize;
                   ConstVals[StoredCount] := CurrentVal;
                   Result := True;
 
@@ -11759,16 +11808,17 @@ unit aoptx86;
                   Exit;
                 end;
 
-            NewReg := GetIntRegisterBetween(RegSize, TmpUsedRegs, search_start_p, stop_search_p, True);
-            if NewReg = NR_NO then
+            ANewReg := GetIntRegisterBetween(R_SUBWHOLE, TmpUsedRegs, search_start_p, stop_search_p, True);
+            if ANewReg = NR_NO then
               { No free registers }
               Exit;
 
             { Reserve the register so subsequent TryCMOVConst calls don't all end
               up vying for the same register }
-            IncludeRegInUsedRegs(NewReg, TmpUsedRegs);
+            IncludeRegInUsedRegs(ANewReg, TmpUsedRegs);
 
-            ConstRegs[StoredCount] := NewReg;
+            ConstRegs[StoredCount] := ANewReg;
+            ConstSizes[StoredCount] := RegSize;
             ConstVals[StoredCount] := CurrentVal;
 
             Inc(StoredCount);
@@ -12054,7 +12104,7 @@ unit aoptx86;
                   Result:=true;
                   exit;
                 end
-              else if (CPUX86_HAS_CMOV in cpu_capabilities[current_settings.optimizecputype]) and
+              else if (CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype]) and
                 MatchInstruction(hp1,A_MOV,[S_W,S_L{$ifdef x86_64},S_Q{$endif x86_64}]) then
                 begin
                  { check for
@@ -12239,10 +12289,13 @@ unit aoptx86;
                      l := 0;
                      c := 0;
 
-                     { Initialise RegWrites, ConstRegs and ConstVals }
+                     { Initialise RegWrites, ConstRegs, ConstVals, ConstSizes, ConstWriteSizes and ConstMovs }
                      FillChar(RegWrites[0], MAX_CMOV_INSTRUCTIONS * 2 * SizeOf(TRegister), 0);
                      FillChar(ConstRegs[0], MAX_CMOV_REGISTERS * SizeOf(TRegister), 0);
                      FillChar(ConstVals[0], MAX_CMOV_REGISTERS * SizeOf(TCGInt), 0);
+                     FillChar(ConstSizes[0], MAX_CMOV_REGISTERS * SizeOf(TSubRegister), 0);
+                     FillChar(ConstWriteSizes[0], first_int_imreg * SizeOf(TOpSize), 0);
+                     FillChar(ConstMovs[0], MAX_CMOV_REGISTERS * SizeOf(taicpu), 0);
 
                      RefModified := False;
                      while assigned(hp1) and
@@ -12338,7 +12391,7 @@ unit aoptx86;
                                           below) }
                                         if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                           begin
-                                            hp_new := taicpu.op_const_reg(A_MOV, taicpu(hp1).opsize, taicpu(hp1).oper[0]^.val, ConstRegs[x]);
+                                            hp_new := taicpu.op_const_reg(A_MOV, subreg2opsize(R_SUBWHOLE), taicpu(hp1).oper[0]^.val, ConstRegs[X]);
                                             taicpu(hp_new).fileinfo := taicpu(hp_prev).fileinfo;
 
                                             asml.InsertBefore(hp_new, hp_flagalloc);
@@ -12346,14 +12399,20 @@ unit aoptx86;
                                               TrySwapMovOp(hp_prev2, hp_new);
 
                                             IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                            ConstMovs[X] := hp_new;
                                           end
                                         else
                                         { We just need an instruction between hp_prev and hp1
                                           where we know the register is marked as in use }
                                           hp_new := hpmov1;
 
+                                        { Keep track of largest write for this register so it can be optimised later }
+                                        if (getsubreg(taicpu(hp1).oper[1]^.reg) > ConstWriteSizes[getsupreg(ConstRegs[X])]) then
+                                          ConstWriteSizes[getsupreg(ConstRegs[X])] := getsubreg(taicpu(hp1).oper[1]^.reg);
+
                                         AllocRegBetween(ConstRegs[x], hp_new, hp1, UsedRegs);
-                                        taicpu(hp1).loadreg(0, ConstRegs[x]);
+                                        taicpu(hp1).loadreg(0, newreg(R_INTREGISTER, getsupreg(ConstRegs[X]), ConstSizes[X]));
                                         Inc(x);
                                       end;
 
@@ -12365,6 +12424,14 @@ unit aoptx86;
                                 GetNextInstruction(hp1, hp1);
                               until (hp1 = hp_lblxxx);
 
+                              { Update initialisation MOVs to the smallest possible size }
+                              for c := 0 to x - 1 do
+                                if Assigned(ConstMovs[c]) then
+                                  begin
+                                    taicpu(ConstMovs[c]).opsize := subreg2opsize(ConstWriteSizes[Word(ConstRegs[c])]);
+                                    setsubreg(taicpu(ConstMovs[c]).oper[1]^.reg, ConstWriteSizes[Word(ConstRegs[c])]);
+                                  end;
+
                               hp2 := hp_lblxxx;
                               repeat
                                 if not Assigned(hp2) then
@@ -12591,7 +12658,8 @@ unit aoptx86;
                                         RegMatch := False;
 
                                         for x := 0 to c - 1 do
-                                          if (ConstVals[x] = taicpu(hp1).oper[0]^.val) then
+                                          if (ConstVals[x] = taicpu(hp1).oper[0]^.val) and
+                                            (getsubreg(taicpu(hp1).oper[1]^.reg) = ConstSizes[X]) then
                                             begin
                                               RegMatch := True;
 
@@ -12602,20 +12670,26 @@ unit aoptx86;
                                                 below) }
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                                 begin
-                                                  hp_new := taicpu.op_const_reg(A_MOV, taicpu(hp1).opsize, taicpu(hp1).oper[0]^.val, ConstRegs[x]);
+                                                  hp_new := taicpu.op_const_reg(A_MOV, subreg2opsize(R_SUBWHOLE), taicpu(hp1).oper[0]^.val, ConstRegs[X]);
                                                   asml.InsertBefore(hp_new, hp_flagalloc);
                                                   if Assigned(hp_prev2) then
                                                     TrySwapMovOp(hp_prev2, hp_new);
 
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                                  ConstMovs[X] := hp_new;
                                                 end
                                               else
                                                 { We just need an instruction between hp_prev and hp1
                                                   where we know the register is marked as in use }
                                                 hp_new := hpmov2;
 
+                                              { Keep track of largest write for this register so it can be optimised later }
+                                              if (getsubreg(taicpu(hp1).oper[1]^.reg) > ConstWriteSizes[getsupreg(ConstRegs[X])]) then
+                                                ConstWriteSizes[getsupreg(ConstRegs[X])] := getsubreg(taicpu(hp1).oper[1]^.reg);
+
                                               AllocRegBetween(ConstRegs[x], hp_new, hp1, UsedRegs);
-                                              taicpu(hp1).loadreg(0, ConstRegs[x]);
+                                              taicpu(hp1).loadreg(0, newreg(R_INTREGISTER, getsupreg(ConstRegs[X]), ConstSizes[X]));
                                               Break;
                                             end;
 
@@ -12673,7 +12747,8 @@ unit aoptx86;
                                         RegMatch := False;
 
                                         for x := 0 to c - 1 do
-                                          if (ConstVals[x] = taicpu(hp1).oper[0]^.val) then
+                                          if (ConstVals[x] = taicpu(hp1).oper[0]^.val) and
+                                            (getsubreg(taicpu(hp1).oper[1]^.reg) = ConstSizes[X]) then
                                             begin
                                               RegMatch := True;
 
@@ -12684,20 +12759,26 @@ unit aoptx86;
                                                 below) }
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                                 begin
-                                                  hp_new := taicpu.op_const_reg(A_MOV, taicpu(hp1).opsize, taicpu(hp1).oper[0]^.val, ConstRegs[x]);
+                                                  hp_new := taicpu.op_const_reg(A_MOV, subreg2opsize(R_SUBWHOLE), taicpu(hp1).oper[0]^.val, ConstRegs[X]);
                                                   asml.InsertBefore(hp_new, hp_flagalloc);
                                                   if Assigned(hp_prev2) then
                                                     TrySwapMovOp(hp_prev2, hp_new);
 
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                                  ConstMovs[X] := hp_new;
                                                 end
                                               else
                                                 { We just need an instruction between hp_prev and hp1
                                                   where we know the register is marked as in use }
                                                 hp_new := hpmov1;
 
+                                              { Keep track of largest write for this register so it can be optimised later }
+                                              if (getsubreg(taicpu(hp1).oper[1]^.reg) > ConstWriteSizes[getsupreg(ConstRegs[X])]) then
+                                                ConstWriteSizes[getsupreg(ConstRegs[X])] := getsubreg(taicpu(hp1).oper[1]^.reg);
+
                                               AllocRegBetween(ConstRegs[x], hp_new, hp1, UsedRegs);
-                                              taicpu(hp1).loadreg(0, ConstRegs[x]);
+                                              taicpu(hp1).loadreg(0, newreg(R_INTREGISTER, getsupreg(ConstRegs[X]), ConstSizes[X]));
                                               Break;
                                             end;
 
@@ -12712,6 +12793,14 @@ unit aoptx86;
                                 GetNextInstruction(hp1, hp1);
                               until (hp1 = hp_jump); { Stop at the jump, not lbl xxx }
 
+                              { Update initialisation MOVs to the smallest possible size }
+                              for x := 0 to c - 1 do
+                                if Assigned(ConstMovs[x]) then
+                                  begin
+                                    taicpu(ConstMovs[x]).opsize := subreg2opsize(ConstWriteSizes[Word(ConstRegs[x])]);
+                                    setsubreg(taicpu(ConstMovs[x]).oper[1]^.reg, ConstWriteSizes[Word(ConstRegs[x])]);
+                                  end;
+
                               UpdateUsedRegs(tai(hp_jump.next));
                               UpdateUsedRegs(tai(hp_lblyyy.next));
 

+ 10 - 3
compiler/x86/cpubase.pas

@@ -338,6 +338,7 @@ topsize2memsize: array[topsize] of integer =
 
     function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
     function reg2opsize(r:Tregister):topsize;
+    function subreg2opsize(sr : tsubregister):topsize;
     function reg_cgsize(const reg: tregister): tcgsize;
     function is_calljmp(o:tasmop):boolean;
     function is_calljmpuncondret(o:tasmop):boolean;
@@ -521,15 +522,21 @@ implementation
         end;
 
 
-    function reg2opsize(r:Tregister):topsize;
+    function subreg2opsize(sr : tsubregister):topsize;
       const
-        subreg2opsize : array[tsubregister] of topsize =
+        _subreg2opsize : array[tsubregister] of topsize =
           (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
+      begin
+        result:=_subreg2opsize[sr];
+      end;
+
+
+    function reg2opsize(r:Tregister):topsize;
       begin
         reg2opsize:=S_L;
         case getregtype(r) of
           R_INTREGISTER :
-            reg2opsize:=subreg2opsize[getsubreg(r)];
+            reg2opsize:=subreg2opsize(getsubreg(r));
           R_FPUREGISTER :
             reg2opsize:=S_FL;
           R_MMXREGISTER,

+ 3 - 3
compiler/x86/nx86set.pas

@@ -723,10 +723,10 @@ implementation
                   hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u32inttype,true);
                   register_maybe_adjust_setbase(current_asmdata.CurrAsmList,u32inttype,left.location,setbase);
 
-                  if (tcgsize2size[right.location.size] < 4) or
+                  if (tcgsize2size[right.location.size] < opdef.size) or
                     (right.location.loc = LOC_CONSTANT) or
                     { bt ...,[mem] is slow, see #40039, so try to use a register if we are not optimizing for size }
-                    ((right.resultdef.size<=sizeof(aint)) and not(cs_opt_size in current_settings.optimizerswitches)) then
+                    ((right.resultdef.size<=u32inttype.size) and not(cs_opt_size in current_settings.optimizerswitches)) then
                     hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,u32inttype,true);
 
                   hreg:=left.location.register;
@@ -971,7 +971,7 @@ implementation
 
                   if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
                     { bt ...,[mem] is slow, see #40039, so try to use a register if we are not optimizing for size }
-                    ((right.resultdef.size<=sizeof(aint)) and not(cs_opt_size in current_settings.optimizerswitches)) then
+                    ((right.resultdef.size<=opdef.size) and not(cs_opt_size in current_settings.optimizerswitches)) then
                     hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,opdef,true);
 
                   pleftreg:=left.location.register;

+ 12 - 1
compiler/x86/rax86.pas

@@ -436,10 +436,11 @@ begin
   Opsize:=S_NO;
 end;
 
-procedure Tx86Instruction.AddReferenceSizes;
 { this will add the sizes for references like [esi] which do not
   have the size set yet, it will take only the size if the other
   operand is a register }
+procedure Tx86Instruction.AddReferenceSizes;
+
 var
   operand2,i,j,k : longint;
   s : tasmsymbol;
@@ -1400,6 +1401,16 @@ begin
                    begin
                      if opsize<>S_NO then
                        tx86operand(operands[i]).opsize:=opsize
+                     else if not(NoMemorySizeRequired(opcode) or
+                       (opcode=A_JMP) or (opcode=A_JCC) or (opcode=A_CALL) or (opcode=A_LCALL) or (opcode=A_LJMP)) then
+                       begin
+                         if (m_delphi in current_settings.modeswitches) then
+                           Message(asmr_w_unable_to_determine_reference_size_using_dword)
+                         else
+                           Message(asmr_e_unable_to_determine_reference_size);
+                         { recovery }
+                         tx86operand(operands[i]).opsize:=S_L;
+                       end;
                    end;
                 end;
               OPR_SYMBOL :

+ 145 - 30
compiler/x86/rax86att.pas

@@ -207,7 +207,105 @@ Implementation
            end;
         end;
 
+      procedure Consume_Index;
 
+        procedure Check_Scaling;
+          begin
+            { check for scaling ... }
+            case actasmtoken of
+              AS_RPAREN:
+                Begin
+                  Consume_RParen;
+                  exit;
+                end;
+              AS_COMMA:
+                Begin
+                  Consume(AS_COMMA);
+                  Consume_Scale;
+                  Consume_RParen;
+                end;
+            else
+              Begin
+                Message(asmr_e_invalid_reference_syntax);
+                RecoverConsume(false);
+              end;
+            end; { end case }
+          end;
+
+        var
+          tmp : tx86operand;
+          expr : string;
+        begin
+          if actasmtoken=AS_REGISTER then
+           Begin
+             oper.opr.ref.index:=actasmregister;
+             Consume(AS_REGISTER);
+             Check_Scaling;
+           end
+          else if actasmtoken=AS_ID then
+            begin
+              expr:=actasmpattern;
+              Consume(AS_ID);
+              tmp:=Tx86Operand.create;
+              if not tmp.SetupVar(expr,false) then
+                begin
+                  { look for special symbols ... }
+                  if expr= '__HIGH' then
+                    begin
+                      consume(AS_LPAREN);
+                      if not tmp.setupvar('high'+actasmpattern,false) then
+                        Message1(sym_e_unknown_id,'high'+actasmpattern);
+                      consume(AS_ID);
+                      consume(AS_RPAREN);
+                    end
+                  else
+                    if expr = '__SELF' then
+                      tmp.SetupSelf
+                  else
+                    begin
+                      message1(sym_e_unknown_id,expr);
+                      RecoverConsume(false);
+                      tmp.free;
+                      Exit;
+                    end;
+                end;
+              { convert OPR_LOCAL register para into a reference base }
+              if (tmp.opr.typ=OPR_LOCAL) and
+                 AsmRegisterPara(tmp.opr.localsym) then
+                begin
+                  tmp.InitRefConvertLocal;
+                  if (tmp.opr.ref.index<>NR_NO) or
+                      (tmp.opr.ref.offset<>0) or
+                      (tmp.opr.ref.scalefactor<>0) or
+                      (tmp.opr.ref.segment<>NR_NO) or
+                      (tmp.opr.ref.base=NR_NO) then
+                    begin
+                      message(asmr_e_invalid_reference_syntax);
+                      RecoverConsume(false);
+                      tmp.free;
+                      Exit;
+                    end;
+                  oper.opr.ref.index:=tmp.opr.ref.base;
+                  tmp.free;
+                  Check_Scaling;
+                end
+              else
+                begin
+                  message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                  tmp.free;
+                  Exit;
+                end;
+            end
+          else
+           Begin
+             Message(asmr_e_invalid_reference_syntax);
+             RecoverConsume(false);
+           end;
+        end;
+
+      var
+        expr : string;
       begin
         oper.InitRef;
         Consume(AS_LPAREN);
@@ -244,7 +342,7 @@ Implementation
                 oper.opr.ref.refaddr:=addr_pic_no_got;
 {$endif x86_64}
               Consume(AS_REGISTER);
-              { can either be a register or a right parenthesis }
+              { can either be a register, an identifier or a right parenthesis }
               { (reg)        }
               if actasmtoken=AS_RPAREN then
                Begin
@@ -253,36 +351,53 @@ Implementation
                end;
               { (reg,reg ..  }
               Consume(AS_COMMA);
-              if actasmtoken=AS_REGISTER then
-               Begin
-                 oper.opr.ref.index:=actasmregister;
-                 Consume(AS_REGISTER);
-                 { check for scaling ... }
-                 case actasmtoken of
-                   AS_RPAREN:
-                     Begin
-                       Consume_RParen;
-                       exit;
-                     end;
-                   AS_COMMA:
-                     Begin
-                       Consume(AS_COMMA);
-                       Consume_Scale;
-                       Consume_RParen;
-                     end;
-                 else
-                   Begin
-                     Message(asmr_e_invalid_reference_syntax);
-                     RecoverConsume(false);
-                   end;
-                 end; { end case }
-               end
-              else
-               Begin
-                 Message(asmr_e_invalid_reference_syntax);
-                 RecoverConsume(false);
-               end;
+              Consume_Index;
             end; {end case }
+          AS_ID: { identifier (parameter, variable, ...), but only those that might be in a register }
+            begin
+              expr:=actasmpattern;
+              Consume(AS_ID);
+              if not oper.SetupVar(expr,false) then
+                begin
+                  { look for special symbols ... }
+                  if expr= '__HIGH' then
+                    begin
+                      consume(AS_LPAREN);
+                      if not oper.setupvar('high'+actasmpattern,false) then
+                        Message1(sym_e_unknown_id,'high'+actasmpattern);
+                      consume(AS_ID);
+                      consume(AS_RPAREN);
+                    end
+                  else
+                    if expr = '__SELF' then
+                      oper.SetupSelf
+                  else
+                    begin
+                      message1(sym_e_unknown_id,expr);
+                      RecoverConsume(false);
+                      Exit;
+                    end;
+                end;
+              { convert OPR_LOCAL register para into a reference base }
+              if (oper.opr.typ=OPR_LOCAL) and
+                 AsmRegisterPara(oper.opr.localsym) then
+                oper.InitRefConvertLocal
+              else
+                begin
+                  message(asmr_e_invalid_reference_syntax);
+                  RecoverConsume(false);
+                  Exit;
+                end;
+              { can either be a register, an identifier or a right parenthesis }
+              { (reg)        }
+              if actasmtoken=AS_RPAREN then
+                begin
+                  Consume_RParen;
+                  exit;
+                end;
+              Consume(AS_COMMA);
+              Consume_Index;
+            end;
           AS_COMMA: { (, ...  can either be scaling, or index }
             Begin
               Consume(AS_COMMA);

+ 2 - 2
compiler/x86/rax86int.pas

@@ -1713,7 +1713,7 @@ Unit Rax86int;
         BuildConstSymbolExpression([],l,hs,hssymtyp,size,out_flags);
         if hs<>'' then
          Message(asmr_e_relocatable_symbol_not_allowed);
-        BuildConstExpression:=l;
+        BuildConstExpression:=aint(l);
       end;
 
 
@@ -1731,7 +1731,7 @@ Unit Rax86int;
         BuildConstSymbolExpression(in_flags,l,hs,hssymtyp,size,out_flags);
         if hs<>'' then
          Message(asmr_e_relocatable_symbol_not_allowed);
-        BuildRefConstExpression:=l;
+        BuildRefConstExpression:=aint(l);
       end;
 
 

+ 5 - 3
compiler/x86_64/cpupara.pas

@@ -1650,10 +1650,11 @@ unit cpupara;
         locidx,
         i,j,
         varalign,
+        procparaalign,
         paraalign  : longint;
         use_ms_abi : boolean;
       begin
-        paraalign:=get_para_align(p.proccalloption);
+        procparaalign:=get_para_align(p.proccalloption);
         use_ms_abi:=x86_64_use_ms_abi(p.proccalloption);
         { Register parameters are assigned from left to right }
         for i:=0 to paras.count-1 do
@@ -1695,6 +1696,7 @@ unit cpupara;
                 paralen:=sizeof(pint);
                 paradef:=cpointerdef.getreusable_no_free(paradef);
                 paralocdef:=paradef;
+                paraalign:=procparaalign;
                 loc[0].def:=paralocdef;
                 loc[1].def:=nil;
                 for j:=2 to high(loc) do
@@ -1707,7 +1709,7 @@ unit cpupara;
               begin
                 getvalueparaloc(p.proccalloption,hp.varspez,paralocdef,loc);
                 paralen:=push_size(hp.varspez,paralocdef,p.proccalloption);
-                paraalign:=max(paraalign,paradef.alignment);
+                paraalign:=max(procparaalign,paradef.alignment);
                 if p.proccalloption = pocall_vectorcall then
                   begin
                     { TODO: Can this set of instructions be put into 'defutil' without it relying on the argument classification? [Kit] }
@@ -1990,7 +1992,7 @@ unit cpupara;
                           else
                             paraloc^.reference.index:=NR_FRAME_POINTER_REG;
                           varalign:=used_align(size_2_align(paralen),paraalign,paraalign);
-                          paraloc^.reference.offset:=parasize;
+                          paraloc^.reference.offset:=align(parasize,varalign);
                           parasize:=align(parasize+paralen,varalign);
                           paralen:=0;
                         end;

Některé soubory nejsou zobrazeny, neboť je v těchto rozdílových datech změněno mnoho souborů