paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 07:19:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix by Jan Bruns for #11042: improves reading of references on arm

Browse Source 
git-svn-id: trunk@10625 -
This commit is contained in:
florian 2008-04-10 19:47:49 +00:00
parent 6c5471f324
commit 951a202e5d
3 changed files with 367 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8131,6 +8131,7 @@ tests/webtbs/tw11033.pp svneol=native#text/plain
tests/webtbs/tw11039a.pp svneol=native#text/plain tests/webtbs/tw11039a.pp svneol=native#text/plain
tests/webtbs/tw11039b.pp svneol=native#text/plain tests/webtbs/tw11039b.pp svneol=native#text/plain
tests/webtbs/tw1104.pp svneol=native#text/plain tests/webtbs/tw1104.pp svneol=native#text/plain
tests/webtbs/tw11042.pp svneol=native#text/plain
tests/webtbs/tw1111.pp svneol=native#text/plain tests/webtbs/tw1111.pp svneol=native#text/plain
tests/webtbs/tw1117.pp svneol=native#text/plain tests/webtbs/tw1117.pp svneol=native#text/plain
tests/webtbs/tw1122.pp svneol=native#text/plain tests/webtbs/tw1122.pp svneol=native#text/plain

338
compiler/arm/raarmgas.pas
View File

@ -152,74 +152,330 @@ Unit raarmgas;
Procedure tarmattreader.BuildReference(oper : tarmoperand); Procedure tarmattreader.BuildReference(oper : tarmoperand);
procedure Consume_RBracket; procedure do_error;
begin begin
if actasmtoken<>AS_RBRACKET then
Begin
Message(asmr_e_invalid_reference_syntax); Message(asmr_e_invalid_reference_syntax);
RecoverConsume(true); RecoverConsume(false);
end;
procedure test_end(require_rbracket : boolean);
begin
if require_rbracket then begin
if not(actasmtoken=AS_RBRACKET) then
begin
do_error;
exit;
end
else
Consume(AS_RBRACKET);
if (actasmtoken=AS_NOT) then
begin
oper.opr.ref.addressmode:=AM_PREINDEXED;
Consume(AS_NOT);
end;
end;
if not(actasmtoken in [AS_SEPARATOR,AS_end]) then
do_error
else
begin
{$IFDEF debugasmreader}
writeln('TEST_end_FINAL_OK. Created the following ref:');
writeln('oper.opr.ref.shiftimm=',oper.opr.ref.shiftimm);
writeln('oper.opr.ref.shiftmode=',ord(oper.opr.ref.shiftmode));
writeln('oper.opr.ref.index=',ord(oper.opr.ref.index));
writeln('oper.opr.ref.base=',ord(oper.opr.ref.base));
writeln('oper.opr.ref.signindex=',ord(oper.opr.ref.signindex));
writeln('oper.opr.ref.addressmode=',ord(oper.opr.ref.addressmode));
writeln;
{$endIF debugasmreader}
end;
end;
function is_shifter_ref_operation(var a : tshiftmode) : boolean;
begin
a := SM_NONE;
if (actasmpattern='LSL') then
a := SM_LSL
else if (actasmpattern='LSR') then
a := SM_LSR
else if (actasmpattern='ASR') then
a := SM_ASR
else if (actasmpattern='ROR') then
a := SM_ROR
else if (actasmpattern='RRX') then
a := SM_RRX;
is_shifter_ref_operation := not(a=SM_NONE);
end;
procedure read_index_shift(require_rbracket : boolean);
begin
case actasmtoken of
AS_COMMA :
begin
Consume(AS_COMMA);
if not(actasmtoken=AS_ID) then
do_error;
if is_shifter_ref_operation(oper.opr.ref.shiftmode) then
begin
Consume(AS_ID);
if not(oper.opr.ref.shiftmode=SM_RRX) then
begin
if not(actasmtoken=AS_HASH) then
do_error;
Consume(AS_HASH);
oper.opr.ref.shiftimm := BuildConstExpression(false,true);
if (oper.opr.ref.shiftimm<0) or (oper.opr.ref.shiftimm>32) then
do_error;
test_end(require_rbracket);
end;
end end
else else
begin begin
Consume(AS_RBRACKET); do_error;
if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then exit;
Begin
Message(asmr_e_invalid_reference_syntax);
RecoverConsume(true);
end; end;
end; end;
end; AS_RBRACKET :
if require_rbracket then
test_end(require_rbracket)
procedure read_index; else
begin
do_error;
exit;
end;
AS_SEPARATOR,AS_END :
if not require_rbracket then
test_end(false)
else
do_error;
else
begin
do_error;
exit;
end;
end;
end;
procedure read_index(require_rbracket : boolean);
var
i : longint;
w : word;
recname : string;
o_int,s_int : aint;
begin
case actasmtoken of
AS_REGISTER :
begin begin
Consume(AS_COMMA);
if actasmtoken=AS_REGISTER then
Begin
oper.opr.ref.index:=actasmregister; oper.opr.ref.index:=actasmregister;
Consume(AS_REGISTER); Consume(AS_REGISTER);
read_index_shift(require_rbracket);
exit;
end;
AS_PLUS,AS_MINUS :
begin
if actasmtoken=AS_PLUS then
begin
Consume(AS_PLUS);
end end
else if actasmtoken=AS_HASH then else
begin
oper.opr.ref.signindex := -1;
Consume(AS_MINUS);
end;
if actasmtoken=AS_REGISTER then
begin
oper.opr.ref.index:=actasmregister;
Consume(AS_REGISTER);
read_index_shift(require_rbracket);
exit;
end
else
begin
do_error;
exit;
end;
test_end(require_rbracket);
exit;
end;
AS_HASH : // constant
begin begin
Consume(AS_HASH); Consume(AS_HASH);
inc(oper.opr.ref.offset,BuildConstExpression(false,true)); o_int := BuildConstExpression(false,true);
if (o_int>4095) or (o_int<-4095) then
begin
Message(asmr_e_constant_out_of_bounds);
RecoverConsume(false);
exit;
end
else
begin
inc(oper.opr.ref.offset,o_int);
test_end(require_rbracket);
exit;
end; end;
end; end;
AS_ID :
begin
recname := actasmpattern;
Consume(AS_ID);
BuildRecordOffsetSize(recname,o_int,s_int,recname,false);
if (o_int>4095)or(o_int<-4095) then
begin
Message(asmr_e_constant_out_of_bounds);
RecoverConsume(false);
exit;
end
else
begin
inc(oper.opr.ref.offset,o_int);
test_end(require_rbracket);
exit;
end;
end;
AS_AT:
begin
do_error;
exit;
end;
AS_DOT : // local label
begin
oper.opr.ref.signindex := BuildConstExpression(true,false);
test_end(require_rbracket);
exit;
end;
AS_RBRACKET :
begin
if require_rbracket then
begin
test_end(require_rbracket);
exit;
end
else
begin
do_error; // unexpected rbracket
exit;
end;
end;
AS_SEPARATOR,AS_end :
begin
if not require_rbracket then
begin
test_end(false);
exit;
end
else
begin
do_error;
exit;
end;
end;
else
begin
// unexpected token
do_error;
exit;
end;
end; // case
end;
procedure try_prepostindexed;
begin
Consume(AS_RBRACKET);
case actasmtoken of
AS_COMMA :
begin // post-indexed
Consume(AS_COMMA);
oper.opr.ref.addressmode:=AM_POSTINDEXED;
read_index(false);
exit;
end;
AS_NOT :
begin // pre-indexed
Consume(AS_NOT);
oper.opr.ref.addressmode:=AM_PREINDEXED;
test_end(false);
exit;
end;
else
begin
test_end(false);
exit;
end;
end; // case
end;
var
lab : TASMLABEL;
begin begin
Consume(AS_LBRACKET); Consume(AS_LBRACKET);
oper.opr.ref.addressmode:=AM_OFFSET; // assume "neither PRE nor POST inc"
if actasmtoken=AS_REGISTER then if actasmtoken=AS_REGISTER then
begin begin
oper.opr.ref.base:=actasmregister; oper.opr.ref.base:=actasmregister;
Consume(AS_REGISTER); Consume(AS_REGISTER);
{ can either be a register or a right parenthesis } case actasmtoken of
{ (reg) } AS_RBRACKET :
if actasmtoken=AS_RBRACKET then begin
Begin try_prepostindexed;
Consume_RBracket;
oper.opr.ref.addressmode:=AM_POSTINDEXED;
if actasmtoken=AS_COMMA then
read_index;
exit; exit;
end; end;
if actasmtoken=AS_COMMA then AS_COMMA :
begin begin
read_index; Consume(AS_COMMA);
Consume_RBracket; read_index(true);
exit;
end; end;
if actasmtoken=AS_NOT then
begin
consume(AS_NOT);
oper.opr.ref.addressmode:=AM_PREINDEXED;
end;
end {end case }
else else
Begin begin
Message(asmr_e_invalid_reference_syntax); Message(asmr_e_invalid_reference_syntax);
RecoverConsume(false); RecoverConsume(false);
end; end;
end; end;
end
else
{
if base isn't a register, r15=PC is implied base, so it must be a local label.
pascal constants don't make sense, because implied r15
record offsets probably don't make sense, too (a record offset of code?)
TODO: However, we could make the Stackpointer implied.
}
Begin
case actasmtoken of
AS_ID :
begin
if is_locallabel(actasmpattern) then
begin
CreateLocalLabel(actasmpattern,lab,false);
oper.opr.ref.symbol := lab;
Consume(AS_ID);
test_end(true);
exit;
end
else
begin
// TODO: Stackpointer implied,
Message(asmr_e_invalid_reference_syntax);
RecoverConsume(false);
exit;
end;
end;
else
begin // elsecase
Message(asmr_e_invalid_reference_syntax);
RecoverConsume(false);
exit;
end;
end;
end;
end;
function tarmattreader.TryBuildShifterOp(oper : tarmoperand) : boolean; function tarmattreader.TryBuildShifterOp(oper : tarmoperand) : boolean;
@ -373,7 +629,7 @@ Unit raarmgas;
Begin Begin
ReadSym(oper); ReadSym(oper);
case actasmtoken of case actasmtoken of
AS_END, AS_end,
AS_SEPARATOR, AS_SEPARATOR,
AS_COMMA: ; AS_COMMA: ;
AS_LPAREN: AS_LPAREN:
@ -529,7 +785,7 @@ Unit raarmgas;
{ save the type of register used. } { save the type of register used. }
tempreg:=actasmregister; tempreg:=actasmregister;
Consume(AS_REGISTER); Consume(AS_REGISTER);
if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then if (actasmtoken in [AS_end,AS_SEPARATOR,AS_COMMA]) then
Begin Begin
if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
Message(asmr_e_invalid_operand_type); Message(asmr_e_invalid_operand_type);
@ -578,7 +834,7 @@ Unit raarmgas;
oper.opr.typ:=OPR_REGSET; oper.opr.typ:=OPR_REGSET;
oper.opr.regset:=registerset; oper.opr.regset:=registerset;
end; end;
AS_END, AS_end,
AS_SEPARATOR, AS_SEPARATOR,
AS_COMMA: ; AS_COMMA: ;
else else
@ -617,7 +873,7 @@ Unit raarmgas;
operandnum:=1; operandnum:=1;
Consume(AS_OPCODE); Consume(AS_OPCODE);
{ Zero operand opcode ? } { Zero operand opcode ? }
if actasmtoken in [AS_SEPARATOR,AS_END] then if actasmtoken in [AS_SEPARATOR,AS_end] then
begin begin
operandnum:=0; operandnum:=0;
exit; exit;
@ -645,7 +901,7 @@ Unit raarmgas;
end; end;
end; end;
AS_SEPARATOR, AS_SEPARATOR,
AS_END : { End of asm operands for this opcode } AS_end : { End of asm operands for this opcode }
begin begin
break; break;
end; end;

39
tests/webtbs/tw11042.pp Normal file
View File

@ -0,0 +1,39 @@
{ %cpu=arm }
{ %norun }
TYPE
ttest = record
a : shortstring;
b : dword;
end;
VAR
q : ttest;
begin
asm
ldr r0,[r1,r2,lsl #3]
ldr r0,[r1]
ldr r0,[r1, r2]
ldr r0,[r1, -r2]
ldr r0,[r1, r2, lsl #23]
ldr r0,[r1, -r2, lsl #23]
ldr r0,[r1, #4095]
ldr r0,[r1, #-4095]
ldr r0,[r1, r2]!
ldr r0,[r1, -r2]!
ldr r0,[r1, r2, lsl #23]!
ldr r0,[r1, -r2, lsl #23]!
ldr r0,[r1, #4095]!
ldr r0,[r1, #-4095]!
ldr r0,[r1], r2
ldr r0,[r1], -r2
ldr r0,[r1], r2, lsl #23
ldr r0,[r1], -r2, lsl #23
ldr r0,[r1], #4095
ldr r0,[r1], #-4095
ldr r0,[r1,q.b]
.Ltest:
ldr r0,[.Ltest]
end;
end.