mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 04:09:11 +02:00
* RTTI fix from Sebastian Guenther
This commit is contained in:
parent
42faa483e2
commit
3afbd99ce6
@ -64,6 +64,20 @@
|
|||||||
ftFixed16 = 5;
|
ftFixed16 = 5;
|
||||||
ftFixed32 = 6;
|
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;
|
constructor tdef.init;
|
||||||
begin
|
begin
|
||||||
@ -2957,8 +2971,68 @@ Const local_symtable_index : longint = $8001;
|
|||||||
|
|
||||||
|
|
||||||
procedure tprocvardef.write_rtti_data;
|
procedure tprocvardef.write_rtti_data;
|
||||||
|
var
|
||||||
|
pdc, pdc2, pdcbefore : pdefcoll;
|
||||||
|
methodkind, paracount, paraspec : byte;
|
||||||
begin
|
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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -3629,7 +3703,10 @@ Const local_symtable_index : longint = $8001;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* vmtmethodoffset made cross target compatible
|
||||||
|
|
||||||
Revision 1.148 1999/08/10 12:32:13 pierre
|
Revision 1.148 1999/08/10 12:32:13 pierre
|
||||||
|
Loading…
Reference in New Issue
Block a user