paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 08:06:07 +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/tw4398.pp svneol=native#text/plain
tests/webtbs/tw4427.pp svneol=native#text/plain tests/webtbs/tw4427.pp svneol=native#text/plain
tests/webtbs/tw4428.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/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.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 BuildConstExpression:aint;
function BuildRefConstExpression:aint; function BuildRefConstExpression:aint;
procedure BuildReference(oper : tx86operand); procedure BuildReference(oper : tx86operand);
procedure BuildOperand(oper: tx86operand); procedure BuildOperand(oper: tx86operand;istypecast:boolean);
procedure BuildConstantOperand(oper: tx86operand); procedure BuildConstantOperand(oper: tx86operand);
procedure BuildOpCode(instr : tx86instruction); procedure BuildOpCode(instr : tx86instruction);
procedure BuildConstant(constsize: byte); procedure BuildConstant(constsize: byte);
@ -751,6 +751,9 @@ Unit Ra386int;
inexpression:=TRUE; inexpression:=TRUE;
parenlevel:=0; parenlevel:=0;
Repeat Repeat
{ Support ugly delphi constructs like: [ECX].1+2[EDX] }
if isref and (actasmtoken=AS_LBRACKET) then
break;
Case actasmtoken of Case actasmtoken of
AS_LPAREN: AS_LPAREN:
Begin Begin
@ -801,12 +804,6 @@ Unit Ra386int;
break; break;
expr:=expr + '+'; expr:=expr + '+';
end; end;
AS_LBRACKET:
begin
{ Support ugly delphi constructs like: [ECX].1+2[EDX] }
if isref then
break;
end;
AS_MINUS: AS_MINUS:
Begin Begin
Consume(AS_MINUS); Consume(AS_MINUS);
@ -890,6 +887,11 @@ Unit Ra386int;
if hasparen then if hasparen then
Consume(AS_RPAREN); Consume(AS_RPAREN);
end; end;
AS_PTR :
begin
{ Support ugly delphi constructs like <constant> PTR [ref] }
break;
end;
AS_STRING: AS_STRING:
begin begin
l:=0; l:=0;
@ -1091,10 +1093,10 @@ Unit Ra386int;
procedure ti386intreader.BuildReference(oper : tx86operand); procedure ti386intreader.BuildReference(oper : tx86operand);
var var
k,l,scale : aint; scale : byte;
k,l : aint;
tempstr,hs : string; tempstr,hs : string;
tempsymtyp : tasmsymtype; tempsymtyp : tasmsymtype;
typesize : longint;
code : integer; code : integer;
hreg : tregister; hreg : tregister;
GotStar,GotOffset,HadVar, GotStar,GotOffset,HadVar,
@ -1162,14 +1164,13 @@ Unit Ra386int;
Consume(AS_ID); Consume(AS_ID);
{ typecasting? } { typecasting? }
if (actasmtoken=AS_LPAREN) and if (actasmtoken=AS_LPAREN) and
SearchType(tempstr,typesize) then SearchType(tempstr,l) then
begin begin
oper.hastype:=true; oper.hastype:=true;
oper.typesize:=l;
Consume(AS_LPAREN); Consume(AS_LPAREN);
BuildOperand(oper); BuildOperand(oper,true);
Consume(AS_RPAREN); Consume(AS_RPAREN);
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end end
else else
if is_locallabel(tempstr) then if is_locallabel(tempstr) then
@ -1467,7 +1468,7 @@ Unit Ra386int;
end; end;
Procedure ti386intreader.BuildOperand(oper: tx86operand); Procedure ti386intreader.BuildOperand(oper: tx86operand;istypecast:boolean);
procedure AddLabelOperand(hl:tasmlabel); procedure AddLabelOperand(hl:tasmlabel);
begin begin
@ -1487,12 +1488,10 @@ Unit Ra386int;
var var
expr : string; expr : string;
tempreg : tregister; tempreg : tregister;
typesize, l : aint;
l,k : aint;
hl : tasmlabel; hl : tasmlabel;
toffset, toffset,
tsize : aint; tsize : aint;
tempstr : string;
begin begin
expr:=''; expr:='';
repeat repeat
@ -1535,15 +1534,6 @@ Unit Ra386int;
end; end;
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 case actasmtoken of
AS_OFFSET, AS_OFFSET,
AS_SIZEOF, AS_SIZEOF,
@ -1568,6 +1558,25 @@ Unit Ra386int;
end; end;
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. } AS_ID : { A constant expression, or a Variable ref. }
Begin Begin
{ Label or Special symbol reference? } { Label or Special symbol reference? }
@ -1631,18 +1640,17 @@ Unit Ra386int;
expr:=actasmpattern; expr:=actasmpattern;
Consume(AS_ID); Consume(AS_ID);
{ typecasting? } { typecasting? }
if SearchType(expr,typesize) then if SearchType(expr,l) then
begin begin
oper.hastype:=true; oper.hastype:=true;
oper.typesize:=l;
case actasmtoken of case actasmtoken of
AS_LPAREN : AS_LPAREN :
begin begin
{ Support Type([Reference]) } { Support Type([Reference]) }
Consume(AS_LPAREN); Consume(AS_LPAREN);
BuildOperand(oper); BuildOperand(oper,true);
Consume(AS_RPAREN); Consume(AS_RPAREN);
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end; end;
AS_LBRACKET : AS_LBRACKET :
begin begin
@ -1650,11 +1658,7 @@ Unit Ra386int;
{ Convert @label.Byte[1] to reference } { Convert @label.Byte[1] to reference }
if oper.opr.typ=OPR_SYMBOL then if oper.opr.typ=OPR_SYMBOL then
oper.initref; oper.initref;
if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
oper.SetSize(typesize,true);
end; end;
else
oper.SetSize(typesize,true);
end; end;
end end
else else
@ -1707,29 +1711,71 @@ Unit Ra386int;
Consume(actasmtoken); Consume(actasmtoken);
end; 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_SEPARATOR,
AS_END, AS_END,
AS_COMMA, AS_COMMA,
AS_COLON: 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 else
Message(asmr_e_syn_operand); begin
Message(asmr_e_syn_operand);
RecoverConsume(true);
break;
end;
end; end;
until not(actasmtoken in [AS_DOT,AS_PLUS,AS_LBRACKET]); until false;
if not((actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA,AS_COLON]) or { End of operand, update size if a typecast is forced }
(oper.hastype and (actasmtoken=AS_RPAREN))) then if (oper.typesize<>0) and
begin (oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL]) then
Message(asmr_e_syntax_error); oper.SetSize(oper.typesize,true);
RecoverConsume(true);
end;
end; end;
Procedure ti386intreader.BuildOpCode(instr : tx86instruction); Procedure ti386intreader.BuildOpCode(instr : tx86instruction);
var var
PrefixOp,OverrideOp: tasmop; PrefixOp,OverrideOp: tasmop;
size,
operandnum : longint; operandnum : longint;
is_far_const:boolean; is_far_const:boolean;
i:byte; i:byte;
@ -1816,6 +1862,7 @@ Unit Ra386int;
Inc(operandnum); Inc(operandnum);
Consume(AS_COMMA); Consume(AS_COMMA);
end; end;
{Far constant, i.e. jmp $0000:$11111111.} {Far constant, i.e. jmp $0000:$11111111.}
AS_COLON: AS_COLON:
begin begin
@ -1827,47 +1874,6 @@ Unit Ra386int;
consume(AS_COLON); consume(AS_COLON);
end; 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 } { Type specifier }
AS_NEAR, AS_NEAR,
AS_FAR : AS_FAR :
@ -1888,17 +1894,23 @@ Unit Ra386int;
Consume(AS_PTR); Consume(AS_PTR);
instr.Operands[operandnum].InitRef; instr.Operands[operandnum].InitRef;
end; end;
BuildOperand(instr.Operands[operandnum] as tx86operand); BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end; end;
else else
BuildOperand(instr.Operands[operandnum] as tx86operand); BuildOperand(instr.Operands[operandnum] as tx86operand,false);
end; { end case } end; { end case }
until false; until false;
instr.ops:=operandnum; instr.ops:=operandnum;
if is_far_const then { Check operands }
for i:=1 to operandnum do for i:=1 to operandnum do
if instr.operands[i].opr.typ<>OPR_CONSTANT then begin
message(asmr_e_expr_illegal); 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; end;

1
compiler/rautils.pas
View File

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