+ customint torddef type to create arbitraty bit-width integers

   o use this to handle non-power-of-two-sized parameters for llvm
   o no general support in the parser/code generator, so don't expose

git-svn-id: trunk@40398 -

compiler/defcmp.pas

@@ -187,7 +187,7 @@ implementation
            u8bit,u16bit,u32bit,u64bit,
            s8bit,s16bit,s32bit,s64bit,
            pasbool, bool8bit,bool16bit,bool32bit,bool64bit,
-           uchar,uwidechar,scurrency }
+           uchar,uwidechar,scurrency,customint }
 
       type
         tbasedef=(bvoid,bchar,bint,bbool);
@@ -198,7 +198,7 @@ implementation
            bint,bint,bint,bint,bint,
            bbool,bbool,bbool,bbool,bbool,
            bbool,bbool,bbool,bbool,
-           bchar,bchar,bint);
+           bchar,bchar,bint,bint);
 
         basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
           { void, char, int, bool }
@@ -1969,6 +1969,8 @@ implementation
                   is_subequal:=(torddef(def2).ordtype=uchar);
                 uwidechar :
                   is_subequal:=(torddef(def2).ordtype=uwidechar);
+                customint:
+                  is_subequal:=(torddef(def2).low=torddef(def1).low) and (torddef(def2).high=torddef(def1).high);
               end;
             end
            else

compiler/defutil.pas

@@ -479,7 +479,7 @@ implementation
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
                                   pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
-                                  bool8bit,bool16bit,bool32bit,bool64bit];
+                                  bool8bit,bool16bit,bool32bit,bool64bit,customint];
              end;
            enumdef :
              is_ordinal:=true;
@@ -550,7 +550,8 @@ implementation
       begin
         result:=(def.typ=orddef) and
                     (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
-                                          s8bit,s16bit,s32bit,s64bit]);
+                                          s8bit,s16bit,s32bit,s64bit,
+                                          customint]);
       end;
 
 
@@ -948,8 +949,11 @@ implementation
       begin
         result:=(def1.typ=orddef) and (def2.typ=orddef) and
           (torddef(def1).ordtype in [u8bit,u16bit,u32bit,u64bit,
-                                     s8bit,s16bit,s32bit,s64bit]) and
-          (torddef(def1).ordtype=torddef(def2).ordtype);
+                                     s8bit,s16bit,s32bit,s64bit,customint]) and
+          (torddef(def1).ordtype=torddef(def2).ordtype) and
+          ((torddef(def1).ordtype<>customint) or
+           ((torddef(def1).low=torddef(def2).low) and
+            (torddef(def1).high=torddef(def2).high)));
       end;
 
 

compiler/htypechk.pas

@@ -3132,7 +3132,7 @@ implementation
            tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
-           tve_chari64,tve_chari64,tve_dblcurrency);
+           tve_chari64,tve_chari64,tve_dblcurrency,tve_incompatible);
 { TODO: fixme for 128 bit floats }
         variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
           (tve_single,tve_dblcurrency,tve_extended,tve_extended,

compiler/llvm/hlcgllvm.pas

@@ -232,7 +232,7 @@ implementation
                    construction (the record is build from the paraloc
                    types) }
                  else if userecord then
-                   a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
+                   a_load_ref_reg(list,fielddef,location^.def,tmpref,location^.register)
                  { if the parameter is passed in a single paraloc, the
                    paraloc's type may be different from the declared type
                    -> use the original complete parameter size as source so

compiler/llvm/llvmdef.pas

@@ -351,8 +351,10 @@ implementation
                 passing it as a parameter may result in unexpected behaviour }
               else if def=llvmbool1type then
                 encodedstr:=encodedstr+'i1'
+              else if torddef(def).ordtype<>customint then
+                encodedstr:=encodedstr+'i'+tostr(def.size*8)
               else
-                encodedstr:=encodedstr+'i'+tostr(def.size*8);
+                encodedstr:=encodedstr+'i'+tostr(def.packedbitsize);
             end;
           pointerdef :
             begin
@@ -836,6 +838,8 @@ implementation
                   s64bit,
                   u64bit:
                     typename:=typename+'i64';
+                  customint:
+                    typename:=typename+'i'+tostr(torddef(hdef).packedbitsize);
                   else
                     { other types should not appear currently, add as needed }
                     internalerror(2014012001);
@@ -876,6 +880,7 @@ implementation
         usedef: tdef;
         valueext: tllvmvalueextension;
         i: longint;
+        sizeleft: asizeint;
       begin
         { single location }
         if not assigned(cgpara.location^.next) then
@@ -903,10 +908,36 @@ implementation
         { multiple locations -> create temp record }
         retloc:=cgpara.location;
         i:=0;
+        sizeleft:=cgpara.Def.size;
         repeat
           if i>high(retdeflist) then
             internalerror(2016121801);
-          retdeflist[i]:=retloc^.def;
+          if assigned(retloc^.next) then
+            begin
+              retdeflist[i]:=retloc^.def;
+              dec(sizeleft,retloc^.def.size);
+            end
+          else
+            begin
+              case sizeleft of
+                1:
+                  retdeflist[i]:=u8inttype;
+                2:
+                  retdeflist[i]:=u16inttype;
+                3:
+                  retdeflist[i]:=u24inttype;
+                4:
+                  retdeflist[i]:=u32inttype;
+                5:
+                  retdeflist[i]:=u40inttype;
+                6:
+                  retdeflist[i]:=u48inttype;
+                7:
+                  retdeflist[i]:=u56inttype;
+                else
+                  retdeflist[i]:=retloc^.def;
+              end;
+            end;
           inc(i);
           retloc:=retloc^.next;
         until not assigned(retloc);

compiler/ncgrtti.pas

@@ -1018,15 +1018,36 @@ implementation
                  otSByte,otSWord,otSLong,otSQWord,otUByte{otNone},
                  otUByte,otUByte,otUWord,otULong,otUQWord,
                  otSByte,otSWord,otSLong,otSQWord,
-                 otUByte,otUWord,otUByte);
+                 otUByte,otUWord,otUByte,255);
             var
               elesize: string[1];
+              deftrans: byte;
           begin
             write_header(tcb,def,typekind);
-            case trans[def.ordtype] of
+            deftrans:=trans[def.ordtype];
+            case deftrans of
               otUQWord,
               otSQWord:
-                elesize:='8'
+                elesize:='8';
+              255:
+                begin
+                  if def.packedbitsize<=32 then
+                    begin
+                      elesize:='4';
+                      if def.low<0 then
+                        deftrans:=otSLong
+                      else
+                        deftrans:=otULong;
+                    end
+                  else
+                    begin
+                      elesize:='8';
+                      if def.low<0 then
+                        deftrans:=otSQWord
+                      else
+                        deftrans:=otUQWord;
+                    end;
+                end
               else
                 elesize:='4'
             end;
@@ -1042,7 +1063,7 @@ implementation
               targetinfos[target_info.system]^.alignment.recordalignmin,
               targetinfos[target_info.system]^.alignment.maxCrecordalign);
             {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
-            case trans[def.ordtype] of
+            case deftrans of
               otUQWord:
                 begin
                   tcb.emit_ord_const(min,u64inttype);

compiler/psystem.pas

@@ -261,8 +261,16 @@ implementation
         s8inttype:=corddef.create(s8bit,int64(-128),127,true);
         u16inttype:=corddef.create(u16bit,0,65535,true);
         s16inttype:=corddef.create(s16bit,int64(-32768),32767,true);
+        s24inttype:=corddef.create(customint,-(int64(1) shl 23),1 shl 23 - 1,true);
+        u24inttype:=corddef.create(customint,0,1 shl 24 - 1,true);
         u32inttype:=corddef.create(u32bit,0,high(longword),true);
         s32inttype:=corddef.create(s32bit,int64(low(longint)),int64(high(longint)),true);
+        s40inttype:=corddef.create(customint,-(int64(1) shl 39),int64(1) shl 39 - 1,true);
+        u40inttype:=corddef.create(customint,0,int64(1) shl 40 - 1,true);
+        s48inttype:=corddef.create(customint,-(int64(1) shl 47),int64(1) shl 47 - 1,true);
+        u48inttype:=corddef.create(customint,0,int64(1) shl 48 - 1,true);
+        s56inttype:=corddef.create(customint,-(int64(1) shl 55),int64(1) shl 55 - 1,true);
+        u56inttype:=corddef.create(customint,0,int64(1) shl 56 - 1,true);
         u64inttype:=corddef.create(u64bit,low(qword),high(qword),true);
         s64inttype:=corddef.create(s64bit,low(int64),high(int64),true);
         { upper/lower bound not yet properly set for 128 bit types, as we don't
@@ -499,8 +507,16 @@ implementation
         addtype('$shortint',s8inttype);
         addtype('$word',u16inttype);
         addtype('$smallint',s16inttype);
+        addtype('$sint24',s24inttype);
+        addtype('$uint24',u24inttype);
         addtype('$ulong',u32inttype);
         addtype('$longint',s32inttype);
+        addtype('$sint40',s40inttype);
+        addtype('$uint40',u40inttype);
+        addtype('$sint48',s48inttype);
+        addtype('$uint48',u48inttype);
+        addtype('$sint56',s56inttype);
+        addtype('$uint56',u56inttype);
         addtype('$qword',u64inttype);
         addtype('$int64',s64inttype);
         addtype('$uint128',u128inttype);
@@ -632,8 +648,16 @@ implementation
         loadtype('shortint',s8inttype);
         loadtype('word',u16inttype);
         loadtype('smallint',s16inttype);
+        loadtype('uint24',u24inttype);
+        loadtype('sint24',s24inttype);
         loadtype('ulong',u32inttype);
         loadtype('longint',s32inttype);
+        loadtype('uint40',u40inttype);
+        loadtype('sint40',s40inttype);
+        loadtype('uint48',u48inttype);
+        loadtype('sint48',s48inttype);
+        loadtype('uint56',u56inttype);
+        loadtype('sint56',s56inttype);
         loadtype('qword',u64inttype);
         loadtype('int64',s64inttype);
         loadtype('uint128',u128inttype);

compiler/symconst.pas

@@ -271,7 +271,7 @@ type
     s8bit,s16bit,s32bit,s64bit,s128bit,
     pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
     bool8bit,bool16bit,bool32bit,bool64bit,
-    uchar,uwidechar,scurrency
+    uchar,uwidechar,scurrency,customint
   );
 
   tordtypeset = set of tordtype;

compiler/symdef.pas

@@ -1055,8 +1055,16 @@ interface
        s8inttype,                 { 8-Bit signed integer }
        u16inttype,                { 16-Bit unsigned integer }
        s16inttype,                { 16-Bit signed integer }
+       u24inttype,                { 24-Bit unsigned integer }
+       s24inttype,                { 24-Bit signed integer }
        u32inttype,                { 32-Bit unsigned integer }
        s32inttype,                { 32-Bit signed integer }
+       u40inttype,                { 40-Bit unsigned integer }
+       s40inttype,                { 40-Bit signed integer }
+       u48inttype,                { 48-Bit unsigned integer }
+       s48inttype,                { 48-Bit signed integer }
+       u56inttype,                { 56-Bit unsigned integer }
+       s56inttype,                { 56-Bit signed integer }
        u64inttype,                { 64-bit unsigned integer }
        s64inttype,                { 64-bit signed integer }
        u128inttype,               { 128-bit unsigned integer }
@@ -2887,10 +2895,12 @@ implementation
           1,2,4,8,16,
           1,1,2,4,8,
           1,2,4,8,
-          1,2,8
+          1,2,8,system.high(longint)
         );
       begin
         savesize:=sizetbl[ordtype];
+        if savesize=system.high(longint) then
+          savesize:=packedbitsize div 8;
       end;
 
 
@@ -2941,9 +2951,11 @@ implementation
           varshortint,varsmallint,varinteger,varint64,varUndefined,
           varboolean,varboolean,varboolean,varboolean,varboolean,
           varboolean,varboolean,varUndefined,varUndefined,
-          varUndefined,varUndefined,varCurrency);
+          varUndefined,varUndefined,varCurrency,varEmpty);
       begin
         result:=basetype2vardef[ordtype];
+        if result=varEmpty then
+          result:=basetype2vardef[range_to_basetype(low,high)];
       end;
 
 
@@ -2971,7 +2983,7 @@ implementation
           'ShortInt','SmallInt','LongInt','Int64','Int128',
           'Boolean','Boolean8','Boolean16','Boolean32','Boolean64',
           'ByteBool','WordBool','LongBool','QWordBool',
-          'Char','WideChar','Currency');
+          'Char','WideChar','Currency','CustomRange');
 
       begin
          GetTypeName:=names[ordtype];
@@ -6239,7 +6251,7 @@ implementation
              'a','s','i','x','',
              'b','b','b','b','b',
              'b','b','b','b',
-             'c','w','x');
+             'c','w','x','C');
 
            floattype2str : array[tfloattype] of string[1] = (
              'f','d','e','e',
@@ -6252,7 +6264,11 @@ implementation
         begin
            case p.typ of
               orddef:
-                s:=ordtype2str[torddef(p).ordtype];
+                begin
+                  s:=ordtype2str[torddef(p).ordtype];
+                  if s='C' then
+                    s:=ordtype2str[range_to_basetype(torddef(p).low,torddef(p).high)];
+                end;
               pointerdef:
                 s:='P'+getcppparaname(tpointerdef(p).pointeddef);
 {$ifndef NAMEMANGLING_GCC2}

compiler/utils/ppuutils/ppudump.pp

@@ -2937,7 +2937,7 @@ procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef);
     u8bit,u16bit,u32bit,u64bit,u128bit,
     s8bit,s16bit,s32bit,s64bit,s128bit,
     bool8bit,bool16bit,bool32bit,bool64bit,
-    uchar,uwidechar,scurrency
+    uchar,uwidechar,scurrency,customint
   ); }
 
 { type tobjecttyp is in symconst unit }
@@ -3145,6 +3145,12 @@ begin
                    orddef.OrdType:=otCurrency;
                    orddef.Size:=8;
                  end;
+               customint:
+                 begin
+                   writeln('customint');
+                   orddef.OrdType:=otSint;
+                   orddef.Size:=sizeof(ASizeInt);
+                 end
                else
                  WriteWarning('Invalid base type: ' + IntToStr(b));
              end;