+ software multiplication support for OS_16,OS_S16,OS_32,OS_S32

git-svn-id: branches/avr@17020 -

compiler/avr/cgcpu.pas

@@ -133,15 +133,15 @@ unit cgcpu;
             [RS_R0,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,
              RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19,
              RS_R20,RS_R21,RS_R22,RS_R23,RS_R24,RS_R25],first_int_imreg,[]);
-        rg[R_ADDRESSREGISTER]:=trgintcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
-            [RS_R26,RS_R30],first_int_imreg,[]);
+        { rg[R_ADDRESSREGISTER]:=trgintcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
+            [RS_R26,RS_R30],first_int_imreg,[]); }
       end;
 
 
     procedure tcgavr.done_register_allocators;
       begin
         rg[R_INTREGISTER].free;
-        rg[R_ADDRESSREGISTER].free;
+        // rg[R_ADDRESSREGISTER].free;
         inherited done_register_allocators;
       end;
 
@@ -378,6 +378,7 @@ unit cgcpu;
          tmpreg: tregister;
          i : integer;
          instr : taicpu;
+         paraloc1,paraloc2,paraloc3 : TCGPara;
       begin
          case op of
            OP_ADD:
@@ -456,6 +457,29 @@ unit cgcpu;
              begin
                if size in [OS_8,OS_S8] then
                  list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src))
+               else if size=OS_16 then
+                 begin
+                   paraloc1.init;
+                   paraloc2.init;
+                   paraloc3.init;
+                   paramanager.getintparaloc(pocall_default,1,paraloc1);
+                   paramanager.getintparaloc(pocall_default,2,paraloc2);
+                   paramanager.getintparaloc(pocall_default,3,paraloc3);
+                   a_load_const_cgpara(list,OS_8,0,paraloc3);
+                   a_load_reg_cgpara(list,OS_16,src,paraloc2);
+                   a_load_reg_cgpara(list,OS_16,dst,paraloc1);
+                   paramanager.freecgpara(list,paraloc3);
+                   paramanager.freecgpara(list,paraloc2);
+                   paramanager.freecgpara(list,paraloc1);
+                   alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                   a_call_name(list,'FPC_MUL_WORD',false);
+                   dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+                   cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG);
+                   cg.a_load_reg_reg(list,OS_16,OS_16,NR_FUNCTION_RESULT_REG,dst);
+                   paraloc3.done;
+                   paraloc2.done;
+                   paraloc1.done;
+                 end
                else
                  internalerror(2011022002);
              end;
@@ -924,13 +948,13 @@ unit cgcpu;
     procedure tcgavr.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
       l : tasmlabel);
       begin
-        internalerror(2011021311);
+        //!!!!! internalerror(2011021311);
       end;
 
 
     procedure tcgavr.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
       begin
-        internalerror(2011021312);
+        //!!!!!internalerror(2011021312);
       end;
 
 
@@ -1237,6 +1261,8 @@ unit cgcpu;
        list.Concat(instr);
        { Notify the register allocator that we have written a move instruction so
          it can try to eliminate it. }
+       writeln(hexstr(dword(reg1),8));
+       writeln(hexstr(dword(reg2),8));
        add_move_instruction(instr);
       end;
 

compiler/fpcdefs.inc

@@ -119,6 +119,7 @@
   {$define cpunofpu}
   {$define cpunodefaultint}
   {$define cpuneedsdiv32helper}
+  {$define cpuneedsmulhelper}
 {$endif avr}
 
 {$ifdef mipsel}

compiler/nadd.pas

@@ -2476,6 +2476,7 @@ implementation
          rd,ld   : tdef;
          i       : longint;
          lt,rt   : tnodetype;
+         procname : string[32];
       begin
          result:=nil;
 
@@ -2588,6 +2589,31 @@ implementation
              { generic s32bit conversion }
              else
                begin
+{$ifdef cpuneedsmulhelper}
+                 if (nodetype=muln) and not(torddef(resultdef).ordtype in [u8bit,s8bit]) then
+                   begin
+                     result := nil;
+
+                     case torddef(resultdef).ordtype of
+                       s16bit:
+                         procname := 'fpc_mul_integer';
+                       u16bit:
+                         procname := 'fpc_mul_word';
+                       s32bit:
+                         procname := 'fpc_mul_longint';
+                       u32bit:
+                         procname := 'fpc_mul_dword';
+                       else
+                         internalerror(2011022301);
+                     end;
+                     result := ccallnode.createintern(procname,ccallparanode.create(left,
+                       ccallparanode.create(right,nil)));
+                     left := nil;
+                     right := nil;
+                     firstpass(result);
+                     exit;
+                   end;
+{$endif cpuneedsmulhelper}
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
                     expectloc:=LOC_REGISTER
                   else

rtl/inc/compproc.inc

@@ -583,6 +583,13 @@ function fpc_div_longint(n,z : longint) : longint; compilerproc;
 function fpc_mod_longint(n,z : longint) : longint; compilerproc;
 {$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}
 
+{$ifdef FPC_INCLUDE_SOFTWARE_MUL}
+function fpc_mul_integer(f1,f2 : integer;checkoverflow : boolean) : integer; compilerproc;
+function fpc_mul_word(f1,f2 : word;checkoverflow : boolean) : word; compilerproc;
+function fpc_mul_longint(f1,f2 : longint;checkoverflow : boolean) : longint; compilerproc;
+function fpc_mul_dword(f1,f2 : dword;checkoverflow : boolean) : dword; compilerproc;
+{$endif FPC_INCLUDE_SOFTWARE_MUL}
+
 { from int64.inc }
 function fpc_div_qword(n,z : qword) : qword; compilerproc;
 function fpc_mod_qword(n,z : qword) : qword; compilerproc;

rtl/inc/generic.inc

@@ -1287,6 +1287,164 @@ end;
                                  Math
 ****************************************************************************}
 
+{****************************************************************************
+                          Software multiplication
+****************************************************************************}
+
+{$ifndef FPC_SYSTEM_HAS_MUL_INTEGER}
+    function fpc_mul_integer(f1,f2 : integer;checkoverflow : boolean) : integer;[public,alias: 'FPC_MUL_INTEGER']; compilerproc;
+      var
+        sign : boolean;
+        q1,q2,q3 : word;
+      begin
+        begin
+           sign:=false;
+           if f1<0 then
+             begin
+                sign:=not(sign);
+                q1:=word(-f1);
+             end
+           else
+             q1:=f1;
+           if f2<0 then
+             begin
+                sign:=not(sign);
+                q2:=word(-f2);
+             end
+           else
+             q2:=f2;
+           { the q1*q2 is coded as call to mulqword }
+           q3:=q1*q2;
+
+           if checkoverflow and (q1 <> 0) and (q2 <>0) and
+           ((q1>q3) or (q2>q3) or
+             { the bit 63 can be only set if we have $8000 }
+             { and sign is true                            }
+             (q3 shr 15<>0) and
+              ((q3<>word(word(1) shl 15)) or not(sign))
+             ) then
+             HandleErrorFrame(215,get_frame);
+
+           if sign then
+             fpc_mul_integer=-q3
+           else
+             fpc_mul_integer:=q3;
+        end;
+      end;
+{$endif FPC_SYSTEM_HAS_MUL_INTEGER}
+
+
+{$ifndef FPC_SYSTEM_HAS_MUL_WORD}
+    function fpc_mul_word(f1,f2 : word;checkoverflow : boolean) : qword;[public,alias: 'FPC_MUL_WORD']; compilerproc;
+      var
+        _f1,bitpos : word;
+        b : byte;
+        f1overflowed : boolean;
+      begin
+        fpc_mul_word:=0;
+        bitpos:=1;
+        f1overflowed:=false;
+
+        for b:=0 to 15 do
+          begin
+            if (f2 and bitpos)<>0 then
+              begin
+                _f1:=fpc_mul_word;
+                fpc_mul_word:=fpc_mul_word+f1;
+
+                { if one of the operands is greater than the result an
+                  overflow occurs                                      }
+                if checkoverflow and (f1overflowed or ((_f1<>0) and (f1<>0) and
+                  ((_f1>fpc_mul_word) or (f1>fpc_mul_word)))) then
+                  HandleErrorFrame(215,get_frame);
+              end;
+            { when bootstrapping, we forget about overflow checking for qword :) }
+            f1overflowed:=f1overflowed or ((f1 and (1 shl 15))<>0);
+            f1:=f1 shl 1;
+            bitpos:=bitpos shl 1;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_MUL_WORD}
+
+
+{$ifndef FPC_SYSTEM_HAS_MUL_LONGINT}
+    function fpc_mul_longint(f1,f2 : longint;checkoverflow : boolean) : longint;[public,alias: 'FPC_MUL_LONGINT']; compilerproc;
+      var
+        sign : boolean;
+        q1,q2,q3 : dword;
+      begin
+        begin
+           sign:=false;
+           if f1<0 then
+             begin
+                sign:=not(sign);
+                q1:=dword(-f1);
+             end
+           else
+             q1:=f1;
+           if f2<0 then
+             begin
+                sign:=not(sign);
+                q2:=dword(-f2);
+             end
+           else
+             q2:=f2;
+           { the q1*q2 is coded as call to mulqword }
+           q3:=q1*q2;
+
+           if checkoverflow and (q1 <> 0) and (q2 <>0) and
+           ((q1>q3) or (q2>q3) or
+             { the bit 31 can be only set if we have $8000 0000 }
+             { and sign is true                                 }
+             (q3 shr 15<>0) and
+              ((q3<>dword(dword(1) shl 31)) or not(sign))
+             ) then
+             HandleErrorFrame(215,get_frame);
+
+           if sign then
+             fpc_mul_longint=-q3
+           else
+             fpc_mul_longint:=q3;
+        end;
+      end;
+{$endif FPC_SYSTEM_HAS_MUL_INTEGER}
+
+
+{$ifndef FPC_SYSTEM_HAS_MUL_DWORD}
+    { multiplies two dwords
+      the longbool for checkoverflow avoids a misaligned stack
+    }
+    function fpc_mul_dword(f1,f2 : dword;checkoverflow : boolean) : qword;[public,alias: 'FPC_MUL_DWORD']; compilerproc;
+      var
+        _f1,bitpos : dword;
+        b : byte;
+        f1overflowed : boolean;
+      begin
+        fpc_mul_dword:=0;
+        bitpos:=1;
+        f1overflowed:=false;
+
+        for b:=0 to 31 do
+          begin
+            if (f2 and bitpos)<>0 then
+              begin
+                _f1:=fpc_mul_dword;
+                fpc_mul_dword:=fpc_mul_dword+f1;
+
+                { if one of the operands is greater than the result an
+                  overflow occurs                                      }
+                if checkoverflow and (f1overflowed or ((_f1<>0) and (f1<>0) and
+                  ((_f1>fpc_mul_dword) or (f1>fpc_mul_dword)))) then
+                  HandleErrorFrame(215,get_frame);
+              end;
+            { when bootstrapping, we forget about overflow checking for qword :) }
+            f1overflowed:=f1overflowed or ((f1 and (1 shl 31))<>0);
+            f1:=f1 shl 1;
+            bitpos:=bitpos shl 1;
+          end;
+      end;
+{$endif FPC_SYSTEM_HAS_MUL_DWORD}
+
 {****************************************************************************
                           Software longint/dword division
 ****************************************************************************}

rtl/inc/systemh.inc

@@ -219,6 +219,7 @@ Type
   {$define DEFAULT_SINGLE}
 
   {$define FPC_INCLUDE_SOFTWARE_MOD_DIV}
+  {$define FPC_INCLUDE_SOFTWARE_MUL}
   {$define FPC_INCLUDE_SOFTWARE_SHIFT_INT64}
 
   {$ifndef FPUNONE}