paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-07 04:10:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: branches/avr@17020 -
This commit is contained in:
florian 2011-02-26 20:33:01 +00:00
parent 7a05158cd1
commit d5455cf6ac
6 changed files with 224 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
compiler/avr/cgcpu.pas
View File

@ -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;

1
compiler/fpcdefs.inc
View File

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

26
compiler/nadd.pas
View File

@ -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

7
rtl/inc/compproc.inc
View File

@ -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;

158
rtl/inc/generic.inc
View File

@ -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
****************************************************************************}

1
rtl/inc/systemh.inc
View File

@ -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}