paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* added missing masking of upper 24/16 bits on ppc after performing

Browse Source 
add/sub/shl/mul on 8 or 16 bit "registers" + test (tcinvint5)
  * optimized register-register loading of < 32 bit values (removes
    30KB of superfluous extsb/extsh/rlwinm's from compiler+rtl)

git-svn-id: trunk@3207 -
This commit is contained in:
Jonas Maebe 2006-04-14 13:01:10 +00:00
parent 608f7de834
commit 0d77459b9d
3 changed files with 123 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5538,6 +5538,7 @@ tests/test/cg/tcnvint1.pp svneol=native#text/plain
tests/test/cg/tcnvint2.pp svneol=native#text/plain
tests/test/cg/tcnvint3.pp svneol=native#text/plain
tests/test/cg/tcnvint4.pp svneol=native#text/plain
tests/test/cg/tcnvint5.pp svneol=native#text/plain
tests/test/cg/tcnvptr.pp svneol=native#text/plain
tests/test/cg/tcnvset.pp svneol=native#text/plain
tests/test/cg/tcnvstr1.pp svneol=native#text/plain

81
compiler/powerpc/cgcpu.pas
View File

@ -105,6 +105,9 @@ unit cgcpu;
(* NOT IN USE: *)
procedure g_return_from_proc_mac(list : TAsmList;parasize : aint);
{ clear out potential overflow bits from 8 or 16 bit operations }
{ the upper 24/16 bits of a register after an operation }
procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
{ Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). }
@ -516,21 +519,30 @@ const
var
instr: taicpu;
begin
case tosize of
OS_8:
instr := taicpu.op_reg_reg_const_const_const(A_RLWINM,
reg2,reg1,0,31-8+1,31);
OS_S8:
instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1);
OS_16:
instr := taicpu.op_reg_reg_const_const_const(A_RLWINM,
reg2,reg1,0,31-16+1,31);
OS_S16:
instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1);
OS_32,OS_S32:
instr := taicpu.op_reg_reg(A_MR,reg2,reg1);
else internalerror(2002090901);
end;
if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
((tcgsize2size[fromsize] = tcgsize2size[tosize]) and
(fromsize <> tosize)) or
{ needs to mask out the sign in the top 16 bits }
((fromsize = OS_S8) and
(tosize = OS_16)) then
case tosize of
OS_8:
instr := taicpu.op_reg_reg_const_const_const(A_RLWINM,
reg2,reg1,0,31-8+1,31);
OS_S8:
instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1);
OS_16:
instr := taicpu.op_reg_reg_const_const_const(A_RLWINM,
reg2,reg1,0,31-16+1,31);
OS_S16:
instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1);
OS_32,OS_S32:
instr := taicpu.op_reg_reg(A_MR,reg2,reg1);
else internalerror(2002090901);
end
else
instr := taicpu.op_reg_reg(A_MR,reg2,reg1);
list.concat(instr);
rg[R_INTREGISTER].add_move_instruction(instr);
end;
@ -611,6 +623,16 @@ const
end;
procedure tcgppc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
const
overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG];
begin
if (op in overflowops) and
(size in [OS_8,OS_S8,OS_16,OS_S16]) then
a_load_reg_reg(list,OS_32,size,dst,dst);
end;
procedure tcgppc.a_op_const_reg_reg(list: TAsmList; op: TOpCg;
size: tcgsize; a: aint; src, dst: tregister);
var
@ -651,9 +673,23 @@ const
begin
case op of
OP_OR:
list.concat(taicpu.op_reg_const(A_LI,dst,-1));
case size of
OS_8, OS_S8:
list.concat(taicpu.op_reg_const(A_LI,dst,255));
OS_16, OS_S16:
a_load_const_reg(list,OS_16,65535,dst);
else
list.concat(taicpu.op_reg_const(A_LI,dst,-1));
end;
OP_XOR:
list.concat(taicpu.op_reg_reg(A_NOT,dst,src));
case size of
OS_8, OS_S8:
list.concat(taicpu.op_reg_reg_const(A_XORI,dst,src,255));
OS_16, OS_S16:
list.concat(taicpu.op_reg_reg_const(A_XORI,dst,src,65535));
else
list.concat(taicpu.op_reg_reg(A_NOT,dst,src));
end;
OP_AND:
a_load_reg_reg(list,size,size,src,dst);
end;
@ -663,7 +699,13 @@ const
((op <> OP_AND) or
not gotrlwi) then
begin
if ((size = OS_8) and
(byte(a) <> a)) or
((size = OS_S8) and
(shortint(a) <> a)) then
internalerror(200604142);
list.concat(taicpu.op_reg_reg_const(oplo,dst,src,word(a)));
{ and/or/xor -> cannot overflow in high 16 bits }
exit;
end;
{ all basic constant instructions also have a shifted form that }
@ -673,6 +715,8 @@ const
(not(op = OP_AND) or
not gotrlwi) then
begin
if (size in [OS_8,OS_S8,OS_16,OS_S16]) then
internalerror(200604141);
list.concat(taicpu.op_reg_reg_const(ophi,dst,src,word(a shr 16)));
exit;
end;
@ -687,6 +731,7 @@ const
(a <= high(smallint)) then
begin
list.concat(taicpu.op_reg_reg_const(A_ADDI,dst,src,smallint(a)));
maybeadjustresult(list,op,size,dst);
exit;
end;
@ -783,6 +828,7 @@ const
a_load_const_reg(list,OS_32,a,scratchreg);
a_op_reg_reg_reg(list,op,OS_32,scratchreg,src,dst);
end;
maybeadjustresult(list,op,size,dst);
end;
@ -809,6 +855,7 @@ const
else
list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
end;
maybeadjustresult(list,op,size,dst);
end;

58
tests/test/cg/tcnvint5.pp Normal file
View File

@ -0,0 +1,58 @@
var
error: boolean;
procedure test;
var
b: byte;
l: longint;
begin
b := 254;
inc(b,2);
l := b;
if (l <> 0) then
begin
writeln('overflow error with byte');
error := true;
end;
b :=1;
dec(b,2);
l := b;
if (l <> 255) then
begin
writeln('underflow error with byte');
error := true;
end;
end;
procedure test2;
var
b: shortint;
l: longint;
begin
b := -127;
dec(b,2);
l := b;
if (l <> 127) then
begin
writeln('neg error with shortint');
error := true;
end;
b := 126;
inc(b,2);
l := b;
if (l <> -128) then
begin
writeln('pos error with shortint');
error := true;
end;
end;
begin
error := false;
test;
test2;
halt(ord(error));
end.