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

* record and array parsing moved to procedure and handle like

Browse Source 
a data stream instead of using records
This commit is contained in:
peter 2004-10-24 21:39:42 +00:00
parent 30d25d1d2b
commit 6214bb294b
1 changed files with 107 additions and 217 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

324
rtl/inc/rtti.inc
View File

@ -42,7 +42,13 @@ Const
tkQWord = 20; tkQWord = 20;
tkDynArray = 21; tkDynArray = 21;
{ A record is designed as follows :
type
TRTTIProc=procedure(Data,TypeInfo:Pointer);
procedure RecordRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
{
A record is designed as follows :
1 : tkrecord 1 : tkrecord
2 : Length of name string (n); 2 : Length of name string (n);
3 : name string; 3 : name string;
@ -51,23 +57,52 @@ Const
11+n : N times : Pointer to type info 11+n : N times : Pointer to type info
Offset in record Offset in record
} }
var
Type Temp : pbyte;
TRecElem = Record namelen : byte;
Info : Pointer; count,
Offset : Longint; offset,
end; i : longint;
info : pointer;
TRecElemArray = Array[1..Maxint] of TRecElem; begin
Temp:=PByte(TypeInfo);
PRecRec = ^TRecRec; inc(Temp);
TRecRec = record { Skip Name }
Size,Count : Longint; namelen:=Temp^;
Elements : TRecElemArray; inc(temp,namelen+1);
end; temp:=aligntoptr(temp);
{ Skip size }
inc(Temp,4);
{ Element count }
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,Count,sizeof(Count));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PLongint(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Count));
{ Process elements }
for i:=1 to count Do
begin
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,Info,sizeof(Info));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Info:=PPointer(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Info));
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,Offset,sizeof(Offset));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Offset:=PLongint(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Offset));
rttiproc (Data+Offset,Info);
end;
end;
{ An array is designed as follows : procedure ArrayRTTI(Data,TypeInfo:Pointer;rttiproc:TRTTIProc);
{
An array is designed as follows :
1 : tkArray; 1 : tkArray;
2 : length of name string (n); 2 : length of name string (n);
3 : NAme string 3 : NAme string
@ -75,93 +110,68 @@ Type
7+n : Number of elements 7+n : Number of elements
11+n : Pointer to type of elements 11+n : Pointer to type of elements
} }
var
PArrayRec = ^TArrayRec; Temp : pbyte;
TArrayRec = record namelen : byte;
Size,Count : Longint; count,
Info : Pointer; size,
i : longint;
info : pointer;
begin
Temp:=PByte(TypeInfo);
inc(Temp);
{ Skip Name }
namelen:=Temp^;
inc(temp,namelen+1);
temp:=aligntoptr(temp);
{ Element size }
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,size,sizeof(size));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
size:=PLongint(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Size));
{ Element count }
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,Count,sizeof(Count));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PLongint(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Count));
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(Temp^,Info,sizeof(Info));
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Info:=PPointer(Temp)^;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
inc(Temp,sizeof(Info));
{ Process elements }
for I:=0 to Count-1 do
rttiproc(Data+(I*size),Info);
end; end;
Procedure fpc_Initialize (Data,TypeInfo : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
{ this definition is sometimes (depending on switches) Procedure fpc_Initialize (Data,TypeInfo : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_INITIALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
already defined or not so define it locally to avoid problems PM }
Var Temp : PByte;
I,Count : longint;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
ArrayRec : TArrayRec;
RecElem : TRecElem;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size : longint;
TInfo : Pointer;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
begin begin
Temp:=PByte(TypeInfo); case PByte(TypeInfo)^ of
case temp^ of
tkAstring,tkWstring,tkInterface,tkDynArray: tkAstring,tkWstring,tkInterface,tkDynArray:
PPchar(Data)^:=Nil; PPchar(Data)^:=Nil;
tkArray: tkArray:
begin arrayrtti(data,typeinfo,@int_initialize);
inc(temp);
I:=temp^;
inc(temp,(I+1)); // skip name string;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PArrayRec(Temp)^,ArrayRec,sizeof(ArrayRec));
for I:=0 to ArrayRec.Count-1 do
int_Initialize (Data+(I*ArrayRec.size),ArrayRec.Info);
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size:=PArrayRec(Temp)^.Size; // get element size
Count:=PArrayRec(Temp)^.Count; // get element Count
TInfo:=PArrayRec(Temp)^.Info; // Get element info
For I:=0 to Count-1 do
int_Initialize (Data+(I*size),TInfo);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkObject, tkObject,
tkRecord: tkRecord:
begin recordrtti(data,typeinfo,@int_initialize);
inc(Temp);
I:=Temp^;
inc(temp,I+1); // skip name string;
temp:=aligntoptr(temp);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PRecRec(Temp)^.Count,Count,sizeof(Count)); // get element Count
For I:=1 to count Do
begin
move(PRecRec(Temp)^.elements[I],RecElem,sizeof(TRecElem));
int_Initialize (Data+RecElem.Offset,RecElem.Info);
end;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PRecRec(Temp)^.Count; // get element Count
For I:=1 to count Do
With PRecRec(Temp)^.elements[I] do
int_Initialize (Data+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
{$ifdef HASVARIANT} {$ifdef HASVARIANT}
tkVariant: tkVariant:
variant_init(Variant(PVarData(Data)^)) variant_init(Variant(PVarData(Data)^));
{$endif HASVARIANT} {$endif HASVARIANT}
end; end;
end; end;
Procedure fpc_finalize (Data,TypeInfo: Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif} Procedure fpc_finalize (Data,TypeInfo: Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,Alias : 'FPC_FINALIZE']; {$ifdef hascompilerproc} compilerproc; {$endif}
{ this definition is sometimes (depending on switches)
already defined or not so define it locally to avoid problems PM }
Var Temp : PByte;
I,Count : longint;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
ArrayRec : TArrayRec;
RecElem : TRecElem;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size : longint;
TInfo : Pointer;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
begin begin
Temp:=PByte(TypeInfo); case PByte(TypeInfo)^ of
case temp^ of
tkAstring : tkAstring :
begin begin
fpc_AnsiStr_Decr_Ref(PPointer(Data)^); fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
@ -175,43 +185,10 @@ begin
end; end;
{$endif HASWIDESTRING} {$endif HASWIDESTRING}
tkArray : tkArray :
begin arrayrtti(data,typeinfo,@int_finalize);
inc(Temp);
I:=temp^;
inc(temp,I+1); // skip name string;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PArrayRec(Temp)^,ArrayRec,sizeof(ArrayRec));
for I:=0 to ArrayRec.Count-1 do
int_Finalize (Data+(I*ArrayRec.size),ArrayRec.Info);
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size:=PArrayRec(Temp)^.Size; // get element size
Count:=PArrayRec(Temp)^.Count; // get element Count
TInfo:=PArrayRec(Temp)^.Info; // Get element info
For I:=0 to Count-1 do
int_Finalize (Data+(I*size),TInfo);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkObject, tkObject,
tkRecord: tkRecord:
begin recordrtti(data,typeinfo,@int_finalize);
inc(Temp);
I:=Temp^;
inc(temp,I+1); // skip name string;
temp:=aligntoptr(temp);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PRecRec(Temp)^.Count,Count,sizeof(Count)); // get element Count
For I:=1 to count Do
begin
move(PRecRec(Temp)^.elements[I],RecElem,sizeof(TRecElem));
int_Finalize (Data+RecElem.Offset,RecElem.Info);
end;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PRecRec(Temp)^.Count; // get element Count
For I:=1 to count do
With PRecRec(Temp)^.elements[I] do
int_Finalize (Data+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
{$ifdef HASINTF} {$ifdef HASINTF}
tkInterface: tkInterface:
begin begin
@ -230,21 +207,8 @@ end;
Procedure fpc_Addref (Data,TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif} Procedure fpc_Addref (Data,TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif} [Public,alias : 'FPC_ADDREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
{ this definition is sometimes (depending on switches)
already defined or not so define it locally to avoid problems PM }
Var Temp : PByte;
I,Count : longint;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
ArrayRec : TArrayRec;
RecElem : TRecElem;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size : longint;
TInfo : Pointer;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
begin begin
Temp:=PByte(TypeInfo); case PByte(TypeInfo)^ of
case temp^ of
tkAstring : tkAstring :
fpc_AnsiStr_Incr_Ref(PPointer(Data)^); fpc_AnsiStr_Incr_Ref(PPointer(Data)^);
{$ifdef HASWIDESTRING} {$ifdef HASWIDESTRING}
@ -252,43 +216,10 @@ begin
fpc_WideStr_Incr_Ref(PPointer(Data)^); fpc_WideStr_Incr_Ref(PPointer(Data)^);
{$endif HASWIDESTRING} {$endif HASWIDESTRING}
tkArray : tkArray :
begin arrayrtti(data,typeinfo,@int_addref);
Inc(Temp);
I:=temp^;
inc(temp,I+1); // skip name string;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PArrayRec(Temp)^,ArrayRec,sizeof(ArrayRec));
for I:=0 to ArrayRec.Count-1 do
int_AddRef (Data+(I*ArrayRec.size),ArrayRec.Info);
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size:=PArrayRec(Temp)^.Size; // get element size
Count:=PArrayRec(Temp)^.Count; // get element Count
TInfo:=PArrayRec(Temp)^.Info; // Get element info
For I:=0 to Count-1 do
int_AddRef (Data+(I*size),TInfo);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkobject, tkobject,
tkrecord : tkrecord :
begin recordrtti(data,typeinfo,@int_addref);
Inc(Temp);
I:=Temp^;
temp:=temp+(I+1); // skip name string;
temp:=aligntoptr(temp);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PRecRec(Temp)^.Count,Count,sizeof(Count)); // get element Count
For I:=1 to count Do
begin
move(PRecRec(Temp)^.elements[I],RecElem,sizeof(TRecElem));
int_AddRef (Data+RecElem.Offset,RecElem.Info);
end;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PRecRec(Temp)^.Count; // get element Count
For I:=1 to count do
With PRecRec(Temp)^.elements[I] do
int_AddRef (Data+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkDynArray: tkDynArray:
fpc_dynarray_incr_ref(PPointer(Data)^); fpc_dynarray_incr_ref(PPointer(Data)^);
{$ifdef HASINTF} {$ifdef HASINTF}
@ -304,20 +235,8 @@ end;
procedure fpc_systemDecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DECREF']; procedure fpc_systemDecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[external name 'FPC_DECREF'];
Procedure fpc_DecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif} Procedure fpc_DecRef (Data, TypeInfo : Pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[Public,alias : 'FPC_DECREF']; {$ifdef hascompilerproc} compilerproc; {$endif}
{ this definition is sometimes (depending on switches)
already defined or not so define it locally to avoid problems PM }
Var Temp : PByte;
I,Count : longint;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
ArrayRec : TArrayRec;
RecElem : TRecElem;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size : longint;
TInfo : Pointer;
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
begin begin
Temp:=PByte(TypeInfo); case PByte(TypeInfo)^ of
case temp^ of
{ see AddRef for comment about below construct (JM) } { see AddRef for comment about below construct (JM) }
tkAstring: tkAstring:
fpc_AnsiStr_Decr_Ref(PPointer(Data)^); fpc_AnsiStr_Decr_Ref(PPointer(Data)^);
@ -326,43 +245,10 @@ begin
fpc_WideStr_Decr_Ref(PPointer(Data)^); fpc_WideStr_Decr_Ref(PPointer(Data)^);
{$endif HASWIDESTRING} {$endif HASWIDESTRING}
tkArray: tkArray:
begin arrayrtti(data,typeinfo,@fpc_systemDecRef);
inc(Temp);
I:=temp^;
inc(temp,I+1); // skip name string;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PArrayRec(Temp)^,ArrayRec,sizeof(ArrayRec));
for I:=0 to ArrayRec.Count-1 do
fpc_systemDecRef (Data+(I*ArrayRec.size),ArrayRec.Info);
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Size:=PArrayRec(Temp)^.Size; // get element size
Count:=PArrayRec(Temp)^.Count; // get element Count
TInfo:=PArrayRec(Temp)^.Info; // Get element info
For I:=0 to Count-1 do
fpc_systemDecRef (Data+(I*size),TInfo);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkobject, tkobject,
tkrecord: tkrecord:
begin recordrtti(data,typeinfo,@fpc_systemDecRef);
inc(Temp);
I:=temp^;
inc(temp,I+1); // skip name string;
temp:=aligntoptr(temp);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
move(PRecRec(Temp)^.Count,Count,sizeof(Count)); // get element Count
For I:=1 to count Do
begin
move(PRecRec(Temp)^.elements[I],RecElem,sizeof(TRecElem));
fpc_systemDecRef (Data+RecElem.Offset,RecElem.Info);
end;
{$else FPC_REQUIRES_PROPER_ALIGNMENT}
Count:=PRecRec(Temp)^.Count; // get element Count
For I:=1 to count do
With PRecRec(Temp)^.elements[I] do
fpc_systemDecRef (Data+Offset,Info);
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
end;
tkDynArray: tkDynArray:
fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo); fpc_dynarray_decr_ref(PPointer(Data)^,TypeInfo);
{$ifdef HASINTF} {$ifdef HASINTF}
@ -385,7 +271,11 @@ procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Pub
{ {
$Log$ $Log$
Revision 1.16 2004-10-24 20:01:42 peter Revision 1.17 2004-10-24 21:39:42 peter
* record and array parsing moved to procedure and handle like
a data stream instead of using records
Revision 1.16 2004/10/24 20:01:42 peter
* saveregisters calling convention is obsolete * saveregisters calling convention is obsolete
Revision 1.15 2004/10/04 21:26:16 florian Revision 1.15 2004/10/04 21:26:16 florian