Browse Source

Merge branch 'main' into wasm_goto

Nikolay Nikolov 1 year ago
parent
commit
b713a64504
100 changed files with 6504 additions and 3484 deletions
  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
 *.app
 *.ttp
 *.ttp
 *.prg
 *.prg
+*.compiled
 fpcmade.*
 fpcmade.*
 *-stamp.*
 *-stamp.*
 build-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
            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.
            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
             (result.def.size<8) and is_ordinal(result.def) then
            begin
            begin
              result.location^.size:=OS_64;
              result.location^.size:=OS_64;

+ 1 - 1
compiler/cfileutl.pas

@@ -70,7 +70,7 @@ interface
 
 
       TCachedSearchRec = record
       TCachedSearchRec = record
         Name       : TCmdStr;
         Name       : TCmdStr;
-        Attr       : byte;
+        Attr       : longint;
         Pattern    : TCmdStr;
         Pattern    : TCmdStr;
         CachedDir  : TCachedDirectory;
         CachedDir  : TCachedDirectory;
         EntryIndex : longint;
         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) }
         { used on llvm for tracking metadata (every unique metadata has its own base register) }
         R_METADATAREGISTER,{ = 8 }
         R_METADATAREGISTER,{ = 8 }
         { optional MAC16 (16 bit multiply-accumulate) registers on Xtensa }
         { 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)
         { do not add more than 16 elements (ifdef by cpu type if needed)
           so we can store this in one nibble and pack TRegister
           so we can store this in one nibble and pack TRegister

+ 12 - 26
compiler/comphook.pas

@@ -34,31 +34,6 @@ uses
   globtype,
   globtype,
   finput;
   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
 const
   { RHIDE expect gcc like error output }
   { RHIDE expect gcc like error output }
   fatalstr      : string[6] = 'Fatal:';
   fatalstr      : string[6] = 'Fatal:';
@@ -69,6 +44,7 @@ const
   warningerrorstr    : string[29] = 'Warning: (treated as error)';
   warningerrorstr    : string[29] = 'Warning: (treated as error)';
   noteerrorstr       : string[27] = 'Note: (treated as error)';
   noteerrorstr       : string[27] = 'Note: (treated as error)';
   hinterrorstr       : string[27] = 'Hint: (treated as error)';
   hinterrorstr       : string[27] = 'Hint: (treated as error)';
+
 type
 type
   PCompilerStatus = ^TCompilerStatus;
   PCompilerStatus = ^TCompilerStatus;
   TCompilerStatus = record
   TCompilerStatus = record
@@ -334,8 +310,18 @@ begin
         MsgTypeStr:=errorstr;
         MsgTypeStr:=errorstr;
       if (status.verbosity and Level)=V_Fatal then
       if (status.verbosity and Level)=V_Fatal then
         MsgTypeStr:=fatalstr;
         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);
         MsgTypeStr:=PadSpace('('+status.currentmodule+')',10);
+
     end
     end
   else
   else
     begin
     begin

+ 83 - 21
compiler/cresstr.pas

@@ -34,7 +34,7 @@ uses
    SysUtils,
    SysUtils,
    cclasses,widestr,
    cclasses,widestr,
    cutils,globtype,globals,systems,
    cutils,globtype,globals,systems,
-   symbase,symconst,symtype,symdef,symsym,symtable,
+   symbase,symconst,symtype,defutil, symdef,symsym,symtable,
    verbose,fmodule,ppu,
    verbose,fmodule,ppu,
    aasmtai,aasmdata,aasmcnst,
    aasmtai,aasmdata,aasmcnst,
    aasmcpu;
    aasmcpu;
@@ -44,9 +44,11 @@ uses
       TResourceStringItem = class(TLinkedListItem)
       TResourceStringItem = class(TLinkedListItem)
         Sym   : TConstSym;
         Sym   : TConstSym;
         Name  : String;
         Name  : String;
-        Value : Pchar;
-        Len   : Longint;
+        AValue : PAnsiChar;
+        WValue : pcompilerwidestring; // just a reference, do not free.
+        Len   : Longint; // in bytes, not characters
         hash  : Cardinal;
         hash  : Cardinal;
+        isUnicode : Boolean;
         constructor Create(asym:TConstsym);
         constructor Create(asym:TConstsym);
         destructor  Destroy;override;
         destructor  Destroy;override;
         procedure CalcHash;
         procedure CalcHash;
@@ -71,33 +73,67 @@ uses
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
     constructor TResourceStringItem.Create(asym:TConstsym);
     constructor TResourceStringItem.Create(asym:TConstsym);
+
+    var
+      pw : pcompilerwidestring;
+      t : TDef;
+
       begin
       begin
         inherited Create;
         inherited Create;
         Sym:=Asym;
         Sym:=Asym;
         Name:=lower(asym.owner.name^+'.'+asym.Name);
         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;
         CalcHash;
       end;
       end;
 
 
 
 
     destructor TResourceStringItem.Destroy;
     destructor TResourceStringItem.Destroy;
       begin
       begin
-        FreeMem(Value);
+        if Assigned(AValue) then
+          FreeMem(AValue);
       end;
       end;
 
 
 
 
     procedure TResourceStringItem.CalcHash;
     procedure TResourceStringItem.CalcHash;
       Var
       Var
         g : Cardinal;
         g : Cardinal;
-        I : longint;
+        llen,wlen,I : longint;
+        P : PByte;
+        pc : PAnsiChar;
+
       begin
       begin
+        pc:=nil;
         hash:=0;
         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
          begin
            hash:=hash shl 4;
            hash:=hash shl 4;
-           inc(Hash,Ord(Value[i]));
+           inc(Hash,P[i]);
            g:=hash and ($f shl 28);
            g:=hash and ($f shl 28);
            if g<>0 then
            if g<>0 then
             begin
             begin
@@ -105,6 +141,8 @@ uses
               hash:=hash xor g;
               hash:=hash xor g;
             end;
             end;
          end;
          end;
+        if Assigned(Pc) then
+          FreeMem(PC);
         If Hash=0 then
         If Hash=0 then
           Hash:=$ffffffff;
           Hash:=$ffffffff;
       end;
       end;
@@ -133,6 +171,8 @@ uses
         R : TResourceStringItem;
         R : TResourceStringItem;
         resstrdef: tdef;
         resstrdef: tdef;
         tcb : ttai_typedconstbuilder;
         tcb : ttai_typedconstbuilder;
+        enc : tstringencoding;
+
       begin
       begin
         resstrdef:=search_system_type('TRESOURCESTRINGRECORD').typedef;
         resstrdef:=search_system_type('TRESOURCESTRINGRECORD').typedef;
 
 
@@ -157,12 +197,20 @@ uses
         while assigned(R) do
         while assigned(R) do
           begin
           begin
             tcb:=ctai_typedconstbuilder.create([tcalo_vectorized_dead_strip_item,tcalo_data_force_indirect]);
             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
               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;
               end;
             current_asmdata.asmlists[al_const].concat(cai_align.Create(sizeof(pint)));
             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);
             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
                   TResourceStringRecord = Packed Record
                      Name,
                      Name,
                      CurrentValue,
                      CurrentValue,
-                     DefaultValue : AnsiString;
+                     DefaultValue : AnsiString/Widestring;
                      HashValue    : LongWord;
                      HashValue    : LongWord;
                    end;
                    end;
             }
             }
@@ -205,9 +253,11 @@ uses
         F: Text;
         F: Text;
         R: TResourceStringItem;
         R: TResourceStringItem;
         ResFileName: string;
         ResFileName: string;
-        I: Integer;
+        I,Len: Integer;
         C: tcompilerwidechar;
         C: tcompilerwidechar;
         W: pcompilerwidestring;
         W: pcompilerwidestring;
+        P : PByte;
+
       begin
       begin
         ResFileName:=ChangeFileExt(current_module.ppufilename,'.rsj');
         ResFileName:=ChangeFileExt(current_module.ppufilename,'.rsj');
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
         message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
@@ -229,15 +279,26 @@ uses
         while assigned(R) do
         while assigned(R) do
           begin
           begin
             write(f, '{"hash":',R.Hash,',"name":"',R.Name,'","sourcebytes":[');
             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
             for i:=0 to R.Len-1 do
               begin
               begin
-                write(f,ord(R.Value[i]));
+                write(f,P[i]);
                 if i<>R.Len-1 then
                 if i<>R.Len-1 then
                   write(f,',');
                   write(f,',');
               end;
               end;
             write(f,'],"value":"');
             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
             for I := 0 to W^.len - 1 do
               begin
               begin
                 C := W^.Data[I];
                 C := W^.Data[I];
@@ -261,7 +322,8 @@ uses
                     write(f,Chr(C));
                     write(f,Chr(C));
                 end;
                 end;
               end;
               end;
-            donewidestring(W);
+            if W<>R.WValue then
+              donewidestring(W);
             write(f,'"}');
             write(f,'"}');
             R:=TResourceStringItem(R.Next);
             R:=TResourceStringItem(R.Next);
             if assigned(R) then
             if assigned(R) then

+ 1 - 0
compiler/dbgbase.pas

@@ -103,6 +103,7 @@ implementation
 
 
     uses
     uses
       cutils,
       cutils,
+      globals,
       verbose,
       verbose,
       cgbase;
       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 }
     { true, if def is a signed int type, equal in size to the processor's native int size }
     function is_nativesint(def : tdef) : boolean;
     function is_nativesint(def : tdef) : boolean;
 
 
+    { true, if the char type is a widechar in the system unit }
+    function is_systemunit_unicode : boolean;
+
   type
   type
     tperformrangecheck = (
     tperformrangecheck = (
       rc_internal,  { nothing, internal conversion }
       rc_internal,  { nothing, internal conversion }
@@ -417,6 +420,7 @@ implementation
 
 
     uses
     uses
        verbose,cutils,
        verbose,cutils,
+       symtable, // search_system_type
        symsym,
        symsym,
        cpuinfo;
        cpuinfo;
 
 
@@ -1250,6 +1254,24 @@ implementation
          result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [s64bit,s32bit,s16bit,s8bit]);
          result:=is_nativeint(def) and (def.typ=orddef) and (torddef(def).ordtype in [s64bit,s32bit,s16bit,s8bit]);
       end;
       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
     { 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 }
       the value is placed within the range }
     procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);
     procedure adaptrange(todef : tdef;var l : tconstexprint; rangecheck: tperformrangecheck);

+ 3 - 1
compiler/export.pas

@@ -37,7 +37,9 @@ type
      eo_resident,
      eo_resident,
      eo_index,
      eo_index,
      eo_name,
      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;
    texportoptions=set of texportoption;
 
 

+ 23 - 0
compiler/fmodule.pas

@@ -174,6 +174,7 @@ interface
         loaded_from   : tmodule;
         loaded_from   : tmodule;
         _exports      : tlinkedlist;
         _exports      : tlinkedlist;
         dllscannerinputlist : TFPHashList;
         dllscannerinputlist : TFPHashList;
+        localnamespacelist,
         resourcefiles,
         resourcefiles,
         linkorderedsymbols : TCmdStrList;
         linkorderedsymbols : TCmdStrList;
         linkunitofiles,
         linkunitofiles,
@@ -241,6 +242,7 @@ interface
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
         destructor destroy;override;
         destructor destroy;override;
         procedure reset;virtual;
         procedure reset;virtual;
+        procedure loadlocalnamespacelist;
         procedure adddependency(callermodule:tmodule);
         procedure adddependency(callermodule:tmodule);
         procedure flagdependent(callermodule:tmodule);
         procedure flagdependent(callermodule:tmodule);
         procedure addimportedsym(sym:TSymEntry);
         procedure addimportedsym(sym:TSymEntry);
@@ -572,6 +574,7 @@ implementation
         localframeworksearchpath:=TSearchPathList.Create;
         localframeworksearchpath:=TSearchPathList.Create;
         used_units:=TLinkedList.Create;
         used_units:=TLinkedList.Create;
         dependent_units:=TLinkedList.Create;
         dependent_units:=TLinkedList.Create;
+        localnamespacelist:=TCmdStrList.Create;
         resourcefiles:=TCmdStrList.Create;
         resourcefiles:=TCmdStrList.Create;
         linkorderedsymbols:=TCmdStrList.Create;
         linkorderedsymbols:=TCmdStrList.Create;
         linkunitofiles:=TLinkContainer.Create;
         linkunitofiles:=TLinkContainer.Create;
@@ -946,6 +949,26 @@ implementation
         }
         }
       end;
       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);
     procedure tmodule.adddependency(callermodule:tmodule);
       begin
       begin

+ 30 - 20
compiler/fppu.pas

@@ -562,10 +562,35 @@ var
              result:=SearchPathList(UnitSearchPath,prefix);
              result:=SearchPathList(UnitSearchPath,prefix);
          end;
          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
        var
          fnd : boolean;
          fnd : boolean;
          hs : TPathStr;
          hs : TPathStr;
-         nsitem : TCmdStrListItem;
        begin
        begin
          if shortname then
          if shortname then
           filename:=FixFileName(Copy(realmodulename^,1,8))
           filename:=FixFileName(Copy(realmodulename^,1,8))
@@ -618,26 +643,11 @@ var
          if not fnd then
          if not fnd then
            begin
            begin
              fnd:=SearchSourcePaths('');
              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
              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;
            end;
          search_unit:=fnd;
          search_unit:=fnd;
       end;
       end;

+ 46 - 3
compiler/globals.pas

@@ -124,6 +124,33 @@ interface
        nroftrashvalues = 4;
        nroftrashvalues = 4;
        trashintvalues: array[0..nroftrashvalues-1] of int64 = ($5555555555555555,$AAAAAAAAAAAAAAAA,$EFEFEFEFEFEFEFEF,0);
        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
     type
        { this is written to ppus during token recording for generics,
        { this is written to ppus during token recording for generics,
@@ -256,6 +283,9 @@ interface
        outputfilename    : string;
        outputfilename    : string;
        outputprefix      : pshortstring;
        outputprefix      : pshortstring;
        outputsuffix      : pshortstring;
        outputsuffix      : pshortstring;
+       { selected subtarget }
+       subtarget         : string;
+
        { specified with -FE or -FU }
        { specified with -FE or -FU }
        outputexedir      : TPathStr;
        outputexedir      : TPathStr;
        outputunitdir     : TPathStr;
        outputunitdir     : TPathStr;
@@ -313,8 +343,13 @@ interface
        includesearchpath,
        includesearchpath,
        frameworksearchpath  : TSearchPathList;
        frameworksearchpath  : TSearchPathList;
        packagesearchpath     : TSearchPathList;
        packagesearchpath     : TSearchPathList;
+
        { list of default namespaces }
        { list of default namespaces }
        namespacelist : TCmdStrList;
        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 }
        { contains tpackageentry entries }
        packagelist : TFPHashList;
        packagelist : TFPHashList;
        autoloadunits      : string;
        autoloadunits      : string;
@@ -375,6 +410,7 @@ interface
        LinkLibraryAliases : TLinkStrMap;
        LinkLibraryAliases : TLinkStrMap;
        LinkLibraryOrder   : TLinkStrMap;
        LinkLibraryOrder   : TLinkStrMap;
 
 
+
        init_settings,
        init_settings,
        current_settings   : tsettings;
        current_settings   : tsettings;
 
 
@@ -653,7 +689,7 @@ interface
     function getrealtime(const st: TSystemTime) : real;
     function getrealtime(const st: TSystemTime) : real;
     function getrealtime : 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;
     function  GetEnvPChar(const envname:ansistring):pchar;
     procedure FreeEnvPChar(p: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}
 {$ifdef mswindows}
        procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer);
        procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer);
          begin
          begin
@@ -1002,6 +1038,8 @@ implementation
          if (tf_use_8_3 in Source_Info.Flags) or
          if (tf_use_8_3 in Source_Info.Flags) or
             (tf_use_8_3 in Target_Info.Flags) then
             (tf_use_8_3 in Target_Info.Flags) then
            Replace(s,'$FPCTARGET',target_os_string)
            Replace(s,'$FPCTARGET',target_os_string)
+         else if subtarget<>'' then
+           Replace(s,'$FPCTARGET',target_full_string+'-'+lower(subtarget))
          else
          else
            Replace(s,'$FPCTARGET',target_full_string);
            Replace(s,'$FPCTARGET',target_full_string);
          Replace(s,'$FPCSUBARCH',lower(cputypestr[init_settings.cputype]));
          Replace(s,'$FPCSUBARCH',lower(cputypestr[init_settings.cputype]));
@@ -1024,6 +1062,8 @@ implementation
          Replace(s,'$OPENBSD_LOCALBASE',GetOpenBSDLocalBase);
          Replace(s,'$OPENBSD_LOCALBASE',GetOpenBSDLocalBase);
          Replace(s,'$OPENBSD_X11BASE',GetOpenBSDX11Base);
          Replace(s,'$OPENBSD_X11BASE',GetOpenBSDX11Base);
 {$endif openbsd}
 {$endif openbsd}
+         if not substitute_env_variables then
+           exit;
          { Replace environment variables between dollar signs }
          { Replace environment variables between dollar signs }
          i := pos('$',s);
          i := pos('$',s);
          while i>0 do
          while i>0 do
@@ -1646,6 +1686,8 @@ implementation
        LinkLibraryOrder.Free;
        LinkLibraryOrder.Free;
        packagesearchpath.Free;
        packagesearchpath.Free;
        namespacelist.Free;
        namespacelist.Free;
+       premodule_namespacelist.Free;
+       current_namespacelist:=Nil;
      end;
      end;
 
 
    procedure InitGlobals;
    procedure InitGlobals;
@@ -1687,7 +1729,8 @@ implementation
         frameworksearchpath:=TSearchPathList.Create;
         frameworksearchpath:=TSearchPathList.Create;
         packagesearchpath:=TSearchPathList.Create;
         packagesearchpath:=TSearchPathList.Create;
         namespacelist:=TCmdStrList.Create;
         namespacelist:=TCmdStrList.Create;
-
+        premodule_namespacelist:=TCmdStrList.Create;
+        current_namespacelist:=Nil;
         { Def file }
         { Def file }
         usewindowapi:=false;
         usewindowapi:=false;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;

+ 4 - 1
compiler/globtype.pas

@@ -232,6 +232,7 @@ interface
          cs_link_native,
          cs_link_native,
          cs_link_pre_binutils_2_19,
          cs_link_pre_binutils_2_19,
          cs_link_vlink,
          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) }
          { disable LTO for the system unit (needed to work around linker bugs on macOS) }
          cs_lto_nosystem,
          cs_lto_nosystem,
          cs_assemble_on_target,
          cs_assemble_on_target,
@@ -239,7 +240,9 @@ interface
            this not supported on all OSes }
            this not supported on all OSes }
          cs_large,
          cs_large,
          { if applicable, the compiler generates an executable in uf2 format }
          { 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;
        tglobalswitches = set of tglobalswitch;
 
 

+ 1 - 1
compiler/htypechk.pas

@@ -1869,7 +1869,7 @@ implementation
                begin
                begin
                  if ((valid_const in opts) and
                  if ((valid_const in opts) and
                      (tinlinenode(hp).inlinenumber in [in_typeof_x])) or
                      (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
                    result:=true
                  else
                  else
                    if report_errors then
                    if report_errors then

+ 2 - 2
compiler/ldscript.pas

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

+ 11 - 3
compiler/llvm/llvminfo.pas

@@ -55,8 +55,10 @@ Type
        llvmver_xc_13_3,
        llvmver_xc_13_3,
        llvmver_xc_14_0,
        llvmver_xc_14_0,
        llvmver_14_0,
        llvmver_14_0,
+       llvmver_xc_14_3,
        llvmver_15_0,
        llvmver_15_0,
-       llvmver_16_0
+       llvmver_16_0,
+       llvmver_17_0
       );
       );
 
 
 type
 type
@@ -99,8 +101,10 @@ Const
      'Xcode-13.3',
      'Xcode-13.3',
      'Xcode-14.0',
      'Xcode-14.0',
      '14.0',
      '14.0',
+     'Xcode-14.3',
      '15.0',
      '15.0',
-     '16.0'
+     '16.0',
+     '17.0'
    );
    );
 
 
    llvm_debuginfo_metadata_format : array[tllvmversion] of byte = (
    llvm_debuginfo_metadata_format : array[tllvmversion] of byte = (
@@ -123,6 +127,8 @@ Const
      3,
      3,
      3,
      3,
      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_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_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_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_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 }
    { Supported optimizations, only used for information }

+ 6 - 1
compiler/llvm/llvmpara.pas

@@ -163,7 +163,12 @@ unit llvmpara;
         paralocs }
         paralocs }
       while assigned(paraloc) do
       while assigned(paraloc) do
         begin
         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}
  {$ifdef aarch64}
              { see AArch64's tcpuparamanager.create_paraloc_info_intern() }
              { see AArch64's tcpuparamanager.create_paraloc_info_intern() }
              and not is_managed_type(parasym.vardef)
              and not is_managed_type(parasym.vardef)

+ 16 - 7
compiler/loongarch64/agcpugas.pas

@@ -54,11 +54,10 @@ unit agcpugas;
 
 
     uses
     uses
        cutils,globals,verbose,
        cutils,globals,verbose,
-       cgbase,
+       cgbase,rgbase,
        itcpugas,cpuinfo,
        itcpugas,cpuinfo,
        aasmcpu;
        aasmcpu;
 
 
-
     function getreferencestring(asminfo: pasminfo; var ref : treference) : string;
     function getreferencestring(asminfo: pasminfo; var ref : treference) : string;
     var
     var
       s : string;
       s : string;
@@ -143,13 +142,16 @@ unit agcpugas;
     end;
     end;
 
 
 
 
-    function getopstr(asminfo: pasminfo; const o:toper) : string;
+    function getopstr(asminfo: pasminfo; const o:toper;use_std_regname : boolean) : string;
     var
     var
       hs : string;
       hs : string;
     begin
     begin
       case o.typ of
       case o.typ of
         top_reg:
         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:
         top_const:
           getopstr:=tostr(o.val);
           getopstr:=tostr(o.val);
         top_ref:
         top_ref:
@@ -159,11 +161,11 @@ unit agcpugas;
       end;
       end;
     end;
     end;
 
 
-
     Procedure TLoongArch64InstrWriter.WriteInstruction(hp : tai);
     Procedure TLoongArch64InstrWriter.WriteInstruction(hp : tai);
     var op: TAsmOp;
     var op: TAsmOp;
         s: string;
         s: string;
-        i: byte;
+	i : byte;
+	use_std_regname_index : byte;
         sep: string[3];
         sep: string[3];
     begin
     begin
       s:=#9+gas_op2str[taicpu(hp).opcode];
       s:=#9+gas_op2str[taicpu(hp).opcode];
@@ -171,12 +173,19 @@ unit agcpugas;
         s:=s+cond2str[taicpu(hp).condition];
         s:=s+cond2str[taicpu(hp).condition];
 
 
       curop:=taicpu(hp).opcode;
       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
       if taicpu(hp).ops<>0 then
         begin
         begin
           sep:=#9;
           sep:=#9;
           for i:=0 to taicpu(hp).ops-1 do
           for i:=0 to taicpu(hp).ops-1 do
             begin
             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:=',';
                sep:=',';
             end;
             end;
         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
 R18,$01,$00,$12,$t6,$r18,18,18
 R19,$01,$00,$13,$t7,$r19,19,19
 R19,$01,$00,$13,$t7,$r19,19,19
 R20,$01,$00,$14,$t8,$r20,20,20
 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
 R22,$01,$00,$16,$fp,$r22,22,22
 R23,$01,$00,$17,$s0,$r23,23,23
 R23,$01,$00,$17,$s0,$r23,23,23
 R24,$01,$00,$18,$s1,$r24,24,24
 R24,$01,$00,$18,$s1,$r24,24,24

+ 1 - 1
compiler/loongarch64/rloongarch64abi.inc

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

+ 86 - 46
compiler/msg/errord.msg

@@ -3,7 +3,7 @@
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #   <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
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
@@ -34,6 +34,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   link_     internal linker
 #   package_  package handling
 #   package_  package handling
+#   sym_      symbol handling 
 #
 #
 # <type> the type of the message it should normally used for
 # <type> the type of the message it should normally used for
 #   f_   fatal error
 #   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
 scan_e_unsupported_switch=02095_E_Direktive $1 wird auf diesem Zielbetriebssystem nicht unterst�tzt
 % Not all compiler directives are supported on all targets.
 % 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.
 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.
 % 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.
 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
 % 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
 # Parser
 #
 #
-# 03364 is the last used one
+# 03370 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 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,
 % 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.
 % 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.
 % 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
 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
 % 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
 % (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
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
 % 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
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
 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;
 % \end{verbatim}
 % \end{verbatim}
 % where \var{MyProtocol} is declared but not defined.
 % 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.
 % Published sections can be used only inside classes.
 parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt
 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.
 % 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;
 %   TObj.test;
 % \end{verbatim}
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
 % \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
 % 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
 % 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.
 % 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.
 % 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
 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
 % 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
 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
 % 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
 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
 % This error occurs if one tries to define a method for a type that is originally declared
 % in a different unit.
 % 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
 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
 % 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
 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
 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
 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
 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.
 % 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
 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
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
 % 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}
 % \end{description}
 # EndOfTeX
 # EndOfTeX
@@ -1666,7 +1681,7 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 #
 #
 # Type Checking
 # Type Checking
 #
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 #
 # BeginOfTeX
 # BeginOfTeX
 %
 %
@@ -1736,7 +1751,7 @@ type_e_set_operation_unknown=04013_E_Operation f
 % several binary operations are not defined for sets.
 % several binary operations are not defined for sets.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % The last two may be  defined for sets in the future.
 % 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
 % 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
 % encountered. Since \var{Comp} is a 64 bit integer type, this may indicate
 % an error.
 % an error.
@@ -1817,12 +1832,12 @@ type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalte
 % Type
 % Type
 %   TMyStream = Class(TStream,Integer)
 %   TMyStream = Class(TStream,Integer)
 % \end{verbatim}
 % \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),
 % 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
 % 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,
 % 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.
 % 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
 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
 % 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.
 % 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
 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
 % 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.
 % 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
 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
 % 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
 % 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.
 % 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
 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.
 % Many operating systems allow you to allocate memory above \$80000000.
 % For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff.
 % 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,
 % 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
 % 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
 % 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # EndOfTeX
@@ -2131,7 +2150,7 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 #
 #
 # Symtable
 # Symtable
 #
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 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.
 % 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # 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
 % Win64 SEH directives have certain restrictions on possible offset values, e.g. they should
 % be positive and have 3 or 4 low bits clear.
 % be positive and have 3 or 4 low bits clear.
 asmr_e_bad_seh_directive_register=07113_E_Ung�ltiges Register f�r $1
 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
 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
 % Win64 SEH directives are allowed only in pure assembler procedures, not in assembler
 % blocks of regular procedures.
 % 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"
 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 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_redefined_label=08017_E_Asm: Neu definiertes Label $1
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_invalid_register=08019_E_Asm: Ung�ltiges Register $1
 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
 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
 % 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.
 % 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
 % 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
 % of wrong code generation, but currently set to Note level as it appears inside
 % the compiler compilation.
 % 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_code_segment_too_large=08030_F_Code-Segment zu groá
 asmw_f_data_segment_too_large=08031_F_Data-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
 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.
 % Check your paths.
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 % Generic error while linking.
 % 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
 % An error occurred when calling an external linker. The compiler will produce a script that
 % can be used to assemble and link the program.
 % can be used to assemble and link the program.
 exec_i_linking=09015_I_Linke $1
 exec_i_linking=09015_I_Linke $1
@@ -3206,20 +3231,20 @@ execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % \begin{description}
 % \begin{description}
 link_f_executable_too_big=09200_F_Das Programm - Image ist f�r das Target $1 zu groá
 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.
 % 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
 % In such case an executable image can be loaded into lower 4Gb of
 % address space only.
 % address space only.
 link_e_program_segment_too_large=09202_E_Program-Segment zu groá (�bersteigt 64k um $1 Byte)
 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)
 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)
 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)
 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)
 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
 % 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
 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
 % 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
 # Options
 #
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 % 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.
 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # 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.
 % 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
 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.
 % 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
 # EndOfTeX
 
 
 #
 #
@@ -3921,7 +3952,7 @@ diskutiert werden k
 #    3 = 80x86 targets
 #    3 = 80x86 targets
 #    4 = x86_64
 #    4 = x86_64
 #    6 = 680x0 targets
 #    6 = 680x0 targets
-#    8 = 8086 (16-bit) targets
+#    8 = 8086 (16 bit) targets
 #    a = AArch64
 #    a = AArch64
 #    A = ARM
 #    A = ARM
 #    e = in extended debug mode only
 #    e = in extended debug mode only
@@ -3929,6 +3960,7 @@ diskutiert werden k
 #    I = VIS
 #    I = VIS
 #    J = JVM
 #    J = JVM
 #    L = LLVM variant
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    m = MIPSEL targets
 #    P = PowerPC 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)
 **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
 *L2ap_Benutze Pipes anstelle tempor„rer Assembler-Dateien
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
+**2aR_Liste RTTI-Informationen in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 # Choice of assembler used
 # Choice of assembler used
 **1A<x>_Ausgabe Format:
 **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*2Aas-darwin_Assembliere Darwin Mach-O mit Hilfe von GNU GAS
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Aelf_ELF (Linux) 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*2Amasm_Objektdatei mit Hilfe von Masm (Microsoft)
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasmcoff_COFF (Go32v2) Datei 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)
 3*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas-darwin_Assembliere Darwin Mach-O64 mit Hilfe von GNU GAS
 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*2Agas_Assembliere mit Hilfe von GNU AS
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasmdarwin_Assembliere darwin Macho64 Objektdatei 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*2Anasmwin64_Assembliere Win64 Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 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*2Tsymbian_Symbian OS
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
 3*2Twdosx_WDOSX DOS extender
-3*2Twin32_Windows 32 Bit
+3*2Twin32_Windows 32-Bit
 3*2Twince_Windows CE
 3*2Twince_Windows CE
 # x86_64 targets
 # x86_64 targets
 4*2Tandroid_Android
 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*2Tnetbsd_NetBSD
 4*2Topenbsd_OpenBSD
 4*2Topenbsd_OpenBSD
 4*2Tsolaris_Solaris
 4*2Tsolaris_Solaris
-4*2Twin64_Win64 (64 bit Windows Systeme)
+4*2Twin64_Win64 (64-Bit Windows Systeme)
 # m68k targets
 # m68k targets
 6*2Tamiga_Commodore Amiga
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
 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
 # i8086 targets
 8*2Tembedded_Embedded
 8*2Tembedded_Embedded
 8*2Tmsdos_MS-DOS (und kompatible)
 8*2Tmsdos_MS-DOS (und kompatible)
-8*2Twin16_Windows 16 Bit
+8*2Twin16_Windows 16-Bit
 # arm targets
 # arm targets
 A*2Tandroid_Android
 A*2Tandroid_Android
 A*2Taros_AROS
 A*2Taros_AROS
@@ -4309,6 +4342,8 @@ a*2Twin64_Windows 64
 # jvm targets
 # jvm targets
 J*2Tandroid_Android
 J*2Tandroid_Android
 J*2Tjava_Java
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 # mipsel targets
 m*2Tandroid_Android
 m*2Tandroid_Android
 m*2Tembedded_Embedded
 m*2Tembedded_Embedded
@@ -4359,6 +4394,10 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Tembedded_Embedded
 W*2Twasi_Das WebAssembly System Interface (WASI)
 W*2Twasi_Das WebAssembly System Interface (WASI)
 # end of targets section
 # 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>_Entferne die Definition f�r das Symbol <x>
 **1U<x>_Unit-Optionen:
 **1U<x>_Unit-Optionen:
 **2Un_Pr�fe den Unitnamen nicht
 **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*3WQqhdr_Setze Metadata auf QDOS Datei-Header Stil (Voreinstellung)
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 **2WX_Erm”gliche den executable stack (Linux)
 **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:
 **1X_Programm-Optionen:
 **2X9_Erzeuge Linkerscript f�r GNU Binutils ld „lter als Version 2.19.1 (Linux)
 **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)
 **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_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)
 **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
 #   Latest updates contributed by Karl-Michael Schindler aka mischi
 #   <karl-michael.schindler at web.de>
 #   <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
 #   This file is part of the Free Pascal Compiler
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
 #   Copyright (c) 1998-2023 by the Free Pascal Development team
@@ -34,6 +34,7 @@
 #   exec_     calls to assembler, external linker, binder
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   link_     internal linker
 #   package_  package handling
 #   package_  package handling
+#   sym_      symbol handling 
 #
 #
 # <type> the type of the message it should normally used for
 # <type> the type of the message it should normally used for
 #   f_   fatal error
 #   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
 scan_e_unsupported_switch=02095_E_Direktive $1 wird auf diesem Zielbetriebssystem nicht unterstützt
 % Not all compiler directives are supported on all targets.
 % 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.
 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.
 % 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.
 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
 % 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
 # Parser
 #
 #
-# 03364 is the last used one
+# 03370 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 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,
 % 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.
 % 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.
 % 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
 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
 % 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
 % (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
 % be packed at the bit level. For performance reasons, they cannot be
 % used as loop variables.
 % 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
 % The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside
 % records, objects and classes.
 % records, objects and classes.
 parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein
 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;
 % \end{verbatim}
 % \end{verbatim}
 % where \var{MyProtocol} is declared but not defined.
 % 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.
 % Published sections can be used only inside classes.
 parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt
 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.
 % 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;
 %   TObj.test;
 % \end{verbatim}
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
 % \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
 % 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
 % 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.
 % 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.
 % 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
 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
 % 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
 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
 % 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
 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
 % This error occurs if one tries to define a method for a type that is originally declared
 % in a different unit.
 % 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
 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
 % 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
 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
 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
 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
 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.
 % 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
 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
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
 % 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}
 % \end{description}
 # EndOfTeX
 # EndOfTeX
@@ -1665,7 +1680,7 @@ parser_e_syscall_format_not_support=03364_E_Syntax der syscall-Direktive wird au
 #
 #
 # Type Checking
 # Type Checking
 #
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 #
 # BeginOfTeX
 # 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.
 % several binary operations are not defined for sets.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}.
 % The last two may be  defined for sets in the future.
 % 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
 % 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
 % encountered. Since \var{Comp} is a 64 bit integer type, this may indicate
 % an error.
 % an error.
@@ -1816,12 +1831,12 @@ type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalte
 % Type
 % Type
 %   TMyStream = Class(TStream,Integer)
 %   TMyStream = Class(TStream,Integer)
 % \end{verbatim}
 % \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),
 % 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
 % 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,
 % 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.
 % 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
 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
 % 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.
 % 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
 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
 % 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.
 % 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
 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
 % 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
 % 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.
 % 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
 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.
 % Many operating systems allow you to allocate memory above \$80000000.
 % For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff.
 % 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,
 % 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
 % 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
 % 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # EndOfTeX
@@ -2130,7 +2149,7 @@ type_e_nested_procvar_to_funcref=04131_E_Eine verschachtelte Funktionsvariable k
 #
 #
 # Symtable
 # Symtable
 #
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 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.
 % 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # 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
 % Win64 SEH directives have certain restrictions on possible offset values, e.g. they should
 % be positive and have 3 or 4 low bits clear.
 % be positive and have 3 or 4 low bits clear.
 asmr_e_bad_seh_directive_register=07113_E_Ungültiges Register für $1
 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
 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
 % Win64 SEH directives are allowed only in pure assembler procedures, not in assembler
 % blocks of regular procedures.
 % 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"
 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 % The size of memory operand is possible invalid. This is
 % probably an error in the assembler statement
 % 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
 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_redefined_label=08017_E_Asm: Neu definiertes Label $1
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_first_defined_label=08018_E_Asm: First beginnt hier
 asmw_e_invalid_register=08019_E_Asm: Ungültiges Register $1
 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
 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
 % 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.
 % 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
 % 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
 % of wrong code generation, but currently set to Note level as it appears inside
 % the compiler compilation.
 % 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_code_segment_too_large=08030_F_Code-Segment zu groß
 asmw_f_data_segment_too_large=08031_F_Data-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
 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.
 % Check your paths.
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 exec_e_error_while_linking=09013_E_Fehler beim Linken
 % Generic error while linking.
 % 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
 % An error occurred when calling an external linker. The compiler will produce a script that
 % can be used to assemble and link the program.
 % can be used to assemble and link the program.
 exec_i_linking=09015_I_Linke $1
 exec_i_linking=09015_I_Linke $1
@@ -3205,20 +3230,20 @@ execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Byte
 % \begin{description}
 % \begin{description}
 link_f_executable_too_big=09200_F_Das Programm - Image ist für das Target $1 zu groß
 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.
 % 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
 % In such case an executable image can be loaded into lower 4Gb of
 % address space only.
 % address space only.
 link_e_program_segment_too_large=09202_E_Program-Segment zu groß (übersteigt 64k um $1 Byte)
 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)
 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)
 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)
 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)
 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
 % 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
 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
 % 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
 # Options
 #
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
 #
 # BeginOfTeX
 # 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
 % 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.
 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.
 % 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}
 % \end{description}
 # EndOfTeX
 # 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.
 % 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
 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.
 % 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
 # EndOfTeX
 
 
 #
 #
@@ -3920,7 +3951,7 @@ diskutiert werden können, usw.):
 #    3 = 80x86 targets
 #    3 = 80x86 targets
 #    4 = x86_64
 #    4 = x86_64
 #    6 = 680x0 targets
 #    6 = 680x0 targets
-#    8 = 8086 (16-bit) targets
+#    8 = 8086 (16 bit) targets
 #    a = AArch64
 #    a = AArch64
 #    A = ARM
 #    A = ARM
 #    e = in extended debug mode only
 #    e = in extended debug mode only
@@ -3928,6 +3959,7 @@ diskutiert werden können, usw.):
 #    I = VIS
 #    I = VIS
 #    J = JVM
 #    J = JVM
 #    L = LLVM variant
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    m = MIPSEL targets
 #    P = PowerPC 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)
 **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
 *L2ap_Benutze Pipes anstelle temporärer Assembler-Dateien
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
 **2ar_Liste Registerbelegungsinformation in Assembler-Datei
+**2aR_Liste RTTI-Informationen in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 **2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei
 # Choice of assembler used
 # Choice of assembler used
 **1A<x>_Ausgabe Format:
 **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*2Aas-darwin_Assembliere Darwin Mach-O mit Hilfe von GNU GAS
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers
 3*2Aelf_ELF (Linux) 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*2Amasm_Objektdatei mit Hilfe von Masm (Microsoft)
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasm_Assembliere mit Hilfe von Nasm
 3*2Anasmcoff_COFF (Go32v2) Datei 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)
 3*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas_Assembliere mit Hilfe von GNU AS
 4*2Aas-darwin_Assembliere Darwin Mach-O64 mit Hilfe von GNU GAS
 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*2Agas_Assembliere mit Hilfe von GNU AS
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Amasm_Win64 Objektdatei mit Hilfe von ml64 (Microsoft)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasm_Assembliere mit Hilfe von Nasm (experimentell)
 4*2Anasmdarwin_Assembliere darwin Macho64 Objektdatei 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*2Anasmwin64_Assembliere Win64 Objektdatei mit Hilfe von Nasm (experimentell)
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Schreibers
 4*2Ayasm_Assembliere mit Hilfe von Yasm (experimentell)
 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*2Tsymbian_Symbian OS
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twatcom_Watcom compatible DOS extender
 3*2Twdosx_WDOSX DOS extender
 3*2Twdosx_WDOSX DOS extender
-3*2Twin32_Windows 32 Bit
+3*2Twin32_Windows 32-Bit
 3*2Twince_Windows CE
 3*2Twince_Windows CE
 # x86_64 targets
 # x86_64 targets
 4*2Tandroid_Android
 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*2Tnetbsd_NetBSD
 4*2Topenbsd_OpenBSD
 4*2Topenbsd_OpenBSD
 4*2Tsolaris_Solaris
 4*2Tsolaris_Solaris
-4*2Twin64_Win64 (64 bit Windows Systeme)
+4*2Twin64_Win64 (64-Bit Windows Systeme)
 # m68k targets
 # m68k targets
 6*2Tamiga_Commodore Amiga
 6*2Tamiga_Commodore Amiga
 6*2Tatari_Atari ST/STe/TT
 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
 # i8086 targets
 8*2Tembedded_Embedded
 8*2Tembedded_Embedded
 8*2Tmsdos_MS-DOS (und kompatible)
 8*2Tmsdos_MS-DOS (und kompatible)
-8*2Twin16_Windows 16 Bit
+8*2Twin16_Windows 16-Bit
 # arm targets
 # arm targets
 A*2Tandroid_Android
 A*2Tandroid_Android
 A*2Taros_AROS
 A*2Taros_AROS
@@ -4308,6 +4341,8 @@ a*2Twin64_Windows 64
 # jvm targets
 # jvm targets
 J*2Tandroid_Android
 J*2Tandroid_Android
 J*2Tjava_Java
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 # mipsel targets
 m*2Tandroid_Android
 m*2Tandroid_Android
 m*2Tembedded_Embedded
 m*2Tembedded_Embedded
@@ -4358,6 +4393,10 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Tembedded_Embedded
 W*2Twasi_Das WebAssembly System Interface (WASI)
 W*2Twasi_Das WebAssembly System Interface (WASI)
 # end of targets section
 # 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>_Entferne die Definition für das Symbol <x>
 **1U<x>_Unit-Optionen:
 **1U<x>_Unit-Optionen:
 **2Un_Prüfe den Unitnamen nicht
 **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*3WQqhdr_Setze Metadata auf QDOS Datei-Header Stil (Voreinstellung)
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 6*3WQxtcc_Setze Metadata auf XTcc Stil
 **2WX_Ermögliche den executable stack (Linux)
 **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:
 **1X_Programm-Optionen:
 **2X9_Erzeuge Linkerscript für GNU Binutils ld älter als Version 2.19.1 (Linux)
 **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)
 **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_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)
 **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
 #   exec_     calls to assembler, external linker, binder
 #   link_     internal linker
 #   link_     internal linker
 #   package_  package handling
 #   package_  package handling
+#   sym_      symbol handling 
 #
 #
 # <type> the type of the message it should normally used for
 # <type> the type of the message it should normally used for
 #   f_   fatal error
 #   f_   fatal error
@@ -445,7 +446,7 @@ scan_e_unexpected_endif=02108_E_$ENDIF directive found without a matching $IF(N)
 #
 #
 # Parser
 # Parser
 #
 #
-# 03365 is the last used one
+# 03368 is the last used one
 #
 #
 % \section{Parser messages}
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
 % 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.
 % 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_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
 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
 % On a certain target, not all syntax variants of the syscall directive make sense and thus those making
 % no sense are not supported
 % no sense are not supported
 % Declarations like \var{var i: Integer absolute i;} are not allowed
 % 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}
 % \end{description}
 %
 %
 # Type Checking
 # Type Checking
 #
 #
-# 04131 is the last used one
+# 04133 is the last used one
 #
 #
 % \section{Type checking errors}
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
 % 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
 % 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
 % 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.
 % 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}
 % \end{description}
 #
 #
 # Symtable
 # Symtable
 #
 #
-# 05099 is the last used one
+# 05101 is the last used one
 #
 #
 % \section{Symbol handling}
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
 % 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
 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.
 % 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.
 % 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}
 % \end{description}
 #
 #
 # Codegenerator
 # 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.
 % 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.
 % If no target controller is set, this command cannot be build and thus linking cannot be carried out.
 %
 %
-%\end{description}
+% \end{description}
 # EndOfTeX
 # 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.
 % Informational message showing the stack size that the compiler reserved for the executable.
 execinfo_x_stackcommit=09134_X_Stack space committed: $1 bytes
 execinfo_x_stackcommit=09134_X_Stack space committed: $1 bytes
 % Informational message showing the stack size that the compiler committed for the executable.
 % Informational message showing the stack size that the compiler committed for the executable.
-%\end{description}
+% \end{description}
 # EndOfTeX
 # 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.
 % 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
 link_e_undefined_symbol=09222_E_Undefined symbol: $1
 % The specified symbol is used, but not defined.
 % The specified symbol is used, but not defined.
-%\end{description}
+% \end{description}
 # EndOfTeX
 # EndOfTeX
 
 
 #
 #
@@ -3468,15 +3492,15 @@ unit_u_ppu_wasm_threads_mismatch=10070_U_PPU and program must both be compiled w
 #
 #
 #  Options
 #  Options
 #
 #
-# 11064 is the last used one
+# 11067 is the last used one
 #
 #
-option_usage=11000_O_$1 [options] <inputfile> [options]
 # BeginOfTeX
 # BeginOfTeX
 %
 %
 % \section{Command line handling errors}
 % \section{Command line handling errors}
 % This section lists errors that occur when the compiler is processing the
 % This section lists errors that occur when the compiler is processing the
 % command line or handling the configuration files.
 % command line or handling the configuration files.
 % \begin{description}
 % \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"
 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
 % 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
 % 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
 % 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.
 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.
 % 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
 # 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.
 % 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"
 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.
 % 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
 # EndOfTeX
 
 
 
 
@@ -3883,6 +3913,7 @@ new features, etc.):
 #    I = VIS
 #    I = VIS
 #    J = JVM
 #    J = JVM
 #    L = LLVM variant
 #    L = LLVM variant
+#    l = loongarch64 targets
 #    M = MIPS (MIPSEB) targets
 #    M = MIPS (MIPSEB) targets
 #    m = MIPSEL targets
 #    m = MIPSEL targets
 #    P = PowerPC 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
 **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
 **2Cb_Generate code for a big-endian variant of the target architecture
 **2Cc<x>_Set default calling convention to <x>
 **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)
 **2CD_Create also dynamic library (not supported)
 **2Ce_Compilation with emulated floating point opcodes
 **2Ce_Compilation with emulated floating point opcodes
 **2CE_Generate FPU code which can raise exceptions
 **2CE_Generate FPU code which can raise exceptions
@@ -4264,6 +4300,8 @@ a*2Twin64_Windows 64
 # jvm targets
 # jvm targets
 J*2Tandroid_Android
 J*2Tandroid_Android
 J*2Tjava_Java
 J*2Tjava_Java
+# loongarch64 targets
+l*2Tlinux_Linux
 # mipsel targets
 # mipsel targets
 m*2Tandroid_Android
 m*2Tandroid_Android
 m*2Tembedded_Embedded
 m*2Tembedded_Embedded
@@ -4313,24 +4351,43 @@ Z*2Tzxspectrum_ZX Spectrum
 W*2Tembedded_Embedded
 W*2Tembedded_Embedded
 W*2Twasi_The WebAssembly System Interface (WASI)
 W*2Twasi_The WebAssembly System Interface (WASI)
 # end of targets section
 # 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<x>_Undefines the symbol <x>
 **1U_Unit options:
 **1U_Unit options:
 **2Un_Do not check where the unit name matches the file name
 **2Un_Do not check where the unit name matches the file name
 **2Ur_Generate release unit files (never automatically recompiled)
 **2Ur_Generate release unit files (never automatically recompiled)
 **2Us_Compile a system unit
 **2Us_Compile a system unit
 **1v<x>_Be verbose. <x> is a combination of the following letters:
 **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*_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)
 F*1V<x>_Append '-<x>' to the used compiler binary name (e.g. for version)
 **1W<x>_Target-specific options (targets)
 **1W<x>_Target-specific options (targets)
 3*2WA_Specify native type application (Windows)
 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*3WQqhdr_Set metadata to QDOS File Header style (default)
 6*3WQxtcc_Set metadata to XTcc style
 6*3WQxtcc_Set metadata to XTcc style
 **2WX_Enable executable stack (Linux)
 **2WX_Enable executable stack (Linux)
+**1x<suff>_Set suffix for compiler executable (fpc command only)
 **1X_Executable options:
 **1X_Executable options:
 **2X9_Generate linkerscript for GNU Binutils ld older than version 2.19.1 (Linux)
 **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)
 **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_absolute_sym_cannot_reference_itself=03363;
   parser_e_syscall_format_not_support=03364;
   parser_e_syscall_format_not_support=03364;
   parser_w_ignoring_published_property=03365;
   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_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
   type_e_not_equal_types=04002;
@@ -601,6 +606,8 @@ const
   type_e_cant_read_write_type_in_iso_mode=04129;
   type_e_cant_read_write_type_in_iso_mode=04129;
   type_w_array_size_does_not_match_size_of_constant_string=04130;
   type_w_array_size_does_not_match_size_of_constant_string=04130;
   type_e_nested_procvar_to_funcref=04131;
   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_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
   sym_e_duplicate_id=05002;
@@ -687,6 +694,8 @@ const
   sym_e_generic_type_param_decl=05097;
   sym_e_generic_type_param_decl=05097;
   sym_e_type_must_be_rec_or_object=05098;
   sym_e_type_must_be_rec_or_object=05098;
   sym_e_symbol_no_capture=05099;
   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_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1104,6 +1113,9 @@ const
   option_valgrind_heaptrc_mismatch=11062;
   option_valgrind_heaptrc_mismatch=11062;
   option_unsupported_fpu=11063;
   option_unsupported_fpu=11063;
   option_too_many_exception_modes=11064;
   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_cant_find_file=12000;
   wpo_begin_processing=12001;
   wpo_begin_processing=12001;
   wpo_end_processing=12002;
   wpo_end_processing=12002;
@@ -1157,9 +1169,9 @@ const
   option_info=11024;
   option_info=11024;
   option_help_pages=11025;
   option_help_pages=11025;
 
 
-  MsgTxtSize = 90618;
+  MsgTxtSize = 92057;
 
 
   MsgIdxMax : array[1..20] of longint=(
   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
   );
   );

File diff suppressed because it is too large
+ 328 - 311
compiler/msgtxt.inc


+ 18 - 6
compiler/nadd.pas

@@ -2675,9 +2675,9 @@ implementation
             case nodetype of
             case nodetype of
                equaln,unequaln :
                equaln,unequaln :
                  begin
                  begin
-                    if is_voidpointer(right.resultdef) then
+                    if is_voidpointer(right.resultdef) and (left.nodetype<>niln) then
                       inserttypeconv(right,left.resultdef)
                       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)
                       inserttypeconv(left,right.resultdef)
                     else if not(equal_defs(ld,rd)) then
                     else if not(equal_defs(ld,rd)) then
                       IncompatibleTypes(ld,rd);
                       IncompatibleTypes(ld,rd);
@@ -2704,6 +2704,16 @@ implementation
                       inserttypeconv_internal(right,charfarpointertype)
                       inserttypeconv_internal(right,charfarpointertype)
                     else
                     else
                       inserttypeconv_internal(right,charnearpointertype);
                       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}
 {$else}
                     inserttypeconv_internal(left,charpointertype);
                     inserttypeconv_internal(left,charpointertype);
                     inserttypeconv_internal(right,charpointertype);
                     inserttypeconv_internal(right,charpointertype);
@@ -2827,9 +2837,11 @@ implementation
                   st_unicodestring :
                   st_unicodestring :
                     begin
                     begin
                       if not(is_unicodestring(rd)) then
                       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
                       if not(is_unicodestring(ld)) then
-                        inserttypeconv(left,cunicodestringtype);
+                        if not ((rd.size=0) and (nodetype in [equaln,unequaln])) then
+                          inserttypeconv(left,cunicodestringtype);
                     end;
                     end;
                   st_ansistring :
                   st_ansistring :
                     begin
                     begin
@@ -3058,9 +3070,9 @@ implementation
                 if (rt=niln) then
                 if (rt=niln) then
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,'NIL');
                   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
                 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(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);
                   CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
                 if (rd.typ=pointerdef) and
                 if (rd.typ=pointerdef) and
                    (tpointerdef(rd).pointeddef.size>1) then
                    (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) }
                                    (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_ignore_visibility,  { internally generated call that should ignore visibility checks }
          cnf_check_fpu_exceptions, { after the call fpu exceptions shall be checked }
          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;
        tcallnodeflags = set of tcallnodeflag;
 
 
@@ -3775,7 +3776,7 @@ implementation
                           { in tp mode we can try to convert to procvar if
                           { in tp mode we can try to convert to procvar if
                             there are no parameters specified }
                             there are no parameters specified }
                           if not(assigned(left)) and
                           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_tp_procvar in current_settings.modeswitches) or
                               (m_mac_procvar in current_settings.modeswitches)) and
                               (m_mac_procvar in current_settings.modeswitches)) and
                              (not assigned(methodpointer) or
                              (not assigned(methodpointer) or
@@ -3823,7 +3824,7 @@ implementation
                            with generic types as arguments we don't complain in
                            with generic types as arguments we don't complain in
                            the generic, but only during the specialization }
                            the generic, but only during the specialization }
                          ignoregenericparacall:=false;
                          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
                            begin
                              pt:=tcallparanode(left);
                              pt:=tcallparanode(left);
                              while assigned(pt) do
                              while assigned(pt) do

+ 8 - 0
compiler/ncgrtti.pas

@@ -268,6 +268,11 @@ implementation
                       tcb.emit_ord_const(def.paras.count,u16inttype);
                       tcb.emit_ord_const(def.paras.count,u16inttype);
                       maybe_add_comment(tcb,#9'caller args size');
                       maybe_add_comment(tcb,#9'caller args size');
                       tcb.emit_ord_const(def.callerargareasize,ptrsinttype);
                       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');
                       maybe_add_comment(tcb,#9'name');
                       tcb.emit_pooled_shortstring_const_ref(sym.realname);
                       tcb.emit_pooled_shortstring_const_ref(sym.realname);
 
 
@@ -1741,6 +1746,9 @@ implementation
             { write GUID }
             { write GUID }
             tcb.emit_guid_const(def.iidguid^);
             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 }
             { write unit name }
             tcb.emit_shortstring_const(current_module.realmodulename^);
             tcb.emit_shortstring_const(current_module.realmodulename^);
 
 

+ 25 - 8
compiler/ncnv.pas

@@ -557,8 +557,10 @@ implementation
                       { widechars are not yet supported }
                       { widechars are not yet supported }
                       if is_widechar(p2.resultdef) then
                       if is_widechar(p2.resultdef) then
                         begin
                         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);
                             incompatibletypes(cwidechartype,cansichartype);
                         end;
                         end;
 
 
@@ -567,8 +569,9 @@ implementation
                        begin
                        begin
                          if is_widechar(p3.resultdef) then
                          if is_widechar(p3.resultdef) then
                            begin
                            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
                                begin
                                  current_filepos:=p3.fileinfo;
                                  current_filepos:=p3.fileinfo;
                                  incompatibletypes(cwidechartype,cansichartype);
                                  incompatibletypes(cwidechartype,cansichartype);
@@ -741,7 +744,7 @@ implementation
                         begin
                         begin
                           if p1.nodetype<>ordconstn then
                           if p1.nodetype<>ordconstn then
                             exit
                             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;
                             exit;
                         end;
                         end;
 
 
@@ -751,7 +754,7 @@ implementation
                             begin
                             begin
                               if p2.nodetype<>ordconstn then
                               if p2.nodetype<>ordconstn then
                                 exit
                                 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;
                                 exit;
                             end;
                             end;
 
 
@@ -2508,7 +2511,10 @@ implementation
                             not is_self_sym(tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym))
                             not is_self_sym(tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym))
                           )
                           )
                         ) then
                         ) then
-                      internalerror(2021060801);
+                      begin
+                        result:=cerrornode.create;
+                        exit;
+                      end;
 
 
                     { so that insert_self_and_vmt_para correctly inserts the
                     { so that insert_self_and_vmt_para correctly inserts the
                       Self, cause it otherwise skips that for anonymous functions }
                       Self, cause it otherwise skips that for anonymous functions }
@@ -2619,7 +2625,10 @@ implementation
                 else if tprocvardef(totypedef).is_addressonly then
                 else if tprocvardef(totypedef).is_addressonly then
                   begin
                   begin
                     if assigned(tprocdef(pd).capturedsyms) and (tprocdef(pd).capturedsyms.count>0) then
                     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 }
                     { remove framepointer and Self parameters }
                     for i:=tprocdef(pd).parast.symlist.count-1 downto 0 do
                     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_open_array(left.resultdef)) and
                                  not(is_array_constructor(left.resultdef)) and
                                  not(is_array_constructor(left.resultdef)) and
                                  not(is_array_of_const(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
                                  (left.resultdef.size=resultdef.size) and
                                  { disallow casts of const nodes }
                                  { disallow casts of const nodes }
                                  (not is_constnode(left) or
                                  (not is_constnode(left) or

+ 2 - 2
compiler/ngenutil.pas

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

+ 21 - 6
compiler/ninl.pas

@@ -138,7 +138,7 @@ implementation
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
       symconst,symdef,symsym,symcpu,symtable,paramgr,defcmp,defutil,symbase,
       cpuinfo,cpubase,
       cpuinfo,cpubase,
       pass_1,
       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,
       nobjc,objcdef,
       cgbase,procinfo;
       cgbase,procinfo;
 
 
@@ -445,6 +445,7 @@ implementation
               not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
               not (def.typ in [arraydef,recorddef,variantdef,objectdef,procvardef]) or
               ((def.typ=objectdef) and not is_object(def)) then
               ((def.typ=objectdef) and not is_object(def)) then
             internalerror(201202101);
             internalerror(201202101);
+
           { extra '$' prefix because on darwin the result of makemangledname
           { extra '$' prefix because on darwin the result of makemangledname
             is prefixed by '_' and hence adding a '$' at the start of the
             is prefixed by '_' and hence adding a '$' at the start of the
             prefix passed to makemangledname doesn't help (the whole point of
             prefix passed to makemangledname doesn't help (the whole point of
@@ -462,20 +463,21 @@ implementation
           if assigned(current_procinfo) then
           if assigned(current_procinfo) then
             begin
             begin
               { the default sym is always part of the current procedure/function }
               { 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));
               srsym:=tsym(srsymtable.findwithhash(hashedid));
               if not assigned(srsym) then
               if not assigned(srsym) then
                 begin
                 begin
                   { no valid default variable found, so create it }
                   { 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 }
                   { mark the staticvarsym as typedconst }
                   include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
                   include(tabstractvarsym(srsym).varoptions,vo_is_typed_const);
                   include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
                   include(tabstractvarsym(srsym).varoptions,vo_is_default_var);
                   { The variable has a value assigned }
                   { The variable has a value assigned }
                   tabstractvarsym(srsym).varstate:=vs_initialised;
                   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;
                 end;
               result:=cloadnode.create(srsym,srsymtable);
               result:=cloadnode.create(srsym,srsymtable);
             end
             end
@@ -488,7 +490,20 @@ implementation
       begin
       begin
         if not assigned(left) or (left.nodetype<>typen) then
         if not assigned(left) or (left.nodetype<>typen) then
           internalerror(2012032102);
           internalerror(2012032102);
+
         def:=ttypenode(left).typedef;
         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;
         result:=nil;
         case def.typ of
         case def.typ of
           enumdef,
           enumdef,

+ 384 - 16
compiler/ogcoff.pas

@@ -564,6 +564,318 @@ implementation
          NumberOfAuxSymbols : byte;
          NumberOfAuxSymbols : byte;
        end;
        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 }
        { This is defined in rtl/win/sysos.inc source }
        tlsdirectory=packed record
        tlsdirectory=packed record
          data_start, data_end : PUInt;
          data_start, data_end : PUInt;
@@ -571,7 +883,52 @@ implementation
          zero_fill_size : dword;
          zero_fill_size : dword;
          flags : dword;
          flags : dword;
        end;
        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
      const
        SymbolMaxGrow = 200*sizeof(coffsymbol);
        SymbolMaxGrow = 200*sizeof(coffsymbol);
        StrsMaxGrow   = 8192;
        StrsMaxGrow   = 8192;
@@ -1437,6 +1794,7 @@ const pemagic : array[0..3] of byte = (
             bosym.StorageClass:=typ;
             bosym.StorageClass:=typ;
             bosym.NumberOfAuxSymbols:=aux;
             bosym.NumberOfAuxSymbols:=aux;
             inc(symidx);
             inc(symidx);
+	    MaybeSwap(bosym);
             FCoffSyms.write(bosym,sizeof(bosym));
             FCoffSyms.write(bosym,sizeof(bosym));
           end
           end
         else
         else
@@ -1453,6 +1811,7 @@ const pemagic : array[0..3] of byte = (
             sym.typ:=typ;
             sym.typ:=typ;
             sym.aux:=aux;
             sym.aux:=aux;
             inc(symidx);
             inc(symidx);
+	    MaybeSwap(sym);
             FCoffSyms.write(sym,sizeof(sym));
             FCoffSyms.write(sym,sizeof(sym));
           end;
           end;
       end;
       end;
@@ -1503,6 +1862,7 @@ const pemagic : array[0..3] of byte = (
             rel.address:=TObjSection(p).ObjRelocations.Count+1;
             rel.address:=TObjSection(p).ObjRelocations.Count+1;
             rel.sym:=0;
             rel.sym:=0;
             rel.reloctype:=0;
             rel.reloctype:=0;
+	    MaybeSwap(rel);
             FWriter.Write(rel,sizeof(rel));
             FWriter.Write(rel,sizeof(rel));
           end;
           end;
         for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
         for i:=0 to TObjSection(p).ObjRelocations.Count-1 do
@@ -1614,6 +1974,7 @@ const pemagic : array[0..3] of byte = (
               else
               else
                 internalerror(200905071);
                 internalerror(200905071);
             end;
             end;
+	    MaybeSwap(rel);
             FWriter.write(rel,sizeof(rel));
             FWriter.write(rel,sizeof(rel));
           end;
           end;
       end;
       end;
@@ -1745,6 +2106,7 @@ const pemagic : array[0..3] of byte = (
               end
               end
             else
             else
               sechdr.flags:=djencodesechdrflags(secoptions);
               sechdr.flags:=djencodesechdrflags(secoptions);
+            MaybeSwap(sechdr);
             FWriter.write(sechdr,sizeof(sechdr));
             FWriter.write(sechdr,sizeof(sechdr));
           end;
           end;
       end;
       end;
@@ -1794,6 +2156,7 @@ const pemagic : array[0..3] of byte = (
                boheader.NumberOfSymbols:=longword(symidx);
                boheader.NumberOfSymbols:=longword(symidx);
                boheader.PointerToSymbolTable:=sympos;
                boheader.PointerToSymbolTable:=sympos;
                Move(COFF_BIG_OBJ_MAGIC,boheader.UUID,length(boheader.UUID));
                Move(COFF_BIG_OBJ_MAGIC,boheader.UUID,length(boheader.UUID));
+	       MaybeSwap(boheader);
                FWriter.write(boheader,sizeof(boheader));
                FWriter.write(boheader,sizeof(boheader));
              end
              end
            else
            else
@@ -1814,6 +2177,7 @@ const pemagic : array[0..3] of byte = (
                  end
                  end
                else
                else
                  header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS;
                  header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS;
+	       MaybeSwap(header);
                FWriter.write(header,sizeof(header));
                FWriter.write(header,sizeof(header));
              end;
              end;
            { Section headers }
            { 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
             { If number of relocations exceeds 65535, it is stored in address field
               of the first record, and includes this first fake relocation. }
               of the first record, and includes this first fake relocation. }
             FReader.read(rel,sizeof(rel));
             FReader.read(rel,sizeof(rel));
+	    MaybeSwap(rel);
             s.coffrelocs:=rel.address-1;
             s.coffrelocs:=rel.address-1;
             if s.coffrelocs<=65535 then
             if s.coffrelocs<=65535 then
               InternalError(2013012503);
               InternalError(2013012503);
@@ -1917,6 +2282,7 @@ const pemagic : array[0..3] of byte = (
         for i:=1 to s.coffrelocs do
         for i:=1 to s.coffrelocs do
          begin
          begin
            FReader.read(rel,sizeof(rel));
            FReader.read(rel,sizeof(rel));
+	   MaybeSwap(rel);
            case rel.reloctype of
            case rel.reloctype of
 {$ifdef arm}
 {$ifdef arm}
              IMAGE_REL_ARM_ABSOLUTE:
              IMAGE_REL_ARM_ABSOLUTE:
@@ -2061,6 +2427,7 @@ const pemagic : array[0..3] of byte = (
               if bigobj then
               if bigobj then
                 begin
                 begin
                   FCoffSyms.Read(bosym,sizeof(bosym));
                   FCoffSyms.Read(bosym,sizeof(bosym));
+		  MaybeSwap(bosym);
                   if bosym.Name.Offset.Zeroes<>0 then
                   if bosym.Name.Offset.Zeroes<>0 then
                     begin
                     begin
                       { Added for sake of global data analysis }
                       { Added for sake of global data analysis }
@@ -2081,6 +2448,7 @@ const pemagic : array[0..3] of byte = (
               else
               else
                 begin
                 begin
                   FCoffSyms.Read(sym,sizeof(sym));
                   FCoffSyms.Read(sym,sizeof(sym));
+		  MaybeSwap(sym);
                   if plongint(@sym.name)^<>0 then
                   if plongint(@sym.name)^<>0 then
                     begin
                     begin
                       { Added for sake of global data analysis }
                       { Added for sake of global data analysis }
@@ -2293,6 +2661,7 @@ const pemagic : array[0..3] of byte = (
                InputError('Can''t read COFF Header');
                InputError('Can''t read COFF Header');
                exit;
                exit;
              end;
              end;
+           MaybeSwap(header);
            if (header.mach=0) and (header.nsects=$ffff) then
            if (header.mach=0) and (header.nsects=$ffff) then
              begin
              begin
                { either a library or big obj COFF }
                { 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');
                    InputError('Can''t read Big Obj COFF Header');
                    exit;
                    exit;
                  end;
                  end;
+               MaybeSwap(boheader);
                if CompareByte(boheader.UUID,COFF_BIG_OBJ_MAGIC,length(boheader.uuid))<>0 then
                if CompareByte(boheader.UUID,COFF_BIG_OBJ_MAGIC,length(boheader.uuid))<>0 then
                  begin
                  begin
                    { ToDo: this should be treated as a library }
                    { 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');
                   InputError('Error reading COFF Section Headers');
                   exit;
                   exit;
                 end;
                 end;
+               MaybeSwap(sechdr);
                move(sechdr.name,secnamebuf,8);
                move(sechdr.name,secnamebuf,8);
                secnamebuf[8]:=#0;
                secnamebuf[8]:=#0;
                secname:=strpas(secnamebuf);
                secname:=strpas(secnamebuf);
@@ -2513,6 +2884,7 @@ const pemagic : array[0..3] of byte = (
         sym.section:=section;
         sym.section:=section;
         sym.typ:=typ;
         sym.typ:=typ;
         sym.aux:=aux;
         sym.aux:=aux;
+	MaybeSwap(sym);
         FWriter.write(sym,sizeof(sym));
         FWriter.write(sym,sizeof(sym));
       end;
       end;
 
 
@@ -2612,6 +2984,7 @@ const pemagic : array[0..3] of byte = (
               end
               end
             else
             else
               sechdr.flags:=djencodesechdrflags(SecOptions);
               sechdr.flags:=djencodesechdrflags(SecOptions);
+            MaybeSwap(sechdr);
             FWriter.write(sechdr,sizeof(sechdr));
             FWriter.write(sechdr,sizeof(sechdr));
           end;
           end;
       end;
       end;
@@ -2843,6 +3216,7 @@ const pemagic : array[0..3] of byte = (
           end
           end
         else
         else
           header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
           header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
+        MaybeSwap(header);
         FWriter.write(header,sizeof(header));
         FWriter.write(header,sizeof(header));
         { Optional COFF Header }
         { Optional COFF Header }
         if win32 then
         if win32 then
@@ -2938,6 +3312,7 @@ const pemagic : array[0..3] of byte = (
             UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
             UpdateDataDir('.rsrc',PE_DATADIR_RSRC);
             UpdateDataDir('.pdata',PE_DATADIR_PDATA);
             UpdateDataDir('.pdata',PE_DATADIR_PDATA);
             UpdateDataDir('.reloc',PE_DATADIR_RELOC);
             UpdateDataDir('.reloc',PE_DATADIR_RELOC);
+	    MaybeSwap(peoptheader);
             FWriter.write(peoptheader,sizeof(peoptheader));
             FWriter.write(peoptheader,sizeof(peoptheader));
           end
           end
         else
         else
@@ -2951,6 +3326,7 @@ const pemagic : array[0..3] of byte = (
             djoptheader.text_start:=TextExeSec.mempos;
             djoptheader.text_start:=TextExeSec.mempos;
             djoptheader.data_start:=DataExeSec.mempos;
             djoptheader.data_start:=DataExeSec.mempos;
             djoptheader.entry:=EntrySym.Address;
             djoptheader.entry:=EntrySym.Address;
+	    MaybeSwap(djoptheader);
             FWriter.write(djoptheader,sizeof(djoptheader));
             FWriter.write(djoptheader,sizeof(djoptheader));
           end;
           end;
 
 
@@ -3414,20 +3790,6 @@ const pemagic : array[0..3] of byte = (
 {$endif win32}
 {$endif win32}
 
 
     function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
     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
       var
         DLLReader : TObjectReader;
         DLLReader : TObjectReader;
         DosHeader : array[0..$7f] of byte;
         DosHeader : array[0..$7f] of byte;
@@ -3440,6 +3802,7 @@ const pemagic : array[0..3] of byte = (
         expdir    : TPECoffExpDir;
         expdir    : TPECoffExpDir;
         i         : longint;
         i         : longint;
         found     : boolean;
         found     : boolean;
+	header_ok : boolean;
         sechdr    : tCoffSecHdr;
         sechdr    : tCoffSecHdr;
 {$ifdef win32}
 {$ifdef win32}
         p : pointer;
         p : pointer;
@@ -3473,7 +3836,9 @@ const pemagic : array[0..3] of byte = (
             Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
             Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
             exit;
             exit;
           end;
           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.mach<>COFF_MAGIC) or
            (Header.opthdr<>sizeof(tcoffpeoptheader)) then
            (Header.opthdr<>sizeof(tcoffpeoptheader)) then
           begin
           begin
@@ -3482,6 +3847,7 @@ const pemagic : array[0..3] of byte = (
           end;
           end;
         { Read optheader }
         { Read optheader }
         DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
         DLLreader.Read(peheader,sizeof(tcoffpeoptheader));
+	MaybeSwap(peheader);
         { Section headers }
         { Section headers }
         found:=false;
         found:=false;
         for i:=1 to header.nsects do
         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);
                 Comment(V_Error,'Error reading coff file '+DLLName);
                 exit;
                 exit;
               end;
               end;
+            MaybeSwap(sechdr);
             if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
             if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
                (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
                (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
               begin
               begin
@@ -3506,6 +3873,7 @@ const pemagic : array[0..3] of byte = (
         { Process edata }
         { Process edata }
         DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
         DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
         DLLReader.Read(expdir,sizeof(expdir));
         DLLReader.Read(expdir,sizeof(expdir));
+	MaybeSwap(expdir);
         for i:=0 to expdir.NumNames-1 do
         for i:=0 to expdir.NumNames-1 do
           begin
           begin
             DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
             DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);

+ 1 - 1
compiler/ogmap.pas

@@ -81,7 +81,7 @@ implementation
               end;
               end;
             tmp[i]:='x';
             tmp[i]:='x';
             tmp[i-1]:='0';
             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;
       end;
       end;
 
 

+ 15 - 1
compiler/ogwasm.pas

@@ -1669,6 +1669,18 @@ implementation
                           WriteByte(FWasmSections[wsiGlobal],$00);
                           WriteByte(FWasmSections[wsiGlobal],$00);
                           WriteByte(FWasmSections[wsiGlobal],$0B);  { end }
                           WriteByte(FWasmSections[wsiGlobal],$0B);  { end }
                         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
                       else
                         internalerror(2022052801);
                         internalerror(2022052801);
                     end;
                     end;
@@ -1840,10 +1852,12 @@ implementation
           end
           end
         else
         else
           begin
           begin
-            WriteUleb(FWasmCustomSections[wcstTargetFeatures],2);
+            WriteUleb(FWasmCustomSections[wcstTargetFeatures],3);
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteName(FWasmCustomSections[wcstTargetFeatures],'bulk-memory');
             WriteName(FWasmCustomSections[wcstTargetFeatures],'bulk-memory');
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
+            WriteName(FWasmCustomSections[wcstTargetFeatures],'mutable-globals');
+            WriteUleb(FWasmCustomSections[wcstTargetFeatures],$2B);
             WriteName(FWasmCustomSections[wcstTargetFeatures],'sign-ext');
             WriteName(FWasmCustomSections[wcstTargetFeatures],'sign-ext');
           end;
           end;
 
 

File diff suppressed because it is too large
+ 2745 - 2466
compiler/options.pas


+ 1 - 1
compiler/owomflib.pas

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

+ 3 - 1
compiler/pbase.pas

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

+ 32 - 10
compiler/pdecl.pas

@@ -460,6 +460,7 @@ implementation
 
 
       var
       var
         p,paran,pcalln,ptmp : tnode;
         p,paran,pcalln,ptmp : tnode;
+        ecnt : longint;
         i,pcount : sizeint;
         i,pcount : sizeint;
         paras : array of tnode;
         paras : array of tnode;
         od : tobjectdef;
         od : tobjectdef;
@@ -492,8 +493,9 @@ implementation
               if constrsym.typ<>procsym then
               if constrsym.typ<>procsym then
                 internalerror(2018102301);
                 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;
               p:=nil;
+              ecnt:=errorcount;
               typecheckpass(pcalln);
               typecheckpass(pcalln);
 
 
               if (pcalln.nodetype=calln) and assigned(tcallnode(pcalln).procdefinition) and not codegenerror then
               if (pcalln.nodetype=calln) and assigned(tcallnode(pcalln).procdefinition) and not codegenerror then
@@ -555,8 +557,12 @@ implementation
                         paras[i].free;
                         paras[i].free;
                     end;
                     end;
                 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;
                 pcalln.free;
+              end;
             end
             end
           else
           else
             begin
             begin
@@ -912,12 +918,15 @@ implementation
                             Delphi-compatible }
                             Delphi-compatible }
                           hdef2:=tstoreddef(hdef).getcopy;
                           hdef2:=tstoreddef(hdef).getcopy;
                           tobjectdef(hdef2).childof:=tobjectdef(hdef);
                           tobjectdef(hdef2).childof:=tobjectdef(hdef);
+                          tstoreddef(hdef2).orgdef:=tstoreddef(hdef);
                           hdef:=hdef2;
                           hdef:=hdef2;
                         end
                         end
                       else
                       else
                         begin
                         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
                           if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then
                             begin
                             begin
                               p:=comp_expr([ef_accept_equal]);
                               p:=comp_expr([ef_accept_equal]);
@@ -1297,6 +1306,8 @@ implementation
          sym : tsym;
          sym : tsym;
          first,
          first,
          isgeneric : boolean;
          isgeneric : boolean;
+         pw : pcompilerwidestring;
+
       begin
       begin
          if target_info.system in systems_managed_vm then
          if target_info.system in systems_managed_vm then
            message(parser_e_feature_unsupported_for_vm);
            message(parser_e_feature_unsupported_for_vm);
@@ -1336,12 +1347,23 @@ implementation
                       stringconstn:
                       stringconstn:
                         with Tstringconstnode(p) do
                         with Tstringconstnode(p) do
                           begin
                           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;
                           end;
                       else
                       else
                         Message(parser_e_illegal_expression);
                         Message(parser_e_illegal_expression);

+ 12 - 1
compiler/pdecobj.pas

@@ -730,11 +730,22 @@ implementation
         end;
         end;
 
 
       procedure check_inheritance_record_type_helper(var def:tdef);
       procedure check_inheritance_record_type_helper(var def:tdef);
+        var
+          tmp : tstoreddef;
         begin
         begin
           if (def.typ<>errordef) and assigned(current_objectdef.childof) then
           if (def.typ<>errordef) and assigned(current_objectdef.childof) then
             begin
             begin
               if def<>current_objectdef.childof.extendeddef then
               if def<>current_objectdef.childof.extendeddef then
                 begin
                 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);
                   Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
                   def:=generrordef;
                   def:=generrordef;
                 end;
                 end;
@@ -1558,7 +1569,7 @@ implementation
         { set published flag in $M+ mode, it can also be inherited and will
         { 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) }
           be added when the parent class set with tobjectdef.set_parent (PFV) }
         if (cs_generate_rtti in current_settings.localswitches) and
         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);
           include(current_structdef.objectoptions,oo_can_have_published);
 
 
         { Objective-C/Java objectdefs can be "formal definitions", in which case
         { Objective-C/Java objectdefs can be "formal definitions", in which case

+ 73 - 14
compiler/pdecsub.pas

@@ -400,6 +400,8 @@ implementation
                    else
                    else
                      stoptions:=[];
                      stoptions:=[];
                    single_type(arrayelementdef,stoptions);
                    single_type(arrayelementdef,stoptions);
+                   if assigned(arrayelementdef.typesym) then
+                     check_hints(arrayelementdef.typesym,arrayelementdef.typesym.symoptions,arrayelementdef.typesym.deprecatedmsg);
                    tarraydef(hdef).elementdef:=arrayelementdef;
                    tarraydef(hdef).elementdef:=arrayelementdef;
                  end;
                  end;
               end
               end
@@ -469,6 +471,9 @@ implementation
           else
           else
            hdef:=cformaltype;
            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 }
           { File types are only allowed for var and out parameters }
           if (hdef.typ=filedef) and
           if (hdef.typ=filedef) and
              not(varspez in [vs_out,vs_var]) then
              not(varspez in [vs_out,vs_var]) then
@@ -510,6 +515,10 @@ implementation
                     if explicit_paraloc then
                     if explicit_paraloc then
                       Message(parser_e_paraloc_all_paras);
                       Message(parser_e_paraloc_all_paras);
                 end;
                 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;
             end;
         until not try_to_consume(_SEMICOLON);
         until not try_to_consume(_SEMICOLON);
 
 
@@ -541,6 +550,7 @@ implementation
         found,
         found,
         searchagain : boolean;
         searchagain : boolean;
         st,
         st,
+        insertst,
         genericst: TSymtable;
         genericst: TSymtable;
         aprocsym : tprocsym;
         aprocsym : tprocsym;
         popclass : integer;
         popclass : integer;
@@ -850,19 +860,23 @@ implementation
         hadspecialize:=false;
         hadspecialize:=false;
         addgendummy:=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
         if not assigned(genericdef) then
           begin
           begin
             if ppf_anonymous in flags then
             if ppf_anonymous in flags then
               begin
               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);
                   internalerror(2021050101);
                 { generate a unique name for the anonymous function; don't use
                 { generate a unique name for the anonymous function; don't use
                   something like file position however as this might be inside
                   something like file position however as this might be inside
                   an include file that's included multiple times }
                   an include file that's included multiple times }
-                str(checkstack^.symtable.symlist.count,orgsp);
+                str(insertst.symlist.count,orgsp);
                 orgsp:='__FPCINTERNAL__Anonymous_'+orgsp;
                 orgsp:='__FPCINTERNAL__Anonymous_'+orgsp;
                 sp:=upper(orgsp);
                 sp:=upper(orgsp);
                 spnongen:=sp;
                 spnongen:=sp;
@@ -1028,7 +1042,7 @@ implementation
                  if (potype=potype_operator)and(optoken=NOTOKEN) then
                  if (potype=potype_operator)and(optoken=NOTOKEN) then
                    parse_operator_name;
                    parse_operator_name;
 
 
-                 srsym:=tsym(symtablestack.top.Find(sp));
+                 srsym:=tsym(insertst.Find(sp));
 
 
                  { Also look in the globalsymtable if we didn't found
                  { Also look in the globalsymtable if we didn't found
                    the symbol in the localsymtable }
                    the symbol in the localsymtable }
@@ -1098,7 +1112,7 @@ implementation
                   operation }
                   operation }
                 if (potype=potype_operator) then
                 if (potype=potype_operator) then
                   begin
                   begin
-                    aprocsym:=Tprocsym(symtablestack.top.Find(sp));
+                    aprocsym:=Tprocsym(insertst.Find(sp));
                     if aprocsym=nil then
                     if aprocsym=nil then
                       aprocsym:=cprocsym.create('$'+sp);
                       aprocsym:=cprocsym.create('$'+sp);
                   end
                   end
@@ -1111,7 +1125,7 @@ implementation
                   include(aprocsym.symoptions,sp_internal);
                   include(aprocsym.symoptions,sp_internal);
                 if addgendummy then
                 if addgendummy then
                   include(aprocsym.symoptions,sp_generic_dummy);
                   include(aprocsym.symoptions,sp_generic_dummy);
-                symtablestack.top.insertsym(aprocsym);
+                insertst.insertsym(aprocsym);
               end;
               end;
           end;
           end;
 
 
@@ -1172,7 +1186,7 @@ implementation
                   dummysym:=tsym(astruct.symtable.find(spnongen))
                   dummysym:=tsym(astruct.symtable.find(spnongen))
                 else
                 else
                   begin
                   begin
-                    dummysym:=tsym(symtablestack.top.find(spnongen));
+                    dummysym:=tsym(insertst.find(spnongen));
                     if not assigned(dummysym) and
                     if not assigned(dummysym) and
                         (symtablestack.top=current_module.localsymtable) and
                         (symtablestack.top=current_module.localsymtable) and
                         assigned(current_module.globalsymtable) then
                         assigned(current_module.globalsymtable) then
@@ -1186,7 +1200,7 @@ implementation
                     if assigned(astruct) then
                     if assigned(astruct) then
                       astruct.symtable.insertsym(dummysym)
                       astruct.symtable.insertsym(dummysym)
                     else
                     else
-                      symtablestack.top.insertsym(dummysym);
+                      insertst.insertsym(dummysym);
                   end
                   end
                 else if (dummysym.typ<>procsym) and
                 else if (dummysym.typ<>procsym) and
                     (
                     (
@@ -1278,10 +1292,18 @@ implementation
 
 
         { symbol options that need to be kept per procdef }
         { symbol options that need to be kept per procdef }
         pd.fileinfo:=procstartfilepos;
         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);
           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 }
         { parse parameters }
         if token=_LKLAMMER then
         if token=_LKLAMMER then
           begin
           begin
@@ -1390,6 +1412,9 @@ implementation
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
               Message1(type_e_not_automatable,pd.returndef.typename);
               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
             if pd.is_generic or pd.is_specialization then
               symtablestack.pop(pd.parast);
               symtablestack.pop(pd.parast);
             if popclass>0 then
             if popclass>0 then
@@ -2397,6 +2422,31 @@ begin
              else
              else
                import_nr:=longint(v.svalue);
                import_nr:=longint(v.svalue);
            end;
            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 }
           { default is to used the realname of the procedure }
           if (import_nr=0) and not assigned(import_name) then
           if (import_nr=0) and not assigned(import_name) then
             begin
             begin
@@ -2476,7 +2526,7 @@ type
    end;
    end;
 const
 const
   {Should contain the number of procedure directives we support.}
   {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=
   proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
    (
    (
     (
     (
@@ -2983,6 +3033,15 @@ const
       mutexclpocall : [];
       mutexclpocall : [];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
       mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
       mutexclpo     : [po_interrupt]
       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) }
           it because it can already be used somewhere (PFV) }
         if not(po_has_mangledname in pd.procoptions) then
         if not(po_has_mangledname in pd.procoptions) then
           begin
           begin
-            if (po_external in pd.procoptions) then
+            if (po_external in pd.procoptions) and not (po_wasm_suspending in pd.procoptions) then
               begin
               begin
                 { External Procedures are only allowed to change the mangledname
                 { External Procedures are only allowed to change the mangledname
                   in their first declaration }
                   in their first declaration }

+ 5 - 1
compiler/pdecvar.pas

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

+ 18 - 0
compiler/pexports.pas

@@ -176,6 +176,24 @@ implementation
                        include(options,eo_resident);
                        include(options,eo_resident);
                        DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                        DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
                      end;
                      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
                     if (DefString<>'') and UseDeffileForExports then
                      DefFile.AddExport(DefString);
                      DefFile.AddExport(DefString);
                   end;
                   end;

+ 27 - 2
compiler/pexpr.pas

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

+ 8 - 1
compiler/pgenutil.pas

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

+ 58 - 6
compiler/pmodules.pas

@@ -36,7 +36,7 @@ implementation
        globtype,systems,tokens,
        globtype,systems,tokens,
        cutils,cfileutl,cclasses,comphook,
        cutils,cfileutl,cclasses,comphook,
        globals,verbose,fmodule,finput,fppu,globstat,fpcp,fpkg,
        globals,verbose,fmodule,finput,fppu,globstat,fpcp,fpkg,
-       symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
+       symconst,symbase,symtype,symdef,symsym,symtable,defutil,symcreat,
        wpoinfo,
        wpoinfo,
        aasmtai,aasmdata,aasmbase,aasmcpu,
        aasmtai,aasmdata,aasmbase,aasmcpu,
        cgbase,ngenutil,
        cgbase,ngenutil,
@@ -211,23 +211,30 @@ implementation
     procedure maybeloadvariantsunit;
     procedure maybeloadvariantsunit;
       var
       var
         hp : tmodule;
         hp : tmodule;
+        addsystemnamespace : Boolean;
       begin
       begin
         { Do we need the variants unit? Skip this
         { Do we need the variants unit? Skip this
           for VarUtils unit for bootstrapping }
           for VarUtils unit for bootstrapping }
         if not(mf_uses_variants in current_module.moduleflags) or
         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;
           exit;
         { Variants unit already loaded? }
         { Variants unit already loaded? }
         hp:=tmodule(loaded_units.first);
         hp:=tmodule(loaded_units.first);
         while assigned(hp) do
         while assigned(hp) do
           begin
           begin
-            if hp.modulename^='VARIANTS' then
+            if (hp.modulename^='VARIANTS') or (hp.modulename^='SYSTEM.VARIANTS') then
               exit;
               exit;
             hp:=tmodule(hp.next);
             hp:=tmodule(hp.next);
           end;
           end;
         { Variants unit is not loaded yet, load it now }
         { Variants unit is not loaded yet, load it now }
         Message(parser_w_implicit_uses_of_variants_unit);
         Message(parser_w_implicit_uses_of_variants_unit);
+        addsystemnamespace:=namespacelist.Find('System')=Nil;
+        if addsystemnamespace then
+          namespacelist.concat('System');
         AddUnit('variants');
         AddUnit('variants');
+        if addsystemnamespace then
+          namespacelist.Remove('System');
       end;
       end;
 
 
 
 
@@ -316,6 +323,12 @@ implementation
           prevent crashes when accessing .owner }
           prevent crashes when accessing .owner }
         generrorsym.owner:=systemunit;
         generrorsym.owner:=systemunit;
         generrordef.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;
       end;
 
 
 
 
@@ -382,9 +395,21 @@ implementation
         if m_blocks in current_settings.modeswitches then
         if m_blocks in current_settings.modeswitches then
           AddUnit('blockrtl');
           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? }
         { Objective-C support unit? }
         if (m_objectivec1 in current_settings.modeswitches) then
         if (m_objectivec1 in current_settings.modeswitches) then
@@ -1000,6 +1025,11 @@ type
          if not(cs_compilesystem in current_settings.moduleswitches) and
          if not(cs_compilesystem in current_settings.moduleswitches) and
             (token=_USES) then
             (token=_USES) then
            begin
            begin
+             // We do this as late as possible.
+             if Assigned(current_module) then
+               current_module.Loadlocalnamespacelist
+             else
+               current_namespacelist:=Nil;
              loadunits(nil);
              loadunits(nil);
              { has it been compiled at a higher level ?}
              { has it been compiled at a higher level ?}
              if current_module.state=ms_compiled then
              if current_module.state=ms_compiled then
@@ -1233,6 +1263,13 @@ type
          { Generate specializations of objectdefs methods }
          { Generate specializations of objectdefs methods }
          generate_specialization_procs;
          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 }
          { Generate VMTs }
          if Errorcount=0 then
          if Errorcount=0 then
            begin
            begin
@@ -1615,6 +1652,12 @@ type
          { ensure that no packages are picked up from the options }
          { ensure that no packages are picked up from the options }
          packagelist.clear;
          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.}
          {Read the packages used by the package we compile.}
          if (token=_ID) and (idtoken=_REQUIRES) then
          if (token=_ID) and (idtoken=_REQUIRES) then
            begin
            begin
@@ -2163,6 +2206,11 @@ type
          { Load the units used by the program we compile. }
          { Load the units used by the program we compile. }
          if token=_USES then
          if token=_USES then
            begin
            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);
              loadunits(nil);
              consume_semicolon_after_uses:=true;
              consume_semicolon_after_uses:=true;
            end
            end
@@ -2260,6 +2308,10 @@ type
          { Generate specializations of objectdefs methods }
          { Generate specializations of objectdefs methods }
          generate_specialization_procs;
          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 }
          { Generate VMTs }
          if Errorcount=0 then
          if Errorcount=0 then
            write_vmts(current_module.localsymtable,false);
            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
 implementation
 
 
 uses
 uses
-  rgBase, verbose, itcpugas;
+  rgBase, globals, verbose, itcpugas;
 
 
 const
 const
   std_regname_table: TRegNameTable = (
   std_regname_table: TRegNameTable = (

+ 101 - 62
compiler/pparautl.pas

@@ -76,6 +76,8 @@ implementation
 
 
 
 
     procedure insert_funcret_para(pd:tabstractprocdef);
     procedure insert_funcret_para(pd:tabstractprocdef);
+      const
+        name_result='result';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
@@ -87,7 +89,8 @@ implementation
            { if this was originally an anonymous function then this was already
            { if this was originally an anonymous function then this was already
              done earlier }
              done earlier }
            not ((pd.typ=procdef) and tprocdef(pd).was_anonymous) and
            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
          begin
            storepos:=current_tokenpos;
            storepos:=current_tokenpos;
            if pd.typ=procdef then
            if pd.typ=procdef then
@@ -113,7 +116,7 @@ implementation
            else
            else
              paranr:=paranr_result;
              paranr:=paranr_result;
            { Generate result variable accessing function 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);
            pd.parast.insertsym(vs);
            { Store this symbol as funcretsym for procedures }
            { Store this symbol as funcretsym for procedures }
            if pd.typ=procdef then
            if pd.typ=procdef then
@@ -125,12 +128,15 @@ implementation
 
 
 
 
     procedure insert_parentfp_para(pd:tabstractprocdef);
     procedure insert_parentfp_para(pd:tabstractprocdef);
+      const
+        name_parentfp='parentfp';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
         paranr   : longint;
         paranr   : longint;
       begin
       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
           begin
             storepos:=current_tokenpos;
             storepos:=current_tokenpos;
             if pd.typ=procdef then
             if pd.typ=procdef then
@@ -157,14 +163,14 @@ implementation
                not assigned(pd.owner.defowner) or
                not assigned(pd.owner.defowner) or
                (pd.owner.defowner.typ<>procdef) then
                (pd.owner.defowner.typ<>procdef) then
               begin
               begin
-                vs:=cparavarsym.create('$parentfp',paranr,vs_value
+                vs:=cparavarsym.create('$'+name_parentfp,paranr,vs_value
                       ,parentfpvoidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
                       ,parentfpvoidpointertype,[vo_is_parentfp,vo_is_hidden_para]);
               end
               end
             else
             else
               begin
               begin
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                 if not assigned(tprocdef(pd.owner.defowner).parentfpstruct) then
                   build_parentfpstruct(tprocdef(pd.owner.defowner));
                   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]);
                       tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
               end;
             pd.parast.insertsym(vs);
             pd.parast.insertsym(vs);
@@ -175,6 +181,11 @@ implementation
 
 
 
 
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
     procedure insert_self_and_vmt_para(pd:tabstractprocdef);
+      const
+        name_cmd='_cmd';
+        name_self='self';
+        name_block_literal='_block_literal';
+        name_vmt='vmt';
       var
       var
         storepos : tfileposinfo;
         storepos : tfileposinfo;
         vs       : tparavarsym;
         vs       : tparavarsym;
@@ -188,55 +199,65 @@ implementation
            is_objc_class_or_protocol(tprocdef(pd).struct) and
            is_objc_class_or_protocol(tprocdef(pd).struct) and
            (pd.parast.symtablelevel=normal_function_level) then
            (pd.parast.symtablelevel=normal_function_level) then
           begin
           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
           end
         else if (pd.typ=procvardef) and
         else if (pd.typ=procvardef) and
            pd.is_methodpointer then
            pd.is_methodpointer then
           begin
           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
           end
         { while only procvardefs of this type can be declared in Pascal code,
         { while only procvardefs of this type can be declared in Pascal code,
           internally we also generate procdefs of this type when creating
           internally we also generate procdefs of this type when creating
           block wrappers }
           block wrappers }
         else if (po_is_block in pd.procoptions) then
         else if (po_is_block in pd.procoptions) then
           begin
           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
               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;
           end
           end
         else
         else
@@ -264,9 +285,10 @@ implementation
                          { no vmt for record/type helper constructors }
                          { no vmt for record/type helper constructors }
                          is_objectpascal_helper(tprocdef(pd).struct) and
                          is_objectpascal_helper(tprocdef(pd).struct) and
                          (tobjectdef(tprocdef(pd).struct).extendeddef.typ<>objectdef)
                          (tobjectdef(tprocdef(pd).struct).extendeddef.typ<>objectdef)
-                       )) then
+                       )) and
+                   not assigned(pd.parast.find(name_vmt)) then
                  begin
                  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);
                    pd.parast.insertsym(vs);
                  end;
                  end;
 
 
@@ -291,10 +313,10 @@ implementation
                       vsp:=vs_var;
                       vsp:=vs_var;
                     hdef:=selfdef;
                     hdef:=selfdef;
                   end;
                   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
                 if not assigned(vs) or (vs.typ<>paravarsym) or (vs.vardef<>hdef) then
                   begin
                   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);
                     pd.parast.insertsym(vs);
                   end;
                   end;
 
 
@@ -335,8 +357,13 @@ implementation
 
 
            { insert the name of the procedure as alias for the function result,
            { insert the name of the procedure as alias for the function result,
              we can't use realname because that will not work for compilerprocs
              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
              begin
                if assigned(pd.resultname) then
                if assigned(pd.resultname) then
                  hs:=pd.resultname^
                  hs:=pd.resultname^
@@ -384,7 +411,11 @@ implementation
 
 
 
 
     procedure insert_hidden_para(p:TObject;arg:pointer);
     procedure insert_hidden_para(p:TObject;arg:pointer);
+      const
+        name_high = 'high';
+        name_typinfo = 'typinfo';
       var
       var
+        n   : tsymstr;
         hvs : tparavarsym;
         hvs : tparavarsym;
         pd  : tabstractprocdef absolute arg;
         pd  : tabstractprocdef absolute arg;
       begin
       begin
@@ -415,19 +446,23 @@ implementation
            { needs high parameter ? }
            { needs high parameter ? }
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
              begin
+               n:=name_high+name;
+               if not assigned(owner.find(n)) then
+                 begin
 {$ifdef cpu8bitalu}
 {$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}
 {$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
              end
            else
            else
             begin
             begin
@@ -448,9 +483,13 @@ implementation
                end;
                end;
               if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
               if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then
                 begin
                 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;
             end;
          end;
          end;

+ 2 - 0
compiler/ppcx64.lpi

@@ -22,7 +22,9 @@
     </PublishOptions>
     </PublishOptions>
     <RunParams>
     <RunParams>
       <local>
       <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)"/>
         <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>
       </local>
       <FormatVersion Value="2"/>
       <FormatVersion Value="2"/>
       <Modes Count="1">
       <Modes Count="1">

+ 1 - 1
compiler/ppu.pas

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

+ 12 - 12
compiler/procdefutil.pas

@@ -1138,6 +1138,7 @@ implementation
       invokename : tsymstr;
       invokename : tsymstr;
       i : longint;
       i : longint;
       outerself,
       outerself,
+      fpsym,
       selfsym,
       selfsym,
       sym : tsym;
       sym : tsym;
       info : pcapturedsyminfo;
       info : pcapturedsyminfo;
@@ -1146,7 +1147,6 @@ implementation
       invokedef,
       invokedef,
       parentdef,
       parentdef,
       curpd : tprocdef;
       curpd : tprocdef;
-      syms : tfpobjectlist;
     begin
     begin
       capturer:=nil;
       capturer:=nil;
       result:=funcref_intf_for_proc(pd,fileinfo_to_suffix(pd.fileinfo));
       result:=funcref_intf_for_proc(pd,fileinfo_to_suffix(pd.fileinfo));
@@ -1203,24 +1203,24 @@ implementation
           pd.procsym.realname:=invokename;
           pd.procsym.realname:=invokename;
           pd.parast.symtablelevel:=normal_function_level;
           pd.parast.symtablelevel:=normal_function_level;
           pd.localst.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;
           selfsym:=nil;
-          syms:=tfpobjectlist.create(false);
           for i:=0 to pd.parast.symlist.count-1 do
           for i:=0 to pd.parast.symlist.count-1 do
             begin
             begin
               sym:=tsym(pd.parast.symlist[i]);
               sym:=tsym(pd.parast.symlist[i]);
               if sym.typ<>paravarsym then
               if sym.typ<>paravarsym then
                 continue;
                 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;
             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;
           outerself:=nil;
           { complain about all symbols that can't be captured and add the symbols
           { 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 }
             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/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);
     procedure initializevars(p:TObject;arg:pointer);
       var
       var
         b : tblocknode;
         b : tblocknode;
@@ -320,8 +292,6 @@ implementation
                             cloadnode.create(defaultconstsym,defaultconstsym.owner)),
                             cloadnode.create(defaultconstsym,defaultconstsym.owner)),
                         b.left);
                         b.left);
             end
             end
-           else
-             initializedefaultvars(p,arg);
          end;
          end;
       end;
       end;
 
 
@@ -365,15 +335,6 @@ implementation
            current_filepos:=current_procinfo.entrypos;
            current_filepos:=current_procinfo.entrypos;
            current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block);
            current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block);
            current_filepos:=oldfilepos;
            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;
          end;
 
 
         if assigned(current_procinfo.procdef.parentfpstruct) then
         if assigned(current_procinfo.procdef.parentfpstruct) then

+ 13 - 3
compiler/psystem.pas

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

+ 11 - 3
compiler/ptype.pas

@@ -495,7 +495,6 @@ implementation
              case token of
              case token of
                _STRING:
                _STRING:
                  string_dec(def,stoAllowTypeDef in options);
                  string_dec(def,stoAllowTypeDef in options);
-
                _FILE:
                _FILE:
                  begin
                  begin
                     consume(_FILE);
                     consume(_FILE);
@@ -1320,8 +1319,17 @@ implementation
                   Message(sym_e_ill_type_decl_set);
                   Message(sym_e_ill_type_decl_set);
                orddef :
                orddef :
                  begin
                  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
                       (torddef(tt2).low>=0) then
                      // !! def:=csetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high),true)
                      // !! def:=csetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high),true)
                      if Torddef(tt2).high>int64(high(byte)) then
                      if Torddef(tt2).high>int64(high(byte)) then

+ 17 - 6
compiler/riscv/agrvgas.pas

@@ -233,8 +233,8 @@ unit agrvgas;
       const
       const
         arch_str: array[boolean,tcputype] of string[10] = (
         arch_str: array[boolean,tcputype] of string[10] = (
 {$ifdef RISCV32}
 {$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}
 {$endif RISCV32}
 {$ifdef RISCV64}
 {$ifdef RISCV64}
           ('','rv64imac','rv64ima','rv64im','rv64i'),
           ('','rv64imac','rv64ima','rv64im','rv64i'),
@@ -245,13 +245,24 @@ unit agrvgas;
         result := inherited MakeCmdLine;
         result := inherited MakeCmdLine;
         Replace(result,'$ARCH',arch_str[current_settings.fputype=fpu_fd,current_settings.cputype]);
         Replace(result,'$ARCH',arch_str[current_settings.fputype=fpu_fd,current_settings.cputype]);
 {$ifdef RISCV32}
 {$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}
 {$endif RISCV32}
 {$ifdef RISCV64}
 {$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');
           Replace(result,'$ABI','lp64');
+        abi_riscv_lp64f:
+          Replace(result,'$ABI','lp64f');
+	else
+          Replace(result,'$ABI','lp64d');
+      end;
 {$endif RISCV64}
 {$endif RISCV64}
       end;
       end;
 
 

+ 18 - 5
compiler/riscv32/cpuinfo.pas

@@ -40,7 +40,8 @@ Type
        cpu_rv32im,
        cpu_rv32im,
        cpu_rv32i,
        cpu_rv32i,
        cpu_rv32e,
        cpu_rv32e,
-       cpu_rv32imc
+       cpu_rv32imc,
+       cpu_rv32ec
       );
       );
 
 
    tfputype =
    tfputype =
@@ -81,7 +82,12 @@ Type
       ct_ch32v307rc,
       ct_ch32v307rc,
       ct_ch32v307wc,
       ct_ch32v307wc,
       ct_ch32V307vc,
       ct_ch32V307vc,
-      ct_esp32c3
+      ct_esp32c3,
+      ct_CH32V0x,
+      ct_CH32Vxxxx6,
+      ct_CH32Vxxxx8,
+      ct_CH32VxxxxB,
+      ct_CH32VxxxxC
      );
      );
 
 
    tcontrollerdatatype = record
    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:'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:'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:'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}
    {$POP}
 
 
@@ -156,7 +167,8 @@ Const
      'RV32IM',
      'RV32IM',
      'RV32I',
      'RV32I',
      'RV32E',
      'RV32E',
-     'RV32IMC'
+     'RV32IMC',
+     'RV32EC'
    );
    );
 
 
    fputypestr : array[tfputype] of string[8] = (         
    fputypestr : array[tfputype] of string[8] = (         
@@ -197,7 +209,8 @@ Const
        { cpu_rv32im    } [CPURV_HAS_MUL],
        { cpu_rv32im    } [CPURV_HAS_MUL],
        { cpu_rv32i     } [],
        { cpu_rv32i     } [],
        { cpu_rv32e     } [CPURV_HAS_16REGISTERS],
        { 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
 Implementation

+ 8 - 3
compiler/riscv32/cpupara.pas

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

+ 34 - 0
compiler/scandir.pas

@@ -1019,6 +1019,39 @@ unit scandir;
       end;
       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;
     procedure dir_namespace;
       var
       var
         s : string;
         s : string;
@@ -2029,6 +2062,7 @@ unit scandir;
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODE',directive_all, @dir_mode);
         AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
         AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
         AddDirective('NAMESPACE',directive_all, @dir_namespace);
         AddDirective('NAMESPACE',directive_all, @dir_namespace);
+        AddDirective('NAMESPACES',directive_all, @dir_namespaces);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
         AddDirective('NODEFINE',directive_all, @dir_nodefine);
         AddDirective('NOTE',directive_all, @dir_note);
         AddDirective('NOTE',directive_all, @dir_note);
         AddDirective('NOTES',directive_all, @dir_notes);
         AddDirective('NOTES',directive_all, @dir_notes);

+ 1 - 1
compiler/scanner.pas

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

+ 3 - 0
compiler/sparcgen/cgsparc.pas

@@ -1155,6 +1155,9 @@ implementation
         { anybody wants to determine a good value here :)? }
         { anybody wants to determine a good value here :)? }
         if len>100 then
         if len>100 then
           g_concatcopy_move(list,source,dest,len)
           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
         else
           begin
           begin
             count:=len div 4;
             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 }
     { implicitly return same type as the class instance to which the message is sent }
     po_objc_related_result_type,
     po_objc_related_result_type,
     { Delphi-style anonymous function }
     { 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;
   tprocoptions=set of tprocoption;
 
 
@@ -497,7 +505,11 @@ type
     tsk_field_setter,          // Setter for a field (callthrough property is passed in skpara)
     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_block_invoke_procvar,  // Call a procvar to invoke inside a block
     tsk_interface_wrapper,     // Call through to a method from an interface wrapper
     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) }
   { 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}
       'po_noinline',{po_noinline}
       'C-style array-of-const', {po_variadic}
       'C-style array-of-const', {po_variadic}
       'objc-related-result-type', {po_objc_related_result_type}
       '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
 implementation

+ 660 - 6
compiler/symcreat.pas

@@ -126,6 +126,10 @@ interface
   function generate_pkg_stub(pd:tprocdef):tnode;
   function generate_pkg_stub(pd:tprocdef):tnode;
   procedure generate_attr_constrs(attrs:tfpobjectlist);
   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
 implementation
@@ -133,10 +137,11 @@ implementation
   uses
   uses
     cutils,globals,verbose,systems,comphook,fmodule,constexp,
     cutils,globals,verbose,systems,comphook,fmodule,constexp,
     symtable,defutil,symutil,procinfo,
     symtable,defutil,symutil,procinfo,
-    pbase,pdecobj,pdecsub,psub,ptconst,pparautl,
+    pbase,pdecl, pdecobj,pdecsub,psub,ptconst,pparautl,
 {$ifdef jvm}
 {$ifdef jvm}
     pjvm,jvmdef,
     pjvm,jvmdef,
 {$endif jvm}
 {$endif jvm}
+    aasmcpu,symcpu,
     nbas,nld,nmem,ncon,
     nbas,nld,nmem,ncon,
     defcmp,
     defcmp,
     paramgr;
     paramgr;
@@ -229,7 +234,7 @@ implementation
     end;
     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
      var
        oldparse_only: boolean;
        oldparse_only: boolean;
        tmpstr: ansistring;
        tmpstr: ansistring;
@@ -260,7 +265,7 @@ implementation
       flags:=[];
       flags:=[];
       if is_classdef then
       if is_classdef then
         include(flags,rpf_classmethod);
         include(flags,rpf_classmethod);
-      read_proc(flags,usefwpd);
+      result_procdef:=read_proc(flags,usefwpd);
       parse_only:=oldparse_only;
       parse_only:=oldparse_only;
       { remove the temporary macro input file again }
       { remove the temporary macro input file again }
       current_scanner.closeinputfile;
       current_scanner.closeinputfile;
@@ -271,8 +276,16 @@ implementation
 
 
 
 
   function str_parse_method_impl(const str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
   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
     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;
     end;
 
 
 
 
@@ -300,6 +313,34 @@ implementation
       current_scanner.tempopeninputfile;
       current_scanner.tempopeninputfile;
     end;
     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;
   function def_unit_name_prefix_if_toplevel(def: tdef): TSymStr;
     begin
     begin
@@ -869,6 +910,151 @@ implementation
     end;
     end;
 {$endif jvm}
 {$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);
   procedure implement_field_getter(pd: tprocdef);
     var
     var
       i: longint;
       i: longint;
@@ -974,7 +1160,7 @@ implementation
   procedure implement_interface_wrapper(pd: tprocdef);
   procedure implement_interface_wrapper(pd: tprocdef);
     var
     var
       wrapperinfo: pskpara_interface_wrapper;
       wrapperinfo: pskpara_interface_wrapper;
-      callthroughpd: tprocdef;
+      callthroughpd, tmpproc: tprocdef;
       str: ansistring;
       str: ansistring;
       fileinfo: tfileposinfo;
       fileinfo: tfileposinfo;
     begin
     begin
@@ -1002,7 +1188,7 @@ implementation
           fileinfo.line:=1;
           fileinfo.line:=1;
           fileinfo.column:=1;
           fileinfo.column:=1;
         end;
         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);
       dispose(wrapperinfo);
       pd.skpara:=nil;
       pd.skpara:=nil;
     end;
     end;
@@ -1029,11 +1215,86 @@ implementation
         setverbosity('W+');
         setverbosity('W+');
     end;
     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);
   procedure add_synthetic_method_implementations_for_st(st: tsymtable);
     var
     var
       i   : longint;
       i   : longint;
       def : tdef;
       def : tdef;
       pd  : tprocdef;
       pd  : tprocdef;
+      cn  : shortstring;
     begin
     begin
       for i:=0 to st.deflist.count-1 do
       for i:=0 to st.deflist.count-1 do
         begin
         begin
@@ -1109,6 +1370,19 @@ implementation
             tsk_jvm_virtual_clmethod:
             tsk_jvm_virtual_clmethod:
               internalerror(2011032801);
               internalerror(2011032801);
 {$endif jvm}
 {$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:
             tsk_field_getter:
               implement_field_getter(pd);
               implement_field_getter(pd);
             tsk_field_setter:
             tsk_field_setter:
@@ -1119,10 +1393,390 @@ implementation
               implement_interface_wrapper(pd);
               implement_interface_wrapper(pd);
             tsk_call_no_parameters:
             tsk_call_no_parameters:
               implement_call_no_parameters(pd);
               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;
         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);
   procedure add_synthetic_method_implementations(st: tsymtable);
     var
     var

+ 23 - 1
compiler/symdef.pas

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

+ 11 - 1
compiler/symtable.pas

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

+ 1 - 1
compiler/systems.pas

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

+ 2 - 2
compiler/systems/i_embed.pas

@@ -645,7 +645,7 @@ unit i_embed;
             first_parm_offset : 8;
             first_parm_offset : 8;
             stacksize    : 262144;
             stacksize    : 262144;
             stackalign   : 4;
             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';
             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;
             first_parm_offset : 16;
             stacksize    : 262144;
             stacksize    : 262144;
             stackalign   : 8;
             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';
             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;
             first_parm_offset : 0;
             stacksize    : 32*1024*1024;
             stacksize    : 32*1024*1024;
             stackalign   : 8;
             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';
             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
 var
   LdProgram: string='ld';
   LdProgram: string='ld';
 begin
 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';
     LdProgram:='ld.bfd';
   LibrarySuffix:=' ';
   LibrarySuffix:=' ';
   LdSupportsNoResponseFile := (target_info.system in ([system_m68k_netbsd]+systems_darwin));
   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('  .rela.bss      : { *(.rela.bss)		}');
       Add('  .rel.plt       : { *(.rel.plt)		}');
       Add('  .rel.plt       : { *(.rel.plt)		}');
       Add('  .rela.plt      : { *(.rela.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('  /* Internal text space or external memory.  */');
       Add('  .text   :');
       Add('  .text   :');
       Add('  {');
       Add('  {');
@@ -1127,36 +1145,55 @@ begin
       Add('    KEEP (*(.fini0))');
       Add('    KEEP (*(.fini0))');
       Add('     _etext = . ;');
       Add('     _etext = . ;');
       Add('  }  > text');
       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('  }  > data');
       Add('  .eeprom  :');
       Add('  .eeprom  :');
       Add('  {');
       Add('  {');

+ 70 - 28
compiler/systems/t_linux.pas

@@ -288,7 +288,7 @@ const defdynlinker='/lib/ld-linux-aarch64.so.1';
 {$endif xtensa}
 {$endif xtensa}
 
 
 {$ifdef loongarch64}
 {$ifdef loongarch64}
-  const defdynlinker='/usr/lib64/ld-linux-loongarch-lp64d.so.1';
+  const defdynlinker='/lib64/ld-linux-loongarch-lp64d.so.1';
 {$endif loongarch64}
 {$endif loongarch64}
 
 
 procedure SetupDynlinker(out DynamicLinker:string;out libctype:TLibcType);
 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
   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 mips}
   {$ifdef mipsel}
   {$ifdef mipsel}
-                   platform_select='-EL';
+  platformopt:=' -EL';
   {$else}
   {$else}
-                   platform_select='-EB';
+  platformopt:=' -EB';
   {$endif}
   {$endif}
 {$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}
 {$ifdef powerpc64}
   if (target_info.abi=abi_powerpc_elfv2) and
   if (target_info.abi=abi_powerpc_elfv2) and
      (target_info.endian=endian_little) then
      (target_info.endian=endian_little) then
-    platformopt:=' -b elf64-powerpcle -m elf64lppc'
+    begin
+      target_opt:=' -b elf64-powerpcle';
+      emulation_opt:=' -m elf64lppc';
+    end
   else
   else
-    platformopt:=' -b elf64-powerpc -m elf64ppc';
+    begin
+      target_opt:=' -b elf64-powerpc';
+      emulation_opt:=' -m elf64ppc';
+    end;
 {$endif powerpc64}
 {$endif powerpc64}
 {$ifdef xtensa}
 {$ifdef xtensa}
   if target_info.endian=endian_little then
   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
   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
   if target_info.abi=abi_xtensa_call0 then
     platformopt:=platformopt+' --abi-call0'
     platformopt:=platformopt+' --abi-call0'
   else if target_info.abi=abi_xtensa_windowed then
   else if target_info.abi=abi_xtensa_windowed then
@@ -456,11 +491,18 @@ begin
 {$ifdef arm}
 {$ifdef arm}
   platformopt:=' -z noexecstack';
   platformopt:=' -z noexecstack';
 {$endif arm}
 {$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
   with Info do
    begin
    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 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
        when targeting binutils 2.19 or later, we use the "INSERT" command to
        augment the default linkerscript, which also requires -T (normally that
        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,
   import, export, aasmdata, aasmcpu,
   fmodule, ogbase,
   fmodule, ogbase,
 
 
-  symsym, symdef,
+  symconst, symsym, symdef, symcpu,
 
 
   link,
   link,
 
 
@@ -247,9 +247,18 @@ end;
 procedure texportlibwasi.exportprocedure(hp: texported_item);
 procedure texportlibwasi.exportprocedure(hp: texported_item);
 var
 var
   nm : TSymStr;
   nm : TSymStr;
+  pd: tcpuprocdef;
 begin
 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;
 end;
 
 
 procedure texportlibwasi.exportvar(hp: texported_item);
 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('  SYMBOL __CTOR_LIST__');
             Concat('  SYMBOL __CTOR_LIST__');
             Concat('  LONG -1');
             Concat('  LONG -1');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG -1');
             Concat('  LONG -1');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  OBJSECTION .ctor*');
             Concat('  OBJSECTION .ctor*');
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL ___DTOR_LIST__');
             Concat('  SYMBOL ___DTOR_LIST__');
             Concat('  SYMBOL __DTOR_LIST__');
             Concat('  SYMBOL __DTOR_LIST__');
             Concat('  LONG -1');
             Concat('  LONG -1');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG -1');
             Concat('  LONG -1');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  OBJSECTION .dtor*');
             Concat('  OBJSECTION .dtor*');
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL etext');
             Concat('  SYMBOL etext');
             Concat('ENDEXESECTION');
             Concat('ENDEXESECTION');
             Concat('EXESECTION .data');
             Concat('EXESECTION .data');
@@ -1061,9 +1061,9 @@ implementation
             Concat('  PROVIDE ___crt_xl_end__');
             Concat('  PROVIDE ___crt_xl_end__');
             { Add a nil pointer as last element }
             { Add a nil pointer as last element }
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Concat('  LONG 0');
             Concat('  LONG 0');
-{$endif x86_64}
+{$endif cpu64}
             Concat('  SYMBOL ___crt_xp_start__');
             Concat('  SYMBOL ___crt_xp_start__');
             Concat('  OBJSECTION .CRT$XP*'); {  /* Pre-termination */');}
             Concat('  OBJSECTION .CRT$XP*'); {  /* Pre-termination */');}
             Concat('  SYMBOL ___crt_xp_end__');
             Concat('  SYMBOL ___crt_xp_end__');
@@ -1255,7 +1255,9 @@ implementation
              end;
              end;
 
 
             Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
             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)');
             Add('OUTPUT_FORMAT(pei-x86-64)');
 {$else not 86_64}
 {$else not 86_64}
             Add('OUTPUT_FORMAT(pei-i386)');
             Add('OUTPUT_FORMAT(pei-i386)');
@@ -1276,22 +1278,22 @@ implementation
             Add('    . = ALIGN(8);');
             Add('    . = ALIGN(8);');
             Add('     ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
             Add('     ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
             Add('    LONG (-1);');
             Add('    LONG (-1);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (-1);');
             Add('    LONG (-1);');
-{$endif x86_64}
+{$endif cpu64}
             Add('    *(.ctors); *(.ctor); *(SORT(.ctors.*));  LONG (0);');
             Add('    *(.ctors); *(.ctor); *(SORT(.ctors.*));  LONG (0);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (0);');
             Add('    LONG (0);');
-{$endif x86_64}
+{$endif cpu64}
             Add('     ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
             Add('     ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
             Add('    LONG (-1);');
             Add('    LONG (-1);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (-1);');
             Add('    LONG (-1);');
-{$endif x86_64}
+{$endif cpu64}
             Add('    *(.dtors); *(.dtor); *(SORT(.dtors.*));  LONG (0);');
             Add('    *(.dtors); *(.dtor); *(SORT(.dtors.*));  LONG (0);');
-{$ifdef x86_64}
+{$ifdef cpu64}
             Add('    LONG (0);');
             Add('    LONG (0);');
-{$endif x86_64}
+{$endif cpu64}
             Add('     *(.fini)');
             Add('     *(.fini)');
             Add('    PROVIDE (etext = .);');
             Add('    PROVIDE (etext = .);');
             Add('    *(.gcc_except_table)');
             Add('    *(.gcc_except_table)');

+ 10 - 0
compiler/tokens.pas

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

+ 35 - 1
compiler/utils/dummyas.pp

@@ -39,7 +39,7 @@ begin
 end;
 end;
 
 
 var
 var
-  i : longint;
+  i,j : longint;
   param : string;
   param : string;
   skipnext : boolean;
   skipnext : boolean;
 begin
 begin
@@ -58,6 +58,36 @@ begin
           skipnext:=true;
           skipnext:=true;
           object_name:=ParamStr(i+1);
           object_name:=ParamStr(i+1);
         end
         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
       else if (Param[1]='-') then
         begin
         begin
           { option Param not handled }
           { option Param not handled }
@@ -73,6 +103,10 @@ begin
               Writeln(stderr,'first non option param =',assembler_name);
               Writeln(stderr,'first non option param =',assembler_name);
               Writeln(stderr,'second non option param =',Param);
               Writeln(stderr,'second non option param =',Param);
               Writeln(stderr,'Don''t know how to handle this!');
               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);
               halt(1);
             end;
             end;
         end;
         end;

+ 199 - 53
compiler/utils/fpc.pp

@@ -126,7 +126,7 @@ Const
     {$endif sparc}
     {$endif sparc}
     {$ifdef sparc64}
     {$ifdef sparc64}
          ppcbin:='ppcsparc64';
          ppcbin:='ppcsparc64';
-          processorname:='sparc64';
+         processorname:='sparc64';
     {$endif sparc64}
     {$endif sparc64}
     {$ifdef x86_64}
     {$ifdef x86_64}
          ppcbin:='ppcx64';
          ppcbin:='ppcx64';
@@ -183,6 +183,8 @@ Const
     end;
     end;
 
 
   var
   var
+    warn : Boolean;
+    ShowErrno : Boolean;
     extrapath : ansistring;
     extrapath : ansistring;
 
 
   function findexe(var ppcbin:string): boolean;
   function findexe(var ppcbin:string): boolean;
@@ -261,18 +263,146 @@ Const
           writeln(processorname);
           writeln(processorname);
           halt(0);
           halt(0);
         end;
         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
   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;
      i : longint;
      errorvalue     : Longint;
      errorvalue     : Longint;
 
 
@@ -283,54 +413,70 @@ Const
        Inc(PPCCommandLineLen);
        Inc(PPCCommandLineLen);
      end;
      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
   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
           else
             begin
             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;
+    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;
        end;
-     SetLength(ppccommandline,ppccommandlinelen);
-
-     ppcbin:=findcompiler(ppcbin,cpusuffix,versionstr);
+     SetLength(ppccommandline, ppccommandlinelen);
+     ppcbin := findcompiler(ppcbin, cpusuffix, exesuffix);
 
 
      { call ppcXXX }
      { call ppcXXX }
      try
      try

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

@@ -2339,10 +2339,15 @@ const
         'Link using native linker', {cs_link_native}
         'Link using native linker', {cs_link_native}
         'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19}
         'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19}
         'Link using vlink', {cs_link_vlink}
         '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}
         'Link-Time Optimization disabled for system unit', {cs_lto_nosystem}
         'Assemble on target OS', {cs_asemble_on_target}
         'Assemble on target OS', {cs_asemble_on_target}
         'Use a memory model to support >2GB static data on 64 Bit target', {cs_large}
         '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] =
     localswitchname : array[tlocalswitch] of string[50] =
        { Switches which can be changed locally }
        { Switches which can be changed locally }
@@ -2872,6 +2877,12 @@ begin
     end;
     end;
   writeln;
   writeln;
 
 
+  if df_unique in defoptions then
+    begin
+      write  ([space,'      OriginalDef : ']);
+      readderef(space);
+    end;
+
   if df_genconstraint in defoptions then
   if df_genconstraint in defoptions then
     begin
     begin
       ppufile.getset(tppuset1(genconstr));
       ppufile.getset(tppuset1(genconstr));
@@ -3041,7 +3052,9 @@ const
      (mask:po_noinline;        str: 'Never inline'),
      (mask:po_noinline;        str: 'Never inline'),
      (mask:po_variadic;        str: 'C VarArgs with array-of-const para'),
      (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_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
 var
   proctypeoption  : tproctypeoption;
   proctypeoption  : tproctypeoption;
@@ -4080,6 +4093,8 @@ begin
                      WriteWarning('Invalid x86 pointer type: ' + IntToStr(b));
                      WriteWarning('Invalid x86 pointer type: ' + IntToStr(b));
                  end;
                  end;
                end;
                end;
+             if tsystemcpu(ppufile.header.common.cpu)=cpu_wasm32 then
+               writeln([space,'   WASM externref : ',(getbyte<>0)]);
            end;
            end;
 
 
          iborddef :
          iborddef :

+ 6 - 26
compiler/verbose.pas

@@ -41,30 +41,6 @@ interface
 
 
 {$i msgidx.inc}
 {$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
     var
       msg : pmessage;
       msg : pmessage;
 
 
@@ -351,6 +327,10 @@ implementation
                          status.verbosity:=status.verbosity and (not V_Info)
                          status.verbosity:=status.verbosity and (not V_Info)
                        else
                        else
                          status.verbosity:=status.verbosity or V_Info;
                          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
                  'L' : if inverse then
                          status.verbosity:=status.verbosity and (not V_Status)
                          status.verbosity:=status.verbosity and (not V_Status)
                        else
                        else
@@ -622,7 +602,7 @@ implementation
       { Create status info }
       { Create status info }
         UpdateStatus;
         UpdateStatus;
       { Fix replacements }
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
       { show comment }
       { show comment }
         if do_comment(l,s) or dostop then
         if do_comment(l,s) or dostop then
           raise ECompilerAbort.Create;
           raise ECompilerAbort.Create;
@@ -754,7 +734,7 @@ implementation
       { fix status }
       { fix status }
         UpdateStatus;
         UpdateStatus;
       { Fix replacements }
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
         if status.showmsgnrs and ((v and V_Normal)=0) then
         if status.showmsgnrs and ((v and V_Normal)=0) then
           s:='('+tostr(w)+') '+s;
           s:='('+tostr(w)+') '+s;
         if doqueue then
         if doqueue then

+ 17 - 2
compiler/wasm32/aasmcpu.pas

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

+ 11 - 4
compiler/wasm32/agllvmmc.pas

@@ -241,7 +241,14 @@ implementation
             else
             else
               begin
               begin
                 result:=result+'nan';
                 result:=result+'nan';
+{$ifndef CPUMIPS}
                 if fraction<>(int64(1) shl (fraction_bits-1)) then
                 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)+')';
                   result:=result+'(0x'+HexStr(fraction,fraction_hexdigits)+')';
               end;
               end;
           end
           end
@@ -372,7 +379,7 @@ implementation
          id     : as_wasm32_llvm_mc_v11;
          id     : as_wasm32_llvm_mc_v11;
          idtxt  : 'LLVM-MC-11';
          idtxt  : 'LLVM-MC-11';
          asmbin : '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];
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
          labelprefix : '.L';
@@ -385,7 +392,7 @@ implementation
          id     : as_wasm32_llvm_mc_v12;
          id     : as_wasm32_llvm_mc_v12;
          idtxt  : 'LLVM-MC-12';
          idtxt  : 'LLVM-MC-12';
          asmbin : '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];
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
          labelprefix : '.L';
@@ -398,7 +405,7 @@ implementation
          id     : as_wasm32_llvm_mc_v13;
          id     : as_wasm32_llvm_mc_v13;
          idtxt  : 'LLVM-MC-13';
          idtxt  : 'LLVM-MC-13';
          asmbin : '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];
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
          labelprefix : '.L';
@@ -411,7 +418,7 @@ implementation
          id     : as_wasm32_llvm_mc;
          id     : as_wasm32_llvm_mc;
          idtxt  : 'LLVM-MC';
          idtxt  : 'LLVM-MC';
          asmbin : '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];
          supported_targets : [system_wasm32_embedded,system_wasm32_wasi];
          flags : [af_smartlink_sections];
          flags : [af_smartlink_sections];
          labelprefix : '.L';
          labelprefix : '.L';

+ 20 - 0
compiler/wasm32/cgcpu.pas

@@ -41,6 +41,8 @@ interface
         function  getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
         function  getaddressregister(list:TAsmList):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 do_register_allocation(list:TAsmList;headertai:tai);override;
         procedure a_label_pascal_goto_target(list : TAsmList;l : tasmlabel);override;
         procedure a_label_pascal_goto_target(list : TAsmList;l : tasmlabel);override;
       end;
       end;
@@ -74,6 +76,10 @@ implementation
           [RS_R0],first_fpu_imreg,[]);
           [RS_R0],first_fpu_imreg,[]);
         rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
         rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
           [RS_R0],first_mm_imreg,[]);
           [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;
       end;
 
 
 
 
@@ -82,6 +88,8 @@ implementation
         rg[R_INTREGISTER].free;
         rg[R_INTREGISTER].free;
         rg[R_FPUREGISTER].free;
         rg[R_FPUREGISTER].free;
         rg[R_MMREGISTER].free;
         rg[R_MMREGISTER].free;
+        rg[R_FUNCREFREGISTER].free;
+        rg[R_EXTERNREFREGISTER].free;
         inherited done_register_allocators;
         inherited done_register_allocators;
       end;
       end;
 
 
@@ -113,6 +121,18 @@ implementation
       end;
       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);
     procedure tcgwasm.do_register_allocation(list:TAsmList;headertai:tai);
       begin
       begin
         { We only run the "register allocation" once for an arbitrary allocator,
         { 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
       // bulk memory operations
       a_memory_copy, a_memory_fill, a_memory_init, a_data_drop,
       a_memory_copy, a_memory_fill, a_memory_init, a_data_drop,
       // reference instructions
       // 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
       // 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,
       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
       // saturating truncation instructions
@@ -230,6 +230,12 @@ uses
       { MM Super register first and last }
       { MM Super register first and last }
       first_mm_imreg     = 4;
       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 = (
       regnumber_table : array[tregisterindex] of tregister = (
         {$i rwasmnum.inc}
         {$i rwasmnum.inc}
       );
       );

+ 1 - 0
compiler/wasm32/cpunode.pas

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

+ 100 - 7
compiler/wasm32/hlcgcpu.pas

@@ -65,6 +65,8 @@ uses
       procedure decstack(list : TAsmList;slots: longint);
       procedure decstack(list : TAsmList;slots: longint);
 
 
       class function def2regtyp(def: tdef): tregistertype; override;
       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;
       procedure a_load_const_cgpara(list : TAsmList;tosize : tdef;a : tcgint;const cgpara : TCGPara);override;
 
 
@@ -256,7 +258,7 @@ implementation
     defutil,cpupi,
     defutil,cpupi,
     aasmtai,aasmcpu,
     aasmtai,aasmcpu,
     symtable,symcpu,
     symtable,symcpu,
-    procinfo,cpuinfo,cgcpu,tgobj,tgcpu,paramgr;
+    procinfo,cpuinfo,cgobj,cgcpu,tgobj,tgcpu,paramgr;
 
 
   const
   const
     TOpCG2IAsmOp : array[topcg] of TAsmOp=(
     TOpCG2IAsmOp : array[topcg] of TAsmOp=(
@@ -364,13 +366,39 @@ implementation
 
 
   class function thlcgwasm.def2regtyp(def: tdef): tregistertype;
   class function thlcgwasm.def2regtyp(def: tdef): tregistertype;
     begin
     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
         result:=R_FPUREGISTER
       else
       else
         result:=inherited;
         result:=inherited;
     end;
     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);
   procedure thlcgwasm.a_load_const_cgpara(list: TAsmList; tosize: tdef; a: tcgint; const cgpara: TCGPara);
     begin
     begin
       tosize:=get_para_push_size(tosize);
       tosize:=get_para_push_size(tosize);
@@ -421,6 +449,18 @@ implementation
                 internalerror(2010110702);
                 internalerror(2010110702);
             end;
             end;
           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
         else
           internalerror(2010110703);
           internalerror(2010110703);
       end;
       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);
   procedure thlcgwasm.a_cmp_const_ref_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; const ref: treference);
     var
     var
       tmpref: treference;
       tmpref: treference;
+      regtyp: TRegisterType;
     begin
     begin
       tmpref:=ref;
       tmpref:=ref;
       if tmpref.base<>NR_EVAL_STACK_BASE then
       if tmpref.base<>NR_EVAL_STACK_BASE then
         a_load_ref_stack(list,size,tmpref,prepare_stack_for_ref(list,tmpref,false));
         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;
     end;
 
 
   procedure thlcgwasm.a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
   procedure thlcgwasm.a_cmp_const_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; a: tcgint; reg: tregister);
+    var
+      regtyp: TRegisterType;
     begin
     begin
       a_load_reg_stack(list,size,reg);
       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;
     end;
 
 
   procedure thlcgwasm.a_cmp_ref_reg_stack(list: TAsmList; size: tdef; cmp_op: topcmp; const ref: treference; reg: tregister);
   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;
               end;
             else
             else
               internalerror(2011010302);
               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
         else
           internalerror(2011010301);
           internalerror(2011010301);
       end;
       end;

+ 1 - 1
compiler/wasm32/itcpugas.pas

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

+ 27 - 1
compiler/wasm32/nwasmcal.pas

@@ -40,6 +40,7 @@ interface
 
 
        twasmcallnode = class(tcgcallnode)
        twasmcallnode = class(tcgcallnode)
        protected
        protected
+         function  pass_typecheck:tnode;override;
          procedure extra_post_call_code; override;
          procedure extra_post_call_code; override;
          procedure do_release_unused_return_value; override;
          procedure do_release_unused_return_value; override;
          procedure set_result_location(realresdef: tstoreddef); override;
          procedure set_result_location(realresdef: tstoreddef); override;
@@ -49,10 +50,35 @@ interface
 implementation
 implementation
 
 
     uses
     uses
-      globals, globtype, aasmdata, defutil, tgobj, hlcgcpu, symconst, symcpu;
+      globals, globtype, verbose, aasmdata, defutil, tgobj, hlcgcpu, symconst, symsym, symcpu;
 
 
       { twasmcallnode }
       { 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;
     procedure twasmcallnode.extra_post_call_code;
       begin
       begin
         thlcgwasm(hlcg).g_adjust_stack_after_call(current_asmdata.CurrAsmList,procdefinition);
         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_int_to_bool;override;
          procedure second_ansistring_to_pchar;override;
          procedure second_ansistring_to_pchar;override;
          procedure second_class_to_intf;override;
          procedure second_class_to_intf;override;
+       public
+         function target_specific_explicit_typeconv: boolean;override;
        end;
        end;
 
 
 implementation
 implementation
@@ -253,6 +255,16 @@ implementation
           internalerror(2002081301);
           internalerror(2002081301);
       end;
       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
 begin
   ctypeconvnode:=twasmtypeconvnode;
   ctypeconvnode:=twasmtypeconvnode;
 end.
 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,
       globtype,globals,
       cgobj,
       cgobj,
       tgobj,
       tgobj,
-      symtype,symdef,symcpu;
+      symtype,symdef,symconst,symcpu;
 
 
     { trgcpu }
     { trgcpu }
 
 
@@ -326,7 +326,9 @@ implementation
         spill_temps : tspilltemps;
         spill_temps : tspilltemps;
         templist : TAsmList;
         templist : TAsmList;
         intrg,
         intrg,
-        fprg     : trgcpu;
+        fprg,
+        frrg,
+        errg     : trgcpu;
         p,q      : tai;
         p,q      : tai;
         size     : longint;
         size     : longint;
 
 
@@ -340,6 +342,7 @@ implementation
         pidx    : integer;
         pidx    : integer;
         t: treftemppos;
         t: treftemppos;
         def: tdef;
         def: tdef;
+        wasmfuncreftype: tprocvardef;
 
 
       begin
       begin
         { Since there are no actual registers, we simply spill everything. We
         { Since there are no actual registers, we simply spill everything. We
@@ -350,9 +353,13 @@ implementation
         { get references to all register allocators }
         { get references to all register allocators }
         intrg:=trgcpu(cg.rg[R_INTREGISTER]);
         intrg:=trgcpu(cg.rg[R_INTREGISTER]);
         fprg:=trgcpu(cg.rg[R_FPUREGISTER]);
         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 }
         { determine the live ranges of all registers }
         intrg.insert_regalloc_info_all(list);
         intrg.insert_regalloc_info_all(list);
         fprg.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 }
         { Don't do the actual allocation when -sr is passed }
         if (cs_no_regalloc in current_settings.globalswitches) then
         if (cs_no_regalloc in current_settings.globalswitches) then
           exit;
           exit;
@@ -361,8 +368,13 @@ implementation
         { allocate room to store the virtual register -> temp mapping }
         { allocate room to store the virtual register -> temp mapping }
         spill_temps[R_INTREGISTER]:=allocmem(sizeof(treference)*intrg.maxreg);
         spill_temps[R_INTREGISTER]:=allocmem(sizeof(treference)*intrg.maxreg);
         spill_temps[R_FPUREGISTER]:=allocmem(sizeof(treference)*fprg.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 }
         { List to insert temp allocations into }
         templist:=TAsmList.create;
         templist:=TAsmList.create;
+        {  }
+        wasmfuncreftype:=cprocvardef.create(normal_function_level,true);
+        include(wasmfuncreftype.procoptions,po_wasm_funcref);
         { allocate/replace all registers }
         { allocate/replace all registers }
         p:=headertai;
         p:=headertai;
         insbefore := nil;
         insbefore := nil;
@@ -408,6 +420,16 @@ implementation
                           else
                           else
                             internalerror(2020120804);
                             internalerror(2020120804);
                         end;
                         end;
+                      R_FUNCREFREGISTER:
+                        begin
+                          size:=0;
+                          def:=wasmfuncreftype;
+                        end;
+                      R_EXTERNREFREGISTER:
+                        begin
+                          size:=0;
+                          def:=wasmvoidexternreftype;
+                        end;
                       else
                       else
                         internalerror(2010122912);
                         internalerror(2010122912);
                     end;
                     end;
@@ -445,7 +467,11 @@ implementation
           list.insertListBefore(nil, templist);
           list.insertListBefore(nil, templist);
         freemem(spill_temps[R_INTREGISTER]);
         freemem(spill_temps[R_INTREGISTER]);
         freemem(spill_temps[R_FPUREGISTER]);
         freemem(spill_temps[R_FPUREGISTER]);
+        freemem(spill_temps[R_FUNCREFREGISTER]);
+        freemem(spill_temps[R_EXTERNREFREGISTER]);
         templist.free;
         templist.free;
+        { Not needed anymore }
+        wasmfuncreftype.owner.deletedef(wasmfuncreftype);
       end;
       end;
 
 
 end.
 end.

+ 1 - 1
compiler/wasm32/strinst.inc

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

+ 131 - 12
compiler/wasm32/symcpu.pas

@@ -60,6 +60,16 @@ type
   tcpuerrordefclass = class of tcpuerrordef;
   tcpuerrordefclass = class of tcpuerrordef;
 
 
   tcpupointerdef = class(tpointerdef)
   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;
   end;
   tcpupointerdefclass = class of tcpupointerdef;
   tcpupointerdefclass = class of tcpupointerdef;
 
 
@@ -107,9 +117,14 @@ type
     { generated assembler code; used by WebAssembly backend so it can afterwards
     { generated assembler code; used by WebAssembly backend so it can afterwards
       easily write out all methods grouped per class }
       easily write out all methods grouped per class }
     exprasmlist  : TAsmList;
     exprasmlist  : TAsmList;
+    promising_first_export_name: string;
+    promising_last_export_name: string;
     destructor destroy; override;
     destructor destroy; override;
     function create_functype: TWasmFuncType;
     function create_functype: TWasmFuncType;
     function is_pushleftright: boolean; override;
     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;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
   tcpuprocdefclass = class of tcpuprocdef;
 
 
@@ -196,6 +211,14 @@ type
 const
 const
   pbestrealtype : ^tdef = @s64floattype;
   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
 implementation
 
 
@@ -209,6 +232,21 @@ implementation
     tgcpu
     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
                                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
                              tcpuprocdef
 ****************************************************************************}
 ****************************************************************************}
@@ -239,7 +324,11 @@ implementation
           for i:=0 to pd.paras.Count-1 do
           for i:=0 to pd.paras.Count-1 do
             begin
             begin
               prm := tcpuparavarsym(pd.paras[i]);
               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:
                 OS_8..OS_32, OS_S8..OS_S32:
                   result.add_param(wbt_i32);
                   result.add_param(wbt_i32);
                 OS_64, OS_S64:
                 OS_64, OS_S64:
@@ -264,16 +353,7 @@ implementation
         begin
         begin
           if not defToWasmBasic(pd.returndef,bt) then
           if not defToWasmBasic(pd.returndef,bt) then
             bt:=wbt_i32;
             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;
     end;
     end;
 
 
@@ -297,6 +377,41 @@ implementation
     end;
     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
                              tcpuprocvardef
 ****************************************************************************}
 ****************************************************************************}
@@ -328,7 +443,11 @@ implementation
     function tcpustaticvarsym.try_get_wasm_global_vardef_type(out res: TWasmBasicType): Boolean;
     function tcpustaticvarsym.try_get_wasm_global_vardef_type(out res: TWasmBasicType): Boolean;
       begin
       begin
         Result:=True;
         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
           res:=wbt_i64
         else if is_pointer(vardef) then
         else if is_pointer(vardef) then
           res:=wbt_i32
           res:=wbt_i32

+ 28 - 1
compiler/wasm32/tgcpu.pas

@@ -83,6 +83,7 @@ unit tgcpu;
          procedure ungettemp(list: TAsmList; const ref : treference); override;
          procedure ungettemp(list: TAsmList; const ref : treference); override;
          procedure allocframepointer(list: TAsmList; out ref: treference);
          procedure allocframepointer(list: TAsmList; out ref: treference);
          procedure allocbasepointer(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;
        end;
 
 
     function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
     function defToWasmBasic(def: tdef; var wbt: TWasmBasicType): Boolean;
@@ -105,7 +106,11 @@ unit tgcpu;
       if not Result then
       if not Result then
         Exit;
         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
         wbt := wbt_i32 // wasm32
       else if is_currency(def) then
       else if is_currency(def) then
         wbt := wbt_i64
         wbt := wbt_i64
@@ -235,6 +240,13 @@ unit tgcpu;
             else
             else
               internalerror(2020121801);
               internalerror(2020121801);
           end
           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
         else
           inherited;
           inherited;
       end;
       end;
@@ -284,6 +296,21 @@ unit tgcpu;
         updateFirstTemp;
         updateFirstTemp;
       end;
       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;
     function TWasmLocalVars.alloc(bt: TWasmBasicType): integer;
       var
       var
         i : integer;
         i : integer;

+ 30 - 2
compiler/x86/aasmcpu.pas

@@ -659,6 +659,8 @@ interface
     function get_ref_address_size(const ref:treference):byte;
     function get_ref_address_size(const ref:treference):byte;
     function get_default_segment_of_ref(const ref:treference):tregister;
     function get_default_segment_of_ref(const ref:treference):tregister;
     procedure optimize_ref(var ref:treference; inlineasm: boolean);
     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_load(const ref:treference;r:tregister):Taicpu;
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
     function spilling_create_store(r:tregister; const ref:treference):Taicpu;
@@ -2490,9 +2492,9 @@ implementation
           (0, 1, 2, 3, 6, 7, 5, 4);
           (0, 1, 2, 3, 6, 7, 5, 4);
         maxsupreg: array[tregistertype] of tsuperregister=
         maxsupreg: array[tregistertype] of tsuperregister=
 {$ifdef x86_64}
 {$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}
 {$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}
 {$endif x86_64}
       var
       var
         rs: tsuperregister;
         rs: tsuperregister;
@@ -5581,6 +5583,32 @@ implementation
       end;
       end;
     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;
     procedure InitAsm;
       begin
       begin
         build_spilling_operation_type_table;
         build_spilling_operation_type_table;

+ 30 - 0
compiler/x86/agx86att.pas

@@ -521,6 +521,20 @@ interface
             dollarsign: '$';
             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}
 {$else x86_64}
        as_i386_as_info : tasminfo =
        as_i386_as_info : tasminfo =
           (
           (
@@ -600,6 +614,20 @@ interface
             dollarsign: '$';
             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 =
        as_i386_gas_info : tasminfo =
           (
           (
             id     : as_ggas;
             id     : as_ggas;
@@ -641,6 +669,7 @@ initialization
   RegisterAssembler(as_x86_64_gas_info,Tx86ATTAssembler);
   RegisterAssembler(as_x86_64_gas_info,Tx86ATTAssembler);
   RegisterAssembler(as_x86_64_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_x86_64_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_x86_64_clang_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);
   RegisterAssembler(as_x86_64_solaris_info,Tx86ATTAssembler);
 {$else x86_64}
 {$else x86_64}
   RegisterAssembler(as_i386_as_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_as_info,Tx86ATTAssembler);
@@ -648,6 +677,7 @@ initialization
   RegisterAssembler(as_i386_yasm_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_yasm_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_i386_gas_darwin_info,Tx86AppleGNUAssembler);
   RegisterAssembler(as_i386_clang_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_as_aout_info,Tx86AoutGNUAssembler);
   RegisterAssembler(as_i386_solaris_info,Tx86ATTAssembler);
   RegisterAssembler(as_i386_solaris_info,Tx86ATTAssembler);
 {$endif x86_64}
 {$endif x86_64}

+ 115 - 26
compiler/x86/aoptx86.pas

@@ -2254,12 +2254,22 @@ unit aoptx86;
                 exit;
                 exit;
               end;
               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
               begin
                 if MatchInstruction(hp1,[taicpu(p).opcode],[S_NO]) and
                 if MatchInstruction(hp1,[taicpu(p).opcode],[S_NO]) and
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   begin
                   begin
                     { vmova* reg1,reg2
                     { vmova* reg1,reg2
+                      ...
                       vmova* reg2,reg3
                       vmova* reg2,reg3
                       dealloc reg2
                       dealloc reg2
                       =>
                       =>
@@ -2267,16 +2277,22 @@ unit aoptx86;
                     TransferUsedRegs(TmpUsedRegs);
                     TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     UpdateUsedRegs(TmpUsedRegs, tai(p.next));
                     if MatchOpType(taicpu(hp1),top_reg,top_reg) and
                     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
                       not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
                       begin
                       begin
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVA*2(V)MOVA* 1',p);
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVA*2(V)MOVA* 1',p);
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
+
+                        TransferUsedRegs(TmpUsedRegs);
+                        AllocRegBetween(taicpu(hp1).oper[1]^.reg, p, hp1, TmpUsedRegs);
+
                         RemoveInstruction(hp1);
                         RemoveInstruction(hp1);
                         result:=true;
                         result:=true;
                         exit;
                         exit;
                       end;
                       end;
                     { special case:
                     { special case:
                       vmova* reg1,<op>
                       vmova* reg1,<op>
+                      ...
                       vmova* <op>,reg1
                       vmova* <op>,reg1
                       =>
                       =>
                       vmova* reg1,<op> }
                       vmova* reg1,<op> }
@@ -2299,10 +2315,11 @@ unit aoptx86;
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   MatchOperand(taicpu(p).oper[1]^,taicpu(hp1).oper[0]^) then
                   begin
                   begin
                     { vmova* reg1,reg2
                     { vmova* reg1,reg2
+                      ...
                       vmovs* reg2,<op>
                       vmovs* reg2,<op>
                       dealloc reg2
                       dealloc reg2
                       =>
                       =>
-                      vmovs* reg1,reg3 }
+                      vmovs* reg1,<op> }
                     TransferUsedRegs(TmpUsedRegs);
                     TransferUsedRegs(TmpUsedRegs);
                     UpdateUsedRegsBetween(TmpUsedRegs, p, hp1);
                     UpdateUsedRegsBetween(TmpUsedRegs, p, hp1);
                     if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,TmpUsedRegs)) then
                     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);
                         DebugMsg(SPeepholeOptimization + '(V)MOVA*(V)MOVS*2(V)MOVS* 1',p);
                         taicpu(p).opcode:=taicpu(hp1).opcode;
                         taicpu(p).opcode:=taicpu(hp1).opcode;
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
                         taicpu(p).loadoper(1,taicpu(hp1).oper[1]^);
+
+                        TransferUsedRegs(TmpUsedRegs);
+                        AllocRegBetween(taicpu(p).oper[0]^.reg, p, hp1, TmpUsedRegs);
+
                         RemoveInstruction(hp1);
                         RemoveInstruction(hp1);
                         result:=true;
                         result:=true;
                         exit;
                         exit;
                       end
                       end
                   end;
                   end;
-              end;
-          if GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[1]^.reg) then
-            begin
+
               if MatchInstruction(hp1,[A_VFMADDPD,
               if MatchInstruction(hp1,[A_VFMADDPD,
                                               A_VFMADD132PD,
                                               A_VFMADD132PD,
                                               A_VFMADD132PS,
                                               A_VFMADD132PS,
@@ -5313,7 +5332,6 @@ unit aoptx86;
         { Search for:
         { Search for:
             test  $x,(reg/ref)
             test  $x,(reg/ref)
             jne   @lbl1
             jne   @lbl1
-            ...
             test  $y,(reg/ref) (same register or reference)
             test  $y,(reg/ref) (same register or reference)
             jne   @lbl1
             jne   @lbl1
 
 
@@ -5481,6 +5499,16 @@ unit aoptx86;
                         (FirstValue = -1) or
                         (FirstValue = -1) or
                         (SecondValue = -1) or
                         (SecondValue = -1) or
                         MatchOperand(taicpu(hp1_dist).oper[0]^, taicpu(hp1).oper[0]^)
                         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
                       ) then
                       begin
                       begin
                         { Same jump location... can be a register since nothing's changed }
                         { Same jump location... can be a register since nothing's changed }
@@ -5492,15 +5520,29 @@ unit aoptx86;
                         if IsJumpToLabel(taicpu(hp1_dist)) then
                         if IsJumpToLabel(taicpu(hp1_dist)) then
                           TAsmLabel(taicpu(hp1_dist).oper[0]^.ref^.symbol).DecRefs;
                           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 }
                         { Only remove the second test if no jumps or other conditional instructions follow }
                         TransferUsedRegs(TmpUsedRegs);
                         TransferUsedRegs(TmpUsedRegs);
                         UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
                         UpdateUsedRegs(TmpUsedRegs, tai(p.Next));
                         UpdateUsedRegs(TmpUsedRegs, tai(hp1.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;
                         Result := True;
                         Exit;
                         Exit;
@@ -11714,6 +11756,10 @@ unit aoptx86;
 
 
         ConstRegs: array[0..MAX_CMOV_REGISTERS - 1] of TRegister;
         ConstRegs: array[0..MAX_CMOV_REGISTERS - 1] of TRegister;
         ConstVals: array[0..MAX_CMOV_REGISTERS - 1] of TCGInt;
         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
         { Tries to convert a mov const,%reg instruction into a CMOV by reserving a
           new register to store the constant }
           new register to store the constant }
@@ -11721,7 +11767,7 @@ unit aoptx86;
           var
           var
             RegSize: TSubRegister;
             RegSize: TSubRegister;
             CurrentVal: TCGInt;
             CurrentVal: TCGInt;
-            NewReg: TRegister;
+            ANewReg: TRegister;
             X: ShortInt;
             X: ShortInt;
           begin
           begin
             Result := False;
             Result := False;
@@ -11739,8 +11785,10 @@ unit aoptx86;
                 RegSize := R_SUBW;
                 RegSize := R_SUBW;
               S_L:
               S_L:
                 RegSize := R_SUBD;
                 RegSize := R_SUBD;
+{$ifdef x86_64}
               S_Q:
               S_Q:
                 RegSize := R_SUBQ;
                 RegSize := R_SUBQ;
+{$endif x86_64}
               else
               else
                 InternalError(2021100401);
                 InternalError(2021100401);
             end;
             end;
@@ -11751,6 +11799,7 @@ unit aoptx86;
               if ConstVals[X] = CurrentVal then
               if ConstVals[X] = CurrentVal then
                 begin
                 begin
                   ConstRegs[StoredCount] := ConstRegs[X];
                   ConstRegs[StoredCount] := ConstRegs[X];
+                  ConstSizes[StoredCount] := RegSize;
                   ConstVals[StoredCount] := CurrentVal;
                   ConstVals[StoredCount] := CurrentVal;
                   Result := True;
                   Result := True;
 
 
@@ -11759,16 +11808,17 @@ unit aoptx86;
                   Exit;
                   Exit;
                 end;
                 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 }
               { No free registers }
               Exit;
               Exit;
 
 
             { Reserve the register so subsequent TryCMOVConst calls don't all end
             { Reserve the register so subsequent TryCMOVConst calls don't all end
               up vying for the same register }
               up vying for the same register }
-            IncludeRegInUsedRegs(NewReg, TmpUsedRegs);
+            IncludeRegInUsedRegs(ANewReg, TmpUsedRegs);
 
 
-            ConstRegs[StoredCount] := NewReg;
+            ConstRegs[StoredCount] := ANewReg;
+            ConstSizes[StoredCount] := RegSize;
             ConstVals[StoredCount] := CurrentVal;
             ConstVals[StoredCount] := CurrentVal;
 
 
             Inc(StoredCount);
             Inc(StoredCount);
@@ -12054,7 +12104,7 @@ unit aoptx86;
                   Result:=true;
                   Result:=true;
                   exit;
                   exit;
                 end
                 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
                 MatchInstruction(hp1,A_MOV,[S_W,S_L{$ifdef x86_64},S_Q{$endif x86_64}]) then
                 begin
                 begin
                  { check for
                  { check for
@@ -12239,10 +12289,13 @@ unit aoptx86;
                      l := 0;
                      l := 0;
                      c := 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(RegWrites[0], MAX_CMOV_INSTRUCTIONS * 2 * SizeOf(TRegister), 0);
                      FillChar(ConstRegs[0], MAX_CMOV_REGISTERS * SizeOf(TRegister), 0);
                      FillChar(ConstRegs[0], MAX_CMOV_REGISTERS * SizeOf(TRegister), 0);
                      FillChar(ConstVals[0], MAX_CMOV_REGISTERS * SizeOf(TCGInt), 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;
                      RefModified := False;
                      while assigned(hp1) and
                      while assigned(hp1) and
@@ -12338,7 +12391,7 @@ unit aoptx86;
                                           below) }
                                           below) }
                                         if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                         if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                           begin
                                           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;
                                             taicpu(hp_new).fileinfo := taicpu(hp_prev).fileinfo;
 
 
                                             asml.InsertBefore(hp_new, hp_flagalloc);
                                             asml.InsertBefore(hp_new, hp_flagalloc);
@@ -12346,14 +12399,20 @@ unit aoptx86;
                                               TrySwapMovOp(hp_prev2, hp_new);
                                               TrySwapMovOp(hp_prev2, hp_new);
 
 
                                             IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
                                             IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                            ConstMovs[X] := hp_new;
                                           end
                                           end
                                         else
                                         else
                                         { We just need an instruction between hp_prev and hp1
                                         { We just need an instruction between hp_prev and hp1
                                           where we know the register is marked as in use }
                                           where we know the register is marked as in use }
                                           hp_new := hpmov1;
                                           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);
                                         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);
                                         Inc(x);
                                       end;
                                       end;
 
 
@@ -12365,6 +12424,14 @@ unit aoptx86;
                                 GetNextInstruction(hp1, hp1);
                                 GetNextInstruction(hp1, hp1);
                               until (hp1 = hp_lblxxx);
                               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;
                               hp2 := hp_lblxxx;
                               repeat
                               repeat
                                 if not Assigned(hp2) then
                                 if not Assigned(hp2) then
@@ -12591,7 +12658,8 @@ unit aoptx86;
                                         RegMatch := False;
                                         RegMatch := False;
 
 
                                         for x := 0 to c - 1 do
                                         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
                                             begin
                                               RegMatch := True;
                                               RegMatch := True;
 
 
@@ -12602,20 +12670,26 @@ unit aoptx86;
                                                 below) }
                                                 below) }
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                                 begin
                                                 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);
                                                   asml.InsertBefore(hp_new, hp_flagalloc);
                                                   if Assigned(hp_prev2) then
                                                   if Assigned(hp_prev2) then
                                                     TrySwapMovOp(hp_prev2, hp_new);
                                                     TrySwapMovOp(hp_prev2, hp_new);
 
 
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                                  ConstMovs[X] := hp_new;
                                                 end
                                                 end
                                               else
                                               else
                                                 { We just need an instruction between hp_prev and hp1
                                                 { We just need an instruction between hp_prev and hp1
                                                   where we know the register is marked as in use }
                                                   where we know the register is marked as in use }
                                                 hp_new := hpmov2;
                                                 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);
                                               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;
                                               Break;
                                             end;
                                             end;
 
 
@@ -12673,7 +12747,8 @@ unit aoptx86;
                                         RegMatch := False;
                                         RegMatch := False;
 
 
                                         for x := 0 to c - 1 do
                                         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
                                             begin
                                               RegMatch := True;
                                               RegMatch := True;
 
 
@@ -12684,20 +12759,26 @@ unit aoptx86;
                                                 below) }
                                                 below) }
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                               if not TmpUsedRegs[R_INTREGISTER].IsUsed(ConstRegs[x]) then
                                                 begin
                                                 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);
                                                   asml.InsertBefore(hp_new, hp_flagalloc);
                                                   if Assigned(hp_prev2) then
                                                   if Assigned(hp_prev2) then
                                                     TrySwapMovOp(hp_prev2, hp_new);
                                                     TrySwapMovOp(hp_prev2, hp_new);
 
 
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
                                                   IncludeRegInUsedRegs(ConstRegs[x], TmpUsedRegs);
+
+                                                  ConstMovs[X] := hp_new;
                                                 end
                                                 end
                                               else
                                               else
                                                 { We just need an instruction between hp_prev and hp1
                                                 { We just need an instruction between hp_prev and hp1
                                                   where we know the register is marked as in use }
                                                   where we know the register is marked as in use }
                                                 hp_new := hpmov1;
                                                 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);
                                               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;
                                               Break;
                                             end;
                                             end;
 
 
@@ -12712,6 +12793,14 @@ unit aoptx86;
                                 GetNextInstruction(hp1, hp1);
                                 GetNextInstruction(hp1, hp1);
                               until (hp1 = hp_jump); { Stop at the jump, not lbl xxx }
                               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_jump.next));
                               UpdateUsedRegs(tai(hp_lblyyy.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 cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
     function reg2opsize(r:Tregister):topsize;
     function reg2opsize(r:Tregister):topsize;
+    function subreg2opsize(sr : tsubregister):topsize;
     function reg_cgsize(const reg: tregister): tcgsize;
     function reg_cgsize(const reg: tregister): tcgsize;
     function is_calljmp(o:tasmop):boolean;
     function is_calljmp(o:tasmop):boolean;
     function is_calljmpuncondret(o:tasmop):boolean;
     function is_calljmpuncondret(o:tasmop):boolean;
@@ -521,15 +522,21 @@ implementation
         end;
         end;
 
 
 
 
-    function reg2opsize(r:Tregister):topsize;
+    function subreg2opsize(sr : tsubregister):topsize;
       const
       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);
           (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
       begin
         reg2opsize:=S_L;
         reg2opsize:=S_L;
         case getregtype(r) of
         case getregtype(r) of
           R_INTREGISTER :
           R_INTREGISTER :
-            reg2opsize:=subreg2opsize[getsubreg(r)];
+            reg2opsize:=subreg2opsize(getsubreg(r));
           R_FPUREGISTER :
           R_FPUREGISTER :
             reg2opsize:=S_FL;
             reg2opsize:=S_FL;
           R_MMXREGISTER,
           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);
                   hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u32inttype,true);
                   register_maybe_adjust_setbase(current_asmdata.CurrAsmList,u32inttype,left.location,setbase);
                   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
                     (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 }
                     { 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);
                     hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,u32inttype,true);
 
 
                   hreg:=left.location.register;
                   hreg:=left.location.register;
@@ -971,7 +971,7 @@ implementation
 
 
                   if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) or
                   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 }
                     { 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);
                     hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,opdef,true);
 
 
                   pleftreg:=left.location.register;
                   pleftreg:=left.location.register;

+ 12 - 1
compiler/x86/rax86.pas

@@ -436,10 +436,11 @@ begin
   Opsize:=S_NO;
   Opsize:=S_NO;
 end;
 end;
 
 
-procedure Tx86Instruction.AddReferenceSizes;
 { this will add the sizes for references like [esi] which do not
 { 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
   have the size set yet, it will take only the size if the other
   operand is a register }
   operand is a register }
+procedure Tx86Instruction.AddReferenceSizes;
+
 var
 var
   operand2,i,j,k : longint;
   operand2,i,j,k : longint;
   s : tasmsymbol;
   s : tasmsymbol;
@@ -1400,6 +1401,16 @@ begin
                    begin
                    begin
                      if opsize<>S_NO then
                      if opsize<>S_NO then
                        tx86operand(operands[i]).opsize:=opsize
                        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;
                 end;
                 end;
               OPR_SYMBOL :
               OPR_SYMBOL :

+ 145 - 30
compiler/x86/rax86att.pas

@@ -207,7 +207,105 @@ Implementation
            end;
            end;
         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
       begin
         oper.InitRef;
         oper.InitRef;
         Consume(AS_LPAREN);
         Consume(AS_LPAREN);
@@ -244,7 +342,7 @@ Implementation
                 oper.opr.ref.refaddr:=addr_pic_no_got;
                 oper.opr.ref.refaddr:=addr_pic_no_got;
 {$endif x86_64}
 {$endif x86_64}
               Consume(AS_REGISTER);
               Consume(AS_REGISTER);
-              { can either be a register or a right parenthesis }
+              { can either be a register, an identifier or a right parenthesis }
               { (reg)        }
               { (reg)        }
               if actasmtoken=AS_RPAREN then
               if actasmtoken=AS_RPAREN then
                Begin
                Begin
@@ -253,36 +351,53 @@ Implementation
                end;
                end;
               { (reg,reg ..  }
               { (reg,reg ..  }
               Consume(AS_COMMA);
               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 }
             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 }
           AS_COMMA: { (, ...  can either be scaling, or index }
             Begin
             Begin
               Consume(AS_COMMA);
               Consume(AS_COMMA);

+ 2 - 2
compiler/x86/rax86int.pas

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

+ 5 - 3
compiler/x86_64/cpupara.pas

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

Some files were not shown because too many files changed in this diff