Browse Source

* RTTI fix from Sebastian Guenther

michael 26 years ago
parent
commit
3afbd99ce6
1 changed files with 80 additions and 3 deletions
  1. 80 3
      compiler/symdef.inc

+ 80 - 3
compiler/symdef.inc

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