|
@@ -23,11 +23,6 @@ unit typinfo;
|
|
|
|
|
|
{$MODE objfpc}
|
|
{$MODE objfpc}
|
|
|
|
|
|
-{$ifndef AUTOOBJPAS}
|
|
|
|
- uses
|
|
|
|
- objpas;
|
|
|
|
-{$endif}
|
|
|
|
-
|
|
|
|
// temporary types:
|
|
// temporary types:
|
|
|
|
|
|
type
|
|
type
|
|
@@ -39,7 +34,7 @@ unit typinfo;
|
|
PDouble =^Double;
|
|
PDouble =^Double;
|
|
PExtended =^Extended;
|
|
PExtended =^Extended;
|
|
PComp =^Comp;
|
|
PComp =^Comp;
|
|
- PFixed16 =^Fixed16;
|
|
|
|
|
|
+ PFixed16 =^Fixed16;
|
|
{ Doesn't exist ?
|
|
{ Doesn't exist ?
|
|
PFIxed32 = ^Fixed32;
|
|
PFIxed32 = ^Fixed32;
|
|
}
|
|
}
|
|
@@ -143,7 +138,7 @@ unit typinfo;
|
|
// bit 0..1 GetProc
|
|
// bit 0..1 GetProc
|
|
// 2..3 SetProc
|
|
// 2..3 SetProc
|
|
// 4..5 StoredProc
|
|
// 4..5 StoredProc
|
|
- // 6 : true, constant index property
|
|
|
|
|
|
+ // 6 : true, constant index property
|
|
PropProcs : Byte;
|
|
PropProcs : Byte;
|
|
|
|
|
|
Name : ShortString;
|
|
Name : ShortString;
|
|
@@ -202,7 +197,7 @@ unit typinfo;
|
|
{$ASMMODE ATT}
|
|
{$ASMMODE ATT}
|
|
|
|
|
|
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
|
|
function CallIntegerFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Integer;assembler;
|
|
-
|
|
|
|
|
|
+
|
|
Label LINoPush;
|
|
Label LINoPush;
|
|
|
|
|
|
asm
|
|
asm
|
|
@@ -228,7 +223,7 @@ unit typinfo;
|
|
movl Address,%edi
|
|
movl Address,%edi
|
|
// Push value to set
|
|
// Push value to set
|
|
movl Value,%eax
|
|
movl Value,%eax
|
|
- pushl %eax
|
|
|
|
|
|
+ pushl %eax
|
|
// ? Indexed procedure
|
|
// ? Indexed procedure
|
|
movl Index,%eax
|
|
movl Index,%eax
|
|
xorl %eax,%eax
|
|
xorl %eax,%eax
|
|
@@ -241,7 +236,7 @@ unit typinfo;
|
|
end;
|
|
end;
|
|
|
|
|
|
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
|
|
function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
|
|
-
|
|
|
|
|
|
+
|
|
Label LINoPush;
|
|
Label LINoPush;
|
|
|
|
|
|
asm
|
|
asm
|
|
@@ -268,7 +263,7 @@ unit typinfo;
|
|
// Push value to set
|
|
// Push value to set
|
|
//!! MUST BE CHANGED !!
|
|
//!! MUST BE CHANGED !!
|
|
movl Value,%eax
|
|
movl Value,%eax
|
|
- pushl %eax
|
|
|
|
|
|
+ pushl %eax
|
|
// ? Indexed procedure
|
|
// ? Indexed procedure
|
|
movl Index,%eax
|
|
movl Index,%eax
|
|
xorl %eax,%eax
|
|
xorl %eax,%eax
|
|
@@ -282,7 +277,7 @@ unit typinfo;
|
|
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
|
|
function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
|
|
|
|
|
|
Label LBNoPush;
|
|
Label LBNoPush;
|
|
-
|
|
|
|
|
|
+
|
|
asm
|
|
asm
|
|
movl S,%edi
|
|
movl S,%edi
|
|
movl Address,%edi
|
|
movl Address,%edi
|
|
@@ -302,7 +297,7 @@ unit typinfo;
|
|
|
|
|
|
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
|
Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
|
|
Var Res: Shortstring);assembler;
|
|
Var Res: Shortstring);assembler;
|
|
-
|
|
|
|
|
|
+
|
|
Label LSSNoPush;
|
|
Label LSSNoPush;
|
|
|
|
|
|
asm
|
|
asm
|
|
@@ -329,7 +324,7 @@ unit typinfo;
|
|
// Push value to set
|
|
// Push value to set
|
|
//!! Is this correct for short strings ????
|
|
//!! Is this correct for short strings ????
|
|
movl Value,%eax
|
|
movl Value,%eax
|
|
- pushl %eax
|
|
|
|
|
|
+ pushl %eax
|
|
// ? Indexed procedure
|
|
// ? Indexed procedure
|
|
movl Index,%eax
|
|
movl Index,%eax
|
|
xorl %eax,%eax
|
|
xorl %eax,%eax
|
|
@@ -403,10 +398,10 @@ unit typinfo;
|
|
Var TD : PTypeData;
|
|
Var TD : PTypeData;
|
|
TP : PPropInfo;
|
|
TP : PPropInfo;
|
|
Count : Longint;
|
|
Count : Longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
TD:=GetTypeData(TypeInfo);
|
|
TD:=GetTypeData(TypeInfo);
|
|
- // Get this objects TOTAL published properties count
|
|
|
|
|
|
+ // Get this objects TOTAL published properties count
|
|
TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
|
|
TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
|
|
Count:=PWord(TP)^;
|
|
Count:=PWord(TP)^;
|
|
// Now point TP to first propinfo record.
|
|
// Now point TP to first propinfo record.
|
|
@@ -415,7 +410,7 @@ unit typinfo;
|
|
begin
|
|
begin
|
|
PropList^[0]:=TP;
|
|
PropList^[0]:=TP;
|
|
Inc(Longint(PropList),SizeOf(Pointer));
|
|
Inc(Longint(PropList),SizeOf(Pointer));
|
|
- // Point to TP next propinfo record.
|
|
|
|
|
|
+ // Point to TP next propinfo record.
|
|
// Located at Name[Length(Name)+1] !
|
|
// Located at Name[Length(Name)+1] !
|
|
TP:=PPropInfo((@TP^.Name)+PByte(@TP^.Name)^+1);
|
|
TP:=PPropInfo((@TP^.Name)+PByte(@TP^.Name)^+1);
|
|
Dec(Count);
|
|
Dec(Count);
|
|
@@ -424,17 +419,17 @@ unit typinfo;
|
|
If TD^.Parentinfo<>Nil then
|
|
If TD^.Parentinfo<>Nil then
|
|
GetPropInfos (TD^.ParentInfo,PropList);
|
|
GetPropInfos (TD^.ParentInfo,PropList);
|
|
end;
|
|
end;
|
|
-
|
|
|
|
- Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
|
|
|
|
-
|
|
|
|
|
|
+
|
|
|
|
+ Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
|
|
|
|
+
|
|
VAr I : Longint;
|
|
VAr I : Longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
I:=0;
|
|
I:=0;
|
|
While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
|
|
While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
|
|
If I<Count then
|
|
If I<Count then
|
|
Move(PL^[I],PL[I+1],Count-I*SizeOf(Pointer));
|
|
Move(PL^[I],PL[I+1],Count-I*SizeOf(Pointer));
|
|
- PL^[I]:=PI;
|
|
|
|
|
|
+ PL^[I]:=PI;
|
|
end;
|
|
end;
|
|
|
|
|
|
function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
|
|
function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
|
|
@@ -448,7 +443,7 @@ unit typinfo;
|
|
Var TempList : PPropList;
|
|
Var TempList : PPropList;
|
|
PropInfo : PPropinfo;
|
|
PropInfo : PPropinfo;
|
|
I,Count : longint;
|
|
I,Count : longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
Result:=0;
|
|
Result:=0;
|
|
Count:=GetTypeData(TypeInfo)^.Propcount;
|
|
Count:=GetTypeData(TypeInfo)^.Propcount;
|
|
@@ -467,13 +462,13 @@ unit typinfo;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
finally
|
|
- FreeMem(TempList,Count*SizeOf(Pointer));
|
|
|
|
|
|
+ FreeMem(TempList,Count*SizeOf(Pointer));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
|
|
Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
Index:=((P^.PropProcs shr 6) and 1);
|
|
Index:=((P^.PropProcs shr 6) and 1);
|
|
If Index=0 then
|
|
If Index=0 then
|
|
@@ -536,16 +531,16 @@ unit typinfo;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer;
|
|
Function GetAStrProp(Instance : TObject;PropInfo : PPropInfo):Pointer;
|
|
-
|
|
|
|
|
|
+
|
|
{
|
|
{
|
|
Dirty trick based on fact that AnsiString is just a pointer,
|
|
Dirty trick based on fact that AnsiString is just a pointer,
|
|
hence can be treated like an integer type.
|
|
hence can be treated like an integer type.
|
|
}
|
|
}
|
|
-
|
|
|
|
|
|
+
|
|
var
|
|
var
|
|
value : Pointer;
|
|
value : Pointer;
|
|
Index,Ivalue : Longint;
|
|
Index,Ivalue : Longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
@@ -562,11 +557,11 @@ unit typinfo;
|
|
end;
|
|
end;
|
|
|
|
|
|
Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString;
|
|
Function GetSStrProp(Instance : TObject;PropInfo : PPropInfo):ShortString;
|
|
-
|
|
|
|
|
|
+
|
|
var
|
|
var
|
|
value : ShortString;
|
|
value : ShortString;
|
|
Index,IValue : Longint;
|
|
Index,IValue : Longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
@@ -601,16 +596,16 @@ unit typinfo;
|
|
Dirty trick based on fact that AnsiString is just a pointer,
|
|
Dirty trick based on fact that AnsiString is just a pointer,
|
|
hence can be treated like an integer type.
|
|
hence can be treated like an integer type.
|
|
}
|
|
}
|
|
-
|
|
|
|
|
|
+
|
|
var
|
|
var
|
|
Index,Ivalue : Longint;
|
|
Index,Ivalue : Longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
SetIndexValues(PropInfo,Index,IValue);
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
ptfield:
|
|
ptfield:
|
|
PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Longint(Pointer(Value)) ;
|
|
PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Longint(Pointer(Value)) ;
|
|
- ptstatic:
|
|
|
|
|
|
+ ptstatic:
|
|
CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
|
|
CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
|
|
ptvirtual:
|
|
ptvirtual:
|
|
CallIntegerProc(Instance,
|
|
CallIntegerProc(Instance,
|
|
@@ -618,7 +613,7 @@ unit typinfo;
|
|
Longint(Pointer(Value)),Index,IValue);
|
|
Longint(Pointer(Value)),Index,IValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
-
|
|
|
|
|
|
+
|
|
procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
|
|
procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
|
|
const Value : ShortString);
|
|
const Value : ShortString);
|
|
|
|
|
|
@@ -637,7 +632,7 @@ unit typinfo;
|
|
Value,Index,IValue);
|
|
Value,Index,IValue);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
-
|
|
|
|
|
|
+
|
|
procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
|
|
procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
|
|
const Value : AnsiString);
|
|
const Value : AnsiString);
|
|
|
|
|
|
@@ -660,7 +655,7 @@ unit typinfo;
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
ptfield:
|
|
ptfield:
|
|
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
|
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
|
- ftSingle:
|
|
|
|
|
|
+ ftSingle:
|
|
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
ftDouble:
|
|
ftDouble:
|
|
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
@@ -673,7 +668,7 @@ unit typinfo;
|
|
Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
ftfixed32:
|
|
ftfixed32:
|
|
Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
|
|
- }
|
|
|
|
|
|
+ }
|
|
end;
|
|
end;
|
|
ptstatic:
|
|
ptstatic:
|
|
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
|
|
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
|
|
@@ -686,15 +681,15 @@ unit typinfo;
|
|
|
|
|
|
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
|
|
procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
|
|
Value : Extended);
|
|
Value : Extended);
|
|
-
|
|
|
|
|
|
+
|
|
Var IValue,Index : longint;
|
|
Var IValue,Index : longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
SetIndexValues(PropInfo,Index,Ivalue);
|
|
SetIndexValues(PropInfo,Index,Ivalue);
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
case (PropInfo^.PropProcs) and 3 of
|
|
ptfield:
|
|
ptfield:
|
|
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
|
Case GetTypeData(PropInfo^.PropType)^.FloatType of
|
|
- ftSingle:
|
|
|
|
|
|
+ ftSingle:
|
|
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
ftDouble:
|
|
ftDouble:
|
|
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
@@ -707,7 +702,7 @@ unit typinfo;
|
|
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
ftfixed32:
|
|
ftfixed32:
|
|
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
|
|
- }
|
|
|
|
|
|
+ }
|
|
end;
|
|
end;
|
|
ptstatic:
|
|
ptstatic:
|
|
CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
|
|
CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
|
|
@@ -747,7 +742,7 @@ unit typinfo;
|
|
function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
|
|
function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
|
|
|
|
|
|
Var PS : PShortString;
|
|
Var PS : PShortString;
|
|
- PT : PTypeData;
|
|
|
|
|
|
+ PT : PTypeData;
|
|
|
|
|
|
begin
|
|
begin
|
|
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
|
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
|
@@ -762,20 +757,20 @@ unit typinfo;
|
|
end;
|
|
end;
|
|
|
|
|
|
function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
|
|
function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
|
|
-
|
|
|
|
|
|
+
|
|
Var PS : PShortString;
|
|
Var PS : PShortString;
|
|
PT : PTypeData;
|
|
PT : PTypeData;
|
|
Count : longint;
|
|
Count : longint;
|
|
-
|
|
|
|
|
|
+
|
|
begin
|
|
begin
|
|
If Length(Name)=0 then exit(-1);
|
|
If Length(Name)=0 then exit(-1);
|
|
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
|
PT:=GetTypeData(GetTypeData(TypeInfo)^.BaseType);
|
|
Count:=0;
|
|
Count:=0;
|
|
Result:=-1;
|
|
Result:=-1;
|
|
PS:=@PT^.NameList;
|
|
PS:=@PT^.NameList;
|
|
- While (Result=-1) and (PByte(PS)^<>0) do
|
|
|
|
|
|
+ While (Result=-1) and (PByte(PS)^<>0) do
|
|
begin
|
|
begin
|
|
- If PS^=Name then
|
|
|
|
|
|
+ If PS^=Name then
|
|
Result:=Count;
|
|
Result:=Count;
|
|
PS:=PS+PByte(PS)^;
|
|
PS:=PS+PByte(PS)^;
|
|
Inc(Count);
|
|
Inc(Count);
|
|
@@ -786,7 +781,10 @@ end.
|
|
|
|
|
|
{
|
|
{
|
|
$Log$
|
|
$Log$
|
|
- Revision 1.16 1998-12-02 12:35:07 michael
|
|
|
|
|
|
+ Revision 1.17 1998-12-15 22:43:13 peter
|
|
|
|
+ * removed temp symbols
|
|
|
|
+
|
|
|
|
+ Revision 1.16 1998/12/02 12:35:07 michael
|
|
More changes for type-information
|
|
More changes for type-information
|
|
|
|
|
|
Revision 1.15 1998/11/26 14:57:47 michael
|
|
Revision 1.15 1998/11/26 14:57:47 michael
|