From 19eaf660c2cfde04e92128b298fa5e571225287a Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 20 Oct 2005 11:13:49 +0000 Subject: [PATCH] * more flexibel support for typecasting to different sizes fixes tw4450 git-svn-id: trunk@1544 - --- .gitattributes | 1 + compiler/i386/ra386int.pas | 194 ++++++++++++++++++++----------------- compiler/rautils.pas | 1 + tests/webtbs/tw4450.pp | 21 ++++ 4 files changed, 126 insertions(+), 91 deletions(-) create mode 100755 tests/webtbs/tw4450.pp diff --git a/.gitattributes b/.gitattributes index 79a9022cd2..40691b6a78 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/i386/ra386int.pas b/compiler/i386/ra386int.pas index 991252fe3f..15f2ba6e21 100644 --- a/compiler/i386/ra386int.pas +++ b/compiler/i386/ra386int.pas @@ -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 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; diff --git a/compiler/rautils.pas b/compiler/rautils.pas index eeb9ccc691..6f3d57a4ab 100644 --- a/compiler/rautils.pas +++ b/compiler/rautils.pas @@ -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; diff --git a/tests/webtbs/tw4450.pp b/tests/webtbs/tw4450.pp new file mode 100755 index 0000000000..85e34fbfcf --- /dev/null +++ b/tests/webtbs/tw4450.pp @@ -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. +