paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 10:48:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Atributes for class/record methods

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-03-02 14:15:22 +01:00
parent 4e1f854d49
commit 05f0ceeb26
4 changed files with 27 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/ncgrtti.pas
View File

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

10
compiler/pdecobj.pas
View File

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

6
compiler/ptype.pas
View File

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

12
rtl/objpas/typinfo.pp
View File

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