From 27062c2e0194dfe473de778f2fb3f1f067ca9319 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 29 Mar 2003 16:55:56 +0000 Subject: [PATCH] + Patch from Mattias Gaertner for single typeinfo --- rtl/i386/typinfo.inc | 39 +++++++--- rtl/linux/i386/signal.inc | 7 +- rtl/objpas/typinfo.pp | 151 +++++++++++++++++++++++++++----------- 3 files changed, 142 insertions(+), 55 deletions(-) diff --git a/rtl/i386/typinfo.inc b/rtl/i386/typinfo.inc index 7d08394228..a7c5bd769c 100644 --- a/rtl/i386/typinfo.inc +++ b/rtl/i386/typinfo.inc @@ -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 } diff --git a/rtl/linux/i386/signal.inc b/rtl/linux/i386/signal.inc index 13679ff958..7ed900ca52 100644 --- a/rtl/linux/i386/signal.inc +++ b/rtl/linux/i386/signal.inc @@ -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 } diff --git a/rtl/objpas/typinfo.pp b/rtl/objpas/typinfo.pp index ab5be2fdb8..e52c18f411 100644 --- a/rtl/objpas/typinfo.pp +++ b/rtl/objpas/typinfo.pp @@ -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