Browse Source

* always write bitpacked typed constant arrays as a multiple of bytes rather
than of their loadsize, because otherwise if they are e.g. part of a record
they would occupy more space than allowed
o adapted llvm code to deal with the fact that bitpacked arrays are now
always arrays of bytes rather than arrays of integers with the same size
as their loadsize -- this also fixes several type inconsistencies
detected by llvm

git-svn-id: trunk@34125 -

Jonas Maebe 9 năm trước cách đây
mục cha
commit
0311528502

+ 7 - 7
compiler/llvm/llvmdef.pas

@@ -308,8 +308,6 @@ implementation
     tllvmencodeflags = set of tllvmencodeflag;
     tllvmencodeflags = set of tllvmencodeflag;
 
 
     procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr);
     procedure llvmaddencodedtype_intern(def: tdef; const flags: tllvmencodeflags; var encodedstr: TSymStr);
-      var
-        elesize: asizeint;
       begin
       begin
         case def.typ of
         case def.typ of
           stringdef :
           stringdef :
@@ -465,11 +463,13 @@ implementation
               else if is_packed_array(def) and
               else if is_packed_array(def) and
                       (tarraydef(def).elementdef.typ in [enumdef,orddef]) then
                       (tarraydef(def).elementdef.typ in [enumdef,orddef]) then
                 begin
                 begin
-                  elesize:=packedbitsloadsize(tarraydef(def).elementdef.packedbitsize);
-                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size div elesize)+' x ';
-                  { encode as an array of integers with the size on which we
-                    perform the packedbits operations }
-                  llvmaddencodedtype_intern(cgsize_orddef(int_cgsize(elesize)),[lef_inaggregate],encodedstr);
+                  { encode as an array of bytes rather than as an array of
+                    packedbitsloadsize(elesize), because even if the load size
+                    is e.g. 2 bytes, the array may only be 1 or 3 bytes long
+                    (and if this array is inside a record, it must not be
+                     encoded as a type that is too long) }
+                  encodedstr:=encodedstr+'['+tostr(tarraydef(def).size)+' x ';
+                  llvmaddencodedtype_intern(u8inttype,[lef_inaggregate],encodedstr);
                   encodedstr:=encodedstr+']';
                   encodedstr:=encodedstr+']';
                 end
                 end
               else
               else

+ 24 - 2
compiler/llvm/nllvmmem.pas

@@ -106,6 +106,7 @@ implementation
       locref: preference;
       locref: preference;
       hreg: tregister;
       hreg: tregister;
       arrptrelementdef: tdef;
       arrptrelementdef: tdef;
+      packedloadsize: aint;
       indirect: boolean;
       indirect: boolean;
 
 
     procedure getarrelementptrdef;
     procedure getarrelementptrdef;
@@ -169,6 +170,21 @@ implementation
          hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,arrptrelementdef,cpointerdef.getreusable(resultdef),locref^.base,hreg);
          hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,arrptrelementdef,cpointerdef.getreusable(resultdef),locref^.base,hreg);
          locref^.base:=hreg;
          locref^.base:=hreg;
        end;
        end;
+
+      { packed arrays are represented by an array of byte, but when we operate
+        on them we treat them as arrays of elements of packedbitsloadsize()
+        -> typecast }
+      if is_packed_array(left.resultdef) and
+         (tarraydef(left.resultdef).elementdef.typ in [enumdef,orddef]) then
+        begin
+          getarrelementptrdef;
+          packedloadsize:=packedbitsloadsize(tarraydef(left.resultdef).elementdef.packedbitsize);
+          arrptrelementdef:=cpointerdef.getreusable(cgsize_orddef(int_cgsize(packedloadsize)));
+          hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
+            cpointerdef.getreusable(u8inttype),
+            arrptrelementdef,
+            locref^);
+        end;
     end;
     end;
 
 
 
 
@@ -253,8 +269,10 @@ implementation
         value: divide the index by 8 (we're working with a bitpacked array here,
         value: divide the index by 8 (we're working with a bitpacked array here,
         all quantities are expressed in bits), and then by the size of the
         all quantities are expressed in bits), and then by the size of the
         chunks (alignpower) }
         chunks (alignpower) }
+      hreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,ptruinttype,3+alignpower,hreg,hreg2);
       offsetreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
       offsetreg:=hlcg.getintregister(current_asmdata.CurrAsmList,ptruinttype);
-      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,ptruinttype,3+alignpower,hreg,offsetreg);
+      hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,ptruinttype,alignpower,hreg2,offsetreg);
       { index the array using this chunk index }
       { index the array using this chunk index }
       basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cpointerdef.getreusable(defloadsize));
       basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cpointerdef.getreusable(defloadsize));
       current_asmdata.CurrAsmList.Concat(taillvm.getelementptr_reg_size_ref_size_reg(basereg,cpointerdef.getreusable(left.resultdef),
       current_asmdata.CurrAsmList.Concat(taillvm.getelementptr_reg_size_ref_size_reg(basereg,cpointerdef.getreusable(left.resultdef),
@@ -278,7 +296,11 @@ implementation
 
 
   procedure tllvmvecnode.update_reference_offset(var ref: treference; index, mulsize: aint);
   procedure tllvmvecnode.update_reference_offset(var ref: treference; index, mulsize: aint);
     begin
     begin
-      inc(constarrayoffset,index);
+      if not is_packed_array(left.resultdef) or
+         not (tarraydef(left.resultdef).elementdef.typ in [enumdef,orddef]) then
+        inc(constarrayoffset,index)
+      else
+        inc(constarrayoffset,index*mulsize)
     end;
     end;
 
 
 
 

+ 16 - 27
compiler/ngtcon.pas

@@ -71,7 +71,7 @@ interface
       tbitpackedval = record
       tbitpackedval = record
         curval, nextval: aword;
         curval, nextval: aword;
         curbitoffset: smallint;
         curbitoffset: smallint;
-        loadbitsize,packedbitsize: byte;
+        packedbitsize: byte;
       end;
       end;
 
 
       tasmlisttypedconstbuilder = class(ttypedconstbuilder)
       tasmlisttypedconstbuilder = class(ttypedconstbuilder)
@@ -320,7 +320,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         bp.nextval:=0;
         bp.nextval:=0;
         bp.curbitoffset:=0;
         bp.curbitoffset:=0;
         bp.packedbitsize:=packedbitsize;
         bp.packedbitsize:=packedbitsize;
-        bp.loadbitsize:=packedbitsloadsize(bp.packedbitsize)*8;
       end;
       end;
 
 
 
 
@@ -366,8 +365,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       begin
       begin
         if (bp.curbitoffset < AIntBits) then
         if (bp.curbitoffset < AIntBits) then
           begin
           begin
-            { forced flush -> write multiple of loadsize }
-            bitstowrite:=align(bp.curbitoffset,bp.loadbitsize);
+            { forced flush -> write multiple of a byte }
+            bitstowrite:=align(bp.curbitoffset,8);
             bp.curbitoffset:=0;
             bp.curbitoffset:=0;
           end
           end
         else
         else
@@ -375,29 +374,24 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
             bitstowrite:=AIntBits;
             bitstowrite:=AIntBits;
             dec(bp.curbitoffset,AIntBits);
             dec(bp.curbitoffset,AIntBits);
           end;
           end;
-        while (bitstowrite>=bp.loadbitsize) do
+        while (bitstowrite>=8) do
           begin
           begin
             if (target_info.endian=endian_little) then
             if (target_info.endian=endian_little) then
               begin
               begin
-                { write lowest "loadbitsize" bits }
-                writeval:=bp.curval and (aint(-1) shr ((sizeof(aint)*8)-bp.loadbitsize));
-                bp.curval:=bp.curval shr bp.loadbitsize;
+                { write lowest byte }
+                writeval:=byte(bp.curval);
+                bp.curval:=bp.curval shr 8;
               end
               end
             else
             else
               begin
               begin
-                { write highest "loadbitsize" bits }
-                writeval:=bp.curval shr (AIntBits-bp.loadbitsize);
-                bp.curval:=bp.curval shl bp.loadbitsize;
+                { write highest byte }
+                writeval:=bp.curval shr (AIntBits-8);
+{$push}{$r-,q-}
+                bp.curval:=bp.curval shl 8;
+{$pop}
               end;
               end;
-            case bp.loadbitsize of
-              8: ftcb.emit_tai(tai_const.create_8bit(writeval),u8inttype);
-              16: ftcb.emit_tai(tai_const.create_16bit(writeval),u16inttype);
-              32: ftcb.emit_tai(tai_const.create_32bit(writeval),u32inttype);
-              64: ftcb.emit_tai(tai_const.create_64bit(writeval),u64inttype);
-              else
-                internalerror(2013111101);
-            end;
-            dec(bitstowrite,bp.loadbitsize);
+            ftcb.emit_tai(tai_const.create_8bit(writeval),u8inttype);
+            dec(bitstowrite,8);
           end;
           end;
         bp.curval:=bp.nextval;
         bp.curval:=bp.nextval;
         bp.nextval:=0;
         bp.nextval:=0;
@@ -1477,13 +1471,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         { bitpacked record? }
         { bitpacked record? }
         is_packed:=is_packed_record_or_object(def);
         is_packed:=is_packed_record_or_object(def);
         if (is_packed) then
         if (is_packed) then
-          begin
-            { loadbitsize = 8, bitpacked records are always padded to    }
-            { a multiple of a byte. packedbitsize will be set separately }
-            { for each field                                             }
-            initbitpackval(bp,0);
-            bp.loadbitsize:=8;
-          end;
+          { packedbitsize will be set separately for each field }
+          initbitpackval(bp,0);
         { normal record }
         { normal record }
         consume(_LKLAMMER);
         consume(_LKLAMMER);
         recoffset:=0;
         recoffset:=0;