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

+ Patch from Mattias Gaertner for single typeinfo

Browse Source
This commit is contained in:
michael 2003-03-29 16:55:56 +00:00
parent 53b6c5d242
commit 27062c2e01
3 changed files with 142 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
rtl/i386/typinfo.inc
View File

@ -58,7 +58,8 @@ Function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IV
call %edi
end;
Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
Function CallSingleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Single; assembler;
asm
movl S,%esi
movl Address,%edi
@ -74,24 +75,37 @@ Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint)
//
end;
Function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
Function CallDoubleFunc(s : Pointer; Address : Pointer;
Index, IValue : Longint) : Double; assembler;
asm
movl S,%esi
movl Address,%edi
// Push value to set
leal Value,%eax
pushl (%eax)
pushl 4(%eax)
pushl 8(%eax)
// ? Indexed Procedure
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LIPNoPush
je .LINoPush
movl IValue,%eax
pushl %eax
.LIPNoPush:
.LINoPush:
push %esi
call %edi
//
end;
Function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
asm
movl S,%esi
movl Address,%edi
// ? Indexed Function
movl Index,%eax
testl %eax,%eax
je .LINoPush
movl IValue,%eax
pushl %eax
.LINoPush:
push %esi
call %edi
//
end;
Function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
@ -153,7 +167,10 @@ Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortStrin
{
$Log$
Revision 1.4 2002-09-07 16:01:19 peter
Revision 1.5 2003-03-29 16:55:56 michael
+ Patch from Mattias Gaertner for single typeinfo
Revision 1.4 2002/09/07 16:01:19 peter
* old logs removed and tabs fixed
}

7
rtl/linux/i386/signal.inc
View File

@ -14,6 +14,7 @@
**********************************************************************}
{$packrecords C}
const
SI_PAD_SIZE = ((128/sizeof(longint)) - 3);
@ -130,6 +131,7 @@ Procedure SigAction(Signum:Integer;Act,OldAct:PSigActionRec );
If Act is non-nil, it is used to specify the new action.
If OldAct is non-nil the previous action is saved there.
}
Var
sr : Syscallregs;
begin
@ -141,7 +143,10 @@ end;
{
$Log$
Revision 1.3 2002-09-07 16:01:20 peter
Revision 1.4 2003-03-29 16:55:56 michael
+ Patch from Mattias Gaertner for single typeinfo
Revision 1.3 2002/09/07 16:01:20 peter
* old logs removed and tabs fixed
}

151
rtl/objpas/typinfo.pp
View File

@ -893,63 +893,125 @@ end;
{ ---------------------------------------------------------------------
Float properties
---------------------------------------------------------------------}
Function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
var
Index,Ivalue : longint;
Value : Extended;
Index,Ivalue : longint;
Value : Extended;
begin
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs) and 3 of
ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftDouble:
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftExtended:
Value:=PExtended(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs) and 3 of
ptField:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftDouble:
Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftExtended:
Value:=PExtended(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
{$ifndef m68k}
ftcomp:
Value:=PComp(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
ftcomp:
Value:=PComp(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
{$endif m68k}
end;
ptstatic:
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
ptvirtual:
Value:=CallExtendedFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
end;
Result:=Value;
end;
ptStatic:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=CallSingleFunc(Instance,PropInfo^.GetProc,Index,IValue);
ftDouble:
Value:=CallDoubleFunc(Instance,PropInfo^.GetProc,Index,IValue);
ftExtended:
Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
end;
ptVirtual:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
Value:=CallSingleFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
ftDouble:
Value:=CallDoubleFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
ftExtended:
Value:=CallExtendedFunc(Instance,
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,
Index,IValue);
end;
end;
Result:=Value;
end;
Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
Value : Extended);
Value : Extended);
Var IValue,Index : longint;
type
TSetExtendedProc = procedure(const AValue: Extended) of object;
TSetExtendedProcIndex = procedure(Index: integer; const AValue: Extended) of object;
TSetDoubleProc = procedure(const AValue: Double) of object;
TSetDoubleProcIndex = procedure(Index: integer; const AValue: Double) of object;
TSetSingleProc = procedure(const AValue: Single) of object;
TSetSingleProcIndex = procedure(Index: integer; const AValue: Single) of object;
Var IValue,Index : longint;
AMethod: TMethod;
begin
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs shr 2) and 3 of
ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftDouble:
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftExtended:
PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
SetIndexValues(PropInfo,Index,Ivalue);
case (PropInfo^.PropProcs shr 2) and 3 of
ptfield:
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftDouble:
PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftExtended:
PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
{$ifndef m68k}
ftcomp:
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
ftcomp:
PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
{$endif m68k}
end;
ptstatic:
CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
ptvirtual:
CallExtendedProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
end;
{ Uncommenting this code results in a internal error!!
ftFixed16:
PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
ftfixed32:
PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
}
end;
ptStatic, ptVirtual:
begin
if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
AMethod.Code:=PropInfo^.SetProc
else
AMethod.Code:=
PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
AMethod.Data:=Instance;
Case GetTypeData(PropInfo^.PropType)^.FloatType of
ftSingle:
if Index=0 then
TSetSingleProc(AMethod)(Value)
else
TSetSingleProcIndex(AMethod)(IValue,Value);
ftDouble:
if Index=0 then
TSetDoubleProc(AMethod)(Value)
else
TSetDoubleProcIndex(AMethod)(IValue,Value);
ftExtended:
if Index=0 then
TSetExtendedProc(AMethod)(Value)
else
TSetExtendedProcIndex(AMethod)(IValue,Value);
end;
end;
end;
end;
Function GetFloatProp(Instance: TObject; const PropName: string): Extended;
@ -1151,7 +1213,10 @@ end;
end.
{
$Log$
Revision 1.14 2002-09-07 16:01:22 peter
Revision 1.15 2003-03-29 16:55:56 michael
+ Patch from Mattias Gaertner for single typeinfo
Revision 1.14 2002/09/07 16:01:22 peter
* old logs removed and tabs fixed
Revision 1.13 2002/04/04 18:32:59 peter