paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 05:08:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

* 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)

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/nobj.pas
View File

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

19
rtl/inc/objpas.inc
View File

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

2
rtl/inc/objpash.inc
View File

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

46
tests/webtbs/tw14145.pp
View File

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