|
@@ -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;
|
|
|
- begin
|
|
|
- {!!!!!!!}
|
|
|
+ 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
|