Răsfoiți Sursa

* limit the number of string message methods per class to 2^31 independent of architecture width: this avoids lots of compiler changes when allowing 2^63 (for 64 bit targets)
* fix string message method handling data structures to reflect this change, and also use the correct types for accessing them (longint vs. dword)
* output proper alignment code for string message method data structures to avoid issues on big-endian 64 bit architectures or architectures requiring proper alignment
* same for integer message methods; also, like string message method data structures, do not use packed records for them when accessing
* extend the test case (tw14145) do do multiple message dispatches, both integer and string ones, to complete successfully

git-svn-id: trunk@16254 -

tom_at_work 14 ani în urmă
părinte
comite
8a2696eb24
4 a modificat fișierele cu 65 adăugiri și 14 ștergeri
  1. 10 2
      compiler/nobj.pas
  2. 12 7
      rtl/inc/objpas.inc
  3. 1 1
      rtl/inc/objpash.inc
  4. 42 4
      tests/webtbs/tw14145.pp

+ 10 - 2
compiler/nobj.pas

@@ -958,7 +958,9 @@ implementation
            writestrentry(p^.l);
            writestrentry(p^.l);
 
 
          { write name label }
          { write name label }
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(p^.nl));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(p^.nl));
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0));
 
 
          if assigned(p^.r) then
          if assigned(p^.r) then
@@ -968,7 +970,7 @@ implementation
 
 
     function TVMTWriter.genstrmsgtab : tasmlabel;
     function TVMTWriter.genstrmsgtab : tasmlabel;
       var
       var
-         count : aint;
+         count : longint;
       begin
       begin
          root:=nil;
          root:=nil;
          count:=0;
          count:=0;
@@ -983,7 +985,9 @@ implementation
          current_asmdata.getdatalabel(result);
          current_asmdata.getdatalabel(result);
          current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(Tai_label.Create(result));
          current_asmdata.asmlists[al_globals].concat(Tai_label.Create(result));
-         current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(count));
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint))));
+         current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count));
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          if assigned(root) then
          if assigned(root) then
            begin
            begin
               writestrentry(root);
               writestrentry(root);
@@ -998,7 +1002,9 @@ implementation
            writeintentry(p^.l);
            writeintentry(p^.l);
 
 
          { write name label }
          { write name label }
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint))));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(p^.data.messageinf.i));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(p^.data.messageinf.i));
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0));
 
 
          if assigned(p^.r) then
          if assigned(p^.r) then
@@ -1021,7 +1027,9 @@ implementation
          current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          current_asmdata.asmlists[al_globals].concat(Tai_label.Create(r));
          current_asmdata.asmlists[al_globals].concat(Tai_label.Create(r));
          genintmsgtab:=r;
          genintmsgtab:=r;
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint))));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count));
          current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count));
+         current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint))));
          if assigned(root) then
          if assigned(root) then
            begin
            begin
               writeintentry(root);
               writeintentry(root);

+ 12 - 7
rtl/inc/objpas.inc

@@ -546,18 +546,23 @@
       procedure TObject.Dispatch(var message);
       procedure TObject.Dispatch(var message);
 
 
         type
         type
-           tmsgtable = packed record
+           PMsgIntTable = ^TMsgIntTable;
+           TMsgIntTable = record
               index : dword;
               index : dword;
               method : pointer;
               method : pointer;
            end;
            end;
 
 
-           pmsgtable = ^tmsgtable;
+           PMsgInt = ^TMsgInt;
+           TMsgInt = record
+              count : longint;
+              msgs : array[0..0] of TMsgIntTable;
+           end;
 
 
         var
         var
            index : dword;
            index : dword;
            count,i : longint;
            count,i : longint;
-           msgtable : pmsgtable;
-           p : pointer;
+           msgtable : PMsgIntTable;
+           p : PMsgInt;
            ovmt : PVmt;
            ovmt : PVmt;
            msghandler : tmessagehandler;
            msghandler : tmessagehandler;
 
 
@@ -567,11 +572,11 @@
            while assigned(ovmt) do
            while assigned(ovmt) do
              begin
              begin
                 // See if we have messages at all in this class.
                 // See if we have messages at all in this class.
-                p:=ovmt^.vDynamicTable;
+                p:=PMsgInt(ovmt^.vDynamicTable);
                 If Assigned(p) then
                 If Assigned(p) then
                   begin
                   begin
-                     msgtable:=pmsgtable(p+4);
-                     count:=pdword(p)^;
+                     msgtable:=@p^.msgs;
+                     count:=p^.count;
                   end
                   end
                 else
                 else
                   Count:=0;
                   Count:=0;

+ 1 - 1
rtl/inc/objpash.inc

@@ -89,7 +89,7 @@
        PMsgStrTable = ^TMsgStrTable;
        PMsgStrTable = ^TMsgStrTable;
 
 
        TStringMessageTable = record
        TStringMessageTable = record
-          count : ptruint;
+          count : longint;
           msgstrtable : array[0..0] of tmsgstrtable;
           msgstrtable : array[0..0] of tmsgstrtable;
        end;
        end;
 
 

+ 42 - 4
tests/webtbs/tw14145.pp

@@ -8,11 +8,20 @@ Type
   TMyObject = Class(TObject)
   TMyObject = Class(TObject)
   public
   public
     Procedure MyMessage(Var Msg); message 'somestring';
     Procedure MyMessage(Var Msg); message 'somestring';
+    Procedure MyMessage2(Var Msg); message 'otherstring';
+
+    procedure Message2(var msg); message 1;
+    procedure Message3(var msg); message 10000;
   end;
   end;
 
 
-  TMyMessage = packed record
+  TMyMessage = record
     MsgStr : ShortString;
     MsgStr : ShortString;
-    Data : Pointer;
+    Data : pointer;
+  end;
+  
+  TMyIntMessage = record
+    Id: integer;
+    Data : pointer;
   end;
   end;
 
 
 Var
 Var
@@ -22,19 +31,48 @@ Procedure TMyObject.MyMessage(Var Msg);
 
 
 begin
 begin
   Writeln('Got Message');
   Writeln('Got Message');
-  MyExitCode:=0;
+  dec(MyExitCode);
+end;
+
+Procedure TMyObject.MyMessage2(Var Msg);
+
+begin
+  Writeln('Got Message');
+  dec(MyExitCode);
+end;
+
+procedure TMyObject.Message2(var msg);
+begin
+  Writeln('Got Message 2');
+  dec(MyExitCode)
+end;
+
+procedure TMyObject.Message3(var msg);
+begin
+  Writeln('Got message 3');
+  dec(MyExitCode);
 end;
 end;
 
 
 var
 var
   msg : TMyMessage;
   msg : TMyMessage;
+  msgi : TMyIntMessage;
   M : TMyObject;
   M : TMyObject;
   s : shortstring;
   s : shortstring;
 begin
 begin
-  MyExitCode:=1;
+  MyExitCode:=4;
   M:=TMyObject.Create;
   M:=TMyObject.Create;
   try
   try
     msg.MsgStr:='somestring';
     msg.MsgStr:='somestring';
     M.DispatchStr(Msg);
     M.DispatchStr(Msg);
+
+    msg.MsgStr:='otherstring';
+    M.DispatchStr(msg);
+
+    msgi.id := 10000;
+    M.Dispatch(msgi);
+
+    msgi.id := 1;
+    M.Dispatch(msgi);
   finally
   finally
     M.Free;
     M.Free;
   end;
   end;