mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-28 10:39:23 +02:00
* make variables not regable if they are referenced by an absolute
variable of a different size git-svn-id: trunk@6817 -
This commit is contained in:
parent
bdc378e250
commit
1205d05ba4
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8113,6 +8113,7 @@ tests/webtbs/tw8371.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw8391.pp svneol=native#text/plain
|
tests/webtbs/tw8391.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8434.pp svneol=native#text/plain
|
tests/webtbs/tw8434.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw8462.pp svneol=native#text/plain
|
tests/webtbs/tw8462.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw8513.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
|
||||||
|
@ -51,7 +51,7 @@ implementation
|
|||||||
systems,
|
systems,
|
||||||
{ symtable }
|
{ symtable }
|
||||||
symconst,symbase,symtype,symtable,defutil,defcmp,
|
symconst,symbase,symtype,symtable,defutil,defcmp,
|
||||||
fmodule,
|
fmodule,htypechk,
|
||||||
{ pass 1 }
|
{ pass 1 }
|
||||||
node,pass_1,aasmdata,
|
node,pass_1,aasmdata,
|
||||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
|
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
|
||||||
@ -814,6 +814,14 @@ implementation
|
|||||||
abssym.fileinfo:=vs.fileinfo;
|
abssym.fileinfo:=vs.fileinfo;
|
||||||
abssym.abstyp:=tovar;
|
abssym.abstyp:=tovar;
|
||||||
abssym.ref:=node_to_propaccesslist(pt);
|
abssym.ref:=node_to_propaccesslist(pt);
|
||||||
|
{ if the sizes are different, can't be a regvar since you }
|
||||||
|
{ can't be "absolute upper 8 bits of a register" (except }
|
||||||
|
{ if its a record field of the same size of a record }
|
||||||
|
{ regvar, but in that case pt.resultdef.size will have }
|
||||||
|
{ the same size since it refers to the field and not to }
|
||||||
|
{ the whole record -- which is why we use pt and not hp) }
|
||||||
|
if (vs.vardef.size <> pt.resultdef.size) then
|
||||||
|
make_not_regable(pt,vr_addr);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
Message(parser_e_absolute_only_to_var_or_const);
|
Message(parser_e_absolute_only_to_var_or_const);
|
||||||
|
54
tests/webtbs/tw8513.pp
Normal file
54
tests/webtbs/tw8513.pp
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
type
|
||||||
|
TMyType = cardinal;
|
||||||
|
tr = record
|
||||||
|
a,b,c,d: byte;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure t(var l: cardinal);
|
||||||
|
begin
|
||||||
|
if (l <> $cafebabe) then
|
||||||
|
halt(4);
|
||||||
|
l := $c001d00d;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Item: TMyType;
|
||||||
|
ItemAsByte: byte absolute Item;
|
||||||
|
|
||||||
|
r: tr;
|
||||||
|
b: byte absolute r.b;
|
||||||
|
|
||||||
|
l: cardinal;
|
||||||
|
labs: cardinal absolute l;
|
||||||
|
begin
|
||||||
|
{ Of course I understand fully that this code is bad
|
||||||
|
(unless you really want to read the 1st byte of 4-byte LongInt
|
||||||
|
type, messing with endianess problems).
|
||||||
|
|
||||||
|
In real code, I accessed ItemAsByte only when
|
||||||
|
SizeOf(TMyType) = 1 (the code is
|
||||||
|
used like a simple template, so it must work with any
|
||||||
|
TMyType, and the case when SizeOf(TMyType) = 1 uses some
|
||||||
|
specially optimized versions (e.g. FillChar(..., ItemAsByte)
|
||||||
|
can be used in this case to fill the array of TMyType). }
|
||||||
|
|
||||||
|
{$ifdef FPC_BIG_ENDIAN}
|
||||||
|
item:=$deadbeef;
|
||||||
|
{$else}
|
||||||
|
item:=$efbeadde;
|
||||||
|
{$endif}
|
||||||
|
if (itemasbyte <> $de) then
|
||||||
|
halt(1);
|
||||||
|
|
||||||
|
r.a := $de;
|
||||||
|
r.b := $ad;
|
||||||
|
r.c := $be;
|
||||||
|
r.d := $ef;
|
||||||
|
if (b <> $ad) then
|
||||||
|
halt(2);
|
||||||
|
|
||||||
|
l := $cafebabe;
|
||||||
|
t(labs);
|
||||||
|
if (l <> $c001d00d) then
|
||||||
|
halt(6);
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user