Browse Source

* support LOC_CONSTANT for loading self pointer

git-svn-id: trunk@5086 -
peter 19 years ago
parent
commit
3c5d82d2d1
3 changed files with 37 additions and 8 deletions
  1. 1 0
      .gitattributes
  2. 3 8
      compiler/ncgld.pas
  3. 33 0
      tests/webtbs/tw7643.pp

+ 1 - 0
.gitattributes

@@ -7570,6 +7570,7 @@ tests/webtbs/tw7527.pp svneol=native#text/plain
 tests/webtbs/tw7567.pp svneol=native#text/plain
 tests/webtbs/tw7568.pp svneol=native#text/plain
 tests/webtbs/tw7637.pp svneol=native#text/plain
+tests/webtbs/tw7643.pp svneol=native#text/plain
 tests/webtbs/tw7679.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

+ 3 - 8
compiler/ncgld.pas

@@ -297,13 +297,6 @@ implementation
                     internalerror(200312011);
                   if assigned(left) then
                     begin
-                      {
-                        THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
-                        ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
-                        CONSISTS OF TWO OS_ADDR, so you cannot set it
-                        to OS_64 - how to solve?? Carl
-                        Solved. Florian
-                      }
                       if (sizeof(aint) = 4) then
                          location_reset(location,LOC_CREFERENCE,OS_64)
                       else if (sizeof(aint) = 8) then
@@ -314,6 +307,8 @@ implementation
                       secondpass(left);
 
                       { load class instance address }
+                      if left.location.loc=LOC_CONSTANT then
+                        location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,false);
                       case left.location.loc of
                          LOC_CREGISTER,
                          LOC_REGISTER:
@@ -334,7 +329,7 @@ implementation
                               location_freetemp(current_asmdata.CurrAsmList,left.location);
                            end;
                          else
-                           internalerror(26019);
+                           internalerror(200610311);
                       end;
 
                       { store the class instance address }

+ 33 - 0
tests/webtbs/tw7643.pp

@@ -0,0 +1,33 @@
+{$mode objfpc}
+
+type
+  TMethod = procedure of object;
+
+  TDummy = class
+    procedure Method;
+  end;
+
+  tr=record
+    i1,i2 : longint;
+  end;
+  pr=^tr;
+  
+procedure TDummy.Method;
+begin
+end;
+
+procedure DoSomething(Method: TMethod);
+begin
+end;
+
+var
+  Dummy: TDummy;
+  r : tr;
+  i : longint;
+begin
+  i:=ptrint(@pr(nil)^.i2);
+{  Dummy := nil;
+  DoSomething(@Dummy.Method);}
+  DoSomething(@TDummy(nil).Method);
+  
+end.