mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-09 04:45:58 +02:00
* RTTI fix from Sebastian Guenther
This commit is contained in:
parent
42faa483e2
commit
3afbd99ce6
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user