Browse Source

* Atributes for class/record methods

Michaël Van Canneyt 1 year ago
parent
commit
05f0ceeb26
4 changed files with 27 additions and 9 deletions
  1. 5 3
      compiler/ncgrtti.pas
  2. 7 3
      compiler/pdecobj.pas
  3. 5 1
      compiler/ptype.pas
  4. 10 2
      rtl/objpas/typinfo.pp

+ 5 - 3
compiler/ncgrtti.pas

@@ -322,9 +322,11 @@ implementation
                           begin
                             maybe_add_comment(tcb,#9'VMT index');
                             tcb.emit_ord_const(def.extnumber,u16inttype);
-                            maybe_add_comment(tcb,#9'Code Address');
-                            tcb.emit_procdef_const(def);
-                          end
+                          end;
+                        maybe_add_comment(tcb,#9'Code Address');
+                        tcb.emit_procdef_const(def);
+                        maybe_add_comment(tcb,#9'Attribute table');
+                        write_attribute_data(tcb,def.rtti_attribute_list);
                       end;
 
                     for k:=0 to def.paras.count-1 do

+ 7 - 3
compiler/pdecobj.pas

@@ -1085,6 +1085,7 @@ implementation
         fieldlist: tfpobjectlist;
         rtti_attrs_def: trtti_attribute_list;
         attr_element_count,fldCount : Integer;
+        method_def : tprocdef;
 
       procedure parse_const;
         begin
@@ -1442,9 +1443,12 @@ implementation
             _CONSTRUCTOR,
             _DESTRUCTOR :
               begin
-                check_unbound_attributes;
-                rtti_attrs_def := nil;
-                method_dec(current_structdef,is_classdef,hadgeneric);
+                method_def:=method_dec(current_structdef,is_classdef,hadgeneric);
+                if assigned(rtti_attrs_def) then
+                  begin
+                  trtti_attribute_list.bind(rtti_attrs_def,method_def.rtti_attribute_list);
+                  rtti_attrs_def:=nil;
+                  end;
                 fields_allowed:=false;
                 is_classdef:=false;
                 hadgeneric:=false;

+ 5 - 1
compiler/ptype.pas

@@ -959,10 +959,14 @@ implementation
             _PROCEDURE,
             _FUNCTION:
               begin
-                check_unbound_attributes;
                 if IsAnonOrLocal then
                   Message(parser_e_no_methods_in_local_anonymous_records);
                 pd:=parse_record_method_dec(current_structdef,is_classdef,hadgeneric);
+                if assigned(rtti_attrs_def) then
+                  begin
+                  trtti_attribute_list.bind(rtti_attrs_def,pd.rtti_attribute_list);
+                  rtti_attrs_def:=Nil;
+                  end;
                 hadgeneric:=false;
                 fields_allowed:=false;
                 is_classdef:=false;

+ 10 - 2
rtl/objpas/typinfo.pp

@@ -507,6 +507,7 @@ unit TypInfo;
         VmtIndex: Smallint;
         {$IFNDEF VER3_2}
         CodeAddress : CodePointer;
+        AttributeTable : PAttributeTable;
         {$ENDIF}
         property Name: ShortString read GetName;
         property Param[Index: Word]: PVmtMethodParam read GetParam;
@@ -664,6 +665,10 @@ unit TypInfo;
         {$ENDIF}
         NamePtr: PShortString;
         Flags: Byte;
+        {$IFNDEF VER3_2}
+        CodeAddress : CodePointer;
+        AttributeTable : PAttributeTable;
+        {$ENDIF}
         { Params: array[0..ParamCount - 1] of TRecMethodParam }
         { ResultLocs: PParameterLocations (if ResultType != Nil) }
         property Name: ShortString read GetName;
@@ -4654,7 +4659,7 @@ var
 begin
   if ParamCount = 0 then
 {$IFNDEF VER3_2}
-    Result := PByte(@CodeAddress) + SizeOf(CodePointer)
+    Result := PByte(@CodeAddress) + SizeOf(CodePointer)+SizeOf(AttributeTable)
 {$ELSE}
     Result := PByte(@VmtIndex) + SizeOf(VmtIndex)
 {$ENDIF}
@@ -4679,6 +4684,9 @@ end;
 function TRecMethodExEntry.GetParamsStart: PByte;
 begin
   Result:=PByte(aligntoptr(PByte(@NamePtr) + SizeOf(NamePtr)+SizeOf(FLags)));
+  {$IFNDEF VER3_2}
+  Result:=Result+SizeOf(CodeAddress)+SizeOf(AttributeTable);
+  {$ENDIF}
 end;
 
 function TRecMethodExEntry.GetMethodVisibility: TVisibilityClass;
@@ -4709,7 +4717,7 @@ end;
 
 function TRecMethodExEntry.GetTail: Pointer;
 begin
-  Result := PByte(@Flags) + SizeOf(Flags);
+  Result := GetParamsStart;
   if ParamCount > 0 then
     Result := PByte(aligntoptr(Result)) + ParamCount * PtrUInt(aligntoptr(Pointer(SizeOf(TRecMethodParam))));
   if Assigned(ResultType) then