Merged revisions 6745,6755,6765,6771-6772,6784,6796-6797,6800,6806,6808-6809,6815,6824,6832,6836,6842-6843,6864-6866,6868-6869,6872,6882-6883,6889,6891,6893-6894,6896,6898,6901-6903,6908,6915-6916,6921-6922,6924-6925,6927-6928,6930,6943-6946,6952,6954,6956,6974,6976,6996-6997,7002,7007,7016,7020-7021,7033,7036-7037,7040,7042,7045,7068-7069,7075-7079,7087,7094,7098-7099,7101,7103,7109,7115-7119,7128,7136-7137,7139,7150,7153-7154,7156,7160-7162,7175-7177,7179,7188,7190-7195,7198,7202,7205-7206,7208-7217,7220-7222,7225-7228,7230,7233,7239-7241,7244,7246,7263,7275,7277,7279-7281,7285,7288-7289,7291-7293,7296,7300,7303,7310,7318,7340-7341,7343,7345,7372-7373,7375-7376,7379,7381,7383-7388,7391-7392,7395,7398-7400,7402-7406,7411,7422,7425,7436,7441-7442,7444-7445,7450,7456,7463,7467,7475,7479,7486,7504,7506-7509,7522,7527,7534-7536,7558-7559,7563-7565,7567,7570-7571,7573-7576,7586,7589,7592-7594,7607,7612,7615,7619-7620,7622-7623,7626,7628,7631,7633,7646,7663,7677,7681-7683,7689,7697,7704-7712,7725,7736,7738,7740,7744-7746,7751,7753,7764,7767,7769-7770,7776-7777,7788,7830,7836-7839,7846,7849,7858-7859,7862,7864-7865,7869,7872-7875,7877,7880,7882,7918-7919,7922,7927-7929,7953,7961,7967,7971,7986-7987,7990-7994,7998-8000,8004-8006,8008-8012,8016,8027,8034,8036-8037,8039,8044,8046,8048,8051,8060,8071,8075-8076,8082-8083,8087-8089,8095-8096,8099-8100,8108,8111,8136,8187,8190,8199,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8302,8307,8309,8316,8318-8319,8323,8336,8338-8340,8344,8361,8369,8385 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r6745 | jonas | 2007-03-06 17:10:56 +0100 (Tue, 06 Mar 2007) | 7 lines
  
    * changed cpurequiresproperalignment from a compile-time define into
      a target flag, since some kernels may be able to handle alignment
      problems, and the alignment requirements may not be absolute (e.g. on
      ppc64, only 8 byte values need alignment, and only to 4 byte boundaries)
     -> linux/ppc64 has tf_requires_proper_alignment set in its target flags,
        darwin/ppc64 hasn't
........
  r6832 | jonas | 2007-03-13 23:27:55 +0100 (Tue, 13 Mar 2007) | 4 lines
  
    + support for simplifying simple inline functions down to a single
      constant node (rather than to just a blocknode with a statement
      assigning a constant to a temp)
........
  r6836 | jonas | 2007-03-14 00:17:12 +0100 (Wed, 14 Mar 2007) | 9 lines
  
    * moved typechecking stuff from taddnode.simplify to taddnode.pass_typechec
      This is needed to be able to call simplify after pass_1, because
      otherwise the inserttypeconv's inserted new type conversions which
      where never firstpassed (if you want to do something like that, you
      have to return a new node as well so it will be firstpassed properly
      -- but in this case it seems this is not needed, since inserting
      those typeconversions are part of typechecking and not of simplifying,
      and typechecking must be done before simplifying anyway)
........
  r6915 | jonas | 2007-03-18 13:20:01 +0100 (Sun, 18 Mar 2007) | 9 lines
  
    * changed *string_to_*chararray helpers from functions into procedures
      because on win64 the location of a function result can depend on its
      size (so some chararrays had to be returned in registers and others
      by reference, which means it's impossible to have a generic function
      declaration which works in all cases) (mantis #8533)
    * pad constant string assignments to chararrays with #0 up to the
      length of the chararray for 2.0.x compatibility (fixes
      tests/test/tarray3)
........
  r7036 | jonas | 2007-03-30 14:13:22 +0200 (Fri, 30 Mar 2007) | 2 lines
  
    * r7035 for darwin/ppc64
........
  r7153 | florian | 2007-04-22 20:53:44 +0200 (Sun, 22 Apr 2007) | 2 lines
  
  * gcc 3.x cpp name mangling
........
  r7154 | florian | 2007-04-22 21:49:56 +0200 (Sun, 22 Apr 2007) | 2 lines
  
  * pass this to C++ methods always by reference
........
  r7156 | florian | 2007-04-22 21:55:05 +0200 (Sun, 22 Apr 2007) | 3 lines
  
  * allow external in cppclasses
  * don't insert vmt pointer for C++ constructor/destructor calls
........
  r7176 | daniel | 2007-04-26 23:48:18 +0200 (Thu, 26 Apr 2007) | 4 lines
  
    + Add optimization to optimize [0..31]-x set expression to use one less
      register. This construction is used in our Shootout meteor contest
      implementation.
........
  r7177 | daniel | 2007-04-27 15:35:25 +0200 (Fri, 27 Apr 2007) | 2 lines
  
    * Improve comment for [0..31]-x optimization
........
  r7188 | daniel | 2007-04-29 12:32:18 +0200 (Sun, 29 Apr 2007) | 2 lines
  
    + Add peoplehole optimization to optimize "smallset+[x]" and "smallset-[x]".
........
  r7395 | jonas | 2007-05-19 19:15:15 +0200 (Sat, 19 May 2007) | 18 lines
  
    * new internal set format for big endian systems. Advantages:
      * varsets ({$packset x}) are now supported on big endian targets
      * gdb now displays sets properly on big endian systems
      * cleanup of generic set code (in, include/exclude, helpers), all
        based on "bitpacked array[] of 0..1" now
    * there are no helpers available yet to convert sets from the old to
      the new format, because the set format will change again slightly
      in the near future (so that e.g. a set of 24..31 will be stored in
      1 byte), and creating two classes of set conversion helpers would
      confuse things (i.e., it's not recommended to use trunk currently for
      programs  which load sets stored to disk by big endian programs compiled
      by previous FPC versions)
    * cross-endian compiling has been tested and still works, but one case
      is not supported: compiling a compiler for a different endianess
      using a starting compiler from before the current revision (so first
      cycle natively, and then use the newly created compiler to create a
      cross-compiler)
........
  r7398 | jonas | 2007-05-19 20:53:24 +0200 (Sat, 19 May 2007) | 5 lines
  
    * also check for properties passed to read(ln) when reading integers
      different from the native size, or when reading enums (because those
      are handled via a temp internally -> regular var parameter checks
      were not automatically performed)
........
  r7399 | jonas | 2007-05-19 22:15:55 +0200 (Sat, 19 May 2007) | 2 lines
  
    * fixed some varset helpers broken in the previous commit
........
  r7402 | jonas | 2007-05-20 12:25:48 +0200 (Sun, 20 May 2007) | 3 lines
  
    * fixed unportable soft float mask handling which broke on big endian
      systems after yesterday's set changes
........
  r7403 | jonas | 2007-05-20 13:19:36 +0200 (Sun, 20 May 2007) | 3 lines
  
    - removed/disabled all normalset code (except for bootstrapping), since
      it's no longer needed
........
  r7858 | daniel | 2007-06-30 09:54:50 +0200 (Sat, 30 Jun 2007) | 3 lines
  
    * Convert to system unit endian swap routines.
    * Endian conversion should be done while reading only, not while writing.
........
  r7859 | daniel | 2007-06-30 10:13:46 +0200 (Sat, 30 Jun 2007) | 3 lines
  
    * Change rest of compiler to system unit swapendian routines.
    - Remove endian swapping routines from cutils.
........
  r7873 | daniel | 2007-06-30 21:48:27 +0200 (Sat, 30 Jun 2007) | 2 lines
  
    * Reals can need endian conversions too.
........
  r7874 | daniel | 2007-06-30 22:38:59 +0200 (Sat, 30 Jun 2007) | 2 lines
  
    * Add endian swapping for deflistsize and symlistsize.
........
  r7875 | daniel | 2007-06-30 22:43:15 +0200 (Sat, 30 Jun 2007) | 2 lines
  
    * ... and when writing too.
........
  r7880 | daniel | 2007-06-30 23:45:20 +0200 (Sat, 30 Jun 2007) | 2 lines
  
    * Convert guid load/save to endian safe code.
........
  r7918 | daniel | 2007-07-02 00:30:43 +0200 (Mon, 02 Jul 2007) | 2 lines
  
    * Fix set endian handling.
........
  r7919 | daniel | 2007-07-02 08:18:38 +0200 (Mon, 02 Jul 2007) | 2 lines
  
    * Fix endian issue in ppuload/ppuwrite.
........
  r7922 | daniel | 2007-07-02 21:23:30 +0200 (Mon, 02 Jul 2007) | 2 lines
  
    - Remove hexstr implementation.
........
  r8108 | jonas | 2007-07-20 18:49:35 +0200 (Fri, 20 Jul 2007) | 9 lines
  
    * fixed calling inline functions (with exit statements) from inside
      finally blocks
    * fixed the handling of function results of inlined functions with
      exit statements
    + test for the above two issues and for bug fixed in r8091
    * copy may_be_in_reg field inside ttempcreatenode.dogetcopy (allows
      some more temps which were needlessly forced into memory to be in
      registers)
........
  r8111 | daniel | 2007-07-21 12:29:09 +0200 (Sat, 21 Jul 2007) | 2 lines
  
    - Remove long2hex, replace by hexstr.
........
  r8199 | jonas | 2007-07-29 21:37:06 +0200 (Sun, 29 Jul 2007) | 3 lines
  
    * changed boolean fields in ttempinfo to a set for easier
      extensibility without increasing the size of the record
........
  r8323 | jonas | 2007-08-28 21:38:40 +0200 (Tue, 28 Aug 2007) | 6 lines
  
    * always demote type conversions which cannot represent part of the
      source value to convert_l3, instead of only those with a destination
      type whose size is < source size (like Delphi) + test -> fixes
      toperator6 along with a host of wrong tordconst typeconversions in
      the compiler sources themselves (although most are harmless)
........
  r8344 | jonas | 2007-08-31 19:03:33 +0200 (Fri, 31 Aug 2007) | 2 lines
  
    * save/load LinkOtherFrameworks to/from ppu files
........
  r8361 | jonas | 2007-09-02 23:27:37 +0200 (Sun, 02 Sep 2007) | 5 lines
  
    * fixed tests/cg/opt/tretopt, and also in more cases
      perform the transformation of x:=f(hiddencomplexresult, ..)
      -> f(x, ...) (the compiler now performs some very
      conservative escape analysis for such types)
........
  r8369 | jonas | 2007-09-03 17:55:26 +0200 (Mon, 03 Sep 2007) | 4 lines
  
    * fixed mantis #9522: no longer allow typecasting ordinal constants
      to complex types (caused a lot of internal errors later on, and
      was also Delphi-incompatible)
........
  r8385 | jonas | 2007-09-05 15:29:22 +0200 (Wed, 05 Sep 2007) | 6 lines
  
    * Improved escape analysis so the improved tretopt no longer fails.
      The downside is that because it is context-insensitive, several
      (correct) optimizations which were performed in the past no longer
      are now (and while some new ones are done now, the downside is bigger
      -- but at least the code should be correct in all cases now)
........

git-svn-id: branches/fixes_2_2@8681 -

compiler/cgobj.pas

@@ -237,6 +237,24 @@ unit cgobj;
           procedure a_load_subsetref_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsref: tsubsetreference; const tosreg: tsubsetregister); virtual;
           procedure a_load_subsetreg_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsreg: tsubsetregister; const tosref: tsubsetreference); virtual;
 
+          { bit test instructions }
+          procedure a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tcgsize;bitnumber,value,destreg: tregister); virtual;
+          procedure a_bit_test_const_ref_reg(list: TAsmList; destsize: tcgsize; bitnumber: aint; const ref: treference; destreg: tregister); virtual;
+          procedure a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: aint; setreg, destreg: tregister); virtual;
+          procedure a_bit_test_const_subsetreg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister); virtual;
+          procedure a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const ref: treference; destreg: tregister); virtual;
+          procedure a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const loc: tlocation; destreg: tregister);
+          procedure a_bit_test_const_loc_reg(list: TAsmList; destsize: tcgsize; bitnumber: aint; const loc: tlocation; destreg: tregister);
+
+          { bit set/clear instructions }
+          procedure a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tcgsize; bitnumber,dest: tregister); virtual;
+          procedure a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tcgsize; bitnumber: aint; const ref: treference); virtual;
+          procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: aint; destreg: tregister); virtual;
+          procedure a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: aint; const destreg: tsubsetregister); virtual;
+          procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference); virtual;
+          procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const loc: tlocation);
+          procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; bitnumber: aint; const loc: tlocation);
+
           { fpu move instructions }
           procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract;
           procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
@@ -463,6 +481,10 @@ unit cgobj;
 
           procedure a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); virtual;
           procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); virtual;
+
+          function get_bit_const_ref_sref(bitnumber: aint; const ref: treference): tsubsetreference;
+          function get_bit_const_reg_sreg(setregsize: tcgsize; bitnumber: aint; setreg: tregister): tsubsetregister;
+          function get_bit_reg_ref_sref(list: TAsmList; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference): tsubsetreference;
        end;
 
 {$ifndef cpu64bit}
@@ -1152,9 +1174,9 @@ implementation
       begin
         intloadsize := packedbitsloadsize(sref.bitlen);
 
-{$if defined(cpurequiresproperalignment) and not defined(arm) and not(defined(sparc))}
+{$if not(defined(arm)) and not(defined(sparc))}
         { may need to be split into several smaller loads/stores }
-        if {(tf_requires_proper_alignment in target_info.flags) and }
+        if (tf_requires_proper_alignment in target_info.flags) and
            (intloadsize <> 1) and
            (intloadsize <> sref.ref.alignment) then
           internalerror(2006082011);
@@ -1325,7 +1347,7 @@ implementation
         loadbitsize := tcgsize2size[loadsize]*8;
 
         { load the (first part) of the bit sequence }
-        valuereg := cg.getintregister(list,OS_INT);
+        valuereg := getintregister(list,OS_INT);
         a_load_ref_reg(list,loadsize,OS_INT,sref.ref,valuereg);
 
         if not extra_load then
@@ -1414,6 +1436,7 @@ implementation
         tmpreg, tmpindexreg, valuereg, extra_value_reg, maskreg: tregister;
         tosreg, fromsreg: tsubsetregister;
         tmpref: treference;
+        bitmask: aword;
         loadsize: tcgsize;
         loadbitsize: byte;
         extra_load: boolean;
@@ -1426,7 +1449,7 @@ implementation
         loadbitsize := tcgsize2size[loadsize]*8;
 
         { load the (first part) of the bit sequence }
-        valuereg := cg.getintregister(list,OS_INT);
+        valuereg := getintregister(list,OS_INT);
         a_load_ref_reg(list,loadsize,OS_INT,sref.ref,valuereg);
 
         { constant offset of bit sequence? }
@@ -1454,21 +1477,20 @@ implementation
                 if (sref.bitlen = AIntBits) then
                   internalerror(2006081711);
 
-                { calculated correct shiftcount for big endian }
-                tmpindexreg := getintregister(list,OS_INT);
-                a_load_reg_reg(list,OS_INT,OS_INT,sref.bitindexreg,tmpindexreg);
-                if (target_info.endian = endian_big) then
-                  begin
-                    a_op_const_reg(list,OP_SUB,OS_INT,loadbitsize-sref.bitlen,tmpindexreg);
-                    a_op_reg_reg(list,OP_NEG,OS_INT,tmpindexreg,tmpindexreg);
-                  end;
-
                 { zero the bits we have to insert }
                 if (slopt <> SL_SETMAX) then
                   begin
                     maskreg := getintregister(list,OS_INT);
-                    a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen)-1),maskreg);
-                    a_op_reg_reg(list,OP_SHL,OS_INT,tmpindexreg,maskreg);
+                    if (target_info.endian = endian_big) then
+                      begin
+                        a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg);
+                        a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,maskreg);
+                      end
+                    else
+                      begin
+                        a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen)-1),maskreg);
+                        a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,maskreg);
+                      end;
                     a_op_reg_reg(list,OP_NOT,OS_INT,maskreg,maskreg);
                     a_op_reg_reg(list,OP_AND,OS_INT,maskreg,valuereg);
                   end;
@@ -1483,9 +1505,25 @@ implementation
                       a_load_const_reg(list,OS_INT,aint((aword(1) shl sref.bitlen) - 1), tmpreg)
                     else
                       a_load_const_reg(list,OS_INT,-1,tmpreg);
-                    if (slopt <> SL_REGNOSRCMASK) then
-                      a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),tmpreg);
-                    a_op_reg_reg(list,OP_SHL,OS_INT,tmpindexreg,tmpreg);
+                    if (target_info.endian = endian_big) then
+                      begin
+                        a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.bitlen,tmpreg);
+                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
+                          begin
+                            if (loadbitsize <> AIntBits) then
+                              bitmask := (((aword(1) shl loadbitsize)-1) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1))
+                            else
+                              bitmask := (high(aword) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1));
+                            a_op_const_reg(list,OP_AND,OS_INT,bitmask,tmpreg);
+                          end;
+                        a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,tmpreg);
+                      end
+                    else
+                      begin
+                        if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then
+                          a_op_const_reg(list,OP_AND,OS_INT,aint((aword(1) shl sref.bitlen)-1),tmpreg);
+                        a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,tmpreg);
+                      end;
                     a_op_reg_reg(list,OP_OR,OS_INT,tmpreg,valuereg);
                   end;
               end;
@@ -1813,6 +1851,279 @@ implementation
 {$undef overflowon}
 {$endif}
 
+    { generic bit address calculation routines }
+
+    function tcg.get_bit_const_ref_sref(bitnumber: aint; const ref: treference): tsubsetreference;
+      begin
+        result.ref:=ref;
+        inc(result.ref.offset,bitnumber div 8);
+        result.bitindexreg:=NR_NO;
+        result.startbit:=bitnumber mod 8;
+        result.bitlen:=1;
+      end;
+
+
+    function tcg.get_bit_const_reg_sreg(setregsize: tcgsize; bitnumber: aint; setreg: tregister): tsubsetregister;
+      begin
+        result.subsetreg:=setreg;
+        result.subsetregsize:=setregsize;
+        { subsetregs always count from the least significant to the most significant bit }
+        if (target_info.endian=endian_big) then
+          result.startbit:=(tcgsize2size[setregsize]*8)-bitnumber-1
+        else
+          result.startbit:=bitnumber;
+        result.bitlen:=1;
+      end;
+
+
+    function tcg.get_bit_reg_ref_sref(list: TAsmList; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference): tsubsetreference;
+      var
+        tmpreg,
+        tmpaddrreg: tregister;
+      begin
+        result.ref:=ref;
+        result.startbit:=0;
+        result.bitlen:=1;
+
+        tmpreg:=getintregister(list,bitnumbersize);
+        a_op_const_reg_reg(list,OP_SHR,bitnumbersize,3,bitnumber,tmpreg);
+        tmpaddrreg:=cg.getaddressregister(list);
+        a_load_reg_reg(list,bitnumbersize,OS_ADDR,tmpreg,tmpaddrreg);
+        if (result.ref.base=NR_NO) then
+          result.ref.base:=tmpaddrreg
+        else if (result.ref.index=NR_NO) then
+          result.ref.index:=tmpaddrreg
+        else
+          begin
+            a_op_reg_reg(list,OP_ADD,OS_ADDR,result.ref.index,tmpaddrreg);
+            result.ref.index:=tmpaddrreg;
+          end;
+        tmpreg:=getintregister(list,OS_INT);
+        a_op_const_reg_reg(list,OP_AND,OS_INT,7,bitnumber,tmpreg);
+        result.bitindexreg:=tmpreg;
+      end;
+
+
+    { bit testing routines }
+
+    procedure tcg.a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tcgsize;bitnumber,value,destreg: tregister);
+      var
+        tmpvalue: tregister;
+      begin
+        tmpvalue:=cg.getintregister(list,valuesize);
+
+        if (target_info.endian=endian_little) then
+          begin
+            { rotate value register "bitnumber" bits to the right }
+            a_op_reg_reg_reg(list,OP_SHR,valuesize,bitnumber,value,tmpvalue);
+            { extract the bit we want }
+            a_op_const_reg(list,OP_AND,valuesize,1,tmpvalue);
+          end
+        else
+          begin
+            { highest (leftmost) bit = bit 0 -> shl bitnumber results in wanted }
+            { bit in uppermost position, then move it to the lowest position    }
+            { "and" is not necessary since combination of shl/shr will clear    }
+            { all other bits                                                    }
+            a_op_reg_reg_reg(list,OP_SHL,valuesize,bitnumber,value,tmpvalue);
+            a_op_const_reg(list,OP_SHR,valuesize,tcgsize2size[valuesize]*8-1,tmpvalue);
+          end;
+        a_load_reg_reg(list,valuesize,destsize,tmpvalue,destreg);
+      end;
+
+
+    procedure tcg.a_bit_test_const_ref_reg(list: TAsmList; destsize: tcgsize; bitnumber: aint; const ref: treference; destreg: tregister);
+      begin
+        a_load_subsetref_reg(list,OS_8,destsize,get_bit_const_ref_sref(bitnumber,ref),destreg);
+      end;
+
+
+    procedure tcg.a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: aint; setreg, destreg: tregister);
+      begin
+        a_load_subsetreg_reg(list,setregsize,destsize,get_bit_const_reg_sreg(setregsize,bitnumber,setreg),destreg);
+      end;
+
+
+    procedure tcg.a_bit_test_const_subsetreg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: aint; const setreg: tsubsetregister; destreg: tregister);
+      var
+        tmpsreg: tsubsetregister;
+      begin
+        { the first parameter is used to calculate the bit offset in }
+        { case of big endian, and therefore must be the size of the  }
+        { set and not of the whole subsetreg                         }
+        tmpsreg:=get_bit_const_reg_sreg(setregsize,bitnumber,setreg.subsetreg);
+        { now fix the size of the subsetreg }
+        tmpsreg.subsetregsize:=setreg.subsetregsize;
+        { correct offset of the set in the subsetreg }
+        inc(tmpsreg.startbit,setreg.startbit);
+        a_load_subsetreg_reg(list,setregsize,destsize,tmpsreg,destreg);
+      end;
+
+
+    procedure tcg.a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const ref: treference; destreg: tregister);
+      begin
+        a_load_subsetref_reg(list,OS_8,destsize,get_bit_reg_ref_sref(list,bitnumbersize,bitnumber,ref),destreg);
+      end;
+
+
+    procedure tcg.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const loc: tlocation; destreg: tregister);
+      var
+        tmpreg: tregister;
+      begin
+        case loc.loc of
+          LOC_REFERENCE,LOC_CREFERENCE:
+            a_bit_test_reg_ref_reg(list,bitnumbersize,destsize,bitnumber,loc.reference,destreg);
+          LOC_REGISTER,LOC_CREGISTER,
+          LOC_SUBSETREG,LOC_CSUBSETREG,
+          LOC_CONSTANT:
+            begin
+              case loc.loc of
+                LOC_REGISTER,LOC_CREGISTER:
+                  tmpreg:=loc.register;
+                LOC_SUBSETREG,LOC_CSUBSETREG:
+                  begin
+                    tmpreg:=getintregister(list,loc.size);
+                    a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg);
+                  end;
+                LOC_CONSTANT:
+                  begin
+                    tmpreg:=getintregister(list,loc.size);
+                    a_load_const_reg(list,loc.size,loc.value,tmpreg);
+                  end;
+              end;
+              a_bit_test_reg_reg_reg(list,bitnumbersize,loc.size,destsize,bitnumber,tmpreg,destreg);
+            end;
+          { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
+          else
+            internalerror(2007051701);
+        end;
+      end;
+
+
+    procedure tcg.a_bit_test_const_loc_reg(list: TAsmList; destsize: tcgsize; bitnumber: aint; const loc: tlocation; destreg: tregister);
+      begin
+        case loc.loc of
+          LOC_REFERENCE,LOC_CREFERENCE:
+            a_bit_test_const_ref_reg(list,destsize,bitnumber,loc.reference,destreg);
+          LOC_REGISTER,LOC_CREGISTER:
+            a_bit_test_const_reg_reg(list,loc.size,destsize,bitnumber,loc.register,destreg);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_bit_test_const_subsetreg_reg(list,loc.size,destsize,bitnumber,loc.sreg,destreg);
+          { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
+          else
+            internalerror(2007051702);
+        end;
+      end;
+
+    { bit setting/clearing routines }
+
+    procedure tcg.a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tcgsize; bitnumber,dest: tregister);
+      var
+        tmpvalue: tregister;
+      begin
+        tmpvalue:=cg.getintregister(list,destsize);
+
+        if (target_info.endian=endian_little) then
+          begin
+            a_load_const_reg(list,destsize,1,tmpvalue);
+            { rotate bit "bitnumber" bits to the left }
+            a_op_reg_reg(list,OP_SHL,destsize,bitnumber,tmpvalue);
+          end
+        else
+          begin
+            { highest (leftmost) bit = bit 0 -> "$80/$8000/$80000000/ ... }
+            { shr bitnumber" results in correct mask                      }
+            a_load_const_reg(list,destsize,1 shl (tcgsize2size[destsize]*8-1),tmpvalue);
+            a_op_reg_reg(list,OP_SHR,destsize,bitnumber,tmpvalue);
+          end;
+        { set/clear the bit we want }
+        if (doset) then
+          a_op_reg_reg(list,OP_OR,destsize,tmpvalue,dest)
+        else
+          begin
+            a_op_reg_reg(list,OP_NOT,destsize,tmpvalue,tmpvalue);
+            a_op_reg_reg(list,OP_AND,destsize,tmpvalue,dest)
+          end;
+      end;
+
+
+    procedure tcg.a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tcgsize; bitnumber: aint; const ref: treference);
+      begin
+        a_load_const_subsetref(list,OS_8,ord(doset),get_bit_const_ref_sref(bitnumber,ref));
+      end;
+
+
+    procedure tcg.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: aint; destreg: tregister);
+      begin
+        a_load_const_subsetreg(list,OS_8,ord(doset),get_bit_const_reg_sreg(destsize,bitnumber,destreg));
+      end;
+
+
+    procedure tcg.a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: aint; const destreg: tsubsetregister);
+      var
+        tmpsreg: tsubsetregister;
+      begin
+        { the first parameter is used to calculate the bit offset in }
+        { case of big endian, and therefore must be the size of the  }
+        { set and not of the whole subsetreg                         }
+        tmpsreg:=get_bit_const_reg_sreg(destsize,bitnumber,destreg.subsetreg);
+        { now fix the size of the subsetreg }
+        tmpsreg.subsetregsize:=destreg.subsetregsize;
+        { correct offset of the set in the subsetreg }
+        inc(tmpsreg.startbit,destreg.startbit);
+        a_load_const_subsetreg(list,OS_8,ord(doset),tmpsreg);
+      end;
+
+
+    procedure tcg.a_bit_set_reg_ref(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference);
+      begin
+        a_load_const_subsetref(list,OS_8,ord(doset),get_bit_reg_ref_sref(list,bitnumbersize,bitnumber,ref));
+      end;
+
+
+    procedure tcg.a_bit_set_reg_loc(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const loc: tlocation);
+      var
+        tmpreg: tregister;
+      begin
+        case loc.loc of
+          LOC_REFERENCE:
+            a_bit_set_reg_ref(list,doset,bitnumbersize,bitnumber,loc.reference);
+          LOC_CREGISTER:
+            a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,loc.register);
+          { e.g. a 2-byte set in a record regvar }
+          LOC_CSUBSETREG:
+            begin
+              { hard to do in-place in a generic way, so operate on a copy }
+              tmpreg:=cg.getintregister(list,loc.size);
+              a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg);
+              a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,tmpreg);
+              a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg);
+            end;
+          { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
+          else
+            internalerror(2007051703)
+        end;
+      end;
+
+
+    procedure tcg.a_bit_set_const_loc(list: TAsmList; doset: boolean; bitnumber: aint; const loc: tlocation);
+      begin
+        case loc.loc of
+          LOC_REFERENCE:
+            a_bit_set_const_ref(list,doset,loc.size,bitnumber,loc.reference);
+          LOC_CREGISTER:
+            a_bit_set_const_reg(list,doset,loc.size,bitnumber,loc.register);
+          LOC_CSUBSETREG:
+            a_bit_set_const_subsetreg(list,doset,loc.size,bitnumber,loc.sreg);
+          { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked }
+          else
+            internalerror(2007051704)
+        end;
+      end;
+
+
+    { memory/register loading }
+
     procedure tcg.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
       var
         tmpref : treference;
@@ -2220,7 +2531,7 @@ implementation
       var
         tmpreg: tregister;
       begin
-        tmpreg := cg.getintregister(list, size);
+        tmpreg := getintregister(list, size);
         a_load_subsetreg_reg(list,subsetsize,size,sreg,tmpreg);
         a_op_const_reg(list,op,size,a,tmpreg);
         a_load_reg_subsetreg(list,size,subsetsize,tmpreg,sreg);
@@ -2231,7 +2542,7 @@ implementation
       var
         tmpreg: tregister;
       begin
-        tmpreg := cg.getintregister(list, size);
+        tmpreg := getintregister(list, size);
         a_load_subsetref_reg(list,subsetsize,size,sref,tmpreg);
         a_op_const_reg(list,op,size,a,tmpreg);
         a_load_reg_subsetref(list,size,subsetsize,tmpreg,sref);
@@ -2293,7 +2604,7 @@ implementation
       var
         tmpreg: tregister;
       begin
-        tmpreg := cg.getintregister(list, opsize);
+        tmpreg := getintregister(list, opsize);
         a_load_subsetreg_reg(list,subsetsize,opsize,sreg,tmpreg);
         a_op_reg_reg(list,op,opsize,reg,tmpreg);
         a_load_reg_subsetreg(list,opsize,subsetsize,tmpreg,sreg);
@@ -2304,7 +2615,7 @@ implementation
       var
         tmpreg: tregister;
       begin
-        tmpreg := cg.getintregister(list, opsize);
+        tmpreg := getintregister(list, opsize);
         a_load_subsetref_reg(list,subsetsize,opsize,sref,tmpreg);
         a_op_reg_reg(list,op,opsize,reg,tmpreg);
         a_load_reg_subsetref(list,opsize,subsetsize,tmpreg,sref);
@@ -2384,10 +2695,16 @@ implementation
           end
         else
           begin
-            tmpreg:=getintregister(list,size);
-            a_load_reg_reg(list,size,size,src2,tmpreg);
-            a_op_reg_reg(list,op,size,src1,tmpreg);
-            a_load_reg_reg(list,size,size,tmpreg,dst);
+            { can we do a direct operation on the target register ? }
+            if op in [OP_ADD,OP_MUL,OP_AND,OP_MOVE,OP_XOR,OP_IMUL,OP_OR] then
+              a_op_reg_reg(list,op,size,src2,dst)
+            else
+              begin
+                tmpreg:=getintregister(list,size);
+                a_load_reg_reg(list,size,size,src2,tmpreg);
+                a_op_reg_reg(list,op,size,src1,tmpreg);
+                a_load_reg_reg(list,size,size,tmpreg,dst);
+              end;
           end;
       end;
 
@@ -2983,8 +3300,8 @@ implementation
         if (fromdef = todef) and
            (fromdef.typ=orddef) and
            (((((torddef(fromdef).ordtype = s32bit) and
-               (lfrom = low(longint)) and
-               (hfrom = high(longint))) or
+               (lfrom = int64(low(longint))) and
+               (hfrom = int64(high(longint)))) or
               ((torddef(fromdef).ordtype = u32bit) and
                (lfrom = low(cardinal)) and
                (hfrom = high(cardinal)))))) then
@@ -3085,7 +3402,7 @@ implementation
           end;
         hreg:=getintregister(list,OS_INT);
         a_load_loc_reg(list,OS_INT,l,hreg);
-        a_op_const_reg(list,OP_SUB,OS_INT,aint(lto),hreg);
+        a_op_const_reg(list,OP_SUB,OS_INT,aint(int64(lto)),hreg);
         current_asmdata.getjumplabel(neglabel);
         {
         if from_signed then
@@ -3097,7 +3414,7 @@ implementation
           a_cmp_const_reg_label(list,OS_INT,OC_BE,aintmax,hreg,neglabel)
         else
 {$endif cpu64bit}
-          a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(hto-lto),hreg,neglabel);
+          a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(int64(hto-lto)),hreg,neglabel);
         a_call_name(list,'FPC_RANGEERROR');
         a_label(list,neglabel);
       end;
@@ -3399,21 +3716,26 @@ implementation
         result := NR_NO;
         case target_info.system of
           system_powerpc_darwin,
-          system_i386_darwin:
+          system_i386_darwin,
+          system_powerpc64_darwin,
+          system_x86_64_darwin:
             begin
               l:=current_asmdata.getasmsymbol('L'+symname+'$non_lazy_ptr');
               if not(assigned(l)) then
                 begin
-                  l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_COMMON,AT_DATA);
+                  l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_LOCAL,AT_DATA);
                   current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
                   current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname)));
+{$ifdef cpu64bit}
+                  current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0));
+{$else cpu64bit}
                   current_asmdata.asmlists[al_picdata].concat(tai_const.create_32bit(0));
+{$endif cpu64bit}
                 end;
-              result := cg.getaddressregister(list);
+              result := getaddressregister(list);
               reference_reset_symbol(ref,l,0);
-{              ref.base:=current_procinfo.got;
-              ref.relsymbol:=current_procinfo.CurrGOTLabel;}
-              cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
+              { a_load_ref_reg will turn this into a pic-load if needed }
+              a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result);
             end;
           end;
         end;

compiler/cutils.pas

@@ -44,16 +44,10 @@ interface
     {# Returns the maximum value between @var(a) and @var(b) }
     function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
     function max(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @var(x) swapped to different endian }
-    Function SwapInt64(x : int64): int64;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @var(x) swapped to different endian }
-    function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @va(x) swapped to different endian }
-    function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @va(x) swapped to different endian }
-    Function SwapQWord(x : qword) : qword;{$ifdef USEINLINE}inline;{$endif}
     {# Return value @var(i) aligned on @var(a) boundary }
     function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
+    {# Return @var(b) with the bit order reversed }
+    function reverse_byte(b: byte): byte;
 
     function used_align(varalign,minalign,maxalign:shortint):shortint;
     function isbetteralignedthan(new, org, limit: cardinal): boolean;
@@ -140,6 +134,17 @@ interface
 
     Function nextafter(x,y:double):double;
 
+{$ifdef ver2_0}
+{ RTL routines not available yet in 2.0.x }
+function SwapEndian(const AValue: SmallInt): SmallInt;
+function SwapEndian(const AValue: Word): Word;
+function SwapEndian(const AValue: LongInt): LongInt;
+function SwapEndian(const AValue: DWord): DWord;
+function SwapEndian(const AValue: Int64): Int64;
+function SwapEndian(const AValue: QWord): QWord;
+{$endif ver2_0}
+
+
 implementation
 
     uses
@@ -197,44 +202,14 @@ implementation
            max:=b;
       end;
 
-
-    Function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
-      var
-        y : word;
-        z : word;
-      Begin
-        y := x shr 16;
-        y := word(longint(y) shl 8) or (y shr 8);
-        z := x and $FFFF;
-        z := word(longint(z) shl 8) or (z shr 8);
-        SwapLong := (longint(z) shl 16) or longint(y);
-      End;
-
-
-    Function SwapInt64(x : int64): int64;{$ifdef USEINLINE}inline;{$endif}
-      Begin
-        result:=swaplong(longint(hi(x)));
-        result:=result or (swaplong(longint(lo(x))) shl 32);
-      End;
-
-
-    Function SwapQWord(x : qword) : qword;{$ifdef USEINLINE}inline;{$endif}
-      Begin
-        result:=swaplong(longint(hi(x)));
-        result:=result or (swaplong(longint(lo(x))) shl 32);
-      End;
-
-
-    Function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
-      var
-        z : byte;
-      Begin
-        z := x shr 8;
-        x := x and $ff;
-        x := (x shl 8);
-        SwapWord := x or z;
-      End;
-
+    function reverse_byte(b: byte): byte;
+      const
+        reverse_nible:array[0..15] of 0..15 =
+          (%0000,%1000,%0100,%1100,%0010,%1010,%0110,%1110,
+           %0001,%1001,%0101,%1101,%0011,%1011,%0111,%1111);
+      begin
+        reverse_byte:=(reverse_nible[b and $f] shl 4) or reverse_nible[b shr 4];
+      end;
 
     function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
     {
@@ -1362,6 +1337,64 @@ implementation
 
     end;
 
+
+{$ifdef ver2_0}
+function SwapEndian(const AValue: SmallInt): SmallInt;
+  begin
+    Result := (AValue shr 8) or (AValue shl 8);
+  end;
+
+
+function SwapEndian(const AValue: Word): Word;
+  begin
+    Result := (AValue shr 8) or (AValue shl 8);
+  end;
+
+
+function SwapEndian(const AValue: LongInt): LongInt;
+  begin
+    Result := (AValue shl 24)
+           or ((AValue and $0000FF00) shl 8)
+           or ((AValue and $00FF0000) shr 8)
+           or (AValue shr 24);
+  end;
+
+
+function SwapEndian(const AValue: DWord): DWord;
+  begin
+    Result := (AValue shl 24)
+           or ((AValue and $0000FF00) shl 8)
+           or ((AValue and $00FF0000) shr 8)
+           or (AValue shr 24);
+  end;
+
+
+function SwapEndian(const AValue: Int64): Int64;
+  begin
+    Result := (AValue shl 56)
+           or ((AValue and $000000000000FF00) shl 40)
+           or ((AValue and $0000000000FF0000) shl 24)
+           or ((AValue and $00000000FF000000) shl 8)
+           or ((AValue and $000000FF00000000) shr 8)
+           or ((AValue and $0000FF0000000000) shr 24)
+           or ((AValue and $00FF000000000000) shr 40)
+           or (AValue shr 56);
+  end;
+
+
+function SwapEndian(const AValue: QWord): QWord;
+  begin
+    Result := (AValue shl 56)
+           or ((AValue and $000000000000FF00) shl 40)
+           or ((AValue and $0000000000FF0000) shl 24)
+           or ((AValue and $00000000FF000000) shl 8)
+           or ((AValue and $000000FF00000000) shr 8)
+           or ((AValue and $0000FF0000000000) shr 24)
+           or ((AValue and $00FF000000000000) shr 40)
+           or (AValue shr 56);
+  end;
+{$endif ver2_0}
+
 initialization
   internalerrorproc:=@defaulterror;
   initupperlower;

compiler/defcmp.pas

@@ -250,12 +250,10 @@ implementation
                          doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]];
                         if (doconv=tc_not_possible) then
                           eq:=te_incompatible
-                        else
+                        else if (not is_in_limit(def_from,def_to)) then
                           { "punish" bad type conversions :) (JM) }
-                          if (not is_in_limit(def_from,def_to)) and
-                             (def_from.size > def_to.size) then
-                            eq:=te_convert_l3
-                        else
+                          eq:=te_convert_l3
+                         else
                           eq:=te_convert_l1;
                       end;
                    end;

compiler/defutil.pas

@@ -230,9 +230,6 @@ interface
     {# returns true, if the type passed is a varset }
     function is_varset(p : tdef) : boolean;
 
-    {# returns true if the type passed is a normalset }
-    function is_normalset(p : tdef) : boolean;
-
     { # returns true if the procdef has no parameters and no specified return type }
     function is_bareprocdef(pd : tprocdef): boolean;
 
@@ -1029,19 +1026,7 @@ implementation
     {# returns true, if the type passed is a varset }
     function is_varset(p : tdef) : boolean;
       begin
-        if target_info.endian=endian_little then
-          result:=(p.typ=setdef) and not(p.size in [1,2,4])
-        else
-          result:=false;
-      end;
-
-
-    function is_normalset(p : tdef) : boolean;
-      begin
-        if target_info.endian=endian_big then
-          result:=(p.typ=setdef) and (tsetdef(p).size=32)
-        else
-          result:=false;
+        result:=(p.typ=setdef) and not(p.size in [1,2,4])
       end;
 
 

compiler/fpcdefs.inc

@@ -74,7 +74,6 @@
 {$ifdef sparc}
   {$define cpuflags}
   {$define cputargethasfixedstack}
-  {$define cpurequiresproperalignment}
 {$endif sparc}
 
 {$ifdef powerpc}
@@ -88,7 +87,6 @@
   {$define cpuflags}
   {$define cputargethasfixedstack}
   {$define cpumm}
-  {$define cpurequiresproperalignment}
 {$endif powerpc64}
 
 {$ifdef arm}
@@ -96,7 +94,6 @@
   {$define cpufpemu}
   {$define cpuneedsdiv32helper}
   {$define cputargethasfixedstack}
-  {$define cpurequiresproperalignment}
 {$endif arm}
 
 {$ifdef m68k}

compiler/fppu.pas

@@ -939,6 +939,8 @@ uses
                readlinkcontainer(LinkotherStaticLibs);
              iblinkothersharedlibs :
                readlinkcontainer(LinkotherSharedLibs);
+             iblinkotherframeworks :
+               readlinkcontainer(LinkOtherFrameworks);
              ibImportSymbols :
                readImportSymbols;
              ibderefmap :
@@ -1029,6 +1031,7 @@ uses
          writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
          writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
          writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
+         writelinkcontainer(linkotherframeworks,iblinkotherframeworks,true);
          writeImportSymbols;
          writeResources;
          ppufile.do_crc:=true;

compiler/globals.pas

@@ -807,29 +807,16 @@ implementation
 
 
     function guid2string(const GUID: TGUID): string;
-        function long2hex(l, len: longint): string;
-          const
-            hextbl: array[0..15] of char = '0123456789ABCDEF';
-          var
-            rs: string;
-            i: integer;
-          begin
-            rs[0]:=chr(len);
-            for i:=len downto 1 do begin
-              rs[i]:=hextbl[l and $F];
-              l:=l shr 4;
-            end;
-            long2hex:=rs;
-          end;
+
       begin
         guid2string:=
-          '{'+long2hex(GUID.D1,8)+
-          '-'+long2hex(GUID.D2,4)+
-          '-'+long2hex(GUID.D3,4)+
-          '-'+long2hex(GUID.D4[0],2)+long2hex(GUID.D4[1],2)+
-          '-'+long2hex(GUID.D4[2],2)+long2hex(GUID.D4[3],2)+
-              long2hex(GUID.D4[4],2)+long2hex(GUID.D4[5],2)+
-              long2hex(GUID.D4[6],2)+long2hex(GUID.D4[7],2)+
+          '{'+hexstr(GUID.D1,8)+
+          '-'+hexstr(GUID.D2,4)+
+          '-'+hexstr(GUID.D3,4)+
+          '-'+hexstr(GUID.D4[0],2)+hexstr(GUID.D4[1],2)+
+          '-'+hexstr(GUID.D4[2],2)+hexstr(GUID.D4[3],2)+
+              hexstr(GUID.D4[4],2)+hexstr(GUID.D4[5],2)+
+              hexstr(GUID.D4[6],2)+hexstr(GUID.D4[7],2)+
           '}';
       end;
 

compiler/htypechk.pas

@@ -79,6 +79,16 @@ interface
         property  VisibleCount:integer read FProcVisibleCnt;
       end;
 
+    type
+      tregableinfoflag = (
+         // can be put in a register if it's the address of a var/out/const parameter
+         ra_addr_regable,
+         // orthogonal to above flag: the address of the node is taken and may
+         // possibly escape the block in which this node is declared (e.g. a
+         // local variable is passed as var parameter to another procedure)
+         ra_addr_taken);
+      tregableinfoflags = set of tregableinfoflag;
+
     const
       tok2nodes=24;
       tok2node:array[1..tok2nodes] of ttok2noderec=(
@@ -123,7 +133,7 @@ interface
     function isbinaryoverloaded(var t : tnode) : boolean;
 
     { Register Allocation }
-    procedure make_not_regable(p : tnode; how: tvarregable);
+    procedure make_not_regable(p : tnode; how: tregableinfoflags);
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
     { procvar handling }
@@ -643,34 +653,68 @@ implementation
 ****************************************************************************}
 
     { marks an lvalue as "unregable" }
-    procedure make_not_regable_intern(p : tnode; how: tvarregable; records_only: boolean);
+    procedure make_not_regable_intern(p : tnode; how: tregableinfoflags; records_only: boolean);
+      var
+        update_regable: boolean;
       begin
-         case p.nodetype of
-             subscriptn:
-               make_not_regable_intern(tsubscriptnode(p).left,how,true);
+        update_regable:=true;
+        repeat
+          case p.nodetype of
+            subscriptn:
+              begin
+                records_only:=true;
+                p:=tsubscriptnode(p).left;
+              end;
+            vecn:
+              begin
+                { arrays are currently never regable and pointers indexed like }
+                { arrays do not have be made unregable, but we do need to      }
+                { propagate the ra_addr_taken info                             }                                          
+                update_regable:=false;
+                p:=tvecnode(p).left;
+              end;
             typeconvn :
-               if (ttypeconvnode(p).resultdef.typ = recorddef) then
-                 make_not_regable_intern(ttypeconvnode(p).left,how,false)
-               else
-                 make_not_regable_intern(ttypeconvnode(p).left,how,records_only);
+               begin
+                 if (ttypeconvnode(p).resultdef.typ = recorddef) then
+                   records_only:=false;
+                 p:=ttypeconvnode(p).left;
+               end;
             loadn :
-              if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) and
-                 (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
-                 ((not records_only) or
-                  (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
-                if (tloadnode(p).symtableentry.typ = paravarsym) then
-                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
-                else
-                  tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
+              begin
+                if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
+                  begin
+                    if (ra_addr_taken in how) then
+                      tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true;
+                    if update_regable and
+                       (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
+                       ((not records_only) or
+                        (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then
+                      if (tloadnode(p).symtableentry.typ = paravarsym) and
+                         (ra_addr_regable in how) then
+                        tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_addr
+                      else
+                        tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none;
+                  end;
+                break;
+              end;
             temprefn :
-              if (ttemprefnode(p).tempinfo^.may_be_in_reg) and
-                 ((not records_only) or
-                  (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
-                ttemprefnode(p).tempinfo^.may_be_in_reg:=false;
-         end;
+              begin
+                if (ra_addr_taken in how) then
+                  include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken);
+                if update_regable and
+                   (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and
+                   ((not records_only) or
+                    (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then
+                  exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg);
+                break;
+              end;
+            else
+              break;
+          end;
+        until false;
       end;
 
-    procedure make_not_regable(p : tnode; how: tvarregable);
+    procedure make_not_regable(p : tnode; how: tregableinfoflags);
       begin
         make_not_regable_intern(p,how,false);
       end;
@@ -1048,7 +1092,7 @@ implementation
                       be in a register }
                     if (m_tp7 in current_settings.modeswitches) or
                        (todef.size<fromdef.size) then
-                      make_not_regable(hp,vr_addr)
+                      make_not_regable(hp,[ra_addr_regable])
                     else
                       if report_errors then
                         CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size));

compiler/i386/popt386.pas

@@ -937,9 +937,9 @@ begin
                          (taicpu(hp1).oper[0]^.typ = top_reg) and
                          (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) then
                         begin
-                    {we have "mov x, %treg; mov %treg, y}
+                          {we have "mov x, %treg; mov %treg, y}
                           if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then
-                    {we've got "mov x, %treg; mov %treg, y; with %treg is not used after }
+                            {we've got "mov x, %treg; mov %treg, y; with %treg is not used after }
                             case taicpu(p).oper[0]^.typ Of
                               top_reg:
                                 begin
@@ -1041,7 +1041,7 @@ begin
                                   (taicpu(hp1).opcode = A_CMP) and
                                   (taicpu(hp1).oper[1]^.typ = top_ref) and
                                   RefsEqual(taicpu(p).oper[1]^.ref^, taicpu(hp1).oper[1]^.ref^) then
-          {change "mov reg1, mem1; cmp x, mem1" to "mov reg, mem1; cmp x, reg1"}
+                                {change "mov reg1, mem1; cmp x, mem1" to "mov reg, mem1; cmp x, reg1"}
                                 begin
                                   taicpu(hp1).loadreg(1,taicpu(p).oper[0]^.reg);
                                   allocRegBetween(asmL,taicpu(p).oper[0]^.reg,p,hp1,usedregs);
@@ -1058,13 +1058,13 @@ begin
                               mov mem2, reg2            mov reg2, mem2}
                             begin
                               if OpsEqual(taicpu(hp1).oper[1]^,taicpu(p).oper[0]^) then
-                            {mov reg1, mem1     or     mov mem1, reg1
-                            mov mem2, reg1            mov reg2, mem1}
+                                {mov reg1, mem1     or     mov mem1, reg1
+                                 mov mem2, reg1            mov reg2, mem1}
                                 begin
                                   if OpsEqual(taicpu(hp1).oper[0]^,taicpu(p).oper[1]^) then
-                        { Removes the second statement from
-                            mov reg1, mem1/reg2
-                            mov mem1/reg2, reg1 }
+                                    { Removes the second statement from
+                                      mov reg1, mem1/reg2
+                                      mov mem1/reg2, reg1 }
                                     begin
                                       if (taicpu(p).oper[0]^.typ = top_reg) then
                                         AllocRegBetween(asmL,taicpu(p).oper[0]^.reg,p,hp1,usedregs);
@@ -1088,10 +1088,10 @@ begin
                                          RefsEqual(taicpu(hp2).oper[0]^.ref^, taicpu(p).oper[1]^.ref^) and
                                          (taicpu(hp2).oper[1]^.reg= taicpu(p).oper[0]^.reg) and
                                          not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs)) then
-                          { change                   to
-                              mov reg1, mem1           mov reg1, mem1
-                              mov mem2, reg1           cmp reg1, mem2
-                              cmp mem1, reg1                          }
+                                         { change                   to
+                                           mov reg1, mem1           mov reg1, mem1
+                                           mov mem2, reg1           cmp reg1, mem2
+                                           cmp mem1, reg1                          }
                                         begin
                                           asml.remove(hp2);
                                           hp2.free;
@@ -1118,12 +1118,12 @@ begin
                                      RefsEqual(taicpu(hp2).oper[0]^.ref^, taicpu(hp1).oper[1]^.ref^)  then
                                     if not regInRef(getsupreg(taicpu(hp2).oper[1]^.reg),taicpu(hp2).oper[0]^.ref^) and
                                        not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,tmpUsedRegs)) then
-                            {   mov mem1, %reg1
-                                mov %reg1, mem2
-                                mov mem2, reg2
-                              to:
-                                mov mem1, reg2
-                                mov reg2, mem2}
+                                    {   mov mem1, %reg1
+                                        mov %reg1, mem2
+                                        mov mem2, reg2
+                                     to:
+                                        mov mem1, reg2
+                                        mov reg2, mem2}
                                       begin
                                         AllocRegBetween(asmL,taicpu(hp2).oper[1]^.reg,p,hp2,usedregs);
                                         taicpu(p).loadoper(1,taicpu(hp2).oper[1]^);
@@ -1135,21 +1135,21 @@ begin
                                       if (taicpu(p).oper[1]^.reg <> taicpu(hp2).oper[1]^.reg) and
                                          not(RegInRef(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^)) and
                                          not(RegInRef(getsupreg(taicpu(hp2).oper[1]^.reg),taicpu(hp2).oper[0]^.ref^)) then
-                          {   mov mem1, reg1         mov mem1, reg1
-                              mov reg1, mem2         mov reg1, mem2
-                              mov mem2, reg2         mov mem2, reg1
-                            to:                    to:
-                              mov mem1, reg1         mov mem1, reg1
-                              mov mem1, reg2         mov reg1, mem2
-                              mov reg1, mem2
+                                         {   mov mem1, reg1         mov mem1, reg1
+                                             mov reg1, mem2         mov reg1, mem2
+                                             mov mem2, reg2         mov mem2, reg1
+                                          to:                    to:
+                                             mov mem1, reg1         mov mem1, reg1
+                                             mov mem1, reg2         mov reg1, mem2
+                                             mov reg1, mem2
 
-                        or (if mem1 depends on reg1
-                            and/or if mem2 depends on reg2)
-                            to:
-                              mov mem1, reg1
-                              mov reg1, mem2
-                              mov reg1, reg2
-                        }
+                                          or (if mem1 depends on reg1
+                                       and/or if mem2 depends on reg2)
+                                          to:
+                                              mov mem1, reg1
+                                              mov reg1, mem2
+                                              mov reg1, reg2
+                                         }
                                         begin
                                           taicpu(hp1).loadRef(0,taicpu(p).oper[0]^.ref^);
                                           taicpu(hp1).loadReg(1,taicpu(hp2).oper[1]^.reg);
@@ -1211,6 +1211,31 @@ begin
                                   taicpu(p).loadReg(1,taicpu(hp1).oper[0]^.reg);
                                 end
                         end;
+                      if GetNextInstruction(p, hp1) and
+                         (Tai(hp1).typ = ait_instruction) and
+                         ((Taicpu(hp1).opcode = A_BTS) or (Taicpu(hp1).opcode = A_BTR)) and
+                         (Taicpu(hp1).opsize = Taicpu(p).opsize) and
+                         GetNextInstruction(hp1, hp2) and
+                         (Tai(hp2).typ = ait_instruction) and
+                         (Taicpu(hp2).opcode = A_OR) and
+                         (Taicpu(hp1).opsize = Taicpu(p).opsize) and 
+                         (Taicpu(hp2).opsize = Taicpu(p).opsize) and 
+                         (Taicpu(p).oper[0]^.typ = top_const) and (Taicpu(p).oper[0]^.val=0) and
+                         (Taicpu(p).oper[1]^.typ = top_reg) and
+                         (Taicpu(hp1).oper[1]^.typ = top_reg) and
+                         (Taicpu(p).oper[1]^.reg=Taicpu(hp1).oper[1]^.reg) and
+                         (Taicpu(hp2).oper[1]^.typ = top_reg) and
+                         (Taicpu(p).oper[1]^.reg=Taicpu(hp2).oper[1]^.reg) then
+                         {mov reg1,0
+                          bts reg1,operand1             -->      mov reg1,operand2
+                          or  reg1,operand2                      bts reg1,operand1}
+                        begin
+                          Taicpu(hp2).opcode:=A_MOV;
+                          asml.remove(hp1);
+                          insertllitem(asml,hp2,hp2.next,hp1);
+                          asml.remove(p);
+                          p.free;
+                        end;
                     end;
                   A_MOVZX:
                     begin

compiler/nadd.pas

@@ -154,50 +154,6 @@ implementation
         b       : boolean;
       begin
         result:=nil;
-        { is one a real float, then both need to be floats, this
-          need to be done before the constant folding so constant
-          operation on a float and int are also handled }
-        resultrealdef:=pbestrealtype^;
-        if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
-         begin
-           { when both floattypes are already equal then use that
-             floattype for results }
-           if (right.resultdef.typ=floatdef) and
-              (left.resultdef.typ=floatdef) and
-              (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then
-             resultrealdef:=left.resultdef
-           { when there is a currency type then use currency, but
-             only when currency is defined as float }
-           else
-            if (is_currency(right.resultdef) or
-                is_currency(left.resultdef)) and
-               ((s64currencytype.typ = floatdef) or
-                (nodetype <> slashn)) then
-             begin
-               resultrealdef:=s64currencytype;
-               inserttypeconv(right,resultrealdef);
-               inserttypeconv(left,resultrealdef);
-             end
-           else
-            begin
-              resultrealdef:=getbestreal(left.resultdef,right.resultdef);
-              inserttypeconv(right,resultrealdef);
-              inserttypeconv(left,resultrealdef);
-            end;
-         end;
-
-        { If both operands are constant and there is a widechar
-          or widestring then convert everything to widestring. This
-          allows constant folding like char+widechar }
-        if is_constnode(right) and is_constnode(left) and
-           (is_widestring(right.resultdef) or
-            is_widestring(left.resultdef) or
-            is_widechar(right.resultdef) or
-            is_widechar(left.resultdef)) then
-          begin
-            inserttypeconv(right,cwidestringtype);
-            inserttypeconv(left,cwidestringtype);
-          end;
 
         { load easier access variables }
         rd:=right.resultdef;
@@ -895,6 +851,51 @@ implementation
               end;
           end;
 
+        { is one a real float, then both need to be floats, this
+          need to be done before the constant folding so constant
+          operation on a float and int are also handled }
+        resultrealdef:=pbestrealtype^;
+        if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then
+         begin
+           { when both floattypes are already equal then use that
+             floattype for results }
+           if (right.resultdef.typ=floatdef) and
+              (left.resultdef.typ=floatdef) and
+              (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then
+             resultrealdef:=left.resultdef
+           { when there is a currency type then use currency, but
+             only when currency is defined as float }
+           else
+            if (is_currency(right.resultdef) or
+                is_currency(left.resultdef)) and
+               ((s64currencytype.typ = floatdef) or
+                (nodetype <> slashn)) then
+             begin
+               resultrealdef:=s64currencytype;
+               inserttypeconv(right,resultrealdef);
+               inserttypeconv(left,resultrealdef);
+             end
+           else
+            begin
+              resultrealdef:=getbestreal(left.resultdef,right.resultdef);
+              inserttypeconv(right,resultrealdef);
+              inserttypeconv(left,resultrealdef);
+            end;
+         end;
+
+        { If both operands are constant and there is a widechar
+          or widestring then convert everything to widestring. This
+          allows constant folding like char+widechar }
+        if is_constnode(right) and is_constnode(left) and
+           (is_widestring(right.resultdef) or
+            is_widestring(left.resultdef) or
+            is_widechar(right.resultdef) or
+            is_widechar(left.resultdef)) then
+          begin
+            inserttypeconv(right,cwidestringtype);
+            inserttypeconv(left,cwidestringtype);
+          end;
+
          result:=simplify;
          if assigned(result) then
            exit;
@@ -1257,7 +1258,7 @@ implementation
                  is to convert right to a set }
                if not(equal_defs(ld,rd)) then
                 begin
-                  if is_varset(rd) or is_normalset(rd) then
+                  if is_varset(rd) then
                     inserttypeconv(left,right.resultdef)
                   else
                     inserttypeconv(right,left.resultdef);
@@ -1922,9 +1923,7 @@ implementation
         newstatement : tstatementnode;
         temp    : ttempcreatenode;
       begin
-        if (is_varset(left.resultdef) or is_varset(right.resultdef)) and
-          not(is_normalset(left.resultdef)) and
-          not(is_normalset(right.resultdef)) then
+        if (is_varset(left.resultdef) or is_varset(right.resultdef)) then
           begin
             case nodetype of
               equaln,unequaln,lten,gten:
@@ -2574,7 +2573,7 @@ implementation
            else array constructor can be seen as array of char (PFV) }
          else if (ld.typ=setdef) then
            begin
-             if not(is_varset(ld)) and not(is_normalset(ld)) then
+             if not(is_varset(ld)) then
                begin
                  if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
                    expectloc:=LOC_FLAGS

compiler/nbas.pas

@@ -70,6 +70,7 @@ interface
 
        tstatementnode = class(tbinarynode)
           constructor create(l,r : tnode);virtual;
+          function simplify : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure printnodetree(var t:text);override;
@@ -81,6 +82,7 @@ interface
        tblocknode = class(tunarynode)
           constructor create(l : tnode);virtual;
           destructor destroy; override;
+          function simplify : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
 {$ifdef state_tracking}
@@ -92,6 +94,14 @@ interface
 
        ttempcreatenode = class;
 
+       ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,ti_is_inlined_result,
+        ti_addr_taken);
+       ttempinfoflags = set of ttempinfoflag;
+
+const
+       tempinfostoreflags = [ti_may_be_in_reg,ti_is_inlined_result,ti_addr_taken];
+
+type
        { to allow access to the location by temp references even after the temp has }
        { already been disposed and to make sure the coherency between temps and     }
        { temp references is kept after a getcopy                                    }
@@ -106,9 +116,7 @@ interface
          owner                      : ttempcreatenode;
          withnode                   : tnode;
          location                   : tlocation;
-         may_be_in_reg              : boolean;
-         valid                      : boolean;
-         nextref_set_hookoncopy_nil : boolean;
+         flags                      : ttempinfoflags;
        end;
 
        { a node which will create a (non)persistent temp of a given type with a given  }
@@ -125,6 +133,7 @@ interface
           { to it and *not* generate a ttempdeletenode                          }
           constructor create(_typedef: tdef; _size: aint; _temptype: ttemptype;allowreg:boolean); virtual;
           constructor create_withnode(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual;
+          constructor create_inlined_result(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean); virtual;
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
@@ -307,6 +316,58 @@ implementation
          inherited create(statementn,l,r);
       end;
 
+
+    function tstatementnode.simplify : tnode;
+      begin
+        result:=nil;
+        { these "optimizations" are only to make it more easy to recognise    }
+        { blocknodes which at the end of inlining only contain one single     }
+        { statement. Simplifying inside blocknode.simplify could be dangerous }
+        { because if the main blocknode which makes up a procedure/function   }
+        { body were replaced with a statementn/nothingn, this could cause     }
+        { problems elsewhere in the compiler which expects a blocknode        }
+
+        { remove next statement if it's a nothing-statement (since if it's }
+        { the last, it won't remove itself -- see next simplification)     }
+        while assigned(right) and
+              (tstatementnode(right).left.nodetype = nothingn) do
+          begin
+            result:=tstatementnode(right).right;
+            tstatementnode(right).right:=nil;
+            right.free;
+            right:=result;
+            result:=nil;
+          end;
+
+        { Remove initial nothingn if there are other statements. If there }
+        { are no other statements, returning nil doesn't help (will be    }
+        { interpreted as "can't be simplified") and replacing the         }
+        { statementnode with a nothingnode cannot be done (because it's   }
+        { possible this statementnode is a child of a blocknode, and      }
+        { blocknodes are expected to only contain statementnodes)         }
+        if (left.nodetype = nothingn) and
+           assigned(right) then
+          begin
+            result:=right;
+            right:=nil;
+            exit;
+          end;
+
+        { if the current statement contains a block with one statement, }
+        { replace the current statement with that block's statement     }
+        if (left.nodetype = blockn) and
+           assigned(tblocknode(left).left) and
+           not assigned(tstatementnode(tblocknode(left).left).right) then
+          begin
+            result:=tblocknode(left).left;
+            tstatementnode(result).right:=right;
+            right:=nil;
+            tblocknode(left).left:=nil;
+            exit;
+          end;
+      end;
+
+
     function tstatementnode.pass_typecheck:tnode;
       begin
          result:=nil;
@@ -386,6 +447,31 @@ implementation
         inherited destroy;
       end;
 
+
+    function tblocknode.simplify: tnode;
+      var
+        hp, next: tstatementnode;
+      begin
+        result := nil;
+        { Warning: never replace a blocknode with another node type,      }
+        {  since the block may be the main block of a procedure/function/ }
+        {  main program body, and those nodes should always be blocknodes }
+        {  since that's what the compiler expects elsewhere.              }
+
+        { if the current block contains only one statement, and   }
+        { this one statement only contains another block, replace }
+        { this block with that other block.                       }
+        if assigned(left) and
+           not assigned(tstatementnode(left).right) and
+           (tstatementnode(left).left.nodetype = blockn) then
+          begin
+            result:=tstatementnode(left).left;
+            tstatementnode(left).left:=nil;
+            exit;
+          end;
+      end;
+
+
     function tblocknode.pass_typecheck:tnode;
       var
          hp : tstatementnode;
@@ -636,19 +722,19 @@ implementation
         tempinfo^.temptype := _temptype;
         tempinfo^.owner := self;
         tempinfo^.withnode := nil;
-        tempinfo^.may_be_in_reg:=
-          allowreg and
-          { temp must fit a single register }
-          (tstoreddef(_typedef).is_fpuregable or
-           (tstoreddef(_typedef).is_intregable and
-            (_size<=TCGSize2Size[OS_64]))) and
-          { size of register operations must be known }
-          (def_cgsize(_typedef)<>OS_NO) and
-          { no init/final needed }
-          not (_typedef.needs_inittable) and
-          ((_typedef.typ <> pointerdef) or
-           (is_object(tpointerdef(_typedef).pointeddef) or
-            not tpointerdef(_typedef).pointeddef.needs_inittable));
+        if allowreg and
+           { temp must fit a single register }
+           (tstoreddef(_typedef).is_fpuregable or
+            (tstoreddef(_typedef).is_intregable and
+             (_size<=TCGSize2Size[OS_64]))) and
+           { size of register operations must be known }
+           (def_cgsize(_typedef)<>OS_NO) and
+           { no init/final needed }
+           not (_typedef.needs_inittable) and
+           ((_typedef.typ <> pointerdef) or
+            (is_object(tpointerdef(_typedef).pointeddef) or
+             not tpointerdef(_typedef).pointeddef.needs_inittable)) then
+          include(tempinfo^.flags,ti_may_be_in_reg);
       end;
 
     constructor ttempcreatenode.create_withnode(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean; withnode: tnode);
@@ -658,6 +744,13 @@ implementation
       end;
 
 
+    constructor ttempcreatenode.create_inlined_result(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean);
+      begin
+        self.create(_typedef,_size,_temptype,allowreg);
+        include(tempinfo^.flags,ti_is_inlined_result);
+      end;
+
+
     function ttempcreatenode.dogetcopy: tnode;
       var
         n: ttempcreatenode;
@@ -670,6 +763,7 @@ implementation
         n.tempinfo^.owner:=n;
         n.tempinfo^.typedef := tempinfo^.typedef;
         n.tempinfo^.temptype := tempinfo^.temptype;
+        n.tempinfo^.flags := tempinfo^.flags * tempinfostoreflags;
         if assigned(tempinfo^.withnode) then
           n.tempinfo^.withnode := tempinfo^.withnode.getcopy
         else
@@ -684,7 +778,7 @@ implementation
         { so that if the refs get copied as well, they can hook themselves }
         { to the copy of the temp                                          }
         tempinfo^.hookoncopy := n.tempinfo;
-        tempinfo^.nextref_set_hookoncopy_nil := false;
+        exclude(tempinfo^.flags,ti_nextref_set_hookoncopy_nil);
 
         result := n;
       end;
@@ -697,7 +791,7 @@ implementation
         size:=ppufile.getlongint;
         new(tempinfo);
         fillchar(tempinfo^,sizeof(tempinfo^),0);
-        tempinfo^.may_be_in_reg:=boolean(ppufile.getbyte);
+        ppufile.getsmallset(tempinfo^.flags);
         ppufile.getderef(tempinfo^.typedefderef);
         tempinfo^.temptype := ttemptype(ppufile.getbyte);
         tempinfo^.owner:=self;
@@ -709,7 +803,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putlongint(size);
-        ppufile.putbyte(byte(tempinfo^.may_be_in_reg));
+        ppufile.putsmallset(tempinfo^.flags);
         ppufile.putderef(tempinfo^.typedefderef);
         ppufile.putbyte(byte(tempinfo^.temptype));
         ppuwritenode(ppufile,tempinfo^.withnode);
@@ -768,7 +862,7 @@ implementation
         result :=
           inherited docompare(p) and
           (ttempcreatenode(p).size = size) and
-          (ttempcreatenode(p).tempinfo^.may_be_in_reg = tempinfo^.may_be_in_reg) and
+          (ttempcreatenode(p).tempinfo^.flags*tempinfostoreflags=tempinfo^.flags*tempinfostoreflags) and
           (ttempcreatenode(p).tempinfo^.withnode.isequal(tempinfo^.withnode)) and
           equal_defs(ttempcreatenode(p).tempinfo^.typedef,tempinfo^.typedef);
       end;
@@ -817,7 +911,7 @@ implementation
             { from a persistent one into a normal one, we must be  }
             { the last reference (since our parent should free the }
             { temp (JM)                                            }
-            if (tempinfo^.nextref_set_hookoncopy_nil) then
+            if (ti_nextref_set_hookoncopy_nil in tempinfo^.flags) then
               tempinfo^.hookoncopy := nil;
           end
         else
@@ -866,7 +960,7 @@ implementation
       begin
         expectloc := LOC_REFERENCE;
         if not tempinfo^.typedef.needs_inittable and
-           tempinfo^.may_be_in_reg then
+           (ti_may_be_in_reg in tempinfo^.flags) then
           begin
             if tempinfo^.typedef.typ=floatdef then
               begin
@@ -942,31 +1036,32 @@ implementation
       var
         n: ttempdeletenode;
       begin
-        n := ttempdeletenode(inherited dogetcopy);
-        n.release_to_normal := release_to_normal;
+        n:=ttempdeletenode(inherited dogetcopy);
+        n.release_to_normal:=release_to_normal;
 
         if assigned(tempinfo^.hookoncopy) then
           { if the temp has been copied, assume it becomes a new }
           { temp which has to be hooked by the copied deletenode }
           begin
             { hook the tempdeletenode to the copied temp }
-            n.tempinfo := tempinfo^.hookoncopy;
+            n.tempinfo:=tempinfo^.hookoncopy;
             { the temp shall not be used, reset hookoncopy    }
             { Only if release_to_normal is false, otherwise   }
             { the temp can still be referenced once more (JM) }
             if (not release_to_normal) then
               tempinfo^.hookoncopy:=nil
             else
-              tempinfo^.nextref_set_hookoncopy_nil := true;
+              include(tempinfo^.flags,ti_nextref_set_hookoncopy_nil);
           end
         else
           { if the temp we refer to hasn't been copied, we have a }
           { problem since that means we now have two delete nodes }
           { for one temp                                          }
           internalerror(200108234);
-        result := n;
+        result:=n;
       end;
 
+
     constructor ttempdeletenode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);

compiler/ncal.pas

@@ -71,6 +71,7 @@ interface
           function  replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
           procedure createlocaltemps(p:TObject;arg:pointer);
           function  pass1_inline:tnode;
+          function  getfuncretassignment(inlineblock: tblocknode): tnode;
        protected
           pushedparasize : longint;
        public
@@ -980,20 +981,28 @@ implementation
 
                  { When the address needs to be pushed then the register is
                    not regable. Exception is when the location is also a var
-                   parameter and we can pass the address transparently }
+                   parameter and we can pass the address transparently (but
+                   that is handled by make_not_regable if ra_addr_regable is
+                   passed, and make_not_regable always needs to called for
+                   the ra_addr_taken info for non-invisble parameters }
                  if (
                      not(
                          (vo_is_hidden_para in parasym.varoptions) and
                          (left.resultdef.typ in [pointerdef,classrefdef])
                         ) and
                      paramanager.push_addr_param(parasym.varspez,parasym.vardef,
-                         aktcallnode.procdefinition.proccalloption) and
-                     not(
-                         (left.nodetype=loadn) and
-                         (tloadnode(left).is_addr_param_load)
-                        )
+                         aktcallnode.procdefinition.proccalloption)
                     ) then
-                   make_not_regable(left,vr_addr);
+                   { pushing the address of a variable to take the place of a temp  }
+                   { as the complex function result of a function does not make its }
+                   { address escape the current block, as the "address of the       }
+                   { function result" is not something which can be stored          }
+                   { persistently by the callee (it becomes invalid when the callee }
+                   { returns)                                                       }
+                   if not(vo_is_funcret in parasym.varoptions) then
+                     make_not_regable(left,[ra_addr_regable,ra_addr_taken])
+                   else
+                     make_not_regable(left,[ra_addr_regable]);
 
                  if do_count then
                   begin
@@ -2459,15 +2468,22 @@ implementation
           end
         else
           begin
-            tempnode := ctempcreatenode.create(tabstractvarsym(p).vardef,tabstractvarsym(p).vardef.size,tt_persistent,tabstractvarsym(p).is_regvar(false));
-            addstatement(tempinfo^.createstatement,tempnode);
             if (vo_is_funcret in tlocalvarsym(p).varoptions) then
               begin
+                tempnode := ctempcreatenode.create_inlined_result(tabstractvarsym(p).vardef,tabstractvarsym(p).vardef.size,tt_persistent,tabstractvarsym(p).is_regvar(false));
+                addstatement(tempinfo^.createstatement,tempnode);
                 funcretnode := ctemprefnode.create(tempnode);
                 addstatement(tempinfo^.deletestatement,ctempdeletenode.create_normal_temp(tempnode));
               end
             else
-              addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
+              begin
+                tempnode := ctempcreatenode.create(tabstractvarsym(p).vardef,tabstractvarsym(p).vardef.size,tt_persistent,tabstractvarsym(p).is_regvar(false));
+                addstatement(tempinfo^.createstatement,tempnode);
+                addstatement(tempinfo^.deletestatement,ctempdeletenode.create(tempnode));
+              end;
+            { inherit addr_taken flag }
+            if (tabstractvarsym(p).addr_taken) then
+              include(tempnode.tempinfo^.flags,ti_addr_taken);
             inlinelocals[indexnr] := ctemprefnode.create(tempnode);
           end;
       end;
@@ -2625,6 +2641,9 @@ implementation
 
                     tempnode := ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size,tt_persistent,tparavarsym(para.parasym).is_regvar(false));
                     addstatement(createstatement,tempnode);
+                    { inherit addr_taken flag }
+                    if (tabstractvarsym(para.parasym).addr_taken) then
+                      include(tempnode.tempinfo^.flags,ti_addr_taken);
                     { assign the value of the parameter to the temp, except in case of the function result }
                     { (in that case, para.left is a block containing the creation of a new temp, while we  }
                     {  only need a temprefnode, so delete the old stuff)                                   }
@@ -2653,6 +2672,9 @@ implementation
                   begin
                     tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,tparavarsym(para.parasym).is_regvar(true));
                     addstatement(createstatement,tempnode);
+                    { inherit addr_taken flag }
+                    if (tabstractvarsym(para.parasym).addr_taken) then
+                      include(tempnode.tempinfo^.flags,ti_addr_taken);
                     addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
                       caddrnode.create_internal(para.left)));
                     para.left := ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),para.left.resultdef);
@@ -2674,6 +2696,62 @@ implementation
       end;
 
 
+    function tcallnode.getfuncretassignment(inlineblock: tblocknode): tnode;
+      var
+        hp: tstatementnode;
+        resassign: tnode;
+      begin
+        result:=nil;
+        if not assigned(funcretnode) or
+           not(cnf_return_value_used in callnodeflags) then
+        exit;
+
+        { tempcreatenode for the function result }
+        hp:=tstatementnode(inlineblock.left);
+        if not(assigned(hp)) or
+           (hp.left.nodetype <> tempcreaten) then
+          exit;
+
+        { assignment to the result }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           (hp.left.nodetype<>assignn) or
+           { left must be function result }
+           (not(tassignmentnode(hp.left).left.isequal(funcretnode)) and
+            { can have extra type conversion due to absolute mapping }
+            { of <fucntionname> on function result var               }
+            not((tassignmentnode(hp.left).left.nodetype = typeconvn) and
+                (ttypeconvnode(tassignmentnode(hp.left).left).convtype = tc_equal) and
+                (ttypeconvnode(tassignmentnode(hp.left).left).left.isequal(funcretnode)))) or
+           { right must be a constant (mainly to avoid trying to reuse    }
+           { local temps which may already be freed afterwards once these }
+           { checks are made looser)                                      }
+           not is_constnode(tassignmentnode(hp.left).right) then
+          exit
+        else
+          resassign:=hp.left;
+
+        { tempdelete to normal of the function result }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           (hp.left.nodetype <> tempdeleten) then
+          exit;
+        
+        { the function result once more }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           not(hp.left.isequal(funcretnode)) then
+          exit;
+
+        { should be the end }
+        if assigned(hp.right) then
+          exit;
+
+        { we made it! }
+        result:=tassignmentnode(resassign).right.getcopy;
+        firstpass(result);
+      end;
+
 
     function tcallnode.pass1_inline:tnode;
       var
@@ -2722,11 +2800,22 @@ implementation
         exclude(procdefinition.procoptions,po_inline);
 
         dosimplify(createblock);
-
         firstpass(createblock);
         include(procdefinition.procoptions,po_inline);
-        { return inlined block }
-        result := createblock;
+
+        { if all that's left of the inlined function is an constant       }
+        { assignment to the result, replace the whole block with what's   }
+        { assigned to the result. There will also be a tempcreatenode for }
+        { the function result itself though, so ignore it. The statement/ }
+        { blocknode simplification code will have removed all nothingn-   }
+        { statements empty nested blocks, so we don't have to care about  }
+        { those                                                           }
+        result := getfuncretassignment(createblock);
+        if assigned(result) then
+          createblock.free
+        else
+          { return inlined block }
+          result := createblock;
 
 {$ifdef DEBUGINLINE}
         writeln;

compiler/ncgadd.pas

@@ -233,9 +233,7 @@ interface
       begin
         { when a setdef is passed, it has to be a smallset }
         if is_varset(left.resultdef) or
-          is_normalset(left.resultdef) or
-          is_varset(right.resultdef) or
-          is_normalset(right.resultdef) then
+          is_varset(right.resultdef) then
           internalerror(200203302);
 
         if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then
@@ -249,6 +247,7 @@ interface
       var
         cgop   : TOpCg;
         tmpreg : tregister;
+        mask   : aint;
         opdone : boolean;
       begin
         opdone := false;
@@ -279,14 +278,30 @@ interface
                   if assigned(tsetelementnode(right).right) then
                    internalerror(43244);
                   if (right.location.loc = LOC_CONSTANT) then
-                    cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
-                      aint(1 shl right.location.value),
-                      left.location.register,location.register)
+                    begin
+                      if (target_info.endian=endian_big) then
+                        mask:=aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value))
+                      else
+                        mask:=aint(1 shl right.location.value);
+                      cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,
+                        mask,left.location.register,location.register);
+                    end
                   else
                     begin
+                      if (target_info.endian=endian_big) then
+                        begin
+                          mask:=aint((aword(1) shl (resultdef.size*8-1)));
+                          cgop:=OP_SHR
+                        end
+                      else
+                        begin
+                          mask:=1;
+                          cgop:=OP_SHL
+                        end;
                       tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size);
-                      cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,tmpreg);
-                      cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SHL,location.size,
+                      cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,mask,tmpreg);
+                      location_force_reg(current_asmdata.CurrAsmList,right.location,location.size,true);
+                      cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,location.size,
                         right.location.register,tmpreg);
                       if left.location.loc <> LOC_CONSTANT then
                         cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,tmpreg,
@@ -769,8 +784,7 @@ interface
             begin
               {Normalsets are already handled in pass1 if mmx
                should not be used.}
-              if is_varset(tsetdef(left.resultdef)) or
-                is_normalset(tsetdef(left.resultdef)) then
+              if is_varset(tsetdef(left.resultdef)) then
                 begin
 {$ifdef SUPPORT_MMX}
                 {$ifdef i386}

compiler/ncgbas.pas

@@ -323,6 +323,7 @@ interface
       var
         hp : tstatementnode;
         oldexitlabel : tasmlabel;
+        oldflowcontrol : tflowcontrol;
       begin
         location_reset(location,LOC_VOID,OS_NO);
 
@@ -331,6 +332,9 @@ interface
           begin
             oldexitlabel:=current_procinfo.CurrExitLabel;
             current_asmdata.getjumplabel(current_procinfo.CurrExitLabel);
+            oldflowcontrol:=flowcontrol;
+            { the nested block will not span an exit statement of the parent }
+            exclude(flowcontrol,fc_exit);
           end;
 
         { do second pass on left node }
@@ -354,6 +358,9 @@ interface
           begin
             cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel);
             current_procinfo.CurrExitLabel:=oldexitlabel;
+            { the exit statements inside this block are not exit statements }
+            { out of the parent                                             }
+            flowcontrol:=oldflowcontrol+(flowcontrol - [fc_exit]);
           end;
       end;
 
@@ -367,7 +374,7 @@ interface
         location_reset(location,LOC_VOID,OS_NO);
 
         { if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
-        if tempinfo^.valid then
+        if (ti_valid in tempinfo^.flags) then
           internalerror(200108222);
 
         { get a (persistent) temp }
@@ -379,7 +386,7 @@ interface
               because we're in a loop }
             cg.g_finalize(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.location.reference);
           end
-        else if tempinfo^.may_be_in_reg then
+        else if (ti_may_be_in_reg in tempinfo^.flags) then
           begin
             if tempinfo^.typedef.typ=floatdef then
               begin
@@ -424,7 +431,7 @@ interface
             location_reset(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef));
             tg.GetTemp(current_asmdata.CurrAsmList,size,tempinfo^.temptype,tempinfo^.location.reference);
           end;
-        tempinfo^.valid := true;
+        include(tempinfo^.flags,ti_valid);
       end;
 
 
@@ -435,19 +442,19 @@ interface
     procedure tcgtemprefnode.pass_generate_code;
       begin
         { check if the temp is valid }
-        if not tempinfo^.valid then
+        if not(ti_valid in tempinfo^.flags) then
           internalerror(200108231);
         location:=tempinfo^.location;
         case tempinfo^.location.loc of
           LOC_REFERENCE:
             begin
               inc(location.reference.offset,offset);
-              { tempinfo^.valid should be set to false it it's a normal temp }
+              { ti_valid should be excluded if it's a normal temp }
             end;
           LOC_REGISTER,
           LOC_FPUREGISTER,
           LOC_MMREGISTER :
-            tempinfo^.valid := false;
+            exclude(tempinfo^.flags,ti_valid);
         end;
       end;
 
@@ -455,7 +462,7 @@ interface
     procedure tcgtemprefnode.changelocation(const ref: treference);
       begin
         { check if the temp is valid }
-        if not tempinfo^.valid then
+        if not(ti_valid in tempinfo^.flags) then
           internalerror(200306081);
         if (tempinfo^.location.loc<>LOC_REFERENCE) then
           internalerror(2004020203);
@@ -486,7 +493,7 @@ interface
               else
                 begin
                   tg.UnGetTemp(current_asmdata.CurrAsmList,tempinfo^.location.reference);
-                  tempinfo^.valid := false;
+                  exclude(tempinfo^.flags,ti_valid);
                 end;
             end;
           LOC_CREGISTER,
@@ -510,7 +517,7 @@ interface
               if release_to_normal then
                 tempinfo^.location.loc := LOC_REGISTER
               else
-                tempinfo^.valid := false;
+                exclude(tempinfo^.flags,ti_valid);
             end;
           LOC_CFPUREGISTER,
           LOC_FPUREGISTER:
@@ -525,7 +532,7 @@ interface
               if release_to_normal then
                 tempinfo^.location.loc := LOC_FPUREGISTER
               else
-                tempinfo^.valid := false;
+                exclude(tempinfo^.flags,ti_valid);
             end;
           LOC_CMMREGISTER,
           LOC_MMREGISTER:
@@ -540,7 +547,7 @@ interface
               if release_to_normal then
                 tempinfo^.location.loc := LOC_MMREGISTER
               else
-                tempinfo^.valid := false;
+                exclude(tempinfo^.flags,ti_valid);
             end;
           else
             internalerror(200507161);

compiler/ncgcal.pas

@@ -408,6 +408,9 @@ implementation
                  { don't push a node that already generated a pointer type
                    by address for implicit hidden parameters }
                  if (vo_is_funcret in parasym.varoptions) or
+                   { pass "this" in C++ classes explicitly as pointer
+                     because push_addr_param might not be true for them }
+                   (is_cppclass(parasym.vardef) and (vo_is_self in parasym.varoptions)) or
                     (not(left.resultdef.typ in [pointerdef,classrefdef]) and
                      paramanager.push_addr_param(parasym.varspez,parasym.vardef,
                          aktcallnode.procdefinition.proccalloption)) then

compiler/ncgcon.pas

@@ -67,7 +67,7 @@ implementation
 
     uses
       globtype,widestr,systems,
-      verbose,globals,
+      verbose,globals,cutils,
       symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
       cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
@@ -510,23 +510,38 @@ implementation
          lastlabel   : tasmlabel;
          i           : longint;
          neededtyp   : taiconst_type;
-         indexadjust : longint;
       type
          setbytes=array[0..31] of byte;
          Psetbytes=^setbytes;
       begin
-        { xor indexadjust with indexes in a set typecasted to an array of   }
-        { bytes to get the correct locations, also when endianess of source }
-        { and destiantion differs (JM)                                      }
-        if (source_info.endian = target_info.endian) then
-          indexadjust := 0
-        else
-          indexadjust := 3;
         { small sets are loaded as constants }
-        if not(is_varset(resultdef)) and not(is_normalset(resultdef)) then
+        if not(is_varset(resultdef)) then
          begin
            location_reset(location,LOC_CONSTANT,int_cgsize(resultdef.size));
-           location.value:=pLongint(value_set)^;
+           if (source_info.endian=target_info.endian) then
+             begin
+{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
+               { not plongint, because that will "sign extend" the set on 64 bit platforms }
+               { if changed to "paword", please also modify "32-resultdef.size*8" and      }
+               { cross-endian code below                                                   }
+               location.value:=pCardinal(value_set)^
+{$else}
+               location.value:=reverse_byte(Psetbytes(value_set)^[0]);
+               location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[1]) shl 8);
+               location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[2]) shl 16);
+               location.value:=location.value or (reverse_byte(Psetbytes(value_set)^[3]) shl 24);
+{$endif}
+             end
+           else
+             begin
+               location.value:=swapendian(Pcardinal(value_set)^);
+               location.value:= reverse_byte (location.value         and $ff)         or
+                               (reverse_byte((location.value shr  8) and $ff) shl  8) or
+                               (reverse_byte((location.value shr 16) and $ff) shl 16) or
+                               (reverse_byte((location.value shr 24) and $ff) shl 24);
+             end;
+           if (target_info.endian=endian_big) then
+             location.value:=location.value shr (32-resultdef.size*8);
            exit;
          end;
         location_reset(location,LOC_CREFERENCE,OS_NO);
@@ -553,7 +568,16 @@ implementation
                              i:=0;
                              while assigned(hp1) and (i<32) do
                               begin
-                                if tai_const(hp1).value<>Psetbytes(value_set)^[i xor indexadjust] then
+                                if (source_info.endian=target_info.endian) then
+                                  begin
+{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
+                                    if tai_const(hp1).value<>Psetbytes(value_set)^[i ] then
+{$else}
+                                    if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i xor 3]) then
+{$endif}
+                                      break
+                                  end
+                                else if tai_const(hp1).value<>reverse_byte(Psetbytes(value_set)^[i]) then
                                   break;
                                 inc(i);
                                 hp1:=tai(hp1.next);
@@ -601,8 +625,17 @@ implementation
                  else
                  }
                   begin
-                    for i:=0 to 31 do
-                      current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i xor indexadjust]));
+                    if (source_info.endian=target_info.endian) then
+{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
+                      for i:=0 to 31 do
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i]))
+{$else}
+                      for i:=0 to 31 do
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i xor 3])))
+{$endif}
+                    else
+                      for i:=0 to 31 do
+                        current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i])));
                   end;
                end;
           end;

compiler/ncginl.pas

@@ -502,126 +502,26 @@ implementation
 
       procedure tcginlinenode.second_IncludeExclude;
         var
-          bitsperop,l : longint;
-          opsize : tcgsize;
-          cgop : topcg;
-          addrreg2,addrreg,
-          hregister,hregister2: tregister;
-          use_small : boolean;
-          href : treference;
+          setpara, elepara: tnode;
         begin
-          if not(is_varset(tcallparanode(left).resultdef)) and
-             not(is_normalset(tcallparanode(left).resultdef)) then
-            opsize:=int_cgsize(tcallparanode(left).resultdef.size)
-          else
-            opsize:=OS_32;
-          bitsperop:=(8*tcgsize2size[opsize]);
+          { the set }
           secondpass(tcallparanode(left).left);
-          if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
-            begin
-              { calculate bit position }
-              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod bitsperop);
+          { the element to set }
+          secondpass(tcallparanode(tcallparanode(left).right).left);
 
-              { determine operator }
-              if inlinenumber=in_include_x_y then
-                cgop:=OP_OR
-              else
-                begin
-                  cgop:=OP_AND;
-                  l:=not(l);
-                end;
-              case tcallparanode(left).left.location.loc of
-                LOC_REFERENCE :
-                  begin
-                    inc(tcallparanode(left).left.location.reference.offset,
-                      (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div bitsperop)*tcgsize2size[opsize]);
-                    cg.a_op_const_ref(current_asmdata.CurrAsmList,cgop,opsize,l,tcallparanode(left).left.location.reference);
-                  end;
-                LOC_CREGISTER :
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register);
-                else
-                  internalerror(200405021);
-              end;
+          setpara:=tcallparanode(left).left;
+          elepara:=tcallparanode(tcallparanode(left).right).left;
+
+          if elepara.location.loc=LOC_CONSTANT then
+            begin
+              cg.a_bit_set_const_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y),
+                elepara.location.value,setpara.location);
             end
           else
             begin
-              use_small:=
-                 { set type }
-                 (tsetdef(tcallparanode(left).left.resultdef).settype=smallset)
-                  and
-                   { elemenut number between 1 and 32 }
-                  ((tcallparanode(tcallparanode(left).right).left.resultdef.typ=orddef) and
-                   (torddef(tcallparanode(tcallparanode(left).right).left.resultdef).high<=32) or
-                   (tcallparanode(tcallparanode(left).right).left.resultdef.typ=enumdef) and
-                   (tenumdef(tcallparanode(tcallparanode(left).right).left.resultdef).max<=32));
-
-              { generate code for the element to set }
-              secondpass(tcallparanode(tcallparanode(left).right).left);
-
-              { bitnumber - which must be loaded into register }
-              hregister:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-              hregister2:=cg.getintregister(current_asmdata.CurrAsmList,opsize);
-
-              cg.a_load_loc_reg(current_asmdata.CurrAsmList,opsize,
-                  tcallparanode(tcallparanode(left).right).left.location,hregister);
-
-              if use_small then
-                begin
-                  { hregister contains the bitnumber to add }
-                  cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, 1, hregister2);
-                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_SHL, opsize, hregister, hregister2);
-
-                  { possiblities :
-                       bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
-                       set value : LOC_REFERENCE, LOC_REGISTER
-                  }
-                  { location of set }
-                  if inlinenumber=in_include_x_y then
-                    begin
-                      cg.a_op_reg_loc(current_asmdata.CurrAsmList, OP_OR, hregister2,
-                      tcallparanode(left).left.location);
-                    end
-                  else
-                    begin
-                      cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_NOT, opsize, hregister2,hregister2);
-                      cg.a_op_reg_loc(current_asmdata.CurrAsmList, OP_AND, hregister2,
-                          tcallparanode(left).left.location);
-                    end;
-                end
-              else
-                begin
-                  { possiblities :
-                       bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
-                       set value : LOC_REFERENCE
-                  }
-                  { hregister contains the bitnumber (div 32 to get the correct offset) }
-                  { hregister contains the bitnumber to add }
-
-                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, opsize, 5, hregister,hregister2);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SHL, opsize, 2, hregister2);
-                  addrreg:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                  { we need an extra address register to be able to do an ADD operation }
-                  addrreg2:=cg.getaddressregister(current_asmdata.CurrAsmList);
-                  cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,OS_ADDR,hregister2,addrreg2);
-                  { calculate the correct address of the operand }
-                  cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList, tcallparanode(left).left.location.reference,addrreg);
-                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_ADDR, addrreg2, addrreg);
-
-                  { hregister contains the bitnumber to add }
-                  cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, 1, hregister2);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_AND, opsize, 31, hregister);
-                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_SHL, opsize, hregister, hregister2);
-
-                  reference_reset_base(href,addrreg,0);
-
-                  if inlinenumber=in_include_x_y then
-                    cg.a_op_reg_ref(current_asmdata.CurrAsmList, OP_OR, opsize, hregister2, href)
-                  else
-                    begin
-                      cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_NOT, opsize, hregister2, hregister2);
-                      cg.a_op_reg_ref(current_asmdata.CurrAsmList, OP_AND, opsize, hregister2, href);
-                    end;
-                end;
+              location_force_reg(current_asmdata.CurrAsmList,elepara.location,OS_INT,true);
+              cg.a_bit_set_reg_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y),
+                elepara.location.size,elepara.location.register,setpara.location);
             end;
         end;
 

compiler/ncgrtti.pas

@@ -39,6 +39,7 @@ interface
         function  fields_count(st:tsymtable;rt:trttitype):longint;
         procedure fields_write_rtti(st:tsymtable;rt:trttitype);
         procedure fields_write_rtti_data(st:tsymtable;rt:trttitype);
+        procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
         procedure published_write_rtti(st:tsymtable;rt:trttitype);
         function  published_properties_count(st:tsymtable):longint;
         procedure published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable);
@@ -50,6 +51,8 @@ interface
       public
         procedure write_rtti(def:tdef;rt:trttitype);
         function  get_rtti_label(def:tdef;rt:trttitype):tasmsymbol;
+        function  get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
+        function  get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
       end;
 
     var
@@ -60,7 +63,7 @@ implementation
 
     uses
        cutils,
-       globals,globtype,verbose,
+       globals,globtype,verbose,systems,
        fmodule,
        symsym,
        aasmtai,aasmdata
@@ -228,7 +231,7 @@ implementation
         var
            typvalue : byte;
            hp : ppropaccesslistitem;
-           address : longint;
+           address,space : longint;
            def : tdef;
            hpropsym : tpropertysym;
            propaccesslist : tpropaccesslist;
@@ -270,7 +273,12 @@ implementation
                            if not(assigned(def) and (def.typ=arraydef)) then
                              internalerror(200402172);
                            def:=tarraydef(def).elementdef;
-                           inc(address,def.size*hp^.value);
+                           {Hp.value is a Tconstexprint, which can be rather large,
+                            sanity check for longint overflow.}
+                           space:=(high(address)-address) div def.size;
+                           if int64(space)<hp^.value then
+                             internalerror(200706101);
+                           inc(address,int64(def.size*hp^.value));
                          end;
                      end;
                      hp:=hp^.next;
@@ -331,9 +339,8 @@ implementation
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo));
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tpropertysym(sym).realname)));
                 current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tpropertysym(sym).realname));
-{$ifdef cpurequiresproperalignment}
-                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+                if (tf_requires_proper_alignment in target_info.flags) then
+                  current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
              end;
           end;
       end;
@@ -375,9 +382,8 @@ implementation
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSString));
                  write_rtti_name(def);
                  current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.len));
-{$ifdef cpurequiresproperalignment}
-                 current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+                 if (tf_requires_proper_alignment in target_info.flags) then
+                   current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
               end;
           end;
         end;
@@ -388,9 +394,8 @@ implementation
         begin
           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkEnumeration));
           write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+          if (tf_requires_proper_alignment in target_info.flags) then
+            current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUInt)));
           case longint(def.size) of
             1 :
               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
@@ -399,9 +404,8 @@ implementation
             4 :
               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
           end;
-{$ifdef cpurequiresproperalignment}
-          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+          if (tf_requires_proper_alignment in target_info.flags) then
+            current_asmdata.asmlists[al_rtti].concat(Cai_align.Create(sizeof(TConstPtrUInt)));
           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min));
           current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max));
           if assigned(def.basedef) then
@@ -430,13 +434,11 @@ implementation
                otUByte,otUWord,otUByte);
           begin
             write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype])));
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high)));
           end;
@@ -447,9 +449,8 @@ implementation
               begin
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkInt64));
                 write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+                if (tf_requires_proper_alignment in target_info.flags) then
+                  current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
                 { low }
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(int64($80000000) shl 32));
                 { high }
@@ -459,9 +460,8 @@ implementation
               begin
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkQWord));
                 write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+                if (tf_requires_proper_alignment in target_info.flags) then
+                  current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
                 { low }
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(0));
                 { high }
@@ -499,9 +499,8 @@ implementation
         begin
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkFloat));
            write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[def.floattype]));
         end;
 
@@ -510,9 +509,8 @@ implementation
         begin
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkSet));
            write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            case def.size of
              1:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte));
@@ -521,9 +519,8 @@ implementation
              4:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong));
            end;
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt)));
         end;
 
@@ -535,9 +532,8 @@ implementation
            else
              current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray));
            write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            { size of elements }
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(def.elesize));
            if not(ado_IsDynamicArray in def.arrayoptions) then
@@ -554,9 +550,8 @@ implementation
         begin
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkrecord));
            write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size));
            fieldcnt:=fields_count(def.symtable,rt);
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(fieldcnt));
@@ -598,9 +593,8 @@ implementation
                { write method id and name }
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkmethod));
                write_rtti_name(def);
-{$ifdef cpurequiresproperalignment}
-               current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+               if (tf_requires_proper_alignment in target_info.flags) then
+                 current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 
                { write kind of method (can only be function or procedure)}
                if def.returndef = voidtype then
@@ -674,15 +668,13 @@ implementation
             { write unit name }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
             current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 
             { write published properties for this object }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable)));
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
             published_properties_write_rtti_data(propnamelist,def.symtable);
 
             propnamelist.free;
@@ -718,9 +710,8 @@ implementation
               {
               ifDispatch, }
               ));
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1)));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2));
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3));
@@ -730,9 +721,8 @@ implementation
             { write unit name }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(current_module.realmodulename^)));
             current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(current_module.realmodulename^));
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 
             { write iidstr }
             if assigned(def.iidstr) then
@@ -742,9 +732,8 @@ implementation
               end
             else
               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0));
-{$ifdef cpurequiresproperalignment}
-            current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 
             { write published properties for this object }
             published_properties_write_rtti_data(propnamelist,def.symtable);
@@ -770,9 +759,8 @@ implementation
            { generate the name }
            current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(def.objrealname^)));
            current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(def.objrealname^));
-{$ifdef cpurequiresproperalignment}
-           current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+           if (tf_requires_proper_alignment in target_info.flags) then
+             current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
 
            case rt of
              initrtti :
@@ -829,6 +817,231 @@ implementation
         end;
       end;
 
+    procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol);
+
+        procedure enumdef_rtti_ord2stringindex(def:Tenumdef);
+
+        var rttilab:Tasmsymbol;
+            t:Tenumsym;
+            syms:^Tenumsym;
+            offsets:^longint;
+            sym_count,sym_alloc:longint;
+            h,i,p,o,st:longint;
+            mode:(lookup,search); {Modify with care, ordinal value of enum is written.}
+            r:single;             {Must be real type because of integer overflow risk.}
+
+        begin
+          {Random access needed, put in array.}
+          getmem(syms,64*sizeof(Tenumsym));
+          getmem(offsets,64*sizeof(longint));
+          sym_count:=0;
+          sym_alloc:=64;
+          st:=0;
+          t:=Tenumsym(def.firstenum);
+          while assigned(t) do
+            begin
+              if sym_count>=sym_alloc then
+                begin
+                  reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
+                  reallocmem(offsets,2*sym_alloc*sizeof(longint));
+                  sym_alloc:=sym_alloc*2;
+                end;
+              syms[sym_count]:=t;
+              offsets[sym_count]:=st;
+              inc(sym_count);
+              st:=st+length(t.realname)+1;
+              t:=t.nextenum;
+            end;
+          {Sort the syms by enum value}
+          if sym_count>=2 then
+            begin
+              p:=1;
+              while 2*p<sym_count do
+                p:=2*p;
+              while p<>0 do
+                begin
+                  for h:=p to sym_count-1 do
+                    begin
+                      i:=h;
+                      t:=syms[i];
+                      o:=offsets[i];
+                      repeat
+                        if syms[i-p].value<=t.value then
+                          break;
+                        syms[i]:=syms[i-p];
+                        offsets[i]:=offsets[i-p];
+                        dec(i,p);
+                      until i<p;
+                      syms[i]:=t;
+                      offsets[i]:=o;
+                    end;
+                  p:=p shr 1;
+                end;
+            end;
+          {Decide wether a lookup array is size efficient.}
+          mode:=lookup;
+          if sym_count>0 then
+            begin
+              i:=1;
+              r:=0;
+              h:=syms[0].value; {Next expected enum value is min.}
+              while i<sym_count do
+                begin
+                  {Calculate size of hole between values. Avoid integer overflows.}
+                  r:=r+(single(syms[i].value)-single(h))-1;
+                  h:=syms[i].value;
+                  inc(i);
+                end;
+              if r>sym_count then
+                mode:=search; {Don't waste more than 50% space.}
+            end;
+          {Calculate start of string table.}
+          st:=1;
+          if assigned(def.typesym) then
+            inc(st,length(def.typesym.realname)+1)
+          else
+            inc(st);
+          if (tf_requires_proper_alignment in target_info.flags) then
+            align(st,sizeof(Tconstptruint));
+          inc(st);
+          if (tf_requires_proper_alignment in target_info.flags) then
+            align(st,sizeof(Tconstptruint));
+          inc(st,8+sizeof(aint));
+          { write rtti data }
+          with current_asmdata do
+            begin
+              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA);
+              maybe_new_object_file(asmlists[al_rtti]);
+              new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(aint)));
+              asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
+              asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode)));
+              if mode=lookup then
+                begin
+                  o:=syms[0].value;  {Start with min value.}
+                  for i:=0 to sym_count-1 do
+                    begin
+                      while o<syms[i].value do
+                        begin
+                          asmlists[al_rtti].concat(Tai_const.create_aint(0));
+                          inc(o);
+                        end;
+                      inc(o);
+                      asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                    end;
+                end
+              else
+                begin
+                  asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
+                  for i:=0 to sym_count-1 do
+                    begin
+                      asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
+                      asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                    end;
+                end;
+              asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+            end;
+          dispose(syms);
+          dispose(offsets);
+        end;
+
+        procedure enumdef_rtti_string2ordindex(def:Tenumdef);
+
+        var rttilab:Tasmsymbol;
+            t:Tenumsym;
+            syms:^Tenumsym;
+            offsets:^longint;
+            sym_count,sym_alloc:longint;
+            h,i,p,o,st:longint;
+
+        begin
+          {Random access needed, put in array.}
+          getmem(syms,64*sizeof(Tenumsym));
+          getmem(offsets,64*sizeof(longint));
+          sym_count:=0;
+          sym_alloc:=64;
+          st:=0;
+          t:=Tenumsym(def.firstenum);
+          while assigned(t) do
+            begin
+              if sym_count>=sym_alloc then
+                begin
+                  reallocmem(syms,2*sym_alloc*sizeof(Tenumsym));
+                  reallocmem(offsets,2*sym_alloc*sizeof(longint));
+                  sym_alloc:=sym_alloc*2;
+                end;
+              syms[sym_count]:=t;
+              offsets[sym_count]:=st;
+              inc(sym_count);
+              st:=st+length(t.realname)+1;
+              t:=t.nextenum;
+            end;
+          {Sort the syms by enum name}
+          if sym_count>=2 then
+            begin
+              p:=1;
+              while 2*p<sym_count do
+                p:=2*p;
+              while p<>0 do
+                begin
+                  for h:=p to sym_count-1 do
+                    begin
+                      i:=h;
+                      t:=syms[i];
+                      o:=offsets[i];
+                      repeat
+                        if syms[i-p].name<=t.name then
+                          break;
+                        syms[i]:=syms[i-p];
+                        offsets[i]:=offsets[i-p];
+                        dec(i,p);
+                      until i<p;
+                      syms[i]:=t;
+                      offsets[i]:=o;
+                    end;
+                  p:=p shr 1;
+                end;
+            end;
+          {Calculate start of string table.}
+          st:=1;
+          if assigned(def.typesym) then
+            inc(st,length(def.typesym.realname)+1)
+          else
+            inc(st);
+          if (tf_requires_proper_alignment in target_info.flags) then
+            align(st,sizeof(Tconstptruint));
+          inc(st);
+          if (tf_requires_proper_alignment in target_info.flags) then
+            align(st,sizeof(Tconstptruint));
+          inc(st,8+sizeof(aint));
+          { write rtti data }
+          with current_asmdata do
+            begin
+              rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA);
+              maybe_new_object_file(asmlists[al_rtti]);
+              new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(aint)));
+              asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0));
+              asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count));
+              for i:=0 to sym_count-1 do
+                begin
+                  asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value));
+                  asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i]));
+                end;
+              asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab));
+            end;
+          dispose(syms);
+          dispose(offsets);
+        end;
+
+    begin
+      case def.typ of
+        enumdef:
+          if rt=fullrtti then
+            begin
+              enumdef_rtti_ord2stringindex(Tenumdef(def));
+              enumdef_rtti_string2ordindex(Tenumdef(def));
+            end;
+      end;
+    end;
 
     procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype);
       begin
@@ -881,6 +1094,7 @@ implementation
         current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0));
         write_rtti_data(def,rt);
         current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab));
+        write_rtti_extrasyms(def,rt,rttilab);
       end;
 
 
@@ -889,5 +1103,15 @@ implementation
         result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt));
       end;
 
+    function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol;
+      begin
+        result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s');
+      end;
+
+    function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol;
+      begin
+        result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o');
+      end;
+
 end.
 

compiler/ncgset.pas

@@ -27,7 +27,7 @@ interface
 
     uses
        globtype,globals,
-       node,nset,cpubase,cgbase,cgobj,aasmbase,aasmtai,aasmdata;
+       node,nset,cpubase,cgbase,cgutils,cgobj,aasmbase,aasmtai,aasmdata;
 
     type
        tcgsetelementnode = class(tsetelementnode)
@@ -45,18 +45,6 @@ interface
           function pass_1: tnode;override;
           procedure pass_generate_code;override;
        protected
-          {# Routine to test bitnumber in bitnumber register on value
-             in value register. The __result register should be set
-             to one if the bit is set, otherwise __result register
-             should be set to zero.
-
-             Should be overriden on processors which have specific
-             instructions to do bit tests.
-          }
-
-          procedure emit_bit_test_reg_reg(list : TAsmList;
-                                          bitsize: tcgsize; bitnumber,value : tregister;
-                                          ressize: tcgsize; res :tregister);virtual;
           function checkgenjumps(out setparts: Tsetparts; out numparts: byte; out use_small: boolean): boolean; virtual;
           function analizeset(const Aset:Tconstset;out setparts: Tsetparts; out numparts: byte;is_small:boolean):boolean;virtual;
        end;
@@ -100,8 +88,7 @@ implementation
       paramgr,
       procinfo,pass_2,tgobj,
       nbas,ncon,nflw,
-      ncgutil,regvars,
-      cgutils;
+      ncgutil;
 
 
 {*****************************************************************************
@@ -133,45 +120,6 @@ implementation
 {*****************************************************************************
 *****************************************************************************}
 
-  {**********************************************************************}
-  {  Description: Emit operation to do a bit test, where the bitnumber   }
-  {  to test is in the bitnumber register. The value to test against is  }
-  {  located in the value register.                                      }
-  {   WARNING: Bitnumber register value is DESTROYED!                    }
-  {  __Result register is set to 1, if the bit is set otherwise, __Result}
-  {   is set to zero. __RESULT register is also used as scratch.         }
-  {**********************************************************************}
-  procedure tcginnode.emit_bit_test_reg_reg(list : TAsmList;
-                                            bitsize: tcgsize; bitnumber,value : tregister;
-                                            ressize: tcgsize; res :tregister);
-    begin
-      { first make sure that the bit number is modulo 32 }
-
-      { not necessary, since if it's > 31, we have a range error -> will }
-      { be caught when range checking is on! (JM)                        }
-      { cg.a_op_const_reg(list,OP_AND,31,bitnumber);                     }
-
-      if tcgsize2unsigned[bitsize]<>tcgsize2unsigned[ressize] then
-        begin
-          internalerror(2007020401);
-          { FIX ME! We're not allowed to modify the value register here! }
-
-          { shift value register "bitnumber" bits to the right }
-          cg.a_op_reg_reg(list,OP_SHR,bitsize,bitnumber,value);
-          { extract the bit we want }
-          cg.a_op_const_reg(list,OP_AND,bitsize,1,value);
-          cg.a_load_reg_reg(list,bitsize,ressize,value,res);
-        end
-      else
-        begin
-          { rotate value register "bitnumber" bits to the right }
-          cg.a_op_reg_reg_reg(list,OP_SHR,bitsize,bitnumber,value,res);
-          { extract the bit we want }
-          cg.a_op_const_reg(list,OP_AND,bitsize,1,res);
-        end;
-    end;
-
-
   function tcginnode.analizeset(const Aset:Tconstset; out setparts:tsetparts; out numparts: byte; is_small:boolean):boolean;
     var
       compares,maxcompares:word;
@@ -234,8 +182,8 @@ implementation
          { check if we can use smallset operation using btl which is limited
            to 32 bits, the left side may also not contain higher values !! }
          use_small:=(tsetdef(right.resultdef).settype=smallset) and not is_signed(left.resultdef) and
-                    ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<=32) or
-                     (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<=32));
+                    ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<32) or
+                     (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32));
 
          { Can we generate jumps? Possible for all types of sets }
          checkgenjumps:=(right.nodetype=setconstn) and
@@ -258,10 +206,11 @@ implementation
     procedure tcginnode.pass_generate_code;
        var
          adjustment : aint;
+				 l,l2,
          otl, ofl   : tasmlabel;
          hr,hr2,
          pleftreg   : tregister;
-	 href       : treference;
+         href       : treference;
          setparts   : Tsetparts;
          opsize     : tcgsize;
          uopsize    : tcgsize;
@@ -270,7 +219,6 @@ implementation
          use_small,
          isjump     : boolean;
          i,numparts : byte;
-         l, l2      : tasmlabel;
          needslabel : Boolean;
        begin
          { We check first if we can generate jumps, this can be done
@@ -403,30 +351,25 @@ implementation
           begin
             { location is always LOC_REGISTER }
             location_reset(location, LOC_REGISTER, uopsize{def_cgsize(resultdef)});
+            { allocate a register for the result }
+            location.register := cg.getintregister(current_asmdata.CurrAsmList, uopsize);
 
             { We will now generated code to check the set itself, no jmps,
               handle smallsets separate, because it allows faster checks }
             if use_small then
              begin
                {****************************  SMALL SET **********************}
-               if left.nodetype=ordconstn then
+               if left.location.loc=LOC_CONSTANT then
                 begin
-                  location_force_reg(current_asmdata.CurrAsmList, right.location, uopsize, true);
-                  location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
-                  { first SHR the register }
-                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, uopsize, tordconstnode(left).value and 31, right.location.register, location.register);
-                  { then extract the lowest bit }
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_AND, uopsize, 1, location.register);
+                  cg.a_bit_test_const_loc_reg(current_asmdata.CurrAsmList,location.size,
+                    left.location.value,right.location,
+                    location.register);
                 end
                else
                 begin
-                  location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false);
-                  location_force_reg(current_asmdata.CurrAsmList, right.location, uopsize, false);
-                  { allocate a register for the result }
-                  location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
-                  { emit bit test operation }
-                  emit_bit_test_reg_reg(current_asmdata.CurrAsmList,left.location.size,left.location.register,
-                      right.location.register,location.size,location.register);
+                  location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
+                  cg.a_bit_test_reg_loc_reg(current_asmdata.CurrAsmList,left.location.size,
+                    location.size,left.location.register,right.location,location.register);
                 end;
              end
             else
@@ -441,59 +384,39 @@ implementation
                   { assumption (other cases will be caught by range checking) (JM)  }
 
                   { load left in register }
-                  location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
-                  if left.location.loc = LOC_CREGISTER then
-                    hr := cg.getintregister(current_asmdata.CurrAsmList,opsize)
-                  else
-                    hr := left.location.register;
-                  { load right in register }
-                  hr2:=cg.getintregister(current_asmdata.CurrAsmList, uopsize);
-                  cg.a_load_const_reg(current_asmdata.CurrAsmList, uopsize, right.location.value, hr2);
-
+                  location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,true);
+                  location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true);
                   { emit bit test operation }
-                  emit_bit_test_reg_reg(current_asmdata.CurrAsmList, left.location.size, left.location.register, hr2, uopsize, hr2);
-
-                  { if left > 31 then hr := 0 else hr := $ffffffff }
-                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SUB, uopsize, 32, left.location.register, hr);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SAR, uopsize, 31, hr);
-
-                  { if left > 31, then result := 0 else result := result of bit test }
-                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_AND, uopsize, hr, hr2);
-                  { allocate a register for the result }
-                  location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size);
-                  cg.a_load_reg_reg(current_asmdata.CurrAsmList, uopsize, location.size, hr2, location.register);
+                  cg.a_bit_test_reg_reg_reg(current_asmdata.CurrAsmList,
+                    left.location.size,right.location.size,location.size,
+                    left.location.register, right.location.register,location.register);
+
+                  { now zero the result if left > nr_of_bits_in_right_register }
+                  hr := cg.getintregister(current_asmdata.CurrAsmList,location.size);
+                  { if left > tcgsize2size[opsize]*8 then hr := 0 else hr := $ffffffff }
+                  { (left.location.size = location.size at this point) }
+                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SUB, location.size, tcgsize2size[opsize]*8, left.location.register, hr);
+                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SAR, location.size, (tcgsize2size[opsize]*8)-1, hr);
+
+                  { if left > tcgsize2size[opsize]*8-1, then result := 0 else result := result of bit test }
+                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_AND, location.size, hr, location.register);
                 end { of right.location.loc=LOC_CONSTANT }
                { do search in a normal set which could have >32 elementsm
                  but also used if the left side contains higher values > 32 }
-               else if left.nodetype=ordconstn then
+               else if (left.location.loc=LOC_CONSTANT) then
                 begin
-                  if (tordconstnode(left).value < 0) or ((tordconstnode(left).value shr 3) >= right.resultdef.size) then
+                  if (left.location.value < 0) or ((left.location.value shr 3) >= right.resultdef.size) then
                     {should be caught earlier }
                     internalerror(2007020402);
 
-                  { use location.register as scratch register here }
-                  if (target_info.endian = endian_little) then
-                    inc(right.location.reference.offset,tordconstnode(left).value shr 3)
-                  else
-                    { adjust for endianess differences }
-                    inc(right.location.reference.offset,(tordconstnode(left).value shr 3) xor 3);
-                  { allocate a register for the result }
-                  location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size);
-                  cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_8,location.size,right.location.reference, location.register);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,location.size,tordconstnode(left).value and 7,
-                    location.register);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,location.size,1,location.register);
+                  cg.a_bit_test_const_loc_reg(current_asmdata.CurrAsmList,location.size,left.location.value,
+                    right.location,location.register);
                 end
                else
                 begin
                   location_force_reg(current_asmdata.CurrAsmList, left.location, opsize, true);
                   pleftreg := left.location.register;
 
-                  location_freetemp(current_asmdata.CurrAsmList,left.location);
-
-                  { allocate a register for the result }
-                  location.register := cg.getintregister(current_asmdata.CurrAsmList, uopsize);
-
                   if (opsize >= OS_S8) or { = if signed }
                      ((left.resultdef.typ=orddef)  and (torddef(left.resultdef).high > tsetdef(right.resultdef).setmax)) or
                      ((left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max > tsetdef(right.resultdef).setmax)) then
@@ -502,47 +425,16 @@ implementation
                       current_asmdata.getjumplabel(l2);
                       needslabel := True;
 
-                      cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_BE, tsetdef(right.resultdef).setmax, pleftreg, l);
+                      cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, left.location.size, OC_BE, tsetdef(right.resultdef).setmax, pleftreg, l);
 
-                      cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, 0, location.register);
+                      cg.a_load_const_reg(current_asmdata.CurrAsmList, location.size, 0, location.register);
                       cg.a_jmp_always(current_asmdata.CurrAsmList, l2);
 
                       cg.a_label(current_asmdata.CurrAsmList, l);
                     end;
 
-                  case right.location.loc of
-                    LOC_REGISTER, LOC_CREGISTER :
-                      begin
-                        cg.a_load_reg_reg(current_asmdata.CurrAsmList, uopsize, uopsize, right.location.register, location.register);
-                      end;
-                    LOC_CREFERENCE, LOC_REFERENCE :
-                      begin
-                        hr := cg.getaddressregister(current_asmdata.CurrAsmList);
-                        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, uopsize, 5, pleftreg, hr);
-                        cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SHL, uopsize, 2, hr);
-
-                        href := right.location.reference;
-                        if (href.base = NR_NO) then
-                          href.base := hr
-                        else if (right.location.reference.index = NR_NO) then
-                          href.index := hr
-                        else
-                          begin
-                            hr2 := cg.getaddressregister(current_asmdata.CurrAsmList);
-                            cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList, href, hr2);
-                            reference_reset_base(href, hr2, 0);
-                            href.index := hr;
-                          end;
-                        cg.a_load_ref_reg(current_asmdata.CurrAsmList, uopsize, uopsize, href, location.register);
-                      end
-                    else
-                      internalerror(2007020403);
-                  end;
-
-                  hr := cg.getintregister(current_asmdata.CurrAsmList, uopsize);
-                  cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, uopsize, 31, pleftreg, hr);
-                  cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_SHR, uopsize, hr, location.register);
-                  cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_AND, uopsize, 1, location.register);
+                  cg.a_bit_test_reg_loc_reg(current_asmdata.CurrAsmList,left.location.size,location.size,
+                    left.location.register,right.location,location.register);
 
                   if needslabel then
                     cg.a_label(current_asmdata.CurrAsmList, l2);

compiler/ncgutil.pas

@@ -2379,7 +2379,7 @@ implementation
             { tempinfo^.valid will be false and so we do not add            }
             { unnecessary registers. This way, we don't have to look at     }
             { tempcreate and tempdestroy nodes to get this info (JM)        }
-            if (ttemprefnode(n).tempinfo^.valid) then
+            if (ti_valid in ttemprefnode(n).tempinfo^.flags) then
               add_regvars(rv^,ttemprefnode(n).tempinfo^.location);
           loadn:
             if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then
@@ -2501,9 +2501,11 @@ implementation
             end;
           temprefn:
             begin
-              if (ttemprefnode(n).tempinfo^.valid) and
+              if (ti_valid in ttemprefnode(n).tempinfo^.flags) and
                  (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and
-                 (ttemprefnode(n).tempinfo^.location.register = rr^.old) then
+                 (ttemprefnode(n).tempinfo^.location.register = rr^.old) and
+                 (not(ti_is_inlined_result in ttemprefnode(n).tempinfo^.flags) or
+                  not(fc_exit in flowcontrol)) then
                 begin
 {$ifndef cpu64bit}
                   { it's possible a 64 bit location was shifted and/xor typecasted }

compiler/ncnv.pas

@@ -1560,7 +1560,7 @@ implementation
             convtype:=tc_equal;
             if not(tstoreddef(resultdef).is_intregable) and
                not(tstoreddef(resultdef).is_fpuregable) then
-              make_not_regable(left,vr_addr);
+              make_not_regable(left,[ra_addr_regable]);
             exit;
           end;
 
@@ -1713,7 +1713,7 @@ implementation
                          not(tstoreddef(resultdef).is_fpuregable)) or
                         ((left.resultdef.typ = floatdef) and
                          (resultdef.typ <> floatdef))  then
-                       make_not_regable(left,vr_addr);
+                       make_not_regable(left,[ra_addr_regable]);
 
                      { class/interface to class/interface, with checkobject support }
                      if is_class_or_interface(resultdef) and
@@ -1775,13 +1775,19 @@ implementation
 
                       else
                        begin
-                         { only if the same size or formal def }
+                         { only if the same size or formal def, and }
+                         { don't allow type casting of constants to }
+                         { structured types                         }
                          if not(
                                 (left.resultdef.typ=formaldef) or
                                 (
                                  not(is_open_array(left.resultdef)) and
                                  not(is_array_constructor(left.resultdef)) and
-                                 (left.resultdef.size=resultdef.size)
+                                 (left.resultdef.size=resultdef.size) and
+                                 (not is_constnode(left) or
+                                  (not(resultdef.typ in [arraydef,recorddef,setdef,stringdef,
+                                                         filedef,variantdef,objectdef]) or
+                                   is_class_or_interface(resultdef)))
                                 ) or
                                 (
                                  is_void(left.resultdef)  and
@@ -2608,7 +2614,7 @@ implementation
         { When using only a part of the value it can't be in a register since
           that will load the value in a new register first }
         if (resultdef.size<left.resultdef.size) then
-          make_not_regable(left,vr_addr);
+          make_not_regable(left,[ra_addr_regable]);
       end;
 
 

compiler/ncon.pas

@@ -973,7 +973,7 @@ implementation
         inherited ppuload(t,ppufile);
         ppufile.getderef(typedefderef);
         new(value_set);
-        ppufile.getdata(value_set^,sizeof(tconstset));
+        ppufile.getnormalset(value_set^);
       end;
 
 
@@ -981,7 +981,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putderef(typedefderef);
-        ppufile.putdata(value_set^,sizeof(tconstset));
+        ppufile.putnormalset(value_set^);
       end;
 
 

compiler/nld.pas

@@ -269,7 +269,7 @@ implementation
                     (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or
                     (current_procinfo.procdef.proctypeoption=potype_unitfinalize)
                   ) then
-                 make_not_regable(self,vr_none);
+                 make_not_regable(self,[ra_addr_taken]);
                resultdef:=tabstractvarsym(symtableentry).vardef;
              end;
            paravarsym,
@@ -288,7 +288,8 @@ implementation
                    { we can't inline the referenced parent procedure }
                    exclude(tprocdef(symtable.defowner).procoptions,po_inline);
                    { reference in nested procedures, variable needs to be in memory }
-                   make_not_regable(self,vr_none);
+                   { and behaves as if its address escapes its parent block         }
+                   make_not_regable(self,[ra_addr_taken]);
                  end;
                { fix self type which is declared as voidpointer in the
                  definition }
@@ -672,6 +673,16 @@ implementation
          if codegenerror then
            exit;
 
+         { if right is a function call for which the address of the result  }
+         { is allocated by the caller and passed to the function via an     }
+         { invisible function result, try to pass the x in "x:=f(...)" as   }
+         { that function result instead. Condition: x cannot be accessible  }
+         { from within f. This is the case if x is a temp, or x is a local  }
+         { variable or value parameter of the current block and its address }
+         { is not passed to f. One problem: what if someone takes the       }
+         { address of x, puts it in a pointer variable/field and then       }
+         { accesses it that way from within the function? This is solved    }
+         { (in a conservative way) using the ti_addr_taken/addr_taken flags }
          if (cs_opt_level1 in current_settings.optimizerswitches) and
             (right.nodetype = calln) and
             (right.resultdef=left.resultdef) and
@@ -681,7 +692,25 @@ implementation
             { function                                                       }
             (
              (
-              (left.nodetype = temprefn) and
+              (((left.nodetype = temprefn) and
+                not(ti_addr_taken in ttemprefnode(left).tempinfo^.flags) and
+                not(ti_may_be_in_reg in ttemprefnode(left).tempinfo^.flags)) or
+               ((left.nodetype = loadn) and
+                { nested procedures may access the current procedure's locals }
+                (tcallnode(right).procdefinition.parast.symtablelevel=normal_function_level) and
+                { must be a local variable or a value para }
+                ((tloadnode(left).symtableentry.typ = localvarsym) or
+                 ((tloadnode(left).symtableentry.typ = paravarsym) and
+                  (tparavarsym(tloadnode(left).symtableentry).varspez = vs_value)
+                 )
+                ) and
+                { the address may not have been taken of the variable/parameter, because }
+                { otherwise it's possible that the called function can access it via a   }
+                { global variable or other stored state                                  }
+                not(tabstractvarsym(tloadnode(left).symtableentry).addr_taken) and
+                (tabstractvarsym(tloadnode(left).symtableentry).varregable in [vr_none,vr_addr])
+               )
+              ) and
               paramanager.ret_in_param(right.resultdef,tcallnode(right).procdefinition.proccalloption)
              ) or
              { there's special support for ansi/widestrings in the callnode }
@@ -689,7 +718,8 @@ implementation
              is_widestring(right.resultdef)
             )  then
            begin
-             make_not_regable(left,vr_addr);
+             if assigned(tcallnode(right).funcretnode) then
+               internalerror(2007080201);
              tcallnode(right).funcretnode := left;
              result := right;
              left := nil;

compiler/nmem.pas

@@ -353,7 +353,7 @@ implementation
         if codegenerror then
          exit;
 
-        make_not_regable(left,vr_addr);
+        make_not_regable(left,[ra_addr_regable,ra_addr_taken]);
 
         { don't allow constants, for internal use we also
           allow taking the address of strings }
@@ -607,7 +607,7 @@ implementation
         // don't put records from which we load fields which aren't regable in integer registers
         if (left.resultdef.typ = recorddef) and
            not(tstoreddef(resultdef).is_intregable) then
-          make_not_regable(left,vr_addr);
+          make_not_regable(left,[ra_addr_regable]);
       end;
 
     procedure Tsubscriptnode.mark_write;

compiler/nobj.pas

@@ -1106,9 +1106,8 @@ implementation
         { write fields }
         current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(fieldtable));
         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(fieldcount));
-{$ifdef cpurequiresproperalignment}
-        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+        if (tf_requires_proper_alignment in target_info.flags) then
+          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(classtable));
         for i:=0 to _class.symtable.SymList.Count-1 do
           begin
@@ -1116,9 +1115,8 @@ implementation
             if (tsym(sym).typ=fieldvarsym) and
                (sp_published in tsym(sym).symoptions) then
               begin
-{$ifdef cpurequiresproperalignment}
-                current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(AInt)));
-{$endif cpurequiresproperalignment}
+                if (tf_requires_proper_alignment in target_info.flags) then
+                  current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(AInt)));
                 current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_aint(tfieldvarsym(sym).fieldoffset));
                 classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef);
                 if classindex=-1 then
@@ -1133,9 +1131,8 @@ implementation
         current_asmdata.asmlists[al_rtti].concat(cai_align.create(const_align(sizeof(aint))));
         current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(classtable));
         current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(classtablelist.count));
-{$ifdef cpurequiresproperalignment}
-        current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
-{$endif cpurequiresproperalignment}
+        if (tf_requires_proper_alignment in target_info.flags) then
+          current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt)));
         for i:=0 to classtablelist.Count-1 do
           current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(tobjectdef(classtablelist[i]).vmt_mangledname,0));
 

compiler/ogelf.pas

@@ -327,19 +327,19 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.e_type:=swapword(e_type);
-                result.e_machine:=swapword(e_machine);
-                result.e_version:=swaplong(e_version);
-                result.e_entry:=swaplong(e_entry);
-                result.e_phoff:=swaplong(e_phoff);
-                result.e_shoff:=swaplong(e_shoff);
-                result.e_flags:=swaplong(e_flags);
-                result.e_ehsize:=swapword(e_ehsize);
-                result.e_phentsize:=swapword(e_phentsize);
-                result.e_phnum:=swapword(e_phnum);
-                result.e_shentsize:=swapword(e_shentsize);
-                result.e_shnum:=swapword(e_shnum);
-                result.e_shstrndx:=swapword(e_shstrndx);
+                result.e_type:=swapendian(e_type);
+                result.e_machine:=swapendian(e_machine);
+                result.e_version:=swapendian(e_version);
+                result.e_entry:=swapendian(e_entry);
+                result.e_phoff:=swapendian(e_phoff);
+                result.e_shoff:=swapendian(e_shoff);
+                result.e_flags:=swapendian(e_flags);
+                result.e_ehsize:=swapendian(e_ehsize);
+                result.e_phentsize:=swapendian(e_phentsize);
+                result.e_phnum:=swapendian(e_phnum);
+                result.e_shentsize:=swapendian(e_shentsize);
+                result.e_shnum:=swapendian(e_shnum);
+                result.e_shstrndx:=swapendian(e_shstrndx);
               end;
         end;
 
@@ -350,19 +350,19 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.e_type:=swapword(e_type);
-                result.e_machine:=swapword(e_machine);
-                result.e_version:=swaplong(e_version);
-                result.e_entry:=swapqword(e_entry);
-                result.e_phoff:=swapqword(e_phoff);
-                result.e_shoff:=swapqword(e_shoff);
-                result.e_flags:=swaplong(e_flags);
-                result.e_ehsize:=swapword(e_ehsize);
-                result.e_phentsize:=swapword(e_phentsize);
-                result.e_phnum:=swapword(e_phnum);
-                result.e_shentsize:=swapword(e_shentsize);
-                result.e_shnum:=swapword(e_shnum);
-                result.e_shstrndx:=swapword(e_shstrndx);
+                result.e_type:=swapendian(e_type);
+                result.e_machine:=swapendian(e_machine);
+                result.e_version:=swapendian(e_version);
+                result.e_entry:=swapendian(e_entry);
+                result.e_phoff:=swapendian(e_phoff);
+                result.e_shoff:=swapendian(e_shoff);
+                result.e_flags:=swapendian(e_flags);
+                result.e_ehsize:=swapendian(e_ehsize);
+                result.e_phentsize:=swapendian(e_phentsize);
+                result.e_phnum:=swapendian(e_phnum);
+                result.e_shentsize:=swapendian(e_shentsize);
+                result.e_shnum:=swapendian(e_shnum);
+                result.e_shstrndx:=swapendian(e_shstrndx);
               end;
         end;
 
@@ -373,16 +373,16 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.sh_name:=SwapLong(sh_name);
-                result.sh_type:=SwapLong(sh_type);
-                result.sh_flags:=SwapLong(sh_flags);
-                result.sh_addr:=SwapLong(sh_addr);
-                result.sh_offset:=SwapLong(sh_offset);
-                result.sh_size:=SwapLong(sh_size);
-                result.sh_link:=SwapLong(sh_link);
-                result.sh_info:=SwapLong(sh_info);
-                result.sh_addralign:=SwapLong(sh_addralign);
-                result.sh_entsize:=SwapLong(sh_entsize);
+                result.sh_name:=swapendian(sh_name);
+                result.sh_type:=swapendian(sh_type);
+                result.sh_flags:=swapendian(sh_flags);
+                result.sh_addr:=swapendian(sh_addr);
+                result.sh_offset:=swapendian(sh_offset);
+                result.sh_size:=swapendian(sh_size);
+                result.sh_link:=swapendian(sh_link);
+                result.sh_info:=swapendian(sh_info);
+                result.sh_addralign:=swapendian(sh_addralign);
+                result.sh_entsize:=swapendian(sh_entsize);
               end;
         end;
 
@@ -393,16 +393,16 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.sh_name:=SwapLong(sh_name);
-                result.sh_type:=SwapLong(sh_type);
-                result.sh_flags:=SwapQWord(sh_flags);
-                result.sh_addr:=SwapQWord(sh_addr);
-                result.sh_offset:=SwapQWord(sh_offset);
-                result.sh_size:=SwapQWord(sh_size);
-                result.sh_link:=SwapLong(sh_link);
-                result.sh_info:=SwapLong(sh_info);
-                result.sh_addralign:=SwapQWord(sh_addralign);
-                result.sh_entsize:=SwapQWord(sh_entsize);
+                result.sh_name:=swapendian(sh_name);
+                result.sh_type:=swapendian(sh_type);
+                result.sh_flags:=swapendian(sh_flags);
+                result.sh_addr:=swapendian(sh_addr);
+                result.sh_offset:=swapendian(sh_offset);
+                result.sh_size:=swapendian(sh_size);
+                result.sh_link:=swapendian(sh_link);
+                result.sh_info:=swapendian(sh_info);
+                result.sh_addralign:=swapendian(sh_addralign);
+                result.sh_entsize:=swapendian(sh_entsize);
               end;
         end;
 
@@ -413,10 +413,10 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.st_name:=SwapLong(st_name);
-                result.st_value:=SwapLong(st_value);
-                result.st_size:=SwapLong(st_size);
-                result.st_shndx:=SwapWord(st_shndx);
+                result.st_name:=swapendian(st_name);
+                result.st_value:=swapendian(st_value);
+                result.st_size:=swapendian(st_size);
+                result.st_shndx:=swapendian(st_shndx);
               end;
         end;
 
@@ -427,10 +427,10 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.st_name:=SwapLong(st_name);
-                result.st_value:=SwapQWord(st_value);
-                result.st_size:=SwapQWord(st_size);
-                result.st_shndx:=SwapWord(st_shndx);
+                result.st_name:=swapendian(st_name);
+                result.st_value:=swapendian(st_value);
+                result.st_size:=swapendian(st_size);
+                result.st_shndx:=swapendian(st_shndx);
               end;
         end;
 
@@ -441,8 +441,8 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.address:=SwapLong(address);
-                result.info:=SwapLong(info);
+                result.address:=swapendian(address);
+                result.info:=swapendian(info);
               end;
         end;
 
@@ -453,8 +453,8 @@ implementation
           if source_info.endian<>target_info.endian then
             with h do
               begin
-                result.address:=SwapQWord(address);
-                result.info:=SwapQWord(info);
+                result.address:=swapendian(address);
+                result.info:=swapendian(info);
               end;
         end;
 

compiler/options.pas

@@ -2128,7 +2128,7 @@ begin
   def_system_macro('FPC_HAS_LWSYNC');
 {$endif}
   def_system_macro('FPC_HAS_MEMBAR');
-
+  def_system_macro('FPC_NEW_BIGENDIAN_SETS');
 {$if defined(x86) or defined(arm)}
   def_system_macro('INTERNAL_BACKTRACE');
 {$endif}
@@ -2189,7 +2189,6 @@ begin
   def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
-  def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
 {$endif}
 {$ifdef iA64}
   def_system_macro('CPUIA64');
@@ -2224,7 +2223,6 @@ begin
   def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
-  def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
 {$endif}
 {$ifdef vis}
   def_system_macro('CPUVIS');
@@ -2238,7 +2236,6 @@ begin
   def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
   def_system_macro('FPC_CURRENCY_IS_INT64');
   def_system_macro('FPC_COMP_IS_INT64');
-  def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT');
 {$endif arm}
 
   if (not disable_configfile) and

compiler/pass_1.pas

@@ -170,7 +170,19 @@ implementation
                     firstpass(hp);
                     { switch to new node }
                     p:=hp;
-                  end;
+                  end
+                 else
+                   begin
+                     { inlining happens in pass_1 and can cause new }
+                     { simplify opportunities                       }
+                     hp:=p.simplify;
+                     if assigned(hp) then
+                       begin
+                         p.free;
+                         firstpass(hp);
+                         p:=hp;
+                       end;
+                   end;
                  if codegenerror then
                   include(p.flags,nf_error)
                  else

compiler/pdecsub.pas

@@ -38,7 +38,8 @@ interface
         pd_notobject,    { directive can not be used object declaration }
         pd_notobjintf,   { directive can not be used interface declaration }
         pd_notprocvar,   { directive can not be used procvar declaration }
-        pd_dispinterface { directive can be used with dispinterface methods }
+        pd_dispinterface,{ directive can be used with dispinterface methods }
+        pd_cppobject     { directive can be used with cppclass }
       );
       tpdflags=set of tpdflag;
 
@@ -168,7 +169,7 @@ implementation
                 current_tokenpos:=tprocdef(pd).fileinfo;
 
                 { Generate VMT variable for constructor/destructor }
-                if pd.proctypeoption in [potype_constructor,potype_destructor] then
+                if (pd.proctypeoption in [potype_constructor,potype_destructor]) and not(is_cppclass(tprocdef(pd)._class)) then
                  begin
                    { can't use classrefdef as type because inheriting
                      will then always file because of a type mismatch }
@@ -1671,12 +1672,13 @@ const
       mutexclpo     : [po_external,po_interrupt,po_inline]
     ),(
       idtok:_EXTERNAL;
-      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf];
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject];
       handler  : @pd_external;
       pocall   : pocall_none;
       pooption : [po_external];
       mutexclpocall : [pocall_internproc,pocall_syscall];
-      mutexclpotype : [potype_constructor,potype_destructor];
+      { allowed for external cpp classes }
+      mutexclpotype : [{potype_constructor,potype_destructor}];
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     ),(
       idtok:_FAR;
@@ -2025,7 +2027,9 @@ const
         { check if method and directive not for object, like public.
           This needs to be checked also for procvars }
         if (pd_notobject in proc_direcdata[p].pd_flags) and
-           (symtablestack.top.symtabletype=ObjectSymtable) then
+           (symtablestack.top.symtabletype=ObjectSymtable) and
+           { directive allowed for cpp classes? }
+           not(is_cppclass(tdef(symtablestack.top.defowner)) and (pd_cppobject in proc_direcdata[p].pd_flags)) then
            exit;
 
         { Conflicts between directives ? }

compiler/pdecvar.pas

@@ -958,7 +958,7 @@ implementation
                   { we can't take the size of an open array }
                   if is_open_array(pt.resultdef) or
                      (vs.vardef.size <> pt.resultdef.size) then
-                    make_not_regable(pt,vr_addr);
+                    make_not_regable(pt,[ra_addr_regable]);
                 end
               else
                 Message(parser_e_absolute_only_to_var_or_const);

compiler/ppcgen/ngppcadd.pas

@@ -416,13 +416,13 @@ implementation
                    internalerror(43244);
                   if (right.location.loc = LOC_CONSTANT) then
                     cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,
-                      aint(aword(1) shl aword(right.location.value)),
+                      aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value)),
                       left.location.register,location.register)
                   else
                     begin
                       tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-                      cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,tmpreg);
-                      cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_INT,
+                      cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,aint((aword(1) shl (resultdef.size*8-1))),tmpreg);
+                      cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,
                         right.location.register,tmpreg);
                       if left.location.loc <> LOC_CONSTANT then
                         cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,tmpreg,

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=78;
+  CurrentPPUVersion=79;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -125,6 +125,8 @@ const
   ibnodetree       = 80;
   ibasmsymbols     = 81;
   ibresources      = 82;
+  { target-specific things }
+  iblinkotherframeworks = 100;
 
 { unit flags }
   uf_init          = $1;
@@ -272,32 +274,17 @@ implementation
     fpccrc,
     cutils;
 
-{*****************************************************************************
-                             Endian Handling
-*****************************************************************************}
 
-Function SwapLong(x : longint): longint;
-var
-  y : word;
-  z : word;
-Begin
-  y := x shr 16;
-  y := word(longint(y) shl 8) or (y shr 8);
-  z := x and $FFFF;
-  z := word(longint(z) shl 8) or (z shr 8);
-  SwapLong := (longint(z) shl 16) or longint(y);
-End;
-
-
-Function SwapWord(x : word): word;
-var
-  z : byte;
-Begin
-  z := x shr 8;
-  x := x and $ff;
-  x := word(x shl 8);
-  SwapWord := x or z;
-End;
+function swapendian_ppureal(d:ppureal):ppureal;
+
+type ppureal_bytes=array[0..sizeof(d)-1] of byte;
+
+var i:0..sizeof(d)-1;
+
+begin
+  for i:=low(ppureal_bytes) to high(ppureal_bytes) do
+    ppureal_bytes(swapendian_ppureal)[i]:=ppureal_bytes(d)[high(ppureal_bytes)-i];
+end;
 
 
 {*****************************************************************************
@@ -424,13 +411,15 @@ begin
   { The header is always stored in little endian order }
   { therefore swap if on a big endian machine          }
 {$IFDEF ENDIAN_BIG}
-  header.compiler := SwapWord(header.compiler);
-  header.cpu := SwapWord(header.cpu);
-  header.target := SwapWord(header.target);
-  header.flags := SwapLong(header.flags);
-  header.size := SwapLong(header.size);
-  header.checksum := cardinal(SwapLong(longint(header.checksum)));
-  header.interface_checksum := cardinal(SwapLong(longint(header.interface_checksum)));
+  header.compiler := swapendian(header.compiler);
+  header.cpu := swapendian(header.cpu);
+  header.target := swapendian(header.target);
+  header.flags := swapendian(header.flags);
+  header.size := swapendian(header.size);
+  header.checksum := swapendian(header.checksum);
+  header.interface_checksum := swapendian(header.interface_checksum);
+  header.deflistsize:=swapendian(header.deflistsize);
+  header.symlistsize:=swapendian(header.symlistsize);
 {$ENDIF}
   { the PPU DATA is stored in native order }
   if (header.flags and uf_big_endian) = uf_big_endian then
@@ -491,7 +480,7 @@ begin
       exit;
   until false;
   { For small values copy directly }
-  if len<=sizeof(ptrint) then
+  if len<=sizeof(ptruint) then
     begin
       pmax:=p+len;
       while (p<pmax) do
@@ -536,7 +525,7 @@ begin
    skipdata(entry.size-entryidx);
   readdata(entry,sizeof(tppuentry));
   if change_endian then
-   entry.size:=swaplong(entry.size);
+    entry.size:=swapendian(entry.size);
   entrystart:=bufstart+bufidx;
   entryidx:=0;
   if not(entry.id in [mainentryid,subentryid]) then
@@ -612,7 +601,7 @@ begin
    end;
   readdata(w,2);
   if change_endian then
-   getword:=swapword(w)
+   getword:=swapendian(w)
   else
    getword:=w;
   inc(entryidx,2);
@@ -631,7 +620,7 @@ begin
    end;
   readdata(l,4);
   if change_endian then
-   getlongint:=swaplong(l)
+   getlongint:=swapendian(l)
   else
    getlongint:=l;
   inc(entryidx,4);
@@ -650,7 +639,7 @@ begin
    end;
   readdata(i,8);
   if change_endian then
-    result:=swapint64(i)
+    result:=swapendian(i)
   else
     result:=i;
   inc(entryidx,8);
@@ -681,7 +670,10 @@ begin
          exit;
        end;
       readdata(hd,sizeof(hd));
-      getreal:=hd;
+      if change_endian then
+        getreal:=swapendian(qword(hd))
+      else
+        getreal:=hd;
       inc(entryidx,sizeof(hd));
     end
   else
@@ -693,7 +685,10 @@ begin
          exit;
        end;
       readdata(d,sizeof(ppureal));
-      getreal:=d;
+      if change_endian then
+        getreal:=swapendian_ppureal(d)
+      else
+        getreal:=d;
       inc(entryidx,sizeof(ppureal));
     end;
 end;
@@ -717,26 +712,23 @@ end;
 
 procedure tppufile.getsmallset(var b);
 var
-  l : longint;
+  i : longint;
 begin
-  l:=getlongint;
-  longint(b):=l;
+  getdata(b,4);
+  if change_endian then
+    for i:=0 to 3 do
+      Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
 end;
 
 
 procedure tppufile.getnormalset(var b);
-type
-  SetLongintArray = Array [0..7] of longint;
 var
   i : longint;
 begin
+  getdata(b,32);
   if change_endian then
-    begin
-      for i:=0 to 7 do
-        SetLongintArray(b)[i]:=getlongint;
-    end
-  else
-    getdata(b,32);
+    for i:=0 to 31 do
+      Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]);
 end;
 
 
@@ -819,13 +811,15 @@ begin
 {$else not FPC_BIG_ENDIAN}
     header.flags := header.flags or uf_big_endian;
     { Now swap the header in the correct endian (always little endian) }
-    header.compiler := SwapWord(header.compiler);
-    header.cpu := SwapWord(header.cpu);
-    header.target := SwapWord(header.target);
-    header.flags := SwapLong(header.flags);
-    header.size := SwapLong(header.size);
-    header.checksum := cardinal(SwapLong(longint(header.checksum)));
-    header.interface_checksum := cardinal(SwapLong(longint(header.interface_checksum)));
+    header.compiler := swapendian(header.compiler);
+    header.cpu := swapendian(header.cpu);
+    header.target := swapendian(header.target);
+    header.flags := swapendian(header.flags);
+    header.size := swapendian(header.size);
+    header.checksum := swapendian(header.checksum);
+    header.interface_checksum := swapendian(header.interface_checksum);
+    header.deflistsize:=swapendian(header.deflistsize);
+    header.symlistsize:=swapendian(header.symlistsize);
 {$endif not FPC_BIG_ENDIAN}
 { write header and restore filepos after it }
   opos:=filepos(f);
@@ -1026,75 +1020,68 @@ begin
 end;
 
 
-    procedure tppufile.putstring(s:string);
-      begin
-        putdata(s,length(s)+1);
-      end;
+procedure tppufile.putstring(s:string);
+  begin
+    putdata(s,length(s)+1);
+  end;
 
 
-    procedure tppufile.putsmallset(const b);
-      var
-        l : longint;
-      begin
-        l:=longint(b);
-        putlongint(l);
-      end;
+procedure tppufile.putsmallset(const b);
+  var
+    l : longint;
+  begin
+    l:=longint(b);
+    putlongint(l);
+  end;
 
 
-    procedure tppufile.putnormalset(const b);
-      type
-        SetLongintArray = Array [0..7] of longint;
-      var
-        i : longint;
-        tempb : setlongintarray;
-      begin
-        if change_endian then
-          begin
-            for i:=0 to 7 do
-              tempb[i]:=SwapLong(SetLongintArray(b)[i]);
-            putdata(tempb,32);
-          end
-        else
-          putdata(b,32);
-      end;
+procedure tppufile.putnormalset(const b);
+  type
+    SetLongintArray = Array [0..7] of longint;
+  var
+    i : longint;
+    tempb : setlongintarray;
+  begin
+    putdata(b,32);
+  end;
 
 
-    procedure tppufile.tempclose;
-      begin
-        if not closed then
-         begin
-           closepos:=filepos(f);
-           {$I-}
-            system.close(f);
-           {$I+}
-           if ioresult<>0 then;
-           closed:=true;
-           tempclosed:=true;
-         end;
-      end;
+procedure tppufile.tempclose;
+  begin
+    if not closed then
+     begin
+       closepos:=filepos(f);
+       {$I-}
+        system.close(f);
+       {$I+}
+       if ioresult<>0 then;
+       closed:=true;
+       tempclosed:=true;
+     end;
+  end;
 
 
-    function tppufile.tempopen:boolean;
-      var
-        ofm : byte;
-      begin
-        tempopen:=false;
-        if not closed or not tempclosed then
-         exit;
-        ofm:=filemode;
-        filemode:=0;
-        {$I-}
-         reset(f,1);
-        {$I+}
-        filemode:=ofm;
-        if ioresult<>0 then
-         exit;
-        closed:=false;
-        tempclosed:=false;
+function tppufile.tempopen:boolean;
+  var
+    ofm : byte;
+  begin
+    tempopen:=false;
+    if not closed or not tempclosed then
+     exit;
+    ofm:=filemode;
+    filemode:=0;
+    {$I-}
+     reset(f,1);
+    {$I+}
+    filemode:=ofm;
+    if ioresult<>0 then
+     exit;
+    closed:=false;
+    tempclosed:=false;
 
-      { restore state }
-        seek(f,closepos);
-        tempopen:=true;
-      end;
+  { restore state }
+    seek(f,closepos);
+    tempopen:=true;
+  end;
 
 end.

compiler/ptconst.pas

@@ -551,7 +551,7 @@ implementation
            Psetbytes = ^setbytes;
         var
           p : tnode;
-          i,j : longint;
+          i : longint;
         begin
           p:=comp_expr(true);
           if p.nodetype=setconstn then
@@ -569,21 +569,18 @@ implementation
                   { arrays of 32-bit values CEC          }
                   if source_info.endian = target_info.endian then
                     begin
+{$if defined(FPC_NEW_BIGENDIAN_SETS) or defined(FPC_LITTLE_ENDIAN)}
                       for i:=0 to p.resultdef.size-1 do
                         list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[i]));
+{$else}
+                      for i:=0 to p.resultdef.size-1 do
+                        list.concat(tai_const.create_8bit(reverse_byte(Psetbytes(tsetconstnode(p).value_set)^[i xor 3])));
+{$endif}
                     end
                   else
                     begin
-                      { store as longint values in swaped format }
-                      j:=0;
-                      for i:=0 to ((p.resultdef.size-1) div 4) do
-                        begin
-                          list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+3]));
-                          list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+2]));
-                          list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j+1]));
-                          list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[j]));
-                          Inc(j,4);
-                        end;
+                      for i:=0 to p.resultdef.size-1 do
+                        list.concat(tai_const.create_8bit(reverse_byte(Psetbytes(tsetconstnode(p).value_set)^[i])));
                     end;
                 end;
             end

compiler/rautils.pas

@@ -802,6 +802,8 @@ Begin
         inc(tabstractvarsym(sym).refs);
         { variable can't be placed in a register }
         tabstractvarsym(sym).varregable:=vr_none;
+        { and anything may happen with its address }
+        tabstractvarsym(sym).addr_taken:=true;
         case sym.typ of
           staticvarsym :
             begin

compiler/symdef.pas

@@ -1233,12 +1233,11 @@ implementation
             alignment:=size_2_align(savesize);
           st_longstring,
           st_shortstring:
-{$ifdef cpurequiresproperalignment}
-            { char to string accesses byte 0 and 1 with one word access }
-            alignment:=size_2_align(2);
-{$else cpurequiresproperalignment}
-            alignment:=size_2_align(1);
-{$endif cpurequiresproperalignment}
+            if (tf_requires_proper_alignment in target_info.flags) then
+              { char to string accesses byte 0 and 1 with one word access }
+              alignment:=size_2_align(2)
+            else
+              alignment:=size_2_align(1);
           else
             internalerror(200412301);
         end;
@@ -3351,10 +3350,13 @@ implementation
          i    : integer;
 
       begin
+        { outdated gcc 2.x name mangling scheme }
+{$ifdef NAMEMANGLING_GCC2}
+
          s := procsym.realname;
          if procsym.owner.symtabletype=ObjectSymtable then
            begin
-              s2:=upper(tobjectdef(procsym.owner.defowner).typesym.realname);
+              s2:=upper(tobjectdef(procsym.owner.defowner).objrealname^);
               case proctypeoption of
                  potype_destructor:
                    s:='_$_'+tostr(length(s2))+s2;
@@ -3372,6 +3374,44 @@ implementation
          { concat modifiers }
          { !!!!! }
 
+         { now we handle the parameters }
+         if maxparacount>0 then
+           begin
+             for i:=0 to paras.count-1 do
+               begin
+                 hp:=tparavarsym(paras[i]);
+                 s2:=getcppparaname(hp.vardef);
+                 if hp.varspez in [vs_var,vs_out] then
+                   s2:='R'+s2;
+                 s:=s+s2;
+               end;
+           end
+         else
+           s:=s+'v';
+         cplusplusmangledname:=s;
+{$endif NAMEMANGLING_GCC2}
+
+         { gcc 3.x name mangling scheme }
+         if procsym.owner.symtabletype=ObjectSymtable then
+           begin
+             s:='_ZN';
+
+             s2:=tobjectdef(procsym.owner.defowner).objrealname^;
+             s:=s+tostr(length(s2))+s2;
+             case proctypeoption of
+                potype_constructor:
+                  s:=s+'C1';
+                potype_destructor:
+                  s:=s+'D1';
+                else
+                  s:=s+tostr(length(procsym.realname))+procsym.realname;
+             end;
+
+             s:=s+'E';
+           end
+         else
+           s:=procsym.realname;
+
          { now we handle the parameters }
          if maxparacount>0 then
            begin
@@ -3866,9 +3906,8 @@ implementation
              tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,
                  tObjectSymtable(symtable).fieldalignment);
 
-{$ifdef cpurequiresproperalignment}
-             tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,sizeof(aint));
-{$endif cpurequiresproperalignment}
+             if (tf_requires_proper_alignment in target_info.flags) then
+               tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,sizeof(aint));
 
              vmt_offset:=tObjectSymtable(symtable).datasize;
              tObjectSymtable(symtable).datasize:=
@@ -3997,6 +4036,8 @@ implementation
               needs_inittable:=is_related(interface_iunknown);
             odt_object:
               needs_inittable:=tObjectSymtable(symtable).needs_init_final;
+            odt_cppclass:
+              needs_inittable:=false;
             else
               internalerror(200108267);
          end;

compiler/symsym.pas

@@ -119,10 +119,15 @@ interface
 
        tabstractvarsym = class(tstoredsym)
           varoptions    : tvaroptions;
+          notifications : Tlinkedlist;
           varspez       : tvarspez;  { sets the type of access }
           varregable    : tvarregable;
           varstate      : tvarstate;
-          notifications : Tlinkedlist;
+          { Has the address of this variable potentially escaped the }
+          { block in which is was declared?                          }
+          { could also be part of tabstractnormalvarsym, but there's }
+          { one byte left here till the next 4 byte alignment        }
+          addr_taken     : boolean;
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -922,6 +927,7 @@ implementation
          varstate:=vs_readwritten;
          varspez:=tvarspez(ppufile.getbyte);
          varregable:=tvarregable(ppufile.getbyte);
+         addr_taken:=boolean(ppufile.getbyte);
          ppufile.getderef(vardefderef);
          ppufile.getsmallset(varoptions);
       end;
@@ -964,6 +970,7 @@ implementation
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;
          ppufile.putbyte(byte(varregable));
+         ppufile.putbyte(byte(addr_taken));
          ppufile.do_crc:=oldintfcrc;
          ppufile.putderef(vardefderef);
          ppufile.putsmallset(varoptions);

compiler/symtype.pas

@@ -759,7 +759,10 @@ implementation
 
     procedure tcompilerppufile.getguid(var g: tguid);
       begin
-        getdata(g,sizeof(g));
+        longint(g.d1):=getlongint;
+        g.d2:=getword;
+        g.d3:=getword;
+        getdata(g.d4,sizeof(g.d4));
       end;
 
 
@@ -949,7 +952,10 @@ implementation
 
     procedure tcompilerppufile.putguid(const g: tguid);
       begin
-        putdata(g,sizeof(g));
+        putlongint(longint(g.d1));
+        putword(g.d2);
+        putword(g.d3);
+        putdata(g.d4,sizeof(g.d4));
       end;
 
 

compiler/systems/i_bsd.pas

@@ -514,6 +514,68 @@ unit i_bsd;
             abi         : abi_default;
           );
 
+
+       system_powerpc64_darwin_info  : tsysteminfo =
+          (
+            system       : system_powerpc64_darwin;
+            name         : 'Darwin for PowerPC64';
+            shortname    : 'Darwin';
+            flags        : [tf_p_ext_support,tf_files_case_aware,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels];
+            cpu          : cpu_powerpc64;
+            unit_env     : 'BSDUNITS';
+            extradefines : 'UNIX;BSD;HASUNIX';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.dylib';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.dylib';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            Cprefix      : '_';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_darwin;
+            assemextern  : as_darwin;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_dwarf2;
+            script       : script_unix;
+            endian       : endian_big;
+            alignment    :
+              (
+                procalign       : 16;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 4;
+                constalignmax   : 8;
+                varalignmin     : 4;
+                varalignmax     : 8;
+                localalignmin   : 4;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 8
+              );
+            first_parm_offset : 48;
+            stacksize   : 262144;
+            abi : abi_powerpc_aix;
+          );
+
+
+
   implementation
 
 initialization

compiler/systems/i_embedded.pas

@@ -32,7 +32,7 @@ unit i_embedded;
             name         : 'Embedded';
             shortname    : 'embedded';
             flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
-	                          ,tf_smartlink_sections];
+	                          ,tf_smartlink_sections,tf_requires_proper_alignment ];
             cpu          : cpu_arm;
             unit_env     : '';
             extradefines : '';

compiler/systems/i_gba.pas

@@ -33,7 +33,7 @@ unit i_gba;
             name         : 'GameBoy Advance';
             shortname    : 'gba';
             flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
-	                          ,tf_smartlink_sections];
+	                          ,tf_smartlink_sections,tf_requires_proper_alignment];
             cpu          : cpu_arm;
             unit_env     : '';
             extradefines : '';

compiler/systems/i_linux.pas

@@ -293,7 +293,7 @@ unit i_linux;
             system       : system_powerpc64_LINUX;
             name         : 'Linux for PowerPC64';
             shortname    : 'Linux';
-            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,tf_use_function_relative_addresses];
+            flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,tf_use_function_relative_addresses,tf_requires_proper_alignment];
             cpu          : cpu_powerpc64;
             unit_env     : '';
             extradefines : 'UNIX;HASUNIX';
@@ -471,7 +471,7 @@ unit i_linux;
             system       : system_SPARC_Linux;
             name         : 'Linux for SPARC';
             shortname    : 'Linux';
-            flags        : [tf_needs_symbol_size,tf_library_needs_pic,tf_needs_symbol_type,tf_files_case_sensitive,tf_use_function_relative_addresses];
+            flags        : [tf_needs_symbol_size,tf_library_needs_pic,tf_needs_symbol_type,tf_files_case_sensitive,tf_use_function_relative_addresses,tf_requires_proper_alignment];
             cpu          : cpu_SPARC;
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';
@@ -531,7 +531,7 @@ unit i_linux;
             name         : 'Linux for ARM';
             shortname    : 'Linux';
             flags        : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive,
-                            tf_use_function_relative_addresses,tf_smartlink_sections];
+                            tf_use_function_relative_addresses,tf_requires_proper_alignment,tf_smartlink_sections];
             cpu          : cpu_arm;
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';

compiler/systems/i_nds.pas

@@ -1,98 +1,98 @@
-{
-    This unit implements support information structures for GameBoy Advance
-
-    Copyright (c) 1998-2002 by Peter Vreman
-
-    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.
- ****************************************************************************
-}
-{ This unit implements support information structures for nds. }
-unit i_nds;
-
-  interface
-
-    uses
-       systems;
-
-    const
-       system_arm_nds_info : tsysteminfo =
-          (
-            system       : system_arm_nds;
-            name         : 'Nintendo DS';
-            shortname    : 'nds';
-            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
-	                          ,tf_smartlink_sections];
-            cpu          : cpu_arm;
-            unit_env     : '';
-            extradefines : '';
-            exeext       : '.bin';
-            defext       : '.def';
-            scriptext    : '.sh';
-            smartext     : '.sl';
-            unitext      : '.ppu';
-            unitlibext   : '.ppl';
-            asmext       : '.s';
-            objext       : '.o';
-            resext       : '.res';
-            resobjext    : '.or';
-            sharedlibext : '.so';
-            staticlibext : '.a';
-            staticlibprefix : 'libp';
-            sharedlibprefix : 'lib';
-            sharedClibext : '.so';
-            staticClibext : '.a';
-            staticClibprefix : 'lib';
-            sharedClibprefix : 'lib';
-            Cprefix      : '';
-            newline      : #10;
-            dirsep       : '/';
-            assem        : as_gas;
-            assemextern  : as_gas;
-            link         : nil;
-            linkextern   : nil;
-            ar           : ar_gnu_ar;
-            res          : res_none;
-            dbg          : dbg_stabs;
-            script       : script_unix;
-            endian       : endian_little;
-            alignment    :
-              (
-                procalign       : 4;
-                loopalign       : 4;
-                jumpalign       : 0;
-                constalignmin   : 0;
-                constalignmax   : 4;
-                varalignmin     : 0;
-                varalignmax     : 4;
-                localalignmin   : 4;
-                localalignmax   : 8;
-                recordalignmin  : 0;
-                recordalignmax  : 4;
-                maxCrecordalign : 4
-              );
-            first_parm_offset : 8;
-            stacksize    : 262144;
-            abi : abi_default
-          );
-
-  implementation
-
-initialization
-{$ifdef arm}
-  {$ifdef nds}
-    set_source_info(system_arm_nds_info);
-  {$endif nds}
-{$endif arm}
-end.
+{
+    This unit implements support information structures for GameBoy Advance
+
+    Copyright (c) 1998-2002 by Peter Vreman
+
+    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.
+ ****************************************************************************
+}
+{ This unit implements support information structures for nds. }
+unit i_nds;
+
+  interface
+
+    uses
+       systems;
+
+    const
+       system_arm_nds_info : tsysteminfo =
+          (
+            system       : system_arm_nds;
+            name         : 'Nintendo DS';
+            shortname    : 'nds';
+            flags        : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses
+	                          ,tf_smartlink_sections,tf_requires_proper_alignment];
+            cpu          : cpu_arm;
+            unit_env     : '';
+            extradefines : '';
+            exeext       : '.bin';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_gas;
+            assemextern  : as_gas;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            dbg          : dbg_stabs;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 0;
+                varalignmax     : 4;
+                localalignmin   : 4;
+                localalignmax   : 8;
+                recordalignmin  : 0;
+                recordalignmax  : 4;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 8;
+            stacksize    : 262144;
+            abi : abi_default
+          );
+
+  implementation
+
+initialization
+{$ifdef arm}
+  {$ifdef nds}
+    set_source_info(system_arm_nds_info);
+  {$endif nds}
+{$endif arm}
+end.

compiler/systems/i_palmos.pas

@@ -98,7 +98,7 @@ unit i_palmos;
             system       : system_arm_PalmOS;
             name         : 'PalmOS';
             shortname    : 'PalmOS';
-            flags        : [tf_code_small,tf_static_reg_based,tf_smartlink_sections];
+            flags        : [tf_code_small,tf_static_reg_based,tf_smartlink_sections,tf_requires_proper_alignment];
             cpu          : cpu_arm;
             unit_env     : 'PALMUNITS';
             extradefines : '';

compiler/systems/i_sunos.pas

@@ -91,7 +91,7 @@ unit i_sunos;
             system       : system_sparc_solaris;
             name         : 'Solaris for SPARC';
             shortname    : 'solaris';
-            flags        : [tf_needs_symbol_size,tf_under_development,tf_files_case_sensitive,tf_use_function_relative_addresses];
+            flags        : [tf_needs_symbol_size,tf_under_development,tf_files_case_sensitive,tf_use_function_relative_addresses,tf_requires_proper_alignment];
             cpu          : cpu_SPARC;
             unit_env     : 'SOLARISUNITS';
             extradefines : 'UNIX;LIBC;SUNOS;HASUNIX';

compiler/utils/ppudump.pp

@@ -294,31 +294,6 @@ begin
 end;
 
 
-const
-  HexTbl : array[0..15] of char='0123456789ABCDEF';
-function HexB(b:byte):shortstring;
-begin
-  HexB[0]:=#2;
-  HexB[1]:=HexTbl[b shr 4];
-  HexB[2]:=HexTbl[b and $f];
-end;
-
-
-function hexstr(val : cardinal;cnt : byte) : shortstring;
-const
-  HexTbl : array[0..15] of char='0123456789ABCDEF';
-var
-  i : longint;
-begin
-  hexstr[0]:=char(cnt);
-  for i:=cnt downto 1 do
-   begin
-     hexstr[i]:=hextbl[val and $f];
-     val:=val shr 4;
-   end;
-end;
-
-
     Function L0(l:longint):string;
     {
       return the string of value l, if l<10 then insert a zero, so
@@ -1493,7 +1468,7 @@ begin
                        begin
                          if j>1 then
                           write(',');
-                         write(hexb(getbyte));
+                         write(hexstr(getbyte,2));
                        end;
                       writeln;
                     end;

compiler/x86/nx86add.pas

@@ -340,11 +340,14 @@ unit nx86add;
         op     : TAsmOp;
         extra_not,
         noswap : boolean;
+        all_member_optimization:boolean;
+
       begin
         pass_left_right;
 
         noswap:=false;
         extra_not:=false;
+        all_member_optimization:=false;
         opsize:=int_cgsize(resultdef.size);
         case nodetype of
           addn :
@@ -377,6 +380,10 @@ unit nx86add;
           subn :
             begin
               op:=A_AND;
+              if (not(nf_swapped in flags) and (left.location.loc=LOC_CONSTANT) and (left.location.value=-1)) or
+                  ((nf_swapped in flags) and (right.location.loc=LOC_CONSTANT) and (right.location.value=-1)) then
+                all_member_optimization:=true;
+
               if (not(nf_swapped in flags)) and
                  (right.location.loc=LOC_CONSTANT) then
                 right.location.value := not(right.location.value)
@@ -395,13 +402,29 @@ unit nx86add;
           else
             internalerror(2003042215);
         end;
-        { left must be a register }
-        left_must_be_reg(opsize,noswap);
-        emit_generic_code(op,opsize,true,extra_not,false);
-        location_freetemp(current_asmdata.CurrAsmList,right.location);
+        if all_member_optimization then
+          begin
+            {A set expression [0..31]-x can be implemented with a simple NOT.}
+            if nf_swapped in flags then
+              begin
+                { newly swapped also set swapped flag }
+                location_swap(left.location,right.location);
+                toggleflag(nf_swapped);
+              end;
+            location_force_reg(current_asmdata.currAsmList,right.location,opsize,false);
+            emit_reg(A_NOT,TCGSize2Opsize[opsize],right.location.register);
+            location:=right.location;
+          end
+        else
+          begin
+            { left must be a register }
+            left_must_be_reg(opsize,noswap);
+            emit_generic_code(op,opsize,true,extra_not,false);
+            location_freetemp(current_asmdata.CurrAsmList,right.location);
 
-        { left is always a register and contains the result }
-        location:=left.location;
+            { left is always a register and contains the result }
+            location:=left.location;
+          end;
 
         { fix the changed opsize we did above because of the missing btsb }
         if opsize<>int_cgsize(resultdef.size) then

compiler/x86/nx86set.pas

@@ -162,8 +162,8 @@ implementation
          { check if we can use smallset operation using btl which is limited
            to 32 bits, the left side may also not contain higher values or be signed !! }
          use_small:=(tsetdef(right.resultdef).settype=smallset) and not is_signed(left.resultdef) and
-                    ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<=32) or
-                     (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<=32));
+                    ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<32) or
+                     (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32));
 
          { Can we generate jumps? Possible for all types of sets }
          genjumps:=(right.nodetype=setconstn) and
@@ -195,6 +195,8 @@ implementation
 
          if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE,LOC_CONSTANT]) then
            location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true);
+         if (right.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then
+           location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true);
 
          if genjumps then
           begin

rtl/arm/mathu.inc

@@ -12,6 +12,40 @@
 
  **********************************************************************}
 
+function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
+begin
+    result:=0;
+    if exInvalidOp in Mask then
+      result:=result or (1 shl ord(exInvalidOp));
+    if exDenormalized in Mask then
+      result:=result or (1 shl ord(exDenormalized));
+    if exZeroDivide in Mask then
+      result:=result or (1 shl ord(exZeroDivide));
+    if exOverflow in Mask then
+      result:=result or (1 shl ord(exOverflow));
+    if exUnderflow in Mask then
+      result:=result or (1 shl ord(exUnderflow));
+    if exPrecision in Mask then
+      result:=result or (1 shl ord(exPrecision));
+end;
+
+function SoftFloatMaskToFPUExceptionMask(const Mask: byte): TFPUExceptionMask;
+begin
+    result:=[];
+    if (mask and (1 shl ord(exInvalidOp)) <> 0) then
+      include(result,exInvalidOp);
+    if (mask and (1 shl ord(exDenormalized)) <> 0) then
+      include(result,exDenormalized);
+    if (mask and (1 shl ord(exZeroDivide)) <> 0) then
+      include(result,exZeroDivide);
+    if (mask and (1 shl ord(exOverflow)) <> 0) then
+      include(result,exOverflow);
+    if (mask and (1 shl ord(exUnderflow)) <> 0) then
+      include(result,exUnderflow);
+    if (mask and (1 shl ord(exPrecision)) <> 0) then
+      include(result,exPrecision);
+end;
+
 {$ifdef wince}
 
 const
@@ -126,7 +160,7 @@ begin
     c:=c or _EM_INEXACT;
   c:=_controlfp(c, _MCW_EM);
   Result:=ConvertExceptionMask(c);
-  softfloat_exception_mask:=dword(Mask);
+  softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
 end;
 
 procedure ClearExceptions(RaisePending: Boolean =true);
@@ -285,7 +319,7 @@ function GetExceptionMask: TFPUExceptionMask;
     if (cw and _FPU_MASK_PM)=0 then
       include(Result,exPrecision);
 {$else}
-    dword(Result):=softfloat_exception_mask;
+    Result:=SoftFloatMaskToFPUExceptionMask(softfloat_exception_mask);
 {$endif}
   end;
 
@@ -317,7 +351,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 
     FPU_SetCW(cw);
 {$endif}
-    softfloat_exception_mask:=dword(Mask);
+    softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(Mask);
   end;
 
 

rtl/i386/set.inc

@@ -13,6 +13,7 @@
 
  **********************************************************************}
 
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
 
 {$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
@@ -542,3 +543,4 @@ end;
 
 {$endif LARGESET}
 
+{$endif ndef FPC_NEW_BIGENDIAN_SETS}

rtl/inc/compproc.inc

@@ -32,8 +32,15 @@ type
   fpc_big_chararray = array[0..0] of char;
   fpc_big_widechararray = array[0..0] of widechar;
 {$endif ndef FPC_STRTOCHARARRAYPROC}
+{$ifdef FPC_NEW_BIGENDIAN_SETS}
+  fpc_small_set = bitpacked array[0..31] of 0..1;
+  fpc_normal_set = bitpacked array[0..255] of 0..1;
+{$else}
   fpc_small_set = longint;
   fpc_normal_set = array[0..7] of longint;
+{$endif}
+  fpc_normal_set_byte = array[0..31] of byte;
+  fpc_normal_set_long = array[0..7] of longint;
 
 
 {$ifdef FPC_HAS_FEATURE_HEAP}
@@ -393,25 +400,26 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); comp
 Function fpc_Copy (Src, Dest, TypeInfo : Pointer) : SizeInt; compilerproc;
 {$endif FPC_HAS_FEATURE_RTTI}
 
+
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
 function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; compilerproc;
 function fpc_set_create_element(b : byte): fpc_normal_set; compilerproc;
 function fpc_set_set_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
 function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_set; compilerproc;
 function fpc_set_set_range(const orgset: fpc_normal_set; l,h : byte): fpc_normal_set; compilerproc;
-function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; compilerproc;
 function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
 function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
 function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
 function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set; compilerproc;
 function fpc_set_comp_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
 function fpc_set_contains_sets(const set1,set2: fpc_normal_set): boolean; compilerproc;
+{$endif ndef FPC_NEW_BIGENDIAN_SETS}
 
 procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint); compilerproc;
 procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
 procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
 procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;
 procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
-function fpc_varset_in(const p; b : ptrint): boolean; compilerproc;
 procedure fpc_varset_add_sets(const set1,set2; var dest;size : ptrint); compilerproc;
 procedure fpc_varset_mul_sets(const set1,set2; var dest;size : ptrint); compilerproc;
 procedure fpc_varset_sub_sets(const set1,set2; var dest;size : ptrint); compilerproc;

rtl/inc/genset.inc

@@ -13,6 +13,8 @@
 
  **********************************************************************}
 
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
+
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 { Error No pascal version of FPC_SET_LOAD_SMALL}
  { THIS DEPENDS ON THE ENDIAN OF THE ARCHITECTURE!
@@ -23,8 +25,8 @@ function fpc_set_load_small(l: fpc_small_set): fpc_normal_set; [public,alias:'FP
   load a normal set p from a smallset l
  }
  begin
-   fpc_set_load_small[0] := l;
-   FillDWord(fpc_set_load_small[1],7,0);
+   FillDWord(fpc_set_load_small,sizeof(fpc_set_load_small) div 4,0);
+   move(l,fpc_set_load_small,sizeof(l));
  end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 
@@ -36,7 +38,11 @@ function fpc_set_create_element(b : byte): fpc_normal_set;[public,alias:'FPC_SET
  }
  begin
    FillDWord(fpc_set_create_element,SizeOf(fpc_set_create_element) div 4,0);
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
    fpc_set_create_element[b div 32] := 1 shl (b mod 32);
+{$else}
+   fpc_set_create_element[b] := 1;
+{$endif}
  end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_CREATE_ELEMENT}
 
@@ -50,9 +56,13 @@ function fpc_set_create_element(b : byte): fpc_normal_set;[public,alias:'FPC_SET
    c: longint;
   begin
     move(source,fpc_set_set_byte,sizeof(source));
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     c := fpc_set_set_byte[b div 32];
     c := (1 shl (b mod 32)) or c;
     fpc_set_set_byte[b div 32] := c;
+{$else}
+    fpc_set_set_byte[b] := 1;
+{$endif}
   end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_SET_BYTE}
 
@@ -68,9 +78,13 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
    c: longint;
   begin
     move(source,fpc_set_unset_byte,sizeof(source));
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     c := fpc_set_unset_byte[b div 32];
     c := c and not (1 shl (b mod 32));
     fpc_set_unset_byte[b div 32] := c;
+{$else}
+    fpc_set_unset_byte[b] := 0;
+{$endif}
   end;
 {$endif FPC_SYSTEM_HAS_FPC_SET_UNSET_BYTE}
 
@@ -87,30 +101,24 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
     move(orgset,fpc_set_set_range,sizeof(orgset));
     for i:=l to h do
       begin
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
         c := fpc_set_set_range[i div 32];
         c := (1 shl (i mod 32)) or c;
         fpc_set_set_range[i div 32] := c;
+{$else}
+        fpc_set_set_range[i] := 1;
+{$endif}
       end;
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_SET_SET_RANGE}
 
 
-{$ifndef FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
-
- function fpc_set_in_byte(const p: fpc_normal_set; b: byte): boolean; [public,alias:'FPC_SET_IN_BYTE']; compilerproc;
- {
-   tests if the element b is in the set p the carryflag is set if it present
- }
-  begin
-    fpc_set_in_byte := (p[b div 32] and (1 shl (b mod 32))) <> 0;
-  end;
-{$endif}
-
-
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
  function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
  var
-   dest: fpc_normal_set absolute fpc_set_add_sets;
+   src1: fpc_normal_set_long absolute set1;
+   src2: fpc_normal_set_long absolute set2;
+   dest: fpc_normal_set_long absolute fpc_set_add_sets;
  {
    adds set1 and set2 into set dest
  }
@@ -118,7 +126,7 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
     i: integer;
    begin
      for i:=0 to 7 do
-       dest[i] := set1[i] or set2[i];
+       dest[i] := src1[i] or src2[i];
    end;
 {$endif}
 
@@ -126,7 +134,9 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_MUL_SETS}
  function fpc_set_mul_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_MUL_SETS']; compilerproc;
  var
-   dest: fpc_normal_set absolute fpc_set_mul_sets;
+   src1: fpc_normal_set_long absolute set1;
+   src2: fpc_normal_set_long absolute set2;
+   dest: fpc_normal_set_long absolute fpc_set_mul_sets;
  {
    multiplies (takes common elements of) set1 and set2 result put in dest
  }
@@ -134,7 +144,7 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
     i: integer;
    begin
      for i:=0 to 7 do
-       dest[i] := set1[i] and set2[i];
+       dest[i] := src1[i] and src2[i];
    end;
 {$endif}
 
@@ -142,7 +152,9 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SUB_SETS}
  function fpc_set_sub_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SUB_SETS']; compilerproc;
  var
-   dest: fpc_normal_set absolute fpc_set_sub_sets;
+   src1: fpc_normal_set_long absolute set1;
+   src2: fpc_normal_set_long absolute set2;
+   dest: fpc_normal_set_long absolute fpc_set_sub_sets;
  {
   computes the diff from set1 to set2 result in dest
  }
@@ -150,7 +162,7 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
     i: integer;
    begin
      for i:=0 to 7 do
-       dest[i] := set1[i] and not set2[i];
+       dest[i] := src1[i] and not src2[i];
    end;
 {$endif}
 
@@ -158,7 +170,9 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
 {$ifndef FPC_SYSTEM_HAS_FPC_SET_SYMDIF_SETS}
  function fpc_set_symdif_sets(const set1,set2: fpc_normal_set): fpc_normal_set;[public,alias:'FPC_SET_SYMDIF_SETS']; compilerproc;
  var
-   dest: fpc_normal_set absolute fpc_set_symdif_sets;
+   src1: fpc_normal_set_long absolute set1;
+   src2: fpc_normal_set_long absolute set2;
+   dest: fpc_normal_set_long absolute fpc_set_symdif_sets;
  {
    computes the symetric diff from set1 to set2 result in dest
  }
@@ -166,7 +180,7 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
     i: integer;
    begin
      for i:=0 to 7 do
-       dest[i] := set1[i] xor set2[i];
+       dest[i] := src1[i] xor src2[i];
    end;
 {$endif}
 
@@ -177,10 +191,12 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
  }
    var
     i: integer;
+    src1: fpc_normal_set_long absolute set1;
+    src2: fpc_normal_set_long absolute set2;
    begin
      fpc_set_comp_sets:= false;
      for i:=0 to 7 do
-       if set1[i] <> set2[i] then
+       if src1[i] <> src2[i] then
          exit;
      fpc_set_comp_sets:= true;
    end;
@@ -195,15 +211,18 @@ function fpc_set_unset_byte(const source: fpc_normal_set; b : byte): fpc_normal_
  }
  var
   i : integer;
+  src1: fpc_normal_set_long absolute set1;
+  src2: fpc_normal_set_long absolute set2;
  begin
    fpc_set_contains_sets:= false;
    for i:=0 to 7 do
-     if (set1[i] and not set2[i]) <> 0 then
+     if (src1[i] and not src2[i]) <> 0 then
        exit;
    fpc_set_contains_sets:= true;
  end;
 {$endif}
 
+{$endif ndef FPC_NEW_BIGENDIAN_SETS}
 
 {****************************************************************************
                                  Var sets
@@ -229,10 +248,18 @@ procedure fpc_varset_load(const l;sourcesize : longint;var dest;size : ptrint);
 }
 procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
   type
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
+{$else}
+    tbsetarray = bitpacked array[0..sizeof(sizeint)-1] of 0..1;
+{$endif}
   begin
     FillChar(data,size,0);
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray(data)[b div 8]:=1 shl (b mod 8);
+{$else}
+    tbsetarray(data)[b]:=1;
+{$endif}
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_CREATE_ELEMENT}
 
@@ -243,10 +270,18 @@ procedure fpc_varset_create_element(b,size : ptrint; var data); compilerproc;
 }
 procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
   type
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
+{$else}
+    tbsetarray = bitpacked array[0..sizeof(sizeint)-1] of 0..1;
+{$endif}
   begin
     move(source,dest,size);
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] or (1 shl (b mod 8));
+{$else}
+    tbsetarray(dest)[b]:=1;
+{$endif}
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_BYTE}
 
@@ -258,10 +293,18 @@ procedure fpc_varset_set(const source;var dest; b,size : ptrint); compilerproc;
 }
 procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc;
   type
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
+{$else}
+    tbsetarray = bitpacked array[0..sizeof(sizeint)-1] of 0..1;
+{$endif}
   begin
     move(source,dest,size);
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray(dest)[b div 8]:=tbytearray(dest)[b div 8] and not (1 shl (b mod 8));
+{$else}
+    tbsetarray(dest)[b]:=0;
+{$endif}
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_UNSET_BYTE}
 
@@ -272,30 +315,25 @@ procedure fpc_varset_unset(const source;var dest; b,size : ptrint); compilerproc
 }
 procedure fpc_varset_set_range(const orgset; var dest;l,h,size : ptrint); compilerproc;
   type
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
     tbytearray = array[0..sizeof(sizeint)-1] of byte;
+{$else}
+    tbsetarray = bitpacked array[0..sizeof(sizeint)-1] of 0..1;
+{$endif}
   var
     i : ptrint;
   begin
     move(orgset,dest,size);
     for i:=l to h do
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
        tbytearray(dest)[i div 8]:=(1 shl (i mod 8)) or tbytearray(dest)[i div 8];
+{$else}
+       tbsetarray(dest)[i]:=1;
+{$endif}
   end;
 {$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_SET_RANGE}
 
 
-{$ifndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
-{
-  tests if the element b is in the set p the carryflag is set if it present
-}
-function fpc_varset_in(const p; b : ptrint): boolean; compilerproc;
-  type
-    tbytearray = array[0..sizeof(sizeint)-1] of byte;
-  begin
-    fpc_varset_in:=(tbytearray(p)[b div 8] and (1 shl (b mod 8)))<>0;
-  end;
-{$endif ndef FPC_SYSTEM_HAS_FPC_VARSET_IN_BYTE}
-
-
 {$ifndef FPC_SYSTEM_HAS_FPC_VARSET_ADD_SETS}
 {
   adds set1 and set2 into set dest

rtl/objpas/typinfo.pp

@@ -392,23 +392,40 @@ end;
 
 Function SetToString(TypeInfo: PTypeInfo; Value: Integer; Brackets: Boolean) : String;
 
+{$ifdef FPC_NEW_BIGENDIAN_SETS}
+type
+  tsetarr = bitpacked array[0..31] of 0..1;
+{$endif}
 Var
   I : Integer;
   PTI : PTypeInfo;
 
 begin
+{$if defined(FPC_NEW_BIGENDIAN_SETS) and defined(FPC_BIG_ENDIAN)}
+  case GetTypeData(TypeInfo)^.OrdType of
+    otSByte,otUByte: Value:=Value shl 24;
+    otSWord,otUWord: Value:=Value shl 16;
+  end;
+{$endif}
+
   PTI:=GetTypeData(TypeInfo)^.CompType;
   Result:='';
   For I:=0 to SizeOf(Integer)*8-1 do
     begin
+{$ifdef FPC_NEW_BIGENDIAN_SETS}
+      if (tsetarr(Value)[i]<>0) then
+{$else}
       if ((Value and 1)<>0) then
+{$endif}
         begin
           If Result='' then
             Result:=GetEnumName(PTI,i)
           else
             Result:=Result+','+GetEnumName(PTI,I);
         end;
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
       Value:=Value shr 1;
+{$endif FPC_NEW_BIGENDIAN_SETS}
     end;
   if Brackets then
     Result:='['+Result+']';

rtl/powerpc/set.inc

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
+
 {$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
 {
@@ -62,7 +64,6 @@ asm
         // (((b div 8) div 4)*4= (b div 8) and not(3))
         // r5 := (r4 rotl(32-3)) and (0x01ffffff8)
         rlwinm  r4,r4,31-3+1,3,31-2
-
         // store the result
         stwx    r0,r3,r4
 end;
@@ -198,29 +199,6 @@ asm
 end;
 
 
-{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
-function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;[public,alias:'FPC_SET_IN_BYTE'];
-{
-  tests if the element b is in the set p, the **zero** flag is cleared if it's present
-
-  on entry: p in r3, b in r4
-}
-asm
-       // get the index of the correct *dword* in the set
-       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
-       rlwinm   r0,r4,31-3+1,3,31-2
-
-       // load dword in which the bit has to be tested
-       lwzx     r3,r3,r0
-
-       // r4 := 32 - r4 (no problem if r4 > 32, the rlwnm next does a mod 32)
-       subfic   r4,r4,32
-       // r3 := (r3 shr (r4 mod 32)) and 1
-       rlwnm    r3,r3,r4,31,31
-end;
-
-
-
 {$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
 function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
 {
@@ -355,168 +333,4 @@ asm
        srwi.    r3,r3,5
 end;
 
-
-
-{$ifdef LARGESETS}
-
-procedure do_set(p : pointer;b : word);assembler;[public,alias:'FPC_SET_SET_WORD'];
-{
-  sets the element b in set p works for sets larger than 256 elements
-  not yet use by the compiler so
-}
-asm
-       pushl %eax
-       movl p,%edi
-       movw b,%ax
-       andl $0xfff8,%eax
-       shrl $3,%eax
-       addl %eax,%edi
-       movb 12(%ebp),%al
-       andl $7,%eax
-       btsl %eax,(%edi)
-       popl %eax
-end;
-
-
-procedure do_in(p : pointer;b : word);assembler;[public,alias:'FPC_SET_IN_WORD'];
-{
-  tests if the element b is in the set p the carryflag is set if it present
-  works for sets larger than 256 elements
-}
-asm
-        pushl %eax
-        movl p,%edi
-        movw b,%ax
-        andl $0xfff8,%eax
-        shrl $3,%eax
-        addl %eax,%edi
-        movb 12(%ebp),%al
-        andl $7,%eax
-        btl %eax,(%edi)
-        popl %eax
-end;
-
-
-procedure add_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_ADD_SETS_SIZE'];
-{
-  adds set1 and set2 into set dest size is the number of bytes in the set
-}
-asm
-      movl set1,%esi
-      movl set2,%ebx
-      movl dest,%edi
-      movl size,%ecx
-  .LMADDSETSIZES1:
-      lodsl
-      orl (%ebx),%eax
-      stosl
-      addl $4,%ebx
-      decl %ecx
-      jnz .LMADDSETSIZES1
-end;
-
-
-procedure mul_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_MUL_SETS_SIZE'];
-{
-  multiplies (i.E. takes common elements of) set1 and set2 result put in
-  dest size is the number of bytes in the set
-}
-asm
-         movl set1,%esi
-         movl set2,%ebx
-         movl dest,%edi
-         movl size,%ecx
-     .LMMULSETSIZES1:
-         lodsl
-         andl (%ebx),%eax
-         stosl
-         addl $4,%ebx
-         decl %ecx
-         jnz .LMMULSETSIZES1
-end;
-
-
-procedure sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SUB_SETS_SIZE'];
-asm
-         movl set1,%esi
-         movl set2,%ebx
-         movl dest,%edi
-         movl size,%ecx
-     .LMSUBSETSIZES1:
-         lodsl
-         movl (%ebx),%edx
-         notl %edx
-         andl %edx,%eax
-         stosl
-         addl $4,%ebx
-         decl %ecx
-         jnz .LMSUBSETSIZES1
-end;
-
-
-procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);assembler;[public,alias:'FPC_SET_SYMDIF_SETS_SIZE'];
-{
-   computes the symetric diff from set1 to set2 result in dest
-}
-asm
-      movl set1,%esi
-      movl set2,%ebx
-      movl dest,%edi
-      movl size,%ecx
-  .LMSYMDIFSETSIZE1:
-      lodsl
-      movl (%ebx),%edx
-      xorl %edx,%eax
-      stosl
-      addl $4,%ebx
-      decl %ecx
-      jnz LMSYMDIFSETSIZE1
-end;
-
-
-procedure comp_sets(set1,set2 : pointer;size : longint);assembler;[public,alias:'FPC_SET_COMP_SETS_SIZE'];
-asm
-      movl set1,%esi
-      movl set2,%edi
-      movl size,%ecx
-  LMCOMPSETSIZES1:
-      lodsl
-      movl (%edi),%edx
-      cmpl %edx,%eax
-      jne  LMCOMPSETSIZEEND
-      addl $4,%edi
-      decl %ecx
-      jnz LMCOMPSETSIZES1
-      { we are here only if the two sets are equal
-        we have zero flag set, and that what is expected }
-  LMCOMPSETSIZEEND:
-end;
-
-{$IfNDef NoSetInclusion}
-procedure contains_sets(set1,set2 : pointer; size: longint);assembler;[public,alias:'FPC_SET_CONTAINS_SETS'];
-{
-  on exit, zero flag is set if set1 <= set2 (set2 contains set1)
-}
-asm
-        movl set1,%esi
-        movl set2,%edi
-        movl size,%ecx
-    LMCONTAINSSETS2:
-        movl (%esi),%eax
-        movl (%edi),%edx
-        andl %eax,%edx
-        cmpl %edx,%eax  {set1 and set2 = set1?}
-        jne  LMCONTAINSSETEND2
-        addl $4,%esi
-        addl $4,%edi
-        decl %ecx
-        jnz LMCONTAINSSETS2
-        { we are here only if set2 contains set1
-          we have zero flag set, and that what is expected }
-    LMCONTAINSSETEND2:
-end;
-{$EndIf NoSetInclusion}
-
-
-{$endif LARGESET}
-
+{$endif ndef FPC_NEW_BIGENDIAN_SETS}

rtl/powerpc64/set.inc

@@ -14,6 +14,8 @@
 
  **********************************************************************}
 
+{$ifndef FPC_NEW_BIGENDIAN_SETS}
+
 {$define FPC_SYSTEM_HAS_FPC_SET_LOAD_SMALL}
 function fpc_set_load_small(l: fpc_small_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_LOAD_SMALL']; compilerproc;
 {
@@ -59,7 +61,6 @@ asm
         // (((b div 8) div 4)*4= (b div 8) and not(3))
         // r5 := (r4 rotl(32-3)) and (0x01ffffff8)
         rlwinm  r4,r4,31-3+1,3,31-2
-
         // store the result
         stwx    r0,r3,r4
 end;
@@ -195,29 +196,6 @@ asm
 end;
 
 
-{$define FPC_SYSTEM_HAS_FPC_SET_IN_BYTE}
-function fpc_set_in_byte(const p: fpc_normal_set; b : byte): boolean;compilerproc;assembler;[public,alias:'FPC_SET_IN_BYTE'];
-{
-  tests if the element b is in the set p, the **zero** flag is cleared if it's present
-
-  on entry: p in r3, b in r4
-}
-asm
-       // get the index of the correct *dword* in the set
-       // r0 := (r4 rotl(32-3)) and (0x0fffffff8)
-       rlwinm   r0,r4,31-3+1,3,31-2
-
-       // load dword in which the bit has to be tested
-       lwzx     r3,r3,r0
-
-       // r4 := 32 - r4 (no problem if r4 > 32, the rlwnm next does a mod 32)
-       subfic   r4,r4,32
-       // r3 := (r3 shr (r4 mod 32)) and 1
-       rlwnm    r3,r3,r4,31,31
-end;
-
-
-
 {$define FPC_SYSTEM_HAS_FPC_SET_ADD_SETS}
 function fpc_set_add_sets(const set1,set2: fpc_normal_set): fpc_normal_set;assembler;[public,alias:'FPC_SET_ADD_SETS']; compilerproc;
 {
@@ -352,6 +330,6 @@ asm
        srwi.    r3,r3,5
 end;
 
-
+{$endif ndef FPC_NEW_BIGENDIAN_SETS}
 
 

rtl/sparc/mathu.inc

@@ -16,6 +16,23 @@
 function get_fsr : dword;external name 'FPC_GETFSR';
 procedure set_fsr(fsr : dword);external name 'FPC_SETFSR';
 
+function FPUExceptionMaskToSoftFloatMask(const Mask: TFPUExceptionMask): byte;
+begin
+    result:=0;
+    if exInvalidOp in Mask then
+      result:=result or (1 shl ord(exInvalidOp));
+    if exDenormalized in Mask then
+      result:=result or (1 shl ord(exDenormalized));
+    if exZeroDivide in Mask then
+      result:=result or (1 shl ord(exZeroDivide));
+    if exOverflow in Mask then
+      result:=result or (1 shl ord(exOverflow));
+    if exUnderflow in Mask then
+      result:=result or (1 shl ord(exUnderflow));
+    if exPrecision in Mask then
+      result:=result or (1 shl ord(exPrecision));
+end;
+
 function GetRoundMode: TFPURoundingMode;
   begin
     result:=TFPURoundingMode(get_fsr shr 30);
@@ -108,7 +125,7 @@ function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
     { update control register contents }
     set_fsr(fsr);
 
-    softfloat_exception_mask:=dword(Mask);
+    softfloat_exception_mask:=FPUExceptionMaskToSoftFloatMask(mask);
   end;
 
 

tests/tbs/tb0395.pp

@@ -1,11 +0,0 @@
-{ %VERSION=1.1 }
-type
-  dummyrec = record
-    i : int64;
-  end;
-
-var
-   d: double;
-begin
-   d := double(dummyrec($ffffffff80000000));
-end.

tests/webtbs/tw3812.pp

@@ -1,16 +0,0 @@
-{ Source provided for Free Pascal Bug Report 3812 }
-{ Submitted by "Sergey@michint" on  2005-03-22 }
-{ e-mail:  }
-type
-  LARGE_INTEGER = record
-     LowPart : Cardinal;
-     HighPart : LongInt;
-  end;
-
-procedure t(li1: Large_Integer); stdcall;
-begin
-end;
-
-begin
-  t(Large_Integer(1111111111111111));
-end.

tests/webtbs/tw8660.pp

@@ -25,11 +25,15 @@ var
 begin
   C := TClient.Create;
   C.Num := 2;
-  C.St := [ckVip, ckNormal]; // the numeric representation is 5
+  C.St := [ckVip, ckNormal]; // the numeric representation is 5 (on little endian systems)
   V := C.St;
   writeln(sizeof(V), ' ', byte(V)); // It's OK
   writeln(sizeof(C.St), ' ', byte(C.St)); // It's OK
+{$ifdef FPC_LITTLE_ENDIAN}
   if GetOrdProp(C, 'St')<>5 then
+{$else}
+  if GetOrdProp(C, 'St')<>160 then
+{$endif}
     halt(1);
   if GetSetProp(C, 'St')<>'ckNormal,ckVip' then
     halt(1);