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

Made it compilable

Browse Source
This commit is contained in:
michael 1998-09-08 00:08:36 +00:00
parent 7e27f45109
commit dedb40b870
1 changed files with 25 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/objpas/typinfo.pp
View File

@ -21,10 +21,17 @@ unit typinfo;
interface interface
uses uses objpas;
{
sysutils; sysutils;
}
// temporary types:
type type
ShortSTring=String;
PByte =^Byte;
PBoolean =^Boolean;
{$MINENUMSIZE 1 this saves a lot of memory } {$MINENUMSIZE 1 this saves a lot of memory }
// if you change one of the following enumeration types // if you change one of the following enumeration types
// you have also to change the compiler in an appropriate way ! // you have also to change the compiler in an appropriate way !
@ -67,12 +74,13 @@ unit typinfo;
tkUnKnown,tkLString,tkWString,tkAString,tkVariant: tkUnKnown,tkLString,tkWString,tkAString,tkVariant:
(); ();
tkInteger,tkChar,tkEnumeration,tkWChar: tkInteger,tkChar,tkEnumeration,tkWChar:
(OrdType : TOrdType; (OrdType : TTOrdType;
case TTypeKind of case TTypeKind of
tkInteger,tkChar,tkEnumeration,tkBool,tkWChar : ( tkInteger,tkChar,tkEnumeration,tkBool,tkWChar : (
MinValue,MaxValue : Longint; MinValue,MaxValue : Longint;
case TTypeKind of case TTypeKind of
tkEnumeration: tkEnumeration:
(
BaseType : PTypeInfo; BaseType : PTypeInfo;
NameList : ShortString) NameList : ShortString)
); );
@ -151,13 +159,16 @@ unit typinfo;
var var
hp : PTypeData; hp : PTypeData;
i : longint;
begin begin
Result:=Nil; Result:=Nil;
while Assigned(hp) do while Assigned(hp) do
begin begin
// skip the name // skip the name
hp:=GetTypeData; //!! Florian, I added (typeinfo) so it would compile
hp:=GetTypeData(Typeinfo);
// the class info rtti the property rtti follows // the class info rtti the property rtti follows
// immediatly // immediatly
@ -172,7 +183,8 @@ unit typinfo;
Result:=PPropInfo(@Result^.Name)+byte(Result^.Name[0])+1; Result:=PPropInfo(@Result^.Name)+byte(Result^.Name[0])+1;
end; end;
// parent class // parent class
hp:=hp^.ParentInfo; //!! Florian, commented out, because the types are wrong
// hp:=hp^.ParentInfo;
end; end;
end; end;
@ -189,19 +201,20 @@ unit typinfo;
begin begin
caller.Instance:=Instance; caller.Instance:=Instance;
case (PropInfo^.PropProcs shr 4) and 3 of //!! propprocs doesn't exist, changed to procprops
case (PropInfo^.ProcProcs shr 4) and 3 of
0: 0:
IsStoredProp:= IsStoredProp:=
PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^; PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
1: 1:
begin begin
caller.Address:=PropInfo^.StoredProc; caller.Address:=PropInfo^.StoredProc;
IsStoredProc:=tbfunction(caller); // IsStoredProp:=tbfunction(caller);
end; end;
2: 2:
begin begin
caller.Address:=PPointer(PPointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^; caller.Address:=PPointer(PPointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^;
IsStoredProc:=tbfunction(caller); // IsStoredProp:=tbfunction(caller);
end; end;
4: 4:
begin begin
@ -215,7 +228,10 @@ end.
{ {
$Log$ $Log$
Revision 1.5 1998-09-07 23:11:43 florian Revision 1.6 1998-09-08 00:08:36 michael
Made it compilable
Revision 1.5 1998/09/07 23:11:43 florian
+ more fields to TTypeInfo added + more fields to TTypeInfo added
Revision 1.4 1998/09/07 19:34:47 florian Revision 1.4 1998/09/07 19:34:47 florian