paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-06 18:38:33 +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, symconst,symsym,
procinfo, procinfo,
rabase,rautils, rabase,rautils,
cgbase,cgutils; cgbase,cgutils,paramgr;
function taarch64attreader.is_register(const s:string):boolean; function taarch64attreader.is_register(const s:string):boolean;
@ -608,8 +608,9 @@ Unit racpugas;
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

7
compiler/arm/raarmgas.pas
View File

@ -68,7 +68,7 @@ Unit raarmgas;
symconst,symsym, symconst,symsym,
procinfo, procinfo,
rabase,rautils, rabase,rautils,
cgbase,cgutils; cgbase,cgutils,paramgr;
function tarmunifiedattreader.is_unified: boolean; function tarmunifiedattreader.is_unified: boolean;
@ -635,8 +635,9 @@ Unit raarmgas;
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

7
compiler/avr/raavrgas.pas
View File

@ -59,7 +59,7 @@ Unit raavrgas;
procinfo, procinfo,
itcpugas, itcpugas,
rabase,rautils, 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 } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

7
compiler/mips/racpugas.pas
View File

@ -60,7 +60,7 @@ Interface
rabase, rabase,
rgbase, rgbase,
itcpugas, itcpugas,
cgobj cgobj,paramgr
; ;
@ -168,8 +168,9 @@ Interface
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

7
compiler/powerpc/rappcgas.pas
View File

@ -56,7 +56,7 @@ Unit rappcgas;
{ parser } { parser }
procinfo, procinfo,
rabase,rautils, rabase,rautils,
cgbase,cgobj,cgppc cgbase,cgobj,cgppc,paramgr
; ;
procedure tppcattreader.ReadSym(oper : tppcoperand); procedure tppcattreader.ReadSym(oper : tppcoperand);
@ -340,8 +340,9 @@ Unit rappcgas;
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

8
compiler/powerpc64/rappcgas.pas
View File

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

3
compiler/raatt.pas
View File

@ -1331,6 +1331,7 @@ unit raatt;
{ On entry actasmtoken should be equal to AS_DOT } { On entry actasmtoken should be equal to AS_DOT }
var var
s : string; s : string;
hastypecast: boolean;
Begin Begin
offset:=0; offset:=0;
size:=0; size:=0;
@ -1352,7 +1353,7 @@ unit raatt;
break; break;
end; end;
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); Message(asmr_e_building_record_offset);
end; 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); 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 SearchType(const hs:string;var size:aint): Boolean;
Function SearchRecordType(const s:string): boolean; Function SearchRecordType(const s:string): boolean;
Function SearchIConstant(const s:string; var l:aint): boolean; Function SearchIConstant(const s:string; var l:aint): boolean;
@ -1278,7 +1278,7 @@ Begin
end; 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 } { search and returns the offset and size of records/objects of the base }
{ with field name setup in field. } { with field name setup in field. }
{ returns FALSE if not found. } { returns FALSE if not found. }
@ -1296,6 +1296,7 @@ Begin
Offset:=0; Offset:=0;
Size:=0; Size:=0;
mangledname:=''; mangledname:='';
hastypecast:=false;
i:=pos('.',s); i:=pos('.',s);
if i=0 then if i=0 then
i:=255; i:=255;
@ -1407,7 +1408,8 @@ Begin
if assigned(sym) and (sym.typ=typesym) then if assigned(sym) and (sym.typ=typesym) then
begin begin
size:=ttypesym(sym).typedef.size; size:=ttypesym(sym).typedef.size;
s:='' s:='';
hastypecast:=true;
end; end;
end; end;
GetRecordOffsetSize:=(s=''); GetRecordOffsetSize:=(s='');

7
compiler/sparc/racpugas.pas
View File

@ -57,7 +57,7 @@ Interface
scanner, scanner,
procinfo, procinfo,
rabase,rautils, rabase,rautils,
cgobj cgobj,paramgr
; ;
@ -221,8 +221,9 @@ Interface
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l) inc(oper.opr.localsymofs,l)
end; end;

9
compiler/x86/rax86att.pas
View File

@ -63,12 +63,12 @@ Implementation
{ aasm } { aasm }
aasmbase,aasmtai,aasmdata,aasmcpu, aasmbase,aasmtai,aasmdata,aasmcpu,
{ symtable } { symtable }
symconst, symconst,symsym,
{ parser } { parser }
scanner, scanner,
procinfo, procinfo,
itcpugas, itcpugas,
rabase, rabase,paramgr,
cgbase cgbase
; ;
@ -460,8 +460,9 @@ Implementation
will generate buggy code. Allow it only for explicit typecasting } will generate buggy code. Allow it only for explicit typecasting }
if hasdot and if hasdot and
(not oper.hastype) and (not oper.hastype) and
(oper.opr.localsym.owner.symtabletype=parasymtable) and (oper.opr.localsym.typ=paravarsym) and
(current_procinfo.procdef.proccalloption<>pocall_register) then ((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); Message(asmr_e_cannot_access_field_directly_for_parameters);
inc(oper.opr.localsymofs,l); inc(oper.opr.localsymofs,l);
inc(oper.opr.localconstoffset,l); inc(oper.opr.localconstoffset,l);

34
compiler/x86/rax86int.pas
View File

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