* RTTI fix from Sebastian Guenther

This commit is contained in:
michael 1999-08-11 08:56:53 +00:00
parent 42faa483e2
commit 3afbd99ce6

View File

@ -64,6 +64,20 @@
ftFixed16 = 5;
ftFixed32 = 6;
mkProcedure = 0;
mkFunction = 1;
mkConstructor = 2;
mkDestructor = 3;
mkClassProcedure= 4;
mkClassFunction = 5;
pfvar = 1;
pfConst = 2;
pfArray = 4;
pfAddress = 8;
pfReference = 16;
pfOut = 32;
constructor tdef.init;
begin
@ -2957,8 +2971,68 @@ Const local_symtable_index : longint = $8001;
procedure tprocvardef.write_rtti_data;
var
pdc, pdc2, pdcbefore : pdefcoll;
methodkind, paracount, paraspec : byte;
begin
{!!!!!!!}
{ write method id and name }
rttilist^.concat(new(pai_const,init_8bit(tkmethod)));
write_rtti_name;
{ write kind of method (can only be function or procedure)}
if retdef = pdef(voiddef) then { ### typecast shoudln't be necessary! (sg) }
methodkind := mkProcedure
else
methodkind := mkFunction;
rttilist^.concat(new(pai_const,init_8bit(methodkind)));
{ get # of parameters }
paracount:=0;
pdc:=para1;
while assigned(pdc) do
begin
inc(paracount);
pdc:=pdc^.next;
end;
rttilist^.concat(new(pai_const,init_8bit(paracount)));
{ write parameter info. The parameters must be written in reverse order
if this method uses right to left parameter pushing! }
pdc:=para1;
if assigned(pdc) and not (pocall_leftright in proccalloptions) then
while assigned(pdc^.next) do pdc := pdc^.next;
while assigned(pdc) do
begin
case pdc^.paratyp of
vs_value: paraspec := 0;
vs_const: paraspec := pfConst;
vs_var : paraspec := pfVar;
end;
{ write flags for current parameter }
rttilist^.concat(new(pai_const,init_8bit(paraspec)));
{ write name of current parameter ### how can I get this??? (sg)}
rttilist^.concat(new(pai_const,init_8bit(0)));
{ write name of type of current parameter }
pdc^.data^.write_rtti_name;
if pocall_leftright in proccalloptions then
pdc:=pdc^.next
else
begin
{ find previous argument }
pdcbefore := nil;
pdc2 := para1;
while pdc2 <> pdc do
begin
pdcbefore := pdc2;
pdc2 := pdc2^.next;
end;
pdc := pdcbefore;
end;
end;
{ write name of result type }
retdef^.write_rtti_name;
end;
@ -3629,7 +3703,10 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.149 1999-08-10 13:22:08 pierre
Revision 1.150 1999-08-11 08:56:53 michael
* RTTI fix from Sebastian Guenther
Revision 1.149 1999/08/10 13:22:08 pierre
* vmtmethodoffset made cross target compatible
Revision 1.148 1999/08/10 12:32:13 pierre