* 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 -
This commit is contained in:
tom_at_work 2010-10-29 13:26:50 +00:00
parent b4aa087aad
commit 8a2696eb24
4 changed files with 65 additions and 14 deletions

View File

@ -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);

View File

@ -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; msgtable : PMsgIntTable;
p : pointer; 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); msgtable:=@p^.msgs;
count:=pdword(p)^; count:=p^.count;
end end
else else
Count:=0; Count:=0;

View File

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

View File

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