paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 13:28:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Christo Crause to implement 8 bit multiplications for "mul-less" avr types, resolves issue #31925

Browse Source 
git-svn-id: trunk@37380 -
This commit is contained in:
florian 2017-10-01 20:34:44 +00:00
parent c0feaf1f1e
commit 7817102727
3 changed files with 131 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/avr/cgcpu.pas
View File

@ -612,7 +612,31 @@ unit cgcpu;
cg.a_reg_dealloc(list,NR_R0);
end
else
internalerror(2015061001);
begin
if size=OS_8 then
pd:=search_system_proc('fpc_mul_byte')
else
pd:=search_system_proc('fpc_mul_shortint');
paraloc1.init;
paraloc2.init;
paramanager.getintparaloc(list,pd,1,paraloc1);
paramanager.getintparaloc(list,pd,2,paraloc2);
a_load_reg_cgpara(list,OS_8,src,paraloc2);
a_load_reg_cgpara(list,OS_8,dst,paraloc1);
paramanager.freecgpara(list,paraloc2);
paramanager.freecgpara(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
if size=OS_8 then
a_call_name(list,'FPC_MUL_BYTE',false)
else
a_call_name(list,'FPC_MUL_SHORTINT',false);
dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
cg.a_reg_alloc(list,NR_R24);
cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
cg.a_reg_dealloc(list,NR_R24);
paraloc2.done;
paraloc1.done;
end;
end
else if size in [OS_16,OS_S16] then
begin
@ -632,7 +656,6 @@ unit cgcpu;
end
else
begin
{ keep code for muls with overflow checking }
if size=OS_16 then
pd:=search_system_proc('fpc_mul_word')
else

5
rtl/inc/compproc.inc
View File

@ -598,6 +598,11 @@ 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;
{$else VER3_0}
function fpc_mul_shortint(f1,f2 : shortint) : shortint; compilerproc;
function fpc_mul_shortint_checkoverflow(f1,f2 : shortint) : shortint; compilerproc;
function fpc_mul_byte(f1,f2 : byte) : byte; compilerproc;
function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte; compilerproc;
function fpc_mul_integer(f1,f2 : integer) : integer; compilerproc;
function fpc_mul_integer_checkoverflow(f1,f2 : integer) : integer; compilerproc;
function fpc_mul_word(f1,f2 : word) : word; compilerproc;

101
rtl/inc/generic.inc
View File

@ -1500,6 +1500,107 @@ end;
{$else VER3_0}
{$ifndef FPC_SYSTEM_HAS_MUL_SHORTINT}
function fpc_mul_shortint(f1,f2 : shortint) : shortint;[public,alias: 'FPC_MUL_SHORTINT']; compilerproc;
begin
{ there's no difference between signed and unsigned multiplication,
when the destination size is equal to the source size and overflow
checking is off }
{ byte(f1) * byte(f2) is coded as a call to mul_byte }
fpc_mul_shortint := shortint(byte(f1) * byte(f2));
end;
function fpc_mul_shortint_checkoverflow(f1,f2 : shortint) : shortint;[public,alias: 'FPC_MUL_SHORTINT_CHECKOVERFLOW']; compilerproc;
var
sign : boolean;
q1,q2,q3 : byte;
begin
sign:=false;
if f1 < 0 then
begin
sign := not(sign);
q1 := byte(-f1);
end
else
q1 := f1;
if f2 < 0 then
begin
sign := not(sign);
q2 := byte(-f2);
end
else
q2 := f2;
{ the q1*q2 is coded as call to mul_byte }
q3 := q1 * q2;
if (q1 <> 0) and (q2 <> 0) and
((q1 > q3) or (q2 > q3) or
{ the bit 7 can be only set if we have $80 }
{ and sign is true }
(q3 shr 7 <> 0) and
((q3 <> byte(byte(1) shl 7)) or not(sign))
) then
HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);
if sign then
fpc_mul_shortint_checkoverflow := -q3
else
fpc_mul_shortint_checkoverflow := q3;
end;
{$endif FPC_SYSTEM_HAS_MUL_SHORTINT}
{$ifndef FPC_SYSTEM_HAS_MUL_BYTE}
function fpc_mul_byte(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE']; compilerproc;
var
_f1, bitpos : byte;
b : byte;
begin
fpc_mul_byte := 0;
bitpos := 1;
for b := 0 to 7 do
begin
if (f2 and bitpos) <> 0 then
begin
_f1 := fpc_mul_byte;
fpc_mul_byte := fpc_mul_byte + f1;
end;
f1 := f1 shl 1;
bitpos := bitpos shl 1;
end;
end;
function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE_CHECKOVERFLOW']; compilerproc;
var
_f1, bitpos : byte;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_byte_checkoverflow := 0;
bitpos := 1;
f1overflowed := false;
for b := 0 to 7 do
begin
if (f2 and bitpos) <> 0 then
begin
_f1 := fpc_mul_byte_checkoverflow;
fpc_mul_byte_checkoverflow := fpc_mul_byte_checkoverflow + f1;
{ if one of the operands is greater than the result an
overflow occurs }
if f1overflowed or ((_f1 <> 0) and (f1 <> 0) and
((_f1 > fpc_mul_byte_checkoverflow) or (f1 > fpc_mul_byte_checkoverflow))) then
HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);
end;
{ when bootstrapping, we forget about overflow checking for qword :) }
f1overflowed := f1overflowed or ((f1 and (1 shl 7)) <> 0);
f1 := f1 shl 1;
bitpos := bitpos shl 1;
end;
end;
{$endif FPC_SYSTEM_HAS_MUL_BYTE}
{$ifndef FPC_SYSTEM_HAS_MUL_INTEGER}
function fpc_mul_integer(f1,f2 : integer) : integer;[public,alias: 'FPC_MUL_INTEGER']; compilerproc;
begin