Browse Source

* make variables not regable if they are referenced by an absolute
variable of a different size

git-svn-id: trunk@6817 -

Jonas Maebe 18 years ago
parent
commit
1205d05ba4
3 changed files with 64 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 9 1
      compiler/pdecvar.pas
  3. 54 0
      tests/webtbs/tw8513.pp

+ 1 - 0
.gitattributes

@@ -8113,6 +8113,7 @@ tests/webtbs/tw8371.pp svneol=native#text/plain
 tests/webtbs/tw8391.pp svneol=native#text/plain
 tests/webtbs/tw8434.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/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 9 - 1
compiler/pdecvar.pas

@@ -51,7 +51,7 @@ implementation
        systems,
        { symtable }
        symconst,symbase,symtype,symtable,defutil,defcmp,
-       fmodule,
+       fmodule,htypechk,
        { pass 1 }
        node,pass_1,aasmdata,
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,
@@ -814,6 +814,14 @@ implementation
                   abssym.fileinfo:=vs.fileinfo;
                   abssym.abstyp:=tovar;
                   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
               else
                 Message(parser_e_absolute_only_to_var_or_const);

+ 54 - 0
tests/webtbs/tw8513.pp

@@ -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.