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

* fixed check to determine whether a record parameter can be subscripted

Browse Source 
directly in inline assembly: that's only possible if it's a register
    parameter where the address of the record was passed (rather than the
    record itself), or if a parameter has been explicitly typecasted in
    Intel-style assembly using ".size"

git-svn-id: trunk@35959 -
This commit is contained in:
Jonas Maebe 2017-04-26 19:43:35 +00:00
parent 0f010430cc
commit aa82e00615
11 changed files with 62 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/aarch64/racpugas.pas
View File

@ -58,7 +58,7 @@ Unit racpugas;
symconst,symsym,
procinfo,
rabase,rautils,
cgbase,cgutils;
cgbase,cgutils,paramgr;
function taarch64attreader.is_register(const s:string):boolean;
@ -608,8 +608,9 @@ Unit racpugas;
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

7
compiler/arm/raarmgas.pas
View File

@ -68,7 +68,7 @@ Unit raarmgas;
symconst,symsym,
procinfo,
rabase,rautils,
cgbase,cgutils;
cgbase,cgutils,paramgr;
function tarmunifiedattreader.is_unified: boolean;
@ -635,8 +635,9 @@ Unit raarmgas;
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

7
compiler/avr/raavrgas.pas
View File

@ -59,7 +59,7 @@ Unit raavrgas;
procinfo,
itcpugas,
rabase,rautils,
cgbase,cgutils,cgobj
cgbase,cgutils,cgobj,paramgr
;
@ -259,8 +259,9 @@ Unit raavrgas;
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

7
compiler/mips/racpugas.pas
View File

@ -60,7 +60,7 @@ Interface
rabase,
rgbase,
itcpugas,
cgobj
cgobj,paramgr
;
@ -168,8 +168,9 @@ Interface
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

7
compiler/powerpc/rappcgas.pas
View File

@ -56,7 +56,7 @@ Unit rappcgas;
{ parser }
procinfo,
rabase,rautils,
cgbase,cgobj,cgppc
cgbase,cgobj,cgppc,paramgr
;
procedure tppcattreader.ReadSym(oper : tppcoperand);
@ -340,8 +340,9 @@ Unit rappcgas;
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

8
compiler/powerpc64/rappcgas.pas
View File

@ -58,7 +58,7 @@ uses
{ parser }
procinfo,
rabase, rautils,
cgbase, cgobj, cgppc
cgbase, cgobj, cgppc, paramgr
;
procedure tppcattreader.ReadSym(oper: tppcoperand);
@ -350,9 +350,9 @@ var
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractvarsym(oper.opr.localsym).owner.symtabletype =
parasymtable) and
(current_procinfo.procdef.proccalloption <> pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs, l)
end;

3
compiler/raatt.pas
View File

@ -1331,6 +1331,7 @@ unit raatt;
{ On entry actasmtoken should be equal to AS_DOT }
var
s : string;
hastypecast: boolean;
Begin
offset:=0;
size:=0;
@ -1352,7 +1353,7 @@ unit raatt;
break;
end;
end;
if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then
if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs,hastypecast) then
Message(asmr_e_building_record_offset);
end;

8
compiler/rautils.pas
View File

@ -173,7 +173,7 @@ Function EscapeToPascal(const s:string): string;
---------------------------------------------------------------------}
procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:TSymtable);
Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean):boolean;
Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
Function SearchType(const hs:string;var size:aint): Boolean;
Function SearchRecordType(const s:string): boolean;
Function SearchIConstant(const s:string; var l:aint): boolean;
@ -1278,7 +1278,7 @@ Begin
end;
Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean):boolean;
Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean; out hastypecast: boolean):boolean;
{ search and returns the offset and size of records/objects of the base }
{ with field name setup in field. }
{ returns FALSE if not found. }
@ -1296,6 +1296,7 @@ Begin
Offset:=0;
Size:=0;
mangledname:='';
hastypecast:=false;
i:=pos('.',s);
if i=0 then
i:=255;
@ -1407,7 +1408,8 @@ Begin
if assigned(sym) and (sym.typ=typesym) then
begin
size:=ttypesym(sym).typedef.size;
s:=''
s:='';
hastypecast:=true;
end;
end;
GetRecordOffsetSize:=(s='');

7
compiler/sparc/racpugas.pas
View File

@ -57,7 +57,7 @@ Interface
scanner,
procinfo,
rabase,rautils,
cgobj
cgobj,paramgr
;
@ -221,8 +221,9 @@ Interface
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l)
end;

9
compiler/x86/rax86att.pas
View File

@ -63,12 +63,12 @@ Implementation
{ aasm }
aasmbase,aasmtai,aasmdata,aasmcpu,
{ symtable }
symconst,
symconst,symsym,
{ parser }
scanner,
procinfo,
itcpugas,
rabase,
rabase,paramgr,
cgbase
;
@ -460,8 +460,9 @@ Implementation
will generate buggy code. Allow it only for explicit typecasting }
if hasdot and
(not oper.hastype) and
(oper.opr.localsym.owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l);
inc(oper.opr.localconstoffset,l);

34
compiler/x86/rax86int.pas
View File

@ -62,7 +62,7 @@ Unit Rax86int;
procedure GetToken;
function consume(t : tasmtoken):boolean;
procedure RecoverConsume(allowcomma:boolean);
procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean);
procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean; out hastypecast: boolean);
procedure BuildConstSymbolExpression(needofs,isref,startingminus:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype;out isseg,is_farproc_entry:boolean);
function BuildConstExpression:aint;
function BuildRefConstExpression(startingminus:boolean=false):aint;
@ -91,7 +91,7 @@ Unit Rax86int;
{ register allocator }
rabase,rautils,itx86int,
{ codegen }
cgbase,cgobj,procinfo
cgbase,cgobj,procinfo,paramgr
;
type
@ -232,7 +232,6 @@ Unit Rax86int;
if (getsupreg(actasmregister)=RS_DEFAULTFLAGS) and (getregtype(actasmregister)=getregtype(NR_DEFAULTFLAGS)) then
actasmregister:=NR_NO;
if (actasmregister=NR_NO) and
(current_procinfo.procdef.proccalloption=pocall_register) and
(po_assembler in current_procinfo.procdef.procoptions) then
begin
entry:=current_procinfo.procdef.parast.Find(s);
@ -763,12 +762,13 @@ Unit Rax86int;
{ This routine builds up a record offset after a AS_DOT
token is encountered.
On entry actasmtoken should be equal to AS_DOT }
Procedure tx86intreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean);
Procedure tx86intreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean; out hastypecast: boolean);
var
s: string;
Begin
offset:=0;
size:=0;
hastypecast:=false;
s:=expr;
while (actasmtoken=AS_DOT) do
begin
@ -785,7 +785,7 @@ Unit Rax86int;
break;
end;
end;
if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then
if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs,hastypecast) then
Message(asmr_e_building_record_offset);
end;
@ -804,6 +804,7 @@ Unit Rax86int;
def : tdef;
sym : tsym;
srsymtable : TSymtable;
hastypecast : boolean;
Begin
{ reset }
value:=0;
@ -943,10 +944,12 @@ Unit Rax86int;
Consume(AS_ID);
if actasmtoken=AS_DOT then
begin
BuildRecordOffsetSize(tempstr,k,l,mangledname,false);
BuildRecordOffsetSize(tempstr,k,l,mangledname,false,hastypecast);
if mangledname<>'' then
{ procsym }
Message(asmr_e_wrong_sym_type);
if hastypecast then
end
else
begin
@ -1114,7 +1117,7 @@ Unit Rax86int;
(sym.typ = fieldvarsym) and
not(sp_static in sym.symoptions)) then
begin
BuildRecordOffsetSize(tempstr,l,k,hs,needvmtofs);
BuildRecordOffsetSize(tempstr,l,k,hs,needvmtofs,hastypecast);
if hs <> '' then
hssymtyp:=AT_FUNCTION
else
@ -1224,7 +1227,8 @@ Unit Rax86int;
GotPlus,Negative : boolean;
hl : tasmlabel;
isseg: boolean;
is_farproc_entry : boolean;
is_farproc_entry,
hastypecast: boolean;
Begin
Consume(AS_LBRACKET);
if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then
@ -1342,7 +1346,7 @@ Unit Rax86int;
{ record.field ? }
if actasmtoken=AS_DOT then
begin
BuildRecordOffsetSize(tempstr,l,k,hs,false);
BuildRecordOffsetSize(tempstr,l,k,hs,false,hastypecast);
if (hs<>'') then
Message(asmr_e_invalid_symbol_ref);
case oper.opr.typ of
@ -1351,6 +1355,8 @@ Unit Rax86int;
OPR_REFERENCE :
inc(oper.opr.ref.offset,l);
end;
if hastypecast then
oper.hastype:=true;
oper.SetSize(k,false);
end;
if GotOffset then
@ -1701,6 +1707,7 @@ Unit Rax86int;
hl : tasmlabel;
toffset,
tsize : aint;
hastypecast: boolean;
begin
expr:='';
repeat
@ -1708,11 +1715,13 @@ Unit Rax86int;
begin
if expr<>'' then
begin
BuildRecordOffsetSize(expr,toffset,tsize,hs,false);
BuildRecordOffsetSize(expr,toffset,tsize,hs,false,hastypecast);
if (oper.opr.typ<>OPR_NONE) and
(hs<>'') then
Message(asmr_e_wrong_sym_type);
oper.SetSize(tsize,true);
if hastypecast then
oper.hastype:=true;
{ we have used the size of a field. Reset the typesize of the record }
oper.typesize:=0;
case oper.opr.typ of
@ -1722,8 +1731,9 @@ Unit Rax86int;
will generate buggy code. Allow it only for explicit typecasting
and when the parameter is in a register (delphi compatible) }
if (not oper.hastype) and
(oper.opr.localsym.owner.symtabletype=parasymtable) and
(current_procinfo.procdef.proccalloption<>pocall_register) then
(oper.opr.localsym.typ=paravarsym) and
((tparavarsym(oper.opr.localsym).paraloc[calleeside].location^.loc<>LOC_REGISTER) or
not paramanager.push_addr_param(oper.opr.localsym.varspez,oper.opr.localsym.vardef,current_procinfo.procdef.proccalloption)) then
Message(asmr_e_cannot_access_field_directly_for_parameters);
oper.opr.localforceref:=true;