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

* more flexibel support for typecasting to different sizes

Browse Source 
fixes tw4450
      

git-svn-id: trunk@1544 -
This commit is contained in:
peter 2005-10-20 11:13:49 +00:00
parent f3bfe5735c
commit 19eaf660c2
4 changed files with 126 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6337,6 +6337,7 @@ tests/webtbs/tw4390.pp svneol=native#text/plain
tests/webtbs/tw4398.pp svneol=native#text/plain
tests/webtbs/tw4427.pp svneol=native#text/plain
tests/webtbs/tw4428.pp svneol=native#text/plain
tests/webtbs/tw4450.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain

194
compiler/i386/ra386int.pas
View File

@ -66,7 +66,7 @@ Unit Ra386int;
function BuildConstExpression:aint;
function BuildRefConstExpression:aint;
procedure BuildReference(oper : tx86operand);
procedure BuildOperand(oper: tx86operand);
procedure BuildOperand(oper: tx86operand;istypecast:boolean);
procedure BuildConstantOperand(oper: tx86operand);
procedure BuildOpCode(instr : tx86instruction);
procedure BuildConstant(constsize: byte);
@ -751,6 +751,9 @@ Unit Ra386int;
inexpression:=TRUE;
parenlevel:=0;
Repeat
{ Support ugly delphi constructs like: [ECX].1+2[EDX] }
if isref and (actasmtoken=AS_LBRACKET) then
break;
Case actasmtoken of
AS_LPAREN:
Begin
@ -801,12 +804,6 @@ Unit Ra386int;
break;
expr:=expr + '+';
end;
AS_LBRACKET:
begin
{ Support ugly delphi constructs like: [ECX].1+2[EDX] }
if isref then
break;
end;
AS_MINUS:
Begin
Consume(AS_MINUS);
@ -890,6 +887,11 @@ Unit Ra386int;
if hasparen then
Consume(AS_RPAREN);
end;
AS_PTR :
begin
{ Support ugly delphi constructs like <constant> PTR [ref] }
break;
end;
AS_STRING:
begin
l:=0;
@ -1091,10 +1093,10 @@ Unit Ra386int;
procedure ti386intreader.BuildReference(oper : tx86operand);
var
k,l,scale : aint;
scale : byte;
k,l : aint;
tempstr,hs : string;
tempsymtyp : tasmsymtype;
typesize : longint;
code : integer;
hreg : tregister;
GotStar,GotOffset,HadVar,
@ -1162,14 +1164,13 @@ Unit Ra386int;
Consume(AS_ID);
{ typecasting? }
if (actasmtoken=AS_LPAREN) and
SearchType(tempstr,typesize) then
SearchType(tempstr,l) then
begin
oper.hastype:=true;
oper.typesize:=l;
Consume(AS_LPAREN);
BuildOperand(oper);
BuildOperand(oper,true);
Consume(AS_RPAREN);
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end
else
if is_locallabel(tempstr) then
@ -1467,7 +1468,7 @@ Unit Ra386int;
end;
Procedure ti386intreader.BuildOperand(oper: tx86operand);
Procedure ti386intreader.BuildOperand(oper: tx86operand;istypecast:boolean);
procedure AddLabelOperand(hl:tasmlabel);
begin
@ -1487,12 +1488,10 @@ Unit Ra386int;
var
expr : string;
tempreg : tregister;
typesize,
l,k : aint;
l : aint;
hl : tasmlabel;
toffset,
tsize : aint;
tempstr : string;
begin
expr:='';
repeat
@ -1535,15 +1534,6 @@ Unit Ra386int;
end;
end;
{ Word,Dword,etc shall now be seen as normal (pascal) typename identifiers }
case actasmtoken of
AS_DWORD,
AS_BYTE,
AS_WORD,
AS_QWORD :
actasmtoken:=AS_ID;
end;
case actasmtoken of
AS_OFFSET,
AS_SIZEOF,
@ -1568,6 +1558,25 @@ Unit Ra386int;
end;
end;
AS_PTR :
begin
if not oper.hastype then
begin
if (oper.opr.typ=OPR_CONSTANT) then
begin
oper.typesize:=oper.opr.val;
{ reset constant value of operand }
oper.opr.typ:=OPR_NONE;
oper.opr.val:=0;
end
else
Message(asmr_e_syn_operand);
end;
Consume(AS_PTR);
oper.InitRef;
BuildOperand(oper,false);
end;
AS_ID : { A constant expression, or a Variable ref. }
Begin
{ Label or Special symbol reference? }
@ -1631,18 +1640,17 @@ Unit Ra386int;
expr:=actasmpattern;
Consume(AS_ID);
{ typecasting? }
if SearchType(expr,typesize) then
if SearchType(expr,l) then
begin
oper.hastype:=true;
oper.typesize:=l;
case actasmtoken of
AS_LPAREN :
begin
{ Support Type([Reference]) }
Consume(AS_LPAREN);
BuildOperand(oper);
BuildOperand(oper,true);
Consume(AS_RPAREN);
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end;
AS_LBRACKET :
begin
@ -1650,11 +1658,7 @@ Unit Ra386int;
{ Convert @label.Byte[1] to reference }
if oper.opr.typ=OPR_SYMBOL then
oper.initref;
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end;
else
oper.SetSize(typesize,true);
end;
end
else
@ -1707,29 +1711,71 @@ Unit Ra386int;
Consume(actasmtoken);
end;
AS_DWORD,
AS_BYTE,
AS_WORD,
AS_TBYTE,
AS_DQWORD,
AS_QWORD :
begin
{ Type specifier }
oper.hastype:=true;
oper.typesize:=0;
case actasmtoken of
AS_DWORD : oper.typesize:=4;
AS_WORD : oper.typesize:=2;
AS_BYTE : oper.typesize:=1;
AS_QWORD : oper.typesize:=8;
AS_DQWORD : oper.typesize:=16;
AS_TBYTE : oper.typesize:=10;
end;
Consume(actasmtoken);
if (actasmtoken=AS_LPAREN) then
begin
{ Support Type([Reference]) }
Consume(AS_LPAREN);
BuildOperand(oper,true);
Consume(AS_RPAREN);
end;
end;
AS_SEPARATOR,
AS_END,
AS_COMMA,
AS_COLON:
break;
begin
break;
end;
AS_RPAREN:
begin
if not istypecast then
begin
Message(asmr_e_syn_operand);
Consume(AS_RPAREN);
end
else
break;
end;
else
Message(asmr_e_syn_operand);
begin
Message(asmr_e_syn_operand);
RecoverConsume(true);
break;
end;
end;
until not(actasmtoken in [AS_DOT,AS_PLUS,AS_LBRACKET]);
if not((actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA,AS_COLON]) or
(oper.hastype and (actasmtoken=AS_RPAREN))) then
begin
Message(asmr_e_syntax_error);
RecoverConsume(true);
end;
until false;
{ End of operand, update size if a typecast is forced }
if (oper.typesize<>0) and
(oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL]) then
oper.SetSize(oper.typesize,true);
end;
Procedure ti386intreader.BuildOpCode(instr : tx86instruction);
var
PrefixOp,OverrideOp: tasmop;
size,
operandnum : longint;
is_far_const:boolean;
i:byte;
@ -1816,6 +1862,7 @@ Unit Ra386int;
Inc(operandnum);
Consume(AS_COMMA);
end;
{Far constant, i.e. jmp $0000:$11111111.}
AS_COLON:
begin
@ -1827,47 +1874,6 @@ Unit Ra386int;
consume(AS_COLON);
end;
{ Typecast, Constant Expression, Type Specifier }
AS_DWORD,
AS_BYTE,
AS_WORD,
AS_TBYTE,
AS_DQWORD,
AS_QWORD :
begin
{ load the size in a temp variable, so it can be set when the
operand is read }
size:=0;
case actasmtoken of
AS_DWORD : size:=4;
AS_WORD : size:=2;
AS_BYTE : size:=1;
AS_QWORD : size:=8;
AS_DQWORD : size:=16;
AS_TBYTE : size:=10;
end;
Consume(actasmtoken);
case actasmtoken of
AS_LPAREN :
begin
instr.Operands[operandnum].hastype:=true;
Consume(AS_LPAREN);
BuildOperand(instr.Operands[operandnum] as tx86operand);
Consume(AS_RPAREN);
end;
AS_PTR :
begin
Consume(AS_PTR);
instr.Operands[operandnum].InitRef;
BuildOperand(instr.Operands[operandnum] as tx86operand);
end;
else
BuildOperand(instr.Operands[operandnum] as tx86operand);
end;
{ now set the size which was specified by the override }
instr.Operands[operandnum].setsize(size,true);
end;
{ Type specifier }
AS_NEAR,
AS_FAR :
@ -1888,17 +1894,23 @@ Unit Ra386int;
Consume(AS_PTR);
instr.Operands[operandnum].InitRef;
end;
BuildOperand(instr.Operands[operandnum] as tx86operand);
BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end;
else
BuildOperand(instr.Operands[operandnum] as tx86operand);
BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end; { end case }
until false;
instr.ops:=operandnum;
if is_far_const then
for i:=1 to operandnum do
if instr.operands[i].opr.typ<>OPR_CONSTANT then
message(asmr_e_expr_illegal);
{ Check operands }
for i:=1 to operandnum do
begin
if is_far_const and
(instr.operands[i].opr.typ<>OPR_CONSTANT) then
message(asmr_e_expr_illegal)
else
if instr.operands[i].opr.typ=OPR_NONE then
Message(asmr_e_syntax_error);
end;
end;

1
compiler/rautils.pas
View File

@ -91,6 +91,7 @@ type
end;
TOperand = class
typesize : aint;
hastype, { if the operand has typecasted variable }
hasvar : boolean; { if the operand is loaded with a variable }
size : TCGSize;

21
tests/webtbs/tw4450.pp Executable file
View File

@ -0,0 +1,21 @@
{ %cpu=i386 }
{$ifdef fpc}{$asmmode intel}{$endif}
Type
float=single;
var
f : float;
begin
f:=4.0;
asm
lea eax,f
fld SizeOf(float) ptr [eax]
fsqrt
fstp SizeOf(float) ptr [eax]
end;
writeln(f);
if trunc(f)<>2 then
halt(1);
end.