* synchronized with trunk

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

.gitattributes

@@ -11241,7 +11241,6 @@ rtl/linux/linux.pp svneol=native#text/plain
 rtl/linux/linuxvcs.pp svneol=native#text/plain
 rtl/linux/m68k/bsyscall.inc svneol=native#text/plain
 rtl/linux/m68k/cprt0.as svneol=native#text/plain
-rtl/linux/m68k/cprt21.as svneol=native#text/plain
 rtl/linux/m68k/dllprt0.as svneol=native#text/plain
 rtl/linux/m68k/gprt0.as svneol=native#text/plain
 rtl/linux/m68k/gprt21.as svneol=native#text/plain
@@ -15621,6 +15620,11 @@ tests/test/toperator88.pp svneol=native#text/pascal
 tests/test/toperator89.pp svneol=native#text/pascal
 tests/test/toperator9.pp svneol=native#text/pascal
 tests/test/toperator90.pp svneol=native#text/pascal
+tests/test/toperator91.pp svneol=native#text/pascal
+tests/test/toperator92.pp svneol=native#text/pascal
+tests/test/toperator93.pp svneol=native#text/pascal
+tests/test/toperator94.pp svneol=native#text/pascal
+tests/test/toperator95.pp svneol=native#text/pascal
 tests/test/toperatorerror.pp svneol=native#text/plain
 tests/test/tover1.pp svneol=native#text/plain
 tests/test/tover2.pp svneol=native#text/plain
@@ -15873,6 +15877,7 @@ tests/test/tthlp26b.pp -text svneol=native#text/pascal
 tests/test/tthlp26c.pp -text svneol=native#text/pascal
 tests/test/tthlp27.pp svneol=native#text/pascal
 tests/test/tthlp28.pp svneol=native#text/pascal
+tests/test/tthlp29.pp svneol=native#text/pascal
 tests/test/tthlp3.pp svneol=native#text/pascal
 tests/test/tthlp4.pp svneol=native#text/pascal
 tests/test/tthlp5.pp svneol=native#text/pascal
@@ -18629,7 +18634,10 @@ tests/webtbs/tw38058.pp svneol=native#text/pascal
 tests/webtbs/tw38069.pp svneol=native#text/pascal
 tests/webtbs/tw38074.pp svneol=native#text/pascal
 tests/webtbs/tw38083.pp svneol=native#text/pascal
+tests/webtbs/tw38122.pp svneol=native#text/pascal
 tests/webtbs/tw3814.pp svneol=native#text/plain
+tests/webtbs/tw38145a.pp svneol=native#text/pascal
+tests/webtbs/tw38145b.pp svneol=native#text/pascal
 tests/webtbs/tw3827.pp svneol=native#text/plain
 tests/webtbs/tw3829.pp svneol=native#text/plain
 tests/webtbs/tw3833.pp svneol=native#text/plain

compiler/cepiktimer.pas

@@ -25,6 +25,7 @@
 {$define epiktimer:=cepiktimer}
 { do not depend on the classes unit }
 {$DEFINE NOCLASSES}
+
 { include the original file }
 {$i ../../epiktimer/epiktimer.pas}
 

compiler/cgobj.pas

@@ -586,7 +586,8 @@ implementation
     uses
        globals,systems,fmodule,
        verbose,paramgr,symsym,symtable,
-       tgobj,cutils,procinfo;
+       tgobj,cutils,procinfo,
+       cpuinfo;
 
 {*****************************************************************************
                             basic functionallity
@@ -1997,7 +1998,10 @@ implementation
         tmpreg : tregister;
         tmpref : treference;
       begin
-        if assigned(ref.symbol) then
+        if assigned(ref.symbol)
+          { for avrtiny, the code generator generates a ref which is Z relative and while using it,
+            Z is changed, so the following code breaks }
+          {$ifdef avr}and not(CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]){$endif avr} then
           begin
             tmpreg:=getaddressregister(list);
             a_loadaddr_ref_reg(list,ref,tmpreg);
@@ -2030,7 +2034,10 @@ implementation
         tmpreg : tregister;
         tmpref : treference;
       begin
-        if assigned(ref.symbol) then
+        if assigned(ref.symbol)
+          { for avrtiny, the code generator generates a ref which is Z relative and while using it,
+            Z is changed, so the following code breaks }
+          {$ifdef avr}and not(CPUAVR_16_REGS in cpu_capabilities[current_settings.cputype]){$endif avr} then
           begin
             tmpreg:=getaddressregister(list);
             a_loadaddr_ref_reg(list,ref,tmpreg);

compiler/entfile.pas

@@ -1400,7 +1400,7 @@ begin
     for i:=low(arr) to high(arr) do
       arr[i]:=reverse_byte(arr[i]);
 {$ifdef DEBUG_PPU}
-  for i:=0 to 3 do
+  for i:=low(arr) to high(arr) do
     ppu_log_val('byte['+tostr(i)+']=$'+hexstr(arr[i],2));
   dec_log_level;
 {$endif}
@@ -1871,7 +1871,7 @@ procedure tentryfile.putset(const arr: array of byte);
 {$endif}
     putdata(arr,sizeof(arr));
 {$ifdef DEBUG_PPU}
-  for i:=0 to 31 do
+  for i:=0 to sizeof(arr)-1 do
     ppu_log_val('byte['+tostr(i)+']=$'+hexstr(arr[i],2));
   dec_log_level;
 {$endif}

compiler/fpcdefs.inc

@@ -2,7 +2,9 @@
 {$asmmode default}
 {$H-}
 {$goto on}
-{$inline on}
+{$ifndef DISABLE_INLINE}
+  {$inline on}
+{$endif}
 {$interfaces corba}
 
 { This reduces the memory requirements a lot }

compiler/fppu.pas

@@ -51,10 +51,15 @@ interface
           comments   : TCmdStrList;
           nsprefix   : TCmdStr; { Namespace prefix the unit was found with }
 {$ifdef Test_Double_checksum}
-          crc_array  : pointer;
-          crc_size   : longint;
-          crc_array2 : pointer;
-          crc_size2  : longint;
+          interface_read_crc_index,
+          interface_write_crc_index,
+          indirect_read_crc_index,
+          indirect_write_crc_index,
+          implementation_read_crc_index,
+          implementation_write_crc_index : cardinal;
+          interface_crc_array,
+          indirect_crc_array,
+          implementation_crc_array  : pointer;
 {$endif def Test_Double_checksum}
           constructor create(LoadedFrom:TModule;const amodulename: string; const afilename:TPathStr;_is_unit:boolean);
           destructor destroy;override;
@@ -1511,16 +1516,41 @@ var
          if (cs_fp_emulation in current_settings.moduleswitches) then
            headerflags:=headerflags or uf_fpu_emulation;
 {$endif cpufpemu}
-{$ifdef Test_Double_checksum_write}
-         Assign(CRCFile,ppufilename+'.IMP');
-         Rewrite(CRCFile);
-{$endif def Test_Double_checksum_write}
-
          { create new ppufile }
          ppufile:=tcompilerppufile.create(ppufilename);
          if not ppufile.createfile then
           Message(unit_f_ppu_cannot_write);
 
+{$ifdef Test_Double_checksum_write}
+         { Re-use the values collected in .INT part }
+         if assigned(interface_crc_array) then
+           begin
+             ppufile.implementation_write_crc_index:=implementation_write_crc_index;
+             ppufile.interface_write_crc_index:=interface_write_crc_index;
+             ppufile.indirect_write_crc_index:=indirect_write_crc_index;
+             if assigned(ppufile.interface_crc_array) then
+               begin
+                 dispose(ppufile.interface_crc_array);
+                 ppufile.interface_crc_array:=interface_crc_array;
+               end; 
+             if assigned(ppufile.implementation_crc_array) then
+               begin
+                 dispose(ppufile.implementation_crc_array);
+                 ppufile.implementation_crc_array:=implementation_crc_array;
+               end; 
+             if assigned(ppufile.indirect_crc_array) then
+               begin
+                 dispose(ppufile.indirect_crc_array);
+                 ppufile.indirect_crc_array:=indirect_crc_array;
+               end; 
+           end;
+         if FileExists(ppufilename+'.IMP',false) then
+           RenameFile(ppufilename+'.IMP',ppufilename+'.IMP-old');
+         Assign(ppufile.CRCFile,ppufilename+'.IMP');
+         Rewrite(ppufile.CRCFile);
+         Writeln(ppufile.CRCFile,'CRC in writeppu method of implementation of ',ppufilename,' defsgeneration=',defsgeneration);
+{$endif def Test_Double_checksum_write}
+
          { extra header (sub version, module flags) }
          writeextraheader;
 
@@ -1681,7 +1711,15 @@ var
          indirect_crc:=ppufile.indirect_crc;
 
 {$ifdef Test_Double_checksum_write}
-         close(CRCFile);
+         Writeln(ppufile.CRCFile,'End of implementation CRC in writeppu method of ',ppufilename,
+                 ' implementation_crc=$',hexstr(ppufile.crc,8),
+                 ' interface_crc=$',hexstr(ppufile.interface_crc,8),
+                 ' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
+                 ' implementation_crc_size=',ppufile.implementation_read_crc_index,
+                 ' interface_crc_size=',ppufile.interface_read_crc_index,
+                 ' indirect_crc_size=',ppufile.indirect_read_crc_index,
+                 ' defsgeneration=',defsgeneration);
+         close(ppufile.CRCFile);
 {$endif Test_Double_checksum_write}
 
          ppufile.closefile;
@@ -1692,10 +1730,6 @@ var
 
     procedure tppumodule.getppucrc;
       begin
-{$ifdef Test_Double_checksum_write}
-         Assign(CRCFile,ppufilename+'.INT');
-         Rewrite(CRCFile);
-{$endif def Test_Double_checksum_write}
 
          { create new ppufile }
          ppufile:=tcompilerppufile.create(ppufilename);
@@ -1703,6 +1737,14 @@ var
          if not ppufile.createfile then
            Message(unit_f_ppu_cannot_write);
 
+{$ifdef Test_Double_checksum_write}
+         if FileExists(ppufilename+'.INT',false) then
+           RenameFile(ppufilename+'.INT',ppufilename+'.INT-old');
+         Assign(ppufile.CRCFile,ppufilename+'.INT');
+         Rewrite(ppufile.CRCFile);
+         Writeln(ppufile.CRCFile,'CRC of getppucrc of ',ppufilename,
+                 ' defsgeneration=',defsgeneration);
+{$endif def Test_Double_checksum_write}
          { first the (JVM) namespace }
          if assigned(namespace) then
            begin
@@ -1757,17 +1799,26 @@ var
            for ppudump when using INTFPPU define }
          ppufile.writeentry(ibendimplementation);
 
-{$ifdef Test_Double_checksum}
-         crc_array:=ppufile.crc_test;
-         ppufile.crc_test:=nil;
-         crc_size:=ppufile.crc_index2;
-         crc_array2:=ppufile.crc_test2;
-         ppufile.crc_test2:=nil;
-         crc_size2:=ppufile.crc_index2;
-{$endif Test_Double_checksum}
-
 {$ifdef Test_Double_checksum_write}
-         close(CRCFile);
+         Writeln(ppufile.CRCFile,'End of CRC of getppucrc of ',ppufilename,
+                 ' implementation_crc=$',hexstr(ppufile.crc,8),
+                 ' interface_crc=$',hexstr(ppufile.interface_crc,8),
+                 ' indirect_crc=$',hexstr(ppufile.indirect_crc,8),
+                 ' implementation_crc_size=',ppufile.implementation_write_crc_index,
+                 ' interface_crc_size=',ppufile.interface_write_crc_index,
+                 ' indirect_crc_size=',ppufile.indirect_write_crc_index,
+                 ' defsgeneration=',defsgeneration);
+         close(ppufile.CRCFile);
+         { Remember the values generated in .INT part }
+          implementation_write_crc_index:=ppufile.implementation_write_crc_index;
+          interface_write_crc_index:=ppufile.interface_write_crc_index;
+          indirect_write_crc_index:=ppufile.indirect_write_crc_index;
+          interface_crc_array:=ppufile.interface_crc_array;
+          ppufile.interface_crc_array:=nil;
+          implementation_crc_array:=ppufile.implementation_crc_array;
+          ppufile.implementation_crc_array:=nil;
+          indirect_crc_array:=ppufile.indirect_crc_array;
+          ppufile.indirect_crc_array:=nil;
 {$endif Test_Double_checksum_write}
 
          { create and write header, this will only be used
@@ -1821,11 +1872,11 @@ var
                  Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename,@queuecomment);
 {$ifdef DEBUG_UNIT_CRC_CHANGES}
                  if (pu.u.interface_crc<>pu.interface_checksum) then
-                   writeln('  intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+                   Comment(V_Normal,'  intfcrc change: '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
                  else if (pu.u.indirect_crc<>pu.indirect_checksum) then
-                   writeln('  indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
+                   Comment(V_Normal,'  indcrc change: '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
                  else
-                   writeln('  implcrc change: ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
+                   Comment(V_Normal,'  implcrc change: '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
 {$endif DEBUG_UNIT_CRC_CHANGES}
                  recompile_reason:=rr_crcchanged;
                  do_compile:=true;
@@ -1877,9 +1928,9 @@ var
                   Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.ppufilename+' {impl}',@queuecomment);
 {$ifdef DEBUG_UNIT_CRC_CHANGES}
                   if (pu.u.interface_crc<>pu.interface_checksum) then
-                    writeln('  intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+                    Comment(V_Normal,'  intfcrc change (2): '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
                   else if (pu.u.indirect_crc<>pu.indirect_checksum) then
-                    writeln('  indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8));
+                    Comment(V_Normal,'  indcrc change (2): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^);
 {$endif DEBUG_UNIT_CRC_CHANGES}
                   recompile_reason:=rr_crcchanged;
                   do_compile:=true;
@@ -1933,11 +1984,11 @@ var
              begin
 {$ifdef DEBUG_UNIT_CRC_CHANGES}
                if (pu.u.interface_crc<>pu.interface_checksum) then
-                 writeln('  intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
+                 Comment(V_Normal,'  intfcrc change (3): '+hexstr(pu.u.interface_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.interface_checksum,8)+' in unit '+realmodulename^)
                else if (pu.u.indirect_crc<>pu.indirect_checksum) then
-                 writeln('  indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
+                 Comment(V_Normal,'  indcrc change (3): '+hexstr(pu.u.indirect_crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.indirect_checksum,8)+' in unit '+realmodulename^)
                else
-                 writeln('  implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
+                 Comment(V_Normal,'  implcrc change (3): '+hexstr(pu.u.crc,8)+' for '+pu.u.ppufilename+' <> '+hexstr(pu.checksum,8)+' in unit '+realmodulename^);
 {$endif DEBUG_UNIT_CRC_CHANGES}
                result:=true;
                exit;

compiler/globtype.pas

@@ -230,7 +230,10 @@ interface
          cs_link_vlink,
          { disable LTO for the system unit (needed to work around linker bugs on macOS) }
          cs_lto_nosystem,
-	 cs_assemble_on_target
+         cs_assemble_on_target,
+         { use a memory model which allows large data structures, e.g. > 2 GB static data on x86-64 targets
+           this not supported on all OSes }
+         cs_large
        );
        tglobalswitches = set of tglobalswitch;
 

compiler/htypechk.pas

@@ -673,17 +673,7 @@ implementation
                     eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,cdo);
                     result:=
                       (eq=te_exact) or
-                      (
-                        (eq=te_incompatible) and
-                        { don't allow overloading assigning to custom shortstring
-                          types, because we also don't want to differentiate based
-                          on different shortstring types (e.g.,
-                          "operator :=(const v: variant) res: shorstring" also
-                          has to work for assigning a variant to a string[80])
-                        }
-                        (not is_shortstring(pf.returndef) or
-                         (tstringdef(pf.returndef).len=255))
-                      );
+                      (eq=te_incompatible);
                   end
                 else
                 { enumerator is a special case too }

compiler/link.pas

@@ -91,6 +91,8 @@ interface
          Function  MakeStaticLibrary:boolean;override;
 
          Function UniqueName(const str:TCmdStr): TCmdStr;
+
+         function PostProcessELFExecutable(const fn: string; isdll: boolean): boolean;
        end;
 
       TBooleanArray = array [1..1024] of boolean;
@@ -988,6 +990,161 @@ Implementation
       end;
 
 
+    function TExternalLinker.PostProcessELFExecutable(const fn : string;isdll:boolean):boolean;
+      type
+        TElf32header=packed record
+          magic0123         : longint;
+          file_class        : byte;
+          data_encoding     : byte;
+          file_version      : byte;
+          padding           : array[$07..$0f] of byte;
+
+          e_type            : word;
+          e_machine         : word;
+          e_version         : longint;
+          e_entry           : longint;          { entrypoint }
+          e_phoff           : longint;          { program header offset }
+
+          e_shoff           : longint;          { sections header offset }
+          e_flags           : longint;
+          e_ehsize          : word;             { elf header size in bytes }
+          e_phentsize       : word;             { size of an entry in the program header array }
+          e_phnum           : word;             { 0..e_phnum-1 of entrys }
+          e_shentsize       : word;             { size of an entry in sections header array }
+          e_shnum           : word;             { 0..e_shnum-1 of entrys }
+          e_shstrndx        : word;             { index of string section header }
+        end;
+        TElf32sechdr=packed record
+          sh_name           : longint;
+          sh_type           : longint;
+          sh_flags          : longint;
+          sh_addr           : longint;
+
+          sh_offset         : longint;
+          sh_size           : longint;
+          sh_link           : longint;
+          sh_info           : longint;
+
+          sh_addralign      : longint;
+          sh_entsize        : longint;
+        end;
+
+      function MayBeSwapHeader(h : telf32header) : telf32header;
+        begin
+          result:=h;
+          if source_info.endian<>target_info.endian then
+            with h do
+              begin
+                result.e_type:=swapendian(e_type);
+                result.e_machine:=swapendian(e_machine);
+                result.e_version:=swapendian(e_version);
+                result.e_entry:=swapendian(e_entry);
+                result.e_phoff:=swapendian(e_phoff);
+                result.e_shoff:=swapendian(e_shoff);
+                result.e_flags:=swapendian(e_flags);
+                result.e_ehsize:=swapendian(e_ehsize);
+                result.e_phentsize:=swapendian(e_phentsize);
+                result.e_phnum:=swapendian(e_phnum);
+                result.e_shentsize:=swapendian(e_shentsize);
+                result.e_shnum:=swapendian(e_shnum);
+                result.e_shstrndx:=swapendian(e_shstrndx);
+              end;
+        end;
+
+      function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
+        begin
+          result:=h;
+          if source_info.endian<>target_info.endian then
+            with h do
+              begin
+                result.sh_name:=swapendian(sh_name);
+                result.sh_type:=swapendian(sh_type);
+                result.sh_flags:=swapendian(sh_flags);
+                result.sh_addr:=swapendian(sh_addr);
+                result.sh_offset:=swapendian(sh_offset);
+                result.sh_size:=swapendian(sh_size);
+                result.sh_link:=swapendian(sh_link);
+                result.sh_info:=swapendian(sh_info);
+                result.sh_addralign:=swapendian(sh_addralign);
+                result.sh_entsize:=swapendian(sh_entsize);
+              end;
+        end;
+
+      var
+        f : file;
+
+      function ReadSectionName(pos : longint) : String;
+        var
+          oldpos : longint;
+          c : char;
+        begin
+          oldpos:=filepos(f);
+          seek(f,pos);
+          Result:='';
+          while true do
+            begin
+              blockread(f,c,1);
+              if c=#0 then
+                break;
+              Result:=Result+c;
+            end;
+          seek(f,oldpos);
+        end;
+
+      var
+        elfheader : TElf32header;
+        secheader : TElf32sechdr;
+        i : longint;
+        stringoffset : longint;
+        secname : string;
+      begin
+        Result:=false;
+        { open file }
+        assign(f,fn);
+        {$push}{$I-}
+        reset(f,1);
+        if ioresult<>0 then
+          Message1(execinfo_f_cant_open_executable,fn);
+        { read header }
+        blockread(f,elfheader,sizeof(tElf32header));
+        elfheader:=MayBeSwapHeader(elfheader);
+        seek(f,elfheader.e_shoff);
+        { read string section header }
+        seek(f,elfheader.e_shoff+sizeof(TElf32sechdr)*elfheader.e_shstrndx);
+        blockread(f,secheader,sizeof(secheader));
+        secheader:=MaybeSwapSecHeader(secheader);
+        stringoffset:=secheader.sh_offset;
+
+        seek(f,elfheader.e_shoff);
+        status.datasize:=0;
+        for i:=0 to elfheader.e_shnum-1 do
+          begin
+            blockread(f,secheader,sizeof(secheader));
+            secheader:=MaybeSwapSecHeader(secheader);
+            secname:=ReadSectionName(stringoffset+secheader.sh_name);
+            if secname='.text' then
+              begin
+                Message1(execinfo_x_codesize,tostr(secheader.sh_size));
+                status.codesize:=secheader.sh_size;
+              end
+            else if secname='.data' then
+              begin
+                Message1(execinfo_x_initdatasize,tostr(secheader.sh_size));
+                inc(status.datasize,secheader.sh_size);
+              end
+            else if secname='.bss' then
+              begin
+                Message1(execinfo_x_uninitdatasize,tostr(secheader.sh_size));
+                inc(status.datasize,secheader.sh_size);
+              end;
+
+          end;
+        close(f);
+        {$pop}
+        if ioresult<>0 then
+          ;
+        Result:=true;
+      end;
 {*****************************************************************************
                               TINTERNALLINKER
 *****************************************************************************}

compiler/m68k/cgcpu.pas

@@ -1868,13 +1868,22 @@ unit cgcpu;
           begin
             localsize:=align(localsize,4);
 
-            if (localsize > high(smallint)) then
+            if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
               begin
-                list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
-                list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
+                if (localsize > high(smallint)) then
+                  begin
+                    list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
+                    list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
+                  end
+                else
+                  list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
               end
             else
-              list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
+              begin
+                if localsize<>0 then
+                  list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
+                current_procinfo.final_localsize:=localsize;
+              end;
           end;
       end;
 
@@ -1884,59 +1893,75 @@ unit cgcpu;
         ref : TReference;
         ref2: TReference;
       begin
+        { if a subroutine is marked as non-returning, we do
+          not generate any exit code, so we really trust the noreturn directive
+        }
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
         if not nostackframe then
           begin
-            list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
+            if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
+              begin
+                list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG));
 
-            { if parasize is less than zero here, we probably have a cdecl function.
-              According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/
-              68k GCC uses two different methods to free the stack, depending if the target
-              architecture supports RTD or not, and one does callee side, the other does
-              caller side free, which looks like a PITA to support. We have to figure this 
-              out later. More info welcomed. (KB) }
+                { if parasize is less than zero here, we probably have a cdecl function.
+                  According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/
+                  68k GCC uses two different methods to free the stack, depending if the target
+                  architecture supports RTD or not, and one does callee side, the other does
+                  caller side free, which looks like a PITA to support. We have to figure this
+                  out later. More info welcomed. (KB) }
 
-            if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then
-              begin
-                if CPUM68K_HAS_RTD in cpu_capabilities[current_settings.cputype] then
-                  list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
-                else
+                if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then
                   begin
-                    { We must pull the PC Counter from the stack, before  }
-                    { restoring the stack pointer, otherwise the PC would }
-                    { point to nowhere!                                   }
-
-                    { Instead of doing a slow copy of the return address while trying    }
-                    { to feed it to the RTS instruction, load the PC to A1 (scratch reg) }
-                    { then free up the stack allocated for paras, then use a JMP (A1) to }
-                    { return to the caller with the paras freed. (KB) }
-
-                    hregister:=NR_A1;
-                    cg.a_reg_alloc(list,hregister);
-                    reference_reset_base(ref,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]);
-                    list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
-
-                    { instead of using a postincrement above (which also writes the     }
-                    { stackpointer reg) simply add 4 to the parasize, the instructions  }
-                    { below then take that size into account as well, so SP reg is only }
-                    { written once (KB) }
-                    parasize:=parasize+4;
-
-                    r:=NR_SP;
-                    { can we do a quick addition ... }
-                    if (parasize < 9) then
-                       list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
-                    else { nope ... }
-                       begin
-                         reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,ctempposinvalid,4,[]);
-                         list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r));
-                       end;
-
-                    reference_reset_base(ref,hregister,0,ctempposinvalid,4,[]);
-                    list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
-                  end;
+                    if CPUM68K_HAS_RTD in cpu_capabilities[current_settings.cputype] then
+                      list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
+                    else
+                      begin
+                        { We must pull the PC Counter from the stack, before  }
+                        { restoring the stack pointer, otherwise the PC would }
+                        { point to nowhere!                                   }
+
+                        { Instead of doing a slow copy of the return address while trying    }
+                        { to feed it to the RTS instruction, load the PC to A1 (scratch reg) }
+                        { then free up the stack allocated for paras, then use a JMP (A1) to }
+                        { return to the caller with the paras freed. (KB) }
+
+                        hregister:=NR_A1;
+                        cg.a_reg_alloc(list,hregister);
+                        reference_reset_base(ref,NR_STACK_POINTER_REG,0,ctempposinvalid,4,[]);
+                        list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
+
+                        { instead of using a postincrement above (which also writes the     }
+                        { stackpointer reg) simply add 4 to the parasize, the instructions  }
+                        { below then take that size into account as well, so SP reg is only }
+                        { written once (KB) }
+                        parasize:=parasize+4;
+
+                        r:=NR_SP;
+                        { can we do a quick addition ... }
+                        if (parasize < 9) then
+                           list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
+                        else { nope ... }
+                           begin
+                             reference_reset_base(ref2,NR_STACK_POINTER_REG,parasize,ctempposinvalid,4,[]);
+                             list.concat(taicpu.op_ref_reg(A_LEA,S_NO,ref2,r));
+                           end;
+
+                        reference_reset_base(ref,hregister,0,ctempposinvalid,4,[]);
+                        list.concat(taicpu.op_ref(A_JMP,S_NO,ref));
+                      end;
+                    end
+                  else
+                    list.concat(taicpu.op_none(A_RTS,S_NO));
               end
             else
-              list.concat(taicpu.op_none(A_RTS,S_NO));
+              begin
+                if parasize<>0 then
+                  Internalerror(2020112901);
+                if  current_procinfo.final_localsize<>0 then
+                  list.concat(taicpu.op_const_reg(A_ADDA,S_L,current_procinfo.final_localsize,NR_STACK_POINTER_REG));
+                list.concat(taicpu.op_none(A_RTS,S_NO));
+              end;
           end
         else
           begin

compiler/msg/errore.msg

@@ -4325,6 +4325,7 @@ P*2WT_Specify MPW tool type application (Classic Mac OS)
 **2WX_Enable executable stack (Linux)
 **1X_Executable options:
 **2X9_Generate linkerscript for GNU Binutils ld older than version 2.19.1 (Linux)
+**2Xa_Generate code which allows to use more than 2 GB static data on 64 Bit targets (Linux)
 **2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Linux)
 **2Xd_Do not search default library path (sometimes required for cross-compiling when not using -XR)
 **2Xe_Use external linker

compiler/msgidx.inc

@@ -1135,7 +1135,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 86754;
+  MsgTxtSize = 86847;
 
   MsgIdxMax : array[1..20] of longint=(
     28,107,360,130,99,63,145,36,223,68,

compiler/msgtxt.inc

@@ -1967,39 +1967,40 @@ const msgtxt : array[0..000361,1..240] of char=(
   '**1X_Executable options:'#010+
   '**2X9_Generate linkerscript for GNU Binutils ld older than version 2.1'+
   '9.1 (Linux)'#010+
-  '**2Xc_Pass --share','d/-dynamic to the linker (BeOS, Darwin, FreeBSD, L'+
-  'inux)'#010+
+  '**2Xa_Generate cod','e which allows to use more than 2 GB static data o'+
+  'n 64 Bit targets (Linux)'#010+
+  '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
+  'ux)'#010+
   '**2Xd_Do not search default library path (sometimes required for cross'+
-  '-compiling when not using -XR)'#010+
+  '-compiling when not u','sing -XR)'#010+
   '**2Xe_Use external linker'#010+
   '**2Xf_Substitute pthread library name for linking (BSD)'#010+
-  '*','*2Xg_Create debuginfo in a separate file and add a debuglink sectio'+
-  'n to executable'#010+
-  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAMIC)'#010+
+  '**2Xg_Create debuginfo in a separate file and add a debuglink section '+
+  'to executable'#010+
+  '**2XD_Try to link units dynamically      (defines FPC_LINK_DYNAM','IC)'#010+
   '**2Xi_Use internal linker'#010+
-  'L*2XlS<x>_LLVM utilties suffix (e.g. -7 in case clang is called',' clan'+
-  'g-7)'#010+
+  'L*2XlS<x>_LLVM utilties suffix (e.g. -7 in case clang is called clang-'+
+  '7)'#010+
   '**2XLA_Define library substitutions for linking'#010+
   '**2XLO_Define order of library linking'#010+
-  '**2XLD_Exclude default order of standard libraries'#010+
+  '**2XLD_Exclude default order of standard libraries',#010+
   '**2Xm_Generate link map'#010+
   '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+
-  's '#039'mai','n'#039')'#010+
+  's '#039'main'#039')'#010+
   '**2Xn_Use target system native linker instead of GNU ld (Solaris, AIX)'+
   #010+
   'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+
-  '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
-  '**2Xr<x>_Set the linker'#039's rlink-path to <x','> (needed for cross co'+
-  'mpile, see the ld manual for more information) (BeOS, Linux)'#010+
-  '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+
-  ', Linux, Mac OS, Solaris)'#010+
+  '**2XP','<x>_Prepend the binutils names with the prefix <x>'#010+
+  '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
+  'ile, see the ld manual for more information) (BeOS, Linux)'#010+
+  '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, F','reeB'+
+  'SD, Linux, Mac OS, Solaris)'#010+
   '**2Xs_Strip all symbols from executable'#010+
-  '**2XS_Try to link uni','ts statically (default, defines FPC_LINK_STATIC'+
-  ')'#010+
+  '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
   '**2Xt_Link with static libraries (-static is passed to linker)'#010+
-  '**2Xv_Generate table for Virtual Entry calls'#010+
+  '**2Xv_Generate table for Virtual En','try calls'#010+
   '**2XV_Use VLink as external linker       (default on Amiga, MorphOS)'#010+
-  '**2XX_Try to s','martlink units             (defines FPC_LINK_SMART)'#010+
+  '**2XX_Try to smartlink units             (defines FPC_LINK_SMART)'#010+
   '**1*_'#010+
   '**1?_Show this help'#010+
   '**1h_Shows this help without waiting'

compiler/ncal.pas

@@ -3578,7 +3578,7 @@ implementation
       var
         candidates : tcallcandidates;
         oldcallnode : tcallnode;
-        hpt : tnode;
+        hpt,tmp : tnode;
         pt : tcallparanode;
         lastpara : longint;
         paraidx,
@@ -4004,6 +4004,19 @@ implementation
                    e.g. class reference types account }
                  hpt:=actualtargetnode(@hpt)^;
 
+                 { if the value a type helper works on is a derefentiation we need to
+                   pass the original pointer as Self as the Self value might be
+                   changed by the helper }
+                 if is_objectpascal_helper(tdef(procdefinition.owner.defowner)) and
+                    not is_implicit_pointer_object_type(tobjectdef(procdefinition.owner.defowner).extendeddef) and
+                    (hpt.nodetype=derefn) then
+                   begin
+                     tmp:=tderefnode(hpt).left;
+                     tderefnode(hpt).left:=nil;
+                     methodpointer.free;
+                     methodpointer:=tmp;
+                   end;
+
                  { R.Init then R will be initialized by the constructor,
                    Also allow it for simple loads }
                  if (procdefinition.proctypeoption=potype_constructor) or

compiler/ncgutil.pas

@@ -870,6 +870,8 @@ implementation
 
     procedure gen_save_used_regs(list:TAsmList);
       begin
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
         { Pure assembler routines need to save the registers themselves }
         if (po_assembler in current_procinfo.procdef.procoptions) then
           exit;
@@ -880,6 +882,8 @@ implementation
 
     procedure gen_restore_used_regs(list:TAsmList);
       begin
+        if po_noreturn in current_procinfo.procdef.procoptions then
+          exit;
         { Pure assembler routines need to save the registers themselves }
         if (po_assembler in current_procinfo.procdef.procoptions) then
           exit;

compiler/nmem.pas

@@ -1016,7 +1016,13 @@ implementation
                          (right.resultdef.typ=enumdef) and
                          (tenumdef(htype).basedef=tenumdef(right.resultdef).basedef) and
                     ((tarraydef(left.resultdef).lowrange<>tenumdef(htype).min) or
-                     (tarraydef(left.resultdef).highrange<>tenumdef(htype).max)) then
+                     (tarraydef(left.resultdef).highrange<>tenumdef(htype).max) or
+                   { while we could assume that the value might not be out of range,
+                     memory corruption could have resulted in an illegal value,
+                     so do not skip the type conversion in case of range checking
+
+                     After all, range checking is a safety mean }
+                     (cs_check_range in current_settings.localswitches)) then
                    {Convert array indexes to low_bound..high_bound.}
                    inserttypeconv(right,cenumdef.create_subrange(tenumdef(right.resultdef),
                                                       asizeint(Tarraydef(left.resultdef).lowrange),

compiler/options.pas

@@ -2695,6 +2695,13 @@ begin
                         else
                           IllegalPara(opt);
                       end;
+                    'a' :
+                      begin
+                        If UnsetBool(More, j, opt, false) then
+                          exclude(init_settings.globalswitches,cs_large)
+                        else
+                          include(init_settings.globalswitches,cs_large);
+                      end;
                     'c' : Cshared:=TRUE;
                     'd' : Dontlinkstdlibpath:=TRUE;
                     'e' :

compiler/ppc68k.lpi

@@ -1,17 +1,18 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <LRSInOutputDirectory Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="ppcm68k"/>
     </General>
     <BuildModes Count="1">
@@ -19,25 +20,28 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
     <Units Count="2">
       <Unit0>
         <Filename Value="pp.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="pp"/>
       </Unit0>
       <Unit1>
         <Filename Value="m68k\aasmcpu.pas"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="aasmcpu"/>
       </Unit1>
     </Units>
   </ProjectOptions>
@@ -70,7 +74,6 @@
         <StopAfterErrCount Value="50"/>
       </ConfigFile>
       <CustomOptions Value="-dm68k"/>
-      <CompilerPath Value="$(CompPath)"/>
     </Other>
   </CompilerOptions>
 </CONFIG>

compiler/ppu.pas

@@ -33,8 +33,6 @@ interface
 { define INTFPPU}
 
 {$ifdef Test_Double_checksum}
-var
-  CRCFile : text;
 const
   CRC_array_Size = 200000;
 type
@@ -123,12 +121,16 @@ type
   tppufile=class(tentryfile)
 {$ifdef Test_Double_checksum}
   public
-    crcindex,
-    crc_index,
-    crcindex2,
-    crc_index2 : cardinal;
-    crc_test,
-    crc_test2  : pcrc_array;
+    interface_read_crc_index,
+    interface_write_crc_index,
+    indirect_read_crc_index,
+    indirect_write_crc_index,
+    implementation_read_crc_index,
+    implementation_write_crc_index : cardinal;
+    interface_crc_array,
+    indirect_crc_array,
+    implementation_crc_array  : pcrc_array;
+    CRCFile : text;
   private
 {$endif def Test_Double_checksum}
   protected
@@ -175,6 +177,20 @@ implementation
 {$endif def Test_Double_checksum}
     fpccrc;
 
+{$ifdef Test_Double_checksum}
+{$ifdef TEST_CRC_ERROR}
+const
+  CRC_Interface_Change_Message_Level=V_Error;
+  CRC_Implementation_Change_Message_Level=V_Error;
+  CRC_Indirect_Change_Message_Level=V_Error;
+{$else : not  TEST_CRC_ERROR}
+const
+  CRC_Interface_Change_Message_Level=V_Warning;
+  CRC_Implementation_Change_Message_Level=V_Note;
+  CRC_Indirect_Change_Message_Level=V_Note;
+{$endif : not TEST_CRC_ERROR}
+{$endif Test_Double_checksum}
+
 function swapendian_ppureal(d:ppureal):ppureal;
 
 type ppureal_bytes=array[0..sizeof(d)-1] of byte;
@@ -196,22 +212,36 @@ begin
   inherited Create(fn);
   crc_only:=false;
 {$ifdef Test_Double_checksum}
-  if not assigned(crc_test) then
-    new(crc_test);
-  if not assigned(crc_test2) then
-    new(crc_test2);
+  if not assigned(interface_crc_array) then
+    begin
+      new(interface_crc_array);
+      fillchar(interface_crc_array^,sizeof(interface_crc_array),#$ff);
+    end;
+  if not assigned(indirect_crc_array) then
+    begin
+      new(indirect_crc_array);
+      fillchar(indirect_crc_array^,sizeof(indirect_crc_array),#$ff);
+    end;
+  if not assigned(implementation_crc_array) then
+    begin
+      new(implementation_crc_array);
+      fillchar(implementation_crc_array^,sizeof(implementation_crc_array),#$ff);
+    end;
 {$endif Test_Double_checksum}
 end;
 
 destructor tppufile.destroy;
 begin
 {$ifdef Test_Double_checksum}
-  if assigned(crc_test) then
-    dispose(crc_test);
-  crc_test:=nil;
-  if assigned(crc_test2) then
-    dispose(crc_test2);
-  crc_test2:=nil;
+  if assigned(interface_crc_array) then
+    dispose(interface_crc_array);
+  interface_crc_array:=nil;
+  if assigned(indirect_crc_array) then
+    dispose(indirect_crc_array);
+  indirect_crc_array:=nil;
+  if assigned(implementation_crc_array) then
+    dispose(implementation_crc_array);
+  implementation_crc_array:=nil;
 {$endif Test_Double_checksum}
   inherited destroy;
 end;
@@ -359,6 +389,11 @@ end;
 
 
 procedure tppufile.putdata(const b;len:integer);
+{$ifdef Test_Double_checksum}
+  var 
+    pb : pbyte;
+    ind : integer;
+{$endif Test_Double_checksum}
 begin
   if do_crc then
    begin
@@ -366,22 +401,32 @@ begin
 {$ifdef Test_Double_checksum}
      if crc_only then
        begin
-         crc_test2^[crc_index2]:=crc;
+         implementation_crc_array^[implementation_write_crc_index]:=crc;
 {$ifdef Test_Double_checksum_write}
-         Writeln(CRCFile,crc);
+         Write(CRCFile,'imp_crc ',implementation_write_crc_index:6,' $',hexstr(crc,8),' ',len);
+	 pb:=@b;
+	 for ind:=0 to len-1 do
+           Write(CRCFile,' ',hexstr(pb[ind],2));
+         Writeln(CRCFile);
 {$endif Test_Double_checksum_write}
-         if crc_index2<crc_array_size then
-          inc(crc_index2);
+         if implementation_write_crc_index<crc_array_size then
+          inc(implementation_write_crc_index);
        end
      else
        begin
-         if (crcindex2<crc_array_size) and (crcindex2<crc_index2) and
-            (crc_test2^[crcindex2]<>crc) then
-           Do_comment(V_Note,'impl CRC changed');
+         if (implementation_read_crc_index<crc_array_size) and
+            (implementation_crc_array^[implementation_read_crc_index]<>crc) then
+           begin
+             do_comment(CRC_implementation_Change_Message_Level,'implementation CRC changed at index '+tostr(implementation_read_crc_index));
 {$ifdef Test_Double_checksum_write}
-         Writeln(CRCFile,crc);
+             Writeln(CRCFile,'!!!imp_crc ',implementation_read_crc_index:5,'$',hexstr(crc,8),'<>$',hexstr(implementation_crc_array^[implementation_read_crc_index],8));
+           end
+         else
+           begin
+             Writeln(CRCFile,'imp_crc ',implementation_read_crc_index:5,' OK');
 {$endif Test_Double_checksum_write}
-         inc(crcindex2);
+           end;
+         inc(implementation_read_crc_index);
        end;
 {$endif def Test_Double_checksum}
      if do_interface_crc then
@@ -390,29 +435,72 @@ begin
 {$ifdef Test_Double_checksum}
         if crc_only then
           begin
-            crc_test^[crc_index]:=interface_crc;
+            interface_crc_array^[interface_write_crc_index]:=interface_crc;
 {$ifdef Test_Double_checksum_write}
-            Writeln(CRCFile,interface_crc);
+            Write(CRCFile,'int_crc ',interface_write_crc_index:5,' $',hexstr(interface_crc,8),' ',len);
+	    pb:=@b;
+	    for ind:=0 to len-1 do
+              Write(CRCFile,' ',hexstr(pb[ind],2));
+            Writeln(CRCFile);
 {$endif Test_Double_checksum_write}
-            if crc_index<crc_array_size then
-             inc(crc_index);
+            if interface_write_crc_index<crc_array_size then
+             inc(interface_write_crc_index);
           end
         else
           begin
-            if (crcindex<crc_array_size) and (crcindex<crc_index) and
-               (crc_test^[crcindex]<>interface_crc) then
-              Do_comment(V_Warning,'CRC changed');
+            if (interface_read_crc_index<crc_array_size) and
+               (interface_crc_array^[interface_read_crc_index]<>interface_crc) then
+              begin
+                do_comment(CRC_Interface_Change_Message_Level,'interface CRC changed at index '+tostr(interface_read_crc_index));
 {$ifdef Test_Double_checksum_write}
-            Writeln(CRCFile,interface_crc);
+                Writeln(CRCFile,'!!!int_crc ',interface_read_crc_index:5,'$',hexstr(interface_crc,8),'<>$',hexstr(interface_crc_array^[interface_read_crc_index],8));
+              end
+            else
+              begin
+                Writeln(CRCFile,'int_crc ',interface_read_crc_index:5,' OK');
 {$endif Test_Double_checksum_write}
-            inc(crcindex);
+              end;
+            inc(interface_read_crc_index);
           end;
 {$endif def Test_Double_checksum}
          { indirect crc must only be calculated for the interface; changes
            to a class in the implementation cannot require another unit to
            be recompiled }
          if do_indirect_crc then
-           indirect_crc:=UpdateCrc32(indirect_crc,b,len);
+           begin
+             indirect_crc:=UpdateCrc32(indirect_crc,b,len);
+{$ifdef Test_Double_checksum}
+             if crc_only then
+               begin
+                 indirect_crc_array^[indirect_write_crc_index]:=indirect_crc;
+{$ifdef Test_Double_checksum_write}
+                 Write(CRCFile,'ind_crc ',indirect_write_crc_index:5,' $',hexstr(indirect_crc,8),' ',len);
+                 pb:=@b;
+                 for ind:=0 to len-1 do
+                   Write(CRCFile,' ',hexstr(pb[ind],2));
+                 Writeln(CRCFile);
+{$endif Test_Double_checksum_write}
+                 if indirect_write_crc_index<crc_array_size then
+                   inc(indirect_write_crc_index);
+               end
+             else
+               begin
+                 if (indirect_read_crc_index<crc_array_size) and
+                    (indirect_crc_array^[indirect_read_crc_index]<>indirect_crc) then
+                   begin
+                     do_comment(CRC_Indirect_Change_Message_Level,'Indirect CRC changed at index '+tostr(indirect_read_crc_index));
+{$ifdef Test_Double_checksum_write}
+                     Writeln(CRCFile,'!!!ind_crc ',indirect_read_crc_index:5,'$',hexstr(indirect_crc,8),'<>$',hexstr(indirect_crc_array^[indirect_read_crc_index],8));
+                   end
+                 else
+                   begin
+                     Writeln(CRCFile,'ind_crc ',indirect_read_crc_index:5,' OK');
+{$endif Test_Double_checksum_write}
+                   end;
+                 inc(indirect_read_crc_index);
+               end;
+{$endif def Test_Double_checksum}
+           end;
        end;
     end;
   inherited putdata(b,len);
@@ -433,6 +521,16 @@ end;
 
 procedure tppufile.resetfile;
 begin
+{$ifdef Test_Double_checksum_write}
+  if (crc<>0) or (interface_crc<>0) or (indirect_crc<>0) then
+    Writeln(CRCFile,'!!! tppufile.reset called',
+                 ' implementation_crc=$',hexstr(crc,8),
+                 ' interface_crc=$',hexstr(interface_crc,8),
+                 ' indirect_crc=$',hexstr(indirect_crc,8),
+                 ' implementation_crc_size=',implementation_write_crc_index,
+                 ' interface_crc_size=',interface_write_crc_index,
+                 ' indirect_crc_size=',indirect_write_crc_index);
+{$endif Test_Double_checksum_write}
   crc:=0;
   interface_crc:=0;
   indirect_crc:=0;

compiler/psub.pas

@@ -1046,7 +1046,7 @@ implementation
       end;
 
 
-{$if defined(i386) or defined(x86_64) or defined(arm) or defined(riscv32) or defined(riscv64)}
+{$if defined(i386) or defined(x86_64) or defined(arm) or defined(riscv32) or defined(riscv64) or defined(m68k)}
     const
       exception_flags: array[boolean] of tprocinfoflags = (
         [],
@@ -1058,7 +1058,7 @@ implementation
       begin
         tg:=tgobjclass.create;
 
-{$if defined(i386) or defined(x86_64) or defined(arm)}
+{$if defined(i386) or defined(x86_64) or defined(arm) or defined(m68k)}
 {$if defined(arm)}
         { frame and stack pointer must be always the same on arm thumb so it makes no
           sense to fiddle with a frame pointer }
@@ -1127,7 +1127,15 @@ implementation
                 generate_parameter_info;
 
                 if not(procdef.stack_tainting_parameter(calleeside)) and
-                   not(has_assembler_child) {and (para_stack_size=0)} then
+                   not(has_assembler_child)
+{$ifdef m68k}
+                  { parasize must be really zero, this means also that no result may be returned
+                    in a parameter }
+                  and not((current_procinfo.procdef.proccalloption in clearstack_pocalls) and
+                    not(current_procinfo.procdef.generate_safecall_wrapper) and
+                    paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef))
+{$endif m68k}
+                   {and (para_stack_size=0)} then
                   begin
                     { Only need to set the framepointer }
                     framepointer:=NR_STACK_POINTER_REG;
@@ -1156,7 +1164,7 @@ implementation
 {$endif defined(arm)}
               end;
           end;
-{$endif defined(x86) or defined(arm)}
+{$endif defined(x86) or defined(arm) or defined(m68k)}
 {$if defined(xtensa)}
         { On xtensa, the stack frame size can be estimated to avoid using an extra frame pointer,
           in case parameters are passed on the stack.

compiler/scandir.pas

@@ -1339,30 +1339,32 @@ unit scandir;
     procedure dir_setpeflags;
       var
         ident : string;
+        flags : int64;
       begin
         if not (target_info.system in (systems_all_windows)) then
           Message(scan_w_setpeflags_not_support);
-        current_scanner.skipspace;
-        ident:=current_scanner.readid;
-        if ident<>'' then
-          peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag)
-        else
-          peflags:=peflags or current_scanner.readval;
+        if current_scanner.readpreprocint(flags,'SETPEFLAGS') then
+          begin
+            if flags>$ffff then
+              message(scan_e_illegal_peflag);
+            peflags:=peflags or uint16(flags);
+          end;
         SetPEFlagsSetExplicity:=true;
       end;
 
     procedure dir_setpeoptflags;
       var
         ident : string;
+        flags : int64;
       begin
         if not (target_info.system in (systems_all_windows)) then
           Message(scan_w_setpeoptflags_not_support);
-        current_scanner.skipspace;
-        ident:=current_scanner.readid;
-        if ident<>'' then
-          peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag)
-        else
-          peoptflags:=peoptflags or current_scanner.readval;
+        if current_scanner.readpreprocint(flags,'SETPEOPTFLAGS') then
+          begin
+            if flags>$ffff then
+              message(scan_e_illegal_peoptflag);
+            peoptflags:=peoptflags or uint16(flags);
+          end;
         SetPEOptFlagsSetExplicity:=true;
       end;
 

compiler/scanner.pas

@@ -227,6 +227,7 @@ interface
           procedure skipoldtpcomment(read_first_char:boolean);
           procedure readtoken(allowrecordtoken:boolean);
           function  readpreproc:ttoken;
+          function  readpreprocint(var value:int64;const place:string):boolean;
           function  asmgetchar:char;
        end;
 
@@ -276,7 +277,6 @@ interface
     Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean;
     procedure SetAppType(NewAppType:tapptype);
 
-
 implementation
 
     uses
@@ -963,6 +963,7 @@ type
     function evaluate(v:texprvalue;op:ttoken):texprvalue;
     procedure error(expecteddef, place: string);
     function isBoolean: Boolean;
+    function isInt: Boolean;
     function asBool: Boolean;
     function asInt: Integer;
     function asInt64: Int64;
@@ -1403,6 +1404,11 @@ type
         end;
     end;
 
+  function texprvalue.isInt: Boolean;
+    begin
+      result:=is_integer(def);
+    end;
+
   function texprvalue.asBool: Boolean;
     begin
       result:=value.valueord<>0;
@@ -5753,6 +5759,25 @@ exit_label:
       end;
 
 
+    function tscannerfile.readpreprocint(var value:int64;const place:string):boolean;
+      var
+        hs : texprvalue;
+      begin
+        hs:=preproc_comp_expr;
+        if hs.isInt then
+          begin
+            value:=hs.asInt64;
+            result:=true;
+          end
+        else
+          begin
+            hs.error('Integer',place);
+            result:=false;
+          end;
+        hs.free;
+      end;
+
+
     function tscannerfile.asmgetchar : char;
       begin
          readchar;

compiler/symsym.pas

@@ -151,7 +151,7 @@ interface
           function find_procdef_bytype_and_para(pt:Tproctypeoption;para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function find_procdef_byoptions(ops:tprocoptions): Tprocdef;
           function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
-          function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
+          function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype;isexplicit:boolean):Tprocdef;
           function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
           property ProcdefList:TFPObjectList read FProcdefList;
        end;
@@ -1214,7 +1214,7 @@ implementation
       end;
 
 
-    function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
+    function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype;isexplicit:boolean):Tprocdef;
       var
         paraidx, realparamcount,
         i, j : longint;
@@ -1223,12 +1223,22 @@ implementation
         pd : tprocdef;
         convtyp : tconverttype;
         eq      : tequaltype;
+        shortstringcount : longint;
+        checkshortstring,
+        isgenshortstring : boolean;
       begin
         { This function will return the pprocdef of pprocsym that
           is the best match for fromdef and todef. }
         result:=nil;
         bestpd:=nil;
         besteq:=te_incompatible;
+        { special handling for assignment operators overloads to shortstring:
+          for implicit assignment we pick the ShortString one if available and
+          only pick one with specific length if it is the *only* one }
+        shortstringcount:=0;
+        checkshortstring:=not isexplicit and
+                          is_shortstring(todef) and
+                          (tstringdef(todef).len<>255);
         for i:=0 to ProcdefList.Count-1 do
           begin
             pd:=tprocdef(ProcdefList[i]);
@@ -1236,7 +1246,7 @@ implementation
               continue;
             if (equal_defs(todef,pd.returndef) or
                 { shortstrings of different lengths are ok as result }
-                (is_shortstring(todef) and is_shortstring(pd.returndef))) and
+                (not isexplicit and is_shortstring(todef) and is_shortstring(pd.returndef))) and
                { the result type must be always really equal and not an alias,
                  if you mess with this code, check tw4093 }
                ((todef=pd.returndef) or
@@ -1270,7 +1280,14 @@ implementation
                        (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then
                       eq:=te_convert_l1;
 
-                    if eq=te_exact then
+                    isgenshortstring:=false;
+                    if checkshortstring and is_shortstring(pd.returndef) then
+                      if tstringdef(pd.returndef).len<>255 then
+                        inc(shortstringcount)
+                      else
+                        isgenshortstring:=true;
+
+                    if (eq=te_exact) and (not checkshortstring or isgenshortstring) then
                       begin
                         besteq:=eq;
                         result:=pd;
@@ -1284,6 +1301,11 @@ implementation
                   end;
               end;
           end;
+        if checkshortstring and (shortstringcount>1) then
+          begin
+            besteq:=te_incompatible;
+            bestpd:=nil;
+          end;
         result:=bestpd;
       end;
 

compiler/symtable.pas

@@ -3969,11 +3969,21 @@ implementation
         currpd,
         bestpd : tprocdef;
         stackitem : psymtablestackitem;
+        shortstringcount : longint;
+        isexplicit,
+        checkshortstring : boolean;
       begin
         hashedid.id:=overloaded_names[assignment_type];
         besteq:=te_incompatible;
         bestpd:=nil;
         stackitem:=symtablestack.stack;
+        { special handling for assignments to shortstrings with a specific length:
+          - if we get an operator to ShortString we use that
+          - if we get only a single String[x] operator we use that
+          - otherwise it's a nogo }
+        isexplicit:=assignment_type=_OP_EXPLICIT;
+        shortstringcount:=0;
+        checkshortstring:=not isexplicit and is_shortstring(to_def) and (tstringdef(to_def).len<>255);
         while assigned(stackitem) do
           begin
             sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid));
@@ -3983,17 +3993,36 @@ implementation
                   internalerror(200402031);
                 { if the source type is an alias then this is only the second choice,
                   if you mess with this code, check tw4093 }
-                currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq);
+                currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq,isexplicit);
+                { we found a ShortString overload, use that and be done }
+                if checkshortstring and
+                    assigned(currpd) and
+                    is_shortstring(currpd.returndef) and
+                    (tstringdef(currpd.returndef).len=255) then
+                  begin
+                    besteq:=curreq;
+                    bestpd:=currpd;
+                    break;
+                  end;
+                { independently of the operator being better count if we encountered
+                  multpile String[x] operators }
+                if checkshortstring and assigned(currpd) and is_shortstring(currpd.returndef) then
+                  inc(shortstringcount);
                 if curreq>besteq then
                   begin
                     besteq:=curreq;
                     bestpd:=currpd;
-                    if (besteq=te_exact) then
+                    { don't stop searching if we have a String[x] operator cause
+                      we might find a ShortString one or multiple ones (which
+                      leads to no operator use) }
+                    if (besteq=te_exact) and not checkshortstring then
                       break;
                   end;
               end;
             stackitem:=stackitem^.next;
           end;
+        if checkshortstring and (shortstringcount>1) then
+          bestpd:=nil;
         result:=bestpd;
       end;
 

compiler/systems/i_linux.pas

@@ -187,7 +187,7 @@ unit i_linux;
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';
             exeext       : '';
-            defext       : '';
+            defext       : '.def';
             scriptext    : '.sh';
             smartext     : '.sl';
             unitext      : '.ppu';

compiler/systems/t_embed.pas

@@ -1664,159 +1664,8 @@ end;
 
 
 function TLinkerEmbedded.postprocessexecutable(const fn : string;isdll:boolean):boolean;
-  type
-    TElf32header=packed record
-      magic0123         : longint;
-      file_class        : byte;
-      data_encoding     : byte;
-      file_version      : byte;
-      padding           : array[$07..$0f] of byte;
-
-      e_type            : word;
-      e_machine         : word;
-      e_version         : longint;
-      e_entry           : longint;          { entrypoint }
-      e_phoff           : longint;          { program header offset }
-
-      e_shoff           : longint;          { sections header offset }
-      e_flags           : longint;
-      e_ehsize          : word;             { elf header size in bytes }
-      e_phentsize       : word;             { size of an entry in the program header array }
-      e_phnum           : word;             { 0..e_phnum-1 of entrys }
-      e_shentsize       : word;             { size of an entry in sections header array }
-      e_shnum           : word;             { 0..e_shnum-1 of entrys }
-      e_shstrndx        : word;             { index of string section header }
-    end;
-    TElf32sechdr=packed record
-      sh_name           : longint;
-      sh_type           : longint;
-      sh_flags          : longint;
-      sh_addr           : longint;
-
-      sh_offset         : longint;
-      sh_size           : longint;
-      sh_link           : longint;
-      sh_info           : longint;
-
-      sh_addralign      : longint;
-      sh_entsize        : longint;
-    end;
-
-  function MayBeSwapHeader(h : telf32header) : telf32header;
-    begin
-      result:=h;
-      if source_info.endian<>target_info.endian then
-        with h do
-          begin
-            result.e_type:=swapendian(e_type);
-            result.e_machine:=swapendian(e_machine);
-            result.e_version:=swapendian(e_version);
-            result.e_entry:=swapendian(e_entry);
-            result.e_phoff:=swapendian(e_phoff);
-            result.e_shoff:=swapendian(e_shoff);
-            result.e_flags:=swapendian(e_flags);
-            result.e_ehsize:=swapendian(e_ehsize);
-            result.e_phentsize:=swapendian(e_phentsize);
-            result.e_phnum:=swapendian(e_phnum);
-            result.e_shentsize:=swapendian(e_shentsize);
-            result.e_shnum:=swapendian(e_shnum);
-            result.e_shstrndx:=swapendian(e_shstrndx);
-          end;
-    end;
-
-  function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr;
-    begin
-      result:=h;
-      if source_info.endian<>target_info.endian then
-        with h do
-          begin
-            result.sh_name:=swapendian(sh_name);
-            result.sh_type:=swapendian(sh_type);
-            result.sh_flags:=swapendian(sh_flags);
-            result.sh_addr:=swapendian(sh_addr);
-            result.sh_offset:=swapendian(sh_offset);
-            result.sh_size:=swapendian(sh_size);
-            result.sh_link:=swapendian(sh_link);
-            result.sh_info:=swapendian(sh_info);
-            result.sh_addralign:=swapendian(sh_addralign);
-            result.sh_entsize:=swapendian(sh_entsize);
-          end;
-    end;
-
-  var
-    f : file;
-
-  function ReadSectionName(pos : longint) : String;
-    var
-      oldpos : longint;
-      c : char;
-    begin
-      oldpos:=filepos(f);
-      seek(f,pos);
-      Result:='';
-      while true do
-        begin
-          blockread(f,c,1);
-          if c=#0 then
-            break;
-          Result:=Result+c;
-        end;
-      seek(f,oldpos);
-    end;
-
-  var
-    elfheader : TElf32header;
-    secheader : TElf32sechdr;
-    i : longint;
-    stringoffset : longint;
-    secname : string;
   begin
-    postprocessexecutable:=false;
-    { open file }
-    assign(f,fn);
-    {$push}{$I-}
-    reset(f,1);
-    if ioresult<>0 then
-      Message1(execinfo_f_cant_open_executable,fn);
-    { read header }
-    blockread(f,elfheader,sizeof(tElf32header));
-    elfheader:=MayBeSwapHeader(elfheader);
-    seek(f,elfheader.e_shoff);
-    { read string section header }
-    seek(f,elfheader.e_shoff+sizeof(TElf32sechdr)*elfheader.e_shstrndx);
-    blockread(f,secheader,sizeof(secheader));
-    secheader:=MaybeSwapSecHeader(secheader);
-    stringoffset:=secheader.sh_offset;
-
-    seek(f,elfheader.e_shoff);
-    status.datasize:=0;
-    for i:=0 to elfheader.e_shnum-1 do
-      begin
-        blockread(f,secheader,sizeof(secheader));
-        secheader:=MaybeSwapSecHeader(secheader);
-        secname:=ReadSectionName(stringoffset+secheader.sh_name);
-        if secname='.text' then
-          begin
-            Message1(execinfo_x_codesize,tostr(secheader.sh_size));
-            status.codesize:=secheader.sh_size;
-          end
-        else if secname='.data' then
-          begin
-            Message1(execinfo_x_initdatasize,tostr(secheader.sh_size));
-            inc(status.datasize,secheader.sh_size);
-          end
-        else if secname='.bss' then
-          begin
-            Message1(execinfo_x_uninitdatasize,tostr(secheader.sh_size));
-            inc(status.datasize,secheader.sh_size);
-          end;
-
-      end;
-    close(f);
-    {$pop}
-    if ioresult<>0 then
-      ;
-    postprocessexecutable:=true;
+    Result:=PostProcessELFExecutable(fn,isdll);
   end;
 
 

compiler/systems/t_linux.pas

@@ -49,6 +49,7 @@ interface
       reorder : boolean;
       linklibc: boolean;
       Function  WriteResponseFile(isdll:boolean) : Boolean;
+      function postprocessexecutable(const fn: string; isdll: boolean): boolean;
     public
       constructor Create;override;
       procedure SetDefaultInfo;override;
@@ -787,6 +788,9 @@ begin
   if tf_use_psabieh in target_info.flags then
     cmdstr:=cmdstr+ ' --eh-frame-hdr';
 
+  if cs_large in current_settings.globalswitches then
+    cmdstr:=cmdstr+' --no-relax';
+
   success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false);
 
   { Create external .dbg file with debuginfo }
@@ -809,6 +813,11 @@ begin
   if (success) and not(cs_link_nolink in current_settings.globalswitches) then
    DeleteFile(outputexedir+Info.ResName);
 
+  { Post process,
+    as it only writes sections sizes so far, do this only if V_Info is set }
+  if success and CheckVerbosity(V_Info) and not(cs_link_nolink in current_settings.globalswitches) then
+    success:=PostProcessExecutable(current_module.exefilename,false);
+
   MakeExecutable:=success;   { otherwise a recursive call to link method }
 end;
 
@@ -886,6 +895,12 @@ begin
   MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
 end;
 
+
+function TLinkerLinux.postprocessexecutable(const fn : string;isdll:boolean):boolean;
+  begin
+    Result:=PostProcessELFExecutable(fn,isdll);
+  end;
+
 {*****************************************************************************
                               TINTERNALLINKERLINUX
 *****************************************************************************}

compiler/utils/ppuutils/ppudump.pp

@@ -2301,7 +2301,8 @@ const
         'Link for GNU linker version <=2.19', {cs_link_pre_binutils_2_19}
         'Link using vlink', {cs_link_vlink}
         '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}
        );
     localswitchname : array[tlocalswitch] of string[50] =
        { Switches which can be changed locally }

compiler/x86/cgx86.pas

@@ -468,12 +468,19 @@ unit cgx86;
           members aren't known until link time, ABIs place very pessimistic limits
           on offset values, e.g. SysV AMD64 allows +/-$1000000 (16 megabytes) }
         if ((ref.offset<low(longint)) or (ref.offset>high(longint))) or
+           ((cs_large in current_settings.globalswitches) and assigned(ref.symbol)) or
            { absolute address is not a common thing in x64, but nevertheless a possible one }
            ((ref.base=NR_NO) and (ref.index=NR_NO) and (ref.symbol=nil)) then
           begin
             { Load constant value to register }
             hreg:=GetAddressRegister(list);
-            list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg));
+            if (cs_large in current_settings.globalswitches) and assigned(ref.symbol) then
+              begin
+                list.concat(taicpu.op_sym_ofs_reg(A_MOVABS,S_Q,ref.symbol,ref.offset+10,hreg));
+                ref.symbol:=nil;
+              end
+            else
+              list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg));
             ref.offset:=0;
             {if assigned(ref.symbol) then
               begin

compiler/x86/x86ins.dat

@@ -3156,7 +3156,7 @@ void                  \2\x0F\x3A                      P6,CYRIX
 ;
 ; GAS specific x86-64 instructions
 ;
-[MOVABS]
+[MOVABS,movabsX]
 (Ch_Wop2, Ch_Rop1)
 reg_al,mem_offs       \1\xA0\45                       X86_64,SM
 reg_ax|32|64,mem_offs \320\1\xA1\45                   X86_64,SM

compiler/x86_64/x8664ats.inc

@@ -589,7 +589,7 @@ attsufNONE,
 attsufNONE,
 attsufNONE,
 attsufNONE,
-attsufNONE,
+attsufINT,
 attsufNONE,
 attsufNONE,
 attsufNONE,

compiler/z80/cpuinfo.pas

@@ -14,6 +14,8 @@
 
 Unit CPUInfo;
 
+{$i fpcdefs.inc}
+
 Interface
 
   uses

packages/fcl-db/src/base/bufdataset.pas

@@ -45,6 +45,12 @@ type
     BlobBuffer     : PBlobBuffer;
   end;
 
+  TApplyRecUpdateResult = Record
+    HadError : Boolean;
+    Response : TResolverResponse;
+    Async : Boolean;
+  end;
+
   { TBufBlobStream }
 
   TBufBlobStream = class(TStream)
@@ -78,6 +84,7 @@ type
   end;
 
   TRecUpdateBuffer = record
+    Processing         : Boolean;
     UpdateKind         : TUpdateKind;
 {  BookMarkData:
      - Is -1 if the update has canceled out. For example: an appended record has been deleted again
@@ -558,6 +565,14 @@ type
     procedure BuildIndexes;
     procedure RemoveRecordFromIndexes(const ABookmark : TBufBookmark);
     procedure InternalCreateIndex(F: TBufDataSetIndex); virtual;
+    // Position record for update. Note that no check on state is done.
+    procedure PrepareForUpdate(aUpdate: TRecUpdateBuffer);
+    // Apply update for current record. Called in sequence by ApplyUpdates. The active buffer is positioned on the record to be updated.
+    function DoApplyUpdate(var aUpdate : TRecUpdateBuffer; AbortOnError : Boolean): TApplyRecUpdateResult;
+    // Call this when an update failed. This will return true if update must be retried.
+    function HandleUpdateError(aUpdate: TRecUpdateBuffer; var aResult: TApplyRecUpdateResult; E: Exception): Boolean;
+    // Call this when a record has been resolved. It will free temp buffers.
+    procedure ResolvedRecord(var aUpdate: TRecUpdateBuffer);
     Property CurrentIndexBuf : TBufIndex Read GetCurrentIndexBuf;
     Property CurrentIndexDef : TBufDatasetIndex Read FCurrentIndexDef;
     Property BufIndexDefs[Aindex : Integer] : TBufDatasetIndex Read GetBufIndexDef;
@@ -596,7 +611,8 @@ type
     function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
     function IsCursorOpen: Boolean; override;
     function  GetRecordCount: Longint; override;
-    procedure ApplyRecUpdate(UpdateKind : TUpdateKind); virtual;
+    procedure ApplyRecUpdate(UpdateKind : TUpdateKind); virtual; deprecated;
+    Function  ApplyRecUpdateEx(UpdateKind : TUpdateKind) : TApplyRecUpdateResult; virtual;
     procedure SetOnUpdateError(const AValue: TResolverErrorEvent);
     procedure SetFilterText(const Value: String); override; {virtual;}
     procedure SetFiltered(Value: Boolean); override; {virtual;}
@@ -1898,6 +1914,7 @@ begin
 end;
 
 procedure TDoubleLinkedBufIndex.BeginUpdate;
+
 begin
   if FCurrentRecBuf = FLastRecBuf then
     FCursOnFirstRec := True
@@ -2837,95 +2854,162 @@ begin
   FOnUpdateError := AValue;
 end;
 
-procedure TCustomBufDataset.ApplyUpdates; // For backward compatibility
+
+function TCustomBufDataset.ApplyRecUpdateEx(UpdateKind: TUpdateKind): TApplyRecUpdateResult;
 
 begin
-  ApplyUpdates(0);
+  Result:=Default(TApplyRecUpdateResult);
+  Result.Async:=False;
+  Result.Response:=rrApply;
+  ApplyRecUpdate(UpdateKind);
+end;
+
+Function TCustomBufDataset.HandleUpdateError(aUpdate : TRecUpdateBuffer; var aResult : TApplyRecUpdateResult; E : Exception) : Boolean;
+
+Var
+  AUpdateError : EUpdateError;
+
+begin
+  Result:=False;
+  AUpdateError := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
+  if assigned(FOnUpdateError) then
+    begin
+    FOnUpdateError(Self, Self, AUpdateError, aUpdate.UpdateKind, aResult.Response);
+    AUpdateError.Free;
+    Result:=aResult.Response=rrApply;
+    end
+  else if (aResult.Response = rrAbort) then
+    begin
+    raise AUpdateError;
+    end
+  else
+    aUpdateError.Free;
+end;
+
+Procedure TCustomBufDataset.PrepareForUpdate(aUpdate : TRecUpdateBuffer);
+
+begin
+  // For async, this could be a different buffer than the buffer
+  CurrentIndexBuf.GotoBookmark(@aUpdate.BookmarkData);
+  // Synchronise the CurrentBuffer to the ActiveBuffer
+  CurrentRecordToBuffer(ActiveBuffer);
+end;
+
+function TCustomBufDataset.DoApplyUpdate(var aUpdate : TRecUpdateBuffer; AbortOnError : Boolean): TApplyRecUpdateResult;
+
+Const
+  ErrorResponse : Array[Boolean] of TResolverResponse = (rrSkip,rrAbort);
+
+begin
+  Result.Async:=False;
+  Result.Response:=rrApply;
+  // If the record is first inserted and afterwards deleted, do nothing
+  if ((aUpdate.UpdateKind=ukDelete) and not (assigned(aUpdate.OldValuesBuffer))) then
+    exit;
+  try
+     PrepareForUpdate(aUpdate);
+     Result:=ApplyRecUpdateEx(aUpdate.UpdateKind);
+  except
+    on E: EDatabaseError do
+      begin
+      Result.Response:=ErrorResponse[AbortOnError];
+      if HandleUpdateError(aUpdate,Result,E) then
+         DoApplyUpdate(aUpdate,AbortOnError);
+      Result.HadError:=True;
+      end
+    else
+      raise;
+  end;
+end;
+
+procedure TCustomBufDataset.ResolvedRecord(Var aUpdate : TRecUpdateBuffer);
+
+begin
+  FreeRecordBuffer(aUpdate.OldValuesBuffer);
+  if aUpdate.UpdateKind = ukDelete then
+    FreeRecordBuffer(TRecordBuffer(AUpdate.BookmarkData.BookmarkData));
+  AUpdate.BookmarkData.BookmarkData := nil;
+  aUpdate.Processing:=False;
 end;
 
 procedure TCustomBufDataset.ApplyUpdates(MaxErrors: Integer);
 
 var r            : Integer;
     FailedCount  : integer;
-    Response     : TResolverResponse;
+    Res : TApplyRecUpdateResult;
     StoreCurrRec : TBufBookmark;
-    AUpdateError : EUpdateError;
+    aSyncDetected : Boolean;
+    aOldState : TDataSetState;
+    UpdOK : Boolean;
 
 begin
+  Res:=Default(TApplyRecUpdateResult);
+  Res.Response:=rrApply;
   CheckBrowseMode;
-
   CurrentIndexBuf.StoreCurrentRecIntoBookmark(@StoreCurrRec);
-
-  r := 0;
-  FailedCount := 0;
-  Response := rrApply;
-  DisableControls;
+  aSyncDetected:=False;
+  aOldState:=SetTempState(dsBlockRead);
   try
-    while (r < Length(FUpdateBuffer)) and (Response <> rrAbort) do
-      begin
-      // If the record is first inserted and afterwards deleted, do nothing
-      if not ((FUpdateBuffer[r].UpdateKind=ukDelete) and not (assigned(FUpdateBuffer[r].OldValuesBuffer))) then
+    DisableControls;
+    r := 0;
+    FailedCount := 0;
+    while (r < Length(FUpdateBuffer)) and (Res.Response <> rrAbort) do
+      // S
+      if Not FUpdateBuffer[r].Processing then
         begin
-        CurrentIndexBuf.GotoBookmark(@FUpdateBuffer[r].BookmarkData);
-        // Synchronise the CurrentBuffer to the ActiveBuffer
-        CurrentRecordToBuffer(ActiveBuffer);
-        Response := rrApply;
+        UpdOK:=False;
+        FUpdateBuffer[r].Processing:=True;
         try
-          ApplyRecUpdate(FUpdateBuffer[r].UpdateKind);
-        except
-          on E: EDatabaseError do
-            begin
-            Inc(FailedCount);
-            if FailedCount > word(MaxErrors) then
-              Response := rrAbort
-            else
-              Response := rrSkip;
-            if assigned(FOnUpdateError) then
-              begin
-              AUpdateError := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
-              FOnUpdateError(Self, Self, AUpdateError, FUpdateBuffer[r].UpdateKind, Response);
-              AUpdateError.Free;
-              if Response in [rrApply, rrIgnore] then dec(FailedCount);
-              if Response = rrApply then dec(r);
-              end
-            else if Response = rrAbort then
-              begin
-              AUpdateError := PSGetUpdateException(Exception(AcquireExceptionObject), nil);
-              raise AUpdateError;
-              end;
-            end
+          Res:=DoApplyUpdate(FUpdateBuffer[r],FailedCount>=MaxErrors);
+          UpdOK:=True;
+        finally
+          if Res.Async then
+            aSyncDetected:=True
           else
-            raise;
+            begin
+            FUpdateBuffer[r].Processing:=False;
+            if not UpdOK then // We have an exception, force HadError
+              Res.HadError:=True;
+            if Res.HadError then
+              Inc(FailedCount);
+            if Res.Response in [rrApply, rrIgnore] then
+              ResolvedRecord(FUpdateBuffer[r]);
+            end;
         end;
-        if Response in [rrApply, rrIgnore] then
-          begin
-          FreeRecordBuffer(FUpdateBuffer[r].OldValuesBuffer);
-          if FUpdateBuffer[r].UpdateKind = ukDelete then
-            FreeRecordBuffer( TRecordBuffer(FUpdateBuffer[r].BookmarkData.BookmarkData));
-          FUpdateBuffer[r].BookmarkData.BookmarkData := nil;
-          end
+        inc(r);
         end;
-      inc(r);
-      end;
   finally
-    if (FailedCount=0) and Not ManualMergeChangeLog then
+    if (FailedCount=0) and Not (AsyncDetected or ManualMergeChangeLog) then
       MergeChangeLog;
     InternalGotoBookmark(@StoreCurrRec);
     Resync([]);
+    RestoreState(aOldState);
     EnableControls;
   end;
 end;
 
+procedure TCustomBufDataset.ApplyUpdates; // For backward compatibility
+
+begin
+  ApplyUpdates(0);
+end;
+
 procedure TCustomBufDataset.MergeChangeLog;
 
-var r            : Integer;
+var
+  r,aCount : Integer;
 
 begin
+  aCount:=0;
+  for r:=0 to length(FUpdateBuffer)-1 do
+    if FUpdateBuffer[r].Processing then
+      Inc(aCount);
+  If aCount>0 then
+    Raise EDatabaseError.CreateFmt(SErrUpdatesInProgess,[ACount]);
   for r:=0 to length(FUpdateBuffer)-1 do
     if assigned(FUpdateBuffer[r].OldValuesBuffer) then
       FreeMem(FUpdateBuffer[r].OldValuesBuffer);
   SetLength(FUpdateBuffer,0);
-
   if assigned(FUpdateBlobBuffers) then for r:=0 to length(FUpdateBlobBuffers)-1 do
     if assigned(FUpdateBlobBuffers[r]) then
       begin

packages/fcl-db/src/base/dbconst.pas

@@ -91,6 +91,7 @@ Resourcestring
   SFieldIsNull             = 'The field is null';
   SOnUpdateError           = 'An error occurred while applying the updates in a record: %s';
   SApplyRecNotSupported    = 'Applying updates is not supported by this TDataset descendent';
+  SErrUpdatesInProgess     = 'Apply updates in progress: %d records being processed.';
   SNoWhereFields           = 'No %s query specified and failed to generate one. (No fields for inclusion in where statement found)';
   SNoUpdateFields          = 'No %s query specified and failed to generate one. (No fields for insert- or update-statement found)';
   SNotSupported            = 'Operation is not supported by this type of database';

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -49,6 +49,7 @@ type
     in_SQLDA             : PXSQLDA;
     ParamBinding         : array of integer;
     FieldBinding         : array of integer;
+    CursorName : String;
   end;
 
   TIBTrans = Class(TSQLHandle)
@@ -70,6 +71,7 @@ type
     FBlobSegmentSize       : word; //required for backward compatibilty; not used
     FUseConnectionCharSetIfNone: Boolean;
     FWireCompression       : Boolean;
+    FCursorCount : Integer;
     procedure ConnectFB;
 
     procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
@@ -773,6 +775,7 @@ begin
   curs.sqlda := nil;
   curs.StatementHandle := nil;
   curs.FPrepared := False;
+  curs.CursorName:='';
   AllocSQLDA(curs.SQLDA,0);
   result := curs;
 end;
@@ -809,6 +812,7 @@ begin
     begin
     DatabaseHandle := GetHandle;
     TransactionHandle := aTransaction.Handle;
+    CursorName:='';
 
     if isc_dsql_allocate_statement(@Status[0], @DatabaseHandle, @StatementHandle) <> 0 then
       CheckError('PrepareStatement', Status);
@@ -908,6 +912,7 @@ begin
           CheckError('FreeStatement', Status);
         StatementHandle := nil;
         FPrepared := False;
+        CursorName:='';
       end;
     FreeSQLDABuffer(SQLDA);
     FreeSQLDABuffer(in_SQLDA);
@@ -950,21 +955,29 @@ begin
     FieldNameQuoteChars := NoQuotes
   else
     FieldNameQuoteChars := DoubleQuotes;
+  FCursorCount:=0;
 end;
 
 procedure TIBConnection.FreeFldBuffers(cursor : TSQLCursor);
 
+
 begin
   with cursor as TIBCursor do
     begin
-    if isc_dsql_free_statement(@Status, @StatementHandle, DSQL_close)<>0 then
-      CheckError('Close Cursor', Status);
+    if FSelectable and (CursorName<>'') then
+      begin
+      if isc_dsql_free_statement(@Status, @StatementHandle, DSQL_close)<>0 then
+        CheckError('Close Cursor', Status); // Ignore this, it can already be closed.
+      end;
     end;
 end;
 
 procedure TIBConnection.Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams);
-var TransactionHandle : pointer;
-    out_SQLDA : PXSQLDA;
+var
+  TransactionHandle : pointer;
+  out_SQLDA : PXSQLDA;
+  S: String;
+
 begin
   TransactionHandle := aTransaction.Handle;
   if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
@@ -978,8 +991,17 @@ begin
       out_SQLDA := nil;
     if isc_dsql_execute2(@Status[0], @TransactionHandle, @StatementHandle, 1, in_SQLDA, out_SQLDA) <> 0 then
       CheckError('Execute', Status);
-    if isc_dsql_set_cursor_name(@Status[0], @StatementHandle, 'sqldbcursor', 0) <> 0 then
-      CheckError('Open Cursor', Status);
+    if FSelectable then
+      begin
+      if CursorName='' then
+        begin
+        Inc(FCursorCount);
+        CursorName:='sqldbcursor'+IntToStr(FCursorCount);
+        end;
+      if isc_dsql_set_cursor_name(@Status[0], @StatementHandle, PChar(CursorName) , 0) <> 0 then
+        CheckError('Open Cursor', Status);
+    end
+    else
   end;
 end;
 

packages/fcl-db/src/sqldb/postgres/pqconnection.pp

@@ -104,6 +104,8 @@ type
     // Release connection in pool.
     procedure ReleaseConnection(Conn: PPGConn; DoClear : Boolean);
 
+    function PortParamName: string; override;
+
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
     function GetHandle : pointer; override;
@@ -1419,6 +1421,11 @@ begin
     end;
 end;
 
+function TPQConnection.PortParamName: string;
+begin
+  Result := 'port';
+end;
+
 procedure TPQConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
 
 var qry : TSQLQuery;

packages/fcl-db/src/sqldb/sqldb.pp

@@ -222,6 +222,7 @@ type
     procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
     function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; virtual;
     procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
+    function PortParamName: string; virtual;
     function GetConnectionCharSet: string; virtual;
     procedure SetTransaction(Value : TSQLTransaction); virtual;
     procedure DoConnect; override;
@@ -1519,7 +1520,7 @@ end;
 
 function TSQLConnection.GetPort: cardinal;
 begin
-  result := StrToIntDef(Params.Values['Port'],0);
+  result := StrToIntDef(Params.Values[PortParamName],0);
 end;
 
 procedure TSQLConnection.SetOptions(AValue: TSQLConnectionOptions);
@@ -1532,9 +1533,9 @@ end;
 procedure TSQLConnection.SetPort(const AValue: cardinal);
 begin
   if AValue<>0 then
-    Params.Values['Port']:=IntToStr(AValue)
-  else with params do if IndexOfName('Port') > -1 then
-    Delete(IndexOfName('Port'));
+    Params.Values[PortParamName]:=IntToStr(AValue)
+  else with params do if IndexOfName(PortParamName) > -1 then
+    Delete(IndexOfName(PortParamName));
 end;
 
 function TSQLConnection.AttemptCommit(trans: TSQLHandle): boolean;
@@ -2317,6 +2318,11 @@ begin
     end;
 end;
 
+function TSQLConnection.PortParamName: string;
+begin
+  Result := 'Port';
+end;
+
 procedure TSQLConnection.CreateDB;
 
 begin

packages/fcl-passrc/src/pasresolver.pp

@@ -872,6 +872,7 @@ type
   public
     constructor Create; override;
     destructor Destroy; override;
+    procedure ClearIdentifiers(FreeItems: boolean);
     function FindLocalIdentifier(const Identifier: String): TPasIdentifier; inline;
     function FindIdentifier(const Identifier: String): TPasIdentifier; virtual;
     function RemoveLocalIdentifier(El: TPasElement): boolean; virtual;
@@ -4412,19 +4413,34 @@ end;
 
 destructor TPasIdentifierScope.Destroy;
 begin
+  ClearIdentifiers(true);
+  inherited Destroy;
   {$IFDEF VerbosePasResolverMem}
-  writeln('TPasIdentifierScope.Destroy START ',ClassName);
+  writeln('TPasIdentifierScope.Destroy END ',ClassName);
   {$ENDIF}
+end;
+
+procedure TPasIdentifierScope.ClearIdentifiers(FreeItems: boolean);
+begin
+  {$IFDEF VerbosePasResolverMem}
+  writeln('TPasIdentifierScope.Clear START ',ClassName);
+  {$ENDIF}
+
   FItems.ForEachCall(@OnClearItem,nil);
+
   {$ifdef pas2js}
-  FItems:=nil;
+  if FreeItems then
+    FItems:=nil
+  else
+    FItems.Clear;
   {$else}
   FItems.Clear;
-  FreeAndNil(FItems);
+  if FreeItems then
+    FreeAndNil(FItems);
   {$endif}
-  inherited Destroy;
+
   {$IFDEF VerbosePasResolverMem}
-  writeln('TPasIdentifierScope.Destroy END ',ClassName);
+  writeln('TPasIdentifierScope.Clear END ',ClassName);
   {$ENDIF}
 end;
 
@@ -20904,11 +20920,27 @@ end;
 function TPasResolver.FindElementFor(const aName: String; AParent: TPasElement;
   TypeParamCount: integer): TPasElement;
 // called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub
+var
+  ErrorEl: TPasElement;
+
+  procedure CheckGenericRefWithoutParams(GenEl: TPasGenericType);
+  // called when TypeParamCount=0  check if reference to a generic type is allowed with
+  begin
+    if (GenEl.GenericTemplateTypes=nil) or (GenEl.GenericTemplateTypes.Count=0) then
+      exit;
+    // referrring to a generic type without params
+    if not (msDelphi in CurrentParser.CurrentModeswitches)
+        and (AParent<>nil)
+        and AParent.HasParent(GenEl) then
+      exit; // mode objfpc: inside the generic type it can be referred without params
+    RaiseMsg(20201129005025,nGenericsWithoutSpecializationAsType,sGenericsWithoutSpecializationAsType,['variable'],ErrorEl);
+  end;
+
 var
   p: SizeInt;
   RightPath, CurName, LeftPath: String;
   NeedPop: Boolean;
-  CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement;
+  CurScopeEl, NextEl, BestEl: TPasElement;
   CurSection: TPasSection;
   i: Integer;
   UsesUnit: TPasUsesUnit;
@@ -20980,11 +21012,17 @@ begin
         RaiseInternalError(20190801104033); // caller forgot to handle "With"
       end
     else
+      begin
       NextEl:=FindElementWithoutParams(CurName,ErrorEl,true,true);
+      if (NextEl is TPasGenericType) and (RightPath='') then
+        CheckGenericRefWithoutParams(TPasGenericType(NextEl));
+      end;
     {$IFDEF VerbosePasResolver}
     //if RightPath<>'' then
     //  writeln('TPasResolver.FindElement searching scope "',CurName,'" RightPath="',RightPath,'" ... NextEl=',GetObjName(NextEl));
     {$ENDIF}
+    if NextEl=nil then
+      RaiseIdentifierNotFound(20201129004745,CurName,ErrorEl);
     if NextEl is TPasModule then
       begin
       if CurScopeEl is TPasModule then
@@ -21038,10 +21076,8 @@ begin
       else
         CurScopeEl:=BestEl;
       end
-    else if NextEl<>nil then
-      CurScopeEl:=NextEl
     else
-      RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl);
+      CurScopeEl:=NextEl;
 
     // restore scope
     if NeedPop then
@@ -21056,6 +21092,7 @@ end;
 
 function TPasResolver.FindElementWithoutParams(const AName: String;
   ErrorPosEl: TPasElement; NoProcsWithArgs, NoGenerics: boolean): TPasElement;
+// ErrorPosEl=nil means to use scanner position as error position
 var
   Data: TPRFindData;
 begin
@@ -21070,6 +21107,7 @@ end;
 function TPasResolver.FindElementWithoutParams(const AName: String; out
   Data: TPRFindData; ErrorPosEl: TPasElement; NoProcsWithArgs,
   NoGenerics: boolean): TPasElement;
+// ErrorPosEl=nil means to use scanner position as error position
 var
   Abort: boolean;
 begin

packages/fcl-passrc/src/pastree.pp

@@ -2155,7 +2155,7 @@ destructor TInlineSpecializeExpr.Destroy;
 var
   i: Integer;
 begin
-  TPasElement(NameExpr).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+  ReleaseAndNil(TPasElement(NameExpr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
   for i:=0 to Params.Count-1 do
     TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
   FreeAndNil(Params);

packages/fcl-passrc/src/pparser.pp

@@ -2029,7 +2029,10 @@ begin
   finally
     if not ok then
       if Result<>nil then
+        begin
         Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+        Result:=nil;
+        end;
   end;
 end;
 

packages/fcl-passrc/src/pscanner.pp

@@ -3797,8 +3797,8 @@ begin
     SetMode(msMac,MacModeSwitches,false,bsMacPasMode);
   'ISO':
     SetMode(msIso,ISOModeSwitches,false,[],[],false);
-  'EXTENDED':
-    SetMode(msExtpas,ExtPasModeSwitches,false,[],[],false);
+  'EXTENDEDPASCAL':
+    SetMode(msExtpas,ExtPasModeSwitches,false);
   'GPC':
     SetMode(msGPC,GPCModeSwitches,false);
   else

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -64,6 +64,7 @@ type
     procedure TestGen_ClassObjFPC;
     procedure TestGen_ClassObjFPC_OverloadFail;
     procedure TestGen_ClassObjFPC_OverloadOtherUnit;
+    procedure TestGen_ClassGenAncestorWithoutParamFail;
     procedure TestGen_ClassForward;
     procedure TestGen_ClassForwardConstraints;
     procedure TestGen_ClassForwardConstraintNameMismatch;
@@ -261,8 +262,8 @@ begin
   '  TBirdAlias = TBird;',
   'begin',
   '']);
-  CheckResolverException('type expected, but TBird<> found',
-    nXExpectedButYFound);
+  CheckResolverException('Generics without specialization cannot be used as a type for a variable',
+    nGenericsWithoutSpecializationAsType);
 end;
 
 procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
@@ -940,6 +941,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ClassGenAncestorWithoutParamFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class end;',
+  '  generic TEagle<T> = class(TBird)',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Generics without specialization cannot be used as a type for a variable',
+    nGenericsWithoutSpecializationAsType);
+end;
+
 procedure TTestResolveGenerics.TestGen_ClassForward;
 begin
   StartProgram(false);

packages/fpmkunit/src/fpmkunit.pp

@@ -4268,23 +4268,33 @@ Var
   SL : TStringList;
   L : TUnsortedDuplicatesStringList;
   I : Integer;
+  iCPU : TCPU;
+  iOS : TOS;
 
 begin
   GPathPrefix:=P.Directory;
   AddPackageMacrosToDictionary(P,P.Dictionary);
+  // First target OS
   ResolveFileNames(P,Defaults.CPU,Defaults.OS,False,True);
-
+  // Then other OSes
+  for ICPU:=Low(TCPU) to high(TCPU) do
+    for IOS:=Low(TOS) to high(TOS) do
+       if (IOS<>Defaults.OS) or (iCPU<>Defaults.CPU) then
+         if OSCPUSupported[IOS,ICPU] then
+            ResolveFileNames(P,ICPU,IOS,false);
   AddLn('<package name="%s" output="" content="%s.xct">',[quotexml(P.Name),quotexml(P.Name)]);
   Addln('  <units>');
   SL:=TStringList.Create;
   For T in P.Targets do
-    if (T.TargetType=ttUnit) and (T.TargetSourceFileName<>'') then
+    if (T.TargetType in [ttUnit,ttImplicitUnit]) and (T.TargetSourceFileName<>'') then
       begin
       SL.Clear;
-      Writeln(T.Name,' -> ',T.TargetSourceFileName);
+      // Writeln(T.Name,' -> ',T.TargetSourceFileName);
       FN:=AddPathPrefix(P,T.TargetSourceFileName);
       SL.Add('-d'+CPUToString(Defaults.CPU));
       SL.Add('-d'+OSToString(Defaults.OS));
+      if Defaults.OS in AllUnixOSes then
+        SL.Add('-dUNIX');
       SL.Add('-M'+ModeToString(T.Mode));
       // Include Path
       L:=TUnsortedDuplicatesStringList.Create;
@@ -7106,8 +7116,11 @@ begin
           synchronised from the thread that wrote them; the critical section there
           acts as a read/write barrier }
         ReadBarrier;
-
+{$ifdef NO_THREADING}
+      Args.Add('-Fl'+FCachedlibcPath);
+{$ELSE}      
       Args.Add('-Fl'+volatile(FCachedlibcPath));
+{$ENDIF}      
     end;
 
   // Custom options which are added by dependencies

packages/pastojs/src/fppas2js.pp

@@ -981,7 +981,7 @@ const
      'yield'
     );
   // reserved words, not usable as global identifiers, can be used as sub identifiers
-  JSReservedGlobalWords: array[0..51] of string = (
+  JSReservedGlobalWords: array[0..52] of string = (
      // keep sorted, first uppercase, then lowercase !
      'Array',
      'ArrayBuffer',
@@ -992,6 +992,7 @@ const
      'EvalError',
      'Float32Array',
      'Float64Array',
+     'FormData',
      'Generator',
      'GeneratorFunction',
      'Infinity',
@@ -1787,7 +1788,7 @@ type
     ImplContext: TSectionContext;
     ImplHeaderStatements: TFPList;
     ImplSrcElements: TJSSourceElements;
-    ImplHeaderIndex: integer; // index in TJSSourceElements(JSElement).Statements
+    ImplHeaderIndex: integer; // index in ImplSrcElements.Statements
     destructor Destroy; override;
     procedure AddImplHeaderStatement(JS: TJSElement);
   end;
@@ -8112,31 +8113,34 @@ begin
           AddToSourceElements(Src,ConvertDeclarations(El.InterfaceSection,IntfSecCtx));
 
         ImplFunc:=CreateImplementationSection(El,IntfSecCtx);
-        if ImplFunc=nil then
+        // add $mod.$implcode = ImplFunc;
+        AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
+        AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
+        AssignSt.Expr:=ImplFunc;
+        AddToSourceElements(Src,AssignSt);
+
+        // append initialization section
+        CreateInitSection(El,Src,IntfSecCtx);
+
+        if TJSSourceElements(ImplFunc.AFunction.Body.A).Statements.Count=0 then
           begin
+          // empty implementation
+
           // remove unneeded $impl from interface
           RemoveFromSourceElements(Src,ImplVarSt);
-          if IntfSecCtx.HeaderIndex>0 then
-            dec(IntfSecCtx.HeaderIndex);
-          if IntfSecCtx.ImplHeaderIndex>0 then
-            dec(IntfSecCtx.ImplHeaderIndex);
+          // remove unneeded $mod.$implcode = function(){}
+          RemoveFromSourceElements(Src,AssignSt);
           HasImplUsesClause:=length(El.ImplementationSection.UsesClause)>0;
           end
         else
           begin
-          // add $mod.$implcode = ImplFunc;
-          AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
-          AssignSt.LHS:=CreateMemberExpression([ModVarName,GetBIName(pbivnImplCode)]);
-          AssignSt.Expr:=ImplFunc;
-          AddToSourceElements(Src,AssignSt);
           HasImplUsesClause:=true;
           end;
+
         if HasImplUsesClause then
           // add implementation uses list: [<implementation uses1>,<uses2>, ...]
           ArgArray.AddElement(CreateUsesList(El.ImplementationSection,AContext));
 
-        CreateInitSection(El,Src,IntfSecCtx);
-
         end;
 
       if (ModScope<>nil) and (coStoreImplJS in Options) then
@@ -9733,11 +9737,30 @@ end;
 function TPasToJSConverter.CreateSubDeclJSNameExpr(El: TPasElement;
   JSName: string; AContext: TConvertContext; PosEl: TPasElement): TJSElement;
 var
+  C: TClass;
+  VarKinds: TCtxVarKinds;
   ParentName: String;
 begin
-  if AContext.IsGlobal then
+  C:=El.ClassType;
+  if C.InheritsFrom(TPasType) or (C=TPasConst) then
+    VarKinds:=[cvkGlobal]
+  else if C.InheritsFrom(TPasVariable) then
+    begin
+    VarKinds:=[cvkCurType];
+    if ([vmClass, vmStatic]*TPasVariable(El).VarModifiers<>[]) then
+      VarKinds:=[cvkGlobal]
+    else if El.Parent is TPasMembersType then
+      VarKinds:=[cvkCurType]
+    else
+      VarKinds:=[cvkGlobal];
+    end
+  else if (El.Parent is TProcedureBody) then
+    VarKinds:=[]
+  else
+    VarKinds:=[cvkGlobal];
+  if VarKinds<>[] then
     begin
-    ParentName:=GetLocalName(El.Parent,[cvkGlobal,cvkCurType],AContext);
+    ParentName:=GetLocalName(El.Parent,VarKinds,AContext);
     if ParentName='' then
       ParentName:='this';
     if JSName[1]='[' then
@@ -14826,7 +14849,7 @@ begin
     ObjLit.Name:=TJSString(TransformElToJSName(El,AContext));
     ObjLit.Expr:=CreateVarInit(El,AContext);
     end
-  else if AContext.IsGlobal then
+  else if AContext.IsGlobal or (El.Parent is TPasMembersType) then
     begin
     // create 'this.A=initvalue'
     AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
@@ -15354,7 +15377,7 @@ var
   C: TClass;
   AssignSt: TJSSimpleAssignStatement;
   NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt,
-    SpecializeDelay: Boolean;
+    SpecializeDelay, NeedTypeInfo: Boolean;
   Proc: TPasProcedure;
 begin
   Result:=nil;
@@ -15463,6 +15486,7 @@ begin
       end;
 
     NeedInitFunction:=true;
+    NeedTypeInfo:=(pcsfPublished in Scope.Flags) or HasTypeInfo(El,AContext);
     IntfKind:='';
     if El.ObjKind=okInterface then
       begin
@@ -15473,8 +15497,7 @@ begin
         else
           RaiseNotSupported(El,AContext,20180405093512);
         end;
-      NeedInitFunction:=(pcsfPublished in Scope.Flags) or HasTypeInfo(El,AContext)
-                        or (IntfKind<>'') or (coShortRefGlobals in Options);
+      NeedInitFunction:=NeedTypeInfo or (IntfKind<>'') or (coShortRefGlobals in Options);
       end;
 
     if NeedInitFunction then
@@ -15616,11 +15639,14 @@ begin
           AddClassSupportedInterfaces(El,Src,FuncContext);
         AddClassMessageIds(El,Src,FuncContext,pbivnMessageInt);
         AddClassMessageIds(El,Src,FuncContext,pbivnMessageStr);
-        // add RTTI init function
-        if SpecializeDelay then
-          AddClassRTTI(El,DelaySrc,DelayFuncContext)
-        else
-          AddClassRTTI(El,Src,FuncContext);
+        if NeedTypeInfo then
+          begin
+          // add RTTI init function
+          if SpecializeDelay then
+            AddClassRTTI(El,DelaySrc,DelayFuncContext)
+          else
+            AddClassRTTI(El,Src,FuncContext);
+          end;
         end;
 
       end;// end of init function
@@ -17471,14 +17497,15 @@ begin
     if ImplDecl<>nil then
       RaiseInconsistency(20170910175032,El); // elements should have been added directly
     IntfContext.ImplHeaderIndex:=ImplContext.HeaderIndex;
-    if Src.Statements.Count=0 then
-      exit; // no implementation
     Result:=FunDecl;
   finally
     IntfContext.ImplContext:=nil;
     ImplContext.Free;
     if Result=nil then
+      begin
       FunDecl.Free;
+      IntfContext.ImplSrcElements:=nil;
+      end;
   end;
 end;
 
@@ -18588,7 +18615,7 @@ begin
   try
     New_FuncContext.ThisVar.Element:=El;
     New_FuncContext.ThisVar.Kind:=cvkCurType;
-    New_FuncContext.IsGlobal:=true;
+    New_FuncContext.IsGlobal:=false;
 
     // add class members
     For I:=0 to El.Members.Count-1 do
@@ -18600,8 +18627,10 @@ begin
           and (ClassVarModifiersType*TPasVariable(P).VarModifiers=[]) then
         begin
         if Kind=mfInit then
+        begin
           // mfInit: init var
-          NewEl:=CreateVarDecl(TPasVariable(P),New_FuncContext) // can be nil
+          NewEl:=CreateVarDecl(TPasVariable(P),New_FuncContext); // can be nil
+        end
         else
           begin
           // mfFinalize: clear reference
@@ -19445,6 +19474,8 @@ var
   Bracket: TJSBracketMemberExpression;
 begin
   El:=ResolveSimpleAliasType(El);
+  if El is TPasSpecializeType then
+    El:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
   aName:=GetTypeInfoName(El,AContext,ErrorEl);
   if aName=GetBIName(pbivnRTTILocal) then
     Result:=CreatePrimitiveDotExpr(aName,El)

packages/pastojs/src/pas2jscompiler.pp

@@ -393,7 +393,7 @@ type
     destructor Destroy; override;
     Function CreatePCUSupport: TPCUSupport; virtual;
     function GetInitialModeSwitches: TModeSwitches;
-    function IsUnitReadFromPCU: Boolean;
+    function IsUnitReadFromPCU: Boolean; // unit was read from pcu
     function GetInitialBoolSwitches: TBoolSwitches;
     function GetInitialConverterOptions: TPasToJsConverterOptions;
     procedure CreateScannerAndParser(aFileResolver: TPas2jsFSResolver);
@@ -1053,7 +1053,7 @@ begin
 
   if coEnumValuesAsNumbers in Compiler.Options then
     Include(Result,fppas2js.coEnumNumbers);
-  if coShortRefGlobals in Compiler.Options then
+  if (coShortRefGlobals in Compiler.Options) or IsUnitReadFromPCU then
     Include(Result,fppas2js.coShortRefGlobals);
 
   if coLowerCase in Compiler.Options then
@@ -2219,7 +2219,6 @@ begin
 end;
 
 function TPas2jsCompiler.CreateOptimizer: TPas2JSAnalyzer;
-
 begin
   Result:=TPas2JSAnalyzer.Create;
 end;
@@ -2351,7 +2350,6 @@ begin
 end;
 
 function TPas2jsCompiler.CreateSrcMap(const aFileName: String): TPas2JSSrcMap;
-
 begin
   Result:=TPas2JSSrcMap.Create(aFileName);
 end;
@@ -2788,8 +2786,6 @@ begin
     FResources.DoneUnit(aFile.isMainFile);
     EmitJavaScript(aFile,aFileWriter);
 
-
-
     if aFile.IsMainFile and (TargetPlatform=PlatformNodeJS) then
       aFileWriter.WriteFile('rtl.run();'+LineEnding,aFile.UnitFilename);
 
@@ -3767,7 +3763,7 @@ begin
      'enumnumbers': SetOption(coEnumValuesAsNumbers,Enable);
      'removenotusedprivates': SetOption(coKeepNotUsedPrivates,not Enable);
      'removenotuseddeclarations': SetOption(coKeepNotUsedDeclarationsWPO,not Enable);
-     'shortrefglobals': SetOption(coShortRefGlobals,not Enable);
+     'shortrefglobals': SetOption(coShortRefGlobals,Enable);
     else
       Log.LogMsgIgnoreFilter(nUnknownOptimizationOption,[QuoteStr(aValue)]);
     end;
@@ -4193,19 +4189,16 @@ begin
 end;
 
 function TPas2jsCompiler.CreateMacroEngine: TPas2jsMacroEngine;
-
 begin
   Result:=TPas2jsMacroEngine.Create;
 end;
 
 function TPas2jsCompiler.CreateLog: TPas2jsLogger;
-
 begin
   Result:=TPas2jsLogger.Create;
 end;
 
 constructor TPas2jsCompiler.Create;
-
 begin
   FOptions:=DefaultP2jsCompilerOptions;
   FConverterGlobals:=TPasToJSConverterGlobals.Create(Self);

packages/pastojs/src/pas2jsfiler.pp

@@ -243,8 +243,9 @@ const
     'Goto'
     );
 
+  PCUMinConverterOptions = [coStoreImplJS,coShortRefGlobals];
   PCUDefaultConverterOptions: TPasToJsConverterOptions =
-    [coUseStrict,coStoreImplJS,coShortRefGlobals];
+    PCUMinConverterOptions+[coUseStrict];
   PCUConverterOptions: array[TPasToJsConverterOption] of string = (
     'LowerCase',
     'SwitchStatement',
@@ -999,6 +1000,7 @@ type
     FElementRefsArray: TPCUFilerElementRefArray; // TPCUFilerElementRef by Id
     FJSON: TJSONObject;
     FPendingIdentifierScopes: TObjectList; // list of TPCUReaderPendingIdentifierScope
+    FIntfSectionObj: TJSONObject;
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
@@ -1043,6 +1045,7 @@ type
     procedure DeletePendingSpecialize(PendSpec: TPCUReaderPendingSpecialized);
     function PromiseSpecialize(SpecId: integer; const SpecName: string; RefEl, ErrorEl: TPasElement): TPCUReaderPendingSpecialized; virtual;
     procedure ResolveSpecializedElements(Complete: boolean);
+    function IsSpecialize(ChildEl: TPasElement): boolean;
   protected
     // json
     procedure RaiseMsg(Id: int64; const Msg: string = ''); overload; override;
@@ -1095,6 +1098,7 @@ type
     procedure ReadSpecialization(Obj: TJSONObject; GenEl: TPasGenericType; ParamIDs: TJSONArray); virtual;
     procedure ReadExternalReferences(Obj: TJSONObject; El: TPasElement); virtual;
     procedure ReadUsedUnitsInit(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
+    procedure ReadIndirectUsedUnits(Obj: TJSONObject; Section: TPasSection; aComplete: boolean); virtual;
     procedure ReadUsedUnitsFinish(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
     procedure ReadSectionScope(Obj: TJSONObject; Scope: TPas2JSSectionScope; aContext: TPCUReaderContext); virtual;
     procedure ReadSection(Obj: TJSONObject; Section: TPasSection; aContext: TPCUReaderContext); virtual;
@@ -1300,7 +1304,7 @@ implementation
 procedure RegisterPCUFormat;
 begin
   if PCUFormat=nil then
-    PCUFormat:=PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
+    PCUFormat:=PrecompileFormats.Add('pcu','all used pcu must match exactly together',TPCUReader,TPCUWriter);
 end;
 
 function ComparePointer(Data1, Data2: Pointer): integer;
@@ -2164,7 +2168,7 @@ begin
   ParserOptions:=PCUDefaultParserOptions;
   ModeSwitches:=PCUDefaultModeSwitches;
   BoolSwitches:=PCUDefaultBoolSwitches;
-  ConverterOptions:=PCUDefaultConverterOptions-[coStoreImplJS];
+  ConverterOptions:=PCUDefaultConverterOptions;
   TargetPlatform:=PCUDefaultTargetPlatform;
   TargetProcessor:=PCUDefaultTargetProcessor;
 end;
@@ -2588,7 +2592,7 @@ procedure TPCUWriter.WriteModule(Obj: TJSONObject; aModule: TPasModule;
     if Section=nil then exit;
     if Section.Parent<>aModule then
       RaiseMsg(20180205153912,aModule,PropName);
-    aContext.Section:=Section; // set Section before calling virtual method
+    aContext.Section:=Section; // set Section before calling virtual WriteSection
     aContext.SectionObj:=nil;
     aContext.IndirectUsesArr:=nil;
     WriteSection(Obj,Section,PropName,aContext);
@@ -3467,7 +3471,7 @@ begin
     end
   else if (El.ClassType=TPasModule) or (El is TPasUnitModule) then
     begin
-    // indirect used unit
+    // indirectly used unit (refs to directly used units are created in WriteSection)
     if aContext.IndirectUsesArr=nil then
       begin
       if aContext.SectionObj=nil then
@@ -5208,7 +5212,12 @@ begin
   // set AncestorScope
   aClassAncestor:=Resolver.ResolveAliasType(Scope.DirectAncestor);
   if not (aClassAncestor is TPasClassType) then
+    begin
+    {$IFDEF VerbosePCUFiler}
+    writeln('TPCUReader.Set_ClassScope_DirectAncestor ',GetObjPath(Scope.DirectAncestor),' ClassAnc=',GetObjPath(aClassAncestor));
+    {$ENDIF}
     RaiseMsg(20180214114322,Scope.Element,GetObjName(RefEl));
+    end;
   AncestorScope:=aClassAncestor.CustomData as TPas2JSClassScope;
   Scope.AncestorScope:=AncestorScope;
   if (AncestorScope<>nil) and (pcsfPublished in Scope.AncestorScope.Flags) then
@@ -5526,7 +5535,8 @@ begin
       RaiseMsg(20200531101105,PendSpec.GenericEl,PendSpec.SpecName);// nothing uses this specialize
     end;
   if PendSpec.GenericEl=nil then
-    RaiseMsg(20200531101333,RefEl,PendSpec.SpecName);
+    // not yet ready
+    exit;
   Obj:=PendSpec.Obj;
   if Obj=nil then
     RaiseMsg(20200531101128,PendSpec.GenericEl,PendSpec.SpecName); // specialize missing in JSON
@@ -5642,6 +5652,17 @@ begin
     end;
 end;
 
+function TPCUReader.IsSpecialize(ChildEl: TPasElement): boolean;
+begin
+  if (ChildEl is TPasGenericType)
+      and Resolver.IsSpecialized(TPasGenericType(ChildEl)) then
+    exit(true);
+  if (ChildEl is TPasProcedure)
+      and (TPas2JSProcedureScope(ChildEl.CustomData).SpecializedFromItem<>nil) then
+    exit(true);
+  Result:=false;
+end;
+
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 var
   E: EPas2JsReadError;
@@ -6597,8 +6618,7 @@ begin
     for k:=0 to Members.Count-1 do
       begin
       ChildEl:=TPasElement(Members[k]);
-      if (ChildEl is TPasGenericType)
-          and Resolver.IsSpecialized(TPasGenericType(ChildEl)) then
+      if IsSpecialize(ChildEl) then
         // skip specialized type
       else if Index=j then
         break
@@ -6643,6 +6663,8 @@ end;
 
 procedure TPCUReader.ReadSpecialization(Obj: TJSONObject;
   GenEl: TPasGenericType; ParamIDs: TJSONArray);
+// called by ReadSpecializations
+// create a specialization promise
 var
   i, Id: Integer;
   ErrorEl: TPasElement;
@@ -6796,6 +6818,50 @@ begin
   if aContext=nil then ;
 end;
 
+procedure TPCUReader.ReadIndirectUsedUnits(Obj: TJSONObject;
+  Section: TPasSection; aComplete: boolean);
+// read external refs from indirectly used units
+var
+  i: Integer;
+  Arr: TJSONArray;
+  Data: TJSONData;
+  UsesObj: TJSONObject;
+  Name: string;
+  Module: TPasModule;
+  UsedScope: TPas2JSSectionScope;
+begin
+  if ReadArray(Obj,'IndirectUses',Arr,Section) then
+    begin
+    for i:=0 to Arr.Count-1 do
+      begin
+      Data:=Arr[i];
+      if not (Data is TJSONObject) then
+        RaiseMsg(20180314155716,Section,GetObjName(Data));
+      UsesObj:=TJSONObject(Data);
+      if not ReadString(UsesObj,'Name',Name,Section) then
+        RaiseMsg(20180314155756,Section);
+      if not IsValidIdent(Name,true,true) then
+        RaiseMsg(20180314155800,Section,Name);
+      Module:=Resolver.FindModule(Name,nil,nil);
+      if Module=nil then
+        RaiseMsg(20180314155840,Section,Name);
+      if Module.InterfaceSection=nil then
+        begin
+        if not aComplete then
+          continue;
+        {$IF defined(VerbosePCUFiler) or defined(VerbosePJUFiler)}
+        writeln('TPCUReader.ReadUsedUnitsFinish Resolver.RootElement=',GetObjPath(Resolver.RootElement),' Section=',GetObjPath(Section));
+        {$ENDIF}
+        RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
+        end;
+      UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
+      if not UsedScope.Finished then
+        RaiseMsg(20180314155954,Section,'indirect unit "'+Name+'"');
+      ReadExternalReferences(UsesObj,Module);
+      end;
+    end;
+end;
+
 procedure TPCUReader.ReadUsedUnitsFinish(Obj: TJSONObject;
   Section: TPasSection; aContext: TPCUReaderContext);
 var
@@ -6806,10 +6872,9 @@ var
   Module: TPasModule;
   Data: TJSONData;
   UsesObj, ModuleObj: TJSONObject;
-  Name: string;
 begin
   Scope:=Section.CustomData as TPas2JSSectionScope;
-  // read external refs from used units
+  // read external refs from directly used units
   if ReadArray(Obj,'Uses',Arr,Section) then
     begin
     Scope:=Section.CustomData as TPas2JSSectionScope;
@@ -6836,29 +6901,15 @@ begin
     end;
 
   // read external refs from indirectly used units
-  if ReadArray(Obj,'IndirectUses',Arr,Section) then
+  if Section.ClassType=TInterfaceSection then
+    FIntfSectionObj:=Obj
+  else if Section.ClassType=TImplementationSection then
     begin
-    for i:=0 to Arr.Count-1 do
-      begin
-      Data:=Arr[i];
-      if not (Data is TJSONObject) then
-        RaiseMsg(20180314155716,Section,GetObjName(Data));
-      UsesObj:=TJSONObject(Data);
-      if not ReadString(UsesObj,'Name',Name,Section) then
-        RaiseMsg(20180314155756,Section);
-      if not IsValidIdent(Name,true,true) then
-        RaiseMsg(20180314155800,Section,Name);
-      Module:=Resolver.FindModule(Name,nil,nil);
-      if Module=nil then
-        RaiseMsg(20180314155840,Section,Name);
-      if Module.InterfaceSection=nil then
-        RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
-      UsedScope:=Module.InterfaceSection.CustomData as TPas2JSSectionScope;
-      if not UsedScope.Finished then
-        RaiseMsg(20180314155953,Section,'indirect unit "'+Name+'"');
-      ReadExternalReferences(UsesObj,Module);
-      end;
-    end;
+    ReadIndirectUsedUnits(FIntfSectionObj,Section,true);
+    ReadIndirectUsedUnits(Obj,Section,true);
+    end
+  else
+    ReadIndirectUsedUnits(Obj,Section,true);
 
   Scope.UsesFinished:=true;
 
@@ -6899,14 +6950,19 @@ begin
     if Section.PendingUsedIntf<>nil then
       RaiseMsg(20180308160639,Section,GetObjName(Section.PendingUsedIntf));
     end;
-  // read external references
-  ReadUsedUnitsFinish(Obj,Section,aContext);
-  // read scope, needs external refs
-  ReadSectionScope(Obj,Scope,aContext);
-  aContext.BoolSwitches:=Scope.BoolSwitches;
-  aContext.ModeSwitches:=Scope.ModeSwitches;
-  // read declarations, needs external refs
-  ReadDeclarations(Obj,Section,aContext);
+  Resolver.PushScope(Scope);
+  try
+    // read external references
+    ReadUsedUnitsFinish(Obj,Section,aContext);
+    // read scope, needs external refs
+    ReadSectionScope(Obj,Scope,aContext);
+    aContext.BoolSwitches:=Scope.BoolSwitches;
+    aContext.ModeSwitches:=Scope.ModeSwitches;
+    // read declarations, needs external refs
+    ReadDeclarations(Obj,Section,aContext);
+  finally
+    Resolver.PopScope;
+  end;
 
   Scope.Finished:=true;
   if Section is TInterfaceSection then
@@ -6962,10 +7018,31 @@ end;
 
 function TPCUReader.CreateElement(AClass: TPTreeElement; const AName: String;
   AParent: TPasElement): TPasElement;
+var
+  Scope: TPasScope;
+  Kind: TPasIdentifierKind;
 begin
   Result:=AClass.Create(AName,AParent);
   Result.SourceFilename:=SourceFilename;
   {$IFDEF CheckPasTreeRefCount}Result.RefIds.Add('CreateElement');{$ENDIF}
+  if (AName<>'')
+      and (AClass<>TPasArgument)
+      and (AClass<>TPasResultElement)
+      and (AClass<>TPasGenericTemplateType) then
+    begin
+    Scope:=Resolver.TopScope;
+    if Scope is TPasIdentifierScope then
+      begin
+      // add identifier to scope
+      // Note: Resolver needs this for specializations
+      // The scope identifiers will be later replaced with the values from the
+      // pcu, see ResolvePendingIdentifierScopes
+      Kind:=PCUDefaultIdentifierKind;
+      if Result is TPasProcedure then
+        Kind:=pikProc;
+      TPasIdentifierScope(Scope).AddIdentifier(AName,Result,Kind);
+      end;
+    end;
 end;
 
 function TPCUReader.ReadElementProperty(Obj: TJSONObject; Parent: TPasElement;
@@ -7449,8 +7526,9 @@ var
   Ref: TPCUFilerElementRef;
 begin
   {$IFDEF VerbosePCUFiler}
-  writeln('TPCUReader.ReadIdentifierScope ',Arr.Count);
+  writeln('TPCUReader.ReadIdentifierScopeArray ',Arr.Count);
   {$ENDIF}
+  Scope.ClearIdentifiers(false);
   for i:=0 to Arr.Count-1 do
     begin
     Data:=Arr[i];
@@ -7459,7 +7537,7 @@ begin
       Id:=Data.AsInteger;
       Ref:=GetElRef(Id,DefKind,DefName);
       {$IFDEF VerbosePCUFiler}
-      writeln('TPCUReader.ReadIdentifierScope Id=',Id,' ',DefName,' ',DefKind,' ',GetObjName(Ref.Element));
+      writeln('TPCUReader.ReadIdentifierScopeArray Id=',Id,' ',DefName,' ',DefKind,' ',GetObjName(Ref.Element));
       {$ENDIF}
       Scope.AddIdentifier(DefName,Ref.Element,DefKind);
       end
@@ -8239,6 +8317,7 @@ var
   SpecName: string;
   i, SpecId: Integer;
   Data: TPasSpecializeTypeData;
+  PendSpec: TPCUReaderPendingSpecialized;
 begin
   ReadAliasType(Obj,El,aContext);
   if not (El.DestType is TPasGenericType) then
@@ -8274,7 +8353,11 @@ begin
     RaiseMsg(20200530134152,El);
 
   if Data.SpecializedType=nil then
-    PromiseSpecialize(SpecId,SpecName,El,El);
+    begin
+    PendSpec:=PromiseSpecialize(SpecId,SpecName,El,El);
+    // specialize now
+    CreateSpecializedElement(PendSpec);
+    end;
 end;
 
 procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
@@ -8366,9 +8449,14 @@ begin
 
   ReadPasElement(Obj,El,aContext);
   ReadEnumTypeScope(Obj,Scope,aContext);
-  ReadElementList(Obj,El,'Values',El.Values,
-    {$IFDEF CheckPasTreeRefCount}'TPasEnumType.Values'{$ELSE}true{$ENDIF},
-    aContext);
+  Resolver.PushScope(Scope);
+  try
+    ReadElementList(Obj,El,'Values',El.Values,
+      {$IFDEF CheckPasTreeRefCount}'TPasEnumType.Values'{$ELSE}true{$ENDIF},
+      aContext);
+  finally
+    Resolver.PopScope;
+  end;
 end;
 
 procedure TPCUReader.ReadSetType(Obj: TJSONObject; El: TPasSetType;
@@ -8427,28 +8515,33 @@ begin
   ReadPasElement(Obj,El,aContext);
   ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   El.PackMode:=ReadPackedMode(Obj,'Packed',El);
-  ReadElementList(Obj,El,'Members',El.Members,
-    {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Members'{$ELSE}true{$ENDIF},
-    aContext);
 
-  // VariantEl: TPasElement can be TPasVariable or TPasType
-  Data:=Obj.Find('VariantEl');
-  if Data is TJSONIntegerNumber then
-    begin
-    Id:=Data.AsInteger;
-    PromiseSetElReference(Id,@Set_RecordType_VariantEl,El,El);
-    end
-  else if Data is TJSONObject then
-    begin
-    SubObj:=TJSONObject(Data);
-    El.VariantEl:=ReadNewElement(SubObj,El);
-    ReadElement(SubObj,El.VariantEl,aContext);
-    end;
+  Resolver.PushScope(Scope);
+  try
+    ReadElementList(Obj,El,'Members',El.Members,
+      {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Members'{$ELSE}true{$ENDIF},
+      aContext);
 
-  ReadElementList(Obj,El,'Variants',El.Variants,
-    {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Variants'{$ELSE}true{$ENDIF},
-    aContext);
+    // VariantEl: TPasElement can be TPasVariable or TPasType
+    Data:=Obj.Find('VariantEl');
+    if Data is TJSONIntegerNumber then
+      begin
+      Id:=Data.AsInteger;
+      PromiseSetElReference(Id,@Set_RecordType_VariantEl,El,El);
+      end
+    else if Data is TJSONObject then
+      begin
+      SubObj:=TJSONObject(Data);
+      El.VariantEl:=ReadNewElement(SubObj,El);
+      ReadElement(SubObj,El.VariantEl,aContext);
+      end;
 
+    ReadElementList(Obj,El,'Variants',El.Variants,
+      {$IFDEF CheckPasTreeRefCount}'TPasRecordType.Variants'{$ELSE}true{$ENDIF},
+      aContext);
+  finally
+    Resolver.PopScope;
+  end;
   ReadRecordScope(Obj,Scope,aContext);
   Resolver.FinishSpecializedClassOrRecIntf(Scope);
   Resolver.FinishSpecializations(Scope);
@@ -8790,33 +8883,37 @@ begin
 
   if Scope<>nil then
     begin
-    ReadClassScope(Obj,Scope,aContext);
+    Resolver.PushScope(Scope);
+    try
+      ReadClassScope(Obj,Scope,aContext);
 
-    // read Members
-    ReadElementList(Obj,El,'Members',El.Members,
-      {$IFDEF CheckPasTreeRefCount}'TPasClassType.Members'{$ELSE}true{$ENDIF},
-      aContext);
+      // read Members
+      ReadElementList(Obj,El,'Members',El.Members,
+        {$IFDEF CheckPasTreeRefCount}'TPasClassType.Members'{$ELSE}true{$ENDIF},
+        aContext);
 
-    ReadClassScopeAbstractProcs(Obj,Scope);
-    ReadClassScopeInterfaces(Obj,Scope);
-    ReadClassScopeDispatchProcs(Obj,Scope);
+      ReadClassScopeAbstractProcs(Obj,Scope);
+      ReadClassScopeInterfaces(Obj,Scope);
+      ReadClassScopeDispatchProcs(Obj,Scope);
 
-    if El.ObjKind in okAllHelpers then
-      begin
-      // restore cached helpers in interface
-      Parent:=El.Parent;
-      while Parent<>nil do
+      if El.ObjKind in okAllHelpers then
         begin
-        if Parent.ClassType=TInterfaceSection then
+        // restore cached helpers in interface
+        Parent:=El.Parent;
+        while Parent<>nil do
           begin
-          SectionScope:=Parent.CustomData as TPasSectionScope;
-          Resolver.AddHelper(El,SectionScope.Helpers);
-          break;
+          if Parent.ClassType=TInterfaceSection then
+            begin
+            SectionScope:=Parent.CustomData as TPasSectionScope;
+            Resolver.AddHelper(El,SectionScope.Helpers);
+            break;
+            end;
+          Parent:=Parent.Parent;
           end;
-        Parent:=Parent.Parent;
         end;
-      end;
-
+    finally
+      Resolver.PopScope;
+    end;
     Resolver.FinishSpecializedClassOrRecIntf(Scope);
     Resolver.FinishSpecializations(Scope);
     ReadSpecializations(Obj,El);
@@ -8903,6 +9000,14 @@ var
 begin
   ReadPasElement(Obj,El,aContext);
   ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
+
+  if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+    begin
+    Scope:=TPas2JSProcTypeScope(Resolver.CreateScope(El,TPas2JSProcTypeScope));
+    El.CustomData:=Scope;
+    ReadProcTypeScope(Obj,Scope,aContext);
+    end;
+
   ReadElementList(Obj,El,'Args',El.Args,
     {$IFDEF CheckPasTreeRefCount}'TPasProcedureType.Args'{$ELSE}true{$ENDIF},
     aContext);
@@ -8922,13 +9027,6 @@ begin
     end;
   El.Modifiers:=ReadProcTypeModifiers(Obj,El,'Modifiers',GetDefaultProcTypeModifiers(El));
 
-  if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
-    begin
-    Scope:=TPas2JSProcTypeScope(Resolver.CreateScope(El,TPas2JSProcTypeScope));
-    El.CustomData:=Scope;
-    ReadProcTypeScope(Obj,Scope,aContext);
-    end;
-
   ReadSpecializations(Obj,El);
 end;
 
@@ -9059,9 +9157,17 @@ begin
   El.DispIDExpr:=ReadExpr(Obj,El,'DispId',aContext);
   El.StoredAccessor:=ReadExpr(Obj,El,'Stored',aContext);
   El.DefaultExpr:=ReadExpr(Obj,El,'DefaultValue',aContext);
-  ReadElementList(Obj,El,'Args',El.Args,
-    {$IFDEF CheckPasTreeRefCount}'TPasProperty.Args'{$ELSE}true{$ENDIF},
-    aContext);
+
+  if Scope<>nil then
+    Resolver.PushScope(Scope);
+  try
+    ReadElementList(Obj,El,'Args',El.Args,
+      {$IFDEF CheckPasTreeRefCount}'TPasProperty.Args'{$ELSE}true{$ENDIF},
+      aContext);
+  finally
+    if Scope<>nil then
+      Resolver.PopScope;
+  end;
   //ReadAccessorName: string; // not used by resolver
   //WriteAccessorName: string; // not used by resolver
   //ImplementsName: string; // not used by resolver
@@ -9292,41 +9398,46 @@ begin
   if DeclProc=nil then
     DeclProc:=El;
 
-  if Resolver.ProcCanBePrecompiled(DeclProc) then
-    begin
-    // normal proc (non generic)
-    ImplJS:=TPas2JSPrecompiledJS.Create;
-    ImplScope.ImplJS:=ImplJS;
-    ReadPrecompiledJS(Obj,El,ImplJS,aContext);
-    end
-  else
-    begin
-    // generic proc
-    if ReadObject(Obj,'Body',BodyObj,El) then
+  Resolver.PushScope(ImplScope);
+  try
+    if Resolver.ProcCanBePrecompiled(DeclProc) then
       begin
-      OldInGeneric:=aContext.InGeneric;
-      aContext.InGeneric:=true;
-      ProcBody:=TProcedureBody(CreateElement(TProcedureBody,'',El));
-      El.Body:=ProcBody;
-      ProcBody.SourceFilename:=El.SourceFilename;
-      ProcBody.SourceLinenumber:=El.SourceLinenumber;
-      ProcBody.SourceEndLinenumber:=El.SourceEndLinenumber;
-      ReadDeclarations(BodyObj,ProcBody,aContext);
-      if ReadObject(BodyObj,'Impl',BodyBodyObj,ProcBody) then
+      // normal proc (non generic)
+      ImplJS:=TPas2JSPrecompiledJS.Create;
+      ImplScope.ImplJS:=ImplJS;
+      ReadPrecompiledJS(Obj,El,ImplJS,aContext);
+      end
+    else
+      begin
+      // generic proc
+      if ReadObject(Obj,'Body',BodyObj,El) then
         begin
-        ImplEl:=ReadNewElement(BodyBodyObj,ProcBody);
-        if not (ImplEl is TPasImplBlock) then
+        OldInGeneric:=aContext.InGeneric;
+        aContext.InGeneric:=true;
+        ProcBody:=TProcedureBody(CreateElement(TProcedureBody,'',El));
+        El.Body:=ProcBody;
+        ProcBody.SourceFilename:=El.SourceFilename;
+        ProcBody.SourceLinenumber:=El.SourceLinenumber;
+        ProcBody.SourceEndLinenumber:=El.SourceEndLinenumber;
+        ReadDeclarations(BodyObj,ProcBody,aContext);
+        if ReadObject(BodyObj,'Impl',BodyBodyObj,ProcBody) then
           begin
-          s:=GetObjName(ImplEl);
-          ImplEl.Release;
-          RaiseMsg(20191231171840,ProcBody,s);
+          ImplEl:=ReadNewElement(BodyBodyObj,ProcBody);
+          if not (ImplEl is TPasImplBlock) then
+            begin
+            s:=GetObjName(ImplEl);
+            ImplEl.Release;
+            RaiseMsg(20191231171840,ProcBody,s);
+            end;
+          ProcBody.Body:=TPasImplBlock(ImplEl);
+          ReadElement(BodyBodyObj,ImplEl,aContext);
           end;
-        ProcBody.Body:=TPasImplBlock(ImplEl);
-        ReadElement(BodyBodyObj,ImplEl,aContext);
+        aContext.InGeneric:=OldInGeneric;
         end;
-      aContext.InGeneric:=OldInGeneric;
       end;
-    end;
+  finally
+    Resolver.PopScope;
+  end;
 end;
 
 procedure TPCUReader.ReadProcedure(Obj: TJSONObject; El: TPasProcedure;
@@ -9828,7 +9939,7 @@ begin
     'InitParserOpts': InitialFlags.ParserOptions:=ReadParserOptions(Obj,nil,aName,PCUDefaultParserOptions);
     'InitModeSwitches': InitialFlags.ModeSwitches:=ReadModeSwitches(Obj,nil,aName,PCUDefaultModeSwitches);
     'InitBoolSwitches': InitialFlags.BoolSwitches:=ReadBoolSwitches(Obj,nil,aName,PCUDefaultBoolSwitches);
-    'InitConverterOpts': InitialFlags.ConverterOptions:=ReadConverterOptions(Obj,nil,aName,PCUDefaultConverterOptions-[coStoreImplJS]);
+    'InitConverterOpts': InitialFlags.ConverterOptions:=ReadConverterOptions(Obj,nil,aName,PCUDefaultConverterOptions);
     'FinalParserOpts': Parser.Options:=ReadParserOptions(Obj,nil,aName,InitialFlags.ParserOptions);
     'FinalModeSwitches': Scanner.CurrentModeSwitches:=ReadModeSwitches(Obj,nil,aName,InitialFlags.ModeSwitches);
     'FinalBoolSwitches': Scanner.CurrentBoolSwitches:=ReadBoolSwitches(Obj,nil,aName,InitialFlags.BoolSwitches);

packages/pastojs/src/pas2jspcucompiler.pp

@@ -169,7 +169,7 @@ begin
   PrecompileInitialFlags.ParserOptions:=MyFile.Parser.Options;
   PrecompileInitialFlags.ModeSwitches:=MyFile.Scanner.CurrentModeSwitches;
   PrecompileInitialFlags.BoolSwitches:=MyFile.Scanner.CurrentBoolSwitches;
-  PrecompileInitialFlags.ConverterOptions:=MyFile.GetInitialConverterOptions;
+  PrecompileInitialFlags.ConverterOptions:=MyFile.GetInitialConverterOptions+PCUMinConverterOptions;
   PrecompileInitialFlags.TargetPlatform:=Compiler.TargetPlatform;
   PrecompileInitialFlags.TargetProcessor:=Compiler.TargetProcessor;
 end;
@@ -315,17 +315,16 @@ begin
 
     // create JavaScript for procs, initialization, finalization
     MyFile.CreateConverter;
-    MyFile.Converter.Options:=MyFile.Converter.Options+[coStoreImplJS];
+    MyFile.Converter.Options:=MyFile.Converter.Options+PCUMinConverterOptions;
     MyFile.Converter.OnIsElementUsed:=@OnPCUConverterIsElementUsed;
     MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
     JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
-    MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
     MyFile.PCUSupport.SetInitialCompileFlags;
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
     {$ENDIF}
     Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,
-                    PrecompileInitialFlags,ms,AllowCompressed);
+              PrecompileInitialFlags,ms,AllowCompressed);
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
     {$ENDIF}

packages/pastojs/tests/tcmodules.pas

@@ -843,6 +843,7 @@ type
     Procedure TestRTTI_Interface_COM;
     Procedure TestRTTI_ClassHelper;
     Procedure TestRTTI_ExternalClass;
+    Procedure TestRTTI_Unit;
 
     // Resourcestring
     Procedure TestResourcestringProgram;
@@ -16980,6 +16981,7 @@ end;
 
 procedure TTestModule.TestExternalClass_SameNamePublishedProperty;
 begin
+  WithTypeInfo:=true;
   StartProgram(false);
   Add([
   '{$modeswitch externalclass}',
@@ -16999,6 +17001,9 @@ begin
   ConvertProgram;
   CheckSource('TestExternalClass_SameNamePublishedProperty',
     LinesToStr([ // statements
+    'this.$rtti.$ExtClass("JSwiper", {',
+    '  jsclass: "Swiper"',
+    '});',
     'rtl.createClass(this, "TObject", null, function () {',
     '  this.$init = function () {',
     '    this.FSwiper = null;',
@@ -30681,7 +30686,7 @@ begin
   Add('{$modeswitch externalclass}');
   Add('type');
   Add('  TRec = record end;');
-  // ToDo: ^PRec
+  // ToDo: ^TRec
   Add('  TObject = class end;');
   Add('  TClass = class of tobject;');
   Add('var');
@@ -30691,7 +30696,7 @@ begin
   Add('  tiClass: ttypeinfoclass;');
   Add('  aClass: tclass;');
   Add('  tiClassRef: ttypeinfoclassref;');
-  // ToDo: ^PRec
+  // ToDo: ^TRec
   Add('  tiPointer: ttypeinfopointer;');
   Add('begin');
   Add('  tirecord:=typeinfo(trec);');
@@ -31110,6 +31115,66 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRTTI_Unit;
+begin
+  WithTypeInfo:=true;
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    '{$mode delphi}',
+    'type',
+    '  TWordArray = array of word;',
+    '  TArray<T> = array of T;',
+    '']),
+    '');
+  StartUnit(true,[supTypeInfo,supTInterfacedObject]);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'uses unit2;',
+  'type',
+  '  IBird = interface',
+  '    function Swoop: TWordArray;',
+  '    function Glide: TArray<word>;',
+  '  end;',
+  'procedure Fly;',
+  'implementation',
+  'procedure Fly;',
+  'var',
+  '  ta: tTypeInfoDynArray;',
+  '  ti: tTypeInfoInterface;',
+  'begin',
+  '  ta:=typeinfo(TWordArray);',
+  '  ta:=typeinfo(TArray<word>);',
+  '  ti:=typeinfo(IBird);',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestRTTI_ExternalClass',
+    LinesToStr([ // statements
+    'rtl.createInterface(',
+    '  this,',
+    '  "IBird",',
+    '  "{3B98AAAC-6116-3E17-AA85-F16786D85B09}",',
+    '  ["Swoop", "Glide"],',
+    '  pas.system.IUnknown,',
+    '  function () {',
+    '    var $r = this.$rtti;',
+    '    $r.addMethod("Swoop", 1, null, pas.unit2.$rtti["TWordArray"]);',
+    '    $r.addMethod("Glide", 1, null, pas.unit2.$rtti["TArray<System.Word>"]);',
+    '  }',
+    ');',
+    'this.Fly = function () {',
+    '  var ta = null;',
+    '  var ti = null;',
+    '  ta = pas.unit2.$rtti["TWordArray"];',
+    '  ta = pas.unit2.$rtti["TArray<System.Word>"];',
+    '  ti = $mod.$rtti["IBird"];',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestResourcestringProgram;
 begin
   AddModuleWithIntfImplSrc('unit2.pas',

packages/pastojs/tests/tcoptimizations.pas

@@ -61,6 +61,7 @@ type
     procedure TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl;
     procedure TestOptShortRefGlobals_Property;
     procedure TestOptShortRefGlobals_ExternalAbstract;
+    procedure TestOptShortRefGlobals_Class;
     procedure TestOptShortRefGlobals_GenericFunction;
     procedure TestOptShortRefGlobals_GenericMethod_Call;
     procedure TestOptShortRefGlobals_GenericStaticMethod_Call;
@@ -71,6 +72,7 @@ type
     procedure TestOptShortRefGlobals_SameUnit_EnumType;
     procedure TestOptShortRefGlobals_SameUnit_ClassType;
     procedure TestOptShortRefGlobals_SameUnit_RecordType;
+    procedure TestOptShortRefGlobals_Unit_InitNoImpl;
 
     // Whole Program Optimization
     procedure TestWPO_OmitLocalVar;
@@ -551,6 +553,77 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_Class;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  TBird = class',
+    '  end;',
+    '']),
+  LinesToStr([
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'uses unita;',
+  'type',
+  '  TEagle = class(TBird)',
+  '    Size: TBird;',
+  '    class var Color: TBird;',
+  '    procedure Fly;',
+  '    class procedure Run;',
+  '  end;',
+  'implementation',
+  'procedure TEagle.Fly;',
+  'begin',
+  '  Size:=Size;',
+  '  Self.Size:=Self.Size;',
+  '  Color:=Color;',
+  '  Self.Color:=Self.Color;',
+  'end;',
+  'class procedure TEagle.Run;',
+  'begin',
+  '  Color:=Color;',
+  '  Self.Color:=Self.Color;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_Class',
+    LinesToStr([
+    'var $lt = null;',
+    'var $lm = pas.UnitA;',
+    'var $lt1 = $lm.TBird;',
+    'rtl.createClass(this, "TEagle", $lt1, function () {',
+    '  $lt = this;',
+    '  this.Color = null;',
+    '  this.$init = function () {',
+    '    $lt1.$init.call(this);',
+    '    this.Size = null;',
+    '  };',
+    '  this.$final = function () {',
+    '    this.Size = undefined;',
+    '    $lt1.$final.call(this);',
+    '  };',
+    '  this.Fly = function () {',
+    '    this.Size = this.Size;',
+    '    this.Size = this.Size;',
+    '    $lt.Color = this.Color;',
+    '    $lt.Color = this.Color;',
+    '  };',
+    '  this.Run = function () {',
+    '    $lt.Color = this.Color;',
+    '    $lt.Color = this.Color;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestOptimizations.TestOptShortRefGlobals_GenericFunction;
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
@@ -1413,6 +1486,43 @@ begin
     '']));
 end;
 
+procedure TTestOptimizations.TestOptShortRefGlobals_Unit_InitNoImpl;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'var a: word;',
+    'procedure Run(w: word);',
+    '']),
+  LinesToStr([
+    'procedure Run(w: word);',
+    'begin',
+    'end;',
+    '']));
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$optimization JSShortRefGlobals}',
+  'interface',
+  'implementation',
+  'uses UnitA;', // empty implementation function
+  'begin',
+  '  Run(a);',
+  '']);
+  ConvertUnit;
+  CheckSource('TestOptShortRefGlobals_Unit_InitNoImpl',
+    LinesToStr([
+    'var $impl = $mod.$impl;',
+    'var $lm = null;',
+    'var $lp = null;',
+    '']),
+    LinesToStr([
+    '$lp($lm.a);',
+    '']),
+    LinesToStr([
+    '$lm = pas.UnitA;',
+    '$lp = $lm.Run;',
+    '']));
+end;
+
 procedure TTestOptimizations.TestWPO_OmitLocalVar;
 begin
   StartProgram(false);
@@ -2287,19 +2397,22 @@ var
 begin
   WithTypeInfo:=true;
   StartProgram(true);
-  Add('type');
-  Add('  TArrA = array of char;');
-  Add('  TArrB = array of string;');
-  Add('  TObject = class');
-  Add('  public');
-  Add('    PublicA: TArrA;');
-  Add('  published');
-  Add('    PublishedB: TArrB;');
-  Add('  end;');
-  Add('var');
-  Add('  C: TObject;');
-  Add('begin');
-  Add('  C.PublicA:=nil;');
+  Add([
+  'type',
+  '  TArrA = array of char;',
+  '  TArrB = array of string;',
+  '  TObject = class',
+  '  public',
+  '    PublicA: TArrA;',
+  '  published',
+  '    PublishedB: TArrB;',
+  '  end;',
+  'var',
+  '  C: TObject;',
+  'begin',
+  '  C.PublicA:=nil;',
+  '  if typeinfo(TObject)=nil then ;',
+  '']);
   ConvertProgram;
   ActualSrc:=ConvertJSModuleToString(JSModule);
   ExpectedSrc:=LinesToStr([
@@ -2323,6 +2436,7 @@ begin
     '  this.C = null;',
     '  $mod.$main = function () {',
     '    $mod.C.PublicA = [];',
+    '    if ($mod.$rtti["TObject"] === null) ;',
     '  };',
     '});',
     '']);

packages/pastojs/tests/tcprecompile.pas

@@ -130,6 +130,7 @@ begin
       Params.AddStrings(SharedParams);
     if SecondRunParams<>nil then
       Params.AddStrings(SecondRunParams);
+    writeln('BBB1 TCustomTestCLI_Precompile.CheckPrecompile ',Params.Text);
     Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
     if ExpExitCode=0 then
       begin

packages/pastojs/tests/tcunitsearch.pas

@@ -398,6 +398,7 @@ begin
   aFile.Attr:=faNormal;
   aFile.Age:=DateTimeToFileDate(CurDate);
   writeln('TCustomTestCLI.OnWriteFile ',aFile.Filename,' Found=',FindFile(aFilename)<>nil,' "',LeftStr(aFile.Source,50),'" ');
+  //writeln('TCustomTestCLI.OnWriteFile ',aFile.Source);
 end;
 
 procedure TCustomTestCLI.WriteSources;

packages/paszlib/src/zipper.pp

@@ -838,6 +838,7 @@ Procedure ZipDateTimeToDateTime(ZD,ZT : Word;out DT : TDateTime);
 
 Var
   Y,M,D,H,N,S,MS : Word;
+  aDate,aTime : TDateTime;
 
 begin
   MS:=0;
@@ -847,10 +848,19 @@ begin
   D:=ZD and 31;
   M:=(ZD shr 5) and 15;
   Y:=((ZD shr 9) and 127)+1980;
-
+  // Some corrections
   if M < 1 then M := 1;
+  if M > 12 then M:=12;
   if D < 1 then D := 1;
-  DT:=ComposeDateTime(EncodeDate(Y,M,D),EncodeTime(H,N,S,MS));
+  if D>MonthDays[IsLeapYear(Y)][M] then
+    D:=MonthDays[IsLeapYear(Y)][M];
+  // Try to encode the result, fall back on today if it fails
+  if Not TryEncodeDate(Y,M,D,aDate) then
+    aDate:=Date;
+  if not TryEncodeTime(H,N,S,MS,aTime) then
+    aTime:=Time;
+  // Return result
+  DT:=ComposeDateTime(aDate,ATime);
 end;
 
 

rtl/linux/m68k/cprt21.as

@@ -1,100 +0,0 @@
-|
-|   This file is part of the Free Pascal run time library.
-|   Copyright (c) 1999-2000 by Michael Van Canneyt and Peter Vreman
-|   members of the Free Pascal development team.
-|
-|   See the file COPYING.FPC, included in this distribution,
-|   for details about the copyright.
-|
-|   This program is distributed in the hope that it will be useful,
-|   but WITHOUT ANY WARRANTY;without even the implied warranty of
-|   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-|
-|**********************************************************************}
-|
-| Linux ELF startup code for Free Pascal
-|
-
-        .file   "prt1.as"
-        .text
-        .globl  _start
-        .type   _start,@function
-_start:
-        /* First locate the start of the environment variables */
-        move.l    (%sp)+,%d3
-        move.l    %d0,%d4
-
-        move.l    %sp,%d1               /* Points to the arguments */
-        move.l    %d3,%d0
-        addq.l    #1,%d0
-        lsl.l     #2,%d0
-        add.l     %sp,%d0
-
-        move.l    %sp,%d7
-        and.l     #0xfffffff8,%d7        /* Align stack */
-        move.l    %d7,%sp
-
-        move.l    %d0,U_SYSLINUX_ENVP    /* Move the environment pointer */
-        move.l    %d3,U_SYSLINUX_ARGC    /* Move the argument counter    */
-        move.l    %d1,U_SYSLINUX_ARGV    /* Move the argument pointer    */
-
-        move.l   #0,%fp                  /* Zero frame pointer to end call stack */
-
-|
-|       Start of args for __libc_start_main
-|
-|
-        move.l   %d4,-(%sp)
-        move.l   %sp,-(%sp)
-        move.l   %a1,-(%sp)
-        pea.l    _fini_dummy
-        pea.l    _init_dummy
-        move.l   %d1,-(%sp)
-        move.l   %d3,-(%sp)
-        pea.l    main
-        jsr      __libc_start_main
-        trap     #0
-
-/* fake main routine which will be run from libc */
-main:
-        /* save return address */
-        move.l    (%sp)+,%d0
-        move.l    %d0,___fpc_ret
-        move.l    %d1,___fpc_ret_d1
-        move.l    %fp,___fpc_ret_fp
-        move.l    %d0,-(%sp)
-
-        /* start the program */
-        move.l   #0,%fp
-        jsr      PASCALMAIN
-
-        .globl _haltproc
-        .type _haltproc,@function
-_haltproc:
-        eor.l    %d0,%d0               /* load and save exitcode */
-        move.w   U_SYSLINUX_EXITCODE,%d0
-
-        move.l    ___fpc_ret,%d3         /* return to libc */
-        move.l    ___fpc_ret_fp,%fp
-        move.l    ___fpc_ret_d1,%d1
-        move.l    %d3,-(%sp)
-_init_dummy:
-_fini_dummy:
-        rts
-
-.data
-        .align  4
-
-        .globl  ___fpc_brk_addr         /* heap management */
-        .type   ___fpc_brk_addr,@object
-        .size   ___fpc_brk_addr,4
-___fpc_brk_addr:
-        .long   0
-
-___fpc_ret:                             /* return address to libc */
-        .long   0
-___fpc_ret_d1:
-        .long   0
-___fpc_ret_fp:
-        .long   0
-

rtl/objpas/classes/classes.inc

@@ -2521,6 +2521,9 @@ begin
   GlobalLists.Free;
   ComponentPages.Free;
   FreeAndNil(NeedResolving);
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  GlobalNameSpace.EndWrite;
+{$endif}
   { GlobalNameSpace is an interface so this is enough }
   GlobalNameSpace:=nil;
 

rtl/unix/cwstring.pp

@@ -208,7 +208,7 @@ function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'libico
 const
   iconvctlname='libiconvctl';
 {$endif}
-var 
+var
   iconvctl:function(__cd:iconv_t; __request:cint; __argument:pointer):cint;cdecl;
 
 procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
@@ -229,26 +229,28 @@ threadvar
 procedure InitThread;
 var
   transliterate: cint;
-  iconvindex: longint;
 {$if not(defined(darwin) and (defined(cpuarm) or defined(cpuaarch64))) and not defined(iphonesim)}
-  iconvname: rawbytestring;
+  iconvindex: longint;
 {$endif}
+  iconvname, toencoding: rawbytestring;
 begin
   current_DefaultSystemCodePage:=DefaultSystemCodePage;
-{$if not(defined(darwin) and (defined(cpuarm) or defined(cpuaarch64))) and not defined(iphonesim)}
+{$if declared(iconvindex)}
   iconvindex:=GetCodepageData(DefaultSystemCodePage);
   if iconvindex<>-1 then
     iconvname:=UnixCpMap[iconvindex].name
   else
     { default to UTF-8 on Unix platforms }
     iconvname:='UTF-8';
-  iconv_wide2ansi:=iconv_open(pchar(iconvname),unicode_encoding2);
-  iconv_ansi2wide:=iconv_open(unicode_encoding2,pchar(iconvname));
 {$else}
   { Unix locale settings are ignored on iPhoneOS/iPhoneSimulator }
-  iconv_wide2ansi:=iconv_open('UTF-8',unicode_encoding2);
-  iconv_ansi2wide:=iconv_open(unicode_encoding2,'UTF-8');
+  iconvname:='UTF-8';
 {$endif}
+  toencoding:=iconvname;
+  if not assigned(iconvctl) then
+    toencoding:=toencoding+'//TRANSLIT';
+  iconv_wide2ansi:=iconv_open(pchar(toencoding),unicode_encoding2);
+  iconv_ansi2wide:=iconv_open(unicode_encoding2,pchar(iconvname));
   if assigned(iconvctl) and
      (iconv_wide2ansi<>iconv_t(-1)) then
   begin
@@ -287,6 +289,8 @@ end;
 function open_iconv_for_cps(cp: TSystemCodePage; const otherencoding: pchar; cp_is_from: boolean): iconv_t;
   var
     iconvindex: longint;
+    toencoding: rawbytestring;
+    transliterate: cint;
   begin
     { TODO: add caching (then we also don't need separate code for
       the default system page and other ones)
@@ -302,11 +306,23 @@ function open_iconv_for_cps(cp: TSystemCodePage; const otherencoding: pchar; cp_
       if cp_is_from then
         open_iconv_for_cps:=iconv_open(otherencoding,pchar(UnixCpMap[iconvindex].name))
       else
-        open_iconv_for_cps:=iconv_open(pchar(UnixCpMap[iconvindex].name),otherencoding);
+      begin
+        toencoding:=UnixCpMap[iconvindex].name;
+        if not assigned(iconvctl) then
+          toencoding:=toencoding+'//TRANSLIT';
+        open_iconv_for_cps:=iconv_open(pchar(toencoding),otherencoding);
+      end;
       inc(iconvindex);
     until (open_iconv_for_cps<>iconv_t(-1)) or
           (iconvindex>high(UnixCpMap)) or
           (UnixCpMap[iconvindex].cp<>cp);
+    if not cp_is_from and
+      (open_iconv_for_cps<>iconv_t(-1)) and
+      assigned(iconvctl) then
+    begin
+      transliterate:=1;
+      iconvctl(open_iconv_for_cps,ICONV_SET_TRANSLITERATE,@transliterate);
+    end;
   end;
 
 
@@ -771,19 +787,19 @@ function CompareWideString(const s1, s2 : WideString; Options : TCompareOptions)
   var
     hs1,hs2 : UCS4String;
     us1,us2 : WideString;
-    
+
   begin
     { wcscoll interprets null chars as end-of-string -> filter out }
     if coIgnoreCase in Options then
       begin
       us1:=UpperWideString(s1);
       us2:=UpperWideString(s2);
-      end     
-    else      
-      begin   
+      end
+    else
+      begin
       us1:=s1;
       us2:=s2;
-      end;  
+      end;
     hs1:=WideStringToUCS4StringNoNulls(us1);
     hs2:=WideStringToUCS4StringNoNulls(us2);
     result:=wcscoll(pwchar_t(hs1),pwchar_t(hs2));
@@ -804,7 +820,7 @@ function CompareWideString(const s1, s2 : WideString; Options : TCompareOptions)
       begin
       us1:=s1;
       us2:=s2;
-      end;  
+      end;
     len:=length(us1);
     setlength(hs1,len+1);
     for i:=1 to len do
@@ -1138,8 +1154,10 @@ initialization
   { (some OSes do this automatically, but e.g. Darwin and Solaris don't)    }
   setlocale(LC_ALL,'');
 
-  { load iconvctl function }
+  { load iconv library and iconvctl function }
   iconvlib:=LoadLibrary(libprefix+libiconvname+'.'+SharedSuffix);
+  if iconvlib=0 then
+    iconvlib:=LoadLibrary(libprefix+libiconvname+'.'+SharedSuffix+'.6');
   if iconvlib<>0 then
     pointer(iconvctl):=GetProcAddress(iconvlib,iconvctlname);
 

tests/Makefile

@@ -2588,6 +2588,9 @@ endif
 ifdef EMULATOR
 override DOTESTOPT+=-M$(EMULATOR)
 endif
+ifdef EMULATOR_OPTS
+override DOTESTOPT+=-N$(EMULATOR_OPTS)
+endif
 ifdef USEENV
 override DOTESTENV:=$(DOTESTOPT)
 override DOTESTOPT=!DOTESTENV

tests/Makefile.fpc

@@ -390,6 +390,10 @@ ifdef EMULATOR
 override DOTESTOPT+=-M$(EMULATOR)
 endif
 
+ifdef EMULATOR_OPTS
+override DOTESTOPT+=-N$(EMULATOR_OPTS)
+endif
+
 
 ifdef USEENV
 override DOTESTENV:=$(DOTESTOPT)

tests/readme.txt

@@ -217,6 +217,7 @@ Emulator execution is possible as well. It can't be combined with remote
 execution though.
 
 EMULATOR: name of the emulator to use
+EMULATOR_OPTS: pass the given options to the emulator
 
 Examples:
 

tests/tbs/tb0528.pp

@@ -1,5 +1,7 @@
 {%CPU=x86_64,powerpc64}
 {%skiptarget=darwin,aix,win64}
+{ %opt=-Xa }  { use the large option }
+
 
 { darwin limits statically declared data structures to 32 bit for efficiency reasons }
 { the aix assembler cannot deal with the way we declare these arrays in assembler code }

tests/tbs/tb0596.pp

@@ -5,13 +5,21 @@ program tb0596;
 
 const
   IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020;
+  IMAGE_REMOVABLE_RUN_FROM_SWAP  = $0400;
+  IMAGE_NET_RUN_FROM_SWAP        = $0800;
+  IMAGE_DLLCHARACTERISTICS_NO_ISOLATION          = $0200;
+  IMAGE_DLLCHARACTERISTICS_APPCONTAINER          = $1000;
   IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
 
 {$setpeflags IMAGE_FILE_LARGE_ADDRESS_AWARE}
 {$setpeflags $0800}
+{$setpeflags IMAGE_REMOVABLE_RUN_FROM_SWAP or IMAGE_NET_RUN_FROM_SWAP}
+{$setpeflags $0008 or $0004}
 
 {$setpeoptflags IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE}
 {$setpeoptflags $0040}
+{$setpeoptflags IMAGE_DLLCHARACTERISTICS_APPCONTAINER or IMAGE_DLLCHARACTERISTICS_NO_ISOLATION}
+{$setpeoptflags $0008 or $0004}
 
 begin
 

tests/test/toperator91.pp

@@ -0,0 +1,104 @@
+program toperator91;
+
+{$mode delphi}
+
+type
+  TString80 = String[80];
+  TString90 = String[90];
+  TString40 = String[40];
+  TString100 = String[100];
+
+  TTest = record
+    class operator Explicit(const aArg: TTest): TString80;
+    class operator Explicit(const aArg: TTest): TString90;
+    class operator Explicit(const aArg: TTest): ShortString;
+    class operator Implicit(const aArg: TTest): TString80;
+    class operator Implicit(const aArg: TTest): TString90;
+    class operator Implicit(const aArg: TTest): ShortString;
+  end;
+
+var
+  ExplicitString80: LongInt;
+  ExplicitString90: LongInt;
+  ExplicitShortString: LongInt;
+  ImplicitString80: LongInt;
+  ImplicitString90: LongInt;
+  ImplicitShortString: LongInt;
+
+class operator TTest.Explicit(const aArg: TTest): TString80;
+begin
+  Writeln('TString80 Explicit');
+  Inc(ExplicitString80);
+  Result := '';
+end;
+
+class operator TTest.Explicit(const aArg: TTest): TString90;
+begin
+  Writeln('TString90 Explicit');
+  Inc(ExplicitString90);
+  Result := '';
+end;
+
+class operator TTest.Explicit(const aArg: TTest): ShortString;
+begin
+  Writeln('ShortString Explicit');
+  Inc(ExplicitShortString);
+  Result := '';
+end;
+
+class operator TTest.Implicit(const aArg: TTest): TString80;
+begin
+  Writeln('TString80 Implicit');
+  Inc(ImplicitString80);
+  Result := '';
+end;
+
+class operator TTest.Implicit(const aArg: TTest): TString90;
+begin
+  Writeln('TString90 Implicit');
+  Inc(ImplicitString90);
+  Result := '';
+end;
+
+class operator TTest.Implicit(const aArg: TTest): ShortString;
+begin
+  Writeln('ShortString Implicit');
+  Inc(ImplicitShortString);
+  Result := '';
+end;
+
+var
+  s80: TString80;
+  s90: TString90;
+  s40: TString40;
+  s100: TString100;
+  t: TTest;
+begin
+  // Explicit
+  s80 := TString80(t);
+  if ExplicitString80 <> 1 then
+    Halt(1);
+  s90 := TString90(t);
+  if ExplicitString90 <> 1 then
+    Halt(2);
+  s40 := TString40(t);
+  if ImplicitShortString <> 1 then
+    Halt(3);
+  s100 := TString100(t);
+  if ImplicitShortString <> 2 then
+    Halt(4);
+  // Implicit
+  s80 := t;
+  if ImplicitShortString <> 3 then
+    Halt(5);
+  s90 := t;
+  if ImplicitShortString <> 4 then
+    Halt(6);
+  s40 := t;
+  if ImplicitShortString <> 5 then
+    Halt(7);
+  s100 := t;
+  if ImplicitShortString <> 6 then
+    Halt(8);
+  Writeln('ok');
+end.

tests/test/toperator92.pp

@@ -0,0 +1,33 @@
+{ %FAIL }
+
+program toperator92;
+
+{$mode delphi}
+
+type
+  TString80 = String[80];
+  TString90 = String[90];
+  TString40 = String[40];
+  TString100 = String[100];
+
+  TTest = record
+    class operator Implicit(const aArg: TTest): TString80;
+    class operator Implicit(const aArg: TTest): TString90;
+  end;
+
+class operator TTest.Implicit(const aArg: TTest): TString80;
+begin
+
+end;
+
+class operator TTest.Implicit(const aArg: TTest): TString90;
+begin
+
+end;
+
+var
+  t: TTest;
+  s: TString80;
+begin
+  s := t;
+end.

tests/test/toperator93.pp

@@ -0,0 +1,27 @@
+{ %NORUN }
+
+program toperator93;
+
+{$mode delphi}
+
+type
+  TString80 = String[80];
+  TString90 = String[90];
+  TString40 = String[40];
+  TString100 = String[100];
+
+  TTest = record
+    class operator Implicit(const aArg: TTest): TString80;
+  end;
+
+class operator TTest.Implicit(const aArg: TTest): TString80;
+begin
+
+end;
+
+var
+  t: TTest;
+  s: TString80;
+begin
+  s := t;
+end.

tests/test/toperator94.pp

@@ -0,0 +1,66 @@
+program toperator94;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TString80 = String[80];
+  TString90 = String[90];
+  TString40 = String[40];
+  TString100 = String[100];
+
+  TTest1 = record
+    class operator :=(const aArg: TTest1): TString80;
+  end;
+
+  TTest2 = record
+    class operator :=(const aArg: TTest2): ShortString;
+  end;
+
+var
+  ImplicitTest1ShortString: LongInt;
+  ImplicitTest1String80: LongInt;
+  ImplicitTest2ShortString: LongInt;
+  ImplicitTest2String80: LongInt;
+
+class operator TTest1.:=(const aArg: TTest1): TString80;
+begin
+  Writeln('TTest1 Implicit TString80');
+  Inc(ImplicitTest1String80);
+  Result := '';
+end;
+
+class operator TTest2.:=(const aArg: TTest2): ShortString;
+begin
+  Writeln('TTest2 Implicit ShortString');
+  Inc(ImplicitTest2ShortString);
+  Result := '';
+end;
+
+operator :=(const aArg: TTest1): ShortString;
+begin
+  Writeln('TTest1 Implicit ShortString');
+  Inc(ImplicitTest1ShortString);
+  Result := '';
+end;
+
+operator :=(const aArg: TTest2): TString80;
+begin
+  Writeln('TTest2 Implicit TString80');
+  Inc(ImplicitTest2String80);
+  Result := '';
+end;
+
+var
+  t1: TTest1;
+  t2: TTest2;
+  s80: TString80;
+begin
+  s80 := t1;
+  if ImplicitTest1ShortString <> 1 then
+    Halt(1);
+  s80 := t2;
+  if ImplicitTest2ShortString <> 1 then
+    Halt(2);
+  Writeln('ok');
+end.

tests/test/toperator95.pp

@@ -0,0 +1,29 @@
+{ %FAIL }
+
+program toperator95;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+type
+  TString80 = String[80];
+  TString90 = String[90];
+
+  TTest = record
+    class operator :=(const aArg: TTest): TString80;
+  end;
+
+class operator TTest.:=(const aArg: TTest): TString80;
+begin
+end;
+
+operator :=(const aArg: TTest): TString90;
+begin
+end;
+
+var
+  t: TTest;
+  s80: TString80;
+begin
+  s80 := t;
+end.

tests/test/tthlp29.pp

@@ -0,0 +1,76 @@
+program tthlp29;
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$APPTYPE CONSOLE}
+
+type
+  TLongIntHelper = type helper for LongInt
+    procedure Test;
+  end;
+
+procedure TLongIntHelper.Test;
+begin
+  Self := Self + 10;
+end;
+
+var
+  l: LongInt;
+  pl: PLongInt;
+  pul: PLongWord;
+  pb: PByte;
+
+function GetPL: PLongInt;
+begin
+  Result := @l;
+end;
+
+function GetPUL: PLongWord;
+begin
+  Result := @l;
+end;
+
+function GetPB: PByte;
+begin
+  Result := @l;
+end;
+
+begin
+  l := 0;
+  pl := @l;
+  pul := @l;
+  pb := @l;
+  Writeln(l);
+  l.Test;
+  Writeln(l);
+  if l <> 10 then
+    Halt(1);
+  pl^.Test;
+  Writeln(l);
+  if l <> 20 then
+    Halt(2);
+  GetPL^.Test;
+  Writeln(l);
+  if l <> 30 then
+    Halt(3);
+  { type conversions with the same size are ignored }
+  LongInt(pul^).Test;
+  Writeln(l);
+  if l <> 40 then
+    Halt(4);
+  LongInt(GetPUL^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(5);
+  { type conversions with different sizes operate on a tmp }
+  LongInt(pb^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(6);
+  LongInt(GetPB^).Test;
+  Writeln(l);
+  if l <> 50 then
+    Halt(7);
+  Writeln('ok');
+end.
+

tests/utils/dotest.pp

@@ -112,6 +112,7 @@ const
   rquote : string = '''';
   UseTimeout : boolean = false;
   emulatorname : string = '';
+  EmulatorOpts : string = '';
   TargetCanCompileLibraries : boolean = true;
   UniqueSuffix: string = '';
 
@@ -1314,7 +1315,7 @@ begin
       { Add -Ssource_file_name for dosbox_wrapper }
       if pos('dosbox_wrapper',EmulatorName)>0 then
         s:=s+' -S'+PPFile[current];
-      execres:=ExecuteEmulated(EmulatorName,s,FullExeLogFile,StartTicks,EndTicks);
+      execres:=ExecuteEmulated(EmulatorName,EmulatorOpts+' '+s,FullExeLogFile,StartTicks,EndTicks);
       {$I-}
        ChDir(OldDir);
       {$I+}
@@ -1543,30 +1544,31 @@ procedure getargs;
     writeln('dotest [Options] <File>');
     writeln;
     writeln('Options can be:');
-    writeln('  !ENV_NAME     parse environment variable ENV_NAME for options');
-    writeln('  -A            include ALL tests');
-    writeln('  -ADB          use ADB to run tests');
-    writeln('  -B            delete executable before remote upload');
-    writeln('  -C<compiler>  set compiler to use');
-    writeln('  -D            display execution time');
-    writeln('  -E            execute test also');
-    writeln('  -G            include graph tests');
-    writeln('  -I            include interactive tests');
-    writeln('  -K            include known bug tests');
-    writeln('  -L<ext>       set extension of temporary files (prevent conflicts with parallel invocations)');
-    writeln('  -M<emulator>  run the tests using the given emulator');
-    writeln('  -O            use timeout wrapper for (remote) execution');
-    writeln('  -P<path>      path to the tests tree on the remote machine');
-    writeln('  -R<remote>    run the tests remotely with the given rsh/ssh address');
-    writeln('  -S            use ssh instead of rsh');
-    writeln('  -T[cpu-]<os>  run tests for target cpu and os');
+    writeln('  !ENV_NAME           parse environment variable ENV_NAME for options');
+    writeln('  -A                  include ALL tests');
+    writeln('  -ADB                use ADB to run tests');
+    writeln('  -B                  delete executable before remote upload');
+    writeln('  -C<compiler>        set compiler to use');
+    writeln('  -D                  display execution time');
+    writeln('  -E                  execute test also');
+    writeln('  -G                  include graph tests');
+    writeln('  -I                  include interactive tests');
+    writeln('  -K                  include known bug tests');
+    writeln('  -L<ext>             set extension of temporary files (prevent conflicts with parallel invocations)');
+    writeln('  -M<emulator>        run the tests using the given emulator');
+    writeln('  -N<emulator opts.>  pass options to the emulator');
+    writeln('  -O                  use timeout wrapper for (remote) execution');
+    writeln('  -P<path>            path to the tests tree on the remote machine');
+    writeln('  -R<remote>          run the tests remotely with the given rsh/ssh address');
+    writeln('  -S                  use ssh instead of rsh');
+    writeln('  -T[cpu-]<os>        run tests for target cpu and os');
     writeln('  -U<remotepara>');
-    writeln('                pass additional parameter to remote program. Multiple -U can be used');
-    writeln('  -V            be verbose');
-    writeln('  -W            use putty compatible file names when testing (plink and pscp)');
-    writeln('  -X            don''t use COMSPEC');
-    writeln('  -Y<opts>      extra options passed to the compiler. Several -Y<opt> can be given.');
-    writeln('  -Z            remove temporary files (executable,ppu,o)');
+    writeln('                      pass additional parameter to remote program. Multiple -U can be used');
+    writeln('  -V                  be verbose');
+    writeln('  -W                  use putty compatible file names when testing (plink and pscp)');
+    writeln('  -X                  don''t use COMSPEC');
+    writeln('  -Y<opts>            extra options passed to the compiler. Several -Y<opt> can be given.');
+    writeln('  -Z                  remove temporary files (executable,ppu,o)');
     halt(1);
   end;
 
@@ -1630,6 +1632,8 @@ procedure getargs;
 
      'M' : EmulatorName:=Para;
 
+     'N' : EmulatorOpts:=Para;
+
      'O' : UseTimeout:=true;
 
      'P' : RemotePath:=Para;

tests/webtbs/tw17236.pp

@@ -1,5 +1,6 @@
 { %target=linux,darwin,freebsd,netbsd,openbsd,sunos,beos,haiku }
 { %cpu=x86_64,powerpc64,mips64,sparc64,ia64,alpha }
+{ %opt=-Xa }
 
 { windows does not support statics > 2GB }
 var

tests/webtbs/tw17904.pp

@@ -34,7 +34,7 @@ begin
     tmp := Swap(tmp);
     {$endif}
     Variant(Dest^) := tmp;
-  end;  
+  end;
 end;
 
 type
@@ -126,7 +126,7 @@ begin
   begin
     write(' BYREF failed');
     Code := Code or 1;
-  end;  
+  end;
   if WordRec(tmp).Hi <> absexp then
   begin
     write(' BYVAL failed');
@@ -142,7 +142,7 @@ begin
   TVarData(v).vType := cv.VarType;
 
   test('u8:    ', v.foo(cl.u8, cl.u8prop), varbyte);
-  
+
   test('u16:    ', v.foo(cl.u16, cl.u16prop), varword);       // (Uncertain) D7: treated as Integer
   test('u32:    ', v.foo(cl.u32, cl.u32prop), varlongword);   // (Uncertain) D7: treated as Integer ByRef
   test('s8:     ', v.foo(cl.s8, cl.s8prop), varshortint);     // (Uncertain) D7: treated as Integer
@@ -153,29 +153,37 @@ begin
 {$ifdef fpc}
   test('u64:    ', v.foo(cl.u64, cl.u64prop), varword64);
 {$endif}
-  
+
   test('wordbool:', v.foo(cl.wb, cl.wbprop), varBoolean);
   test('curncy:  ', v.foo(cl.cy, cl.cyprop), varCurrency);
-  
+
   test('single:  ', v.foo(cl.sgl, cl.sglprop), varSingle);
   test('double:  ', v.foo(cl.dbl, cl.dblprop), varDouble);
   test('extended:', v.foo(cl.ext, cl.extprop), -varDouble);  // not a COM type, passed by value
-  
+
   test('date:    ', v.foo(cl.dt, cl.dtprop), varDate);
 
   test('ansistr: ', v.foo(cl.fastr, cl.astr), varStrArg);
+{$ifdef FPC_WINLIKEWIDESTRING}
   test('widestr: ', v.foo(cl.fwstr, cl.wstr), varOleStr);
+{$else FPC_WINLIKEWIDESTRING}
+  test('widestr: ', v.foo(cl.fwstr, cl.wstr), varUStrArg);
+{$endif FPC_WINLIKEWIDESTRING}
 {$ifdef fpc}
   test('unistr:  ', v.foo(cl.fustr, cl.ustr), varUStrArg);
 {$endif}
   test('variant: ', v.foo(cl.fvar, cl.varprop), varVariant);
-  
+
   test('IUnknown:', v.foo(cl.fintf, cl.intfprop), varUnknown);
   test('IDispatch:', v.foo(cl.fdisp, cl.dispprop), varDispatch);
-  
+
   // not an COM type, passed by value; Delphi uses varStrArg
+{$ifdef FPC_WINLIKEWIDESTRING}
   test('shortstr:', v.foo(cl.fsstr, cl.sstr), -varOleStr);
-  // not an COM type, passed by value
+{$else FPC_WINLIKEWIDESTRING}
+  test('shortstr:', v.foo(cl.fsstr, cl.sstr), -varUStrArg);
+{$endif FPC_WINLIKEWIDESTRING}
+// not an COM type, passed by value
   test('longbool:', v.foo(cl.lb, cl.lbprop), -varBoolean);
 
   // typecasted ordinals (only one arg is actually used)
@@ -195,4 +203,4 @@ begin
     writeln('Errors: ', Code);
   Halt(Code);
 
-end.
+end.

tests/webtbs/tw29957.pp

@@ -45,8 +45,13 @@ type
 
  function _VectorDotProductAVX(Vector1, Vector2: TVector4): Single; assembler;
  asm
+{$if defined(cpux86_64) and not(defined(win64))}
+   VMOVLHPS XMM0,XMM0,XMM1
+   VMOVLHPS XMM1,XMM2,XMM3
+{$else defined(cpux86_64) and not(defined(win64))}
    VMOVUPS XMM0, [Vector1]
    VMOVUPS XMM1, [Vector2]
+{$endif defined(cpux86_64) and not(defined(win64))}
    VDPPS XMM0, XMM0, XMM1, $71 { Only perform calculations on the X, Y and Z coordinates; only store result in the first element }
    VMOVSS Result, XMM0 { Store result - first element of XMM0 }
  end;

tests/webtbs/tw38122.pp

@@ -0,0 +1,81 @@
+program tw38122;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+uses
+  Math;
+
+type float = double;
+     pfloat = ^float;
+
+type  TFloatHelper = type helper for float
+        procedure sub (const a: float);
+      end;
+
+type TMatrix = record
+                 sx,sy: sizeint;
+                 procedure Init (x,y: sizeint; content: array of float);
+                 function GetAdr (x,y: sizeint): pfloat;
+                 procedure print;
+                 private
+                   data: array of float;
+               end;
+
+procedure TFloatHelper.sub (const a: float);
+begin
+  self := self-a;
+end;
+
+function TMatrix.GetAdr (x,y: sizeint): pfloat;
+begin
+  result := @data[x*sy+y];
+end;
+
+procedure TMatrix.Init (x,y: sizeint; content: array of float);
+var i: sizeint;
+begin
+  sx :=x;
+  sy :=y;
+  Data := nil;
+  SetLength (data, sx*sy);
+  for i := 0 to sx*sy-1 do data[i] := content[i];
+end;
+
+procedure TMatrix.print;
+var x,y: sizeint;
+begin
+  for y := 0 to sy-1 do begin
+    writeln;
+    for x := 0 to sx-1 do begin
+      write (GetAdr(x,y)^:2:2,'  ');
+    end;
+  end;
+  writeln;
+end;
+
+var A: TMatrix;
+    px: pfloat;
+begin
+  A.Init (2,2,[1,2,3,4]);
+  A.print;
+  if not SameValue(A.data[3],4,1e-1) then
+    Halt(1);
+
+  A.GetAdr(1,1)^ := 0; //I can set an element like this...
+  A.Print;
+  if not SameValue(A.data[3],0,1e-1) then
+    Halt(2);
+
+  px := A.GetAdr(1,1);
+  px^.sub(100);  //and this works as well.
+  A.Print;
+  if not SameValue(A.data[3],-100,1e-1) then
+    Halt(3);
+
+  A.GetAdr(1,1)^.sub(1000); //but that does not change the Matrix !?!
+  A.print;
+  if not SameValue(A.data[3],-1100,1e-1) then
+    Halt(4);
+end.

tests/webtbs/tw38145a.pp

@@ -0,0 +1,29 @@
+{ %NORUN }
+
+program tw38145a;
+{$mode delphi}
+type
+  TMyWrap<T> = record
+    Value: T;
+    class operator Explicit(const w: TMyWrap<T>): T;
+    class operator Implicit(const w: TMyWrap<T>): T;
+  end;
+
+class operator TMyWrap<T>.Explicit(const w: TMyWrap<T>): T;
+begin
+  Result := w.Value;
+end;
+
+class operator TMyWrap<T>.Implicit(const w: TMyWrap<T>): T;
+begin
+  Result := w.Value;
+end;
+
+type
+  //TString = string[255]; //compiles
+  TString = string[254]; //not compiles
+
+var
+  MySpec: TMyWrap<TString>;
+begin
+end.

tests/webtbs/tw38145b.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+program tw38145b;
+{$mode objfpc}{$modeswitch advancedrecords}
+type
+  generic TMyWrap<T> = record
+    Value: T;
+    class operator Explicit(const w: TMyWrap): T;
+    class operator :=(const w: TMyWrap): T;
+  end;
+
+class operator TMyWrap.Explicit(const w: TMyWrap): T;
+begin
+  Result := w.Value;
+end;
+
+class operator TMyWrap.:=(const w: TMyWrap): T;
+begin
+  Result := w.Value;
+end;
+
+type
+  //TString = string[255]; //compiles
+  TString = string[254]; //not compiles
+var
+  MySpec: specialize TMyWrap<TString>;
+begin
+end.

tests/webtbs/tw5086.pp

@@ -28,6 +28,9 @@ begin
   erase(input);
 end;
 
+var
+  p : pbyte;
+
 procedure dfs(a, b, c, k1: Byte);
 var
 	x					: Byte;
@@ -52,6 +55,8 @@ begin
 end;
 
 begin
+//    p:=@a;
+
 	if (k1 > k) then Exit;
 	if (a = 1) or (b = 1) or (c = 1) then begin
 		answ := answ + 1;