+ Add common type integer promotion.

    - {$intpromotion common_type} or -CIcommon_type switches to common type promotion.
    - {$intpromotion native_integer} or -CIcommon_type switches to current behaviour.
    - Default in tp mode is common_type, native_integer in other modes
    - Compiler can cycle with -CIcommon_type
    - Still needs checking on other architectures than i386

git-svn-id: trunk@8118 -

compiler/aasmtai.pas

@@ -1876,10 +1876,10 @@ implementation
 
     destructor tai_cpu_abstract.Destroy;
       var
-        i : integer;
+        i : byte;
       begin
-        for i:=0 to opercnt-1 do
-          freeop(i);
+        for i:=1 to opercnt do
+          freeop(i-1);
         inherited destroy;
       end;
 
@@ -2092,7 +2092,7 @@ implementation
         { make a copy of the references }
         p.opercnt:=0;
         p.allocate_oper(ops);
-        for i:=0 to ops-1 do
+        for i:=0 to longint(ops)-1 do
           begin
             p.oper[i]^:=oper[i]^;
             case oper[i]^.typ of
@@ -2144,14 +2144,14 @@ implementation
 
     constructor tai_cpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
       var
-        i : integer;
+        i : byte;
       begin
         inherited ppuload(t,ppufile);
         { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
         ppufile.getdata(condition,sizeof(tasmcond));
         allocate_oper(ppufile.getbyte);
-        for i:=0 to ops-1 do
-          ppuloadoper(ppufile,oper[i]^);
+        for i:=1 to ops do
+          ppuloadoper(ppufile,oper[i-1]^);
         opcode:=tasmop(ppufile.getword);
 {$ifdef x86}
         ppufile.getdata(segprefix,sizeof(Tregister));
@@ -2162,13 +2162,13 @@ implementation
 
     procedure tai_cpu_abstract.ppuwrite(ppufile:tcompilerppufile);
       var
-        i : integer;
+        i : byte;
       begin
         inherited ppuwrite(ppufile);
         ppufile.putdata(condition,sizeof(tasmcond));
         ppufile.putbyte(ops);
-        for i:=0 to ops-1 do
-          ppuwriteoper(ppufile,oper[i]^);
+        for i:=1 to ops do
+          ppuwriteoper(ppufile,oper[i-1]^);
         ppufile.putword(word(opcode));
 {$ifdef x86}
         ppufile.putdata(segprefix,sizeof(Tregister));
@@ -2179,19 +2179,19 @@ implementation
 
     procedure tai_cpu_abstract.buildderefimpl;
       var
-        i : integer;
+        i : byte;
       begin
-        for i:=0 to ops-1 do
-          ppubuildderefimploper(oper[i]^);
+        for i:=1 to ops do
+          ppubuildderefimploper(oper[i-1]^);
       end;
 
 
     procedure tai_cpu_abstract.derefimpl;
       var
-        i : integer;
+        i : byte;
       begin
-        for i:=0 to ops-1 do
-          ppuderefoper(oper[i]^);
+        for i:=1 to ops do
+          ppuderefoper(oper[i-1]^);
       end;
 
 

compiler/constexp.pas

@@ -165,7 +165,7 @@ begin
   else if not a.signed and (a.uvalue>qword(high(int64))) then
     goto try_qword
   else
-    sspace:=qword(high(int64))-a.svalue;
+    sspace:=qword(high(int64))-qword(a.svalue);
 
   if sspace>=b then
     begin

compiler/dbgstabs.pas

@@ -653,7 +653,7 @@ implementation
                  info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym);
              end;
             stabsstr:=def.mangledname;
-            getmem(p,length(stabsstr)+255);
+            getmem(p,sizeint(length(stabsstr))+255);
             strpcopy(p,'"'+obj+':'+RType
                   +def_stab_number(def.returndef)+info+'",'+tostr(n_function)
                   +',0,'+

compiler/defutil.pas

@@ -54,6 +54,10 @@ interface
 
     procedure range_to_type(l,h:TConstExprInt;var def:tdef);
 
+    {# Returns the common ordtype of a and b, i.e. a type that can handle
+     values of both a and b.}
+    function get_common_type(a,b:Torddef;rebase:boolean):Torddef;
+
     procedure int_to_type(v:TConstExprInt;var def:tdef);
 
     {# Returns true, if definition defines an integer type }
@@ -307,31 +311,99 @@ implementation
          range_to_basetype:=s32bit
         else if (l>=low(cardinal)) and (h<=high(cardinal)) then
          range_to_basetype:=u32bit
+        else if (l>=low(int64)) and (h<=high(int64)) then
+         range_to_basetype:=s64bit
         else
-         range_to_basetype:=s64bit;
+         range_to_basetype:=u64bit;
       end;
 
 
     procedure range_to_type(l,h:TConstExprInt;var def:tdef);
-      begin
-        { prefer signed over unsigned }
-        if (l>=int64(-128)) and (h<=127) then
-         def:=s8inttype
-        else if (l>=0) and (h<=255) then
-         def:=u8inttype
-        else if (l>=int64(-32768)) and (h<=32767) then
-         def:=s16inttype
-        else if (l>=0) and (h<=65535) then
-         def:=u16inttype
-        else if (l>=int64(low(longint))) and (h<=high(longint)) then
-         def:=s32inttype
-        else if (l>=low(cardinal)) and (h<=high(cardinal)) then
-         def:=u32inttype
-        else if (l>=low(int64)) and (h<=high(int64)) then
-         def:=s64inttype
-        else
-         def:=u64inttype;
-      end;
+
+    var ot:Tordtype;
+
+    begin
+      if cs_common_type in current_settings.localswitches then
+        begin
+          { prefer signed over unsigned }
+          if (l>=int64(-128)) and (h<=127) then
+            ot:=s8bit
+          else if (l>=0) and (h<=255) then
+            ot:=u8bit
+          else if (l>=int64(-32768)) and (h<=32767) then
+            ot:=s16bit
+          else if (l>=0) and (h<=65535) then
+            ot:=u16bit
+          else if (l>=int64(low(longint))) and (h<=high(longint)) then
+            ot:=s32bit
+          else if (l>=low(cardinal)) and (h<=high(cardinal)) then
+            ot:=u32bit
+          else if (l>=low(int64)) and (h<=high(int64)) then
+            ot:=s64bit
+          else
+            ot:=u64bit;
+          def:=Torddef.create(ot,l,h);
+        end
+      else
+        begin
+          { prefer signed over unsigned }
+          if (l>=int64(-128)) and (h<=127) then
+            def:=s8inttype
+          else if (l>=0) and (h<=255) then
+            def:=u8inttype
+          else if (l>=int64(-32768)) and (h<=32767) then
+            def:=s16inttype
+          else if (l>=0) and (h<=65535) then
+            def:=u16inttype
+          else if (l>=int64(low(longint))) and (h<=high(longint)) then
+            def:=s32inttype
+          else if (l>=low(cardinal)) and (h<=high(cardinal)) then
+            def:=u32inttype
+          else if (l>=low(int64)) and (h<=high(int64)) then
+            def:=s64inttype
+          else
+            def:=u64inttype;
+        end;
+    end;
+
+    function get_common_type(a,b:Torddef;rebase:boolean):Torddef;
+
+    {Determines the common ordtype of a and b, i.e. a type that can handle
+     values of both a and b.}
+
+    const common_ordtypes:array[u8bit..s64bit,u8bit..s64bit] of Tordtype=
+              {u8bit}   {u16bit}  {u32bit}  {u64bit}  {s8bit}  {s16bit}  {s32bit}  {s64bit}
+    {u8bit}  ((u8bit,    u16bit,   u32bit,   u64bit,   s16bit,  s16bit,   s32bit,   s64bit),
+    {u16bit}  (u16bit,   u16bit,   u32bit,   u64bit,   s32bit,  s32bit,   s32bit,   s64bit),
+    {u32bit}  (u32bit,   u32bit,   u32bit,   u64bit,   s64bit,  s64bit,   s64bit,   s64bit),
+    {u64bit}  (u64bit,   u64bit,   u64bit,   u64bit,   uvoid,   uvoid,    uvoid,    uvoid),
+    {s8bit}   (s16bit,   s32bit,   s64bit,   uvoid,    s8bit,   s16bit,   s32bit,   s64bit),
+    {s16bit}  (s32bit,   s32bit,   s64bit,   uvoid,   s16bit,   s16bit,   s32bit,   s64bit),
+    {s32bit}  (s32bit,   s32bit,   s64bit,   uvoid,   s32bit,   s32bit,   s32bit,   s64bit),
+    {s64bit}  (s64bit,   s64bit,   s64bit,   uvoid,   s64bit,   s64bit,   s64bit,   s64bit));
+
+    var l,h:Tconstexprint;
+        ordtype:Tordtype;
+
+    begin
+      get_common_type:=nil;
+      ordtype:=common_ordtypes[a.ordtype,b.ordtype];
+      if rebase or (ordtype<>uvoid) then
+        begin
+          l:=a.low;
+          if b.low<l then
+            l:=b.low;
+          h:=a.high;
+          if b.high>h then
+            h:=b.high;
+          if rebase then
+            ordtype:=range_to_basetype(l,h);
+          if not(not h.signed and (h.uvalue>qword(high(int64))) and
+                 (l.signed and (l.svalue<0))
+                ) then
+            get_common_type:=Torddef.create(ordtype,l,h);
+        end;
+    end;
 
 
     procedure int_to_type(v:TConstExprInt;var def:tdef);

compiler/globtype.pas

@@ -87,6 +87,7 @@ interface
          cs_mmx,cs_mmx_saturation,
          { parser }
          cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking,
+         cs_common_type,
          { macpas specific}
          cs_external_var, cs_externally_visible
        );

compiler/i386/n386add.pas

@@ -40,11 +40,11 @@ interface
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,paramgr,
+      symconst,symdef,defutil,
       aasmbase,aasmtai,aasmdata,aasmcpu,
       cgbase,procinfo,
       ncon,nset,cgutils,tgobj,
-      cga,ncgutil,cgobj,cg64f32;
+      cga,ncgutil,cgobj,cg64f32,cgx86;
 
 {*****************************************************************************
                                 Add64bit
@@ -349,12 +349,31 @@ interface
         ref:Treference;
         use_ref:boolean;
         hl4 : tasmlabel;
+        acc1,acc2:Tregister;
 
     begin
       pass_left_right;
 
+      case Tcgsize2unsigned[left.location.size] of
+        OS_8:
+          begin
+            acc1:=NR_AL;
+            acc2:=NR_AH;
+          end;
+        OS_16:
+          begin
+            acc1:=NR_AX;
+            acc2:=NR_DX;
+          end;
+        OS_32:
+          begin
+            acc1:=NR_EAX;
+            acc2:=NR_EDX;
+          end;
+      end;
+
       {The location.register will be filled in later (JM)}
-      location_reset(location,LOC_REGISTER,OS_INT);
+      location_reset(location,LOC_REGISTER,left.location.size);
       { Mul supports registers and references, so if not register/reference,
         load the location into a register}
       use_ref:=false;
@@ -372,15 +391,16 @@ interface
           cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg);
         end;
       {Allocate EAX.}
-      cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+      cg.getcpuregister(current_asmdata.CurrAsmList,acc1);
       {Load the right value.}
-      cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_EAX);
+      cg.a_load_loc_reg(current_asmdata.CurrAsmList,right.location.size,right.location,acc1);
       {Also allocate EDX, since it is also modified by a mul (JM).}
-      cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX);
+      if not(location.size in [OS_8,OS_S8]) then
+        cg.getcpuregister(current_asmdata.CurrAsmList,acc2);
       if use_ref then
-        emit_ref(A_MUL,S_L,ref)
+        emit_ref(A_MUL,Tcgsize2opsize[location.size],ref)
       else
-        emit_reg(A_MUL,S_L,reg);
+        emit_reg(A_MUL,Tcgsize2opsize[location.size],reg);
       if cs_check_overflow in current_settings.localswitches  then
        begin
          current_asmdata.getjumplabel(hl4);
@@ -389,11 +409,12 @@ interface
          cg.a_label(current_asmdata.CurrAsmList,hl4);
        end;
       {Free EAX,EDX}
-      cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX);
-      cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX);
+      if not(location.size in [OS_8,OS_S8]) then
+        cg.ungetcpuregister(current_asmdata.CurrAsmList,acc2);
+      cg.ungetcpuregister(current_asmdata.CurrAsmList,acc1);
       {Allocate a new register and store the result in EAX in it.}
-      location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register);
+      location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size);
+      cg.a_load_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,acc1,location.register);
       location_freetemp(current_asmdata.CurrAsmList,left.location);
       location_freetemp(current_asmdata.CurrAsmList,right.location);
     end;

compiler/msg/errore.msg

@@ -125,7 +125,7 @@ general_i_number_of_notes=01023_I_$1 note(s) issued
 #
 # Scanner
 #
-# 02063 is the last used one
+# 02083 is the last used one
 #
 % \section{Scanner messages.}
 % This section lists the messages that the scanner emits. The scanner takes
@@ -350,6 +350,8 @@ scan_w_pic_ignored=02081_W_PIC directive ignored
 % ignored.
 scan_w_unsupported_switch_by_target=02082_W_The switch "$1" is not supported by the currently selected target
 % Some compiler switches like $E are not supported by all targets.
+scanner_e_illegal_intpromotion=02083_E_Illegal state for $INTPROMOTION directive
+% Only COMMON_TYPE and NATIVE)_INTEGER can be used as state with a \$INTPROMOTION compiler directive
 % \end{description}
 #
 # Parser
@@ -2498,6 +2500,9 @@ S*2Aas_assemble using GNU AS
 **2Cg_Generate PIC code
 **2Ch<n>_<n> bytes heap (between 1023 and 67107840)
 **2Ci_IO-checking
+**2CI_Integer promotion
+**3CIcommon_type=Promote integers to common type before doing operation
+**3CInative_integer=Promote integers to native_integer before doing operation
 **2Cn_omit linking stage
 **2Co_check overflow of integer operations
 **2Cp<x>_select instruction set, see fpc -i for possible values

compiler/msgidx.inc

@@ -103,6 +103,7 @@ const
   scan_e_only_packset=02080;
   scan_w_pic_ignored=02081;
   scan_w_unsupported_switch_by_target=02082;
+  scanner_e_illegal_intpromotion=02083;
   parser_e_syntax_error=03000;
   parser_e_dont_nest_interrupt=03004;
   parser_w_proc_directive_ignored=03005;
@@ -729,9 +730,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 43728;
+  MsgTxtSize = 43952;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,83,237,83,63,49,107,22,135,60,
+    24,84,237,83,63,49,107,22,135,60,
     42,1,1,1,1,1,1,1,1,1
   );

compiler/nadd.pas

@@ -724,7 +724,7 @@ implementation
       var
         hp      : tnode;
         lt,rt   : tnodetype;
-        rd,ld   : tdef;
+        rd,ld,d : tdef;
         ot      : tnodetype;
         hsym    : tfieldvarsym;
         i       : longint;
@@ -1061,108 +1061,122 @@ implementation
                  else
                    inserttypeconv_internal(right,left.resultdef);
                end
-             { is there a signed 64 bit type ? }
-             else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
-               begin
-                  if (torddef(ld).ordtype<>s64bit) then
-                   inserttypeconv(left,s64inttype);
-                  if (torddef(rd).ordtype<>s64bit) then
-                   inserttypeconv(right,s64inttype);
-               end
-             { is there a unsigned 64 bit type ? }
-             else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
-               begin
-                  if (torddef(ld).ordtype<>u64bit) then
-                   inserttypeconv(left,u64inttype);
-                  if (torddef(rd).ordtype<>u64bit) then
-                   inserttypeconv(right,u64inttype);
-               end
-             { 64 bit cpus do calculations always in 64 bit }
-{$ifndef cpu64bit}
-             { is there a cardinal? }
-             else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
+             else if cs_common_type in current_settings.localswitches then
                begin
-                 { convert positive constants to u32bit }
-                 if (torddef(ld).ordtype<>u32bit) and
-                    is_constintnode(left) and
-                    (tordconstnode(left).value >= 0) then
-                   inserttypeconv(left,u32inttype);
-                 if (torddef(rd).ordtype<>u32bit) and
-                    is_constintnode(right) and
-                    (tordconstnode(right).value >= 0) then
-                   inserttypeconv(right,u32inttype);
-                 { when one of the operand is signed or the operation is subn then perform
-                   the operation in 64bit, can't use rd/ld here because there
-                   could be already typeconvs inserted.
-                   This is compatible with the code below for other unsigned types (PFV) }
-                 if is_signed(left.resultdef) or
-                    is_signed(right.resultdef) or
-                    (nodetype=subn) then
-                   begin
-                     if nodetype<>subn then
-                       CGMessage(type_w_mixed_signed_unsigned);
-                     inserttypeconv(left,s64inttype);
-                     inserttypeconv(right,s64inttype);
-                   end
+                 d:=get_common_type(Torddef(ld),Torddef(rd),true);
+                 if d=nil then
+                   message2(parser_e_no_common_type,ld.gettypename,rd.gettypename)
                  else
                    begin
-                     if (torddef(left.resultdef).ordtype<>u32bit) then
-                       inserttypeconv(left,u32inttype);
-                     if (torddef(right.resultdef).ordtype<>u32bit) then
-                       inserttypeconv(right,u32inttype);
+                     inserttypeconv(left,d);
+                     inserttypeconv(right,d);
                    end;
                end
-{$endif cpu64bit}
-             { generic ord conversion is sinttype }
              else
                begin
-                 { if the left or right value is smaller than the normal
-                   type sinttype and is unsigned, and the other value
-                   is a constant < 0, the result will always be false/true
-                   for equal / unequal nodes.
-                 }
-                 if (
-                      { left : unsigned ordinal var, right : < 0 constant }
-                      (
-                       ((is_signed(ld)=false) and (is_constintnode(left) =false)) and
-                       ((is_constintnode(right)) and (tordconstnode(right).value < 0))
-                      ) or
-                      { right : unsigned ordinal var, left : < 0 constant }
-                      (
-                       ((is_signed(rd)=false) and (is_constintnode(right) =false)) and
-                       ((is_constintnode(left)) and (tordconstnode(left).value < 0))
-                      )
-                    )  then
-                    begin
-                      if nodetype = equaln then
-                         CGMessage(type_w_signed_unsigned_always_false)
-                      else
-                      if nodetype = unequaln then
-                         CGMessage(type_w_signed_unsigned_always_true)
-                      else
-                      if (is_constintnode(left) and (nodetype in [ltn,lten])) or
-                         (is_constintnode(right) and (nodetype in [gtn,gten])) then
-                         CGMessage(type_w_signed_unsigned_always_true)
-                      else
-                      if (is_constintnode(right) and (nodetype in [ltn,lten])) or
-                         (is_constintnode(left) and (nodetype in [gtn,gten])) then
-                         CGMessage(type_w_signed_unsigned_always_false);
-                    end;
-
-                 { When there is a signed type or there is a minus operation
-                   we convert to signed int. Otherwise (both are unsigned) we keep
-                   the result also unsigned. This is compatible with Delphi (PFV) }
-                 if is_signed(ld) or
-                    is_signed(rd) or
-                    (nodetype=subn) then
+                 { is there a signed 64 bit type ? }
+                 if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then
+                   begin
+                      if (torddef(ld).ordtype<>s64bit) then
+                       inserttypeconv(left,s64inttype);
+                      if (torddef(rd).ordtype<>s64bit) then
+                       inserttypeconv(right,s64inttype);
+                   end
+                 { is there a unsigned 64 bit type ? }
+                 else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then
                    begin
-                     inserttypeconv(right,sinttype);
-                     inserttypeconv(left,sinttype);
+                      if (torddef(ld).ordtype<>u64bit) then
+                       inserttypeconv(left,u64inttype);
+                      if (torddef(rd).ordtype<>u64bit) then
+                       inserttypeconv(right,u64inttype);
                    end
+                 { 64 bit cpus do calculations always in 64 bit }
+{$ifndef cpu64bit}
+                 { is there a cardinal? }
+                 else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then
+                   begin
+                     { convert positive constants to u32bit }
+                     if (torddef(ld).ordtype<>u32bit) and
+                        is_constintnode(left) and
+                        (tordconstnode(left).value >= 0) then
+                       inserttypeconv(left,u32inttype);
+                     if (torddef(rd).ordtype<>u32bit) and
+                        is_constintnode(right) and
+                        (tordconstnode(right).value >= 0) then
+                       inserttypeconv(right,u32inttype);
+                     { when one of the operand is signed or the operation is subn then perform
+                       the operation in 64bit, can't use rd/ld here because there
+                       could be already typeconvs inserted.
+                       This is compatible with the code below for other unsigned types (PFV) }
+                     if is_signed(left.resultdef) or
+                        is_signed(right.resultdef) or
+                        (nodetype=subn) then
+                       begin
+                         if nodetype<>subn then
+                           CGMessage(type_w_mixed_signed_unsigned);
+                         inserttypeconv(left,s64inttype);
+                         inserttypeconv(right,s64inttype);
+                       end
+                     else
+                       begin
+                         if (torddef(left.resultdef).ordtype<>u32bit) then
+                           inserttypeconv(left,u32inttype);
+                         if (torddef(right.resultdef).ordtype<>u32bit) then
+                           inserttypeconv(right,u32inttype);
+                       end;
+                   end
+{$endif cpu64bit}
+                 { generic ord conversion is sinttype }
                  else
                    begin
-                     inserttypeconv(right,uinttype);
-                     inserttypeconv(left,uinttype);
+                     { if the left or right value is smaller than the normal
+                       type sinttype and is unsigned, and the other value
+                       is a constant < 0, the result will always be false/true
+                       for equal / unequal nodes.
+                     }
+                     if (
+                          { left : unsigned ordinal var, right : < 0 constant }
+                          (
+                           ((is_signed(ld)=false) and (is_constintnode(left) =false)) and
+                           ((is_constintnode(right)) and (tordconstnode(right).value < 0))
+                          ) or
+                          { right : unsigned ordinal var, left : < 0 constant }
+                          (
+                           ((is_signed(rd)=false) and (is_constintnode(right) =false)) and
+                           ((is_constintnode(left)) and (tordconstnode(left).value < 0))
+                          )
+                        )  then
+                        begin
+                          if nodetype = equaln then
+                             CGMessage(type_w_signed_unsigned_always_false)
+                          else
+                          if nodetype = unequaln then
+                             CGMessage(type_w_signed_unsigned_always_true)
+                          else
+                          if (is_constintnode(left) and (nodetype in [ltn,lten])) or
+                             (is_constintnode(right) and (nodetype in [gtn,gten])) then
+                             CGMessage(type_w_signed_unsigned_always_true)
+                          else
+                          if (is_constintnode(right) and (nodetype in [ltn,lten])) or
+                             (is_constintnode(left) and (nodetype in [gtn,gten])) then
+                             CGMessage(type_w_signed_unsigned_always_false);
+                        end;
+
+                     { When there is a signed type or there is a minus operation
+                       we convert to signed int. Otherwise (both are unsigned) we keep
+                       the result also unsigned. This is compatible with Delphi (PFV) }
+                     if is_signed(ld) or
+                        is_signed(rd) or
+                        (nodetype=subn) then
+                       begin
+                         inserttypeconv(right,sinttype);
+                         inserttypeconv(left,sinttype);
+                       end
+                     else
+                       begin
+                         inserttypeconv(right,uinttype);
+                         inserttypeconv(left,uinttype);
+                       end;
                    end;
                end;
            end

compiler/ninl.pas

@@ -1297,7 +1297,10 @@ implementation
                     v:=torddef(def).low
                   else
                     v:=torddef(def).high;
-                  hp:=cordconstnode.create(v,def,true);
+                  if cs_common_type in current_settings.localswitches then
+                    hp:=cordconstnode.create(v,Torddef.create(Torddef(def).ordtype,v,v),true)
+                  else
+                    hp:=cordconstnode.create(v,def,true);
                   typecheckpass(hp);
                   do_lowhigh:=hp;
                end;

compiler/options.pas

@@ -504,6 +504,17 @@ begin
                            IllegalPara(opt);
                          break;
                       end;
+                    'I':
+                      begin
+                        delete(more,1,1);
+                        if upper(more)='COMMON_TYPE' then
+                          include(init_settings.localswitches,cs_common_type)
+                        else if upper(more)='NATIVE_INTEGER' then
+                          exclude(init_settings.localswitches,cs_common_type)
+                        else
+                          illegalpara(opt);
+                        break;
+                      end;
                     'i' :
                       If UnsetBool(More, j) then
                         exclude(init_settings.localswitches,cs_check_io)

compiler/rgobj.pas

@@ -1581,7 +1581,7 @@ unit rgobj;
     procedure Trgobj.translate_registers(list:TAsmList);
       var
         hp,p,q:Tai;
-        i:shortint;
+        i:byte;
 {$ifdef arm}
         so:pshifterop;
 {$endif arm}
@@ -1643,8 +1643,8 @@ unit rgobj;
                 with Taicpu(p) do
                   begin
                     current_filepos:=fileinfo;
-                    for i:=0 to ops-1 do
-                      with oper[i]^ do
+                    for i:=1 to ops do
+                      with oper[i-1]^ do
                         case typ of
                           Top_reg:
                              if (getregtype(reg)=regtype) then
@@ -1892,7 +1892,7 @@ unit rgobj;
 
         { check whether and if so which and how (read/written) this instructions contains
           registers that must be spilled }
-        for counter := 0 to instr.ops-1 do
+        for counter := 0 to longint(instr.ops)-1 do
          with instr.oper[counter]^ do
           begin
             case typ of
@@ -2057,7 +2057,7 @@ unit rgobj;
         live_registers:=oldlive_registers;
 
         { substitute registers }
-        for counter:=0 to instr.ops-1 do
+        for counter:=0 to longint(instr.ops)-1 do
           with instr.oper[counter]^ do
             case typ of
               top_reg:

compiler/scandir.pas

@@ -1222,6 +1222,21 @@ implementation
         do_localswitch(cs_bitpacking);
       end;
 
+    procedure dir_intpromotion;
+
+    var s:string;
+
+      begin
+        current_scanner.skipspace;
+        s:=upper(current_scanner.readcomment);
+        if s='COMMON_TYPE' then
+          include(current_settings.localswitches,cs_common_type)
+        else if s='NATIVE_INTEGER' then
+          exclude(current_settings.localswitches,cs_common_type)
+        else
+          message1(scanner_e_illegal_intpromotion,s);
+      end;
+
 
 {****************************************************************************
                          Initialize Directives
@@ -1269,6 +1284,7 @@ implementation
         AddDirective('INFO',directive_all, @dir_info);
         AddDirective('INLINE',directive_all, @dir_inline);
         AddDirective('INTERFACES',directive_all, @dir_interfaces);
+        AddDirective('INTPROMOTION',directive_all, @dir_intpromotion);
         AddDirective('L',directive_all, @dir_link);
         AddDirective('LIBEXPORT',directive_mac, @dir_libexport);
         AddDirective('LIBRARYPATH',directive_all, @dir_librarypath);

compiler/scanner.pas

@@ -349,6 +349,14 @@ implementation
                  include(init_settings.moduleswitches,cs_support_goto);
              end;
 
+           { turn on common type promotion for mode tp }
+           if (m_tp7 in current_settings.modeswitches) then
+             begin
+               include(current_settings.localswitches,cs_common_type);
+               if changeinit then
+                 include(init_settings.localswitches,cs_common_type);
+             end;
+
            { Default enum packing for delphi/tp7 }
            if (m_tp7 in current_settings.modeswitches) or
               (m_delphi in current_settings.modeswitches) then

compiler/x86/aasmcpu.pas

@@ -1037,9 +1037,10 @@ implementation
        * required to have unspecified size in the instruction too...)
       }
       var
+        i,j,oprs:byte;
         insot,
         currot,
-        i,j,asize,oprs : longint;
+        asize: longint;
         insflags:cardinal;
         siz : array[0..2] of longint;
       begin
@@ -1049,10 +1050,10 @@ implementation
         if (p^.opcode<>opcode) or (p^.ops<>ops) then
           exit;
 
-        for i:=0 to p^.ops-1 do
+        for i:=1 to p^.ops do
          begin
-           insot:=p^.optypes[i];
-           currot:=oper[i]^.ot;
+           insot:=p^.optypes[i-1];
+           currot:=oper[i-1]^.ot;
            { Check the operand flags }
            if (insot and (not currot) and OT_NON_SIZE)<>0 then
              exit;
@@ -1102,11 +1103,11 @@ implementation
                 oprs:=2
                else
                 oprs:=p^.ops;
-               for i:=0 to oprs-1 do
-                if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
+               for i:=1 to oprs do
+                if ((p^.optypes[i-1] and OT_SIZE_MASK) <> 0) then
                  begin
-                   for j:=0 to oprs-1 do
-                    siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
+                   for j:=1 to oprs do
+                    siz[j-1]:=p^.optypes[i-1] and OT_SIZE_MASK;
                    break;
                  end;
               end
@@ -1114,15 +1115,15 @@ implementation
               oprs:=2;
 
             { Check operand sizes }
-            for i:=0 to p^.ops-1 do
+            for i:=1 to p^.ops do
               begin
-                insot:=p^.optypes[i];
-                currot:=oper[i]^.ot;
+                insot:=p^.optypes[i-1];
+                currot:=oper[i-1]^.ot;
                 if ((insot and OT_SIZE_MASK)=0) and
-                   ((currot and OT_SIZE_MASK and (not siz[i]))<>0) and
+                   ((currot and OT_SIZE_MASK and (not siz[i-1]))<>0) and
                    { Immediates can always include smaller size }
                    ((currot and OT_IMMEDIATE)=0) and
-                    (((insot and OT_SIZE_MASK) or siz[i])<(currot and OT_SIZE_MASK)) then
+                    (((insot and OT_SIZE_MASK) or siz[i-1])<(currot and OT_SIZE_MASK)) then
                   exit;
               end;
           end;

compiler/x86/itcpugas.pas

@@ -107,7 +107,7 @@ implementation
         p:=0;
         i:=regnumber_count_bsstart;
         repeat
-          if (p+i<=high(tregisterindex)) and (att_regname_table[att_regname_index[p+i]]<=s) then
+          if (p<=high(tregisterindex)-i) and (att_regname_table[att_regname_index[p+i]]<=s) then
             p:=p+i;
           i:=i shr 1;
         until i=0;

compiler/x86/itx86int.pas

@@ -66,7 +66,7 @@ implementation
         p:=0;
         i:=regnumber_count_bsstart;
         repeat
-          if (p+i<=high(tregisterindex)) and (int_regname_table[int_regname_index[p+i]]<=s) then
+          if (p<=high(tregisterindex)-i) and (int_regname_table[int_regname_index[p+i]]<=s) then
             p:=p+i;
           i:=i shr 1;
         until i=0;

compiler/x86/nx86add.pas

@@ -1067,9 +1067,14 @@ unit nx86add;
     procedure tx86addnode.second_addordinal;
       begin
          { filter unsigned MUL opcode, which requires special handling }
-         if (nodetype=muln) and
+{         if (nodetype=muln) and
             (not(is_signed(left.resultdef)) or
-             not(is_signed(right.resultdef))) then
+             not(is_signed(right.resultdef))) then}
+          {Handle unsigned with the 1 operand mul/imul and signed 8-bit as
+           well, because there is no mul immediate for signed 8-bit.}
+          if (nodetype=muln) and
+             ((def_cgsize(left.resultdef) in [OS_8,OS_16,OS_32,OS_64,OS_S8]) or
+              (def_cgsize(right.resultdef) in [OS_8,OS_16,OS_32,OS_64,OS_S8])) then
            begin
              second_mul;
              exit;