From 8a2696eb241036a8b74a7497b347a1f96a607ed3 Mon Sep 17 00:00:00 2001 From: tom_at_work Date: Fri, 29 Oct 2010 13:26:50 +0000 Subject: [PATCH] * 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 - --- compiler/nobj.pas | 12 +++++++++-- rtl/inc/objpas.inc | 19 ++++++++++------- rtl/inc/objpash.inc | 2 +- tests/webtbs/tw14145.pp | 46 +++++++++++++++++++++++++++++++++++++---- 4 files changed, 65 insertions(+), 14 deletions(-) diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 8a2ec77421..3217ed931d 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -958,7 +958,9 @@ implementation writestrentry(p^.l); { 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(cai_align.create(const_align(sizeof(pint)))); current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0)); if assigned(p^.r) then @@ -968,7 +970,7 @@ implementation function TVMTWriter.genstrmsgtab : tasmlabel; var - count : aint; + count : longint; begin root:=nil; count:=0; @@ -983,7 +985,9 @@ implementation current_asmdata.getdatalabel(result); 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_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 begin writestrentry(root); @@ -998,7 +1002,9 @@ implementation writeintentry(p^.l); { 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(cai_align.create(const_align(sizeof(pint)))); current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0)); 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(Tai_label.Create(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(cai_align.create(const_align(sizeof(pint)))); if assigned(root) then begin writeintentry(root); diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index 850bb2ecf6..6abc26cddb 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -546,18 +546,23 @@ procedure TObject.Dispatch(var message); type - tmsgtable = packed record + PMsgIntTable = ^TMsgIntTable; + TMsgIntTable = record index : dword; method : pointer; end; - pmsgtable = ^tmsgtable; + PMsgInt = ^TMsgInt; + TMsgInt = record + count : longint; + msgs : array[0..0] of TMsgIntTable; + end; var index : dword; count,i : longint; - msgtable : pmsgtable; - p : pointer; + msgtable : PMsgIntTable; + p : PMsgInt; ovmt : PVmt; msghandler : tmessagehandler; @@ -567,11 +572,11 @@ while assigned(ovmt) do begin // See if we have messages at all in this class. - p:=ovmt^.vDynamicTable; + p:=PMsgInt(ovmt^.vDynamicTable); If Assigned(p) then begin - msgtable:=pmsgtable(p+4); - count:=pdword(p)^; + msgtable:=@p^.msgs; + count:=p^.count; end else Count:=0; diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc index e7661fbd7c..19cea3e4da 100644 --- a/rtl/inc/objpash.inc +++ b/rtl/inc/objpash.inc @@ -89,7 +89,7 @@ PMsgStrTable = ^TMsgStrTable; TStringMessageTable = record - count : ptruint; + count : longint; msgstrtable : array[0..0] of tmsgstrtable; end; diff --git a/tests/webtbs/tw14145.pp b/tests/webtbs/tw14145.pp index e321bc65e1..b33d3feb0d 100644 --- a/tests/webtbs/tw14145.pp +++ b/tests/webtbs/tw14145.pp @@ -8,11 +8,20 @@ Type TMyObject = Class(TObject) public 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; - TMyMessage = packed record + TMyMessage = record MsgStr : ShortString; - Data : Pointer; + Data : pointer; + end; + + TMyIntMessage = record + Id: integer; + Data : pointer; end; Var @@ -22,19 +31,48 @@ Procedure TMyObject.MyMessage(Var Msg); begin 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; var msg : TMyMessage; + msgi : TMyIntMessage; M : TMyObject; s : shortstring; begin - MyExitCode:=1; + MyExitCode:=4; M:=TMyObject.Create; try msg.MsgStr:='somestring'; M.DispatchStr(Msg); + + msg.MsgStr:='otherstring'; + M.DispatchStr(msg); + + msgi.id := 10000; + M.Dispatch(msgi); + + msgi.id := 1; + M.Dispatch(msgi); finally M.Free; end;