* support > 32bit accesses for x86_64

  * rewrote array size checking to support 64bit

compiler/aasmbase.pas

@@ -198,7 +198,7 @@ interface
        end;
        TAsmObjectDataClass = class of TAsmObjectData;
 
-       tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))] of tasmsymbol;
+       tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))-1] of tasmsymbol;
        pasmsymbolidxarr = ^tasmsymbolidxarr;
 
        TAsmLibraryData = class(TLinkedListItem)
@@ -941,7 +941,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2004-10-31 21:45:02  peter
+  Revision 1.24  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.23  2004/10/31 21:45:02  peter
     * generic tlocation
     * move tlocation to cgutils
 

compiler/defutil.pas

@@ -671,7 +671,7 @@ implementation
          if error then
           begin
              { Fix the value to fit in the allocated space for this type of variable }
-             case def.size of
+             case longint(def.size) of
                1: l := l and $ff;
                2: l := l and $ffff;
                { work around sign extension bug (to be fixed) (JM) }
@@ -680,7 +680,7 @@ implementation
              { do sign extension if necessary (JM) }
              if is_signed(def) then
               begin
-                case def.size of
+                case longint(def.size) of
                   1: l := shortint(l);
                   2: l := smallint(l);
                   4: l := longint(l);
@@ -888,7 +888,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2004-10-31 21:45:02  peter
+  Revision 1.21  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.20  2004/10/31 21:45:02  peter
     * generic tlocation
     * move tlocation to cgutils
 

compiler/ncgmem.pas

@@ -60,7 +60,7 @@ interface
        private
          procedure rangecheck_array;
        protected
-         function get_mul_size : longint;
+         function get_mul_size : aint;
          {# This routine is used to calculate the address of the reference.
             On entry reg contains the index in the array,
            and l contains the size of each element in the array.
@@ -437,7 +437,7 @@ implementation
                             TCGVECNODE
 *****************************************************************************}
 
-     function tcgvecnode.get_mul_size : longint;
+     function tcgvecnode.get_mul_size : aint;
        begin
          if nf_memindex in flags then
           get_mul_size:=1
@@ -557,14 +557,15 @@ implementation
 
       var
          offsetdec,
-         extraoffset : longint;
-         t : tnode;
-         href : treference;
-         otl,ofl : tasmlabel;
-         newsize : tcgsize;
-         mulsize: longint;
-         isjump  : boolean;
-         paraloc1,paraloc2 : tcgpara;
+         extraoffset : aint;
+         t        : tnode;
+         href     : treference;
+         otl,ofl  : tasmlabel;
+         newsize  : tcgsize;
+         mulsize  : aint;
+         isjump   : boolean;
+         paraloc1,
+         paraloc2 : tcgpara;
       begin
          paraloc1.init;
          paraloc2.init;
@@ -877,7 +878,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.100  2004-11-01 17:15:47  peter
+  Revision 1.101  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.100  2004/11/01 17:15:47  peter
     * no checkpointer code for dynarr to openarr
 
   Revision 1.99  2004/11/01 15:31:57  peter

compiler/ncnv.pas

@@ -1327,7 +1327,7 @@ implementation
                      { Insert typeconv for ordinal to the correct size first on left, after
                        that the other conversion can be done }
                      htype.reset;
-                     case resulttype.def.size of
+                     case longint(resulttype.def.size) of
                        1 :
                          htype:=s8inttype;
                        2 :
@@ -2467,7 +2467,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.159  2004-11-01 17:15:47  peter
+  Revision 1.160  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.159  2004/11/01 17:15:47  peter
     * no checkpointer code for dynarr to openarr
 
   Revision 1.158  2004/11/01 15:31:58  peter

compiler/ptconst.pas

@@ -519,7 +519,7 @@ implementation
                   if equal_defs(p.resulttype.def,t.def) or
                      is_subequal(p.resulttype.def,t.def) then
                    begin
-                     case p.resulttype.def.size of
+                     case longint(p.resulttype.def.size) of
                        1 : curconstSegment.concat(Tai_const.Create_8bit(Byte(tordconstnode(p).value)));
                        2 : curconstSegment.concat(Tai_const.Create_16bit(Word(tordconstnode(p).value)));
                        4 : curconstSegment.concat(Tai_const.Create_32bit(Longint(tordconstnode(p).value)));
@@ -1089,7 +1089,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.93  2004-11-01 15:32:12  peter
+  Revision 1.94  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.93  2004/11/01 15:32:12  peter
     * support @labelsym
 
   Revision 1.92  2004/10/15 09:14:17  mazen

compiler/ptype.pas

@@ -341,7 +341,7 @@ implementation
         procedure array_dec;
         var
           lowval,
-          highval   : longint;
+          highval   : aint;
           arraytype : ttype;
           ht        : ttype;
 
@@ -361,6 +361,9 @@ implementation
                   if torddef(t.def).typ in [uchar,
                     u8bit,u16bit,
                     s8bit,s16bit,s32bit,
+{$ifdef cpu64bit}
+                    u32bit,s64bit,
+{$endif cpu64bit}
                     bool8bit,bool16bit,bool32bit,
                     uwidechar] then
                     begin
@@ -384,8 +387,8 @@ implementation
                 consume(_LECKKLAMMER);
                 { defaults }
                 arraytype:=generrortype;
-                lowval:=longint($80000000);
-                highval:=$7fffffff;
+                lowval:=low(aint);
+                highval:=high(aint);
                 tt.reset;
                 repeat
                   { read the expression and check it, check apart if the
@@ -656,7 +659,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2004-06-20 08:55:30  florian
+  Revision 1.69  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.68  2004/06/20 08:55:30  florian
     * logs truncated
 
   Revision 1.67  2004/06/16 20:07:09  florian

compiler/symdef.pas

@@ -77,7 +77,7 @@ interface
           procedure buildderefimpl;override;
           procedure deref;override;
           procedure derefimpl;override;
-          function  size:longint;override;
+          function  size:aint;override;
           function  alignment:longint;override;
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
@@ -100,7 +100,7 @@ interface
           function is_intregable : boolean;
           function is_fpuregable : boolean;
        private
-          savesize  : longint;
+          savesize  : aint;
        end;
 
        tparaitem = class(TLinkedListItem)
@@ -241,7 +241,7 @@ interface
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
-          function  size:longint;override;
+          function  size:aint;override;
           function  alignment : longint;override;
           function  padalignment: longint;
           function  gettypename:string;override;
@@ -297,7 +297,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  getparentdef:tdef;override;
-          function  size : longint;override;
+          function  size : aint;override;
           function  alignment:longint;override;
           function  vmtmethodoffset(index:longint):longint;
           function  members_need_inittable : boolean;
@@ -372,7 +372,7 @@ interface
 
        tarraydef = class(tstoreddef)
           lowrange,
-          highrange  : longint;
+          highrange  : aint;
           rangetype  : ttype;
           IsConvertedPointer,
           IsDynamicArray,
@@ -382,9 +382,10 @@ interface
        protected
           _elementtype : ttype;
        public
-          function elesize : longint;
+          function elesize : aint;
+          function elecount : aint;
           constructor create_from_pointer(const elemt : ttype);
-          constructor create(l,h : longint;const t : ttype);
+          constructor create(l,h : aint;const t : ttype);
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function  gettypename:string;override;
@@ -396,7 +397,7 @@ interface
 {$endif GDB}
           procedure buildderef;override;
           procedure deref;override;
-          function size : longint;override;
+          function size : aint;override;
           function alignment : longint;override;
           { returns the label of the range check string }
           function needs_inittable : boolean;override;
@@ -484,7 +485,7 @@ interface
           procedure buildderef;override;
           procedure deref;override;
           function  getsymtable(t:tgetsymtable):tsymtable;override;
-          function  size : longint;override;
+          function  size : aint;override;
           function  gettypename:string;override;
           function  is_publishable : boolean;override;
           function  is_methodpointer:boolean;override;
@@ -626,19 +627,19 @@ interface
 
        tstringdef = class(tstoreddef)
           string_typ : tstringtype;
-          len        : longint;
+          len        : aint;
           constructor createshort(l : byte);
           constructor loadshort(ppufile:tcompilerppufile);
-          constructor createlong(l : longint);
+          constructor createlong(l : aint);
           constructor loadlong(ppufile:tcompilerppufile);
        {$ifdef ansistring_bits}
-          constructor createansi(l:longint;bits:Tstringbits);
+          constructor createansi(l:aint;bits:Tstringbits);
           constructor loadansi(ppufile:tcompilerppufile;bits:Tstringbits);
        {$else}
-          constructor createansi(l : longint);
+          constructor createansi(l : aint);
           constructor loadansi(ppufile:tcompilerppufile);
        {$endif}
-          constructor createwide(l : longint);
+          constructor createwide(l : aint);
           constructor loadwide(ppufile:tcompilerppufile);
           function getcopy : tstoreddef;override;
           function  stringtypname:string;
@@ -659,13 +660,13 @@ interface
 
        tenumdef = class(tstoreddef)
           minval,
-          maxval    : longint;
+          maxval    : aint;
           has_jumps : boolean;
           firstenum : tsym;  {tenumsym}
           basedef   : tenumdef;
           basedefderef : tderef;
           constructor create;
-          constructor create_subrange(_basedef:tenumdef;_min,_max:longint);
+          constructor create_subrange(_basedef:tenumdef;_min,_max:aint);
           constructor ppuload(ppufile:tcompilerppufile);
           destructor destroy;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -674,10 +675,10 @@ interface
           function  gettypename:string;override;
           function  is_publishable : boolean;override;
           procedure calcsavesize;
-          procedure setmax(_max:longint);
-          procedure setmin(_min:longint);
-          function  min:longint;
-          function  max:longint;
+          procedure setmax(_max:aint);
+          procedure setmin(_min:aint);
+          function  min:aint;
+          function  max:aint;
           { debug }
 {$ifdef GDB}
           function stabstring : pchar;override;
@@ -1050,7 +1051,7 @@ implementation
       end;
 
 
-    function tstoreddef.size : longint;
+    function tstoreddef.size : aint;
       begin
          size:=savesize;
       end;
@@ -1307,7 +1308,7 @@ implementation
       end;
 
 
-    constructor tstringdef.createlong(l : longint);
+    constructor tstringdef.createlong(l : aint);
       begin
          inherited create;
          string_typ:=st_longstring;
@@ -1322,12 +1323,12 @@ implementation
          inherited ppuloaddef(ppufile);
          deftype:=stringdef;
          string_typ:=st_longstring;
-         len:=ppufile.getlongint;
+         len:=ppufile.getaint;
          savesize:=sizeof(aint);
       end;
 
 {$ifdef ansistring_bits}
-    constructor tstringdef.createansi(l:longint;bits:Tstringbits);
+    constructor tstringdef.createansi(l:aint;bits:Tstringbits);
       begin
          inherited create;
          case bits of
@@ -1355,11 +1356,11 @@ implementation
            sb_64:
              string_typ:=st_ansistring64;
          end;
-         len:=ppufile.getlongint;
+         len:=ppufile.getaint;
          savesize:=POINTER_SIZE;
       end;
 {$else}
-    constructor tstringdef.createansi(l:longint);
+    constructor tstringdef.createansi(l:aint);
       begin
          inherited create;
          string_typ:=st_ansistring;
@@ -1374,12 +1375,12 @@ implementation
          inherited ppuloaddef(ppufile);
          deftype:=stringdef;
          string_typ:=st_ansistring;
-         len:=ppufile.getlongint;
+         len:=ppufile.getaint;
          savesize:=sizeof(aint);
       end;
 {$endif}
 
-    constructor tstringdef.createwide(l : longint);
+    constructor tstringdef.createwide(l : aint);
       begin
          inherited create;
          string_typ:=st_widestring;
@@ -1394,7 +1395,7 @@ implementation
          inherited ppuloaddef(ppufile);
          deftype:=stringdef;
          string_typ:=st_widestring;
-         len:=ppufile.getlongint;
+         len:=ppufile.getaint;
          savesize:=sizeof(aint);
       end;
 
@@ -1437,7 +1438,7 @@ implementation
             ppufile.putbyte(byte(len))
            end
          else
-           ppufile.putlongint(len);
+           ppufile.putaint(len);
          case string_typ of
             st_shortstring : ppufile.writeentry(ibshortstringdef);
             st_longstring : ppufile.writeentry(iblongstringdef);
@@ -1457,7 +1458,7 @@ implementation
     function tstringdef.stabstring : pchar;
       var
         bytest,charst,longst : string;
-        slen : longint;
+        slen : aint;
       begin
         case string_typ of
            st_shortstring:
@@ -1645,7 +1646,7 @@ implementation
          correct_owner_symtable;
       end;
 
-    constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:longint);
+    constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:aint);
       begin
          inherited create;
          deftype:=enumdef;
@@ -1666,9 +1667,9 @@ implementation
          inherited ppuloaddef(ppufile);
          deftype:=enumdef;
          ppufile.getderef(basedefderef);
-         minval:=ppufile.getlongint;
-         maxval:=ppufile.getlongint;
-         savesize:=ppufile.getlongint;
+         minval:=ppufile.getaint;
+         maxval:=ppufile.getaint;
+         savesize:=ppufile.getaint;
          has_jumps:=false;
          firstenum:=Nil;
       end;
@@ -1676,37 +1677,40 @@ implementation
 
     procedure tenumdef.calcsavesize;
       begin
-        if (aktpackenum=4) or (min<0) or (max>65535) then
-         savesize:=4
+        if (aktpackenum=8) or (min<low(longint)) or (max>high(cardinal)) then
+         savesize:=8
         else
-         if (aktpackenum=2) or (min<0) or (max>255) then
+         if (aktpackenum=4) or (min<low(smallint)) or (max>high(word)) then
+          savesize:=4
+        else
+         if (aktpackenum=2) or (min<low(shortint)) or (max>high(byte)) then
           savesize:=2
         else
          savesize:=1;
       end;
 
 
-    procedure tenumdef.setmax(_max:longint);
+    procedure tenumdef.setmax(_max:aint);
       begin
         maxval:=_max;
         calcsavesize;
       end;
 
 
-    procedure tenumdef.setmin(_min:longint);
+    procedure tenumdef.setmin(_min:aint);
       begin
         minval:=_min;
         calcsavesize;
       end;
 
 
-    function tenumdef.min:longint;
+    function tenumdef.min:aint;
       begin
         min:=minval;
       end;
 
 
-    function tenumdef.max:longint;
+    function tenumdef.max:aint;
       begin
         max:=maxval;
       end;
@@ -1738,9 +1742,9 @@ implementation
       begin
          inherited ppuwritedef(ppufile);
          ppufile.putderef(basedefderef);
-         ppufile.putlongint(min);
-         ppufile.putlongint(max);
-         ppufile.putlongint(savesize);
+         ppufile.putaint(min);
+         ppufile.putaint(max);
+         ppufile.putaint(savesize);
          ppufile.writeentry(ibenumdef);
       end;
 
@@ -1816,7 +1820,7 @@ implementation
       begin
          rttiList.concat(Tai_const.Create_8bit(tkEnumeration));
          write_rtti_name;
-         case savesize of
+         case longint(savesize) of
             1:
               rttiList.concat(Tai_const.Create_8bit(otUByte));
             2:
@@ -2794,7 +2798,7 @@ implementation
                            TARRAYDEF
 ***************************************************************************}
 
-    constructor tarraydef.create(l,h : longint;const t : ttype);
+    constructor tarraydef.create(l,h : aint;const t : ttype);
       begin
          inherited create;
          deftype:=arraydef;
@@ -2825,8 +2829,8 @@ implementation
          { the addresses are calculated later }
          ppufile.gettype(_elementtype);
          ppufile.gettype(rangetype);
-         lowrange:=ppufile.getlongint;
-         highrange:=ppufile.getlongint;
+         lowrange:=ppufile.getaint;
+         highrange:=ppufile.getaint;
          IsArrayOfConst:=boolean(ppufile.getbyte);
          IsDynamicArray:=boolean(ppufile.getbyte);
          IsVariant:=false;
@@ -2855,8 +2859,8 @@ implementation
          inherited ppuwritedef(ppufile);
          ppufile.puttype(_elementtype);
          ppufile.puttype(rangetype);
-         ppufile.putlongint(lowrange);
-         ppufile.putlongint(highrange);
+         ppufile.putaint(lowrange);
+         ppufile.putaint(highrange);
          ppufile.putbyte(byte(IsArrayOfConst));
          ppufile.putbyte(byte(IsDynamicArray));
          ppufile.writeentry(ibarraydef);
@@ -2882,65 +2886,78 @@ implementation
 {$endif GDB}
 
 
-    function tarraydef.elesize : longint;
+    function tarraydef.elesize : aint;
       begin
         elesize:=_elementtype.def.size;
       end;
 
 
-    function tarraydef.size : longint;
+    function tarraydef.elecount : aint;
+{$ifdef cpu64bit}
+      var
+        qhigh,qlow : qword;
+{$endif cpu64bit}
+      begin
+        if IsDynamicArray then
+          begin
+            result:=0;
+            exit;
+          end;
+{$ifdef cpu64bit}
+        if (highrange>0) and (lowrange<0) then
+          begin
+            qhigh:=highrange;
+            qlow:=qword(-lowrange);
+            { prevent overflow, return -1 to indicate overflow }
+            if qhigh+qlow>qword(high(aint)-1) then
+              result:=-1
+            else
+              result:=qhigh+qlow+1;
+          end
+        else
+{$endif cpu64bit}
+          result:=int64(highrange)-lowrange+1;
+      end;
+
+
+    function tarraydef.size : aint;
       var
-        newsize : TConstExprInt;
+        cachedelecount,
+        cachedelesize : aint;
       begin
         if IsDynamicArray then
           begin
             size:=sizeof(aint);
             exit;
           end;
-        {Tarraydef.size may never be called for an open array!}
+        { Tarraydef.size may never be called for an open array! }
         if highrange<lowrange then
-            internalerror(99080501);
-        newsize:=(int64(highrange)-int64(lowrange)+1)*elesize;
-        { prevent an overflow }
-        if newsize>high(longint) then
-          result:=high(longint)
+          internalerror(99080501);
+        cachedelesize:=elesize;
+        cachedelecount:=elecount;
+        { prevent overflow, return -1 to indicate overflow }
+        if (cachedelesize <> 0) and
+	   (
+	    (cachedelecount < 0) or
+            ((high(aint) div cachedelesize) < cachedelecount) or
+            { also lowrange*elesize must be < high(aint) to prevent overflow when
+              accessing the array, see ncgmem (PFV) }
+            ((high(aint) div cachedelesize) < abs(lowrange))
+ 	   ) then
+          result:=-1
         else
-          result:=newsize;
+          result:=cachedelesize*cachedelecount;
       end;
 
 
     procedure tarraydef.setelementtype(t: ttype);
-      var
-        cachedsize : TConstExprInt;
       begin
         _elementtype:=t;
        if not(IsDynamicArray or
               IsConvertedPointer or
               (highrange<lowrange)) then
          begin
-           { cache element size for performance on multidimensional arrays }
-           cachedsize := elesize;
-           if (cachedsize>0) and
-               (
-{$ifdef cpu64bit}
-{$ifdef VER1_0}
-                { 1.0.x can't handle this and while bootstrapping with 1.0.x we can forget about it }
-                false
-{$else}
-                (TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffffffffffff) or
-
-                { () are needed around cachedsize-1 to avoid a possible
-                  integer overflow for cachedsize=1 !! PM }
-                (($7fffffffffffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
-{$endif VER1_0}
-{$else cpu64bit}
-                (TConstExprInt(highrange)-TConstExprInt(lowrange) > $7fffffff) or
-
-                { () are needed around cachedsize-1 to avoid a possible
-                  integer overflow for cachedsize=1 !! PM }
-                (($7fffffff div cachedsize + (cachedsize -1)) < (int64(highrange) - int64(lowrange)))
-{$endif cpu64bit}
-               ) Then
+           if (size=-1) then
              Message(sym_e_segment_too_large);
          end;
       end;
@@ -2980,9 +2997,8 @@ implementation
 {$endif cpurequiresproperalignment}
          { size of elements }
          rttiList.concat(Tai_const.Create_aint(elesize));
-         { count of elements, prevent overflow for 0..maxlongint }
          if not(IsDynamicArray) then
-           rttiList.concat(Tai_const.Create_aint(min(int64(highrange)-lowrange+1,maxlongint)));
+           rttiList.concat(Tai_const.Create_aint(elecount));
          { element type }
          rttiList.concat(Tai_const.Create_sym(tstoreddef(elementtype.def).get_rtti_label(rt)));
          { variant type }
@@ -3042,8 +3058,8 @@ implementation
       var
         newrec:Pchar;
         spec:string[3];
-        varsize:longint;
-        state:^Trecord_stabgen_state;
+        varsize : aint;
+        state   : ^Trecord_stabgen_state;
       begin
         state:=arg;
         { static variables from objects are like global objects }
@@ -3136,7 +3152,7 @@ implementation
          inherited ppuloaddef(ppufile);
          deftype:=recorddef;
          symtable:=trecordsymtable.create(0);
-         trecordsymtable(symtable).datasize:=ppufile.getlongint;
+         trecordsymtable(symtable).datasize:=ppufile.getaint;
          trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte);
          trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte);
@@ -3196,7 +3212,7 @@ implementation
     procedure trecorddef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwritedef(ppufile);
-         ppufile.putlongint(trecordsymtable(symtable).datasize);
+         ppufile.putaint(trecordsymtable(symtable).datasize);
          ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment));
          ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment));
          ppufile.putbyte(byte(trecordsymtable(symtable).padalignment));
@@ -3205,7 +3221,7 @@ implementation
       end;
 
 
-    function trecorddef.size:longint;
+    function trecorddef.size:aint;
       begin
         result:=trecordsymtable(symtable).datasize;
       end;
@@ -4561,7 +4577,7 @@ implementation
       end;
 
 
-    function tprocvardef.size : longint;
+    function tprocvardef.size : aint;
       begin
          if (po_methodpointer in procoptions) and
             not(po_addressonly in procoptions) then
@@ -4776,7 +4792,7 @@ implementation
          objrealname:=stringdup(ppufile.getstring);
          objname:=stringdup(upper(objrealname^));
          symtable:=tobjectsymtable.create(objrealname^,0);
-         tobjectsymtable(symtable).datasize:=ppufile.getlongint;
+         tobjectsymtable(symtable).datasize:=ppufile.getaint;
          tobjectsymtable(symtable).fieldalignment:=ppufile.getbyte;
          tobjectsymtable(symtable).recordalignment:=ppufile.getbyte;
          vmt_offset:=ppufile.getlongint;
@@ -4853,7 +4869,7 @@ implementation
          inherited ppuwritedef(ppufile);
          ppufile.putbyte(byte(objecttype));
          ppufile.putstring(objrealname^);
-         ppufile.putlongint(tobjectsymtable(symtable).datasize);
+         ppufile.putaint(tobjectsymtable(symtable).datasize);
          ppufile.putbyte(tobjectsymtable(symtable).fieldalignment);
          ppufile.putbyte(tobjectsymtable(symtable).recordalignment);
          ppufile.putlongint(vmt_offset);
@@ -5077,7 +5093,7 @@ implementation
      end;
 
 
-    function tobjectdef.size : longint;
+    function tobjectdef.size : aint;
       begin
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
           result:=sizeof(aint)
@@ -6200,7 +6216,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.262  2004-11-01 15:33:12  florian
+  Revision 1.263  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.262  2004/11/01 15:33:12  florian
     * fixed type information for dyn. arrays on 64 bit systems
 
   Revision 1.261  2004/10/31 21:45:03  peter

compiler/symtable.pas

@@ -87,7 +87,7 @@ interface
 
        tabstractrecordsymtable = class(tstoredsymtable)
        public
-          datasize       : longint;
+          datasize       : aint;
           usefieldalignment,     { alignment to use for fields (PACKRECORDS value), -1 is C style }
           recordalignment,       { alignment required when inserting this record }
           fieldalignment,        { alignment current alignment used when fields are inserted }
@@ -2314,7 +2314,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.159  2004-10-15 09:14:17  mazen
+  Revision 1.160  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.159  2004/10/15 09:14:17  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/symtype.pas

@@ -80,7 +80,7 @@ interface
          function  gettypename:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:string;virtual;abstract;
-         function  size:longint;virtual;abstract;
+         function  size:aint;virtual;abstract;
          function  alignment:longint;virtual;abstract;
          function  getparentdef:tdef;virtual;
          function  getsymtable(t:tgetsymtable):tsymtable;virtual;
@@ -162,7 +162,7 @@ interface
         next   : psymlistitem;
         case byte of
           0 : (sym : tsym; symderef : tderef);
-          1 : (value  : longint);
+          1 : (value  : TConstExprInt);
           2 : (tt : ttype);
       end;
 
@@ -176,7 +176,7 @@ interface
         function  empty:boolean;
         procedure addsym(slt:tsltype;p:tsym);
         procedure addsymderef(slt:tsltype;const d:tderef);
-        procedure addconst(slt:tsltype;v:longint);
+        procedure addconst(slt:tsltype;v:TConstExprInt);
         procedure addtype(slt:tsltype;const tt:ttype);
         procedure clear;
         function  getcopy:tsymlist;
@@ -709,7 +709,7 @@ implementation
       end;
 
 
-    procedure tsymlist.addconst(slt:tsltype;v:longint);
+    procedure tsymlist.addconst(slt:tsltype;v:TConstExprInt);
       var
         hp : psymlistitem;
       begin
@@ -1043,7 +1043,7 @@ implementation
         typ    : tdereftype;
         st     : tsymtable;
         idx    : word;
-        i      : longint;
+        i      : aint;
         len    : byte;
         data   : array[0..255] of byte;
       begin
@@ -1487,7 +1487,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.45  2004-10-12 14:34:49  peter
+  Revision 1.46  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.45  2004/10/12 14:34:49  peter
     * fixed visibility for procsyms
     * fixed override check when there was no entry yet
 

compiler/x86/cgx86.pas

@@ -119,6 +119,7 @@ unit cgx86;
         procedure opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
       private
         procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
+        procedure make_simple_ref(list:taasmoutput;var ref: treference);
 
         procedure floatload(list: taasmoutput; t : tcgsize;const ref : treference);
         procedure floatstore(list: taasmoutput; t : tcgsize;const ref : treference);
@@ -321,6 +322,46 @@ unit cgx86;
        end;
 
 
+    procedure tcgx86.make_simple_ref(list:taasmoutput;var ref: treference);
+{$ifdef x86_64}
+      var
+        hreg : tregister;
+{$endif x86_64}
+      begin
+{$ifdef x86_64}
+        { Only 32bit is allowed }
+        if ((ref.offset<low(longint)) or (ref.offset>high(longint))) then
+          begin
+            { Load constant value to register }
+            hreg:=GetAddressRegister(list);
+            list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg));
+            ref.offset:=0;
+            {if assigned(ref.symbol) then
+              begin
+                list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_Q,ref.symbol,0,hreg));
+                ref.symbol:=nil;
+              end;}
+            { Add register to reference }
+            if ref.index=NR_NO then
+              ref.index:=hreg
+            else
+              begin
+                if ref.scalefactor<>0 then
+                  begin
+                    list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.base,hreg));
+                    ref.base:=hreg;
+                  end
+                else
+                  begin
+                    list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.index,hreg));
+                    ref.index:=hreg;
+                  end;
+               end;
+          end;
+{$endif x86_64}
+      end;
+
+
     procedure tcgx86.floatloadops(t : tcgsize;var op : tasmop;var s : topsize);
       begin
          case t of
@@ -355,10 +396,12 @@ unit cgx86;
       var
          op : tasmop;
          s : topsize;
-
+         tmpref : treference;
       begin
+         tmpref:=ref;
+         make_simple_ref(list,tmpref);
          floatloadops(t,op,s);
-         list.concat(Taicpu.Op_ref(op,s,ref));
+         list.concat(Taicpu.Op_ref(op,s,tmpref));
          inc_fpu_stack;
       end;
 
@@ -398,10 +441,12 @@ unit cgx86;
       var
          op : tasmop;
          s : topsize;
-
+         tmpref : treference;
       begin
+         tmpref:=ref;
+         make_simple_ref(list,tmpref);
          floatstoreops(t,op,s);
-         list.concat(Taicpu.Op_ref(op,s,ref));
+         list.concat(Taicpu.Op_ref(op,s,tmpref));
          dec_fpu_stack;
       end;
 
@@ -454,25 +499,23 @@ unit cgx86;
 
 
     procedure tcgx86.a_load_const_ref(list : taasmoutput; tosize: tcgsize; a : aint;const ref : treference);
-
-{$ifdef x86_64}
       var
-        href : treference;
-{$endif x86_64}
+        tmpref : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
 {$ifdef x86_64}
         { x86_64 only supports signed 32 bits constants directly }
         if (tosize in [OS_S64,OS_64]) and
-            ((a<low(longint)) or (a>high(longint))) then
+           ((a<low(longint)) or (a>high(longint))) then
           begin
-            href:=ref;
-            a_load_const_ref(list,OS_32,longint(a and $ffffffff),href);
-            inc(href.offset,4);
-            a_load_const_ref(list,OS_32,longint(a shr 32),href);
+            a_load_const_ref(list,OS_32,longint(a and $ffffffff),tmpref);
+            inc(tmpref.offset,4);
+            a_load_const_ref(list,OS_32,longint(a shr 32),tmpref);
           end
         else
 {$endif x86_64}
-          list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,ref));
+          list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,tmpref));
       end;
 
 
@@ -481,8 +524,11 @@ unit cgx86;
         op: tasmop;
         s: topsize;
         tmpsize : tcgsize;
-        tmpreg : tregister;
+        tmpreg  : tregister;
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(fromsize,reg);
         sizes2load(fromsize,tosize,op,s);
         case s of
@@ -505,10 +551,10 @@ unit cgx86;
 {$endif x86_64}
                 tmpsize:=tosize;
               list.concat(taicpu.op_reg_reg(op,s,reg,tmpreg));
-              a_load_reg_ref(list,tmpsize,tosize,tmpreg,ref);
+              a_load_reg_ref(list,tmpsize,tosize,tmpreg,tmpref);
             end;
         else
-          list.concat(taicpu.op_reg_ref(op,s,reg,ref));
+          list.concat(taicpu.op_reg_ref(op,s,reg,tmpref));
         end;
       end;
 
@@ -517,7 +563,10 @@ unit cgx86;
       var
         op: tasmop;
         s: topsize;
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(tosize,reg);
         sizes2load(fromsize,tosize,op,s);
  {$ifdef x86_64}
@@ -527,7 +576,7 @@ unit cgx86;
         if s in [S_BL,S_WL,S_L] then
           reg:=makeregsize(list,reg,OS_32);
 {$endif x86_64}
-        list.concat(taicpu.op_ref_reg(op,s,ref,reg));
+        list.concat(taicpu.op_ref_reg(op,s,tmpref,reg));
       end;
 
 
@@ -566,6 +615,8 @@ unit cgx86;
 
 
     procedure tcgx86.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
+      var
+        tmpref  : treference;
       begin
         with ref do
           if (base=NR_NO) and (index=NR_NO) then
@@ -582,7 +633,11 @@ unit cgx86;
                   (offset=0) and (symbol=nil) then
             a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r)
           else
-            list.concat(taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],ref,r));
+            begin
+              tmpref:=ref;
+              make_simple_ref(list,tmpref);
+              list.concat(taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r));
+            end;
       end;
 
 
@@ -652,13 +707,15 @@ unit cgx86;
 
 
     procedure tcgx86.a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
+       var
+         tmpref  : treference;
        begin
+         tmpref:=ref;
+         make_simple_ref(list,tmpref);
          if shuffle=nil then
-           begin
-             list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,ref,reg));
-           end
+           list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,tmpref,reg))
          else if shufflescalar(shuffle) then
-           list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,ref,reg))
+           list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,tmpref,reg))
          else
            internalerror(200312252);
        end;
@@ -667,21 +724,22 @@ unit cgx86;
     procedure tcgx86.a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle);
        var
          hreg : tregister;
+         tmpref  : treference;
        begin
+         tmpref:=ref;
+         make_simple_ref(list,tmpref);
          if shuffle=nil then
-           begin
-             list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,ref));
-           end
+           list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,tmpref))
          else if shufflescalar(shuffle) then
            begin
              if tosize<>fromsize then
                begin
                  hreg:=getmmregister(list,tosize);
                  list.concat(taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg,hreg));
-                 list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,ref));
+                 list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,tmpref));
                end
              else
-               list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,ref))
+               list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,tmpref));
            end
          else
            internalerror(200312252);
@@ -881,7 +939,10 @@ unit cgx86;
 {$ifdef x86_64}
         tmpreg : tregister;
 {$endif x86_64}
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
 {$ifdef x86_64}
         { x86_64 only supports signed 32 bits constants directly }
         if (size in [OS_S64,OS_64]) and
@@ -889,7 +950,7 @@ unit cgx86;
           begin
             tmpreg:=getintregister(list,size);
             a_load_const_reg(list,size,a,tmpreg);
-            a_op_reg_ref(list,op,size,tmpreg,ref);
+            a_op_reg_ref(list,op,size,tmpreg,tmpref);
             exit;
           end;
 {$endif x86_64}
@@ -905,7 +966,7 @@ unit cgx86;
                       opcode := A_SAR;
                   end;
                   list.concat(taicpu.op_const_ref(opcode,
-                    TCgSize2OpSize[size],power,ref));
+                    TCgSize2OpSize[size],power,tmpref));
                   exit;
                 end;
               { the rest should be handled specifically in the code      }
@@ -918,12 +979,12 @@ unit cgx86;
                  ispowerof2(int64(a),power) then
                 begin
                   list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
-                    power,ref));
+                    power,tmpref));
                   exit;
                 end;
               { can't multiply a memory location directly with a constant }
               if op = OP_IMUL then
-                inherited a_op_const_ref(list,op,size,a,ref)
+                inherited a_op_const_ref(list,op,size,a,tmpref)
               else
                 { OP_MUL should be handled specifically in the code        }
                 { generator because of the silly register usage restraints }
@@ -934,14 +995,14 @@ unit cgx86;
                (a = 1) and
                (op in [OP_ADD,OP_SUB]) then
               if op = OP_ADD then
-                list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],ref))
+                list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],tmpref))
               else
-                list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],ref))
+                list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],tmpref))
             else if (a = 0) then
               if (op <> OP_AND) then
                 exit
               else
-                a_load_const_ref(list,size,0,ref)
+                a_load_const_ref(list,size,0,tmpref)
             else if (aword(a) = high(aword)) and
                     (op in [OP_AND,OP_OR,OP_XOR]) then
                    begin
@@ -949,19 +1010,19 @@ unit cgx86;
                        OP_AND:
                          exit;
                        OP_OR:
-                         list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),ref));
+                         list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),tmpref));
                        OP_XOR:
-                         list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],ref));
+                         list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],tmpref));
                      end
                    end
             else
               list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
-                TCgSize2OpSize[size],a,ref));
+                TCgSize2OpSize[size],a,tmpref));
           OP_SHL,OP_SHR,OP_SAR:
             begin
               if (a and 31) <> 0 then
                 list.concat(taicpu.op_const_ref(
-                  TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,ref));
+                  TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,tmpref));
               if (a shr 5) <> 0 Then
                 internalerror(68991);
             end
@@ -1008,12 +1069,16 @@ unit cgx86;
 
 
     procedure tcgx86.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
+      var
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(size,reg);
         case op of
           OP_NEG,OP_NOT,OP_IMUL:
             begin
-              inherited a_op_ref_reg(list,op,size,ref,reg);
+              inherited a_op_ref_reg(list,op,size,tmpref,reg);
             end;
           OP_MUL,OP_DIV,OP_IDIV:
             { special stuff, needs separate handling inside code }
@@ -1022,26 +1087,30 @@ unit cgx86;
           else
             begin
               reg := makeregsize(list,reg,size);
-              list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],ref,reg));
+              list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref,reg));
             end;
         end;
       end;
 
 
     procedure tcgx86.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
+      var
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(size,reg);
         case op of
           OP_NEG,OP_NOT:
             begin
               if reg<>NR_NO then
                 internalerror(200109237);
-              list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],ref));
+              list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref));
             end;
           OP_IMUL:
             begin
               { this one needs a load/imul/store, which is the default }
-              inherited a_op_ref_reg(list,op,size,ref,reg);
+              inherited a_op_ref_reg(list,op,size,tmpref,reg);
             end;
           OP_MUL,OP_DIV,OP_IDIV:
             { special stuff, needs separate handling inside code }
@@ -1049,7 +1118,7 @@ unit cgx86;
             internalerror(200109238);
           else
             begin
-              list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,ref));
+              list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,tmpref));
             end;
         end;
       end;
@@ -1179,23 +1248,26 @@ unit cgx86;
     procedure tcgx86.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
       l : tasmlabel);
 
-{$ifdef x86_64}
       var
+{$ifdef x86_64}
         tmpreg : tregister;
 {$endif x86_64}
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
 {$ifdef x86_64}
         { x86_64 only supports signed 32 bits constants directly }
         if (size in [OS_S64,OS_64]) and
-            ((a<low(longint)) or (a>high(longint))) then
+           ((a<low(longint)) or (a>high(longint))) then
           begin
             tmpreg:=getintregister(list,size);
             a_load_const_reg(list,size,a,tmpreg);
-            a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,ref,l);
+            a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,tmpref,l);
             exit;
           end;
 {$endif x86_64}
-        list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,ref));
+        list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,tmpref));
         a_jmp_cond(list,cmp_op,l);
       end;
 
@@ -1212,17 +1284,25 @@ unit cgx86;
 
 
     procedure tcgx86.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel);
+      var
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(size,reg);
-        list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],ref,reg));
+        list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],tmpref,reg));
         a_jmp_cond(list,cmp_op,l);
       end;
 
 
     procedure tcgx86.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;const ref: treference; l : tasmlabel);
+      var
+        tmpref  : treference;
       begin
+        tmpref:=ref;
+        make_simple_ref(list,tmpref);
         check_register_size(size,reg);
-        list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,ref));
+        list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,tmpref));
         a_jmp_cond(list,cmp_op,l);
       end;
 
@@ -1271,10 +1351,13 @@ unit cgx86;
      procedure tcgx86.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref: TReference);
        var
          ai : taicpu;
+         tmpref  : treference;
        begin
+          tmpref:=ref;
+          make_simple_ref(list,tmpref);
           if not(size in [OS_8,OS_S8]) then
-            a_load_const_ref(list,size,0,ref);
-          ai:=Taicpu.op_ref(A_SETcc,S_B,ref);
+            a_load_const_ref(list,size,0,tmpref);
+          ai:=Taicpu.op_ref(A_SETcc,S_B,tmpref);
           ai.setcondition(flags_to_cond(f));
           list.concat(ai);
        end;
@@ -1637,7 +1720,11 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.135  2004-11-01 15:42:47  florian
+  Revision 1.136  2004-11-01 23:30:11  peter
+    * support > 32bit accesses for x86_64
+    * rewrote array size checking to support 64bit
+
+  Revision 1.135  2004/11/01 15:42:47  florian
     * cvt*2* can't write to memory location, fixed
 
   Revision 1.134  2004/11/01 10:30:06  peter