* synchronised with trunk till r41423

git-svn-id: branches/debug_eh@41424 -

.gitattributes

@@ -103,6 +103,7 @@ compiler/arm/rarmstd.inc svneol=native#text/plain
 compiler/arm/rarmsup.inc svneol=native#text/plain
 compiler/arm/rgcpu.pas svneol=native#text/plain
 compiler/arm/symcpu.pas svneol=native#text/plain
+compiler/armgen/armpara.pas svneol=native#text/plain
 compiler/assemble.pas svneol=native#text/plain
 compiler/avr/aasmcpu.pas svneol=native#text/plain
 compiler/avr/agavrgas.pas svneol=native#text/plain
@@ -2433,6 +2434,7 @@ packages/fcl-fpcunit/src/xmltestreport.pp svneol=native#text/plain
 packages/fcl-image/Makefile svneol=native#text/plain
 packages/fcl-image/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-image/examples/DejaVuLGCSans.ttf -text
 packages/fcl-image/examples/Makefile svneol=native#text/plain
 packages/fcl-image/examples/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/examples/createbarcode.lpi svneol=native#text/plain
@@ -2440,6 +2442,8 @@ packages/fcl-image/examples/createbarcode.lpr svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.lpi svneol=native#text/plain
 packages/fcl-image/examples/createqrcode.pp svneol=native#text/plain
 packages/fcl-image/examples/drawing.pp svneol=native#text/plain
+packages/fcl-image/examples/edit-clear.png -text svneol=unset#image/png
+packages/fcl-image/examples/fpcanvasalphadraw.pp svneol=native#text/plain
 packages/fcl-image/examples/imgconv.pp svneol=native#text/plain
 packages/fcl-image/examples/interpoldemo.pp svneol=native#text/plain
 packages/fcl-image/examples/pattern.png -text svneol=unset#image/png
@@ -5436,6 +5440,11 @@ packages/libgd/examples/gdtest.pp svneol=native#text/plain
 packages/libgd/examples/gdtestcgi.pp svneol=native#text/plain
 packages/libgd/fpmake.pp svneol=native#text/plain
 packages/libgd/src/gd.pas svneol=native#text/plain
+packages/libmagic/Makefile svneol=native#text/plain
+packages/libmagic/Makefile.fpc svneol=native#text/plain
+packages/libmagic/examples/basic.pp svneol=native#text/plain
+packages/libmagic/fpmake.pp svneol=native#text/plain
+packages/libmagic/src/libmagic.pp svneol=native#text/plain
 packages/libmicrohttpd/Makefile svneol=native#text/plain
 packages/libmicrohttpd/Makefile.fpc svneol=native#text/plain
 packages/libmicrohttpd/examples/basicauthentication.pp svneol=native#text/plain
@@ -7027,6 +7036,7 @@ packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
@@ -7486,6 +7496,7 @@ packages/rtl-extra/src/inc/real48utils.pp svneol=native#text/plain
 packages/rtl-extra/src/inc/sockets.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/socketsh.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/sockovl.inc svneol=native#text/plain
+packages/rtl-extra/src/inc/sortalgs.pp svneol=native#text/plain
 packages/rtl-extra/src/inc/stdsock.inc svneol=native#text/plain
 packages/rtl-extra/src/inc/ucomplex.pp svneol=native#text/plain
 packages/rtl-extra/src/linux/ipccall.inc svneol=native#text/plain
@@ -12721,6 +12732,9 @@ tests/test/packages/fcl-db/tdb5.pp svneol=native#text/plain
 tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060c.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain
@@ -12738,6 +12752,7 @@ tests/test/packages/win-base/tdispvar1.pp svneol=native#text/plain
 tests/test/packages/zlib/tzlib1.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain
+tests/test/taarch64abi.pp svneol=native#text/plain
 tests/test/tabstract1.pp svneol=native#text/pascal
 tests/test/tabstrcl.pp svneol=native#text/plain
 tests/test/tabsvr1.pp svneol=native#text/plain
@@ -14252,6 +14267,7 @@ tests/test/units/objects/testobj2.pp svneol=native#text/plain
 tests/test/units/sharemem/libtest.pp svneol=native#text/plain
 tests/test/units/sharemem/test1.pp svneol=native#text/plain
 tests/test/units/softfpu/sfttst.pp svneol=native#text/plain
+tests/test/units/sortalgs/tsortalgs1.pp svneol=native#text/plain
 tests/test/units/sortbase/tsortbase.pp svneol=native#text/plain
 tests/test/units/strings/tstrcopy.pp svneol=native#text/plain
 tests/test/units/strings/tstrings1.pp svneol=native#text/plain
@@ -16240,6 +16256,7 @@ tests/webtbs/tw30179.pp svneol=native#text/pascal
 tests/webtbs/tw30182.pp svneol=native#text/plain
 tests/webtbs/tw30202.pp svneol=native#text/pascal
 tests/webtbs/tw30203.pp svneol=native#text/pascal
+tests/webtbs/tw30205.pp svneol=native#text/pascal
 tests/webtbs/tw30207.pp svneol=native#text/plain
 tests/webtbs/tw30208.pp svneol=native#text/pascal
 tests/webtbs/tw3023.pp svneol=native#text/plain
@@ -16495,6 +16512,8 @@ tests/webtbs/tw3492.pp svneol=native#text/plain
 tests/webtbs/tw3494.pp svneol=native#text/plain
 tests/webtbs/tw34971.pp svneol=native#text/plain
 tests/webtbs/tw3499.pp svneol=native#text/plain
+tests/webtbs/tw35027.pp svneol=native#text/pascal
+tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain

compiler/Makefile

@@ -543,7 +543,7 @@ ifeq ($(PPC_TARGET),sparc64)
 override LOCALOPT+=-Fusparcgen -Fisparcgen
 endif
 ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=
+override LOCALOPT+=-Fuarmgen
 endif
 ifeq ($(PPC_TARGET),mipsel)
 override LOCALOPT+=-Fumips
@@ -551,6 +551,9 @@ endif
 ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
 endif
+ifeq ($(PPC_TARGET),aarch64)
+override LOCALOPT+=-Fuarmgen
+endif
 ifeq ($(PPC_TARGET),i8086)
 override LOCALOPT+=-Fux86
 endif

compiler/Makefile.fpc

@@ -309,7 +309,7 @@ endif
 
 # ARM specific
 ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=
+override LOCALOPT+=-Fuarmgen
 endif
 
 # mipsel specific
@@ -322,6 +322,11 @@ ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
 endif
 
+# AArch64 specific
+ifeq ($(PPC_TARGET),aarch64)
+override LOCALOPT+=-Fuarmgen
+endif
+
 # i8086 specific
 ifeq ($(PPC_TARGET),i8086)
 override LOCALOPT+=-Fux86

compiler/aarch64/cpupara.pas

@@ -30,10 +30,10 @@ unit cpupara;
        globtype,globals,
        aasmtai,aasmdata,
        cpuinfo,cpubase,cgbase,cgutils,
-       symconst,symbase,symtype,symdef,parabase,paramgr;
+       symconst,symbase,symtype,symdef,parabase,paramgr,armpara;
 
     type
-       tcpuparamanager = class(tparamanager)
+       tcpuparamanager = class(tarmgenparamanager)
           function get_volatile_registers_int(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_fpu(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset; override;
@@ -42,7 +42,7 @@ unit cpupara;
           function push_addr_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
           function ret_in_param(def: tdef; pd: tabstractprocdef):boolean;override;
           function create_paraloc_info(p: tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist):longint;override;
           function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
           function param_use_paraloc(const cgpara: tcgpara): boolean; override;
          private
@@ -52,6 +52,7 @@ unit cpupara;
 
           procedure init_para_alloc_values;
           procedure alloc_para(out result: tcgpara; p: tabstractprocdef; varspez: tvarspez; side: tcallercallee; paradef: tdef; isvariadic, isdelphinestedcc: boolean);
+          function getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
 
           procedure create_paraloc_info_intern(p: tabstractprocdef; side: tcallercallee; paras: tparalist; isvariadic: boolean);
        end;
@@ -106,83 +107,7 @@ unit cpupara;
       end;
 
 
-    function is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
-      var
-        i: longint;
-        sym: tsym;
-        tmpelecount: longint;
-      begin
-        result:=false;
-        case p.typ of
-          arraydef:
-            begin
-              if is_special_array(p) then
-                exit;
-              { an array of empty records has no influence }
-              if tarraydef(p).elementdef.size=0 then
-                begin
-                  result:=true;
-                  exit
-                end;
-              tmpelecount:=0;
-              if not is_hfa_internal(tarraydef(p).elementdef,basedef,tmpelecount) then
-                exit;
-              { tmpelecount now contains the number of hfa elements in a
-                single array element (e.g. 2 if it's an array of a record
-                containing two singles) -> multiply by number of elements
-                in the array }
-              inc(elecount,tarraydef(p).elecount*tmpelecount);
-              if elecount>4 then
-                exit;
-              result:=true;
-            end;
-          floatdef:
-            begin
-              if not assigned(basedef) then
-                basedef:=p
-              else if basedef<>p then
-                exit;
-              inc(elecount);
-              result:=true;
-            end;
-          recorddef:
-            begin
-              for i:=0 to tabstractrecorddef(p).symtable.symlist.count-1 do
-                begin
-                  sym:=tsym(tabstractrecorddef(p).symtable.symlist[i]);
-                  if sym.typ<>fieldvarsym then
-                    continue;
-                  if not is_hfa_internal(tfieldvarsym(sym).vardef,basedef,elecount) then
-                    exit
-                end;
-              result:=true;
-            end;
-          else
-            exit
-        end;
-      end;
-
-
-    { Returns whether a def is a "homogeneous float array" at the machine level.
-      This means that in the memory layout, the def only consists of maximally
-      4 floating point values that appear consecutively in memory }
-    function is_hfa(p: tdef; out basedef: tdef) : boolean;
-      var
-        elecount: longint;
-      begin
-        result:=false;
-        basedef:=nil;
-        elecount:=0;
-        result:=is_hfa_internal(p,basedef,elecount);
-        result:=
-          result and
-          (elecount>0) and
-          (elecount<=4) and
-          (p.size=basedef.size*elecount)
-      end;
-
-
-    function getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
+    function tcpuparamanager.getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
       var
         hfabasedef: tdef;
       begin
@@ -364,6 +289,24 @@ unit cpupara;
          if not assigned(result.location) or
             not(result.location^.loc in [LOC_REGISTER,LOC_MMREGISTER,LOC_VOID]) then
            internalerror(2014113001);
+         {
+           According to ARM64 ABI: "If the size of the argument is less than 8 bytes then
+           the size of the argument is set to 8 bytes. The effect is as if the argument
+           was copied to the least significant bits of a 64-bit register and the remaining
+           bits filled with unspecified values."
+
+           Therefore at caller side force the ordinal result to be always 64-bit, so it
+           will be stripped to the required size and uneeded bits are discarded.
+
+           This is not required for iOS, where the result is zero/sign extended.
+         }
+         if (target_info.abi<>abi_aarch64_darwin) and
+            (side=callerside) and (result.location^.loc = LOC_REGISTER) and
+            (result.def.size<8) and is_ordinal(result.def) then
+           begin
+             result.location^.size:=OS_64;
+             result.location^.def:=u64inttype;
+           end;
       end;
 
 
@@ -597,14 +540,28 @@ unit cpupara;
                     responsibility to sign or zero-extend arguments having fewer
                     than 32 bits, and that unused bits in a register are
                     unspecified. In iOS, however, the caller must perform such
-                    extensions, up to 32 bits." }
-                 if (target_info.abi=abi_aarch64_darwin) and
-                    (side=callerside) and
-                    is_ordinal(paradef) and
-                    (paradef.size<4) then
+                    extensions, up to 32 bits."
+                    Zero extend an argument at caller side for iOS and
+                    ignore the argument's unspecified high bits at callee side for
+                    all other platforms. }
+                 if (paradef.size<4) and is_ordinal(paradef) then
                    begin
-                     paraloc^.size:=OS_32;
-                     paraloc^.def:=u32inttype;
+                     if target_info.abi=abi_aarch64_darwin then
+                       begin
+                         if side=callerside then
+                           begin
+                             paraloc^.size:=OS_32;
+                             paraloc^.def:=u32inttype;
+                           end;
+                       end
+                     else
+                       begin
+                         if side=calleeside then
+                           begin
+                             paraloc^.size:=OS_32;
+                             paraloc^.def:=u32inttype;
+                           end;
+                       end;
                    end;
 
                  { in case it's a composite, "The argument is passed as though
@@ -682,12 +639,12 @@ unit cpupara;
      end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist):longint;
       begin
         init_para_alloc_values;
 
         { non-variadic parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,false);
+        create_paraloc_info_intern(p,side,p.paras,false);
         if p.proccalloption in cstylearrayofconst then
           begin
             { on Darwin, we cannot use any registers for variadic parameters }
@@ -697,11 +654,19 @@ unit cpupara;
                 curmmreg:=succ(RS_LAST_MM_PARAM_SUPREG);
               end;
             { continue loading the parameters  }
-            create_paraloc_info_intern(p,callerside,varargspara,true);
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  create_paraloc_info_intern(p,side,varargspara,true)
+                else
+                  internalerror(2019021916);
+              end;
             result:=curstackoffset;
           end
         else
           internalerror(200410231);
+
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/aasmtai.pas

@@ -2928,9 +2928,10 @@ implementation
         i : integer;
       begin
         inherited ppuload(t,ppufile);
-        { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
+        { hopefully, we don't get problems with big/little endian here when cross compiling :/ }
         ppufile.getdata(condition,sizeof(tasmcond));
-        allocate_oper(ppufile.getbyte);
+        ops := ppufile.getbyte;
+        allocate_oper(ops);
         for i:=0 to ops-1 do
           ppuloadoper(ppufile,oper[i]^);
         opcode:=tasmop(ppufile.getword);

compiler/arm/cgcpu.pas

@@ -42,7 +42,9 @@ unit cgcpu;
         cgsetflags : boolean;
 
         procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override;
-        procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
+       protected
+         procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); override;
+       public
         procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
 
         procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
@@ -571,52 +573,16 @@ unit cgcpu;
       end;
 
 
-    procedure tbasecgarm.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);
-      var
-        tmpref, ref: treference;
-        location: pcgparalocation;
-        sizeleft: aint;
+    procedure tbasecgarm.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
       begin
-        location := paraloc.location;
-        tmpref := r;
-        sizeleft := paraloc.intsize;
-        while assigned(location) do
+        { doubles in softemu mode have a strange order of registers and references }
+        if (cgpara.size=OS_F64) and
+           (location^.size=OS_32) then
           begin
-            paramanager.allocparaloc(list,location);
-            case location^.loc of
-              LOC_REGISTER,LOC_CREGISTER:
-                a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-              LOC_REFERENCE:
-                begin
-                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,paraloc.alignment,[]);
-                  { doubles in softemu mode have a strange order of registers and references }
-                  if location^.size=OS_32 then
-                    g_concatcopy(list,tmpref,ref,4)
-                  else
-                    begin
-                      g_concatcopy(list,tmpref,ref,sizeleft);
-                      if assigned(location^.next) then
-                        internalerror(2005010710);
-                    end;
-                end;
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                case location^.size of
-                   OS_F32, OS_F64:
-                     a_loadfpu_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-                   else
-                     internalerror(2002072801);
-                end;
-              LOC_VOID:
-                begin
-                  // nothing to do
-                end;
-              else
-                internalerror(2002081103);
-            end;
-            inc(tmpref.offset,tcgsize2size[location^.size]);
-            dec(sizeleft,tcgsize2size[location^.size]);
-            location := location^.next;
-          end;
+            g_concatcopy(list,ref,paralocref,4)
+          end
+        else
+          inherited;
       end;
 
 
@@ -2520,6 +2486,11 @@ unit cgcpu;
                (tf_pic_uses_got in target_info.flags) and
                assigned(ref.symbol) then
               begin
+                {$ifdef EXTDEBUG}
+                if not (pi_needs_got in current_procinfo.flags) then
+                	Comment(V_warning,'pi_needs_got not included');
+                {$endif EXTDEBUG}
+                Include(current_procinfo.flags,pi_needs_got);
                 reference_reset(tmpref,4,[]);
                 tmpref.base:=current_procinfo.got;
                 tmpref.index:=tmpreg;
@@ -2690,7 +2661,7 @@ unit cgcpu;
         if we can keep the original reference while copying }
       function SimpleRef(const ref : treference) : boolean;
         begin
-          result:=((ref.base=NR_PC) and (ref.addressmode=AM_OFFSET) and (ref.refaddr=addr_full)) or
+          result:=((ref.base=NR_PC) and (ref.addressmode=AM_OFFSET) and (ref.refaddr in [addr_full,addr_no])) or
               ((ref.symbol=nil) and
                (ref.addressmode=AM_OFFSET) and
                (((ref.offset>=0) and (ref.offset+len<=31)) or

compiler/arm/cpupara.pas

@@ -30,10 +30,10 @@ unit cpupara;
        globtype,globals,
        aasmdata,
        cpuinfo,cpubase,cgbase,cgutils,
-       symconst,symtype,symdef,parabase,paramgr;
+       symconst,symtype,symdef,parabase,paramgr,armpara;
 
     type
-       tcpuparamanager = class(tparamanager)
+       tcpuparamanager = class(tarmgenparamanager)
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
@@ -42,9 +42,11 @@ unit cpupara;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
+          function usemmpararegs(calloption: tproccalloption; variadic: boolean): boolean;
+          function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
           procedure init_values(p: tabstractprocdef; side: tcallercallee; var curintreg,
             curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword;
             var sparesinglereg: tregister);
@@ -131,7 +133,9 @@ unit cpupara;
       end;
 
 
-    function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
+    function tcpuparamanager.getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
+      var
+        basedef: tdef;
       begin
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
            if push_addr_param for the def is true
@@ -161,7 +165,11 @@ unit cpupara;
             classrefdef:
               getparaloc:=LOC_REGISTER;
             recorddef:
-              getparaloc:=LOC_REGISTER;
+              if usemmpararegs(calloption,isvariadic) and
+                 is_hfa(p,basedef) then
+                getparaloc:=LOC_MMREGISTER
+              else
+                getparaloc:=LOC_REGISTER;
             objectdef:
               getparaloc:=LOC_REGISTER;
             stringdef:
@@ -176,6 +184,9 @@ unit cpupara;
             arraydef:
               if is_dynamic_array(p) then
                 getparaloc:=LOC_REGISTER
+              else if usemmpararegs(calloption,isvariadic) and
+                 is_hfa(p,basedef) then
+                getparaloc:=LOC_MMREGISTER
               else
                 getparaloc:=LOC_REFERENCE;
             setdef:
@@ -229,12 +240,19 @@ unit cpupara;
       var
         i: longint;
         sym: tsym;
+        basedef: tdef;
       begin
         if handle_common_ret_in_param(def,pd,result) then
           exit;
         case def.typ of
           recorddef:
             begin
+              if usemmpararegs(pd.proccalloption,is_c_variadic(pd)) and
+                 is_hfa(def,basedef) then
+                begin
+                  result:=false;
+                  exit;
+                end;
               result:=def.size>4;
               if not result and
                  (target_info.abi in [abi_default,abi_armeb]) then
@@ -327,11 +345,13 @@ unit cpupara;
 
       var
         nextintreg,nextfloatreg,nextmmreg : tsuperregister;
-        paradef : tdef;
+        paradef,
+        hfabasedef : tdef;
         paraloc : pcgparalocation;
         stack_offset : aword;
         hp : tparavarsym;
         loc : tcgloc;
+        hfabasesize  : tcgsize;
         paracgsize   : tcgsize;
         paralen : longint;
         i : integer;
@@ -359,6 +379,31 @@ unit cpupara;
         end;
 
 
+      procedure updatemmregs(paradef, basedef: tdef);
+        var
+          regsavailable,
+          regsneeded: longint;
+          basesize: asizeint;
+        begin
+          basesize:=basedef.size;
+          regsneeded:=paradef.size div basesize;
+          regsavailable:=ord(RS_D7)-ord(nextmmreg)+1;
+          case basesize of
+            4:
+              regsavailable:=regsavailable*2+ord(sparesinglereg<>NR_NO);
+            8:
+              ;
+            else
+              internalerror(2019022301);
+          end;
+          if regsavailable<regsneeded then
+            begin
+              nextmmreg:=succ(RS_D7);
+              sparesinglereg:=NR_NO;
+            end;
+        end;
+
+
       begin
         result:=0;
         nextintreg:=curintreg;
@@ -429,6 +474,18 @@ unit cpupara;
              hp.paraloc[side].def:=paradef;
              firstparaloc:=true;
 
+             if (loc=LOC_MMREGISTER) and
+                is_hfa(paradef,hfabasedef) then
+               begin
+                 updatemmregs(paradef,hfabasedef);
+                 hfabasesize:=def_cgsize(hfabasedef);
+               end
+             else
+               begin
+                 hfabasedef:=nil;
+                 hfabasesize:=OS_NO;
+               end;
+
 {$ifdef EXTDEBUG}
              if paralen=0 then
                internalerror(200410311);
@@ -514,10 +571,18 @@ unit cpupara;
                       end;
                     LOC_MMREGISTER:
                       begin
-                        paraloc^.size:=paracgsize;
-                        paraloc^.def:=paradef;
+                        if assigned(hfabasedef) then
+                          begin
+                            paraloc^.def:=hfabasedef;
+                            paraloc^.size:=hfabasesize;
+                          end
+                        else
+                          begin
+                            paraloc^.size:=paracgsize;
+                            paraloc^.def:=paradef;
+                          end;
                         if (nextmmreg<=RS_D7) or
-                           ((paraloc^.size = OS_F32) and
+                           ((paraloc^.size=OS_F32) and
                             (sparesinglereg<>NR_NO)) then
                           begin
                             paraloc^.loc:=LOC_MMREGISTER;
@@ -642,35 +707,53 @@ unit cpupara;
 
     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
-        paraloc : pcgparalocation;
+        paraloc: pcgparalocation;
         retcgsize  : tcgsize;
+        basedef: tdef;
+        i: longint;
+        mmreg: tregister;
       begin
          if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
            exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if result.def.typ=floatdef then
+        basedef:=nil;
+        if (result.def.typ=floatdef) or
+           is_hfa(result.def,basedef) then
           begin
-            if (target_info.abi=abi_eabihf) or (p.proccalloption=pocall_hardfloat) then
+            if usemmpararegs(p.proccalloption,is_c_variadic(p)) then
               begin
-                paraloc^.loc:=LOC_MMREGISTER;
+                if assigned(basedef) then
+                  begin
+                    for i:=2 to result.def.size div basedef.size do
+                      result.add_location;
+                    retcgsize:=def_cgsize(basedef);
+                  end
+                else
+                  basedef:=result.def;
                 case retcgsize of
                   OS_64,
                   OS_F64:
                     begin
-                      paraloc^.register:=NR_MM_RESULT_REG;
+                      mmreg:=NR_MM_RESULT_REG
                     end;
                   OS_32,
                   OS_F32:
                     begin
-                      paraloc^.register:=NR_S0;
+                      mmreg:=NR_S0;
                     end;
                   else
                     internalerror(2012032501);
                 end;
-                paraloc^.size:=retcgsize;
-                paraloc^.def:=result.def;
+                repeat
+                  paraloc^.loc:=LOC_MMREGISTER;
+                  paraloc^.register:=mmreg;
+                  inc(mmreg);
+                  paraloc^.size:=retcgsize;
+                  paraloc^.def:=basedef;
+                  paraloc:=paraloc^.next;
+                until not assigned(paraloc);
               end
             else if (p.proccalloption in [pocall_softfloat]) or
                (cs_fp_emulation in current_settings.moduleswitches) or
@@ -764,6 +847,14 @@ unit cpupara;
       end;
 
 
+    function tcpuparamanager.usemmpararegs(calloption: tproccalloption; variadic: boolean): boolean;
+      begin
+        result:=
+         ((target_info.abi=abi_eabihf) or (calloption=pocall_hardfloat)) and
+          (not variadic);
+      end;
+
+
     function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         cur_stack_offset: aword;
@@ -778,20 +869,30 @@ unit cpupara;
      end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
         sparesinglereg:tregister;
       begin
-        init_values(p,callerside,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
+        init_values(p,side,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
+                else
+                  internalerror(2019021915);
+              end;
+          end
         else
           internalerror(200410231);
+
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/armgen/armpara.pas

@@ -0,0 +1,121 @@
+{
+    Copyright (c) 2019 by Jonas Maebe
+
+    ARM and AArch64 common parameter helpers
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit armpara;
+
+{$mode objfpc}
+
+interface
+
+uses
+  symtype,
+  paramgr;
+
+type
+  tarmgenparamanager = class(tparamanager)
+   protected
+    { Returns whether a def is a "homogeneous float array" at the machine level.
+      This means that in the memory layout, the def only consists of maximally
+      4 floating point values that appear consecutively in memory }
+    function is_hfa(p: tdef; out basedef: tdef) : boolean;
+   private
+    function is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
+  end;
+
+
+implementation
+
+  uses
+    symconst,symdef,symsym,defutil;
+
+
+  function tarmgenparamanager.is_hfa(p: tdef; out basedef: tdef): boolean;
+    var
+      elecount: longint;
+    begin
+      result:=false;
+      basedef:=nil;
+      elecount:=0;
+      result:=is_hfa_internal(p,basedef,elecount);
+      result:=
+        result and
+        (elecount>0) and
+        (elecount<=4) and
+        (p.size=basedef.size*elecount)
+      end;
+
+
+  function tarmgenparamanager.is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
+    var
+      i: longint;
+      sym: tsym;
+      tmpelecount: longint;
+    begin
+      result:=false;
+      case p.typ of
+        arraydef:
+          begin
+            if is_special_array(p) then
+              exit;
+            { an array of empty records has no influence }
+            if tarraydef(p).elementdef.size=0 then
+              begin
+                result:=true;
+                exit
+              end;
+            tmpelecount:=0;
+            if not is_hfa_internal(tarraydef(p).elementdef,basedef,tmpelecount) then
+              exit;
+            { tmpelecount now contains the number of hfa elements in a
+              single array element (e.g. 2 if it's an array of a record
+              containing two singles) -> multiply by number of elements
+              in the array }
+            inc(elecount,tarraydef(p).elecount*tmpelecount);
+            if elecount>4 then
+              exit;
+            result:=true;
+          end;
+        floatdef:
+          begin
+            if not assigned(basedef) then
+              basedef:=p
+            else if basedef<>p then
+              exit;
+            inc(elecount);
+            result:=true;
+          end;
+        recorddef:
+          begin
+            for i:=0 to tabstractrecorddef(p).symtable.symlist.count-1 do
+              begin
+                sym:=tsym(tabstractrecorddef(p).symtable.symlist[i]);
+                if sym.typ<>fieldvarsym then
+                  continue;
+                if not is_hfa_internal(tfieldvarsym(sym).vardef,basedef,elecount) then
+                  exit
+              end;
+            result:=true;
+          end;
+        else
+          exit
+      end;
+    end;
+
+end.

compiler/avr/cpupara.pas

@@ -39,7 +39,7 @@ unit cpupara;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -526,17 +526,25 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
       begin
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+                else
+                  internalerror(2019021914);
+              end;
+          end
         else
           internalerror(200410231);
       end;

compiler/cgobj.pas

@@ -170,6 +170,9 @@ unit cgobj;
              @param(cgpara where the parameter will be stored)
           }
           procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
+         protected
+          procedure a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation); virtual;
+         public
           {# Pass the value of a parameter, which can be located either in a register or memory location,
              to a routine.
 
@@ -1129,16 +1132,8 @@ implementation
                 end;
               LOC_REFERENCE,LOC_CREFERENCE:
                 begin
-                   if assigned(location^.next) then
-                     internalerror(2010052906);
-                   reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
-                   if (size <> OS_NO) and
-                      (tcgsize2size[size] <= sizeof(aint)) then
-                     a_load_ref_ref(list,size,location^.size,tmpref,ref)
-                   else
-                     { use concatcopy, because the parameter can be larger than }
-                     { what the OS_* constants can handle                       }
-                     g_concatcopy(list,tmpref,ref,sizeleft);
+                  reference_reset_base(ref,location^.reference.index,location^.reference.offset,ctempposinvalid,newalignment(cgpara.alignment,cgpara.intsize-sizeleft),[]);
+                  a_load_ref_cgparalocref(list,size,sizeleft,tmpref,ref,cgpara,location);
                 end;
               LOC_MMREGISTER,LOC_CMMREGISTER:
                 begin
@@ -1153,6 +1148,10 @@ implementation
                      else
                        internalerror(2010053101);
                    end;
+                end;
+              LOC_FPUREGISTER,LOC_CFPUREGISTER:
+                begin
+                  a_loadfpu_ref_reg(list,size,location^.size,tmpref,location^.register);
                 end
               else
                 internalerror(2010053111);
@@ -1163,6 +1162,19 @@ implementation
           end;
       end;
 
+    procedure tcg.a_load_ref_cgparalocref(list: TAsmList; sourcesize: tcgsize; sizeleft: tcgint; const ref, paralocref: treference; const cgpara: tcgpara; const location: PCGParaLocation);
+      begin
+        if assigned(location^.next) then
+          internalerror(2010052906);
+        if (sourcesize<>OS_NO) and
+           (tcgsize2size[sourcesize]<=sizeof(aint)) then
+           a_load_ref_ref(list,sourcesize,location^.size,ref,paralocref)
+        else
+          { use concatcopy, because the parameter can be larger than }
+          { what the OS_* constants can handle                       }
+          g_concatcopy(list,ref,paralocref,sizeleft);
+       end;
+
 
     procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara);
       begin

compiler/defutil.pas

@@ -325,6 +325,9 @@ interface
     { # returns true if the procdef has no parameters and no specified return type }
     function is_bareprocdef(pd : tprocdef): boolean;
 
+    { returns true if the procdef is a C-style variadic function }
+    function is_c_variadic(pd: tabstractprocdef): boolean; {$ifdef USEINLINE}inline;{$endif}
+
     { # returns the smallest base integer type whose range encompasses that of
         both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
         signdness, the result will also get that signdness }
@@ -1496,6 +1499,12 @@ implementation
                  (pd.proctypeoption = potype_constructor));
       end;
 
+    function is_c_variadic(pd: tabstractprocdef): boolean;
+      begin
+        result:=
+          (po_varargs in pd.procoptions) or
+          (po_variadic in pd.procoptions);
+      end;
 
     function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
       var

compiler/hlcg2ll.pas

@@ -1548,8 +1548,9 @@ implementation
               cg128.a_load128_loc_cgpara(list,l,cgpara)
             else
 {$else cpu64bitalu}
-            { use cg64 only for int64, not for 8 byte records }
-            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) then
+            { use cg64 only for int64, not for 8 byte records; in particular,
+              filter out records passed in fpu/mm register}
+            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc=LOC_REGISTER) then
               cg64.a_load64_loc_cgpara(list,l,cgpara)
             else
 {$endif cpu64bitalu}

compiler/i386/cpupara.pas

@@ -42,7 +42,7 @@ unit cpupara;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
           function get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
        private
@@ -767,15 +767,22 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
+        create_stdcall_paraloc_info(p,side,p.paras,parasize);
         { append the varargs }
-        create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_stdcall_paraloc_info(p,side,varargspara,parasize)
+            else
+              internalerror(2019021926);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/i8086/cpupara.pas

@@ -55,7 +55,7 @@ unit cpupara;
           }
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
        private
@@ -783,15 +783,22 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
+        create_stdcall_paraloc_info(p,side,p.paras,parasize);
         { append the varargs }
-        create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_stdcall_paraloc_info(p,side,varargspara,parasize)
+            else
+              internalerror(2019021925);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/jvm/cpupara.pas

@@ -46,7 +46,7 @@ interface
         @param(nr Parameter number of routine, starting from 1)}
         procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
         function param_use_paraloc(const cgpara: tcgpara): boolean; override;
         function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
@@ -209,15 +209,22 @@ implementation
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,parasize);
+        create_paraloc_info_intern(p,side,p.paras,parasize);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara,parasize)
+            else
+              internalerror(2019021924);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/m68k/cpupara.pas

@@ -45,7 +45,7 @@ unit cpupara;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
           function get_volatile_registers_int(calloption:tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;override;
@@ -675,18 +675,27 @@ unit cpupara;
         inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
       begin
         cur_stack_offset:=0;
 
-        result:=create_stdcall_paraloc_info(p,callerside,p.paras,cur_stack_offset);
+        result:=create_stdcall_paraloc_info(p,side,p.paras,cur_stack_offset);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_stdcall_paraloc_info(p,callerside,varargspara,cur_stack_offset)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_stdcall_paraloc_info(p,side,varargspara,cur_stack_offset)
+                else
+                  internalerror(2019021923);
+              end;
+          end
         else
           internalerror(200410231);
+        create_funcretloc_info(p,side);
       end;
 
 

compiler/mips/cpupara.pas

@@ -73,7 +73,7 @@ interface
         function  get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
         function  get_saved_registers_int(calloption : tproccalloption):TCpuRegisterArray;override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
         function  param_use_paraloc(const cgpara: tcgpara): boolean; override;
       private
@@ -490,7 +490,7 @@ implementation
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       begin
         intparareg:=0;
         intparasize:=0;
@@ -498,13 +498,20 @@ implementation
         { Create Function result paraloc }
         create_funcretloc_info(p,callerside);
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras);
+        create_paraloc_info_intern(p,side,p.paras);
         { append the varargs }
         can_use_float := false;
         { restore correct intparasize value }
         if intparareg < 4 then
           intparasize:=intparareg * 4;
-        create_paraloc_info_intern(p,callerside,varargspara);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara)
+            else
+              internalerror(2019021922);
+          end;
+        create_funcretloc_info(p,side);
         { We need to return the size allocated on the stack }
         result:=intparasize;
       end;

compiler/ncal.pas

@@ -4416,7 +4416,7 @@ implementation
 
          { calculate the parameter size needed for this call include varargs if they are available }
          if assigned(varargsparas) then
-           pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,varargsparas)
+           pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,callerside,varargsparas)
          else
            pushedparasize:=procdefinition.callerargareasize;
 

compiler/paramgr.pas

@@ -140,7 +140,7 @@ unit paramgr;
             for the routine that are passed as varargs. It returns
             the size allocated on the stack (including the normal parameters)
           }
-          function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract;
+          function  create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;virtual;abstract;
 
           function is_stack_paraloc(paraloc: pcgparalocation): boolean;virtual;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);virtual;

compiler/pdecsub.pas

@@ -1520,6 +1520,13 @@ implementation
             internalerror(2015052202);
         end;
 
+        if (pd.proccalloption in cdecl_pocalls) and
+           (pd.paras.count>0) and
+           is_array_of_const(tparavarsym(pd.paras[pd.paras.count-1]).vardef) then
+          begin
+            include(pd.procoptions,po_variadic);
+          end;
+
         { file types can't be function results }
         if assigned(pd) and
            (pd.returndef.typ=filedef) then

compiler/powerpc/cpupara.pas

@@ -40,7 +40,7 @@ unit cpupara;
 
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -628,7 +628,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         parasize, l: longint;
@@ -640,36 +640,27 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
         if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           begin
-            result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true);
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
+                else
+                  internalerror(2019021921);
+                if curfloatreg<>firstfloatreg then
+                  include(varargspara.varargsinfo,va_uses_float_reg);
+              end;
             { varargs routines have to reserve at least 32 bytes for the AIX abi }
             if (target_info.abi in [abi_powerpc_aix,abi_powerpc_darwin]) and
                (result < 32) then
               result := 32;
            end
         else
-          begin
-            parasize:=cur_stack_offset;
-            for i:=0 to varargspara.count-1 do
-              begin
-                hp:=tparavarsym(varargspara[i]);
-                hp.paraloc[callerside].alignment:=4;
-                paraloc:=hp.paraloc[callerside].add_location;
-                paraloc^.loc:=LOC_REFERENCE;
-                paraloc^.size:=def_cgsize(hp.vardef);
-                paraloc^.def:=hp.vardef;
-                paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                l:=push_size(hp.varspez,hp.vardef,p.proccalloption);
-                paraloc^.reference.offset:=parasize;
-                parasize:=parasize+l;
-              end;
-            result:=parasize;
-          end;
-        if curfloatreg<>firstfloatreg then
-          include(varargspara.varargsinfo,va_uses_float_reg);
+          internalerror(2019021710);
+        create_funcretloc_info(p,side);
       end;
 
 

compiler/powerpc64/cpupara.pas

@@ -45,8 +45,7 @@ type
 
     procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara); override;
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
-    function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
-      tvarargsparalist): longint; override;
+    function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
     function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
 
   private
@@ -743,7 +742,7 @@ implemented
   end;
 end;
 
-function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
+function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee;
   varargspara: tvarargsparalist): longint;
 var
   cur_stack_offset: aword;
@@ -756,33 +755,28 @@ begin
   init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
   firstfloatreg := curfloatreg;
 
-  result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
+  result := create_paraloc_info_intern(p, side, p.paras, curintreg,
     curfloatreg, curmmreg, cur_stack_offset, false);
-  if (p.proccalloption in cstylearrayofconst) then begin
-    { just continue loading the parameters in the registers }
-    result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
-      curfloatreg, curmmreg, cur_stack_offset, true);
-    { varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
-    if (result < 64) then
-      result := 64;
-  end else begin
-    parasize := cur_stack_offset;
-    for i := 0 to varargspara.count - 1 do begin
-      hp := tparavarsym(varargspara[i]);
-      hp.paraloc[callerside].alignment := 8;
-      paraloc := hp.paraloc[callerside].add_location;
-      paraloc^.loc := LOC_REFERENCE;
-      paraloc^.size := def_cgsize(hp.vardef);
-      paraloc^.def := hp.vardef;
-      paraloc^.reference.index := NR_STACK_POINTER_REG;
-      l := push_size(hp.varspez, hp.vardef, p.proccalloption);
-      paraloc^.reference.offset := parasize;
-      parasize := parasize + l;
-    end;
-    result := parasize;
-  end;
-  if curfloatreg <> firstfloatreg then
-    include(varargspara.varargsinfo, va_uses_float_reg);
+  if (p.proccalloption in cstylearrayofconst) then
+    begin
+      { just continue loading the parameters in the registers }
+      if assigned(varargspara) then
+        begin
+          if side=callerside then
+            result := create_paraloc_info_intern(p, side, varargspara, curintreg,
+              curfloatreg, curmmreg, cur_stack_offset, true)
+          else
+            internalerror(2019021920);
+          if curfloatreg <> firstfloatreg then
+            include(varargspara.varargsinfo, va_uses_float_reg);
+        end;
+      { varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
+      if (result < 64) then
+        result := 64;
+    end
+  else
+    internalerror(2019021911);
+  create_funcretloc_info(p, side);
 end;
 
 function tcpuparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;

compiler/ppcaarch64.lpi

@@ -43,7 +43,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="aarch64"/>
-      <OtherUnitFiles Value="aarch64;systems"/>
+      <OtherUnitFiles Value="armgen;aarch64;systems"/>
       <UnitOutputDirectory Value="aarch64\lazbuild"/>
     </SearchPaths>
     <Parsing>

compiler/ppcarm.lpi

@@ -62,7 +62,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="arm"/>
-      <OtherUnitFiles Value="arm;systems"/>
+      <OtherUnitFiles Value="armgen;arm;systems"/>
       <UnitOutputDirectory Value="arm\lazbuild"/>
     </SearchPaths>
     <Parsing>

compiler/procdefutil.pas

@@ -36,7 +36,7 @@ implementation
 
   uses
     cutils,
-    symbase,symsym,symtable,pparautl;
+    symbase,symsym,symtable,pparautl,globtype;
 
 
   function create_outline_procdef(const basesymname: string; astruct: tabstractrecorddef; potype: tproctypeoption; resultdef: tdef): tprocdef;
@@ -72,6 +72,9 @@ implementation
         nested procvars modeswitch is active. We must be independent of this switch. }
       exclude(result.procoptions,po_delphi_nested_cc);
       result.proctypeoption:=potype;
+      { always use the default calling convention }
+      result.proccalloption:=pocall_default;
+      include(result.procoptions,po_hascallingconvention);
       handle_calling_convention(result,hcc_default_actions_impl);
       sym:=cprocsym.create(basesymname+result.unique_id_str);
       st.insert(sym);

compiler/riscv32/cpupara.pas

@@ -39,7 +39,7 @@ unit cpupara;
 
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -505,7 +505,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         parasize, l: longint;
@@ -517,32 +517,23 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
         if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           begin
-            result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true);
-           end
-        else
-          begin
-            parasize:=cur_stack_offset;
-            for i:=0 to varargspara.count-1 do
+            if assigned(varargspara) then
               begin
-                hp:=tparavarsym(varargspara[i]);
-                hp.paraloc[callerside].alignment:=4;
-                paraloc:=hp.paraloc[callerside].add_location;
-                paraloc^.loc:=LOC_REFERENCE;
-                paraloc^.size:=def_cgsize(hp.vardef);
-                paraloc^.def:=hp.vardef;
-                paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                l:=push_size(hp.varspez,hp.vardef,p.proccalloption);
-                paraloc^.reference.offset:=parasize;
-                parasize:=parasize+l;
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
+                else
+                  internalerror(2019021919);
+                if curfloatreg<>firstfloatreg then
+                  include(varargspara.varargsinfo,va_uses_float_reg);
               end;
-            result:=parasize;
-          end;
-        if curfloatreg<>firstfloatreg then
-          include(varargspara.varargsinfo,va_uses_float_reg);
+           end
+        else
+          internalerror(2019021912);
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/riscv64/cpupara.pas

@@ -40,7 +40,7 @@ unit cpupara;
 
         procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara); override;
         function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
-        function create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist): longint; override;
+        function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
         function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
 
       private
@@ -490,7 +490,7 @@ implementation
         end;
       end;
 
-function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
+function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee;
   varargspara: tvarargsparalist): longint;
 var
   cur_stack_offset: aword;
@@ -503,33 +503,29 @@ begin
   init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
   firstfloatreg := curfloatreg;
 
-  result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
+  result := create_paraloc_info_intern(p, side, p.paras, curintreg,
     curfloatreg, curmmreg, cur_stack_offset, false);
-  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then begin
-    { just continue loading the parameters in the registers }
-    result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
-      curfloatreg, curmmreg, cur_stack_offset, true);
-    { varargs routines have to reserve at least 64 bytes for the RiscV ABI }
-    if (result < 64) then
-      result := 64;
-  end else begin
-    parasize := cur_stack_offset;
-    for i := 0 to varargspara.count - 1 do begin
-      hp := tparavarsym(varargspara[i]);
-      hp.paraloc[callerside].alignment := 8;
-      paraloc := hp.paraloc[callerside].add_location;
-      paraloc^.loc := LOC_REFERENCE;
-      paraloc^.size := def_cgsize(hp.vardef);
-      paraloc^.def := hp.vardef;
-      paraloc^.reference.index := NR_STACK_POINTER_REG;
-      l := push_size(hp.varspez, hp.vardef, p.proccalloption);
-      paraloc^.reference.offset := parasize;
-      parasize := parasize + l;
-    end;
-    result := parasize;
-  end;
-  if curfloatreg <> firstfloatreg then
-    include(varargspara.varargsinfo, va_uses_float_reg);
+  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then
+    begin
+      { just continue loading the parameters in the registers }
+      if assigned(varargspara) then
+        begin
+          if side=callerside then
+            result := create_paraloc_info_intern(p, side, varargspara, curintreg,
+              curfloatreg, curmmreg, cur_stack_offset, true)
+          else
+            internalerror(2019021918);
+          if curfloatreg <> firstfloatreg then
+            include(varargspara.varargsinfo, va_uses_float_reg);
+        end;
+      { varargs routines have to reserve at least 64 bytes for the RiscV ABI }
+      if (result < 64) then
+        result := 64;
+    end
+  else
+    internalerror(2019021913);
+
+  create_funcretloc_info(p, side);
 end;
 
 function tcpuparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;

compiler/scanner.pas

@@ -572,13 +572,15 @@ implementation
            { Default to intel assembler for delphi/tp7 on i386/i8086 }
            if (m_delphi in current_settings.modeswitches) or
               (m_tp7 in current_settings.modeswitches) then
+             begin
 {$ifdef i8086}
-             current_settings.asmmode:=asmmode_i8086_intel;
+               current_settings.asmmode:=asmmode_i8086_intel;
 {$else i8086}
-             current_settings.asmmode:=asmmode_i386_intel;
+               current_settings.asmmode:=asmmode_i386_intel;
 {$endif i8086}
-           if changeinit then
-             init_settings.asmmode:=current_settings.asmmode;
+               if changeinit then
+                 init_settings.asmmode:=current_settings.asmmode;
+             end;
 {$endif i386 or i8086}
 
            { Exception support explicitly turned on (mainly for macpas, to }

compiler/sparcgen/sppara.pas

@@ -35,7 +35,7 @@ interface
         function  get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override;
         function  get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                              var curintreg: longint; curfloatreg: tsuperregister; var cur_stack_offset: aword);virtual;abstract;
       end;
@@ -66,7 +66,7 @@ implementation
       end;
 
 
-    function tsparcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tsparcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         curintreg : LongInt;
         curfloatreg : TSuperRegister;
@@ -76,9 +76,15 @@ implementation
         curfloatreg:=RS_F0;
         cur_stack_offset:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset);
+        create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset)
+            else
+              internalerror(2019021927);
+          end;
         result:=cur_stack_offset;
       end;
 

compiler/symconst.pas

@@ -416,7 +416,10 @@ type
     { procedure is an automatically generated property setter }
     po_is_auto_setter,
     { must never be inlined          by auto-inlining }
-    po_noinline
+    po_noinline,
+    { same as po_varargs, but with an array-of-const parameter instead of with the
+      "varargs" modifier or Mac-Pascal ".." parameter }
+    po_variadic
   );
   tprocoptions=set of tprocoption;
 
@@ -1028,7 +1031,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       'C-style blocks',{po_is_block}
       'po_is_auto_getter',{po_is_auto_getter}
       'po_is_auto_setter',{po_is_auto_setter}
-      'po_noinline'{po_noinline}
+      'po_noinline',{po_noinline}
+      'C-style array-of-const' {po_variadic}
     );
 
 implementation

compiler/symdef.pas

@@ -5284,7 +5284,10 @@ implementation
         if (side in [callerside,callbothsides]) and
            not(has_paraloc_info in [callerside,callbothsides]) then
           begin
-            callerargareasize:=paramanager.create_paraloc_info(self,callerside);
+            if not is_c_variadic(self) then
+              callerargareasize:=paramanager.create_paraloc_info(self,callerside)
+            else
+              callerargareasize:=paramanager.create_varargs_paraloc_info(self,callerside,nil);
             if has_paraloc_info in [calleeside,callbothsides] then
               has_paraloc_info:=callbothsides
             else
@@ -5293,7 +5296,10 @@ implementation
         if (side in [calleeside,callbothsides]) and
            not(has_paraloc_info in [calleeside,callbothsides]) then
           begin
-            calleeargareasize:=paramanager.create_paraloc_info(self,calleeside);
+            if not is_c_variadic(self) then
+              calleeargareasize:=paramanager.create_paraloc_info(self,calleeside)
+            else
+              callerargareasize:=paramanager.create_varargs_paraloc_info(self,calleeside,nil);
             if has_paraloc_info in [callerside,callbothsides] then
               has_paraloc_info:=callbothsides
             else

compiler/systems/t_embed.pas

@@ -1311,12 +1311,12 @@ begin
   if success and (target_info.system in [system_arm_embedded,system_avr_embedded,system_mipsel_embedded]) then
     begin
       success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O ihex '+
-        ChangeFileExt(current_module.exefilename,'.elf')+' '+
-        ChangeFileExt(current_module.exefilename,'.hex'),true,false);
+        maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.elf')))+' '+
+        maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.hex'))),true,false);
       if success then
         success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+
-          ChangeFileExt(current_module.exefilename,'.elf')+' '+
-          ChangeFileExt(current_module.exefilename,'.bin'),true,false);
+          maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.elf')))+' '+
+          maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.bin'))),true,false);
     end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }

compiler/utils/ppuutils/ppudump.pp

@@ -596,9 +596,9 @@ var
   s : string;
 begin
   s:='';
+  ntflags:=flags;
   if flags<>0 then
    begin
-     ntflags:=flags;
      first:=true;
      for i:=1to flagopts do
       if (flags and flagopt[i].mask)<>0 then
@@ -1033,6 +1033,9 @@ var
 begin
   with ppufile do
    begin
+     fileindex:=0;
+     line:=0;
+     column:=0;
      {
        info byte layout in bits:
        0-1 - amount of bytes for fileindex
@@ -2015,7 +2018,8 @@ const
      (mask:po_is_block;        str: 'C "Block"'),
      (mask:po_is_auto_getter;  str: 'Automatically generated getter'),
      (mask:po_is_auto_setter;  str: 'Automatically generated setter'),
-     (mask:po_noinline;        str: 'Never inline')
+     (mask:po_noinline;        str: 'Never inline'),
+     (mask:po_variadic;        str: 'C VarArgs with array-of-const para')
   );
 var
   proctypeoption  : tproctypeoption;
@@ -2395,9 +2399,9 @@ begin
            write(', ');
          write(managementoperatoropt[i].str);
        end;
+     if not first then
+       writeln;
    end;
-  if not first then
-    writeln;
 end;
 
 
@@ -4133,12 +4137,12 @@ begin
                   'J':
                     begin
                       nostdout:=True;
-                      pout:=TPpuJsonOutput.Create(Output);
+                      pout:=TPpuJsonOutput.Create(StdOutputHandle);
                     end;
                   'X':
                     begin
                       nostdout:=True;
-                      pout:=TPpuXmlOutput.Create(Output);
+                      pout:=TPpuXmlOutput.Create(StdOutputHandle);
                     end;
                   else
                     begin

compiler/utils/ppuutils/ppujson.pp

@@ -47,7 +47,7 @@ type
     procedure WriteBool(const AName: string; AValue: boolean); override;
     procedure WriteNull(const AName: string); override;
   public
-    constructor Create(var OutFile: Text); override;
+    constructor Create(OutFileHandle: THandle); override;
     procedure IncI; override;
     procedure DecI; override;
   end;
@@ -214,9 +214,9 @@ begin
   Write('}');
 end;
 
-constructor TPpuJsonOutput.Create(var OutFile: Text);
+constructor TPpuJsonOutput.Create(OutFileHandle: THandle);
 begin
-  inherited Create(OutFile);
+  inherited Create(OutFileHandle);
   SetLength(FNeedDelim, 10);
   FNeedDelim[0]:=False;
 end;

compiler/utils/ppuutils/ppuout.pp

@@ -39,11 +39,14 @@ type
   { TPpuOutput }
   TPpuOutput = class
   private
-    FOutFile: ^Text;
+    FOutFileHandle: THandle;
+    FOutBuf: array[0..10000] of char;
+    FOutBufPos: integer;
     FIndent: integer;
     FIndentSize: integer;
     FIndStr: string;
     FNoIndent: boolean;
+    procedure Flush;
     procedure SetIndent(AValue: integer);
     procedure SetIndentSize(AValue: integer);
   protected
@@ -57,7 +60,7 @@ type
     procedure WriteBool(const AName: string; AValue: boolean); virtual;
     procedure WriteNull(const AName: string); virtual;
   public
-    constructor Create(var OutFile: Text); virtual;
+    constructor Create(OutFileHandle: THandle); virtual;
     destructor Destroy; override;
     procedure Write(const s: string);
     procedure WriteLn(const s: string = '');
@@ -1187,22 +1190,56 @@ begin
   DecI;
 end;
 
-constructor TPpuOutput.Create(var OutFile: Text);
+constructor TPpuOutput.Create(OutFileHandle: THandle);
 begin
-  FOutFile:=@OutFile;
+  FOutFileHandle:=OutFileHandle;
   FIndentSize:=2;
 end;
 
 destructor TPpuOutput.Destroy;
 begin
+  Flush;
   inherited Destroy;
 end;
 
+procedure TPpuOutput.Flush;
+var
+  i, len: integer;
+begin
+  i:=0;
+  while FOutBufPos > 0 do begin
+    len:=FileWrite(FOutFileHandle, FOutBuf[i], FOutBufPos);
+    if len < 0 then
+      raise Exception.CreateFmt('Error writing to file: ', [SysErrorMessage(GetLastOSError)]);
+    Inc(i, len);
+    Dec(FOutBufPos, len);
+  end;
+end;
+
 procedure TPpuOutput.Write(const s: string);
+var
+  ss: string;
+  i, len, len2: integer;
 begin
   if not FNoIndent then
-    System.Write(FOutFile^, FIndStr);
-  System.Write(FOutFile^, s);
+    ss:=FIndStr + s
+  else
+    ss:=s;
+  i:=1;
+  len:=Length(ss);
+  while len > 0 do begin
+    len2:=Length(FOutBuf) - FOutBufPos;
+    if len2 > 0 then begin
+      if len < len2 then
+        len2:=len;
+      Move(ss[i], FOutBuf[FOutBufPos], len2);
+      Inc(FOutBufPos, len2);
+    end;
+    if FOutBufPos = Length(FOutBuf) then
+      Flush;
+    Inc(i, len2);
+    Dec(len, len2);
+  end;
   FNoIndent:=True;
 end;
 
@@ -1228,6 +1265,7 @@ end;
 
 procedure TPpuOutput.Done;
 begin
+  Flush;
 end;
 
 { TPpuUnitDef }

compiler/utils/ppuutils/ppuxml.pp

@@ -41,7 +41,6 @@ type
     procedure WriteArrayEnd(const AName: string); override;
     procedure WriteStr(const AName, AValue: string); override;
   public
-    constructor Create(var OutFile: Text); override;
     procedure Init; override;
   end;
 
@@ -162,11 +161,6 @@ begin
     WriteLn(Format('</%s>', [GetTagName(Def.DefTypeName, 'object')]));
 end;
 
-constructor TPpuXmlOutput.Create(var OutFile: Text);
-begin
-  inherited Create(OutFile);
-end;
-
 procedure TPpuXmlOutput.Init;
 begin
   inherited Init;

compiler/x86_64/cpupara.pas

@@ -46,7 +46,7 @@ unit cpupara;
           function get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;override;
           function get_saved_registers_mm(calloption: tproccalloption):tcpuregisterarray;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
        end;
 
@@ -1946,7 +1946,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         intparareg,mmparareg,
         parasize : longint;
@@ -1958,11 +1958,18 @@ unit cpupara;
         else
           parasize:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,intparareg,mmparareg,parasize,false);
+        create_paraloc_info_intern(p,side,p.paras,intparareg,mmparareg,parasize,false);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,intparareg,mmparareg,parasize,true);
-        { store used no. of SSE registers, that needs to be passed in %AL }
-        varargspara.mmregsused:=mmparareg;
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara,intparareg,mmparareg,parasize,true)
+            else
+              internalerror(2019021917);
+            { store used no. of SSE registers, that needs to be passed in %AL }
+            varargspara.mmregsused:=mmparareg;
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

packages/fcl-image/examples/fpcanvasalphadraw.pp

@@ -0,0 +1,97 @@
+{
+  Sample program by Ondrey Pokorny to demonstrate drawing modes of the TFPCustomCanvas:
+    - opaque 
+    - alphablend 
+    - custom blending, using a callback (not-used in this case)
+}
+program FPCanvasAlphaDraw;
+
+uses FPImage, FPImgCanv, FPCanvas, FPReadPNG, FPWritePNG, Classes, SysUtils, freetype, ftFont;
+
+const
+  cImageName: array[TFPDrawingMode] of string = ('opaque', 'alphablend', 'not-used');
+
+var
+  xNew, xImage: TFPMemoryImage;
+  xCanvas: TFPImageCanvas;
+  xDrawingMode: TFPDrawingMode;
+  xRect: TRect;
+begin
+  ftFont.InitEngine;
+  xNew := nil;
+  xCanvas := nil;
+  xImage := nil;
+  try
+    xImage := TFPMemoryImage.Create(0, 0);
+    xImage.LoadFromFile('edit-clear.png');
+
+    for xDrawingMode := dmOpaque to dmAlphaBlend do
+    begin
+      xNew := TFPMemoryImage.Create(200, 200);
+      xCanvas := TFPImageCanvas.Create(xNew);
+
+      xCanvas.DrawingMode := xDrawingMode;
+
+      xCanvas.Pen.Style := psClear;
+      xCanvas.Brush.FPColor := colRed;
+
+      xCanvas.FillRect(0, 0, xNew.Width, xNew.Height);
+      // draw semi-transparent objects
+      xCanvas.Brush.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xRect := Rect(0, 0, 50, 50);
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+
+      xRect := Rect(0, 50, 50, 100);
+
+      xCanvas.Pen.Style := psSolid;
+      xCanvas.Pen.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Pen.Width := 4;
+      xCanvas.Brush.Style := bsClear;
+
+      xCanvas.Ellipse(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Rectangle(xRect);
+      xRect.Offset(50, 0);
+      xCanvas.Polyline([
+        Point(xRect.CenterPoint.X, xRect.Top),
+        Point(xRect.Right, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Bottom),
+        Point(xRect.Left, xRect.CenterPoint.Y),
+        Point(xRect.CenterPoint.X, xRect.Top)]);
+      xRect.Offset(50, 0);
+      xCanvas.MoveTo(xRect.TopLeft);
+      xCanvas.LineTo(xRect.Right, xRect.Top);
+
+      xRect := Rect(0, 100, 50, 150);
+      xCanvas.Draw(xRect.Left, xRect.Top, xImage);
+      xRect.Offset(50, 0);
+      xCanvas.StretchDraw(xRect.Left, xRect.Top, xRect.Width, xRect.Height, xImage);
+
+      xRect := Rect(0, 150, 50, 200);
+      xCanvas.Font:=TFreeTypeFont.Create;
+      xCanvas.Font.FPColor := FPColor($FFFF, $FFFF, $FFFF, $8000);
+      xCanvas.Font.Name := 'DejaVuLGCSans.ttf';
+      xCanvas.Font.Size := 15;
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := True;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xRect.Offset(100, 0);
+      (xCanvas.Font as TFreeTypeFont).AntiAliased := False;
+      xCanvas.TextOut(xRect.Left, xRect.CenterPoint.Y, 'Hello');
+
+      xNew.SaveToFile(cImageName[xDrawingMode]+'.png');
+
+      xCanvas.Font.Free;
+      xCanvas.Font := nil;
+      FreeAndNil(xNew);
+      FreeAndNil(xCanvas);
+    end;
+  finally
+    xCanvas.Free;
+    xNew.Free;
+    xImage.Free;
+  end;
+end.
+

packages/fcl-image/examples/imgconv.pp

@@ -17,7 +17,7 @@ program ImgConv;
 
 {_$define UseFile}
 
-uses FPWriteXPM, FPWritePNG, FPWriteBMP,
+uses FPWriteXPM, FPWritePNG, FPWriteBMP,fpreadgif,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
      fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
      {$ifndef UseFile}classes,{$endif}
@@ -40,6 +40,8 @@ begin
       Reader := TFPReaderBMP.Create
     else if T = 'J' then
       Reader := TFPReaderJPEG.Create
+    else if T = 'G' then
+      Reader := TFPReaderGif.Create
     else if T = 'P' then
       Reader := TFPReaderPNG.Create
     else if T = 'T' then
@@ -154,7 +156,7 @@ begin
     begin
     writeln ('Give filename to read and to write, preceded by filetype:');
     writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
-    writeln ('N for PNM (read only), F for TIFF');
+    writeln ('N for PNM (read only), F for TIFF, G for gif (read only)');
     writeln ('example: imgconv X hello.xpm P hello.png');
     writeln ('example: imgconv hello.xpm P hello.png');
     writeln ('Options for');

packages/fcl-image/src/ellipses.pp

@@ -337,7 +337,7 @@ end;
 procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
 procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
@@ -508,7 +508,7 @@ begin
       for r := 0 to info.infolist.count-1 do
         with PEllipseInfoData (info.infolist[r])^ do
           for y := ytopmin to ybotmax do
-            colors[x,y] := c;
+            DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -530,7 +530,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         for y := ytopmin to ybotmax do
           if (y mod width) = 0 then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -548,7 +548,7 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -569,7 +569,7 @@ begin
         w := width - 1 - (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -591,7 +591,7 @@ begin
         w := (x mod width);
         for y := ytopmin to ybotmax do
           if (y mod width) = w then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
         end;
   finally
     info.Free;
@@ -616,7 +616,7 @@ begin
           begin
           wy := y mod width;
           if (wy = w1) or (wy = w2) then
-            canv.colors[x,y] := c;
+            canv.DrawPixel(x,y,c);
           end;
         end;
   finally
@@ -636,11 +636,11 @@ begin
       with PEllipseInfoData (info.infolist[r])^ do
         if (x mod width) = 0 then
           for y := ytopmin to ybotmax do
-            canv.colors[x,y] := c
+            canv.DrawPixel(x,y,c)
         else
           for y := ytopmin to ybotmax do
             if (y mod width) = 0 then
-              canv.colors[x,y] := c;
+              canv.DrawPixel(x,y,c);
   finally
     info.Free;
   end;
@@ -660,7 +660,7 @@ begin
         begin
         w := (x mod image.width);
         for y := ytopmin to ybotmax do
-          canv.colors[x,y] := Image.colors[w, (y mod image.height)];
+          canv.DrawPixel(x,y,Image.colors[w, (y mod image.height)]);
         end;
   finally
     info.Free;
@@ -692,7 +692,7 @@ begin
           yi := (y - yo) mod image.height;
           if yi < 0 then
             inc (yi, image.height);
-          canv.colors[x,y] := Image.colors[xi, yi];
+          canv.DrawPixel(x,y,Image.colors[xi, yi]);
           end;
         end;
   finally

packages/fcl-image/src/fpcanvas.inc

@@ -571,6 +571,16 @@ begin
     end;
 end;
 
+procedure TFPCustomCanvas.DrawPixel(const x, y: integer;
+  const newcolor: TFPColor);
+begin
+  case FDrawingMode of
+    dmOpaque: Colors[x,y] := newcolor;
+    dmAlphaBlend: Colors[x,y] := AlphaBlend(Colors[x,y], newcolor);
+    dmCustom: Colors[x,y] := FOnCombineColors(Colors[x,y], newcolor);
+  end;
+end;
+
 procedure TFPCustomCanvas.Erase;
 var
   x,y:Integer;
@@ -784,7 +794,7 @@ begin
     begin
     xx := r - x;
     for t := yi to ym do
-      colors [r,t] := AlphaBlend(colors [r,t], image.colors[xx,t-y]);
+      DrawPixel(r,t, image.colors[xx,t-y]);
     end;
 end;
 

packages/fcl-image/src/fpcanvas.pp

@@ -233,6 +233,9 @@ type
     function IsPointInRegion(AX, AY: Integer): Boolean; override;
   end;
 
+  TFPDrawingMode = (dmOpaque, dmAlphaBlend, dmCustom);
+  TFPCanvasCombineColors = function(const color1, color2: TFPColor): TFPColor of object;
+
   { TFPCustomCanvas }
 
   TFPCustomCanvas = class(TPersistent)
@@ -243,6 +246,8 @@ type
     FHelpers : TList;
     FLocks : integer;
     FInterpolation : TFPCustomInterpolation;
+    FDrawingMode : TFPDrawingMode;
+    FOnCombineColors : TFPCanvasCombineColors;
     function AllowFont (AFont : TFPCustomFont) : boolean;
     function AllowBrush (ABrush : TFPCustomBrush) : boolean;
     function AllowPen (APen : TFPCustomPen) : boolean;
@@ -370,6 +375,7 @@ type
     procedure Draw (x,y:integer; image:TFPCustomImage);
     procedure StretchDraw (x,y,w,h:integer; source:TFPCustomImage);
     procedure Erase;virtual;
+    procedure DrawPixel(const x, y: integer; const newcolor: TFPColor);
     // properties
     property LockCount: Integer read FLocks;
     property Font : TFPCustomFont read GetFont write SetFont;
@@ -384,6 +390,8 @@ type
     property Height : integer read GetHeight write SetHeight;
     property Width : integer read GetWidth write SetWidth;
     property ManageResources: boolean read FManageResources write FManageResources;
+    property DrawingMode : TFPDrawingMode read FDrawingMode write FDrawingMode;
+    property OnCombineColors : TFPCanvasCombineColors read FOnCombineColors write FOnCombineColors;
   end;
 
   TFPCustomDrawFont = class (TFPCustomFont)

packages/fcl-image/src/fpinterpolation.inc

@@ -17,7 +17,7 @@ begin
 
   for dx := 0 to w-1 do
     for dy := 0 to h-1 do
-      Canvas.Colors[x+dx,y+dy] := Image.Colors[dx*iw div w, dy*ih div h];
+      Canvas.DrawPixel(x+dx,y+dy, Image.Colors[dx*iw div w, dy*ih div h]);
 end;
 
 { TFPBaseInterpolation }
@@ -223,7 +223,7 @@ begin
           NewCol.blue:=Min(NewCol.blue+round(Col.blue*f),$ffff);
           NewCol.alpha:=Min(NewCol.alpha+round(Col.alpha*f),$ffff);
         end;
-        Canvas.Colors[x+dx,y+dy]:=AlphaBlend(Canvas.Colors[x+dx,y+dy], NewCol);
+        Canvas.DrawPixel(x+dx,y+dy, NewCol);
       end;
     end;
   finally

packages/fcl-image/src/fpreadgif.pas

@@ -303,8 +303,8 @@ begin
       end;
     until (B = 0)  or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then 
-      Exit(False);
+   { if Stream.Position>=Stream.Size then 
+      Exit(False); }
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
              False, Rect(0,0,0,0), '', ContProgress);
@@ -323,8 +323,8 @@ begin
       end;
     until (B = 0) or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then
-       Exit(False);
+   { if Stream.Position>=Stream.Size then
+       Exit(False); }
               
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),

packages/fcl-image/src/ftfont.pp

@@ -353,8 +353,16 @@ procedure TFreeTypeFont.DrawChar (x,y:integer; data:PByteArray; pitch, width, he
   var
     pixelcolor: TFPColor;
   begin
-    pixelcolor := AlphaBlend(canv.colors[x,y], FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1));
-    canv.colors[x,y] := pixelcolor;
+    case canv.DrawingMode of
+      dmOpaque:
+      begin
+        pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, (t+1) shl 8 - 1); // opaque: ignore c.Alpha
+        canv.colors[x,y] := AlphaBlend(canv.colors[x,y], pixelcolor);
+      end;
+    else
+      pixelcolor := FPImage.FPColor(c.red, c.green,c.blue, ((t+1) shl 8 - 1) * c.Alpha div $ffff); // apply c.Alpha
+      canv.DrawPixel(x,y,pixelcolor);
+    end;
   end;
 
 var b,rx,ry : integer;
@@ -380,7 +388,7 @@ begin
       begin
       rb := rx mod 8;
       if (data^[b+l] and bits[rb]) <> 0 then
-        canvas.colors[x+rx,y+ry] := FPColor;
+        canvas.DrawPixel(x+rx,y+ry, FPColor);
       if rb = 7 then
         inc (l);
       end;

packages/fcl-image/src/pixtools.pp

@@ -75,7 +75,7 @@ begin
     begin
     for x := x1 to x2 do
       for y := y1 to y2 do
-        colors[x,y] := color;
+        DrawPixel(x,y,color);
     end;
 end;
 
@@ -104,7 +104,7 @@ type
 procedure PutPixelCopy(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
 begin
   with Canv do
-    Colors[x,y] := color;
+    DrawPixel(x,y,color);
 end;
 
 procedure PutPixelXor(Canv:TFPCustomCanvas; x,y:integer; color:TFPColor);
@@ -557,7 +557,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[x mod width, y mod height];
+        Canv.DrawPixel(x,y, colors[x mod width, y mod height]);
 end;
 
 procedure FillRectangleImageRel (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const Image:TFPCustomImage);
@@ -566,7 +566,7 @@ begin
   with image do
     for x := x1 to x2 do
       for y := y1 to y2 do
-        Canv.colors[x,y] := colors[(x-x1) mod width, (y-y1) mod height];
+        Canv.DrawPixel(x,y, colors[(x-x1) mod width, (y-y1) mod height]);
 end;
 
 type
@@ -890,7 +890,7 @@ end;
 
 procedure SetFloodColor (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
 begin
-  Canv.colors[x,y] := PFPColor(data)^;
+  Canv.DrawPixel(x,y, PFPColor(data)^);
 end;
 
 procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
@@ -967,7 +967,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (y mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashVer(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -975,7 +975,7 @@ var r : PFloodHashRec;
 begin
   r := PFloodHashRec(data);
   if (x mod r^.width) = 0 then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -985,7 +985,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) + (y mod w)) = (w - 1) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashBDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -995,7 +995,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if (x mod w) = (y mod w) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1005,7 +1005,7 @@ begin
   r := PFloodHashRec(data);
   w := r^.width;
   if ((x mod w) = 0) or ((y mod w) = 0) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure SetFloodHashDiagCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
@@ -1016,7 +1016,7 @@ begin
   w := r^.width;
   if ( (x mod w) = (y mod w) ) or
      ( ((x mod w) + (y mod w)) = (w - 1) ) then
-    Canv.colors[x,y] := r^.color;
+    Canv.DrawPixel(x,y,r^.color);
 end;
 
 procedure FillFloodHash (Canv:TFPCustomCanvas; x,y:integer; width:integer; SetHashColor:TFuncSetColor; const c:TFPColor);
@@ -1109,7 +1109,7 @@ var r : PFloodImageRec;
 begin
   r := PFloodImageRec(data);
   with r^.image do
-    Canv.colors[x,y] := colors[x mod width, y mod height];
+    Canv.DrawPixel(x,y,colors[x mod width, y mod height]);
 end;
 
 procedure FillFloodImage (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
@@ -1142,7 +1142,7 @@ begin
     yi := (y - yo) mod height;
     if yi < 0 then
       yi := height - yi;
-    Canv.colors[x,y] := colors[xi,yi];
+    Canv.DrawPixel(x,y,colors[xi,yi]);
     end;
 end;
 

packages/fcl-js/src/jsbase.pp

@@ -23,11 +23,11 @@ uses
   {$ifdef pas2js}
   js,
   {$endif}
-  Classes, SysUtils;
+  Classes;
 
 const
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 

packages/fcl-js/src/jstree.pp

@@ -439,6 +439,13 @@ Type
     Class function PostFixOperatorToken : tjsToken; override;
   end;
 
+  { TJSUnaryBracketsExpression - e.g. '(A)' }
+
+  TJSUnaryBracketsExpression = Class(TJSUnaryExpression)
+  Public
+    Class function PrefixOperatorToken : tjsToken; override;
+    Class function PostFixOperatorToken : tjsToken; override;
+  end;
 
   { TJSBinary - base class }
 
@@ -1432,6 +1439,18 @@ begin
   Result:=tjsThrow;
 end;
 
+{ TJSUnaryBracketsExpression }
+
+class function TJSUnaryBracketsExpression.PrefixOperatorToken: tjsToken;
+begin
+  Result:=tjsBraceOpen;
+end;
+
+class function TJSUnaryBracketsExpression.PostFixOperatorToken: tjsToken;
+begin
+  Result:=tjsBraceClose;
+end;
+
 { TJSUnaryPostMinusMinusExpression }
 
 Class function TJSUnaryPostMinusMinusExpression.PostFixOperatorToken : tjsToken;

packages/fcl-js/src/jswriter.pp

@@ -240,7 +240,9 @@ Type
     Property Options : TWriteOptions Read FOptions Write SetOptions;
     Property IndentSize : Byte Read FIndentSize Write FIndentSize;
     Property UseUTF8 : Boolean Read GetUseUTF8;
-    property LastChar: WideChar read FLastChar;
+    Property LastChar: WideChar read FLastChar;
+    Property SkipCurlyBrackets : Boolean read FSkipCurlyBrackets write FSkipCurlyBrackets;
+    Property SkipRoundBrackets : Boolean read FSkipRoundBrackets write FSkipRoundBrackets;
   end;
   EJSWriter = Class(Exception);
 
@@ -801,6 +803,15 @@ begin
             if (Code=0) and (D=AsNumber) then
               S:=S2;
             end;
+          else
+            if s[i-1]='0' then
+              begin
+              // 1.2340E...
+              S2:=LeftStr(S,i-2)+copy(S,i,length(S));
+              val(S2,D,Code);
+              if (Code=0) and (D=AsNumber) then
+                S:=S2;
+              end;
           end;
           end;
         // chomp default exponent E+000
@@ -944,10 +955,14 @@ begin
         and (not (A is TJSSourceElements))
         and (not (A is TJSEmptyBlockStatement))
     then
+      begin
+      if FLastChar<>';' then
+        Write(';');
       if C then
-        Write('; ')
+        Write(' ')
       else
-        Writeln(';');
+        Writeln('');
+      end;
     end;
   Writer.CurElement:=LastEl;
   if C then
@@ -1197,17 +1212,15 @@ begin
     Write(S);
     end;
   WriteJS(El.A);
-  if (S='') then
+  S:=El.PostFixOperator;
+  if (S<>'') then
     begin
-    S:=El.PostFixOperator;
-    if (S<>'') then
-      begin
-      Writer.CurElement:=El;
-      if ((S='-') and (FLastChar='-'))
-          or ((S='+') and (FLastChar='+')) then
-        Write(' ');
-      Write(S);
-      end;
+    Writer.CurElement:=El;
+    case S[1] of
+    '+': if FLastChar='+' then Write(' ');
+    '-': if FLastChar='-' then Write(' ');
+    end;
+    Write(S);
     end;
 end;
 
@@ -1240,10 +1253,12 @@ begin
       begin
       if not (LastEl is TJSStatementList) then
         begin
+        if FLastChar<>';' then
+          Write(';');
         if C then
-          Write('; ')
+          Write(' ')
         else
-          Writeln(';');
+          Writeln('');
         end;
       FSkipCurlyBrackets:=True;
       WriteJS(El.B);
@@ -1252,11 +1267,14 @@ begin
     if (not C) and not (LastEl is TJSStatementList) then
       writeln(';');
     end
-  else if Assigned(El.B) then
+  else if Assigned(El.B) and not IsEmptyStatement(El.B) then
     begin
     WriteJS(El.B);
     if (not C) and not (El.B is TJSStatementList) then
-      writeln(';');
+      if FLastChar=';' then
+        writeln('')
+      else
+        writeln(';');
     end;
   if B then
     begin

packages/fcl-json/src/fpjsonrtti.pp

@@ -777,7 +777,7 @@ begin
     else If AObject is TObjectList then
       Result.Add('Objects',StreamObjectList(TObjectList(AObject)))
     else if (jsoStreamTlist in Options) and (AObject is TList) then
-      Result := TJSONObject(StreamTList(TList(AObject)))
+      Result.Add('Objects', StreamTList(TList(AObject)))
     else
       begin
       PIL:=TPropInfoList.Create(AObject,tkProperties);

packages/fcl-passrc/src/pasresolveeval.pas

@@ -177,10 +177,13 @@ const
   nIllegalAssignmentToForLoopVar = 3111;
   nFunctionHidesIdentifier_NonProc = 3112;
   nTypeXCannotBeExtendedByATypeHelper = 3113;
-  nDerivedXMustExtendASubClassY = 3114;
-  nDefaultPropertyNotAllowedInHelperForX = 3115;
-  nHelpersCannotBeUsedAsTypes = 3116;
-  nBitWiseOperationsAre32Bit = 3117;
+  nTypeXCannotBeExtendedByARecordHelper = 3114;
+  nDerivedXMustExtendASubClassY = 3115;
+  nDefaultPropertyNotAllowedInHelperForX = 3116;
+  nHelpersCannotBeUsedAsTypes = 3117;
+  nBitWiseOperationsAre32Bit = 3118;
+  nImplictConversionUnicodeToAnsi = 3119;
+  nWrongTypeXInArrayConstructor = 3120;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -305,10 +308,13 @@ resourcestring
   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
   sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
+  sTypeXCannotBeExtendedByARecordHelper = 'Type "%s" cannot be extended by a record helper';
   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
   sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
   sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
+  sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
+  sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -355,9 +361,9 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
-  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
-  MaskUIntDouble = $fffffffffffff;
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
+  MaskUIntDouble = $1fffffffffffff;
 
 type
   { TResEvalValue }
@@ -721,6 +727,7 @@ type
     {$ifdef FPC_HAS_CPSTRING}
     function CheckValidUTF8(const s: RawByteString; ErrorEl: TPasElement): boolean;
     function GetCodePage(const s: RawByteString): TSystemCodePage;
+    function GetRawByteString(const s: UnicodeString; CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
     function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
     function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
     function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
@@ -3580,13 +3587,13 @@ begin
           Result.ElKind:=revskChar
         else if Result.ElKind<>revskChar then
           RaiseNotYetImplemented(20170713201456,El);
-        if StringToOrd(Value,nil)>$ffff then
+        RangeStart:=StringToOrd(Value,nil);
+        if RangeStart>$ffff then
           begin
           // set of string (not of char)
           ReleaseEvalValue(TResEvalValue(Result));
           exit;
           end;
-        RangeStart:=ord(TResEvalString(Value).S[1]);
         RangeEnd:=RangeStart;
         end;
       {$endif}
@@ -4007,6 +4014,7 @@ function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
   {$else}
   begin
     TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
+    if ForceUTF16 then ;
   end;
   {$endif}
 
@@ -4850,6 +4858,10 @@ begin
       RaiseNotYetImplemented(20170601141811,Expr);
     end;
   else
+    {$ifndef FPC_HAS_CPSTRING}
+    if LeftExpr=nil then ; // no Parameter "LeftExpr" not used
+    if RightExpr=nil then ; // no Parameter "RightExpr" not used
+    {$endif}
     RaiseNotYetImplemented(20181219233139,Expr);
   end;
 end;
@@ -4957,6 +4969,33 @@ begin
     end;
 end;
 
+function TResExprEvaluator.GetRawByteString(const s: UnicodeString;
+  CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
+var
+  ok: Boolean;
+begin
+  Result:=UTF8Encode(s);
+  if (CodePage=CP_UTF8)
+      or ((DefaultSystemCodePage=CP_UTF8) and ((CodePage=CP_ACP) or (CodePage=CP_NONE))) then
+    begin
+    // to UTF-8
+    SetCodePage(Result,CodePage,false);
+    end
+  else
+    begin
+    // to non UTF-8 -> possible loss
+    ok:=false;
+    try
+      SetCodePage(Result,CodePage,true);
+      ok:=true;
+    except
+    end;
+    if (not ok) or (GetUnicodeStr(Result,ErrorEl)<>s) then
+      LogMsg(20190204165110,mtWarning,nImplictConversionUnicodeToAnsi,
+        sImplictConversionUnicodeToAnsi,[],ErrorEl);
+    end;
+end;
+
 function TResExprEvaluator.GetUTF8Str(const s: RawByteString;
   ErrorEl: TPasElement): String;
 var

packages/fcl-passrc/src/pastree.pp

@@ -197,7 +197,7 @@ type
      pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
   TExprOpCode = (eopNone,
-                 eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
+                 eopAdd,eopSubtract,eopMultiply,eopDivide{/}, eopDiv{div},eopMod, eopPower,// arithmetic
                  eopShr,eopShl, // bit operations
                  eopNot,eopAnd,eopOr,eopXor, // logical/bit
                  eopEqual, eopNotEqual,  // Logical

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -218,12 +218,16 @@ const
     );
 
 type
+  TPAOtherCheckedEl = (
+    pocClassConstructor
+    );
 
   { TPasAnalyzer }
 
   TPasAnalyzer = class
   private
-    FChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
+    FModeChecked: array[TPAUseMode] of TPasAnalyzerKeySet; // tree of TElement
+    FOtherChecked: array[TPAOtherCheckedEl] of TPasAnalyzerKeySet; // tree of TElement
     FOnMessage: TPAMessageEvent;
     FOptions: TPasAnalyzerOptions;
     FOverrideLists: TPasAnalyzerKeySet; // tree of TPAOverrideList sorted for Element
@@ -245,12 +249,13 @@ type
     function PAElementExists(El: TPasElement): boolean; inline;
     procedure CreateTree; virtual;
     function MarkElementAsUsed(El: TPasElement; aClass: TPAElementClass = nil): boolean; // true if new
-    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean;
+    function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean; overload;
+    function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
-    procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual;
+    function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
     procedure UseImplElement(El: TPasImplElement); virtual;
@@ -260,9 +265,10 @@ type
     procedure UseInheritedExpr(El: TInheritedExpr); virtual;
     procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
-    procedure UseProcedureType(ProcType: TPasProcedureType; Mark: boolean); virtual;
+    procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
     procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
+    procedure UseClassConstructor(El: TPasMembersType); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
@@ -952,9 +958,19 @@ function TPasAnalyzer.ElementVisited(El: TPasElement; Mode: TPAUseMode
 begin
   if El=nil then
     exit(true);
-  if FChecked[Mode].ContainsItem(El) then exit(true);
+  if FModeChecked[Mode].ContainsItem(El) then exit(true);
+  Result:=false;
+  FModeChecked[Mode].Add(El,false);
+end;
+
+function TPasAnalyzer.ElementVisited(El: TPasElement;
+  OtherCheck: TPAOtherCheckedEl): boolean;
+begin
+  if El=nil then
+    exit(true);
+  if FOtherChecked[OtherCheck].ContainsItem(El) then exit(true);
   Result:=false;
-  FChecked[Mode].Add(El,false);
+  FOtherChecked[OtherCheck].Add(El,false);
 end;
 
 procedure TPasAnalyzer.MarkImplScopeRef(El, RefEl: TPasElement;
@@ -1010,19 +1026,20 @@ begin
   else if C.InheritsFrom(TPasExpr) then
     UseExpr(TPasExpr(El))
   else if C=TPasEnumValue then
-    begin
-    UseExpr(TPasEnumValue(El).Value);
-    repeat
-      MarkElementAsUsed(El);
-      El:=El.Parent;
-    until not (El is TPasType);
-    end
+    UseExpr(TPasEnumValue(El).Value)
   else if C=TPasMethodResolution then
     // nothing to do
   else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then
     // e.g. unitname.identifier -> the module is used by the identifier
   else
     RaiseNotSupported(20170307090947,El);
+  repeat
+    El:=El.Parent;
+    if not (El is TPasType) then break;
+    MarkElementAsUsed(El);
+    if El is TPasMembersType then
+      UseClassConstructor(TPasMembersType(El));
+  until false;
 end;
 
 procedure TPasAnalyzer.UseTypeInfo(El: TPasElement);
@@ -1136,7 +1153,7 @@ begin
   UseElement(El,rraNone,true);
 end;
 
-procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
+function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
 
   procedure UseInitFinal(ImplBlock: TPasImplBlock);
   var
@@ -1155,7 +1172,8 @@ procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
 var
   ModScope: TPasModuleScope;
 begin
-  if ElementVisited(aModule,Mode) then exit;
+  if ElementVisited(aModule,Mode) then exit(false);
+  Result:=true;
 
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseModule ',GetElModName(aModule),' Mode=',Mode{$IFDEF pas2js},' ',aModule.PasElementId{$ENDIF});
@@ -1180,6 +1198,10 @@ begin
     UseClassOrRecType(ModScope.RangeErrorClass,paumElement);
   if ModScope.RangeErrorConstructor<>nil then
     UseProcedure(ModScope.RangeErrorConstructor);
+  // no need to use here ModScope.AssertClass, it is used by Assert
+  // no need to use here ModScope.AssertMsgConstructor
+  // no need to use here ModScope.AssertDefConstructor
+  // no need to use here ModScope.SystemTVarRec
 
   if Mode=paumElement then
     // e.g. a reference: unitname.identifier
@@ -1540,7 +1562,6 @@ begin
   UseExpr(El.format2);
   C:=El.ClassType;
   if (C=TPrimitiveExpr)
-      or (C=TSelfExpr)
       or (C=TBoolConstExpr)
       or (C=TNilExpr) then
     // ok
@@ -1614,7 +1635,7 @@ begin
       RaiseNotSupported(20170403173817,Params);
     end;
     end
-  else if (C=TSelfExpr) or ((C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent)) then
+  else if (C=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
     begin
     if (Expr.CustomData is TResolvedReference) then
       begin
@@ -1729,7 +1750,7 @@ begin
   {$ENDIF}
   UseScopeReferences(ProcScope.References);
 
-  UseProcedureType(Proc.ProcType,false);
+  UseProcedureType(Proc.ProcType);
 
   ImplProc:=Proc;
   if ProcScope.ImplProc<>nil then
@@ -1778,8 +1799,7 @@ begin
     end;
 end;
 
-procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType;
-  Mark: boolean);
+procedure TPasAnalyzer.UseProcedureType(ProcType: TPasProcedureType);
 var
   i: Integer;
   Arg: TPasArgument;
@@ -1787,7 +1807,7 @@ begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   {$ENDIF}
-  if Mark and not MarkElementAsUsed(ProcType) then exit;
+  if not MarkElementAsUsed(ProcType) then exit;
 
   for i:=0 to ProcType.Args.Count-1 do
     begin
@@ -1869,7 +1889,7 @@ begin
       UseElType(El,TPasSetType(El).EnumType,Mode);
       end
     else if C.InheritsFrom(TPasProcedureType) then
-      UseProcedureType(TPasProcedureType(El),true)
+      UseProcedureType(TPasProcedureType(El))
     else
       RaiseNotSupported(20170306170315,El);
 
@@ -1939,7 +1959,7 @@ var
   List, ProcList: TFPList;
   o: TObject;
   Map: TPasClassIntfMap;
-  ImplProc, IntfProc: TPasProcedure;
+  ImplProc, IntfProc, Proc: TPasProcedure;
   aClass: TPasClassType;
 begin
   FirstTime:=true;
@@ -1967,7 +1987,7 @@ begin
   ClassScope:=nil;
   IsCOMInterfaceRoot:=false;
 
-  if El is TPasClassType then
+  if El.ClassType=TPasClassType then
     begin
     aClass:=TPasClassType(El);
     if aClass.IsForward then
@@ -2019,37 +2039,44 @@ begin
     Member:=TPasElement(El.Members[i]);
     if FirstTime and (Member is TPasProcedure) then
       begin
+      Proc:=TPasProcedure(Member);
       ProcScope:=Member.CustomData as TPasProcedureScope;
-      if TPasProcedure(Member).IsOverride and (ProcScope.OverriddenProc<>nil) then
+      if Proc.IsOverride and (ProcScope.OverriddenProc<>nil) then
         begin
         // this is an override
         AddOverride(ProcScope.OverriddenProc,Member);
         if ScopeModule<>nil then
           begin
           // when analyzing a single module, all overrides are assumed to be called
-          UseProcedure(TPasProcedure(Member));
+          UseProcedure(Proc);
           continue;
           end;
+        end
+      else if (Proc.ClassType=TPasClassConstructor)
+          or (Proc.ClassType=TPasClassDestructor) then
+        begin
+        UseProcedure(Proc);
+        continue;
         end;
       if IsCOMInterfaceRoot then
         begin
         case lowercase(Member.Name) of
         'queryinterface':
-          if (TPasProcedure(Member).ProcType.Args.Count=2) then
+          if (Proc.ProcType.Args.Count=2) then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         '_addref':
-          if TPasProcedure(Member).ProcType.Args.Count=0 then
+          if Proc.ProcType.Args.Count=0 then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         '_release':
-          if TPasProcedure(Member).ProcType.Args.Count=0 then
+          if Proc.ProcType.Args.Count=0 then
             begin
-            UseProcedure(TPasProcedure(Member));
+            UseProcedure(Proc);
             continue;
             end;
         end;
@@ -2116,6 +2143,20 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseClassConstructor(El: TPasMembersType);
+var
+  i: Integer;
+  Member: TPasElement;
+begin
+  if ElementVisited(El,pocClassConstructor) then exit;
+  for i:=0 to El.Members.Count-1 do
+    begin
+    Member:=TPasElement(El.Members[i]);
+    if (Member.ClassType=TPasClassConstructor) or (Member.ClassType=TPasClassDestructor) then
+      UseProcedure(TPasProcedure(Member));
+    end;
+end;
+
 procedure TPasAnalyzer.UseVariable(El: TPasVariable;
   Access: TResolvedRefAccess; UseFull: boolean);
 var
@@ -2609,10 +2650,20 @@ end;
 constructor TPasAnalyzer.Create;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   CreateTree;
   for m in TPAUseMode do
-    FChecked[m]:=TPasAnalyzerKeySet.Create(
+    FModeChecked[m]:=TPasAnalyzerKeySet.Create(
+      {$ifdef pas2js}
+      @PasElementToHashName
+      {$else}
+      @ComparePointer
+      {$endif}
+      ,nil
+      );
+  for oc in TPAOtherCheckedEl do
+    FOtherChecked[oc]:=TPasAnalyzerKeySet.Create(
       {$ifdef pas2js}
       @PasElementToHashName
       {$else}
@@ -2631,23 +2682,29 @@ end;
 destructor TPasAnalyzer.Destroy;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   Clear;
   FreeAndNil(FOverrideLists);
   FreeAndNil(FUsedElements);
   for m in TPAUseMode do
-    FreeAndNil(FChecked[m]);
+    FreeAndNil(FModeChecked[m]);
+  for oc in TPAOtherCheckedEl do
+    FreeAndNil(FOtherChecked[oc]);
   inherited Destroy;
 end;
 
 procedure TPasAnalyzer.Clear;
 var
   m: TPAUseMode;
+  oc: TPAOtherCheckedEl;
 begin
   FOverrideLists.FreeItems;
   FUsedElements.FreeItems;
   for m in TPAUseMode do
-    FChecked[m].Clear;
+    FModeChecked[m].Clear;
+  for oc in TPAOtherCheckedEl do
+    FOtherChecked[oc].Clear;
 end;
 
 procedure TPasAnalyzer.AnalyzeModule(aModule: TPasModule);
@@ -2729,7 +2786,7 @@ end;
 
 function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean;
 begin
-  Result:=FChecked[paumTypeInfo].ContainsItem(El);
+  Result:=FModeChecked[paumTypeInfo].ContainsItem(El);
 end;
 
 function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;

packages/fcl-passrc/src/pparser.pp

@@ -450,7 +450,8 @@ type
     procedure ParseProcBeginBlock(Parent: TProcedureBody);
     procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
-    function  ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
+    function ParseProcedureOrFunctionDecl(Parent: TPasElement;
+      ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
@@ -1892,32 +1893,42 @@ begin
     case CurToken of
       tkSquaredBraceOpen:
         begin
-          repeat
-            NextToken;
-            if po_arrayrangeexpr in Options then
-              begin
-              RangeExpr:=DoParseExpression(Result);
-              Result.AddRange(RangeExpr);
-              end
-            else if CurToken<>tkSquaredBraceClose then
-               S:=S+CurTokenText;
-            if CurToken=tkSquaredBraceClose then
-              break
-            else if CurToken=tkComma then
-              continue
-            else if po_arrayrangeexpr in Options then
-              ParseExcTokenError(']');
-          until false;
-          Result.IndexRange:=S;
-          ExpectToken(tkOf);
-          Result.ElType := ParseType(Result,CurSourcePos);
+        // static array
+        if Parent is TPasArgument then
+          ParseExcTokenError('of');
+        repeat
+          NextToken;
+          if po_arrayrangeexpr in Options then
+            begin
+            RangeExpr:=DoParseExpression(Result);
+            Result.AddRange(RangeExpr);
+            end
+          else if CurToken<>tkSquaredBraceClose then
+             S:=S+CurTokenText;
+          if CurToken=tkSquaredBraceClose then
+            break
+          else if CurToken=tkComma then
+            continue
+          else if po_arrayrangeexpr in Options then
+            ParseExcTokenError(']');
+        until false;
+        Result.IndexRange:=S;
+        ExpectToken(tkOf);
+        Result.ElType := ParseType(Result,CurSourcePos);
         end;
       tkOf:
         begin
         NextToken;
         if CurToken = tkConst then
+          // array of const
+          begin
+          if not (Parent is TPasArgument) then
+            ParseExcExpectedIdentifier;
+          end
         else
           begin
+          if (CurToken=tkarray) and (Parent is TPasArgument) then
+            ParseExcExpectedIdentifier;
           UngetToken;
           Result.ElType := ParseType(Result,CurSourcePos);
           end;
@@ -2250,7 +2261,11 @@ begin
       end;
     tkfalse, tktrue:    Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
     tknil:              Last:=CreateNilExpr(AParent);
-    tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
+    tkSquaredBraceOpen:
+      begin
+      Last:=ParseParams(AParent,pekSet);
+      UngetToken;
+      end;
     tkinherited:
       begin
       //inherited; inherited function
@@ -2286,7 +2301,7 @@ begin
         ProcType:=ptAnonymousFunction;
       try
         ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
-        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType));
+        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType,false));
         Result:=ProcExpr;
       finally
         if Result=nil then
@@ -2306,6 +2321,18 @@ begin
         end;
       Last:=CreatePrimitiveExpr(AParent,pekString, '^'+CurTokenText);
       end;
+    tkBraceOpen:
+      begin
+      NextToken;
+      Last:=DoParseExpression(AParent);
+      if not Assigned(Last) then
+        ParseExcSyntaxError;
+      if (CurToken<>tkBraceClose) then
+        begin
+        Last.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+        CheckToken(tkBraceClose);
+        end;
+      end
   else
     ParseExcExpectedIdentifier;
   end;
@@ -2314,13 +2341,7 @@ begin
   ok:=false;
   ISE:=nil;
   try
-    if Last.Kind<>pekSet then NextToken;
-    if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
-      begin
-      ok:=true;
-      exit;
-      end;
-
+    NextToken;
     Func:=Last;
     repeat
       case CurToken of
@@ -2509,8 +2530,6 @@ const
 Var
   AllowedBinaryOps : Set of TToken;
   SrcPos: TPasSourcePos;
-  ArrParams: TParamsExpr;
-
 begin
   AllowedBinaryOps:=BinaryOP;
   if Not AllowEqual then
@@ -2536,62 +2555,12 @@ begin
           inc(PrefixCnt);
           NextToken;
           end;
-
-        if (CurToken = tkBraceOpen) then
-          begin
-          NextToken;
-          x:=DoParseExpression(AParent);
-          if not Assigned(x) then
-            ParseExcSyntaxError;
-          if (CurToken<>tkBraceClose) then
-            begin
-            x.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-            CheckToken(tkBraceClose);
-            end;
-          NextToken;
-          repeat
-            case CurToken of
-            tkCaret:
-              begin
-              // for expressions like (ppdouble)^^;
-              x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
-              NextToken;
-              end;
-            tkBraceOpen:
-              begin
-              // for expressions like (a+b)(0);
-              ArrParams:=ParseParams(AParent,pekFuncParams,False);
-              ArrParams.Value:=x;
-              x.Parent:=ArrParams;
-              x:=ArrParams;
-              end;
-            tkSquaredBraceOpen:
-              begin
-              // for expressions like (PChar(a)+10)[0];
-              ArrParams:=ParseParams(AParent,pekArrayParams,False);
-              ArrParams.Value:=x;
-              x.Parent:=ArrParams;
-              x:=ArrParams;
-              end;
-            tkDot:
-              begin
-              // for expressions like (TObject(m)).Free;
-              NextToken;
-              x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
-              end
-            else
-              break;
-            end;
-          until false;
-          end
-        else
-          begin
-          x:=ParseExprOperand(AParent);
-          if not Assigned(x) then
-            ParseExcSyntaxError;
-          end;
+        // parse operand
+        x:=ParseExprOperand(AParent);
+        if not Assigned(x) then
+          ParseExcSyntaxError;
         ExpStack.Add(x);
-
+        // apply prefixes
         for i:=1 to PrefixCnt do
           begin
           TempOp:=PopOper(SrcPos);
@@ -3445,7 +3414,7 @@ begin
       SetBlock(declNone);
       SaveComments;
       pt:=GetProcTypeFromToken(CurToken);
-      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt));
+      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, false));
       end;
     tkClass:
       begin
@@ -3455,7 +3424,7 @@ begin
         If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
           begin
           pt:=GetProcTypeFromToken(CurToken,True);
-          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt));
+          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, false));
           end
         else
           CheckToken(tkprocedure);
@@ -3565,9 +3534,8 @@ begin
         end;
       end;
     tkGeneric:
-      begin
-        if CurBlock <> declType then
-          ParseExcSyntaxError;
+      if CurBlock = declType then
+        begin
         TypeName := ExpectIdentifier;
         NamePos:=CurSourcePos;
         List:=TFPList.Create;
@@ -3625,7 +3593,41 @@ begin
             TPasElement(List[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
           List.Free;
         end;
-      end;
+        end
+      else if CurBlock = declNone then
+        begin
+        if msDelphi in CurrentModeswitches then
+          ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
+        SetBlock(declNone);
+        SaveComments;
+        NextToken;
+        case CurToken of
+        tkclass:
+          begin
+          // generic class ...
+          NextToken;
+          if not (CurToken in [tkprocedure,tkfunction]) then
+            ParseExcSyntaxError;
+          // generic class procedure ...
+          pt:=GetProcTypeFromToken(CurToken,true);
+          AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, true));
+          end;
+        tkprocedure,tkfunction:
+          begin
+          // generic procedure ...
+          SetBlock(declNone);
+          SaveComments;
+          pt:=GetProcTypeFromToken(CurToken);
+          AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, true));
+          end;
+        else
+          ParseExcSyntaxError;
+        end;
+        end
+      else
+        begin
+        ParseExcSyntaxError;
+        end;
     tkbegin:
       begin
       if Declarations is TProcedureBody then
@@ -4254,17 +4256,8 @@ begin
   if (CurToken=tkAbsolute) then
     begin
     Result:=True;
-    ExpectIdentifier;
-    Location:=CurTokenText;
-    AbsoluteExpr:=CreatePrimitiveExpr(Parent,pekIdent,CurTokenText);
     NextToken;
-    While CurToken=tkDot do
-      begin
-      ExpectIdentifier;
-      Location:=Location+'.'+CurTokenText;
-      AbsoluteExpr:=CreateBinaryExpr(Parent,AbsoluteExpr,CreatePrimitiveExpr(Parent,pekIdent,CurTokenText),eopSubIdent);
-      NextToken;
-      end;
+    Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
     UnGetToken;
     end
   else
@@ -4488,6 +4481,7 @@ procedure TPasParser.OnScannerModeChanged(Sender: TObject;
   NewMode: TModeSwitch; Before: boolean; var Handled: boolean);
 begin
   Engine.ModeChanged(Self,NewMode,Before,Handled);
+  if Sender=nil then ;
 end;
 
 function TPasParser.SaveComments: String;
@@ -5212,20 +5206,9 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
     Param: TPasExpr;
     SrcPos: TPasSourcePos;
   begin
-    ExpectIdentifier;
-    Result := CurTokenString;
-    Expr := CreatePrimitiveExpr(aParent,pekIdent,CurTokenString);
-
-    // read .subident.subident...
-    repeat
-      NextToken;
-      if CurToken <> tkDot then break;
-      SrcPos:=CurTokenPos;
-      ExpectIdentifier;
-      Result := Result + '.' + CurTokenString;
-      AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),
-        eopSubIdent,SrcPos);
-    until false;
+    NextToken;
+    // read ident.subident...
+    Result:=ReadDottedIdentifier(aParent,Expr,true);
 
     // read optional array index
     if CurToken <> tkSquaredBraceOpen then
@@ -6017,7 +6000,10 @@ begin
         end;
       tkEOF:
         CheckToken(tkend);
-      tkAt,tkAtAt,tkBraceOpen,tkIdentifier,tkNumber,tkSquaredBraceOpen,tkMinus,tkPlus,tkinherited:
+      tkAt,tkAtAt,
+      tkIdentifier,tkNumber,tkString,tkfalse,tktrue,tkChar,
+      tkBraceOpen,tkSquaredBraceOpen,
+      tkMinus,tkPlus,tkinherited:
         begin
         // Do not check this here:
         //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
@@ -6160,7 +6146,8 @@ begin
 end;
 
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
-  ProcType: TProcType; AVisibility: TPasMemberVisibility): TPasProcedure;
+  ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility
+  ): TPasProcedure;
 
   function ExpectProcName: string;
 
@@ -6172,13 +6159,15 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
     Result:=ExpectIdentifier;
     //writeln('ExpectProcName ',Parent.Classname);
     if Parent is TImplementationSection then
-    begin
+      begin
       NextToken;
       repeat
         if CurToken=tkDot then
           Result:=Result+'.'+ExpectIdentifier
         else if CurToken=tkLessThan then
           begin // <> can be ignored, we read the list but discard its content
+          if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
+            ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc
           UnGetToken;
           L:=TFPList.Create;
           Try
@@ -6194,7 +6183,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
         NextToken;
       until false;
       UngetToken;
-    end;
+      end;
   end;
 
 var
@@ -6206,6 +6195,8 @@ begin
   case ProcType of
   ptOperator,ptClassOperator:
     begin
+    if MustBeGeneric then
+      ParseExcTokenError('procedure');
     NextToken;
     IsTokenBased:=CurToken<>tkIdentifier;
     if IsTokenBased then
@@ -6217,7 +6208,11 @@ begin
     Name:=OperatorNames[Ot];
     end;
   ptAnonymousProcedure,ptAnonymousFunction:
+    begin
     Name:='';
+    if MustBeGeneric then
+      ParseExcTokenError('generic'); // inconsistency
+    end
   else
     Name:=ExpectProcName;
   end;
@@ -6424,7 +6419,7 @@ begin
         if Not AllowMethods then
           ParseExc(nErrRecordMethodsNotAllowed,SErrRecordMethodsNotAllowed);
         ProcType:=GetProcTypeFromToken(CurToken,isClass);
-        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,v);
+        Proc:=ParseProcedureOrFunctionDecl(ARec,ProcType,false,v);
         if Proc.Parent is TPasOverloadedProc then
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
@@ -6567,7 +6562,7 @@ var
   ProcType: TProcType;
 begin
   ProcType:=GetProcTypeFromToken(CurToken,isClass);
-  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,AVisibility);
+  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,false,AVisibility);
   if Proc.Parent is TPasOverloadedProc then
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
   else
@@ -6729,7 +6724,12 @@ begin
           CurSection:=stNone
         else
           begin
-          if not haveClass then
+          if haveClass then
+            begin
+            if LastToken=tkclass then
+              ParseExcTokenError('procedure or function');
+            end
+          else
             SaveComments;
           Case CurSection of
           stType:

packages/fcl-passrc/src/pscanner.pp

@@ -3400,9 +3400,15 @@ begin
   'OBJFPC':
     SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
   'DELPHI':
+    begin
     SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'DELPHIUNICODE':
+    begin
     SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
+    SetNonToken(tkgeneric);
+    end;
   'TP':
     SetMode(msTP7,TPModeSwitches,false);
   'MACPAS':

packages/fcl-passrc/tests/tcexprparser.pas

@@ -111,6 +111,7 @@ type
     Procedure TestADotBDotC;
     Procedure TestADotBBracketC;
     Procedure TestSelfDotBBracketC;
+    Procedure TestAasBDotCBracketFuncParams;
     Procedure TestRange;
     Procedure TestBracketsTotal;
     Procedure TestBracketsLeft;
@@ -1289,6 +1290,32 @@ begin
   AssertExpression('first param c',p.Params[0],pekIdent,'c');
 end;
 
+procedure TTestExpressions.TestAasBDotCBracketFuncParams;
+var
+  P: TParamsExpr;
+  B, AsExpr: TBinaryExpr;
+begin
+  ParseExpression('(a as b).c(d)');
+  P:=TParamsExpr(AssertExpression('FuncParams',TheExpr,pekFuncParams,TParamsExpr));
+  AssertEquals('length(p.Params)',length(p.Params),1);
+  AssertExpression('first param d',p.Params[0],pekIdent,'d');
+
+  B:=TBinaryExpr(AssertExpression('Upper Binary identifier',P.Value,pekBinary,TBinaryExpr));
+  AssertEquals('dot c expr',eopSubIdent,B.OpCode);
+  TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
+  TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
+
+  AssertExpression('dot c',b.right,pekIdent,'c');
+
+  AsExpr:=TBinaryExpr(AssertExpression('lower binary identifier',B.left,pekBinary,TBinaryExpr));
+  AssertEquals('AS expr',eopAs,AsExpr.OpCode);
+  TAssert.AssertSame('AsExpr.left.parent=AsExpr',AsExpr,AsExpr.left.Parent);
+  TAssert.AssertSame('AsExpr.right.parent=AsExpr',AsExpr,AsExpr.right.Parent);
+
+  AssertExpression('left AS a',AsExpr.left,pekIdent,'a');
+  AssertExpression('right AS b',AsExpr.right,pekIdent,'b');
+end;
+
 initialization
 
   RegisterTest(TTestExpressions);

packages/fcl-passrc/tests/tcgenerics.pp

@@ -219,13 +219,12 @@ end;
 
 procedure TTestGenerics.TestGenericFunction;
 begin
-  exit; // ToDo
   Add([
   'generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;',
   'begin',
   'end;',
   'begin',
-  '  IfThen<word>(true,2,3);',
+  //'  specialize IfThen<word>(true,2,3);',
   '']);
   ParseModule;
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -103,7 +103,8 @@ type
   PTestResolverReferenceData = ^TTestResolverReferenceData;
 
   TSystemUnitPart = (
-    supTObject
+    supTObject,
+    supTVarRec
     );
   TSystemUnitParts = set of TSystemUnitPart;
 
@@ -503,6 +504,8 @@ type
     Procedure TestAdvRecord_ConstructorNoParamsFail;
     Procedure TestAdvRecord_ClassConstructor;
     Procedure TestAdvRecord_ClassConstructorParamsFail;
+    Procedure TestAdvRecord_ClassConstructor_CallFail;
+    Procedure TestAdvRecord_ClassConstructorDuplicateFail;
     Procedure TestAdvRecord_NestedRecordType;
     Procedure TestAdvRecord_NestedArgConstFail;
     Procedure TestAdvRecord_Property;
@@ -585,6 +588,7 @@ type
     Procedure TestClass_FuncReturningObjectMember;
     Procedure TestClass_StaticWithoutClassFail;
     Procedure TestClass_SelfInStaticFail;
+    Procedure TestClass_SelfDotInStaticFail;
     Procedure TestClass_PrivateProtectedInSameUnit;
     Procedure TestClass_PrivateInMainBeginFail;
     Procedure TestClass_PrivateInDescendantFail;
@@ -607,6 +611,7 @@ type
     Procedure TestClass_VarExternal;
     Procedure TestClass_WarnOverrideLowerVisibility;
     Procedure TestClass_Const;
+    Procedure TestClass_ClassMissingVarFail;
     Procedure TestClass_ClassConstFail;
     Procedure TestClass_Enumerator;
     Procedure TestClass_EnumeratorFunc;
@@ -692,7 +697,11 @@ type
     Procedure TestPropertyArgs2;
     Procedure TestPropertyArgsWithDefaultsFail;
     Procedure TestPropertyArgs_StringConstDefault;
-    Procedure TestProperty_Index;
+    Procedure TestClassProperty;
+    Procedure TestClassPropertyNonStaticFail;
+    Procedure TestClassPropertyNonStaticAllow;
+    //Procedure TestClassPropertyStaticMismatchFail;
+    Procedure TestArrayProperty;
     Procedure TestProperty_WrongTypeAsIndexFail;
     Procedure TestProperty_Option_ClassPropertyNonStatic;
     Procedure TestDefaultProperty;
@@ -794,9 +803,14 @@ type
     Procedure TestArray_ConstDynArrayWrite;
     Procedure TestArray_ConstOpenArrayWriteFail;
     Procedure TestArray_ForIn;
+    Procedure TestArray_Arg_AnonymousStaticFail;
+    Procedure TestArray_Arg_AnonymousMultiDimFail;
 
     // array of const
     Procedure TestArrayOfConst;
+    Procedure TestArrayOfConst_PassDynArrayOfIntFail;
+    Procedure TestArrayOfConst_AssignNilFail;
+    Procedure TestArrayOfConst_SetLengthFail;
 
     // static arrays
     Procedure TestArrayIntRange_OutOfRange;
@@ -899,6 +913,7 @@ type
     Procedure TestClassHelper_DefaultClassProperty;
     Procedure TestClassHelper_MultipleScopeHelpers;
     Procedure TestRecordHelper;
+    Procedure TestRecordHelper_ForByteFail;
     Procedure TestRecordHelper_ClassNonStaticFail;
     Procedure TestRecordHelper_InheritedObjFPC;
     Procedure TestRecordHelper_Constructor_NewInstance;
@@ -908,7 +923,10 @@ type
     Procedure TestTypeHelper_Enum;
     Procedure TestTypeHelper_EnumDotValueFail;
     Procedure TestTypeHelper_EnumHelperDotProcFail;
+    Procedure TestTypeHelper_Set;
     Procedure TestTypeHelper_Enumerator;
+    Procedure TestTypeHelper_String;
+    Procedure TestTypeHelper_Boolean;
     Procedure TestTypeHelper_Constructor_NewInstance;
     Procedure TestTypeHelper_InterfaceFail;
 
@@ -2064,6 +2082,20 @@ begin
     '    function ToString: String; virtual;',
     '  end;']);
     end;
+  if supTVarRec in Parts then
+    begin
+    Intf.AddStrings([
+    'const',
+    '  vtInteger       = 0;',
+    '  vtBoolean       = 1;',
+    'type',
+    '  PVarRec = ^TVarRec;',
+    '  TVarRec = record',
+    '    case VType : sizeint of',
+    '    vtInteger       : (VInteger: Longint);',
+    '    vtBoolean       : (VBoolean: Boolean);',
+    '  end;']);
+    end;
   Intf.Add('var');
   Intf.Add('  ExitCode: Longint = 0;');
 
@@ -3399,6 +3431,8 @@ begin
   '  k=chr(97);',
   '  l=ord(a[1]);',
   '  m=low(char)+high(char);',
+  '  n = string(''A'');',
+  '  o = UnicodeString(''A'');',
   'begin']);
   ParseProgram;
   CheckResolverUnexpectedHints;
@@ -8217,7 +8251,7 @@ begin
   '  TRec = record',
   '    class var w: word;',
   '    class procedure {#a}Create; static;',
-  '    class constructor Create; static;',
+  '    class constructor Create;', // name clash is allowed!
   '  end;',
   'class constructor TRec.Create;',
   'begin',
@@ -8250,6 +8284,46 @@ begin
   CheckResolverException('class constructor cannot have parameters',nXCannotHaveParameters);
 end;
 
+procedure TTestResolver.TestAdvRecord_ClassConstructor_CallFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    class constructor Create;',
+  '  end;',
+  'class constructor TRec.Create;',
+  'begin',
+  'end;',
+  'begin',
+  '  TRec.Create;',
+  '']);
+  CheckResolverException('identifier not found "Create"',nIdentifierNotFound);
+end;
+
+procedure TTestResolver.TestAdvRecord_ClassConstructorDuplicateFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    class constructor Create;',
+  '    class constructor Init;',
+  '  end;',
+  'class constructor TRec.Create;',
+  'begin',
+  'end;',
+  'class constructor TRec.Init;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Multiple class constructor in record TRec: Create and Init',
+    nMultipleXinTypeYNameZCAandB);
+end;
+
 procedure TTestResolver.TestAdvRecord_NestedRecordType;
 begin
   StartProgram(false);
@@ -10036,6 +10110,23 @@ begin
   CheckResolverException('identifier not found "Self"',nIdentifierNotFound);
 end;
 
+procedure TTestResolver.TestClass_SelfDotInStaticFail;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    class var FLeft: word;');
+  Add('    class function DoIt: word; static;');
+  Add('    class property Left: word read FLeft;');
+  Add('  end;');
+  Add('class function TObject.DoIt: word;');
+  Add('begin');
+  Add('  Result:=Self.Left;');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('identifier not found "Self"',nIdentifierNotFound);
+end;
+
 procedure TTestResolver.TestClass_PrivateProtectedInSameUnit;
 begin
   StartProgram(false);
@@ -10744,6 +10835,18 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestClass_ClassMissingVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    class c: word;',
+  '  end;',
+  'begin']);
+  CheckParserException('Expected "procedure or function"',nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestClass_ClassConstFail;
 begin
   StartProgram(false);
@@ -12173,7 +12276,89 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestProperty_Index;
+procedure TTestResolver.TestClassProperty;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    class function GetStatic: word; static;',
+  '    class procedure SetStatic(Value: word); static;',
+  '    class property StaticP: word read GetStatic write SetStatic;',
+  '  end;',
+  'class function TObject.GetStatic: word;',
+  'begin',
+  '  StaticP:=StaticP;',
+  'end;',
+  'class procedure TObject.SetStatic(Value: word);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestClassPropertyNonStaticFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    class function GetNonStatic: word;',
+  '    class property NonStatic: word read GetNonStatic;',
+  '  end;',
+  'class function TObject.GetNonStatic: word;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sClassPropertyAccessorMustBeStatic,nClassPropertyAccessorMustBeStatic);
+end;
+
+procedure TTestResolver.TestClassPropertyNonStaticAllow;
+begin
+  ResolverEngine.Options:=ResolverEngine.Options+[proClassPropertyNonStatic];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    class function GetStatic: word; static;',
+  '    class procedure SetStatic(Value: word); static;',
+  '    class property StaticP: word read GetStatic write SetStatic;',
+  '    class function GetNonStatic: word;',
+  '    class procedure SetNonStatic(Value: word);',
+  '    class property NonStatic: word read GetNonStatic write SetNonStatic;',
+  '  end;',
+  '  TClass = class of TObject;',
+  'class function TObject.GetStatic: word;',
+  'begin',
+  '  StaticP:=StaticP;',
+  '  NonStatic:=NonStatic;',
+  'end;',
+  'class procedure TObject.SetStatic(Value: word);',
+  'begin',
+  'end;',
+  'class function TObject.GetNonStatic: word;',
+  'begin',
+  '  StaticP:=StaticP;',
+  '  NonStatic:=NonStatic;',
+  'end;',
+  'class procedure TObject.SetNonStatic(Value: word);',
+  'begin',
+  'end;',
+  'var',
+  '  c: TClass;',
+  '  o: TObject;',
+  'begin',
+  '  c.STaticP:=c.StaticP;',
+  '  o.STaticP:=o.StaticP;',
+  '  c.NonStatic:=c.NonStatic;',
+  '  o.NonStatic:=o.NonStatic;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayProperty;
 begin
   StartProgram(false);
   Add('type');
@@ -14201,14 +14386,103 @@ begin
   CheckParamsExpr_pkSet_Markers;
 end;
 
-procedure TTestResolver.TestArrayOfConst;
+procedure TTestResolver.TestArray_Arg_AnonymousStaticFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt(args: array[1..2] of word);',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException('Expected "of"',nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestArray_Arg_AnonymousMultiDimFail;
 begin
   StartProgram(false);
   Add([
+  'procedure DoIt(args: array of array of word);',
+  'begin',
+  'end;',
+  'begin']);
+  CheckParserException(SParserExpectedIdentifier,nParserExpectedIdentifier);
+end;
+
+procedure TTestResolver.TestArrayOfConst;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArrOfVarRec = array of TVarRec;',
   'procedure DoIt(args: array of const);',
-  'begin end;',
+  'var',
+  '  i: longint;',
+  '  v: TVarRec;',
+  '  a: TArrOfVarRec;',
+  '  sa: array[1..2] of TVarRec;',
+  'begin',
+  '  DoIt(args);',
+  '  DoIt(a);',
+  '  DoIt([]);',
+  '  DoIt([1]);',
+  '  DoIt([i]);',
+  '  DoIt([true,''foo'',''c'',1.3,nil,@DoIt]);',
+  '  for i:=low(args) to high(args) do begin',
+  '    v:=args[i];',
+  '    case args[i].VType of',
+  '    vtInteger: if length(args)=args[i].VInteger then ;',
+  '    end;',
+  '  end;',
+  '  for v in Args do ;',
+  '  args:=sa;',
+  'end;',
   'begin']);
-  CheckResolverException('not yet implemented: :TPasArrayType [20171005235610] array of const',nNotYetImplemented);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestArrayOfConst_PassDynArrayOfIntFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  'end;',
+  'var a: TArr;',
+  'begin',
+  '  DoIt(a)']);
+  CheckResolverException('Incompatible type arg no. 1: Got "TArr", expected "array of const"',
+    nIncompatibleTypeArgNo);
+end;
+
+procedure TTestResolver.TestArrayOfConst_AssignNilFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  '  args:=nil;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types: got "Nil" expected "array of const"',nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestArrayOfConst_SetLengthFail;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'type',
+  '  TArr = array of word;',
+  'procedure DoIt(args: array of const);',
+  'begin',
+  '  SetLength(args,2);',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible type arg no. 1: Got "array of const", expected "string or dynamic array variable"',
+    nIncompatibleTypeArgNo);
 end;
 
 procedure TTestResolver.TestArrayIntRange_OutOfRange;
@@ -16645,6 +16919,20 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecordHelper_ForByteFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TRecHelper = record helper for byte',
+  '    class var Glob: word;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type "Byte" cannot be extended by a record helper',nTypeXCannotBeExtendedByARecordHelper);
+end;
+
 procedure TTestResolver.TestRecordHelper_ClassNonStaticFail;
 begin
   StartProgram(false);
@@ -16883,6 +17171,8 @@ begin
   '  f: TFlag;',
   'begin',
   '  f.toString;',
+  '  green.toString;',
+  '  TFlag.green.toString;',
   '  TFlag.Fly;',
   '']);
   ParseProgram;
@@ -16924,6 +17214,38 @@ begin
   CheckResolverException('Cannot access this member from a type helper',nCannotAccessThisMemberFromAX);
 end;
 
+procedure TTestResolver.TestTypeHelper_Set;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TEnum = (Red, Green, Blue);',
+  '  TSetOfEnum = set of TEnum;',
+  '  THelper = type helper for TSetOfEnum',
+  '    procedure Fly;',
+  '    class procedure Run; static;',
+  '  end;',
+  'procedure THelper.Fly;',
+  'begin',
+  '  Self:=[];',
+  '  Self:=[green];',
+  '  Include(Self,blue);',
+  'end;',
+  'class procedure THelper.Run;',
+  'begin',
+  'end;',
+  'var s: TSetOfEnum;',
+  'begin',
+  '  s.Fly;',
+  //'  with s do Fly;',
+  '  TSetOfEnum.Run;',
+  //'  with TSetOfEnum do Run;',
+  //'  [green].Fly', not supported
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestTypeHelper_Enumerator;
 begin
   StartProgram(false);
@@ -16958,6 +17280,54 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestTypeHelper_String;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TStringHelper = type helper for String',
+  '    procedure DoIt;',
+  '  end;',
+  '  TCharHelper = type helper for char',
+  '    procedure Fly;',
+  '  end;',
+  'procedure TStringHelper.DoIt;',
+  'begin',
+  '  Self[1]:=Self[2];',
+  'end;',
+  'procedure TCharHelper.Fly;',
+  'begin',
+  '  Self:=''c'';',
+  '  Self:=Self;',
+  'end;',
+  'begin',
+  '  ''abc''.DoIt;',
+  '  ''xyz''.DoIt();',
+  '  ''c''.Fly;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestTypeHelper_Boolean;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  THelper = type helper for boolean',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure THelper.DoIt;',
+  'begin',
+  '  Self:=not Self;',
+  'end;',
+  'begin',
+  '  false.DoIt;',
+  '  true.DoIt();']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestTypeHelper_Constructor_NewInstance;
 var
   aMarker: PSrcMarker;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -164,6 +164,8 @@ type
     procedure TestWP_ClassInterface_COM_Unit;
     procedure TestWP_ClassInterface_Typeinfo;
     procedure TestWP_ClassInterface_TGUID;
+    procedure TestWP_ClassHelper;
+    procedure TestWP_ClassHelper_ClassConstrucor_Used;
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -3061,6 +3063,94 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_ClassHelper;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TObject_used}TObject = class',
+  '  end;',
+  '  {#TBird_used}TBird = class',
+  '    {#TBird_A_notused}A: word;',
+  '  end;',
+  '  {#TAnt_used}TAnt = class',
+  '    {#TAnt_B_notused}B: word;',
+  '  type',
+  '    {#TMouth_used}TMouth = class',
+  '      {#TMouth_C_notused}C: word;',
+  '    type',
+  '      {#TBirdHelper_used}TBirdHelper = class helper for TBird',
+  '        procedure {#TBirdHelper_Fly_used}Fly;',
+  '      end;',
+  '    end;',
+  '  end;',
+  'procedure TAnt.TMouth.TBirdHelper.Fly;',
+  'begin',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  b.Fly;;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_ClassHelper_ClassConstrucor_Used;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TObject_used}TObject = class',
+  '    class constructor {#TObject_Init_used}Init;',
+  '    class destructor {#TObject_Done_used}Done;',
+  '  end;',
+  '  {#TBird_used}TBird = class',
+  '    {#TBird_A_notused}A: word;',
+  '    class constructor {#TBird_Init_used}Init;',
+  '    class destructor {#TBird_Done_used}Done;',
+  '  end;',
+  '  {#TBirdHelper_used}TBirdHelper = class helper for TBird',
+  '    procedure {#TBirdHelper_Fly_used}Fly;',
+  '    class constructor {#TBirdHelper_Init_used}Init;',
+  '    class destructor {#TBirdHelper_Done_used}Done;',
+  '  end;',
+  '  TAnt = class',
+  '    class constructor {#TAnt_Init_notused}Init;',
+  '    class destructor {#TAnt_Done_notused}Done;',
+  '  end;',
+  'class constructor TObject.Init;',
+  'begin',
+  'end;',
+  'class destructor TObject.Done;',
+  'begin',
+  'end;',
+  'class constructor TBird.Init;',
+  'begin',
+  'end;',
+  'class destructor TBird.Done;',
+  'begin',
+  'end;',
+  'procedure TBirdHelper.Fly;',
+  'begin',
+  'end;',
+  'class constructor TBirdHelper.Init;',
+  'begin',
+  'end;',
+  'class destructor TBirdHelper.Done;',
+  'begin',
+  'end;',
+  'class constructor TAnt.Init;',
+  'begin',
+  'end;',
+  'class destructor TAnt.Done;',
+  'begin',
+  'end;',
+  'var b: TBird;',
+  'begin',
+  '  b.Fly;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin
   StartUnit(false);

packages/fcl-registry/src/registry.pp

@@ -32,7 +32,7 @@ type
   end;
 
   TRegDataType = (rdUnknown, rdString, rdExpandString, rdBinary, rdInteger, rdIntegerBigEndian,
-                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList);
+                  rdLink, rdMultiString, rdResourceList, rdFullResourceDescriptor,  rdResourceRequirementList, rdInt64);
 
   TRegDataInfo = record
     RegData: TRegDataType;
@@ -95,6 +95,7 @@ type
     function ReadDateTime(const Name: string): TDateTime;
     function ReadFloat(const Name: string): Double;
     function ReadInteger(const Name: string): Integer;
+    function ReadInt64(const Name: string): Int64;
     function ReadString(const Name: string): string;
     procedure ReadStringList(const Name: string; AList: TStrings);
     function ReadTime(const Name: string): TDateTime;
@@ -118,6 +119,7 @@ type
     procedure WriteDateTime(const Name: string; Value: TDateTime);
     procedure WriteFloat(const Name: string; Value: Double);
     procedure WriteInteger(const Name: string; Value: Integer);
+    procedure WriteInt64(const Name: string; Value: Int64);
     procedure WriteString(const Name, Value: string);
     procedure WriteExpandString(const Name, Value: string);
     procedure WriteStringList(const Name: string; List: TStrings);
@@ -346,6 +348,17 @@ begin
     Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
 end;
 
+function TRegistry.ReadInt64(const Name: string): Int64;
+
+Var
+  RegDataType: TRegDataType;
+
+begin
+  GetData(Name, @Result, SizeOf(Int64), RegDataType);
+  If RegDataType<>rdInt64 Then
+    Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
+end;
+
 function TRegistry.ReadBool(const Name: string): Boolean;
 
 begin
@@ -491,7 +504,7 @@ var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
 end;
 
@@ -515,12 +528,17 @@ begin
   PutData(Name, @Value, SizeOf(Integer), rdInteger);
 end;
 
+procedure TRegistry.WriteInt64(const Name: string; Value: Int64);
+begin
+  PutData(Name, @Value, SizeOf(Int64), rdInt64);
+end;
+
 procedure TRegistry.WriteString(const Name, Value: string);
 var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdString);
 end;
 

packages/fcl-registry/src/winreg.inc

@@ -1,7 +1,7 @@
 Const
   RegDataWords : Array [TRegDataType] of DWORD
                = (REG_NONE,REG_SZ,REG_EXPAND_SZ,REG_BINARY,REG_DWORD,REG_DWORD_BIG_ENDIAN,
-                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST);
+                  REG_LINK,REG_MULTI_SZ,REG_RESOURCE_LIST,REG_FULL_RESOURCE_DESCRIPTOR,REG_RESOURCE_REQUIREMENTS_LIST,REG_QWORD);
 
 type
   TWinRegData = record
@@ -28,12 +28,12 @@ begin
   Dispose(PWinRegData(FSysData));
 end;
 
-Function PrepKey(Const S : String) : pChar;
+Function PrepKey(Const S : String) : String;
 
 begin
-  Result:=PChar(S);
-  If Result^='\' then
-    Inc(Result);
+  Result := S;
+  if (Result <> '') and (Result[1] = '\') then
+    System.Delete(Result, 1, 1);
 end;
 
 Function RelativeKey(Const S : String) : Boolean;
@@ -52,7 +52,7 @@ Var
 
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
                               PWideChar(u),
                               0,
@@ -71,14 +71,14 @@ function TRegistry.DeleteKey(const Key: String): Boolean;
 Var
   u: UnicodeString;
 begin
-  u:=UTF8Decode(PRepKey(Key));
+  u:=PRepKey(Key);
   FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
 function TRegistry.DeleteValue(const Name: String): Boolean;
 begin
-  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name)));
+  FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UnicodeString(Name)));
   Result:=FLastError=ERROR_SUCCESS;
 end;
 
@@ -89,7 +89,7 @@ Var
   RD : DWord;
 
 begin
-  u := UTF8Decode(Name);
+  u := Name;
   FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
                       @RD,Buffer,lpdword(@BufSize));
   if (FLastError<>ERROR_SUCCESS) Then
@@ -110,7 +110,7 @@ Var
   RD : DWord;
 
 begin
-  u:=UTF8Decode(ValueName);
+  u:=ValueName;
   With Value do
     begin
     FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
@@ -147,7 +147,7 @@ begin
 {$ifdef WinCE}
   FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
 {$else WinCE}
-  u:=UTF8Decode(S);
+  u:=UnicodeString(S);
   FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
 {$endif WinCE}
 end;
@@ -212,7 +212,7 @@ Var
   S: string;
 begin
   SecurityAttributes := Nil;
-  u:=UTF8Decode(PrepKey(Key));
+  u:=PrepKey(Key);
   If CanCreate then
     begin
     Handle:=0;
@@ -260,7 +260,7 @@ begin
 {$ifdef WinCE}
   Result:=False;
 {$else}
-  FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot);
+  FLastError:=RegConnectRegistryW(PWideChar(UnicodeString(UNCName)),RootKey,newroot);
   Result:=FLastError=ERROR_SUCCESS;
   if Result then begin
     RootKey:=newroot;
@@ -422,7 +422,7 @@ Var
 
 begin
   RegDataType:=RegDataWords[RegData];
-  u:=UTF8Decode(Name);
+  u:=UnicodeString(Name);
   FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
   Result:=FLastError=ERROR_SUCCESS;
 end;

packages/fcl-xml/src/xmlconf.pp

@@ -166,6 +166,7 @@ Var
 begin
   F:=TFileStream.Create(AFileName,fmOpenread or fmShareDenyWrite);
   try
+    FFileName := '';
     ReadXMLFile(Doc, AFilename);
     FFileName:=AFileName;
   finally
@@ -398,11 +399,14 @@ procedure TXMLConfig.DoSetFilename(const AFilename: String; ForceReload: Boolean
 begin
   if (not ForceReload) and (FFilename = AFilename) then
     exit;
-    
+
   Flush;
   FreeAndNil(Doc);
   if csLoading in ComponentState then
+  begin
+    FFilename := AFilename;
     exit;
+  end;
   if FileExists(AFilename) and not FStartEmpty then
     LoadFromFile(AFilename)
   else if not Assigned(Doc) then
@@ -425,6 +429,8 @@ begin
   if AValue <> FRootName then
   begin
     FRootName := AValue;
+    if not (ComponentState * [csLoading,csDesigning] = []) then
+      Exit;
     Root := Doc.DocumentElement;
     Cfg := Doc.CreateElement(AValue);
     while Assigned(Root.FirstChild) do
@@ -475,7 +481,7 @@ var
 begin
   for I := Length(FPathStack)-1 downto 0 do
     FPathStack[I] := '';
-  FElement := nil;    
+  FElement := nil;
   FPathDirty := False;
   FPathCount := 0;
 end;

packages/fpmake_add.inc

@@ -11,6 +11,7 @@
   add_cocoaint(ADirectory+IncludeTrailingPathDelimiter('cocoaint'));
   add_dblib(ADirectory+IncludeTrailingPathDelimiter('dblib'));
   add_dbus(ADirectory+IncludeTrailingPathDelimiter('dbus'));
+  add_libmagic(ADirectory+IncludeTrailingPathDelimiter('libmagic'));
   add_dts(ADirectory+IncludeTrailingPathDelimiter('dts'));
   add_fastcgi(ADirectory+IncludeTrailingPathDelimiter('fastcgi'));
   add_fcl_async(ADirectory+IncludeTrailingPathDelimiter('fcl-async'));

packages/fpmake_proc.inc

@@ -72,6 +72,12 @@ begin
 {$include dbus/fpmake.pp}
 end;
 
+procedure add_libmagic(const ADirectory: string);
+begin
+  with Installer do
+{$include libmagic/fpmake.pp}
+end;
+
 procedure add_dts(const ADirectory: string);
 begin
   with Installer do

packages/fpmkunit/src/fpmkunit.pp

@@ -8016,19 +8016,21 @@ end;
 
 procedure TBuildEngine.Clean(APackage: TPackage; ACPU: TCPU; AOS: TOS);
 Var
-  List : TStringList;
+  List,List2 : TStringList;
   DirectoryList : TStringList;
   RemainingList : TStrings;
   i : longint;
 begin
-  List:=TStringList.Create;
+  List:=TUnsortedDuplicatesStringList.Create;
+  List.Duplicates:=DupIgnore;
   try
     List.Add(APackage.GetUnitConfigOutputFilename(ACPU,AOS));
     APackage.GetCleanFiles(List,ACPU,AOS);
     if (List.Count>0) then
       begin
       CmdDeleteFiles(List);
-      DirectoryList := TStringList.Create;
+      DirectoryList:=TUnsortedDuplicatesStringList.Create;
+      DirectoryList.Duplicates:=DupIgnore;
       try
         GetDirectoriesFromFilelist(List,DirectoryList);
         CmdRemoveDirs(DirectoryList);
@@ -8049,9 +8051,18 @@ begin
             Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetBinOutputDir(ACPU,AOS)]));
             DirectoryList.Add(APackage.GetBinOutputDir(ACPU,AOS));
             RemainingList := TStringList.Create;
+            List2:=TStringList.Create;
             SearchFiles(AllFilesMask, APackage.GetBinOutputDir(ACPU,AOS), true, RemainingList);
             for i:=0 to RemainingList.Count-1 do
-              Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+              begin
+                if ExtractFileExt(Remaininglist[i])=PPUExt then
+                  Installer.log(vlDebug,format('File %s still present, add corresponding entry to fpmake',[RemainingList[i]]))
+                else
+                  Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+                List2.Add(IncludeTrailingPathDelimiter(APackage.GetUnitsOutputDir(ACPU,AOS))+Remaininglist[i]);
+              end;
+            CmdDeleteFiles(List2);
+            List2.Free;
             RemainingList.Free;
             CmdRemoveTrees(DirectoryList);
             DirectoryList.Clear;
@@ -8062,9 +8073,18 @@ begin
             Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetUnitsOutputDir(ACPU,AOS)]));
             DirectoryList.Add(APackage.GetUnitsOutputDir(ACPU,AOS));
             RemainingList := TStringList.Create;
+            List2:=TStringList.Create;
             SearchFiles(AllFilesMask, APackage.GetUnitsOutputDir(ACPU,AOS), true, RemainingList);
             for i:=0 to RemainingList.Count-1 do
-              Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+              begin
+                if ExtractFileExt(Remaininglist[i])=PPUExt then
+                  Installer.log(vlDebug,format('File %s still present, add corresponding entry to fpmake',[RemainingList[i]]))
+                else
+                  Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+                List2.Add(IncludeTrailingPathDelimiter(APackage.GetUnitsOutputDir(ACPU,AOS))+RemainingList[i]);
+              end;
+            CmdDeleteFiles(List2);
+            List2.free;
             RemainingList.Free;
             CmdRemoveTrees(DirectoryList);
             DirectoryList.Clear;
@@ -8746,15 +8766,17 @@ begin
     end
   else If (TargetType in [ttProgram,ttExampleProgram]) then
     begin
-    List.Add(APrefixB + GetProgramFileName(AOS));
-    if FileExists(APrefixB + GetProgramDebugFileName(AOS)) then
-      List.Add(APrefixB + GetProgramDebugFileName(AOS));
+      List.Add(APrefixB + GetProgramFileName(AOS));
+      if FileExists(APrefixB + GetProgramDebugFileName(AOS)) then
+        List.Add(APrefixB + GetProgramDebugFileName(AOS));
+      if (AOS in AllImportLibraryOSes) and FileExists(APrefixU + GetImportLibFilename(AOS)) then
+        List.Add(APrefixU + GetImportLibFilename(AOS));
     end
   else If (TargetType in [ttSharedLibrary]) then
     begin
-    List.Add(APrefixB + GetLibraryFileName(AOS));
-    if FileExists(APrefixB + GetLibraryDebugFileName(AOS)) then
-      List.Add(APrefixB + GetLibraryDebugFileName(AOS));
+      List.Add(APrefixB + GetLibraryFileName(AOS));
+      if FileExists(APrefixB + GetLibraryDebugFileName(AOS)) then
+        List.Add(APrefixB + GetLibraryDebugFileName(AOS));
     end;
   If ResourceStrings then
     begin

packages/ide/fpmake.pp

@@ -228,6 +228,10 @@ begin
         
         if CompilerTarget in [powerpc, powerpc64] then
           P.Options.Add('-Fu'+CompilerDir+'/ppcgen');
+
+        if CompilerTarget in [arm, aarch64] then
+          P.Options.Add('-Fu'+CompilerDir+'/armgen');
+
         if CompilerTarget in [sparc, sparc64] then
           begin
               P.Options.Add('-Fu'+CompilerDir+'/sparcgen');

packages/libmagic/Makefile

@@ -0,0 +1,2553 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0
+#
+default: all
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
+BSDs = freebsd netbsd openbsd darwin dragonfly
+UNIXs = linux $(BSDs) solaris qnx haiku aix
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
+OSNeedsComspecToRunBatch = go32v2 watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef COMSPEC
+ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),)
+ifndef RUNBATCH
+RUNBATCH=$(COMSPEC) /C
+endif
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+ifneq ($(CPU_TARGET),)
+FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB)
+else
+FPC:=$(shell $(FPCPROG) -PB)
+endif
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+else
+ifeq ($(strip $(wildcard $(FPC))),)
+FPC:=$(firstword $(FPCPROG))
+endif
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifeq ($(CPU_TARGET),armeb)
+ARCH=arm
+override FPCOPT+=-Cb
+else
+ifeq ($(CPU_TARGET),armel)
+ARCH=arm
+override FPCOPT+=-CaEABI
+else
+ARCH=$(CPU_TARGET)
+endif
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+endif
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+ifndef CROSSCOMPILE
+BUILDFULLNATIVE=1
+export BUILDFULLNATIVE
+endif
+ifdef BUILDFULLNATIVE
+BUILDNATIVE=1
+export BUILDNATIVE
+endif
+export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+ifeq ($(OS_SOURCE),darwin)
+DARWIN2DARWIN=1
+endif
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+ifneq ($(OS_TARGET),msdos)
+ifndef DARWIN2DARWIN
+ifneq ($(CPU_TARGET),jvm)
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+ifeq ($(OS_TARGET),android)
+ifeq ($(CPU_TARGET),arm)
+BINUTILSPREFIX=arm-linux-androideabi-
+else
+ifeq ($(CPU_TARGET),i386)
+BINUTILSPREFIX=i686-linux-android-
+else
+BINUTILSPREFIX=$(CPU_TARGET)-linux-android-
+endif
+endif
+endif
+endif
+endif
+else
+BINUTILSPREFIX=$(OS_TARGET)-
+endif
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
+ifndef FPCFPMAKE
+ifdef CROSSCOMPILE
+ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPCFPMAKE:=$(shell $(FPCPROG) -PB)
+ifeq ($(strip $(wildcard $(FPCFPMAKE))),)
+FPCFPMAKE:=$(firstword $(FPCPROG))
+endif
+else
+override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR))))
+FPMAKE_SKIP_CONFIG=-n
+export FPCFPMAKE
+export FPMAKE_SKIP_CONFIG
+endif
+else
+FPMAKE_SKIP_CONFIG=-n
+FPCFPMAKE=$(FPC)
+endif
+endif
+override PACKAGE_NAME=libmagiv
+override PACKAGE_VERSION=3.3.1
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+EXEDBGEXT=.dbg
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+IMPORTLIBPREFIX=
+endif
+ifneq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),dragonfly)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=df
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+IMPORTLIBPREFIX=
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),aros)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=aros
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),haiku)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=hai
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+IMPORTLIBPREFIX=imp
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+IMPORTLIBPREFIX=imp
+endif
+ifneq ($(findstring $(OS_TARGET),darwin iphonesim),)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+EXEDBGEXT=.dSYM
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
+ifeq ($(OS_TARGET),wii)
+EXEEXT=.dol
+SHAREDLIBEXT=.so
+SHORTSUFFIX=wii
+endif
+ifeq ($(OS_TARGET),aix)
+BATCHEXT=.sh
+EXEEXT=
+SHAREDLIBEXT=.a
+SHORTSUFFIX=aix
+endif
+ifeq ($(OS_TARGET),java)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=java
+endif
+ifeq ($(CPU_TARGET),jvm)
+ifeq ($(OS_TARGET),android)
+OEXT=.class
+ASMEXT=.j
+SHAREDLIBEXT=.jar
+SHORTSUFFIX=android
+endif
+endif
+ifeq ($(OS_TARGET),msdos)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHORTSUFFIX=d16
+endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+NASMNAME=$(BINUTILSPREFIX)nasm
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+ifndef NASMPROG
+ifdef CROSSBINDIR
+NASMPROG=$(CROSSBINDIR)/$(NASMNAME)$(SRCEXEEXT)
+else
+NASMPROG=$(NASMNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+NASM=$(NASMPROG)
+ifdef inUnix
+PPAS=./ppas$(SRCBATCHEXT)
+else
+PPAS=ppas$(SRCBATCHEXT)
+endif
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl fpmkunit
+ifeq ($(FULL_TARGET),i386-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-go32v2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-win32)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-os2)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-haiku)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netware)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-emx)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-netwlibc)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i386-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-amiga)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-wii)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-freebsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-solaris)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-win64)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-iphonesim)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),x86_64-dragonfly)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-palmos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-wince)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),powerpc64-aix)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),avr-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),armeb-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mips-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),mipsel-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-java)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),jvm-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-msdos)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),i8086-win16)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-darwin)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),aarch64-android)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),wasm-wasm)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),sparc64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv32-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-linux)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifeq ($(FULL_TARGET),riscv64-embedded)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_PASZLIB=1
+REQUIRE_PACKAGES_FCL-PROCESS=1
+REQUIRE_PACKAGES_HASH=1
+REQUIRE_PACKAGES_LIBTAR=1
+REQUIRE_PACKAGES_FPMKUNIT=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+ifdef UNITDIR_FPMAKE_RTL
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL)
+endif
+endif
+ifdef REQUIRE_PACKAGES_PASZLIB
+PACKAGEDIR_PASZLIB:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_PASZLIB),)
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)),)
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(TARGETSUFFIX)
+else
+UNITDIR_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_PASZLIB=$(PACKAGEDIR_PASZLIB)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_PASZLIB)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_PASZLIB) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_PASZLIB)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_PASZLIB=
+UNITDIR_PASZLIB:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /paszlib/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_PASZLIB),)
+UNITDIR_PASZLIB:=$(firstword $(UNITDIR_PASZLIB))
+else
+UNITDIR_PASZLIB=
+endif
+endif
+ifdef UNITDIR_PASZLIB
+override COMPILER_UNITDIR+=$(UNITDIR_PASZLIB)
+endif
+ifdef UNITDIR_FPMAKE_PASZLIB
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_PASZLIB)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FCL-PROCESS
+PACKAGEDIR_FCL-PROCESS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FCL-PROCESS),)
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)),)
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FCL-PROCESS=$(PACKAGEDIR_FCL-PROCESS)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FCL-PROCESS) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-PROCESS)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FCL-PROCESS=
+UNITDIR_FCL-PROCESS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-process/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FCL-PROCESS),)
+UNITDIR_FCL-PROCESS:=$(firstword $(UNITDIR_FCL-PROCESS))
+else
+UNITDIR_FCL-PROCESS=
+endif
+endif
+ifdef UNITDIR_FCL-PROCESS
+override COMPILER_UNITDIR+=$(UNITDIR_FCL-PROCESS)
+endif
+ifdef UNITDIR_FPMAKE_FCL-PROCESS
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-PROCESS)
+endif
+endif
+ifdef REQUIRE_PACKAGES_HASH
+PACKAGEDIR_HASH:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /hash/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_HASH),)
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)),)
+UNITDIR_HASH=$(PACKAGEDIR_HASH)/units/$(TARGETSUFFIX)
+else
+UNITDIR_HASH=$(PACKAGEDIR_HASH)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_HASH=$(PACKAGEDIR_HASH)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_HASH)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_HASH) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_HASH)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_HASH=
+UNITDIR_HASH:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /hash/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_HASH),)
+UNITDIR_HASH:=$(firstword $(UNITDIR_HASH))
+else
+UNITDIR_HASH=
+endif
+endif
+ifdef UNITDIR_HASH
+override COMPILER_UNITDIR+=$(UNITDIR_HASH)
+endif
+ifdef UNITDIR_FPMAKE_HASH
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_HASH)
+endif
+endif
+ifdef REQUIRE_PACKAGES_LIBTAR
+PACKAGEDIR_LIBTAR:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /libtar/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_LIBTAR),)
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)),)
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(TARGETSUFFIX)
+else
+UNITDIR_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_LIBTAR=$(PACKAGEDIR_LIBTAR)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_LIBTAR)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_LIBTAR) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_LIBTAR)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_LIBTAR=
+UNITDIR_LIBTAR:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /libtar/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_LIBTAR),)
+UNITDIR_LIBTAR:=$(firstword $(UNITDIR_LIBTAR))
+else
+UNITDIR_LIBTAR=
+endif
+endif
+ifdef UNITDIR_LIBTAR
+override COMPILER_UNITDIR+=$(UNITDIR_LIBTAR)
+endif
+ifdef UNITDIR_FPMAKE_LIBTAR
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_LIBTAR)
+endif
+endif
+ifdef REQUIRE_PACKAGES_FPMKUNIT
+PACKAGEDIR_FPMKUNIT:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_FPMKUNIT),)
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)),)
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(TARGETSUFFIX)
+else
+UNITDIR_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units/$(SOURCESUFFIX)
+else
+ifneq ($(wildcard $(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)),)
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)/units_bs/$(SOURCESUFFIX)
+else
+UNITDIR_FPMAKE_FPMKUNIT=$(PACKAGEDIR_FPMKUNIT)
+endif
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_FPMKUNIT) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_FPMKUNIT)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_FPMKUNIT=
+UNITDIR_FPMKUNIT:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fpmkunit/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_FPMKUNIT),)
+UNITDIR_FPMKUNIT:=$(firstword $(UNITDIR_FPMKUNIT))
+else
+UNITDIR_FPMKUNIT=
+endif
+endif
+ifdef UNITDIR_FPMKUNIT
+override COMPILER_UNITDIR+=$(UNITDIR_FPMKUNIT)
+endif
+ifdef UNITDIR_FPMAKE_FPMKUNIT
+override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(ARCH)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(ARCH)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX)
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifndef CROSSCOMPILE
+ifneq ($(BINUTILSPREFIX),)
+override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+endif
+ifneq ($(findstring $(OS_TARGET),dragonfly freebsd openbsd netbsd linux solaris),)
+ifneq ($(findstring $(CPU_TARGET),x86_64 mips mipsel),)
+override FPCOPT+=-Cg
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(strip $(FPC) $(FPCOPT))
+ifneq (,$(findstring -sh ,$(COMPILER)))
+UseEXECPPAS=1
+endif
+ifneq (,$(findstring -s ,$(COMPILER)))
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+UseEXECPPAS=1
+endif
+endif
+ifneq ($(UseEXECPPAS),1)
+EXECPPAS=
+else
+ifdef RUNBATCH
+EXECPPAS:=@$(RUNBATCH) $(PPAS)
+else
+EXECPPAS:=@$(PPAS)
+endif
+endif
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) c$(TAROPT)f $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+ifdef RUNBATCH
+	$(RUNBATCH) $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES))
+endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS)))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANEXEDBGFILES
+	-$(DELTREE) $(CLEANEXEDBGFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)  FPC fpmake... $(FPCFPMAKE)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+units:
+examples:
+shared:
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+zipexampleinstall: fpc_zipexampleinstall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: units examples shared sourceinstall exampleinstall zipexampleinstall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+	{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+	$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

packages/libmagic/Makefile.fpc

@@ -0,0 +1,102 @@
+#
+#   Makefile.fpc for running fpmake
+#
+
+[package]
+name=libmagiv
+version=3.3.1
+
+[require]
+packages=rtl fpmkunit
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+
+[prerules]
+FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
+ifdef OS_TARGET
+FPC_TARGETOPT+=--os=$(OS_TARGET)
+endif
+ifdef CPU_TARGET
+FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
+endif
+LOCALFPMAKE=./fpmake$(SRCEXEEXT)
+
+[rules]
+# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
+override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
+override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
+# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
+override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
+# Compose general fpmake-parameters
+ifdef FPMAKEOPT
+FPMAKE_OPT+=$(FPMAKEOPT)
+endif
+FPMAKE_OPT+=--localunitdir=../..
+FPMAKE_OPT+=--globalunitdir=..
+FPMAKE_OPT+=$(FPC_TARGETOPT)
+FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
+FPMAKE_OPT+=--compiler=$(FPC)
+FPMAKE_OPT+=-bu
+.NOTPARALLEL:
+
+fpmake$(SRCEXEEXT): fpmake.pp
+	$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
+all:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT)
+smart:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
+release:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
+debug:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
+# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
+# most often fail because the dependencies are cleared.
+# In case of a clean, simply do nothing
+ifeq ($(FPMAKE_BIN_CLEAN),)
+clean:
+else
+clean:
+	$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
+endif
+# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
+# when the package is compiled using fpcmake prior to running this clean using fpmake
+ifeq ($(FPMAKE_BIN_CLEAN),)
+distclean:	$(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
+else
+distclean:
+ifdef inUnix
+        { $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi;  }
+else
+        $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
+endif
+	-$(DEL) $(LOCALFPMAKE)
+endif
+cleanall: distclean
+install:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
+endif
+# distinstall also installs the example-sources and omits the location of the source-
+# files from the fpunits.cfg files.
+distinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+else
+	$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
+endif
+zipinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
+zipdistinstall:	fpmake$(SRCEXEEXT)
+	$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
+zipsourceinstall:	fpmake$(SRCEXEEXT)
+ifdef UNIXHier
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
+else
+	$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
+endif

packages/libmagic/examples/basic.pp

@@ -0,0 +1,31 @@
+program basic;
+
+{$IFDEF FPC}
+ {$MODE OBJFPC}
+ {$H+}
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+ {$APPTYPE CONSOLE}
+{$ENDIF}
+
+uses libmagic;
+
+const
+  MAGIC_MGC = {$IFDEF MSWINFOWS}'magic.mgc'{$ELSE}nil{$ENDIF};
+
+var
+  filename: string;
+  cookie: magic_t;
+begin
+  cookie := magic_open(MAGIC_ERROR_ or MAGIC_MIME);
+  magic_load(cookie, MAGIC_MGC);
+  filename := {$I %file%};
+  WriteLn('The content-type of ''', filename, ''' is: ',
+    magic_file(cookie, Pcchar(filename)));
+  magic_close(cookie);
+{$IFDEF MSWINDOWS}
+  WriteLn('Press [ENTER] to exit ...');
+  ReadLn;
+{$ENDIF}
+end.

packages/libmagic/fpmake.pp

@@ -0,0 +1,40 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+  P : TPackage;
+  T : TTarget;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('libmagic');
+    P.ShortName:='magic';
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.3.1';
+    P.Author := 'Library: libmagic';
+    P.License := 'Library: GPL, header: LGPL with modification, ';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Headers for the magic library (library to determine file type)';
+    P.NeedLibC:= true;  // true for headers that indirectly link to libc?
+    P.OSes := AllUnixOSes-[qnx];
+    P.SourcePath.Add('src');
+    P.IncludePath.Add('src');
+    
+    T:=P.Targets.AddUnit('libmagic.pp');
+    
+    P.ExamplePath.Add('examples');
+    P.Targets.AddExampleProgram('basic.pp');
+
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}

packages/libmagic/src/libmagic.pp

@@ -0,0 +1,160 @@
+{
+    This file is part of the Free Pascal packages
+    Copyright (C) 2019 Silvio Clecio (silvioprog)
+
+    Pascal binding for libmagic(3)
+
+    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.
+}
+
+unit libmagic;
+
+{$IFDEF FPC}
+ {$MODE OBJFPC}
+ {$H+}
+{$ENDIF}
+
+interface
+
+type
+  Pcchar = PAnsiChar;
+  cint = LongInt;
+  csize_t = NativeUInt;
+  Pcsize_t = PNativeUInt;
+  Pcvoid = Pointer;
+  PPcvoid = PPointer;
+
+const
+  MAGIC_LIB_NAME = {$IFDEF MSWINDOWS}'libmagic-1'{$ELSE}'magic'{$ENDIF};
+
+const
+  MAGIC_NONE = $0000000; // No flags
+  MAGIC_DEBUG = $0000001; // Turn on debugging
+  MAGIC_SYMLINK = $0000002; // Follow symlinks
+  MAGIC_COMPRESS = $0000004; // Check inside compressed files
+  MAGIC_DEVICES = $0000008; // Look at the contents of devices
+  MAGIC_MIME_TYPE = $0000010; // Return the MIME type
+  MAGIC_CONTINUE = $0000020; // Return all matches
+  MAGIC_CHECK_ = $0000040; // Print warnings to stderr
+  MAGIC_PRESERVE_ATIME = $0000080; // Restore access time on exit
+  MAGIC_RAW = $0000100; // Don't convert unprintable chars
+  MAGIC_ERROR_ = $0000200; // Handle ENOENT etc as real errors
+  MAGIC_MIME_ENCODING = $0000400; // Return the MIME encoding
+  MAGIC_MIME = MAGIC_MIME_TYPE or MAGIC_MIME_ENCODING;
+  MAGIC_APPLE = $0000800; // Return the Apple creator/type
+  MAGIC_EXTENSION  = $1000000; // Return a /-separated list of extensions
+  MAGIC_COMPRESS_TRANSP = $2000000; // Check inside compressed files but not report compression
+  MAGIC_NODESC = MAGIC_EXTENSION or MAGIC_MIME or MAGIC_APPLE;
+
+const
+  MAGIC_NO_CHECK_COMPRESS = $0001000; // Don't check for compressed files
+  MAGIC_NO_CHECK_TAR = $0002000; // Don't check for tar files
+  MAGIC_NO_CHECK_SOFT = $0004000; // Don't check magic entries
+  MAGIC_NO_CHECK_APPTYPE = $0008000; // Don't check application type
+  MAGIC_NO_CHECK_ELF = $0010000; // Don't check for elf details
+  MAGIC_NO_CHECK_TEXT = $0020000; // Don't check for text files
+  MAGIC_NO_CHECK_CDF = $0040000; // Don't check for cdf files
+  MAGIC_NO_CHECK_TOKENS = $0100000; // Don't check tokens
+  MAGIC_NO_CHECK_ENCODING = $0200000; // Don't check text encodings
+
+const
+  // No built-in tests; only consult the magic file
+  MAGIC_NO_CHECK_BUILTIN =
+    MAGIC_NO_CHECK_COMPRESS or
+    MAGIC_NO_CHECK_TAR or
+    //MAGIC_NO_CHECK_SOFT or
+    MAGIC_NO_CHECK_APPTYPE or
+    MAGIC_NO_CHECK_ELF or
+    MAGIC_NO_CHECK_TEXT or
+    MAGIC_NO_CHECK_CDF or
+    MAGIC_NO_CHECK_TOKENS or
+    MAGIC_NO_CHECK_ENCODING or
+    0;
+
+const
+  MAGIC_SNPRINTB = #177#020+
+    'b'#0'debug'#0+
+    'b'#1'symlink'#0+
+    'b'#2'compress'#0+
+    'b'#3'devices'#0+
+    'b'#4'mime_type'#0+
+    'b'#5'continue'#0+
+    'b'#6'check'#0+
+    'b'#7'preserve_atime'#0+
+    'b'#10'raw'#0+
+    'b'#11'error'#0+
+    'b'#12'mime_encoding'#0+
+    'b'#13'apple'#0+
+    'b'#14'no_check_compress'#0+
+    'b'#15'no_check_tar'#0+
+    'b'#16'no_check_soft'#0+
+    'b'#17'no_check_sapptype'#0+
+    'b'#20'no_check_elf'#0+
+    'b'#21'no_check_text'#0+
+    'b'#22'no_check_cdf'#0+
+    'b'#23'no_check_reserved0'#0+
+    'b'#24'no_check_tokens'#0+
+    'b'#25'no_check_encoding'#0+
+    'b'#26'no_check_reserved1'#0+
+    'b'#27'no_check_reserved2'#0+
+    'b'#30'extension'#0+
+    'b'#31'transp_compression'#0;
+
+const
+  // Defined for backwards compatibility (renamed)
+  MAGIC_NO_CHECK_ASCII = MAGIC_NO_CHECK_TEXT;
+
+const
+  // Defined for backwards compatibility; do nothing
+  MAGIC_NO_CHECK_FORTRAN = $000000; // Don't check ascii/fortran
+  MAGIC_NO_CHECK_TROFF = $000000; // Don't check ascii/troff
+
+const
+  MAGIC_VERSION_ = 532; // This implementation
+
+type
+  magic_t = ^magic_set;
+  magic_set = record
+  end;
+
+function magic_open(flags: cint): magic_t; cdecl; external MAGIC_LIB_NAME name 'magic_open';
+procedure magic_close(cookie: magic_t); cdecl; external MAGIC_LIB_NAME name 'magic_close';
+
+function magic_getpath(const magicfile: Pcchar; action: cint): Pcchar; cdecl; external MAGIC_LIB_NAME name 'magic_getpath';
+function magic_file(cookie: magic_t; const filename: Pcchar): Pcchar; cdecl; external MAGIC_LIB_NAME name 'magic_file';
+function magic_descriptor(cookie: magic_t; fd: cint): Pcchar; cdecl; external MAGIC_LIB_NAME name 'magic_descriptor';
+function magic_buffer(cookie: magic_t; const buffer: Pcvoid; length: csize_t): Pcchar; cdecl; external MAGIC_LIB_NAME name 'magic_buffer';
+
+function magic_error(cookie: magic_t): Pcchar; cdecl; external MAGIC_LIB_NAME name 'magic_error';
+function magic_getflags(cookie: magic_t): cint; cdecl; external MAGIC_LIB_NAME name 'magic_getflags';
+function magic_setflags(cookie: magic_t; flags: cint): cint; cdecl; external MAGIC_LIB_NAME name 'magic_setflags';
+
+function magic_version: cint; cdecl; external MAGIC_LIB_NAME name 'magic_version';
+function magic_load(cookie: magic_t; const filename: Pcchar): cint; cdecl; external MAGIC_LIB_NAME name 'magic_load';
+function magic_load_buffers(cookie: magic_t; buffers: PPcvoid; sizes: Pcsize_t; nbuffers: csize_t): cint; cdecl; external MAGIC_LIB_NAME name 'magic_load_buffers';
+
+function magic_compile(cookie: magic_t; const filename: Pcchar): cint; cdecl; external MAGIC_LIB_NAME name 'magic_compile';
+function magic_check(cookie: magic_t; const filename: Pcchar): cint; cdecl; external MAGIC_LIB_NAME name 'magic_check';
+function magic_list(cookie: magic_t; const filename: Pcchar): cint; cdecl; external MAGIC_LIB_NAME name 'magic_list';
+function magic_errno(cookie: magic_t): cint; cdecl; external MAGIC_LIB_NAME name 'magic_errno';
+
+const
+  MAGIC_PARAM_INDIR_MAX = 0;
+  MAGIC_PARAM_NAME_MAX = 1;
+  MAGIC_PARAM_ELF_PHNUM_MAX = 2;
+  MAGIC_PARAM_ELF_SHNUM_MAX = 3;
+  MAGIC_PARAM_ELF_NOTES_MAX = 4;
+  MAGIC_PARAM_REGEX_MAX = 5;
+  MAGIC_PARAM_BYTES_MAX = 6;
+
+function magic_setparam(cookie: magic_t; param: cint; const value: Pcvoid): cint; cdecl; external MAGIC_LIB_NAME name 'magic_setparam';
+function magic_getparam(cookie: magic_t; param: cint; value: Pcvoid): cint; cdecl; external MAGIC_LIB_NAME name 'magic_getparam';
+
+implementation
+
+end.

packages/pastojs/fpmake.pp

@@ -55,6 +55,7 @@ begin
       T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
+    T:=P.Targets.AddUnit('pas2jsuseanalyzer.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
     T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
       T.Dependencies.AddUnit('pas2jscompiler');

packages/pastojs/src/pas2jscompiler.pp

@@ -38,12 +38,12 @@ uses
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
   jsbase, jstree, jswriter, JSSrcMap,
-  PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
-  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
+  PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
+  FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 const
   VersionMajor = 1;
-  VersionMinor = 3;
+  VersionMinor = 5;
   VersionRelease = 1;
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
@@ -346,7 +346,7 @@ type
     FScanner: TPas2jsPasScanner;
     FShowDebug: boolean;
     FUnitFilename: string;
-    FUseAnalyzer: TPasAnalyzer;
+    FUseAnalyzer: TPas2JSAnalyzer;
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedByCount(Section: TUsedBySection): integer;
@@ -413,7 +413,7 @@ type
     property Scanner: TPas2jsPasScanner read FScanner;
     property ShowDebug: boolean read FShowDebug write FShowDebug;
     property UnitFilename: string read FUnitFilename;
-    property UseAnalyzer: TPasAnalyzer read FUseAnalyzer; // unit analysis
+    property UseAnalyzer: TPas2JSAnalyzer read FUseAnalyzer; // unit analysis
     property UsedByCount[Section: TUsedBySection]: integer read GetUsedByCount;
     property UsedBy[Section: TUsedBySection; Index: integer]: TPas2jsCompilerFile read GetUsedBy;
   end;
@@ -454,11 +454,6 @@ type
     property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
 
-  { TPas2JSWPOptimizer }
-
-  TPas2JSWPOptimizer = class(TPasAnalyzer)
-  end;
-
   { TPas2jsCompiler }
 
   TPas2jsCompiler = class
@@ -484,7 +479,7 @@ type
     FParamMacros: TPas2jsMacroEngine;
     FSrcMapSourceRoot: string;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
-    FWPOAnalyzer: TPas2JSWPOptimizer;
+    FWPOAnalyzer: TPas2JSAnalyzer;
     FInterfaceType: TPasClassInterfaceType;
     FPrecompileGUID: TGUID;
     FInsertFilenames: TStringList;
@@ -564,7 +559,7 @@ type
     function CreateLog: TPas2jsLogger; virtual;
     function CreateMacroEngine: TPas2jsMacroEngine;virtual;
     function CreateSrcMap(const aFileName: String): TPas2JSSrcMap; virtual;
-    function CreateOptimizer: TPas2JSWPOptimizer;
+    function CreateOptimizer: TPas2JSAnalyzer;
     // These are mandatory !
     function CreateSetOfCompilerFiles(keyType: TKeyCompareType): TPasAnalyzerKeySet; virtual; abstract;
     function CreateFS: TPas2JSFS; virtual; abstract;
@@ -672,7 +667,7 @@ type
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
     property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
     property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
-    property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
+    property WPOAnalyzer: TPas2JSAnalyzer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
@@ -936,7 +931,7 @@ begin
   for ub in TUsedBySection do
     FUsedBy[ub]:=TFPList.Create;
 
-  FUseAnalyzer:=TPasAnalyzer.Create;
+  FUseAnalyzer:=TPas2JSAnalyzer.Create;
   FUseAnalyzer.OnMessage:=@OnUseAnalyzerMessage;
   FUseAnalyzer.Resolver:=FPasResolver;
 
@@ -1938,10 +1933,10 @@ begin
   Result:=aFile.NeedBuild;
 end;
 
-function TPas2jsCompiler.CreateOptimizer: TPas2JSWPOptimizer;
+function TPas2jsCompiler.CreateOptimizer: TPas2JSAnalyzer;
 
 begin
-  Result:=TPas2JSWPOptimizer.Create;
+  Result:=TPas2JSAnalyzer.Create;
 end;
 
 procedure TPas2jsCompiler.OptimizeProgram(aFile: TPas2jsCompilerFile);

packages/pastojs/src/pas2jsfiler.pp

@@ -71,13 +71,15 @@ uses
 
 const
   PCUMagic = 'Pas2JSCache';
-  PCUVersion = 3;
+  PCUVersion = 4;
   { Version Changes:
     1: initial version
     2: - TPasProperty.ImplementsFunc:String -> Implements:TPasExprArray
        - pcsfAncestorResolved
        - removed msIgnoreInterfaces
-    3: changed records from function to objects
+    3: changed records from function to objects (pas2js 1.3)
+    4: precompiled JS of initialization section now only contains the statements,
+       not the whole $init function (pas2js 1.5)
   }
 
   BuiltInNodeName = 'BuiltIn';
@@ -860,6 +862,8 @@ type
     procedure Set_ModScope_AssertMsgConstructor(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorClass(RefEl: TPasElement; Data: TObject);
     procedure Set_ModScope_RangeErrorConstructor(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemTVarRec(RefEl: TPasElement; Data: TObject);
+    procedure Set_ModScope_SystemVarRecs(RefEl: TPasElement; Data: TObject);
     procedure Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement; Data: TObject);
     procedure Set_PropertyScope_AncestorProp(RefEl: TPasElement; Data: TObject);
     procedure Set_ProcedureScope_ImplProc(RefEl: TPasElement; Data: TObject);
@@ -2511,6 +2515,8 @@ begin
   AddReferenceToObj(Obj,'AssertMsgConstructor',Scope.AssertMsgConstructor);
   AddReferenceToObj(Obj,'RangeErrorClass',Scope.RangeErrorClass);
   AddReferenceToObj(Obj,'RangeErrorConstructor',Scope.RangeErrorConstructor);
+  AddReferenceToObj(Obj,'SystemTVarRec',Scope.SystemTVarRec);
+  AddReferenceToObj(Obj,'SystemVarRecs',Scope.SystemVarRecs);
   WritePasScope(Obj,Scope,aContext);
 end;
 
@@ -4399,6 +4405,28 @@ begin
     RaiseMsg(20180211123100,Scope.Element,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_ModScope_SystemTVarRec(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasRecordType then
+    Scope.SystemTVarRec:=TPasRecordType(RefEl)
+  else
+    RaiseMsg(20190215230826,Scope.Element,GetObjName(RefEl));
+end;
+
+procedure TPCUReader.Set_ModScope_SystemVarRecs(RefEl: TPasElement;
+  Data: TObject);
+var
+  Scope: TPas2JSModuleScope absolute Data;
+begin
+  if RefEl is TPasFunction then
+    Scope.SystemVarRecs:=TPasFunction(RefEl)
+  else
+    RaiseMsg(20190215230857,Scope.Element,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_EnumTypeScope_CanonicalSet(RefEl: TPasElement;
   Data: TObject);
 var
@@ -6262,6 +6290,8 @@ begin
   ReadElementReference(Obj,Scope,'AssertMsgConstructor',@Set_ModScope_AssertMsgConstructor);
   ReadElementReference(Obj,Scope,'RangeErrorClass',@Set_ModScope_RangeErrorClass);
   ReadElementReference(Obj,Scope,'RangeErrorConstructor',@Set_ModScope_RangeErrorConstructor);
+  ReadElementReference(Obj,Scope,'SystemTVarRec',@Set_ModScope_SystemTVarRec);
+  ReadElementReference(Obj,Scope,'SystemVarRecs',@Set_ModScope_SystemVarRecs);
   ReadPasScope(Obj,Scope,aContext);
 end;
 

packages/pastojs/src/pas2jsfileutils.pp

@@ -40,8 +40,8 @@ function FileIsInPath(const Filename, Path: string): boolean;
 function ChompPathDelim(const Path: string): string;
 function ExpandFileNamePJ(const FileName: string; {const} BaseDir: string = ''): string;
 function ExpandDirectory(const aDirectory: string): string;
-function IsUNCPath(const {%H-}Path: String): Boolean;
-function ExtractUNCVolume(const {%H-}Path: String): String;
+function IsUNCPath(const Path: String): Boolean;
+function ExtractUNCVolume(const Path: String): String;
 function ExtractFileRoot(FileName: String): String;
 function TryCreateRelativePath(
   const Dest: String; // Filename

packages/pastojs/src/pas2jsfileutilsnodejs.inc

@@ -145,11 +145,13 @@ end;
 function IsUNCPath(const Path: String): Boolean;
 begin
   Result := false;
+  if Path='' then ;
 end;
 
 function ExtractUNCVolume(const Path: String): String;
 begin
   Result := '';
+  if Path='' then ;
 end;
 
 function FileIsWritable(const AFilename: string): boolean;

packages/pastojs/src/pas2jsfileutilsunix.inc

@@ -146,11 +146,13 @@ end;
 function IsUNCPath(const Path: String): Boolean;
 begin
   Result := false;
+  if Path='' then ;
 end;
 
 function ExtractUNCVolume(const Path: String): String;
 begin
   Result := '';
+  if Path='' then ;
 end;
 
 function FileIsWritable(const AFilename: string): boolean;

packages/pastojs/src/pas2jsuseanalyzer.pp

@@ -0,0 +1,96 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2019  Mattias Gaertner  [email protected]
+
+    Pascal to Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+  Abstract:
+    Extends the FCL Pascal use analyzer for the language subset of pas2js.
+}
+unit Pas2jsUseAnalyzer;
+
+{$mode objfpc}{$H+}
+{$inline on}
+
+interface
+
+uses
+  Classes,
+  PasUseAnalyzer, PasTree, PasResolver,
+  FPPas2Js;
+
+type
+
+  { TPas2JSAnalyzer }
+
+  TPas2JSAnalyzer = class(TPasAnalyzer)
+  public
+    procedure UseExpr(El: TPasExpr); override;
+  end;
+
+implementation
+
+{ TPas2JSAnalyzer }
+
+procedure TPas2JSAnalyzer.UseExpr(El: TPasExpr);
+
+  procedure CheckArgs(Args: TFPList);
+  var
+    i: Integer;
+    ArgType: TPasType;
+    ModScope: TPas2JSModuleScope;
+    aMod: TPasModule;
+    SystemVarRecs: TPasFunction;
+  begin
+    if Args=nil then exit;
+    for i:=0 to Args.Count-1 do
+      begin
+      ArgType:=TPasArgument(Args[i]).ArgType;
+      if ArgType=nil then continue;
+      if (ArgType.ClassType=TPasArrayType)
+          and (TPasArrayType(ArgType).ElType=nil) then
+        begin
+        // array of const
+        aMod:=El.GetModule;
+        ModScope:=NoNil(aMod.CustomData) as TPas2JSModuleScope;
+        SystemVarRecs:=ModScope.SystemVarRecs;
+        if SystemVarRecs=nil then
+          RaiseNotSupported(20190216104347,El);
+        MarkImplScopeRef(El,SystemVarRecs,psraRead);
+        UseProcedure(SystemVarRecs);
+        break;
+        end;
+      end;
+  end;
+
+var
+  Ref: TResolvedReference;
+  Decl: TPasElement;
+begin
+  if El=nil then exit;
+  inherited UseExpr(El);
+
+  Ref:=nil;
+  if El.CustomData is TResolvedReference then
+    begin
+    // this is a reference -> mark target
+    Ref:=TResolvedReference(El.CustomData);
+    Decl:=Ref.Declaration;
+    if Decl is TPasProcedure then
+      CheckArgs(TPasProcedure(Decl).ProcType.Args)
+    else if Decl.ClassType=TPasProperty then
+      CheckArgs(Resolver.GetPasPropertyArgs(TPasProperty(Decl)));
+    end;
+end;
+
+end.
+

packages/pastojs/tests/tcfiler.pas

@@ -24,9 +24,10 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
+  jstree,
   PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
-  FPPas2Js, Pas2JsFiler,
-  tcmodules, jstree;
+  Pas2jsUseAnalyzer, FPPas2Js, Pas2JsFiler,
+  tcmodules;
 
 type
 
@@ -34,11 +35,11 @@ type
 
   TCustomTestPrecompile = Class(TCustomTestModule)
   private
-    FAnalyzer: TPasAnalyzer;
+    FAnalyzer: TPas2JSAnalyzer;
     FInitialFlags: TPCUInitialFlags;
     FPCUReader: TPCUReader;
     FPCUWriter: TPCUWriter;
-    FRestAnalyzer: TPasAnalyzer;
+    FRestAnalyzer: TPas2JSAnalyzer;
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar;
       out Count: integer);
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
@@ -121,8 +122,8 @@ type
     procedure CheckRestoredProcedure(const Path: string; Orig, Rest: TPasProcedure); virtual;
     procedure CheckRestoredOperator(const Path: string; Orig, Rest: TPasOperator); virtual;
   public
-    property Analyzer: TPasAnalyzer read FAnalyzer;
-    property RestAnalyzer: TPasAnalyzer read FRestAnalyzer;
+    property Analyzer: TPas2JSAnalyzer read FAnalyzer;
+    property RestAnalyzer: TPas2JSAnalyzer read FRestAnalyzer;
     property PCUWriter: TPCUWriter read FPCUWriter write FPCUWriter;
     property PCUReader: TPCUReader read FPCUReader write FPCUReader;
     property InitialFlags: TPCUInitialFlags read FInitialFlags;
@@ -155,6 +156,7 @@ type
     procedure TestPC_Proc_Arg;
     procedure TestPC_ProcType;
     procedure TestPC_Proc_Anonymous;
+    procedure TestPC_Proc_ArrayOfConst;
     procedure TestPC_Class;
     procedure TestPC_ClassForward;
     procedure TestPC_ClassConstructor;
@@ -278,7 +280,7 @@ procedure TCustomTestPrecompile.SetUp;
 begin
   inherited SetUp;
   FInitialFlags:=TPCUInitialFlags.Create;
-  FAnalyzer:=TPasAnalyzer.Create;
+  FAnalyzer:=TPas2JSAnalyzer.Create;
   Analyzer.Resolver:=Engine;
   Analyzer.Options:=Analyzer.Options+[paoImplReferences];
   Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
@@ -378,7 +380,7 @@ begin
     end;
 
     // analyze
-    FRestAnalyzer:=TPasAnalyzer.Create;
+    FRestAnalyzer:=TPas2JSAnalyzer.Create;
     FRestAnalyzer.Resolver:=RestResolver;
     try
       RestAnalyzer.AnalyzeModule(RestResolver.RootElement);
@@ -617,6 +619,8 @@ begin
   CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
   CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
   CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
+  CheckRestoredReference(Path+'.SystemTVarRec',Orig.SystemTVarRec,Rest.SystemTVarRec);
+  CheckRestoredReference(Path+'.SystemVarRecs',Orig.SystemVarRecs,Rest.SystemVarRecs);
   CheckRestoredPasScope(Path,Orig,Rest);
 end;
 
@@ -2021,6 +2025,23 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_Proc_ArrayOfConst;
+begin
+  StartUnit(true,[supTVarRec]);
+  Add([
+  'interface',
+  'procedure Fly(arr: array of const);',
+  'implementation',
+  'procedure Fly(arr: array of const);',
+  'begin',
+  '  if arr[1].VType=1 then ;',
+  '  if arr[2].VInteger=1 then ;',
+  '  Fly([true,0.3]);',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_Class;
 begin
   StartUnit(false);

packages/pastojs/tests/tcoptimizations.pas

@@ -25,7 +25,7 @@ interface
 
 uses
   Classes, SysUtils, testregistry, fppas2js, pastree,
-  PScanner, PasUseAnalyzer, PasResolver, PasResolveEval,
+  PScanner, Pas2jsUseAnalyzer, PasResolver, PasResolveEval,
   tcmodules;
 
 type
@@ -34,8 +34,8 @@ type
 
   TCustomTestOptimizations = class(TCustomTestModule)
   private
-    FAnalyzerModule: TPasAnalyzer;
-    FAnalyzerProgram: TPasAnalyzer;
+    FAnalyzerModule: TPas2JSAnalyzer;
+    FAnalyzerProgram: TPas2JSAnalyzer;
     FWholeProgramOptimization: boolean;
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
@@ -46,8 +46,8 @@ type
     procedure ParseProgram; override;
     function CreateConverter: TPasToJSConverter; override;
   public
-    property AnalyzerModule: TPasAnalyzer read FAnalyzerModule;
-    property AnalyzerProgram: TPasAnalyzer read FAnalyzerProgram;
+    property AnalyzerModule: TPas2JSAnalyzer read FAnalyzerModule;
+    property AnalyzerProgram: TPas2JSAnalyzer read FAnalyzerProgram;
     property WholeProgramOptimization: boolean read FWholeProgramOptimization
         write FWholeProgramOptimization;
   end;
@@ -78,6 +78,8 @@ type
     procedure TestWPO_Class_OmitPropertySetter2;
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
+    procedure TestWPO_ArrayOfConst_Use;
+    procedure TestWPO_ArrayOfConst_NotUsed;
     procedure TestWPO_Class_PropertyInOtherUnit;
     procedure TestWPO_ProgramPublicDeclaration;
     procedure TestWPO_ConstructorDefaultValueConst;
@@ -92,7 +94,7 @@ implementation
 function TCustomTestOptimizations.OnConverterIsElementUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -114,7 +116,7 @@ end;
 function TCustomTestOptimizations.OnConverterIsTypeInfoUsed(Sender: TObject;
   El: TPasElement): boolean;
 var
-  A: TPasAnalyzer;
+  A: TPas2JSAnalyzer;
 begin
   if WholeProgramOptimization then
     A:=AnalyzerProgram
@@ -137,9 +139,9 @@ procedure TCustomTestOptimizations.SetUp;
 begin
   inherited SetUp;
   FWholeProgramOptimization:=false;
-  FAnalyzerModule:=TPasAnalyzer.Create;
+  FAnalyzerModule:=TPas2JSAnalyzer.Create;
   FAnalyzerModule.Resolver:=Engine;
-  FAnalyzerProgram:=TPasAnalyzer.Create;
+  FAnalyzerProgram:=TPas2JSAnalyzer.Create;
   FAnalyzerProgram.Resolver:=Engine;
 end;
 
@@ -763,7 +765,7 @@ begin
     '});',
     ' rtl.createClass($mod, "TMobile", $mod.TObject, function () {',
     '  this.DoA$1 = function () {',
-    '    $mod.TObject.DoA.apply(this, arguments);',
+    '    $mod.TObject.DoA.call(this);',
     '  };',
     '  this.DoC = function () {',
     '    $mod.TObject.DoB.call(this);',
@@ -814,6 +816,60 @@ begin
   CheckDiff('TestWPO_UseUnit',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_ArrayOfConst_Use;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin',
+  '  Say([true]);']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '  rtl.recNewT($mod, "TVarRec", function () {',
+  '    this.VType = 0;',
+  '    this.VJSValue = undefined;',
+  '    this.$eq = function (b) {',
+  '      return (this.VType === b.VType) && (this.VJSValue === b.VJSValue);',
+  '    };',
+  '    this.$assign = function (s) {',
+  '      this.VType = s.VType;',
+  '      this.VJSValue = s.VJSValue;',
+  '      return this;',
+  '    };',
+  '  });',
+  '  this.VarRecs = function () {',
+  '    var Result = [];',
+  '    var v = null;',
+  '    v.VType = 1;',
+  '    v.VJSValue = 2;',
+  '    return Result;',
+  '  };',
+  '});',
+  '']));
+end;
+
+procedure TTestOptimizations.TestWPO_ArrayOfConst_NotUsed;
+begin
+  StartProgram(true,[supTVarRec]);
+  Add([
+  'procedure Say(arr: array of const);',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckUnit('system.pp',
+  LinesToStr([
+  'rtl.module("system", [], function () {',
+  '  var $mod = this;',
+  '});',
+  '']));
+end;
+
 procedure TTestOptimizations.TestWPO_Class_PropertyInOtherUnit;
 begin
   AddModuleWithIntfImplSrc('unit1.pp',

packages/pastojs/tests/tcprecompile.pas

@@ -59,8 +59,9 @@ type
     procedure TestPCU_Overloads;
     procedure TestPCU_Overloads_MDelphi_ModeObjFPC;
     procedure TestPCU_UnitCycle;
-    procedure TestPCU_ClassForward;
-    procedure TestPCU_ClassConstructor;
+    procedure TestPCU_Class_Forward;
+    procedure TestPCU_Class_Constructor;
+    procedure TestPCU_Class_ClassConstructor;
     procedure TestPCU_ClassInterface;
     procedure TestPCU_Namespace;
     procedure TestPCU_CheckVersionMain;
@@ -300,7 +301,7 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
-procedure TTestCLI_Precompile.TestPCU_ClassForward;
+procedure TTestCLI_Precompile.TestPCU_Class_Forward;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;',
@@ -339,7 +340,7 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
-procedure TTestCLI_Precompile.TestPCU_ClassConstructor;
+procedure TTestCLI_Precompile.TestPCU_Class_Constructor;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;',
@@ -379,6 +380,41 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_Class_ClassConstructor;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddUnit('src/unit1.pp',[
+    'type',
+    '  TObject = class',
+    '    constructor Create;',
+    '  end;',
+    '  TBird = class',
+    '    class constructor Init;',
+    '  end;',
+    ''],[
+    'constructor TObject.Create; begin end;',
+    'class constructor TBird.Init; begin end;',
+    '']);
+  AddUnit('src/unit2.pp',[
+    'uses unit1;',
+    'procedure DoIt;',
+    ''],[
+    'procedure DoIt;',
+    'begin',
+    '  TBird.Create;',
+    'end;',
+    '']);
+  AddFile('test1.pas',[
+    'uses unit2;',
+    'begin',
+    '  DoIt;',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 procedure TTestCLI_Precompile.TestPCU_ClassInterface;
 begin
   AddUnit('src/system.pp',[
@@ -536,7 +572,7 @@ end;
 procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
 var
   aFile: TCLIFile;
-  s, JSFilename, ExpectedSrc: string;
+  s, JSFilename, ExpectedSrc, VerStr: string;
 begin
   AddUnit('src/system.pp',[
     'type integer = longint;'],
@@ -549,10 +585,11 @@ begin
   aFile:=FindFile(JSFilename);
   AssertNotNull('File not found '+JSFilename,aFile);
   writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
+  VerStr:=IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease);
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
-    '  rtl.checkVersion(10301);',
+    '  rtl.checkVersion('+VerStr+');',
     '  var $mod = this;',
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then

packages/pastojs/tests/testpas2js.lpi

@@ -32,7 +32,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -83,6 +83,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="TCPrecompile"/>
       </Unit10>
+      <Unit11>
+        <Filename Value="../src/pas2jsuseanalyzer.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="Pas2jsUseAnalyzer"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

packages/pastojs/tests/testpas2js.pp

@@ -21,7 +21,7 @@ uses
   MemCheck,
   {$ENDIF}
   Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
-  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile;
+  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile, pas2jsuseanalyzer;
 
 type
 

packages/rtl-console/fpmake.pp

@@ -78,6 +78,7 @@ begin
         AddInclude('keyscan.inc',AllUnixOSes);
         AddUnit   ('winevent',[win32,win64]);
         AddInclude('nwsys.inc',[netware]);
+        AddUnit   ('mouse',AllUnixOSes);
         AddUnit   ('video',[win16]);
       end;
 
@@ -87,7 +88,7 @@ begin
        AddInclude('mouseh.inc');
        AddInclude('mouse.inc');
        AddUnit   ('winevent',[win32,win64]);
-       AddUnit   ('video',[go32v2,msdos]);
+       AddUnit   ('video',[go32v2,msdos] + AllUnixOSes);
      end;
 
     T:=P.Targets.AddUnit('video.pp',VideoOSes);

packages/rtl-extra/fpmake.pp

@@ -144,6 +144,7 @@ begin
      begin
        addinclude('clocale.inc',clocaleincOSes);
      end;
+    T:=P.Targets.AddUnit('sortalgs.pp');
   end
 end;
 

packages/rtl-extra/src/inc/sortalgs.pp

@@ -0,0 +1,1047 @@
+{
+    This file is part of the Free Pascal Run Time Library (rtl)
+    Copyright (c) 1999-2019 by the Free Pascal development team
+
+    This file provides alternative pluggable sorting algorithms,
+    which can be used instead of the default QuickSort implementation
+    in unit SortBase.
+
+    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.
+
+ **********************************************************************}
+
+unit SortAlgs;
+
+{$MODE objfpc}
+
+interface
+
+uses
+  SortBase;
+
+{
+                       HeapSort
+
+  Average performance: O(n log n)
+    Worst performance: O(n log n)
+     Extra memory use: O(1)
+               Stable: no
+     Additional notes: Usually slower in practice, compared to QuickSort (in the
+                       average case), but has a much better worst-case
+                       performance of O(n log n) (versus O(n*n) for QuickSort).
+                       Can be used instead of QuickSort where the risk of
+                       QuickSort's worst case scenario is not acceptable - e.g.
+                       high risk applications, security-conscious applications
+                       or applications with hard real-time requirements.
+
+                       On systems with small or no data caches it might perform
+                       better or comparable to QuickSort even in the average
+                       case, so might be a good general purpose choice for
+                       embedded systems as well. It's O(1) extra memory use and
+                       the fact it's not recursive also makes it a good
+                       candidate for embedded use.
+}
+
+procedure HeapSort_PtrList_NoContext(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_NoContext);
+procedure HeapSort_PtrList_Context(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure HeapSort_ItemList_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure HeapSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+const
+  HeapSort: TSortingAlgorithm = (
+    PtrListSorter_NoContextComparer: @HeapSort_PtrList_NoContext;
+    PtrListSorter_ContextComparer: @HeapSort_PtrList_Context;
+    ItemListSorter_ContextComparer: @HeapSort_ItemList_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: @HeapSort_ItemList_CustomItemExchanger_Context;
+  );
+
+{
+                       Randomized QuickSort
+
+  Average performance: O(n log n)
+    Worst performance: O(n*n)
+     Extra memory use: O(log n) on the stack
+               Stable: no
+     Additional notes: Uses a random element as the pivot. This makes it harder
+                       to intentionally produce an input permutation that
+                       triggers its worst O(n*n) performance. Note that, while
+                       this ensures that no particular input triggers the worst
+                       case scenario, this doesn't completely eliminate the
+                       chance of it happening. There is still an extremely
+                       small chance that the random number generator generates
+                       an unlucky sequence that triggers the worst O(n*n)
+                       performance when combined with the input permutation.
+                       And it is still possible for a malicious user to
+                       deliberately construct a worst case scenario, if the
+                       random sequence can be predicted (it is generated by a
+                       pseudorandom-number generator, which means its output is
+                       deterministic, and can be predicted if the initial random
+                       seed is known. And Randomize uses the system time to
+                       initialize the random seed, which also makes it easy to
+                       predict). If these risks cannot be tolerated, a different
+                       sorting algorithm should be used.
+}
+{$ifdef FPC_HAS_FEATURE_RANDOM}
+procedure RandomizedQuickSort_PtrList_NoContext(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_NoContext);
+procedure RandomizedQuickSort_PtrList_Context(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure RandomizedQuickSort_ItemList_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure RandomizedQuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+const
+  RandomizedQuickSort: TSortingAlgorithm = (
+    PtrListSorter_NoContextComparer: @RandomizedQuickSort_PtrList_NoContext;
+    PtrListSorter_ContextComparer: @RandomizedQuickSort_PtrList_Context;
+    ItemListSorter_ContextComparer: @RandomizedQuickSort_ItemList_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: @RandomizedQuickSort_ItemList_CustomItemExchanger_Context;
+  );
+{$endif def FPC_HAS_FEATURE_RANDOM}
+
+{
+                       IntroSort
+
+  Average performance: O(n log n)
+    Worst performance: O(n log n)
+     Extra memory use: O(log n) on the stack
+               Stable: no
+     Additional notes: Hybrid between QuickSort and HeapSort. It starts by doing
+                       QuickSort, but switches to HeapSort if the recursion
+                       depth exceeds 2*log2(n). This results in fast average
+                       performance, similar to QuickSort, combined with a good
+                       O(n log n) worst case performance, because sequences that
+                       trigger QuickSort's worst case are caught and sorted by
+                       HeapSort instead.
+}
+procedure IntroSort_PtrList_NoContext(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_NoContext);
+procedure IntroSort_PtrList_Context(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure IntroSort_ItemList_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure IntroSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+const
+  IntroSort: TSortingAlgorithm = (
+    PtrListSorter_NoContextComparer: @IntroSort_PtrList_NoContext;
+    PtrListSorter_ContextComparer: @IntroSort_PtrList_Context;
+    ItemListSorter_ContextComparer: @IntroSort_ItemList_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: @IntroSort_ItemList_CustomItemExchanger_Context;
+  );
+
+implementation
+
+{$GOTO on}
+
+{*****************************************************************************
+                                   HeapSort
+*****************************************************************************}
+
+function HeapSort_Parent(i: SizeUInt): SizeUInt; inline;
+begin
+  Result := (i - 1) div 2;
+end;
+
+function HeapSort_Left(i: SizeUInt): SizeUInt; inline;
+begin
+  Result := 2*i + 1;
+end;
+
+function HeapSort_Right(i: SizeUInt): SizeUInt; inline;
+begin
+  Result := 2*i + 2;
+end;
+
+procedure HeapSort_PtrList_NoContext(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_NoContext);
+var
+  HeapSize: SizeUInt;
+
+  procedure Heapify(I: SizeUInt);
+  label
+    again;
+  var
+    L, R, Largest: SizeUInt;
+    Q: Pointer;
+  begin
+again:
+    L := HeapSort_Left(I);
+    R := HeapSort_Right(I);
+    if (L < HeapSize) and (Comparer(ItemPtrs[L], ItemPtrs[I]) > 0) then
+      Largest := L
+    else
+      Largest := I;
+    if (R < HeapSize) and (Comparer(ItemPtrs[R], ItemPtrs[Largest]) > 0) then
+      Largest := R;
+    if Largest <> I then
+    begin
+      Q := ItemPtrs[I];
+      ItemPtrs[I] := ItemPtrs[Largest];
+      ItemPtrs[Largest] := Q;
+      { we use goto instead of tail recursion }
+      I := Largest;
+      goto again;
+    end;
+  end;
+
+var
+  I: SizeUInt;
+  Q: Pointer;
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  HeapSize := ItemCount;
+  for I := HeapSort_Parent(ItemCount - 1) downto 0 do
+    Heapify(I);
+  for I := ItemCount - 1 downto 1 do
+  begin
+    Q := ItemPtrs[0];
+    ItemPtrs[0] := ItemPtrs[I];
+    ItemPtrs[I] := Q;
+    Dec(HeapSize);
+    Heapify(0);
+  end;
+end;
+
+procedure HeapSort_PtrList_Context(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+var
+  HeapSize: SizeUInt;
+
+  procedure Heapify(I: SizeUInt);
+  label
+    again;
+  var
+    L, R, Largest: SizeUInt;
+    Q: Pointer;
+  begin
+again:
+    L := HeapSort_Left(I);
+    R := HeapSort_Right(I);
+    if (L < HeapSize) and (Comparer(ItemPtrs[L], ItemPtrs[I], Context) > 0) then
+      Largest := L
+    else
+      Largest := I;
+    if (R < HeapSize) and (Comparer(ItemPtrs[R], ItemPtrs[Largest], Context) > 0) then
+      Largest := R;
+    if Largest <> I then
+    begin
+      Q := ItemPtrs[I];
+      ItemPtrs[I] := ItemPtrs[Largest];
+      ItemPtrs[Largest] := Q;
+      { we use goto instead of tail recursion }
+      I := Largest;
+      goto again;
+    end;
+  end;
+
+var
+  I: SizeUInt;
+  Q: Pointer;
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  HeapSize := ItemCount;
+  for I := HeapSort_Parent(ItemCount - 1) downto 0 do
+    Heapify(I);
+  for I := ItemCount - 1 downto 1 do
+  begin
+    Q := ItemPtrs[0];
+    ItemPtrs[0] := ItemPtrs[I];
+    ItemPtrs[I] := Q;
+    Dec(HeapSize);
+    Heapify(0);
+  end;
+end;
+
+procedure HeapSort_ItemList_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+var
+  HeapSize: SizeUInt;
+  TempBuf: Pointer;
+
+  procedure Heapify(I: SizeUInt);
+  label
+    again;
+  var
+    L, R, Largest: SizeUInt;
+  begin
+again:
+    L := HeapSort_Left(I);
+    R := HeapSort_Right(I);
+    if (L < HeapSize) and (Comparer(Items + ItemSize*L, Items + ItemSize*I, Context) > 0) then
+      Largest := L
+    else
+      Largest := I;
+    if (R < HeapSize) and (Comparer(Items + ItemSize*R, Items + ItemSize*Largest, Context) > 0) then
+      Largest := R;
+    if Largest <> I then
+    begin
+      Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
+      Move((Items + ItemSize*Largest)^, (Items + ItemSize*I)^, ItemSize);
+      Move(TempBuf^, (Items + ItemSize*Largest)^, ItemSize);
+      { we use goto instead of tail recursion }
+      I := Largest;
+      goto again;
+    end;
+  end;
+
+var
+  I: SizeUInt;
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+
+  GetMem(TempBuf, ItemSize);
+  try
+    HeapSize := ItemCount;
+    for I := HeapSort_Parent(ItemCount - 1) downto 0 do
+      Heapify(I);
+    for I := ItemCount - 1 downto 1 do
+    begin
+      Move((Items + ItemSize*0)^, TempBuf^, ItemSize);
+      Move((Items + ItemSize*I)^, (Items + ItemSize*0)^, ItemSize);
+      Move(TempBuf^, (Items + ItemSize*I)^, ItemSize);
+      Dec(HeapSize);
+      Heapify(0);
+    end;
+  finally
+    FreeMem(TempBuf, ItemSize);
+  end;
+end;
+
+procedure HeapSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+var
+  HeapSize: SizeUInt;
+
+  procedure Heapify(I: SizeUInt);
+  label
+    again;
+  var
+    L, R, Largest: SizeUInt;
+  begin
+again:
+    L := HeapSort_Left(I);
+    R := HeapSort_Right(I);
+    if (L < HeapSize) and (Comparer(Items + ItemSize*L, Items + ItemSize*I, Context) > 0) then
+      Largest := L
+    else
+      Largest := I;
+    if (R < HeapSize) and (Comparer(Items + ItemSize*R, Items + ItemSize*Largest, Context) > 0) then
+      Largest := R;
+    if Largest <> I then
+    begin
+      Exchanger(Items + ItemSize*I, Items + ItemSize*Largest, Context);
+      { we use goto instead of tail recursion }
+      I := Largest;
+      goto again;
+    end;
+  end;
+
+var
+  I: SizeUInt;
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+
+  HeapSize := ItemCount;
+  for I := HeapSort_Parent(ItemCount - 1) downto 0 do
+    Heapify(I);
+  for I := ItemCount - 1 downto 1 do
+  begin
+    Exchanger(Items + ItemSize*0, Items + ItemSize*I, Context);
+    Dec(HeapSize);
+    Heapify(0);
+  end;
+end;
+
+{*****************************************************************************
+                            Randomized QuickSort
+*****************************************************************************}
+{$ifdef FPC_HAS_FEATURE_RANDOM}
+
+function Random_SizeUInt(L: SizeUInt): SizeUInt;
+begin
+{$if sizeof(SizeUInt)=2}
+  Result := Random(LongInt(L));
+{$elseif sizeof(SizeUInt)=4}
+  Result := Random(Int64(L));
+{$elseif sizeof(SizeUInt)=8}
+  Result := Random(Int64($100000000));
+  Result := Result or (SizeUInt(Random(Int64($100000000))) shl 32);
+  if L <> 0 then
+    Result := Result mod L
+  else
+    Result := 0;
+{$else}
+  {$fatal Unexpected size of SizeUInt}
+{$endif}
+end;
+
+procedure RandomizedQuickSort_PtrList_NoContext(ItemPtrs: PPointer; L, R : SizeUInt;
+                                                Comparer: TListSortComparer_NoContext);
+var
+  I, J, PivotIdx : SizeUInt;
+  P, Q : Pointer;
+begin
+ repeat
+   I := L;
+   J := R;
+   PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+   P := ItemPtrs[PivotIdx];
+   repeat
+     while (I < PivotIdx) and (Comparer(P, ItemPtrs[i]) > 0) do
+       Inc(I);
+     while (J > PivotIdx) and (Comparer(P, ItemPtrs[J]) < 0) do
+       Dec(J);
+     if I < J then
+     begin
+       Q := ItemPtrs[I];
+       ItemPtrs[I] := ItemPtrs[J];
+       ItemPtrs[J] := Q;
+       if PivotIdx = I then
+       begin
+         PivotIdx := J;
+         Inc(I);
+       end
+       else if PivotIdx = J then
+       begin
+         PivotIdx := I;
+         Dec(J);
+       end
+       else
+       begin
+         Inc(I);
+         Dec(J);
+       end;
+     end;
+   until I >= J;
+   // sort the smaller range recursively
+   // sort the bigger range via the loop
+   // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+   if (PivotIdx - L) < (R - PivotIdx) then
+   begin
+     if (L + 1) < PivotIdx then
+       RandomizedQuickSort_PtrList_NoContext(ItemPtrs, L, PivotIdx - 1, Comparer);
+     L := PivotIdx + 1;
+   end
+   else
+   begin
+     if (PivotIdx + 1) < R then
+       RandomizedQuickSort_PtrList_NoContext(ItemPtrs, PivotIdx + 1, R, Comparer);
+     if (L + 1) < PivotIdx then
+       R := PivotIdx - 1
+     else
+       exit;
+   end;
+ until L >= R;
+end;
+
+procedure RandomizedQuickSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  RandomizedQuickSort_PtrList_NoContext(ItemPtrs, 0, ItemCount - 1, Comparer);
+end;
+
+procedure RandomizedQuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P, Q : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := ItemPtrs[PivotIdx];
+      repeat
+        while (I < PivotIdx) and (Comparer(P, ItemPtrs[I], Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, ItemPtrs[J], Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Q := ItemPtrs[I];
+          ItemPtrs[I] := ItemPtrs[J];
+          ItemPtrs[J] := Q;
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  QuickSort(0, ItemCount - 1);
+end;
+
+procedure RandomizedQuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+var
+  TempBuf: Pointer;
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
+          Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
+          Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  GetMem(TempBuf, ItemSize);
+  try
+    QuickSort(0, ItemCount - 1);
+  finally
+    FreeMem(TempBuf, ItemSize);
+  end;
+end;
+
+procedure RandomizedQuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+  procedure QuickSort(L, R : SizeUInt);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      PivotIdx := L + Random_SizeUInt(SizeUInt(R - L));
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  QuickSort(0, ItemCount - 1);
+end;
+{$endif def FPC_HAS_FEATURE_RANDOM}
+
+{*****************************************************************************
+                                   IntroSort
+*****************************************************************************}
+
+function IntLog2(a: Word): Integer; inline;
+begin
+  Result := BsrWord(a);
+end;
+function IntLog2(a: LongWord): Integer; inline;
+begin
+  Result := BsrDWord(a);
+end;
+function IntLog2(a: QWord): Integer; inline;
+begin
+  Result := BsrQWord(a);
+end;
+
+procedure IntroSort_PtrList_NoContext(ItemPtrs: PPointer; L, R : SizeUInt;
+                                      Comparer: TListSortComparer_NoContext;
+                                      MaxDepth: Integer);
+var
+  I, J, PivotIdx : SizeUInt;
+  P, Q : Pointer;
+begin
+ repeat
+   if MaxDepth > 0 then
+     Dec(MaxDepth)
+   else
+   begin
+     HeapSort_PtrList_NoContext(@ItemPtrs[L], (R - L) + 1, Comparer);
+     exit;
+   end;
+   I := L;
+   J := R;
+   PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+   P := ItemPtrs[PivotIdx];
+   repeat
+     while (I < PivotIdx) and (Comparer(P, ItemPtrs[i]) > 0) do
+       Inc(I);
+     while (J > PivotIdx) and (Comparer(P, ItemPtrs[J]) < 0) do
+       Dec(J);
+     if I < J then
+     begin
+       Q := ItemPtrs[I];
+       ItemPtrs[I] := ItemPtrs[J];
+       ItemPtrs[J] := Q;
+       if PivotIdx = I then
+       begin
+         PivotIdx := J;
+         Inc(I);
+       end
+       else if PivotIdx = J then
+       begin
+         PivotIdx := I;
+         Dec(J);
+       end
+       else
+       begin
+         Inc(I);
+         Dec(J);
+       end;
+     end;
+   until I >= J;
+   // sort the smaller range recursively
+   // sort the bigger range via the loop
+   // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+   if (PivotIdx - L) < (R - PivotIdx) then
+   begin
+     if (L + 1) < PivotIdx then
+       IntroSort_PtrList_NoContext(ItemPtrs, L, PivotIdx - 1, Comparer, MaxDepth);
+     L := PivotIdx + 1;
+   end
+   else
+   begin
+     if (PivotIdx + 1) < R then
+       IntroSort_PtrList_NoContext(ItemPtrs, PivotIdx + 1, R, Comparer, MaxDepth);
+     if (L + 1) < PivotIdx then
+       R := PivotIdx - 1
+     else
+       exit;
+   end;
+ until L >= R;
+end;
+
+procedure IntroSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  IntroSort_PtrList_NoContext(ItemPtrs, 0, ItemCount - 1, Comparer, 2*IntLog2(ItemCount));
+end;
+
+procedure IntroSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+  procedure IntroSort(L, R : SizeUInt; MaxDepth: Integer);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P, Q : Pointer;
+  begin
+    repeat
+      if MaxDepth > 0 then
+        Dec(MaxDepth)
+      else
+      begin
+        HeapSort_PtrList_Context(@ItemPtrs[L], (R - L) + 1, Comparer, Context);
+        exit;
+      end;
+      I := L;
+      J := R;
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := ItemPtrs[PivotIdx];
+      repeat
+        while (I < PivotIdx) and (Comparer(P, ItemPtrs[I], Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, ItemPtrs[J], Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Q := ItemPtrs[I];
+          ItemPtrs[I] := ItemPtrs[J];
+          ItemPtrs[J] := Q;
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          IntroSort(L, PivotIdx - 1, MaxDepth);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          IntroSort(PivotIdx + 1, R, MaxDepth);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(ItemPtrs) or (ItemCount < 2) then
+    exit;
+  IntroSort(0, ItemCount - 1, 2*IntLog2(ItemCount));
+end;
+
+procedure IntroSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+
+var
+  TempBuf: Pointer;
+
+  procedure IntroSort(L, R : SizeUInt; MaxDepth: Integer);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      if MaxDepth > 0 then
+        Dec(MaxDepth)
+      else
+      begin
+        HeapSort_ItemList_Context(Items + ItemSize*L, (R - L) + 1, ItemSize, Comparer, Context);
+        exit;
+      end;
+      I := L;
+      J := R;
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
+          Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
+          Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          IntroSort(L, PivotIdx - 1, MaxDepth);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          IntroSort(PivotIdx + 1, R, MaxDepth);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  GetMem(TempBuf, ItemSize);
+  try
+    IntroSort(0, ItemCount - 1, 2*IntLog2(ItemCount));
+  finally
+    FreeMem(TempBuf, ItemSize);
+  end;
+end;
+
+procedure IntroSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+  procedure IntroSort(L, R : SizeUInt; MaxDepth: Integer);
+  var
+    I, J, PivotIdx : SizeUInt;
+    P : Pointer;
+  begin
+    repeat
+      if MaxDepth > 0 then
+        Dec(MaxDepth)
+      else
+      begin
+        HeapSort_ItemList_CustomItemExchanger_Context(Items + ItemSize*L, (R - L) + 1, ItemSize, Comparer, Exchanger, Context);
+        exit;
+      end;
+      I := L;
+      J := R;
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := Items + ItemSize*PivotIdx;
+      repeat
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
+          Inc(I);
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
+          Dec(J);
+        if I < J then
+        begin
+          Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
+        end;
+      until I >= J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if (PivotIdx - L) < (R - PivotIdx) then
+      begin
+        if (L + 1) < PivotIdx then
+          IntroSort(L, PivotIdx - 1, MaxDepth);
+        L := PivotIdx + 1;
+      end
+      else
+      begin
+        if (PivotIdx + 1) < R then
+          IntroSort(PivotIdx + 1, R, MaxDepth);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  IntroSort(0, ItemCount - 1, 2*IntLog2(ItemCount));
+end;
+
+end.

packages/rtl-objpas/src/inc/strutils.pp

@@ -20,7 +20,7 @@ unit StrUtils;
 interface
 
 uses
-  SysUtils{, Types};
+  SysUtils, Types;
 
 { ---------------------------------------------------------------------
     Case insensitive search/replace
@@ -36,6 +36,11 @@ Function AnsiIndexText(const AText: string; const AValues: array of string): Int
 Function StartsText(const ASubText, AText: string): Boolean; inline;
 Function EndsText(const ASubText, AText: string): Boolean; inline;
 
+function ResemblesText(const AText, AOther: string): Boolean; inline;
+function ContainsText(const AText, ASubText: string): Boolean; inline;
+function MatchText(const AText: string; const AValues: array of string): Boolean; inline;
+function IndexText(const AText: string; const AValues: array of string): Integer; inline;
+
 { ---------------------------------------------------------------------
     Case sensitive search/replace
   ---------------------------------------------------------------------}
@@ -54,6 +59,11 @@ Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeStr
 Function IndexText(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
 Operator in (const AText: string; const AValues: array of string):Boolean;inline;
 Operator in (const AText: UnicodeString; const AValues: array of UnicodeString):Boolean;inline;
+
+function ContainsStr(const AText, ASubText: string): Boolean; inline;
+function MatchStr(const AText: string; const AValues: array of string): Boolean; inline;
+function IndexStr(const AText: string; const AValues: array of string): Integer; inline;
+
 { ---------------------------------------------------------------------
     Miscellaneous
   ---------------------------------------------------------------------}
@@ -67,6 +77,8 @@ Function IfThen(AValue: Boolean; const ATrue: string; const AFalse: string = '')
 function NaturalCompareText (const S1 , S2 : string ): Integer ;
 function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThousandSeparator: Char): Integer;
 
+function SplitString(const S, Delimiters: string): TStringDynArray;
+
 { ---------------------------------------------------------------------
     VB emulations.
   ---------------------------------------------------------------------}
@@ -146,6 +158,7 @@ type
 
 Const
   AnsiResemblesProc: TCompareTextProc = @SoundexProc;
+  ResemblesProc: TCompareTextProc = @SoundexProc;
 
 { ---------------------------------------------------------------------
     Other functions, based on RxStrUtils.
@@ -245,6 +258,7 @@ Type
                              sraBoyerMoore  // Algorithm optimized for long replacements.
                             );
 
+Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; out aCount : Integer; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
 Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
 { We need these for backwards compatibility:
   The compiler will stop searching and convert to ansistring if the widestring version of stringreplace is used.
@@ -563,8 +577,7 @@ begin
   Result:=MatchesCount>0;
 end;
 
-function StringReplaceFast(const S, OldPattern, NewPattern: string;
-  Flags: TReplaceFlags): string;
+function StringReplaceFast(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags; out aCount : Integer): string;
 const
   MATCHESCOUNTRESIZER=100; //Arbitrary value. Memory used = MATCHESCOUNTRESIZER * sizeof(SizeInt)
 var
@@ -606,6 +619,7 @@ var
     inc(MatchesCount);
   end;
 begin
+  aCount:=0;
   if (OldPattern='') or (Length(OldPattern)>Length(S)) then begin
     //This cases will never match nothing.
     Result:=S;
@@ -690,7 +704,8 @@ begin
       end;
     end;
   end;
-  //Create room enougth for the result string
+  //Create room enough for the result string
+  aCount:=MatchesCount;
   SetLength(Result,Length(S)-OldPatternSize*MatchesCount+NewPatternSize*MatchesCount);
   MatchIndex:=1;
   MatchTarget:=1;
@@ -746,7 +761,7 @@ end;
 
 *)
 
-function StringReplaceBoyerMoore(const S, OldPattern, NewPattern: string;Flags: TReplaceFlags): string;
+function StringReplaceBoyerMoore(const S, OldPattern, NewPattern: string;Flags: TReplaceFlags; out aCount : Integer): string;
 var
   Matches: SizeIntArray;
   OldPatternSize: SizeInt;
@@ -757,6 +772,7 @@ var
   MatchInternal: SizeInt;
   AdvanceIndex: SizeInt;
 begin
+  aCount:=0;
   OldPatternSize:=Length(OldPattern);
   NewPatternSize:=Length(NewPattern);
   if (OldPattern='') or (Length(OldPattern)>Length(S)) then begin
@@ -771,6 +787,7 @@ begin
   end;
 
   MatchesCount:=Length(Matches);
+  aCount:=MatchesCount;
 
   //Create room enougth for the result string
   SetLength(Result,Length(S)-OldPatternSize*MatchesCount+NewPatternSize*MatchesCount);
@@ -800,11 +817,21 @@ end;
 
 function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; Algorithm: TStringReplaceAlgorithm): string;
 
+Var
+  C : Integer;
+
+begin
+  Result:=StringReplace(S, OldPattern, NewPattern, Flags,C,Algorithm);
+end;
+
+Function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags; out aCount : Integer; Algorithm : TStringReplaceAlgorithm = sraDefault): string; overload;
+
+
 begin
   Case Algorithm of
-    sraDefault    : Result:=sysutils.StringReplace(S,OldPattern,NewPattern,Flags);
-    sraManySmall  : Result:=StringReplaceFast(S,OldPattern,NewPattern,Flags);
-    sraBoyerMoore : Result:=StringReplaceBoyerMoore(S,OldPattern,NewPattern,Flags);
+    sraDefault    : Result:=sysutils.StringReplace(S,OldPattern,NewPattern,Flags,aCount);
+    sraManySmall  : Result:=StringReplaceFast(S,OldPattern,NewPattern,Flags,aCount);
+    sraBoyerMoore : Result:=StringReplaceBoyerMoore(S,OldPattern,NewPattern,Flags,aCount);
   end;
 end;
 
@@ -927,19 +954,54 @@ begin
   Result := AnsiEndsText(ASubText, AText);
 end;
 
+function ResemblesText(const AText, AOther: string): Boolean;
+begin
+  if Assigned(ResemblesProc) then
+    Result := ResemblesProc(AText, AOther)
+  else
+    Result := False;
+end;
+
+function ContainsText(const AText, ASubText: string): Boolean;
+begin
+  Result := AnsiContainsText(AText, ASubText);
+end;
+
+function MatchText(const AText: string; const AValues: array of string): Boolean;
+begin
+  Result := AnsiMatchText(AText, AValues);
+end;
+
+function IndexText(const AText: string; const AValues: array of string): Integer;
+begin
+  Result := AnsiIndexText(AText, AValues);
+end;
+
+function ContainsStr(const AText, ASubText: string): Boolean;
+begin
+  Result := AnsiContainsStr(AText, ASubText);
+end;
+
+function MatchStr(const AText: string; const AValues: array of string): Boolean;
+begin
+  Result := AnsiMatchStr(AText, AValues);
+end;
+
+function IndexStr(const AText: string; const AValues: array of string): Integer;
+begin
+  Result := AnsiIndexStr(AText, AValues);
+end;
 
 function AnsiReplaceText(const AText, AFromText, AToText: string): string;
 begin
   Result := StringReplace(AText,AFromText,AToText,[rfReplaceAll,rfIgnoreCase]);
 end;
 
-
 function AnsiMatchText(const AText: string; const AValues: array of string): Boolean;
 begin
   Result:=(AnsiIndexText(AText,AValues)<>-1)
 end;
 
-
 function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
 begin
   for Result := Low(AValues) to High(AValues) do
@@ -1292,6 +1354,11 @@ begin
   end;
 end;
 
+function SplitString(const S, Delimiters: string): TStringDynArray;
+begin
+  Result := S.Split(Delimiters);
+end;
+
 function NaturalCompareText (const S1 , S2 : string ): Integer ;
 begin
   Result := NaturalCompareText(S1, S2,

packages/winunits-base/src/activex.pp

@@ -1115,6 +1115,12 @@ Const
     XFORMCOORDS_CONTAINERTOHIMETRIC       = $8;
     XFORMCOORDS_EVENTCOMPAT               = $10;
 
+    REGCLS_SINGLEUSE      = 0;  // class object only generates one instance
+    REGCLS_MULTIPLEUSE    = 1;  // same class object genereates multiple inst.
+    REGCLS_MULTI_SEPARATE = 2;  // multiple use, but separate control over each
+    REGCLS_SUSPENDED      = 4;  // register is as suspended, will be activated
+    REGCLS_SURROGATE      = 8;  // must be used when a surrogate process
+
 TYPE
     TVarType            = USHORT;
 

rtl/android/sysandroid.inc

@@ -215,9 +215,10 @@ end;
 
 const
   IOBufferLength = 512;
-var
+threadvar
   IOBuf : array[0..IOBufferLength] of char;
   IOLen : SizeInt;
+var
   IORedirected: boolean;
 
 procedure OutputIOBuffer(Var F: TextRec);
@@ -235,12 +236,16 @@ end;
 procedure IOWrite(Var F: TextRec);
 var
   i, len : SizeInt;
+  pIOBuf: PAnsiChar;
+  pIOLen: ^SizeInt;
 Begin
+  pIOBuf:=@IOBuf;
+  pIOLen:=@IOLen;
   while F.BufPos>0 do
     begin
       begin
-        if F.BufPos + IOLen > IOBufferLength then
-          len:=IOBufferLength - IOLen
+        if F.BufPos + pIOLen^ > IOBufferLength then
+          len:=IOBufferLength - pIOLen^
         else
           len:=F.BufPos;
         i:=0;
@@ -248,7 +253,7 @@ Begin
           begin
             if F.bufptr^[i] in [#10, #13] then
               begin
-                IOBuf[IOLen]:=#0;
+                pIOBuf[pIOLen^]:=#0;
                 OutputIOBuffer(F);
                 Inc(i);
                 if (i < len) and (F.bufptr^[i - 1] = #13) and (F.bufptr^[i] = #10) then
@@ -256,14 +261,14 @@ Begin
               end
             else
               begin
-                IOBuf[IOLen]:=F.bufptr^[i];
-                Inc(IOLen);
+                pIOBuf[pIOLen^]:=F.bufptr^[i];
+                Inc(pIOLen^);
                 Inc(i);
               end;
           end;
-        IOBuf[IOLen]:=#0;
+        pIOBuf[pIOLen^]:=#0;
       end;
-      if IOLen = IOBufferLength then
+      if pIOLen^ = IOBufferLength then
         OutputIOBuffer(F);
       Dec(F.BufPos, len);
     end;
@@ -311,6 +316,13 @@ begin
   DefaultLogTag[len + 1]:=#0;
 end;
 
+procedure InitStdIOAndroid;
+begin
+  if not IORedirected then exit;
+  IORedirected:=False;
+  RedirectOutputToSysLog;
+end;
+
 // ************* System init
 
 procedure InitAndroid;

rtl/embedded/Makefile

@@ -354,7 +354,7 @@ CPU_UNITS=
 SYSINIT_UNITS=
 CPU_SPECIFIC_COMMON_UNITS=
 ifeq ($(ARCH),arm)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),armv7m)
 CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 lm4f120 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
 CPU_UNITS_DEFINED=1
@@ -429,7 +429,7 @@ $(error No CPUs enabled for given SUBARCH, pass either a SUBARCH or set CPU_UNIT
 endif
 endif
 ifeq ($(ARCH),i386)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 CPU_UNITS=multiboot
 CPU_UNITS_DEFINED=1
 ifeq ($(CPU_UNITS_DEFINED),)
@@ -437,13 +437,13 @@ $(error No CPUs enabled for given SUBARCH, pass either a SUBARCH or set CPU_UNIT
 endif
 endif
 ifeq ($(ARCH),x86_64)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 endif
 ifeq ($(ARCH),m68k)
 CPU_SPECIFIC_COMMON_UNITS=sysutils math
 endif
 ifeq ($(ARCH),mipsel)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),pic32mx)
 CPU_UNITS=pic32mx1xxfxxxb pic32mx2xxfxxxb pic32mx1xxfxxxc pic32mx2xxfxxxc pic32mx1xxfxxxd pic32mx2xxfxxxd pic32mx7x5fxxxl pic32mx7x5fxxxh
 CPU_UNITS_DEFINED=1
@@ -455,280 +455,280 @@ endif
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc-aix)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-haiku)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-iphonesim)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),x86_64-dragonfly)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-netbsd)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),arm-aros)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),powerpc64-aix)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),mips-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),mipsel-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),jvm-java)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),jvm-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i8086-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i8086-msdos)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i8086-win16)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),aarch64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),aarch64-darwin)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),aarch64-android)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),wasm-wasm)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),sparc64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),riscv32-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),riscv32-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),riscv64-linux)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),riscv64-embedded)
-override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) dos ctypes charset cpall sysconst
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_LOADERS+=$(LOADERS)

rtl/embedded/Makefile.fpc

@@ -12,7 +12,7 @@ loaders=$(LOADERS)
 # not all targets include enough features to build all units so
 # the common units which are not compiled for all CPUs are stored in
 # CPU_SPECIFIC_COMMON_UNITS
-units=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio $(CPU_SPECIFIC_COMMON_UNITS) \
+units=$(SYSTEMUNIT) $(CPU_UNITS) uuchar objpas iso7185 extpas strings heapmgr consoleio sortbase $(CPU_SPECIFIC_COMMON_UNITS) \
 # macpas iso7185 strings
        dos \
        ctypes \
@@ -69,7 +69,7 @@ SYSINIT_UNITS=
 CPU_SPECIFIC_COMMON_UNITS=
 
 ifeq ($(ARCH),arm)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),armv7m)
 CPU_UNITS=lm3fury lm3tempest stm32f10x_ld stm32f10x_md stm32f10x_hd stm32f10x_xl stm32f10x_conn stm32f10x_cl lpc13xx lpc1768 lm4f120 sam3x8e xmc4500 cortexm3 cortexm4 # thumb2_bare
 CPU_UNITS_DEFINED=1
@@ -146,7 +146,7 @@ endif
 endif
 
 ifeq ($(ARCH),i386)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 CPU_UNITS=multiboot
 CPU_UNITS_DEFINED=1
 ifeq ($(CPU_UNITS_DEFINED),)
@@ -155,7 +155,7 @@ endif
 endif
 
 ifeq ($(ARCH),x86_64)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 # CPU_UNITS=multiboot
 endif
 
@@ -165,7 +165,7 @@ CPU_SPECIFIC_COMMON_UNITS=sysutils math
 endif
 
 ifeq ($(ARCH),mipsel)
-CPU_SPECIFIC_COMMON_UNITS=sysutils math sortbase classes fgl macpas typinfo types rtlconsts getopts lineinfo
+CPU_SPECIFIC_COMMON_UNITS=sysutils math classes fgl macpas typinfo types rtlconsts getopts lineinfo
 ifeq ($(SUBARCH),pic32mx)
 CPU_UNITS=pic32mx1xxfxxxb pic32mx2xxfxxxb pic32mx1xxfxxxc pic32mx2xxfxxxc pic32mx1xxfxxxd pic32mx2xxfxxxd pic32mx7x5fxxxl pic32mx7x5fxxxh
 CPU_UNITS_DEFINED=1

rtl/i8086/i8086.inc

@@ -137,7 +137,14 @@ asm
   add di, cx
   dec si
   dec di
-  rep movsb  // todo: movsw
+  dec si
+  dec di
+  shr cx, 1
+  rep movsw
+  adc cx, cx
+  inc si
+  inc di
+  rep movsb
   cld
 
 @@AfterMove:
@@ -183,7 +190,14 @@ asm
   add di, cx
   dec si
   dec di
-  rep movsb  // todo: movsw
+  dec si
+  dec di
+  shr cx, 1
+  rep movsw
+  adc cx, cx
+  inc si
+  inc di
+  rep movsb
   cld
 
 @@AfterMove:
@@ -500,6 +514,38 @@ end;
 {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
 
 
+{$ifndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
+{$define FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
+function fpc_pwidechar_length(p:pwidechar):sizeint;assembler;nostackframe;[public,alias:'FPC_PWIDECHAR_LENGTH']; compilerproc;
+asm
+  mov bx, sp
+{$ifdef FPC_X86_DATA_NEAR}
+  mov ax, ss:[bx + 2 + extra_param_offset]  // p
+  test ax, ax
+  jz @@Done
+  xchg ax, di
+  mov ax, ds
+  mov es, ax
+{$else FPC_X86_DATA_NEAR}
+  les di, ss:[bx + 2 + extra_param_offset]  // p
+  mov ax, es
+  or ax, di
+  jz @@Done
+{$endif FPC_X86_DATA_NEAR}
+  mov cx, 0FFFFh
+  xor ax, ax
+{$ifdef FPC_ENABLED_CLD}
+  cld
+{$endif FPC_ENABLED_CLD}
+  repne scasw
+  dec ax
+  dec ax
+  sub ax, cx
+@@Done:
+end;
+{$endif FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}
+
+
 {$define FPC_SYSTEM_HAS_SPTR}
 Function Sptr : Pointer;assembler;nostackframe;
 asm
@@ -1197,33 +1243,21 @@ procedure DetectFPU;
 
 {$ifndef FPC_SYSTEM_HAS_SYSINITFPU}
 {$define FPC_SYSTEM_HAS_SYSINITFPU}
-Procedure SysInitFPU;
-  var
-    { these locals are so we don't have to hack pic code in the assembler }
-    localfpucw: word;
-  begin
-    localfpucw:=Default8087CW;
-    asm
-      fninit
-      fldcw   localfpucw
-      fwait
-    end;
+Procedure SysInitFPU; assembler;
+  asm
+    fninit
+    fldcw   Default8087CW
+    fwait
   end;
 
 {$endif ndef FPC_SYSTEM_HAS_SYSINITFPU}
 
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
-Procedure SysResetFPU;
-  var
-    { these locals are so we don't have to hack pic code in the assembler }
-    localfpucw: word;
-  begin
-    localfpucw:=Default8087CW;
-    asm
-      fninit
-      fwait
-      fldcw   localfpucw
-    end;
+Procedure SysResetFPU; assembler;
+  asm
+    fninit
+    fwait
+    fldcw   Default8087CW
   end;
 
 {$I int32p.inc}

rtl/inc/objc.pp

@@ -3,6 +3,9 @@ unit objc;
 
 {$ifdef darwin}
 {$define targethandled}
+
+{$linklib objc}
+
 {$if defined(iphonesim) or defined(cpuarm) or defined(cpux86_64) or defined(cpupowerpc64) or defined(cpuaarch64)}
 {$i objcnf.inc}
 {$endif}

rtl/inc/sortbase.pp

@@ -41,9 +41,41 @@ type
     ItemListSorter_CustomItemExchanger_ContextComparer: TItemListSorter_CustomItemExchanger_Context;
   end;
 
-procedure QuickSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
-procedure QuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
-procedure QuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+{
+                       QuickSort
+
+  Average performance: O(n log n)
+    Worst performance: O(n*n)
+     Extra memory use: O(log n) on the stack
+               Stable: no
+     Additional notes: Uses the middle element as the pivot. This makes it work
+                       well also on already sorted sequences, which can occur
+                       often in practice. As expected from QuickSort, it works
+                       best on random sequences and is usually the fastest
+                       algorithm to sort them. It is, however, possible for a
+                       malicious user to craft special sequences, which trigger
+                       its worst O(n*n) case. They can also occur in practice,
+                       although they are very unlikely. If this is not an
+                       acceptable risk (e.g. for high risk applications,
+                       security-conscious applications or applications with hard
+                       real-time requirements), another sorting algorithm must
+                       be used.
+}
+
+procedure QuickSort_PtrList_NoContext(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_NoContext);
+procedure QuickSort_PtrList_Context(
+                ItemPtrs: PPointer;
+                ItemCount: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
+procedure QuickSort_ItemList_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Context: Pointer);
 procedure QuickSort_ItemList_CustomItemExchanger_Context(
                 Items: Pointer;
                 ItemCount, ItemSize: SizeUInt;
@@ -64,44 +96,61 @@ var
 
 implementation
 
-Procedure QuickSort_PtrList_NoContext(ItemPtrs: PPointer; L, R : Longint;
+Procedure QuickSort_PtrList_NoContext(ItemPtrs: PPointer; L, R : SizeUInt;
                                       Comparer: TListSortComparer_NoContext);
 var
-  I, J : Longint;
+  I, J, PivotIdx : SizeUInt;
   P, Q : Pointer;
 begin
  repeat
    I := L;
    J := R;
-   P := ItemPtrs[ (L + R) div 2 ];
+   PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+   P := ItemPtrs[PivotIdx];
    repeat
-     while Comparer(P, ItemPtrs[i]) > 0 do
+     while (I < PivotIdx) and (Comparer(P, ItemPtrs[i]) > 0) do
        Inc(I);
-     while Comparer(P, ItemPtrs[J]) < 0 do
+     while (J > PivotIdx) and (Comparer(P, ItemPtrs[J]) < 0) do
        Dec(J);
-     If I <= J then
+     if I < J then
      begin
        Q := ItemPtrs[I];
        ItemPtrs[I] := ItemPtrs[J];
        ItemPtrs[J] := Q;
-       Inc(I);
-       Dec(J);
+       if PivotIdx = I then
+       begin
+         PivotIdx := J;
+         Inc(I);
+       end
+       else if PivotIdx = J then
+       begin
+         PivotIdx := I;
+         Dec(J);
+       end
+       else
+       begin
+         Inc(I);
+         Dec(J);
+       end;
      end;
-   until I > J;
+   until I >= J;
    // sort the smaller range recursively
    // sort the bigger range via the loop
    // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
-   if J - L < R - I then
+   if (PivotIdx - L) < (R - PivotIdx) then
    begin
-     if L < J then
-       QuickSort_PtrList_NoContext(ItemPtrs, L, J, Comparer);
-     L := I;
+     if (L + 1) < PivotIdx then
+       QuickSort_PtrList_NoContext(ItemPtrs, L, PivotIdx - 1, Comparer);
+     L := PivotIdx + 1;
    end
    else
    begin
-     if I < R then
-       QuickSort_PtrList_NoContext(ItemPtrs, I, R, Comparer);
-     R := J;
+     if (PivotIdx + 1) < R then
+       QuickSort_PtrList_NoContext(ItemPtrs, PivotIdx + 1, R, Comparer);
+     if (L + 1) < PivotIdx then
+       R := PivotIdx - 1
+     else
+       exit;
    end;
  until L >= R;
 end;
@@ -115,43 +164,60 @@ end;
 
 procedure QuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
 
-  procedure QuickSort(L, R : Longint);
+  procedure QuickSort(L, R : SizeUInt);
   var
-    I, J : Longint;
+    I, J, PivotIdx : SizeUInt;
     P, Q : Pointer;
   begin
     repeat
       I := L;
       J := R;
-      P := ItemPtrs[ (L + R) div 2 ];
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := ItemPtrs[PivotIdx];
       repeat
-        while Comparer(P, ItemPtrs[I], Context) > 0 do
+        while (I < PivotIdx) and (Comparer(P, ItemPtrs[I], Context) > 0) do
           Inc(I);
-        while Comparer(P, ItemPtrs[J], Context) < 0 do
+        while (J > PivotIdx) and (Comparer(P, ItemPtrs[J], Context) < 0) do
           Dec(J);
-        If I <= J then
+        if I < J then
         begin
           Q := ItemPtrs[I];
           ItemPtrs[I] := ItemPtrs[J];
           ItemPtrs[J] := Q;
-          Inc(I);
-          Dec(J);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            Inc(I);
+          end
+          else if PivotIdx = J then
+          begin
+            PivotIdx := I;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
+          end;
         end;
-      until I > J;
+      until I >= J;
       // sort the smaller range recursively
       // sort the bigger range via the loop
       // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
-      if J - L < R - I then
+      if (PivotIdx - L) < (R - PivotIdx) then
       begin
-        if L < J then
-          QuickSort(L, J);
-        L := I;
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
       end
       else
       begin
-        if I < R then
-          QuickSort(I, R);
-        R := J;
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
       end;
     until L >= R;
   end;
@@ -167,50 +233,62 @@ procedure QuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUI
 var
   TempBuf: Pointer;
 
-  procedure QuickSort(L, R : Longint);
+  procedure QuickSort(L, R : SizeUInt);
   var
-    I, J : Longint;
+    I, J, PivotIdx : SizeUInt;
     P : Pointer;
   begin
     repeat
       I := L;
       J := R;
-      P := Items + ItemSize*((L + R) div 2);
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := Items + ItemSize*PivotIdx;
       repeat
-        while Comparer(P, Items + ItemSize*I, Context) > 0 do
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
           Inc(I);
-        while Comparer(P, Items + ItemSize*J, Context) < 0 do
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
           Dec(J);
-        If I <= J then
+        if I < J then
         begin
-          if I < J then
+          Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
+          Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
+          Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
           begin
-            Move((Items + ItemSize*I)^, TempBuf^, ItemSize);
-            Move((Items + ItemSize*J)^, (Items + ItemSize*I)^, ItemSize);
-            Move(TempBuf^, (Items + ItemSize*J)^, ItemSize);
-            if P = (Items + ItemSize*I) then
-              P := Items + ItemSize*J
-            else if P = (Items + ItemSize*J) then
-              P := Items + ItemSize*I;
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
           end;
-          Inc(I);
-          Dec(J);
         end;
-      until I > J;
+      until I >= J;
       // sort the smaller range recursively
       // sort the bigger range via the loop
       // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
-      if J - L < R - I then
+      if (PivotIdx - L) < (R - PivotIdx) then
       begin
-        if L < J then
-          QuickSort(L, J);
-        L := I;
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
       end
       else
       begin
-        if I < R then
-          QuickSort(I, R);
-        R := J;
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
       end;
     until L >= R;
   end;
@@ -219,8 +297,11 @@ begin
   if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
     exit;
   GetMem(TempBuf, ItemSize);
-  QuickSort(0, ItemCount - 1);
-  FreeMem(TempBuf, ItemSize);
+  try
+    QuickSort(0, ItemCount - 1);
+  finally
+    FreeMem(TempBuf, ItemSize);
+  end;
 end;
 
 procedure QuickSort_ItemList_CustomItemExchanger_Context(
@@ -230,48 +311,60 @@ procedure QuickSort_ItemList_CustomItemExchanger_Context(
                 Exchanger: TListSortCustomItemExchanger_Context;
                 Context: Pointer);
 
-  procedure QuickSort(L, R : Longint);
+  procedure QuickSort(L, R : SizeUInt);
   var
-    I, J : Longint;
+    I, J, PivotIdx : SizeUInt;
     P : Pointer;
   begin
     repeat
       I := L;
       J := R;
-      P := Items + ItemSize*((L + R) div 2);
+      PivotIdx := L + ((R - L) shr 1); { same as ((L + R) div 2), but without the possibility of overflow }
+      P := Items + ItemSize*PivotIdx;
       repeat
-        while Comparer(P, Items + ItemSize*I, Context) > 0 do
+        while (I < PivotIdx) and (Comparer(P, Items + ItemSize*I, Context) > 0) do
           Inc(I);
-        while Comparer(P, Items + ItemSize*J, Context) < 0 do
+        while (J > PivotIdx) and (Comparer(P, Items + ItemSize*J, Context) < 0) do
           Dec(J);
-        If I <= J then
+        if I < J then
         begin
-          if I < J then
+          Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
+          if PivotIdx = I then
+          begin
+            PivotIdx := J;
+            P := Items + ItemSize*PivotIdx;
+            Inc(I);
+          end
+          else if PivotIdx = J then
           begin
-            Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
-            if P = (Items + ItemSize*I) then
-              P := Items + ItemSize*J
-            else if P = (Items + ItemSize*J) then
-              P := Items + ItemSize*I;
+            PivotIdx := I;
+            P := Items + ItemSize*PivotIdx;
+            Dec(J);
+          end
+          else
+          begin
+            Inc(I);
+            Dec(J);
           end;
-          Inc(I);
-          Dec(J);
         end;
-      until I > J;
+      until I >= J;
       // sort the smaller range recursively
       // sort the bigger range via the loop
       // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
-      if J - L < R - I then
+      if (PivotIdx - L) < (R - PivotIdx) then
       begin
-        if L < J then
-          QuickSort(L, J);
-        L := I;
+        if (L + 1) < PivotIdx then
+          QuickSort(L, PivotIdx - 1);
+        L := PivotIdx + 1;
       end
       else
       begin
-        if I < R then
-          QuickSort(I, R);
-        R := J;
+        if (PivotIdx + 1) < R then
+          QuickSort(PivotIdx + 1, R);
+        if (L + 1) < PivotIdx then
+          R := PivotIdx - 1
+        else
+          exit;
       end;
     until L >= R;
   end;

rtl/linux/system.pp

@@ -584,6 +584,9 @@ begin
   OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{$ifdef android}
+  InitStdIOAndroid;
+{$endif android}
 end;
 
 Procedure RestoreOldSignalHandlers;