I have made an attempt at fixing an AVR related bug. Since this is my
first attempt at messing with the compiler, I would like a review and
critique of my attempt.
The bug seems to be caused by the absence of the MUL instruction for
the limited AVR subarchitectures (avr1 - avr35). As far as I could see
there is no fallback code for the case where CPUAVR_HAS_MUL is not
defined for an 8 bit MUL operation. I have copied the code for the
corresponding 16 bit MUL branch, then copied and adapted the pascal
code for fpc_mul_xxx etc in rtl/inc/generic.inc and added declarations
to rtl/inc/generic.inc.
Can anyone see any problems with this approach, or perhaps suggest a
better approach to fix this bug?
Thanks
Index: compiler/avr/cgcpu.pas
===================================================================
--- compiler/avr/cgcpu.pas (revision 36776)
+++ compiler/avr/cgcpu.pas (working copy)
@@ -609,7 +609,36 @@
cg.a_reg_dealloc(list,NR_R0);
end
else
- internalerror(2015061001);
+ begin
+ { keep code for muls with overflow checking }
+ 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_reg_alloc(list,NR_R25);
+ cg.a_load_reg_reg(list,OS_8,OS_8,NR_R24,dst);
+ cg.a_reg_dealloc(list,NR_R24);
+ cg.a_load_reg_reg(list,OS_8,OS_8,NR_R25,GetNextReg(dst));
+ cg.a_reg_dealloc(list,NR_R25);
+ paraloc2.done;
+ paraloc1.done;
+ end;
+ //internalerror(2015061001);
end
else if size in [OS_16,OS_S16] then
begin
Index: rtl/inc/compproc.inc
===================================================================
--- rtl/inc/compproc.inc (revision 36776)
+++ rtl/inc/compproc.inc (working copy)
@@ -598,6 +598,14 @@
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}
+
+{$if defined(CPUAVR) and not defined(CPUAVR_HAS_MUL)}
+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;
+{$endif CPUAVR_HAS_MUL}
+
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;
Index: rtl/inc/generic.inc
===================================================================
--- rtl/inc/generic.inc (revision 36776)
+++ rtl/inc/generic.inc (working copy)
@@ -1500,6 +1500,109 @@
{$else VER3_0}
+{$if defined(CPUAVR) AND not defined(CPUAVR_HAS_MUL)}
+{$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 mulword }
+ 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 mulword }
+ q3 := q1 * q2;
+
+ if (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 <> 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 :) } // CONFIRM BELOW
+ f1overflowed := f1overflowed or ((f1 and (1 shl 15)) <> 0);
+ f1 := f1 shl 1;
+ bitpos := bitpos shl 1;
+ end;
+ end;
+{$endif FPC_SYSTEM_HAS_MUL_BYTE}
+{$endif CPUAVR_HAS_MUL}
+
{$ifndef FPC_SYSTEM_HAS_MUL_INTEGER}
function fpc_mul_integer(f1,f2 : integer) : integer;[public,alias: 'FPC_MUL_INTEGER']; compilerproc;
begin
_______________________________________________
fpc-devel maillist - fpc-devel@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel
